Mercurial > hg > Members > kono > Proof > category
changeset 1059:e0819260ba18
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 20 Apr 2021 15:59:28 +0900 |
parents | 79e7e0367189 |
children | 2458af98786a |
files | src/Polynominal.agda |
diffstat | 1 files changed, 16 insertions(+), 5 deletions(-) [+] |
line wrap: on
line diff
--- a/src/Polynominal.agda Mon Apr 19 23:12:17 2021 +0900 +++ b/src/Polynominal.agda Tue Apr 20 15:59:28 2021 +0900 @@ -54,6 +54,12 @@ toφ : {a ⊤ b c : Obj A } → ( x∈a : Hom A ⊤ a ) → (z : Hom A b c ) → φ {a} x∈a z toφ {a} {⊤} {b} {c} x∈a z = i + -- arrow in A[x], equality in A[x] should be a modulo x, that is k x phi ≈ k x phi' + -- the smallest equivalence relation + -- + -- if we use equality on f as in A, Poly is ovioously Hom c b of a Category. + -- it is better to define A[x] as an extension of A as described before + record Poly (a c b : Obj A ) : Set (c₁ ⊔ c₂ ⊔ ℓ) where field x : Hom A 1 a @@ -66,6 +72,7 @@ -- For every polynominal ψ(x) : b → c in an indeterminate x : 1 → a over a cartesian or cartesian closed -- category A there is a unique arrow f : a ∧ b → c in A such that f ∙ < x ∙ ○ b , id1 A b > ≈ ψ(x). -- + -- equality assumption in uniq should be modulo-x, k x phi ≈ k x phi' record Functional-completeness {a b c : Obj A} ( p : Poly a c b ) : Set (c₁ ⊔ c₂ ⊔ ℓ) where x = Poly.x p @@ -81,7 +88,7 @@ field sl : Hom A a b g : Hom A 1 (b <= a) - g = (A [ A [ A [ sl o π ] o < id1 A _ , ○ a > ] o π' ] ) * + g = (A [ sl o π' ] ) * field isSelect : A [ A [ ε o < g , Poly.x φ > ] ≈ Poly.f φ ] isUnique : (f : Hom A 1 (b <= a) ) → A [ A [ ε o < f , Poly.x φ > ] ≈ Poly.f φ ] @@ -89,8 +96,10 @@ π-cong = IsCCC.π-cong isCCC *-cong = IsCCC.*-cong isCCC + distr-* = IsCCC.distr-* isCCC e2 = IsCCC.e2 isCCC + -- proof in p.59 Lambek functional-completeness : {a b c : Obj A} ( p : Poly a c b ) → Functional-completeness p functional-completeness {a} {b} {c} p = record { fun = k (Poly.x p) (Poly.phi p) @@ -152,7 +161,7 @@ -- -- f ∙ < x ∙ ○ b , id1 A b > ≈ f → f ≈ k x (phi p) -- - -- why k x {x ∙ ○ b} (iv ii i ) ≡ k x {x ∙ ○ b} i? + -- why k x {x ∙ ○ b} (iv ii i ) ≡ k x {x ∙ ○ b} i? Lambek p.60 -- if A is locally small, it is ≡-cong. postulate k-cong : {a b c : Obj A} → (x : Hom A 1 a) → (f g : Hom A b c ) → A [ f ≈ g ] → (fp : φ x {b} {c} f ) (gp : φ x {b} {c} g ) @@ -177,9 +186,11 @@ FC {a} {b} φ = record { sl = A [ k (Poly.x φ ) (Poly.phi φ) o < id1 A _ , ○ a > ] ; isSelect = begin - ε ∙ < (( ((k (Poly.x φ) (Poly.phi φ)∙ < id1 A _ , ○ a > ) ∙ π ) ∙ < id1 A a , ○ a > ) ∙ π') * , Poly.x φ > ≈↑⟨ cdr (π-cong (*-cong (car assoc)) refl-hom) ⟩ - ε ∙ < (((k (Poly.x φ) (Poly.phi φ) ∙ < id1 A _ , ○ a >) ∙ (π ∙ (< id1 A _ , ○ a >))) ∙ π' ) * , Poly.x φ > ≈⟨ {!!} ⟩ - ε ∙ < ( (k (Poly.x φ) (Poly.phi φ)∙ < id1 A _ , ○ a > ) ∙ (id1 A _ ∙ π' ) ) * , Poly.x φ > ≈⟨ {!!} ⟩ + ε ∙ < ((k (Poly.x φ) (Poly.phi φ)∙ < id1 A _ , ○ a > ) ∙ π') * , Poly.x φ > ≈⟨ {!!} ⟩ + ε ∙ < (k (Poly.x φ) (Poly.phi φ)∙ (< id1 A _ , ○ a > ∙ π')) * , Poly.x φ > ≈⟨ {!!} ⟩ + ε ∙ ( < (k (Poly.x φ ) (Poly.phi φ) * ) ∙ (Poly.x φ ∙ ○ 1) , id1 A 1 > ) ≈⟨ {!!} ⟩ + ε ∙ ( < (k (Poly.x φ ) (Poly.phi φ) * ) ∙ (π ∙ < Poly.x φ ∙ ○ 1 , id1 A 1 > ) , id1 A 1 > ) ≈⟨ {!!} ⟩ + ε ∙ ( < ((k (Poly.x φ ) (Poly.phi φ) * ) ∙ π ) ∙ < Poly.x φ ∙ ○ 1 , id1 A 1 > , π' ∙ < Poly.x φ ∙ ○ 1 , id1 A 1 > > ) ≈⟨ {!!} ⟩ ε ∙ ( < ((k (Poly.x φ ) (Poly.phi φ) * ) ∙ π ) , π' > ∙ < Poly.x φ ∙ ○ 1 , id1 A 1 > ) ≈⟨ assoc ⟩ (ε ∙ < ((k (Poly.x φ ) (Poly.phi φ) * ) ∙ π ) , π' > ) ∙ < Poly.x φ ∙ ○ 1 , id1 A 1 > ≈⟨ car ( IsCCC.e4a isCCC ) ⟩ k (Poly.x φ ) (Poly.phi φ) ∙ < Poly.x φ ∙ ○ 1 , id1 A 1 > ≈⟨ fc0 φ ⟩