lapack-0.0: src/Numeric/LAPACK/Matrix/Shape/Private.hs

{-# LANGUAGE TypeFamilies #-}
module Numeric.LAPACK.Matrix.Shape.Private where

import qualified Data.Array.Comfort.Shape as Shape

import Data.Tuple.HT (swap)


data Order = RowMajor | ColumnMajor
   deriving (Eq, Show)

flipOrder :: Order -> Order
flipOrder RowMajor = ColumnMajor
flipOrder ColumnMajor = RowMajor

charFromOrder :: Order -> Char
charFromOrder RowMajor = 'T'
charFromOrder ColumnMajor = 'N'


data General height width =
   General {
      generalOrder :: Order,
      generalHeight :: height,
      generalWidth :: width
   } deriving (Eq, Show)

instance (Shape.C height, Shape.C width) => Shape.C (General height width) where
   type Index (General height width) = (Shape.Index height, Shape.Index width)
   indices (General _ height width) = Shape.indices (height,width)

   offset (General RowMajor height width) =
      Shape.offset (height,width)
   offset (General ColumnMajor height width) =
      Shape.offset (width,height) . swap
   uncheckedOffset (General RowMajor height width) =
      Shape.uncheckedOffset (height,width)
   uncheckedOffset (General ColumnMajor height width) =
      Shape.uncheckedOffset (width,height) . swap

   sizeOffset (General RowMajor height width) =
      Shape.sizeOffset (height,width)
   sizeOffset (General ColumnMajor height width) =
      Shape.sizeOffset (width,height) . swap
   uncheckedSizeOffset (General RowMajor height width) =
      Shape.uncheckedSizeOffset (height,width)
   uncheckedSizeOffset (General ColumnMajor height width) =
      Shape.uncheckedSizeOffset (width,height) . swap

   inBounds (General _ height width) = Shape.inBounds (height,width)
   size (General _ height width) = Shape.size (height,width)
   uncheckedSize (General _ height width) = Shape.uncheckedSize (height,width)


transpose :: General height width -> General width height
transpose (General order height width) = General (flipOrder order) width height

dimensions ::
   (Shape.C height, Shape.C width) => General height width -> (Int, Int)
dimensions (General order height width) =
   case order of
      RowMajor -> (Shape.size width, Shape.size height)
      ColumnMajor -> (Shape.size height, Shape.size width)


data Householder height width =
   Householder {
      householderOrder :: Order,
      householderHeight :: height,
      householderWidth :: width
   } deriving (Eq, Show)

data Reflector = Reflector deriving (Eq)
data Triangular = Triangular deriving (Eq)

householderPart ::
   (Shape.C height, Shape.C width) =>
   Householder height width ->
   (Shape.Index height, Shape.Index width) -> Either Reflector Triangular
householderPart (Householder _ height width) (r,c) =
   if Shape.offset height r > Shape.offset width c
     then Left Reflector
     else Right Triangular

instance
   (Shape.C height, Shape.C width) =>
      Shape.C (Householder height width) where

   type Index (Householder height width) =
            (Either Reflector Triangular,
             (Shape.Index height, Shape.Index width))

   indices sh@(Householder _ height width) =
      map (\ix -> (householderPart sh ix, ix)) $
      Shape.indices (height,width)

   offset sh@(Householder order height width) (part,ix) =
      if part == householderPart sh ix
        then
            case order of
               RowMajor -> Shape.offset (height,width) ix
               ColumnMajor -> Shape.offset (width,height) (swap ix)
        else error "Shape.Householder.offset: wrong matrix part"
   uncheckedOffset (Householder RowMajor height width) =
      Shape.uncheckedOffset (height,width) . snd
   uncheckedOffset (Householder ColumnMajor height width) =
      Shape.uncheckedOffset (width,height) . swap . snd

   sizeOffset sh@(Householder order height width) (part,ix) =
      if part == householderPart sh ix
        then
            case order of
               RowMajor -> Shape.sizeOffset (height,width) ix
               ColumnMajor -> Shape.sizeOffset (width,height) (swap ix)
        else error "Shape.Householder.sizeOffset: wrong matrix part"
   uncheckedSizeOffset (Householder RowMajor height width) =
      Shape.uncheckedSizeOffset (height,width) . snd
   uncheckedSizeOffset (Householder ColumnMajor height width) =
      Shape.uncheckedSizeOffset (width,height) . swap . snd

   size (Householder _ height width) = Shape.size (height,width)
   uncheckedSize (Householder _ height width) =
      Shape.uncheckedSize (height,width)
   inBounds sh@(Householder _ height width) (part,ix) =
      Shape.inBounds (height,width) ix
      &&
      part == householderPart sh ix