aboutsummaryrefslogtreecommitdiff
path: root/Data/Matrix
diff options
context:
space:
mode:
Diffstat (limited to 'Data/Matrix')
-rw-r--r--Data/Matrix/Cast.agda162
-rw-r--r--Data/Matrix/Category.agda177
-rw-r--r--Data/Matrix/Core.agda266
-rw-r--r--Data/Matrix/Dagger-2-Poset.agda72
-rw-r--r--Data/Matrix/Monoid.agda93
-rw-r--r--Data/Matrix/SemiadditiveDagger.agda389
-rw-r--r--Data/Matrix/Transform.agda298
-rw-r--r--Data/Matrix/Vec.agda20
8 files changed, 1477 insertions, 0 deletions
diff --git a/Data/Matrix/Cast.agda b/Data/Matrix/Cast.agda
new file mode 100644
index 0000000..a171c7a
--- /dev/null
+++ b/Data/Matrix/Cast.agda
@@ -0,0 +1,162 @@
+{-# OPTIONS --without-K --safe #-}
+
+open import Level using (Level; _⊔_)
+open import Relation.Binary using (Setoid)
+
+module Data.Matrix.Cast {c ℓ : Level} (S : Setoid c ℓ) where
+
+module S = Setoid S
+
+open import Data.Matrix.Core S using (Matrix; _∥_; _≑_; _∷ₕ_; []ᵥ; []ᵥ-!; []ᵥ-∥; ∷ₕ-∥; head-∷-tailₕ; headₕ; tailₕ)
+open import Data.Nat using (ℕ; _+_)
+open import Data.Nat.Properties using (suc-injective; +-assoc)
+open import Data.Vec using (Vec; map) renaming (cast to castVec)
+open import Data.Vec.Properties using (++-assoc-eqFree) renaming (cast-is-id to castVec-is-id)
+open import Data.Vector.Core S using (Vector; _++_)
+open import Relation.Binary.PropositionalEquality as ≡ using (_≡_; module ≡-Reasoning)
+
+open Vec
+open ℕ
+
+private
+ variable
+ A B C D E F : ℕ
+
+opaque
+ unfolding Matrix Vector
+ cast₁ : .(A ≡ B) → Matrix A C → Matrix B C
+ cast₁ eq = map (castVec eq)
+
+opaque
+ unfolding Matrix
+ cast₂ : .(B ≡ C) → Matrix A B → Matrix A C
+ cast₂ eq [] = castVec eq []
+ cast₂ {B} {suc C} {A} eq (x ∷ M) = x ∷ cast₂ (suc-injective eq) M
+
+opaque
+ unfolding cast₁
+ cast₁-is-id : .(eq : A ≡ A) (M : Matrix A B) → cast₁ eq M ≡ M
+ cast₁-is-id _ [] = ≡.refl
+ cast₁-is-id _ (M₀ ∷ M) = ≡.cong₂ _∷_ (castVec-is-id _ M₀) (cast₁-is-id _ M)
+
+opaque
+ unfolding cast₂
+ cast₂-is-id : .(eq : B ≡ B) (M : Matrix A B) → cast₂ eq M ≡ M
+ cast₂-is-id _ [] = ≡.refl
+ cast₂-is-id eq (M₀ ∷ M) = ≡.cong (M₀ ∷_) (cast₂-is-id (suc-injective eq) M)
+
+opaque
+ unfolding cast₂
+ cast₂-trans : .(eq₁ : B ≡ C) (eq₂ : C ≡ D) (M : Matrix A B) → cast₂ eq₂ (cast₂ eq₁ M) ≡ cast₂ (≡.trans eq₁ eq₂) M
+ cast₂-trans {zero} {zero} {zero} {A} eq₁ eq₂ [] = ≡.refl
+ cast₂-trans {suc B} {suc C} {suc D} {A} eq₁ eq₂ (M₀ ∷ M) = ≡.cong (M₀ ∷_) (cast₂-trans (suc-injective eq₁) (suc-injective eq₂) M)
+
+opaque
+ unfolding _∥_ cast₁
+ ∥-assoc
+ : (X : Matrix A D)
+ (Y : Matrix B D)
+ (Z : Matrix C D)
+ → cast₁ (+-assoc A B C) ((X ∥ Y) ∥ Z) ≡ X ∥ Y ∥ Z
+ ∥-assoc [] [] [] = cast₁-is-id ≡.refl []
+ ∥-assoc (X₀ ∷ X) (Y₀ ∷ Y) (Z₀ ∷ Z) = ≡.cong₂ _∷_ (++-assoc-eqFree X₀ Y₀ Z₀) (∥-assoc X Y Z)
+
+opaque
+ unfolding _≑_ cast₂
+ ≑-assoc
+ : (X : Matrix A B)
+ (Y : Matrix A C)
+ (Z : Matrix A D)
+ → cast₂ (+-assoc B C D) ((X ≑ Y) ≑ Z) ≡ X ≑ Y ≑ Z
+ ≑-assoc [] Y Z = cast₂-is-id ≡.refl (Y ≑ Z)
+ ≑-assoc (X₀ ∷ X) Y Z = ≡.cong (X₀ ∷_) (≑-assoc X Y Z)
+
+≑-sym-assoc
+ : (X : Matrix A B)
+ (Y : Matrix A C)
+ (Z : Matrix A D)
+ → cast₂ (≡.sym (+-assoc B C D)) (X ≑ Y ≑ Z) ≡ (X ≑ Y) ≑ Z
+≑-sym-assoc {A} {B} {C} {D} X Y Z = begin
+ cast₂ _ (X ≑ Y ≑ Z) ≡⟨ ≡.cong (cast₂ _) (≑-assoc X Y Z) ⟨
+ cast₂ _ (cast₂ assoc ((X ≑ Y) ≑ Z)) ≡⟨ cast₂-trans assoc (≡.sym assoc) ((X ≑ Y) ≑ Z) ⟩
+ cast₂ _ ((X ≑ Y) ≑ Z) ≡⟨ cast₂-is-id _ ((X ≑ Y) ≑ Z) ⟩
+ (X ≑ Y) ≑ Z ∎
+ where
+ open ≡-Reasoning
+ assoc : B + C + D ≡ B + (C + D)
+ assoc = +-assoc B C D
+
+opaque
+ unfolding _∥_ _≑_
+ ∥-≑ : {A₁ B₁ A₂ B₂ : ℕ}
+ (W : Matrix A₁ B₁)
+ (X : Matrix A₂ B₁)
+ (Y : Matrix A₁ B₂)
+ (Z : Matrix A₂ B₂)
+ → W ∥ X ≑ Y ∥ Z ≡ (W ≑ Y) ∥ (X ≑ Z)
+ ∥-≑ {A₁} {ℕ.zero} {A₂} {B₂} [] [] Y Z = ≡.refl
+ ∥-≑ {A₁} {suc B₁} {A₂} {B₂} (W₀ ∷ W) (X₀ ∷ X) Y Z = ≡.cong ((W₀ ++ X₀) ∷_) (∥-≑ W X Y Z)
+
+∥-≑⁴
+ : (R : Matrix A D)
+ (S : Matrix B D)
+ (T : Matrix C D)
+ (U : Matrix A E)
+ (V : Matrix B E)
+ (W : Matrix C E)
+ (X : Matrix A F)
+ (Y : Matrix B F)
+ (Z : Matrix C F)
+ → (R ∥ S ∥ T) ≑
+ (U ∥ V ∥ W) ≑
+ (X ∥ Y ∥ Z)
+ ≡ (R ≑ U ≑ X) ∥
+ (S ≑ V ≑ Y) ∥
+ (T ≑ W ≑ Z)
+∥-≑⁴ R S T U V W X Y Z = begin
+ R ∥ S ∥ T ≑ U ∥ V ∥ W ≑ X ∥ Y ∥ Z ≡⟨ ≡.cong (R ∥ S ∥ T ≑_) (∥-≑ U (V ∥ W) X (Y ∥ Z)) ⟩
+ R ∥ S ∥ T ≑ (U ≑ X) ∥ (V ∥ W ≑ Y ∥ Z) ≡⟨ ≡.cong (λ h → (R ∥ S ∥ T ≑ (U ≑ X) ∥ h)) (∥-≑ V W Y Z) ⟩
+ R ∥ S ∥ T ≑ (U ≑ X) ∥ (V ≑ Y) ∥ (W ≑ Z) ≡⟨ ∥-≑ R (S ∥ T) (U ≑ X) ((V ≑ Y) ∥ (W ≑ Z)) ⟩
+ (R ≑ (U ≑ X)) ∥ ((S ∥ T) ≑ ((V ≑ Y) ∥ (W ≑ Z))) ≡⟨ ≡.cong ((R ≑ U ≑ X) ∥_) (∥-≑ S T (V ≑ Y) (W ≑ Z)) ⟩
+ (R ≑ U ≑ X) ∥ (S ≑ V ≑ Y) ∥ (T ≑ W ≑ Z) ∎
+ where
+ open ≡-Reasoning
+
+opaque
+ unfolding Vector
+ cast : .(A ≡ B) → Vector A → Vector B
+ cast = castVec
+
+opaque
+ unfolding cast cast₂ _∷ₕ_
+ cast₂-∷ₕ : .(eq : B ≡ C) (V : Vector B) (M : Matrix A B) → cast eq V ∷ₕ cast₂ eq M ≡ cast₂ eq (V ∷ₕ M)
+ cast₂-∷ₕ {zero} {zero} {A} _ [] [] = ≡.sym (cast₂-is-id ≡.refl ([] ∷ₕ []))
+ cast₂-∷ₕ {suc B} {suc C} {A} eq (x ∷ V) (M₀ ∷ M) = ≡.cong ((x ∷ M₀) ∷_) (cast₂-∷ₕ _ V M)
+
+opaque
+ unfolding []ᵥ cast₂
+ cast₂-[]ᵥ : .(eq : A ≡ B) → cast₂ eq []ᵥ ≡ []ᵥ
+ cast₂-[]ᵥ {zero} {zero} _ = ≡.refl
+ cast₂-[]ᵥ {suc A} {suc B} eq = ≡.cong ([] ∷_) (cast₂-[]ᵥ (suc-injective eq))
+
+cast₂-∥ : .(eq : C ≡ D) (M : Matrix A C) (N : Matrix B C) → cast₂ eq M ∥ cast₂ eq N ≡ cast₂ eq (M ∥ N)
+cast₂-∥ {C} {D} {zero} {B} eq M N
+ rewrite ([]ᵥ-! M) = begin
+ cast₂ _ []ᵥ ∥ cast₂ _ N ≡⟨ ≡.cong (_∥ cast₂ _ N) (cast₂-[]ᵥ _) ⟩
+ []ᵥ ∥ cast₂ _ N ≡⟨ []ᵥ-∥ (cast₂ _ N) ⟩
+ cast₂ _ N ≡⟨ ≡.cong (cast₂ _) ([]ᵥ-∥ N) ⟨
+ cast₂ _ ([]ᵥ ∥ N) ∎
+ where
+ open ≡-Reasoning
+cast₂-∥ {C} {D} {suc A} {B} eq M N
+ rewrite ≡.sym (head-∷-tailₕ M)
+ using M₀ ← headₕ M
+ using M ← tailₕ M = begin
+ cast₂ _ (M₀ ∷ₕ M) ∥ (cast₂ _ N) ≡⟨ ≡.cong (_∥ (cast₂ eq N)) (cast₂-∷ₕ eq M₀ M) ⟨
+ (cast _ M₀ ∷ₕ cast₂ _ M) ∥ (cast₂ _ N) ≡⟨ ∷ₕ-∥ (cast _ M₀) (cast₂ _ M) (cast₂ _ N) ⟨
+ cast _ M₀ ∷ₕ (cast₂ _ M ∥ cast₂ _ N) ≡⟨ ≡.cong (cast eq M₀ ∷ₕ_) (cast₂-∥ _ M N) ⟩
+ cast _ M₀ ∷ₕ cast₂ _ (M ∥ N) ≡⟨ cast₂-∷ₕ eq M₀ (M ∥ N) ⟩
+ cast₂ _ (M₀ ∷ₕ (M ∥ N)) ≡⟨ ≡.cong (cast₂ eq) (∷ₕ-∥ M₀ M N) ⟩
+ cast₂ _ ((M₀ ∷ₕ M) ∥ N) ∎
+ where
+ open ≡-Reasoning
diff --git a/Data/Matrix/Category.agda b/Data/Matrix/Category.agda
new file mode 100644
index 0000000..5a33440
--- /dev/null
+++ b/Data/Matrix/Category.agda
@@ -0,0 +1,177 @@
+{-# OPTIONS --without-K --safe #-}
+
+open import Algebra using (Semiring)
+open import Level using (Level; 0ℓ; _⊔_)
+
+module Data.Matrix.Category {c ℓ : Level} (R : Semiring c ℓ) where
+
+module R = Semiring R
+
+import Data.Vec.Relation.Binary.Pointwise.Inductive as PW
+import Relation.Binary.Reasoning.Setoid as ≈-Reasoning
+
+open import Categories.Category using (Category)
+open import Categories.Category.Helper using (categoryHelper)
+open import Data.Matrix.Core R.setoid using (Matrix; Matrixₛ; _≋_; ≋-isEquiv; _ᵀ; -ᵀ-cong; _∷ₕ_; mapRows; _ᵀᵀ; module ≋; _∥_; _≑_)
+open import Data.Matrix.Monoid R.+-monoid using (𝟎; _[+]_)
+open import Data.Matrix.Transform R using ([_]_; _[_]; -[-]-cong; [-]--cong; -[-]ᵀ; []-∙; [-]--∥; [++]-≑; I; Iᵀ; I[-]; map--[-]-I; [-]-𝟎; [⟨0⟩]-)
+open import Data.Nat using (ℕ)
+open import Data.Vec using (Vec; map)
+open import Data.Vec.Properties using (map-id; map-∘)
+open import Data.Vector.Bisemimodule R using (_∙_; ∙-cong)
+open import Data.Vector.Core R.setoid using (Vector; Vectorₛ; module ≊; _≊_)
+open import Data.Vector.Monoid R.+-monoid using () renaming (⟨ε⟩ to ⟨0⟩)
+open import Function using (id)
+open import Relation.Binary.PropositionalEquality as ≡ using (_≡_; module ≡-Reasoning)
+
+open R
+open Vec
+open ℕ
+
+private
+ variable
+ n m p : ℕ
+ A B C D : ℕ
+
+-- matrix multiplication
+_·_ : Matrix m p → Matrix n m → Matrix n p
+_·_ A B = mapRows ([_] B) A
+
+-- alternative form
+_·′_ : Matrix m p → Matrix n m → Matrix n p
+_·′_ A B = mapRows (A [_]) (B ᵀ) ᵀ
+
+infixr 9 _·_ _·′_
+
+·-·′ : (A : Matrix m p) (B : Matrix n m) → A · B ≡ A ·′ B
+·-·′ A B = begin
+ mapRows ([_] B) A ≡⟨ mapRows ([_] B) A ᵀᵀ ⟨
+ mapRows ([_] B) A ᵀ ᵀ ≡⟨ ≡.cong (_ᵀ) (-[-]ᵀ A B) ⟨
+ mapRows (A [_]) (B ᵀ) ᵀ ∎
+ where
+ open ≡-Reasoning
+
+opaque
+
+ unfolding _[_]
+
+ ·-[] : {A B C : ℕ} (M : Matrix A B) (N : Matrix B C) (V : Vector A) → (N · M) [ V ] ≊ N [ M [ V ] ]
+ ·-[] {A} {B} {zero} M [] V = PW.[]
+ ·-[] {A} {B} {suc C} M (N₀ ∷ N) V = []-∙ N₀ M V PW.∷ ·-[] M N V
+
+opaque
+
+ unfolding [_]_
+
+ []-· : {A B C : ℕ} (V : Vector C) (M : Matrix A B) (N : Matrix B C) → [ V ] (N · M) ≊ [ [ V ] N ] M
+ []-· {A} {B} {C} V M N = begin
+ [ V ] (map ([_] M) N) ≡⟨ ≡.cong (map (V ∙_)) (-[-]ᵀ N M) ⟨
+ map (V ∙_) (map (N [_]) (M ᵀ)) ≡⟨ map-∘ (V ∙_) (N [_]) (M ᵀ) ⟨
+ map (λ h → V ∙ N [ h ]) (M ᵀ) ≈⟨ PW.map⁺ (λ {W} ≋W → trans ([]-∙ V N W) (∙-cong ≊.refl (-[-]-cong N ≋W))) {xs = M ᵀ} ≋.refl ⟨
+ map ([ V ] N ∙_) (M ᵀ) ∎
+ where
+ open ≈-Reasoning (Vectorₛ A)
+
+opaque
+
+ unfolding _∥_
+
+ ·-∥
+ : (M : Matrix C D)
+ (N : Matrix A C)
+ (P : Matrix B C)
+ → M · (N ∥ P) ≡ M · N ∥ M · P
+ ·-∥ {C} {D} {A} {B} [] N P = ≡.refl
+ ·-∥ {C} {D} {A} {B} (M₀ ∷ M) N P = ≡.cong₂ _∷_ ([-]--∥ M₀ N P) (·-∥ M N P)
+
+opaque
+
+ unfolding _≑_
+
+ ≑-· : (M : Matrix B C)
+ (N : Matrix B D)
+ (P : Matrix A B)
+ → (M ≑ N) · P ≡ (M · P) ≑ (N · P)
+ ≑-· [] N P = ≡.refl
+ ≑-· (M₀ ∷ M) N P = ≡.cong ([ M₀ ] P ∷_) (≑-· M N P)
+
+opaque
+
+ unfolding _[+]_
+
+ ∥-·-≑
+ : (W : Matrix A C)
+ (X : Matrix B C)
+ (Y : Matrix D A)
+ (Z : Matrix D B)
+ → (W ∥ X) · (Y ≑ Z) ≋ (W · Y) [+] (X · Z)
+ ∥-·-≑ [] [] Y Z = PW.[]
+ ∥-·-≑ {A} {C} {B} {D} (W₀ ∷ W) (X₀ ∷ X) Y Z = [++]-≑ W₀ X₀ Y Z PW.∷ ∥-·-≑ W X Y Z
+ where
+ open ≈-Reasoning (Matrixₛ A B)
+
+opaque
+
+ unfolding Matrix
+
+ ·-resp-≋ : {X X′ : Matrix n p} {Y Y′ : Matrix m n} → X ≋ X′ → Y ≋ Y′ → X · Y ≋ X′ · Y′
+ ·-resp-≋ ≋X ≋Y = PW.map⁺ (λ {_} {y} ≋V → [-]--cong ≋V ≋Y) ≋X
+
+ ·-assoc : {A B C D : ℕ} {f : Matrix A B} {g : Matrix B C} {h : Matrix C D} → (h · g) · f ≋ h · g · f
+ ·-assoc {A} {B} {C} {D} {f} {g} {h} = begin
+ map ([_] f) (map ([_] g) h) ≡⟨ map-∘ ([_] f) ([_] g) h ⟨
+ map (λ v → [ [ v ] g ] f) h ≈⟨ PW.map⁺ (λ {x} x≊y → ≊.trans ([]-· x f g) ([-]--cong ([-]--cong x≊y ≋.refl) ≋.refl)) {xs = h} ≋.refl ⟨
+ map (λ v → [ v ] (g · f)) h ∎
+ where
+ open ≈-Reasoning (Matrixₛ A D)
+
+ ·-Iˡ : {f : Matrix n m} → I · f ≋ f
+ ·-Iˡ {A} {B} {f} = begin
+ I · f ≡⟨ ·-·′ I f ⟩
+ map (I [_]) (f ᵀ) ᵀ ≈⟨ -ᵀ-cong (PW.map⁺ (λ {x} ≊V → ≊.trans (I[-] x) ≊V) {xs = f ᵀ} ≋.refl) ⟩
+ map id (f ᵀ) ᵀ ≡⟨ ≡.cong (_ᵀ) (map-id (f ᵀ)) ⟩
+ f ᵀ ᵀ ≡⟨ f ᵀᵀ ⟩
+ f ∎
+ where
+ open ≈-Reasoning (Matrixₛ A B)
+
+ ·-Iʳ : {f : Matrix n m} → f · I ≋ f
+ ·-Iʳ {A} {B} {f} = begin
+ f · I ≡⟨ ·-·′ f I ⟩
+ map (f [_]) (I ᵀ) ᵀ ≈⟨ -ᵀ-cong (≋.reflexive (≡.cong (map (f [_])) Iᵀ)) ⟩
+ map (f [_]) I ᵀ ≈⟨ -ᵀ-cong (map--[-]-I f) ⟩
+ f ᵀ ᵀ ≡⟨ f ᵀᵀ ⟩
+ f ∎
+ where
+ open ≈-Reasoning (Matrixₛ A B)
+
+opaque
+
+ unfolding 𝟎
+
+ ·-𝟎ʳ : (M : Matrix A B) → M · 𝟎 {C} ≋ 𝟎
+ ·-𝟎ʳ [] = ≋.refl
+ ·-𝟎ʳ (M₀ ∷ M) = begin
+ [ M₀ ] 𝟎 ∷ M · 𝟎 ≈⟨ [-]-𝟎 M₀ PW.∷ ·-𝟎ʳ M ⟩
+ ⟨0⟩ ∷ 𝟎 ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+ ·-𝟎ˡ : (M : Matrix A B) → 𝟎 {B} {C} · M ≋ 𝟎
+ ·-𝟎ˡ {A} {B} {zero} M = PW.[]
+ ·-𝟎ˡ {A} {B} {suc C} M = [⟨0⟩]- M PW.∷ ·-𝟎ˡ M
+
+-- The category of matrices over a rig
+Mat : Category 0ℓ c (c ⊔ ℓ)
+Mat = categoryHelper record
+ { Obj = ℕ
+ ; _⇒_ = Matrix
+ ; _≈_ = _≋_
+ ; id = I
+ ; _∘_ = _·_
+ ; assoc = λ {A B C D f g h} → ·-assoc {f = f} {g} {h}
+ ; identityˡ = ·-Iˡ
+ ; identityʳ = ·-Iʳ
+ ; equiv = ≋-isEquiv
+ ; ∘-resp-≈ = ·-resp-≋
+ }
diff --git a/Data/Matrix/Core.agda b/Data/Matrix/Core.agda
new file mode 100644
index 0000000..d97cb20
--- /dev/null
+++ b/Data/Matrix/Core.agda
@@ -0,0 +1,266 @@
+{-# OPTIONS --without-K --safe #-}
+
+open import Level using (Level; _⊔_)
+open import Relation.Binary using (Setoid; Rel; IsEquivalence)
+
+module Data.Matrix.Core {c ℓ : Level} (S : Setoid c ℓ) where
+
+import Data.Vec.Relation.Binary.Equality.Setoid as PW-≈
+import Data.Vec.Relation.Binary.Pointwise.Inductive as PW
+import Relation.Binary.Reasoning.Setoid as ≈-Reasoning
+
+open import Data.Matrix.Vec using (transpose)
+open import Data.Nat using (ℕ; _+_)
+open import Data.Vec as Vec using (Vec; map; zipWith; head; tail; replicate)
+open import Data.Vec.Properties using (map-cong; map-id)
+open import Data.Vector.Core S using (Vector; Vectorₛ; _++_; ⟨⟩; ⟨⟩-!; _≊_)
+open import Data.Vector.Vec using (zipWith-map; replicate-++)
+open import Function using (id)
+open import Relation.Binary.PropositionalEquality as ≡ using (_≡_; module ≡-Reasoning)
+
+open Setoid S
+open ℕ
+open Vec.Vec
+
+private
+ variable
+ n m p : ℕ
+ A B C : ℕ
+
+private
+
+ module PW-≊ {n} = PW-≈ (Vectorₛ n)
+
+opaque
+
+ -- Matrices over a setoid
+ Matrix : Rel ℕ c
+ Matrix n m = Vec (Vector n) m
+
+ -- Pointwise equality of matrices
+ _≋_ : Rel (Matrix n m) (c ⊔ ℓ)
+ _≋_ {n} {m} A B = A PW-≊.≋ B
+
+ -- Pointwise equivalence is an equivalence relation
+ ≋-isEquiv : IsEquivalence (_≋_ {n} {m})
+ ≋-isEquiv {n} {m} = PW-≊.≋-isEquivalence m
+
+ mapRows : (Vector n → Vector m) → Matrix n p → Matrix m p
+ mapRows = map
+
+ _∥_ : Matrix A C → Matrix B C → Matrix (A + B) C
+ _∥_ M N = zipWith _++_ M N
+
+ infixr 7 _∥_
+
+ _≑_ : Matrix A B → Matrix A C → Matrix A (B + C)
+ _≑_ M N = M Vec.++ N
+
+ infixr 6 _≑_
+
+ _∷ᵥ_ : Vector A → Matrix A B → Matrix A (suc B)
+ _∷ᵥ_ V M = V Vec.∷ M
+
+ infixr 5 _∷ᵥ_
+
+ opaque
+
+ unfolding Vector
+
+ _∷ₕ_ : Vector B → Matrix A B → Matrix (suc A) B
+ _∷ₕ_ V M = zipWith _∷_ V M
+
+ infixr 5 _∷ₕ_
+
+ ∷ₕ-cong : {V V′ : Vector B} {M M′ : Matrix A B} → V ≊ V′ → M ≋ M′ → V ∷ₕ M ≋ V′ ∷ₕ M′
+ ∷ₕ-cong PW.[] PW.[] = PW.[]
+ ∷ₕ-cong (≈x PW.∷ ≊V) (≊M₀ PW.∷ ≋M) = (≈x PW.∷ ≊M₀) PW.∷ (∷ₕ-cong ≊V ≋M)
+
+ headₕ : Matrix (suc A) B → Vector B
+ headₕ M = map Vec.head M
+
+ tailₕ : Matrix (suc A) B → Matrix A B
+ tailₕ M = map Vec.tail M
+
+ head-∷-tailₕ : (M : Matrix (suc A) B) → headₕ M ∷ₕ tailₕ M ≡ M
+ head-∷-tailₕ M = begin
+ zipWith _∷_ (map Vec.head M) (map Vec.tail M) ≡⟨ zipWith-map head tail _∷_ M ⟩
+ map (λ x → head x ∷ tail x) M ≡⟨ map-cong (λ { (_ ∷ _) → ≡.refl }) M ⟩
+ map id M ≡⟨ map-id M ⟩
+ M ∎
+ where
+ open ≡-Reasoning
+
+ []ᵥ : Matrix 0 B
+ []ᵥ = replicate _ []
+
+ []ᵥ-! : (E : Matrix 0 B) → E ≡ []ᵥ
+ []ᵥ-! [] = ≡.refl
+ []ᵥ-! ([] ∷ E) = ≡.cong ([] ∷_) ([]ᵥ-! E)
+
+ []ᵥ-≑ : []ᵥ {A} ≑ []ᵥ {B} ≡ []ᵥ
+ []ᵥ-≑ {A} {B} = replicate-++ A B []
+
+ []ᵥ-∥ : (M : Matrix A B) → []ᵥ ∥ M ≡ M
+ []ᵥ-∥ [] = ≡.refl
+ []ᵥ-∥ (M₀ ∷ M) = ≡.cong (M₀ ∷_) ([]ᵥ-∥ M)
+
+ ∷ₕ-∥ : (V : Vector C) (M : Matrix A C) (N : Matrix B C) → V ∷ₕ (M ∥ N) ≡ (V ∷ₕ M) ∥ N
+ ∷ₕ-∥ [] [] [] = ≡.refl
+ ∷ₕ-∥ (x ∷ V) (M₀ ∷ M) (N₀ ∷ N) = ≡.cong ((x ∷ M₀ ++ N₀) ∷_) (∷ₕ-∥ V M N)
+
+ ∷ₕ-≑ : (V : Vector A) (W : Vector B) (M : Matrix C A) (N : Matrix C B) → (V ++ W) ∷ₕ (M ≑ N) ≡ (V ∷ₕ M) ≑ (W ∷ₕ N)
+ ∷ₕ-≑ [] W [] N = ≡.refl
+ ∷ₕ-≑ (x ∷ V) W (M₀ ∷ M) N = ≡.cong ((x ∷ M₀) ∷_) (∷ₕ-≑ V W M N)
+
+ headᵥ : Matrix A (suc B) → Vector A
+ headᵥ (V ∷ _) = V
+
+ tailᵥ : Matrix A (suc B) → Matrix A B
+ tailᵥ (_ ∷ M) = M
+
+ head-∷-tailᵥ : (M : Matrix A (suc B)) → headᵥ M ∷ᵥ tailᵥ M ≡ M
+ head-∷-tailᵥ (_ ∷ _) = ≡.refl
+
+ []ₕ : Matrix A 0
+ []ₕ = []
+
+ []ₕ-! : (E : Matrix A 0) → E ≡ []ₕ
+ []ₕ-! [] = ≡.refl
+
+ []ₕ-≑ : (M : Matrix A B) → []ₕ ≑ M ≡ M
+ []ₕ-≑ _ = ≡.refl
+
+ ∷ᵥ-≑ : (V : Vector A) (M : Matrix A B) (N : Matrix A C) → V ∷ᵥ (M ≑ N) ≡ (V ∷ᵥ M) ≑ N
+ ∷ᵥ-≑ V M N = ≡.refl
+
+infix 4 _≋_
+
+module ≋ {n} {m} = IsEquivalence (≋-isEquiv {n} {m})
+
+Matrixₛ : ℕ → ℕ → Setoid c (c ⊔ ℓ)
+Matrixₛ n m = record
+ { Carrier = Matrix n m
+ ; _≈_ = _≋_ {n} {m}
+ ; isEquivalence = ≋-isEquiv
+ }
+
+opaque
+
+ unfolding Vector
+
+ head′ : Vector (suc A) → Carrier
+ head′ = head
+
+ head-cong : {V V′ : Vector (suc A)} → V ≊ V′ → head′ V ≈ head′ V′
+ head-cong (≈x PW.∷ _) = ≈x
+
+ tail′ : Vector (suc A) → Vector A
+ tail′ = tail
+
+ tail-cong : {V V′ : Vector (suc A)} → V ≊ V′ → tail′ V ≊ tail′ V′
+ tail-cong (_ PW.∷ ≊V) = ≊V
+
+opaque
+
+ unfolding headₕ head′
+
+ ≋headₕ : {M M′ : Matrix (suc A) B} → M ≋ M′ → headₕ M ≊ headₕ M′
+ ≋headₕ M≋M′ = PW.map⁺ head-cong M≋M′
+
+ ≋tailₕ : {M M′ : Matrix (suc A) B} → M ≋ M′ → tailₕ M ≋ tailₕ M′
+ ≋tailₕ M≋M′ = PW.map⁺ tail-cong M≋M′
+
+opaque
+ unfolding _≋_ _∥_ []ᵥ _∷ₕ_
+ ∥-cong : {M M′ : Matrix A C} {N N′ : Matrix B C} → M ≋ M′ → N ≋ N′ → M ∥ N ≋ M′ ∥ N′
+ ∥-cong {zero} {C} {B} {M} {M′} {N} {N′} ≋M ≋N
+ rewrite []ᵥ-! M
+ rewrite []ᵥ-! M′ = begin
+ ([]ᵥ ∥ N) ≡⟨ []ᵥ-∥ N ⟩
+ N ≈⟨ ≋N ⟩
+ N′ ≡⟨ []ᵥ-∥ N′ ⟨
+ ([]ᵥ ∥ N′) ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+ ∥-cong {suc A} {C} {B} {M} {M′} {N} {N′} ≋M ≋N
+ rewrite ≡.sym (head-∷-tailₕ M)
+ using M₀ ← headₕ M
+ using M- ← tailₕ M
+ rewrite ≡.sym (head-∷-tailₕ M′)
+ using M₀′ ← headₕ M′
+ using M-′ ← tailₕ M′ = begin
+ (M₀ ∷ₕ M-) ∥ N ≡⟨ ∷ₕ-∥ M₀ M- N ⟨
+ M₀ ∷ₕ M- ∥ N ≈⟨ ∷ₕ-cong ≊M₀ (∥-cong ≋M- ≋N) ⟩
+ M₀′ ∷ₕ M-′ ∥ N′ ≡⟨ ∷ₕ-∥ M₀′ M-′ N′ ⟩
+ (M₀′ ∷ₕ M-′) ∥ N′ ∎
+ where
+ ≊M₀ : M₀ ≊ M₀′
+ ≊M₀ = begin
+ headₕ M ≡⟨ ≡.cong headₕ (head-∷-tailₕ M) ⟨
+ headₕ (M₀ ∷ₕ M-) ≈⟨ ≋headₕ ≋M ⟩
+ headₕ (M₀′ ∷ₕ M-′) ≡⟨ ≡.cong headₕ (head-∷-tailₕ M′) ⟩
+ headₕ M′ ∎
+ where
+ open ≈-Reasoning (Vectorₛ _)
+ ≋M- : M- ≋ M-′
+ ≋M- = begin
+ tailₕ M ≡⟨ ≡.cong tailₕ (head-∷-tailₕ M) ⟨
+ tailₕ (M₀ ∷ₕ M-) ≈⟨ ≋tailₕ ≋M ⟩
+ tailₕ (M₀′ ∷ₕ M-′) ≡⟨ ≡.cong tailₕ (head-∷-tailₕ M′) ⟩
+ tailₕ M′ ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+ open ≈-Reasoning (Matrixₛ _ _)
+
+opaque
+ unfolding _≑_
+ ≑-cong : {M M′ : Matrix A B} {N N′ : Matrix A C} → M ≋ M′ → N ≋ N′ → M ≑ N ≋ M′ ≑ N′
+ ≑-cong PW.[] ≋N = ≋N
+ ≑-cong (M₀≊M₀′ PW.∷ ≋M) ≋N = M₀≊M₀′ PW.∷ ≑-cong ≋M ≋N
+
+opaque
+
+ unfolding Matrix
+
+ _ᵀ : Matrix n m → Matrix m n
+ _ᵀ [] = []ᵥ
+ _ᵀ (M₀ ∷ M) = M₀ ∷ₕ M ᵀ
+
+ infix 10 _ᵀ
+
+ -ᵀ-cong : {M₁ M₂ : Matrix n m} → M₁ ≋ M₂ → M₁ ᵀ ≋ M₂ ᵀ
+ -ᵀ-cong PW.[] = ≋.refl
+ -ᵀ-cong (≊M₀ PW.∷ ≋M) = ∷ₕ-cong ≊M₀ (-ᵀ-cong ≋M)
+
+ opaque
+
+ unfolding []ᵥ []ₕ
+
+ []ᵥ-ᵀ : []ᵥ ᵀ ≡ []ₕ {A}
+ []ᵥ-ᵀ {zero} = ≡.refl
+ []ᵥ-ᵀ {suc A} = ≡.cong (zipWith _∷_ []) ([]ᵥ-ᵀ)
+
+ opaque
+
+ unfolding _∷ₕ_ Vector
+
+ ∷ₕ-ᵀ : (V : Vector A) (M : Matrix B A) → (V ∷ₕ M) ᵀ ≡ V ∷ᵥ M ᵀ
+ ∷ₕ-ᵀ [] [] = ≡.refl
+ ∷ₕ-ᵀ (x ∷ V) (M₀ ∷ M) = ≡.cong ((x ∷ M₀) ∷ₕ_) (∷ₕ-ᵀ V M)
+
+ ∷ᵥ-ᵀ : (V : Vector B) (M : Matrix B A) → (V ∷ᵥ M) ᵀ ≡ V ∷ₕ M ᵀ
+ ∷ᵥ-ᵀ V M = ≡.refl
+
+ opaque
+
+ _ᵀᵀ : (M : Matrix n m) → M ᵀ ᵀ ≡ M
+ _ᵀᵀ [] = []ᵥ-ᵀ
+ _ᵀᵀ (M₀ ∷ M) = begin
+ (M₀ ∷ₕ M ᵀ) ᵀ ≡⟨ ∷ₕ-ᵀ M₀ (M ᵀ) ⟩
+ M₀ ∷ᵥ M ᵀ ᵀ ≡⟨ ≡.cong (M₀ ∷ᵥ_) (M ᵀᵀ) ⟩
+ M₀ ∷ᵥ M ∎
+ where
+ open ≡-Reasoning
+
+ infix 10 _ᵀᵀ
diff --git a/Data/Matrix/Dagger-2-Poset.agda b/Data/Matrix/Dagger-2-Poset.agda
new file mode 100644
index 0000000..cddf183
--- /dev/null
+++ b/Data/Matrix/Dagger-2-Poset.agda
@@ -0,0 +1,72 @@
+{-# OPTIONS --without-K --safe #-}
+
+open import Algebra using (Idempotent; CommutativeSemiring)
+open import Level using (Level)
+
+module Data.Matrix.Dagger-2-Poset
+ {c ℓ : Level}
+ (R : CommutativeSemiring c ℓ)
+ (let module R = CommutativeSemiring R)
+ (+-idem : Idempotent R._≈_ R._+_)
+ where
+
+import Data.Vec.Relation.Binary.Pointwise.Inductive as PW
+import Relation.Binary.Reasoning.Setoid as ≈-Reasoning
+
+open import Category.Dagger.2-Poset using (dagger-2-poset; Dagger-2-Poset)
+open import Category.Dagger.Semiadditive using (IdempotentSemiadditiveDagger)
+open import Data.Matrix.Category R.semiring using (Mat; _·_; ·-Iˡ; ·-Iʳ; ·-resp-≋; ·-assoc; ∥-·-≑; ·-∥; ·-𝟎ˡ; ≑-·)
+open import Data.Matrix.Core R.setoid using (Matrix; Matrixₛ; _≋_; _∥_; _≑_; _ᵀ; module ≋; ∥-cong; ≑-cong)
+open import Data.Matrix.Monoid R.+-monoid using (𝟎; _[+]_; [+]-cong; [+]-𝟎ˡ; [+]-𝟎ʳ)
+open import Data.Matrix.Transform R.semiring using (I; Iᵀ)
+open import Data.Matrix.SemiadditiveDagger R using (∥-ᵀ; Mat-SemiadditiveDagger)
+open import Data.Nat using (ℕ)
+open import Data.Vec using (Vec)
+open import Data.Vector.Core R.setoid using (Vector; _≊_)
+open import Data.Vector.Monoid R.+-monoid using (_⊕_)
+open import Relation.Binary.PropositionalEquality as ≡ using (_≡_)
+
+open Vec
+
+private
+ variable
+ A B : ℕ
+
+opaque
+ unfolding _≊_ _⊕_
+ ⊕-idem : (V : Vector A) → V ⊕ V ≊ V
+ ⊕-idem [] = PW.[]
+ ⊕-idem (v ∷ V) = +-idem v PW.∷ ⊕-idem V
+
+opaque
+ unfolding _≋_ _[+]_
+ [+]-idem : (M : Matrix A B) → M [+] M ≋ M
+ [+]-idem [] = PW.[]
+ [+]-idem (M₀ ∷ M) = ⊕-idem M₀ PW.∷ [+]-idem M
+
+idem : (M : Matrix A B) → (I ∥ I) · (((I ≑ 𝟎) · M) ∥ ((𝟎 ≑ I) · M)) · (I ∥ I) ᵀ ≋ M
+idem M = begin
+ (I ∥ I) · (((I ≑ 𝟎) · M) ∥ ((𝟎 ≑ I) · M)) · (I ∥ I) ᵀ ≡⟨ ≡.cong₂ (λ h₁ h₂ → (I ∥ I) · (h₁ ∥ h₂) · (I ∥ I) ᵀ) (≑-· I 𝟎 M) (≑-· 𝟎 I M) ⟩
+ (I ∥ I) · ((I · M ≑ 𝟎 · M) ∥ (𝟎 · M ≑ I · M)) · (I ∥ I) ᵀ ≈⟨ ·-resp-≋ ≋.refl (·-resp-≋ (∥-cong (≑-cong ·-Iˡ (·-𝟎ˡ M)) (≑-cong (·-𝟎ˡ M) ·-Iˡ)) ≋.refl) ⟩
+ (I ∥ I) · ((M ≑ 𝟎) ∥ (𝟎 ≑ M)) · (I ∥ I) ᵀ ≡⟨ ≡.cong (λ h → (I ∥ I) · ((M ≑ 𝟎) ∥ (𝟎 ≑ M)) · h) (∥-ᵀ I I) ⟩
+ (I ∥ I) · ((M ≑ 𝟎) ∥ (𝟎 ≑ M)) · (I ᵀ ≑ I ᵀ) ≡⟨ ≡.cong₂ (λ h₁ h₂ → (I ∥ I) · ((M ≑ 𝟎) ∥ (𝟎 ≑ M)) · (h₁ ≑ h₂)) Iᵀ Iᵀ ⟩
+ (I ∥ I) · ((M ≑ 𝟎) ∥ (𝟎 ≑ M)) · (I ≑ I) ≈⟨ ·-assoc ⟨
+ ((I ∥ I) · ((M ≑ 𝟎) ∥ (𝟎 ≑ M))) · (I ≑ I) ≡⟨ ≡.cong (_· (I ≑ I)) (·-∥ (I ∥ I) (M ≑ 𝟎) (𝟎 ≑ M)) ⟩
+ (((I ∥ I) · (M ≑ 𝟎)) ∥ ((I ∥ I) · (𝟎 ≑ M))) · (I ≑ I) ≈⟨ ∥-·-≑ ((I ∥ I) · (M ≑ 𝟎)) ((I ∥ I) · (𝟎 ≑ M)) I I ⟩
+ (((I ∥ I) · (M ≑ 𝟎)) · I) [+] (((I ∥ I) · (𝟎 ≑ M)) · I) ≈⟨ [+]-cong ·-Iʳ ·-Iʳ ⟩
+ ((I ∥ I) · (M ≑ 𝟎)) [+] ((I ∥ I) · (𝟎 ≑ M)) ≈⟨ [+]-cong (∥-·-≑ I I M 𝟎) (∥-·-≑ I I 𝟎 M) ⟩
+ ((I · M) [+] (I · 𝟎)) [+] ((I · 𝟎) [+] (I · M)) ≈⟨ [+]-cong ([+]-cong ·-Iˡ ·-Iˡ) ([+]-cong ·-Iˡ ·-Iˡ) ⟩
+ (M [+] 𝟎) [+] (𝟎 [+] M) ≈⟨ [+]-cong ([+]-𝟎ʳ M) ([+]-𝟎ˡ M) ⟩
+ M [+] M ≈⟨ [+]-idem M ⟩
+ M ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+Mat-IdempotentSemiadditiveDagger : IdempotentSemiadditiveDagger Mat
+Mat-IdempotentSemiadditiveDagger = record
+ { semiadditiveDagger = Mat-SemiadditiveDagger
+ ; idempotent = idem _
+ }
+
+Mat-Dagger-2-Poset : Dagger-2-Poset
+Mat-Dagger-2-Poset = dagger-2-poset Mat-IdempotentSemiadditiveDagger
diff --git a/Data/Matrix/Monoid.agda b/Data/Matrix/Monoid.agda
new file mode 100644
index 0000000..b7638f6
--- /dev/null
+++ b/Data/Matrix/Monoid.agda
@@ -0,0 +1,93 @@
+{-# OPTIONS --without-K --safe #-}
+
+open import Algebra using (Monoid)
+open import Level using (Level)
+
+module Data.Matrix.Monoid {c ℓ : Level} (M : Monoid c ℓ) where
+
+module M = Monoid M
+
+import Relation.Binary.Reasoning.Setoid as ≈-Reasoning
+import Data.Vec.Relation.Binary.Pointwise.Inductive as PW
+
+open import Data.Matrix.Core M.setoid using (Matrix; _≋_; _ᵀ; _∷ₕ_; []ᵥ; _≑_; _∥_; []ᵥ-!; []ᵥ-∥; ∷ₕ-∥)
+open import Data.Nat using (ℕ)
+open import Data.Vec using (Vec; replicate; zipWith)
+open import Data.Vec.Properties using (zipWith-replicate)
+open import Data.Vector.Monoid M using (_⊕_; ⊕-cong; ⊕-identityˡ; ⊕-identityʳ; ⟨ε⟩)
+open import Relation.Binary.PropositionalEquality as ≡ using (_≡_; module ≡-Reasoning)
+
+open M
+open Vec
+open ℕ
+
+private
+ variable
+ A B C : ℕ
+
+opaque
+
+ unfolding Matrix
+
+ 𝟎 : Matrix A B
+ 𝟎 {A} {B} = replicate B ⟨ε⟩
+
+ opaque
+
+ unfolding _ᵀ []ᵥ ⟨ε⟩
+
+ 𝟎ᵀ : 𝟎 ᵀ ≡ 𝟎 {A} {B}
+ 𝟎ᵀ {zero} = ≡.refl
+ 𝟎ᵀ {suc A} = let open ≡-Reasoning in begin
+ ⟨ε⟩ ∷ₕ (𝟎 ᵀ) ≡⟨ ≡.cong (⟨ε⟩ ∷ₕ_) 𝟎ᵀ ⟩
+ ⟨ε⟩ ∷ₕ 𝟎 ≡⟨ zipWith-replicate _∷_ ε ⟨ε⟩ ⟩
+ 𝟎 ∎
+
+ opaque
+
+ unfolding _≑_
+
+ 𝟎≑𝟎 : 𝟎 {A} {B} ≑ 𝟎 {A} {C} ≡ 𝟎
+ 𝟎≑𝟎 {B = zero} = ≡.refl
+ 𝟎≑𝟎 {B = suc B} = ≡.cong (⟨ε⟩ ∷_) (𝟎≑𝟎 {B = B})
+
+ opaque
+
+ unfolding _∷ₕ_ ⟨ε⟩
+
+ ⟨ε⟩∷ₕ𝟎 : ⟨ε⟩ ∷ₕ 𝟎 {A} {B} ≡ 𝟎
+ ⟨ε⟩∷ₕ𝟎 {A} {zero} = ≡.refl
+ ⟨ε⟩∷ₕ𝟎 {A} {suc B} = ≡.cong (⟨ε⟩ ∷_) ⟨ε⟩∷ₕ𝟎
+
+𝟎∥𝟎 : 𝟎 {A} {C} ∥ 𝟎 {B} {C} ≡ 𝟎
+𝟎∥𝟎 {zero} {C} rewrite []ᵥ-! (𝟎 {0} {C}) = []ᵥ-∥ 𝟎
+𝟎∥𝟎 {suc A} {C} {B} = begin
+ 𝟎 ∥ 𝟎  ≡⟨ ≡.cong (_∥ 𝟎) (⟨ε⟩∷ₕ𝟎 {A} {C}) ⟨
+ (⟨ε⟩ ∷ₕ 𝟎 {A}) ∥ 𝟎  ≡⟨ ∷ₕ-∥ ⟨ε⟩ 𝟎 𝟎 ⟨
+ ⟨ε⟩ ∷ₕ 𝟎 {A} ∥ 𝟎  ≡⟨ ≡.cong (⟨ε⟩ ∷ₕ_) 𝟎∥𝟎 ⟩
+ ⟨ε⟩ ∷ₕ 𝟎  ≡⟨ ⟨ε⟩∷ₕ𝟎 ⟩
+ 𝟎 ∎
+ where
+ open ≡-Reasoning
+
+opaque
+
+ unfolding Matrix
+
+ _[+]_ : Matrix A B → Matrix A B → Matrix A B
+ _[+]_ = zipWith _⊕_
+
+ [+]-cong : {M M′ N N′ : Matrix A B} → M ≋ M′ → N ≋ N′ → M [+] N ≋ M′ [+] N′
+ [+]-cong = PW.zipWith-cong ⊕-cong
+
+ opaque
+
+ unfolding 𝟎
+
+ [+]-𝟎ˡ : (M : Matrix A B) → 𝟎 [+] M ≋ M
+ [+]-𝟎ˡ [] = PW.[]
+ [+]-𝟎ˡ (M₀ ∷ M) = ⊕-identityˡ M₀ PW.∷ [+]-𝟎ˡ M
+
+ [+]-𝟎ʳ : (M : Matrix A B) → M [+] 𝟎 ≋ M
+ [+]-𝟎ʳ [] = PW.[]
+ [+]-𝟎ʳ (M₀ ∷ M) = ⊕-identityʳ M₀ PW.∷ [+]-𝟎ʳ M
diff --git a/Data/Matrix/SemiadditiveDagger.agda b/Data/Matrix/SemiadditiveDagger.agda
new file mode 100644
index 0000000..220ff2e
--- /dev/null
+++ b/Data/Matrix/SemiadditiveDagger.agda
@@ -0,0 +1,389 @@
+{-# OPTIONS --without-K --safe #-}
+
+open import Algebra.Bundles using (CommutativeSemiring)
+open import Level using (Level)
+
+module Data.Matrix.SemiadditiveDagger {c ℓ : Level} (R : CommutativeSemiring c ℓ) where
+
+module R = CommutativeSemiring R
+
+import Relation.Binary.Reasoning.Setoid as ≈-Reasoning
+import Data.Vec.Relation.Binary.Pointwise.Inductive as PW
+import Data.Nat.Properties as ℕ-Props
+import Data.Nat as ℕ
+
+open import Categories.Category.Cocartesian using (Cocartesian)
+open import Categories.Object.Coproduct using (Coproduct)
+open import Categories.Object.Initial using (Initial)
+open import Category.Dagger.Semiadditive using (DaggerCocartesianMonoidal; SemiadditiveDagger)
+open import Data.Matrix.Cast R.setoid using (cast₂; cast₂-∥; ∥-≑; ∥-≑⁴; ≑-sym-assoc)
+open import Data.Matrix.Category R.semiring using (Mat; _·_; ≑-·; ·-Iˡ; ·-Iʳ; ·-𝟎ˡ; ·-𝟎ʳ; ·-∥; ∥-·-≑)
+open import Data.Matrix.Core R.setoid using (Matrix; Matrixₛ; _ᵀ; _ᵀᵀ; _≋_; module ≋; mapRows; []ᵥ; []ᵥ-∥; []ₕ; []ₕ-!; []ₕ-≑; _∷ᵥ_; _∷ₕ_; ∷ᵥ-ᵀ; _∥_; _≑_; ∷ₕ-ᵀ; ∷ₕ-≑; []ᵥ-ᵀ; ∥-cong; ≑-cong; -ᵀ-cong; head-∷-tailₕ; headₕ; tailₕ; ∷ₕ-∥; []ᵥ-!)
+open import Data.Matrix.Monoid R.+-monoid using (𝟎; 𝟎ᵀ; 𝟎≑𝟎; 𝟎∥𝟎; _[+]_; [+]-cong; [+]-𝟎ˡ; [+]-𝟎ʳ)
+open import Data.Matrix.Transform R.semiring using (I; Iᵀ; [_]_; _[_]; -[-]ᵀ; [-]--cong; [-]-[]ᵥ; [⟨⟩]-[]ₕ)
+open import Data.Nat using (ℕ)
+open import Data.Product using (_,_; Σ-syntax)
+open import Data.Vec using (Vec; map; replicate)
+open import Data.Vec.Properties using (map-cong; map-const)
+open import Data.Vector.Bisemimodule R.semiring using (_∙_ ; ∙-cong)
+open import Data.Vector.Core R.setoid using (Vector; Vectorₛ; ⟨⟩; _++_; module ≊; _≊_)
+open import Data.Vector.Monoid R.+-monoid using () renaming (⟨ε⟩ to ⟨0⟩)
+open import Data.Vector.Vec using (replicate-++)
+open import Function using (_∘_)
+open import Relation.Binary.PropositionalEquality as ≡ using (_≡_; module ≡-Reasoning)
+
+open R
+open Vec
+open ℕ.ℕ
+
+private
+ variable
+ A B C D E F : ℕ
+
+opaque
+ unfolding Vector _∙_
+ ∙-comm : (V W : Vector A) → V ∙ W ≈ W ∙ V
+ ∙-comm [] [] = refl
+ ∙-comm (x ∷ V) (w ∷ W) = +-cong (*-comm x w) (∙-comm V W)
+
+opaque
+ unfolding _[_] [_]_ _ᵀ []ᵥ ⟨⟩ _∷ₕ_ _≊_ _≋_ _∷ᵥ_
+ [-]-ᵀ : (M : Matrix A B) (V : Vector A) → M [ V ] ≊ [ V ] (M ᵀ)
+ [-]-ᵀ [] V = ≊.sym (≊.reflexive ([-]-[]ᵥ V))
+ [-]-ᵀ (M₀ ∷ M) V = begin
+ M₀ ∙ V ∷ map (_∙ V) M ≈⟨ ∙-comm M₀ V PW.∷ (PW.map⁺ (λ {x} ≊V → trans (∙-comm x V) (∙-cong ≊.refl ≊V)) ≋.refl) ⟩
+ V ∙ M₀ ∷ map (V ∙_) M ≡⟨⟩
+ map (V ∙_) (M₀ ∷ᵥ M) ≡⟨ ≡.cong (map (V ∙_) ∘ (M₀ ∷ᵥ_)) (M ᵀᵀ) ⟨
+ map (V ∙_) (M₀ ∷ᵥ M ᵀ ᵀ) ≡⟨ ≡.cong (map (V ∙_)) (∷ₕ-ᵀ M₀ (M ᵀ)) ⟨
+ map (V ∙_) ((M₀ ∷ₕ (M ᵀ)) ᵀ) ∎
+ where
+ open ≈-Reasoning (Vectorₛ _)
+
+opaque
+ unfolding []ᵥ mapRows ⟨⟩ _∷ₕ_ _∷ᵥ_ _ᵀ
+ ·-ᵀ
+ : {A B C : ℕ}
+ (M : Matrix A B)
+ (N : Matrix B C)
+ → (N · M) ᵀ ≋ M ᵀ · N ᵀ
+ ·-ᵀ {A} {B} {zero} M [] = begin
+ []ᵥ ≡⟨ map-const (M ᵀ) ⟨⟩ ⟨
+ map (λ _ → ⟨⟩) (M ᵀ) ≡⟨ map-cong [-]-[]ᵥ (M ᵀ) ⟨
+ map ([_] []ᵥ) (M ᵀ) ∎
+ where
+ open ≈-Reasoning (Matrixₛ 0 A)
+ ·-ᵀ {A} {B} {suc C} M (N₀ ∷ N) = begin
+ map ([_] M) (N₀ ∷ N) ᵀ ≡⟨ -[-]ᵀ (N₀ ∷ N) M ⟨
+ map ((N₀ ∷ N) [_]) (M ᵀ) ≈⟨ PW.map⁺ (λ {V} ≋V → ≊.trans ([-]-ᵀ (N₀ ∷ N) V) ([-]--cong {A = (N₀ ∷ᵥ N) ᵀ} ≋V ≋.refl)) ≋.refl ⟩
+ map ([_] ((N₀ ∷ N) ᵀ)) (M ᵀ) ≡⟨ map-cong (λ V → ≡.cong ([ V ]_) (∷ᵥ-ᵀ N₀ N)) (M ᵀ) ⟩
+ map ([_] (N₀ ∷ₕ N ᵀ)) (M ᵀ) ∎
+ where
+ open ≈-Reasoning (Matrixₛ (suc C) A)
+
+opaque
+ unfolding _≋_
+ ᵀ-involutive : (M : Matrix A B) → (M ᵀ) ᵀ ≋ M
+ ᵀ-involutive M = ≋.reflexive (M ᵀᵀ)
+
+opaque
+ unfolding _≋_
+ ≋λᵀ : ([]ᵥ ∥ I) ᵀ ≋ 𝟎 ≑ I {A}
+ ≋λᵀ = begin
+ ([]ᵥ ∥ I) ᵀ ≡⟨ ≡.cong (_ᵀ) ([]ᵥ-∥ I) ⟩
+ I ᵀ ≡⟨ Iᵀ ⟩
+ I ≡⟨ []ₕ-≑ I ⟨
+ []ₕ ≑ I ≡⟨ ≡.cong (_≑ I) ([]ₕ-! 𝟎) ⟨
+ 𝟎 ≑ I ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+opaque
+ unfolding Matrix _∥_ _ᵀ _≑_ _∷ₕ_
+ ∥-ᵀ : (M : Matrix A C) (N : Matrix B C) → (M ∥ N) ᵀ ≡ M ᵀ ≑ N ᵀ
+ ∥-ᵀ {A} {zero} {B} [] [] = ≡.sym (replicate-++ A B [])
+ ∥-ᵀ (M₀ ∷ M) (N₀ ∷ N) = begin
+ (M₀ ++ N₀) ∷ₕ ((M ∥ N) ᵀ) ≡⟨ ≡.cong ((M₀ ++ N₀) ∷ₕ_) (∥-ᵀ M N) ⟩
+ (M₀ ++ N₀) ∷ₕ (M ᵀ ≑ N ᵀ) ≡⟨ ∷ₕ-≑ M₀ N₀ (M ᵀ) (N ᵀ) ⟩
+ (M₀ ∷ₕ M ᵀ) ≑ (N₀ ∷ₕ N ᵀ) ∎
+ where
+ open ≡-Reasoning
+
+≑-ᵀ : (M : Matrix A B) (N : Matrix A C) → (M ≑ N) ᵀ ≡ M ᵀ ∥ N ᵀ
+≑-ᵀ M N = begin
+ (M ≑ N) ᵀ ≡⟨ ≡.cong₂ (λ h₁ h₂ → (h₁ ≑ h₂) ᵀ) (M ᵀᵀ) (N ᵀᵀ) ⟨
+ (M ᵀ ᵀ ≑ N ᵀ ᵀ ) ᵀ ≡⟨ ≡.cong (_ᵀ) (∥-ᵀ (M ᵀ) (N ᵀ)) ⟨
+ (M ᵀ ∥ N ᵀ ) ᵀ ᵀ ≡⟨ (M ᵀ ∥ N ᵀ ) ᵀᵀ ⟩
+ M ᵀ ∥ N ᵀ ∎
+ where
+ open ≡-Reasoning
+
+opaque
+ unfolding _≋_
+ ≋ρᵀ : (I ∥ []ᵥ) ᵀ ≋ I {A} ≑ 𝟎
+ ≋ρᵀ {A} = begin
+ (I ∥ []ᵥ) ᵀ ≡⟨ ∥-ᵀ I []ᵥ ⟩
+ I ᵀ ≑ []ᵥ ᵀ ≡⟨ ≡.cong (I ᵀ ≑_) []ᵥ-ᵀ ⟩
+ I ᵀ ≑ []ₕ ≡⟨ ≡.cong (_≑ []ₕ) Iᵀ ⟩
+ I ≑ []ₕ ≡⟨ ≡.cong (I ≑_) ([]ₕ-! 𝟎) ⟨
+ I ≑ 𝟎 ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+opaque
+ unfolding _≋_
+ ≋αᵀ : (((I {A} ≑ 𝟎 {A} {B ℕ.+ C}) ∥ (𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎)) ∥ (𝟎 {_} {A} ≑ I {B ℕ.+ C}) · (𝟎 ≑ I {C})) ᵀ
+ ≋ (I {A ℕ.+ B} ≑ 𝟎) · (I {A} ≑ 𝟎) ∥ (I {A ℕ.+ B} ≑ 𝟎) · (𝟎 ≑ I {B}) ∥ (𝟎 ≑ I {C})
+ ≋αᵀ {A} {B} {C} = begin
+ (((I {A} ≑ 𝟎 {A} {B ℕ.+ C}) ∥ (𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎 {B} {C})) ∥ (𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (𝟎 {C} {B} ≑ I {C})) ᵀ
+ ≡⟨ ∥-ᵀ ((I {A} ≑ 𝟎 {A} {B ℕ.+ C}) ∥ (𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎 {B} {C})) ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (𝟎 {C} {B} ≑ I {C})) ⟩
+ ((I {A} ≑ 𝟎 {A} {B ℕ.+ C}) ∥ (𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎 {B} {C})) ᵀ ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (𝟎 {C} {B} ≑ I {C})) ᵀ
+ ≡⟨ ≡.cong (_≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (𝟎 {C} {B} ≑ I {C})) ᵀ) (∥-ᵀ (I {A} ≑ 𝟎 {A} {B ℕ.+ C}) ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎 {B} {C}))) ⟩
+ ((I {A} ≑ 𝟎 {A} {B ℕ.+ C}) ᵀ ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎 {B} {C})) ᵀ) ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (𝟎 {C} {B} ≑ I {C})) ᵀ
+ ≡⟨ ≡.cong (λ h → (h ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎 {B} {C})) ᵀ) ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (𝟎 {C} {B} ≑ I {C})) ᵀ) (≑-ᵀ I 𝟎) ⟩
+ (I {A} ᵀ ∥ 𝟎 {A} {B ℕ.+ C} ᵀ ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎 {B} {C})) ᵀ) ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (𝟎 {C} {B} ≑ I {C})) ᵀ
+ ≡⟨ ≡.cong (λ h → (h ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎 {B} {C})) ᵀ) ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (𝟎 {C} {B} ≑ I {C})) ᵀ) (≡.cong₂ _∥_ Iᵀ 𝟎ᵀ) ⟩
+ (I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (I {B} ≑ 𝟎 {B} {C})) ᵀ) ≑ ((𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) · (𝟎 {C} {B} ≑ I {C})) ᵀ
+ ≈⟨ ≑-cong (≑-cong ≋.refl (·-ᵀ (I ≑ 𝟎) (𝟎 ≑ I))) (·-ᵀ (𝟎 ≑ I) (𝟎 ≑ I)) ⟩
+ (I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ (I {B} ≑ 𝟎 {B} {C}) ᵀ · (𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) ᵀ) ≑ (𝟎 {C} {B} ≑ I {C}) ᵀ · (𝟎 {B ℕ.+ C} {A} ≑ I {B ℕ.+ C}) ᵀ
+ ≡⟨ ≡.cong₂ _≑_ (≡.cong₂ (λ h₁ h₂ → I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ h₁ · h₂) (≑-ᵀ I 𝟎) (≑-ᵀ 𝟎 I)) (≡.cong₂ _·_ (≑-ᵀ 𝟎 I) (≑-ᵀ 𝟎 I)) ⟩
+ (I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ (I {B} ᵀ ∥ 𝟎 {B} {C} ᵀ) · (𝟎 {B ℕ.+ C} {A} ᵀ ∥ I {B ℕ.+ C} ᵀ)) ≑ (𝟎 {C} {B} ᵀ ∥ I {C} ᵀ) · (𝟎 {B ℕ.+ C} {A} ᵀ ∥ I {B ℕ.+ C} ᵀ)
+ ≡⟨ ≡.cong₂ _≑_ (≡.cong₂ (λ h₁ h₂ → I {A} ∥ 𝟎 ≑ h₁ · h₂) (≡.cong₂ _∥_ Iᵀ 𝟎ᵀ) (≡.cong₂ _∥_ 𝟎ᵀ Iᵀ)) (≡.cong₂ _·_ (≡.cong₂ _∥_ 𝟎ᵀ Iᵀ) (≡.cong₂ _∥_ 𝟎ᵀ Iᵀ)) ⟩
+ (I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ (I {B} ∥ 𝟎 {C} {B}) · (𝟎 {A} {B ℕ.+ C} ∥ I {B ℕ.+ C})) ≑ (𝟎 {B} {C} ∥ I {C}) · (𝟎 {A} {B ℕ.+ C} ∥ I {B ℕ.+ C})
+ ≡⟨ ≡.cong (λ h → (I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ h) ≑ (𝟎 {B} {C} ∥ I {C}) · (𝟎 {A} {B ℕ.+ C} ∥ I {B ℕ.+ C})) (·-∥ (I ∥ 𝟎) 𝟎 I) ⟩
+ (I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ (I {B} ∥ 𝟎 {C} {B}) · 𝟎 {A} {B ℕ.+ C} ∥ (I {B} ∥ 𝟎 {C} {B}) · I {B ℕ.+ C}) ≑ (𝟎 {B} {C} ∥ I {C}) · (𝟎 {A} {B ℕ.+ C} ∥ I {B ℕ.+ C})
+ ≈⟨ ≑-cong (≑-cong ≋.refl (∥-cong (·-𝟎ʳ (I ∥ 𝟎)) ·-Iʳ)) (≋.refl {x = (𝟎 {B} {C} ∥ I {C}) · (𝟎 {A} {B ℕ.+ C} ∥ I {B ℕ.+ C})}) ⟩
+ (I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ 𝟎 {A} {B} ∥ I {B} ∥ 𝟎 {C} {B}) ≑ (𝟎 {B} {C} ∥ I {C}) · (𝟎 {A} {B ℕ.+ C} ∥ I {B ℕ.+ C})
+ ≡⟨ ≡.cong ((I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ 𝟎 {A} {B} ∥ I {B} ∥ 𝟎 {C} {B}) ≑_) (·-∥ (𝟎 ∥ I) 𝟎 I) ⟩
+ (I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ 𝟎 {A} {B} ∥ I {B} ∥ 𝟎 {C} {B}) ≑ (𝟎 {B} {C} ∥ I {C}) · (𝟎 {A} {B ℕ.+ C}) ∥ (𝟎 {B} {C} ∥ I {C}) · I {B ℕ.+ C}
+ ≈⟨ ≑-cong ≋.refl (∥-cong (·-𝟎ʳ (𝟎 ∥ I)) ·-Iʳ) ⟩
+ (I {A} ∥ 𝟎 {B ℕ.+ C} {A} ≑ 𝟎 {A} {B} ∥ I {B} ∥ 𝟎 {C} {B}) ≑ 𝟎 {A} {C} ∥ 𝟎 {B} {C} ∥ I {C}
+ ≡⟨ ≡.cong (λ h → (I {A} ∥ h ≑ 𝟎 {A} {B} ∥ I {B} ∥ 𝟎 {C} {B}) ≑ 𝟎 {A} {C} ∥ 𝟎 {B} {C} ∥ I {C}) 𝟎∥𝟎 ⟨
+ (I {A} ∥ 𝟎 {B} ∥ 𝟎 {C} ≑ 𝟎 {A} ∥ I {B} ∥ 𝟎 {C}) ≑ 𝟎 {A} ∥ 𝟎 {B} ∥ I {C}
+ ≡⟨ ≑-sym-assoc (I {A} ∥ 𝟎 {B} ∥ 𝟎 {C}) (𝟎 {A} ∥ I {B} ∥ 𝟎 {C}) (𝟎 {A} ∥ 𝟎 {B} ∥ I {C}) ⟨
+ cast₂ _ (I {A} ∥ 𝟎 {B} ∥ 𝟎 {C} ≑ 𝟎 {A} ∥ I {B} ∥ 𝟎 {C} ≑ 𝟎 {A} ∥ 𝟎 {B} ∥ I {C})
+ ≡⟨ ≡.cong (cast₂ _) (∥-≑⁴ I 𝟎 𝟎 𝟎 I 𝟎 𝟎 𝟎 I) ⟩
+ cast₂ (≡.sym assoc) ((I {A} ≑ 𝟎 {A} {B} ≑ (𝟎 {A} {C})) ∥ (𝟎 {B} {A} ≑ I {B} ≑ 𝟎 {B} {C}) ∥ ((𝟎 {C} {A} ≑ 𝟎 {C} {B} ≑ I {C})))
+ ≡⟨ cast₂-∥ (≡.sym assoc) ((I {A} ≑ 𝟎 {A} {B} ≑ (𝟎 {A} {C}))) ((𝟎 {B} {A} ≑ I {B} ≑ 𝟎 {B} {C}) ∥ ((𝟎 {C} {A} ≑ 𝟎 {C} {B} ≑ I {C}))) ⟨
+ (cast₂ (≡.sym assoc) (I {A} ≑ 𝟎 {A} {B} ≑ (𝟎 {A} {C}))) ∥ cast₂ (≡.sym assoc) ((𝟎 {B} {A} ≑ I {B} ≑ 𝟎 {B} {C}) ∥ ((𝟎 {C} {A} ≑ 𝟎 {C} {B} ≑ I {C})))
+ ≡⟨ ≡.cong (cast₂ (≡.sym assoc) (I {A} ≑ 𝟎 {A} {B} ≑ (𝟎 {A} {C})) ∥_) (cast₂-∥ (≡.sym assoc) (𝟎 {B} {A} ≑ I {B} ≑ 𝟎 {B} {C}) (𝟎 {C} {A} ≑ 𝟎 {C} {B} ≑ I {C})) ⟨
+ cast₂ (≡.sym assoc) (I {A} ≑ 𝟎 {A} {B} ≑ (𝟎 {A} {C})) ∥ cast₂ (≡.sym assoc) (𝟎 {B} {A} ≑ I {B} ≑ 𝟎 {B} {C}) ∥ cast₂ (≡.sym assoc) (𝟎 {C} {A} ≑ 𝟎 {C} {B} ≑ I {C})
+ ≡⟨ ≡.cong₂ _∥_ (≑-sym-assoc I 𝟎 𝟎) (≡.cong₂ _∥_ (≑-sym-assoc 𝟎 I 𝟎) (≑-sym-assoc 𝟎 𝟎 I)) ⟩
+ ((I {A} ≑ 𝟎 {A} {B}) ≑ (𝟎 {A} {C})) ∥ ((𝟎 {B} {A} ≑ I {B}) ≑ 𝟎 {B} {C}) ∥ ((𝟎 {C} {A} ≑ 𝟎 {C} {B}) ≑ I {C})
+ ≡⟨ ≡.cong (λ h → ((I {A} ≑ 𝟎 {A} {B}) ≑ (𝟎 {A} {C})) ∥ ((𝟎 {B} {A} ≑ I {B}) ≑ 𝟎 {B} {C}) ∥ (h ≑ I {C})) 𝟎≑𝟎 ⟩
+ ((I {A} ≑ 𝟎 {A} {B}) ≑ (𝟎 {A} {C})) ∥ ((𝟎 {B} {A} ≑ I {B}) ≑ 𝟎 {B} {C}) ∥ (𝟎 {C} {A ℕ.+ B} ≑ I {C})
+ ≈⟨ ∥-cong ≋.refl (∥-cong (≑-cong ·-Iˡ (·-𝟎ˡ (𝟎 ≑ I))) ≋.refl) ⟨
+ ((I {A} ≑ 𝟎 {A} {B}) ≑ (𝟎 {A} {C})) ∥ (((I {A ℕ.+ B} · (𝟎 {B} {A} ≑ I {B})) ≑ (𝟎 {A ℕ.+ B} {C} · (𝟎 {B} {A} ≑ I {B})))) ∥ (𝟎 {C} {A ℕ.+ B} ≑ I {C})
+ ≡⟨ ≡.cong (λ h → ((I {A} ≑ 𝟎 {A} {B}) ≑ (𝟎 {A} {C})) ∥ h ∥ (𝟎 {C} {A ℕ.+ B} ≑ I {C})) (≑-· I 𝟎 (𝟎 ≑ I)) ⟨
+ ((I {A} ≑ 𝟎 {A} {B}) ≑ (𝟎 {A} {C})) ∥ ((I {A ℕ.+ B} ≑ 𝟎 {A ℕ.+ B} {C}) · (𝟎 {B} {A} ≑ I {B})) ∥ (𝟎 {C} {A ℕ.+ B} ≑ I {C})
+ ≈⟨ ∥-cong (≑-cong ·-Iˡ (·-𝟎ˡ (I ≑ 𝟎))) ≋.refl ⟨
+ ((I {A ℕ.+ B} · (I {A} ≑ 𝟎 {A} {B})) ≑ (𝟎 {A ℕ.+ B} {C} · (I {A} ≑ 𝟎 {A} {B}))) ∥ ((I {A ℕ.+ B} ≑ 𝟎 {A ℕ.+ B} {C}) · (𝟎 {B} {A} ≑ I {B})) ∥ (𝟎 {C} {A ℕ.+ B} ≑ I {C})
+ ≡⟨ ≡.cong (λ h → h ∥ ((I {A ℕ.+ B} ≑ 𝟎 {A ℕ.+ B} {C}) · (𝟎 {B} {A} ≑ I {B})) ∥ (𝟎 {C} {A ℕ.+ B} ≑ I {C})) (≑-· I 𝟎 (I ≑ 𝟎)) ⟨
+ (I {A ℕ.+ B} ≑ 𝟎 {A ℕ.+ B} {C}) · (I {A} ≑ 𝟎 {A} {B}) ∥ ((I {A ℕ.+ B} ≑ 𝟎 {A ℕ.+ B} {C}) · (𝟎 {B} {A} ≑ I {B})) ∥ (𝟎 {C} {A ℕ.+ B} ≑ I {C}) ∎
+ where
+ assoc : A ℕ.+ B ℕ.+ C ≡ A ℕ.+ (B ℕ.+ C)
+ assoc = ℕ-Props.+-assoc A B C
+ open ≈-Reasoning (Matrixₛ _ _)
+
+≋σᵀ : ((𝟎 ≑ I {A}) ∥ (I {B} ≑ 𝟎)) ᵀ ≋ (𝟎 ≑ I {B}) ∥ (I {A} ≑ 𝟎)
+≋σᵀ {A} {B} = begin
+ ((𝟎 ≑ I) ∥ (I ≑ 𝟎)) ᵀ ≡⟨ ∥-ᵀ (𝟎 ≑ I) (I ≑ 𝟎) ⟩
+ (𝟎 ≑ I {A}) ᵀ ≑ (I ≑ 𝟎) ᵀ ≡⟨ ≡.cong₂ _≑_ (≑-ᵀ 𝟎 I) (≑-ᵀ I 𝟎) ⟩
+ 𝟎 ᵀ ∥ (I {A}) ᵀ ≑ I ᵀ ∥ 𝟎 ᵀ ≡⟨ ≡.cong₂ _≑_ (≡.cong₂ _∥_ 𝟎ᵀ Iᵀ) (≡.cong₂ _∥_ Iᵀ 𝟎ᵀ) ⟩
+ 𝟎 ∥ I {A} ≑ I ∥ 𝟎 ≡⟨ ∥-≑ 𝟎 I I 𝟎 ⟩
+ (𝟎 ≑ I {B}) ∥ (I ≑ 𝟎) ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+≋⊗ : (M : Matrix A B)
+ (N : Matrix C D)
+ → (I ≑ 𝟎) · M ∥ (𝟎 ≑ I) · N
+ ≋ (M ≑ 𝟎) ∥ (𝟎 ≑ N)
+≋⊗ M N = begin
+ (I ≑ 𝟎) · M ∥ (𝟎 ≑ I) · N ≡⟨ ≡.cong₂ _∥_ (≑-· I 𝟎 M) (≑-· 𝟎 I N) ⟩
+ (I · M ≑ 𝟎 · M) ∥ (𝟎 · N ≑ I · N) ≈⟨ ∥-cong (≑-cong ·-Iˡ (·-𝟎ˡ M)) (≑-cong (·-𝟎ˡ N) ·-Iˡ) ⟩
+ (M ≑ 𝟎) ∥ (𝟎 ≑ N) ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+ᵀ-resp-⊗
+ : {M : Matrix A B}
+ {N : Matrix C D}
+ → ((I ≑ 𝟎) · M ∥ (𝟎 ≑ I) · N) ᵀ
+ ≋ (I ≑ 𝟎) · M ᵀ ∥ (𝟎 ≑ I) · N ᵀ
+ᵀ-resp-⊗ {M = M} {N = N} = begin
+ ((I ≑ 𝟎) · M ∥ (𝟎 ≑ I) · N) ᵀ ≈⟨ -ᵀ-cong (≋⊗ M N) ⟩
+ ((M ≑ 𝟎) ∥ (𝟎 ≑ N)) ᵀ ≡⟨ ≡.cong (_ᵀ) (∥-≑ M 𝟎 𝟎 N) ⟨
+ ((M ∥ 𝟎) ≑ (𝟎 ∥ N)) ᵀ ≡⟨ ≑-ᵀ (M ∥ 𝟎) (𝟎 ∥ N) ⟩
+ (M ∥ 𝟎) ᵀ ∥ (𝟎 ∥ N) ᵀ ≡⟨ ≡.cong₂ _∥_ (∥-ᵀ M 𝟎) (∥-ᵀ 𝟎 N) ⟩
+ (M ᵀ ≑ 𝟎 ᵀ) ∥ (𝟎 ᵀ ≑ N ᵀ) ≡⟨ ≡.cong₂ (λ h₁ h₂ → (M ᵀ ≑ h₁) ∥ (h₂ ≑ N ᵀ)) 𝟎ᵀ 𝟎ᵀ ⟩
+ (M ᵀ ≑ 𝟎) ∥ (𝟎 ≑ N ᵀ) ≈⟨ ≋⊗ (M ᵀ) (N ᵀ) ⟨
+ (I ≑ 𝟎) · M ᵀ ∥ (𝟎 ≑ I) · N ᵀ ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+inj₁ : (M : Matrix A C) (N : Matrix B C) → (M ∥ N) · (I ≑ 𝟎) ≋ M
+inj₁ {A} {C} M N = begin
+ (M ∥ N) · (I ≑ 𝟎) ≈⟨ ∥-·-≑ M N I 𝟎 ⟩
+ (M · I) [+] (N · 𝟎) ≈⟨ [+]-cong ·-Iʳ (·-𝟎ʳ N) ⟩
+ M [+] 𝟎 ≈⟨ [+]-𝟎ʳ M ⟩
+ M ∎
+ where
+ open ≈-Reasoning (Matrixₛ A C)
+
+inj₂ : (M : Matrix A C) (N : Matrix B C) → (M ∥ N) · (𝟎 ≑ I) ≋ N
+inj₂ {A} {C} {B} M N = begin
+ (M ∥ N) · (𝟎 ≑ I) ≈⟨ ∥-·-≑ M N 𝟎 I ⟩
+ (M · 𝟎) [+] (N · I) ≈⟨ [+]-cong (·-𝟎ʳ M) ·-Iʳ ⟩
+ 𝟎 [+] N ≈⟨ [+]-𝟎ˡ N ⟩
+ N ∎
+ where
+ open ≈-Reasoning (Matrixₛ B C)
+
+opaque
+ unfolding Matrix
+ split-∥ : (A : ℕ) → (M : Matrix (A ℕ.+ B) C) → Σ[ M₁ ∈ Matrix A C ] Σ[ M₂ ∈ Matrix B C ] M₁ ∥ M₂ ≡ M
+ split-∥ zero M = []ᵥ , M , []ᵥ-∥ M
+ split-∥ (suc A) M′
+ rewrite ≡.sym (head-∷-tailₕ M′)
+ using M₀ ← headₕ M′
+ using M ← tailₕ M′
+ with split-∥ A M
+ ... | M₁ , M₂ , M₁∥M₂≡M = M₀ ∷ₕ M₁ , M₂ , (begin
+ (M₀ ∷ₕ M₁) ∥ M₂ ≡⟨ ∷ₕ-∥ M₀ M₁ M₂ ⟨
+ M₀ ∷ₕ M₁ ∥ M₂ ≡⟨ ≡.cong (M₀ ∷ₕ_) M₁∥M₂≡M ⟩
+ M₀ ∷ₕ M ∎)
+ where
+ open ≡-Reasoning
+
+uniq
+ : (H : Matrix (A ℕ.+ B) C)
+ (M : Matrix A C)
+ (N : Matrix B C)
+ → H · (I ≑ 𝟎) ≋ M
+ → H · (𝟎 ≑ I) ≋ N
+ → M ∥ N ≋ H
+uniq {A} {B} {C} H M N eq₁ eq₂
+ with (H₁ , H₂ , H₁∥H₂≡H) ← split-∥ A H
+ rewrite ≡.sym H₁∥H₂≡H = begin
+ M ∥ N ≈⟨ ∥-cong eq₁ eq₂ ⟨
+ (H₁ ∥ H₂) · (I {A} ≑ 𝟎) ∥ (H₁ ∥ H₂) · (𝟎 ≑ I) ≈⟨ ∥-cong (inj₁ H₁ H₂) (inj₂ H₁ H₂) ⟩
+ (H₁ ∥ H₂) ∎
+ where
+ open ≈-Reasoning (Matrixₛ (A ℕ.+ B) C)
+
+coproduct : Coproduct Mat A B
+coproduct {A} {B} = record
+ { A+B = A ℕ.+ B
+ ; i₁ = I ≑ 𝟎
+ ; i₂ = 𝟎 ≑ I
+ ; [_,_] = _∥_
+ ; inject₁ = λ {a} {b} {c} → inj₁ b c
+ ; inject₂ = λ {a} {b} {c} → inj₂ b c
+ ; unique = λ eq₁ eq₂ → uniq _ _ _ eq₁ eq₂
+ }
+
+opaque
+ unfolding _≋_
+ !-unique : (E : Matrix 0 B) → []ᵥ ≋ E
+ !-unique E = ≋.reflexive (≡.sym ([]ᵥ-! E))
+
+initial : Initial Mat
+initial = record
+ { ⊥ = 0
+ ; ⊥-is-initial = record
+ { ! = []ᵥ
+ ; !-unique = !-unique
+ }
+ }
+
+Mat-Cocartesian : Cocartesian Mat
+Mat-Cocartesian = record
+ { initial = initial
+ ; coproducts = record
+ { coproduct = coproduct
+ }
+ }
+
+Mat-DaggerCocartesian : DaggerCocartesianMonoidal Mat
+Mat-DaggerCocartesian = record
+ { cocartesian = Mat-Cocartesian
+ ; dagger = record
+ { _† = λ M → M ᵀ
+ ; †-identity = ≋.reflexive Iᵀ
+ ; †-homomorphism = λ {f = f} {g} → ·-ᵀ f g
+ ; †-resp-≈ = -ᵀ-cong
+ ; †-involutive = ᵀ-involutive
+ }
+ ; λ≅† = ≋λᵀ
+ ; ρ≅† = ≋ρᵀ
+ ; α≅† = ≋αᵀ
+ ; σ≅† = ≋σᵀ
+ ; †-resp-⊗ = ᵀ-resp-⊗
+ }
+
+p₁-i₁ : (I ≑ 𝟎) ᵀ · (I ≑ 𝟎 {A} {B}) ≋ I
+p₁-i₁ = begin
+ (I ≑ 𝟎) ᵀ · (I ≑ 𝟎) ≡⟨ ≡.cong (_· (I ≑ 𝟎)) (≑-ᵀ I 𝟎) ⟩
+ (I ᵀ ∥ 𝟎 ᵀ) · (I ≑ 𝟎) ≡⟨ ≡.cong₂ (λ h₁ h₂ → (h₁ ∥ h₂) · (I ≑ 𝟎)) Iᵀ 𝟎ᵀ ⟩
+ (I ∥ 𝟎) · (I ≑ 𝟎) ≈⟨ ∥-·-≑ I 𝟎 I 𝟎 ⟩
+ (I · I) [+] (𝟎 · 𝟎) ≈⟨ [+]-cong ·-Iˡ (·-𝟎ˡ 𝟎) ⟩
+ I [+] 𝟎 ≈⟨ [+]-𝟎ʳ I ⟩
+ I ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+p₂-i₂ : (𝟎 {A} {B} ≑ I) ᵀ · (𝟎 ≑ I) ≋ I
+p₂-i₂ = begin
+ (𝟎 ≑ I) ᵀ · (𝟎 ≑ I) ≡⟨ ≡.cong (_· (𝟎 ≑ I)) (≑-ᵀ 𝟎 I) ⟩
+ (𝟎 ᵀ ∥ I ᵀ) · (𝟎 ≑ I) ≡⟨ ≡.cong₂ (λ h₁ h₂ → (h₁ ∥ h₂) · (𝟎 ≑ I)) 𝟎ᵀ Iᵀ ⟩
+ (𝟎 ∥ I) · (𝟎 ≑ I) ≈⟨ ∥-·-≑ 𝟎 I 𝟎 I ⟩
+ (𝟎 · 𝟎) [+] (I · I) ≈⟨ [+]-cong (·-𝟎ˡ 𝟎) ·-Iˡ ⟩
+ 𝟎 [+] I ≈⟨ [+]-𝟎ˡ I ⟩
+ I ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+opaque
+ unfolding 𝟎 ⟨⟩
+ []ᵥ·[]ₕ : []ᵥ · []ₕ ≡ 𝟎 {A} {B}
+ []ᵥ·[]ₕ {A} {B} = begin
+ map ([_] []ₕ) []ᵥ ≡⟨ map-cong (λ { [] → [⟨⟩]-[]ₕ }) []ᵥ ⟩
+ map (λ _ → ⟨0⟩) []ᵥ ≡⟨ map-const []ᵥ ⟨0⟩ ⟩
+ 𝟎 ∎
+ where
+ open ≡-Reasoning
+
+p₂-i₁ : (𝟎 {A} ≑ I) ᵀ · (I ≑ 𝟎 {B}) ≋ []ᵥ · []ᵥ ᵀ
+p₂-i₁ = begin
+ (𝟎 ≑ I) ᵀ · (I ≑ 𝟎) ≡⟨ ≡.cong (_· (I ≑ 𝟎)) (≑-ᵀ 𝟎 I) ⟩
+ (𝟎 ᵀ ∥ I ᵀ) · (I ≑ 𝟎) ≡⟨ ≡.cong₂ (λ h₁ h₂ → (h₁ ∥ h₂) · (I ≑ 𝟎)) 𝟎ᵀ Iᵀ ⟩
+ (𝟎 ∥ I) · (I ≑ 𝟎) ≈⟨ ∥-·-≑ 𝟎 I I 𝟎 ⟩
+ (𝟎 · I) [+] (I · 𝟎) ≈⟨ [+]-cong (·-𝟎ˡ I) (·-𝟎ʳ I) ⟩
+ 𝟎 [+] 𝟎 ≈⟨ [+]-𝟎ˡ 𝟎 ⟩
+ 𝟎 ≡⟨ []ᵥ·[]ₕ ⟨
+ []ᵥ · []ₕ ≡⟨ ≡.cong ([]ᵥ ·_) []ᵥ-ᵀ ⟨
+ []ᵥ · []ᵥ ᵀ ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+p₁-i₂ : (I ≑ 𝟎 {A}) ᵀ · (𝟎 {B} ≑ I) ≋ []ᵥ · []ᵥ ᵀ
+p₁-i₂ = begin
+ (I ≑ 𝟎) ᵀ · (𝟎 ≑ I) ≡⟨ ≡.cong (_· (𝟎 ≑ I)) (≑-ᵀ I 𝟎) ⟩
+ (I ᵀ ∥ 𝟎 ᵀ) · (𝟎 ≑ I) ≡⟨ ≡.cong₂ (λ h₁ h₂ → (h₁ ∥ h₂) · (𝟎 ≑ I)) Iᵀ 𝟎ᵀ ⟩
+ (I ∥ 𝟎) · (𝟎 ≑ I) ≈⟨ ∥-·-≑ I 𝟎 𝟎 I ⟩
+ (I · 𝟎) [+] (𝟎 · I) ≈⟨ [+]-cong (·-𝟎ʳ I) (·-𝟎ˡ I) ⟩
+ 𝟎 [+] 𝟎 ≈⟨ [+]-𝟎ˡ 𝟎 ⟩
+ 𝟎 ≡⟨ []ᵥ·[]ₕ ⟨
+ []ᵥ · []ₕ ≡⟨ ≡.cong ([]ᵥ ·_) []ᵥ-ᵀ ⟨
+ []ᵥ · []ᵥ ᵀ ∎
+ where
+ open ≈-Reasoning (Matrixₛ _ _)
+
+Mat-SemiadditiveDagger : SemiadditiveDagger Mat
+Mat-SemiadditiveDagger = record
+ { daggerCocartesianMonoidal = Mat-DaggerCocartesian
+ ; p₁-i₁ = p₁-i₁
+ ; p₂-i₂ = p₂-i₂
+ ; p₂-i₁ = p₂-i₁
+ ; p₁-i₂ = p₁-i₂
+ }
diff --git a/Data/Matrix/Transform.agda b/Data/Matrix/Transform.agda
new file mode 100644
index 0000000..671725f
--- /dev/null
+++ b/Data/Matrix/Transform.agda
@@ -0,0 +1,298 @@
+{-# OPTIONS --without-K --safe #-}
+
+open import Level using (Level; 0ℓ; _⊔_)
+open import Relation.Binary using (Setoid; Rel; IsEquivalence)
+open import Algebra using (Semiring)
+
+module Data.Matrix.Transform {c ℓ : Level} (R : Semiring c ℓ) where
+
+module R = Semiring R
+
+import Relation.Binary.Reasoning.Setoid as ≈-Reasoning
+import Data.Vec.Relation.Binary.Pointwise.Inductive as PW
+
+open import Data.Nat using (ℕ)
+open import Data.Vec using (Vec; map; replicate; zipWith)
+open import Data.Vec.Properties using (map-id; map-const; map-∘; zipWith-replicate; zipWith-replicate₁; map-replicate; map-cong)
+open import Relation.Binary.PropositionalEquality as ≡ using (_≗_; _≡_; module ≡-Reasoning)
+open import Function using (id; _∘_)
+
+open import Data.Matrix.Core R.setoid
+ using
+ ( Matrix; Matrixₛ; _≋_; ≋-isEquiv; _ᵀ; _∷ₕ_; []ᵥ; []ₕ; []ᵥ-ᵀ; mapRows
+ ; _ᵀᵀ; []ᵥ-!; ∷ₕ-ᵀ; ∷ₕ-cong; module ≋; -ᵀ-cong; _∥_; []ᵥ-∥; headₕ; tailₕ; head-∷-tailₕ; ∷ₕ-∥
+ ; _≑_; []ᵥ-≑; ∷ₕ-≑
+ )
+open import Data.Matrix.Monoid R.+-monoid using (𝟎; 𝟎ᵀ; _[+]_)
+open import Data.Vector.Core R.setoid using (Vector; Vectorₛ; ⟨⟩; module ≊; _≊_; _++_; ⟨⟩-++)
+open import Data.Vector.Vec using (zipWith-map; map-zipWith; zipWith-map-map)
+open import Data.Vector.Monoid R.+-monoid using (_⊕_; ⊕-cong; ⊕-identityˡ; ⊕-identityʳ) renaming (⟨ε⟩ to ⟨0⟩)
+open import Data.Vector.Bisemimodule R using (_∙_; ∙-cong; ∙-zeroˡ; ∙-zeroʳ; _⟨_⟩; *-∙ˡ; ∙-distribʳ)
+
+open Vec
+open ℕ
+open R
+
+private
+ variable
+ n m p : ℕ
+ A B C D : ℕ
+
+opaque
+
+ unfolding Matrix
+
+ opaque
+
+ unfolding Vector
+
+ _[_] : Matrix n m → Vector n → Vector m
+ _[_] M V = map (_∙ V) M
+
+ [_]_ : Vector m → Matrix n m → Vector n
+ [_]_ V M = map (V ∙_) (M ᵀ)
+
+ -[-]-cong : {x y : Vector n} (A : Matrix n m) → x ≊ y → A [ x ] ≊ A [ y ]
+ -[-]-cong {x = x} {y} A ≋V = PW.map⁺ (λ ≋w → ∙-cong ≋w ≋V) {xs = A} ≋.refl
+
+ [-]--cong : {x y : Vector m} {A B : Matrix n m} → x ≊ y → A ≋ B → [ x ] A ≊ [ y ] B
+ [-]--cong ≋V A≋B = PW.map⁺ (∙-cong ≋V) (-ᵀ-cong A≋B)
+
+ opaque
+
+ unfolding _ᵀ []ᵥ
+
+ [-]-[]ᵥ : (V : Vector A) → [ V ] []ᵥ ≡ ⟨⟩
+ [-]-[]ᵥ [] = ≡.refl
+ [-]-[]ᵥ (x ∷ V) = ≡.cong (map ((x ∷ V) ∙_)) []ᵥ-ᵀ
+
+ opaque
+
+ unfolding []ᵥ _ᵀ ⟨0⟩ _∙_
+
+ [-]-[]ₕ : (V : Vector 0) → [ V ] []ₕ ≡ ⟨0⟩ {n}
+ [-]-[]ₕ {zero} [] = ≡.refl
+ [-]-[]ₕ {suc A} [] = ≡.cong (0# ∷_) ([-]-[]ₕ [])
+
+opaque
+
+ unfolding Matrix Vector
+
+ -- The identity matrix
+ I : Matrix n n
+ I {zero} = []
+ I {suc n} = (1# ∷ ⟨0⟩) ∷ ⟨0⟩ ∷ₕ I
+
+ opaque
+
+ unfolding _ᵀ _∷ₕ_
+
+ Iᵀ : I ᵀ ≡ I {n}
+ Iᵀ {zero} = ≡.sym ([]ᵥ-! [])
+ Iᵀ {suc n} = begin
+ (1# ∷ ⟨0⟩) ∷ₕ ((⟨0⟩ ∷ₕ I) ᵀ) ≡⟨ ≡.cong ((1# ∷ ⟨0⟩) ∷ₕ_) (∷ₕ-ᵀ ⟨0⟩ I) ⟩
+ (1# ∷ ⟨0⟩) ∷ (⟨0⟩ ∷ₕ (I ᵀ)) ≡⟨ ≡.cong (λ h → (1# ∷ ⟨0⟩) ∷ (⟨0⟩ ∷ₕ h)) Iᵀ ⟩
+ (1# ∷ ⟨0⟩) ∷ (⟨0⟩ ∷ₕ I) ∎
+ where
+ open ≡-Reasoning
+
+opaque
+ unfolding mapRows _ᵀ _[_] [_]_ []ᵥ
+ -[-]ᵀ : (A : Matrix m p) (B : Matrix n m) → mapRows (A [_]) (B ᵀ) ≡ (mapRows ([_] B) A) ᵀ
+ -[-]ᵀ [] B = map-const (B ᵀ) []
+ -[-]ᵀ (A₀ ∷ A) B = begin
+ map (λ V → A₀ ∙ V ∷ map (_∙ V) A) (B ᵀ) ≡⟨ zipWith-map (A₀ ∙_) (A [_]) _∷_ (B ᵀ) ⟨
+ [ A₀ ] B ∷ₕ (map (A [_]) (B ᵀ)) ≡⟨ ≡.cong ([ A₀ ] B ∷ₕ_) (-[-]ᵀ A B) ⟩
+ [ A₀ ] B ∷ₕ ((map ([_] B) A) ᵀ) ∎
+ where
+ open ≡-Reasoning
+
+opaque
+ unfolding [_]_ _[_] _ᵀ []ₕ _∙_ _∷ₕ_ _⟨_⟩
+
+ []-∙ : (V : Vector m) (M : Matrix n m) (W : Vector n) → [ V ] M ∙ W ≈ V ∙ M [ W ]
+ []-∙ {n = n} [] M@[] W = begin
+ [ [] ] []ₕ ∙ W ≡⟨ ≡.cong (_∙ W) ([-]-[]ₕ []) ⟩
+ ⟨0⟩ ∙ W ≈⟨ ∙-zeroˡ W ⟩
+ 0# ∎
+ where
+ open ≈-Reasoning setoid
+ []-∙ (V₀ ∷ V) (M₀ ∷ M) W = begin
+ [ V₀ ∷ V ] (M₀ ∷ M) ∙ W ≡⟨ ≡.cong (_∙ W) (map-zipWith ((V₀ ∷ V) ∙_) _∷_ M₀ (M ᵀ)) ⟩
+ (zipWith (λ x y → V₀ * x + V ∙ y) M₀ (M ᵀ)) ∙ W ≡⟨ ≡.cong (_∙ W) (zipWith-map-map (V₀ *_) (V ∙_) _+_ M₀ (M ᵀ)) ⟩
+ (V₀ ⟨ M₀ ⟩ ⊕ [ V ] M) ∙ W ≈⟨ ∙-distribʳ (V₀ ⟨ M₀ ⟩) ([ V ] M) W ⟩
+ V₀ ⟨ M₀ ⟩ ∙ W + [ V ] M ∙ W ≈⟨ +-congʳ (*-∙ˡ V₀ M₀ W) ⟨
+ V₀ * (M₀ ∙ W) + ([ V ] M) ∙ W ≈⟨ +-congˡ ([]-∙ V M W) ⟩
+ (V₀ ∷ V) ∙ (M₀ ∷ M) [ W ] ∎
+ where
+ open ≈-Reasoning setoid
+
+opaque
+ unfolding Vector [_]_ I _∙_ ⟨0⟩ mapRows _ᵀ []ᵥ
+ [-]I : {n : ℕ} (V : Vector n) → [ V ] I ≊ V
+ [-]I {zero} [] = ≊.refl
+ [-]I {suc n} (x ∷ V) = begin
+ map ((x ∷ V) ∙_) ((1# ∷ ⟨0⟩) ∷ₕ (⟨0⟩ ∷ₕ I) ᵀ) ≡⟨ ≡.cong (λ h → map ((x ∷ V) ∙_) ((1# ∷ ⟨0⟩) ∷ₕ h)) (∷ₕ-ᵀ ⟨0⟩ I) ⟩
+ x * 1# + V ∙ ⟨0⟩ ∷ map ((x ∷ V) ∙_) (⟨0⟩ ∷ₕ I ᵀ) ≈⟨ +-congʳ (*-identityʳ x) PW.∷ ≊.refl ⟩
+ x + V ∙ ⟨0⟩ ∷ map ((x ∷ V) ∙_) (⟨0⟩ ∷ₕ I ᵀ) ≈⟨ +-congˡ (∙-zeroʳ V) PW.∷ ≊.refl ⟩
+ x + 0# ∷ map ((x ∷ V) ∙_) (⟨0⟩ ∷ₕ I ᵀ) ≈⟨ +-identityʳ x PW.∷ ≊.refl ⟩
+ x ∷ map ((x ∷ V) ∙_) (⟨0⟩ ∷ₕ I ᵀ) ≡⟨ ≡.cong (λ h → x ∷ map ((x ∷ V) ∙_) h) (zipWith-replicate₁ _∷_ 0# (I ᵀ)) ⟩
+ x ∷ map ((x ∷ V) ∙_) (map (0# ∷_) (I ᵀ)) ≡⟨ ≡.cong (x ∷_) (map-∘ ((x ∷ V) ∙_) (0# ∷_) (I ᵀ)) ⟨
+ x ∷ map (λ y → x * 0# + V ∙ y) (I ᵀ) ≈⟨ refl PW.∷ PW.map⁺ (λ ≊V → trans (+-congʳ (zeroʳ x)) (+-congˡ (∙-cong {v₁ = V} ≊.refl ≊V))) ≋.refl ⟩
+ x ∷ map (λ y → 0# + V ∙ y) (I ᵀ) ≈⟨ refl PW.∷ PW.map⁺ (λ ≊V → trans (+-identityˡ (V ∙ _)) (∙-cong {v₁ = V} ≊.refl ≊V)) ≋.refl ⟩
+ x ∷ map (V ∙_) (I ᵀ) ≈⟨ refl PW.∷ ([-]I V) ⟩
+ x ∷ V ∎
+ where
+ open ≈-Reasoning (Vectorₛ (suc n))
+
+opaque
+ unfolding _≊_ I _[_] _∙_ _≋_ _∷ₕ_ ⟨0⟩
+ I[-] : {n : ℕ} (V : Vector n) → I [ V ] ≊ V
+ I[-] {zero} [] = PW.[]
+ I[-] {suc n} (x ∷ V) = hd PW.∷ tl
+ where
+ hd : (1# ∷ ⟨0⟩) ∙ (x ∷ V) ≈ x
+ hd = begin
+ 1# * x + ⟨0⟩ ∙ V ≈⟨ +-congʳ (*-identityˡ x) ⟩
+ x + ⟨0⟩ ∙ V ≈⟨ +-congˡ (∙-zeroˡ V) ⟩
+ x + 0# ≈⟨ +-identityʳ x ⟩
+ x ∎
+ where
+ open ≈-Reasoning setoid
+ tl : map (_∙ (x ∷ V)) (⟨0⟩ ∷ₕ I) ≊ V
+ tl = begin
+ map (_∙ (x ∷ V)) (⟨0⟩ ∷ₕ I) ≡⟨ ≡.cong (map (_∙ (x ∷ V))) (zipWith-replicate₁ _∷_ 0# I) ⟩
+ map (_∙ (x ∷ V)) (map (0# ∷_) I) ≡⟨ map-∘ (_∙ (x ∷ V)) (0# ∷_) I ⟨
+ map (λ t → 0# * x + t ∙ V) I ≈⟨ PW.map⁺ (λ ≋X → trans (+-congʳ (zeroˡ x)) (+-congˡ (∙-cong ≋X ≊.refl))) {xs = I} ≋.refl ⟩
+ map (λ t → 0# + t ∙ V) I ≈⟨ PW.map⁺ (λ {t} ≋X → trans (+-identityˡ (t ∙ V)) (∙-cong ≋X ≊.refl)) {xs = I} ≋.refl ⟩
+ map (_∙ V) I ≈⟨ I[-] V ⟩
+ V ∎
+ where
+ open ≈-Reasoning (Vectorₛ n)
+
+opaque
+ unfolding mapRows _[_] _ᵀ _∷ₕ_ I
+ map--[-]-I : (M : Matrix n m) → mapRows (M [_]) I ≋ M ᵀ
+ map--[-]-I {n} {m} [] = ≋.reflexive (map-const I [])
+ map--[-]-I {n} {suc m} (M₀ ∷ M) = begin
+ map ((M₀ ∷ M) [_]) I ≡⟨⟩
+ map (λ V → M₀ ∙ V ∷ M [ V ]) I ≡⟨ zipWith-map (M₀ ∙_) (M [_]) _∷_ I ⟨
+ map (M₀ ∙_) I ∷ₕ (map (M [_]) I) ≈⟨ ∷ₕ-cong (≊.reflexive (≡.sym (≡.cong (map (M₀ ∙_)) Iᵀ))) (map--[-]-I M) ⟩
+ [ M₀ ] I ∷ₕ (M ᵀ) ≈⟨ ∷ₕ-cong ([-]I M₀) ≋.refl ⟩
+ M₀ ∷ₕ (M ᵀ) ∎
+ where
+ open ≈-Reasoning (Matrixₛ (suc m) n)
+
+opaque
+
+ unfolding [_]_
+
+ [-]--∥
+ : (V : Vector C)
+ (M : Matrix A C)
+ (N : Matrix B C)
+ → [ V ] (M ∥ N) ≡ ([ V ] M) ++ ([ V ] N)
+ [-]--∥ {C} {zero} V M N rewrite []ᵥ-! M = begin
+ [ V ] ([]ᵥ ∥ N) ≡⟨ ≡.cong ([ V ]_) ([]ᵥ-∥ N) ⟩
+ [ V ] N ≡⟨ ⟨⟩-++ ([ V ] N) ⟨
+ ⟨⟩ ++ ([ V ] N) ≡⟨ ≡.cong (_++ ([ V ] N)) ([-]-[]ᵥ V) ⟨
+ ([ V ] []ᵥ) ++ ([ V ] N) ∎
+ where
+ open ≡-Reasoning
+ [-]--∥ {C} {suc A} V M N
+ rewrite ≡.sym (head-∷-tailₕ M)
+ using M₀ ← headₕ M
+ using M ← tailₕ M = begin
+ [ V ] ((M₀ ∷ₕ M) ∥ N) ≡⟨ ≡.cong ([ V ]_) (∷ₕ-∥ M₀ M N) ⟨
+ [ V ] (M₀ ∷ₕ (M ∥ N)) ≡⟨ ≡.cong (map (V ∙_)) (∷ₕ-ᵀ M₀ (M ∥ N)) ⟩
+ V ∙ M₀ ∷ ([ V ] (M ∥ N)) ≡⟨ ≡.cong (V ∙ M₀ ∷_) ([-]--∥ V M N) ⟩
+ V ∙ M₀ ∷ (([ V ] M) ++ ([ V ] N)) ≡⟨⟩
+ (V ∙ M₀ ∷ map (V ∙_ ) (M ᵀ)) ++ ([ V ] N) ≡⟨ ≡.cong (λ h → map (V ∙_) h ++ ([ V ] N)) (∷ₕ-ᵀ M₀ M) ⟨
+ ([ V ] (M₀ ∷ₕ M)) ++ ([ V ] N) ∎
+ where
+ open ≡-Reasoning
+
+opaque
+
+ unfolding _++_ _∙_
+
+ ∙-++ : (W Y : Vector A) (X Z : Vector B) → (W ++ X) ∙ (Y ++ Z) ≈ W ∙ Y + X ∙ Z
+ ∙-++ [] [] X Z = sym (+-identityˡ (X ∙ Z))
+ ∙-++ (w ∷ W) (y ∷ Y) X Z = begin
+ w * y + (W ++ X) ∙ (Y ++ Z) ≈⟨ +-congˡ (∙-++ W Y X Z) ⟩
+ w * y + (W ∙ Y + X ∙ Z) ≈⟨ +-assoc _ _ _ ⟨
+ (w * y + W ∙ Y) + X ∙ Z ∎
+ where
+ open ≈-Reasoning setoid
+
+opaque
+
+ unfolding _⊕_ ⟨⟩ [_]_
+
+ [++]-≑
+ : (V : Vector B)
+ (W : Vector C)
+ (M : Matrix A B)
+ (N : Matrix A C)
+ → [ V ++ W ] (M ≑ N)
+ ≊ [ V ] M ⊕ [ W ] N
+ [++]-≑ {B} {C} {zero} V W M N
+ rewrite []ᵥ-! M
+ rewrite []ᵥ-! N = begin
+ [ V ++ W ] ([]ᵥ {B} ≑ []ᵥ) ≡⟨ ≡.cong ([ V ++ W ]_) []ᵥ-≑ ⟩
+ [ V ++ W ] []ᵥ ≡⟨ [-]-[]ᵥ (V ++ W) ⟩
+ ⟨⟩ ⊕ ⟨⟩ ≡⟨ ≡.cong₂ _⊕_ ([-]-[]ᵥ V) ([-]-[]ᵥ W) ⟨
+ [ V ] []ᵥ ⊕ [ W ] []ᵥ ∎
+ where
+ open ≈-Reasoning (Vectorₛ 0)
+ [++]-≑ {B} {C} {suc A} V W M N
+ rewrite ≡.sym (head-∷-tailₕ M)
+ rewrite ≡.sym (head-∷-tailₕ N)
+ using M₀ ← headₕ M
+ using M ← tailₕ M
+ using N₀ ← headₕ N
+ using N ← tailₕ N = begin
+ [ V ++ W ] ((M₀ ∷ₕ M) ≑ (N₀ ∷ₕ N)) ≡⟨ ≡.cong ([ V ++ W ]_) (∷ₕ-≑ M₀ N₀ M N) ⟨
+ [ V ++ W ] ((M₀ ++ N₀) ∷ₕ (M ≑ N)) ≡⟨ ≡.cong (map ((V ++ W) ∙_)) (∷ₕ-ᵀ (M₀ ++ N₀) (M ≑ N)) ⟩
+ (V ++ W) ∙ (M₀ ++ N₀) ∷ ([ V ++ W ] (M ≑ N)) ≈⟨ ∙-++ V M₀ W N₀ PW.∷ [++]-≑ V W M N ⟩
+ (V ∙ M₀ ∷ [ V ] M) ⊕ (W ∙ N₀ ∷ [ W ] N) ≡⟨ ≡.cong₂ (λ h₁ h₂ → map (V ∙_) h₁ ⊕ map (W ∙_) h₂) (∷ₕ-ᵀ M₀ M) (∷ₕ-ᵀ N₀ N) ⟨
+ ([ V ] (M₀ ∷ₕ M)) ⊕ ([ W ] (N₀ ∷ₕ N)) ∎
+ where
+ open ≈-Reasoning (Vectorₛ (suc A))
+opaque
+
+ unfolding []ₕ []ᵥ [_]_ ⟨0⟩ _∙_ _ᵀ
+
+ [⟨⟩]-[]ₕ : [ ⟨⟩ ] ([]ₕ {A}) ≡ ⟨0⟩ {A}
+ [⟨⟩]-[]ₕ {zero} = ≡.refl
+ [⟨⟩]-[]ₕ {suc A} = ≡.cong (0# ∷_) [⟨⟩]-[]ₕ
+
+opaque
+
+ unfolding Vector ⟨⟩ ⟨0⟩ []ᵥ [_]_ _ᵀ _∷ₕ_ 𝟎 _≊_
+
+ [-]-𝟎 : (V : Vector A) → [ V ] (𝟎 {B}) ≊ ⟨0⟩
+ [-]-𝟎 {A} {zero} V = ≊.reflexive (≡.cong (map (V ∙_)) 𝟎ᵀ)
+ [-]-𝟎 {A} {suc B} V = begin
+ map (V ∙_) (𝟎 ᵀ) ≡⟨ ≡.cong (map (V ∙_)) 𝟎ᵀ ⟩
+ V ∙ ⟨0⟩ ∷ map (V ∙_) 𝟎 ≡⟨ ≡.cong ((V ∙ ⟨0⟩ ∷_) ∘ map (V ∙_)) 𝟎ᵀ ⟨
+ V ∙ ⟨0⟩ ∷ [ V ] 𝟎 ≈⟨ ∙-zeroʳ V PW.∷ ([-]-𝟎 V) ⟩
+ 0# ∷ ⟨0⟩ ∎
+ where
+ open ≈-Reasoning (Vectorₛ (suc B))
+
+opaque
+
+ unfolding ⟨0⟩ ⟨⟩ [_]_
+
+ [⟨0⟩]- : (M : Matrix A B) → [ ⟨0⟩ ] M ≊ ⟨0⟩
+ [⟨0⟩]- {zero} M rewrite []ᵥ-! M = ≊.reflexive ([-]-[]ᵥ ⟨0⟩)
+ [⟨0⟩]- {suc A} M
+ rewrite ≡.sym (head-∷-tailₕ M)
+ using M₀ ← headₕ M
+ using M ← tailₕ M = begin
+ [ ⟨0⟩ ] (M₀ ∷ₕ M) ≡⟨ ≡.cong (map (⟨0⟩ ∙_)) (∷ₕ-ᵀ M₀ M) ⟩
+ ⟨0⟩ ∙ M₀ ∷ [ ⟨0⟩ ] M ≈⟨ ∙-zeroˡ M₀ PW.∷ [⟨0⟩]- M ⟩
+ 0# ∷ ⟨0⟩ ∎
+ where
+ open ≈-Reasoning (Vectorₛ _)
diff --git a/Data/Matrix/Vec.agda b/Data/Matrix/Vec.agda
new file mode 100644
index 0000000..e0312d4
--- /dev/null
+++ b/Data/Matrix/Vec.agda
@@ -0,0 +1,20 @@
+{-# OPTIONS --without-K --safe #-}
+
+module Data.Matrix.Vec where
+
+open import Relation.Binary.PropositionalEquality using (_≡_)
+open import Level using (Level)
+open import Data.Nat using (ℕ)
+open import Data.Vec using (Vec; replicate; zipWith)
+
+private
+ variable
+ a : Level
+ A : Set a
+ n m : ℕ
+
+open Vec
+
+transpose : Vec (Vec A n) m → Vec (Vec A m) n
+transpose [] = replicate _ []
+transpose (row ∷ mat) = zipWith _∷_ row (transpose mat)