changeset 12:247ce3e67b5f

add utilitites
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sat, 15 Dec 2018 17:24:35 +0900
parents f34066c435cd
children 575b849cab1a
files utilities.agda
diffstat 1 files changed, 154 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/utilities.agda	Sat Dec 15 17:24:35 2018 +0900
@@ -0,0 +1,154 @@
+module utilities where
+
+open import Function
+open import Data.Nat
+open import Data.Bool hiding ( _≟_ )
+open import Level renaming ( suc to succ ; zero to Zero )
+open import Relation.Nullary using (¬_; Dec; yes; no)
+open import Relation.Binary.PropositionalEquality
+
+
+record _/\_ {n : Level } (a : Set n) (b : Set n): Set n where
+  field
+    pi1 : a
+    pi2 : b
+
+open  _/\_
+
+_-_ : ℕ → ℕ → ℕ 
+x - zero  = x
+zero - _  = zero
+(suc x) - (suc y)  = x - y
+
++zero : { y : ℕ } → y + zero  ≡ y
++zero {zero} = refl
++zero {suc y} = cong ( λ x → suc x ) ( +zero {y} )
+
+
++-sym : { x y : ℕ } → x + y ≡ y + x
++-sym {zero} {zero} = refl
++-sym {zero} {suc y} = let open ≡-Reasoning  in
+          begin
+            zero + suc y 
+          ≡⟨⟩
+            suc y
+          ≡⟨ sym +zero ⟩
+            suc y + zero
+          ∎
++-sym {suc x} {zero} =  let open ≡-Reasoning  in
+          begin
+            suc x + zero
+          ≡⟨ +zero  ⟩
+            suc x
+          ≡⟨⟩
+            zero + suc x
+          ∎
++-sym {suc x} {suc y} = cong ( λ z → suc z ) (  let open ≡-Reasoning  in
+          begin
+            x + suc y
+          ≡⟨ +-sym {x} {suc y} ⟩
+            suc (y + x)
+          ≡⟨ cong ( λ z → suc z )  (+-sym {y} {x}) ⟩
+            suc (x + y)
+          ≡⟨ sym ( +-sym {y} {suc x}) ⟩
+            y + suc x
+          ∎ )
+
+minus-plus : { x y : ℕ } → (suc x - 1) + (y + 1) ≡ suc x + y
+minus-plus {zero} {y} = +-sym {y} {1}
+minus-plus {suc x} {y} =  cong ( λ z → suc z ) (minus-plus {x} {y})
+
++1≡suc : { x : ℕ } → x + 1 ≡ suc x
++1≡suc {zero} = refl
++1≡suc {suc x} = cong ( λ z → suc z ) ( +1≡suc {x} )
+
+lt : ℕ → ℕ → Bool
+lt x y with (suc x ) ≤? y
+lt x y | yes p = true
+lt x y | no ¬p = false
+
+predℕ : {n :  ℕ } → lt 0 n ≡ true  →  ℕ
+predℕ {zero} ()
+predℕ {suc n} refl = n
+
+predℕ+1=n : {n :  ℕ } → (less : lt 0 n ≡ true ) → (predℕ less) + 1 ≡ n
+predℕ+1=n {zero} ()
+predℕ+1=n {suc n} refl = +1≡suc
+
+suc-predℕ=n : {n :  ℕ } → (less : lt 0 n ≡ true ) → suc (predℕ less) ≡ n
+suc-predℕ=n {zero} ()
+suc-predℕ=n {suc n} refl = refl
+
+Equal : ℕ → ℕ → Bool
+Equal x y with x ≟ y
+Equal x y | yes p = true
+Equal x y | no ¬p = false
+
+_⇒_ : Bool → Bool → Bool
+false  ⇒  _ = true
+true  ⇒  true = true
+true  ⇒  false = false
+
+⇒t : {x : Bool} → x  ⇒ true  ≡ true
+⇒t {x} with x
+⇒t {x} | false = refl
+⇒t {x} | true = refl
+
+f⇒ : {x : Bool} → false  ⇒ x  ≡ true
+f⇒ {x} with x
+f⇒ {x} | false = refl
+f⇒ {x} | true = refl
+
+∧-pi1 : { x y : Bool } → x  ∧  y  ≡ true  → x  ≡ true
+∧-pi1 {x} {y} eq with x | y | eq
+∧-pi1 {x} {y} eq | false | b | ()
+∧-pi1 {x} {y} eq | true | false | ()
+∧-pi1 {x} {y} eq | true | true | refl = refl
+
+∧-pi2 : { x y : Bool } →  x  ∧  y  ≡ true  → y  ≡ true
+∧-pi2 {x} {y} eq with x | y | eq
+∧-pi2 {x} {y} eq | false | b | ()
+∧-pi2 {x} {y} eq | true | false | ()
+∧-pi2 {x} {y} eq | true | true | refl = refl
+
+∧true : { x : Bool } →  x  ∧  true  ≡ x
+∧true {x} with x
+∧true {x} | false = refl
+∧true {x} | true = refl
+
+true∧ : { x : Bool } →  true  ∧  x  ≡ x
+true∧ {x} with x
+true∧ {x} | false = refl
+true∧ {x} | true = refl
+bool-case : ( x : Bool ) { p : Set } → ( x ≡ true  → p ) → ( x ≡ false  → p ) → p
+bool-case x T F with x
+bool-case x T F | false = F refl
+bool-case x T F | true = T refl
+
+impl⇒ :  {x y : Bool} → (x  ≡ true → y  ≡ true ) → x  ⇒ y  ≡ true
+impl⇒ {x} {y} p = bool-case x (λ x=t →   let open ≡-Reasoning  in
+          begin
+            x  ⇒ y
+          ≡⟨  cong ( λ z → x  ⇒ z ) (p x=t ) ⟩
+            x  ⇒  true
+          ≡⟨ ⇒t ⟩
+            true
+          ∎
+    ) ( λ x=f →  let open ≡-Reasoning  in
+          begin
+            x  ⇒  y
+          ≡⟨  cong ( λ z → z  ⇒  y ) x=f ⟩
+            true
+          ∎
+  )
+ 
+Equal→≡ : { x y : ℕ } →  Equal x y ≡ true → x ≡ y
+Equal→≡ {x} {y} eq with x ≟ y
+Equal→≡ {x} {y} refl | yes refl = refl
+Equal→≡ {x} {y} () | no ¬p 
+
+Equal+1 : { x y : ℕ } →  Equal x y ≡ Equal (suc x) (suc y)
+Equal+1 {x} {y} with  x ≟ y
+Equal+1 {x} {.x} | yes refl = refl
+Equal+1 {x} {y} | no ¬p = refl
+