{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE EmptyDataDecls #-}
module Numeric.LAPACK.Matrix.Type where

import qualified Numeric.LAPACK.Matrix.Plain.Format as ArrFormat
import qualified Numeric.LAPACK.Output as Output
import qualified Numeric.LAPACK.Permutation.Private as Perm
import qualified Numeric.LAPACK.Matrix.Shape.Private as MatrixShape
import Numeric.LAPACK.Output (Output)

import qualified Numeric.Netlib.Class as Class

import qualified Hyper

import qualified Control.DeepSeq as DeepSeq

import qualified Data.Array.Comfort.Shape as Shape

import Data.Monoid (Monoid, mempty, mappend)
import Data.Semigroup (Semigroup, (<>))



data family Matrix typ a


data Scale shape
data instance Matrix (Scale shape) a = Scale shape a


newtype instance Matrix (Perm.Permutation sh) a =
   Permutation (Perm.Permutation sh)
      deriving (Int -> Matrix (Permutation sh) a -> ShowS
[Matrix (Permutation sh) a] -> ShowS
Matrix (Permutation sh) a -> String
(Int -> Matrix (Permutation sh) a -> ShowS)
-> (Matrix (Permutation sh) a -> String)
-> ([Matrix (Permutation sh) a] -> ShowS)
-> Show (Matrix (Permutation sh) a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall sh a.
(C sh, Show sh) =>
Int -> Matrix (Permutation sh) a -> ShowS
forall sh a.
(C sh, Show sh) =>
[Matrix (Permutation sh) a] -> ShowS
forall sh a. (C sh, Show sh) => Matrix (Permutation sh) a -> String
showList :: [Matrix (Permutation sh) a] -> ShowS
$cshowList :: forall sh a.
(C sh, Show sh) =>
[Matrix (Permutation sh) a] -> ShowS
show :: Matrix (Permutation sh) a -> String
$cshow :: forall sh a. (C sh, Show sh) => Matrix (Permutation sh) a -> String
showsPrec :: Int -> Matrix (Permutation sh) a -> ShowS
$cshowsPrec :: forall sh a.
(C sh, Show sh) =>
Int -> Matrix (Permutation sh) a -> ShowS
Show)



instance (NFData typ, DeepSeq.NFData a) => DeepSeq.NFData (Matrix typ a) where
   rnf :: Matrix typ a -> ()
rnf = Matrix typ a -> ()
forall typ a. (NFData typ, NFData a) => Matrix typ a -> ()
rnf

class NFData typ where
   rnf :: (DeepSeq.NFData a) => Matrix typ a -> ()



instance
   (FormatMatrix typ, Class.Floating a) =>
      Hyper.Display (Matrix typ a) where
   display :: Matrix typ a -> Graphic
display = Html -> Graphic
Output.hyper (Html -> Graphic)
-> (Matrix typ a -> Html) -> Matrix typ a -> Graphic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Matrix typ a -> Html
forall typ a out.
(FormatMatrix typ, Floating a, Output out) =>
String -> Matrix typ a -> out
formatMatrix String
ArrFormat.deflt


class FormatMatrix typ where
   {-
   We use constraint @(Class.Floating a)@ and not @(Format a)@
   because it allows us to align the components of complex numbers.
   -}
   formatMatrix ::
      (Class.Floating a, Output out) => String -> Matrix typ a -> out

instance (Shape.C sh) => FormatMatrix (Scale sh) where
   formatMatrix :: String -> Matrix (Scale sh) a -> out
formatMatrix String
fmt (Scale shape a) =
      String -> Order -> sh -> [a] -> out
forall size a out.
(C size, Floating a, Output out) =>
String -> Order -> size -> [a] -> out
ArrFormat.formatDiagonal String
fmt Order
MatrixShape.RowMajor sh
shape ([a] -> out) -> [a] -> out
forall a b. (a -> b) -> a -> b
$
      Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
shape) a
a

instance (Shape.C sh) => FormatMatrix (Perm.Permutation sh) where
   formatMatrix :: String -> Matrix (Permutation sh) a -> out
formatMatrix String
_fmt (Permutation perm) = Permutation sh -> out
forall sh out. (C sh, Output out) => Permutation sh -> out
Perm.format Permutation sh
perm



instance (MultiplySame typ, Class.Floating a) => Semigroup (Matrix typ a) where
   <> :: Matrix typ a -> Matrix typ a -> Matrix typ a
(<>) = Matrix typ a -> Matrix typ a -> Matrix typ a
forall typ a.
(MultiplySame typ, Floating a) =>
Matrix typ a -> Matrix typ a -> Matrix typ a
multiplySame

class MultiplySame typ where
   multiplySame ::
      (Class.Floating a) => Matrix typ a -> Matrix typ a -> Matrix typ a

instance (Eq shape) => MultiplySame (Scale shape) where
   multiplySame :: Matrix (Scale shape) a
-> Matrix (Scale shape) a -> Matrix (Scale shape) a
multiplySame =
      String
-> (Matrix (Scale shape) a -> shape)
-> (a -> Matrix (Scale shape) a -> Matrix (Scale shape) a)
-> Matrix (Scale shape) a
-> Matrix (Scale shape) a
-> Matrix (Scale shape) a
forall shape b a c.
Eq shape =>
String
-> (b -> shape)
-> (a -> b -> c)
-> Matrix (Scale shape) a
-> b
-> c
scaleWithCheck String
"Scale.multiplySame" Matrix (Scale shape) a -> shape
forall typ a. Box typ => Matrix typ a -> HeightOf typ
height
         (\a
a (Scale shape b) -> shape -> a -> Matrix (Scale shape) a
forall shape a. shape -> a -> Matrix (Scale shape) a
Scale shape
shape (a -> Matrix (Scale shape) a) -> a -> Matrix (Scale shape) a
forall a b. (a -> b) -> a -> b
$ a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
b)

instance (Shape.C sh, Eq sh) => MultiplySame (Perm.Permutation sh) where
   multiplySame :: Matrix (Permutation sh) a
-> Matrix (Permutation sh) a -> Matrix (Permutation sh) a
multiplySame (Permutation a) (Permutation b) =
      Permutation sh -> Matrix (Permutation sh) a
forall sh a. Permutation sh -> Matrix (Permutation sh) a
Permutation (Permutation sh -> Matrix (Permutation sh) a)
-> Permutation sh -> Matrix (Permutation sh) a
forall a b. (a -> b) -> a -> b
$ Permutation sh -> Permutation sh -> Permutation sh
forall sh.
(C sh, Eq sh) =>
Permutation sh -> Permutation sh -> Permutation sh
Perm.multiply Permutation sh
b Permutation sh
a


instance
   (MultiplySame typ, StaticIdentity typ, Class.Floating a) =>
      Monoid (Matrix typ a) where
   mappend :: Matrix typ a -> Matrix typ a -> Matrix typ a
mappend = Matrix typ a -> Matrix typ a -> Matrix typ a
forall a. Semigroup a => a -> a -> a
(<>)
   mempty :: Matrix typ a
mempty = Matrix typ a
forall typ a. (StaticIdentity typ, Floating a) => Matrix typ a
staticIdentity

class StaticIdentity typ where
   staticIdentity :: (Class.Floating a) => Matrix typ a

instance (Shape.Static shape) => StaticIdentity (Scale shape) where
   staticIdentity :: Matrix (Scale shape) a
staticIdentity = shape -> a -> Matrix (Scale shape) a
forall shape a. shape -> a -> Matrix (Scale shape) a
Scale shape
forall sh. Static sh => sh
Shape.static a
1

instance (Shape.Static sh) => StaticIdentity (Perm.Permutation sh) where
   staticIdentity :: Matrix (Permutation sh) a
staticIdentity = Permutation sh -> Matrix (Permutation sh) a
forall sh a. Permutation sh -> Matrix (Permutation sh) a
Permutation (Permutation sh -> Matrix (Permutation sh) a)
-> Permutation sh -> Matrix (Permutation sh) a
forall a b. (a -> b) -> a -> b
$ sh -> Permutation sh
forall sh. C sh => sh -> Permutation sh
Perm.identity sh
forall sh. Static sh => sh
Shape.static


scaleWithCheck :: (Eq shape) =>
   String -> (b -> shape) ->
   (a -> b -> c) -> Matrix (Scale shape) a -> b -> c
scaleWithCheck :: String
-> (b -> shape)
-> (a -> b -> c)
-> Matrix (Scale shape) a
-> b
-> c
scaleWithCheck String
name b -> shape
getSize a -> b -> c
f (Scale shape a) b
b =
   if shape
shape shape -> shape -> Bool
forall a. Eq a => a -> a -> Bool
== b -> shape
getSize b
b
      then a -> b -> c
f a
a b
b
      else String -> c
forall a. HasCallStack => String -> a
error (String -> c) -> String -> c
forall a b. (a -> b) -> a -> b
$ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": dimensions mismatch"


class Box typ where
   type HeightOf typ
   type WidthOf typ
   height :: Matrix typ a -> HeightOf typ
   width :: Matrix typ a -> WidthOf typ

instance Box (Scale sh) where
   type HeightOf (Scale sh) = sh
   type WidthOf (Scale sh) = sh
   height :: Matrix (Scale sh) a -> HeightOf (Scale sh)
height (Scale shape _) = sh
HeightOf (Scale sh)
shape
   width :: Matrix (Scale sh) a -> WidthOf (Scale sh)
width (Scale shape _) = sh
WidthOf (Scale sh)
shape

instance Box (Perm.Permutation sh) where
   type HeightOf (Perm.Permutation sh) = sh
   type WidthOf (Perm.Permutation sh) = sh
   height :: Matrix (Permutation sh) a -> HeightOf (Permutation sh)
height (Permutation perm) = Permutation sh -> sh
forall sh. Permutation sh -> sh
Perm.size Permutation sh
perm
   width :: Matrix (Permutation sh) a -> WidthOf (Permutation sh)
width (Permutation perm) = Permutation sh -> sh
forall sh. Permutation sh -> sh
Perm.size Permutation sh
perm

indices ::
   (Box typ,
    HeightOf typ ~ height, Shape.Indexed height,
    WidthOf typ ~ width, Shape.Indexed width) =>
   Matrix typ a -> [(Shape.Index height, Shape.Index width)]
indices :: Matrix typ a -> [(Index height, Index width)]
indices Matrix typ a
sh = (height, width) -> [Index (height, width)]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices (Matrix typ a -> HeightOf typ
forall typ a. Box typ => Matrix typ a -> HeightOf typ
height Matrix typ a
sh, Matrix typ a -> WidthOf typ
forall typ a. Box typ => Matrix typ a -> WidthOf typ
width Matrix typ a
sh)