#ifdef ghcjs_HOST_OS
#endif
module Numeric.DataFrame.SubSpace
( SubSpace (..), (!), element
, ewfoldMap, iwfoldMap
, ewzip, iwzip
) where
import GHC.Base (runRW#)
import GHC.Prim
import GHC.Types (Int (..), Type)
#ifdef ghcjs_HOST_OS
import GHCJS.Types (JSVal)
import Unsafe.Coerce (unsafeCoerce)
#endif
import qualified Numeric.Array.ElementWise as EW
import Numeric.Commons
import Numeric.DataFrame.Type
import Numeric.Dimensions
import Numeric.Dimensions.Traverse
import Numeric.TypeLits
import Numeric.Scalar
class ( ConcatList as bs asbs
, Dimensions as
, Dimensions bs
, Dimensions asbs
) => SubSpace (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])
| asbs as -> bs, asbs bs -> as, as bs -> asbs where
indexOffset# :: Int# -> Int# -> DataFrame t asbs -> DataFrame t as
(!.) :: Idx bs -> DataFrame t asbs -> DataFrame t as
(!.) i = case (# dimVal (dim @as), fromEnum i #) of (# I# n, I# j #) -> indexOffset# (n *# j) n
update :: Idx bs -> DataFrame t as -> DataFrame t asbs -> DataFrame t asbs
ewmap :: forall s (as' :: [Nat]) (asbs' :: [Nat])
. SubSpace s as' bs asbs'
=> (DataFrame s as' -> DataFrame t as)
-> DataFrame s asbs' -> DataFrame t asbs
iwmap :: forall s (as' :: [Nat]) (asbs' :: [Nat])
. SubSpace s as' bs asbs'
=> (Idx bs -> DataFrame s as' -> DataFrame t as)
-> DataFrame s asbs' -> DataFrame t asbs
ewgen :: DataFrame t as -> DataFrame t asbs
iwgen :: (Idx bs -> DataFrame t as) -> DataFrame t asbs
ewfoldl :: (b -> DataFrame t as -> b) -> b -> DataFrame t asbs -> b
iwfoldl :: (Idx bs -> b -> DataFrame t as -> b) -> b -> DataFrame t asbs -> b
ewfoldr :: (DataFrame t as -> b -> b) -> b -> DataFrame t asbs -> b
iwfoldr :: (Idx bs -> DataFrame t as -> b -> b) -> b -> DataFrame t asbs -> b
elementWise :: forall s (as' :: [Nat]) (asbs' :: [Nat]) f
. ( Applicative f
, SubSpace s as' bs asbs'
)
=> (DataFrame s as' -> f (DataFrame t as))
-> DataFrame s asbs' -> f (DataFrame t asbs)
indexWise :: forall s (as' :: [Nat]) (asbs' :: [Nat]) f
. ( Applicative f
, SubSpace s as' bs asbs'
)
=> (Idx bs -> DataFrame s as' -> f (DataFrame t as))
-> DataFrame s asbs' -> f (DataFrame t asbs)
infixr 4 !.
element :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) f
. (SubSpace t as bs asbs, Applicative f)
=> Idx bs
-> (DataFrame t as -> f (DataFrame t as))
-> DataFrame t asbs -> f (DataFrame t asbs)
element i f df = flip (update i) df <$> f (i !. df)
(!) :: SubSpace t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])
=> DataFrame t asbs -> Idx bs -> DataFrame t as
(!) = flip (!.)
infixl 4 !
ewfoldMap :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) m
. (Monoid m, SubSpace t as bs asbs)
=> (DataFrame t as -> m) -> DataFrame t asbs -> m
ewfoldMap f = ewfoldl (\m b -> m `seq` (mappend m $! f b)) mempty
iwfoldMap :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) m
. ( Monoid m, SubSpace t as bs asbs)
=> (Idx bs -> DataFrame t as -> m) -> DataFrame t asbs -> m
iwfoldMap f = iwfoldl (\i m b -> m `seq` (mappend m $! f i b)) mempty
iwzip :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])
s (as' :: [Nat]) (asbs' :: [Nat])
r (as'' :: [Nat]) (asbs'' :: [Nat])
. ( SubSpace t as bs asbs
, SubSpace s as' bs asbs'
, SubSpace r as'' bs asbs''
)
=> (Idx bs -> DataFrame t as -> DataFrame s as' -> DataFrame r as'')
-> DataFrame t asbs
-> DataFrame s asbs'
-> DataFrame r asbs''
iwzip f dft dfs = iwmap g dft
where
g i dft' = f i dft' (i !. dfs)
ewzip :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])
s (as' :: [Nat]) (asbs' :: [Nat])
r (as'' :: [Nat]) (asbs'' :: [Nat])
. ( SubSpace t as bs asbs
, SubSpace s as' bs asbs'
, SubSpace r as'' bs asbs''
)
=> (DataFrame t as -> DataFrame s as' -> DataFrame r as'')
-> DataFrame t asbs
-> DataFrame s asbs'
-> DataFrame r asbs''
ewzip = iwzip . const
#ifdef ghcjs_HOST_OS
foreign import javascript unsafe "$3.subarray($1,$1 + $2)" js_subarray :: Int# -> Int# -> JSVal -> JSVal
#endif
instance
( ConcatList as bs asbs
, Dimensions as
, Dimensions bs
, Dimensions asbs
, PrimBytes (DataFrame t as)
, PrimBytes (DataFrame t asbs)
, as ~ (a'' ': as'')
, asbs ~ (a'' ': asbs'')
) => SubSpace t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) where
#ifdef ghcjs_HOST_OS
indexOffset# i l = unsafeCoerce . js_subarray i l . unsafeCoerce
#else
indexOffset# i l d = case toBytes d of
(# off, _, arr #) -> fromBytes (# off +# i, l, arr #)
#endif
ewmap :: forall s (as' :: [Nat]) (asbs' :: [Nat])
. SubSpace s as' bs asbs'
=> (DataFrame s as' -> DataFrame t as)
-> DataFrame s asbs' -> DataFrame t asbs
ewmap f df
| elS <- elementByteSize (undefined :: DataFrame t asbs)
, I# lenBS <- totalDim (Proxy @bs)
, I# lenAS <- totalDim (Proxy @as)
, I# lenAS' <- totalDim (Proxy @as')
, lenASB <- lenAS *# elS
= case runRW#
( \s0 -> case newByteArray# (lenAS *# lenBS *# elS) s0 of
(# s1, marr #) -> case overDimOff_#
(dim @bs)
( \pos s -> case toBytes $ f (indexOffset# (pos *# lenAS') lenAS' df) of
(# offX, _, arrX #) -> copyByteArray# arrX (offX *# elS) marr (pos *# lenASB) lenASB s
) 0# 1# s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, r #) -> fromBytes (# 0#, lenAS *# lenBS, r #)
iwmap :: forall s (as' :: [Nat]) (asbs' :: [Nat])
. SubSpace s as' bs asbs'
=> (Idx bs -> DataFrame s as' -> DataFrame t as)
-> DataFrame s asbs' -> DataFrame t asbs
iwmap f df
| elS <- elementByteSize (undefined :: DataFrame t asbs)
, I# lenBS <- totalDim (Proxy @bs)
, I# lenAS <- totalDim (Proxy @as)
, I# lenAS' <- totalDim (Proxy @as')
, lenASB <- lenAS *# elS
= case runRW#
( \s0 -> case newByteArray# (lenAS *# lenBS *# elS) s0 of
(# s1, marr #) -> case overDim_#
(dim @bs)
( \i pos s -> case toBytes $ f i (indexOffset# (pos *# lenAS') lenAS' df) of
(# offX, _, arrX #) -> copyByteArray# arrX (offX *# elS) marr (pos *# lenASB) lenASB s
) 0# 1# s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, r #) -> fromBytes (# 0#, lenAS *# lenBS, r #)
ewgen x
| (# offX, lenX, arrX #) <- toBytes x
, I# lenASBS <- totalDim (Proxy @asbs)
, elS <- elementByteSize x
, offXB <- offX *# elS
, lenXB <- lenX *# elS
= case runRW#
( \s0 -> case newByteArray# (lenASBS *# elS) s0 of
(# s1, marr #) -> case overDimOff_# (dim @bs)
( \posB -> copyByteArray# arrX offXB marr posB lenXB )
0# lenXB s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, r #) -> fromBytes (# 0#, lenASBS, r #)
iwgen f
| I# lenASBS <- totalDim (Proxy @asbs)
, elS <- elementByteSize (undefined :: DataFrame t asbs)
, I# lenAS <- totalDim (Proxy @as)
, lenASB <- lenAS *# elS
= case runRW#
( \s0 -> case newByteArray# (lenASBS *# elS) s0 of
(# s1, marr #) -> case overDim_# (dim @bs)
( \i pos s -> case toBytes (f i) of
(# offX, _, arrX #) -> copyByteArray# arrX (offX *# elS) marr pos lenASB s
) 0# lenASB s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, r #) -> fromBytes (# 0#, lenASBS, r #)
ewfoldl f x0 df = case (# toBytes df, totalDim ( Proxy @as) #) of
(# (# off, _, arr #), I# step #) -> foldDimOff (dim @bs)
(\pos acc -> f acc $! fromBytes (# pos, step, arr #))
off step x0
iwfoldl f x0 df = case (# toBytes df, totalDim ( Proxy @as) #) of
(# (# off, _, arr #), I# step #) -> foldDim (dim @bs)
(\i pos acc -> f i acc $! fromBytes (# pos, step, arr #))
off step x0
ewfoldr f x0 df = case (# toBytes df, totalDim ( Proxy @as) #) of
(# (# off, len, arr #), I# step #) -> foldDimOff (dim @bs)
(\pos -> f (fromBytes (# pos, step, arr #)))
(off +# len -# step) (negateInt# step) x0
iwfoldr f x0 df = case (# toBytes df, totalDim ( Proxy @as) #) of
(# (# off, _, arr #), I# step #) -> foldDimReverse (dim @bs)
(\i pos -> f i (fromBytes (# pos, step, arr #)) )
off step x0
elementWise = indexWise . const
indexWise :: forall (s :: Type) (f :: Type -> Type) (as' :: [Nat]) (asbs' :: [Nat])
. ( Applicative f
, SubSpace s as' bs asbs'
)
=> (Idx bs -> DataFrame s as' -> f (DataFrame t as))
-> DataFrame s asbs' -> f (DataFrame t asbs)
indexWise f df = runWithState <$> iwfoldl applyF (pure initialState) df
where
runWithState :: ( State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))
-> DataFrame t asbs
runWithState g = case runRW#
( \s0 -> case g s0 of
(# s1, (# marr, _ #) #) -> unsafeFreezeByteArray# marr s1
) of (# _, arr #) -> fromBytes (# 0#, rezLength#, arr #)
initialState :: State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #)
initialState s0 = case newByteArray# (rezLength# *# rezElBSize#) s0 of
(# s1, marr #) -> (# s1, (# marr, 0# #) #)
updateChunk :: (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))
-> DataFrame t as
-> (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))
updateChunk g dfChunk = case toBytes dfChunk of
(# off#, _, arr# #) -> \s -> case g s of
(# s1, (# marr#, pos# #) #) -> case
copyByteArray# arr# (off# *# rezElBSize#)
marr# (pos# *# rezElBSize#)
(rezStepN# *# rezElBSize#) s1 of
s2 -> (# s2, (# marr#, pos# +# rezStepN# #) #)
applyF :: Idx bs
-> f (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))
-> DataFrame s as'
-> f (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))
applyF idx s dfChunk = idx `seq` dfChunk `seq` updateChunk <$> s <*> f idx dfChunk
rezElBSize# = elementByteSize (undefined :: DataFrame t asbs)
!(I# rezStepN#) = totalDim (Proxy @as)
!(I# rezLength#) = totalDim (Proxy @asbs)
update ei x df
| I# i <- fromEnum ei
, (# off, len, arr #) <- toBytes df
, (# offX, lenX, arrX #) <- toBytes x
, elS <- elementByteSize df
= case runRW#
( \s0 -> case newByteArray# ( len *# elS ) s0 of
(# s1, marr #) -> case copyByteArray# arr (off *# elS) marr 0# (len *# elS) s1 of
s2 -> case copyByteArray# arrX (offX *# elS) marr (lenX *# i *# elS) (lenX *# elS) s2 of
s3 -> unsafeFreezeByteArray# marr s3
) of (# _, r #) -> fromBytes (# 0#, len, r #)
instance
( Dimensions bs
, EW.ElementWise (Idx bs) t (DataFrame t bs)
, PrimBytes (DataFrame t bs)
) => SubSpace t ('[] :: [Nat]) (bs :: [Nat]) (bs :: [Nat]) where
indexOffset# i _ x = scalar (EW.indexOffset# x i)
i !. x = scalar $ x EW.! i
ewmap = iwmap . const
iwmap f x = EW.ewgen (\i -> unScalar $ f i (i !. x))
ewgen = EW.broadcast . unScalar
iwgen f = EW.ewgen (unScalar . f)
ewfoldl f = EW.ewfoldl (\_ a -> f a . scalar)
iwfoldl f = EW.ewfoldl (\i a -> f i a . scalar)
ewfoldr f = EW.ewfoldr (\_ x -> f (scalar x))
iwfoldr f = EW.ewfoldr (\i x -> f i (scalar x))
elementWise = indexWise . const
indexWise f x = EW.ewgenA (\i -> unScalar <$> f i (i !. x))
update i x = EW.update i (unScalar x)