diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,3 +8,11 @@ * Fixed parse failure on nested, escaped quotation. * Fixed column info when field name isn't found. + +## 0.1.0.2 + +* Change namespace from `Data.DataFrame` to `DataFrame` +* Add `toVector` function for converting columns to vectors. +* Add `impute` function for replacing `Nothing` values in optional columns. +* Add `filterAllJust` to filter out all rows with missing data. +* Add `distinct` function that returns a dataframe with distict rows. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -24,9 +24,9 @@ ### Code example ```haskell -import qualified Data.DataFrame as D +import qualified DataFrame as D -import Data.DataFrame ((|>)) +import DataFrame ((|>)) main :: IO () df <- D.readTsv "./data/chipotle.tsv" diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -6,8 +6,8 @@ module Main where -import qualified Data.DataFrame as D -import Data.DataFrame (dimensions, (|>)) +import qualified DataFrame as D +import DataFrame (dimensions, (|>)) import Data.List (delete) import Data.Maybe (fromMaybe, isJust, isNothing) import qualified Data.Text as T diff --git a/benchmark/Main.hs b/benchmark/Main.hs --- a/benchmark/Main.hs +++ b/benchmark/Main.hs @@ -1,7 +1,7 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} -import qualified Data.DataFrame as D +import qualified DataFrame as D import qualified Data.Vector.Unboxed as VU import Control.Monad (replicateM) diff --git a/dataframe.cabal b/dataframe.cabal --- a/dataframe.cabal +++ b/dataframe.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: dataframe -version: 0.1.0.1 +version: 0.1.0.2 synopsis: An intuitive, dynamically-typed DataFrame library. @@ -22,25 +22,25 @@ location: https://github.com/mchav/dataframe library - exposed-modules: Data.DataFrame - other-modules: Data.DataFrame.Internal.Types, - Data.DataFrame.Internal.Function, - Data.DataFrame.Internal.Parsing, - Data.DataFrame.Internal.Column, - Data.DataFrame.Display.Terminal.PrettyPrint, - Data.DataFrame.Display.Terminal.Colours, - Data.DataFrame.Internal.DataFrame, - Data.DataFrame.Internal.Row, - Data.DataFrame.Errors, - Data.DataFrame.Operations.Core, - Data.DataFrame.Operations.Subset, - Data.DataFrame.Operations.Sorting, - Data.DataFrame.Operations.Statistics, - Data.DataFrame.Operations.Transformations, - Data.DataFrame.Operations.Typing, - Data.DataFrame.Operations.Aggregation, - Data.DataFrame.Display.Terminal.Plot, - Data.DataFrame.IO.CSV + exposed-modules: DataFrame + other-modules: DataFrame.Internal.Types, + DataFrame.Internal.Function, + DataFrame.Internal.Parsing, + DataFrame.Internal.Column, + DataFrame.Display.Terminal.PrettyPrint, + DataFrame.Display.Terminal.Colours, + DataFrame.Internal.DataFrame, + DataFrame.Internal.Row, + DataFrame.Errors, + DataFrame.Operations.Core, + DataFrame.Operations.Subset, + DataFrame.Operations.Sorting, + DataFrame.Operations.Statistics, + DataFrame.Operations.Transformations, + DataFrame.Operations.Typing, + DataFrame.Operations.Aggregation, + DataFrame.Display.Terminal.Plot, + DataFrame.IO.CSV build-depends: base >= 4.17.2.0 && < 4.21, array ^>= 0.5, attoparsec >= 0.12 && <= 0.14.4, @@ -58,25 +58,25 @@ executable dataframe main-is: Main.hs - other-modules: Data.DataFrame, - Data.DataFrame.Internal.Types, - Data.DataFrame.Internal.Function, - Data.DataFrame.Internal.Parsing, - Data.DataFrame.Internal.Column, - Data.DataFrame.Display.Terminal.PrettyPrint, - Data.DataFrame.Display.Terminal.Colours, - Data.DataFrame.Internal.DataFrame, - Data.DataFrame.Internal.Row, - Data.DataFrame.Errors, - Data.DataFrame.Operations.Core, - Data.DataFrame.Operations.Subset, - Data.DataFrame.Operations.Sorting, - Data.DataFrame.Operations.Statistics, - Data.DataFrame.Operations.Transformations, - Data.DataFrame.Operations.Typing, - Data.DataFrame.Operations.Aggregation, - Data.DataFrame.Display.Terminal.Plot, - Data.DataFrame.IO.CSV + other-modules: DataFrame, + DataFrame.Internal.Types, + DataFrame.Internal.Function, + DataFrame.Internal.Parsing, + DataFrame.Internal.Column, + DataFrame.Display.Terminal.PrettyPrint, + DataFrame.Display.Terminal.Colours, + DataFrame.Internal.DataFrame, + DataFrame.Internal.Row, + DataFrame.Errors, + DataFrame.Operations.Core, + DataFrame.Operations.Subset, + DataFrame.Operations.Sorting, + DataFrame.Operations.Statistics, + DataFrame.Operations.Transformations, + DataFrame.Operations.Typing, + DataFrame.Operations.Aggregation, + DataFrame.Display.Terminal.Plot, + DataFrame.IO.CSV build-depends: base >= 4.17.2.0 && < 4.21, array ^>= 0.5, attoparsec >= 0.12 && <= 0.14.4, diff --git a/src/Data/DataFrame.hs b/src/Data/DataFrame.hs deleted file mode 100644 --- a/src/Data/DataFrame.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Data.DataFrame - ( module D, - (|>) - ) -where - -import Data.DataFrame.Internal.Types as D -import Data.DataFrame.Internal.Function as D -import Data.DataFrame.Internal.Parsing as D -import Data.DataFrame.Internal.Column as D -import Data.DataFrame.Internal.DataFrame as D hiding (columnIndices, columns) -import Data.DataFrame.Internal.Row as D hiding (mkRowRep) -import Data.DataFrame.Errors as D -import Data.DataFrame.Operations.Core as D -import Data.DataFrame.Operations.Subset as D -import Data.DataFrame.Operations.Sorting as D -import Data.DataFrame.Operations.Statistics as D -import Data.DataFrame.Operations.Transformations as D -import Data.DataFrame.Operations.Typing as D -import Data.DataFrame.Operations.Aggregation as D -import Data.DataFrame.Display.Terminal.Plot as D -import Data.DataFrame.IO.CSV as D - -import Data.Function - -(|>) = (&) diff --git a/src/Data/DataFrame/Display/Terminal/Colours.hs b/src/Data/DataFrame/Display/Terminal/Colours.hs deleted file mode 100644 --- a/src/Data/DataFrame/Display/Terminal/Colours.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Data.DataFrame.Display.Terminal.Colours where - --- terminal color functions -red :: String -> String -red s = "\ESC[31m" ++ s ++ "\ESC[0m" - -green :: String -> String -green s = "\ESC[32m" ++ s ++ "\ESC[0m" - -brightGreen :: String -> String -brightGreen s = "\ESC[92m" ++ s ++ "\ESC[0m" - -brightBlue :: String -> String -brightBlue s = "\ESC[94m" ++ s ++ "\ESC[0m" diff --git a/src/Data/DataFrame/Display/Terminal/Plot.hs b/src/Data/DataFrame/Display/Terminal/Plot.hs deleted file mode 100644 --- a/src/Data/DataFrame/Display/Terminal/Plot.hs +++ /dev/null @@ -1,340 +0,0 @@ -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE TupleSections #-} -module Data.DataFrame.Display.Terminal.Plot where - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Data.Vector.Generic as VG -import qualified Data.Vector.Unboxed as VU -import qualified Type.Reflection as Ref - -import Control.Monad ( forM_, forM ) -import Data.Bifunctor ( first ) -import Data.Char ( ord, chr ) -import Data.DataFrame.Display.Terminal.Colours -import Data.DataFrame.Internal.Column (Column(..)) -import Data.DataFrame.Internal.DataFrame (DataFrame(..)) -import Data.DataFrame.Internal.Types (Columnable) -import Data.DataFrame.Operations.Core -import Data.Maybe (fromMaybe) -import Data.Typeable (Typeable) -import Data.Type.Equality - ( type (:~:)(Refl), TestEquality(testEquality) ) -import GHC.Stack (HasCallStack) -import Text.Printf ( printf ) -import Type.Reflection (typeRep) - -data HistogramOrientation = VerticalHistogram | HorizontalHistogram - -data PlotColumns = PlotAll | PlotSubset [T.Text] - -plotHistograms :: HasCallStack => PlotColumns -> HistogramOrientation -> DataFrame -> IO () -plotHistograms plotSet orientation df = do - let cs = case plotSet of - PlotAll -> columnNames df - PlotSubset xs -> columnNames df `L.intersect` xs - forM_ cs $ \cname -> do - plotForColumn cname ((V.!) (columns df) (columnIndices df M.! cname)) orientation df - - -plotHistogramsBy :: HasCallStack => T.Text -> PlotColumns -> HistogramOrientation -> DataFrame -> IO () -plotHistogramsBy col plotSet orientation df = do - let cs = case plotSet of - PlotAll -> columnNames df - PlotSubset xs -> columnNames df `L.intersect` xs - forM_ cs $ \cname -> do - let plotColumn = (V.!) (columns df) (columnIndices df M.! cname) - let byColumn = (V.!) (columns df) (columnIndices df M.! col) - plotForColumnBy col cname byColumn plotColumn orientation df - --- Plot code adapted from: https://alexwlchan.net/2018/ascii-bar-charts/ -plotForColumnBy :: HasCallStack => T.Text -> T.Text -> Maybe Column -> Maybe Column -> HistogramOrientation -> DataFrame -> IO () -plotForColumnBy _ _ Nothing _ _ _ = return () -plotForColumnBy byCol cname (Just (BoxedColumn (byColumn :: V.Vector a))) (Just (BoxedColumn (plotColumn :: V.Vector b))) orientation df = do - let zipped = VG.zipWith (\left right -> (show left, show right)) plotColumn byColumn - let counts = countOccurrences zipped - if null counts || length counts > 20 - then pure () - else case orientation of - VerticalHistogram -> error "Vertical histograms aren't yet supported" - HorizontalHistogram -> plotGivenCounts' cname counts -plotForColumnBy byCol cname (Just (UnboxedColumn byColumn)) (Just (BoxedColumn plotColumn)) orientation df = do - let zipped = VG.zipWith (\left right -> (show left, show right)) plotColumn (V.convert byColumn) - let counts = countOccurrences zipped - if null counts || length counts > 20 - then pure () - else case orientation of - VerticalHistogram -> error "Vertical histograms aren't yet supported" - HorizontalHistogram -> plotGivenCounts' cname counts -plotForColumnBy byCol cname (Just (BoxedColumn byColumn)) (Just (UnboxedColumn plotColumn)) orientation df = do - let zipped = VG.zipWith (\left right -> (show left, show right)) (V.convert plotColumn) (V.convert byColumn) - let counts = countOccurrences zipped - if null counts || length counts > 20 - then pure () - else case orientation of - -- VerticalHistogram -> plotVerticalGivenCounts cname counts - HorizontalHistogram -> plotGivenCounts' cname counts -plotForColumnBy byCol cname (Just (UnboxedColumn byColumn)) (Just (UnboxedColumn plotColumn)) orientation df = do - let zipped = VG.zipWith (\left right -> (show left, show right)) (V.convert plotColumn) (V.convert byColumn) - let counts = countOccurrences zipped - if null counts || length counts > 20 - then pure () - else case orientation of - VerticalHistogram -> error "Vertical histograms aren't yet supported" - HorizontalHistogram -> plotGivenCounts' cname counts --- TODO: Add Optional columns -plotForColumnBy _ _ _ _ _ _ = return () - --- Plot code adapted from: https://alexwlchan.net/2018/ascii-bar-charts/ -plotForColumn :: HasCallStack => T.Text -> Maybe Column -> HistogramOrientation -> DataFrame -> IO () -plotForColumn _ Nothing _ _ = return () -plotForColumn cname (Just (BoxedColumn (column :: V.Vector a))) orientation df = do - let repa :: Ref.TypeRep a = Ref.typeRep @a - repText :: Ref.TypeRep T.Text = Ref.typeRep @T.Text - repString :: Ref.TypeRep String = Ref.typeRep @String - let counts = case repa `testEquality` repText of - Just Refl -> map (first T.unpack) $ valueCounts @T.Text cname df - Nothing -> case repa `testEquality` repString of - Just Refl -> valueCounts @String cname df - -- Support other scalar types. - Nothing -> [] -- numericHistogram column - if null counts || length counts > 20 - then putStrLn $ numericHistogram cname (V.convert column) - else case orientation of - VerticalHistogram -> plotVerticalGivenCounts cname counts - HorizontalHistogram -> plotGivenCounts cname counts -plotForColumn cname (Just (UnboxedColumn (column :: VU.Vector a))) orientation df = do - let repa :: Ref.TypeRep a = Ref.typeRep @a - repText :: Ref.TypeRep T.Text = Ref.typeRep @T.Text - repString :: Ref.TypeRep String = Ref.typeRep @String - let counts = case repa `testEquality` repText of - Just Refl -> map (first show) $ valueCounts @T.Text cname df - Nothing -> case repa `testEquality` repString of - Just Refl -> valueCounts @String cname df - -- Support other scalar types. - Nothing -> [] - if null counts || length counts > 20 - then putStrLn $ numericHistogram cname (V.convert column) - else case orientation of - VerticalHistogram -> plotVerticalGivenCounts cname counts - HorizontalHistogram -> plotGivenCounts cname counts -plotForColumn _ _ _ _ = return () - -plotGivenCounts :: HasCallStack => T.Text -> [(String, Int)] -> IO () -plotGivenCounts cname counts = do - putStrLn $ "\nHistogram for " ++ show cname ++ "\n" - let n = 8 :: Int - let maxValue = maximum $ map snd counts - let increment = max 1 (maxValue `div` 50) - let longestLabelLength = maximum $ map (length . fst) counts - let longestBar = fromIntegral $ (maxValue * fromIntegral n `div` increment) `div` fromIntegral n + 1 - let border = "|" ++ replicate (longestLabelLength + length (show maxValue) + longestBar + 6) '-' ++ "|" - body <- forM counts $ \(label, count) -> do - let barChunks = fromIntegral $ (count * fromIntegral n `div` increment) `div` fromIntegral n - let remainder = fromIntegral $ (count * fromIntegral n `div` increment) `rem` fromIntegral n - let fractional = ([chr (ord '█' + n - remainder - 1) | remainder > 0]) - let bar = replicate barChunks '█' ++ fractional - let disp = if null bar then "| " else bar - let hist= "|" ++ brightGreen (leftJustify label longestLabelLength) ++ " | " ++ - leftJustify (show count) (length (show maxValue)) ++ " |" ++ - " " ++ brightBlue bar - return $ hist ++ "\n" ++ border - mapM_ putStrLn (border : body) - putChar '\n' - -plotVerticalGivenCounts :: HasCallStack => T.Text -> [(String, Int)] -> IO () -plotVerticalGivenCounts cname counts' = do - putStrLn $ "\nHistogram for " ++ show cname ++ "\n" - let n = 8 :: Int - let clip s = if length s > n then take n s ++ ".." else s - let counts = map (first clip) counts' - let maxValue = maximum $ map snd counts - let increment = max 1 (maxValue `div` 10) - let longestLabelLength = 2 + maximum (map (length . fst) counts) - let longestBar = fromIntegral $ (maxValue * fromIntegral n `div` increment) `div` fromIntegral n + 1 - let border = "‾" ++ replicate (longestBar + 1) '|' ++ "+" - let maximumLineLength = length border - body <- forM counts $ \(label, count) -> do - let barChunks = fromIntegral $ (count * fromIntegral n `div` increment) `div` fromIntegral n - let remainder = fromIntegral $ (count * fromIntegral n `div` increment) `rem` fromIntegral n - let fractional = ([chr (ord '█' - (n - remainder - 1)) | remainder > 0]) - let bar = replicate barChunks '█' ++ fractional - let disp = if null bar then "| " else bar - let hist = "‾" ++ bar - return $ replicate longestLabelLength (leftJustify hist maximumLineLength) ++ [border] - let fullGraph = map brightBlue $ rotate $ border : concat body - let partition = smallestPartition increment intPlotRanges - let increments = reverse [0, maxValue `div` 2 , maxValue + partition] - let incString = reverse $ map (`leftJustify` (length (show maxValue) + 1)) $ show 0 : replicate (length fullGraph `div` 2 - 2) " " - ++ [show (maxValue `div` 2)] - ++ replicate (length fullGraph `div` 2 - 2) " " - ++ [show (maxValue + partition)] - ++ [""] - mapM_ putStrLn (zipWith (++) incString fullGraph) - putStrLn $ " " ++ replicate (length (show maxValue) + 1) ' ' ++ unwords (map (brightGreen . flip leftJustify longestLabelLength . fst) counts) - putChar '\n' - -leftJustify :: String -> Int -> String -leftJustify s n = s ++ replicate (max 0 (n - length s)) ' ' - - -plotGivenCounts' :: HasCallStack => T.Text -> [((String, String), Int)] -> IO () -plotGivenCounts' cname counts = do - putStrLn $ "\nHistogram for " ++ show cname ++ "\n" - let n = 8 :: Int - let maxValue = maximum $ map snd counts - let increment = max 1 (maxValue `div` 50) - let longestLabelLength = maximum $ map (length. (\(a, b) -> a ++ " " ++ b) . fst) counts - let longestBar = fromIntegral $ (maxValue * fromIntegral n `div` increment) `div` fromIntegral n + 1 - let border = "|" ++ replicate (longestLabelLength + length (show maxValue) + longestBar + 6) '-' ++ "|" - body <- forM counts $ \((plotCol, byCol), count) -> do - let barChunks = fromIntegral $ (count * fromIntegral n `div` increment) `div` fromIntegral n - let remainder = fromIntegral $ (count * fromIntegral n `div` increment) `rem` fromIntegral n - let fractional = ([chr (ord '█' + n - remainder - 1) | remainder > 0]) - let bar = replicate barChunks '█' ++ fractional - let disp = if null bar then "| " else bar - let label = plotCol ++ " " ++ byCol - let hist= "|" ++ brightGreen (leftJustify label longestLabelLength) ++ " | " ++ - leftJustify (show count) (length (show maxValue)) ++ " |" ++ - " " ++ brightBlue bar - return $ hist ++ "\n" ++ border - mapM_ putStrLn (border : body) - putChar '\n' - -numericHistogram :: forall a . (HasCallStack, Columnable a) - => T.Text - -> V.Vector a - -> String -numericHistogram name xs = let - config = defaultConfig { - title = Just (T.unpack name), - width = 30, - height = 10 - } - in createHistogram config (V.toList xs') - where - xs' = case testEquality (typeRep @a) (typeRep @Double) of - Just Refl -> xs - Nothing -> case testEquality (typeRep @a) (typeRep @Int) of - Just Refl -> V.map fromIntegral xs - Nothing -> case testEquality (typeRep @a) (typeRep @Integer) of - Just Refl -> V.map fromIntegral xs - Nothing -> V.empty - -smallestPartition :: (Ord a) => a -> [a] -> a --- TODO: Find a more graceful way to handle this. -smallestPartition p [] = error "Data range too large to plot" -smallestPartition p (x:y:rest) - | p < y = x - | otherwise = smallestPartition p (y:rest) -smallestPartition p (x:rest) - | p < x = x - | otherwise = error "" - -largestPartition :: (Ord a) => a -> [a] -> a --- TODO: Find a more graceful way to handle this. -largestPartition p [] = error "Data range too large to plot" -largestPartition p (x:rest) - | p < x = x - | otherwise = largestPartition p rest - -intPlotRanges :: [Int] -intPlotRanges = [1, 5, - 10, 50, - 100, 500, - 1_000, 5_000, - 10_000, 50_000, - 100_000, 500_000, - 1_000_000, 5_000_000] - -rotate :: [String] -> [String] -rotate [] = [] -rotate xs - | head xs == "" = [] - | otherwise = map last xs : rotate (map init xs) - - -countOccurrences :: Ord a => V.Vector a -> [(a, Int)] -countOccurrences xs = M.toList $ VG.foldr count initMap xs - where initMap = M.fromList (map (, 0) (V.toList xs)) - count k = M.insertWith (+) k 1 - -data HistogramConfig = HistogramConfig { - width :: Int, -- Width of the histogram in characters - height :: Int, -- Height of the histogram in rows - barChar :: Char, -- Character to use for bars - title :: Maybe String -- Optional title for the histogram -} - -defaultConfig :: HistogramConfig -defaultConfig = HistogramConfig { - width = 40, - height = 15, - barChar = '█', - title = Nothing -} - --- Calculate the histogram bins and counts -calculateBins :: [Double] -> Int -> [(Double, Int)] -calculateBins values numBins = - let minVal = minimum values - maxVal = maximum values - binWidth = (maxVal - minVal) / fromIntegral numBins - toBin x = floor ((x - minVal) / binWidth) - bins = map toBin values - counts = map length . L.group . L.sort $ bins - binValues = [minVal + (fromIntegral i * binWidth) | i <- [0..numBins-1]] - in zip binValues (counts ++ repeat 0) - --- Format a number with appropriate scaling (k, M, B, etc.) -formatNumber :: Double -> String -formatNumber n - | n >= 1e9 = printf "%.1fB" (n / 1e9) - | n >= 1e6 = printf "%.1fM" (n / 1e6) - | n >= 1e3 = printf "%.1fk" (n / 1e3) - | otherwise = printf "%.1f" n - --- Create the ASCII histogram -createHistogram :: HistogramConfig -> [Double] -> String -createHistogram _ [] = [] -createHistogram config values = - let bins = calculateBins values (width config) - maxCount = maximum $ map snd bins - scaleY = fromIntegral maxCount / fromIntegral (height config) - - -- Create Y-axis labels - yLabels = [formatNumber (fromIntegral i * scaleY) | i <- [height config, height config-1..0]] - maxYLabelWidth = maximum $ map length yLabels - - -- Create X-axis labels - xValues = map fst bins - xLabels = map formatNumber [head xValues, last xValues] - - -- Create histogram rows - makeRow :: Int -> String - makeRow row = - let threshold = fromIntegral (height config - row) * scaleY - barLine = map (\(_, count) -> - if fromIntegral count >= threshold - then barChar config - else ' ') bins - in printf "%*s |%s" maxYLabelWidth (yLabels !! row) (brightBlue $ L.foldl' (\acc c -> c:'|':acc) "" barLine) - - -- Build the complete histogram - histogramRows = map makeRow [0..height config - 1] - xAxis = replicate maxYLabelWidth ' ' ++ " " ++ - L.intercalate (replicate (2 * (width config - length xLabels)) ' ') xLabels - - -- Add title if provided - titleLine = case title config of - Just t -> t ++ "\n\n" - Nothing -> "" - - in titleLine ++ unlines (histogramRows ++ [xAxis]) diff --git a/src/Data/DataFrame/Display/Terminal/PrettyPrint.hs b/src/Data/DataFrame/Display/Terminal/PrettyPrint.hs deleted file mode 100644 --- a/src/Data/DataFrame/Display/Terminal/PrettyPrint.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Data.DataFrame.Display.Terminal.PrettyPrint where - -import qualified Data.Text as T - -import Data.List (transpose) - --- Utility functions to show a DataFrame as a Markdown-ish table. - --- Adapted from: https://stackoverflow.com/questions/5929377/format-list-output-in-haskell --- a type for fill functions -type Filler = Int -> T.Text -> T.Text - --- a type for describing table columns -data ColDesc t = ColDesc - { colTitleFill :: Filler, - colTitle :: T.Text, - colValueFill :: Filler - } - --- functions that fill a string (s) to a given width (n) by adding pad --- character (c) to align left, right, or center -fillLeft :: Char -> Int -> T.Text -> T.Text -fillLeft c n s = s `T.append` T.replicate (n - T.length s) (T.singleton c) - -fillRight :: Char -> Int -> T.Text -> T.Text -fillRight c n s = T.replicate (n - T.length s) (T.singleton c) `T.append` s - -fillCenter :: Char -> Int -> T.Text -> T.Text -fillCenter c n s = T.replicate l (T.singleton c) `T.append` s `T.append` T.replicate r (T.singleton c) - where - x = n - T.length s - l = x `div` 2 - r = x - l - --- functions that fill with spaces -left :: Int -> T.Text -> T.Text -left = fillLeft ' ' - -right :: Int -> T.Text -> T.Text -right = fillRight ' ' - -center :: Int -> T.Text -> T.Text -center = fillCenter ' ' - -showTable :: [T.Text] -> [T.Text] -> [[T.Text]] -> T.Text -showTable header types rows = - let cs = map (\h -> ColDesc center h left) header - widths = [maximum $ map T.length col | col <- transpose $ header : types : rows] - border = T.intercalate "---" [T.replicate width (T.singleton '-') | width <- widths] - separator = T.intercalate "-|-" [T.replicate width (T.singleton '-') | width <- widths] - fillCols fill cols = T.intercalate " | " [fill c width col | (c, width, col) <- zip3 cs widths cols] - in T.unlines $ border : fillCols colTitleFill header : separator : fillCols colTitleFill types : separator : map (fillCols colValueFill) rows diff --git a/src/Data/DataFrame/Errors.hs b/src/Data/DataFrame/Errors.hs deleted file mode 100644 --- a/src/Data/DataFrame/Errors.hs +++ /dev/null @@ -1,119 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} - -module Data.DataFrame.Errors where - -import qualified Data.Text as T - -import Control.Exception -import Data.Array -import Data.DataFrame.Display.Terminal.Colours -import Data.Typeable (Typeable) -import Type.Reflection (TypeRep) - -data DataFrameException where - TypeMismatchException :: forall a b. (Typeable a, Typeable b) - => TypeRep a -- ^ given type - -> TypeRep b -- ^ expected type - -> T.Text -- ^ column name - -> T.Text -- ^ call point - -> DataFrameException - TypeMismatchException' :: forall a . (Typeable a) - => TypeRep a -- ^ expected type - -> String -- ^ given type - -> T.Text -- ^ column name - -> T.Text -- ^ call point - -> DataFrameException - ColumnNotFoundException :: T.Text -> T.Text -> [T.Text] -> DataFrameException - deriving (Exception) - -instance Show DataFrameException where - show :: DataFrameException -> String - show (TypeMismatchException a b columnName callPoint) = addCallPointInfo columnName (Just callPoint) (typeMismatchError a b) - show (TypeMismatchException' a b columnName callPoint) = addCallPointInfo columnName (Just callPoint) (typeMismatchError' (show a) b) - show (ColumnNotFoundException columnName callPoint availableColumns) = columnNotFound columnName callPoint availableColumns - -columnNotFound :: T.Text -> T.Text -> [T.Text] -> String -columnNotFound name callPoint columns = - red "\n\n[ERROR] " - ++ "Column not found: " - ++ T.unpack name - ++ " for operation " - ++ T.unpack callPoint - ++ "\n\tDid you mean " - ++ T.unpack (guessColumnName name columns) - ++ "?\n\n" - -typeMismatchError :: - Type.Reflection.TypeRep a -> - Type.Reflection.TypeRep b -> - String -typeMismatchError a b = typeMismatchError' (show a) (show b) - -typeMismatchError' :: String -> String -> String -typeMismatchError' givenType expectedType = - red $ - red "\n\n[Error]: Type Mismatch" - ++ "\n\tWhile running your code I tried to " - ++ "get a column of type: " - ++ red (show givenType) - ++ " but column was of type: " - ++ green (show expectedType) - -addCallPointInfo :: T.Text -> Maybe T.Text -> String -> String -addCallPointInfo name (Just cp) err = - err - ++ ( "\n\tThis happened when calling function " - ++ brightGreen (T.unpack cp) - ++ " on the column " - ++ brightGreen (T.unpack name) - ++ "\n\n" - ++ typeAnnotationSuggestion (T.unpack cp) - ) -addCallPointInfo name Nothing err = - err - ++ ( "\n\tOn the column " - ++ T.unpack name - ++ "\n\n" - ++ typeAnnotationSuggestion "" - ) - -typeAnnotationSuggestion :: String -> String -typeAnnotationSuggestion cp = - "\n\n\tTry adding a type at the end of the function e.g " - ++ "change\n\t\t" - ++ red (cp ++ " arg1 arg2") - ++ " to \n\t\t" - ++ green ("(" ++ cp ++ " arg1 arg2 :: )") - ++ "\n\tor add " - ++ "{-# LANGUAGE TypeApplications #-} to the top of your " - ++ "file then change the call to \n\t\t" - ++ brightGreen (cp ++ " @ arg1 arg2") - -guessColumnName :: T.Text -> [T.Text] -> T.Text -guessColumnName userInput columns = case map (\k -> (editDistance userInput k, k)) columns of - [] -> "" - res -> (snd . minimum) res - -editDistance :: T.Text -> T.Text -> Int -editDistance xs ys = table ! (m, n) - where - (m, n) = (T.length xs, T.length ys) - x = array (1, m) (zip [1 ..] (T.unpack xs)) - y = array (1, n) (zip [1 ..] (T.unpack ys)) - - table :: Array (Int, Int) Int - table = array bnds [(ij, dist ij) | ij <- range bnds] - bnds = ((0, 0), (m, n)) - - dist (0, j) = j - dist (i, 0) = i - dist (i, j) = - minimum - [ table ! (i - 1, j) + 1, - table ! (i, j - 1) + 1, - if x ! i == y ! j then table ! (i - 1, j - 1) else 1 + table ! (i - 1, j - 1) - ] diff --git a/src/Data/DataFrame/IO/CSV.hs b/src/Data/DataFrame/IO/CSV.hs deleted file mode 100644 --- a/src/Data/DataFrame/IO/CSV.hs +++ /dev/null @@ -1,295 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Strict #-} -module Data.DataFrame.IO.CSV where - -import qualified Data.ByteString.Char8 as C -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.IO as TLIO -import qualified Data.Text.IO as TIO -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as VU -import qualified Data.Vector.Mutable as VM -import qualified Data.Vector.Unboxed.Mutable as VUM - -import Control.Applicative ((<$>), (<|>), (<*>), (<*), (*>), many) -import Control.Monad (forM_, zipWithM_, unless, void) -import Data.Attoparsec.Text -import Data.Char -import Data.DataFrame.Internal.Column (Column(..), freezeColumn', writeColumn, columnLength) -import Data.DataFrame.Internal.DataFrame (DataFrame(..)) -import Data.DataFrame.Internal.Parsing -import Data.DataFrame.Operations.Typing -import Data.Foldable (fold) -import Data.Function (on) -import Data.IORef -import Data.Maybe -import Data.Text.Encoding (decodeUtf8Lenient) -import Data.Type.Equality - ( TestEquality (testEquality), - type (:~:) (Refl) - ) -import GHC.IO.Handle (Handle) -import Prelude hiding (concat, takeWhile) -import System.IO -import Type.Reflection - --- | Record for CSV read options. -data ReadOptions = ReadOptions { - hasHeader :: Bool, - inferTypes :: Bool, - safeRead :: Bool -} - --- | By default we assume the file has a header, we infer the types on read --- and we convert any rows with nullish objects into Maybe (safeRead). -defaultOptions :: ReadOptions -defaultOptions = ReadOptions { hasHeader = True, inferTypes = True, safeRead = True } - --- | Reads a CSV file from the given path. --- Note this file stores intermediate temporary files --- while converting the CSV from a row to a columnar format. -readCsv :: String -> IO DataFrame -readCsv = readSeparated ',' defaultOptions - --- | Reads a tab separated file from the given path. --- Note this file stores intermediate temporary files --- while converting the CSV from a row to a columnar format. -readTsv :: String -> IO DataFrame -readTsv = readSeparated '\t' defaultOptions - --- | Reads a character separated file into a dataframe using mutable vectors. -readSeparated :: Char -> ReadOptions -> String -> IO DataFrame -readSeparated c opts path = do - totalRows <- countRows c path - withFile path ReadMode $ \handle -> do - firstRow <- map T.strip . parseSep c <$> TIO.hGetLine handle - let columnNames = if hasHeader opts - then map (T.filter (/= '\"')) firstRow - else map (T.singleton . intToDigit) [0..(length firstRow - 1)] - -- If there was no header rewind the file cursor. - unless (hasHeader opts) $ hSeek handle AbsoluteSeek 0 - - -- Initialize mutable vectors for each column - let numColumns = length columnNames - let numRows = if hasHeader opts then totalRows - 1 else totalRows - -- Use this row to infer the types of the rest of the column. - -- TODO: this isn't robust but in so far as this is a guess anyway - -- it's probably fine. But we should probably sample n rows and pick - -- the most likely type from the sample. - dataRow <- map T.strip . parseSep c <$> TIO.hGetLine handle - - -- This array will track the indices of all null values for each column. - -- If any exist then the column will be an optional type. - nullIndices <- VM.unsafeNew numColumns - VM.set nullIndices [] - mutableCols <- VM.unsafeNew numColumns - getInitialDataVectors numRows mutableCols dataRow - - -- Read rows into the mutable vectors - fillColumns numRows c mutableCols nullIndices handle - - -- Freeze the mutable vectors into immutable ones - nulls' <- V.unsafeFreeze nullIndices - cols <- V.mapM (freezeColumn mutableCols nulls' opts) (V.generate numColumns id) - return $ DataFrame { - columns = cols, - freeIndices = [], - columnIndices = M.fromList (zip columnNames [0..]), - dataframeDimensions = (maybe 0 columnLength (cols V.! 0), V.length cols) - } -{-# INLINE readSeparated #-} - -getInitialDataVectors :: Int -> VM.IOVector Column -> [T.Text] -> IO () -getInitialDataVectors n mCol xs = do - forM_ (zip [0..] xs) $ \(i, x) -> do - col <- case inferValueType x of - "Int" -> MutableUnboxedColumn <$> ((VUM.unsafeNew n :: IO (VUM.IOVector Int)) >>= \c -> VUM.unsafeWrite c 0 (fromMaybe 0 $ readInt x) >> return c) - "Double" -> MutableUnboxedColumn <$> ((VUM.unsafeNew n :: IO (VUM.IOVector Double)) >>= \c -> VUM.unsafeWrite c 0 (fromMaybe 0 $ readDouble x) >> return c) - _ -> MutableBoxedColumn <$> ((VM.unsafeNew n :: IO (VM.IOVector T.Text)) >>= \c -> VM.unsafeWrite c 0 x >> return c) - VM.unsafeWrite mCol i col -{-# INLINE getInitialDataVectors #-} - -inferValueType :: T.Text -> T.Text -inferValueType s = let - example = s - in case readInt example of - Just _ -> "Int" - Nothing -> case readDouble example of - Just _ -> "Double" - Nothing -> "Other" -{-# INLINE inferValueType #-} - --- | Reads rows from the handle and stores values in mutable vectors. -fillColumns :: Int -> Char -> VM.IOVector Column -> VM.IOVector [(Int, T.Text)] -> Handle -> IO () -fillColumns n c mutableCols nullIndices handle = do - input <- newIORef (mempty :: T.Text) - forM_ [1..n] $ \i -> do - isEOF <- hIsEOF handle - input' <- readIORef input - unless (isEOF && input' == mempty) $ do - parseWith (TIO.hGetChunk handle) (parseRow c) input' >>= \case - Fail unconsumed ctx er -> do - erpos <- hTell handle - fail $ "Failed to parse CSV file around " <> show erpos <> " byte; due: " - <> show er <> "; context: " <> show ctx - Partial c -> do - fail "Partial handler is called" - Done (unconsumed :: T.Text) (row :: [T.Text]) -> do - writeIORef input unconsumed - zipWithM_ (writeValue mutableCols nullIndices i) [0..] row -{-# INLINE fillColumns #-} - --- | Writes a value into the appropriate column, resizing the vector if necessary. -writeValue :: VM.IOVector Column -> VM.IOVector [(Int, T.Text)] -> Int -> Int -> T.Text -> IO () -writeValue mutableCols nullIndices count colIndex value = do - col <- VM.unsafeRead mutableCols colIndex - res <- writeColumn count value col - let modify value = VM.unsafeModify nullIndices ((count, value) :) colIndex - either modify (const (return ())) res -{-# INLINE writeValue #-} - --- | Freezes a mutable vector into an immutable one, trimming it to the actual row count. -freezeColumn :: VM.IOVector Column -> V.Vector [(Int, T.Text)] -> ReadOptions -> Int -> IO (Maybe Column) -freezeColumn mutableCols nulls opts colIndex = do - col <- VM.unsafeRead mutableCols colIndex - Just <$> freezeColumn' (nulls V.! colIndex) col -{-# INLINE freezeColumn #-} - -parseSep :: Char -> T.Text -> [T.Text] -parseSep c s = either error id (parseOnly (record c) s) -{-# INLINE parseSep #-} - -record :: Char -> Parser [T.Text] -record c = - field c `sepBy1` char c - "record" -{-# INLINE record #-} - -parseRow :: Char -> Parser [T.Text] -parseRow c = (record c <* lineEnd) "record-new-line" - -field :: Char -> Parser T.Text -field c = - quotedField <|> unquotedField c - "field" -{-# INLINE field #-} - -unquotedTerminators :: Char -> S.Set Char -unquotedTerminators sep = S.fromList [sep, '\n', '\r', '"'] - -unquotedField :: Char -> Parser T.Text -unquotedField sep = - takeWhile (not . (`S.member` terminators)) "unquoted field" - where terminators = unquotedTerminators sep -{-# INLINE unquotedField #-} - -quotedField :: Parser T.Text -quotedField = char '"' *> contents <* char '"' "quoted field" - where - contents = fold <$> many (unquote <|> unescape) - where - unquote = takeWhile1 (notInClass "\"\\") - unescape = char '\\' *> do - T.singleton <$> do - char '\\' <|> char '"' -{-# INLINE quotedField #-} - -lineEnd :: Parser () -lineEnd = - (endOfLine <|> endOfInput) - "end of line" -{-# INLINE lineEnd #-} - --- | First pass to count rows for exact allocation -countRows :: Char -> FilePath -> IO Int -countRows c path = withFile path ReadMode $! go 0 "" - where - go !n !input h = do - isEOF <- hIsEOF h - if isEOF && input == mempty - then pure n - else - parseWith (TIO.hGetChunk h) (parseRow c) input >>= \case - Fail unconsumed ctx er -> do - erpos <- hTell h - fail $ "Failed to parse CSV file around " <> show erpos <> " byte; due: " - <> show er <> "; context: " <> show ctx <> " " <> show unconsumed - Partial c -> do - fail $ "Partial handler is called; n = " <> show n - Done (unconsumed :: T.Text) _ -> - go (n + 1) unconsumed h -{-# INLINE countRows #-} - -writeCsv :: String -> DataFrame -> IO () -writeCsv = writeSeparated ',' - -writeSeparated :: Char -- ^ Separator - -> String -- ^ Path to write to - -> DataFrame - -> IO () -writeSeparated c filepath df = withFile filepath WriteMode $ \handle ->do - let (rows, columns) = dataframeDimensions df - let headers = map fst (L.sortBy (compare `on` snd) (M.toList (columnIndices df))) - TIO.hPutStrLn handle (T.intercalate ", " headers) - forM_ [0..(rows - 1)] $ \i -> do - let row = getRowAsText df i - TIO.hPutStrLn handle (T.intercalate ", " row) - -getRowAsText :: DataFrame -> Int -> [T.Text] -getRowAsText df i = V.ifoldr go [] (columns df) - where - indexMap = M.fromList (map (\(a, b) -> (b, a)) $ M.toList (columnIndices df)) - go k Nothing acc = acc - go k (Just (BoxedColumn (c :: V.Vector a))) acc = case c V.!? i of - Just e -> textRep : acc - where textRep = case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> e - Nothing -> case typeRep @a of - App t1 t2 -> case eqTypeRep t1 (typeRep @Maybe) of - Just HRefl -> case testEquality t2 (typeRep @T.Text) of - Just Refl -> fromMaybe "null" e - Nothing -> (fromOptional . (T.pack . show)) e - where fromOptional s - | T.isPrefixOf "Just " s = T.drop (T.length "Just ") s - | otherwise = "null" - Nothing -> (T.pack . show) e - _ -> (T.pack . show) e - Nothing -> - error $ - "Column " - ++ T.unpack (indexMap M.! k) - ++ " has less items than " - ++ "the other columns at index " - ++ show i - go k (Just (UnboxedColumn c)) acc = case c VU.!? i of - Just e -> T.pack (show e) : acc - Nothing -> - error $ - "Column " - ++ T.unpack (indexMap M.! k) - ++ " has less items than " - ++ "the other columns at index " - ++ show i - go k (Just (OptionalColumn (c :: V.Vector (Maybe a)))) acc = case c V.!? i of - Just e -> textRep : acc - where textRep = case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> fromMaybe "Nothing" e - Nothing -> (T.pack . show) e - Nothing -> - error $ - "Column " - ++ T.unpack (indexMap M.! k) - ++ " has less items than " - ++ "the other columns at index " - ++ show i diff --git a/src/Data/DataFrame/Internal/Column.hs b/src/Data/DataFrame/Internal/Column.hs deleted file mode 100644 --- a/src/Data/DataFrame/Internal/Column.hs +++ /dev/null @@ -1,467 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -module Data.DataFrame.Internal.Column where - -import qualified Data.ByteString.Char8 as C -import qualified Data.List as L -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Vector.Algorithms.Merge as VA -import qualified Data.Vector.Generic as VG -import qualified Data.Vector as VB -import qualified Data.Vector.Mutable as VBM -import qualified Data.Vector.Unboxed as VU -import qualified Data.Vector.Unboxed.Mutable as VUM - -import Control.Monad.ST (runST) -import Data.DataFrame.Internal.Function -import Data.DataFrame.Internal.Types -import Data.DataFrame.Internal.Parsing -import Data.Int -import Data.Maybe -import Data.Text.Encoding (decodeUtf8Lenient) -import Data.Type.Equality (type (:~:)(Refl), TestEquality (..)) -import Data.Typeable (Typeable) -import Data.Word -import Type.Reflection - --- | Our representation of a column is a GADT that can store data in either --- a vector with boxed elements or -data Column where - BoxedColumn :: Columnable a => VB.Vector a -> Column - UnboxedColumn :: (Columnable a, VU.Unbox a) => VU.Vector a -> Column - OptionalColumn :: Columnable a => VB.Vector (Maybe a) -> Column - GroupedBoxedColumn :: Columnable a => VB.Vector (VB.Vector a) -> Column - GroupedUnboxedColumn :: (Columnable a, VU.Unbox a) => VB.Vector (VU.Vector a) -> Column - GroupedOptionalColumn :: (Columnable a) => VB.Vector (VB.Vector (Maybe a)) -> Column - MutableBoxedColumn :: Columnable a => VBM.IOVector a -> Column - MutableUnboxedColumn :: (Columnable a, VU.Unbox a) => VUM.IOVector a -> Column - --- Functions about column metadata. -isGrouped :: Column -> Bool -isGrouped (GroupedBoxedColumn column) = True -isGrouped (GroupedUnboxedColumn column) = True -isGrouped _ = False - -columnVersionString :: Column -> String -columnVersionString column = case column of - BoxedColumn _ -> "Boxed" - UnboxedColumn _ -> "Unboxed" - OptionalColumn _ -> "Optional" - GroupedBoxedColumn _ -> "Grouped Boxed" - GroupedUnboxedColumn _ -> "Grouped Unboxed" - GroupedOptionalColumn _ -> "Grouped Optional" - -columnTypeString :: Column -> String -columnTypeString column = case column of - BoxedColumn (column :: VB.Vector a) -> show (typeRep @a) - UnboxedColumn (column :: VU.Vector a) -> show (typeRep @a) - OptionalColumn (column :: VB.Vector a) -> show (typeRep @a) - GroupedBoxedColumn (column :: VB.Vector a) -> show (typeRep @a) - GroupedUnboxedColumn (column :: VB.Vector a) -> show (typeRep @a) - GroupedOptionalColumn (column :: VB.Vector a) -> show (typeRep @a) - -instance Show Column where - show :: Column -> String - show (BoxedColumn column) = show column - show (UnboxedColumn column) = show column - show (OptionalColumn column) = show column - show (GroupedBoxedColumn column) = show column - show (GroupedUnboxedColumn column) = show column - -instance Eq Column where - (==) :: Column -> Column -> Bool - (==) (BoxedColumn (a :: VB.Vector t1)) (BoxedColumn (b :: VB.Vector t2)) = - case testEquality (typeRep @t1) (typeRep @t2) of - Nothing -> False - Just Refl -> a == b - (==) (OptionalColumn (a :: VB.Vector t1)) (OptionalColumn (b :: VB.Vector t2)) = - case testEquality (typeRep @t1) (typeRep @t2) of - Nothing -> False - Just Refl -> a == b - (==) (UnboxedColumn (a :: VU.Vector t1)) (UnboxedColumn (b :: VU.Vector t2)) = - case testEquality (typeRep @t1) (typeRep @t2) of - Nothing -> False - Just Refl -> a == b - -- Note: comparing grouped columns is expensive. We do this for stable tests - -- but also you should probably aggregate grouped columns soon after creating them. - (==) (GroupedBoxedColumn (a :: VB.Vector t1)) (GroupedBoxedColumn (b :: VB.Vector t2)) = - case testEquality (typeRep @t1) (typeRep @t2) of - Nothing -> False - Just Refl -> VB.map (L.sort . VG.toList) a == VB.map (L.sort . VG.toList) b - (==) (GroupedUnboxedColumn (a :: VB.Vector t1)) (GroupedUnboxedColumn (b :: VB.Vector t2)) = - case testEquality (typeRep @t1) (typeRep @t2) of - Nothing -> False - Just Refl -> VB.map (L.sort . VG.toList) a == VB.map (L.sort . VG.toList) b - (==) (GroupedOptionalColumn (a :: VB.Vector t1)) (GroupedOptionalColumn (b :: VB.Vector t2)) = - case testEquality (typeRep @t1) (typeRep @t2) of - Nothing -> False - Just Refl -> VB.map (L.sort . VG.toList) a == VB.map (L.sort . VG.toList) b - (==) _ _ = False - -class (Columnable a) => Columnify a where - -- | Converts a boxed vector to a column making sure to put - -- the vector into an appropriate column type by reflection on the - -- vector's type parameter. - toColumn' :: VB.Vector a -> Column - -instance (Columnable a) => Columnify (Maybe a) where - toColumn' = OptionalColumn - -instance (Columnable a) => Columnify (VB.Vector a) where - toColumn' = GroupedBoxedColumn - -instance (Columnable a, VU.Unbox a) => Columnify (VU.Vector a) where - toColumn' = GroupedUnboxedColumn - -instance {-# INCOHERENT #-} (Columnable a) => Columnify a where - toColumn' xs = case testEquality (typeRep @a) (typeRep @Int) of - Just Refl -> UnboxedColumn (VU.convert xs) - Nothing -> case testEquality (typeRep @a) (typeRep @Double) of - Just Refl -> UnboxedColumn (VU.convert xs) - Nothing -> case testEquality (typeRep @a) (typeRep @Float) of - Just Refl -> UnboxedColumn (VU.convert xs) - Nothing -> BoxedColumn xs - -class (Columnable a) => ColumnifyList a where - -- | Converts a boxed vector to a column making sure to put - -- the vector into an appropriate column type by reflection on the - -- vector's type parameter. - toColumn :: [a] -> Column - -instance (Columnable a) => ColumnifyList (Maybe a) where - toColumn = OptionalColumn . VB.fromList - -instance {-# INCOHERENT #-} (Columnable a) => ColumnifyList a where - toColumn xs = case testEquality (typeRep @a) (typeRep @Int) of - Just Refl -> UnboxedColumn (VU.fromList xs) - Nothing -> case testEquality (typeRep @a) (typeRep @Double) of - Just Refl -> UnboxedColumn (VU.fromList xs) - Nothing -> case testEquality (typeRep @a) (typeRep @Float) of - Just Refl -> UnboxedColumn (VU.fromList xs) - Nothing -> BoxedColumn (VB.fromList xs) - --- | Converts a an unboxed vector to a column making sure to put --- the vector into an appropriate column type by reflection on the --- vector's type parameter. -toColumnUnboxed :: forall a. (Columnable a, VU.Unbox a) => VU.Vector a -> Column -toColumnUnboxed = UnboxedColumn - --- Functions that don't depend on column type. --- | O(1) Gets the number of elements in the column. -columnLength :: Column -> Int -columnLength (BoxedColumn xs) = VG.length xs -columnLength (UnboxedColumn xs) = VG.length xs -columnLength (OptionalColumn xs) = VG.length xs -columnLength (GroupedBoxedColumn xs) = VG.length xs -columnLength (GroupedUnboxedColumn xs) = VG.length xs -columnLength (GroupedOptionalColumn xs) = VG.length xs -{-# INLINE columnLength #-} - -takeColumn :: Int -> Column -> Column -takeColumn n (BoxedColumn xs) = BoxedColumn $ VG.take n xs -takeColumn n (UnboxedColumn xs) = UnboxedColumn $ VG.take n xs -takeColumn n (OptionalColumn xs) = OptionalColumn $ VG.take n xs -takeColumn n (GroupedBoxedColumn xs) = GroupedBoxedColumn $ VG.take n xs -takeColumn n (GroupedUnboxedColumn xs) = GroupedUnboxedColumn $ VG.take n xs -takeColumn n (GroupedOptionalColumn xs) = GroupedOptionalColumn $ VG.take n xs -{-# INLINE takeColumn #-} - --- TODO: Maybe we can remvoe all this boilerplate and make --- transform take in a generic vector function. -takeLastColumn :: Int -> Column -> Column -takeLastColumn n column = sliceColumn (columnLength column - n) n column -{-# INLINE takeLastColumn #-} - -sliceColumn :: Int -> Int -> Column -> Column -sliceColumn start n (BoxedColumn xs) = BoxedColumn $ VG.slice start n xs -sliceColumn start n (UnboxedColumn xs) = UnboxedColumn $ VG.slice start n xs -sliceColumn start n (OptionalColumn xs) = OptionalColumn $ VG.slice start n xs -sliceColumn start n (GroupedBoxedColumn xs) = GroupedBoxedColumn $ VG.slice start n xs -sliceColumn start n (GroupedUnboxedColumn xs) = GroupedUnboxedColumn $ VG.slice start n xs -sliceColumn start n (GroupedOptionalColumn xs) = GroupedOptionalColumn $ VG.slice start n xs -{-# INLINE sliceColumn #-} - --- TODO: We can probably generalize this to `applyVectorFunction`. -atIndices :: S.Set Int -> Column -> Column -atIndices indexes (BoxedColumn column) = BoxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column -atIndices indexes (OptionalColumn column) = OptionalColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column -atIndices indexes (UnboxedColumn column) = UnboxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column -atIndices indexes (GroupedBoxedColumn column) = GroupedBoxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column -atIndices indexes (GroupedUnboxedColumn column) = GroupedUnboxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column -atIndices indexes (GroupedOptionalColumn column) = GroupedOptionalColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column -{-# INLINE atIndices #-} - -atIndicesStable :: VU.Vector Int -> Column -> Column -atIndicesStable indexes (BoxedColumn column) = BoxedColumn $ indexes `getIndices` column -atIndicesStable indexes (UnboxedColumn column) = UnboxedColumn $ indexes `getIndicesUnboxed` column -atIndicesStable indexes (OptionalColumn column) = OptionalColumn $ indexes `getIndices` column -atIndicesStable indexes (GroupedBoxedColumn column) = GroupedBoxedColumn $ indexes `getIndices` column -atIndicesStable indexes (GroupedUnboxedColumn column) = GroupedUnboxedColumn $ indexes `getIndices` column -atIndicesStable indexes (GroupedOptionalColumn column) = GroupedOptionalColumn $ indexes `getIndices` column -{-# INLINE atIndicesStable #-} - -getIndices :: VU.Vector Int -> VB.Vector a -> VB.Vector a -getIndices indices xs = VB.generate (VU.length indices) (\i -> xs VB.! (indices VU.! i)) -{-# INLINE getIndices #-} - -getIndicesUnboxed :: (VU.Unbox a) => VU.Vector Int -> VU.Vector a -> VU.Vector a -getIndicesUnboxed indices xs = VU.generate (VU.length indices) (\i -> xs VU.! (indices VU.! i)) -{-# INLINE getIndicesUnboxed #-} - -sortedIndexes :: Bool -> Column -> VU.Vector Int -sortedIndexes asc (BoxedColumn column ) = runST $ do - withIndexes <- VG.thaw $ VG.indexed column - VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes - sorted <- VG.unsafeFreeze withIndexes - return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) -sortedIndexes asc (UnboxedColumn column) = runST $ do - withIndexes <- VG.thaw $ VG.indexed column - VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes - sorted <- VG.unsafeFreeze withIndexes - return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) -sortedIndexes asc (OptionalColumn column ) = runST $ do - withIndexes <- VG.thaw $ VG.indexed column - VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes - sorted <- VG.unsafeFreeze withIndexes - return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) -sortedIndexes asc (GroupedBoxedColumn column) = runST $ do - withIndexes <- VG.thaw $ VG.indexed column - VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes - sorted <- VG.unsafeFreeze withIndexes - return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) -sortedIndexes asc (GroupedUnboxedColumn column) = runST $ do - withIndexes <- VG.thaw $ VG.indexed column - VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes - sorted <- VG.unsafeFreeze withIndexes - return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) -sortedIndexes asc (GroupedOptionalColumn column) = runST $ do - withIndexes <- VG.thaw $ VG.indexed column - VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes - sorted <- VG.unsafeFreeze withIndexes - return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) -{-# INLINE sortedIndexes #-} - --- Operations on a column that may change its type. - -instance Transformable Column where - transform :: forall b c . (Columnable b, Columnable c) => (b -> c) -> Column -> Maybe Column - transform f (BoxedColumn (column :: VB.Vector a)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return (toColumn' (VB.map f column)) - transform f (OptionalColumn (column :: VB.Vector a)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return (toColumn' (VB.map f column)) - transform f (UnboxedColumn (column :: VU.Vector a)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ if testUnboxable (typeRep @c) then transformUnboxed f column else toColumn' (VB.map f (VB.convert column)) - transform f (GroupedBoxedColumn (column :: VB.Vector (VB.Vector a))) = do - Refl <- testEquality (typeRep @(VB.Vector a)) (typeRep @b) - return (toColumn' (VB.map f column)) - transform f (GroupedUnboxedColumn (column :: VB.Vector (VU.Vector a))) = do - Refl <- testEquality (typeRep @(VU.Vector a)) (typeRep @b) - return (toColumn' (VB.map f column)) - transform f (GroupedOptionalColumn (column :: VB.Vector (VB.Vector a))) = do - Refl <- testEquality (typeRep @(VB.Vector a)) (typeRep @b) - return (toColumn' (VB.map f column)) - --- | Applies a function that returns an unboxed result to an unboxed vector, storing the result in a column. -transformUnboxed :: forall a b . (Columnable a, VU.Unbox a, Columnable b) => (a -> b) -> VU.Vector a -> Column -transformUnboxed f = itransformUnboxed (const f) - --- TODO: Make a type class with incoherent instances. -itransformUnboxed :: forall a b . (Columnable a, VU.Unbox a, Columnable b) => (Int -> a -> b) -> VU.Vector a -> Column -itransformUnboxed f column = case testEquality (typeRep @b) (typeRep @Int) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Int8) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Int16) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Int32) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Int64) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Word8) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing-> case testEquality (typeRep @b) (typeRep @Word16) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Word32) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Word64) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Char) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Bool) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Float) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Double) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> case testEquality (typeRep @b) (typeRep @Word) of - Just Refl -> UnboxedColumn $ VU.imap f column - Nothing -> error "Result type is unboxed" -- since we only call this after confirming - --- | tranform with index. -itransform :: forall b c. (Columnable b, Columnable c) => (Int -> b -> c) -> Column -> Maybe Column -itransform f (BoxedColumn (column :: VB.Vector a)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return (toColumn' (VB.imap f column)) -itransform f (UnboxedColumn (column :: VU.Vector a)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ if testUnboxable (typeRep @c) then itransformUnboxed f column else toColumn' (VB.imap f (VB.convert column)) -itransform f (GroupedBoxedColumn (column :: VB.Vector (VB.Vector a))) = do - Refl <- testEquality (typeRep @(VB.Vector a)) (typeRep @b) - return (toColumn' (VB.imap f column)) -itransform f (GroupedUnboxedColumn (column :: VB.Vector (VU.Vector a))) = do - Refl <- testEquality (typeRep @(VU.Vector a)) (typeRep @b) - return (toColumn' (VB.imap f column)) - --- | Filter column with index. -ifilterColumn :: forall a . (Columnable a) => (Int -> a -> Bool) -> Column -> Maybe Column -ifilterColumn f c@(BoxedColumn (column :: VB.Vector b)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ BoxedColumn $ VG.ifilter f column -ifilterColumn f c@(UnboxedColumn (column :: VU.Vector b)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ UnboxedColumn $ VG.ifilter f column -ifilterColumn f c@(GroupedBoxedColumn (column :: VB.Vector b)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ GroupedBoxedColumn $ VG.ifilter f column -ifilterColumn f c@(GroupedUnboxedColumn (column :: VB.Vector b)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ GroupedUnboxedColumn $ VG.ifilter f column - --- TODO: Expand this to use more predicates. -ifilterColumnF :: Function -> Column -> Maybe Column -ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(BoxedColumn (column :: VB.Vector b)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ BoxedColumn $ VG.ifilter f column -ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(UnboxedColumn (column :: VU.Vector b)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ UnboxedColumn $ VG.ifilter f column -ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(OptionalColumn (column :: VB.Vector b)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ OptionalColumn $ VG.ifilter f column -ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(GroupedBoxedColumn (column :: VB.Vector b)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ GroupedBoxedColumn $ VG.ifilter f column -ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(GroupedUnboxedColumn (column :: VB.Vector b)) = do - Refl <- testEquality (typeRep @a) (typeRep @b) - return $ GroupedUnboxedColumn $ VG.ifilter f column - -ifoldrColumn :: forall a b. (Columnable a, Columnable b) => (Int -> a -> b -> b) -> b -> Column -> Maybe b -ifoldrColumn f acc c@(BoxedColumn (column :: VB.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldr f acc column -ifoldrColumn f acc c@(OptionalColumn (column :: VB.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldr f acc column -ifoldrColumn f acc c@(UnboxedColumn (column :: VU.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldr f acc column -ifoldrColumn f acc c@(GroupedBoxedColumn (column :: VB.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldr f acc column -ifoldrColumn f acc c@(GroupedUnboxedColumn (column :: VB.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldr f acc column - -ifoldlColumn :: forall a b . (Columnable a, Columnable b) => (b -> Int -> a -> b) -> b -> Column -> Maybe b -ifoldlColumn f acc c@(BoxedColumn (column :: VB.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldl' f acc column -ifoldlColumn f acc c@(OptionalColumn (column :: VB.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldl' f acc column -ifoldlColumn f acc c@(UnboxedColumn (column :: VU.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldl' f acc column -ifoldlColumn f acc c@(GroupedBoxedColumn (column :: VB.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldl' f acc column -ifoldlColumn f acc c@(GroupedUnboxedColumn (column :: VB.Vector d)) = do - Refl <- testEquality (typeRep @a) (typeRep @d) - return $ VG.ifoldl' f acc column - -reduceColumn :: forall a b. Columnable a => (a -> b) -> Column -> b -{-# SPECIALIZE reduceColumn :: - (VU.Vector (Double, Double) -> Double) -> Column -> Double, - (VU.Vector Double -> Double) -> Column -> Double #-} -reduceColumn f (BoxedColumn (column :: c)) = case testEquality (typeRep @c) (typeRep @a) of - Just Refl -> f column - Nothing -> error $ "Can't reduce. Incompatible types: " ++ show (typeRep @a) ++ " " ++ show (typeRep @a) -reduceColumn f (UnboxedColumn (column :: c)) = case testEquality (typeRep @c) (typeRep @a) of - Just Refl -> f column - Nothing -> error $ "Can't reduce. Incompatible types: " ++ show (typeRep @a) ++ " " ++ show (typeRep @a) -reduceColumn f (OptionalColumn (column :: c)) = case testEquality (typeRep @c) (typeRep @a) of - Just Refl -> f column - Nothing -> error $ "Can't reduce. Incompatible types: " ++ show (typeRep @a) ++ " " ++ show (typeRep @a) -{-# INLINE reduceColumn #-} - -safeReduceColumn :: forall a b. (Typeable a) => (a -> b) -> Column -> Maybe b -safeReduceColumn f (BoxedColumn (column :: c)) = do - Refl <- testEquality (typeRep @c) (typeRep @a) - return $! f column -safeReduceColumn f (UnboxedColumn (column :: c)) = do - Refl <- testEquality (typeRep @c) (typeRep @a) - return $! f column -safeReduceColumn f (OptionalColumn (column :: c)) = do - Refl <- testEquality (typeRep @c) (typeRep @a) - return $! f column -{-# INLINE safeReduceColumn #-} - -zipColumns :: Column -> Column -> Column -zipColumns (BoxedColumn column) (BoxedColumn other) = BoxedColumn (VG.zip column other) -zipColumns (BoxedColumn column) (UnboxedColumn other) = BoxedColumn (VB.generate (min (VG.length column) (VG.length other)) (\i -> (column VG.! i, other VG.! i))) -zipColumns (UnboxedColumn column) (BoxedColumn other) = BoxedColumn (VB.generate (min (VG.length column) (VG.length other)) (\i -> (column VG.! i, other VG.! i))) -zipColumns (UnboxedColumn column) (UnboxedColumn other) = UnboxedColumn (VG.zip column other) -{-# INLINE zipColumns #-} - --- Functions for mutable columns (intended for IO). --- Clean this up. -writeColumn :: Int -> T.Text -> Column -> IO (Either T.Text Bool) -writeColumn i value (MutableBoxedColumn (col :: VBM.IOVector a)) = let - in case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> (if isNullish value - then VBM.unsafeWrite col i "" >> return (Left $! value) - else VBM.unsafeWrite col i value >> return (Right True)) - Nothing -> return (Left value) -writeColumn i value (MutableUnboxedColumn (col :: VUM.IOVector a)) = - case testEquality (typeRep @a) (typeRep @Int) of - Just Refl -> case readInt value of - Just v -> VUM.unsafeWrite col i v >> return (Right True) - Nothing -> VUM.unsafeWrite col i 0 >> return (Left value) - Nothing -> case testEquality (typeRep @a) (typeRep @Double) of - Nothing -> return (Left $! value) - Just Refl -> case readDouble value of - Just v -> VUM.unsafeWrite col i v >> return (Right True) - Nothing -> VUM.unsafeWrite col i 0 >> return (Left $! value) -{-# INLINE writeColumn #-} - -freezeColumn' :: [(Int, T.Text)] -> Column -> IO Column -freezeColumn' nulls (MutableBoxedColumn col) - | null nulls = BoxedColumn <$> VB.unsafeFreeze col - | all (isNullish . snd) nulls = OptionalColumn . VB.imap (\i v -> if i `elem` map fst nulls then Nothing else Just v) <$> VB.unsafeFreeze col - | otherwise = BoxedColumn . VB.imap (\i v -> if i `elem` map fst nulls then Left (fromMaybe (error "") (lookup i nulls)) else Right v) <$> VB.unsafeFreeze col -freezeColumn' nulls (MutableUnboxedColumn col) - | null nulls = UnboxedColumn <$> VU.unsafeFreeze col - | all (isNullish . snd) nulls = VU.unsafeFreeze col >>= \c -> return $ OptionalColumn $ VB.generate (VU.length c) (\i -> if i `elem` map fst nulls then Nothing else Just (c VU.! i)) - | otherwise = VU.unsafeFreeze col >>= \c -> return $ BoxedColumn $ VB.generate (VU.length c) (\i -> if i `elem` map fst nulls then Left (fromMaybe (error "") (lookup i nulls)) else Right (c VU.! i)) -{-# INLINE freezeColumn' #-} - -expandColumn :: Int -> Column -> Column -expandColumn n (OptionalColumn col) = OptionalColumn $ col <> VB.replicate n Nothing -expandColumn n (BoxedColumn col) = OptionalColumn $ VB.map Just col <> VB.replicate n Nothing -expandColumn n (UnboxedColumn col) = OptionalColumn $ VB.map Just (VU.convert col) <> VB.replicate n Nothing -expandColumn n (GroupedBoxedColumn col) = GroupedBoxedColumn $ col <> VB.replicate n VB.empty -expandColumn n (GroupedUnboxedColumn col) = GroupedUnboxedColumn $ col <> VB.replicate n VU.empty diff --git a/src/Data/DataFrame/Internal/DataFrame.hs b/src/Data/DataFrame/Internal/DataFrame.hs deleted file mode 100644 --- a/src/Data/DataFrame/Internal/DataFrame.hs +++ /dev/null @@ -1,95 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE StrictData #-} -module Data.DataFrame.Internal.DataFrame where - -import qualified Data.Map as M -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as VU - -import Control.Monad (join) -import Data.DataFrame.Display.Terminal.PrettyPrint -import Data.DataFrame.Internal.Column -import Data.Function (on) -import Data.List (sortBy, transpose) -import Data.Maybe (isJust) -import Data.Type.Equality (type (:~:)(Refl), TestEquality (testEquality)) -import Type.Reflection (typeRep) - -data DataFrame = DataFrame - { -- | Our main data structure stores a dataframe as - -- a vector of columns. This improv - columns :: V.Vector (Maybe Column), - -- | Keeps the column names in the order they were inserted in. - columnIndices :: M.Map T.Text Int, - -- | Next free index that we insert a column into. - freeIndices :: [Int], - dataframeDimensions :: (Int, Int) - } - -instance Eq DataFrame where - (==) :: DataFrame -> DataFrame -> Bool - a == b = map fst (M.toList $ columnIndices a) == map fst (M.toList $ columnIndices b) && - foldr (\(name, index) acc -> acc && (columns a V.!? index == (columns b V.!? (columnIndices b M.! name)))) True (M.toList $ columnIndices a) - -instance Show DataFrame where - show :: DataFrame -> String - show d = T.unpack (asText d) - -asText :: DataFrame -> T.Text -asText d = - let header = "index" : map fst (sortBy (compare `on` snd) $ M.toList (columnIndices d)) - types = V.toList $ V.filter (/= "") $ V.map getType (columns d) - getType Nothing = "" - getType (Just (BoxedColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) - getType (Just (UnboxedColumn (column :: VU.Vector a))) = T.pack $ show (typeRep @a) - getType (Just (OptionalColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) - getType (Just (GroupedBoxedColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) - getType (Just (GroupedUnboxedColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) - -- Separate out cases dynamically so we don't end up making round trip string - -- copies. - get (Just (BoxedColumn (column :: V.Vector a))) = case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> column - Nothing -> case testEquality (typeRep @a) (typeRep @String) of - Just Refl -> V.map T.pack column - Nothing -> V.map (T.pack . show) column - get (Just (UnboxedColumn column)) = V.map (T.pack . show) (V.convert column) - get (Just (OptionalColumn column)) = V.map (T.pack . show) column - get (Just (GroupedBoxedColumn column)) = V.map (T.pack . show) column - get (Just (GroupedUnboxedColumn column)) = V.map (T.pack . show) column - getTextColumnFromFrame df (i, name) = if i == 0 - then V.fromList (map (T.pack . show) [0..(fst (dataframeDimensions df) - 1)]) - else get $ (V.!) (columns d) ((M.!) (columnIndices d) name) - rows = - transpose $ - zipWith (curry (V.toList . getTextColumnFromFrame d)) [0..] header - in showTable header ("Int":types) rows - --- | O(1) Creates an empty dataframe -empty :: DataFrame -empty = DataFrame {columns = V.replicate initialColumnSize Nothing, - columnIndices = M.empty, - freeIndices = [0..(initialColumnSize - 1)], - dataframeDimensions = (0, 0) } - -initialColumnSize :: Int -initialColumnSize = 8 - -getColumn :: T.Text -> DataFrame -> Maybe Column -getColumn name df = do - i <- columnIndices df M.!? name - join $ columns df V.!? i - -null :: DataFrame -> Bool -null df = dataframeDimensions df == (0, 0) - -metadata :: DataFrame -> String -metadata df = show (columnIndices df) ++ "\n" ++ - show (V.map (fmap columnVersionString) (columns df)) ++ "\n" ++ - show (freeIndices df) ++ "\n" ++ - show (dataframeDimensions df) diff --git a/src/Data/DataFrame/Internal/Function.hs b/src/Data/DataFrame/Internal/Function.hs deleted file mode 100644 --- a/src/Data/DataFrame/Internal/Function.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE PatternSynonyms #-} - -module Data.DataFrame.Internal.Function where - -import qualified Data.Text as T -import qualified Data.Vector as V - -import Data.DataFrame.Internal.Types -import Data.Typeable ( Typeable, type (:~:)(Refl) ) -import Data.Type.Equality (TestEquality(testEquality)) -import Type.Reflection (typeRep, typeOf) - --- A GADT to wrap functions so we can have hetegeneous lists of functions. -data Function where - F1 :: forall a b . (Columnable a, Columnable b) => (a -> b) -> Function - F2 :: forall a b c . (Columnable a, Columnable b, Columnable c) => (a -> b -> c) -> Function - F3 :: forall a b c d . (Columnable a, Columnable b, Columnable c, Columnable d) => (a -> b -> c -> d) -> Function - F4 :: forall a b c d e . (Columnable a, Columnable b, Columnable c, Columnable d, Columnable e) => (a -> b -> c -> d -> e) -> Function - Cond :: forall a . (Columnable a) => (a -> Bool) -> Function - ICond :: forall a . (Columnable a) => (Int -> a -> Bool) -> Function - --- Helper class to do the actual wrapping -class WrapFunction a where - wrapFunction :: a -> Function - --- Instance for 1-argument functions -instance (Columnable a, Columnable b) => WrapFunction (a -> b) where - wrapFunction :: (Columnable a, Columnable b) => (a -> b) -> Function - wrapFunction = F1 - --- Instance for 2-argument functions -instance {-# INCOHERENT #-} (Columnable a, Columnable b, Columnable c) => WrapFunction (a -> b -> c) where - wrapFunction :: (Columnable a, Columnable b, Columnable c) => (a -> b -> c) -> Function - wrapFunction = F2 - --- Instance for 3-argument functions -instance {-# INCOHERENT #-} (Columnable a, Columnable b, Columnable c, Columnable d) => WrapFunction (a -> b -> c -> d) where - wrapFunction :: (Columnable a, Columnable b, Columnable c, Columnable d) => (a -> b -> c -> d) -> Function - wrapFunction = F3 - -instance {-# INCOHERENT #-} (Columnable a, Columnable b, Columnable c, Columnable d, Columnable e) => WrapFunction (a -> b -> c -> d -> e) where - wrapFunction :: (Columnable a, Columnable b, Columnable c, Columnable d, Columnable e) => (a -> b -> c -> d -> e) -> Function - wrapFunction = F4 - --- The main function that wraps arbitrary functions -func :: forall fn . WrapFunction fn => fn -> Function -func = wrapFunction - -pattern Empty :: V.Vector a -pattern Empty <- (V.null -> True) where Empty = V.empty - -uncons :: V.Vector a -> Maybe (a, V.Vector a) -uncons Empty = Nothing -uncons v = Just (V.unsafeHead v, V.unsafeTail v) - -pattern (:<|) :: a -> V.Vector a -> V.Vector a -pattern x :<| xs <- (uncons -> Just (x, xs)) - -funcApply :: forall c . (Columnable c) => V.Vector RowValue -> Function -> c -funcApply Empty _ = error "Empty args" -funcApply (Value (x :: a') :<| Empty) (F1 (f :: (a -> b))) = case testEquality (typeRep @a') (typeRep @a) of - Just Refl -> case testEquality (typeOf (f x)) (typeRep @c) of - Just Refl -> f x - Nothing -> error "Result type mismatch" - Nothing -> error "Arg type mismatch" -funcApply (Value (x :: a') :<| xs) (F2 (f :: (a -> b))) = case testEquality (typeOf x) (typeRep @a) of - Just Refl -> funcApply xs (F1 (f x)) - Nothing -> error "Arg type mismatch" -funcApply (Value (x :: a') :<| xs) (F3 (f :: (a -> b))) = case testEquality (typeOf x) (typeRep @a) of - Just Refl -> funcApply xs (F2 (f x)) - Nothing -> error "Arg type mismatch" -funcApply (Value (x :: a') :<| xs) (F4 (f :: (a -> b))) = case testEquality (typeOf x) (typeRep @a) of - Just Refl -> funcApply xs (F3 (f x)) - Nothing -> error "Arg type mismatch" diff --git a/src/Data/DataFrame/Internal/Parsing.hs b/src/Data/DataFrame/Internal/Parsing.hs deleted file mode 100644 --- a/src/Data/DataFrame/Internal/Parsing.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -module Data.DataFrame.Internal.Parsing where - -import qualified Data.ByteString.Char8 as C -import qualified Data.Set as S -import qualified Data.Text as T - -import Data.Text.Read -import Data.Maybe (fromMaybe) -import GHC.Stack (HasCallStack) -import Text.Read (readMaybe) - -isNullish :: T.Text -> Bool -isNullish s = s `S.member` S.fromList ["Nothing", "NULL", "", " ", "nan"] - -readValue :: (HasCallStack, Read a) => T.Text -> a -readValue s = case readMaybe (T.unpack s) of - Nothing -> error $ "Could not read value: " ++ T.unpack s - Just value -> value - -readInteger :: (HasCallStack) => T.Text -> Maybe Integer -readInteger s = case signed decimal (T.strip s) of - Left _ -> Nothing - Right (value, "") -> Just value - Right (value, _) -> Nothing - -readInt :: (HasCallStack) => T.Text -> Maybe Int -readInt s = case signed decimal (T.strip s) of - Left _ -> Nothing - Right (value, "") -> Just value - Right (value, _) -> Nothing -{-# INLINE readInt #-} - -readByteStringInt :: (HasCallStack) => C.ByteString -> Maybe Int -readByteStringInt s = case C.readInt (C.strip s) of - Nothing -> Nothing - Just (value, "") -> Just value - Just (value, _) -> Nothing -{-# INLINE readByteStringInt #-} - -readDouble :: (HasCallStack) => T.Text -> Maybe Double -readDouble s = - case signed double s of - Left _ -> Nothing - Right (value, "") -> Just value - Right (value, _) -> Nothing -{-# INLINE readDouble #-} - -readIntegerEither :: (HasCallStack) => T.Text -> Either T.Text Integer -readIntegerEither s = case signed decimal (T.strip s) of - Left _ -> Left s - Right (value, "") -> Right value - Right (value, _) -> Left s -{-# INLINE readIntegerEither #-} - -readIntEither :: (HasCallStack) => T.Text -> Either T.Text Int -readIntEither s = case signed decimal (T.strip s) of - Left _ -> Left s - Right (value, "") -> Right value - Right (value, _) -> Left s -{-# INLINE readIntEither #-} - -readDoubleEither :: (HasCallStack) => T.Text -> Either T.Text Double -readDoubleEither s = - case signed double s of - Left _ -> Left s - Right (value, "") -> Right value - Right (value, _) -> Left s -{-# INLINE readDoubleEither #-} - -safeReadValue :: (Read a) => T.Text -> Maybe a -safeReadValue s = readMaybe (T.unpack s) - -readWithDefault :: (HasCallStack, Read a) => a -> T.Text -> a -readWithDefault v s = fromMaybe v (readMaybe (T.unpack s)) diff --git a/src/Data/DataFrame/Internal/Row.hs b/src/Data/DataFrame/Internal/Row.hs deleted file mode 100644 --- a/src/Data/DataFrame/Internal/Row.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Data.DataFrame.Internal.Row where - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Data.Vector.Generic as VG -import qualified Data.Vector.Unboxed as VU -import qualified Data.Vector.Algorithms.Merge as VA - -import Control.Exception (throw) -import Control.Monad.ST (runST) -import Data.DataFrame.Errors (DataFrameException(..)) -import Data.DataFrame.Internal.Column -import Data.DataFrame.Internal.DataFrame -import Data.DataFrame.Internal.Types -import Data.Function (on) - -type Row = V.Vector RowValue - -toRowList :: [T.Text] -> DataFrame -> [Row] -toRowList names df = let - nameSet = S.fromList names - in map (mkRowRep df nameSet) [0..(fst (dataframeDimensions df) - 1)] - -toRowVector :: [T.Text] -> DataFrame -> V.Vector Row -toRowVector names df = let - nameSet = S.fromList names - in V.generate (fst (dataframeDimensions df)) (mkRowRep df nameSet) - -mkRowFromArgs :: [T.Text] -> DataFrame -> Int -> Row -mkRowFromArgs names df i = V.map get (V.fromList names) - where - get name = case getColumn name df of - Nothing -> throw $ ColumnNotFoundException name "[INTERNAL] mkRowFromArgs" (map fst $ M.toList $ columnIndices df) - Just (BoxedColumn column) -> toRowValue (column V.! i) - Just (UnboxedColumn column) -> toRowValue (column VU.! i) - Just (OptionalColumn column) -> toRowValue (column V.! i) - -mkRowRep :: DataFrame -> S.Set T.Text -> Int -> Row -mkRowRep df names i = V.generate (S.size names) (\index -> get (names' V.! index)) - where - inOrderIndexes = map fst $ L.sortBy (compare `on` snd) $ M.toList (columnIndices df) - names' = V.fromList [n | n <- inOrderIndexes, S.member n names] - throwError name = error $ "Column " - ++ T.unpack name - ++ " has less items than " - ++ "the other columns at index " - ++ show i - get name = case getColumn name df of - Just (BoxedColumn c) -> case c V.!? i of - Just e -> toRowValue e - Nothing -> throwError name - Just (OptionalColumn c) -> case c V.!? i of - Just e -> toRowValue e - Nothing -> throwError name - Just (UnboxedColumn c) -> case c VU.!? i of - Just e -> toRowValue e - Nothing -> throwError name - Just (GroupedBoxedColumn c) -> case c V.!? i of - Just e -> toRowValue e - Nothing -> throwError name - Just (GroupedUnboxedColumn c) -> case c V.!? i of - Just e -> toRowValue e - Nothing -> throwError name - -sortedIndexes' :: Bool -> V.Vector Row -> VU.Vector Int -sortedIndexes' asc rows = runST $ do - withIndexes <- VG.thaw (V.indexed rows) - VA.sortBy ((if asc then compare else flip compare) `on` snd) withIndexes - sorted <- VG.unsafeFreeze withIndexes - return $ VU.generate (VG.length rows) (\i -> fst (sorted VG.! i)) diff --git a/src/Data/DataFrame/Internal/Types.hs b/src/Data/DataFrame/Internal/Types.hs deleted file mode 100644 --- a/src/Data/DataFrame/Internal/Types.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE Strict #-} -module Data.DataFrame.Internal.Types where - -import Data.Int ( Int8, Int16, Int32, Int64 ) -import Data.Kind (Type) -import Data.Maybe (fromMaybe) -import Data.Typeable (Typeable, type (:~:) (..)) -import Data.Word ( Word8, Word16, Word32, Word64 ) -import Type.Reflection (TypeRep, typeOf, typeRep) -import Data.Type.Equality (TestEquality(..)) - --- We need an "Object" type as an intermediate representation --- for rows. Useful for things like sorting and function application. -type Columnable a = (Typeable a, Show a, Ord a, Eq a) - -data RowValue where - Value :: (Columnable a) => a -> RowValue - -instance Eq RowValue where - (==) :: RowValue -> RowValue -> Bool - (Value a) == (Value b) = fromMaybe False $ do - Refl <- testEquality (typeOf a) (typeOf b) - return $ a == b - -instance Ord RowValue where - (<=) :: RowValue -> RowValue -> Bool - (Value a) <= (Value b) = fromMaybe False $ do - Refl <- testEquality (typeOf a) (typeOf b) - return $ a <= b - -instance Show RowValue where - show :: RowValue -> String - show (Value a) = show a - -toRowValue :: forall a . (Columnable a) => a -> RowValue -toRowValue = Value - --- | Essentially a "functor" instance of our type-erased Column. -class Transformable a where - transform :: forall b c . (Columnable b, Columnable c) => (b -> c) -> a -> Maybe a - --- Convenience functions for types. -unboxableTypes :: TypeRepList '[Int, Int8, Int16, Int32, Int64, - Word, Word8, Word16, Word32, Word64, - Char, Double, Float, Bool] -unboxableTypes = Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep Nil))))))))))))) - -numericTypes :: TypeRepList '[Int, Int8, Int16, Int32, Int64, Double, Float] -numericTypes = Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep Nil)))))) - -data TypeRepList (xs :: [Type]) where - Nil :: TypeRepList '[] - Cons :: Typeable x => TypeRep x -> TypeRepList xs -> TypeRepList (x ': xs) - -matchesAnyType :: forall a xs. (Typeable a) => TypeRepList xs -> TypeRep a -> Bool -matchesAnyType Nil _ = False -matchesAnyType (Cons ty tys) rep = - case testEquality ty rep of - Just Refl -> True - Nothing -> matchesAnyType tys rep - -testUnboxable :: forall a . Typeable a => TypeRep a -> Bool -testUnboxable x = matchesAnyType unboxableTypes (typeRep @a) - -testNumeric :: forall a . Typeable a => TypeRep a -> Bool -testNumeric x = matchesAnyType numericTypes (typeRep @a) diff --git a/src/Data/DataFrame/Operations/Aggregation.hs b/src/Data/DataFrame/Operations/Aggregation.hs deleted file mode 100644 --- a/src/Data/DataFrame/Operations/Aggregation.hs +++ /dev/null @@ -1,227 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -module Data.DataFrame.Operations.Aggregation where - -import qualified Data.Set as S - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Map.Strict as MS -import qualified Data.Text as T -import qualified Data.Vector.Generic as VG -import qualified Data.Vector as V -import qualified Data.Vector.Mutable as VM -import qualified Data.Vector.Unboxed as VU -import qualified Statistics.Quantile as SS -import qualified Statistics.Sample as SS - -import Control.Exception (throw) -import Control.Monad (foldM_) -import Control.Monad.ST (runST) -import Data.DataFrame.Internal.Column (Column(..), toColumn', getIndicesUnboxed, getIndices) -import Data.DataFrame.Internal.DataFrame (DataFrame(..), empty, getColumn) -import Data.DataFrame.Internal.Parsing -import Data.DataFrame.Internal.Types -import Data.DataFrame.Errors -import Data.DataFrame.Operations.Core -import Data.DataFrame.Operations.Subset -import Data.Function ((&)) -import Data.Hashable -import Data.Maybe -import Data.Type.Equality (type (:~:)(Refl), TestEquality(..)) -import Type.Reflection (typeRep, typeOf) - --- | O(k * n) groups the dataframe by the given rows aggregating the remaining rows --- into vector that should be reduced later. -groupBy :: - [T.Text] -> - DataFrame -> - DataFrame -groupBy names df - | any (`notElem` columnNames df) names = throw $ ColumnNotFoundException (T.pack $ show $ names L.\\ columnNames df) "groupBy" (columnNames df) - | otherwise = L.foldl' insertColumns initDf groupingColumns - where - insertOrAdjust k v m = if MS.notMember k m then MS.insert k [v] m else MS.adjust (appendWithFrontMin v) k m - -- Create a string representation of each row. - values = V.generate (fst (dimensions df)) (mkRowRep df (S.fromList names)) - -- Create a mapping from the row representation to the list of indices that - -- have that row representation. This will allow us sortedIndexesto combine the indexes - -- where the rows are the same. - valueIndices = V.ifoldl' (\m index rowRep -> insertOrAdjust rowRep index m) M.empty values - -- Since the min is at the head this allows us to get the min in constant time and sort by it - -- That way we can recover the original order of the rows. - -- valueIndicesInitOrder = L.sortBy (compare `on` snd) $! MS.toList $ MS.map VU.head valueIndices - valueIndicesInitOrder = runST $ do - v <- VM.new (MS.size valueIndices) - foldM_ (\i idxs -> VM.write v i (VU.fromList idxs) >> return (i + 1)) 0 valueIndices - V.unsafeFreeze v - - -- These are the indexes of the grouping/key rows i.e the minimum elements - -- of the list. - keyIndices = VU.generate (VG.length valueIndicesInitOrder) (\i -> VG.head $ valueIndicesInitOrder VG.! i) - -- this will be our main worker function in the fold that takes all - -- indices and replaces each value in a column with a list of - -- the elements with the indices where the grouped row - -- values are the same. - insertColumns = groupColumns valueIndicesInitOrder df - -- Out initial DF will just be all the grouped rows added to an - -- empty dataframe. The entries are dedued and are in their - -- initial order. - initDf = L.foldl' (mkGroupedColumns keyIndices df) empty names - -- All the rest of the columns that we are grouping by. - groupingColumns = columnNames df L.\\ names - -mkRowRep :: DataFrame -> S.Set T.Text -> Int -> Int -mkRowRep df names i = hash $ V.ifoldl' go [] (columns df) - where - indexMap = M.fromList (map (\(a, b) -> (b, a)) $ M.toList (columnIndices df)) - go acc k Nothing = acc - go acc k (Just (BoxedColumn (c :: V.Vector a))) = - if S.notMember (indexMap M.! k) names - then acc - else case c V.!? i of - Just e -> hash' @a e : acc - Nothing -> - error $ - "Column " - ++ T.unpack (indexMap M.! k) - ++ " has less items than " - ++ "the other columns at index " - ++ show i - go acc k (Just (UnboxedColumn (c :: VU.Vector a))) = - if S.notMember (indexMap M.! k) names - then acc - else case c VU.!? i of - Just e -> hash' @a e : acc - Nothing -> - error $ - "Column " - ++ T.unpack (indexMap M.! k) - ++ " has less items than " - ++ "the other columns at index " - ++ show i - --- | This hash function returns the hash when given a non numeric type but --- the value when given a numeric. -hash' :: Columnable a => a -> Double -hash' value = case testEquality (typeOf value) (typeRep @Double) of - Just Refl -> value - Nothing -> case testEquality (typeOf value) (typeRep @Int) of - Just Refl -> fromIntegral value - Nothing -> case testEquality (typeOf value) (typeRep @T.Text) of - Just Refl -> fromIntegral $ hash value - Nothing -> fromIntegral $ hash (show value) - -mkGroupedColumns :: VU.Vector Int -> DataFrame -> DataFrame -> T.Text -> DataFrame -mkGroupedColumns indices df acc name = - case (V.!) (columns df) (columnIndices df M.! name) of - Nothing -> error "Unexpected" - (Just (BoxedColumn column)) -> - let vs = indices `getIndices` column - in insertColumn name vs acc - (Just (UnboxedColumn column)) -> - let vs = indices `getIndicesUnboxed` column - in insertUnboxedColumn name vs acc - -groupColumns :: V.Vector (VU.Vector Int) -> DataFrame -> DataFrame -> T.Text -> DataFrame -groupColumns indices df acc name = - case (V.!) (columns df) (columnIndices df M.! name) of - Nothing -> df - (Just (BoxedColumn column)) -> - let vs = V.map (`getIndices` column) indices - in insertColumn' name (Just $ GroupedBoxedColumn vs) acc - (Just (UnboxedColumn column)) -> - let vs = V.map (`getIndicesUnboxed` column) indices - in insertColumn' name (Just $ GroupedUnboxedColumn vs) acc - -data Aggregation = Count - | Mean - | Minimum - | Median - | Maximum - | Sum deriving (Show, Eq) - -groupByAgg :: Aggregation -> [T.Text] -> DataFrame -> DataFrame -groupByAgg agg columnNames df = let - in case agg of - Count -> insertColumnWithDefault @Int 1 (T.pack (show agg)) V.empty df - & groupBy columnNames - & reduceBy @Int VG.length "Count" - _ -> error "UNIMPLEMENTED" - --- O (k * n) Reduces a vector valued volumn with a given function. -reduceBy :: - forall a b . (Columnable a, Columnable b) => - (forall v . (VG.Vector v a) => v a -> b) -> - T.Text -> - DataFrame -> - DataFrame -reduceBy f name df = case getColumn name df of - Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> case testEquality (typeRep @a) (typeRep @a') of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map f column)) df - Nothing -> error "Type error" - Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> case testEquality (typeRep @a) (typeRep @a') of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map f column)) df - Nothing -> error "Type error" - _ -> error "Column is ungrouped" - -reduceByAgg :: Aggregation - -> T.Text - -> DataFrame - -> DataFrame -reduceByAgg agg name df = case agg of - Count -> case getColumn name df of - Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.length column)) df - Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.length column)) df - _ -> error $ "Cannot count ungrouped Column: " ++ T.unpack name - Mean -> case getColumn name df of - Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map fromIntegral) column)) df - Nothing -> case testEquality (typeRep @a') (typeRep @Double) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map SS.mean column)) df - Nothing -> case testEquality (typeRep @a') (typeRep @Float) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map realToFrac) column)) df - Nothing -> error $ "Cannot get mean of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? - Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map fromIntegral) column)) df - Nothing -> case testEquality (typeRep @a') (typeRep @Double) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map SS.mean column)) df - Nothing -> case testEquality (typeRep @a') (typeRep @Float) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map realToFrac) column)) df - Nothing -> error $ "Cannot get mean of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? - Minimum -> case getColumn name df of - Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.minimum column)) df - Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.minimum column)) df - Maximum -> case getColumn name df of - Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.maximum column)) df - Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.maximum column)) df - Sum -> case getColumn name df of - Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df - Nothing -> case testEquality (typeRep @a') (typeRep @Double) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df - Nothing -> error $ "Cannot get sum of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? - Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df - Nothing -> case testEquality (typeRep @a') (typeRep @Double) of - Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df - Nothing -> error $ "Cannot get sum of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? - _ -> error "UNIMPLEMENTED" - -aggregate :: [(T.Text, Aggregation)] -> DataFrame -> DataFrame -aggregate aggs df = let - f (name, agg) d = cloneColumn name alias d & reduceByAgg agg alias - where alias = (T.pack . show) agg <> "_" <> name - in fold f aggs df & exclude (map fst aggs) - - -appendWithFrontMin :: (Ord a) => a -> [a] -> [a] -appendWithFrontMin x [] = [x] -appendWithFrontMin x xs@(f:rest) - | x < f = x:xs - | otherwise = f:x:rest -{-# INLINE appendWithFrontMin #-} diff --git a/src/Data/DataFrame/Operations/Core.hs b/src/Data/DataFrame/Operations/Core.hs deleted file mode 100644 --- a/src/Data/DataFrame/Operations/Core.hs +++ /dev/null @@ -1,243 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE BangPatterns #-} -module Data.DataFrame.Operations.Core where - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Map.Strict as MS -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Vector.Generic as VG -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as VU - -import Control.Exception ( throw ) -import Data.DataFrame.Errors -import Data.DataFrame.Internal.Column ( Column(..), toColumn', toColumn, columnLength, columnTypeString, expandColumn ) -import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn, null, empty) -import Data.DataFrame.Internal.Parsing (isNullish) -import Data.DataFrame.Internal.Types (Columnable) -import Data.Either -import Data.Function (on, (&)) -import Data.Maybe -import Data.Type.Equality (type (:~:)(Refl), TestEquality(..)) -import Type.Reflection -import Prelude hiding (null) - --- | O(1) Get DataFrame dimensions i.e. (rows, columns) -dimensions :: DataFrame -> (Int, Int) -dimensions = dataframeDimensions -{-# INLINE dimensions #-} - --- | O(k) Get column names of the DataFrame in order of insertion. -columnNames :: DataFrame -> [T.Text] -columnNames = map fst . L.sortBy (compare `on` snd). M.toList . columnIndices -{-# INLINE columnNames #-} - --- | /O(n)/ Adds a vector to the dataframe. -insertColumn :: - forall a. - (Columnable a) => - -- | Column Name - T.Text -> - -- | Vector to add to column - V.Vector a -> - -- | DataFrame to add column to - DataFrame -> - DataFrame -insertColumn name xs = insertColumn' name (Just (toColumn' xs)) -{-# INLINE insertColumn #-} - -cloneColumn :: T.Text -> T.Text -> DataFrame -> DataFrame -cloneColumn original new df = fromMaybe (throw $ ColumnNotFoundException original "cloneColumn" (map fst $ M.toList $ columnIndices df)) $ do - column <- getColumn original df - return $ insertColumn' new (Just column) df - --- | /O(n)/ Adds an unboxed vector to the dataframe. -insertUnboxedColumn :: - forall a. - (Columnable a, VU.Unbox a) => - -- | Column Name - T.Text -> - -- | Unboxed vector to add to column - VU.Vector a -> - -- | DataFrame to add to column - DataFrame -> - DataFrame -insertUnboxedColumn name xs = insertColumn' name (Just (UnboxedColumn xs)) - --- -- | /O(n)/ Add a column to the dataframe. Not meant for external use. -insertColumn' :: - -- | Column Name - T.Text -> - -- | Column to add - Maybe Column -> - -- | DataFrame to add to column - DataFrame -> - DataFrame -insertColumn' _ Nothing d = d -insertColumn' name optCol@(Just column) d - | M.member name (columnIndices d) = let - i = (M.!) (columnIndices d) name - in d { columns = columns d V.// [(i, optCol)] } - | otherwise = insertNewColumn - where - l = columnLength column - (r, c) = dataframeDimensions d - diff = abs (l - r) - insertNewColumn - -- If we have a non-empty dataframe and we have more rows in the new column than the other column - -- we should make all the other columns have null and then add the new column. - | r > 0 && l > r = let - indexes = (map snd . L.sortBy (compare `on` snd). M.toList . columnIndices) d - nonEmptyColumns = L.foldl' (\acc i -> acc ++ [maybe (error "Unexpected") (expandColumn diff) (columns d V.! i)]) [] indexes - in fromList (zip (columnNames d ++ [name]) (nonEmptyColumns ++ [column])) - | otherwise = let - (n:rest) = case freeIndices d of - [] -> [VG.length (columns d)..(VG.length (columns d) * 2 - 1)] - lst -> lst - columns' = if L.null (freeIndices d) - then columns d V.++ V.replicate (VG.length (columns d)) Nothing - else columns d - xs' - | diff <= 0 || null d = optCol - | otherwise = expandColumn diff <$> optCol - in d - { columns = columns' V.// [(n, xs')], - columnIndices = M.insert name n (columnIndices d), - freeIndices = rest, - dataframeDimensions = (max l r, c + 1) - } - --- | /O(k)/ Add a column to the dataframe providing a default. --- This constructs a new vector and also may convert it --- to an unboxed vector if necessary. Since columns are usually --- large the runtime is dominated by the length of the list, k. -insertColumnWithDefault :: - forall a. - (Columnable a) => - -- | Default Value - a -> - -- | Column name - T.Text -> - -- | Data to add to column - V.Vector a -> - -- | DataFrame to add to column - DataFrame -> - DataFrame -insertColumnWithDefault defaultValue name xs d = - let (rows, _) = dataframeDimensions d - values = xs V.++ V.replicate (rows - V.length xs) defaultValue - in insertColumn' name (Just $ toColumn' values) d - --- TODO: Add existence check in rename. -rename :: T.Text -> T.Text -> DataFrame -> DataFrame -rename orig new df = fromMaybe (throw $ ColumnNotFoundException orig "rename" (map fst $ M.toList $ columnIndices df)) $ do - columnIndex <- M.lookup orig (columnIndices df) - let origRemoved = M.delete orig (columnIndices df) - let newAdded = M.insert new columnIndex origRemoved - return df { columnIndices = newAdded } - --- | O(1) Get the number of elements in a given column. -columnSize :: T.Text -> DataFrame -> Maybe Int -columnSize name df = columnLength <$> getColumn name df - -data ColumnInfo = ColumnInfo { - nameOfColumn :: !T.Text, - nonNullValues :: !Int, - nullValues :: !Int, - partiallyParsedValues :: !Int, - uniqueValues :: !Int, - typeOfColumn :: !T.Text - } - --- | O(n) Returns the number of non-null columns in the dataframe and the type associated --- with each column. -columnInfo :: DataFrame -> DataFrame -columnInfo df = empty & insertColumn' "Column Name" (Just $! toColumn (map nameOfColumn infos)) - & insertColumn' "# Non-null Values" (Just $! toColumn (map nonNullValues infos)) - & insertColumn' "# Null Values" (Just $! toColumn (map nullValues infos)) - & insertColumn' "# Partially parsed" (Just $! toColumn (map partiallyParsedValues infos)) - & insertColumn' "# Unique Values" (Just $! toColumn (map uniqueValues infos)) - & insertColumn' "Type" (Just $! toColumn (map typeOfColumn infos)) - where - infos = L.sortBy (compare `on` nonNullValues) (V.ifoldl' go [] (columns df)) :: [ColumnInfo] - indexMap = M.fromList (map (\(a, b) -> (b, a)) $ M.toList (columnIndices df)) - columnName i = M.lookup i indexMap - go acc i Nothing = acc - go acc i (Just col@(OptionalColumn (c :: V.Vector a))) = let - cname = columnName i - countNulls = nulls col - countPartial = partiallyParsed col - columnType = T.pack $ show $ typeRep @a - unique = S.size $ VG.foldr S.insert S.empty c - in if cname == Nothing then acc else ColumnInfo (fromMaybe "" cname) (columnLength col - countNulls) countNulls countPartial unique columnType : acc - go acc i (Just col@(BoxedColumn (c :: V.Vector a))) = let - cname = columnName i - countPartial = partiallyParsed col - columnType = T.pack $ show $ typeRep @a - unique = S.size $ VG.foldr S.insert S.empty c - in if cname == Nothing then acc else ColumnInfo (fromMaybe "" cname) (columnLength col) 0 countPartial unique columnType : acc - go acc i (Just col@(UnboxedColumn c)) = let - cname = columnName i - columnType = T.pack $ columnTypeString col - unique = S.size $ VG.foldr S.insert S.empty c - -- Unboxed columns cannot have nulls since Maybe - -- is not an instance of Unbox a - in if cname == Nothing then acc else ColumnInfo (fromMaybe "" cname) (columnLength col) 0 0 unique columnType : acc - -nulls :: Column -> Int -nulls (OptionalColumn xs) = VG.length $ VG.filter isNothing xs -nulls (BoxedColumn (xs :: V.Vector a)) = case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> VG.length $ VG.filter isNullish xs - Nothing -> case testEquality (typeRep @a) (typeRep @String) of - Just Refl -> VG.length $ VG.filter (isNullish . T.pack) xs - Nothing -> case typeRep @a of - App t1 t2 -> case eqTypeRep t1 (typeRep @Maybe) of - Just HRefl -> VG.length $ VG.filter isNothing xs - Nothing -> 0 - _ -> 0 -nulls _ = 0 - -partiallyParsed :: Column -> Int -partiallyParsed (BoxedColumn (xs :: V.Vector a)) = - case typeRep @a of - App (App tycon t1) t2 -> case eqTypeRep tycon (typeRep @Either) of - Just HRefl -> VG.length $ VG.filter isLeft xs - Nothing -> 0 - _ -> 0 -partiallyParsed _ = 0 - -fromList :: [(T.Text, Column)] -> DataFrame -fromList = L.foldl' (\df (!name, !column) -> insertColumn' name (Just $! column) df) empty - --- | O (k * n) Counts the occurences of each value in a given column. -valueCounts :: forall a. (Columnable a) => T.Text -> DataFrame -> [(a, Int)] -valueCounts columnName df = case getColumn columnName df of - Nothing -> throw $ ColumnNotFoundException columnName "sortBy" (map fst $ M.toList $ columnIndices df) - Just (BoxedColumn (column' :: V.Vector c)) -> - let - column = V.foldl' (\m v -> MS.insertWith (+) v (1 :: Int) m) M.empty column' - in case (typeRep @a) `testEquality` (typeRep @c) of - Nothing -> throw $ TypeMismatchException (typeRep @a) (typeRep @c) columnName "valueCounts" - Just Refl -> M.toAscList column - Just (OptionalColumn (column' :: V.Vector c)) -> - let - column = V.foldl' (\m v -> MS.insertWith (+) v (1 :: Int) m) M.empty column' - in case (typeRep @a) `testEquality` (typeRep @c) of - Nothing -> throw $ TypeMismatchException (typeRep @a) (typeRep @c) columnName "valueCounts" - Just Refl -> M.toAscList column - Just (UnboxedColumn (column' :: VU.Vector c)) -> let - column = V.foldl' (\m v -> MS.insertWith (+) v (1 :: Int) m) M.empty (V.convert column') - in case (typeRep @a) `testEquality` (typeRep @c) of - Nothing -> throw $ TypeMismatchException (typeRep @a) (typeRep @c) columnName "valueCounts" - Just Refl -> M.toAscList column - -fold :: (a -> DataFrame -> DataFrame) -> [a] -> DataFrame -> DataFrame -fold f xs acc = L.foldl' (flip f) acc xs diff --git a/src/Data/DataFrame/Operations/Sorting.hs b/src/Data/DataFrame/Operations/Sorting.hs deleted file mode 100644 --- a/src/Data/DataFrame/Operations/Sorting.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Data.DataFrame.Operations.Sorting where - -import qualified Data.List as L -import qualified Data.Text as T -import qualified Data.Vector as V - -import Control.Exception (throw) -import Data.DataFrame.Errors (DataFrameException(..)) -import Data.DataFrame.Internal.Column -import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn) -import Data.DataFrame.Internal.Row -import Data.DataFrame.Operations.Core - --- | Sort order taken as a parameter by the sortby function. -data SortOrder = Ascending | Descending deriving (Eq) - --- | O(k log n) Sorts the dataframe by a given row. --- --- > sortBy "Age" df -sortBy :: - SortOrder -> - [T.Text] -> - DataFrame -> - DataFrame -sortBy order names df - | any (`notElem` columnNames df) names = throw $ ColumnNotFoundException (T.pack $ show $ names L.\\ columnNames df) "sortBy" (columnNames df) - | otherwise = let - -- TODO: Remove the SortOrder defintion from operations so we can share it between here and internal and - -- we don't have to do this Bool mapping. - indexes = sortedIndexes' (order == Ascending) (toRowVector names df) - pick idxs col = atIndicesStable idxs <$> col - in df {columns = V.map (pick indexes) (columns df)} diff --git a/src/Data/DataFrame/Operations/Statistics.hs b/src/Data/DataFrame/Operations/Statistics.hs deleted file mode 100644 --- a/src/Data/DataFrame/Operations/Statistics.hs +++ /dev/null @@ -1,154 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StrictData #-} -module Data.DataFrame.Operations.Statistics where - -import qualified Data.List as L -import qualified Data.Text as T -import qualified Data.Vector.Generic as VG -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as VU -import qualified Statistics.Quantile as SS -import qualified Statistics.Sample as SS - -import Prelude as P - -import Control.Exception (throw) -import Data.DataFrame.Errors (DataFrameException(..)) -import Data.DataFrame.Internal.Column -import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn, empty) -import Data.DataFrame.Internal.Types (Columnable, transform) -import Data.DataFrame.Operations.Core -import Data.Foldable (asum) -import Data.Maybe (isJust, fromMaybe) -import Data.Function ((&)) -import Data.Type.Equality (type (:~:)(Refl), TestEquality (testEquality)) -import Type.Reflection (typeRep) - - -frequencies :: T.Text -> DataFrame -> DataFrame -frequencies name df = case getColumn name df of - Just ((BoxedColumn (column :: V.Vector a))) -> let - counts = valueCounts @a name df - total = P.sum $ map snd counts - vText :: forall a . (Columnable a) => a -> T.Text - vText c' = case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> c' - Nothing -> case testEquality (typeRep @a) (typeRep @String) of - Just Refl -> T.pack c' - Nothing -> (T.pack . show) c' - initDf = empty & insertColumn "Statistic" (V.fromList ["Count" :: T.Text, "Percentage (%)"]) - in L.foldl' (\df (col, k) -> insertColumn (vText col) (V.fromList [k, k * 100 `div` total]) df) initDf counts - Just ((OptionalColumn (column :: V.Vector a))) -> let - counts = valueCounts @a name df - total = P.sum $ map snd counts - vText :: forall a . (Columnable a) => a -> T.Text - vText c' = case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> c' - Nothing -> case testEquality (typeRep @a) (typeRep @String) of - Just Refl -> T.pack c' - Nothing -> (T.pack . show) c' - initDf = empty & insertColumn "Statistic" (V.fromList ["Count" :: T.Text, "Percentage (%)"]) - in L.foldl' (\df (col, k) -> insertColumn (vText col) (V.fromList [k, k * 100 `div` total]) df) initDf counts - Just ((UnboxedColumn (column :: VU.Vector a))) -> let - counts = valueCounts @a name df - total = P.sum $ map snd counts - vText :: forall a . (Columnable a) => a -> T.Text - vText c' = case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> c' - Nothing -> case testEquality (typeRep @a) (typeRep @String) of - Just Refl -> T.pack c' - Nothing -> (T.pack . show) c' - initDf = empty & insertColumn "Statistic" (V.fromList ["Count" :: T.Text, "Percentage (%)"]) - in L.foldl' (\df (col, k) -> insertColumn (vText col) (V.fromList [k, k * 100 `div` total]) df) initDf counts - -mean :: T.Text -> DataFrame -> Maybe Double -mean = applyStatistic SS.mean - -median :: T.Text -> DataFrame -> Maybe Double -median = applyStatistic (SS.median SS.medianUnbiased) - -standardDeviation :: T.Text -> DataFrame -> Maybe Double -standardDeviation = applyStatistic SS.fastStdDev - -skewness :: T.Text -> DataFrame -> Maybe Double -skewness = applyStatistic SS.skewness - -variance :: T.Text -> DataFrame -> Maybe Double -variance = applyStatistic SS.variance - -interQuartileRange :: T.Text -> DataFrame -> Maybe Double -interQuartileRange = applyStatistic (SS.midspread SS.medianUnbiased 4) - -correlation :: T.Text -> T.Text -> DataFrame -> Maybe Double -correlation first second df = do - f <- _getColumnAsDouble first df - s <- _getColumnAsDouble second df - return $ SS.correlation2 f s - -_getColumnAsDouble :: T.Text -> DataFrame -> Maybe (VU.Vector Double) -_getColumnAsDouble name df = case getColumn name df of - Just (UnboxedColumn (f :: VU.Vector a)) -> case testEquality (typeRep @a) (typeRep @Double) of - Just Refl -> Just f - Nothing -> case testEquality (typeRep @a) (typeRep @Int) of - Just Refl -> Just $ VU.map fromIntegral f - Nothing -> Nothing - _ -> Nothing - -sum :: T.Text -> DataFrame -> Maybe Double -sum name df = case getColumn name df of - Just ((UnboxedColumn (column :: VU.Vector a'))) -> case testEquality (typeRep @a') (typeRep @Int) of - Just Refl -> Just $ VG.sum (VU.map fromIntegral column) - Nothing -> case testEquality (typeRep @a') (typeRep @Double) of - Just Refl -> Just $ VG.sum column - Nothing -> Nothing - Nothing -> Nothing - -applyStatistic :: (VU.Vector Double -> Double) -> T.Text -> DataFrame -> Maybe Double -applyStatistic f name df = do - column <- getColumn name df - if columnTypeString column == "Double" - then safeReduceColumn f column - else do - matching <- asum [ transform (fromIntegral :: Int -> Double) column, - transform (realToFrac :: Float -> Double) column, - Just column ] - safeReduceColumn f matching - -applyStatistics :: (VU.Vector Double -> VU.Vector Double) -> T.Text -> DataFrame -> Maybe (VU.Vector Double) -applyStatistics f name df = case getColumn name df of - Just ((UnboxedColumn (column :: VU.Vector a'))) -> case testEquality (typeRep @a') (typeRep @Int) of - Just Refl -> Just $! f (VU.map fromIntegral column) - Nothing -> case testEquality (typeRep @a') (typeRep @Double) of - Just Refl -> Just $! f column - Nothing -> case testEquality (typeRep @a') (typeRep @Float) of - Just Refl -> Just $! f (VG.map realToFrac column) - Nothing -> Nothing - _ -> Nothing - -summarize :: DataFrame -> DataFrame -summarize df = fold columnStats (columnNames df) (fromList [("Statistic", toColumn ["Mean" :: T.Text, "Minimum", "25%" ,"Median", "75%", "Max", "StdDev", "IQR", "Skewness"])]) - where columnStats name d = if all isJust (stats name) then insertUnboxedColumn name (VU.fromList (map (roundTo 2 . fromMaybe 0) $ stats name)) d else d - stats name = let - quantiles = applyStatistics (SS.quantilesVec SS.medianUnbiased (VU.fromList [0,1,2,3,4]) 4) name df - min' = flip (VG.!) 0 <$> quantiles - quartile1 = flip (VG.!) 1 <$> quantiles - median' = flip (VG.!) 2 <$> quantiles - quartile3 = flip (VG.!) 3 <$> quantiles - max' = flip (VG.!) 4 <$> quantiles - iqr = (-) <$> quartile3 <*> quartile1 - in [mean name df, - min', - quartile1, - median', - quartile3, - max', - standardDeviation name df, - iqr, - skewness name df] - roundTo :: Int -> Double -> Double - roundTo n x = fromInteger (round $ x * (10^n)) / (10.0^^n) diff --git a/src/Data/DataFrame/Operations/Subset.hs b/src/Data/DataFrame/Operations/Subset.hs deleted file mode 100644 --- a/src/Data/DataFrame/Operations/Subset.hs +++ /dev/null @@ -1,157 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE GADTs #-} -module Data.DataFrame.Operations.Subset where - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as VU -import qualified Data.Vector.Generic as VG -import qualified Prelude - -import Control.Exception (throw) -import Data.DataFrame.Errors (DataFrameException(..)) -import Data.DataFrame.Internal.Column -import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn, empty) -import Data.DataFrame.Internal.Function -import Data.DataFrame.Internal.Row (mkRowFromArgs) -import Data.DataFrame.Internal.Types (Columnable, RowValue, toRowValue) -import Data.DataFrame.Operations.Core -import Data.DataFrame.Operations.Transformations (apply) -import Data.Function ((&)) -import Data.Maybe (isJust, fromJust, fromMaybe) -import Prelude hiding (filter, take) -import Type.Reflection - --- | O(k * n) Take the first n rows of a DataFrame. -take :: Int -> DataFrame -> DataFrame -take n d = d {columns = V.map (takeColumn n' <$>) (columns d), dataframeDimensions = (n', c)} - where - (r, c) = dataframeDimensions d - n' = clip n 0 r - -takeLast :: Int -> DataFrame -> DataFrame -takeLast n d = d {columns = V.map (takeLastColumn n' <$>) (columns d), dataframeDimensions = (n', c)} - where - (r, c) = dataframeDimensions d - n' = clip n 0 r - -drop :: Int -> DataFrame -> DataFrame -drop n d = d {columns = V.map (sliceColumn n' (max (r - n') 0) <$>) (columns d), dataframeDimensions = (max (r - n') 0, c)} - where - (r, c) = dataframeDimensions d - n' = clip n 0 r - -dropLast :: Int -> DataFrame -> DataFrame -dropLast n d = d {columns = V.map (sliceColumn 0 n' <$>) (columns d), dataframeDimensions = (n', c)} - where - (r, c) = dataframeDimensions d - n' = clip (r - n) 0 r - --- | O(k * n) Take a range of rows of a DataFrame. -range :: (Int, Int) -> DataFrame -> DataFrame -range (start, end) d = d {columns = V.map (sliceColumn (clip start 0 r) n' <$>) (columns d), dataframeDimensions = (n', c)} - where - (r, c) = dataframeDimensions d - n' = clip (end - start) 0 r - -clip :: Int -> Int -> Int -> Int -clip n left right = min right $ max n left - --- | O(n * k) Filter rows by a given condition. -filter :: - forall a. - (Columnable a) => - -- | Column to filter by - T.Text -> - -- | Filter condition - (a -> Bool) -> - -- | Dataframe to filter - DataFrame -> - DataFrame -filter filterColumnName condition df = case getColumn filterColumnName df of - Nothing -> throw $ ColumnNotFoundException filterColumnName "filter" (map fst $ M.toList $ columnIndices df) - Just column -> case ifoldlColumn (\s i v -> if condition v then S.insert i s else s) S.empty column of - Nothing -> throw $ TypeMismatchException' (typeRep @a) (columnTypeString column) filterColumnName "filter" - Just indexes -> let - c' = snd $ dataframeDimensions df - pick idxs col = atIndices idxs <$> col - in df {columns = V.map (pick indexes) (columns df), dataframeDimensions = (S.size indexes, c')} - -filterBy :: (Columnable a) => (a -> Bool) -> T.Text -> DataFrame -> DataFrame -filterBy = flip filter - -filterWhere :: ([T.Text], Function) -> DataFrame -> DataFrame -filterWhere (args, f) df = let - indexes = VG.ifoldl' (\s i row -> if funcApply @Bool row f then S.insert i s else s) S.empty $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) - c' = snd $ dataframeDimensions df - pick idxs col = atIndices idxs <$> col - in df {columns = V.map (pick indexes) (columns df), dataframeDimensions = (S.size indexes, c')} - - -filterJust :: T.Text -> DataFrame -> DataFrame -filterJust name df = case getColumn name df of - Nothing -> throw $ ColumnNotFoundException name "extractNonEmpty" (map fst $ M.toList $ columnIndices df) - Just column@(OptionalColumn (col :: V.Vector (Maybe a))) -> filter @(Maybe a) name isJust df & apply @(Maybe a) fromJust name - Just column -> error $ "Column " ++ T.unpack name ++ " is not of type Maybe a" - --- | O(k) cuts the dataframe in a cube of size (a, b) where --- a is the length and b is the width. --- --- > cube (10, 5) df -cube :: (Int, Int) -> DataFrame -> DataFrame -cube (length, width) = take length . selectIntRange (0, width - 1) - --- | O(n) Selects a number of columns in a given dataframe. --- --- > select ["name", "age"] df -select :: - [T.Text] -> - DataFrame -> - DataFrame -select cs df - | L.null cs = empty - | any (`notElem` columnNames df) cs = throw $ ColumnNotFoundException (T.pack $ show $ cs L.\\ columnNames df) "select" (columnNames df) - | otherwise = L.foldl' addKeyValue empty cs - where - cIndexAssoc = M.toList $ columnIndices df - remaining = L.filter (\(!c, _) -> c `elem` cs) cIndexAssoc - removed = cIndexAssoc L.\\ remaining - indexes = map snd remaining - (r, c) = dataframeDimensions df - addKeyValue d k = - d - { columns = V.imap (\i v -> if i `notElem` indexes then Nothing else v) (columns df), - columnIndices = M.fromList remaining, - freeIndices = map snd removed ++ freeIndices df, - dataframeDimensions = (r, L.length remaining) - } - --- | O(n) select columns by index range of column names. -selectIntRange :: (Int, Int) -> DataFrame -> DataFrame -selectIntRange (from, to) df = select (Prelude.take (to - from + 1) $ Prelude.drop from (columnNames df)) df - --- | O(n) select columns by index range of column names. -selectRange :: (T.Text, T.Text) -> DataFrame -> DataFrame -selectRange (from, to) df = select (reverse $ Prelude.dropWhile (to /=) $ reverse $ dropWhile (from /=) (columnNames df)) df - --- | O(n) select columns by column predicate name. -selectBy :: (T.Text -> Bool) -> DataFrame -> DataFrame -selectBy f df = select (L.filter f (columnNames df)) df - --- | O(n) inverse of select --- --- > exclude ["Name"] df -exclude :: - [T.Text] -> - DataFrame -> - DataFrame -exclude cs df = - let keysToKeep = columnNames df L.\\ cs - in select keysToKeep df diff --git a/src/Data/DataFrame/Operations/Transformations.hs b/src/Data/DataFrame/Operations/Transformations.hs deleted file mode 100644 --- a/src/Data/DataFrame/Operations/Transformations.hs +++ /dev/null @@ -1,150 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -module Data.DataFrame.Operations.Transformations where - -import qualified Data.List as L -import qualified Data.Text as T -import qualified Data.Map as M -import qualified Data.Vector.Generic as VG -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as VU - -import Control.Exception (throw) -import Data.DataFrame.Errors (DataFrameException(..)) -import Data.DataFrame.Internal.Column (Column(..), columnTypeString, itransform, ifoldrColumn) -import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn) -import Data.DataFrame.Internal.Function (Function(..), funcApply) -import Data.DataFrame.Internal.Row (mkRowFromArgs) -import Data.DataFrame.Internal.Types (Columnable, RowValue, toRowValue, transform) -import Data.DataFrame.Operations.Core -import Type.Reflection (typeRep, typeOf) - --- | O(k) Apply a function to a given column in a dataframe. -apply :: - forall b c. - (Columnable b, Columnable c) => - -- | function to apply - (b -> c) -> - -- | Column name - T.Text -> - -- | DataFrame to apply operation to - DataFrame -> - DataFrame -apply f columnName d = case getColumn columnName d of - Nothing -> throw $ ColumnNotFoundException columnName "apply" (map fst $ M.toList $ columnIndices d) - Just column -> case transform f column of - Nothing -> throw $ TypeMismatchException' (typeRep @b) (columnTypeString column) columnName "apply" - column' -> insertColumn' columnName column' d - --- | O(k) Apply a function to a combination of columns in a dataframe and --- add the result into `alias` column. -deriveFrom :: ([T.Text], Function) -> T.Text -> DataFrame -> DataFrame -deriveFrom (args, f) name df = case f of - (F4 (f' :: a -> b -> c -> d -> e)) -> let - xs = VG.map (\row -> funcApply @e row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) - in insertColumn name xs df - (F3 (f' :: a -> b -> c -> d)) -> let - xs = VG.map (\row -> funcApply @d row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) - in insertColumn name xs df - (F2 (f' :: a -> b -> c)) -> let - xs = VG.map (\row -> funcApply @c row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) - in insertColumn name xs df - (F1 (f' :: a -> b)) -> let - xs = VG.map (\row -> funcApply @b row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) - in insertColumn name xs df - --- | O(k) Apply a function to a given column in a dataframe and --- add the result into alias column. - -derive :: - forall b c. - (Columnable b, Columnable c) => - -- | New name - T.Text -> - -- | function to apply - (b -> c) -> - -- | Derivative column name - T.Text -> - -- | DataFrame to apply operation to - DataFrame -> - DataFrame -derive alias f columnName d = case getColumn columnName d of - Nothing -> throw $ ColumnNotFoundException columnName "derive" (map fst $ M.toList $ columnIndices d) - Just column -> case transform f column of - Nothing -> throw $ TypeMismatchException (typeOf column) (typeRep @b) columnName "derive" - Just res -> insertColumn' alias (Just res) d - --- | O(k * n) Apply a function to given column names in a dataframe. -applyMany :: - (Columnable b, Columnable c) => - (b -> c) -> - [T.Text] -> - DataFrame -> - DataFrame -applyMany f names df = L.foldl' (flip (apply f)) df names - --- | O(k) Convenience function that applies to an int column. -applyInt :: - (Columnable b) => - -- | Column name - -- | function to apply - (Int -> b) -> - T.Text -> - -- | DataFrame to apply operation to - DataFrame -> - DataFrame -applyInt = apply - --- | O(k) Convenience function that applies to an double column. -applyDouble :: - (Columnable b) => - -- | Column name - -- | function to apply - (Double -> b) -> - T.Text -> - -- | DataFrame to apply operation to - DataFrame -> - DataFrame -applyDouble = apply - --- | O(k * n) Apply a function to a column only if there is another column --- value that matches the given criterion. --- --- > applyWhere "Age" (<20) "Generation" (const "Gen-Z") -applyWhere :: - forall a b . - (Columnable a, Columnable b) => - (a -> Bool) -> -- Filter condition - T.Text -> -- Criterion Column - (b -> b) -> -- function to apply - T.Text -> -- Column name - DataFrame -> -- DataFrame to apply operation to - DataFrame -applyWhere condition filterColumnName f columnName df = case getColumn filterColumnName df of - Nothing -> throw $ ColumnNotFoundException filterColumnName "applyWhere" (map fst $ M.toList $ columnIndices df) - Just column -> case ifoldrColumn (\i val acc -> if condition val then V.cons i acc else acc) V.empty column of - Nothing -> throw $ TypeMismatchException' (typeRep @a) (columnTypeString column) filterColumnName "applyWhere" - Just indexes -> if V.null indexes - then df - else L.foldl' (\d i -> applyAtIndex i f columnName d) df indexes - --- | O(k) Apply a function to the column at a given index. -applyAtIndex :: - forall a. - (Columnable a) => - -- | Index - Int -> - -- | function to apply - (a -> a) -> - -- | Column name - T.Text -> - -- | DataFrame to apply operation to - DataFrame -> - DataFrame -applyAtIndex i f columnName df = case getColumn columnName df of - Nothing -> throw $ ColumnNotFoundException columnName "applyAtIndex" (map fst $ M.toList $ columnIndices df) - Just column -> case itransform (\index value -> if index == i then f value else value) column of - Nothing -> throw $ TypeMismatchException' (typeRep @a) (columnTypeString column) columnName "applyAtIndex" - column' -> insertColumn' columnName column' df diff --git a/src/Data/DataFrame/Operations/Typing.hs b/src/Data/DataFrame/Operations/Typing.hs deleted file mode 100644 --- a/src/Data/DataFrame/Operations/Typing.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -module Data.DataFrame.Operations.Typing where - -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as VU - -import Data.DataFrame.Internal.Column (Column(..)) -import Data.DataFrame.Internal.DataFrame (DataFrame(..)) -import Data.DataFrame.Internal.Parsing -import Data.Either -import Data.Maybe -import Data.Time -import Data.Type.Equality (type (:~:)(Refl), TestEquality(..)) -import Type.Reflection (typeRep) - -parseDefaults :: Bool -> DataFrame -> DataFrame -parseDefaults safeRead df = df {columns = V.map (parseDefault safeRead) (columns df)} - -parseDefault :: Bool -> Maybe Column -> Maybe Column -parseDefault _ Nothing = Nothing -parseDefault safeRead (Just (BoxedColumn (c :: V.Vector a))) = let - parseTimeOpt s = parseTimeM {- Accept leading/trailing whitespace -} True defaultTimeLocale "%Y-%m-%d" (T.unpack s) :: Maybe Day - unsafeParseTime s = parseTimeOrError {- Accept leading/trailing whitespace -} True defaultTimeLocale "%Y-%m-%d" (T.unpack s) :: Day - in case (typeRep @a) `testEquality` (typeRep @T.Text) of - Nothing -> case (typeRep @a) `testEquality` (typeRep @String) of - Just Refl -> let - emptyToNothing v = if isNullish (T.pack v) then Nothing else Just v - safeVector = V.map emptyToNothing c - hasNulls = V.foldl' (\acc v -> if isNothing v then acc || True else acc) False safeVector - in Just $ if safeRead && hasNulls then BoxedColumn safeVector else BoxedColumn c - Nothing -> Just $ BoxedColumn c - Just Refl -> - let example = T.strip (V.head c) - emptyToNothing v = if isNullish v then Nothing else Just v - in case readInt example of - Just _ -> - let safeVector = V.map ((=<<) readInt . emptyToNothing) c - hasNulls = V.elem Nothing safeVector - in Just $ if safeRead && hasNulls then BoxedColumn safeVector else UnboxedColumn (VU.generate (V.length c) (fromMaybe 0 . (safeVector V.!))) - Nothing -> case readDouble example of - Just _ -> - let safeVector = V.map ((=<<) readDouble . emptyToNothing) c - hasNulls = V.elem Nothing safeVector - in Just $ if safeRead && hasNulls then BoxedColumn safeVector else UnboxedColumn (VU.generate (V.length c) (fromMaybe 0 . (safeVector V.!))) - Nothing -> case parseTimeOpt example of - Just d -> let - -- failed parse should be Either, nullish should be Maybe - emptyToNothing' v = if isNullish v then Left v else Right v - parseTimeEither v = case parseTimeOpt v of - Just v' -> Right v' - Nothing -> Left v - safeVector = V.map ((=<<) parseTimeEither . emptyToNothing') c - toMaybe (Left _) = Nothing - toMaybe (Right value) = Just value - lefts = V.filter isLeft safeVector - onlyNulls = (not (V.null lefts) && V.all (isNullish . fromLeft "non-null") lefts) - in Just $ if safeRead - then if onlyNulls - then BoxedColumn (V.map toMaybe safeVector) - else if V.any isLeft safeVector - then BoxedColumn safeVector - else BoxedColumn (V.map unsafeParseTime c) - else BoxedColumn (V.map unsafeParseTime c) - Nothing -> let - safeVector = V.map emptyToNothing c - hasNulls = V.any isNullish c - in Just $ if safeRead && hasNulls then BoxedColumn safeVector else BoxedColumn c -parseDefault safeRead column = column diff --git a/src/DataFrame.hs b/src/DataFrame.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame.hs @@ -0,0 +1,26 @@ +module DataFrame + ( module D, + (|>) + ) +where + +import DataFrame.Internal.Types as D +import DataFrame.Internal.Function as D +import DataFrame.Internal.Parsing as D +import DataFrame.Internal.Column as D +import DataFrame.Internal.DataFrame as D hiding (columnIndices, columns) +import DataFrame.Internal.Row as D hiding (mkRowRep) +import DataFrame.Errors as D +import DataFrame.Operations.Core as D +import DataFrame.Operations.Subset as D +import DataFrame.Operations.Sorting as D +import DataFrame.Operations.Statistics as D +import DataFrame.Operations.Transformations as D +import DataFrame.Operations.Typing as D +import DataFrame.Operations.Aggregation as D +import DataFrame.Display.Terminal.Plot as D +import DataFrame.IO.CSV as D + +import Data.Function + +(|>) = (&) diff --git a/src/DataFrame/Display/Terminal/Colours.hs b/src/DataFrame/Display/Terminal/Colours.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Display/Terminal/Colours.hs @@ -0,0 +1,14 @@ +module DataFrame.Display.Terminal.Colours where + +-- terminal color functions +red :: String -> String +red s = "\ESC[31m" ++ s ++ "\ESC[0m" + +green :: String -> String +green s = "\ESC[32m" ++ s ++ "\ESC[0m" + +brightGreen :: String -> String +brightGreen s = "\ESC[92m" ++ s ++ "\ESC[0m" + +brightBlue :: String -> String +brightBlue s = "\ESC[94m" ++ s ++ "\ESC[0m" diff --git a/src/DataFrame/Display/Terminal/Plot.hs b/src/DataFrame/Display/Terminal/Plot.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Display/Terminal/Plot.hs @@ -0,0 +1,340 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE TupleSections #-} +module DataFrame.Display.Terminal.Plot where + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Unboxed as VU +import qualified Type.Reflection as Ref + +import Control.Monad ( forM_, forM ) +import Data.Bifunctor ( first ) +import Data.Char ( ord, chr ) +import DataFrame.Display.Terminal.Colours +import DataFrame.Internal.Column (Column(..)) +import DataFrame.Internal.DataFrame (DataFrame(..)) +import DataFrame.Internal.Types (Columnable) +import DataFrame.Operations.Core +import Data.Maybe (fromMaybe) +import Data.Typeable (Typeable) +import Data.Type.Equality + ( type (:~:)(Refl), TestEquality(testEquality) ) +import GHC.Stack (HasCallStack) +import Text.Printf ( printf ) +import Type.Reflection (typeRep) + +data HistogramOrientation = VerticalHistogram | HorizontalHistogram + +data PlotColumns = PlotAll | PlotSubset [T.Text] + +plotHistograms :: HasCallStack => PlotColumns -> HistogramOrientation -> DataFrame -> IO () +plotHistograms plotSet orientation df = do + let cs = case plotSet of + PlotAll -> columnNames df + PlotSubset xs -> columnNames df `L.intersect` xs + forM_ cs $ \cname -> do + plotForColumn cname ((V.!) (columns df) (columnIndices df M.! cname)) orientation df + + +plotHistogramsBy :: HasCallStack => T.Text -> PlotColumns -> HistogramOrientation -> DataFrame -> IO () +plotHistogramsBy col plotSet orientation df = do + let cs = case plotSet of + PlotAll -> columnNames df + PlotSubset xs -> columnNames df `L.intersect` xs + forM_ cs $ \cname -> do + let plotColumn = (V.!) (columns df) (columnIndices df M.! cname) + let byColumn = (V.!) (columns df) (columnIndices df M.! col) + plotForColumnBy col cname byColumn plotColumn orientation df + +-- Plot code adapted from: https://alexwlchan.net/2018/ascii-bar-charts/ +plotForColumnBy :: HasCallStack => T.Text -> T.Text -> Maybe Column -> Maybe Column -> HistogramOrientation -> DataFrame -> IO () +plotForColumnBy _ _ Nothing _ _ _ = return () +plotForColumnBy byCol cname (Just (BoxedColumn (byColumn :: V.Vector a))) (Just (BoxedColumn (plotColumn :: V.Vector b))) orientation df = do + let zipped = VG.zipWith (\left right -> (show left, show right)) plotColumn byColumn + let counts = countOccurrences zipped + if null counts || length counts > 20 + then pure () + else case orientation of + VerticalHistogram -> error "Vertical histograms aren't yet supported" + HorizontalHistogram -> plotGivenCounts' cname counts +plotForColumnBy byCol cname (Just (UnboxedColumn byColumn)) (Just (BoxedColumn plotColumn)) orientation df = do + let zipped = VG.zipWith (\left right -> (show left, show right)) plotColumn (V.convert byColumn) + let counts = countOccurrences zipped + if null counts || length counts > 20 + then pure () + else case orientation of + VerticalHistogram -> error "Vertical histograms aren't yet supported" + HorizontalHistogram -> plotGivenCounts' cname counts +plotForColumnBy byCol cname (Just (BoxedColumn byColumn)) (Just (UnboxedColumn plotColumn)) orientation df = do + let zipped = VG.zipWith (\left right -> (show left, show right)) (V.convert plotColumn) (V.convert byColumn) + let counts = countOccurrences zipped + if null counts || length counts > 20 + then pure () + else case orientation of + -- VerticalHistogram -> plotVerticalGivenCounts cname counts + HorizontalHistogram -> plotGivenCounts' cname counts +plotForColumnBy byCol cname (Just (UnboxedColumn byColumn)) (Just (UnboxedColumn plotColumn)) orientation df = do + let zipped = VG.zipWith (\left right -> (show left, show right)) (V.convert plotColumn) (V.convert byColumn) + let counts = countOccurrences zipped + if null counts || length counts > 20 + then pure () + else case orientation of + VerticalHistogram -> error "Vertical histograms aren't yet supported" + HorizontalHistogram -> plotGivenCounts' cname counts +-- TODO: Add Optional columns +plotForColumnBy _ _ _ _ _ _ = return () + +-- Plot code adapted from: https://alexwlchan.net/2018/ascii-bar-charts/ +plotForColumn :: HasCallStack => T.Text -> Maybe Column -> HistogramOrientation -> DataFrame -> IO () +plotForColumn _ Nothing _ _ = return () +plotForColumn cname (Just (BoxedColumn (column :: V.Vector a))) orientation df = do + let repa :: Ref.TypeRep a = Ref.typeRep @a + repText :: Ref.TypeRep T.Text = Ref.typeRep @T.Text + repString :: Ref.TypeRep String = Ref.typeRep @String + let counts = case repa `testEquality` repText of + Just Refl -> map (first T.unpack) $ valueCounts @T.Text cname df + Nothing -> case repa `testEquality` repString of + Just Refl -> valueCounts @String cname df + -- Support other scalar types. + Nothing -> [] -- numericHistogram column + if null counts || length counts > 20 + then putStrLn $ numericHistogram cname (V.convert column) + else case orientation of + VerticalHistogram -> plotVerticalGivenCounts cname counts + HorizontalHistogram -> plotGivenCounts cname counts +plotForColumn cname (Just (UnboxedColumn (column :: VU.Vector a))) orientation df = do + let repa :: Ref.TypeRep a = Ref.typeRep @a + repText :: Ref.TypeRep T.Text = Ref.typeRep @T.Text + repString :: Ref.TypeRep String = Ref.typeRep @String + let counts = case repa `testEquality` repText of + Just Refl -> map (first show) $ valueCounts @T.Text cname df + Nothing -> case repa `testEquality` repString of + Just Refl -> valueCounts @String cname df + -- Support other scalar types. + Nothing -> [] + if null counts || length counts > 20 + then putStrLn $ numericHistogram cname (V.convert column) + else case orientation of + VerticalHistogram -> plotVerticalGivenCounts cname counts + HorizontalHistogram -> plotGivenCounts cname counts +plotForColumn _ _ _ _ = return () + +plotGivenCounts :: HasCallStack => T.Text -> [(String, Int)] -> IO () +plotGivenCounts cname counts = do + putStrLn $ "\nHistogram for " ++ show cname ++ "\n" + let n = 8 :: Int + let maxValue = maximum $ map snd counts + let increment = max 1 (maxValue `div` 50) + let longestLabelLength = maximum $ map (length . fst) counts + let longestBar = fromIntegral $ (maxValue * fromIntegral n `div` increment) `div` fromIntegral n + 1 + let border = "|" ++ replicate (longestLabelLength + length (show maxValue) + longestBar + 6) '-' ++ "|" + body <- forM counts $ \(label, count) -> do + let barChunks = fromIntegral $ (count * fromIntegral n `div` increment) `div` fromIntegral n + let remainder = fromIntegral $ (count * fromIntegral n `div` increment) `rem` fromIntegral n + let fractional = ([chr (ord '█' + n - remainder - 1) | remainder > 0]) + let bar = replicate barChunks '█' ++ fractional + let disp = if null bar then "| " else bar + let hist= "|" ++ brightGreen (leftJustify label longestLabelLength) ++ " | " ++ + leftJustify (show count) (length (show maxValue)) ++ " |" ++ + " " ++ brightBlue bar + return $ hist ++ "\n" ++ border + mapM_ putStrLn (border : body) + putChar '\n' + +plotVerticalGivenCounts :: HasCallStack => T.Text -> [(String, Int)] -> IO () +plotVerticalGivenCounts cname counts' = do + putStrLn $ "\nHistogram for " ++ show cname ++ "\n" + let n = 8 :: Int + let clip s = if length s > n then take n s ++ ".." else s + let counts = map (first clip) counts' + let maxValue = maximum $ map snd counts + let increment = max 1 (maxValue `div` 10) + let longestLabelLength = 2 + maximum (map (length . fst) counts) + let longestBar = fromIntegral $ (maxValue * fromIntegral n `div` increment) `div` fromIntegral n + 1 + let border = "‾" ++ replicate (longestBar + 1) '|' ++ "+" + let maximumLineLength = length border + body <- forM counts $ \(label, count) -> do + let barChunks = fromIntegral $ (count * fromIntegral n `div` increment) `div` fromIntegral n + let remainder = fromIntegral $ (count * fromIntegral n `div` increment) `rem` fromIntegral n + let fractional = ([chr (ord '█' - (n - remainder - 1)) | remainder > 0]) + let bar = replicate barChunks '█' ++ fractional + let disp = if null bar then "| " else bar + let hist = "‾" ++ bar + return $ replicate longestLabelLength (leftJustify hist maximumLineLength) ++ [border] + let fullGraph = map brightBlue $ rotate $ border : concat body + let partition = smallestPartition increment intPlotRanges + let increments = reverse [0, maxValue `div` 2 , maxValue + partition] + let incString = reverse $ map (`leftJustify` (length (show maxValue) + 1)) $ show 0 : replicate (length fullGraph `div` 2 - 2) " " + ++ [show (maxValue `div` 2)] + ++ replicate (length fullGraph `div` 2 - 2) " " + ++ [show (maxValue + partition)] + ++ [""] + mapM_ putStrLn (zipWith (++) incString fullGraph) + putStrLn $ " " ++ replicate (length (show maxValue) + 1) ' ' ++ unwords (map (brightGreen . flip leftJustify longestLabelLength . fst) counts) + putChar '\n' + +leftJustify :: String -> Int -> String +leftJustify s n = s ++ replicate (max 0 (n - length s)) ' ' + + +plotGivenCounts' :: HasCallStack => T.Text -> [((String, String), Int)] -> IO () +plotGivenCounts' cname counts = do + putStrLn $ "\nHistogram for " ++ show cname ++ "\n" + let n = 8 :: Int + let maxValue = maximum $ map snd counts + let increment = max 1 (maxValue `div` 50) + let longestLabelLength = maximum $ map (length. (\(a, b) -> a ++ " " ++ b) . fst) counts + let longestBar = fromIntegral $ (maxValue * fromIntegral n `div` increment) `div` fromIntegral n + 1 + let border = "|" ++ replicate (longestLabelLength + length (show maxValue) + longestBar + 6) '-' ++ "|" + body <- forM counts $ \((plotCol, byCol), count) -> do + let barChunks = fromIntegral $ (count * fromIntegral n `div` increment) `div` fromIntegral n + let remainder = fromIntegral $ (count * fromIntegral n `div` increment) `rem` fromIntegral n + let fractional = ([chr (ord '█' + n - remainder - 1) | remainder > 0]) + let bar = replicate barChunks '█' ++ fractional + let disp = if null bar then "| " else bar + let label = plotCol ++ " " ++ byCol + let hist= "|" ++ brightGreen (leftJustify label longestLabelLength) ++ " | " ++ + leftJustify (show count) (length (show maxValue)) ++ " |" ++ + " " ++ brightBlue bar + return $ hist ++ "\n" ++ border + mapM_ putStrLn (border : body) + putChar '\n' + +numericHistogram :: forall a . (HasCallStack, Columnable a) + => T.Text + -> V.Vector a + -> String +numericHistogram name xs = let + config = defaultConfig { + title = Just (T.unpack name), + width = 30, + height = 10 + } + in createHistogram config (V.toList xs') + where + xs' = case testEquality (typeRep @a) (typeRep @Double) of + Just Refl -> xs + Nothing -> case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> V.map fromIntegral xs + Nothing -> case testEquality (typeRep @a) (typeRep @Integer) of + Just Refl -> V.map fromIntegral xs + Nothing -> V.empty + +smallestPartition :: (Ord a) => a -> [a] -> a +-- TODO: Find a more graceful way to handle this. +smallestPartition p [] = error "Data range too large to plot" +smallestPartition p (x:y:rest) + | p < y = x + | otherwise = smallestPartition p (y:rest) +smallestPartition p (x:rest) + | p < x = x + | otherwise = error "" + +largestPartition :: (Ord a) => a -> [a] -> a +-- TODO: Find a more graceful way to handle this. +largestPartition p [] = error "Data range too large to plot" +largestPartition p (x:rest) + | p < x = x + | otherwise = largestPartition p rest + +intPlotRanges :: [Int] +intPlotRanges = [1, 5, + 10, 50, + 100, 500, + 1_000, 5_000, + 10_000, 50_000, + 100_000, 500_000, + 1_000_000, 5_000_000] + +rotate :: [String] -> [String] +rotate [] = [] +rotate xs + | head xs == "" = [] + | otherwise = map last xs : rotate (map init xs) + + +countOccurrences :: Ord a => V.Vector a -> [(a, Int)] +countOccurrences xs = M.toList $ VG.foldr count initMap xs + where initMap = M.fromList (map (, 0) (V.toList xs)) + count k = M.insertWith (+) k 1 + +data HistogramConfig = HistogramConfig { + width :: Int, -- Width of the histogram in characters + height :: Int, -- Height of the histogram in rows + barChar :: Char, -- Character to use for bars + title :: Maybe String -- Optional title for the histogram +} + +defaultConfig :: HistogramConfig +defaultConfig = HistogramConfig { + width = 40, + height = 15, + barChar = '█', + title = Nothing +} + +-- Calculate the histogram bins and counts +calculateBins :: [Double] -> Int -> [(Double, Int)] +calculateBins values numBins = + let minVal = minimum values + maxVal = maximum values + binWidth = (maxVal - minVal) / fromIntegral numBins + toBin x = floor ((x - minVal) / binWidth) + bins = map toBin values + counts = map length . L.group . L.sort $ bins + binValues = [minVal + (fromIntegral i * binWidth) | i <- [0..numBins-1]] + in zip binValues (counts ++ repeat 0) + +-- Format a number with appropriate scaling (k, M, B, etc.) +formatNumber :: Double -> String +formatNumber n + | n >= 1e9 = printf "%.1fB" (n / 1e9) + | n >= 1e6 = printf "%.1fM" (n / 1e6) + | n >= 1e3 = printf "%.1fk" (n / 1e3) + | otherwise = printf "%.1f" n + +-- Create the ASCII histogram +createHistogram :: HistogramConfig -> [Double] -> String +createHistogram _ [] = [] +createHistogram config values = + let bins = calculateBins values (width config) + maxCount = maximum $ map snd bins + scaleY = fromIntegral maxCount / fromIntegral (height config) + + -- Create Y-axis labels + yLabels = [formatNumber (fromIntegral i * scaleY) | i <- [height config, height config-1..0]] + maxYLabelWidth = maximum $ map length yLabels + + -- Create X-axis labels + xValues = map fst bins + xLabels = map formatNumber [head xValues, last xValues] + + -- Create histogram rows + makeRow :: Int -> String + makeRow row = + let threshold = fromIntegral (height config - row) * scaleY + barLine = map (\(_, count) -> + if fromIntegral count >= threshold + then barChar config + else ' ') bins + in printf "%*s |%s" maxYLabelWidth (yLabels !! row) (brightBlue $ L.foldl' (\acc c -> c:'|':acc) "" barLine) + + -- Build the complete histogram + histogramRows = map makeRow [0..height config - 1] + xAxis = replicate maxYLabelWidth ' ' ++ " " ++ + L.intercalate (replicate (2 * (width config - length xLabels)) ' ') xLabels + + -- Add title if provided + titleLine = case title config of + Just t -> t ++ "\n\n" + Nothing -> "" + + in titleLine ++ unlines (histogramRows ++ [xAxis]) diff --git a/src/DataFrame/Display/Terminal/PrettyPrint.hs b/src/DataFrame/Display/Terminal/PrettyPrint.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Display/Terminal/PrettyPrint.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} +module DataFrame.Display.Terminal.PrettyPrint where + +import qualified Data.Text as T + +import Data.List (transpose) + +-- Utility functions to show a DataFrame as a Markdown-ish table. + +-- Adapted from: https://stackoverflow.com/questions/5929377/format-list-output-in-haskell +-- a type for fill functions +type Filler = Int -> T.Text -> T.Text + +-- a type for describing table columns +data ColDesc t = ColDesc + { colTitleFill :: Filler, + colTitle :: T.Text, + colValueFill :: Filler + } + +-- functions that fill a string (s) to a given width (n) by adding pad +-- character (c) to align left, right, or center +fillLeft :: Char -> Int -> T.Text -> T.Text +fillLeft c n s = s `T.append` T.replicate (n - T.length s) (T.singleton c) + +fillRight :: Char -> Int -> T.Text -> T.Text +fillRight c n s = T.replicate (n - T.length s) (T.singleton c) `T.append` s + +fillCenter :: Char -> Int -> T.Text -> T.Text +fillCenter c n s = T.replicate l (T.singleton c) `T.append` s `T.append` T.replicate r (T.singleton c) + where + x = n - T.length s + l = x `div` 2 + r = x - l + +-- functions that fill with spaces +left :: Int -> T.Text -> T.Text +left = fillLeft ' ' + +right :: Int -> T.Text -> T.Text +right = fillRight ' ' + +center :: Int -> T.Text -> T.Text +center = fillCenter ' ' + +showTable :: [T.Text] -> [T.Text] -> [[T.Text]] -> T.Text +showTable header types rows = + let cs = map (\h -> ColDesc center h left) header + widths = [maximum $ map T.length col | col <- transpose $ header : types : rows] + border = T.intercalate "---" [T.replicate width (T.singleton '-') | width <- widths] + separator = T.intercalate "-|-" [T.replicate width (T.singleton '-') | width <- widths] + fillCols fill cols = T.intercalate " | " [fill c width col | (c, width, col) <- zip3 cs widths cols] + in T.unlines $ border : fillCols colTitleFill header : separator : fillCols colTitleFill types : separator : map (fillCols colValueFill) rows + +showTableProperMarkdown :: [T.Text] -> [T.Text] -> [[T.Text]] -> T.Text +showTableProperMarkdown header types rows = + let headerWithTypes = zipWith (\h t -> h <> "
" <> t) header types + cs = map (\h -> ColDesc center h left) headerWithTypes + widths = [maximum $ map T.length col | col <- transpose $ headerWithTypes : rows] + border = T.intercalate "---" [T.replicate width (T.singleton '-') | width <- widths] + separator = T.intercalate "-|-" [T.replicate width (T.singleton '-') | width <- widths] + fillCols fill cols = T.intercalate " | " [fill c width col | (c, width, col) <- zip3 cs widths cols] + in T.unlines $ border : fillCols colTitleFill headerWithTypes : separator : map (fillCols colValueFill) rows diff --git a/src/DataFrame/Errors.hs b/src/DataFrame/Errors.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Errors.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} + +module DataFrame.Errors where + +import qualified Data.Text as T + +import Control.Exception +import Data.Array +import DataFrame.Display.Terminal.Colours +import Data.Typeable (Typeable) +import Type.Reflection (TypeRep) + +data DataFrameException where + TypeMismatchException :: forall a b. (Typeable a, Typeable b) + => TypeRep a -- ^ given type + -> TypeRep b -- ^ expected type + -> T.Text -- ^ column name + -> T.Text -- ^ call point + -> DataFrameException + TypeMismatchException' :: forall a . (Typeable a) + => TypeRep a -- ^ expected type + -> String -- ^ given type + -> T.Text -- ^ column name + -> T.Text -- ^ call point + -> DataFrameException + ColumnNotFoundException :: T.Text -> T.Text -> [T.Text] -> DataFrameException + deriving (Exception) + +instance Show DataFrameException where + show :: DataFrameException -> String + show (TypeMismatchException a b columnName callPoint) = addCallPointInfo columnName (Just callPoint) (typeMismatchError a b) + show (TypeMismatchException' a b columnName callPoint) = addCallPointInfo columnName (Just callPoint) (typeMismatchError' (show a) b) + show (ColumnNotFoundException columnName callPoint availableColumns) = columnNotFound columnName callPoint availableColumns + +columnNotFound :: T.Text -> T.Text -> [T.Text] -> String +columnNotFound name callPoint columns = + red "\n\n[ERROR] " + ++ "Column not found: " + ++ T.unpack name + ++ " for operation " + ++ T.unpack callPoint + ++ "\n\tDid you mean " + ++ T.unpack (guessColumnName name columns) + ++ "?\n\n" + +typeMismatchError :: + Type.Reflection.TypeRep a -> + Type.Reflection.TypeRep b -> + String +typeMismatchError a b = typeMismatchError' (show a) (show b) + +typeMismatchError' :: String -> String -> String +typeMismatchError' givenType expectedType = + red $ + red "\n\n[Error]: Type Mismatch" + ++ "\n\tWhile running your code I tried to " + ++ "get a column of type: " + ++ red (show givenType) + ++ " but column was of type: " + ++ green (show expectedType) + +addCallPointInfo :: T.Text -> Maybe T.Text -> String -> String +addCallPointInfo name (Just cp) err = + err + ++ ( "\n\tThis happened when calling function " + ++ brightGreen (T.unpack cp) + ++ " on the column " + ++ brightGreen (T.unpack name) + ++ "\n\n" + ++ typeAnnotationSuggestion (T.unpack cp) + ) +addCallPointInfo name Nothing err = + err + ++ ( "\n\tOn the column " + ++ T.unpack name + ++ "\n\n" + ++ typeAnnotationSuggestion "" + ) + +typeAnnotationSuggestion :: String -> String +typeAnnotationSuggestion cp = + "\n\n\tTry adding a type at the end of the function e.g " + ++ "change\n\t\t" + ++ red (cp ++ " arg1 arg2") + ++ " to \n\t\t" + ++ green ("(" ++ cp ++ " arg1 arg2 :: )") + ++ "\n\tor add " + ++ "{-# LANGUAGE TypeApplications #-} to the top of your " + ++ "file then change the call to \n\t\t" + ++ brightGreen (cp ++ " @ arg1 arg2") + +guessColumnName :: T.Text -> [T.Text] -> T.Text +guessColumnName userInput columns = case map (\k -> (editDistance userInput k, k)) columns of + [] -> "" + res -> (snd . minimum) res + +editDistance :: T.Text -> T.Text -> Int +editDistance xs ys = table ! (m, n) + where + (m, n) = (T.length xs, T.length ys) + x = array (1, m) (zip [1 ..] (T.unpack xs)) + y = array (1, n) (zip [1 ..] (T.unpack ys)) + + table :: Array (Int, Int) Int + table = array bnds [(ij, dist ij) | ij <- range bnds] + bnds = ((0, 0), (m, n)) + + dist (0, j) = j + dist (i, 0) = i + dist (i, j) = + minimum + [ table ! (i - 1, j) + 1, + table ! (i, j - 1) + 1, + if x ! i == y ! j then table ! (i - 1, j - 1) else 1 + table ! (i - 1, j - 1) + ] diff --git a/src/DataFrame/IO/CSV.hs b/src/DataFrame/IO/CSV.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/IO/CSV.hs @@ -0,0 +1,295 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Strict #-} +module DataFrame.IO.CSV where + +import qualified Data.ByteString.Char8 as C +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TLIO +import qualified Data.Text.IO as TIO +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Mutable as VM +import qualified Data.Vector.Unboxed.Mutable as VUM + +import Control.Applicative ((<$>), (<|>), (<*>), (<*), (*>), many) +import Control.Monad (forM_, zipWithM_, unless, void) +import Data.Attoparsec.Text +import Data.Char +import DataFrame.Internal.Column (Column(..), freezeColumn', writeColumn, columnLength) +import DataFrame.Internal.DataFrame (DataFrame(..)) +import DataFrame.Internal.Parsing +import DataFrame.Operations.Typing +import Data.Foldable (fold) +import Data.Function (on) +import Data.IORef +import Data.Maybe +import Data.Text.Encoding (decodeUtf8Lenient) +import Data.Type.Equality + ( TestEquality (testEquality), + type (:~:) (Refl) + ) +import GHC.IO.Handle (Handle) +import Prelude hiding (concat, takeWhile) +import System.IO +import Type.Reflection + +-- | Record for CSV read options. +data ReadOptions = ReadOptions { + hasHeader :: Bool, + inferTypes :: Bool, + safeRead :: Bool +} + +-- | By default we assume the file has a header, we infer the types on read +-- and we convert any rows with nullish objects into Maybe (safeRead). +defaultOptions :: ReadOptions +defaultOptions = ReadOptions { hasHeader = True, inferTypes = True, safeRead = True } + +-- | Reads a CSV file from the given path. +-- Note this file stores intermediate temporary files +-- while converting the CSV from a row to a columnar format. +readCsv :: String -> IO DataFrame +readCsv = readSeparated ',' defaultOptions + +-- | Reads a tab separated file from the given path. +-- Note this file stores intermediate temporary files +-- while converting the CSV from a row to a columnar format. +readTsv :: String -> IO DataFrame +readTsv = readSeparated '\t' defaultOptions + +-- | Reads a character separated file into a dataframe using mutable vectors. +readSeparated :: Char -> ReadOptions -> String -> IO DataFrame +readSeparated c opts path = do + totalRows <- countRows c path + withFile path ReadMode $ \handle -> do + firstRow <- map T.strip . parseSep c <$> TIO.hGetLine handle + let columnNames = if hasHeader opts + then map (T.filter (/= '\"')) firstRow + else map (T.singleton . intToDigit) [0..(length firstRow - 1)] + -- If there was no header rewind the file cursor. + unless (hasHeader opts) $ hSeek handle AbsoluteSeek 0 + + -- Initialize mutable vectors for each column + let numColumns = length columnNames + let numRows = if hasHeader opts then totalRows - 1 else totalRows + -- Use this row to infer the types of the rest of the column. + -- TODO: this isn't robust but in so far as this is a guess anyway + -- it's probably fine. But we should probably sample n rows and pick + -- the most likely type from the sample. + dataRow <- map T.strip . parseSep c <$> TIO.hGetLine handle + + -- This array will track the indices of all null values for each column. + -- If any exist then the column will be an optional type. + nullIndices <- VM.unsafeNew numColumns + VM.set nullIndices [] + mutableCols <- VM.unsafeNew numColumns + getInitialDataVectors numRows mutableCols dataRow + + -- Read rows into the mutable vectors + fillColumns numRows c mutableCols nullIndices handle + + -- Freeze the mutable vectors into immutable ones + nulls' <- V.unsafeFreeze nullIndices + cols <- V.mapM (freezeColumn mutableCols nulls' opts) (V.generate numColumns id) + return $ DataFrame { + columns = cols, + freeIndices = [], + columnIndices = M.fromList (zip columnNames [0..]), + dataframeDimensions = (maybe 0 columnLength (cols V.! 0), V.length cols) + } +{-# INLINE readSeparated #-} + +getInitialDataVectors :: Int -> VM.IOVector Column -> [T.Text] -> IO () +getInitialDataVectors n mCol xs = do + forM_ (zip [0..] xs) $ \(i, x) -> do + col <- case inferValueType x of + "Int" -> MutableUnboxedColumn <$> ((VUM.unsafeNew n :: IO (VUM.IOVector Int)) >>= \c -> VUM.unsafeWrite c 0 (fromMaybe 0 $ readInt x) >> return c) + "Double" -> MutableUnboxedColumn <$> ((VUM.unsafeNew n :: IO (VUM.IOVector Double)) >>= \c -> VUM.unsafeWrite c 0 (fromMaybe 0 $ readDouble x) >> return c) + _ -> MutableBoxedColumn <$> ((VM.unsafeNew n :: IO (VM.IOVector T.Text)) >>= \c -> VM.unsafeWrite c 0 x >> return c) + VM.unsafeWrite mCol i col +{-# INLINE getInitialDataVectors #-} + +inferValueType :: T.Text -> T.Text +inferValueType s = let + example = s + in case readInt example of + Just _ -> "Int" + Nothing -> case readDouble example of + Just _ -> "Double" + Nothing -> "Other" +{-# INLINE inferValueType #-} + +-- | Reads rows from the handle and stores values in mutable vectors. +fillColumns :: Int -> Char -> VM.IOVector Column -> VM.IOVector [(Int, T.Text)] -> Handle -> IO () +fillColumns n c mutableCols nullIndices handle = do + input <- newIORef (mempty :: T.Text) + forM_ [1..n] $ \i -> do + isEOF <- hIsEOF handle + input' <- readIORef input + unless (isEOF && input' == mempty) $ do + parseWith (TIO.hGetChunk handle) (parseRow c) input' >>= \case + Fail unconsumed ctx er -> do + erpos <- hTell handle + fail $ "Failed to parse CSV file around " <> show erpos <> " byte; due: " + <> show er <> "; context: " <> show ctx + Partial c -> do + fail "Partial handler is called" + Done (unconsumed :: T.Text) (row :: [T.Text]) -> do + writeIORef input unconsumed + zipWithM_ (writeValue mutableCols nullIndices i) [0..] row +{-# INLINE fillColumns #-} + +-- | Writes a value into the appropriate column, resizing the vector if necessary. +writeValue :: VM.IOVector Column -> VM.IOVector [(Int, T.Text)] -> Int -> Int -> T.Text -> IO () +writeValue mutableCols nullIndices count colIndex value = do + col <- VM.unsafeRead mutableCols colIndex + res <- writeColumn count value col + let modify value = VM.unsafeModify nullIndices ((count, value) :) colIndex + either modify (const (return ())) res +{-# INLINE writeValue #-} + +-- | Freezes a mutable vector into an immutable one, trimming it to the actual row count. +freezeColumn :: VM.IOVector Column -> V.Vector [(Int, T.Text)] -> ReadOptions -> Int -> IO (Maybe Column) +freezeColumn mutableCols nulls opts colIndex = do + col <- VM.unsafeRead mutableCols colIndex + Just <$> freezeColumn' (nulls V.! colIndex) col +{-# INLINE freezeColumn #-} + +parseSep :: Char -> T.Text -> [T.Text] +parseSep c s = either error id (parseOnly (record c) s) +{-# INLINE parseSep #-} + +record :: Char -> Parser [T.Text] +record c = + field c `sepBy1` char c + "record" +{-# INLINE record #-} + +parseRow :: Char -> Parser [T.Text] +parseRow c = (record c <* lineEnd) "record-new-line" + +field :: Char -> Parser T.Text +field c = + quotedField <|> unquotedField c + "field" +{-# INLINE field #-} + +unquotedTerminators :: Char -> S.Set Char +unquotedTerminators sep = S.fromList [sep, '\n', '\r', '"'] + +unquotedField :: Char -> Parser T.Text +unquotedField sep = + takeWhile (not . (`S.member` terminators)) "unquoted field" + where terminators = unquotedTerminators sep +{-# INLINE unquotedField #-} + +quotedField :: Parser T.Text +quotedField = char '"' *> contents <* char '"' "quoted field" + where + contents = fold <$> many (unquote <|> unescape) + where + unquote = takeWhile1 (notInClass "\"\\") + unescape = char '\\' *> do + T.singleton <$> do + char '\\' <|> char '"' +{-# INLINE quotedField #-} + +lineEnd :: Parser () +lineEnd = + (endOfLine <|> endOfInput) + "end of line" +{-# INLINE lineEnd #-} + +-- | First pass to count rows for exact allocation +countRows :: Char -> FilePath -> IO Int +countRows c path = withFile path ReadMode $! go 0 "" + where + go !n !input h = do + isEOF <- hIsEOF h + if isEOF && input == mempty + then pure n + else + parseWith (TIO.hGetChunk h) (parseRow c) input >>= \case + Fail unconsumed ctx er -> do + erpos <- hTell h + fail $ "Failed to parse CSV file around " <> show erpos <> " byte; due: " + <> show er <> "; context: " <> show ctx <> " " <> show unconsumed + Partial c -> do + fail $ "Partial handler is called; n = " <> show n + Done (unconsumed :: T.Text) _ -> + go (n + 1) unconsumed h +{-# INLINE countRows #-} + +writeCsv :: String -> DataFrame -> IO () +writeCsv = writeSeparated ',' + +writeSeparated :: Char -- ^ Separator + -> String -- ^ Path to write to + -> DataFrame + -> IO () +writeSeparated c filepath df = withFile filepath WriteMode $ \handle ->do + let (rows, columns) = dataframeDimensions df + let headers = map fst (L.sortBy (compare `on` snd) (M.toList (columnIndices df))) + TIO.hPutStrLn handle (T.intercalate ", " headers) + forM_ [0..(rows - 1)] $ \i -> do + let row = getRowAsText df i + TIO.hPutStrLn handle (T.intercalate ", " row) + +getRowAsText :: DataFrame -> Int -> [T.Text] +getRowAsText df i = V.ifoldr go [] (columns df) + where + indexMap = M.fromList (map (\(a, b) -> (b, a)) $ M.toList (columnIndices df)) + go k Nothing acc = acc + go k (Just (BoxedColumn (c :: V.Vector a))) acc = case c V.!? i of + Just e -> textRep : acc + where textRep = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> e + Nothing -> case typeRep @a of + App t1 t2 -> case eqTypeRep t1 (typeRep @Maybe) of + Just HRefl -> case testEquality t2 (typeRep @T.Text) of + Just Refl -> fromMaybe "null" e + Nothing -> (fromOptional . (T.pack . show)) e + where fromOptional s + | T.isPrefixOf "Just " s = T.drop (T.length "Just ") s + | otherwise = "null" + Nothing -> (T.pack . show) e + _ -> (T.pack . show) e + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i + go k (Just (UnboxedColumn c)) acc = case c VU.!? i of + Just e -> T.pack (show e) : acc + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i + go k (Just (OptionalColumn (c :: V.Vector (Maybe a)))) acc = case c V.!? i of + Just e -> textRep : acc + where textRep = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> fromMaybe "Nothing" e + Nothing -> (T.pack . show) e + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i diff --git a/src/DataFrame/Internal/Column.hs b/src/DataFrame/Internal/Column.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Column.hs @@ -0,0 +1,492 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module DataFrame.Internal.Column where + +import qualified Data.ByteString.Char8 as C +import qualified Data.List as L +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector.Algorithms.Merge as VA +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as VB +import qualified Data.Vector.Mutable as VBM +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Unboxed.Mutable as VUM + +import Control.Monad.ST (runST) +import DataFrame.Internal.Function +import DataFrame.Internal.Types +import DataFrame.Internal.Parsing +import Data.Int +import Data.Maybe +import Data.Text.Encoding (decodeUtf8Lenient) +import Data.Type.Equality (type (:~:)(Refl), TestEquality (..)) +import Data.Typeable (Typeable) +import Data.Word +import Type.Reflection +import Unsafe.Coerce (unsafeCoerce) +import DataFrame.Errors +import Control.Exception (throw) + +-- | Our representation of a column is a GADT that can store data in either +-- a vector with boxed elements or +data Column where + BoxedColumn :: Columnable a => VB.Vector a -> Column + UnboxedColumn :: (Columnable a, VU.Unbox a) => VU.Vector a -> Column + OptionalColumn :: Columnable a => VB.Vector (Maybe a) -> Column + GroupedBoxedColumn :: Columnable a => VB.Vector (VB.Vector a) -> Column + GroupedUnboxedColumn :: (Columnable a, VU.Unbox a) => VB.Vector (VU.Vector a) -> Column + GroupedOptionalColumn :: (Columnable a) => VB.Vector (VB.Vector (Maybe a)) -> Column + MutableBoxedColumn :: Columnable a => VBM.IOVector a -> Column + MutableUnboxedColumn :: (Columnable a, VU.Unbox a) => VUM.IOVector a -> Column + +-- Functions about column metadata. +isGrouped :: Column -> Bool +isGrouped (GroupedBoxedColumn column) = True +isGrouped (GroupedUnboxedColumn column) = True +isGrouped _ = False + +columnVersionString :: Column -> String +columnVersionString column = case column of + BoxedColumn _ -> "Boxed" + UnboxedColumn _ -> "Unboxed" + OptionalColumn _ -> "Optional" + GroupedBoxedColumn _ -> "Grouped Boxed" + GroupedUnboxedColumn _ -> "Grouped Unboxed" + GroupedOptionalColumn _ -> "Grouped Optional" + +columnTypeString :: Column -> String +columnTypeString column = case column of + BoxedColumn (column :: VB.Vector a) -> show (typeRep @a) + UnboxedColumn (column :: VU.Vector a) -> show (typeRep @a) + OptionalColumn (column :: VB.Vector a) -> show (typeRep @a) + GroupedBoxedColumn (column :: VB.Vector a) -> show (typeRep @a) + GroupedUnboxedColumn (column :: VB.Vector a) -> show (typeRep @a) + GroupedOptionalColumn (column :: VB.Vector a) -> show (typeRep @a) + +instance Show Column where + show :: Column -> String + show (BoxedColumn column) = show column + show (UnboxedColumn column) = show column + show (OptionalColumn column) = show column + show (GroupedBoxedColumn column) = show column + show (GroupedUnboxedColumn column) = show column + +instance Eq Column where + (==) :: Column -> Column -> Bool + (==) (BoxedColumn (a :: VB.Vector t1)) (BoxedColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> a == b + (==) (OptionalColumn (a :: VB.Vector t1)) (OptionalColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> a == b + (==) (UnboxedColumn (a :: VU.Vector t1)) (UnboxedColumn (b :: VU.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> a == b + -- Note: comparing grouped columns is expensive. We do this for stable tests + -- but also you should probably aggregate grouped columns soon after creating them. + (==) (GroupedBoxedColumn (a :: VB.Vector t1)) (GroupedBoxedColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> VB.map (L.sort . VG.toList) a == VB.map (L.sort . VG.toList) b + (==) (GroupedUnboxedColumn (a :: VB.Vector t1)) (GroupedUnboxedColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> VB.map (L.sort . VG.toList) a == VB.map (L.sort . VG.toList) b + (==) (GroupedOptionalColumn (a :: VB.Vector t1)) (GroupedOptionalColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> VB.map (L.sort . VG.toList) a == VB.map (L.sort . VG.toList) b + (==) _ _ = False + +class (Columnable a) => Columnify a where + -- | Converts a boxed vector to a column making sure to put + -- the vector into an appropriate column type by reflection on the + -- vector's type parameter. + toColumn' :: VB.Vector a -> Column + +instance (Columnable a) => Columnify (Maybe a) where + toColumn' = OptionalColumn + +instance (Columnable a) => Columnify (VB.Vector a) where + toColumn' = GroupedBoxedColumn + +instance (Columnable a, VU.Unbox a) => Columnify (VU.Vector a) where + toColumn' = GroupedUnboxedColumn + +instance {-# INCOHERENT #-} (Columnable a) => Columnify a where + toColumn' xs = case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> UnboxedColumn (VU.convert xs) + Nothing -> case testEquality (typeRep @a) (typeRep @Double) of + Just Refl -> UnboxedColumn (VU.convert xs) + Nothing -> case testEquality (typeRep @a) (typeRep @Float) of + Just Refl -> UnboxedColumn (VU.convert xs) + Nothing -> BoxedColumn xs + +class (Columnable a) => ColumnifyList a where + -- | Converts a boxed vector to a column making sure to put + -- the vector into an appropriate column type by reflection on the + -- vector's type parameter. + toColumn :: [a] -> Column + +instance (Columnable a) => ColumnifyList (Maybe a) where + toColumn = OptionalColumn . VB.fromList + +instance {-# INCOHERENT #-} (Columnable a) => ColumnifyList a where + toColumn xs = case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> UnboxedColumn (VU.fromList xs) + Nothing -> case testEquality (typeRep @a) (typeRep @Double) of + Just Refl -> UnboxedColumn (VU.fromList xs) + Nothing -> case testEquality (typeRep @a) (typeRep @Float) of + Just Refl -> UnboxedColumn (VU.fromList xs) + Nothing -> BoxedColumn (VB.fromList xs) + +-- | Converts a an unboxed vector to a column making sure to put +-- the vector into an appropriate column type by reflection on the +-- vector's type parameter. +toColumnUnboxed :: forall a. (Columnable a, VU.Unbox a) => VU.Vector a -> Column +toColumnUnboxed = UnboxedColumn + +-- Functions that don't depend on column type. +-- | O(1) Gets the number of elements in the column. +columnLength :: Column -> Int +columnLength (BoxedColumn xs) = VG.length xs +columnLength (UnboxedColumn xs) = VG.length xs +columnLength (OptionalColumn xs) = VG.length xs +columnLength (GroupedBoxedColumn xs) = VG.length xs +columnLength (GroupedUnboxedColumn xs) = VG.length xs +columnLength (GroupedOptionalColumn xs) = VG.length xs +{-# INLINE columnLength #-} + +takeColumn :: Int -> Column -> Column +takeColumn n (BoxedColumn xs) = BoxedColumn $ VG.take n xs +takeColumn n (UnboxedColumn xs) = UnboxedColumn $ VG.take n xs +takeColumn n (OptionalColumn xs) = OptionalColumn $ VG.take n xs +takeColumn n (GroupedBoxedColumn xs) = GroupedBoxedColumn $ VG.take n xs +takeColumn n (GroupedUnboxedColumn xs) = GroupedUnboxedColumn $ VG.take n xs +takeColumn n (GroupedOptionalColumn xs) = GroupedOptionalColumn $ VG.take n xs +{-# INLINE takeColumn #-} + +-- TODO: Maybe we can remvoe all this boilerplate and make +-- transform take in a generic vector function. +takeLastColumn :: Int -> Column -> Column +takeLastColumn n column = sliceColumn (columnLength column - n) n column +{-# INLINE takeLastColumn #-} + +sliceColumn :: Int -> Int -> Column -> Column +sliceColumn start n (BoxedColumn xs) = BoxedColumn $ VG.slice start n xs +sliceColumn start n (UnboxedColumn xs) = UnboxedColumn $ VG.slice start n xs +sliceColumn start n (OptionalColumn xs) = OptionalColumn $ VG.slice start n xs +sliceColumn start n (GroupedBoxedColumn xs) = GroupedBoxedColumn $ VG.slice start n xs +sliceColumn start n (GroupedUnboxedColumn xs) = GroupedUnboxedColumn $ VG.slice start n xs +sliceColumn start n (GroupedOptionalColumn xs) = GroupedOptionalColumn $ VG.slice start n xs +{-# INLINE sliceColumn #-} + +-- TODO: We can probably generalize this to `applyVectorFunction`. +atIndices :: S.Set Int -> Column -> Column +atIndices indexes (BoxedColumn column) = BoxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (OptionalColumn column) = OptionalColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (UnboxedColumn column) = UnboxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (GroupedBoxedColumn column) = GroupedBoxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (GroupedUnboxedColumn column) = GroupedUnboxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (GroupedOptionalColumn column) = GroupedOptionalColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +{-# INLINE atIndices #-} + +atIndicesStable :: VU.Vector Int -> Column -> Column +atIndicesStable indexes (BoxedColumn column) = BoxedColumn $ indexes `getIndices` column +atIndicesStable indexes (UnboxedColumn column) = UnboxedColumn $ indexes `getIndicesUnboxed` column +atIndicesStable indexes (OptionalColumn column) = OptionalColumn $ indexes `getIndices` column +atIndicesStable indexes (GroupedBoxedColumn column) = GroupedBoxedColumn $ indexes `getIndices` column +atIndicesStable indexes (GroupedUnboxedColumn column) = GroupedUnboxedColumn $ indexes `getIndices` column +atIndicesStable indexes (GroupedOptionalColumn column) = GroupedOptionalColumn $ indexes `getIndices` column +{-# INLINE atIndicesStable #-} + +getIndices :: VU.Vector Int -> VB.Vector a -> VB.Vector a +getIndices indices xs = VB.generate (VU.length indices) (\i -> xs VB.! (indices VU.! i)) +{-# INLINE getIndices #-} + +getIndicesUnboxed :: (VU.Unbox a) => VU.Vector Int -> VU.Vector a -> VU.Vector a +getIndicesUnboxed indices xs = VU.generate (VU.length indices) (\i -> xs VU.! (indices VU.! i)) +{-# INLINE getIndicesUnboxed #-} + +sortedIndexes :: Bool -> Column -> VU.Vector Int +sortedIndexes asc (BoxedColumn column ) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (UnboxedColumn column) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (OptionalColumn column ) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (GroupedBoxedColumn column) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (GroupedUnboxedColumn column) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (GroupedOptionalColumn column) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +{-# INLINE sortedIndexes #-} + +-- Operations on a column that may change its type. + +instance Transformable Column where + transform :: forall b c . (Columnable b, Columnable c) => (b -> c) -> Column -> Maybe Column + transform f (BoxedColumn (column :: VB.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return (toColumn' (VB.map f column)) + transform f (OptionalColumn (column :: VB.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return (toColumn' (VB.map f column)) + transform f (UnboxedColumn (column :: VU.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ if testUnboxable (typeRep @c) then transformUnboxed f column else toColumn' (VB.map f (VB.convert column)) + transform f (GroupedBoxedColumn (column :: VB.Vector (VB.Vector a))) = do + Refl <- testEquality (typeRep @(VB.Vector a)) (typeRep @b) + return (toColumn' (VB.map f column)) + transform f (GroupedUnboxedColumn (column :: VB.Vector (VU.Vector a))) = do + Refl <- testEquality (typeRep @(VU.Vector a)) (typeRep @b) + return (toColumn' (VB.map f column)) + transform f (GroupedOptionalColumn (column :: VB.Vector (VB.Vector a))) = do + Refl <- testEquality (typeRep @(VB.Vector a)) (typeRep @b) + return (toColumn' (VB.map f column)) + +-- | Applies a function that returns an unboxed result to an unboxed vector, storing the result in a column. +transformUnboxed :: forall a b . (Columnable a, VU.Unbox a, Columnable b) => (a -> b) -> VU.Vector a -> Column +transformUnboxed f = itransformUnboxed (const f) + +-- TODO: Make a type class with incoherent instances. +itransformUnboxed :: forall a b . (Columnable a, VU.Unbox a, Columnable b) => (Int -> a -> b) -> VU.Vector a -> Column +itransformUnboxed f column = case testEquality (typeRep @b) (typeRep @Int) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Int8) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Int16) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Int32) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Int64) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Word8) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing-> case testEquality (typeRep @b) (typeRep @Word16) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Word32) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Word64) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Char) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Bool) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Float) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Double) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Word) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> error "Result type is unboxed" -- since we only call this after confirming + +-- | tranform with index. +itransform :: forall b c. (Columnable b, Columnable c) => (Int -> b -> c) -> Column -> Maybe Column +itransform f (BoxedColumn (column :: VB.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return (toColumn' (VB.imap f column)) +itransform f (UnboxedColumn (column :: VU.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ if testUnboxable (typeRep @c) then itransformUnboxed f column else toColumn' (VB.imap f (VB.convert column)) +itransform f (GroupedBoxedColumn (column :: VB.Vector (VB.Vector a))) = do + Refl <- testEquality (typeRep @(VB.Vector a)) (typeRep @b) + return (toColumn' (VB.imap f column)) +itransform f (GroupedUnboxedColumn (column :: VB.Vector (VU.Vector a))) = do + Refl <- testEquality (typeRep @(VU.Vector a)) (typeRep @b) + return (toColumn' (VB.imap f column)) + +-- | Filter column with index. +ifilterColumn :: forall a . (Columnable a) => (Int -> a -> Bool) -> Column -> Maybe Column +ifilterColumn f c@(BoxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ BoxedColumn $ VG.ifilter f column +ifilterColumn f c@(UnboxedColumn (column :: VU.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ UnboxedColumn $ VG.ifilter f column +ifilterColumn f c@(GroupedBoxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ GroupedBoxedColumn $ VG.ifilter f column +ifilterColumn f c@(GroupedUnboxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ GroupedUnboxedColumn $ VG.ifilter f column + +-- TODO: Expand this to use more predicates. +ifilterColumnF :: Function -> Column -> Maybe Column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(BoxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ BoxedColumn $ VG.ifilter f column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(UnboxedColumn (column :: VU.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ UnboxedColumn $ VG.ifilter f column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(OptionalColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ OptionalColumn $ VG.ifilter f column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(GroupedBoxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ GroupedBoxedColumn $ VG.ifilter f column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(GroupedUnboxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ GroupedUnboxedColumn $ VG.ifilter f column + +ifoldrColumn :: forall a b. (Columnable a, Columnable b) => (Int -> a -> b -> b) -> b -> Column -> Maybe b +ifoldrColumn f acc c@(BoxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column +ifoldrColumn f acc c@(OptionalColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column +ifoldrColumn f acc c@(UnboxedColumn (column :: VU.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column +ifoldrColumn f acc c@(GroupedBoxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column +ifoldrColumn f acc c@(GroupedUnboxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column + +ifoldlColumn :: forall a b . (Columnable a, Columnable b) => (b -> Int -> a -> b) -> b -> Column -> Maybe b +ifoldlColumn f acc c@(BoxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column +ifoldlColumn f acc c@(OptionalColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column +ifoldlColumn f acc c@(UnboxedColumn (column :: VU.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column +ifoldlColumn f acc c@(GroupedBoxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column +ifoldlColumn f acc c@(GroupedUnboxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column + +reduceColumn :: forall a b. Columnable a => (a -> b) -> Column -> b +{-# SPECIALIZE reduceColumn :: + (VU.Vector (Double, Double) -> Double) -> Column -> Double, + (VU.Vector Double -> Double) -> Column -> Double #-} +reduceColumn f (BoxedColumn (column :: c)) = case testEquality (typeRep @c) (typeRep @a) of + Just Refl -> f column + Nothing -> error $ "Can't reduce. Incompatible types: " ++ show (typeRep @a) ++ " " ++ show (typeRep @a) +reduceColumn f (UnboxedColumn (column :: c)) = case testEquality (typeRep @c) (typeRep @a) of + Just Refl -> f column + Nothing -> error $ "Can't reduce. Incompatible types: " ++ show (typeRep @a) ++ " " ++ show (typeRep @a) +reduceColumn f (OptionalColumn (column :: c)) = case testEquality (typeRep @c) (typeRep @a) of + Just Refl -> f column + Nothing -> error $ "Can't reduce. Incompatible types: " ++ show (typeRep @a) ++ " " ++ show (typeRep @a) +{-# INLINE reduceColumn #-} + +safeReduceColumn :: forall a b. (Typeable a) => (a -> b) -> Column -> Maybe b +safeReduceColumn f (BoxedColumn (column :: c)) = do + Refl <- testEquality (typeRep @c) (typeRep @a) + return $! f column +safeReduceColumn f (UnboxedColumn (column :: c)) = do + Refl <- testEquality (typeRep @c) (typeRep @a) + return $! f column +safeReduceColumn f (OptionalColumn (column :: c)) = do + Refl <- testEquality (typeRep @c) (typeRep @a) + return $! f column +{-# INLINE safeReduceColumn #-} + +zipColumns :: Column -> Column -> Column +zipColumns (BoxedColumn column) (BoxedColumn other) = BoxedColumn (VG.zip column other) +zipColumns (BoxedColumn column) (UnboxedColumn other) = BoxedColumn (VB.generate (min (VG.length column) (VG.length other)) (\i -> (column VG.! i, other VG.! i))) +zipColumns (UnboxedColumn column) (BoxedColumn other) = BoxedColumn (VB.generate (min (VG.length column) (VG.length other)) (\i -> (column VG.! i, other VG.! i))) +zipColumns (UnboxedColumn column) (UnboxedColumn other) = UnboxedColumn (VG.zip column other) +{-# INLINE zipColumns #-} + +-- Functions for mutable columns (intended for IO). +-- Clean this up. +writeColumn :: Int -> T.Text -> Column -> IO (Either T.Text Bool) +writeColumn i value (MutableBoxedColumn (col :: VBM.IOVector a)) = let + in case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> (if isNullish value + then VBM.unsafeWrite col i "" >> return (Left $! value) + else VBM.unsafeWrite col i value >> return (Right True)) + Nothing -> return (Left value) +writeColumn i value (MutableUnboxedColumn (col :: VUM.IOVector a)) = + case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> case readInt value of + Just v -> VUM.unsafeWrite col i v >> return (Right True) + Nothing -> VUM.unsafeWrite col i 0 >> return (Left value) + Nothing -> case testEquality (typeRep @a) (typeRep @Double) of + Nothing -> return (Left $! value) + Just Refl -> case readDouble value of + Just v -> VUM.unsafeWrite col i v >> return (Right True) + Nothing -> VUM.unsafeWrite col i 0 >> return (Left $! value) +{-# INLINE writeColumn #-} + +freezeColumn' :: [(Int, T.Text)] -> Column -> IO Column +freezeColumn' nulls (MutableBoxedColumn col) + | null nulls = BoxedColumn <$> VB.unsafeFreeze col + | all (isNullish . snd) nulls = OptionalColumn . VB.imap (\i v -> if i `elem` map fst nulls then Nothing else Just v) <$> VB.unsafeFreeze col + | otherwise = BoxedColumn . VB.imap (\i v -> if i `elem` map fst nulls then Left (fromMaybe (error "") (lookup i nulls)) else Right v) <$> VB.unsafeFreeze col +freezeColumn' nulls (MutableUnboxedColumn col) + | null nulls = UnboxedColumn <$> VU.unsafeFreeze col + | all (isNullish . snd) nulls = VU.unsafeFreeze col >>= \c -> return $ OptionalColumn $ VB.generate (VU.length c) (\i -> if i `elem` map fst nulls then Nothing else Just (c VU.! i)) + | otherwise = VU.unsafeFreeze col >>= \c -> return $ BoxedColumn $ VB.generate (VU.length c) (\i -> if i `elem` map fst nulls then Left (fromMaybe (error "") (lookup i nulls)) else Right (c VU.! i)) +{-# INLINE freezeColumn' #-} + +expandColumn :: Int -> Column -> Column +expandColumn n (OptionalColumn col) = OptionalColumn $ col <> VB.replicate n Nothing +expandColumn n (BoxedColumn col) = OptionalColumn $ VB.map Just col <> VB.replicate n Nothing +expandColumn n (UnboxedColumn col) = OptionalColumn $ VB.map Just (VU.convert col) <> VB.replicate n Nothing +expandColumn n (GroupedBoxedColumn col) = GroupedBoxedColumn $ col <> VB.replicate n VB.empty +expandColumn n (GroupedUnboxedColumn col) = GroupedUnboxedColumn $ col <> VB.replicate n VU.empty + +toVector :: forall a . Columnable a => Column -> VB.Vector a +toVector column@(OptionalColumn (col :: VB.Vector b)) = + case testEquality (typeRep @a) (typeRep @b) of + Just Refl -> col + Nothing -> throw $ TypeMismatchException' (typeRep @b) (show $ typeRep @a) "" "toVector" +toVector (BoxedColumn (col :: VB.Vector b)) = + case testEquality (typeRep @a) (typeRep @b) of + Just Refl -> col + Nothing -> throw $ TypeMismatchException' (typeRep @b) (show $ typeRep @a) "" "toVector" +toVector (UnboxedColumn (col :: VU.Vector b)) = + case testEquality (typeRep @a) (typeRep @b) of + Just Refl -> VB.convert col + Nothing -> throw $ TypeMismatchException' (typeRep @b) (show $ typeRep @a) "" "toVector" +toVector (GroupedBoxedColumn (col :: VB.Vector b)) = + case testEquality (typeRep @a) (typeRep @b) of + Just Refl -> col + Nothing -> throw $ TypeMismatchException' (typeRep @b) (show $ typeRep @a) "" "toVector" +toVector (GroupedUnboxedColumn (col :: VB.Vector b)) = + case testEquality (typeRep @a) (typeRep @b) of + Just Refl -> col + Nothing -> throw $ TypeMismatchException' (typeRep @b) (show $ typeRep @a) "" "toVector" diff --git a/src/DataFrame/Internal/DataFrame.hs b/src/DataFrame/Internal/DataFrame.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/DataFrame.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StrictData #-} +module DataFrame.Internal.DataFrame where + +import qualified Data.Map as M +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Control.Monad (join) +import DataFrame.Display.Terminal.PrettyPrint +import DataFrame.Internal.Column +import Data.Function (on) +import Data.List (sortBy, transpose) +import Data.Maybe (isJust) +import Data.Type.Equality (type (:~:)(Refl), TestEquality (testEquality)) +import Type.Reflection (typeRep) + +data DataFrame = DataFrame + { -- | Our main data structure stores a dataframe as + -- a vector of columns. This improv + columns :: V.Vector (Maybe Column), + -- | Keeps the column names in the order they were inserted in. + columnIndices :: M.Map T.Text Int, + -- | Next free index that we insert a column into. + freeIndices :: [Int], + dataframeDimensions :: (Int, Int) + } + +instance Eq DataFrame where + (==) :: DataFrame -> DataFrame -> Bool + a == b = map fst (M.toList $ columnIndices a) == map fst (M.toList $ columnIndices b) && + foldr (\(name, index) acc -> acc && (columns a V.!? index == (columns b V.!? (columnIndices b M.! name)))) True (M.toList $ columnIndices a) + +instance Show DataFrame where + show :: DataFrame -> String + show d = T.unpack (asText d False) + +asText :: DataFrame -> Bool -> T.Text +asText d properMarkdown = + let header = "index" : map fst (sortBy (compare `on` snd) $ M.toList (columnIndices d)) + types = V.toList $ V.filter (/= "") $ V.map getType (columns d) + getType Nothing = "" + getType (Just (BoxedColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) + getType (Just (UnboxedColumn (column :: VU.Vector a))) = T.pack $ show (typeRep @a) + getType (Just (OptionalColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) + getType (Just (GroupedBoxedColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) + getType (Just (GroupedUnboxedColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) + -- Separate out cases dynamically so we don't end up making round trip string + -- copies. + get (Just (BoxedColumn (column :: V.Vector a))) = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> column + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> V.map T.pack column + Nothing -> V.map (T.pack . show) column + get (Just (UnboxedColumn column)) = V.map (T.pack . show) (V.convert column) + get (Just (OptionalColumn column)) = V.map (T.pack . show) column + get (Just (GroupedBoxedColumn column)) = V.map (T.pack . show) column + get (Just (GroupedUnboxedColumn column)) = V.map (T.pack . show) column + getTextColumnFromFrame df (i, name) = if i == 0 + then V.fromList (map (T.pack . show) [0..(fst (dataframeDimensions df) - 1)]) + else get $ (V.!) (columns d) ((M.!) (columnIndices d) name) + rows = + transpose $ + zipWith (curry (V.toList . getTextColumnFromFrame d)) [0..] header + in (if properMarkdown then showTableProperMarkdown else showTable) header ("Int":types) rows + +-- | O(1) Creates an empty dataframe +empty :: DataFrame +empty = DataFrame {columns = V.replicate initialColumnSize Nothing, + columnIndices = M.empty, + freeIndices = [0..(initialColumnSize - 1)], + dataframeDimensions = (0, 0) } + +initialColumnSize :: Int +initialColumnSize = 8 + +getColumn :: T.Text -> DataFrame -> Maybe Column +getColumn name df = do + i <- columnIndices df M.!? name + join $ columns df V.!? i + +null :: DataFrame -> Bool +null df = dataframeDimensions df == (0, 0) + +metadata :: DataFrame -> String +metadata df = show (columnIndices df) ++ "\n" ++ + show (V.map (fmap columnVersionString) (columns df)) ++ "\n" ++ + show (freeIndices df) ++ "\n" ++ + show (dataframeDimensions df) diff --git a/src/DataFrame/Internal/Function.hs b/src/DataFrame/Internal/Function.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Function.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE PatternSynonyms #-} + +module DataFrame.Internal.Function where + +import qualified Data.Text as T +import qualified Data.Vector as V + +import DataFrame.Internal.Types +import Data.Typeable ( Typeable, type (:~:)(Refl) ) +import Data.Type.Equality (TestEquality(testEquality)) +import Type.Reflection (typeRep, typeOf) + +-- A GADT to wrap functions so we can have hetegeneous lists of functions. +data Function where + F1 :: forall a b . (Columnable a, Columnable b) => (a -> b) -> Function + F2 :: forall a b c . (Columnable a, Columnable b, Columnable c) => (a -> b -> c) -> Function + F3 :: forall a b c d . (Columnable a, Columnable b, Columnable c, Columnable d) => (a -> b -> c -> d) -> Function + F4 :: forall a b c d e . (Columnable a, Columnable b, Columnable c, Columnable d, Columnable e) => (a -> b -> c -> d -> e) -> Function + Cond :: forall a . (Columnable a) => (a -> Bool) -> Function + ICond :: forall a . (Columnable a) => (Int -> a -> Bool) -> Function + +-- Helper class to do the actual wrapping +class WrapFunction a where + wrapFunction :: a -> Function + +-- Instance for 1-argument functions +instance (Columnable a, Columnable b) => WrapFunction (a -> b) where + wrapFunction :: (Columnable a, Columnable b) => (a -> b) -> Function + wrapFunction = F1 + +-- Instance for 2-argument functions +instance {-# INCOHERENT #-} (Columnable a, Columnable b, Columnable c) => WrapFunction (a -> b -> c) where + wrapFunction :: (Columnable a, Columnable b, Columnable c) => (a -> b -> c) -> Function + wrapFunction = F2 + +-- Instance for 3-argument functions +instance {-# INCOHERENT #-} (Columnable a, Columnable b, Columnable c, Columnable d) => WrapFunction (a -> b -> c -> d) where + wrapFunction :: (Columnable a, Columnable b, Columnable c, Columnable d) => (a -> b -> c -> d) -> Function + wrapFunction = F3 + +instance {-# INCOHERENT #-} (Columnable a, Columnable b, Columnable c, Columnable d, Columnable e) => WrapFunction (a -> b -> c -> d -> e) where + wrapFunction :: (Columnable a, Columnable b, Columnable c, Columnable d, Columnable e) => (a -> b -> c -> d -> e) -> Function + wrapFunction = F4 + +-- The main function that wraps arbitrary functions +func :: forall fn . WrapFunction fn => fn -> Function +func = wrapFunction + +pattern Empty :: V.Vector a +pattern Empty <- (V.null -> True) where Empty = V.empty + +uncons :: V.Vector a -> Maybe (a, V.Vector a) +uncons Empty = Nothing +uncons v = Just (V.unsafeHead v, V.unsafeTail v) + +pattern (:<|) :: a -> V.Vector a -> V.Vector a +pattern x :<| xs <- (uncons -> Just (x, xs)) + +funcApply :: forall c . (Columnable c) => V.Vector RowValue -> Function -> c +funcApply Empty _ = error "Empty args" +funcApply (Value (x :: a') :<| Empty) (F1 (f :: (a -> b))) = case testEquality (typeRep @a') (typeRep @a) of + Just Refl -> case testEquality (typeOf (f x)) (typeRep @c) of + Just Refl -> f x + Nothing -> error "Result type mismatch" + Nothing -> error "Arg type mismatch" +funcApply (Value (x :: a') :<| xs) (F2 (f :: (a -> b))) = case testEquality (typeOf x) (typeRep @a) of + Just Refl -> funcApply xs (F1 (f x)) + Nothing -> error "Arg type mismatch" +funcApply (Value (x :: a') :<| xs) (F3 (f :: (a -> b))) = case testEquality (typeOf x) (typeRep @a) of + Just Refl -> funcApply xs (F2 (f x)) + Nothing -> error "Arg type mismatch" +funcApply (Value (x :: a') :<| xs) (F4 (f :: (a -> b))) = case testEquality (typeOf x) (typeRep @a) of + Just Refl -> funcApply xs (F3 (f x)) + Nothing -> error "Arg type mismatch" diff --git a/src/DataFrame/Internal/Parsing.hs b/src/DataFrame/Internal/Parsing.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Parsing.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +module DataFrame.Internal.Parsing where + +import qualified Data.ByteString.Char8 as C +import qualified Data.Set as S +import qualified Data.Text as T + +import Data.Text.Read +import Data.Maybe (fromMaybe) +import GHC.Stack (HasCallStack) +import Text.Read (readMaybe) + +isNullish :: T.Text -> Bool +isNullish s = s `S.member` S.fromList ["Nothing", "NULL", "", " ", "nan"] + +readValue :: (HasCallStack, Read a) => T.Text -> a +readValue s = case readMaybe (T.unpack s) of + Nothing -> error $ "Could not read value: " ++ T.unpack s + Just value -> value + +readInteger :: (HasCallStack) => T.Text -> Maybe Integer +readInteger s = case signed decimal (T.strip s) of + Left _ -> Nothing + Right (value, "") -> Just value + Right (value, _) -> Nothing + +readInt :: (HasCallStack) => T.Text -> Maybe Int +readInt s = case signed decimal (T.strip s) of + Left _ -> Nothing + Right (value, "") -> Just value + Right (value, _) -> Nothing +{-# INLINE readInt #-} + +readByteStringInt :: (HasCallStack) => C.ByteString -> Maybe Int +readByteStringInt s = case C.readInt (C.strip s) of + Nothing -> Nothing + Just (value, "") -> Just value + Just (value, _) -> Nothing +{-# INLINE readByteStringInt #-} + +readDouble :: (HasCallStack) => T.Text -> Maybe Double +readDouble s = + case signed double s of + Left _ -> Nothing + Right (value, "") -> Just value + Right (value, _) -> Nothing +{-# INLINE readDouble #-} + +readIntegerEither :: (HasCallStack) => T.Text -> Either T.Text Integer +readIntegerEither s = case signed decimal (T.strip s) of + Left _ -> Left s + Right (value, "") -> Right value + Right (value, _) -> Left s +{-# INLINE readIntegerEither #-} + +readIntEither :: (HasCallStack) => T.Text -> Either T.Text Int +readIntEither s = case signed decimal (T.strip s) of + Left _ -> Left s + Right (value, "") -> Right value + Right (value, _) -> Left s +{-# INLINE readIntEither #-} + +readDoubleEither :: (HasCallStack) => T.Text -> Either T.Text Double +readDoubleEither s = + case signed double s of + Left _ -> Left s + Right (value, "") -> Right value + Right (value, _) -> Left s +{-# INLINE readDoubleEither #-} + +safeReadValue :: (Read a) => T.Text -> Maybe a +safeReadValue s = readMaybe (T.unpack s) + +readWithDefault :: (HasCallStack, Read a) => a -> T.Text -> a +readWithDefault v s = fromMaybe v (readMaybe (T.unpack s)) diff --git a/src/DataFrame/Internal/Row.hs b/src/DataFrame/Internal/Row.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Row.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} +module DataFrame.Internal.Row where + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Algorithms.Merge as VA + +import Control.Exception (throw) +import Control.Monad.ST (runST) +import DataFrame.Errors (DataFrameException(..)) +import DataFrame.Internal.Column +import DataFrame.Internal.DataFrame +import DataFrame.Internal.Types +import Data.Function (on) + +type Row = V.Vector RowValue + +toRowList :: [T.Text] -> DataFrame -> [Row] +toRowList names df = let + nameSet = S.fromList names + in map (mkRowRep df nameSet) [0..(fst (dataframeDimensions df) - 1)] + +toRowVector :: [T.Text] -> DataFrame -> V.Vector Row +toRowVector names df = let + nameSet = S.fromList names + in V.generate (fst (dataframeDimensions df)) (mkRowRep df nameSet) + +mkRowFromArgs :: [T.Text] -> DataFrame -> Int -> Row +mkRowFromArgs names df i = V.map get (V.fromList names) + where + get name = case getColumn name df of + Nothing -> throw $ ColumnNotFoundException name "[INTERNAL] mkRowFromArgs" (map fst $ M.toList $ columnIndices df) + Just (BoxedColumn column) -> toRowValue (column V.! i) + Just (UnboxedColumn column) -> toRowValue (column VU.! i) + Just (OptionalColumn column) -> toRowValue (column V.! i) + +mkRowRep :: DataFrame -> S.Set T.Text -> Int -> Row +mkRowRep df names i = V.generate (S.size names) (\index -> get (names' V.! index)) + where + inOrderIndexes = map fst $ L.sortBy (compare `on` snd) $ M.toList (columnIndices df) + names' = V.fromList [n | n <- inOrderIndexes, S.member n names] + throwError name = error $ "Column " + ++ T.unpack name + ++ " has less items than " + ++ "the other columns at index " + ++ show i + get name = case getColumn name df of + Just (BoxedColumn c) -> case c V.!? i of + Just e -> toRowValue e + Nothing -> throwError name + Just (OptionalColumn c) -> case c V.!? i of + Just e -> toRowValue e + Nothing -> throwError name + Just (UnboxedColumn c) -> case c VU.!? i of + Just e -> toRowValue e + Nothing -> throwError name + Just (GroupedBoxedColumn c) -> case c V.!? i of + Just e -> toRowValue e + Nothing -> throwError name + Just (GroupedUnboxedColumn c) -> case c V.!? i of + Just e -> toRowValue e + Nothing -> throwError name + +sortedIndexes' :: Bool -> V.Vector Row -> VU.Vector Int +sortedIndexes' asc rows = runST $ do + withIndexes <- VG.thaw (V.indexed rows) + VA.sortBy ((if asc then compare else flip compare) `on` snd) withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length rows) (\i -> fst (sorted VG.! i)) diff --git a/src/DataFrame/Internal/Types.hs b/src/DataFrame/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Types.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Strict #-} +module DataFrame.Internal.Types where + +import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Kind (Type) +import Data.Maybe (fromMaybe) +import Data.Typeable (Typeable, type (:~:) (..)) +import Data.Word ( Word8, Word16, Word32, Word64 ) +import Type.Reflection (TypeRep, typeOf, typeRep) +import Data.Type.Equality (TestEquality(..)) + +-- We need an "Object" type as an intermediate representation +-- for rows. Useful for things like sorting and function application. +type Columnable a = (Typeable a, Show a, Ord a, Eq a) + +data RowValue where + Value :: (Columnable a) => a -> RowValue + +instance Eq RowValue where + (==) :: RowValue -> RowValue -> Bool + (Value a) == (Value b) = fromMaybe False $ do + Refl <- testEquality (typeOf a) (typeOf b) + return $ a == b + +instance Ord RowValue where + (<=) :: RowValue -> RowValue -> Bool + (Value a) <= (Value b) = fromMaybe False $ do + Refl <- testEquality (typeOf a) (typeOf b) + return $ a <= b + +instance Show RowValue where + show :: RowValue -> String + show (Value a) = show a + +toRowValue :: forall a . (Columnable a) => a -> RowValue +toRowValue = Value + +-- | Essentially a "functor" instance of our type-erased Column. +class Transformable a where + transform :: forall b c . (Columnable b, Columnable c) => (b -> c) -> a -> Maybe a + +-- Convenience functions for types. +unboxableTypes :: TypeRepList '[Int, Int8, Int16, Int32, Int64, + Word, Word8, Word16, Word32, Word64, + Char, Double, Float, Bool] +unboxableTypes = Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep Nil))))))))))))) + +numericTypes :: TypeRepList '[Int, Int8, Int16, Int32, Int64, Double, Float] +numericTypes = Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep Nil)))))) + +data TypeRepList (xs :: [Type]) where + Nil :: TypeRepList '[] + Cons :: Typeable x => TypeRep x -> TypeRepList xs -> TypeRepList (x ': xs) + +matchesAnyType :: forall a xs. (Typeable a) => TypeRepList xs -> TypeRep a -> Bool +matchesAnyType Nil _ = False +matchesAnyType (Cons ty tys) rep = + case testEquality ty rep of + Just Refl -> True + Nothing -> matchesAnyType tys rep + +testUnboxable :: forall a . Typeable a => TypeRep a -> Bool +testUnboxable x = matchesAnyType unboxableTypes (typeRep @a) + +testNumeric :: forall a . Typeable a => TypeRep a -> Bool +testNumeric x = matchesAnyType numericTypes (typeRep @a) diff --git a/src/DataFrame/Operations/Aggregation.hs b/src/DataFrame/Operations/Aggregation.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Operations/Aggregation.hs @@ -0,0 +1,248 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module DataFrame.Operations.Aggregation where + +import qualified Data.Set as S + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Map.Strict as MS +import qualified Data.Text as T +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as VM +import qualified Data.Vector.Unboxed as VU +import qualified Statistics.Quantile as SS +import qualified Statistics.Sample as SS + +import Control.Exception (throw) +import Control.Monad (foldM_) +import Control.Monad.ST (runST) +import DataFrame.Internal.Column (Column(..), toColumn', getIndicesUnboxed, getIndices) +import DataFrame.Internal.DataFrame (DataFrame(..), empty, getColumn) +import DataFrame.Internal.Parsing +import DataFrame.Internal.Types +import DataFrame.Errors +import DataFrame.Operations.Core +import DataFrame.Operations.Subset +import Data.Function ((&)) +import Data.Hashable +import Data.Maybe +import Data.Type.Equality (type (:~:)(Refl), TestEquality(..)) +import Type.Reflection (typeRep, typeOf) + +-- | O(k * n) groups the dataframe by the given rows aggregating the remaining rows +-- into vector that should be reduced later. +groupBy :: + [T.Text] -> + DataFrame -> + DataFrame +groupBy names df + | any (`notElem` columnNames df) names = throw $ ColumnNotFoundException (T.pack $ show $ names L.\\ columnNames df) "groupBy" (columnNames df) + | otherwise = L.foldl' insertColumns initDf groupingColumns + where + insertOrAdjust k v m = if MS.notMember k m then MS.insert k [v] m else MS.adjust (appendWithFrontMin v) k m + -- Create a string representation of each row. + values = V.generate (fst (dimensions df)) (mkRowRep df (S.fromList names)) + -- Create a mapping from the row representation to the list of indices that + -- have that row representation. This will allow us sortedIndexesto combine the indexes + -- where the rows are the same. + valueIndices = V.ifoldl' (\m index rowRep -> insertOrAdjust rowRep index m) M.empty values + -- Since the min is at the head this allows us to get the min in constant time and sort by it + -- That way we can recover the original order of the rows. + -- valueIndicesInitOrder = L.sortBy (compare `on` snd) $! MS.toList $ MS.map VU.head valueIndices + valueIndicesInitOrder = runST $ do + v <- VM.new (MS.size valueIndices) + foldM_ (\i idxs -> VM.write v i (VU.fromList idxs) >> return (i + 1)) 0 valueIndices + V.unsafeFreeze v + + -- These are the indexes of the grouping/key rows i.e the minimum elements + -- of the list. + keyIndices = VU.generate (VG.length valueIndicesInitOrder) (\i -> VG.head $ valueIndicesInitOrder VG.! i) + -- this will be our main worker function in the fold that takes all + -- indices and replaces each value in a column with a list of + -- the elements with the indices where the grouped row + -- values are the same. + insertColumns = groupColumns valueIndicesInitOrder df + -- Out initial DF will just be all the grouped rows added to an + -- empty dataframe. The entries are dedued and are in their + -- initial order. + initDf = L.foldl' (mkGroupedColumns keyIndices df) empty names + -- All the rest of the columns that we are grouping by. + groupingColumns = columnNames df L.\\ names + +mkRowRep :: DataFrame -> S.Set T.Text -> Int -> Int +mkRowRep df names i = hash $ V.ifoldl' go [] (columns df) + where + indexMap = M.fromList (map (\(a, b) -> (b, a)) $ M.toList (columnIndices df)) + go acc k Nothing = acc + go acc k (Just (BoxedColumn (c :: V.Vector a))) = + if S.notMember (indexMap M.! k) names + then acc + else case c V.!? i of + Just e -> hash' @a e : acc + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i + go acc k (Just (OptionalColumn (c :: V.Vector (Maybe a)))) = + if S.notMember (indexMap M.! k) names + then acc + else case c V.!? i of + Just e -> hash' @(Maybe a) e : acc + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i + go acc k (Just (UnboxedColumn (c :: VU.Vector a))) = + if S.notMember (indexMap M.! k) names + then acc + else case c VU.!? i of + Just e -> hash' @a e : acc + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i + +-- | This hash function returns the hash when given a non numeric type but +-- the value when given a numeric. +hash' :: Columnable a => a -> Double +hash' value = case testEquality (typeOf value) (typeRep @Double) of + Just Refl -> value + Nothing -> case testEquality (typeOf value) (typeRep @Int) of + Just Refl -> fromIntegral value + Nothing -> case testEquality (typeOf value) (typeRep @T.Text) of + Just Refl -> fromIntegral $ hash value + Nothing -> fromIntegral $ hash (show value) + +mkGroupedColumns :: VU.Vector Int -> DataFrame -> DataFrame -> T.Text -> DataFrame +mkGroupedColumns indices df acc name = + case (V.!) (columns df) (columnIndices df M.! name) of + Nothing -> error "Unexpected" + (Just (BoxedColumn column)) -> + let vs = indices `getIndices` column + in insertColumn name vs acc + (Just (OptionalColumn column)) -> + let vs = indices `getIndices` column + in insertColumn name vs acc + (Just (UnboxedColumn column)) -> + let vs = indices `getIndicesUnboxed` column + in insertUnboxedColumn name vs acc + +groupColumns :: V.Vector (VU.Vector Int) -> DataFrame -> DataFrame -> T.Text -> DataFrame +groupColumns indices df acc name = + case (V.!) (columns df) (columnIndices df M.! name) of + Nothing -> df + (Just (BoxedColumn column)) -> + let vs = V.map (`getIndices` column) indices + in insertColumn' name (Just $ GroupedBoxedColumn vs) acc + (Just (OptionalColumn column)) -> + let vs = V.map (`getIndices` column) indices + in insertColumn' name (Just $ GroupedBoxedColumn vs) acc + (Just (UnboxedColumn column)) -> + let vs = V.map (`getIndicesUnboxed` column) indices + in insertColumn' name (Just $ GroupedUnboxedColumn vs) acc + +data Aggregation = Count + | Mean + | Minimum + | Median + | Maximum + | Sum deriving (Show, Eq) + +groupByAgg :: Aggregation -> [T.Text] -> DataFrame -> DataFrame +groupByAgg agg columnNames df = let + in case agg of + Count -> insertColumnWithDefault @Int 1 (T.pack (show agg)) V.empty df + & groupBy columnNames + & reduceBy @Int VG.length "Count" + _ -> error "UNIMPLEMENTED" + +-- O (k * n) Reduces a vector valued volumn with a given function. +reduceBy :: + forall a b . (Columnable a, Columnable b) => + (forall v . (VG.Vector v a) => v a -> b) -> + T.Text -> + DataFrame -> + DataFrame +reduceBy f name df = case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> case testEquality (typeRep @a) (typeRep @a') of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map f column)) df + Nothing -> error "Type error" + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> case testEquality (typeRep @a) (typeRep @a') of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map f column)) df + Nothing -> error "Type error" + _ -> error "Column is ungrouped" + +reduceByAgg :: Aggregation + -> T.Text + -> DataFrame + -> DataFrame +reduceByAgg agg name df = case agg of + Count -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.length column)) df + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.length column)) df + _ -> error $ "Cannot count ungrouped Column: " ++ T.unpack name + Mean -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map fromIntegral) column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map SS.mean column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Float) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map realToFrac) column)) df + Nothing -> error $ "Cannot get mean of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map fromIntegral) column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map SS.mean column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Float) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map realToFrac) column)) df + Nothing -> error $ "Cannot get mean of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? + Minimum -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.minimum column)) df + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.minimum column)) df + Maximum -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.maximum column)) df + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.maximum column)) df + Sum -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df + Nothing -> error $ "Cannot get sum of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df + Nothing -> error $ "Cannot get sum of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? + _ -> error "UNIMPLEMENTED" + +aggregate :: [(T.Text, Aggregation)] -> DataFrame -> DataFrame +aggregate aggs df = let + f (name, agg) d = cloneColumn name alias d & reduceByAgg agg alias + where alias = (T.pack . show) agg <> "_" <> name + in fold f aggs df & exclude (map fst aggs) + + +appendWithFrontMin :: (Ord a) => a -> [a] -> [a] +appendWithFrontMin x [] = [x] +appendWithFrontMin x xs@(f:rest) + | x < f = x:xs + | otherwise = f:x:rest +{-# INLINE appendWithFrontMin #-} + +distinct :: DataFrame -> DataFrame +distinct df = groupBy (columnNames df) df diff --git a/src/DataFrame/Operations/Core.hs b/src/DataFrame/Operations/Core.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Operations/Core.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE BangPatterns #-} +module DataFrame.Operations.Core where + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Map.Strict as MS +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Control.Exception ( throw ) +import DataFrame.Errors +import DataFrame.Internal.Column ( Column(..), toColumn', toColumn, columnLength, columnTypeString, expandColumn ) +import DataFrame.Internal.DataFrame (DataFrame(..), getColumn, null, empty) +import DataFrame.Internal.Parsing (isNullish) +import DataFrame.Internal.Types (Columnable) +import Data.Either +import Data.Function (on, (&)) +import Data.Maybe +import Data.Type.Equality (type (:~:)(Refl), TestEquality(..)) +import Type.Reflection +import Prelude hiding (null) + +-- | O(1) Get DataFrame dimensions i.e. (rows, columns) +dimensions :: DataFrame -> (Int, Int) +dimensions = dataframeDimensions +{-# INLINE dimensions #-} + +-- | O(k) Get column names of the DataFrame in order of insertion. +columnNames :: DataFrame -> [T.Text] +columnNames = map fst . L.sortBy (compare `on` snd). M.toList . columnIndices +{-# INLINE columnNames #-} + +-- | /O(n)/ Adds a vector to the dataframe. +insertColumn :: + forall a. + (Columnable a) => + -- | Column Name + T.Text -> + -- | Vector to add to column + V.Vector a -> + -- | DataFrame to add column to + DataFrame -> + DataFrame +insertColumn name xs = insertColumn' name (Just (toColumn' xs)) +{-# INLINE insertColumn #-} + +cloneColumn :: T.Text -> T.Text -> DataFrame -> DataFrame +cloneColumn original new df = fromMaybe (throw $ ColumnNotFoundException original "cloneColumn" (map fst $ M.toList $ columnIndices df)) $ do + column <- getColumn original df + return $ insertColumn' new (Just column) df + +-- | /O(n)/ Adds an unboxed vector to the dataframe. +insertUnboxedColumn :: + forall a. + (Columnable a, VU.Unbox a) => + -- | Column Name + T.Text -> + -- | Unboxed vector to add to column + VU.Vector a -> + -- | DataFrame to add to column + DataFrame -> + DataFrame +insertUnboxedColumn name xs = insertColumn' name (Just (UnboxedColumn xs)) + +-- -- | /O(n)/ Add a column to the dataframe. Not meant for external use. +insertColumn' :: + -- | Column Name + T.Text -> + -- | Column to add + Maybe Column -> + -- | DataFrame to add to column + DataFrame -> + DataFrame +insertColumn' _ Nothing d = d +insertColumn' name optCol@(Just column) d + | M.member name (columnIndices d) = let + i = (M.!) (columnIndices d) name + in d { columns = columns d V.// [(i, optCol)] } + | otherwise = insertNewColumn + where + l = columnLength column + (r, c) = dataframeDimensions d + diff = abs (l - r) + insertNewColumn + -- If we have a non-empty dataframe and we have more rows in the new column than the other column + -- we should make all the other columns have null and then add the new column. + | r > 0 && l > r = let + indexes = (map snd . L.sortBy (compare `on` snd). M.toList . columnIndices) d + nonEmptyColumns = L.foldl' (\acc i -> acc ++ [maybe (error "Unexpected") (expandColumn diff) (columns d V.! i)]) [] indexes + in fromList (zip (columnNames d ++ [name]) (nonEmptyColumns ++ [column])) + | otherwise = let + (n:rest) = case freeIndices d of + [] -> [VG.length (columns d)..(VG.length (columns d) * 2 - 1)] + lst -> lst + columns' = if L.null (freeIndices d) + then columns d V.++ V.replicate (VG.length (columns d)) Nothing + else columns d + xs' + | diff <= 0 || null d = optCol + | otherwise = expandColumn diff <$> optCol + in d + { columns = columns' V.// [(n, xs')], + columnIndices = M.insert name n (columnIndices d), + freeIndices = rest, + dataframeDimensions = (max l r, c + 1) + } + +-- | /O(k)/ Add a column to the dataframe providing a default. +-- This constructs a new vector and also may convert it +-- to an unboxed vector if necessary. Since columns are usually +-- large the runtime is dominated by the length of the list, k. +insertColumnWithDefault :: + forall a. + (Columnable a) => + -- | Default Value + a -> + -- | Column name + T.Text -> + -- | Data to add to column + V.Vector a -> + -- | DataFrame to add to column + DataFrame -> + DataFrame +insertColumnWithDefault defaultValue name xs d = + let (rows, _) = dataframeDimensions d + values = xs V.++ V.replicate (rows - V.length xs) defaultValue + in insertColumn' name (Just $ toColumn' values) d + +-- TODO: Add existence check in rename. +rename :: T.Text -> T.Text -> DataFrame -> DataFrame +rename orig new df = fromMaybe (throw $ ColumnNotFoundException orig "rename" (map fst $ M.toList $ columnIndices df)) $ do + columnIndex <- M.lookup orig (columnIndices df) + let origRemoved = M.delete orig (columnIndices df) + let newAdded = M.insert new columnIndex origRemoved + return df { columnIndices = newAdded } + +-- | O(1) Get the number of elements in a given column. +columnSize :: T.Text -> DataFrame -> Maybe Int +columnSize name df = columnLength <$> getColumn name df + +data ColumnInfo = ColumnInfo { + nameOfColumn :: !T.Text, + nonNullValues :: !Int, + nullValues :: !Int, + partiallyParsedValues :: !Int, + uniqueValues :: !Int, + typeOfColumn :: !T.Text + } + +-- | O(n) Returns the number of non-null columns in the dataframe and the type associated +-- with each column. +columnInfo :: DataFrame -> DataFrame +columnInfo df = empty & insertColumn' "Column Name" (Just $! toColumn (map nameOfColumn infos)) + & insertColumn' "# Non-null Values" (Just $! toColumn (map nonNullValues infos)) + & insertColumn' "# Null Values" (Just $! toColumn (map nullValues infos)) + & insertColumn' "# Partially parsed" (Just $! toColumn (map partiallyParsedValues infos)) + & insertColumn' "# Unique Values" (Just $! toColumn (map uniqueValues infos)) + & insertColumn' "Type" (Just $! toColumn (map typeOfColumn infos)) + where + infos = L.sortBy (compare `on` nonNullValues) (V.ifoldl' go [] (columns df)) :: [ColumnInfo] + indexMap = M.fromList (map (\(a, b) -> (b, a)) $ M.toList (columnIndices df)) + columnName i = M.lookup i indexMap + go acc i Nothing = acc + go acc i (Just col@(OptionalColumn (c :: V.Vector a))) = let + cname = columnName i + countNulls = nulls col + countPartial = partiallyParsed col + columnType = T.pack $ show $ typeRep @a + unique = S.size $ VG.foldr S.insert S.empty c + in if isNothing cname then acc else ColumnInfo (fromMaybe "" cname) (columnLength col - countNulls) countNulls countPartial unique columnType : acc + go acc i (Just col@(BoxedColumn (c :: V.Vector a))) = let + cname = columnName i + countPartial = partiallyParsed col + columnType = T.pack $ show $ typeRep @a + unique = S.size $ VG.foldr S.insert S.empty c + in if isNothing cname then acc else ColumnInfo (fromMaybe "" cname) (columnLength col) 0 countPartial unique columnType : acc + go acc i (Just col@(UnboxedColumn c)) = let + cname = columnName i + columnType = T.pack $ columnTypeString col + unique = S.size $ VG.foldr S.insert S.empty c + -- Unboxed columns cannot have nulls since Maybe + -- is not an instance of Unbox a + in if isNothing cname then acc else ColumnInfo (fromMaybe "" cname) (columnLength col) 0 0 unique columnType : acc + +nulls :: Column -> Int +nulls (OptionalColumn xs) = VG.length $ VG.filter isNothing xs +nulls (BoxedColumn (xs :: V.Vector a)) = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> VG.length $ VG.filter isNullish xs + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> VG.length $ VG.filter (isNullish . T.pack) xs + Nothing -> case typeRep @a of + App t1 t2 -> case eqTypeRep t1 (typeRep @Maybe) of + Just HRefl -> VG.length $ VG.filter isNothing xs + Nothing -> 0 + _ -> 0 +nulls _ = 0 + +partiallyParsed :: Column -> Int +partiallyParsed (BoxedColumn (xs :: V.Vector a)) = + case typeRep @a of + App (App tycon t1) t2 -> case eqTypeRep tycon (typeRep @Either) of + Just HRefl -> VG.length $ VG.filter isLeft xs + Nothing -> 0 + _ -> 0 +partiallyParsed _ = 0 + +fromList :: [(T.Text, Column)] -> DataFrame +fromList = L.foldl' (\df (!name, !column) -> insertColumn' name (Just $! column) df) empty + +fromColumnList :: [Column] -> DataFrame +fromColumnList = fromList . zip (map (T.pack . show) [0..]) + +-- | O (k * n) Counts the occurences of each value in a given column. +valueCounts :: forall a. (Columnable a) => T.Text -> DataFrame -> [(a, Int)] +valueCounts columnName df = case getColumn columnName df of + Nothing -> throw $ ColumnNotFoundException columnName "sortBy" (map fst $ M.toList $ columnIndices df) + Just (BoxedColumn (column' :: V.Vector c)) -> + let + column = V.foldl' (\m v -> MS.insertWith (+) v (1 :: Int) m) M.empty column' + in case (typeRep @a) `testEquality` (typeRep @c) of + Nothing -> throw $ TypeMismatchException (typeRep @a) (typeRep @c) columnName "valueCounts" + Just Refl -> M.toAscList column + Just (OptionalColumn (column' :: V.Vector c)) -> + let + column = V.foldl' (\m v -> MS.insertWith (+) v (1 :: Int) m) M.empty column' + in case (typeRep @a) `testEquality` (typeRep @c) of + Nothing -> throw $ TypeMismatchException (typeRep @a) (typeRep @c) columnName "valueCounts" + Just Refl -> M.toAscList column + Just (UnboxedColumn (column' :: VU.Vector c)) -> let + column = V.foldl' (\m v -> MS.insertWith (+) v (1 :: Int) m) M.empty (V.convert column') + in case (typeRep @a) `testEquality` (typeRep @c) of + Nothing -> throw $ TypeMismatchException (typeRep @a) (typeRep @c) columnName "valueCounts" + Just Refl -> M.toAscList column + +fold :: (a -> DataFrame -> DataFrame) -> [a] -> DataFrame -> DataFrame +fold f xs acc = L.foldl' (flip f) acc xs diff --git a/src/DataFrame/Operations/Sorting.hs b/src/DataFrame/Operations/Sorting.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Operations/Sorting.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +module DataFrame.Operations.Sorting where + +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Vector as V + +import Control.Exception (throw) +import DataFrame.Errors (DataFrameException(..)) +import DataFrame.Internal.Column +import DataFrame.Internal.DataFrame (DataFrame(..), getColumn) +import DataFrame.Internal.Row +import DataFrame.Operations.Core + +-- | Sort order taken as a parameter by the sortby function. +data SortOrder = Ascending | Descending deriving (Eq) + +-- | O(k log n) Sorts the dataframe by a given row. +-- +-- > sortBy "Age" df +sortBy :: + SortOrder -> + [T.Text] -> + DataFrame -> + DataFrame +sortBy order names df + | any (`notElem` columnNames df) names = throw $ ColumnNotFoundException (T.pack $ show $ names L.\\ columnNames df) "sortBy" (columnNames df) + | otherwise = let + -- TODO: Remove the SortOrder defintion from operations so we can share it between here and internal and + -- we don't have to do this Bool mapping. + indexes = sortedIndexes' (order == Ascending) (toRowVector names df) + pick idxs col = atIndicesStable idxs <$> col + in df {columns = V.map (pick indexes) (columns df)} diff --git a/src/DataFrame/Operations/Statistics.hs b/src/DataFrame/Operations/Statistics.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Operations/Statistics.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +module DataFrame.Operations.Statistics where + +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import qualified Statistics.Quantile as SS +import qualified Statistics.Sample as SS + +import Prelude as P + +import Control.Exception (throw) +import DataFrame.Errors (DataFrameException(..)) +import DataFrame.Internal.Column +import DataFrame.Internal.DataFrame (DataFrame(..), getColumn, empty) +import DataFrame.Internal.Types (Columnable, transform) +import DataFrame.Operations.Core +import Data.Foldable (asum) +import Data.Maybe (isJust, fromMaybe) +import Data.Function ((&)) +import Data.Type.Equality (type (:~:)(Refl), TestEquality (testEquality)) +import Type.Reflection (typeRep) + + +frequencies :: T.Text -> DataFrame -> DataFrame +frequencies name df = case getColumn name df of + Just ((BoxedColumn (column :: V.Vector a))) -> let + counts = valueCounts @a name df + total = P.sum $ map snd counts + vText :: forall a . (Columnable a) => a -> T.Text + vText c' = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> c' + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> T.pack c' + Nothing -> (T.pack . show) c' + initDf = empty & insertColumn "Statistic" (V.fromList ["Count" :: T.Text, "Percentage (%)"]) + in L.foldl' (\df (col, k) -> insertColumn (vText col) (V.fromList [k, k * 100 `div` total]) df) initDf counts + Just ((OptionalColumn (column :: V.Vector a))) -> let + counts = valueCounts @a name df + total = P.sum $ map snd counts + vText :: forall a . (Columnable a) => a -> T.Text + vText c' = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> c' + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> T.pack c' + Nothing -> (T.pack . show) c' + initDf = empty & insertColumn "Statistic" (V.fromList ["Count" :: T.Text, "Percentage (%)"]) + in L.foldl' (\df (col, k) -> insertColumn (vText col) (V.fromList [k, k * 100 `div` total]) df) initDf counts + Just ((UnboxedColumn (column :: VU.Vector a))) -> let + counts = valueCounts @a name df + total = P.sum $ map snd counts + vText :: forall a . (Columnable a) => a -> T.Text + vText c' = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> c' + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> T.pack c' + Nothing -> (T.pack . show) c' + initDf = empty & insertColumn "Statistic" (V.fromList ["Count" :: T.Text, "Percentage (%)"]) + in L.foldl' (\df (col, k) -> insertColumn (vText col) (V.fromList [k, k * 100 `div` total]) df) initDf counts + +mean :: T.Text -> DataFrame -> Maybe Double +mean = applyStatistic SS.mean + +median :: T.Text -> DataFrame -> Maybe Double +median = applyStatistic (SS.median SS.medianUnbiased) + +standardDeviation :: T.Text -> DataFrame -> Maybe Double +standardDeviation = applyStatistic SS.fastStdDev + +skewness :: T.Text -> DataFrame -> Maybe Double +skewness = applyStatistic SS.skewness + +variance :: T.Text -> DataFrame -> Maybe Double +variance = applyStatistic SS.variance + +interQuartileRange :: T.Text -> DataFrame -> Maybe Double +interQuartileRange = applyStatistic (SS.midspread SS.medianUnbiased 4) + +correlation :: T.Text -> T.Text -> DataFrame -> Maybe Double +correlation first second df = do + f <- _getColumnAsDouble first df + s <- _getColumnAsDouble second df + return $ SS.correlation2 f s + +_getColumnAsDouble :: T.Text -> DataFrame -> Maybe (VU.Vector Double) +_getColumnAsDouble name df = case getColumn name df of + Just (UnboxedColumn (f :: VU.Vector a)) -> case testEquality (typeRep @a) (typeRep @Double) of + Just Refl -> Just f + Nothing -> case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> Just $ VU.map fromIntegral f + Nothing -> Nothing + _ -> Nothing + +sum :: T.Text -> DataFrame -> Maybe Double +sum name df = case getColumn name df of + Just ((UnboxedColumn (column :: VU.Vector a'))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> Just $ VG.sum (VU.map fromIntegral column) + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> Just $ VG.sum column + Nothing -> Nothing + Nothing -> Nothing + +applyStatistic :: (VU.Vector Double -> Double) -> T.Text -> DataFrame -> Maybe Double +applyStatistic f name df = do + column <- getColumn name df + if columnTypeString column == "Double" + then safeReduceColumn f column + else do + matching <- asum [transform (fromIntegral :: Int -> Double) column, + transform (fromIntegral :: Integer -> Double) column, + transform (realToFrac :: Float -> Double) column, + Just column ] + safeReduceColumn f matching + +applyStatistics :: (VU.Vector Double -> VU.Vector Double) -> T.Text -> DataFrame -> Maybe (VU.Vector Double) +applyStatistics f name df = case getColumn name df of + Just ((UnboxedColumn (column :: VU.Vector a'))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> Just $! f (VU.map fromIntegral column) + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> Just $! f column + Nothing -> case testEquality (typeRep @a') (typeRep @Float) of + Just Refl -> Just $! f (VG.map realToFrac column) + Nothing -> Nothing + _ -> Nothing + +summarize :: DataFrame -> DataFrame +summarize df = fold columnStats (columnNames df) (fromList [("Statistic", toColumn ["Mean" :: T.Text, "Minimum", "25%" ,"Median", "75%", "Max", "StdDev", "IQR", "Skewness"])]) + where columnStats name d = if all isJust (stats name) then insertUnboxedColumn name (VU.fromList (map (roundTo 2 . fromMaybe 0) $ stats name)) d else d + stats name = let + quantiles = applyStatistics (SS.quantilesVec SS.medianUnbiased (VU.fromList [0,1,2,3,4]) 4) name df + min' = flip (VG.!) 0 <$> quantiles + quartile1 = flip (VG.!) 1 <$> quantiles + median' = flip (VG.!) 2 <$> quantiles + quartile3 = flip (VG.!) 3 <$> quantiles + max' = flip (VG.!) 4 <$> quantiles + iqr = (-) <$> quartile3 <*> quartile1 + in [mean name df, + min', + quartile1, + median', + quartile3, + max', + standardDeviation name df, + iqr, + skewness name df] + roundTo :: Int -> Double -> Double + roundTo n x = fromInteger (round $ x * (10^n)) / (10.0^^n) diff --git a/src/DataFrame/Operations/Subset.hs b/src/DataFrame/Operations/Subset.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Operations/Subset.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} +module DataFrame.Operations.Subset where + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Generic as VG +import qualified Prelude + +import Control.Exception (throw) +import DataFrame.Errors (DataFrameException(..)) +import DataFrame.Internal.Column +import DataFrame.Internal.DataFrame (DataFrame(..), getColumn, empty) +import DataFrame.Internal.Function +import DataFrame.Internal.Row (mkRowFromArgs) +import DataFrame.Internal.Types (Columnable, RowValue, toRowValue) +import DataFrame.Operations.Core +import DataFrame.Operations.Transformations (apply) +import Data.Function ((&)) +import Data.Maybe (isJust, fromJust, fromMaybe) +import Prelude hiding (filter, take) +import Type.Reflection + +-- | O(k * n) Take the first n rows of a DataFrame. +take :: Int -> DataFrame -> DataFrame +take n d = d {columns = V.map (takeColumn n' <$>) (columns d), dataframeDimensions = (n', c)} + where + (r, c) = dataframeDimensions d + n' = clip n 0 r + +takeLast :: Int -> DataFrame -> DataFrame +takeLast n d = d {columns = V.map (takeLastColumn n' <$>) (columns d), dataframeDimensions = (n', c)} + where + (r, c) = dataframeDimensions d + n' = clip n 0 r + +drop :: Int -> DataFrame -> DataFrame +drop n d = d {columns = V.map (sliceColumn n' (max (r - n') 0) <$>) (columns d), dataframeDimensions = (max (r - n') 0, c)} + where + (r, c) = dataframeDimensions d + n' = clip n 0 r + +dropLast :: Int -> DataFrame -> DataFrame +dropLast n d = d {columns = V.map (sliceColumn 0 n' <$>) (columns d), dataframeDimensions = (n', c)} + where + (r, c) = dataframeDimensions d + n' = clip (r - n) 0 r + +-- | O(k * n) Take a range of rows of a DataFrame. +range :: (Int, Int) -> DataFrame -> DataFrame +range (start, end) d = d {columns = V.map (sliceColumn (clip start 0 r) n' <$>) (columns d), dataframeDimensions = (n', c)} + where + (r, c) = dataframeDimensions d + n' = clip (end - start) 0 r + +clip :: Int -> Int -> Int -> Int +clip n left right = min right $ max n left + +-- | O(n * k) Filter rows by a given condition. +-- +-- filter "x" even df +filter :: + forall a. + (Columnable a) => + -- | Column to filter by + T.Text -> + -- | Filter condition + (a -> Bool) -> + -- | Dataframe to filter + DataFrame -> + DataFrame +filter filterColumnName condition df = case getColumn filterColumnName df of + Nothing -> throw $ ColumnNotFoundException filterColumnName "filter" (map fst $ M.toList $ columnIndices df) + Just column -> case ifoldlColumn (\s i v -> if condition v then S.insert i s else s) S.empty column of + Nothing -> throw $ TypeMismatchException' (typeRep @a) (columnTypeString column) filterColumnName "filter" + Just indexes -> let + c' = snd $ dataframeDimensions df + pick idxs col = atIndices idxs <$> col + in df {columns = V.map (pick indexes) (columns df), dataframeDimensions = (S.size indexes, c')} + +-- | O(k) a version of filter where the predicate comes first. +-- +-- > filterBy even "x" df +filterBy :: (Columnable a) => (a -> Bool) -> T.Text -> DataFrame -> DataFrame +filterBy = flip filter + +-- | O(k) filters the dataframe with a row predicate. The arguments in the function +-- must appear in the same order as they do in the list. +-- +-- > filterWhere (["x", "y"], func (\x y -> x + y > 5)) df +filterWhere :: ([T.Text], Function) -> DataFrame -> DataFrame +filterWhere (args, f) df = let + indexes = VG.ifoldl' (\s i row -> if funcApply @Bool row f then S.insert i s else s) S.empty $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + c' = snd $ dataframeDimensions df + pick idxs col = atIndices idxs <$> col + in df {columns = V.map (pick indexes) (columns df), dataframeDimensions = (S.size indexes, c')} + + +-- | O(k) removes all rows with `Nothing` in a given column from the dataframe. +-- +-- > filterJust df +filterJust :: T.Text -> DataFrame -> DataFrame +filterJust name df = case getColumn name df of + Nothing -> throw $ ColumnNotFoundException name "filterJust" (map fst $ M.toList $ columnIndices df) + Just column@(OptionalColumn (col :: V.Vector (Maybe a))) -> filter @(Maybe a) name isJust df & apply @(Maybe a) fromJust name + Just column -> df + +-- | O(n * k) removes all rows with `Nothing` from the dataframe. +-- +-- > filterJust df +filterAllJust :: DataFrame -> DataFrame +filterAllJust df = foldr filterJust df (columnNames df) + +-- | O(k) cuts the dataframe in a cube of size (a, b) where +-- a is the length and b is the width. +-- +-- > cube (10, 5) df +cube :: (Int, Int) -> DataFrame -> DataFrame +cube (length, width) = take length . selectIntRange (0, width - 1) + +-- | O(n) Selects a number of columns in a given dataframe. +-- +-- > select ["name", "age"] df +select :: + [T.Text] -> + DataFrame -> + DataFrame +select cs df + | L.null cs = empty + | any (`notElem` columnNames df) cs = throw $ ColumnNotFoundException (T.pack $ show $ cs L.\\ columnNames df) "select" (columnNames df) + | otherwise = L.foldl' addKeyValue empty cs + where + cIndexAssoc = M.toList $ columnIndices df + remaining = L.filter (\(!c, _) -> c `elem` cs) cIndexAssoc + removed = cIndexAssoc L.\\ remaining + indexes = map snd remaining + (r, c) = dataframeDimensions df + addKeyValue d k = + d + { columns = V.imap (\i v -> if i `notElem` indexes then Nothing else v) (columns df), + columnIndices = M.fromList remaining, + freeIndices = map snd removed ++ freeIndices df, + dataframeDimensions = (r, L.length remaining) + } + +-- | O(n) select columns by index range of column names. +selectIntRange :: (Int, Int) -> DataFrame -> DataFrame +selectIntRange (from, to) df = select (Prelude.take (to - from + 1) $ Prelude.drop from (columnNames df)) df + +-- | O(n) select columns by index range of column names. +selectRange :: (T.Text, T.Text) -> DataFrame -> DataFrame +selectRange (from, to) df = select (reverse $ Prelude.dropWhile (to /=) $ reverse $ dropWhile (from /=) (columnNames df)) df + +-- | O(n) select columns by column predicate name. +selectBy :: (T.Text -> Bool) -> DataFrame -> DataFrame +selectBy f df = select (L.filter f (columnNames df)) df + +-- | O(n) inverse of select +-- +-- > exclude ["Name"] df +exclude :: + [T.Text] -> + DataFrame -> + DataFrame +exclude cs df = + let keysToKeep = columnNames df L.\\ cs + in select keysToKeep df diff --git a/src/DataFrame/Operations/Transformations.hs b/src/DataFrame/Operations/Transformations.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Operations/Transformations.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module DataFrame.Operations.Transformations where + +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Map as M +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Control.Exception (throw) +import DataFrame.Errors (DataFrameException(..)) +import DataFrame.Internal.Column (Column(..), columnTypeString, itransform, ifoldrColumn) +import DataFrame.Internal.DataFrame (DataFrame(..), getColumn) +import DataFrame.Internal.Function (Function(..), funcApply) +import DataFrame.Internal.Row (mkRowFromArgs) +import DataFrame.Internal.Types (Columnable, RowValue, toRowValue, transform) +import DataFrame.Operations.Core +import Data.Maybe +import Type.Reflection (typeRep, typeOf) + +-- | O(k) Apply a function to a given column in a dataframe. +apply :: + forall b c. + (Columnable b, Columnable c) => + -- | function to apply + (b -> c) -> + -- | Column name + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +apply f columnName d = case getColumn columnName d of + Nothing -> throw $ ColumnNotFoundException columnName "apply" (map fst $ M.toList $ columnIndices d) + Just column -> case transform f column of + Nothing -> throw $ TypeMismatchException' (typeRep @b) (columnTypeString column) columnName "apply" + column' -> insertColumn' columnName column' d + +-- | O(k) Apply a function to a combination of columns in a dataframe and +-- add the result into `alias` column. +deriveFrom :: ([T.Text], Function) -> T.Text -> DataFrame -> DataFrame +deriveFrom (args, f) name df = case f of + (F4 (f' :: a -> b -> c -> d -> e)) -> let + xs = VG.map (\row -> funcApply @e row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + in insertColumn name xs df + (F3 (f' :: a -> b -> c -> d)) -> let + xs = VG.map (\row -> funcApply @d row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + in insertColumn name xs df + (F2 (f' :: a -> b -> c)) -> let + xs = VG.map (\row -> funcApply @c row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + in insertColumn name xs df + (F1 (f' :: a -> b)) -> let + xs = VG.map (\row -> funcApply @b row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + in insertColumn name xs df + +-- | O(k) Apply a function to a given column in a dataframe and +-- add the result into alias column. + +derive :: + forall b c. + (Columnable b, Columnable c) => + -- | New name + T.Text -> + -- | function to apply + (b -> c) -> + -- | Derivative column name + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +derive alias f columnName d = case getColumn columnName d of + Nothing -> throw $ ColumnNotFoundException columnName "derive" (map fst $ M.toList $ columnIndices d) + Just column -> case transform f column of + Nothing -> throw $ TypeMismatchException (typeOf column) (typeRep @b) columnName "derive" + Just res -> insertColumn' alias (Just res) d + +-- | O(k * n) Apply a function to given column names in a dataframe. +applyMany :: + (Columnable b, Columnable c) => + (b -> c) -> + [T.Text] -> + DataFrame -> + DataFrame +applyMany f names df = L.foldl' (flip (apply f)) df names + +-- | O(k) Convenience function that applies to an int column. +applyInt :: + (Columnable b) => + -- | Column name + -- | function to apply + (Int -> b) -> + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +applyInt = apply + +-- | O(k) Convenience function that applies to an double column. +applyDouble :: + (Columnable b) => + -- | Column name + -- | function to apply + (Double -> b) -> + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +applyDouble = apply + +-- | O(k * n) Apply a function to a column only if there is another column +-- value that matches the given criterion. +-- +-- > applyWhere "Age" (<20) "Generation" (const "Gen-Z") +applyWhere :: + forall a b . + (Columnable a, Columnable b) => + (a -> Bool) -> -- Filter condition + T.Text -> -- Criterion Column + (b -> b) -> -- function to apply + T.Text -> -- Column name + DataFrame -> -- DataFrame to apply operation to + DataFrame +applyWhere condition filterColumnName f columnName df = case getColumn filterColumnName df of + Nothing -> throw $ ColumnNotFoundException filterColumnName "applyWhere" (map fst $ M.toList $ columnIndices df) + Just column -> case ifoldrColumn (\i val acc -> if condition val then V.cons i acc else acc) V.empty column of + Nothing -> throw $ TypeMismatchException' (typeRep @a) (columnTypeString column) filterColumnName "applyWhere" + Just indexes -> if V.null indexes + then df + else L.foldl' (\d i -> applyAtIndex i f columnName d) df indexes + +-- | O(k) Apply a function to the column at a given index. +applyAtIndex :: + forall a. + (Columnable a) => + -- | Index + Int -> + -- | function to apply + (a -> a) -> + -- | Column name + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +applyAtIndex i f columnName df = case getColumn columnName df of + Nothing -> throw $ ColumnNotFoundException columnName "applyAtIndex" (map fst $ M.toList $ columnIndices df) + Just column -> case itransform (\index value -> if index == i then f value else value) column of + Nothing -> throw $ TypeMismatchException' (typeRep @a) (columnTypeString column) columnName "applyAtIndex" + column' -> insertColumn' columnName column' df + +impute :: + forall b . + (Columnable b) => + T.Text -> + b -> + DataFrame -> + DataFrame +impute columnName value df = case getColumn columnName df of + Nothing -> throw $ ColumnNotFoundException columnName "impute" (map fst $ M.toList $ columnIndices df) + Just (OptionalColumn _) -> apply (fromMaybe value) columnName df + _ -> error "Cannot impute to a non-Empty column" diff --git a/src/DataFrame/Operations/Typing.hs b/src/DataFrame/Operations/Typing.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Operations/Typing.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module DataFrame.Operations.Typing where + +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import DataFrame.Internal.Column (Column(..)) +import DataFrame.Internal.DataFrame (DataFrame(..)) +import DataFrame.Internal.Parsing +import Data.Either +import Data.Maybe +import Data.Time +import Data.Type.Equality (type (:~:)(Refl), TestEquality(..)) +import Type.Reflection (typeRep) + +parseDefaults :: Bool -> DataFrame -> DataFrame +parseDefaults safeRead df = df {columns = V.map (parseDefault safeRead) (columns df)} + +parseDefault :: Bool -> Maybe Column -> Maybe Column +parseDefault _ Nothing = Nothing +parseDefault safeRead (Just (BoxedColumn (c :: V.Vector a))) = let + parseTimeOpt s = parseTimeM {- Accept leading/trailing whitespace -} True defaultTimeLocale "%Y-%m-%d" (T.unpack s) :: Maybe Day + unsafeParseTime s = parseTimeOrError {- Accept leading/trailing whitespace -} True defaultTimeLocale "%Y-%m-%d" (T.unpack s) :: Day + in case (typeRep @a) `testEquality` (typeRep @T.Text) of + Nothing -> case (typeRep @a) `testEquality` (typeRep @String) of + Just Refl -> let + emptyToNothing v = if isNullish (T.pack v) then Nothing else Just v + safeVector = V.map emptyToNothing c + hasNulls = V.foldl' (\acc v -> if isNothing v then acc || True else acc) False safeVector + in Just $ if safeRead && hasNulls then BoxedColumn safeVector else BoxedColumn c + Nothing -> Just $ BoxedColumn c + Just Refl -> + let example = T.strip (V.head c) + emptyToNothing v = if isNullish v then Nothing else Just v + in case readInt example of + Just _ -> + let safeVector = V.map ((=<<) readInt . emptyToNothing) c + hasNulls = V.elem Nothing safeVector + in Just $ if safeRead && hasNulls then BoxedColumn safeVector else UnboxedColumn (VU.generate (V.length c) (fromMaybe 0 . (safeVector V.!))) + Nothing -> case readDouble example of + Just _ -> + let safeVector = V.map ((=<<) readDouble . emptyToNothing) c + hasNulls = V.elem Nothing safeVector + in Just $ if safeRead && hasNulls then BoxedColumn safeVector else UnboxedColumn (VU.generate (V.length c) (fromMaybe 0 . (safeVector V.!))) + Nothing -> case parseTimeOpt example of + Just d -> let + -- failed parse should be Either, nullish should be Maybe + emptyToNothing' v = if isNullish v then Left v else Right v + parseTimeEither v = case parseTimeOpt v of + Just v' -> Right v' + Nothing -> Left v + safeVector = V.map ((=<<) parseTimeEither . emptyToNothing') c + toMaybe (Left _) = Nothing + toMaybe (Right value) = Just value + lefts = V.filter isLeft safeVector + onlyNulls = (not (V.null lefts) && V.all (isNullish . fromLeft "non-null") lefts) + in Just $ if safeRead + then if onlyNulls + then BoxedColumn (V.map toMaybe safeVector) + else if V.any isLeft safeVector + then BoxedColumn safeVector + else BoxedColumn (V.map unsafeParseTime c) + else BoxedColumn (V.map unsafeParseTime c) + Nothing -> let + safeVector = V.map emptyToNothing c + hasNulls = V.any isNullish c + in Just $ if safeRead && hasNulls then BoxedColumn safeVector else BoxedColumn c +parseDefault safeRead column = column diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -2,8 +2,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Main where -import qualified Data.DataFrame as D -import qualified Data.DataFrame as DI +import qualified DataFrame as D +import qualified DataFrame as DI import qualified Data.List as L import qualified Data.Text as T import qualified Data.Vector as V diff --git a/tests/Operations/Apply.hs b/tests/Operations/Apply.hs --- a/tests/Operations/Apply.hs +++ b/tests/Operations/Apply.hs @@ -3,9 +3,9 @@ {-# LANGUAGE TupleSections #-} module Operations.Apply where -import qualified Data.DataFrame as D -import qualified Data.DataFrame as DI -import qualified Data.DataFrame as DE +import qualified DataFrame as D +import qualified DataFrame as DI +import qualified DataFrame as DE import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU diff --git a/tests/Operations/Derive.hs b/tests/Operations/Derive.hs --- a/tests/Operations/Derive.hs +++ b/tests/Operations/Derive.hs @@ -3,9 +3,9 @@ {-# LANGUAGE ScopedTypeVariables #-} module Operations.Derive where -import qualified Data.DataFrame as D -import qualified Data.DataFrame as DI -import qualified Data.DataFrame as DE +import qualified DataFrame as D +import qualified DataFrame as DI +import qualified DataFrame as DE import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU diff --git a/tests/Operations/Filter.hs b/tests/Operations/Filter.hs --- a/tests/Operations/Filter.hs +++ b/tests/Operations/Filter.hs @@ -2,9 +2,9 @@ {-# LANGUAGE OverloadedStrings #-} module Operations.Filter where -import qualified Data.DataFrame as D -import qualified Data.DataFrame as DI -import qualified Data.DataFrame as DE +import qualified DataFrame as D +import qualified DataFrame as DI +import qualified DataFrame as DE import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU diff --git a/tests/Operations/GroupBy.hs b/tests/Operations/GroupBy.hs --- a/tests/Operations/GroupBy.hs +++ b/tests/Operations/GroupBy.hs @@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Operations.GroupBy where -import qualified Data.DataFrame as D -import qualified Data.DataFrame as DI -import qualified Data.DataFrame as DE +import qualified DataFrame as D +import qualified DataFrame as DI +import qualified DataFrame as DE import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU diff --git a/tests/Operations/InsertColumn.hs b/tests/Operations/InsertColumn.hs --- a/tests/Operations/InsertColumn.hs +++ b/tests/Operations/InsertColumn.hs @@ -2,8 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} module Operations.InsertColumn where -import qualified Data.DataFrame as D -import qualified Data.DataFrame as DI +import qualified DataFrame as D +import qualified DataFrame as DI import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU diff --git a/tests/Operations/Sort.hs b/tests/Operations/Sort.hs --- a/tests/Operations/Sort.hs +++ b/tests/Operations/Sort.hs @@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Operations.Sort where -import qualified Data.DataFrame as D -import qualified Data.DataFrame as DI -import qualified Data.DataFrame as DE +import qualified DataFrame as D +import qualified DataFrame as DI +import qualified DataFrame as DE import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU diff --git a/tests/Operations/Take.hs b/tests/Operations/Take.hs --- a/tests/Operations/Take.hs +++ b/tests/Operations/Take.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module Operations.Take where -import qualified Data.DataFrame as D -import qualified Data.DataFrame as DI +import qualified DataFrame as D +import qualified DataFrame as DI import Test.HUnit