{-# LANGUAGE CPP, TypeOperators #-}
-- | A 'Frame' is a finite 'Int'-indexed collection of rows.
module Frames.Frame where
import Data.Foldable
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import qualified Data.Vector as V
import Data.Vinyl.TypeLevel
import Frames.Rec (Record)
import Frames.RecF (rappend)

-- | A 'Frame' is a finite collection of rows indexed by 'Int'.
data Frame r = Frame { Frame r -> Int
frameLength :: !Int
                     , Frame r -> Int -> r
frameRow    :: Int -> r }

-- | A 'Frame' whose rows are 'Record' values.
type FrameRec rs = Frame (Record rs)

instance Functor Frame where
  fmap :: (a -> b) -> Frame a -> Frame b
fmap a -> b
f (Frame Int
len Int -> a
g) = Int -> (Int -> b) -> Frame b
forall r. Int -> (Int -> r) -> Frame r
Frame Int
len (a -> b
f (a -> b) -> (Int -> a) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
g)

-- | Build a 'Frame' from any 'Foldable'. This simply uses a boxed
-- 'V.Vector' to hold each row. If you have a collection of 'Record's,
-- consider using 'Frames.InCore.toFrame'.
boxedFrame :: Foldable f => f r -> Frame r
boxedFrame :: f r -> Frame r
boxedFrame f r
xs = Int -> (Int -> r) -> Frame r
forall r. Int -> (Int -> r) -> Frame r
Frame (Vector r -> Int
forall a. Vector a -> Int
V.length Vector r
v) (Vector r
v Vector r -> Int -> r
forall a. Vector a -> Int -> a
V.!)
  where v :: Vector r
v = [r] -> Vector r
forall a. [a] -> Vector a
V.fromList (f r -> [r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f r
xs)

instance Eq r => Eq (Frame r) where
  Frame Int
l1 Int -> r
r1 == :: Frame r -> Frame r -> Bool
== Frame Int
l2 Int -> r
r2 =
    Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l2 Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
i -> Int -> r
r1 Int
i r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> r
r2 Int
i) [Int
0 .. Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

-- | The 'Monoid' instance for 'Frame' provides a mechanism for
-- vertical concatenation of 'Frame's. That is, @f1 <> f2@ will return
-- a new 'Frame' with the rows of @f1@ followed by the rows of @f2@.
instance Monoid (Frame r) where
  mempty :: Frame r
mempty = Int -> (Int -> r) -> Frame r
forall r. Int -> (Int -> r) -> Frame r
Frame Int
0 (r -> Int -> r
forall a b. a -> b -> a
const (r -> Int -> r) -> r -> Int -> r
forall a b. (a -> b) -> a -> b
$ [Char] -> r
forall a. HasCallStack => [Char] -> a
error [Char]
"index out of bounds (empty frame)")
  Frame r
f1 mappend :: Frame r -> Frame r -> Frame r
`mappend` Frame r
f2 = Frame r
f1 Frame r -> Frame r -> Frame r
forall a. Semigroup a => a -> a -> a
<> Frame r
f2

instance Semigroup (Frame r) where
  Frame Int
l1 Int -> r
f1 <> :: Frame r -> Frame r -> Frame r
<> Frame Int
l2 Int -> r
f2 =
    Int -> (Int -> r) -> Frame r
forall r. Int -> (Int -> r) -> Frame r
Frame (Int
l1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l2) ((Int -> r) -> Frame r) -> (Int -> r) -> Frame r
forall a b. (a -> b) -> a -> b
$ \Int
i -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l1 then Int -> r
f1 Int
i else Int -> r
f2 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1)

instance Foldable Frame where
  foldMap :: (a -> m) -> Frame a -> m
foldMap a -> m
f (Frame Int
n Int -> a
row) = (Int -> m) -> [Int] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> (Int -> a) -> Int -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
row) [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  {-# INLINE foldMap #-}
  foldl' :: (b -> a -> b) -> b -> Frame a -> b
foldl' b -> a -> b
f b
z (Frame Int
n Int -> a
row) = (b -> Int -> b) -> b -> [Int] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((a -> b) -> (Int -> a) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
row) ((a -> b) -> Int -> b) -> (b -> a -> b) -> b -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
f) b
z [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  {-# INLINE foldl' #-}

instance Applicative Frame where
  -- | A frame of 'maxBound' rows, each of which is the given value.
  pure :: a -> Frame a
pure a
x = Int -> (Int -> a) -> Frame a
forall r. Int -> (Int -> r) -> Frame r
Frame Int
forall a. Bounded a => a
maxBound (a -> Int -> a
forall a b. a -> b -> a
const a
x)
  -- | Zips two 'Frame's together, applying the rows of the first to
  -- those of the second. The result has as many rows as the smaller
  -- of the two argument 'Frame's.
  Frame Int
l1 Int -> a -> b
f1 <*> :: Frame (a -> b) -> Frame a -> Frame b
<*> Frame Int
l2 Int -> a
f2 = Int -> (Int -> b) -> Frame b
forall r. Int -> (Int -> r) -> Frame r
Frame (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l1 Int
l2) ((Int -> b) -> Frame b) -> (Int -> b) -> Frame b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) ((a -> b) -> a -> b) -> (Int -> a -> b) -> Int -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> b
f1 (Int -> a -> b) -> (Int -> a) -> Int -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> a
f2

instance Monad Frame where
  -- | A frame of 'maxBound' rows, each of which is the given value.
  return :: a -> Frame a
return = a -> Frame a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  -- | Like 'concatMap' for lists.
  Frame Int
l Int -> a
f >>= :: Frame a -> (a -> Frame b) -> Frame b
>>= a -> Frame b
fb = (Int -> Frame b) -> [Int] -> Frame b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> Frame b
fb (a -> Frame b) -> (Int -> a) -> Int -> Frame b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
f) [Int
0 .. Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

-- | Horizontal 'Frame' concatenation. That is, @zipFrames f1 f2@ will
-- return a 'Frame' with as many rows as the smaller of @f1@ and @f2@
-- whose rows are the result of appending the columns of @f2@ to those
-- of @f1@.
zipFrames :: FrameRec rs -> FrameRec rs' -> FrameRec (rs ++ rs')
zipFrames :: FrameRec rs -> FrameRec rs' -> FrameRec (rs ++ rs')
zipFrames (Frame Int
l1 Int -> Record rs
f1) (Frame Int
l2 Int -> Record rs'
f2) =
    Int -> (Int -> Rec ElField (rs ++ rs')) -> FrameRec (rs ++ rs')
forall r. Int -> (Int -> r) -> Frame r
Frame (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l1 Int
l2) ((Int -> Rec ElField (rs ++ rs')) -> FrameRec (rs ++ rs'))
-> (Int -> Rec ElField (rs ++ rs')) -> FrameRec (rs ++ rs')
forall a b. (a -> b) -> a -> b
$ Record rs -> Record rs' -> Rec ElField (rs ++ rs')
forall k (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
rappend (Record rs -> Record rs' -> Rec ElField (rs ++ rs'))
-> (Int -> Record rs)
-> Int
-> Record rs'
-> Rec ElField (rs ++ rs')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Record rs
f1 (Int -> Record rs' -> Rec ElField (rs ++ rs'))
-> (Int -> Record rs') -> Int -> Rec ElField (rs ++ rs')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Record rs'
f2