123 lines
2.5 KiB
Idris
123 lines
2.5 KiB
Idris
|
module Quox.Semiring
|
||
|
|
|
||
|
|
import Quox.Context
|
||
|
|
import public Quox.NatExtra
|
||
|
|
import Data.Bool.Decidable
|
||
|
|
import Quox.No
|
||
|
|
|
||
|
|
%hide Nat.isZero
|
||
|
|
|
||
|
|
export infixl 8 +.
|
||
|
|
export infixl 9 *., *:, :*
|
||
|
|
export infixr 10 ^.
|
||
|
|
|
||
|
|
public export
|
||
|
|
interface AddMonoid a where
|
||
|
|
zero : a
|
||
|
|
isZero : a -> Bool
|
||
|
|
(+.) : a -> a -> a
|
||
|
|
|
||
|
|
public export
|
||
|
|
interface TimesMonoid a where
|
||
|
|
one : a
|
||
|
|
(*.) : a -> a -> a
|
||
|
|
|
||
|
|
public export
|
||
|
|
0 Semiring : Type -> Type
|
||
|
|
Semiring a = (AddMonoid a, TimesMonoid a)
|
||
|
|
|
||
|
|
public export
|
||
|
|
interface (Semiring base, AddMonoid vec) => VecSpace base vec | vec where
|
||
|
|
(*:) : base -> vec -> vec
|
||
|
|
(:*) : vec -> base -> vec
|
||
|
|
|
||
|
|
x *: xs = xs :* x
|
||
|
|
xs :* x = x *: xs
|
||
|
|
|
||
|
|
|
||
|
|
namespace Foldable
|
||
|
|
public export %inline %tcinline
|
||
|
|
ssum : AddMonoid a => Foldable t => {default zero init : a} -> t a -> a
|
||
|
|
ssum = foldl (+.) init
|
||
|
|
|
||
|
|
public export %inline %tcinline
|
||
|
|
sproduct : TimesMonoid a => Foldable t => {default one init : a} -> t a -> a
|
||
|
|
sproduct = foldl (*.) init
|
||
|
|
|
||
|
|
namespace Context
|
||
|
|
public export %inline %tcinline
|
||
|
|
ssum : AddMonoid a => {default zero init : a} ->
|
||
|
|
Telescope' a from to -> a
|
||
|
|
ssum = foldl_ (+.) zero
|
||
|
|
|
||
|
|
public export %inline %tcinline
|
||
|
|
sproduct : TimesMonoid a => {default one init : a} ->
|
||
|
|
Telescope' a from to -> a
|
||
|
|
sproduct = foldl_ (*.) one
|
||
|
|
|
||
|
|
|
||
|
|
public export
|
||
|
|
(^.) : TimesMonoid a => a -> Nat -> a
|
||
|
|
x ^. 0 = one
|
||
|
|
x ^. S k = x *. x^.k
|
||
|
|
|
||
|
|
|
||
|
|
export %inline
|
||
|
|
[NumAdd] Eq a => Num a => AddMonoid a where
|
||
|
|
zero = 0; (+.) = (+); isZero = (== 0)
|
||
|
|
|
||
|
|
export %inline
|
||
|
|
[NumTimes] Num a => TimesMonoid a where
|
||
|
|
one = 1; (*.) = (*)
|
||
|
|
|
||
|
|
|
||
|
|
export %inline %hint
|
||
|
|
NatAM : AddMonoid Nat
|
||
|
|
NatAM = NumAdd
|
||
|
|
|
||
|
|
export %inline %hint
|
||
|
|
NatTM : TimesMonoid Nat
|
||
|
|
NatTM = NumTimes
|
||
|
|
|
||
|
|
export %inline %hint
|
||
|
|
IntegerAM : AddMonoid Integer
|
||
|
|
IntegerAM = NumAdd
|
||
|
|
|
||
|
|
export %inline %hint
|
||
|
|
IntegerTM : TimesMonoid Integer
|
||
|
|
IntegerTM = NumTimes
|
||
|
|
|
||
|
|
export %inline %hint
|
||
|
|
IntAM : AddMonoid Int
|
||
|
|
IntAM = NumAdd
|
||
|
|
|
||
|
|
export %inline %hint
|
||
|
|
IntTM : TimesMonoid Int
|
||
|
|
IntTM = NumTimes
|
||
|
|
|
||
|
|
|
||
|
|
export %inline
|
||
|
|
(from `LTE'` to, AddMonoid a) => AddMonoid (Telescope' a from to) where
|
||
|
|
zero = replicateLTE zero
|
||
|
|
(+.) = zipWith (+.)
|
||
|
|
isZero = all isZero
|
||
|
|
|
||
|
|
export %inline
|
||
|
|
(from `LTE'` to, Semiring a) => VecSpace a (Telescope' a from to) where
|
||
|
|
x *: xs = map (x *.) xs
|
||
|
|
|
||
|
|
|
||
|
|
public export
|
||
|
|
interface AddMonoid a => MonoAddMonoid a where
|
||
|
|
0 zeroPlus : (x, y : a) ->
|
||
|
|
No (isZero x) -> No (isZero y) -> No (isZero (x +. y))
|
||
|
|
|
||
|
|
export
|
||
|
|
MonoAddMonoid Nat where
|
||
|
|
zeroPlus (S _) (S _) Ah Ah = Ah
|
||
|
|
|
||
|
|
|
||
|
|
public export
|
||
|
|
0 MonoAddSemiring : Type -> Type
|
||
|
|
MonoAddSemiring a = (MonoAddMonoid a, TimesMonoid a)
|