{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
module Numeric.LAPACK.Matrix.Array.Private (
   Matrix(Array),
   ArrayMatrix,
   Array,
   OmniArray,
   PlainArray,

   Full,
   General,
   Tall,
   Wide,
   LiberalSquare,
   Square,
   SquareMeas,
   Quadratic,
   FullQuadratic,
   QuadraticMeas,

   plainShape,
   shape,
   extent,
   subBandsSingleton,
   superBandsSingleton,
   packTag,
   diagTag,

   asPacked,
   asUnpacked,
   requirePacking,

   reshape,
   mapShape,
   unwrap,
   toVector,
   fromVector,
   lift0,
   lift1,
   lift2,
   lift3,
   lift4,
   unlift1,
   unlift2,
   unliftRow,
   unliftColumn,
   unpackedToVector,
   liftUnpacked0,
   liftUnpacked1,
   liftUnpacked2,
   liftUnpacked3,
   liftOmni1,
   liftOmni2,

   Homogeneous, Scale, zero, negate, scaleReal, scale, scaleRealReal, (.*#),
   order, forceOrder, adaptOrder,
   Additive, add, (#+#),
   Subtractive, sub, (#-#),

   MapExtent, mapExtent,
   ) where

import qualified Numeric.LAPACK.Matrix.Plain.Class as ArrClass
import qualified Numeric.LAPACK.Matrix.Type as Matrix
import qualified Numeric.LAPACK.Matrix.BandedHermitian.Basic as BandedHermitian
import qualified Numeric.LAPACK.Matrix.Banded.Basic as Banded
import qualified Numeric.LAPACK.Matrix.Triangular.Basic as Triangular
import qualified Numeric.LAPACK.Matrix.Mosaic.Basic as Mosaic
import qualified Numeric.LAPACK.Matrix.Plain as Plain
import qualified Numeric.LAPACK.Matrix.Basic as Basic
import qualified Numeric.LAPACK.Matrix.Shape.Omni as Omni
import qualified Numeric.LAPACK.Matrix.Shape as MatrixShape
import qualified Numeric.LAPACK.Matrix.Layout.Private as Layout
import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import qualified Numeric.LAPACK.Matrix.Extent.Strict as ExtentStrict
import qualified Numeric.LAPACK.Vector as Vector
import Numeric.LAPACK.Matrix.Plain.Format (formatArray)
import Numeric.LAPACK.Matrix.Shape.Omni (Omni, Arbitrary)
import Numeric.LAPACK.Matrix.Layout.Private (Filled, Bands, Packed, Unpacked)
import Numeric.LAPACK.Matrix.Extent.Private (Extent, Shape, Size, Big, Small)
import Numeric.LAPACK.Matrix.Type (Matrix)
import Numeric.LAPACK.Vector (Vector)
import Numeric.LAPACK.Scalar (RealOf)

import qualified Type.Data.Num.Unary as Unary
import qualified Type.Data.Bool as TBool
import Type.Data.Bool (True)

import qualified Numeric.Netlib.Class as Class

import qualified Control.DeepSeq as DeepSeq

import qualified Data.Array.Comfort.Storable.Unchecked as Array
import qualified Data.Array.Comfort.Storable as CheckedArray
import qualified Data.Array.Comfort.Shape as Shape
import Data.Function.HT (Id)

import Foreign.Storable (Storable)

import Prelude hiding (negate)


type OmniArray pack prop lower upper meas vert horiz height width a =
      Array.Array (Omni pack prop lower upper meas vert horiz height width) a

data Array pack property
data instance
      Matrix (Array pack prop) xl xu
         lower upper meas vert horiz height width a where
   Array ::
      OmniArray pack prop lower upper meas vert horiz height width a ->
      Matrix (Array pack prop) () () lower upper meas vert horiz height width a

deriving instance
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Shape.C width, Storable a,
    Show height, Show width, Show a) =>
   Show (Matrix (Array pack prop) xl xu
            lower upper meas vert horiz height width a)

type ArrayMatrix pack property = Matrix (Array pack property) () ()
type UnpackedMatrix property = ArrayMatrix Unpacked property


type Full meas vert horiz height width =
         UnpackedMatrix Arbitrary Filled Filled meas vert horiz height width
type General height width = Full Size Big Big height width
type Tall height width = Full Size Big Small height width
type Wide height width = Full Size Small Big height width
type LiberalSquare height width = SquareMeas Size height width
type Square sh = SquareMeas Shape sh sh
type SquareMeas meas height width = Full meas Small Small height width

type Quadratic pack property lower upper sh =
         QuadraticMeas pack property lower upper Shape sh sh
type FullQuadratic pack property sh = Quadratic pack property Filled Filled sh

type QuadraticMeas pack property lower upper meas height width =
         ArrayMatrix pack property lower upper meas Small Small height width


instance Matrix.NFData (Array pack property) where
   rnf (Array arr) = DeepSeq.rnf arr

instance Matrix.Box (Array pack property) where
   extent (Array arr) = Omni.extent $ Array.shape arr

instance Matrix.Transpose (Array pack property) where
   transpose a@(Array _) =
      case shape a of
         Omni.Full _ -> liftUnpacked1 Basic.transpose a
         Omni.UpperTriangular _ -> lift1 Mosaic.transpose a
         Omni.LowerTriangular _ -> lift1 Mosaic.transpose a
         Omni.Symmetric _ -> a
         Omni.Hermitian _ -> lift1 Vector.conjugate a
         Omni.Banded _ -> lift1 Banded.transpose a
         Omni.UnitBandedTriangular _ -> lift1 Banded.transpose a
         Omni.BandedHermitian _ -> lift1 Vector.conjugate a


asPacked ::
   Id (ArrayMatrix Packed property lower upper meas vert horiz height width a)
asPacked = id

asUnpacked ::
   Id (ArrayMatrix Unpacked property lower upper meas vert horiz height width a)
asUnpacked = id

requirePacking ::
   Layout.PackingSingleton pack ->
   Id (ArrayMatrix pack property lower upper meas vert horiz height width a)
requirePacking _ = id


plainShape ::
   (Omni.ToPlain pack property lower upper meas vert horiz height width) =>
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   Omni.Plain pack property lower upper meas vert horiz height width
plainShape = Omni.toPlain . shape

shape ::
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   Omni pack property lower upper meas vert horiz height width
shape (Array a) = Array.shape a

extent ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   Extent meas vert horiz height width
extent = Omni.extent . shape


subBandsSingleton ::
   (Unary.Natural sub) =>
   ArrayMatrix pack property
      (Layout.Bands sub) upper meas vert horiz height width a ->
   Unary.HeadSingleton sub
subBandsSingleton _ = Unary.headSingleton

superBandsSingleton ::
   (Unary.Natural super) =>
   ArrayMatrix pack property
      lower (Layout.Bands super) meas vert horiz height width a ->
   Unary.HeadSingleton super
superBandsSingleton _ = Unary.headSingleton


reshape ::
   (Extent.Measure measA, Extent.C vertA, Extent.C horizA) =>
   (Extent.Measure measB, Extent.C vertB, Extent.C horizB) =>
   (Shape.C heightA, Shape.C widthA) =>
   (Shape.C heightB, Shape.C widthB) =>
   Omni packB propB lowerB upperB measB vertB horizB heightB widthB ->
   ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
   ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB a
reshape = liftOmni1 . CheckedArray.reshape

mapShape ::
   (Extent.Measure measA, Extent.C vertA, Extent.C horizA) =>
   (Extent.Measure measB, Extent.C vertB, Extent.C horizB) =>
   (Shape.C heightA, Shape.C widthA) =>
   (Shape.C heightB, Shape.C widthB) =>
   (Omni packA propA lowerA upperA measA vertA horizA heightA widthA ->
    Omni packB propB lowerB upperB measB vertB horizB heightB widthB) ->
   ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
   ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB a
mapShape = liftOmni1 . CheckedArray.mapShape


type PlainArray pack prop lower upper meas vert horiz height width =
   Array.Array (Omni.Plain pack prop lower upper meas vert horiz height width)

toVector ::
   (Omni.ToPlain pack property lower upper meas vert horiz height width) =>
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   PlainArray pack property lower upper meas vert horiz height width a
toVector (Array a) = Array.mapShape Omni.toPlain a

unwrap ::
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   OmniArray pack property lower upper meas vert horiz height width a
unwrap (Array a) = a

fromVector ::
   (Omni.FromPlain pack prop lower upper meas vert horiz height width) =>
   (Omni.Plain pack prop lower upper meas vert horiz height width ~ shape) =>
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C height, Shape.C width, Class.Floating a) =>
   Array.Array shape a ->
   ArrayMatrix pack prop lower upper meas vert horiz height width a
fromVector arr =
   let omni = Omni.fromPlain $ Array.shape arr
   in case ArrClass.check omni arr of
         Nothing -> Array $ Array.reshape omni arr
         Just msg -> error $ "Matrix.Array.fromVector: " ++ msg


{- |
'lift0' is a synonym for 'fromVector' but lacks the admissibility check.
You may thus fool the type tags.
This applies to the other lift functions, too.
-}
lift0 ::
   (Omni.FromPlain pack prop lower upper meas vert horiz height width) =>
   PlainArray pack prop lower upper meas vert horiz height width a ->
   ArrayMatrix pack prop lower upper meas vert horiz height width a
lift0 = Array . Array.mapShape Omni.fromPlain

lift1 ::
   (Omni.ToPlain packA propA lowerA upperA measA vertA horizA heightA widthA) =>
   (Omni.FromPlain packB propB lowerB upperB measB vertB horizB heightB widthB)
                                                                              =>
   (PlainArray packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    PlainArray packB propB lowerB upperB measB vertB horizB heightB widthB b) ->
   ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
   ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB b
lift1 f = lift0 . f . toVector

lift2 ::
   (Omni.ToPlain packA propA lowerA upperA measA vertA horizA heightA widthA) =>
   (Omni.ToPlain packB propB lowerB upperB measB vertB horizB heightB widthB) =>
   (Omni.FromPlain packC propC lowerC upperC measC vertC horizC heightC widthC)
                                                                              =>
   (PlainArray packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    PlainArray packB propB lowerB upperB measB vertB horizB heightB widthB b ->
    PlainArray packC propC lowerC upperC measC vertC horizC heightC widthC c) ->
   ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
   ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB b ->
   ArrayMatrix packC propC lowerC upperC measC vertC horizC heightC widthC c
lift2 f = lift1 . f . toVector

lift3 ::
   (Omni.ToPlain packA propA lowerA upperA measA vertA horizA heightA widthA) =>
   (Omni.ToPlain packB propB lowerB upperB measB vertB horizB heightB widthB) =>
   (Omni.ToPlain packC propC lowerC upperC measC vertC horizC heightC widthC) =>
   (Omni.FromPlain packD propD lowerD upperD measD vertD horizD heightD widthD)
                                                                              =>
   (PlainArray packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    PlainArray packB propB lowerB upperB measB vertB horizB heightB widthB b ->
    PlainArray packC propC lowerC upperC measC vertC horizC heightC widthC c ->
    PlainArray packD propD lowerD upperD measD vertD horizD heightD widthD d) ->
   ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
   ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB b ->
   ArrayMatrix packC propC lowerC upperC measC vertC horizC heightC widthC c ->
   ArrayMatrix packD propD lowerD upperD measD vertD horizD heightD widthD d
lift3 f = lift2 . f . toVector

lift4 ::
   (Omni.ToPlain packA propA lowerA upperA measA vertA horizA heightA widthA) =>
   (Omni.ToPlain packB propB lowerB upperB measB vertB horizB heightB widthB) =>
   (Omni.ToPlain packC propC lowerC upperC measC vertC horizC heightC widthC) =>
   (Omni.ToPlain packD propD lowerD upperD measD vertD horizD heightD widthD) =>
   (Omni.FromPlain packE propE lowerE upperE measE vertE horizE heightE widthE)
                                                                              =>
   (PlainArray packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    PlainArray packB propB lowerB upperB measB vertB horizB heightB widthB b ->
    PlainArray packC propC lowerC upperC measC vertC horizC heightC widthC c ->
    PlainArray packD propD lowerD upperD measD vertD horizD heightD widthD d ->
    PlainArray packE propE lowerE upperE measE vertE horizE heightE widthE e) ->
   ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
   ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB b ->
   ArrayMatrix packC propC lowerC upperC measC vertC horizC heightC widthC c ->
   ArrayMatrix packD propD lowerD upperD measD vertD horizD heightD widthD d ->
   ArrayMatrix packE propE lowerE upperE measE vertE horizE heightE widthE e
lift4 f = lift3 . f . toVector


unlift1 ::
   (Omni.FromPlain packA propA lowerA upperA measA vertA horizA heightA widthA)
                                                                              =>
   (Omni.ToPlain packB propB lowerB upperB measB vertB horizB heightB widthB) =>
   (ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB b) ->
   (PlainArray packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    PlainArray packB propB lowerB upperB measB vertB horizB heightB widthB b)
unlift1 f = toVector . f . lift0

unlift2 ::
   (Omni.FromPlain packA propA lowerA upperA measA vertA horizA heightA widthA,
    Omni.FromPlain packB propB lowerB upperB measB vertB horizB heightB widthB)
                                                                              =>
   (Omni.ToPlain packC propC lowerC upperC measC vertC horizC heightC widthC) =>
   (ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB b ->
    ArrayMatrix packC propC lowerC upperC measC vertC horizC heightC widthC c) ->
   (PlainArray packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    PlainArray packB propB lowerB upperB measB vertB horizB heightB widthB b ->
    PlainArray packC propC lowerC upperC measC vertC horizC heightC widthC c)
unlift2 f = unlift1 . f . lift0


type FullArray meas vert horiz height width =
      Array.Array (Layout.Full meas vert horiz height width)

unpackedToVector ::
   (Omni.Property property, Omni.Strip lower, Omni.Strip upper) =>
   UnpackedMatrix property lower upper meas vert horiz height width a ->
   FullArray meas vert horiz height width a
unpackedToVector = Array.mapShape Omni.toFull . unwrap

liftUnpacked0 ::
   (Omni.Property propertyA, Omni.Strip lowerA, Omni.Strip upperA) =>
   (FullArray measA vertA horizA heightA widthA a) ->
   UnpackedMatrix propertyA lowerA upperA measA vertA horizA heightA widthA a
liftUnpacked0 = Array . Array.mapShape Omni.fromFull

liftUnpacked1 ::
   (Omni.Property propertyA, Omni.Strip lowerA, Omni.Strip upperA) =>
   (Omni.Property propertyB, Omni.Strip lowerB, Omni.Strip upperB) =>
   (FullArray measA vertA horizA heightA widthA a ->
    FullArray measB vertB horizB heightB widthB b) ->
   UnpackedMatrix propertyA lowerA upperA measA vertA horizA heightA widthA a ->
   UnpackedMatrix propertyB lowerB upperB measB vertB horizB heightB widthB b
liftUnpacked1 f = liftUnpacked0 . f . unpackedToVector

liftUnpacked2 ::
   (Omni.Property propertyA, Omni.Strip lowerA, Omni.Strip upperA) =>
   (Omni.Property propertyB, Omni.Strip lowerB, Omni.Strip upperB) =>
   (Omni.Property propertyC, Omni.Strip lowerC, Omni.Strip upperC) =>
   (FullArray measA vertA horizA heightA widthA a ->
    FullArray measB vertB horizB heightB widthB b ->
    FullArray measC vertC horizC heightC widthC c) ->
   UnpackedMatrix propertyA lowerA upperA measA vertA horizA heightA widthA a ->
   UnpackedMatrix propertyB lowerB upperB measB vertB horizB heightB widthB b ->
   UnpackedMatrix propertyC lowerC upperC measC vertC horizC heightC widthC c
liftUnpacked2 f = liftUnpacked1 . f . unpackedToVector

liftUnpacked3 ::
   (Omni.Property propertyA, Omni.Strip lowerA, Omni.Strip upperA) =>
   (Omni.Property propertyB, Omni.Strip lowerB, Omni.Strip upperB) =>
   (Omni.Property propertyC, Omni.Strip lowerC, Omni.Strip upperC) =>
   (Omni.Property propertyD, Omni.Strip lowerD, Omni.Strip upperD) =>
   (FullArray measA vertA horizA heightA widthA a ->
    FullArray measB vertB horizB heightB widthB b ->
    FullArray measC vertC horizC heightC widthC c ->
    FullArray measD vertD horizD heightD widthD d) ->
   UnpackedMatrix propertyA lowerA upperA measA vertA horizA heightA widthA a ->
   UnpackedMatrix propertyB lowerB upperB measB vertB horizB heightB widthB b ->
   UnpackedMatrix propertyC lowerC upperC measC vertC horizC heightC widthC c ->
   UnpackedMatrix propertyD lowerD upperD measD vertD horizD heightD widthD d
liftUnpacked3 f = liftUnpacked2 . f . unpackedToVector


unliftRow ::
   Layout.Order ->
   (General () height0 a -> General () height1 b) ->
   Vector height0 a -> Vector height1 b
unliftRow order_ = Basic.unliftRow order_ . unlift1

unliftColumn ::
   Layout.Order ->
   (General height0 () a -> General height1 () b) ->
   Vector height0 a -> Vector height1 b
unliftColumn order_ = Basic.unliftColumn order_ . unlift1


instance Matrix.FormatMatrix (Array pack property) where
   formatMatrix fmt a@(Array _) =
      case shape a of
         Omni.Full fullShape ->
            formatArray fmt $ Array.reshape fullShape $ unwrap a
         Omni.UpperTriangular _ -> formatArray fmt $ toVector a
         Omni.LowerTriangular _ -> formatArray fmt $ toVector a
         Omni.Symmetric _ -> formatArray fmt $ toVector a
         Omni.Hermitian _ -> formatArray fmt $ toVector a
         Omni.Banded _ -> formatArray fmt $ toVector a
         Omni.UnitBandedTriangular _ -> formatArray fmt $ toVector a
         Omni.BandedHermitian _ -> formatArray fmt $ toVector a


packTag ::
   (Layout.Packing pack) =>
   ArrayMatrix pack diag lower upper meas vert horiz height width a ->
   Layout.PackingSingleton pack
packTag _ = Layout.autoPacking

diagTag ::
   (Omni.TriDiag diag) =>
   ArrayMatrix pack diag lower upper meas vert horiz height width a ->
   Omni.DiagSingleton diag
diagTag _ = Omni.autoDiag

instance
   (Layout.Packing pack, Omni.TriDiag diag, xl ~ (), xu ~ ()) =>
      Matrix.MultiplySame (Array pack diag) xl xu where
   multiplySame a =
      case Omni.powerSingleton $ shape a of
         Omni.PowerIdentity -> \b ->
            if Matrix.squareSize a == Matrix.squareSize b
               then b
               else error "multiplySame Identity: shape mismatch"
         Omni.PowerUpperTriangular ->
            lift2 (Triangular.multiply $ diagTag a) a
         Omni.PowerLowerTriangular ->
            lift2 (Triangular.multiply $ diagTag a) a
         Omni.PowerDiagonal ->
            case (diagTag a, shape a) of
               (MatrixShape.Unit, Omni.UnitBandedTriangular _) ->
                  lift2 Banded.multiply a
               (MatrixShape.Arbitrary, Omni.Banded _) ->
                  lift2 Banded.multiply a
               (_, Omni.Full _) -> liftUnpacked2 Basic.multiply a
         Omni.PowerSymmetric ->
            case diagTag a of _ -> error "Symmetric forbidden"
         Omni.PowerHermitian ->
            case diagTag a of _ -> error "Hermitian forbidden"
         Omni.PowerFull -> liftUnpacked2 Basic.multiply a


{-
ToDo: implement using Array.Omni.identityOrderAux.
however, we must prevent module cycle

instance
   (meas ~ Extent.Shape, vert ~ Extent.Small, horiz ~ Extent.Small,
    height ~ width, Shape.Static width) =>
      Matrix.StaticIdentity
         (Array pack property lower upper meas vert horiz height width) where
   staticIdentity =
      OmniBasic.identityOrder Layout.RowMajor Shape.static
-}


class (Omni.Property property) => Homogeneous property where
instance Homogeneous Arbitrary where
instance Homogeneous Omni.Symmetric where
instance (zero ~ True, neg ~ pos, TBool.C pos) =>
         Homogeneous (Omni.Hermitian neg zero pos) where

zero ::
   (Homogeneous property) =>
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C height, Shape.C width, Class.Floating a) =>
   Omni pack property lower upper meas vert horiz height width ->
   ArrayMatrix pack property lower upper meas vert horiz height width a
zero = Array . Vector.zero

negate ::
   (Homogeneous property) =>
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C height, Shape.C width, Class.Floating a) =>
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a
negate (Array a) = Array $ Vector.negate a

scaleReal ::
   (Homogeneous property) =>
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C height, Shape.C width, Class.Floating a) =>
   RealOf a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a
scaleReal a (Array v) = Array $ Vector.scaleReal a v

newtype ScaleReal f a = ScaleReal {getScaleReal :: a -> f a -> f a}

scaleRealReal ::
   (Homogeneous property) =>
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C height, Shape.C width, Class.Real a) =>
   a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a
scaleRealReal =
   getScaleReal $ Class.switchReal (ScaleReal scaleReal) (ScaleReal scaleReal)


class (Homogeneous property) => Scale property where
instance Scale Arbitrary where
instance Scale Omni.Symmetric where

scale, (.*#) ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Scale property, Shape.C height, Shape.C width, Class.Floating a) =>
   a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a
scale a (Array v) = Array $ Vector.scale a v
(.*#) = scale

infixl 7 .*#


order ::
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   Layout.Order
order = Omni.order . shape

forceOrder ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C height, Shape.C width, Class.Floating a) =>
   Layout.Order ->
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a
forceOrder order_ a =
   case shape a of
      Omni.UpperTriangular _ -> lift1 (Triangular.forceOrder order_) a
      Omni.LowerTriangular _ -> lift1 (Triangular.forceOrder order_) a
      Omni.Full _ -> liftUnpacked1 (Basic.forceOrder order_) a
      Omni.Symmetric _ -> lift1 (Triangular.forceOrder order_) a
      Omni.Hermitian _ -> lift1 (Triangular.forceOrder order_) a
      Omni.Banded _ -> lift1 (Banded.forceOrder order_) a
      Omni.BandedHermitian _ -> lift1 (BandedHermitian.forceOrder order_) a
      Omni.UnitBandedTriangular _ -> lift1 (Banded.forceOrder order_) a

{- |
@adaptOrder x y@ contains the data of @y@ with the layout of @x@.
-}
adaptOrder ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C height, Shape.C width, Class.Floating a) =>
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a
adaptOrder = forceOrder . order


class (Omni.Property property) => Additive property where
instance Additive Arbitrary where
instance Additive Omni.Symmetric where
instance (TBool.C neg, TBool.C zero, TBool.C pos) =>
            Additive (Omni.Hermitian neg zero pos) where

class (Additive property) => Subtractive property where
instance Subtractive Arbitrary where
instance Subtractive Omni.Symmetric where
instance (TBool.C neg, TBool.C zero, neg ~ pos) =>
            Subtractive (Omni.Hermitian neg zero pos) where

infixl 6 #+#, #-#, `add`, `sub`

add, (#+#) ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Additive property,
    Shape.C height, Eq height, Shape.C width, Eq width, Class.Floating a) =>
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a
add a b = liftOmni2 Vector.add (adaptOrder b a) b

sub, (#-#) ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Subtractive property,
    Shape.C height, Eq height, Shape.C width, Eq width, Class.Floating a) =>
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a ->
   ArrayMatrix pack property lower upper meas vert horiz height width a
sub a b = liftOmni2 Vector.sub (adaptOrder b a) b

(#+#) = add
(#-#) = sub


liftOmni1 ::
   (OmniArray packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    OmniArray packB propB lowerB upperB measB vertB horizB heightB widthB b)
   ->
   ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
   ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB b
liftOmni1 f (Array a) = Array $ f a

liftOmni2 ::
   (OmniArray packA propA lowerA upperA measA vertA horizA heightA widthA a ->
    OmniArray packB propB lowerB upperB measB vertB horizB heightB widthB b ->
    OmniArray packC propC lowerC upperC measC vertC horizC heightC widthC c)
   ->
   ArrayMatrix packA propA lowerA upperA measA vertA horizA heightA widthA a ->
   ArrayMatrix packB propB lowerB upperB measB vertB horizB heightB widthB b ->
   ArrayMatrix packC propC lowerC upperC measC vertC horizC heightC widthC c
liftOmni2 f (Array a) (Array b) = Array $ f a b



instance Matrix.ToQuadratic (Array pack property) where
   heightToQuadratic a@(Array _) =
      case shape a of
         Omni.Full _ ->
            ($a) $ liftUnpacked1 $ Basic.mapExtent $
               Extent.square . Extent.height
         Omni.UpperTriangular _ -> a
         Omni.LowerTriangular _ -> a
         Omni.Symmetric _ -> a
         Omni.Hermitian _ -> a
         Omni.Banded _ ->
            ($a) $ lift1 $ Banded.mapExtentSizes $ Extent.square . Extent.height
         Omni.UnitBandedTriangular _ -> a
         Omni.BandedHermitian _ -> a
   widthToQuadratic a@(Array _) =
      case shape a of
         Omni.Full _ ->
            ($a) $ liftUnpacked1 $ Basic.mapExtent $
               Extent.square . Extent.width
         Omni.UpperTriangular _ -> a
         Omni.LowerTriangular _ -> a
         Omni.Symmetric _ -> a
         Omni.Hermitian _ -> a
         Omni.Banded _ ->
            ($a) $ lift1 $ Banded.mapExtentSizes $ Extent.square . Extent.width
         Omni.UnitBandedTriangular _ -> a
         Omni.BandedHermitian _ -> a


instance
   (MapExtent pack property lower upper, xl ~ (), xu ~ ()) =>
      Matrix.MapExtent (Array pack property) xl xu lower upper where
   mapExtent = mapExtent

class MapExtent pack property lower upper where
   mapExtent ::
      (Extent.Measure measA, Extent.C vertA, Extent.C horizA) =>
      (Extent.Measure measB, Extent.C vertB, Extent.C horizB) =>
      ExtentStrict.Map measA vertA horizA measB vertB horizB height width ->
      ArrayMatrix pack property lower upper measA vertA horizA height width a ->
      ArrayMatrix pack property lower upper measB vertB horizB height width a

instance MapExtent Unpacked Arbitrary Filled Filled where
   mapExtent = lift1 . Plain.mapExtent . ExtentStrict.apply

instance
   (Unary.Natural sub, Unary.Natural super) =>
      MapExtent Packed Arbitrary (Bands sub) (Bands super) where
   mapExtent = lift1 . Banded.mapExtent . ExtentStrict.apply