{-# LANGUAGE RankNTypes #-}

module QLinear.Operations
  ( length,
    mulMatricesWith,
    neg,
    transpose,
    zipMatricesWith,
    det,
    algebraicComplement,
    algebraicComplement',
    adjugate,
    inverted,
    (*~),
    (~*~),
    (~+),
    (+~),
    (~+~),
    (~-~),
  )
where

import qualified Data.List as List
import Data.List.Split (chunksOf)
import Data.Tuple
import Internal.Determinant (adjugate, algebraicComplement, algebraicComplement', det)
import Internal.Matrix
import Internal.Quasi.Matrix.Quasi
import Prelude hiding (length)

-- | Adds two matrices
--
-- >>> [matrix| 1 2 |] ~+~ [matrix| 2 3 |]
-- [3,5]
(~+~) :: Num a => Matrix m n a -> Matrix m n a -> Matrix m n a
~+~ :: Matrix m n a -> Matrix m n a -> Matrix m n a
(~+~) = (a -> a -> a) -> Matrix m n a -> Matrix m n a -> Matrix m n a
forall a b c (m :: Nat) (n :: Nat).
(a -> b -> c) -> Matrix m n a -> Matrix m n b -> Matrix m n c
zipMatricesWith a -> a -> a
forall a. Num a => a -> a -> a
(+)

-- | Multuplies all elements of matrix __m__ by __k__
--
-- >>> 5 *~ [matrix| 1 2 3; 4 5 6 |]
-- [5,10,15]
-- [20,25,30]
(*~) ::
  Num a =>
  -- | k
  a ->
  -- | m
  Matrix m n a ->
  Matrix m n a
*~ :: a -> Matrix m n a -> Matrix m n a
(*~) n :: a
n = (a -> a) -> Matrix m n a -> Matrix m n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
n a -> a -> a
forall a. Num a => a -> a -> a
*)

-- | Adds __a__ to all elements of matrix __m__
--
-- >>> [matrix| 1 2 3 |] ~+ 8
-- [9,10,11]
(~+) ::
  Num a =>
  Matrix m n a ->
  a ->
  Matrix m n a
~+ :: Matrix m n a -> a -> Matrix m n a
(~+) m :: Matrix m n a
m n :: a
n = (a -> a -> a
forall a. Num a => a -> a -> a
+ a
n) (a -> a) -> Matrix m n a -> Matrix m n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Matrix m n a
m

-- | Flipped __~+__ :)
(+~) :: Num a => a -> Matrix m n a -> Matrix m n a
+~ :: a -> Matrix m n a -> Matrix m n a
(+~) = (Matrix m n a -> a -> Matrix m n a)
-> a -> Matrix m n a -> Matrix m n a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Matrix m n a -> a -> Matrix m n a
forall a (m :: Nat) (n :: Nat).
Num a =>
Matrix m n a -> a -> Matrix m n a
(~+)

-- | Substracts second matrix from first one
--
-- >>> [matrix| 1 2 3 |] ~-~ [matrix| 3 2 1 |]
-- [-2,0,2]
(~-~) :: Num a => Matrix m n a -> Matrix m n a -> Matrix m n a
~-~ :: Matrix m n a -> Matrix m n a -> Matrix m n a
(~-~) = (a -> a -> a) -> Matrix m n a -> Matrix m n a -> Matrix m n a
forall a b c (m :: Nat) (n :: Nat).
(a -> b -> c) -> Matrix m n a -> Matrix m n b -> Matrix m n c
zipMatricesWith (-)

-- | Multiplies two matrix
--
-- >>> [matrix| 1 2; 3 4 |] ~*~ [matrix| 1; 2 |]
-- [5]
-- [11]
(~*~) :: Num a => Matrix m n a -> Matrix n k a -> Matrix m k a
~*~ :: Matrix m n a -> Matrix n k a -> Matrix m k a
(~*~) = (a -> a -> a)
-> (a -> a -> a) -> Matrix m n a -> Matrix n k a -> Matrix m k a
forall a b c (m :: Nat) (n :: Nat) (k :: Nat).
(a -> b -> c)
-> (c -> c -> c) -> Matrix m n a -> Matrix n k b -> Matrix m k c
mulMatricesWith a -> a -> a
forall a. Num a => a -> a -> a
(*) a -> a -> a
forall a. Num a => a -> a -> a
(+)

-- | Generalized matrices multiplication
mulMatricesWith ::
  -- | operation "__*__"
  (a -> b -> c) ->
  -- | operation "__+__"
  (c -> c -> c) ->
  Matrix m n a ->
  Matrix n k b ->
  Matrix m k c
mulMatricesWith :: (a -> b -> c)
-> (c -> c -> c) -> Matrix m n a -> Matrix n k b -> Matrix m k c
mulMatricesWith mul :: a -> b -> c
mul add :: c -> c -> c
add (Matrix (m :: Int
m, _) left :: [[a]]
left) (Matrix (_, k :: Int
k) right :: [[b]]
right) =
  (Int, Int) -> [[c]] -> Matrix m k c
forall (m :: Nat) (n :: Nat) a. (Int, Int) -> [[a]] -> Matrix m n a
Matrix (Int
m, Int
k) ([[c]] -> Matrix m k c) -> [[c]] -> Matrix m k c
forall a b. (a -> b) -> a -> b
$
    Int -> [c] -> [[c]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
k [(c -> c -> c) -> [c] -> c
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 c -> c -> c
add ([c] -> c) -> [c] -> c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
mul [a]
line [b]
column | [a]
line <- [[a]]
left, [b]
column <- [[b]] -> [[b]]
forall a. [[a]] -> [[a]]
List.transpose [[b]]
right]

-- | Generalized matrices addition
zipMatricesWith ::
  -- | operation "__+__"
  (a -> b -> c) ->
  Matrix m n a ->
  Matrix m n b ->
  Matrix m n c
zipMatricesWith :: (a -> b -> c) -> Matrix m n a -> Matrix m n b -> Matrix m n c
zipMatricesWith op :: a -> b -> c
op (Matrix size :: (Int, Int)
size l :: [[a]]
l) (Matrix _ r :: [[b]]
r) =
  (Int, Int) -> [[c]] -> Matrix m n c
forall (m :: Nat) (n :: Nat) a. (Int, Int) -> [[a]] -> Matrix m n a
Matrix (Int, Int)
size ([[c]] -> Matrix m n c) -> [[c]] -> Matrix m n c
forall a b. (a -> b) -> a -> b
$ ([a] -> [b] -> [c]) -> [[a]] -> [[b]] -> [[c]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
op) [[a]]
l [[b]]
r

-- | Transposes matrix
--
-- >>> transpose [matrix| 1 2 3; 4 5 6 |]
-- [1,4]
-- [2,5]
-- [3,6]
transpose :: Matrix m n a -> Matrix n m a
transpose :: Matrix m n a -> Matrix n m a
transpose (Matrix size :: (Int, Int)
size matrix :: [[a]]
matrix) = (Int, Int) -> [[a]] -> Matrix n m a
forall (m :: Nat) (n :: Nat) a. (Int, Int) -> [[a]] -> Matrix m n a
Matrix ((Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap (Int, Int)
size) ([[a]] -> [[a]]
forall a. [[a]] -> [[a]]
List.transpose [[a]]
matrix)

-- | Nagates all elements of matrix
--
-- >>> neg [matrix| 1 2 3 |]
-- [-1,-2,-3]
neg :: Num a => Matrix m n a -> Matrix m n a
neg :: Matrix m n a -> Matrix m n a
neg = ((-1) a -> Matrix m n a -> Matrix m n a
forall a (m :: Nat) (n :: Nat).
Num a =>
a -> Matrix m n a -> Matrix m n a
*~)

-- | Length of vector
--
-- >>> length [vector| 3 4 |]
-- 5.0
-- >>> length [vector| 1 1 |]
-- 1.4142135623730951
length :: (Real a, Floating b) => Vector n a -> b
length :: Vector n a -> b
length (Matrix _ matrix :: [[a]]
matrix) = b -> b
forall a. Floating a => a -> a
sqrt (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ [b] -> b
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ [b]
squares
  where
    toFloating :: a -> b
toFloating = forall a b. (Real a, Floating b) => a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: (Real a, Floating b) => a -> b
    squares :: [b]
squares = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> b -> b
forall a. Floating a => a -> a -> a
** 2) (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
toFloating) ([a] -> [b]) -> [a] -> [b]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
matrix

-- | Inverted matrix
--
-- >>> inverted [matrix| 1 2; 3 4|]
-- Just [-2.0,1.0]
--      [1.5,-0.5]
-- >>> inverted [matrix| 1 4; 1 4|]
-- Nothing
inverted :: forall a b n. (Fractional b, Eq a, Real a) => Matrix n n a -> Maybe (Matrix n n b)
inverted :: Matrix n n a -> Maybe (Matrix n n b)
inverted (Matrix size :: (Int, Int)
size@(1, 1) [[a :: a
a]]) = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 then Matrix n n b -> Maybe (Matrix n n b)
forall a. a -> Maybe a
Just ((Int, Int) -> [[b]] -> Matrix n n b
forall (m :: Nat) (n :: Nat) a. (Int, Int) -> [[a]] -> Matrix m n a
Matrix (Int, Int)
size [[1.0 b -> b -> b
forall a. Fractional a => a -> a -> a
/ a -> b
toFloating a
a]]) else Maybe (Matrix n n b)
forall a. Maybe a
Nothing
  where
    toFloating :: a -> b
toFloating = forall a b. (Real a, Fractional b) => a -> b
realToFrac :: (Real a, Fractional b) => a -> b
inverted matrix :: Matrix n n a
matrix = if a
determinant a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 then Matrix n n b -> Maybe (Matrix n n b)
forall a. a -> Maybe a
Just (Matrix n n b -> Maybe (Matrix n n b))
-> Matrix n n b -> Maybe (Matrix n n b)
forall a b. (a -> b) -> a -> b
$ ((b
invertedDet b -> b -> b
forall a. Num a => a -> a -> a
*) (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
toFloating) (a -> b) -> Matrix n n a -> Matrix n n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Matrix n n a
adj else Maybe (Matrix n n b)
forall a. Maybe a
Nothing
  where
    toFloating :: a -> b
toFloating = forall a b. (Real a, Fractional b) => a -> b
realToFrac :: (Real a, Fractional b) => a -> b
    determinant :: a
determinant = Matrix n n a -> a
forall a (n :: Nat). Num a => Matrix n n a -> a
det Matrix n n a
matrix
    invertedDet :: b
invertedDet = 1.0 b -> b -> b
forall a. Fractional a => a -> a -> a
/ a -> b
toFloating a
determinant
    adj :: Matrix n n a
adj = Matrix n n a -> Matrix n n a
forall a (n :: Nat). Num a => Matrix n n a -> Matrix n n a
adjugate Matrix n n a
matrix