mirror of
https://github.com/Smaug123/agdaproofs
synced 2025-10-11 06:38:39 +00:00
Hide more stuff (#124)
This commit is contained in:
Patrick Stevens
GitHub
@@ -11,11 +11,12 @@ open import Semirings.Definition
|
||||
|
||||
module Numbers.BinaryNaturals.Order where
|
||||
|
||||
data Compare : Set where
|
||||
Equal : Compare
|
||||
FirstLess : Compare
|
||||
FirstGreater : Compare
|
||||
data Compare : Set where
|
||||
Equal : Compare
|
||||
FirstLess : Compare
|
||||
FirstGreater : Compare
|
||||
|
||||
private
|
||||
badCompare : Equal ≡ FirstLess → False
|
||||
badCompare ()
|
||||
|
||||
@@ -25,12 +26,13 @@ module Numbers.BinaryNaturals.Order where
|
||||
badCompare'' : FirstLess ≡ FirstGreater → False
|
||||
badCompare'' ()
|
||||
|
||||
_<BInherited_ : BinNat → BinNat → Compare
|
||||
a <BInherited b with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
(a <BInherited b) | inl (inl x) = FirstLess
|
||||
(a <BInherited b) | inl (inr x) = FirstGreater
|
||||
(a <BInherited b) | inr x = Equal
|
||||
_<BInherited_ : BinNat → BinNat → Compare
|
||||
a <BInherited b with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
(a <BInherited b) | inl (inl x) = FirstLess
|
||||
(a <BInherited b) | inl (inr x) = FirstGreater
|
||||
(a <BInherited b) | inr x = Equal
|
||||
|
||||
private
|
||||
go<B : Compare → BinNat → BinNat → Compare
|
||||
go<B Equal [] [] = Equal
|
||||
go<B Equal [] (zero :: b) = go<B Equal [] b
|
||||
@@ -58,9 +60,10 @@ module Numbers.BinaryNaturals.Order where
|
||||
go<B FirstLess (one :: a) (zero :: b) = go<B FirstGreater a b
|
||||
go<B FirstLess (one :: a) (one :: b) = go<B FirstLess a b
|
||||
|
||||
_<B_ : BinNat → BinNat → Compare
|
||||
a <B b = go<B Equal a b
|
||||
_<B_ : BinNat → BinNat → Compare
|
||||
a <B b = go<B Equal a b
|
||||
|
||||
private
|
||||
lemma1 : {s : Compare} → (n : BinNat) → go<B s n n ≡ s
|
||||
lemma1 {Equal} [] = refl
|
||||
lemma1 {Equal} (zero :: n) = lemma1 n
|
||||
@@ -304,73 +307,73 @@ module Numbers.BinaryNaturals.Order where
|
||||
chopDouble a b one | inr a=b | inl (inl a<b) rewrite a=b = exFalso (TotalOrder.irreflexive (ℕTotalOrder) a<b)
|
||||
chopDouble a b zero | inr a=b | inl (inr b<a) rewrite a=b = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
||||
chopDouble a b one | inr a=b | inl (inr b<a) rewrite a=b = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
||||
chopDouble a b i | inr a=b | inr x = refl
|
||||
chopDouble a b _ | inr a=b | inr x = refl
|
||||
|
||||
succNotLess : {n : ℕ} → succ n <N n → False
|
||||
succNotLess {succ n} (le x proof) = succNotLess {n} (le x (succInjective (transitivity (applyEquality succ (transitivity (Semiring.commutative ℕSemiring (succ x) (succ n)) (transitivity (applyEquality succ (transitivity (Semiring.commutative ℕSemiring n (succ x)) (applyEquality succ (Semiring.commutative ℕSemiring x n)))) (Semiring.commutative ℕSemiring (succ (succ n)) x)))) proof)))
|
||||
|
||||
<BIsInherited : (a b : BinNat) → a <BInherited b ≡ a <B b
|
||||
<BIsInherited [] b with TotalOrder.totality ℕTotalOrder 0 (binNatToN b)
|
||||
<BIsInherited [] b | inl (inl x) with inspect (binNatToN b)
|
||||
<BIsInherited [] b | inl (inl x) | 0 with≡ pr rewrite binNatToNZero b pr | pr = exFalso (TotalOrder.irreflexive (ℕTotalOrder) x)
|
||||
<BIsInherited [] b | inl (inl x) | (succ bl) with≡ pr rewrite pr = equalityCommutative (zeroLess b λ p → zeroNotSucc bl b p pr)
|
||||
<BIsInherited [] b | inr 0=b rewrite canonicalSecond [] b Equal | binNatToNZero b (equalityCommutative 0=b) = refl
|
||||
<BIsInherited (a :: as) [] with TotalOrder.totality ℕTotalOrder (binNatToN (a :: as)) 0
|
||||
<BIsInherited (a :: as) [] | inl (inr x) with inspect (binNatToN (a :: as))
|
||||
<BIsInherited (a :: as) [] | inl (inr x) | zero with≡ pr rewrite binNatToNZero (a :: as) pr | pr = exFalso (TotalOrder.irreflexive (ℕTotalOrder) x)
|
||||
<BIsInherited (a :: as) [] | inl (inr x) | succ y with≡ pr rewrite pr = equalityCommutative (zeroLess' (a :: as) λ i → zeroNotSucc y (a :: as) i pr)
|
||||
<BIsInherited (a :: as) [] | inr x rewrite canonicalFirst (a :: as) [] Equal | binNatToNZero (a :: as) x = refl
|
||||
<BIsInherited (zero :: a) (zero :: b) = transitivity (chopDouble a b zero) (<BIsInherited a b)
|
||||
<BIsInherited (zero :: a) (one :: b) with TotalOrder.totality ℕTotalOrder (binNatToN (zero :: a)) (binNatToN (one :: b))
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inl 2a<2b+1) with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inl 2a<2b+1) | inl (inl a<b) = equalityCommutative (equalToFirstLess FirstLess a b (equalityCommutative indHyp))
|
||||
where
|
||||
t : a <BInherited b ≡ FirstLess
|
||||
t with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
t | inl (inl x) = refl
|
||||
t | inl (inr x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x a<b))
|
||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) a<b)
|
||||
indHyp : FirstLess ≡ go<B Equal a b
|
||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited a b)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inl 2a<2b+1) | inl (inr b<a) = exFalso (noIntegersBetweenXAndSuccX {2 *N binNatToN a} (2 *N binNatToN b) (lessRespectsMultiplicationLeft (binNatToN b) (binNatToN a) 2 b<a (le 1 refl)) 2a<2b+1)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inl 2a<2b+1) | inr a=b rewrite a=b | canonicalFirst a b FirstLess | canonicalSecond (canonical a) b FirstLess | transitivity (equalityCommutative (binToBin a)) (transitivity (applyEquality NToBinNat a=b) (binToBin b)) = equalityCommutative (lemma1 (canonical b))
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inr 2b+1<2a) with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inr 2b+1<2a) | inl (inl a<b) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) 2b+1<2a (TotalOrder.<Transitive (ℕTotalOrder) (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 a<b (le 1 refl)) (le zero refl))))
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inr 2b+1<2a) | inl (inr b<a) = equalityCommutative (equalToFirstGreater FirstLess a b (equalityCommutative indHyp))
|
||||
where
|
||||
t : a <BInherited b ≡ FirstGreater
|
||||
t with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
t | inl (inl x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x b<a))
|
||||
t | inl (inr x) = refl
|
||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
||||
indHyp : FirstGreater ≡ go<B Equal a b
|
||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited a b)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inr 2b+1<2a) | inr a=b rewrite a=b = exFalso (succNotLess 2b+1<2a)
|
||||
<BIsInherited (zero :: a) (one :: b) | inr 2a=2b+1 = exFalso (parity (binNatToN b) (binNatToN a) (equalityCommutative 2a=2b+1))
|
||||
<BIsInherited (one :: a) (zero :: b) with TotalOrder.totality ℕTotalOrder (binNatToN (one :: a)) (binNatToN (zero :: b))
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inl 2a+1<2b) with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inl 2a+1<2b) | inl (inl a<b) = equalityCommutative (equalToFirstLess FirstGreater a b (equalityCommutative indHyp))
|
||||
<BIsInherited : (a b : BinNat) → a <BInherited b ≡ a <B b
|
||||
<BIsInherited [] b with TotalOrder.totality ℕTotalOrder 0 (binNatToN b)
|
||||
<BIsInherited [] b | inl (inl x) with inspect (binNatToN b)
|
||||
<BIsInherited [] b | inl (inl x) | 0 with≡ pr rewrite binNatToNZero b pr | pr = exFalso (TotalOrder.irreflexive (ℕTotalOrder) x)
|
||||
<BIsInherited [] b | inl (inl x) | (succ bl) with≡ pr rewrite pr = equalityCommutative (zeroLess b λ p → zeroNotSucc bl b p pr)
|
||||
<BIsInherited [] b | inr 0=b rewrite canonicalSecond [] b Equal | binNatToNZero b (equalityCommutative 0=b) = refl
|
||||
<BIsInherited (a :: as) [] with TotalOrder.totality ℕTotalOrder (binNatToN (a :: as)) 0
|
||||
<BIsInherited (a :: as) [] | inl (inr x) with inspect (binNatToN (a :: as))
|
||||
<BIsInherited (a :: as) [] | inl (inr x) | zero with≡ pr rewrite binNatToNZero (a :: as) pr | pr = exFalso (TotalOrder.irreflexive (ℕTotalOrder) x)
|
||||
<BIsInherited (a :: as) [] | inl (inr x) | succ y with≡ pr rewrite pr = equalityCommutative (zeroLess' (a :: as) λ i → zeroNotSucc y (a :: as) i pr)
|
||||
<BIsInherited (a :: as) [] | inr x rewrite canonicalFirst (a :: as) [] Equal | binNatToNZero (a :: as) x = refl
|
||||
<BIsInherited (zero :: a) (zero :: b) = transitivity (chopDouble a b zero) (<BIsInherited a b)
|
||||
<BIsInherited (zero :: a) (one :: b) with TotalOrder.totality ℕTotalOrder (binNatToN (zero :: a)) (binNatToN (one :: b))
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inl 2a<2b+1) with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inl 2a<2b+1) | inl (inl a<b) = equalityCommutative (equalToFirstLess FirstLess a b (equalityCommutative indHyp))
|
||||
where
|
||||
t : a <BInherited b ≡ FirstLess
|
||||
t with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
t | inl (inr x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x a<b))
|
||||
t | inl (inl x) = refl
|
||||
t | inl (inr x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x a<b))
|
||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) a<b)
|
||||
indHyp : FirstLess ≡ go<B Equal a b
|
||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited a b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inl 2a+1<2b) | inl (inr b<a) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) 2a+1<2b (TotalOrder.<Transitive (ℕTotalOrder) (lessRespectsMultiplicationLeft (binNatToN b) (binNatToN a) 2 b<a (le 1 refl)) (le zero refl))))
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inl 2a+1<2b) | inr a=b rewrite a=b = exFalso (succNotLess 2a+1<2b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inr 2b<2a+1) with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inr 2b<2a+1) | inl (inl a<b) = exFalso (noIntegersBetweenXAndSuccX {2 *N binNatToN b} (2 *N binNatToN a) (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 a<b (le 1 refl)) 2b<2a+1)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inr 2b<2a+1) | inl (inr b<a) = equalityCommutative (equalToFirstGreater FirstGreater a b (equalityCommutative indHyp))
|
||||
where
|
||||
t : a <BInherited b ≡ FirstGreater
|
||||
t with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
t | inl (inl x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x b<a))
|
||||
t | inl (inr x) = refl
|
||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
||||
indHyp : FirstGreater ≡ go<B Equal a b
|
||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited a b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inr 2b<2a+1) | inr a=b rewrite a=b | canonicalFirst a b FirstGreater | canonicalSecond (canonical a) b FirstGreater | transitivity (equalityCommutative (binToBin a)) (transitivity (applyEquality NToBinNat a=b) (binToBin b)) = equalityCommutative (lemma1 (canonical b))
|
||||
<BIsInherited (one :: a) (zero :: b) | inr x = exFalso (parity (binNatToN a) (binNatToN b) x)
|
||||
<BIsInherited (one :: a) (one :: b) = transitivity (chopDouble a b one) (<BIsInherited a b)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inl 2a<2b+1) | inl (inr b<a) = exFalso (noIntegersBetweenXAndSuccX {2 *N binNatToN a} (2 *N binNatToN b) (lessRespectsMultiplicationLeft (binNatToN b) (binNatToN a) 2 b<a (le 1 refl)) 2a<2b+1)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inl 2a<2b+1) | inr a=b rewrite a=b | canonicalFirst a b FirstLess | canonicalSecond (canonical a) b FirstLess | transitivity (equalityCommutative (binToBin a)) (transitivity (applyEquality NToBinNat a=b) (binToBin b)) = equalityCommutative (lemma1 (canonical b))
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inr 2b+1<2a) with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inr 2b+1<2a) | inl (inl a<b) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) 2b+1<2a (TotalOrder.<Transitive (ℕTotalOrder) (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 a<b (le 1 refl)) (le zero refl))))
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inr 2b+1<2a) | inl (inr b<a) = equalityCommutative (equalToFirstGreater FirstLess a b (equalityCommutative indHyp))
|
||||
where
|
||||
t : a <BInherited b ≡ FirstGreater
|
||||
t with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
t | inl (inl x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x b<a))
|
||||
t | inl (inr x) = refl
|
||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
||||
indHyp : FirstGreater ≡ go<B Equal a b
|
||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited a b)
|
||||
<BIsInherited (zero :: a) (one :: b) | inl (inr 2b+1<2a) | inr a=b rewrite a=b = exFalso (succNotLess 2b+1<2a)
|
||||
<BIsInherited (zero :: a) (one :: b) | inr 2a=2b+1 = exFalso (parity (binNatToN b) (binNatToN a) (equalityCommutative 2a=2b+1))
|
||||
<BIsInherited (one :: a) (zero :: b) with TotalOrder.totality ℕTotalOrder (binNatToN (one :: a)) (binNatToN (zero :: b))
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inl 2a+1<2b) with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inl 2a+1<2b) | inl (inl a<b) = equalityCommutative (equalToFirstLess FirstGreater a b (equalityCommutative indHyp))
|
||||
where
|
||||
t : a <BInherited b ≡ FirstLess
|
||||
t with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
t | inl (inr x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x a<b))
|
||||
t | inl (inl x) = refl
|
||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) a<b)
|
||||
indHyp : FirstLess ≡ go<B Equal a b
|
||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited a b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inl 2a+1<2b) | inl (inr b<a) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) 2a+1<2b (TotalOrder.<Transitive (ℕTotalOrder) (lessRespectsMultiplicationLeft (binNatToN b) (binNatToN a) 2 b<a (le 1 refl)) (le zero refl))))
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inl 2a+1<2b) | inr a=b rewrite a=b = exFalso (succNotLess 2a+1<2b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inr 2b<2a+1) with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inr 2b<2a+1) | inl (inl a<b) = exFalso (noIntegersBetweenXAndSuccX {2 *N binNatToN b} (2 *N binNatToN a) (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 a<b (le 1 refl)) 2b<2a+1)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inr 2b<2a+1) | inl (inr b<a) = equalityCommutative (equalToFirstGreater FirstGreater a b (equalityCommutative indHyp))
|
||||
where
|
||||
t : a <BInherited b ≡ FirstGreater
|
||||
t with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||
t | inl (inl x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x b<a))
|
||||
t | inl (inr x) = refl
|
||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
||||
indHyp : FirstGreater ≡ go<B Equal a b
|
||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited a b)
|
||||
<BIsInherited (one :: a) (zero :: b) | inl (inr 2b<2a+1) | inr a=b rewrite a=b | canonicalFirst a b FirstGreater | canonicalSecond (canonical a) b FirstGreater | transitivity (equalityCommutative (binToBin a)) (transitivity (applyEquality NToBinNat a=b) (binToBin b)) = equalityCommutative (lemma1 (canonical b))
|
||||
<BIsInherited (one :: a) (zero :: b) | inr x = exFalso (parity (binNatToN a) (binNatToN b) x)
|
||||
<BIsInherited (one :: a) (one :: b) = transitivity (chopDouble a b one) (<BIsInherited a b)
|
||||
|
||||
Reference in New Issue
Block a user