{-# OPTIONS --allow-unsolved-metas #-} module nat where open import Data.Nat open import Data.Nat.Properties open import Data.Empty open import Relation.Nullary open import Relation.Binary.PropositionalEquality open import Relation.Binary.Core open import Relation.Binary.Definitions open import logic nat-<> : { x y : ℕ } → x < y → y < x → ⊥ nat-<> (s≤s x x : { x y : ℕ } → x ≤ y → y < x → ⊥ nat-≤> (s≤s x x→¬< : {x y : ℕ } → (x < y ) → ¬ ( y < x ) >→¬< (s≤s x→¬< x y → minus x y + y ≡ x minus+n {x} {zero} _ = trans (sym (+-comm zero _ )) refl minus+n {zero} {suc y} (s≤s ()) minus+n {suc x} {suc y} (s≤s lt) = begin minus (suc x) (suc y) + suc y ≡⟨ +-comm _ (suc y) ⟩ suc y + minus x y ≡⟨ cong ( λ k → suc k ) ( begin y + minus x y ≡⟨ +-comm y _ ⟩ minus x y + y ≡⟨ minus+n {x} {y} lt ⟩ x ∎ ) ⟩ suc x ∎ where open ≡-Reasoning sn-m=sn-m : {m n : ℕ } → m ≤ n → suc n - m ≡ suc ( n - m ) sn-m=sn-m {0} {n} z≤n = refl sn-m=sn-m {suc m} {suc n} (s≤s m0 : {x y : ℕ } → x < y → 0 < minus y x minus>0 {zero} {suc _} (s≤s z≤n) = s≤s z≤n minus>0 {suc x} {suc y} (s≤s lt) = minus>0 {x} {y} lt distr-minus-* : {x y z : ℕ } → (minus x y) * z ≡ minus (x * z) (y * z) distr-minus-* {x} {zero} {z} = refl distr-minus-* {x} {suc y} {z} with <-cmp x y distr-minus-* {x} {suc y} {z} | tri< a ¬b ¬c = begin minus x (suc y) * z ≡⟨ cong (λ k → k * z ) (minus<=0 {x} {suc y} (x ¬a ¬b c = +m= {_} {_} {suc y * z} ( begin minus x (suc y) * z + suc y * z ≡⟨ sym (proj₂ *-distrib-+ z (minus x (suc y) ) _) ⟩ ( minus x (suc y) + suc y ) * z ≡⟨ cong (λ k → k * z) (minus+n {x} {suc y} (s≤s c)) ⟩ x * z ≡⟨ sym (minus+n {x * z} {suc y * z} (s≤s (lt c))) ⟩ minus (x * z) (suc y * z) + suc y * z ∎ ) where open ≡-Reasoning lt : {x y z : ℕ } → suc y ≤ x → z + y * z ≤ x * z lt {x} {y} {z} le = *≤ le minus- : {x y z : ℕ } → suc x > z + y → minus (minus x y) z ≡ minus x (y + z) minus- {x} {y} {z} gt = +m= {_} {_} {z} ( begin minus (minus x y) z + z ≡⟨ minus+n {_} {z} lemma ⟩ minus x y ≡⟨ +m= {_} {_} {y} ( begin minus x y + y ≡⟨ minus+n {_} {y} lemma1 ⟩ x ≡⟨ sym ( minus+n {_} {z + y} gt ) ⟩ minus x (z + y) + (z + y) ≡⟨ sym ( +-assoc (minus x (z + y)) _ _ ) ⟩ minus x (z + y) + z + y ∎ ) ⟩ minus x (z + y) + z ≡⟨ cong (λ k → minus x k + z ) (+-comm _ y ) ⟩ minus x (y + z) + z ∎ ) where open ≡-Reasoning lemma1 : suc x > y lemma1 = x+y z lemma = <-minus {_} {_} {y} ( subst ( λ x → z + y < suc x ) (sym (minus+n {x} {y} lemma1 )) gt ) minus-* : {M k n : ℕ } → n < k → minus k (suc n) * M ≡ minus (minus k n * M ) M minus-* {zero} {k} {n} lt = begin minus k (suc n) * zero ≡⟨ *-comm (minus k (suc n)) zero ⟩ zero * minus k (suc n) ≡⟨⟩ 0 * minus k n ≡⟨ *-comm 0 (minus k n) ⟩ minus (minus k n * 0 ) 0 ∎ where open ≡-Reasoning minus-* {suc m} {k} {n} lt with <-cmp k 1 minus-* {suc m} {.0} {zero} lt | tri< (s≤s z≤n) ¬b ¬c = refl minus-* {suc m} {.0} {suc n} lt | tri< (s≤s z≤n) ¬b ¬c = refl minus-* {suc zero} {.1} {zero} lt | tri≈ ¬a refl ¬c = refl minus-* {suc (suc m)} {.1} {zero} lt | tri≈ ¬a refl ¬c = minus-* {suc m} {1} {zero} lt minus-* {suc m} {.1} {suc n} (s≤s ()) | tri≈ ¬a refl ¬c minus-* {suc m} {k} {n} lt | tri> ¬a ¬b c = begin minus k (suc n) * M ≡⟨ distr-minus-* {k} {suc n} {M} ⟩ minus (k * M ) ((suc n) * M) ≡⟨⟩ minus (k * M ) (M + n * M ) ≡⟨ cong (λ x → minus (k * M) x) (+-comm M _ ) ⟩ minus (k * M ) ((n * M) + M ) ≡⟨ sym ( minus- {k * M} {n * M} (lemma lt) ) ⟩ minus (minus (k * M ) (n * M)) M ≡⟨ cong (λ x → minus x M ) ( sym ( distr-minus-* {k} {n} )) ⟩ minus (minus k n * M ) M ∎ where M = suc m lemma : {n k m : ℕ } → n < k → suc (k * suc m) > suc m + n * suc m lemma {zero} {suc k} {m} (s≤s lt) = s≤s (s≤s (subst (λ x → x ≤ m + k * suc m) (+-comm 0 _ ) x≤x+y )) lemma {suc n} {suc k} {m} lt = begin suc (suc m + suc n * suc m) ≡⟨⟩ suc ( suc (suc n) * suc m) ≤⟨ ≤-plus-0 {_} {_} {1} (*≤ lt ) ⟩ suc (suc k * suc m) ∎ where open ≤-Reasoning open ≡-Reasoning