diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# 0.7.2 + +- Add `writeCSVopts` that accepts options to specify the CSV delimiter. +- Add `inferencePrefix` that controls how many lines of the input file are used for column type inference (default is 1000). +- Add `readTableDebug` that loads and parses a data frame as `readTable`, but additionally prints lines that failed to parse to `stderr`. + # 0.7.1 - Add `showFrame`, `printFrame`, `takeRows`, and `dropRows` to the `Frames.Exploration` module. These helpers for working with `Frames` are re-exported from the `Frames` module itself. Thanks to @chfin. diff --git a/Frames.cabal b/Frames.cabal --- a/Frames.cabal +++ b/Frames.cabal @@ -1,5 +1,5 @@ name: Frames -version: 0.7.1 +version: 0.7.2 synopsis: Data frames For working with tabular data files description: User-friendly, type safe, runtime efficient tooling for working with tabular data deserialized from @@ -30,7 +30,7 @@ data/left1.csv data/right1.csv data/left_summary.csv data/FL2.csv cabal-version: >=1.10 -tested-with: GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1 +tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1 source-repository head type: git diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -20,12 +20,11 @@ We generate a collection of definitions generated by inspecting the data file at compile time (using `tableTypes`), then, at runtime, load that data into column-oriented storage in memory (an **in-core** array of structures (AoS)). We're going to compute the average ratio of two columns, so we'll use the `foldl` library. Our fold will project the columns we want, and apply a function that divides one by the other after appropriate numeric type conversions. Here is the entirety of that [program](https://github.com/acowley/Frames/tree/master/test/UncurryFold.hs). ```haskell -{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell #-} +{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell, TypeApplications #-} module UncurryFold where -import qualified Control.Foldl as L -import Data.Vinyl (rcast) -import Data.Vinyl.Curry (runcurryX) -import Frames +import qualified Control.Foldl as L +import Data.Vinyl.Curry ( runcurryX ) +import Frames -- Data set from http://vincentarelbundock.github.io/Rdatasets/datasets.html tableTypes "Row" "test/data/prestige.csv" @@ -49,13 +48,14 @@ Now consider a case where our data file lacks a header row (I deleted the first row from \`prestige.csv\`). We will provide our own name for the generated row type, our own column names, and, for the sake of demonstration, we will also specify a prefix to be added to every column-based identifier (particularly useful if the column names **do** come from a header row, and you want to work with multiple CSV files some of whose column names coincide). We customize behavior by updating whichever fields of the record produced by `rowGen` we care to change, passing the result to `tableTypes'`. [Link to code.](https://github.com/acowley/Frames/tree/master/test/UncurryFoldNoHeader.hs) ```haskell -{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell #-} +{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell, TypeApplications #-} module UncurryFoldNoHeader where -import qualified Control.Foldl as L -import Data.Vinyl (rcast) -import Data.Vinyl.Curry (runcurryX) -import Frames -import Frames.TH (rowGen, RowGen(..)) +import qualified Control.Foldl as L +import Data.Vinyl.Curry ( runcurryX ) +import Frames +import Frames.TH ( rowGen + , RowGen(..) + ) -- Data set from http://vincentarelbundock.github.io/Rdatasets/datasets.html tableTypes' (rowGen "test/data/prestigeNoHeader.csv") @@ -138,4 +138,20 @@ This is a trivial program, but shows that performance is comparable to Pandas, and the memory savings of a compiled program are substantial. -![img](https://pbs.twimg.com/media/B71az_CCUAAgscq.png) +First with Pandas, + +```bash +$ nix-shell -p 'python3.withPackages (p: [p.pandas])' --run '$(which time) -f "%Uuser %Ssystem %Eelapsed %PCPU; %Mmaxresident KB" python benchmarks/panda.py' +28.087476512228815 +-81.90356506136422 +0.67user 0.04system 0:00.72elapsed 99%CPU; 79376maxresident KB +``` + +Then with Frames, + +```bash +$ $(which time) -f '%Uuser %Ssystem %Eelapsed %PCPU; %Mmaxresident KB' dist-newstyle/build/x86_64-linux/ghc-8.10.4/Frames-0.7.2/x/benchdemo/build/benchdemo/benchdemo +28.087476512228815 +-81.90356506136422 +0.36user 0.00system 0:00.37elapsed 100%CPU; 5088maxresident KB +``` diff --git a/benchmarks/BenchDemo.hs b/benchmarks/BenchDemo.hs --- a/benchmarks/BenchDemo.hs +++ b/benchmarks/BenchDemo.hs @@ -10,9 +10,16 @@ -- @$ $(which time) -v dist-newstyle/build/x86_64-linux/ghc-8.8.2/Frames-0.6.2/x/benchdemo/build/benchdemo/benchdemo@ import qualified Control.Foldl as F import Frames +import Frames.TH (rowGen, RowGen (rowTypeName, inferencePrefix)) import Pipes.Prelude (fold) -tableTypes "Ins" "data/FL2.csv" +-- The simple use of 'tableTypes' commented out here is what one +-- typically uses; it infers column types based the first 1000 rows of +-- the data file. In this data file, however, we need to see more rows +-- to properly identify the types. + +-- tableTypes "Ins" "data/FL2.csv" +tableTypes' (rowGen "data/FL2.csv") { rowTypeName = "Ins", inferencePrefix = 2500 } main :: IO () main = do (lat,lng,n) <- runSafeT $ F.purely fold f (readTable "data/FL2.csv") diff --git a/src/Frames.hs b/src/Frames.hs --- a/src/Frames.hs +++ b/src/Frames.hs @@ -40,7 +40,7 @@ RDelete, RecAll) import Frames.Col ((:->), pattern Col) import Frames.ColumnUniverse -import Frames.CSV (readTable, readTableOpt, readTableMaybe, pipeTable, pipeTableMaybe) +import Frames.CSV (readTable, readTableOpt, readTableMaybe, readTableDebug, pipeTable, pipeTableMaybe) import Frames.Exploration import Frames.Frame import qualified Frames.InCore as I diff --git a/src/Frames/CSV.hs b/src/Frames/CSV.hs --- a/src/Frames/CSV.hs +++ b/src/Frames/CSV.hs @@ -39,7 +39,7 @@ import qualified Pipes.Parse as P import qualified Pipes.Safe as P import qualified Pipes.Safe.Prelude as Safe -import System.IO (Handle, IOMode(ReadMode, WriteMode)) +import System.IO (Handle, IOMode(ReadMode, WriteMode), hPrint, stderr) -- * Parsing @@ -336,6 +336,37 @@ readTable = readTableOpt defaultParser {-# INLINE readTable #-} +readRecEither :: (ReadRec rs, RMap rs) + => [T.Text] -> Either (Rec (Either T.Text :. ElField) rs) (Record rs) +readRecEither tokens = let tmp = readRec tokens + in case rtraverse getCompose tmp of + Right r -> Right r + _ -> Left tmp + +-- | Similar to 'readTable' except that rows that fail to parse are +-- printed to @stderr@ with columns that failed to parse printed as +-- @"Left rawtext"@ while those that were successfully parsed are +-- shown as @"Right text"@. +readTableDebug :: forall m rs. + (P.MonadSafe m, ReadRec rs, RMap rs, + RecMapMethod ShowCSV (Either T.Text :. ElField) rs, + RecordToList rs) + => FilePath -> P.Producer (Record rs) m () +readTableDebug csvFile = + produceTokens csvFile (columnSeparator opts) >-> go >-> debugAll + where opts = defaultParser + go = do + when (isNothing (headerOverride opts)) (() <$ P.await) + P.map readRecEither + debugAll = do + P.await >>= either (P.liftIO . hPrint stderr . debugOne) P.yield + debugAll + debugOne = recordToList . rmapMethod @ShowCSV (aux . getCompose) + aux :: (ShowCSV (PayloadType ElField a)) + => Either T.Text (ElField a) -> Const T.Text a + aux (Right (Field x)) = Const ("Right " <> showCSV x) + aux (Left txt) = Const ("Left " <> txt) + -- | Pipe lines of CSV text into rows for which each column was -- successfully parsed. pipeTable :: (ReadRec rs, RMap rs, Monad m) @@ -360,10 +391,18 @@ (ColumnHeaders ts, Foldable f, Monad m, RecordToList ts, RecMapMethod ShowCSV ElField ts) => f (Record ts) -> P.Producer String m () -produceCSV recs = do - P.yield (intercalate "," (columnHeaders (Proxy :: Proxy (Record ts)))) - F.mapM_ (P.yield . T.unpack . T.intercalate "," . showFieldsCSV) recs +produceCSV = produceDSV defaultParser +produceDSV :: forall f ts m. + (ColumnHeaders ts, Foldable f, Monad m, RecordToList ts, + RecMapMethod ShowCSV ElField ts) + => ParserOptions -> f (Record ts) -> P.Producer String m () +produceDSV opts recs = do + P.yield (intercalate (T.unpack separator) (columnHeaders (Proxy :: Proxy (Record ts)))) + F.mapM_ (P.yield . T.unpack . T.intercalate separator . showFieldsCSV) recs + where + separator = columnSeparator opts + -- | 'P.yield' a header row with column names followed by a line of -- text for each 'Record' with each field separated by a comma. This -- is the same as 'produceCSV', but adapated for cases where you have @@ -382,5 +421,12 @@ writeCSV :: (ColumnHeaders ts, Foldable f, RecordToList ts, RecMapMethod ShowCSV ElField ts) => FilePath -> f (Record ts) -> IO () -writeCSV fp recs = P.runSafeT . P.runEffect $ - produceCSV recs >-> P.map T.pack >-> consumeTextLines fp +writeCSV = writeDSV defaultParser + +-- | Write a header row with column names followed by a line of text +-- for each 'Record' to the given file. +writeDSV :: (ColumnHeaders ts, Foldable f, RecordToList ts, + RecMapMethod ShowCSV ElField ts) + => ParserOptions -> FilePath -> f (Record ts) -> IO () +writeDSV opts fp recs = P.runSafeT . P.runEffect $ + produceDSV opts recs >-> P.map T.pack >-> consumeTextLines fp diff --git a/src/Frames/TH.hs b/src/Frames/TH.hs --- a/src/Frames/TH.hs +++ b/src/Frames/TH.hs @@ -9,9 +9,6 @@ import Control.Arrow (second) import Data.Char (toLower) import Data.Maybe (fromMaybe) -#if __GLASGOW_HASKELL__ < 804 -import Data.Semigroup ((<>)) -#endif import Data.Proxy (Proxy(..)) import qualified Data.Text as T import Data.Vinyl @@ -132,6 +129,9 @@ -- ^ A record field that mentions the phantom type list of -- possible column types. Having this field prevents record -- update syntax from losing track of the type argument. + , inferencePrefix :: Int + -- ^ Number of rows to inspect to infer a type for each + -- column. Defaults to 1000. , lineReader :: Separator -> P.Producer [T.Text] (P.SafeT IO) () -- ^ A producer of rows of ’T.Text’ values that were -- separated by a 'Separator' value. @@ -147,12 +147,12 @@ -- separator (a comma), infer column types from the default 'Columns' -- set of types, and produce a row type with name @Row@. rowGen :: FilePath -> RowGen CommonColumns -rowGen = RowGen [] "" defaultSep "Row" Proxy . produceTokens +rowGen = RowGen [] "" defaultSep "Row" Proxy 1000 . produceTokens -- | Like 'rowGen', but will also generate custom data types for -- 'Categorical' variables with up to 8 distinct variants. rowGenCat :: FilePath -> RowGen CommonColumnsCat -rowGenCat = RowGen [] "" defaultSep "Row" Proxy . produceTokens +rowGenCat = RowGen [] "" defaultSep "Row" Proxy 1000 . produceTokens -- -- | Generate a type for each row of a table. This will be something -- -- like @Record ["x" :-> a, "y" :-> b, "z" :-> c]@. @@ -196,13 +196,13 @@ tableTypesText' :: forall a c. (c ~ CoRec ColInfo a, ColumnTypeable c, Monoid c) => RowGen a -> DecsQ -tableTypesText' (RowGen {..}) = +tableTypesText' RowGen {..} = do colNames <- runIO . P.runSafeT $ maybe (colNamesP (lineReader separator)) pure (headerOverride opts) let headers = zip colNames (repeat (ConT ''T.Text)) - (colTypes, colDecs) <- (second concat . unzip) + (colTypes, colDecs) <- second concat . unzip <$> mapM (uncurry mkColDecs) headers let recTy = TySynD (mkName rowTypeName) [] (recDec colTypes) optsName = case rowTypeName of @@ -248,7 +248,7 @@ where colNames' | null columnNames = Nothing | otherwise = Just (map T.pack columnNames) opts = ParserOptions colNames' separator (RFC4180Quoting '\"') - lineSource = lineReader separator P.>-> P.take prefixSize + lineSource = lineReader separator P.>-> P.take inferencePrefix mkColDecs :: T.Text -> Either (String -> Q [Dec]) Type -> Q (Type, [Dec]) mkColDecs colNm colTy = do let safeName = tablePrefix ++ (T.unpack . sanitizeTypeName $ colNm)