{- | Sparse matrices.  Original: Agda.Termination.SparseMatrix

We assume the matrices to be very sparse, so we just implement them as
sorted association lists.

 -}
{-# LANGUAGE CPP #-}

#if __GLASGOW_HASKELL_ >= 800
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
#else
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
#endif

module SparseMatrix
  ( -- * Basic data types
    Matrix(M)
  , matrixInvariant
  , Size(..)
  , sizeInvariant
  , MIx (..)
  , mIxInvariant
    -- * Generating and creating matrices
  , fromLists
  , fromIndexList
  , toLists
--  , matrix
--  , matrixUsingRowGen
    -- * Combining and querying matrices
  , size
  , square
  , isEmpty
  , isSingleton
  , SparseMatrix.all, SparseMatrix.any
  , add, intersectWith, SparseMatrix.zip
  , mul
  , transpose
  , diagonal
    -- * Modifying matrices
  , addRow
  , addColumn
    -- * Tests
  ) where

import Data.Array
import qualified Data.List as List
-- import Data.Monoid

-- import Test.QuickCheck

import Semiring (HasZero(..), Semiring)
import qualified Semiring as Semiring



------------------------------------------------------------------------
-- Basic data types

-- | This matrix type is used for tests.

type TM = Matrix Integer Integer

-- | Size of a matrix.

data Size i = Size { forall i. Size i -> i
rows :: i, forall i. Size i -> i
cols :: i }
  deriving (Size i -> Size i -> Bool
(Size i -> Size i -> Bool)
-> (Size i -> Size i -> Bool) -> Eq (Size i)
forall i. Eq i => Size i -> Size i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall i. Eq i => Size i -> Size i -> Bool
== :: Size i -> Size i -> Bool
$c/= :: forall i. Eq i => Size i -> Size i -> Bool
/= :: Size i -> Size i -> Bool
Eq, Eq (Size i)
Eq (Size i) =>
(Size i -> Size i -> Ordering)
-> (Size i -> Size i -> Bool)
-> (Size i -> Size i -> Bool)
-> (Size i -> Size i -> Bool)
-> (Size i -> Size i -> Bool)
-> (Size i -> Size i -> Size i)
-> (Size i -> Size i -> Size i)
-> Ord (Size i)
Size i -> Size i -> Bool
Size i -> Size i -> Ordering
Size i -> Size i -> Size i
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall i. Ord i => Eq (Size i)
forall i. Ord i => Size i -> Size i -> Bool
forall i. Ord i => Size i -> Size i -> Ordering
forall i. Ord i => Size i -> Size i -> Size i
$ccompare :: forall i. Ord i => Size i -> Size i -> Ordering
compare :: Size i -> Size i -> Ordering
$c< :: forall i. Ord i => Size i -> Size i -> Bool
< :: Size i -> Size i -> Bool
$c<= :: forall i. Ord i => Size i -> Size i -> Bool
<= :: Size i -> Size i -> Bool
$c> :: forall i. Ord i => Size i -> Size i -> Bool
> :: Size i -> Size i -> Bool
$c>= :: forall i. Ord i => Size i -> Size i -> Bool
>= :: Size i -> Size i -> Bool
$cmax :: forall i. Ord i => Size i -> Size i -> Size i
max :: Size i -> Size i -> Size i
$cmin :: forall i. Ord i => Size i -> Size i -> Size i
min :: Size i -> Size i -> Size i
Ord, Int -> Size i -> ShowS
[Size i] -> ShowS
Size i -> String
(Int -> Size i -> ShowS)
-> (Size i -> String) -> ([Size i] -> ShowS) -> Show (Size i)
forall i. Show i => Int -> Size i -> ShowS
forall i. Show i => [Size i] -> ShowS
forall i. Show i => Size i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall i. Show i => Int -> Size i -> ShowS
showsPrec :: Int -> Size i -> ShowS
$cshow :: forall i. Show i => Size i -> String
show :: Size i -> String
$cshowList :: forall i. Show i => [Size i] -> ShowS
showList :: [Size i] -> ShowS
Show)

sizeInvariant :: (Ord i, Num i) => Size i -> Bool
sizeInvariant :: forall i. (Ord i, Num i) => Size i -> Bool
sizeInvariant Size i
sz = Size i -> i
forall i. Size i -> i
rows Size i
sz i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
0 Bool -> Bool -> Bool
&& Size i -> i
forall i. Size i -> i
cols Size i
sz i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
0

{-
instance (Arbitrary i, Integral i) => Arbitrary (Size i) where
  arbitrary = do
    r <- natural
    c <- natural
    return $ Size { rows = fromInteger r, cols = fromInteger c }

instance CoArbitrary i => CoArbitrary (Size i) where
  coarbitrary (Size rs cs) = coarbitrary rs . coarbitrary cs

prop_Arbitrary_Size :: Size Integer -> Bool
prop_Arbitrary_Size = sizeInvariant
-}

-- | Converts a size to a set of bounds suitable for use with
-- the matrices in this module.

toBounds :: Num i => Size i -> (MIx i, MIx i)
toBounds :: forall i. Num i => Size i -> (MIx i, MIx i)
toBounds Size i
sz = (MIx { row :: i
row = i
1, col :: i
col = i
1 }, MIx { row :: i
row = Size i -> i
forall i. Size i -> i
rows Size i
sz, col :: i
col = Size i -> i
forall i. Size i -> i
cols Size i
sz })

-- | Type of matrix indices (row, column).

data MIx i = MIx { forall i. MIx i -> i
row, forall i. MIx i -> i
col :: i }
  deriving (MIx i -> MIx i -> Bool
(MIx i -> MIx i -> Bool) -> (MIx i -> MIx i -> Bool) -> Eq (MIx i)
forall i. Eq i => MIx i -> MIx i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall i. Eq i => MIx i -> MIx i -> Bool
== :: MIx i -> MIx i -> Bool
$c/= :: forall i. Eq i => MIx i -> MIx i -> Bool
/= :: MIx i -> MIx i -> Bool
Eq, Int -> MIx i -> ShowS
[MIx i] -> ShowS
MIx i -> String
(Int -> MIx i -> ShowS)
-> (MIx i -> String) -> ([MIx i] -> ShowS) -> Show (MIx i)
forall i. Show i => Int -> MIx i -> ShowS
forall i. Show i => [MIx i] -> ShowS
forall i. Show i => MIx i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall i. Show i => Int -> MIx i -> ShowS
showsPrec :: Int -> MIx i -> ShowS
$cshow :: forall i. Show i => MIx i -> String
show :: MIx i -> String
$cshowList :: forall i. Show i => [MIx i] -> ShowS
showList :: [MIx i] -> ShowS
Show, Ord (MIx i)
Ord (MIx i) =>
((MIx i, MIx i) -> [MIx i])
-> ((MIx i, MIx i) -> MIx i -> Int)
-> ((MIx i, MIx i) -> MIx i -> Int)
-> ((MIx i, MIx i) -> MIx i -> Bool)
-> ((MIx i, MIx i) -> Int)
-> ((MIx i, MIx i) -> Int)
-> Ix (MIx i)
(MIx i, MIx i) -> Int
(MIx i, MIx i) -> [MIx i]
(MIx i, MIx i) -> MIx i -> Bool
(MIx i, MIx i) -> MIx i -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
forall i. Ix i => Ord (MIx i)
forall i. Ix i => (MIx i, MIx i) -> Int
forall i. Ix i => (MIx i, MIx i) -> [MIx i]
forall i. Ix i => (MIx i, MIx i) -> MIx i -> Bool
forall i. Ix i => (MIx i, MIx i) -> MIx i -> Int
$crange :: forall i. Ix i => (MIx i, MIx i) -> [MIx i]
range :: (MIx i, MIx i) -> [MIx i]
$cindex :: forall i. Ix i => (MIx i, MIx i) -> MIx i -> Int
index :: (MIx i, MIx i) -> MIx i -> Int
$cunsafeIndex :: forall i. Ix i => (MIx i, MIx i) -> MIx i -> Int
unsafeIndex :: (MIx i, MIx i) -> MIx i -> Int
$cinRange :: forall i. Ix i => (MIx i, MIx i) -> MIx i -> Bool
inRange :: (MIx i, MIx i) -> MIx i -> Bool
$crangeSize :: forall i. Ix i => (MIx i, MIx i) -> Int
rangeSize :: (MIx i, MIx i) -> Int
$cunsafeRangeSize :: forall i. Ix i => (MIx i, MIx i) -> Int
unsafeRangeSize :: (MIx i, MIx i) -> Int
Ix, Eq (MIx i)
Eq (MIx i) =>
(MIx i -> MIx i -> Ordering)
-> (MIx i -> MIx i -> Bool)
-> (MIx i -> MIx i -> Bool)
-> (MIx i -> MIx i -> Bool)
-> (MIx i -> MIx i -> Bool)
-> (MIx i -> MIx i -> MIx i)
-> (MIx i -> MIx i -> MIx i)
-> Ord (MIx i)
MIx i -> MIx i -> Bool
MIx i -> MIx i -> Ordering
MIx i -> MIx i -> MIx i
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall i. Ord i => Eq (MIx i)
forall i. Ord i => MIx i -> MIx i -> Bool
forall i. Ord i => MIx i -> MIx i -> Ordering
forall i. Ord i => MIx i -> MIx i -> MIx i
$ccompare :: forall i. Ord i => MIx i -> MIx i -> Ordering
compare :: MIx i -> MIx i -> Ordering
$c< :: forall i. Ord i => MIx i -> MIx i -> Bool
< :: MIx i -> MIx i -> Bool
$c<= :: forall i. Ord i => MIx i -> MIx i -> Bool
<= :: MIx i -> MIx i -> Bool
$c> :: forall i. Ord i => MIx i -> MIx i -> Bool
> :: MIx i -> MIx i -> Bool
$c>= :: forall i. Ord i => MIx i -> MIx i -> Bool
>= :: MIx i -> MIx i -> Bool
$cmax :: forall i. Ord i => MIx i -> MIx i -> MIx i
max :: MIx i -> MIx i -> MIx i
$cmin :: forall i. Ord i => MIx i -> MIx i -> MIx i
min :: MIx i -> MIx i -> MIx i
Ord)

{-
instance (Arbitrary i, Integral i) => Arbitrary (MIx i) where
  arbitrary = do
    r <- positive
    c <- positive
    return $ MIx { row = r, col = c }

instance CoArbitrary i => CoArbitrary (MIx i) where
  coarbitrary (MIx r c) = coarbitrary r . coarbitrary c
-}

-- | No nonpositive indices are allowed.

mIxInvariant :: (Ord i, Num i) => MIx i -> Bool
mIxInvariant :: forall i. (Ord i, Num i) => MIx i -> Bool
mIxInvariant MIx i
i = MIx i -> i
forall i. MIx i -> i
row MIx i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
1 Bool -> Bool -> Bool
&& MIx i -> i
forall i. MIx i -> i
col MIx i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
1

prop_Arbitrary_MIx :: MIx Integer -> Bool
prop_Arbitrary_MIx :: MIx Integer -> Bool
prop_Arbitrary_MIx = MIx Integer -> Bool
forall i. (Ord i, Num i) => MIx i -> Bool
mIxInvariant

-- | Type of matrices, parameterised on the type of values.

data Matrix i b = M { forall i b. Matrix i b -> Size i
size :: Size i, forall i b. Matrix i b -> [(MIx i, b)]
unM :: [(MIx i, b)] }
  deriving (Eq (Matrix i b)
Eq (Matrix i b) =>
(Matrix i b -> Matrix i b -> Ordering)
-> (Matrix i b -> Matrix i b -> Bool)
-> (Matrix i b -> Matrix i b -> Bool)
-> (Matrix i b -> Matrix i b -> Bool)
-> (Matrix i b -> Matrix i b -> Bool)
-> (Matrix i b -> Matrix i b -> Matrix i b)
-> (Matrix i b -> Matrix i b -> Matrix i b)
-> Ord (Matrix i b)
Matrix i b -> Matrix i b -> Bool
Matrix i b -> Matrix i b -> Ordering
Matrix i b -> Matrix i b -> Matrix i b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall i b. (HasZero b, Ord i, Ord b) => Eq (Matrix i b)
forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Bool
forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Ordering
forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Matrix i b
$ccompare :: forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Ordering
compare :: Matrix i b -> Matrix i b -> Ordering
$c< :: forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Bool
< :: Matrix i b -> Matrix i b -> Bool
$c<= :: forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Bool
<= :: Matrix i b -> Matrix i b -> Bool
$c> :: forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Bool
> :: Matrix i b -> Matrix i b -> Bool
$c>= :: forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Bool
>= :: Matrix i b -> Matrix i b -> Bool
$cmax :: forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Matrix i b
max :: Matrix i b -> Matrix i b -> Matrix i b
$cmin :: forall i b.
(HasZero b, Ord i, Ord b) =>
Matrix i b -> Matrix i b -> Matrix i b
min :: Matrix i b -> Matrix i b -> Matrix i b
Ord)

instance (Ord i, Eq a, HasZero a) => Eq (Matrix i a) where
  Matrix i a
m1 == :: Matrix i a -> Matrix i a -> Bool
== Matrix i a
m2 = Matrix i a -> Size i
forall i b. Matrix i b -> Size i
size Matrix i a
m1 Size i -> Size i -> Bool
forall a. Eq a => a -> a -> Bool
== Matrix i a -> Size i
forall i b. Matrix i b -> Size i
size Matrix i a
m2 Bool -> Bool -> Bool
&&
    ((a, a) -> Bool) -> Matrix i (a, a) -> Bool
forall a i. (a -> Bool) -> Matrix i a -> Bool
SparseMatrix.all ((a -> a -> Bool) -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)) (Matrix i a -> Matrix i a -> Matrix i (a, a)
forall i a.
(Ord i, HasZero a) =>
Matrix i a -> Matrix i a -> Matrix i (a, a)
SparseMatrix.zip Matrix i a
m1 Matrix i a
m2)

instance Functor (Matrix i) where
  fmap :: forall a b. (a -> b) -> Matrix i a -> Matrix i b
fmap a -> b
f (M Size i
sz [(MIx i, a)]
m) = Size i -> [(MIx i, b)] -> Matrix i b
forall i b. Size i -> [(MIx i, b)] -> Matrix i b
M Size i
sz (((MIx i, a) -> (MIx i, b)) -> [(MIx i, a)] -> [(MIx i, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (MIx i
i,a
a) -> (MIx i
i, a -> b
f a
a)) [(MIx i, a)]
m)

matrixInvariant :: (Num i, Ix i) => Matrix i b -> Bool
matrixInvariant :: forall i b. (Num i, Ix i) => Matrix i b -> Bool
matrixInvariant Matrix i b
m = ((MIx i, b) -> Bool) -> [(MIx i, b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all (\ (MIx i
i i
j, b
_) -> i
1 i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
i Bool -> Bool -> Bool
&& i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= Size i -> i
forall i. Size i -> i
rows Size i
sz
                                             Bool -> Bool -> Bool
&& i
1 i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
j Bool -> Bool -> Bool
&& i
j i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= Size i -> i
forall i. Size i -> i
cols Size i
sz) (Matrix i b -> [(MIx i, b)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i b
m)
  Bool -> Bool -> Bool
&& MIx i -> [(MIx i, b)] -> Bool
forall i b. Ord i => i -> [(i, b)] -> Bool
strictlySorted (i -> i -> MIx i
forall i. i -> i -> MIx i
MIx i
0 i
0) (Matrix i b -> [(MIx i, b)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i b
m)
  Bool -> Bool -> Bool
&& Size i -> Bool
forall i. (Ord i, Num i) => Size i -> Bool
sizeInvariant Size i
sz
  where sz :: Size i
sz = Matrix i b -> Size i
forall i b. Matrix i b -> Size i
size Matrix i b
m

-- matrix indices are lexicographically sorted with no duplicates
-- Ord MIx should be the lexicographic one already (Haskell report)

strictlySorted :: (Ord i) => i -> [(i, b)] -> Bool
strictlySorted :: forall i b. Ord i => i -> [(i, b)] -> Bool
strictlySorted i
_ [] = Bool
True
strictlySorted i
i ((i
i', b
_) : [(i, b)]
l) = i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
i' Bool -> Bool -> Bool
&& i -> [(i, b)] -> Bool
forall i b. Ord i => i -> [(i, b)] -> Bool
strictlySorted i
i' [(i, b)]
l
{-
strictlySorted (MIx i j) [] = True
strictlySorted (MIx i j) ((MIx i' j', b) : l) =
  (i < i' || i == i' &&  j < j' ) && strictlySorted (MIx i' j') b
-}

instance (Ord i, Integral i, Enum i, Show i, Show b, HasZero b) => Show (Matrix i b) where
  showsPrec :: Int -> Matrix i b -> ShowS
showsPrec Int
_ Matrix i b
m =
    String -> ShowS
showString String
"SparseMatrix.fromLists " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size i -> ShowS
forall a. Show a => a -> ShowS
shows (Matrix i b -> Size i
forall i b. Matrix i b -> Size i
size Matrix i b
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[b]] -> ShowS
forall a. Show a => a -> ShowS
shows (Matrix i b -> [[b]]
forall i b.
(Ord i, Integral i, Enum i, HasZero b, Show i) =>
Matrix i b -> [[b]]
toLists Matrix i b
m)

{-
instance (Integral i, HasZero b, Pretty b) =>
         Pretty (Matrix i b) where
  pretty = vcat . map (hsep . map pretty) . toLists

instance (Arbitrary i, Num i, Integral i, Arbitrary b, HasZero b)
         => Arbitrary (Matrix i b) where
  arbitrary     = matrix =<< arbitrary

instance (Ord i, Integral i, Enum i, CoArbitrary b, HasZero b) => CoArbitrary (Matrix i b) where
  coarbitrary m = coarbitrary (toLists m)


prop_Arbitrary_Matrix :: TM -> Bool
prop_Arbitrary_Matrix = matrixInvariant
-}

------------------------------------------------------------------------
-- Generating and creating matrices

-- | Generates a matrix of the given size, using the given generator
-- to generate the rows.

{-
matrixUsingRowGen :: (Arbitrary i, Integral i, Arbitrary b, HasZero b)
  => Size i
  -> (i -> Gen [b])
     -- ^ The generator is parameterised on the size of the row.
  -> Gen (Matrix i b)
matrixUsingRowGen sz rowGen = do
  rows <- vectorOf (fromIntegral $ rows sz) (rowGen $ cols sz)
  return $ fromLists sz rows
-}

-- | Generates a matrix of the given size.

{-
matrix :: (Arbitrary i, Integral i, Arbitrary b, HasZero b)
  => Size i -> Gen (Matrix i b)
matrix sz = matrixUsingRowGen sz (\n -> vectorOf (fromIntegral n) arbitrary)

prop_matrix sz = forAll (matrix sz :: Gen TM) $ \m ->
--  matrixInvariant m &&
  size m == sz
-}

-- | Constructs a matrix from a list of (index, value)-pairs.

-- compareElt = (\ (i,_) (j,_) -> compare i j)
-- normalize = filter (\ (i,b) -> b /= zeroElement)

fromIndexList :: (Ord i, HasZero b) => Size i -> [(MIx i, b)] -> Matrix i b
fromIndexList :: forall i b.
(Ord i, HasZero b) =>
Size i -> [(MIx i, b)] -> Matrix i b
fromIndexList Size i
sz = Size i -> [(MIx i, b)] -> Matrix i b
forall i b. Size i -> [(MIx i, b)] -> Matrix i b
M Size i
sz ([(MIx i, b)] -> Matrix i b)
-> ([(MIx i, b)] -> [(MIx i, b)]) -> [(MIx i, b)] -> Matrix i b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MIx i, b) -> (MIx i, b) -> Ordering)
-> [(MIx i, b)] -> [(MIx i, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (\ (MIx i
i,b
_) (MIx i
j,b
_) -> MIx i -> MIx i -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MIx i
i MIx i
j) ([(MIx i, b)] -> [(MIx i, b)])
-> ([(MIx i, b)] -> [(MIx i, b)]) -> [(MIx i, b)] -> [(MIx i, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MIx i, b) -> Bool) -> [(MIx i, b)] -> [(MIx i, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ (MIx i
_,b
b) -> b
b b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
forall a. HasZero a => a
zeroElement)

prop_fromIndexList :: TM -> Bool
prop_fromIndexList :: Matrix Integer Integer -> Bool
prop_fromIndexList Matrix Integer Integer
m = Matrix Integer Integer -> Bool
forall i b. (Num i, Ix i) => Matrix i b -> Bool
matrixInvariant Matrix Integer Integer
m' Bool -> Bool -> Bool
&& Matrix Integer Integer
m' Matrix Integer Integer -> Matrix Integer Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Matrix Integer Integer
m
  where vs :: [(MIx Integer, Integer)]
vs = Matrix Integer Integer -> [(MIx Integer, Integer)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix Integer Integer
m
        m' :: Matrix Integer Integer
m' = Size Integer -> [(MIx Integer, Integer)] -> Matrix Integer Integer
forall i b.
(Ord i, HasZero b) =>
Size i -> [(MIx i, b)] -> Matrix i b
fromIndexList (Matrix Integer Integer -> Size Integer
forall i b. Matrix i b -> Size i
size Matrix Integer Integer
m) [(MIx Integer, Integer)]
vs

-- | @'fromLists' sz rs@ constructs a matrix from a list of lists of
-- values (a list of rows).
--
-- Precondition: @'length' rs '==' 'rows' sz '&&' 'all' (('==' 'cols' sz) . 'length') rs@.

fromLists :: (Ord i, Num i, Enum i, HasZero b) => Size i -> [[b]] -> Matrix i b
fromLists :: forall i b.
(Ord i, Num i, Enum i, HasZero b) =>
Size i -> [[b]] -> Matrix i b
fromLists Size i
sz [[b]]
bs = Size i -> [(MIx i, b)] -> Matrix i b
forall i b.
(Ord i, HasZero b) =>
Size i -> [(MIx i, b)] -> Matrix i b
fromIndexList Size i
sz ([(MIx i, b)] -> Matrix i b) -> [(MIx i, b)] -> Matrix i b
forall a b. (a -> b) -> a -> b
$
  [MIx i] -> [b] -> [(MIx i, b)]
forall a b. [a] -> [b] -> [(a, b)]
List.zip ([ i -> i -> MIx i
forall i. i -> i -> MIx i
MIx i
i i
j | i
i <- [i
1..Size i -> i
forall i. Size i -> i
rows Size i
sz] , i
j <- [i
1..Size i -> i
forall i. Size i -> i
cols Size i
sz]]) ([[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[b]]
bs)

-- | Converts a sparse matrix to a sparse list of rows

toSparseRows :: (Num i, Enum i, Eq i) => Matrix i b -> [(i,[(i,b)])]
toSparseRows :: forall i b. (Num i, Enum i, Eq i) => Matrix i b -> [(i, [(i, b)])]
toSparseRows Matrix i b
m0 = i -> [(i, b)] -> [(MIx i, b)] -> [(i, [(i, b)])]
forall {a} {b}.
Eq a =>
a -> [(a, b)] -> [(MIx a, b)] -> [(a, [(a, b)])]
aux i
1 [] (Matrix i b -> [(MIx i, b)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i b
m0)
  where aux :: a -> [(a, b)] -> [(MIx a, b)] -> [(a, [(a, b)])]
aux a
_  [] []  = []
        aux a
i' [(a, b)]
row [] = [(a
i', [(a, b)] -> [(a, b)]
forall a. [a] -> [a]
reverse [(a, b)]
row)]
        aux a
i' [(a, b)]
row ((MIx a
i a
j, b
b) : [(MIx a, b)]
m)
            | a
i' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
i   = a -> [(a, b)] -> [(MIx a, b)] -> [(a, [(a, b)])]
aux a
i' ((a
j,b
b)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
row) [(MIx a, b)]
m
            | Bool
otherwise = (a
i', [(a, b)] -> [(a, b)]
forall a. [a] -> [a]
reverse [(a, b)]
row) (a, [(a, b)]) -> [(a, [(a, b)])] -> [(a, [(a, b)])]
forall a. a -> [a] -> [a]
: a -> [(a, b)] -> [(MIx a, b)] -> [(a, [(a, b)])]
aux a
i [(a
j,b
b)] [(MIx a, b)]
m

-- sparse vectors cannot have two entries in one column
blowUpSparseVec :: (Eq i, Ord i, Num i, Enum i, Show i) => b -> i -> [(i,b)] -> [b]
blowUpSparseVec :: forall i b.
(Eq i, Ord i, Num i, Enum i, Show i) =>
b -> i -> [(i, b)] -> [b]
blowUpSparseVec b
zero i
n = i -> [(i, b)] -> [b]
aux i
1
  where aux :: i -> [(i, b)] -> [b]
aux i
i [] | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
n = []
                 | Bool
otherwise = b
zero b -> [b] -> [b]
forall a. a -> [a] -> [a]
: i -> [(i, b)] -> [b]
aux (i
ii -> i -> i
forall a. Num a => a -> a -> a
+i
1) []
        aux i
i ((i
j,b
b):[(i, b)]
l) | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
n Bool -> Bool -> Bool
&& i
j i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
i = b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: i -> [(i, b)] -> [b]
aux (i -> i
forall a. Enum a => a -> a
succ i
i) [(i, b)]
l
        aux i
i ((i
j,b
b):[(i, b)]
l) | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
n Bool -> Bool -> Bool
&& i
j i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
i = b
zero b -> [b] -> [b]
forall a. a -> [a] -> [a]
: i -> [(i, b)] -> [b]
aux (i -> i
forall a. Enum a => a -> a
succ i
i) ((i
j,b
b)(i, b) -> [(i, b)] -> [(i, b)]
forall a. a -> [a] -> [a]
:[(i, b)]
l)
        aux i
i [(i, b)]
l = String -> [b]
forall a. HasCallStack => String -> a
error (String -> [b]) -> String -> [b]
forall a b. (a -> b) -> a -> b
$ String
"blowUpSparseVec (n = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ i -> String
forall a. Show a => a -> String
show i
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") aux i=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ i -> String
forall a. Show a => a -> String
show i
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" j=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ i -> String
forall a. Show a => a -> String
show ((i, b) -> i
forall a b. (a, b) -> a
fst ([(i, b)] -> (i, b)
forall a. HasCallStack => [a] -> a
head [(i, b)]
l)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" length l = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([(i, b)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(i, b)]
l)
-- __IMPOSSIBLE__

-- | Converts a matrix to a list of row lists.

toLists :: (Ord i, Integral i, Enum i, HasZero b, Show i) => Matrix i b -> [[b]]
toLists :: forall i b.
(Ord i, Integral i, Enum i, HasZero b, Show i) =>
Matrix i b -> [[b]]
toLists Matrix i b
m = [b] -> i -> [(i, [b])] -> [[b]]
forall i b.
(Eq i, Ord i, Num i, Enum i, Show i) =>
b -> i -> [(i, b)] -> [b]
blowUpSparseVec [b]
forall {a}. HasZero a => [a]
emptyRow (Size i -> i
forall i. Size i -> i
rows Size i
sz) ([(i, [b])] -> [[b]]) -> [(i, [b])] -> [[b]]
forall a b. (a -> b) -> a -> b
$
    ((i, [(i, b)]) -> (i, [b])) -> [(i, [(i, b)])] -> [(i, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (\ (i
i,[(i, b)]
r) -> (i
i, b -> i -> [(i, b)] -> [b]
forall i b.
(Eq i, Ord i, Num i, Enum i, Show i) =>
b -> i -> [(i, b)] -> [b]
blowUpSparseVec b
forall a. HasZero a => a
zeroElement (Size i -> i
forall i. Size i -> i
cols Size i
sz) [(i, b)]
r)) ([(i, [(i, b)])] -> [(i, [b])]) -> [(i, [(i, b)])] -> [(i, [b])]
forall a b. (a -> b) -> a -> b
$ Matrix i b -> [(i, [(i, b)])]
forall i b. (Num i, Enum i, Eq i) => Matrix i b -> [(i, [(i, b)])]
toSparseRows Matrix i b
m
--            [ [ maybe zeroElement id $ lookup (MIx { row = r, col = c }) (unM m)
--            | c <- [1 .. cols sz] ] | r <- [1 .. rows sz] ]
  where sz :: Size i
sz = Matrix i b -> Size i
forall i b. Matrix i b -> Size i
size Matrix i b
m
        emptyRow :: [a]
emptyRow = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Size i -> i
forall i. Size i -> i
cols Size i
sz)) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall a. a -> [a]
repeat a
forall a. HasZero a => a
zeroElement

prop_fromLists_toLists :: TM -> Bool
prop_fromLists_toLists :: Matrix Integer Integer -> Bool
prop_fromLists_toLists Matrix Integer Integer
m = Size Integer -> [[Integer]] -> Matrix Integer Integer
forall i b.
(Ord i, Num i, Enum i, HasZero b) =>
Size i -> [[b]] -> Matrix i b
fromLists (Matrix Integer Integer -> Size Integer
forall i b. Matrix i b -> Size i
size Matrix Integer Integer
m) (Matrix Integer Integer -> [[Integer]]
forall i b.
(Ord i, Integral i, Enum i, HasZero b, Show i) =>
Matrix i b -> [[b]]
toLists Matrix Integer Integer
m) Matrix Integer Integer -> Matrix Integer Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Matrix Integer Integer
m

------------------------------------------------------------------------
-- Combining and querying matrices

-- | The size of a matrix.

{-
size :: Ix i => Matrix i b -> Size i
size m = Size { rows = row b, cols = col b }
  where (_, b) = bounds $ unM m
-}

prop_size :: TM -> Bool
prop_size :: Matrix Integer Integer -> Bool
prop_size Matrix Integer Integer
m = Size Integer -> Bool
forall i. (Ord i, Num i) => Size i -> Bool
sizeInvariant (Matrix Integer Integer -> Size Integer
forall i b. Matrix i b -> Size i
size Matrix Integer Integer
m)


prop_size_fromIndexList :: Size Int -> Bool
prop_size_fromIndexList :: Size Int -> Bool
prop_size_fromIndexList Size Int
sz =
  Matrix Int Integer -> Size Int
forall i b. Matrix i b -> Size i
size (Size Int -> [(MIx Int, Integer)] -> Matrix Int Integer
forall i b.
(Ord i, HasZero b) =>
Size i -> [(MIx i, b)] -> Matrix i b
fromIndexList Size Int
sz ([] :: [(MIx Int, Integer)])) Size Int -> Size Int -> Bool
forall a. Eq a => a -> a -> Bool
== Size Int
sz

-- | 'True' iff the matrix is square.

square :: Ix i => Matrix i b -> Bool
square :: forall i b. Ix i => Matrix i b -> Bool
square Matrix i b
m = Size i -> i
forall i. Size i -> i
rows (Matrix i b -> Size i
forall i b. Matrix i b -> Size i
size Matrix i b
m) i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== Size i -> i
forall i. Size i -> i
cols (Matrix i b -> Size i
forall i b. Matrix i b -> Size i
size Matrix i b
m)

-- | Returns 'True' iff the matrix is empty.

isEmpty :: (Num i, Ix i) => Matrix i b -> Bool
isEmpty :: forall i b. (Num i, Ix i) => Matrix i b -> Bool
isEmpty Matrix i b
m = Size i -> i
forall i. Size i -> i
rows Size i
sz i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
0 Bool -> Bool -> Bool
|| Size i -> i
forall i. Size i -> i
cols Size i
sz i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
0
  where sz :: Size i
sz = Matrix i b -> Size i
forall i b. Matrix i b -> Size i
size Matrix i b
m

-- | Returns 'Just b' iff it is a 1x1 matrix with just one entry 'b'.

isSingleton :: (Num i, Ix i, HasZero b) => Matrix i b -> Maybe b
isSingleton :: forall i b. (Num i, Ix i, HasZero b) => Matrix i b -> Maybe b
isSingleton Matrix i b
m = if (Size i -> i
forall i. Size i -> i
rows Size i
sz i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
1 Bool -> Bool -> Bool
|| Size i -> i
forall i. Size i -> i
cols Size i
sz i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
1) then
    case Matrix i b -> [(MIx i, b)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i b
m of
      [(MIx i
_,b
b)] -> b -> Maybe b
forall a. a -> Maybe a
Just b
b
      []      -> b -> Maybe b
forall a. a -> Maybe a
Just b
forall a. HasZero a => a
zeroElement
      [(MIx i, b)]
_       -> Maybe b
forall a. HasCallStack => a
undefined
  else Maybe b
forall a. Maybe a
Nothing
  where sz :: Size i
sz = Matrix i b -> Size i
forall i b. Matrix i b -> Size i
size Matrix i b
m

-- | Transposition
transposeSize :: Size i -> Size i
transposeSize :: forall i. Size i -> Size i
transposeSize (Size { rows :: forall i. Size i -> i
rows = i
n, cols :: forall i. Size i -> i
cols = i
m }) = Size { rows :: i
rows = i
m, cols :: i
cols = i
n }

transpose :: Ord i => Matrix i b -> Matrix i b
transpose :: forall i b. Ord i => Matrix i b -> Matrix i b
transpose Matrix i b
m = M { size :: Size i
size = Size i -> Size i
forall i. Size i -> Size i
transposeSize (Matrix i b -> Size i
forall i b. Matrix i b -> Size i
size Matrix i b
m)
                , unM :: [(MIx i, b)]
unM  = ((MIx i, b) -> (MIx i, b) -> Ordering)
-> [(MIx i, b)] -> [(MIx i, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (\ (MIx i
i,b
_) (MIx i
j,b
_) -> MIx i -> MIx i -> Ordering
forall a. Ord a => a -> a -> Ordering
compare MIx i
i MIx i
j) ([(MIx i, b)] -> [(MIx i, b)]) -> [(MIx i, b)] -> [(MIx i, b)]
forall a b. (a -> b) -> a -> b
$
                           ((MIx i, b) -> (MIx i, b)) -> [(MIx i, b)] -> [(MIx i, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(MIx i
i i
j, b
b) -> (i -> i -> MIx i
forall i. i -> i -> MIx i
MIx i
j i
i, b
b)) ([(MIx i, b)] -> [(MIx i, b)]) -> [(MIx i, b)] -> [(MIx i, b)]
forall a b. (a -> b) -> a -> b
$ Matrix i b -> [(MIx i, b)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i b
m }

all :: (a -> Bool) -> Matrix i a -> Bool
all :: forall a i. (a -> Bool) -> Matrix i a -> Bool
all a -> Bool
p Matrix i a
m = ((MIx i, a) -> Bool) -> [(MIx i, a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all (\ (MIx i
_,a
a) -> a -> Bool
p a
a) (Matrix i a -> [(MIx i, a)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i a
m)

any :: (a -> Bool) -> Matrix i a -> Bool
any :: forall a i. (a -> Bool) -> Matrix i a -> Bool
any a -> Bool
p Matrix i a
m = ((MIx i, a) -> Bool) -> [(MIx i, a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.any (\ (MIx i
_,a
a) -> a -> Bool
p a
a) (Matrix i a -> [(MIx i, a)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i a
m)

-- | @'zip' m1 m2@ zips @m1@ and @m2@.
--
-- Precondition: @'size' m1 == 'size' m2@.

zip :: (Ord i, HasZero a) => Matrix i a -> Matrix i a -> Matrix i (a,a)
zip :: forall i a.
(Ord i, HasZero a) =>
Matrix i a -> Matrix i a -> Matrix i (a, a)
zip Matrix i a
m1 Matrix i a
m2 = Size i -> [(MIx i, (a, a))] -> Matrix i (a, a)
forall i b. Size i -> [(MIx i, b)] -> Matrix i b
M (Matrix i a -> Size i
forall i b. Matrix i b -> Size i
size Matrix i a
m1) ([(MIx i, (a, a))] -> Matrix i (a, a))
-> [(MIx i, (a, a))] -> Matrix i (a, a)
forall a b. (a -> b) -> a -> b
$ [(MIx i, a)] -> [(MIx i, a)] -> [(MIx i, (a, a))]
forall {a} {b} {a}.
(HasZero a, HasZero b, Ord a) =>
[(a, a)] -> [(a, b)] -> [(a, (a, b))]
zips (Matrix i a -> [(MIx i, a)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i a
m1) (Matrix i a -> [(MIx i, a)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i a
m2) where
  zips :: [(a, a)] -> [(a, b)] -> [(a, (a, b))]
zips [] [(a, b)]
m = ((a, b) -> (a, (a, b))) -> [(a, b)] -> [(a, (a, b))]
forall a b. (a -> b) -> [a] -> [b]
map (\ (a
i,b
b) -> (a
i,(a
forall a. HasZero a => a
zeroElement,b
b))) [(a, b)]
m
  zips [(a, a)]
l [] = ((a, a) -> (a, (a, b))) -> [(a, a)] -> [(a, (a, b))]
forall a b. (a -> b) -> [a] -> [b]
map (\ (a
i,a
a) -> (a
i,(a
a,b
forall a. HasZero a => a
zeroElement))) [(a, a)]
l
  zips l :: [(a, a)]
l@((a
i,a
a):[(a, a)]
l') m :: [(a, b)]
m@((a
j,b
b):[(a, b)]
m')
    | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
j = (a
i,(a
a,b
forall a. HasZero a => a
zeroElement)) (a, (a, b)) -> [(a, (a, b))] -> [(a, (a, b))]
forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, b)] -> [(a, (a, b))]
zips [(a, a)]
l' [(a, b)]
m
    | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
j = (a
j,(a
forall a. HasZero a => a
zeroElement,b
b)) (a, (a, b)) -> [(a, (a, b))] -> [(a, (a, b))]
forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, b)] -> [(a, (a, b))]
zips [(a, a)]
l [(a, b)]
m'
    | Bool
otherwise = (a
i,(a
a,b
b)) (a, (a, b)) -> [(a, (a, b))] -> [(a, (a, b))]
forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, b)] -> [(a, (a, b))]
zips [(a, a)]
l' [(a, b)]
m'

-- | @'add' (+) m1 m2@ adds @m1@ and @m2@. Uses @(+)@ to add values.
--
-- Precondition: @'size' m1 == 'size' m2@.

add :: (Ord i) => (a -> a -> a) -> Matrix i a -> Matrix i a -> Matrix i a
add :: forall i a.
Ord i =>
(a -> a -> a) -> Matrix i a -> Matrix i a -> Matrix i a
add a -> a -> a
plus Matrix i a
m1 Matrix i a
m2 = Size i -> [(MIx i, a)] -> Matrix i a
forall i b. Size i -> [(MIx i, b)] -> Matrix i b
M (Matrix i a -> Size i
forall i b. Matrix i b -> Size i
size Matrix i a
m1) ([(MIx i, a)] -> Matrix i a) -> [(MIx i, a)] -> Matrix i a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [(MIx i, a)] -> [(MIx i, a)] -> [(MIx i, a)]
forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
mergeAssocWith a -> a -> a
plus (Matrix i a -> [(MIx i, a)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i a
m1) (Matrix i a -> [(MIx i, a)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i a
m2)

-- | assoc list union
mergeAssocWith :: (Ord i) => (a -> a -> a) -> [(i,a)] -> [(i,a)] -> [(i,a)]
mergeAssocWith :: forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
mergeAssocWith a -> a -> a
_ [] [(i, a)]
m = [(i, a)]
m
mergeAssocWith a -> a -> a
_ [(i, a)]
l [] = [(i, a)]
l
mergeAssocWith a -> a -> a
f l :: [(i, a)]
l@((i
i,a
a):[(i, a)]
l') m :: [(i, a)]
m@((i
j,a
b):[(i, a)]
m')
    | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
j = (i
i,a
a) (i, a) -> [(i, a)] -> [(i, a)]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
mergeAssocWith a -> a -> a
f [(i, a)]
l' [(i, a)]
m
    | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
j = (i
j,a
b) (i, a) -> [(i, a)] -> [(i, a)]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
mergeAssocWith a -> a -> a
f [(i, a)]
l [(i, a)]
m'
    | Bool
otherwise = (i
i, a -> a -> a
f a
a a
b) (i, a) -> [(i, a)] -> [(i, a)]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
mergeAssocWith a -> a -> a
f [(i, a)]
l' [(i, a)]
m'

-- | @'intersectWith' f m1 m2@ build the pointwise conjunction @m1@ and @m2@.
--   Uses @f@ to combine non-zero values.
--
-- Precondition: @'size' m1 == 'size' m2@.

intersectWith :: (Ord i) => (a -> a -> a) -> Matrix i a -> Matrix i a -> Matrix i a
intersectWith :: forall i a.
Ord i =>
(a -> a -> a) -> Matrix i a -> Matrix i a -> Matrix i a
intersectWith a -> a -> a
f Matrix i a
m1 Matrix i a
m2 = Size i -> [(MIx i, a)] -> Matrix i a
forall i b. Size i -> [(MIx i, b)] -> Matrix i b
M (Matrix i a -> Size i
forall i b. Matrix i b -> Size i
size Matrix i a
m1) ([(MIx i, a)] -> Matrix i a) -> [(MIx i, a)] -> Matrix i a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [(MIx i, a)] -> [(MIx i, a)] -> [(MIx i, a)]
forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
interAssocWith a -> a -> a
f (Matrix i a -> [(MIx i, a)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i a
m1) (Matrix i a -> [(MIx i, a)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i a
m2)

-- | assoc list intersection
interAssocWith :: (Ord i) => (a -> a -> a) -> [(i,a)] -> [(i,a)] -> [(i,a)]
interAssocWith :: forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
interAssocWith a -> a -> a
_ [] [(i, a)]
_ = []
interAssocWith a -> a -> a
_ [(i, a)]
_ [] = []
interAssocWith a -> a -> a
f l :: [(i, a)]
l@((i
i,a
a):[(i, a)]
l') m :: [(i, a)]
m@((i
j,a
b):[(i, a)]
m')
    | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
j = (a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
interAssocWith a -> a -> a
f [(i, a)]
l' [(i, a)]
m
    | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
j = (a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
interAssocWith a -> a -> a
f [(i, a)]
l [(i, a)]
m'
    | Bool
otherwise = (i
i, a -> a -> a
f a
a a
b) (i, a) -> [(i, a)] -> [(i, a)]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
interAssocWith a -> a -> a
f [(i, a)]
l' [(i, a)]
m'

{-
prop_add sz =
  forAll (three (matrix sz :: Gen TM)) $ \(m1, m2, m3) ->
    let m' = add (+) m1 m2 in
      associative (add (+)) m1 m2 m3 &&
      commutative (add (+)) m1 m2 &&
      matrixInvariant m' &&
      size m' == size m1
-}

-- | @'mul' semiring m1 m2@ multiplies @m1@ and @m2@. Uses the
-- operations of the semiring @semiring@ to perform the
-- multiplication.
--
-- Precondition: @'cols' ('size' m1) == rows ('size' m2)@.

{- mul A B works as follows:
* turn A into a list of sparse rows and the transposed B as well
* form the crossproduct using the inner vector product to compute els
* the inner vector product is summing up
  after intersecting with the muliplication op of the semiring
-}

mul :: (Enum i, Num i, Ix i, Eq a)
    => Semiring a -> Matrix i a -> Matrix i a -> Matrix i a
mul :: forall i a.
(Enum i, Num i, Ix i, Eq a) =>
Semiring a -> Matrix i a -> Matrix i a -> Matrix i a
mul Semiring a
semiring Matrix i a
m1 Matrix i a
m2 = Size i -> [(MIx i, a)] -> Matrix i a
forall i b. Size i -> [(MIx i, b)] -> Matrix i b
M (Size { rows :: i
rows = Size i -> i
forall i. Size i -> i
rows (Matrix i a -> Size i
forall i b. Matrix i b -> Size i
size Matrix i a
m1), cols :: i
cols = Size i -> i
forall i. Size i -> i
cols (Matrix i a -> Size i
forall i b. Matrix i b -> Size i
size Matrix i a
m2) }) ([(MIx i, a)] -> Matrix i a) -> [(MIx i, a)] -> Matrix i a
forall a b. (a -> b) -> a -> b
$
  ((MIx i, a) -> Bool) -> [(MIx i, a)] -> [(MIx i, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ (MIx i
_,a
b) -> a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= Semiring a -> a
forall a. Semiring a -> a
Semiring.zero Semiring a
semiring) ([(MIx i, a)] -> [(MIx i, a)]) -> [(MIx i, a)] -> [(MIx i, a)]
forall a b. (a -> b) -> a -> b
$
  [ (i -> i -> MIx i
forall i. i -> i -> MIx i
MIx i
i i
j, (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Semiring a -> a -> a -> a
forall a. Semiring a -> a -> a -> a
Semiring.add Semiring a
semiring) (Semiring a -> a
forall a. Semiring a -> a
Semiring.zero Semiring a
semiring) ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$
                ((i, a) -> a) -> [(i, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (i, a) -> a
forall a b. (a, b) -> b
snd ([(i, a)] -> [a]) -> [(i, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
forall i a.
Ord i =>
(a -> a -> a) -> [(i, a)] -> [(i, a)] -> [(i, a)]
interAssocWith (Semiring a -> a -> a -> a
forall a. Semiring a -> a -> a -> a
Semiring.mul Semiring a
semiring) [(i, a)]
v [(i, a)]
w)
    | (i
i,[(i, a)]
v) <- Matrix i a -> [(i, [(i, a)])]
forall i b. (Num i, Enum i, Eq i) => Matrix i b -> [(i, [(i, b)])]
toSparseRows Matrix i a
m1
    , (i
j,[(i, a)]
w) <- Matrix i a -> [(i, [(i, a)])]
forall i b. (Num i, Enum i, Eq i) => Matrix i b -> [(i, [(i, b)])]
toSparseRows (Matrix i a -> [(i, [(i, a)])]) -> Matrix i a -> [(i, [(i, a)])]
forall a b. (a -> b) -> a -> b
$ Matrix i a -> Matrix i a
forall i b. Ord i => Matrix i b -> Matrix i b
transpose Matrix i a
m2 ]

{-
prop_mul sz =
  sized $ \n -> resize (n `div` 2) $
  forAll (two natural) $ \(c2, c3) ->
  forAll (matrix sz :: Gen TM) $ \m1 ->
  forAll (matrix (Size { rows = cols sz, cols = c2 })) $ \m2 ->
  forAll (matrix (Size { rows = c2, cols = c3 })) $ \m3 ->
    let m' = mult m1 m2 in
      associative mult m1 m2 m3 &&
      matrixInvariant m' &&
      size m' == Size { rows = rows sz, cols = c2 }
  where mult = mul Semiring.integerSemiring
-}

-- | @'diagonal' m@ extracts the diagonal of @m@.
--
-- Precondition: @'square' m@.

diagonal :: (Enum i, Num i, Ix i, Show i, HasZero b) => Matrix i b -> [b]
diagonal :: forall i b.
(Enum i, Num i, Ix i, Show i, HasZero b) =>
Matrix i b -> [b]
diagonal Matrix i b
m = b -> i -> [(i, b)] -> [b]
forall i b.
(Eq i, Ord i, Num i, Enum i, Show i) =>
b -> i -> [(i, b)] -> [b]
blowUpSparseVec b
forall a. HasZero a => a
zeroElement (Size i -> i
forall i. Size i -> i
rows Size i
sz) ([(i, b)] -> [b]) -> [(i, b)] -> [b]
forall a b. (a -> b) -> a -> b
$
  ((MIx i, b) -> (i, b)) -> [(MIx i, b)] -> [(i, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\ ((MIx i
i i
_),b
b) -> (i
i,b
b)) ([(MIx i, b)] -> [(i, b)]) -> [(MIx i, b)] -> [(i, b)]
forall a b. (a -> b) -> a -> b
$ ((MIx i, b) -> Bool) -> [(MIx i, b)] -> [(MIx i, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ ((MIx i
i i
j),b
_) -> i
ii -> i -> Bool
forall a. Eq a => a -> a -> Bool
==i
j) (Matrix i b -> [(MIx i, b)]
forall i b. Matrix i b -> [(MIx i, b)]
unM Matrix i b
m)
  where sz :: Size i
sz = Matrix i b -> Size i
forall i b. Matrix i b -> Size i
size Matrix i b
m

{-
diagonal :: (Enum i, Num i, Ix i, HasZero b) => Matrix i b -> Array i b
diagonal m = listArray (1, rows sz) $ blowUpSparseVec zeroElement (rows sz) $
  map (\ ((MIx i j),b) -> (i,b)) $ filter (\ ((MIx i j),b) -> i==j) (unM m)
  where sz = size m
-}

{-
prop_diagonal =
  forAll natural $ \n ->
  forAll (matrix (Size n n) :: Gen TM) $ \m ->
    bounds (diagonal m) == (1, n)
-}

------------------------------------------------------------------------
-- Modifying matrices

-- | @'addColumn' x m@ adds a new column to @m@, after the columns
-- already existing in the matrix. All elements in the new column get
-- set to @x@.

addColumn :: (Num i, HasZero b) => b -> Matrix i b -> Matrix i b
addColumn :: forall i b. (Num i, HasZero b) => b -> Matrix i b -> Matrix i b
addColumn b
x Matrix i b
m
  | b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
forall a. HasZero a => a
zeroElement = Matrix i b
m { size = (size m) { cols = cols (size m) + 1 }}
  | Bool
otherwise = Matrix i b
forall a. HasCallStack => a
undefined

{-
prop_addColumn :: TM -> Bool
prop_addColumn m =
  matrixInvariant m'
  &&
  map init (toLists m') == toLists m
  where
  m' = addColumn zeroElement m
-}

-- | @'addRow' x m@ adds a new row to @m@, after the rows already
-- existing in the matrix. All elements in the new row get set to @x@.

addRow :: (Num i, HasZero b) => b -> Matrix i b -> Matrix i b
addRow :: forall i b. (Num i, HasZero b) => b -> Matrix i b -> Matrix i b
addRow b
x Matrix i b
m | b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
forall a. HasZero a => a
zeroElement = Matrix i b
m { size = (size m) { rows = rows (size m) + 1 }}
           | Bool
otherwise = Matrix i b
forall a. HasCallStack => a
undefined

prop_addRow :: TM -> Bool
prop_addRow :: Matrix Integer Integer -> Bool
prop_addRow Matrix Integer Integer
m =
  Matrix Integer Integer -> Bool
forall i b. (Num i, Ix i) => Matrix i b -> Bool
matrixInvariant Matrix Integer Integer
m'
  Bool -> Bool -> Bool
&&
  [[Integer]] -> [[Integer]]
forall a. HasCallStack => [a] -> [a]
init (Matrix Integer Integer -> [[Integer]]
forall i b.
(Ord i, Integral i, Enum i, HasZero b, Show i) =>
Matrix i b -> [[b]]
toLists Matrix Integer Integer
m') [[Integer]] -> [[Integer]] -> Bool
forall a. Eq a => a -> a -> Bool
== Matrix Integer Integer -> [[Integer]]
forall i b.
(Ord i, Integral i, Enum i, HasZero b, Show i) =>
Matrix i b -> [[b]]
toLists Matrix Integer Integer
m
  where
  m' :: Matrix Integer Integer
m' = Integer -> Matrix Integer Integer -> Matrix Integer Integer
forall i b. (Num i, HasZero b) => b -> Matrix i b -> Matrix i b
addRow Integer
forall a. HasZero a => a
zeroElement Matrix Integer Integer
m

------------------------------------------------------------------------
-- Zipping (assumes non-empty matrices)

{- use mergeAssocList or interAssocList instead
zipWith :: (a -> b -> c) ->
           Matrix Integer a -> Matrix Integer b -> Matrix Integer c
zipWith f m1 m2
  = fromLists (Size { rows = toInteger $ length ll,
                      cols = toInteger $ length (head ll) }) ll
    where ll = List.zipWith (List.zipWith f) (toLists m1) (toLists m2)
-}