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

import qualified Data.Array.Comfort.Shape as Shape


{- |
Uses the indices of the second shape,
but the list of indices is restricted by the size of the first shape.
-}
data Min sh0 sh1 = Min {Min sh0 sh1 -> sh0
minShape0 :: sh0, Min sh0 sh1 -> sh1
minShape1 :: sh1}
   deriving (Min sh0 sh1 -> Min sh0 sh1 -> Bool
(Min sh0 sh1 -> Min sh0 sh1 -> Bool)
-> (Min sh0 sh1 -> Min sh0 sh1 -> Bool) -> Eq (Min sh0 sh1)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall sh0 sh1.
(Eq sh0, Eq sh1) =>
Min sh0 sh1 -> Min sh0 sh1 -> Bool
/= :: Min sh0 sh1 -> Min sh0 sh1 -> Bool
$c/= :: forall sh0 sh1.
(Eq sh0, Eq sh1) =>
Min sh0 sh1 -> Min sh0 sh1 -> Bool
== :: Min sh0 sh1 -> Min sh0 sh1 -> Bool
$c== :: forall sh0 sh1.
(Eq sh0, Eq sh1) =>
Min sh0 sh1 -> Min sh0 sh1 -> Bool
Eq, Int -> Min sh0 sh1 -> ShowS
[Min sh0 sh1] -> ShowS
Min sh0 sh1 -> String
(Int -> Min sh0 sh1 -> ShowS)
-> (Min sh0 sh1 -> String)
-> ([Min sh0 sh1] -> ShowS)
-> Show (Min sh0 sh1)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall sh0 sh1. (Show sh0, Show sh1) => Int -> Min sh0 sh1 -> ShowS
forall sh0 sh1. (Show sh0, Show sh1) => [Min sh0 sh1] -> ShowS
forall sh0 sh1. (Show sh0, Show sh1) => Min sh0 sh1 -> String
showList :: [Min sh0 sh1] -> ShowS
$cshowList :: forall sh0 sh1. (Show sh0, Show sh1) => [Min sh0 sh1] -> ShowS
show :: Min sh0 sh1 -> String
$cshow :: forall sh0 sh1. (Show sh0, Show sh1) => Min sh0 sh1 -> String
showsPrec :: Int -> Min sh0 sh1 -> ShowS
$cshowsPrec :: forall sh0 sh1. (Show sh0, Show sh1) => Int -> Min sh0 sh1 -> ShowS
Show)

instance (Shape.C sh0, Shape.C sh1) => Shape.C (Min sh0 sh1) where
   size :: Min sh0 sh1 -> Int
size (Min sh0
sh0 sh1
sh1) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (sh0 -> Int
forall sh. C sh => sh -> Int
Shape.size sh0
sh0) (sh1 -> Int
forall sh. C sh => sh -> Int
Shape.size sh1
sh1)
   uncheckedSize :: Min sh0 sh1 -> Int
uncheckedSize (Min sh0
sh0 sh1
sh1) =
      Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (sh0 -> Int
forall sh. C sh => sh -> Int
Shape.uncheckedSize sh0
sh0) (sh1 -> Int
forall sh. C sh => sh -> Int
Shape.uncheckedSize sh1
sh1)

instance (Shape.C sh0, Shape.Indexed sh1) => Shape.Indexed (Min sh0 sh1) where
   type Index (Min sh0 sh1) = Shape.Index sh1
   indices :: Min sh0 sh1 -> [Index (Min sh0 sh1)]
indices (Min sh0
sh0 sh1
sh1) = Int -> [Index sh1] -> [Index sh1]
forall a. Int -> [a] -> [a]
take (sh0 -> Int
forall sh. C sh => sh -> Int
Shape.size sh0
sh0) ([Index sh1] -> [Index sh1]) -> [Index sh1] -> [Index sh1]
forall a b. (a -> b) -> a -> b
$ sh1 -> [Index sh1]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh1
sh1
   offset :: Min sh0 sh1 -> Index (Min sh0 sh1) -> Int
offset (Min sh0
sh0 sh1
sh1) Index (Min sh0 sh1)
ix =
      let k :: Int
k = sh1 -> Index sh1 -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset sh1
sh1 Index sh1
Index (Min sh0 sh1)
ix
      in if Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<sh0 -> Int
forall sh. C sh => sh -> Int
Shape.size sh0
sh0
            then Int
k
            else String -> Int
forall a. HasCallStack => String -> a
error String
"Shape.Min.offset: index exceeds size of first shape"
   uncheckedOffset :: Min sh0 sh1 -> Index (Min sh0 sh1) -> Int
uncheckedOffset (Min sh0
_sh0 sh1
sh1) Index (Min sh0 sh1)
ix = sh1 -> Index sh1 -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset sh1
sh1 Index sh1
Index (Min sh0 sh1)
ix
   inBounds :: Min sh0 sh1 -> Index (Min sh0 sh1) -> Bool
inBounds (Min sh0
sh0 sh1
sh1) Index (Min sh0 sh1)
ix =
      sh1 -> Index sh1 -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
Shape.inBounds sh1
sh1 Index sh1
Index (Min sh0 sh1)
ix  Bool -> Bool -> Bool
&&  sh1 -> Index sh1 -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset sh1
sh1 Index sh1
Index (Min sh0 sh1)
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< sh0 -> Int
forall sh. C sh => sh -> Int
Shape.size sh0
sh0

instance
   (Shape.C sh0, Shape.InvIndexed sh1) =>
      Shape.InvIndexed (Min sh0 sh1) where
   indexFromOffset :: Min sh0 sh1 -> Int -> Index (Min sh0 sh1)
indexFromOffset (Min sh0
sh0 sh1
sh1) Int
k =
      if Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<sh0 -> Int
forall sh. C sh => sh -> Int
Shape.size sh0
sh0
         then sh1 -> Int -> Index sh1
forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.indexFromOffset sh1
sh1 Int
k
         else String -> Index sh1
forall a. HasCallStack => String -> a
error
               String
"Shape.Min.indexFromOffset: offset exceeds size of first shape"
   uncheckedIndexFromOffset :: Min sh0 sh1 -> Int -> Index (Min sh0 sh1)
uncheckedIndexFromOffset (Min sh0
_sh0 sh1
sh1) Int
k =
      sh1 -> Int -> Index sh1
forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.uncheckedIndexFromOffset sh1
sh1 Int
k