aboutsummaryrefslogtreecommitdiff
path: root/Data/Matrix/Endofunctor.agda
blob: d33cdbe8cd87607d2113498897751d74f53d2e53 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
{-# OPTIONS --without-K --safe #-}

open import Data.Nat using ()
open import Level using (Level; _⊔_)

-- The endofunctor in setoids sending A to Matrix A n m for fixed n and m
module Data.Matrix.Endofunctor (n m : ) {c  : Level} where

open import Categories.Category.Instance.Setoids using (Setoids)
open import Categories.Functor using (Functor)
open import Data.Vec.Properties using (map-id; map-∘)
open import Data.Vec.Relation.Binary.Pointwise.Inductive using (map⁺)
open import Data.Vector.Core using (module ≊)
open import Data.Matrix.Core as Core using (Matrix; Matrixₛ; module ≋)
open import Function using (Func; _⟶ₛ_; _⟨$⟩_)
open import Function.Construct.Composition using () renaming (function to compose)
open import Function.Construct.Identity using () renaming (function to Id)
open import Relation.Binary using (Setoid)
open import Relation.Binary.PropositionalEquality as  using (_≡_)

open Func

import Data.Vector.Endofunctor as Vector
import Data.Vec as Vec

opaque
  unfolding Matrix
  map : {A B : Setoid c }  A ⟶ₛ B  Matrixₛ A n m ⟶ₛ Matrixₛ B n m
  map f .to = Vec.map (to (Vector.map n f))
  map f .cong = map⁺ (cong (Vector.map n f))

abstract opaque

  unfolding map

  identity
      : {A : Setoid c }
        {M : Matrix A n m}
        (open Core A using (_≋_))
       map (Id A) ⟨$⟩ M  M
  identity {A} {M} = ≋.trans A (map⁺ (≊.trans A (Vector.identity n)) (≋.refl A)) (≋.reflexive A (map-id M))

  homomorphism
      : {X Y Z : Setoid c }
        {f : X ⟶ₛ Y}
        {g : Y ⟶ₛ Z}
        {M : Matrix X n m}
        (open Core Z using (_≋_))
       map (compose f g) ⟨$⟩ M  map g ⟨$⟩ (map f ⟨$⟩ M)
  homomorphism {X} {_} {Z} {f} {g} {M} =
      ≋.trans
          Z
          (map⁺ (λ x≈y  ≊.trans Z (Vector.homomorphism n) (cong (Vector.map n g) (cong (Vector.map n f) x≈y))) (≋.refl X))
          (≋.reflexive Z (map-∘ (to (Vector.map n g)) (to (Vector.map n f)) M))

  F-resp-≈
      : {A B : Setoid c }
        {f g : A ⟶ₛ B}
       ({x : Setoid.Carrier A}  (B Setoid.≈ to f x) (to g x))
       {M : Matrix A n m}
        (open Core B using (_≋_))
       map f ⟨$⟩ M  map g ⟨$⟩ M
  F-resp-≈ {A} {B} {f} {g} f≈g {M} =
      ≋.trans
          B
          (map⁺ (λ x≈y  ≊.trans B (Vector.F-resp-≈ n f≈g) (cong (Vector.map n g) x≈y)) (≋.refl A))
          (map⁺ (cong (Vector.map n g)) (≋.refl A))
    where
      module B = Setoid B

-- only a true endofunctor when c ≤ ℓ
Mat : Functor (Setoids c ) (Setoids c (c  ))
Mat = record
    { F₀ = λ A  Matrixₛ A n m
    ; F₁ = map
    ; identity = identity
    ; homomorphism = homomorphism
    ; F-resp-≈ = F-resp-≈
    }