Mercurial > hg > Members > kono > Proof > category
changeset 792:5bee48f7c126
deduction theorem using category
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 21 Apr 2019 18:11:14 +0900 |
parents | 376c07159acf |
children | f37f11e1b871 |
files | deductive.agda |
diffstat | 1 files changed, 35 insertions(+), 25 deletions(-) [+] |
line wrap: on
line diff
--- a/deductive.agda Sun Apr 21 17:43:01 2019 +0900 +++ b/deductive.agda Sun Apr 21 18:11:14 2019 +0900 @@ -1,41 +1,51 @@ -module deductive (Atom : Set) where +open import Level +open import Category +module deductive {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) where -- Deduction Theorem --- positive logic ( deductive system based on graph ) - -data Obj : Set where - ⊤ : Obj - atom : Atom → Obj - _∧_ : Obj → Obj → Obj - _<=_ : Obj → Obj → Obj +-- positive logic -data Arrow : Obj → Obj → Set where - hom : (a b : Obj) → Arrow a b - id : (a : Obj ) → Arrow a a - _・_ : {a b c : Obj } → Arrow b c → Arrow a b → Arrow a c - ○ : {a : Obj } → Arrow a ⊤ - π : {a b : Obj } → Arrow ( a ∧ b ) a - π' : {a b : Obj } → Arrow ( a ∧ b ) b - <_,_> : {a b c : Obj } → Arrow c a → Arrow c b → Arrow c (a ∧ b) - ε : {a b : Obj } → Arrow ((a <= b) ∧ b ) a - _* : {a b c : Obj } → Arrow (c ∧ b ) a → Arrow c ( a <= b ) +record PositiveLogic {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) : Set ( c₁ ⊔ c₂ ⊔ ℓ ) where + field + ⊤ : Obj A + ○ : (a : Obj A ) → Hom A a ⊤ + _∧_ : Obj A → Obj A → Obj A + <_,_> : {a b c : Obj A } → Hom A c a → Hom A c b → Hom A c (a ∧ b) + π : {a b : Obj A } → Hom A (a ∧ b) a + π' : {a b : Obj A } → Hom A (a ∧ b) b + _<=_ : (a b : Obj A ) → Obj A + _* : {a b c : Obj A } → Hom A (a ∧ b) c → Hom A a (c <= b) + ε : {a b : Obj A } → Hom A ((a <= b ) ∧ b) a + +postulate L : PositiveLogic A + +⊤ = PositiveLogic.⊤ L +○ = PositiveLogic.○ L +_∧_ = PositiveLogic._∧_ L +<_,_> = PositiveLogic.<_,_> L +π = PositiveLogic.π L +π' = PositiveLogic.π' L +_<=_ = PositiveLogic._<=_ L +_* = PositiveLogic._* L +ε = PositiveLogic.ε L +_・_ = _[_o_] A -- every proof b → c with assumption a has following forms -data φ {a : Obj} ( x : Arrow ⊤ a ) : {b c : Obj} → Arrow b c → Set where - i : {b c : Obj} → φ x ( hom b c ) +data φ {a : Obj A } ( x : Hom A ⊤ a ) : {b c : Obj A } → Hom A b c → Set ( c₁ ⊔ c₂ ) where + i : {b c : Obj A} {k : Hom A b c } → φ x k ii : φ x {⊤} {a} x - iii : {b c' c'' : Obj } { f : Arrow b c' } { g : Arrow b c'' } (ψ : φ x f ) (χ : φ x g ) → φ x < f , g > - iv : {b c d : Obj } { f : Arrow d c } { g : Arrow b d } (ψ : φ x f ) (χ : φ x g ) → φ x ( f ・ g ) - v : {b c' c'' : Obj } { f : Arrow (b ∧ c') c'' } (ψ : φ x f ) → φ x ( f * ) + iii : {b c' c'' : Obj A } { f : Hom A b c' } { g : Hom A b c'' } (ψ : φ x f ) (χ : φ x g ) → φ x < f , g > + iv : {b c d : Obj A } { f : Hom A d c } { g : Hom A b d } (ψ : φ x f ) (χ : φ x g ) → φ x ( f ・ g ) + v : {b c' c'' : Obj A } { f : Hom A (b ∧ c') c'' } (ψ : φ x f ) → φ x ( f * ) -α : {a b c : Obj } → Arrow (( a ∧ b ) ∧ c ) ( a ∧ ( b ∧ c ) ) +α : {a b c : Obj A } → Hom A (( a ∧ b ) ∧ c ) ( a ∧ ( b ∧ c ) ) α = < π ・ π , < π' ・ π , π' > > -- genetate (a ∧ b) → c proof from proof b → c with assumption a -kx∈a : {a b c : Obj } → ( x : Arrow ⊤ a ) → {z : Arrow b c } → ( y : φ {a} x z ) → Arrow (a ∧ b) c +kx∈a : {a b c : Obj A } → ( x : Hom A ⊤ a ) → {z : Hom A b c } → ( y : φ {a} x z ) → Hom A (a ∧ b) c kx∈a x {k} i = k ・ π' kx∈a x ii = π kx∈a x (iii ψ χ ) = < kx∈a x ψ , kx∈a x χ >