{- |
  1-dimensional linear transformations.
-}

module Data.Vector.Transform.T1 where

import Data.Semigroup
import Data.Monoid

import Data.Vector.Class
import Data.Vector.V1

{- |
  The type of 1D linear transformations. Essentially, this is applying a linear function to a number.

  Note the @Monoid@ instance, which gives you access to the identity transform (@mempty@) and the ability to combine a series of transforms into a single transform (@mappend@).
-}
data Transform1 =
    Transform1
    {
      Transform1 -> Scalar
t1_XX, Transform1 -> Scalar
t1_1X :: {-# UNPACK #-} !Scalar
    }
  deriving (Transform1 -> Transform1 -> Bool
(Transform1 -> Transform1 -> Bool)
-> (Transform1 -> Transform1 -> Bool) -> Eq Transform1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Transform1 -> Transform1 -> Bool
== :: Transform1 -> Transform1 -> Bool
$c/= :: Transform1 -> Transform1 -> Bool
/= :: Transform1 -> Transform1 -> Bool
Eq, Int -> Transform1 -> ShowS
[Transform1] -> ShowS
Transform1 -> String
(Int -> Transform1 -> ShowS)
-> (Transform1 -> String)
-> ([Transform1] -> ShowS)
-> Show Transform1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Transform1 -> ShowS
showsPrec :: Int -> Transform1 -> ShowS
$cshow :: Transform1 -> String
show :: Transform1 -> String
$cshowList :: [Transform1] -> ShowS
showList :: [Transform1] -> ShowS
Show)

instance Monoid Transform1 where
  mempty :: Transform1
mempty = Scalar -> Scalar -> Transform1
Transform1  Scalar
1 Scalar
0

instance Semigroup Transform1 where
  Transform1
a <> :: Transform1 -> Transform1 -> Transform1
<> Transform1
b =
    Transform1
    {
      t1_XX :: Scalar
t1_XX = Transform1 -> Scalar
t1_XX Transform1
a Scalar -> Scalar -> Scalar
forall a. Num a => a -> a -> a
* Transform1 -> Scalar
t1_XX Transform1
b,
      t1_1X :: Scalar
t1_1X = Transform1 -> Scalar
t1_1X Transform1
a Scalar -> Scalar -> Scalar
forall a. Num a => a -> a -> a
* Transform1 -> Scalar
t1_XX Transform1
b  Scalar -> Scalar -> Scalar
forall a. Num a => a -> a -> a
+  Transform1 -> Scalar
t1_1X Transform1
b
    }

-- | Apply a 1D transformation to a 1D point, yielding a new 1D point.
transformP1 :: Transform1 -> Vector1 -> Vector1
transformP1 :: Transform1 -> Vector1 -> Vector1
transformP1 Transform1
a (Vector1 Scalar
x) = Scalar -> Vector1
Vector1 (Transform1 -> Scalar
t1_XX Transform1
a Scalar -> Scalar -> Scalar
forall a. Num a => a -> a -> a
* Scalar
x Scalar -> Scalar -> Scalar
forall a. Num a => a -> a -> a
+ Transform1 -> Scalar
t1_1X Transform1
a)