{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies  #-}
{-# LANGUAGE TypeOperators #-}

{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

{- |
Module      :  Internal.Modular
Copyright   :  (c) Alberto Ruiz 2015
License     :  BSD3
Stability   :  experimental

Proof of concept of statically checked modular arithmetic.

-}

module Internal.Modular(
    Mod, type (./.)
) where

import Internal.Vector
import Internal.Matrix hiding (size)
import Internal.Numeric
import Internal.Element
import Internal.Container
import Internal.Vectorized (prodI,sumI,prodL,sumL)
import Internal.LAPACK (multiplyI, multiplyL)
import Internal.Algorithms(luFact,LU(..))
import Internal.Util(Normed(..),Indexable(..),
                     gaussElim, gaussElim_1, gaussElim_2,
                     luST, luSolve', luPacked', magnit, invershur)
import Internal.ST(mutable)
#if MIN_VERSION_base(4,11,0)
import GHC.TypeLits hiding (Mod)
#else
import GHC.TypeLits
#endif
import Data.Proxy(Proxy)
import Foreign.ForeignPtr(castForeignPtr)
import Foreign.Storable
import Data.Ratio
import Data.Complex
import Control.DeepSeq ( NFData(..) )
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif



-- | Wrapper with a phantom integer for statically checked modular arithmetic.
newtype Mod (n :: Nat) t = Mod {forall (n :: Nat) t. Mod n t -> t
unMod:: t}
  deriving (Ptr (Mod n t) -> IO (Mod n t)
Ptr (Mod n t) -> Int -> IO (Mod n t)
Ptr (Mod n t) -> Int -> Mod n t -> IO ()
Ptr (Mod n t) -> Mod n t -> IO ()
Mod n t -> Int
forall (n :: Nat) t. Storable t => Ptr (Mod n t) -> IO (Mod n t)
forall (n :: Nat) t.
Storable t =>
Ptr (Mod n t) -> Int -> IO (Mod n t)
forall (n :: Nat) t.
Storable t =>
Ptr (Mod n t) -> Int -> Mod n t -> IO ()
forall (n :: Nat) t.
Storable t =>
Ptr (Mod n t) -> Mod n t -> IO ()
forall (n :: Nat) t. Storable t => Mod n t -> Int
forall (n :: Nat) t b. Storable t => Ptr b -> Int -> IO (Mod n t)
forall (n :: Nat) t b.
Storable t =>
Ptr b -> Int -> Mod n t -> IO ()
forall b. Ptr b -> Int -> IO (Mod n t)
forall b. Ptr b -> Int -> Mod n t -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (Mod n t) -> Mod n t -> IO ()
$cpoke :: forall (n :: Nat) t.
Storable t =>
Ptr (Mod n t) -> Mod n t -> IO ()
peek :: Ptr (Mod n t) -> IO (Mod n t)
$cpeek :: forall (n :: Nat) t. Storable t => Ptr (Mod n t) -> IO (Mod n t)
pokeByteOff :: forall b. Ptr b -> Int -> Mod n t -> IO ()
$cpokeByteOff :: forall (n :: Nat) t b.
Storable t =>
Ptr b -> Int -> Mod n t -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (Mod n t)
$cpeekByteOff :: forall (n :: Nat) t b. Storable t => Ptr b -> Int -> IO (Mod n t)
pokeElemOff :: Ptr (Mod n t) -> Int -> Mod n t -> IO ()
$cpokeElemOff :: forall (n :: Nat) t.
Storable t =>
Ptr (Mod n t) -> Int -> Mod n t -> IO ()
peekElemOff :: Ptr (Mod n t) -> Int -> IO (Mod n t)
$cpeekElemOff :: forall (n :: Nat) t.
Storable t =>
Ptr (Mod n t) -> Int -> IO (Mod n t)
alignment :: Mod n t -> Int
$calignment :: forall (n :: Nat) t. Storable t => Mod n t -> Int
sizeOf :: Mod n t -> Int
$csizeOf :: forall (n :: Nat) t. Storable t => Mod n t -> Int
Storable)

instance (NFData t) => NFData (Mod n t)
  where
    rnf :: Mod n t -> ()
rnf (Mod t
x) = forall a. NFData a => a -> ()
rnf t
x

infixr 5 ./.
type (./.) x n = Mod n x

instance (Integral t, Enum t, KnownNat m) => Enum (Mod m t)
  where
    toEnum :: Int -> Mod m t
toEnum = forall (m :: Nat) a b.
(Num b, KnownNat m) =>
(b -> a -> b) -> a -> Mod m b
l0 (\t
m Int
x -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
x forall a. Integral a => a -> a -> a
`mod` (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
m))
    fromEnum :: Mod m t -> Int
fromEnum = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) t. Mod n t -> t
unMod

instance (Eq t, KnownNat m) => Eq (Mod m t)
  where
    Mod m t
a == :: Mod m t -> Mod m t -> Bool
== Mod m t
b = (forall (n :: Nat) t. Mod n t -> t
unMod Mod m t
a) forall a. Eq a => a -> a -> Bool
== (forall (n :: Nat) t. Mod n t -> t
unMod Mod m t
b)

instance (Ord t, KnownNat m) => Ord (Mod m t)
  where
    compare :: Mod m t -> Mod m t -> Ordering
compare Mod m t
a Mod m t
b = forall a. Ord a => a -> a -> Ordering
compare (forall (n :: Nat) t. Mod n t -> t
unMod Mod m t
a) (forall (n :: Nat) t. Mod n t -> t
unMod Mod m t
b)

instance (Integral t, Real t, KnownNat m) => Real (Mod m t)
  where
    toRational :: Mod m t -> Rational
toRational Mod m t
x = forall a. Integral a => a -> Integer
toInteger Mod m t
x forall a. Integral a => a -> a -> Ratio a
% Integer
1

instance (Integral t, KnownNat m) => Integral (Mod m t)
  where
    toInteger :: Mod m t -> Integer
toInteger = forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) t. Mod n t -> t
unMod
    quotRem :: Mod m t -> Mod m t -> (Mod m t, Mod m t)
quotRem Mod m t
a Mod m t
b = (forall (n :: Nat) t. t -> Mod n t
Mod t
q, forall (n :: Nat) t. t -> Mod n t
Mod t
r)
      where
         (t
q,t
r) = forall a. Integral a => a -> a -> (a, a)
quotRem (forall (n :: Nat) t. Mod n t -> t
unMod Mod m t
a) (forall (n :: Nat) t. Mod n t -> t
unMod Mod m t
b)

-- | this instance is only valid for prime m
instance (Integral t, Show t, Eq t, KnownNat m) => Fractional (Mod m t)
  where
    recip :: Mod m t -> Mod m t
recip Mod m t
x
        | Mod m t
xforall a. Num a => a -> a -> a
*Mod m t
r forall a. Eq a => a -> a -> Bool
== Mod m t
1  = Mod m t
r
        | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Mod m t
x forall a. [a] -> [a] -> [a]
++[Char]
" does not have a multiplicative inverse mod "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Integer
m'
      where
        r :: Mod m t
r = Mod m t
xforall a b. (Num a, Integral b) => a -> b -> a
^(Integer
m'forall a. Num a => a -> a -> a
-Integer
2 :: Integer)
        m' :: Integer
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)
    fromRational :: Rational -> Mod m t
fromRational Rational
x = forall a. Num a => Integer -> a
fromInteger (forall a. Ratio a -> a
numerator Rational
x) forall a. Fractional a => a -> a -> a
/ forall a. Num a => Integer -> a
fromInteger (forall a. Ratio a -> a
denominator Rational
x)

l2 :: forall m a b c. (Num c, KnownNat m) => (c -> a -> b -> c) -> Mod m a -> Mod m b -> Mod m c
l2 :: forall (m :: Nat) a b c.
(Num c, KnownNat m) =>
(c -> a -> b -> c) -> Mod m a -> Mod m b -> Mod m c
l2 c -> a -> b -> c
f (Mod a
u) (Mod b
v) = forall (n :: Nat) t. t -> Mod n t
Mod (c -> a -> b -> c
f c
m' a
u b
v)
  where
    m' :: c
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)

l1 :: forall m a b . (Num b, KnownNat m) => (b -> a -> b) -> Mod m a -> Mod m b
l1 :: forall (m :: Nat) a b.
(Num b, KnownNat m) =>
(b -> a -> b) -> Mod m a -> Mod m b
l1 b -> a -> b
f (Mod a
u) = forall (n :: Nat) t. t -> Mod n t
Mod (b -> a -> b
f b
m' a
u)
  where
    m' :: b
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)

l0 :: forall m a b . (Num b, KnownNat m) => (b -> a -> b) -> a -> Mod m b
l0 :: forall (m :: Nat) a b.
(Num b, KnownNat m) =>
(b -> a -> b) -> a -> Mod m b
l0 b -> a -> b
f a
u = forall (n :: Nat) t. t -> Mod n t
Mod (b -> a -> b
f b
m' a
u)
  where
    m' :: b
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)


instance Show t => Show (Mod n t)
  where
    show :: Mod n t -> [Char]
show = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) t. Mod n t -> t
unMod

instance (Integral t, KnownNat n) => Num (Mod n t)
  where
    + :: Mod n t -> Mod n t -> Mod n t
(+) = forall (m :: Nat) a b c.
(Num c, KnownNat m) =>
(c -> a -> b -> c) -> Mod m a -> Mod m b -> Mod m c
l2 (\t
m t
a t
b -> (t
a forall a. Num a => a -> a -> a
+ t
b) forall a. Integral a => a -> a -> a
`mod` (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
m))
    * :: Mod n t -> Mod n t -> Mod n t
(*) = forall (m :: Nat) a b c.
(Num c, KnownNat m) =>
(c -> a -> b -> c) -> Mod m a -> Mod m b -> Mod m c
l2 (\t
m t
a t
b -> (t
a forall a. Num a => a -> a -> a
* t
b) forall a. Integral a => a -> a -> a
`mod` (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
m))
    (-) = forall (m :: Nat) a b c.
(Num c, KnownNat m) =>
(c -> a -> b -> c) -> Mod m a -> Mod m b -> Mod m c
l2 (\t
m t
a t
b -> (t
a forall a. Num a => a -> a -> a
- t
b) forall a. Integral a => a -> a -> a
`mod` (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
m))
    abs :: Mod n t -> Mod n t
abs = forall (m :: Nat) a b.
(Num b, KnownNat m) =>
(b -> a -> b) -> Mod m a -> Mod m b
l1 (forall a b. a -> b -> a
const forall a. Num a => a -> a
abs)
    signum :: Mod n t -> Mod n t
signum = forall (m :: Nat) a b.
(Num b, KnownNat m) =>
(b -> a -> b) -> Mod m a -> Mod m b
l1 (forall a b. a -> b -> a
const forall a. Num a => a -> a
signum)
    fromInteger :: Integer -> Mod n t
fromInteger = forall (m :: Nat) a b.
(Num b, KnownNat m) =>
(b -> a -> b) -> a -> Mod m b
l0 (\t
m Integer
x -> forall a. Num a => Integer -> a
fromInteger Integer
x forall a. Integral a => a -> a -> a
`mod` (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
m))


instance KnownNat m => Element (Mod m I)
  where
    constantD :: Mod m I -> Int -> Vector (Mod m I)
constantD Mod m I
x Int
n = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f (forall a. Element a => a -> Int -> Vector a
constantD (forall (n :: Nat) t. Mod n t -> t
unMod Mod m I
x) Int
n)
    extractR :: MatrixOrder
-> Matrix (Mod m I)
-> I
-> Vector I
-> I
-> Vector I
-> IO (Matrix (Mod m I))
extractR MatrixOrder
ord Matrix (Mod m I)
m I
mi Vector I
is I
mj Vector I
js = forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix t -> Matrix (Mod n t)
i2fM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Element a =>
MatrixOrder
-> Matrix a -> I -> Vector I -> I -> Vector I -> IO (Matrix a)
extractR MatrixOrder
ord (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m I)
m) I
mi Vector I
is I
mj Vector I
js
    setRect :: Int -> Int -> Matrix (Mod m I) -> Matrix (Mod m I) -> IO ()
setRect Int
i Int
j Matrix (Mod m I)
m Matrix (Mod m I)
x = forall a. Element a => Int -> Int -> Matrix a -> Matrix a -> IO ()
setRect Int
i Int
j (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m I)
m) (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m I)
x)
    sortI :: Ord (Mod m I) => Vector (Mod m I) -> Vector I
sortI = forall a. (Element a, Ord a) => Vector a -> Vector I
sortI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    sortV :: Ord (Mod m I) => Vector (Mod m I) -> Vector (Mod m I)
sortV = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Element a, Ord a) => Vector a -> Vector a
sortV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    compareV :: Ord (Mod m I) => Vector (Mod m I) -> Vector (Mod m I) -> Vector I
compareV Vector (Mod m I)
u Vector (Mod m I)
v = forall a. (Element a, Ord a) => Vector a -> Vector a -> Vector I
compareV (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
u) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
v)
    selectV :: Vector I
-> Vector (Mod m I)
-> Vector (Mod m I)
-> Vector (Mod m I)
-> Vector (Mod m I)
selectV Vector I
c Vector (Mod m I)
l Vector (Mod m I)
e Vector (Mod m I)
g = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f (forall a.
Element a =>
Vector I -> Vector a -> Vector a -> Vector a -> Vector a
selectV Vector I
c (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
l) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
e) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
g))
    remapM :: Matrix I -> Matrix I -> Matrix (Mod m I) -> Matrix (Mod m I)
remapM Matrix I
i Matrix I
j Matrix (Mod m I)
m = forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix t -> Matrix (Mod n t)
i2fM (forall t. Element t => Matrix I -> Matrix I -> Matrix t -> Matrix t
remap Matrix I
i Matrix I
j (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m I)
m))
    rowOp :: Int
-> Mod m I -> Int -> Int -> Int -> Int -> Matrix (Mod m I) -> IO ()
rowOp Int
c Mod m I
a Int
i1 Int
i2 Int
j1 Int
j2 Matrix (Mod m I)
x = forall c a.
(TransArray c, Storable a) =>
(I -> Ptr a -> I -> I -> I -> I -> Trans c (IO I))
-> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux (I -> RowOp I
c_rowOpMI I
m') Int
c (forall (n :: Nat) t. Mod n t -> t
unMod Mod m I
a) Int
i1 Int
i2 Int
j1 Int
j2 (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m I)
x)
      where
        m' :: I
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)
    gemm :: Vector (Mod m I)
-> Matrix (Mod m I)
-> Matrix (Mod m I)
-> Matrix (Mod m I)
-> IO ()
gemm Vector (Mod m I)
u Matrix (Mod m I)
a Matrix (Mod m I)
b Matrix (Mod m I)
c = forall c1 c c2 c3.
(TransArray c1, TransArray c, TransArray c2, TransArray c3) =>
Trans c3 (Trans c2 (Trans c1 (Trans c (IO I))))
-> c3 -> c2 -> c1 -> c -> IO ()
gemmg (I -> Tgemm I
c_gemmMI I
m') (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
u) (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m I)
a) (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m I)
b) (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m I)
c)
      where
        m' :: I
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)
    reorderV :: Vector I -> Vector I -> Vector (Mod m I) -> Vector (Mod m I)
reorderV Vector I
strides Vector I
dims = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c t a1 t1 a.
(TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>
(I
 -> Ptr a
 -> I
 -> Ptr t1
 -> Trans c (I -> Ptr t -> I -> Ptr a1 -> IO I))
-> Vector t1 -> c -> Vector t -> Vector a1
reorderAux Reorder I
c_reorderI Vector I
strides Vector I
dims forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i

instance KnownNat m => Element (Mod m Z)
  where
    constantD :: Mod m Z -> Int -> Vector (Mod m Z)
constantD Mod m Z
x Int
n = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f (forall a. Element a => a -> Int -> Vector a
constantD (forall (n :: Nat) t. Mod n t -> t
unMod Mod m Z
x) Int
n)
    extractR :: MatrixOrder
-> Matrix (Mod m Z)
-> I
-> Vector I
-> I
-> Vector I
-> IO (Matrix (Mod m Z))
extractR MatrixOrder
ord Matrix (Mod m Z)
m I
mi Vector I
is I
mj Vector I
js = forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix t -> Matrix (Mod n t)
i2fM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Element a =>
MatrixOrder
-> Matrix a -> I -> Vector I -> I -> Vector I -> IO (Matrix a)
extractR MatrixOrder
ord (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m Z)
m) I
mi Vector I
is I
mj Vector I
js
    setRect :: Int -> Int -> Matrix (Mod m Z) -> Matrix (Mod m Z) -> IO ()
setRect Int
i Int
j Matrix (Mod m Z)
m Matrix (Mod m Z)
x = forall a. Element a => Int -> Int -> Matrix a -> Matrix a -> IO ()
setRect Int
i Int
j (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m Z)
m) (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m Z)
x)
    sortI :: Ord (Mod m Z) => Vector (Mod m Z) -> Vector I
sortI = forall a. (Element a, Ord a) => Vector a -> Vector I
sortI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    sortV :: Ord (Mod m Z) => Vector (Mod m Z) -> Vector (Mod m Z)
sortV = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Element a, Ord a) => Vector a -> Vector a
sortV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    compareV :: Ord (Mod m Z) => Vector (Mod m Z) -> Vector (Mod m Z) -> Vector I
compareV Vector (Mod m Z)
u Vector (Mod m Z)
v = forall a. (Element a, Ord a) => Vector a -> Vector a -> Vector I
compareV (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
u) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
v)
    selectV :: Vector I
-> Vector (Mod m Z)
-> Vector (Mod m Z)
-> Vector (Mod m Z)
-> Vector (Mod m Z)
selectV Vector I
c Vector (Mod m Z)
l Vector (Mod m Z)
e Vector (Mod m Z)
g = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f (forall a.
Element a =>
Vector I -> Vector a -> Vector a -> Vector a -> Vector a
selectV Vector I
c (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
l) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
e) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
g))
    remapM :: Matrix I -> Matrix I -> Matrix (Mod m Z) -> Matrix (Mod m Z)
remapM Matrix I
i Matrix I
j Matrix (Mod m Z)
m = forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix t -> Matrix (Mod n t)
i2fM (forall t. Element t => Matrix I -> Matrix I -> Matrix t -> Matrix t
remap Matrix I
i Matrix I
j (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m Z)
m))
    rowOp :: Int
-> Mod m Z -> Int -> Int -> Int -> Int -> Matrix (Mod m Z) -> IO ()
rowOp Int
c Mod m Z
a Int
i1 Int
i2 Int
j1 Int
j2 Matrix (Mod m Z)
x = forall c a.
(TransArray c, Storable a) =>
(I -> Ptr a -> I -> I -> I -> I -> Trans c (IO I))
-> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux (Z -> RowOp Z
c_rowOpML Z
m') Int
c (forall (n :: Nat) t. Mod n t -> t
unMod Mod m Z
a) Int
i1 Int
i2 Int
j1 Int
j2 (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m Z)
x)
      where
        m' :: Z
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)
    gemm :: Vector (Mod m Z)
-> Matrix (Mod m Z)
-> Matrix (Mod m Z)
-> Matrix (Mod m Z)
-> IO ()
gemm Vector (Mod m Z)
u Matrix (Mod m Z)
a Matrix (Mod m Z)
b Matrix (Mod m Z)
c = forall c1 c c2 c3.
(TransArray c1, TransArray c, TransArray c2, TransArray c3) =>
Trans c3 (Trans c2 (Trans c1 (Trans c (IO I))))
-> c3 -> c2 -> c1 -> c -> IO ()
gemmg (Z -> Tgemm Z
c_gemmML Z
m') (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
u) (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m Z)
a) (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m Z)
b) (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod m Z)
c)
      where
        m' :: Z
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)
    reorderV :: Vector I -> Vector I -> Vector (Mod m Z) -> Vector (Mod m Z)
reorderV Vector I
strides Vector I
dims = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c t a1 t1 a.
(TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>
(I
 -> Ptr a
 -> I
 -> Ptr t1
 -> Trans c (I -> Ptr t -> I -> Ptr a1 -> IO I))
-> Vector t1 -> c -> Vector t -> Vector a1
reorderAux Reorder Z
c_reorderL Vector I
strides Vector I
dims forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i


instance KnownNat m => CTrans (Mod m I)
instance KnownNat m => CTrans (Mod m Z)


instance KnownNat m => Container Vector (Mod m I)
  where
    conj' :: Vector (Mod m I) -> Vector (Mod m I)
conj' = forall a. a -> a
id
    size' :: Vector (Mod m I) -> IndexOf Vector
size' = forall t. Storable t => Vector t -> Int
dim
    scale' :: Mod m I -> Vector (Mod m I) -> Vector (Mod m I)
scale' Mod m I
s Vector (Mod m I)
x = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale (forall (n :: Nat) t. Mod n t -> t
unMod Mod m I
s) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
x))
    addConstant :: Mod m I -> Vector (Mod m I) -> Vector (Mod m I)
addConstant Mod m I
c Vector (Mod m I)
x = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant (forall (n :: Nat) t. Mod n t -> t
unMod Mod m I
c) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
x))
    add' :: Vector (Mod m I) -> Vector (Mod m I) -> Vector (Mod m I)
add' Vector (Mod m I)
a Vector (Mod m I)
b = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall (c :: * -> *) e. Container c e => c e -> c e -> c e
add' (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
a) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
b))
    sub :: Vector (Mod m I) -> Vector (Mod m I) -> Vector (Mod m I)
sub Vector (Mod m I)
a Vector (Mod m I)
b = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall (c :: * -> *) e. Container c e => c e -> c e -> c e
sub (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
a) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
b))
    mul :: Vector (Mod m I) -> Vector (Mod m I) -> Vector (Mod m I)
mul Vector (Mod m I)
a Vector (Mod m I)
b = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
a) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
b))
    equal :: Vector (Mod m I) -> Vector (Mod m I) -> Bool
equal Vector (Mod m I)
u Vector (Mod m I)
v = forall (c :: * -> *) e. Container c e => c e -> c e -> Bool
equal (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
u) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
v)
    scalar' :: Mod m I -> Vector (Mod m I)
scalar' Mod m I
x = forall a. Storable a => [a] -> Vector a
fromList [Mod m I
x]
    konst' :: Mod m I -> IndexOf Vector -> Vector (Mod m I)
konst' Mod m I
x = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e d (c :: * -> *). Konst e d c => e -> d -> c e
konst (forall (n :: Nat) t. Mod n t -> t
unMod Mod m I
x)
    build' :: IndexOf Vector -> ArgOf Vector (Mod m I) -> Vector (Mod m I)
build' IndexOf Vector
n ArgOf Vector (Mod m I)
f = forall d f (c :: * -> *) e. Build d f c e => d -> f -> c e
build IndexOf Vector
n (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgOf Vector (Mod m I)
f)
    cmap' :: forall b.
Element b =>
(Mod m I -> b) -> Vector (Mod m I) -> Vector b
cmap' = forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
mapVector
    atIndex' :: Vector (Mod m I) -> IndexOf Vector -> Mod m I
atIndex' Vector (Mod m I)
x IndexOf Vector
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (c :: * -> *) e. Container c e => c e -> IndexOf c -> e
atIndex (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
x) IndexOf Vector
k)
    minIndex' :: Vector (Mod m I) -> IndexOf Vector
minIndex'     = forall (c :: * -> *) e. Container c e => c e -> IndexOf c
minIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    maxIndex' :: Vector (Mod m I) -> IndexOf Vector
maxIndex'     = forall (c :: * -> *) e. Container c e => c e -> IndexOf c
maxIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    minElement' :: Vector (Mod m I) -> Mod m I
minElement'   = forall (n :: Nat) t. t -> Mod n t
Mod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> e
minElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    maxElement' :: Vector (Mod m I) -> Mod m I
maxElement'   = forall (n :: Nat) t. t -> Mod n t
Mod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> e
maxElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    sumElements' :: Vector (Mod m I) -> Mod m I
sumElements'  = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a.
(TransRaw c (I -> Ptr a -> IO I)
 ~ (I -> Ptr I -> I -> Ptr I -> IO I),
 TransArray c, Storable a) =>
I -> c -> a
sumI I
m' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
      where
        m' :: I
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)
    prodElements' :: Vector (Mod m I) -> Mod m I
prodElements' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. I -> Vector I -> I
prodI I
m' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
      where
        m' :: I
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)
    step' :: Ord (Mod m I) => Vector (Mod m I) -> Vector (Mod m I)
step'         = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (c :: * -> *). (Ord e, Container c e) => c e -> c e
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    find' :: (Mod m I -> Bool) -> Vector (Mod m I) -> [IndexOf Vector]
find' = forall {a}. Storable a => (a -> Bool) -> Vector a -> [Int]
findV
    assoc' :: IndexOf Vector
-> Mod m I -> [(IndexOf Vector, Mod m I)] -> Vector (Mod m I)
assoc' = forall {t1} {t2 :: * -> *}.
(Storable t1, Foldable t2) =>
Int -> t1 -> t2 (Int, t1) -> Vector t1
assocV
    accum' :: Vector (Mod m I)
-> (Mod m I -> Mod m I -> Mod m I)
-> [(IndexOf Vector, Mod m I)]
-> Vector (Mod m I)
accum' = forall {t1} {t2 :: * -> *} {t3}.
(Storable t1, Foldable t2) =>
Vector t1 -> (t3 -> t1 -> t1) -> t2 (Int, t3) -> Vector t1
accumV
    ccompare' :: Ord (Mod m I) => Vector (Mod m I) -> Vector (Mod m I) -> Vector I
ccompare' Vector (Mod m I)
a Vector (Mod m I)
b = forall t (c :: * -> *). (Ord t, Container c t) => c t -> c t -> c I
ccompare (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
a) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
b)
    cselect' :: Vector I
-> Vector (Mod m I)
-> Vector (Mod m I)
-> Vector (Mod m I)
-> Vector (Mod m I)
cselect' Vector I
c Vector (Mod m I)
l Vector (Mod m I)
e Vector (Mod m I)
g = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall a b. (a -> b) -> a -> b
$ forall (c :: * -> *) t.
Container c t =>
c I -> c t -> c t -> c t -> c t
cselect Vector I
c (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
l) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
e) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m I)
g)
    scaleRecip :: Fractional (Mod m I) =>
Mod m I -> Vector (Mod m I) -> Vector (Mod m I)
scaleRecip Mod m I
s Vector (Mod m I)
x = forall (c :: * -> *) e. Container c e => e -> c e -> c e
scale' Mod m I
s (forall b (c :: * -> *) e.
(Element b, Container c e) =>
(e -> b) -> c e -> c b
cmap forall a. Fractional a => a -> a
recip Vector (Mod m I)
x)
    divide :: Fractional (Mod m I) =>
Vector (Mod m I) -> Vector (Mod m I) -> Vector (Mod m I)
divide Vector (Mod m I)
x Vector (Mod m I)
y = forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul Vector (Mod m I)
x (forall b (c :: * -> *) e.
(Element b, Container c e) =>
(e -> b) -> c e -> c b
cmap forall a. Fractional a => a -> a
recip Vector (Mod m I)
y)
    arctan2' :: Fractional (Mod m I) =>
Vector (Mod m I) -> Vector (Mod m I) -> Vector (Mod m I)
arctan2' = forall a. HasCallStack => a
undefined
    cmod' :: Integral (Mod m I) =>
Mod m I -> Vector (Mod m I) -> Vector (Mod m I)
cmod' Mod m I
m = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e.
(Container c e, Integral e) =>
e -> c e -> c e
cmod' (forall (n :: Nat) t. Mod n t -> t
unMod Mod m I
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    fromInt' :: Vector I -> Vector (Mod m I)
fromInt' = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod
    toInt' :: Vector (Mod m I) -> Vector I
toInt'   = forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    fromZ' :: Vector Z -> Vector (Mod m I)
fromZ'   = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c Z -> c e
fromZ'
    toZ' :: Vector (Mod m I) -> Vector Z
toZ'     = forall (c :: * -> *) e. Container c e => c e -> c Z
toZ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i

instance KnownNat m => Container Vector (Mod m Z)
  where
    conj' :: Vector (Mod m Z) -> Vector (Mod m Z)
conj' = forall a. a -> a
id
    size' :: Vector (Mod m Z) -> IndexOf Vector
size' = forall t. Storable t => Vector t -> Int
dim
    scale' :: Mod m Z -> Vector (Mod m Z) -> Vector (Mod m Z)
scale' Mod m Z
s Vector (Mod m Z)
x = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale (forall (n :: Nat) t. Mod n t -> t
unMod Mod m Z
s) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
x))
    addConstant :: Mod m Z -> Vector (Mod m Z) -> Vector (Mod m Z)
addConstant Mod m Z
c Vector (Mod m Z)
x = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall (c :: * -> *) e. Container c e => e -> c e -> c e
addConstant (forall (n :: Nat) t. Mod n t -> t
unMod Mod m Z
c) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
x))
    add' :: Vector (Mod m Z) -> Vector (Mod m Z) -> Vector (Mod m Z)
add' Vector (Mod m Z)
a Vector (Mod m Z)
b = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall (c :: * -> *) e. Container c e => c e -> c e -> c e
add' (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
a) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
b))
    sub :: Vector (Mod m Z) -> Vector (Mod m Z) -> Vector (Mod m Z)
sub Vector (Mod m Z)
a Vector (Mod m Z)
b = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall (c :: * -> *) e. Container c e => c e -> c e -> c e
sub (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
a) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
b))
    mul :: Vector (Mod m Z) -> Vector (Mod m Z) -> Vector (Mod m Z)
mul Vector (Mod m Z)
a Vector (Mod m Z)
b = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
a) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
b))
    equal :: Vector (Mod m Z) -> Vector (Mod m Z) -> Bool
equal Vector (Mod m Z)
u Vector (Mod m Z)
v = forall (c :: * -> *) e. Container c e => c e -> c e -> Bool
equal (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
u) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
v)
    scalar' :: Mod m Z -> Vector (Mod m Z)
scalar' Mod m Z
x = forall a. Storable a => [a] -> Vector a
fromList [Mod m Z
x]
    konst' :: Mod m Z -> IndexOf Vector -> Vector (Mod m Z)
konst' Mod m Z
x = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e d (c :: * -> *). Konst e d c => e -> d -> c e
konst (forall (n :: Nat) t. Mod n t -> t
unMod Mod m Z
x)
    build' :: IndexOf Vector -> ArgOf Vector (Mod m Z) -> Vector (Mod m Z)
build' IndexOf Vector
n ArgOf Vector (Mod m Z)
f = forall d f (c :: * -> *) e. Build d f c e => d -> f -> c e
build IndexOf Vector
n (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgOf Vector (Mod m Z)
f)
    cmap' :: forall b.
Element b =>
(Mod m Z -> b) -> Vector (Mod m Z) -> Vector b
cmap' = forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
mapVector
    atIndex' :: Vector (Mod m Z) -> IndexOf Vector -> Mod m Z
atIndex' Vector (Mod m Z)
x IndexOf Vector
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (c :: * -> *) e. Container c e => c e -> IndexOf c -> e
atIndex (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
x) IndexOf Vector
k)
    minIndex' :: Vector (Mod m Z) -> IndexOf Vector
minIndex'     = forall (c :: * -> *) e. Container c e => c e -> IndexOf c
minIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    maxIndex' :: Vector (Mod m Z) -> IndexOf Vector
maxIndex'     = forall (c :: * -> *) e. Container c e => c e -> IndexOf c
maxIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    minElement' :: Vector (Mod m Z) -> Mod m Z
minElement'   = forall (n :: Nat) t. t -> Mod n t
Mod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> e
minElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    maxElement' :: Vector (Mod m Z) -> Mod m Z
maxElement'   = forall (n :: Nat) t. t -> Mod n t
Mod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> e
maxElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    sumElements' :: Vector (Mod m Z) -> Mod m Z
sumElements'  = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a.
(TransRaw c (I -> Ptr a -> IO I)
 ~ (I -> Ptr Z -> I -> Ptr Z -> IO I),
 TransArray c, Storable a) =>
Z -> c -> a
sumL Z
m' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
      where
        m' :: Z
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)
    prodElements' :: Vector (Mod m Z) -> Mod m Z
prodElements' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Z -> Vector Z -> Z
prodL Z
m' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
      where
        m' :: Z
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)
    step' :: Ord (Mod m Z) => Vector (Mod m Z) -> Vector (Mod m Z)
step'         = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (c :: * -> *). (Ord e, Container c e) => c e -> c e
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    find' :: (Mod m Z -> Bool) -> Vector (Mod m Z) -> [IndexOf Vector]
find' = forall {a}. Storable a => (a -> Bool) -> Vector a -> [Int]
findV
    assoc' :: IndexOf Vector
-> Mod m Z -> [(IndexOf Vector, Mod m Z)] -> Vector (Mod m Z)
assoc' = forall {t1} {t2 :: * -> *}.
(Storable t1, Foldable t2) =>
Int -> t1 -> t2 (Int, t1) -> Vector t1
assocV
    accum' :: Vector (Mod m Z)
-> (Mod m Z -> Mod m Z -> Mod m Z)
-> [(IndexOf Vector, Mod m Z)]
-> Vector (Mod m Z)
accum' = forall {t1} {t2 :: * -> *} {t3}.
(Storable t1, Foldable t2) =>
Vector t1 -> (t3 -> t1 -> t1) -> t2 (Int, t3) -> Vector t1
accumV
    ccompare' :: Ord (Mod m Z) => Vector (Mod m Z) -> Vector (Mod m Z) -> Vector I
ccompare' Vector (Mod m Z)
a Vector (Mod m Z)
b = forall t (c :: * -> *). (Ord t, Container c t) => c t -> c t -> c I
ccompare (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
a) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
b)
    cselect' :: Vector I
-> Vector (Mod m Z)
-> Vector (Mod m Z)
-> Vector (Mod m Z)
-> Vector (Mod m Z)
cselect' Vector I
c Vector (Mod m Z)
l Vector (Mod m Z)
e Vector (Mod m Z)
g = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall a b. (a -> b) -> a -> b
$ forall (c :: * -> *) t.
Container c t =>
c I -> c t -> c t -> c t -> c t
cselect Vector I
c (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
l) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
e) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod m Z)
g)
    scaleRecip :: Fractional (Mod m Z) =>
Mod m Z -> Vector (Mod m Z) -> Vector (Mod m Z)
scaleRecip Mod m Z
s Vector (Mod m Z)
x = forall (c :: * -> *) e. Container c e => e -> c e -> c e
scale' Mod m Z
s (forall b (c :: * -> *) e.
(Element b, Container c e) =>
(e -> b) -> c e -> c b
cmap forall a. Fractional a => a -> a
recip Vector (Mod m Z)
x)
    divide :: Fractional (Mod m Z) =>
Vector (Mod m Z) -> Vector (Mod m Z) -> Vector (Mod m Z)
divide Vector (Mod m Z)
x Vector (Mod m Z)
y = forall (c :: * -> *) e. Container c e => c e -> c e -> c e
mul Vector (Mod m Z)
x (forall b (c :: * -> *) e.
(Element b, Container c e) =>
(e -> b) -> c e -> c b
cmap forall a. Fractional a => a -> a
recip Vector (Mod m Z)
y)
    arctan2' :: Fractional (Mod m Z) =>
Vector (Mod m Z) -> Vector (Mod m Z) -> Vector (Mod m Z)
arctan2' = forall a. HasCallStack => a
undefined
    cmod' :: Integral (Mod m Z) =>
Mod m Z -> Vector (Mod m Z) -> Vector (Mod m Z)
cmod' Mod m Z
m = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e.
(Container c e, Integral e) =>
e -> c e -> c e
cmod' (forall (n :: Nat) t. Mod n t -> t
unMod Mod m Z
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    fromInt' :: Vector I -> Vector (Mod m Z)
fromInt' = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c I -> c e
fromInt'
    toInt' :: Vector (Mod m Z) -> Vector I
toInt'   = forall (c :: * -> *) e. Container c e => c e -> c I
toInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i
    fromZ' :: Vector Z -> Vector (Mod m Z)
fromZ'   = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod
    toZ' :: Vector (Mod m Z) -> Vector Z
toZ'     = forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i


instance (Storable t, Indexable (Vector t) t) => Indexable (Vector (Mod m t)) (Mod m t)
  where
    ! :: Vector (Mod m t) -> Int -> Mod m t
(!) = forall t. Storable t => Vector t -> Int -> t
(@>)

type instance RealOf (Mod n I) = I
type instance RealOf (Mod n Z) = Z

instance KnownNat m => Product (Mod m I) where
    norm2 :: Floating (Mod m I) => Vector (Mod m I) -> RealOf (Mod m I)
norm2      = forall a. HasCallStack => a
undefined
    absSum :: Vector (Mod m I) -> RealOf (Mod m I)
absSum     = forall a. HasCallStack => a
undefined
    norm1 :: Vector (Mod m I) -> RealOf (Mod m I)
norm1      = forall a. HasCallStack => a
undefined
    normInf :: Vector (Mod m I) -> RealOf (Mod m I)
normInf    = forall a. HasCallStack => a
undefined
    multiply :: Matrix (Mod m I) -> Matrix (Mod m I) -> Matrix (Mod m I)
multiply   = forall {m :: Nat} {a} {t} {t} {n :: Nat} {n :: Nat}.
(KnownNat m, Integral a, Numeric a, Element t, Element t,
 Element (Mod m a), Element (Mod n t), Element (Mod n t)) =>
(Matrix t -> Matrix t -> Matrix a)
-> Matrix (Mod n t) -> Matrix (Mod n t) -> Matrix (Mod m a)
lift2m (I -> Matrix I -> Matrix I -> Matrix I
multiplyI I
m')
      where
        m' :: I
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)

instance KnownNat m => Product (Mod m Z) where
    norm2 :: Floating (Mod m Z) => Vector (Mod m Z) -> RealOf (Mod m Z)
norm2      = forall a. HasCallStack => a
undefined
    absSum :: Vector (Mod m Z) -> RealOf (Mod m Z)
absSum     = forall a. HasCallStack => a
undefined
    norm1 :: Vector (Mod m Z) -> RealOf (Mod m Z)
norm1      = forall a. HasCallStack => a
undefined
    normInf :: Vector (Mod m Z) -> RealOf (Mod m Z)
normInf    = forall a. HasCallStack => a
undefined
    multiply :: Matrix (Mod m Z) -> Matrix (Mod m Z) -> Matrix (Mod m Z)
multiply   = forall {m :: Nat} {a} {t} {t} {n :: Nat} {n :: Nat}.
(KnownNat m, Integral a, Numeric a, Element t, Element t,
 Element (Mod m a), Element (Mod n t), Element (Mod n t)) =>
(Matrix t -> Matrix t -> Matrix a)
-> Matrix (Mod n t) -> Matrix (Mod n t) -> Matrix (Mod m a)
lift2m (Z -> Matrix Z -> Matrix Z -> Matrix Z
multiplyL Z
m')
      where
        m' :: Z
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)

instance KnownNat m => Normed (Vector (Mod m I))
  where
    norm_0 :: Vector (Mod m I) -> R
norm_0 = forall a. Normed a => a -> R
norm_0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> c I
toInt
    norm_1 :: Vector (Mod m I) -> R
norm_1 = forall a. Normed a => a -> R
norm_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> c I
toInt
    norm_2 :: Vector (Mod m I) -> R
norm_2 = forall a. Normed a => a -> R
norm_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> c I
toInt
    norm_Inf :: Vector (Mod m I) -> R
norm_Inf = forall a. Normed a => a -> R
norm_Inf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> c I
toInt

instance KnownNat m => Normed (Vector (Mod m Z))
  where
    norm_0 :: Vector (Mod m Z) -> R
norm_0 = forall a. Normed a => a -> R
norm_0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> c Z
toZ
    norm_1 :: Vector (Mod m Z) -> R
norm_1 = forall a. Normed a => a -> R
norm_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> c Z
toZ
    norm_2 :: Vector (Mod m Z) -> R
norm_2 = forall a. Normed a => a -> R
norm_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> c Z
toZ
    norm_Inf :: Vector (Mod m Z) -> R
norm_Inf = forall a. Normed a => a -> R
norm_Inf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e. Container c e => c e -> c Z
toZ


instance KnownNat m => Numeric (Mod m I)
instance KnownNat m => Numeric (Mod m Z)

i2f :: Storable t => Vector t -> Vector (Mod n t)
i2f :: forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f Vector t
v = forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
unsafeFromForeignPtr (forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr t
fp) (Int
i) (Int
n)
    where (ForeignPtr t
fp,Int
i,Int
n) = forall a. Storable a => Vector a -> (ForeignPtr a, Int, Int)
unsafeToForeignPtr Vector t
v

f2i :: Storable t => Vector (Mod n t) -> Vector t
f2i :: forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod n t)
v = forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
unsafeFromForeignPtr (forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (Mod n t)
fp) (Int
i) (Int
n)
    where (ForeignPtr (Mod n t)
fp,Int
i,Int
n) = forall a. Storable a => Vector a -> (ForeignPtr a, Int, Int)
unsafeToForeignPtr Vector (Mod n t)
v

f2iM :: (Element t, Element (Mod n t)) => Matrix (Mod n t) -> Matrix t
f2iM :: forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod n t)
m = Matrix (Mod n t)
m { xdat :: Vector t
xdat = forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i (forall t. Matrix t -> Vector t
xdat Matrix (Mod n t)
m) }

i2fM :: (Element t, Element (Mod n t)) => Matrix t -> Matrix (Mod n t)
i2fM :: forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix t -> Matrix (Mod n t)
i2fM Matrix t
m = Matrix t
m { xdat :: Vector (Mod n t)
xdat = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f (forall t. Matrix t -> Vector t
xdat Matrix t
m) }

vmod :: forall m t. (KnownNat m, Storable t, Integral t, Numeric t) => Vector t -> Vector (Mod m t)
vmod :: forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod = forall t (n :: Nat). Storable t => Vector t -> Vector (Mod n t)
i2f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) e.
(Container c e, Integral e) =>
e -> c e -> c e
cmod' t
m'
  where
    m' :: t
m' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: Proxy m)

lift1 :: (Vector t -> Vector t) -> Vector (Mod n t) -> Vector (Mod m t)
lift1 Vector t -> Vector t
f Vector (Mod n t)
a   = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (Vector t -> Vector t
f (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod n t)
a))
lift2 :: (Vector t -> Vector t -> Vector t)
-> Vector (Mod n t) -> Vector (Mod n t) -> Vector (Mod m t)
lift2 Vector t -> Vector t -> Vector t
f Vector (Mod n t)
a Vector (Mod n t)
b = forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (Vector t -> Vector t -> Vector t
f (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod n t)
a) (forall t (n :: Nat). Storable t => Vector (Mod n t) -> Vector t
f2i Vector (Mod n t)
b))

lift2m :: (Matrix t -> Matrix t -> Matrix a)
-> Matrix (Mod n t) -> Matrix (Mod n t) -> Matrix (Mod m a)
lift2m Matrix t -> Matrix t -> Matrix a
f Matrix (Mod n t)
a Matrix (Mod n t)
b = forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix forall (m :: Nat) t.
(KnownNat m, Storable t, Integral t, Numeric t) =>
Vector t -> Vector (Mod m t)
vmod (Matrix t -> Matrix t -> Matrix a
f (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod n t)
a) (forall t (n :: Nat).
(Element t, Element (Mod n t)) =>
Matrix (Mod n t) -> Matrix t
f2iM Matrix (Mod n t)
b))

instance KnownNat m => Num (Vector (Mod m I))
  where
    + :: Vector (Mod m I) -> Vector (Mod m I) -> Vector (Mod m I)
(+) = forall {m :: Nat} {t} {t} {t} {n :: Nat} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t, Storable t) =>
(Vector t -> Vector t -> Vector t)
-> Vector (Mod n t) -> Vector (Mod n t) -> Vector (Mod m t)
lift2 forall a. Num a => a -> a -> a
(+)
    * :: Vector (Mod m I) -> Vector (Mod m I) -> Vector (Mod m I)
(*) = forall {m :: Nat} {t} {t} {t} {n :: Nat} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t, Storable t) =>
(Vector t -> Vector t -> Vector t)
-> Vector (Mod n t) -> Vector (Mod n t) -> Vector (Mod m t)
lift2 forall a. Num a => a -> a -> a
(*)
    (-) = forall {m :: Nat} {t} {t} {t} {n :: Nat} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t, Storable t) =>
(Vector t -> Vector t -> Vector t)
-> Vector (Mod n t) -> Vector (Mod n t) -> Vector (Mod m t)
lift2 (-)
    abs :: Vector (Mod m I) -> Vector (Mod m I)
abs = forall {m :: Nat} {t} {t} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t) =>
(Vector t -> Vector t) -> Vector (Mod n t) -> Vector (Mod m t)
lift1 forall a. Num a => a -> a
abs
    signum :: Vector (Mod m I) -> Vector (Mod m I)
signum = forall {m :: Nat} {t} {t} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t) =>
(Vector t -> Vector t) -> Vector (Mod n t) -> Vector (Mod m t)
lift1 forall a. Num a => a -> a
signum
    negate :: Vector (Mod m I) -> Vector (Mod m I)
negate = forall {m :: Nat} {t} {t} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t) =>
(Vector t -> Vector t) -> Vector (Mod n t) -> Vector (Mod m t)
lift1 forall a. Num a => a -> a
negate
    fromInteger :: Integer -> Vector (Mod m I)
fromInteger Integer
x = forall (c :: * -> *) e. Container c e => c I -> c e
fromInt (forall a. Num a => Integer -> a
fromInteger Integer
x)

instance KnownNat m => Num (Vector (Mod m Z))
  where
    + :: Vector (Mod m Z) -> Vector (Mod m Z) -> Vector (Mod m Z)
(+) = forall {m :: Nat} {t} {t} {t} {n :: Nat} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t, Storable t) =>
(Vector t -> Vector t -> Vector t)
-> Vector (Mod n t) -> Vector (Mod n t) -> Vector (Mod m t)
lift2 forall a. Num a => a -> a -> a
(+)
    * :: Vector (Mod m Z) -> Vector (Mod m Z) -> Vector (Mod m Z)
(*) = forall {m :: Nat} {t} {t} {t} {n :: Nat} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t, Storable t) =>
(Vector t -> Vector t -> Vector t)
-> Vector (Mod n t) -> Vector (Mod n t) -> Vector (Mod m t)
lift2 forall a. Num a => a -> a -> a
(*)
    (-) = forall {m :: Nat} {t} {t} {t} {n :: Nat} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t, Storable t) =>
(Vector t -> Vector t -> Vector t)
-> Vector (Mod n t) -> Vector (Mod n t) -> Vector (Mod m t)
lift2 (-)
    abs :: Vector (Mod m Z) -> Vector (Mod m Z)
abs = forall {m :: Nat} {t} {t} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t) =>
(Vector t -> Vector t) -> Vector (Mod n t) -> Vector (Mod m t)
lift1 forall a. Num a => a -> a
abs
    signum :: Vector (Mod m Z) -> Vector (Mod m Z)
signum = forall {m :: Nat} {t} {t} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t) =>
(Vector t -> Vector t) -> Vector (Mod n t) -> Vector (Mod m t)
lift1 forall a. Num a => a -> a
signum
    negate :: Vector (Mod m Z) -> Vector (Mod m Z)
negate = forall {m :: Nat} {t} {t} {n :: Nat}.
(KnownNat m, Integral t, Numeric t, Storable t) =>
(Vector t -> Vector t) -> Vector (Mod n t) -> Vector (Mod m t)
lift1 forall a. Num a => a -> a
negate
    fromInteger :: Integer -> Vector (Mod m Z)
fromInteger Integer
x = forall (c :: * -> *) e. Container c e => c Z -> c e
fromZ (forall a. Num a => Integer -> a
fromInteger Integer
x)

--------------------------------------------------------------------------------

instance (KnownNat m) => Testable (Matrix (Mod m I))
  where
    checkT :: Matrix (Mod m I) -> (Bool, IO ())
checkT Matrix (Mod m I)
_ = (Bool, IO ())
test

test :: (Bool, IO ())
test = (Bool
ok, IO ()
info)
  where
    v :: Vector (Mod 11 I)
v = forall a. Storable a => [a] -> Vector a
fromList [Mod 11 I
3,-Mod 11 I
5,Mod 11 I
75] :: Vector (Mod 11 I)
    m :: Matrix (Mod 11 I)
m = (Int
3forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
3) [Mod 11 I
1..]   :: Matrix (Mod 11 I)

    a :: Matrix I
a = (Int
3forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
3) [I
1,I
2 , I
3
               ,I
4,I
5 , I
6
               ,I
0,I
10,-I
3] :: Matrix I

    b :: Matrix I
b = (Int
3forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
2) [I
0..] :: Matrix I

    am :: Matrix (Mod 13 I)
am = forall (c :: * -> *) e. Container c e => c I -> c e
fromInt Matrix I
a :: Matrix (Mod 13 I)
    bm :: Matrix (Mod 13 I)
bm = forall (c :: * -> *) e. Container c e => c I -> c e
fromInt Matrix I
b :: Matrix (Mod 13 I)
    ad :: Matrix R
ad = forall (c :: * -> *) e. Container c e => c I -> c e
fromInt Matrix I
a :: Matrix Double
    bd :: Matrix R
bd = forall (c :: * -> *) e. Container c e => c I -> c e
fromInt Matrix I
b :: Matrix Double

    g :: Matrix I
g = (Int
3forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
3) (forall a. a -> [a]
repeat (I
40000)) :: Matrix I
    gm :: Matrix (Mod 100000 I)
gm = forall (c :: * -> *) e. Container c e => c I -> c e
fromInt Matrix I
g :: Matrix (Mod 100000 I)

    lg :: Matrix Z
lg = (Int
3forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
3) (forall a. a -> [a]
repeat (Z
3forall a. Num a => a -> a -> a
*Z
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9::Int))) :: Matrix Z
    lgm :: Matrix (Mod 10000000000 Z)
lgm = forall (c :: * -> *) e. Container c e => c Z -> c e
fromZ Matrix Z
lg :: Matrix (Mod 10000000000 Z)

    gen :: Int -> Matrix t
gen  Int
n = forall t. Storable t => t -> Vector t -> Int -> Int -> Matrix t
diagRect t
1 (forall e d (c :: * -> *). Konst e d c => e -> d -> c e
konst t
5 Int
n) Int
n Int
n :: Numeric t => Matrix t
    
    rgen :: Int -> Matrix R
rgen Int
n = forall {t}. Numeric t => Int -> Matrix t
gen Int
n :: Matrix R
    cgen :: Int -> Matrix C
cgen Int
n = forall t (c :: * -> *).
(Convert t, Complexable c) =>
c t -> c (ComplexOf t)
complex (Int -> Matrix R
rgen Int
n) forall a. Num a => a -> a -> a
+ forall t. Element t => Matrix t -> Matrix t
fliprl (forall t (c :: * -> *).
(Convert t, Complexable c) =>
c t -> c (ComplexOf t)
complex (Int -> Matrix R
rgen Int
n)) forall a. Num a => a -> a -> a
* forall (c :: * -> *) e. Container c e => e -> c e
scalar (R
0forall a. a -> a -> Complex a
:+R
1) :: Matrix C
    sgen :: Int -> Matrix (SingleOf C)
sgen Int
n = forall t (c :: * -> *).
(Convert t, Complexable c) =>
c t -> c (SingleOf t)
single (Int -> Matrix C
cgen Int
n)
    
    checkGen :: Matrix t -> R
checkGen Matrix t
x = forall a. Normed a => a -> R
norm_Inf forall a b. (a -> b) -> a -> b
$ forall t. Element t => Matrix t -> Vector t
flatten forall a b. (a -> b) -> a -> b
$ forall {t}.
(Container Vector t, Eq t, Fractional t, Num (Vector t)) =>
Matrix t -> Matrix t
invg Matrix t
x forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix t
x forall a. Num a => a -> a -> a
- forall a. (Num a, Element a) => Int -> Matrix a
ident (forall t. Matrix t -> Int
rows Matrix t
x)
    
    invg :: Matrix t -> Matrix t
invg Matrix t
t = forall {t}.
(Container Vector t, Eq t, Fractional t, Num (Vector t)) =>
Matrix t -> Matrix t -> Matrix t
gaussElim Matrix t
t (forall a. (Num a, Element a) => Int -> Matrix a
ident (forall t. Matrix t -> Int
rows Matrix t
t))

    checkLU :: (t -> Bool) -> Matrix t -> R
checkLU t -> Bool
okf Matrix t
t = forall a. Normed a => a -> R
norm_Inf forall a b. (a -> b) -> a -> b
$ forall t. Element t => Matrix t -> Vector t
flatten (Matrix t
l forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix t
u forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix t
p forall a. Num a => a -> a -> a
- Matrix t
t)
      where
        (Matrix t
l,Matrix t
u,Matrix t
p,t
_) = forall t. Numeric t => LU t -> (Matrix t, Matrix t, Matrix t, t)
luFact (forall t. Matrix t -> [Int] -> LU t
LU Matrix t
x' [Int]
p')
          where
            (Matrix t
x',[Int]
p') = forall t u.
Element t =>
(forall s. (Int, Int) -> STMatrix s t -> ST s u)
-> Matrix t -> (Matrix t, u)
mutable (forall {t} {b} {s}.
(Container Vector t, Num (Vector t), Fractional t) =>
(t -> Bool) -> (Int, b) -> STMatrix s t -> ST s [Int]
luST t -> Bool
okf) Matrix t
t

    checkSolve :: Matrix t -> R
checkSolve Matrix t
aa = forall a. Normed a => a -> R
norm_Inf forall a b. (a -> b) -> a -> b
$ forall t. Element t => Matrix t -> Vector t
flatten (Matrix t
aa forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix t
x forall a. Num a => a -> a -> a
- Matrix t
bb)
       where
         bb :: Matrix t
bb = forall t. Element t => Matrix t -> Matrix t
flipud Matrix t
aa
         x :: Matrix t
x = forall {t}.
(Fractional t, Container Vector t) =>
LU t -> Matrix t -> Matrix t
luSolve' (forall {t}.
(Container Vector t, Fractional t, Normed (Vector t),
 Num (Vector t)) =>
Matrix t -> LU t
luPacked' Matrix t
aa) Matrix t
bb

    tmm :: Matrix (Mod 19 I)
tmm = forall t. Storable t => t -> Vector t -> Int -> Int -> Matrix t
diagRect Mod 19 I
1 (forall a. Storable a => [a] -> Vector a
fromList [Mod 19 I
2..Mod 19 I
6]) Int
5 Int
5 :: Matrix (Mod 19 I)

    info :: IO ()
info = do
        forall a. Show a => a -> IO ()
print Vector (Mod 11 I)
v
        forall a. Show a => a -> IO ()
print Matrix (Mod 11 I)
m
        forall a. Show a => a -> IO ()
print (forall m mt. Transposable m mt => m -> mt
tr Matrix (Mod 11 I)
m)
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Vector (Mod 11 I)
vforall a. Num a => a -> a -> a
+Vector (Mod 11 I)
v
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Matrix (Mod 11 I)
mforall a. Num a => a -> a -> a
+Matrix (Mod 11 I)
m
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Matrix (Mod 11 I)
m forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix (Mod 11 I)
m
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Matrix (Mod 11 I)
m forall t. Numeric t => Matrix t -> Vector t -> Vector t
#> Vector (Mod 11 I)
v

        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Matrix (Mod 13 I)
am forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> forall {t}.
(Container Vector t, Eq t, Fractional t, Num (Vector t)) =>
Matrix t -> Matrix t -> Matrix t
gaussElim Matrix (Mod 13 I)
am Matrix (Mod 13 I)
bm forall a. Num a => a -> a -> a
- Matrix (Mod 13 I)
bm
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Matrix R
ad forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> forall {t}.
(Container Vector t, Eq t, Fractional t, Num (Vector t)) =>
Matrix t -> Matrix t -> Matrix t
gaussElim Matrix R
ad Matrix R
bd forall a. Num a => a -> a -> a
- Matrix R
bd

        forall a. Show a => a -> IO ()
print Matrix I
g
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Matrix I
g forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix I
g
        forall a. Show a => a -> IO ()
print Matrix (Mod 100000 I)
gm
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Matrix (Mod 100000 I)
gm forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix (Mod 100000 I)
gm

        forall a. Show a => a -> IO ()
print Matrix Z
lg
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Matrix Z
lg forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix Z
lg
        forall a. Show a => a -> IO ()
print Matrix (Mod 10000000000 Z)
lgm
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ Matrix (Mod 10000000000 Z)
lgm forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix (Mod 10000000000 Z)
lgm
        
        [Char] -> IO ()
putStrLn [Char]
"checkGen"
        forall a. Show a => a -> IO ()
print (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix R))
        forall a. Show a => a -> IO ()
print (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix Float))
        forall a. Show a => a -> IO ()
print (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (Int -> Matrix C
cgen Int
5 :: Matrix C))
        forall a. Show a => a -> IO ()
print (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (Int -> Matrix (Complex Float)
sgen Int
5 :: Matrix (Complex Float)))
        forall a. Show a => a -> IO ()
print (forall {t}.
(Container Vector t, Eq t, Fractional t, Num (Vector t)) =>
Matrix t -> Matrix t
invg (forall {t}. Numeric t => Int -> Matrix t
gen Int
5) :: Matrix (Mod 7 I))
        forall a. Show a => a -> IO ()
print (forall {t}.
(Container Vector t, Eq t, Fractional t, Num (Vector t)) =>
Matrix t -> Matrix t
invg (forall {t}. Numeric t => Int -> Matrix t
gen Int
5) :: Matrix (Mod 7 Z))
        
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall t u.
Element t =>
(forall s. (Int, Int) -> STMatrix s t -> ST s u)
-> Matrix t -> (Matrix t, u)
mutable (forall {t} {b} {s}.
(Container Vector t, Num (Vector t), Fractional t) =>
(t -> Bool) -> (Int, b) -> STMatrix s t -> ST s [Int]
luST (forall a b. a -> b -> a
const Bool
True)) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix R)
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall t u.
Element t =>
(forall s. (Int, Int) -> STMatrix s t -> ST s u)
-> Matrix t -> (Matrix t, u)
mutable (forall {t} {b} {s}.
(Container Vector t, Num (Vector t), Fractional t) =>
(t -> Bool) -> (Int, b) -> STMatrix s t -> ST s [Int]
luST (forall a b. a -> b -> a
const Bool
True)) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 11 Z))

        [Char] -> IO ()
putStrLn [Char]
"checkLU"
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
0) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix R)
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
0) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix Float)
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
0) (Int -> Matrix C
cgen Int
5 :: Matrix C)
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
0) (Int -> Matrix (Complex Float)
sgen Int
5 :: Matrix (Complex Float))
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
0) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 I))
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
0) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 Z))

        [Char] -> IO ()
putStrLn [Char]
"checkSolve"
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix R)
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix Float)
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (Int -> Matrix C
cgen Int
5 :: Matrix C)
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (Int -> Matrix (Complex Float)
sgen Int
5 :: Matrix (Complex Float))
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 I))
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 Z))
        
        [Char] -> IO ()
putStrLn [Char]
"luSolve'"
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Fractional t, Container Vector t) =>
LU t -> Matrix t -> Matrix t
luSolve' (forall {t}.
(Container Vector t, Fractional t, Normed (Vector t),
 Num (Vector t)) =>
Matrix t -> LU t
luPacked' Matrix (Mod 19 I)
tmm) (forall a. (Num a, Element a) => Int -> Matrix a
ident (forall t. Matrix t -> Int
rows Matrix (Mod 19 I)
tmm))
        forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall {t}.
(Fractional t, Container Vector t, Num (Vector t), Product t) =>
Matrix t -> Matrix t
invershur Matrix (Mod 19 I)
tmm


    ok :: Bool
ok = forall (t :: * -> *). Foldable t => t Bool -> Bool
and
      [ forall (c :: * -> *) e. Container c e => c e -> c I
toInt (Matrix (Mod 11 I)
m forall t. Numeric t => Matrix t -> Vector t -> Vector t
#> Vector (Mod 11 I)
v) forall a. Eq a => a -> a -> Bool
== forall e (c :: * -> *).
(Integral e, Container c e) =>
e -> c e -> c e
cmod I
11 (forall (c :: * -> *) e. Container c e => c e -> c I
toInt Matrix (Mod 11 I)
m forall t. Numeric t => Matrix t -> Vector t -> Vector t
#> forall (c :: * -> *) e. Container c e => c e -> c I
toInt Vector (Mod 11 I)
v )
      , Matrix (Mod 13 I)
am forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> forall t.
(Fractional t, Num (Vector t), Ord t, Indexable (Vector t) t,
 Numeric t) =>
Matrix t -> Matrix t -> Matrix t
gaussElim_1 Matrix (Mod 13 I)
am Matrix (Mod 13 I)
bm forall a. Eq a => a -> a -> Bool
== Matrix (Mod 13 I)
bm
      , Matrix (Mod 13 I)
am forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> forall t.
(Eq t, Fractional t, Num (Vector t), Numeric t) =>
Matrix t -> Matrix t -> Matrix t
gaussElim_2 Matrix (Mod 13 I)
am Matrix (Mod 13 I)
bm forall a. Eq a => a -> a -> Bool
== Matrix (Mod 13 I)
bm
      , Matrix (Mod 13 I)
am forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> forall {t}.
(Container Vector t, Eq t, Fractional t, Num (Vector t)) =>
Matrix t -> Matrix t -> Matrix t
gaussElim   Matrix (Mod 13 I)
am Matrix (Mod 13 I)
bm forall a. Eq a => a -> a -> Bool
== Matrix (Mod 13 I)
bm
      , (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix R)) forall a. Ord a => a -> a -> Bool
< R
1E-15
      , (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix Float)) forall a. Ord a => a -> a -> Bool
< R
2E-7
      , (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (Int -> Matrix C
cgen Int
5 :: Matrix C)) forall a. Ord a => a -> a -> Bool
< R
1E-15
      , (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (Int -> Matrix (Complex Float)
sgen Int
5 :: Matrix (Complex Float))) forall a. Ord a => a -> a -> Bool
< R
3E-7
      , (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 I))) forall a. Eq a => a -> a -> Bool
== R
0
      , (forall {t}.
(Normed (Vector t), Container Vector t, Num (Vector t), Product t,
 Eq t, Fractional t) =>
Matrix t -> R
checkGen (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 Z))) forall a. Eq a => a -> a -> Bool
== R
0
      , (forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
1E-10) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix R)) forall a. Ord a => a -> a -> Bool
< R
2E-15
      , (forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
1E-5) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix Float)) forall a. Ord a => a -> a -> Bool
< R
1E-6
      , (forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
1E-10) (Int -> Matrix C
cgen Int
5 :: Matrix C)) forall a. Ord a => a -> a -> Bool
< R
5E-15
      , (forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
1E-5) (Int -> Matrix (Complex Float)
sgen Int
5 :: Matrix (Complex Float))) forall a. Ord a => a -> a -> Bool
< R
1E-6
      , (forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
0) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 I))) forall a. Eq a => a -> a -> Bool
== R
0
      , (forall {t}.
(Normed (Vector t), Numeric t, Fractional t, Num (Vector t)) =>
(t -> Bool) -> Matrix t -> R
checkLU (forall t. (Element t, Normed (Vector t)) => R -> t -> Bool
magnit R
0) (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 Z))) forall a. Eq a => a -> a -> Bool
== R
0
      , forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix R) forall a. Ord a => a -> a -> Bool
< R
2E-15
      , forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix Float) forall a. Ord a => a -> a -> Bool
< R
1E-6
      , forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (Int -> Matrix C
cgen Int
5 :: Matrix C) forall a. Ord a => a -> a -> Bool
< R
4E-15
      , forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (Int -> Matrix (Complex Float)
sgen Int
5 :: Matrix (Complex Float)) forall a. Ord a => a -> a -> Bool
< R
1E-6
      , forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 I)) forall a. Eq a => a -> a -> Bool
== R
0
      , forall {t}.
(Fractional t, Container Vector t, Normed (Vector t),
 Num (Vector t), Product t) =>
Matrix t -> R
checkSolve (forall {t}. Numeric t => Int -> Matrix t
gen Int
5 :: Matrix (Mod 7 Z)) forall a. Eq a => a -> a -> Bool
== R
0
      , forall (c :: * -> *) e. Container c e => c e -> e
prodElements (forall e d (c :: * -> *). Konst e d c => e -> d -> c e
konst (Mod 10 I
9:: Mod 10 I) (Int
12::Int)) forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (forall a. Int -> a -> [a]
replicate Int
12 (Mod 10 I
9:: Mod 10 I))
      , Matrix (Mod 100000 I)
gm forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix (Mod 100000 I)
gm forall a. Eq a => a -> a -> Bool
== forall e d (c :: * -> *). Konst e d c => e -> d -> c e
konst Mod 100000 I
0 (Int
3,Int
3)
      , Matrix (Mod 10000000000 Z)
lgm forall (a :: * -> *) (b :: * -> *) (c :: * -> *) t.
(Mul a b c, Product t) =>
a t -> b t -> c t
<> Matrix (Mod 10000000000 Z)
lgm forall a. Eq a => a -> a -> Bool
== forall e d (c :: * -> *). Konst e d c => e -> d -> c e
konst Mod 10000000000 Z
0 (Int
3,Int
3)
      , forall {t}.
(Fractional t, Container Vector t, Num (Vector t), Product t) =>
Matrix t -> Matrix t
invershur Matrix (Mod 19 I)
tmm forall a. Eq a => a -> a -> Bool
== forall {t}.
(Fractional t, Container Vector t) =>
LU t -> Matrix t -> Matrix t
luSolve' (forall {t}.
(Container Vector t, Fractional t, Normed (Vector t),
 Num (Vector t)) =>
Matrix t -> LU t
luPacked' Matrix (Mod 19 I)
tmm) (forall a. (Num a, Element a) => Int -> Matrix a
ident (forall t. Matrix t -> Int
rows Matrix (Mod 19 I)
tmm))
      , forall {t}.
(Fractional t, Container Vector t) =>
LU t -> Matrix t -> Matrix t
luSolve' (forall {t}.
(Container Vector t, Fractional t, Normed (Vector t),
 Num (Vector t)) =>
Matrix t -> LU t
luPacked' (forall m mt. Transposable m mt => m -> mt
tr forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Element a) => Int -> Matrix a
ident Int
5 :: Matrix (I ./. 2))) (forall a. (Num a, Element a) => Int -> Matrix a
ident Int
5) forall a. Eq a => a -> a -> Bool
== forall a. (Num a, Element a) => Int -> Matrix a
ident Int
5
      ]