Mercurial > hg > Members > kono > Proof > FirstOrder
changeset 0:aeccd3123e03
First order logic in Agda
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Thu, 13 Aug 2020 08:08:44 +0900 |
parents | |
children | a087d3911b07 |
files | first-order.agda |
diffstat | 1 files changed, 157 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/first-order.agda Thu Aug 13 08:08:44 2020 +0900 @@ -0,0 +1,157 @@ +module first-order where +open import Data.List hiding (all) +open import Data.Bool +open import Relation.Binary.PropositionalEquality hiding ( [_] ) + +data Var : Set where + X : Var + Y : Var + Z : Var + +data Expr : Set where + a : Expr + b : Expr + c : Expr + var : Var → Expr + f[_] : List Expr → Expr + g[_] : List Expr → Expr + h[_] : List Expr → Expr + +data Form : Set where + p : Form + q : Form + r : Form + p[_] : List Expr → Form + q[_] : List Expr → Form + r[_] : List Expr → Form + _/\_ : Form → Form → Form + _\/_ : Form → Form → Form + ¬ : Form → Form + all_=>_ : Var → Form → Form + ∃_=>_ : Var → Form → Form + +test002 : Form +test002 = ¬ ( p /\ ( all X => p[ f[ var X ∷ [] ] ∷ [] ] )) + +open import Relation.Nullary hiding (¬_) +-- open import Relation.Binary +open import Relation.Binary.PropositionalEquality + +subst-expr : List Expr → Var → (value : Expr ) → List Expr +subst-expr [] n v = [] +subst-expr (var X ∷ y) X v = v ∷ subst-expr y X v +subst-expr (var Y ∷ y) Y v = v ∷ subst-expr y X v +subst-expr (var Z ∷ y) Z v = v ∷ subst-expr y X v +subst-expr (x ∷ y) n v = x ∷ subst-expr y X v + +subst-prop : (orig : Form ) → Var → (value : Expr ) → Form +subst-prop p[ x ] n v = p[ subst-expr x n v ] +subst-prop q[ x ] n v = q[ subst-expr x n v ] +subst-prop r[ x ] n v = r[ subst-expr x n v ] +subst-prop (x /\ y) n v = subst-prop x n v /\ subst-prop x n v +subst-prop (x \/ y) n v = subst-prop x n v \/ subst-prop x n v +subst-prop (¬ x) n v = ¬ (subst-prop x n v ) +subst-prop (all x => y) n v = all x => subst-prop y n v +subst-prop (∃ x => y) n v = ∃ x => subst-prop y n v +subst-prop x n v = x + +{-# TERMINATING #-} +M0 : Form → Bool +M0 p = false +M0 q = true +M0 r = false +M0 p[ a ∷ [] ] = true +M0 (x /\ y) = M0 x ∧ M0 y +M0 (x \/ y) = M0 x ∨ M0 y +M0 (¬ f) = not (M0 f) +M0 (all x => f) = M0 ( subst-prop f x a ) ∧ M0 ( subst-prop f x b ) ∧ M0 ( subst-prop f x c ) +M0 (∃ x => f) = M0 ( subst-prop f x a ) ∨ M0 ( subst-prop f x b ) ∨ M0 ( subst-prop f x c ) +M0 _ = false + +test003 : Bool +test003 = M0 ( ∃ X => p[ var X ∷ [] ] ) + +_=n?_ : (x y : List Expr )→ Dec ( x ≡ y ) +_=?_ : (x y : Expr )→ Dec ( x ≡ y ) +a =? a = yes refl +a =? b = no (λ ()) +a =? c = no (λ ()) +a =? var x = no (λ ()) +a =? f[ x ] = no (λ ()) +a =? g[ x ] = no (λ ()) +a =? h[ x ] = no (λ ()) +b =? b = yes refl +b =? a = no (λ ()) +b =? c = no (λ ()) +b =? var x = no (λ ()) +b =? f[ x ] = no (λ ()) +b =? g[ x ] = no (λ ()) +b =? h[ x ] = no (λ ()) +c =? c = yes refl +c =? a = no (λ ()) +c =? b = no (λ ()) +c =? var x = no (λ ()) +c =? f[ x ] = no (λ ()) +c =? g[ x ] = no (λ ()) +c =? h[ x ] = no (λ ()) +var X =? var X = yes refl +var X =? var Y = no (λ ()) +var X =? var Z = no (λ ()) +var Y =? var X = no (λ ()) +var Y =? var Y = yes refl +var Y =? var Z = no (λ ()) +var Z =? var X = no (λ ()) +var Z =? var Y = no (λ ()) +var Z =? var Z = yes refl +var x =? a = no (λ ()) +var x =? b = no (λ ()) +var x =? c = no (λ ()) +var x =? f[ x₁ ] = no (λ ()) +var x =? g[ x₁ ] = no (λ ()) +var x =? h[ x₁ ] = no (λ ()) +f[ x ] =? a = no (λ ()) +f[ x ] =? b = no (λ ()) +f[ x ] =? c = no (λ ()) +f[ x ] =? var x₁ = no (λ ()) +f[ x ] =? g[ x₁ ] = no (λ ()) +f[ x ] =? h[ x₁ ] = no (λ ()) +f[ x ] =? f[ y ] with x =n? y +... | yes eq = yes ( cong (λ k → f[ k ] ) eq ) +... | no ¬p = no (λ eq → ¬p ( lemma eq )) where + lemma : f[ x ] ≡ f[ y ] → x ≡ y + lemma refl = refl +g[ x ] =? a = no (λ ()) +g[ x ] =? b = no (λ ()) +g[ x ] =? c = no (λ ()) +g[ x ] =? var x₁ = no (λ ()) +g[ x ] =? f[ x₁ ] = no (λ ()) +g[ x ] =? h[ x₁ ] = no (λ ()) +g[ x ] =? g[ y ] with x =n? y +... | yes eq = yes ( cong (λ k → g[ k ] ) eq ) +... | no ¬p = no (λ eq → ¬p ( lemma eq )) where + lemma : g[ x ] ≡ g[ y ] → x ≡ y + lemma refl = refl +h[ x ] =? a = no (λ ()) +h[ x ] =? b = no (λ ()) +h[ x ] =? c = no (λ ()) +h[ x ] =? var x₁ = no (λ ()) +h[ x ] =? f[ x₁ ] = no (λ ()) +h[ x ] =? g[ x₁ ] = no (λ ()) +h[ x ] =? h[ y ] with x =n? y +... | yes eq = yes ( cong (λ k → h[ k ] ) eq ) +... | no ¬p = no (λ eq → ¬p ( lemma eq )) where + lemma : h[ x ] ≡ h[ y ] → x ≡ y + lemma refl = refl +[] =n? [] = yes refl +[] =n? (x ∷ y) = no (λ ()) +(x ∷ x₁) =n? [] = no (λ ()) +(x0 ∷ t0) =n? (x1 ∷ t1) with x0 =? x1 +... | no ¬p = no (λ eq → ¬p (lemma eq) ) where + lemma : x0 ∷ t0 ≡ x1 ∷ t1 → x0 ≡ x1 + lemma refl = refl +... | yes eq with t0 =n? t1 +... | yes eql = yes (cong₂ (λ j k → j ∷ k ) eq eql) +... | no ¬p = no (λ eq → ¬p ( lemma eq) ) where + lemma : x0 ∷ t0 ≡ x1 ∷ t1 → t0 ≡ t1 + lemma refl = refl +