{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
#ifdef UNSAFE_INDICES
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif
module Numeric.DataFrame.Type
(
SomeDataFrame (..), DataFrame'
#if defined(__HADDOCK__) || defined(__HADDOCK_VERSION__)
, DataFrame (SingleFrame, MultiFrame, XFrame)
, pattern Z, pattern (:*:)
, pattern S, pattern DF2, pattern DF3, pattern DF4, pattern DF5
, pattern DF6, pattern DF7, pattern DF8, pattern DF9
#else
, DataFrame ( SingleFrame, MultiFrame, XFrame, (:*:), Z
, S, DF2, DF3, DF4, DF5, DF6, DF7, DF8, DF9)
#endif
, scalar, unScalar
, IndexFrame (..), SubFrameIndexCtx
, PackDF, packDF, unpackDF
, appendDF, consDF, snocDF
, fromFlatList, fromListWithDefault, fromList
, constrainDF, asDiag
, KnownBackend (), DFBackend, KnownBackends
, InferKnownBackend (..), inferPrimElem
, Dim (..), Idx (), Nat, XNat (..), N, XN, Dims, Idxs, TypedList (..)
, PrimBytes (), bSizeOf, bAlignOf, bFieldOffsetOf
, PrimArray (), ixOff
) where
#if !(MIN_VERSION_base(4,13,0))
import Data.Proxy (Proxy)
#endif
import Control.Arrow (second, (***))
import Data.Data
import Data.Semigroup hiding (All, Min)
import Data.Type.Lits
import Data.Void
import Foreign.Storable (Storable (..))
import GHC.Base
import GHC.Exts (TYPE)
import qualified GHC.Generics as G
import GHC.Ptr (Ptr (..))
import qualified Text.ParserCombinators.ReadPrec as Read
import qualified Text.Read as Read
import qualified Text.Read.Lex as Read
import Unsafe.Coerce
import Numeric.Basics
import Numeric.DataFrame.Internal.PrimArray
import Numeric.Dimensions
import Numeric.PrimBytes
import Numeric.ProductOrd
import qualified Numeric.ProductOrd.NonTransitive as NonTransitive
import qualified Numeric.ProductOrd.Partial as Partial
import Numeric.TypedList (typeables)
import Numeric.DataFrame.Internal.BackendI (DFBackend, KnownBackend)
import qualified Numeric.DataFrame.Internal.BackendI as Backend
data family DataFrame (t :: l) (xs :: [k])
newtype instance DataFrame (t :: Type) (ns :: [Nat])
= SingleFrame { getSingleFrame :: DFBackend t ns }
newtype instance DataFrame (ts :: [Type]) (ns :: [Nat])
= MultiFrame ( TypedList (DataFrame' ns) ts )
data instance DataFrame (ts :: l) (xns :: [XNat])
= forall (ns :: [Nat])
. (All KnownDimType xns, FixedDims xns ns, Dimensions ns, KnownBackends ts ns)
=> XFrame (DataFrame ts ns)
data SomeDataFrame (t :: l)
= forall (ns :: [Nat]) . (Dimensions ns, KnownBackends t ns)
=> SomeDataFrame (DataFrame t ns)
deriving Typeable
newtype DataFrame' (xs :: [k]) (t :: l) = DataFrame' (DataFrame t xs)
deriving Typeable
{-# COMPLETE Z, (:*:) #-}
#define PLEASE_STYLISH_HASKELL \
forall (xs :: [Type]) (ns :: [Nat]) . () => \
forall (y :: Type) (ys :: [Type]) . (xs ~ (y ': ys)) => \
DataFrame y ns -> DataFrame ys ns -> DataFrame xs ns
pattern (:*:) :: PLEASE_STYLISH_HASKELL
pattern (:*:) x xs <- (MultiFrame (DataFrame' x :* (MultiFrame -> xs)))
where
(:*:) x (MultiFrame xs) = MultiFrame (DataFrame' x :* xs)
infixr 6 :*:
#undef PLEASE_STYLISH_HASKELL
pattern Z :: forall (xs :: [Type]) (ns :: [Nat])
. () => (xs ~ '[]) => DataFrame xs ns
pattern Z = MultiFrame U
unScalar :: DataFrame t ('[] :: [Nat]) -> t
unScalar = unsafeCoerce
{-# INLINE unScalar #-}
scalar :: t -> DataFrame t ('[] :: [Nat])
scalar = unsafeCoerce
{-# INLINE scalar #-}
type family KnownBackends (ts :: l) (ns :: [Nat]) :: Constraint where
KnownBackends ( t :: Type ) ns = KnownBackend t ns
KnownBackends ('[] :: [Type]) _ = ()
KnownBackends (t ': ts :: [Type]) ns =
(KnownBackend t ns, KnownBackends ts ns)
class InferKnownBackend t (ds :: [Nat]) where
inferKnownBackend :: Dict (KnownBackends t ds)
instance (PrimBytes t, Dimensions ds) => InferKnownBackend (t :: Type) ds where
inferKnownBackend = Backend.inferKnownBackend @t @ds
instance (RepresentableList ts, All PrimBytes ts, Dimensions ds)
=> InferKnownBackend (ts :: [Type]) ds where
inferKnownBackend = go (tList @ts)
where
go :: forall ss . All PrimBytes ss
=> TypeList ss -> Dict (KnownBackends ss ds)
go U = Dict
go ((_ :: Proxy t) :* ts)
= case Backend.inferKnownBackend @t @ds of
Dict -> case go ts of
Dict -> Dict
type family AllFrames (f :: Type -> Constraint) (ts :: [Type]) (ds :: [Nat])
:: Constraint where
AllFrames _ '[] _ = ()
AllFrames f (t ': ts) ds = (f (DataFrame t ds), AllFrames f ts ds)
class IndexFrame t d ds where
(!) :: DataFrame t (d ': ds) -> Word -> DataFrame t ds
instance (PrimArray t (DataFrame t '[d]), KnownDim d)
=> IndexFrame (t :: Type) (d :: Nat) '[] where
{-# INLINE (!) #-}
(!) df i
#ifndef UNSAFE_INDICES
| i >= dimVal' @d = outOfDimBoundsNoCallStack "IndexFrame.(!)"
i (dimVal' @d) Nothing Nothing
| otherwise
#endif
= S (ixOff (fromIntegral i) df)
instance {-# INCOHERENT #-}
( PrimArray t (DataFrame t (d ': ds))
, KnownDim d, KnownBackend t ds)
=> IndexFrame (t :: Type) (d :: Nat) ds where
{-# INLINE (!) #-}
(!) df i
#ifndef UNSAFE_INDICES
| i >= dimVal' @d = outOfDimBoundsNoCallStack "IndexFrame.(!)"
i (dimVal' @d) Nothing Nothing
| otherwise
#endif
= withArrayContent broadcast
(\(CumulDims ~(_:ss@(s:_))) off0 ->
fromElems (CumulDims ss) (case s*i of W# off -> off0 +# word2Int# off)
) df
instance IndexFrame ('[] :: [Type]) (d :: Nat) ds where
{-# INLINE (!) #-}
(!) Z _ = Z
instance (IndexFrame t d ds, IndexFrame ts d ds)
=> IndexFrame ((t ': ts) :: [Type]) (d :: Nat) ds where
{-# INLINE (!) #-}
(!) (df :*: dfs) i = df ! i :*: dfs ! i
instance PrimBytes t
=> IndexFrame (t :: Type) (xd :: XNat) xds where
{-# INLINE (!) #-}
(!) (XFrame df) i
| D :* (Dims :: Dims ns) <- dims `inSpaceOf` df
, Dict <- inferKnownBackend @t @ns
= XFrame (df ! i)
(!) _ _ = error "IndexFrame: impossible pattern"
instance (RepresentableList ts, All PrimBytes ts)
=> IndexFrame (ts :: [Type]) (xd :: XNat) xds where
{-# INLINE (!) #-}
(!) (XFrame df) i
| (D :: Dim n) :* (Dims :: Dims ns) <- dims `inSpaceOf` df
, Dict <- getTsEvs @ts @n @ns tList
= XFrame (df ! i)
where
getTsEvs :: forall (as :: [Type]) (d :: Nat) (ds :: [Nat])
. ( All PrimBytes as, KnownBackends as (d ': ds)
, Dimensions ds, KnownDim d)
=> TypeList as -> Dict (IndexFrame as d ds, KnownBackends as ds)
getTsEvs U = Dict
getTsEvs ((_ :: Proxy a) :* as')
| Dict <- getTsEvs @_ @d @ds as'
, Dict <- inferKnownBackend @a @ds = Dict
(!) _ _ = error "IndexFrame: impossible pattern"
type family SubFrameIndexCtx (d :: k) (idxN :: k) (subN :: k) :: Constraint where
SubFrameIndexCtx (n :: Nat) idxN subN
= (n + 1) ~ (idxN + subN)
SubFrameIndexCtx (N n) idxN subN
= ( (n + 1) ~ (DimBound idxN + DimBound subN)
, idxN ~ N (DimBound idxN)
, subN ~ N (DimBound subN)
)
SubFrameIndexCtx (XN m) idxN subN
= ( idxN ~ XN m
, subN ~ N (DimBound subN)
)
deriving instance Typeable (DataFrame (t :: l) (xs :: [k]))
deriving instance ( Data (DataFrame t xs)
, Typeable t, Typeable xs, Typeable k, Typeable l)
=> Data (DataFrame' (xs :: [k]) (t :: l))
deriving instance Eq (DFBackend t ds)
=> Eq (DataFrame t ds)
deriving instance Ord (DFBackend t ds)
=> Ord (DataFrame t ds)
deriving instance ProductOrder (DFBackend t ds)
=> ProductOrder (DataFrame t ds)
deriving instance Bounded (DFBackend t ds)
=> Bounded (DataFrame t ds)
deriving instance Enum (DFBackend t ds)
=> Enum (DataFrame t ds)
deriving instance Integral (DFBackend t ds)
=> Integral (DataFrame t ds)
deriving instance Num (DFBackend t ds)
=> Num (DataFrame t ds)
deriving instance Fractional (DFBackend t ds)
=> Fractional (DataFrame t ds)
deriving instance Floating (DFBackend t ds)
=> Floating (DataFrame t ds)
deriving instance Epsilon (DFBackend t ds)
=> Epsilon (DataFrame t ds)
deriving instance Real (DFBackend t ds)
=> Real (DataFrame t ds)
deriving instance RealExtras (DFBackend t ds)
=> RealExtras (DataFrame t ds)
deriving instance RealFrac (DFBackend t ds)
=> RealFrac (DataFrame t ds)
deriving instance RealFloat (DFBackend t ds)
=> RealFloat (DataFrame t ds)
deriving instance RealFloatExtras (DFBackend t ds)
=> RealFloatExtras (DataFrame t ds)
deriving instance PrimBytes (DFBackend t ds)
=> PrimBytes (DataFrame t ds)
deriving instance (PrimArray t (DFBackend t ds), PrimBytes t)
=> PrimArray t (DataFrame t ds)
instance Ord (NonTransitive.ProductOrd (DFBackend t ds))
=> Ord (NonTransitive.ProductOrd (DataFrame t ds)) where
(>) = coerce ((>) @(NonTransitive.ProductOrd (DFBackend t ds)))
(<) = coerce ((<) @(NonTransitive.ProductOrd (DFBackend t ds)))
(>=) = coerce ((>=) @(NonTransitive.ProductOrd (DFBackend t ds)))
(<=) = coerce ((<=) @(NonTransitive.ProductOrd (DFBackend t ds)))
compare = coerce (compare @(NonTransitive.ProductOrd (DFBackend t ds)))
min = coerce (min @(NonTransitive.ProductOrd (DFBackend t ds)))
max = coerce (max @(NonTransitive.ProductOrd (DFBackend t ds)))
instance (Ord (Partial.ProductOrd (DFBackend t ds)), Eq (DFBackend t ds))
=> Ord (Partial.ProductOrd (DataFrame t ds)) where
(>) = coerce ((>) @(Partial.ProductOrd (DFBackend t ds)))
(<) = coerce ((<) @(Partial.ProductOrd (DFBackend t ds)))
(>=) = coerce ((>=) @(Partial.ProductOrd (DFBackend t ds)))
(<=) = coerce ((<=) @(Partial.ProductOrd (DFBackend t ds)))
compare = coerce (compare @(Partial.ProductOrd (DFBackend t ds)))
min = coerce (min @(Partial.ProductOrd (DFBackend t ds)))
max = coerce (max @(Partial.ProductOrd (DFBackend t ds)))
instance PrimBytes (DataFrame t ds) => Storable (DataFrame t ds) where
sizeOf x = I# (byteSize x)
alignment x = I# (byteAlign x)
peek (Ptr addr) = IO (readAddr addr)
poke (Ptr addr) a = IO (\s -> (# writeAddr a addr s, () #))
instance AllFrames Eq ts ds => Eq (DataFrame (ts :: [Type]) ds) where
Z == Z = True
(a :*: as) == (b :*: bs) = a == b && as == bs
instance Eq t => Eq (DataFrame (t :: Type) (ds :: [XNat])) where
XFrame dfa == XFrame dfb
| Just Dict <- sameDims' dfa dfb = dfa == dfb
| otherwise = False
instance All Eq ts => Eq (DataFrame (ts :: [Type]) (ds :: [XNat])) where
XFrame dfa == XFrame dfb
| Just Dict <- sameDims' dfa dfb = eqFrames dfa dfb
| otherwise = False
instance Eq t => Eq (SomeDataFrame (t :: Type)) where
SomeDataFrame dfa == SomeDataFrame dfb
| Just Dict <- sameDims' dfa dfb = dfa == dfb
| otherwise = False
instance All Eq ts => Eq (SomeDataFrame (ts :: [Type])) where
SomeDataFrame dfa == SomeDataFrame dfb
| Just Dict <- sameDims' dfa dfb = eqFrames dfa dfb
| otherwise = False
eqFrames :: forall (xs :: [Type]) (ns :: [Nat])
. (KnownBackends xs ns, All Eq xs)
=> DataFrame xs ns -> DataFrame xs ns -> Bool
eqFrames Z Z = True
eqFrames (a :*: as) (b :*: bs) = a == b && eqFrames as bs
instance ( Show t
, PrimBytes t
, Dimensions ds
) => Show (DataFrame (t :: Type) (ds :: [Nat])) where
showsPrec p x = case dims @ds of
U -> showParen (p >= 10)
$ showString "S " . showsPrec 10 (unScalar x)
D0 :* _ -> showString "DF0"
d :* _ -> showParen (p >= 10)
$ unpackDF' ( \Dict f ->
let g :: Endo (Int -> ShowS)
g = Endo $ \k -> f (\o e -> k o . showChar ' ' . showsPrec 11 e)
n = dimVal d
in appEndo (stimes n g) (const $ showString "DF" . shows n)
) x
instance ( All Show ts
, All PrimBytes ts
, Dimensions ds
) => Show (DataFrame (ts :: [Type]) (ds :: [Nat])) where
showsPrec _ Z = showChar 'Z'
showsPrec p (x :*: xs) = showParen (p >= 7) $
showsPrec 7 x . showString " :*: " . showsPrec 6 xs
instance (Show t, PrimBytes t)
=> Show (DataFrame (t :: Type) (xns :: [XNat])) where
showsPrec p (XFrame x)
= showParen (p >= 10) $ showString "XFrame " . showsPrec 11 x
instance (All Show ts, All PrimBytes ts)
=> Show (DataFrame (ts :: [Type]) (xns :: [XNat])) where
showsPrec p (XFrame x)
= showParen (p >= 10) $ showString "XFrame " . showsPrec 11 x
instance (Show t, PrimBytes t)
=> Show (SomeDataFrame (t :: Type)) where
showsPrec p (SomeDataFrame x)
= showParen (p >= 10) $ showString "SomeDataFrame " . showsPrec 11 x
instance (All Show ts, All PrimBytes ts)
=> Show (SomeDataFrame (ts :: [Type])) where
showsPrec p (SomeDataFrame x)
= showParen (p >= 10) $ showString "SomeDataFrame " . showsPrec 11 x
instance (Read t, PrimBytes t, Dimensions ds)
=> Read (DataFrame (t :: Type) (ds :: [Nat])) where
readPrec = readPrecFixedDF (dims @ds)
readList = Read.readListDefault
readListPrec = Read.readListPrecDefault
instance (All Read ts, All PrimBytes ts, RepresentableList ts, Dimensions ds)
=> Read (DataFrame (ts :: [Type]) (ds :: [Nat])) where
readPrec = readFixedMultiDF (tList @ts) (dims @ds)
readList = Read.readListDefault
readListPrec = Read.readListPrecDefault
instance (Read t, PrimBytes t, BoundedDims ds, All KnownDimType ds)
=> Read (DataFrame (t :: Type) (ds :: [XNat])) where
readPrec = Read.parens . Read.prec 10 $ do
Read.lift . Read.expect $ Read.Ident "XFrame"
Read.step $ readPrecBoundedDF (minimalDims @ds)
readList = Read.readListDefault
readListPrec = Read.readListPrecDefault
instance ( All Read ts, All PrimBytes ts, RepresentableList ts
, BoundedDims ds, All KnownDimType ds)
=> Read (DataFrame (ts :: [Type]) (ds :: [XNat])) where
readPrec = Read.parens . Read.prec 10 $ do
Read.lift . Read.expect $ Read.Ident "XFrame"
Read.step $ readBoundedMultiDF (tList @ts) (minimalDims @ds)
readList = Read.readListDefault
readListPrec = Read.readListPrecDefault
instance (Read t, PrimBytes t)
=> Read (SomeDataFrame (t :: Type)) where
readPrec = Read.parens . Read.prec 10 $ do
Read.lift . Read.expect $ Read.Ident "SomeDataFrame"
Read.step readPrecSomeDF
readList = Read.readListDefault
readListPrec = Read.readListPrecDefault
instance ( All Read ts, All PrimBytes ts, RepresentableList ts )
=> Read (SomeDataFrame (ts :: [Type])) where
readPrec = Read.parens . Read.prec 10 $ do
Read.lift . Read.expect $ Read.Ident "SomeDataFrame"
Read.step $ readSomeMultiDF (tList @ts)
readList = Read.readListDefault
readListPrec = Read.readListPrecDefault
readPrecFixedDF :: forall (t :: Type) (ds :: [Nat])
. (Read t, PrimBytes t)
=> Dims ds -> Read.ReadPrec (DataFrame t ds)
readPrecFixedDF U
= Read.parens . Read.prec 10 $ do
Read.lift . Read.expect $ Read.Ident "S"
S <$> Read.step Read.readPrec
readPrecFixedDF (D0 :* Dims)
= Read.parens $ do
Read.lift . Read.expect . Read.Ident $ "DF0"
return (packDF @t @0)
readPrecFixedDF (d@D :* ds@Dims)
= Read.parens . Read.prec 10 $ do
Read.lift . Read.expect . Read.Ident $ "DF" ++ show (dimVal d)
packDF' (<*> Read.step (readPrecFixedDF ds)) pure
readPrecBoundedDF :: forall (t :: Type) (ds :: [XNat])
. (Read t, PrimBytes t, All KnownDimType ds)
=> Dims ds -> Read.ReadPrec (DataFrame t ds)
readPrecBoundedDF U
= Read.parens . Read.prec 10 $ do
Read.lift . Read.expect $ Read.Ident "S"
case inferKnownBackend @t @'[] of
Dict -> XFrame . S <$> Read.step Read.readPrec
readPrecBoundedDF (Dn D0 :* XDims (Dims :: Dims ns))
= Read.parens $ do
Read.lift . Read.expect . Read.Ident $ "DF0"
return $ case inferKnownBackend @t @(0 ': ns) of
Dict -> XFrame @Type @t @ds @(0 ': ns) (packDF @t @0 @ns)
readPrecBoundedDF (Dn d@(D :: Dim n) :* xns)
= Read.parens . Read.prec 10 $ do
Read.lift . Read.expect . Read.Ident $ "DF" ++ show (dimVal d)
XFrame (x :: DataFrame t ns) <- Read.step $ readPrecBoundedDF @t xns
case inferKnownBackend @t @(n ': ns) of
Dict -> fmap XFrame . snd . runDelay $ packDF' @t @n @ns
(readDelayed $ Read.prec 10 (readPrecFixedDF @t @ns dims))
(followedBy x)
readPrecBoundedDF ((Dx (m :: Dim m) :: Dim xm) :* xns)
| Dict <- unsafeEqTypes @XNat @('XN m) @xm
= Read.parens $ lookLex >>= \case
Read.Ident ('D':'F':s)
| Just (Dx (n :: Dim n)) <- (Read.readMaybe ('D':s) :: Maybe SomeDim)
, Just Dict <- lessOrEqDim m n
-> case n of
D0 -> do
XFrame x <- readPrecBoundedDF @t (Dn D0 :* xns)
return (XFrame x)
D -> do
Read.lift . Read.expect . Read.Ident $ "DF" ++ show (dimVal n)
XFrame (x :: DataFrame t ns) <- Read.prec 10 $ readPrecBoundedDF @t xns
case inferKnownBackend @t @(n ': ns) of
Dict -> fmap XFrame . snd . runDelay $ packDF' @t @n @ns
(readDelayed $ Read.prec 10 (readPrecFixedDF @t @ns dims))
(followedBy x)
_ -> Read.pfail
readPrecSomeDF :: forall (t :: Type) . (Read t, PrimBytes t)
=> Read.ReadPrec (SomeDataFrame t)
readPrecSomeDF = Read.parens $
Read.prec 10 (do
Read.lift . Read.expect $ Read.Ident "S"
case inferKnownBackend @t @'[] of
Dict -> SomeDataFrame . S <$> Read.readPrec
)
Read.+++
(lookLex >>= \case
Read.Ident ('D':'F':s)
| Just (Dx (d@D :: Dim d)) <- (Read.readMaybe ('D':s) :: Maybe SomeDim)
-> case d of
D0 | Dict <- inferKnownBackend @t @'[0]
-> SomeDataFrame <$> readPrecFixedDF @t (D0 :* U)
_ -> do
Read.lift . Read.expect . Read.Ident $ "DF" ++ show (dimVal d)
SomeDataFrame (x :: DataFrame t ds) <- Read.prec 10 $ readPrecSomeDF @t
case inferKnownBackend @t @(d ': ds) of
Dict -> fmap SomeDataFrame . snd . runDelay $ packDF' @t @d @ds
(readDelayed $ Read.prec 10 (readPrecFixedDF @t @ds dims))
(followedBy x)
_ -> Read.pfail
)
readFixedMultiDF :: forall (ts :: [Type]) (ds :: [Nat])
. (All Read ts, All PrimBytes ts)
=> TypeList ts
-> Dims ds
-> Read.ReadPrec (DataFrame ts ds)
readFixedMultiDF U _ = Read.parens $
Z <$ Read.lift (Read.expect $ Read.Ident "Z")
readFixedMultiDF (_ :* ts) ds = Read.parens . Read.prec 6 $ do
x <- Read.step $ readPrecFixedDF ds
Read.lift . Read.expect $ Read.Symbol ":*:"
xs <- readFixedMultiDF ts ds
return (x :*: xs)
readBoundedMultiDF :: forall (ts :: [Type]) (ds :: [XNat])
. (All Read ts, All PrimBytes ts, All KnownDimType ds)
=> TypeList ts
-> Dims ds
-> Read.ReadPrec (DataFrame ts ds)
readBoundedMultiDF U (XDims (Dims :: Dims ns))
= Read.parens $
XFrame @[Type] @'[] @ds @ns Z <$ Read.lift (Read.expect $ Read.Ident "Z")
readBoundedMultiDF ((_ :: Proxy t) :* ts@TypeList) ds
= Read.parens . Read.prec 6 $ do
XFrame (x :: DataFrame t ns) <- Read.step $ readPrecBoundedDF @t ds
Read.lift . Read.expect $ Read.Symbol ":*:"
xs <- readFixedMultiDF ts (dims @ns)
case inferKnownBackend @ts @ns of
Dict -> return $ XFrame (x :*: xs)
readSomeMultiDF :: forall (ts :: [Type])
. (All Read ts, All PrimBytes ts)
=> TypeList ts
-> Read.ReadPrec (SomeDataFrame ts)
readSomeMultiDF U
= Read.parens $
SomeDataFrame @[Type] @ts @'[] Z <$ Read.lift (Read.expect $ Read.Ident "Z")
readSomeMultiDF ((_ :: Proxy t) :* ts@TypeList)
= Read.parens . Read.prec 6 $ do
SomeDataFrame (x :: DataFrame t ns) <- Read.step $ readPrecSomeDF @t
Read.lift . Read.expect $ Read.Symbol ":*:"
xs <- readFixedMultiDF ts (dims @ns)
case inferKnownBackend @ts @ns of
Dict -> return $ SomeDataFrame (x :*: xs)
newtype Delayed t ds c a = Delayed { runDelay :: (c (DataFrame t ds), c a) }
followedBy :: Applicative c => DataFrame t ds -> a -> Delayed t ds c a
followedBy x = Delayed . (,) (pure x) . pure
readDelayed :: forall (t :: Type) (ds :: [Nat]) (c :: Type -> Type) (r :: Type)
. Applicative c
=> c (DataFrame t ds)
-> Delayed t ds c (DataFrame t ds -> r) -> Delayed t ds c r
readDelayed readF (Delayed (cprev, cf)) = Delayed (readF, cf <*> cprev)
lookLex :: Read.ReadPrec Read.Lexeme
lookLex = Read.look >>=
Read.choice . map (pure . fst) . Read.readPrec_to_S Read.lexP 10
inferPrimElem
:: forall (t :: Type) (d :: Nat) (ds :: [Nat])
. KnownBackend t (d ': ds)
=> DataFrame t (d ': ds) -> Dict (PrimBytes t)
inferPrimElem = Backend.inferPrimElem . getSingleFrame
fromFlatList :: forall (t :: Type) (ds :: [Nat])
. PrimArray t (DataFrame t ds)
=> Dims ds -> t -> [t] -> DataFrame t ds
fromFlatList = unsafeFromFlatList
pattern S :: forall (t :: Type) . t -> DataFrame t ('[] :: [Nat])
pattern S x <- (unScalar -> x)
where
S = scalar
{-# COMPLETE S #-}
pattern DF2 :: forall (t :: Type) (ds :: [Nat])
. (PrimBytes t, Dimensions (2 ': ds))
=> (Dimensions ds, KnownBackend t ds)
=> DataFrame t ds -> DataFrame t ds -> DataFrame t (2 ': ds)
pattern DF2 a1 a2
<- (unpackDF @t @2 @ds (#,,#) -> (# a1,a2,Dict #))
where DF2 = packDF @t @2 @ds
{-# COMPLETE DF2 #-}
pattern DF3 :: forall (t :: Type) (ds :: [Nat])
. (PrimBytes t, Dimensions (3 ': ds))
=> (Dimensions ds, KnownBackend t ds)
=> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t (3 ': ds)
pattern DF3 a1 a2 a3
<- (unpackDF @t @3 @ds (#,,,#) -> (# a1,a2,a3,Dict #))
where DF3 = packDF @t @3 @ds
{-# COMPLETE DF3 #-}
pattern DF4 :: forall (t :: Type) (ds :: [Nat])
. (PrimBytes t, Dimensions (4 ': ds))
=> (Dimensions ds, KnownBackend t ds)
=> DataFrame t ds -> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t (4 ': ds)
pattern DF4 a1 a2 a3 a4
<- (unpackDF @t @4 @ds (#,,,,#) -> (# a1,a2,a3,a4,Dict #))
where DF4 = packDF @t @4 @ds
{-# COMPLETE DF4 #-}
pattern DF5 :: forall (t :: Type) (ds :: [Nat])
. (PrimBytes t, Dimensions (5 ': ds))
=> (Dimensions ds, KnownBackend t ds)
=> DataFrame t ds -> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t ds
-> DataFrame t (5 ': ds)
pattern DF5 a1 a2 a3 a4 a5
<- (unpackDF @t @5 @ds (#,,,,,#) -> (# a1,a2,a3,a4,a5,Dict #))
where DF5 = packDF @t @5 @ds
{-# COMPLETE DF5 #-}
pattern DF6 :: forall (t :: Type) (ds :: [Nat])
. (PrimBytes t, Dimensions (6 ': ds))
=> (Dimensions ds, KnownBackend t ds)
=> DataFrame t ds -> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t ds -> DataFrame t ds
-> DataFrame t (6 ': ds)
pattern DF6 a1 a2 a3 a4 a5 a6
<- (unpackDF @t @6 @ds (#,,,,,,#) -> (# a1,a2,a3,a4,a5,a6,Dict #))
where DF6 = packDF @t @6 @ds
{-# COMPLETE DF6 #-}
pattern DF7 :: forall (t :: Type) (ds :: [Nat])
. (PrimBytes t, Dimensions (7 ': ds))
=> (Dimensions ds, KnownBackend t ds)
=> DataFrame t ds -> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t (7 ': ds)
pattern DF7 a1 a2 a3 a4 a5 a6 a7
<- (unpackDF @t @7 @ds (#,,,,,,,#) -> (# a1,a2,a3,a4,a5,a6,a7,Dict #))
where DF7 = packDF @t @7 @ds
{-# COMPLETE DF7 #-}
pattern DF8 :: forall (t :: Type) (ds :: [Nat])
. (PrimBytes t, Dimensions (8 ': ds))
=> (Dimensions ds, KnownBackend t ds)
=> DataFrame t ds -> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t ds -> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t (8 ': ds)
pattern DF8 a1 a2 a3 a4 a5 a6 a7 a8
<- (unpackDF @t @8 @ds (#,,,,,,,,#) -> (# a1,a2,a3,a4,a5,a6,a7,a8,Dict #))
where DF8 = packDF @t @8 @ds
{-# COMPLETE DF8 #-}
pattern DF9 :: forall (t :: Type) (ds :: [Nat])
. (PrimBytes t, Dimensions (9 ': ds))
=> (Dimensions ds, KnownBackend t ds)
=> DataFrame t ds -> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t ds -> DataFrame t ds -> DataFrame t ds -> DataFrame t ds
-> DataFrame t ds
-> DataFrame t (9 ': ds)
pattern DF9 a1 a2 a3 a4 a5 a6 a7 a8 a9
<- (unpackDF @t @9 @ds (#,,,,,,,,,#) -> (# a1,a2,a3,a4,a5,a6,a7,a8,a9,Dict #))
where DF9 = packDF @t @9 @ds
{-# COMPLETE DF9 #-}
type family PackDF (t :: Type) (ds :: [Nat]) (d :: Nat) (r :: Type) :: Type where
PackDF _ _ 0 r = r
PackDF t ds d r = DataFrame t ds -> PackDF t ds (d - 1) r
packDF :: forall (t :: Type) (d :: Nat) (ds :: [Nat])
. (PrimBytes t, Dimensions (d ': ds))
=> PackDF t ds d (DataFrame t (d ': ds))
packDF
| d :* Dims <- dims @(d ': ds)
, Dict <- inferKnownBackend @t @(d ': ds)
, Dict <- inferKnownBackend @t @ds
= go d
| otherwise = error "Numeric.DataFrame.Type.packDF: impossible args"
where
go :: (Dimensions ds, KnownBackend t ds, KnownBackend t (d ': ds))
=> Dim d
-> PackDF t ds d (DataFrame t (d ': ds))
go d = recur d getResult
where
els = case dimVal d of W# w -> word2Int# w
asize = byteSize @(DataFrame t ds) undefined
getResult :: forall rRep (r :: TYPE rRep)
. (forall s. Int# -> MutableByteArray# s -> State# s -> r)
-> r
getResult f = runRW#
( \s0 -> case newByteArray# (asize *# els) s0 of
(# s1, mba #) -> f 0# mba s1
)
recur :: forall n . Dim n
-> (forall rRep (r :: TYPE rRep)
. (forall s. Int# -> MutableByteArray# s -> State# s -> r ) -> r)
-> PackDF t ds n (DataFrame t (d ': ds))
recur n f = case minusDimM n (D :: Dim 1) of
Nothing -> case unsafeEqTypes @Nat @n @0 of
Dict -> f (\_ mba s -> case unsafeFreezeByteArray# mba s of
(# _, ba #) -> fromBytes 0# ba )
Just n' -> case unsafeEqTypes @_
@(PackDF t ds n (DataFrame t (d ': ds)))
@(DataFrame t ds -> PackDF t ds (n - 1) (DataFrame t (d ': ds))) of
Dict -> \x -> recur n'
( \c -> f (\off mba s -> c (off +# asize) mba (writeBytes mba off x s)) )
unpackDF :: forall (t :: Type) (d :: Nat) (ds :: [Nat])
(rep :: RuntimeRep) (r :: TYPE rep)
. (PrimBytes t, Dimensions (d ': ds))
=> PackDF t ds d (Dict (Dimensions ds, KnownBackend t ds) -> r)
-> DataFrame t (d ': ds) -> r
unpackDF c
| d :* Dims <- dims @(d ': ds)
= unpackDF' (go d)
| otherwise = error "Numeric.DataFrame.Type.unpackDF: impossible args"
where
go :: forall a . (a ~ Dict (Dimensions ds, KnownBackend t ds))
=> Dim d -> a
-> (forall (zRep :: RuntimeRep) (z :: TYPE zRep)
. (Int -> DataFrame t ds -> z) -> Int -> z)
-> Int -> r
go d a k = recur d (const c)
where
recur :: forall n
. Dim n
-> (Int -> PackDF t ds n (a -> r))
-> Int -> r
recur n f = case minusDimM n (D :: Dim 1) of
Nothing -> case unsafeEqTypes @Nat @n @0 of
Dict -> (`f` a)
Just n' -> case unsafeEqTypes @_
@(PackDF t ds n (a -> r))
@(DataFrame t ds -> PackDF t ds (n - 1) (a -> r)) of
Dict -> recur n' (k f)
packDF' :: forall (t :: Type) (d :: Nat) (ds :: [Nat]) c
. (PrimBytes t, Dimensions (d ': ds))
=> (forall r. c (DataFrame t ds -> r) -> c r)
-> (forall r. r -> c r)
-> c (DataFrame t (d ': ds))
packDF' k z
| d :* _ <- dims @(d ': ds)
= go d (z (packDF @t @d @ds))
| otherwise = error "Numeric.DataFrame.Type.packDF': impossible args"
where
go :: forall n . Dim n
-> c (PackDF t ds n (DataFrame t (d ': ds))) -> c (DataFrame t (d ': ds))
go n = case minusDimM n (D :: Dim 1) of
Nothing -> case unsafeEqTypes @Nat @n @0 of Dict -> id
Just n' -> case unsafeEqTypes @_
@(PackDF t ds n (DataFrame t (d ': ds)))
@(DataFrame t ds -> PackDF t ds (n - 1) (DataFrame t (d ': ds))) of
Dict -> go n' . k
unpackDF' :: forall (rep :: RuntimeRep)
(t :: Type) (d :: Nat) (ds :: [Nat]) (r :: TYPE rep)
. (PrimBytes t, Dimensions (d ': ds))
=> ( Dict (Dimensions ds, KnownBackend t ds)
-> (forall (zRep :: RuntimeRep) (z :: TYPE zRep)
. (Int -> DataFrame t ds -> z) -> Int -> z)
-> Int -> r)
-> DataFrame t (d ': ds)
-> r
unpackDF' k
| d :* Dims <- dims @(d ': ds)
, Dict <- inferKnownBackend @t @(d ': ds)
, Dict <- inferKnownBackend @t @ds
= withArrayContent
( \x ->
let e = broadcast x
f :: forall (zr :: RuntimeRep) (z :: TYPE zr)
. (Int -> DataFrame t ds -> z) -> Int -> z
f consume = (`consume` e)
in k Dict f 0
)
( \cdims off arr ->
let cd = CumulDims . tail $ unCumulDims cdims
td = cdTotalDim# cd
n = case dimVal d of W# w -> word2Int# w
f :: forall (zr :: RuntimeRep) (z :: TYPE zr)
. (Int -> DataFrame t ds -> z) -> Int -> z
f consume (I# o) = consume (I# (o -# td)) (fromElems cd o arr)
in k Dict f (I# (off +# td *# (n -# 1#)))
)
| otherwise = error "Numeric.DataFrame.Type.unpackDF: impossible args"
appendDF :: forall (n :: Nat) (m :: Nat) (ds :: [Nat]) (t :: Type)
. ( PrimBytes t, Dimensions ds, KnownDim n, KnownDim m )
=> DataFrame t (n :+ ds)
-> DataFrame t (m :+ ds)
-> DataFrame t ((n + m) :+ ds)
appendDF
| D <- D @n `plusDim` D @m
, Dict <- inferKnownBackend @t @(n :+ ds)
, Dict <- inferKnownBackend @t @(m :+ ds)
, Dict <- inferKnownBackend @t @((n + m) :+ ds)
= unsafeAppendPB
| otherwise = error "Numeri.DataFrame.Type/appendDF: impossible arguments"
consDF :: forall (n :: Nat) (ds :: [Nat]) (t :: Type)
. ( PrimBytes t, Dimensions ds, KnownDim n )
=> DataFrame t ds
-> DataFrame t (n :+ ds)
-> DataFrame t ((n + 1) :+ ds)
consDF
| D <- D @n `plusDim` D1
, Dict <- inferKnownBackend @t @(n :+ ds)
, Dict <- inferKnownBackend @t @ds
, Dict <- inferKnownBackend @t @((n + 1) :+ ds)
= unsafeAppendPB
| otherwise = error "Numeri.DataFrame.Type/consDF: impossible arguments"
snocDF :: forall (n :: Nat) (ds :: [Nat]) (t :: Type)
. ( PrimBytes t, Dimensions ds, KnownDim n )
=> DataFrame t (n :+ ds)
-> DataFrame t ds
-> DataFrame t ((n + 1) :+ ds)
snocDF
| D <- D @n `plusDim` D1
, Dict <- inferKnownBackend @t @(n :+ ds)
, Dict <- inferKnownBackend @t @ds
, Dict <- inferKnownBackend @t @((n + 1) :+ ds)
= unsafeAppendPB
| otherwise = error "Numeri.DataFrame.Type/snocDF: impossible arguments"
unsafeAppendPB :: forall x y z
. (PrimBytes x, PrimBytes y, PrimBytes z)
=> x -> y -> z
unsafeAppendPB x y = go (byteSize x) (byteSize y)
where
go :: Int# -> Int# -> z
go 0# _ = fromBytes (byteOffset y) (getBytes y)
go _ 0# = fromBytes (byteOffset x) (getBytes x)
go sx sy = case runRW#
( \s0 -> case newByteArray# (sx +# sy) s0 of
(# s1, mba #) -> unsafeFreezeByteArray# mba
( writeBytes mba sx y
( writeBytes mba 0# x s1))
) of (# _, r #) -> fromBytes 0# r
fromListWithDefault :: forall (t :: Type) (d :: Nat) (ds :: [Nat])
. (PrimBytes t, Dimensions (d ': ds))
=> DataFrame t ds -> [DataFrame t ds] -> DataFrame t (d ': ds)
fromListWithDefault d ds = snd $ packDF' f ((,) ds)
where
f :: forall r . ([DataFrame t ds], DataFrame t ds -> r) -> ([DataFrame t ds], r)
f ([] , k) = ([], k d)
f (x:xs, k) = (xs, k x)
fromList :: forall (t :: Type) (ds :: [Nat]) (xds :: [XNat])
. (PrimBytes t, Dimensions ds, xds ~ Map N ds, ds ~ UnMap N xds)
=> [DataFrame t ds] -> DataFrame t (XN 0 ': xds)
fromList xs
| Dx (D :: Dim n) <- someDimVal . fromIntegral $ length xs
, Dict <- inferKnownBackend @t @(n ': ds)
, Dict <- unsafeEqTypes @_ @ds @(DimsBound xds)
, Dict <- inferExactFixedDims (dims @ds)
= XFrame (fromListWithDefault @t @n @ds undefined xs)
| otherwise
= case Dict @(ds ~ UnMap N xds) of
Dict ->
error "Numeri.DataFrame.Type/fromList: impossible arguments"
constrainDF :: forall (ds :: [XNat]) (ys :: [XNat]) t
. (BoundedDims ds, All KnownDimType ds)
=> DataFrame t ys -> Maybe (DataFrame t ds)
constrainDF (XFrame (df :: DataFrame t ns))
| ns <- dims @ns
= case constrainDims @ds ns of
Just (XDims (Dims :: Dims ms))
| Dict <- unsafeEqTypes @[Nat] @ns @ms
-> Just $ XFrame df
_ -> Nothing
asDiag :: forall (n :: Nat) (m :: Nat) (ds :: [Nat]) (t :: Type)
. ( Dimensions ds, KnownDim n, KnownDim m
, KnownBackend t (Min n m :+ ds)
, KnownBackend t (n :+ m :+ ds)
, PrimBytes t)
=> DataFrame t (Min n m :+ ds)
-> DataFrame t (n :+ m :+ ds)
asDiag x
| elemSize <- byteSize @t undefined
, dMinNM@D <- minDim (D @n) (D @m)
, xba <- getBytes x
, ds <- dims @ds
, steps@(CumulDims (elemsNR:_:elemsNE:_)) <- cumulDims (D @n :* D @m :* ds)
, m <- dimVal' @m
, bsE <- case elemsNE of W# w -> word2Int# w *# elemSize
, bsR <- case elemsNR of W# w -> word2Int# w *# elemSize
, bsShift <- case m + 1 of W# w -> word2Int# w *# bsE
, bsLim <- case m * dimVal dMinNM of W# w -> word2Int# w *# bsE
= case runRW#
( \s0 -> case newByteArray# bsR s0 of
(# s1, mba #) ->
let go offSrc offDst s
| isTrue# (offDst >=# bsLim) = s
| otherwise = go (offSrc +# bsE) (offDst +# bsShift)
(copyByteArray# xba offSrc mba offDst bsE s)
in unsafeFreezeByteArray# mba
(go (byteOffset x) 0# (setByteArray# mba 0# bsR 0# s1))
) of (# _, r #) -> fromElems steps 0# r
| otherwise
= error "Numeri.DataFrame.Type/asDiag: impossible arguments"
{-# INLINE asDiag #-}
newtype Off c z = Off { runOff :: Int -> c z }
instance (Data t, PrimBytes t, Typeable ds)
=> Data (DataFrame (t :: Type) (ds :: [Nat])) where
gfoldl k z v = case typeableDims @ds of
U | S x <- v
-> z S `k` x
D :* (Dims :: Dims ns)
-> case inferTypeableCons @ds of
Dict ->
unpackDF' (\_ f -> runOff $ packDF'
(\g -> Off . f $ k . runOff g)
(Off . const . z)
) v
gunfold k z _ = case typeableDims @ds of
U -> k (z S)
D :* (Dims :: Dims ns)
-> case inferTypeableCons @ds of Dict -> packDF' k z
toConstr _ = case typeableDims @ds of
U -> scalarFrameConstr
d :* _ -> singleFrameConstr $ dimVal d
dataTypeOf _ = case typeableDims @ds of
U -> dataFrameDataType [scalarFrameConstr]
d :* _ -> dataFrameDataType . (:[]). singleFrameConstr $ dimVal d
instance (AllFrames Data ts ds, Typeable ts, Typeable ds)
=> Data (DataFrame (ts :: [Type]) (ds :: [Nat])) where
gfoldl _ z Z = z Z
gfoldl k z (x :*: xs) = case inferTypeableCons @ts of
Dict -> z (:*:) `k` x `k` xs
gunfold k z _ = case typeables @ts of
U -> z Z
_ :* _ -> case inferTypeableCons @ts of Dict -> k (k (z (:*:)))
toConstr Z = multiFrameZConstr
toConstr (_ :*: _) = multiFrameConsConstr
dataTypeOf _ = dataFrameDataType [multiFrameZConstr, multiFrameConsConstr]
dataFrameDataType :: [Constr] -> DataType
dataFrameDataType = mkDataType "Numeric.DataFrame.Type.DataFrame"
scalarFrameConstr :: Constr
scalarFrameConstr
= mkConstr (dataFrameDataType [scalarFrameConstr]) "S" [] Prefix
singleFrameConstr :: Word -> Constr
singleFrameConstr d
= mkConstr (dataFrameDataType [singleFrameConstr d]) ("DF" ++ show d) [] Prefix
multiFrameZConstr :: Constr
multiFrameZConstr = mkConstr
(dataFrameDataType [multiFrameZConstr, multiFrameConsConstr])
"Z" [] Prefix
multiFrameConsConstr :: Constr
multiFrameConsConstr = mkConstr
(dataFrameDataType [multiFrameZConstr, multiFrameConsConstr])
":*:" [] Infix
type DFMetaSel = 'G.MetaSel
'Nothing 'G.NoSourceUnpackedness 'G.NoSourceStrictness 'G.DecidedLazy
type family DFTree (t :: Type) (ds :: [Nat]) (d :: Nat) where
DFTree t ds 0 = G.U1
DFTree t ds 1 = G.S1 DFMetaSel (G.Rec0 (DataFrame t ds))
DFTree t ds n = DFTree t ds (Div n 2) G.:*: DFTree t ds (Div n 2 + Mod n 2)
type family SingleFrameRep (t :: Type) (ds :: [Nat]) :: (Type -> Type) where
SingleFrameRep t '[]
= G.C1 ('G.MetaCons "S" 'G.PrefixI 'False) (G.S1 DFMetaSel (G.Rec0 t))
SingleFrameRep t (d ': ds)
= G.C1 ('G.MetaCons (AppendSymbol "DF" (ShowNat d)) 'G.PrefixI 'False) (DFTree t ds d)
instance (PrimBytes t, Dimensions ds)
=> G.Generic (DataFrame (t :: Type) (ds :: [Nat])) where
type Rep (DataFrame t ds) = G.D1
('G.MetaData "DataFrame" "Numeric.DataFrame.Type" "easytensor" 'False)
( SingleFrameRep t ds )
from = G.M1 . fromSingleFrame (dims @ds)
to (G.M1 rep) = toSingleFrame (dims @ds) rep
fromSingleFrame :: forall (t :: Type) (ds :: [Nat]) (x :: Type)
. PrimBytes t
=> Dims ds
-> DataFrame t ds
-> SingleFrameRep t ds x
fromSingleFrame U (S x) = G.M1 . G.M1 $ G.K1 x
fromSingleFrame (dd@D :* (Dims :: Dims ds')) x
| Dict <- inferKnownBackend @t @ds
, Dict <- inferKnownBackend @t @ds'
= G.M1 $ withArrayContent
(\e -> fillRep @_ @ds' (const $ broadcast e) 0 dd)
(\cdims off arr ->
let cd = CumulDims . tail $ unCumulDims cdims
td = cdTotalDim# cd
in fillRep @_ @ds'
(\(W# i) -> fromElems cd (off +# td *# word2Int# i) arr) 0 dd
) x
where
fillRep :: forall (n :: Nat) (ns :: [Nat])
. (Word -> DataFrame t ns)
-> Word
-> Dim n
-> DFTree t ns n x
fillRep _ _ D0 = G.U1
fillRep f i D1 = G.M1 . G.K1 $ f i
fillRep f i d
| Dict <- unsafeEqTypes @(Type -> Type)
@(DFTree t ns n)
@(DFTree t ns (Div n 2) G.:*: DFTree t ns (Div n 2 + Mod n 2))
= fillRep f i d2 G.:*: fillRep f (i + dimVal d2) d2'
where
d2 = divDim d D2
d2' = d2 `plusDim` modDim d D2
toSingleFrame :: forall (t :: Type) (ds :: [Nat]) (x :: Type)
. PrimBytes t
=> Dims ds
-> SingleFrameRep t ds x
-> DataFrame t ds
toSingleFrame U (G.M1 (G.M1 (G.K1 x))) = S x
toSingleFrame (dd@D :* (Dims :: Dims ds')) (G.M1 rep)
| Dict <- inferKnownBackend @t @ds
, Dict <- inferKnownBackend @t @ds'
, els <- case dimVal dd of W# w -> word2Int# w
, asize <- byteSize @(DataFrame t ds') undefined
= runRW#
( \s0 -> case newByteArray# (asize *# els) s0 of
(# s1, mba #)
| s2 <- fillDF @_ @ds'
(\(W# i) df -> writeBytes mba (asize *# word2Int# i) df)
0 dd rep s1
, (# _, ba #) <- unsafeFreezeByteArray# mba s2
-> fromBytes 0# ba
)
where
fillDF :: forall (n :: Nat) (ns :: [Nat]) s
. (Word -> DataFrame t ns -> State# s -> State# s)
-> Word
-> Dim n
-> DFTree t ns n x
-> State# s -> State# s
fillDF _ _ D0 _ s = s
fillDF f i D1 (G.M1 (G.K1 e)) s = f i e s
fillDF f i d xy s
| Dict <- unsafeEqTypes @(Type -> Type)
@(DFTree t ns n)
@(DFTree t ns (Div n 2) G.:*: DFTree t ns (Div n 2 + Mod n 2))
, x G.:*: y <- xy
= fillDF f (i + dimVal d2) d2' y (fillDF f i d2 x s)
where
d2 = divDim d D2
d2' = d2 `plusDim` modDim d D2
{-# INLINE toSingleFrame #-}
type family MultiFrameRepNil (ts :: [Type]) :: (Type -> Type) where
MultiFrameRepNil '[] = G.C1 ('G.MetaCons "Z" 'G.PrefixI 'False) G.U1
MultiFrameRepNil (_ ': _) = G.Rec0 Void
type family MultiFrameRepCons (ts :: [Type]) (ds :: [Nat]) :: (Type -> Type) where
MultiFrameRepCons '[] _ = G.Rec0 Void
MultiFrameRepCons (t ': ts) ds = G.C1
('G.MetaCons ":*:" ('G.InfixI 'G.RightAssociative 6) 'False)
( G.S1 DFMetaSel
(G.Rec0 (DataFrame t ds))
G.:*:
G.S1 DFMetaSel
(G.Rec0 (DataFrame ts ds))
)
instance G.Generic (DataFrame (ts :: [Type]) (ds :: [Nat])) where
type Rep (DataFrame ts ds) = G.D1
('G.MetaData "DataFrame" "Numeric.DataFrame.Type" "easytensor" 'False)
( MultiFrameRepNil ts G.:+: MultiFrameRepCons ts ds )
from Z = G.M1 (G.L1 (G.M1 G.U1))
from (x :*: xs) = G.M1 (G.R1 (G.M1 (G.M1 (G.K1 x) G.:*: G.M1 (G.K1 xs))))
to (G.M1 (G.L1 _))
| Dict <- unsafeEqTypes @[Type] @ts @'[] = Z
to (G.M1 (G.R1 xxs))
| Dict <- unsafeEqTypes @[Type] @ts @(Head ts ': Tail ts)
, G.M1 (G.M1 (G.K1 x) G.:*: G.M1 (G.K1 xs)) <- xxs = x :*: xs
instance (AllFrames Eq ts ds, AllFrames Ord ts ds)
=> Ord (DataFrame (ts :: [Type]) ds) where
compare Z Z = EQ
compare (a :*: as) (b :*: bs) = compare a b <> compare as bs
withFixedDF1 :: forall (l :: Type) (ts :: l) (xns :: [XNat])
(rep :: RuntimeRep) (r :: TYPE rep)
. xns ~ Map 'N (DimsBound xns)
=> ( forall (ns :: [Nat])
. ( All KnownDimType xns, FixedDims xns ns
, Dimensions ns
, KnownBackends ts ns
, ns ~ DimsBound xns
, xns ~ Map 'N ns
) => DataFrame ts ns -> r
) -> DataFrame ts xns -> r
withFixedDF1 f (XFrame (df :: DataFrame ts ds))
| Dict <- unsafeEqTypes @_ @ds @(DimsBound xns)
= f df
{-# INLINE withFixedDF1 #-}
withFixedDF2 :: forall (l :: Type) (ts :: l) (xns :: [XNat])
(rep :: RuntimeRep) (r :: TYPE rep)
. xns ~ Map 'N (DimsBound xns)
=> ( forall (ns :: [Nat])
. ( All KnownDimType xns, FixedDims xns ns
, Dimensions ns
, KnownBackends ts ns
, ns ~ DimsBound xns
, xns ~ Map 'N ns
) => DataFrame ts ns -> DataFrame ts ns -> r
) -> DataFrame ts xns -> DataFrame ts xns -> r
withFixedDF2 f (XFrame (a :: DataFrame ts as)) (XFrame (b :: DataFrame ts bs))
| Dict <- unsafeEqTypes @_ @as @(DimsBound xns)
, Dict <- unsafeEqTypes @_ @bs @(DimsBound xns)
= f a b
{-# INLINE withFixedDF2 #-}
instance ( xns ~ Map 'N (DimsBound xns)
, Eq (DataFrame ts xns)
, Ord (DataFrame ts (DimsBound xns))
) => Ord (DataFrame (ts :: l) (xns :: [XNat])) where
compare = withFixedDF2 compare
(>=) = withFixedDF2 (>=)
(<=) = withFixedDF2 (<=)
(>) = withFixedDF2 (>)
(<) = withFixedDF2 (<)
min = withFixedDF2 ((.) XFrame . min)
max = withFixedDF2 ((.) XFrame . max)
instance ( Dimensions xns
, KnownBackends ts (DimsBound xns)
, Num (DataFrame ts (DimsBound xns))
) => Num (DataFrame (ts :: l) (xns :: [XNat])) where
(+) = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (+))
(-) = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (-))
(*) = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (*))
negate = withKnownXDims @xns $ withFixedDF1 (XFrame . negate)
abs = withKnownXDims @xns $ withFixedDF1 (XFrame . abs)
signum = withKnownXDims @xns $ withFixedDF1 (XFrame . signum)
fromInteger = withKnownXDims @xns
(XFrame . fromInteger @(DataFrame ts (DimsBound xns)))
instance ( Dimensions xns
, KnownBackends ts (DimsBound xns)
, Fractional (DataFrame ts (DimsBound xns))
) => Fractional (DataFrame (ts :: l) (xns :: [XNat])) where
(/) = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (/))
recip = withKnownXDims @xns $ withFixedDF1 (XFrame . recip)
fromRational = withKnownXDims @xns
(XFrame . fromRational @(DataFrame ts (DimsBound xns)))
instance ( Dimensions xns
, KnownBackends ts (DimsBound xns)
, Floating (DataFrame ts (DimsBound xns))
) => Floating (DataFrame (ts :: l) (xns :: [XNat])) where
pi = withKnownXDims @xns $ XFrame (pi :: DataFrame ts (DimsBound xns))
exp = withKnownXDims @xns $ withFixedDF1 (XFrame . exp)
log = withKnownXDims @xns $ withFixedDF1 (XFrame . log)
sqrt = withKnownXDims @xns $ withFixedDF1 (XFrame . sqrt)
sin = withKnownXDims @xns $ withFixedDF1 (XFrame . sin)
cos = withKnownXDims @xns $ withFixedDF1 (XFrame . cos)
tan = withKnownXDims @xns $ withFixedDF1 (XFrame . tan)
asin = withKnownXDims @xns $ withFixedDF1 (XFrame . asin)
acos = withKnownXDims @xns $ withFixedDF1 (XFrame . acos)
atan = withKnownXDims @xns $ withFixedDF1 (XFrame . atan)
sinh = withKnownXDims @xns $ withFixedDF1 (XFrame . sinh)
cosh = withKnownXDims @xns $ withFixedDF1 (XFrame . cosh)
tanh = withKnownXDims @xns $ withFixedDF1 (XFrame . tanh)
asinh = withKnownXDims @xns $ withFixedDF1 (XFrame . asinh)
acosh = withKnownXDims @xns $ withFixedDF1 (XFrame . acosh)
atanh = withKnownXDims @xns $ withFixedDF1 (XFrame . atanh)
(**) = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . (**))
logBase = withKnownXDims @xns $ withFixedDF2 ((.) XFrame . logBase)
instance ( xns ~ Map 'N (DimsBound xns)
, ProductOrder (DataFrame ts (DimsBound xns))
) => ProductOrder (DataFrame (ts :: l) (xns :: [XNat])) where
cmp = withFixedDF2 cmp
instance ( Dimensions xns
, KnownBackends ts (DimsBound xns)
, Bounded (DataFrame ts (DimsBound xns))
) => Bounded (DataFrame (ts :: l) (xns :: [XNat])) where
minBound = withKnownXDims @xns (XFrame (minBound :: DataFrame ts (DimsBound xns)))
maxBound = withKnownXDims @xns (XFrame (maxBound :: DataFrame ts (DimsBound xns)))
instance ( Dimensions xns
, KnownBackends ts (DimsBound xns)
, PrimBytes (DataFrame ts (DimsBound xns))
) => PrimBytes (DataFrame (ts :: l) (xns :: [XNat])) where
type PrimFields (DataFrame ts xns)
= PrimFields (DataFrame ts (DimsBound xns))
getBytes = withKnownXDims @xns $ withFixedDF1 getBytes
getBytesPinned = withKnownXDims @xns $ withFixedDF1 getBytesPinned
fromBytes i ba
= withKnownXDims @xns (XFrame (fromBytes i ba :: DataFrame ts (DimsBound xns)))
readBytes mba i s0
| (# s1, (a :: DataFrame ts (DimsBound xns)) #) <- readBytes mba i s0
= (# s1, withKnownXDims @xns (XFrame a) #)
writeBytes mba i = withKnownXDims @xns $ withFixedDF1 (writeBytes mba i)
readAddr addr s0
| (# s1, (a :: DataFrame ts (DimsBound xns)) #) <- readAddr addr s0
= (# s1, withKnownXDims @xns (XFrame a) #)
writeAddr = withKnownXDims @xns $ withFixedDF1 writeAddr
byteSize _ = withKnownXDims @xns (byteSize @(DataFrame ts (DimsBound xns)) undefined)
byteAlign _ = withKnownXDims @xns (byteAlign @(DataFrame ts (DimsBound xns)) undefined)
byteOffset = withKnownXDims @xns (withFixedDF1 byteOffset)
byteFieldOffset n _
= withKnownXDims @xns (byteFieldOffset @(DataFrame ts (DimsBound xns)) n undefined)
indexArray ba i
= withKnownXDims @xns (XFrame (indexArray ba i :: DataFrame ts (DimsBound xns)))
readArray mba i s0
| (# s1, (a :: DataFrame ts (DimsBound xns)) #) <- readArray mba i s0
= (# s1, withKnownXDims @xns (XFrame a) #)
writeArray mba i = withKnownXDims @xns (withFixedDF1 (writeArray mba i))
instance ( Dimensions xns
, KnownBackend t (DimsBound xns)
, PrimArray t (DataFrame t (DimsBound xns))
, PrimBytes t
) => PrimArray t (DataFrame t (xns :: [XNat])) where
broadcast#
= withKnownXDims @xns (XFrame . broadcast# @t @(DataFrame t (DimsBound xns)))
ix# i = withKnownXDims @xns (withFixedDF1 (ix# i))
gen# cd f s0
| (# s1, (a :: DataFrame t (DimsBound xns)) #) <- gen# cd f s0
= (# s1, withKnownXDims @xns (XFrame a) #)
upd# cd i t = withKnownXDims @xns (withFixedDF1 (XFrame . upd# cd i t))
withArrayContent# f g = withKnownXDims @xns (withFixedDF1 (withArrayContent f g))
offsetElems = withKnownXDims @xns (withFixedDF1 offsetElems)
uniqueOrCumulDims = withKnownXDims @xns (withFixedDF1 uniqueOrCumulDims)
fromElems# cd i ba
= withKnownXDims @xns (XFrame (fromElems cd i ba :: DataFrame t (DimsBound xns)))
instance ( Enum (DataFrame ts ('[] :: [Nat]))
, KnownBackends ts ('[] :: [Nat])
) => Enum (DataFrame (ts :: l) ('[] :: [XNat])) where
succ (XFrame x) = XFrame (succ x)
pred (XFrame x) = XFrame (pred x)
toEnum = XFrame . toEnum
fromEnum (XFrame x) = fromEnum x
enumFrom (XFrame x) = map XFrame $ enumFrom x
enumFromThen (XFrame x) (XFrame y) = map XFrame $ enumFromThen x y
enumFromTo (XFrame x) (XFrame y) = map XFrame $ enumFromTo x y
enumFromThenTo (XFrame x) (XFrame y) (XFrame z)
= map XFrame $ enumFromThenTo x y z
instance ( Epsilon (DataFrame ts ('[] :: [Nat]))
, KnownBackends ts ('[] :: [Nat])
, Eq (DataFrame ts ('[] :: [XNat]))
) => Epsilon (DataFrame (ts :: l) ('[] :: [XNat])) where
epsilon = XFrame epsilon
instance ( Real (DataFrame ts ('[] :: [Nat]))
, KnownBackends ts ('[] :: [Nat])
, Eq (DataFrame ts ('[] :: [XNat]))
) => Real (DataFrame (ts :: l) ('[] :: [XNat])) where
toRational (XFrame x) = toRational x
instance ( Integral (DataFrame ts ('[] :: [Nat]))
, KnownBackends ts ('[] :: [Nat])
, Eq (DataFrame ts ('[] :: [XNat]))
) => Integral (DataFrame (ts :: l) ('[] :: [XNat])) where
quot (XFrame x) (XFrame y) = XFrame (quot x y)
rem (XFrame x) (XFrame y) = XFrame (rem x y)
div (XFrame x) (XFrame y) = XFrame (div x y)
mod (XFrame x) (XFrame y) = XFrame (mod x y)
quotRem (XFrame x) (XFrame y) = (XFrame *** XFrame) (quotRem x y)
divMod (XFrame x) (XFrame y) = (XFrame *** XFrame) (divMod x y)
toInteger (XFrame x) = toInteger x
instance ( RealExtras (DataFrame t ('[] :: [Nat]))
, KnownBackend t ('[] :: [Nat])
, Eq t
) => RealExtras (DataFrame (t :: Type) ('[] :: [XNat])) where
copysign (XFrame x) (XFrame y) = XFrame (copysign x y)
instance ( RealFrac (DataFrame t ('[] :: [Nat]))
, KnownBackend t ('[] :: [Nat])
, Eq t
) => RealFrac (DataFrame (t :: Type) ('[] :: [XNat])) where
properFraction (XFrame x) = second XFrame (properFraction x)
truncate (XFrame x) = truncate x
round (XFrame x) = round x
ceiling (XFrame x) = ceiling x
floor (XFrame x) = floor x
instance ( RealFloat (DataFrame t ('[] :: [Nat]))
, KnownBackend t ('[] :: [Nat])
, Eq t
) => RealFloat (DataFrame (t :: Type) ('[] :: [XNat])) where
floatRadix = const (floatRadix @(DataFrame t ('[] :: [Nat])) undefined)
floatDigits = const (floatDigits @(DataFrame t ('[] :: [Nat])) undefined)
floatRange = const (floatRange @(DataFrame t ('[] :: [Nat])) undefined)
decodeFloat (XFrame x) = decodeFloat x
encodeFloat i = XFrame . encodeFloat i
exponent (XFrame x) = exponent x
significand (XFrame x) = XFrame (significand x)
scaleFloat i (XFrame x) = XFrame (scaleFloat i x)
isNaN (XFrame x) = isNaN x
isInfinite (XFrame x) = isInfinite x
isDenormalized (XFrame x) = isDenormalized x
isNegativeZero (XFrame x) = isNegativeZero x
isIEEE (XFrame x) = isIEEE x
atan2 (XFrame y) (XFrame x) = XFrame (atan2 y x)
instance ( RealFloatExtras (DataFrame t ('[] :: [Nat]))
, KnownBackend t ('[] :: [Nat])
, Eq t
) => RealFloatExtras (DataFrame (t :: Type) ('[] :: [XNat])) where
hypot (XFrame x) (XFrame y) = XFrame (hypot x y)
maxFinite = XFrame maxFinite
unsafeEqTypes :: forall k (a :: k) (b :: k) . Dict (a ~ b)
unsafeEqTypes = unsafeCoerce (Dict :: Dict (a ~ a))