Mercurial > hg > Members > kono > Proof > automaton
changeset 333:c19d3af30394
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 12 Mar 2023 23:17:12 +0900 |
parents | 6f3636fbc481 |
children | 1466e18c8180 |
files | automaton-in-agda/src/nat.agda |
diffstat | 1 files changed, 21 insertions(+), 14 deletions(-) [+] |
line wrap: on
line diff
--- a/automaton-in-agda/src/nat.agda Sun Mar 12 22:49:59 2023 +0900 +++ b/automaton-in-agda/src/nat.agda Sun Mar 12 23:17:12 2023 +0900 @@ -282,7 +282,7 @@ y-x<y : {x y : ℕ } → 0 < x → 0 < y → y - x < y y-x<y {x} {y} 0<x 0<y with <-cmp x (suc y) -... | tri< a ¬b ¬c = +-cancelʳ-< x (y - x) y ( begin +... | tri< a ¬b ¬c = +-cancelʳ-< (y - x) _ ( begin suc ((y - x) + x) ≡⟨ cong suc (minus+n {y} {x} a ) ⟩ suc y ≡⟨ +-comm 1 _ ⟩ y + suc 0 ≤⟨ +-mono-≤ ≤-refl 0<x ⟩ @@ -424,6 +424,13 @@ m*1=m {zero} = refl m*1=m {suc m} = cong suc m*1=m ++-cancel-1 : (x y z : ℕ ) → x + y ≡ x + z → y ≡ z ++-cancel-1 zero y z eq = eq ++-cancel-1 (suc x) y z eq = +-cancel-1 x y z (cong pred eq ) + ++-cancel-0 : (x y z : ℕ ) → y + x ≡ z + x → y ≡ z ++-cancel-0 x y z eq = +-cancel-1 x y z (trans (+-comm x y) (trans eq (sym (+-comm x z)) )) + *-cancel-left : {x y z : ℕ } → x > 0 → x * y ≡ x * z → y ≡ z *-cancel-left {suc x} {zero} {zero} lt eq = refl *-cancel-left {suc x} {zero} {suc z} lt eq = ⊥-elim ( nat-≡< eq (s≤s (begin @@ -435,19 +442,19 @@ zero ≤⟨ z≤n ⟩ _ ∎ ))) where open ≤-Reasoning *-cancel-left {suc x} {suc y} {suc z} lt eq with cong pred eq -... | eq1 = cong suc (*-cancel-left {suc x} {y} {z} lt ( proj₂ +-cancel-≡ x _ _ (begin - y + x * y + x ≡⟨ +-assoc y _ _ ⟩ - y + (x * y + x) ≡⟨ cong (λ k → y + (k + x)) (*-comm x _) ⟩ - y + (y * x + x) ≡⟨ cong (_+_ y) (+-comm _ x) ⟩ - y + (x + y * x ) ≡⟨ refl ⟩ - y + suc y * x ≡⟨ cong (_+_ y) (*-comm (suc y) _) ⟩ - y + x * suc y ≡⟨ eq1 ⟩ - z + x * suc z ≡⟨ refl ⟩ - _ ≡⟨ sym ( cong (_+_ z) (*-comm (suc z) _) ) ⟩ - _ ≡⟨ sym ( cong (_+_ z) (+-comm _ x)) ⟩ - z + (z * x + x) ≡⟨ sym ( cong (λ k → z + (k + x)) (*-comm x _) ) ⟩ - z + (x * z + x) ≡⟨ sym ( +-assoc z _ _) ⟩ - z + x * z + x ∎ ))) where open ≡-Reasoning +... | eq1 = cong suc (*-cancel-left {suc x} {y} {z} lt (+-cancel-0 x _ _ (begin + y + x * y + x ≡⟨ +-assoc y _ _ ⟩ + y + (x * y + x) ≡⟨ cong (λ k → y + (k + x)) (*-comm x _) ⟩ + y + (y * x + x) ≡⟨ cong (_+_ y) (+-comm _ x) ⟩ + y + (x + y * x ) ≡⟨ refl ⟩ + y + suc y * x ≡⟨ cong (_+_ y) (*-comm (suc y) _) ⟩ + y + x * suc y ≡⟨ eq1 ⟩ + z + x * suc z ≡⟨ refl ⟩ + _ ≡⟨ sym ( cong (_+_ z) (*-comm (suc z) _) ) ⟩ + _ ≡⟨ sym ( cong (_+_ z) (+-comm _ x)) ⟩ + z + (z * x + x) ≡⟨ sym ( cong (λ k → z + (k + x)) (*-comm x _) ) ⟩ + z + (x * z + x) ≡⟨ sym ( +-assoc z _ _) ⟩ + z + x * z + x ∎ ))) where open ≡-Reasoning record Finduction {n m : Level} (P : Set n ) (Q : P → Set m ) (f : P → ℕ) : Set (n Level.⊔ m) where field