mirror of
https://github.com/Smaug123/agdaproofs
synced 2025-10-10 14:18:41 +00:00
ProjectEuler 2, nearly (#125)
This commit is contained in:
Patrick Stevens
GitHub
@@ -12,4 +12,6 @@ open import Fields.CauchyCompletion.Archimedean
|
|||||||
|
|
||||||
open import Sets.Cardinality.Infinite.Examples
|
open import Sets.Cardinality.Infinite.Examples
|
||||||
|
|
||||||
|
open import ProjectEuler.Problem2
|
||||||
|
|
||||||
module Everything.Guardedness where
|
module Everything.Guardedness where
|
||||||
|
|||||||
@@ -77,3 +77,9 @@ containsDecidable decide (x :: l) needle | inr x!=n | inr notIn = inr t
|
|||||||
t : ((x ≡ needle) || contains l needle) → False
|
t : ((x ≡ needle) || contains l needle) → False
|
||||||
t (inl x) = x!=n x
|
t (inl x) = x!=n x
|
||||||
t (inr x) = notIn x
|
t (inr x) = notIn x
|
||||||
|
|
||||||
|
filter' : {a b : _} {A : Set a} {pred : A → Set b} → (dec : (a : A) → pred a || (pred a → False)) → List A → List A
|
||||||
|
filter' dec [] = []
|
||||||
|
filter' dec (x :: l) with dec x
|
||||||
|
... | inl _ = x :: filter' dec l
|
||||||
|
... | inr _ = filter' dec l
|
||||||
|
|||||||
@@ -60,6 +60,9 @@ liftEquality f .f x .x refl refl = refl
|
|||||||
applyEquality : {a : _} {b : _} {A : Set a} {B : Set b} (f : A → B) → {x y : A} → (x ≡ y) → ((f x) ≡ (f y))
|
applyEquality : {a : _} {b : _} {A : Set a} {B : Set b} (f : A → B) → {x y : A} → (x ≡ y) → ((f x) ≡ (f y))
|
||||||
applyEquality {A} {B} f {x} {.x} refl = refl
|
applyEquality {A} {B} f {x} {.x} refl = refl
|
||||||
|
|
||||||
|
applyEquality2 : {a b c : _} {A : Set a} {B : Set b} {C : Set c} (f : A → B → C) → {x y : A} → (x ≡ y) → {m n : B} → (m ≡ n) → f x m ≡ f y n
|
||||||
|
applyEquality2 f x=y m=n rewrite x=y | m=n = refl
|
||||||
|
|
||||||
identityOfIndiscernablesLeft : {m n o : _} {A : Set m} {B : Set n} {a : A} {b : B} {c : A} → (prop : A → B → Set o) → (prop a b) → (a ≡ c) → (prop c b)
|
identityOfIndiscernablesLeft : {m n o : _} {A : Set m} {B : Set n} {a : A} {b : B} {c : A} → (prop : A → B → Set o) → (prop a b) → (a ≡ c) → (prop c b)
|
||||||
identityOfIndiscernablesLeft {a = a} {b} {.a} prop pAB refl = pAB
|
identityOfIndiscernablesLeft {a = a} {b} {.a} prop pAB refl = pAB
|
||||||
|
|
||||||
|
|||||||
@@ -32,28 +32,29 @@ _+B_ : BinNat → BinNat → BinNat
|
|||||||
+BCommutative (one :: as) (zero :: bs) rewrite +BCommutative as bs = refl
|
+BCommutative (one :: as) (zero :: bs) rewrite +BCommutative as bs = refl
|
||||||
+BCommutative (one :: as) (one :: bs) rewrite +BCommutative as bs = refl
|
+BCommutative (one :: as) (one :: bs) rewrite +BCommutative as bs = refl
|
||||||
|
|
||||||
+BIsInherited[] : (b : BinNat) (prB : b ≡ canonical b) → [] +Binherit b ≡ [] +B b
|
private
|
||||||
+BIsInherited[] [] prB = refl
|
+BIsInherited[] : (b : BinNat) (prB : b ≡ canonical b) → [] +Binherit b ≡ [] +B b
|
||||||
+BIsInherited[] (zero :: b) prB = t
|
+BIsInherited[] [] prB = refl
|
||||||
where
|
+BIsInherited[] (zero :: b) prB = t
|
||||||
refine : (b : BinNat) → zero :: b ≡ canonical (zero :: b) → b ≡ canonical b
|
where
|
||||||
refine b pr with canonical b
|
refine : (b : BinNat) → zero :: b ≡ canonical (zero :: b) → b ≡ canonical b
|
||||||
refine b pr | x :: bl = ::Inj pr
|
refine b pr with canonical b
|
||||||
t : NToBinNat (0 +N binNatToN (zero :: b)) ≡ zero :: b
|
refine b pr | x :: bl = ::Inj pr
|
||||||
t with TotalOrder.totality ℕTotalOrder 0 (binNatToN b)
|
t : NToBinNat (0 +N binNatToN (zero :: b)) ≡ zero :: b
|
||||||
t | inl (inl pos) = transitivity (doubleIsBitShift (binNatToN b) pos) (applyEquality (zero ::_) (transitivity (binToBin b) (equalityCommutative (refine b prB))))
|
t with TotalOrder.totality ℕTotalOrder 0 (binNatToN b)
|
||||||
t | inl (inr ())
|
t | inl (inl pos) = transitivity (doubleIsBitShift (binNatToN b) pos) (applyEquality (zero ::_) (transitivity (binToBin b) (equalityCommutative (refine b prB))))
|
||||||
... | inr eq with binNatToNZero b (equalityCommutative eq)
|
t | inl (inr ())
|
||||||
... | u with canonical b
|
... | inr eq with binNatToNZero b (equalityCommutative eq)
|
||||||
t | inr eq | u | [] = exFalso (bad b prB)
|
... | u with canonical b
|
||||||
where
|
t | inr eq | u | [] = exFalso (bad b prB)
|
||||||
bad : (c : BinNat) → zero :: c ≡ [] → False
|
where
|
||||||
bad c ()
|
bad : (c : BinNat) → zero :: c ≡ [] → False
|
||||||
t | inr eq | () | x :: bl
|
bad c ()
|
||||||
+BIsInherited[] (one :: b) prB = ans
|
t | inr eq | () | x :: bl
|
||||||
where
|
+BIsInherited[] (one :: b) prB = ans
|
||||||
ans : NToBinNat (binNatToN (one :: b)) ≡ one :: b
|
where
|
||||||
ans = transitivity (binToBin (one :: b)) (equalityCommutative prB)
|
ans : NToBinNat (binNatToN (one :: b)) ≡ one :: b
|
||||||
|
ans = transitivity (binToBin (one :: b)) (equalityCommutative prB)
|
||||||
|
|
||||||
-- Show that the monoid structure of ℕ is the same as that of BinNat
|
-- Show that the monoid structure of ℕ is the same as that of BinNat
|
||||||
|
|
||||||
@@ -198,3 +199,9 @@ _+B_ : BinNat → BinNat → BinNat
|
|||||||
where
|
where
|
||||||
ans2 : zero :: incr (as +Binherit bs) ≡ canonical (zero :: incr (as +B bs))
|
ans2 : zero :: incr (as +Binherit bs) ≡ canonical (zero :: incr (as +B bs))
|
||||||
ans2 rewrite +BIsInherited' as bs | equalityCommutative (incrPreservesCanonical' (as +B bs)) | canonicalAscends' {zero} (incr (as +B bs)) (incrNonzero (as +B bs)) = refl
|
ans2 rewrite +BIsInherited' as bs | equalityCommutative (incrPreservesCanonical' (as +B bs)) | canonicalAscends' {zero} (incr (as +B bs)) (incrNonzero (as +B bs)) = refl
|
||||||
|
|
||||||
|
+BIsHom : (a b : BinNat) → binNatToN (a +B b) ≡ (binNatToN a) +N (binNatToN b)
|
||||||
|
+BIsHom a b = transitivity (equalityCommutative (binNatToNIsCanonical (a +B b))) (transitivity (equalityCommutative (applyEquality binNatToN (+BIsInherited' a b))) (nToN _))
|
||||||
|
|
||||||
|
sumCanonical : (a b : BinNat) → canonical a ≡ a → canonical b ≡ b → canonical (a +B b) ≡ a +B b
|
||||||
|
sumCanonical a b a=a b=b = transitivity (equalityCommutative (+BIsInherited' a b)) (+BIsInherited a b (equalityCommutative a=a) (equalityCommutative b=b))
|
||||||
|
|||||||
@@ -6,6 +6,7 @@ open import Numbers.Naturals.Order
|
|||||||
open import Numbers.Naturals.Order.Lemmas
|
open import Numbers.Naturals.Order.Lemmas
|
||||||
open import Numbers.Naturals.Semiring
|
open import Numbers.Naturals.Semiring
|
||||||
open import Numbers.BinaryNaturals.Definition
|
open import Numbers.BinaryNaturals.Definition
|
||||||
|
open import Orders.Partial.Definition
|
||||||
open import Orders.Total.Definition
|
open import Orders.Total.Definition
|
||||||
open import Semirings.Definition
|
open import Semirings.Definition
|
||||||
|
|
||||||
@@ -33,38 +34,38 @@ a <BInherited b with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN
|
|||||||
(a <BInherited b) | inr x = Equal
|
(a <BInherited b) | inr x = Equal
|
||||||
|
|
||||||
private
|
private
|
||||||
go<B : Compare → BinNat → BinNat → Compare
|
go<Bcomp : Compare → BinNat → BinNat → Compare
|
||||||
go<B Equal [] [] = Equal
|
go<Bcomp Equal [] [] = Equal
|
||||||
go<B Equal [] (zero :: b) = go<B Equal [] b
|
go<Bcomp Equal [] (zero :: b) = go<Bcomp Equal [] b
|
||||||
go<B Equal [] (one :: b) = FirstLess
|
go<Bcomp Equal [] (one :: b) = FirstLess
|
||||||
go<B Equal (zero :: a) [] = go<B Equal a []
|
go<Bcomp Equal (zero :: a) [] = go<Bcomp Equal a []
|
||||||
go<B Equal (zero :: a) (zero :: b) = go<B Equal a b
|
go<Bcomp Equal (zero :: a) (zero :: b) = go<Bcomp Equal a b
|
||||||
go<B Equal (zero :: a) (one :: b) = go<B FirstLess a b
|
go<Bcomp Equal (zero :: a) (one :: b) = go<Bcomp FirstLess a b
|
||||||
go<B Equal (one :: a) [] = FirstGreater
|
go<Bcomp Equal (one :: a) [] = FirstGreater
|
||||||
go<B Equal (one :: a) (zero :: b) = go<B FirstGreater a b
|
go<Bcomp Equal (one :: a) (zero :: b) = go<Bcomp FirstGreater a b
|
||||||
go<B Equal (one :: a) (one :: b) = go<B Equal a b
|
go<Bcomp Equal (one :: a) (one :: b) = go<Bcomp Equal a b
|
||||||
go<B FirstGreater [] [] = FirstGreater
|
go<Bcomp FirstGreater [] [] = FirstGreater
|
||||||
go<B FirstGreater [] (zero :: b) = go<B FirstGreater [] b
|
go<Bcomp FirstGreater [] (zero :: b) = go<Bcomp FirstGreater [] b
|
||||||
go<B FirstGreater [] (one :: b) = FirstLess
|
go<Bcomp FirstGreater [] (one :: b) = FirstLess
|
||||||
go<B FirstGreater (zero :: a) [] = FirstGreater
|
go<Bcomp FirstGreater (zero :: a) [] = FirstGreater
|
||||||
go<B FirstGreater (zero :: a) (zero :: b) = go<B FirstGreater a b
|
go<Bcomp FirstGreater (zero :: a) (zero :: b) = go<Bcomp FirstGreater a b
|
||||||
go<B FirstGreater (zero :: a) (one :: b) = go<B FirstLess a b
|
go<Bcomp FirstGreater (zero :: a) (one :: b) = go<Bcomp FirstLess a b
|
||||||
go<B FirstGreater (one :: a) [] = FirstGreater
|
go<Bcomp FirstGreater (one :: a) [] = FirstGreater
|
||||||
go<B FirstGreater (one :: a) (zero :: b) = go<B FirstGreater a b
|
go<Bcomp FirstGreater (one :: a) (zero :: b) = go<Bcomp FirstGreater a b
|
||||||
go<B FirstGreater (one :: a) (one :: b) = go<B FirstGreater a b
|
go<Bcomp FirstGreater (one :: a) (one :: b) = go<Bcomp FirstGreater a b
|
||||||
go<B FirstLess [] b = FirstLess
|
go<Bcomp FirstLess [] b = FirstLess
|
||||||
go<B FirstLess (zero :: a) [] = go<B FirstLess a []
|
go<Bcomp FirstLess (zero :: a) [] = go<Bcomp FirstLess a []
|
||||||
go<B FirstLess (one :: a) [] = FirstGreater
|
go<Bcomp FirstLess (one :: a) [] = FirstGreater
|
||||||
go<B FirstLess (zero :: a) (zero :: b) = go<B FirstLess a b
|
go<Bcomp FirstLess (zero :: a) (zero :: b) = go<Bcomp FirstLess a b
|
||||||
go<B FirstLess (zero :: a) (one :: b) = go<B FirstLess a b
|
go<Bcomp FirstLess (zero :: a) (one :: b) = go<Bcomp FirstLess a b
|
||||||
go<B FirstLess (one :: a) (zero :: b) = go<B FirstGreater a b
|
go<Bcomp FirstLess (one :: a) (zero :: b) = go<Bcomp FirstGreater a b
|
||||||
go<B FirstLess (one :: a) (one :: b) = go<B FirstLess a b
|
go<Bcomp FirstLess (one :: a) (one :: b) = go<Bcomp FirstLess a b
|
||||||
|
|
||||||
_<B_ : BinNat → BinNat → Compare
|
_<Bcomp_ : BinNat → BinNat → Compare
|
||||||
a <B b = go<B Equal a b
|
a <Bcomp b = go<Bcomp Equal a b
|
||||||
|
|
||||||
private
|
private
|
||||||
lemma1 : {s : Compare} → (n : BinNat) → go<B s n n ≡ s
|
lemma1 : {s : Compare} → (n : BinNat) → go<Bcomp s n n ≡ s
|
||||||
lemma1 {Equal} [] = refl
|
lemma1 {Equal} [] = refl
|
||||||
lemma1 {Equal} (zero :: n) = lemma1 n
|
lemma1 {Equal} (zero :: n) = lemma1 n
|
||||||
lemma1 {Equal} (one :: n) = lemma1 n
|
lemma1 {Equal} (one :: n) = lemma1 n
|
||||||
@@ -75,7 +76,7 @@ private
|
|||||||
lemma1 {FirstGreater} (zero :: n) = lemma1 n
|
lemma1 {FirstGreater} (zero :: n) = lemma1 n
|
||||||
lemma1 {FirstGreater} (one :: n) = lemma1 n
|
lemma1 {FirstGreater} (one :: n) = lemma1 n
|
||||||
|
|
||||||
lemma : {s : Compare} → (n : BinNat) → go<B s (incr n) n ≡ FirstGreater
|
lemma : {s : Compare} → (n : BinNat) → go<Bcomp s (incr n) n ≡ FirstGreater
|
||||||
lemma {Equal} [] = refl
|
lemma {Equal} [] = refl
|
||||||
lemma {Equal} (zero :: n) = lemma1 n
|
lemma {Equal} (zero :: n) = lemma1 n
|
||||||
lemma {Equal} (one :: n) = lemma {FirstLess} n
|
lemma {Equal} (one :: n) = lemma {FirstLess} n
|
||||||
@@ -86,36 +87,37 @@ private
|
|||||||
lemma {FirstGreater} (zero :: n) = lemma1 {FirstGreater} n
|
lemma {FirstGreater} (zero :: n) = lemma1 {FirstGreater} n
|
||||||
lemma {FirstGreater} (one :: n) = lemma {FirstLess} n
|
lemma {FirstGreater} (one :: n) = lemma {FirstLess} n
|
||||||
|
|
||||||
succLess : (n : ℕ) → (NToBinNat (succ n)) <B (NToBinNat n) ≡ FirstGreater
|
succLess : (n : ℕ) → (NToBinNat (succ n)) <Bcomp (NToBinNat n) ≡ FirstGreater
|
||||||
succLess zero = refl
|
succLess zero = refl
|
||||||
succLess (succ n) with NToBinNat n
|
succLess (succ n) with NToBinNat n
|
||||||
succLess (succ n) | [] = refl
|
succLess (succ n) | [] = refl
|
||||||
succLess (succ n) | zero :: bl = lemma {FirstLess} bl
|
succLess (succ n) | zero :: bl = lemma {FirstLess} bl
|
||||||
succLess (succ n) | one :: bl = lemma1 {FirstGreater} (incr bl)
|
succLess (succ n) | one :: bl = lemma1 {FirstGreater} (incr bl)
|
||||||
|
|
||||||
compareRefl : (n : BinNat) → n <B n ≡ Equal
|
compareRefl : (n : BinNat) → n <Bcomp n ≡ Equal
|
||||||
compareRefl [] = refl
|
compareRefl [] = refl
|
||||||
compareRefl (zero :: n) = compareRefl n
|
compareRefl (zero :: n) = compareRefl n
|
||||||
compareRefl (one :: n) = compareRefl n
|
compareRefl (one :: n) = compareRefl n
|
||||||
|
|
||||||
zeroLess : (n : BinNat) → ((canonical n ≡ []) → False) → [] <B n ≡ FirstLess
|
zeroLess : (n : BinNat) → ((canonical n ≡ []) → False) → [] <Bcomp n ≡ FirstLess
|
||||||
zeroLess [] pr = exFalso (pr refl)
|
zeroLess [] pr = exFalso (pr refl)
|
||||||
zeroLess (zero :: n) pr with inspect (canonical n)
|
zeroLess (zero :: n) pr with inspect (canonical n)
|
||||||
zeroLess (zero :: n) pr | [] with≡ x rewrite x = exFalso (pr refl)
|
zeroLess (zero :: n) pr | [] with≡ x rewrite x = exFalso (pr refl)
|
||||||
zeroLess (zero :: n) pr | (x₁ :: y) with≡ x = zeroLess n λ i → nonEmptyNotEmpty (transitivity (equalityCommutative x) i)
|
zeroLess (zero :: n) pr | (x₁ :: y) with≡ x = zeroLess n λ i → nonEmptyNotEmpty (transitivity (equalityCommutative x) i)
|
||||||
zeroLess (one :: n) pr = refl
|
zeroLess (one :: n) pr = refl
|
||||||
|
|
||||||
zeroLess' : (n : BinNat) → ((canonical n ≡ []) → False) → n <B [] ≡ FirstGreater
|
zeroLess' : (n : BinNat) → ((canonical n ≡ []) → False) → n <Bcomp [] ≡ FirstGreater
|
||||||
zeroLess' [] pr = exFalso (pr refl)
|
zeroLess' [] pr = exFalso (pr refl)
|
||||||
zeroLess' (zero :: n) pr with inspect (canonical n)
|
zeroLess' (zero :: n) pr with inspect (canonical n)
|
||||||
zeroLess' (zero :: n) pr | [] with≡ x rewrite x = exFalso (pr refl)
|
zeroLess' (zero :: n) pr | [] with≡ x rewrite x = exFalso (pr refl)
|
||||||
zeroLess' (zero :: n) pr | (x₁ :: y) with≡ x = zeroLess' n (λ i → nonEmptyNotEmpty (transitivity (equalityCommutative x) i))
|
zeroLess' (zero :: n) pr | (x₁ :: y) with≡ x = zeroLess' n (λ i → nonEmptyNotEmpty (transitivity (equalityCommutative x) i))
|
||||||
zeroLess' (one :: n) pr = refl
|
zeroLess' (one :: n) pr = refl
|
||||||
|
|
||||||
canonicalFirst : (n m : BinNat) (state : Compare) → go<B state n m ≡ go<B state (canonical n) m
|
abstract
|
||||||
|
canonicalFirst : (n m : BinNat) (state : Compare) → go<Bcomp state n m ≡ go<Bcomp state (canonical n) m
|
||||||
canonicalFirst [] m Equal = refl
|
canonicalFirst [] m Equal = refl
|
||||||
canonicalFirst (zero :: n) m Equal with inspect (canonical n)
|
canonicalFirst (zero :: n) m Equal with inspect (canonical n)
|
||||||
canonicalFirst (zero :: n) [] Equal | [] with≡ x rewrite x = transitivity (canonicalFirst n [] Equal) (applyEquality (λ i → go<B Equal i []) {canonical n} x)
|
canonicalFirst (zero :: n) [] Equal | [] with≡ x rewrite x = transitivity (canonicalFirst n [] Equal) (applyEquality (λ i → go<Bcomp Equal i []) {canonical n} x)
|
||||||
canonicalFirst (zero :: n) (zero :: ms) Equal | [] with≡ x rewrite x | canonicalFirst n ms Equal | x = refl
|
canonicalFirst (zero :: n) (zero :: ms) Equal | [] with≡ x rewrite x | canonicalFirst n ms Equal | x = refl
|
||||||
canonicalFirst (zero :: n) (one :: ms) Equal | [] with≡ x rewrite x | canonicalFirst n ms FirstLess | x = refl
|
canonicalFirst (zero :: n) (one :: ms) Equal | [] with≡ x rewrite x | canonicalFirst n ms FirstLess | x = refl
|
||||||
canonicalFirst (zero :: n) [] Equal | (x₁ :: y) with≡ x rewrite x | canonicalFirst n [] Equal | x = refl
|
canonicalFirst (zero :: n) [] Equal | (x₁ :: y) with≡ x rewrite x | canonicalFirst n [] Equal | x = refl
|
||||||
@@ -149,12 +151,13 @@ private
|
|||||||
canonicalFirst (one :: n) (zero :: m) FirstGreater = canonicalFirst n m FirstGreater
|
canonicalFirst (one :: n) (zero :: m) FirstGreater = canonicalFirst n m FirstGreater
|
||||||
canonicalFirst (one :: n) (one :: m) FirstGreater = canonicalFirst n m FirstGreater
|
canonicalFirst (one :: n) (one :: m) FirstGreater = canonicalFirst n m FirstGreater
|
||||||
|
|
||||||
greater0Lemma : (n : BinNat) → go<B FirstGreater n [] ≡ FirstGreater
|
private
|
||||||
|
greater0Lemma : (n : BinNat) → go<Bcomp FirstGreater n [] ≡ FirstGreater
|
||||||
greater0Lemma [] = refl
|
greater0Lemma [] = refl
|
||||||
greater0Lemma (zero :: n) = refl
|
greater0Lemma (zero :: n) = refl
|
||||||
greater0Lemma (one :: n) = refl
|
greater0Lemma (one :: n) = refl
|
||||||
|
|
||||||
canonicalSecond : (n m : BinNat) (state : Compare) → go<B state n m ≡ go<B state n (canonical m)
|
canonicalSecond : (n m : BinNat) (state : Compare) → go<Bcomp state n m ≡ go<Bcomp state n (canonical m)
|
||||||
canonicalSecond n [] Equal = refl
|
canonicalSecond n [] Equal = refl
|
||||||
canonicalSecond [] (zero :: m) Equal with inspect (canonical m)
|
canonicalSecond [] (zero :: m) Equal with inspect (canonical m)
|
||||||
canonicalSecond [] (zero :: m) Equal | [] with≡ x rewrite x | canonicalSecond [] m Equal | x = refl
|
canonicalSecond [] (zero :: m) Equal | [] with≡ x rewrite x | canonicalSecond [] m Equal | x = refl
|
||||||
@@ -192,8 +195,8 @@ private
|
|||||||
canonicalSecond (zero :: n) (one :: m) FirstGreater = canonicalSecond n m FirstLess
|
canonicalSecond (zero :: n) (one :: m) FirstGreater = canonicalSecond n m FirstLess
|
||||||
canonicalSecond (one :: n) (one :: m) FirstGreater = canonicalSecond n m FirstGreater
|
canonicalSecond (one :: n) (one :: m) FirstGreater = canonicalSecond n m FirstGreater
|
||||||
|
|
||||||
equalContaminated : (n m : BinNat) → go<B FirstLess n m ≡ Equal → False
|
equalContaminated : (n m : BinNat) → go<Bcomp FirstLess n m ≡ Equal → False
|
||||||
equalContaminated' : (n m : BinNat) → go<B FirstGreater n m ≡ Equal → False
|
equalContaminated' : (n m : BinNat) → go<Bcomp FirstGreater n m ≡ Equal → False
|
||||||
|
|
||||||
equalContaminated (zero :: n) [] pr = equalContaminated n [] pr
|
equalContaminated (zero :: n) [] pr = equalContaminated n [] pr
|
||||||
equalContaminated (zero :: n) (zero :: m) pr = equalContaminated n m pr
|
equalContaminated (zero :: n) (zero :: m) pr = equalContaminated n m pr
|
||||||
@@ -207,7 +210,7 @@ private
|
|||||||
equalContaminated' (one :: n) (zero :: m) pr = equalContaminated' n m pr
|
equalContaminated' (one :: n) (zero :: m) pr = equalContaminated' n m pr
|
||||||
equalContaminated' (one :: n) (one :: m) pr = equalContaminated' n m pr
|
equalContaminated' (one :: n) (one :: m) pr = equalContaminated' n m pr
|
||||||
|
|
||||||
comparisonEqual : (a b : BinNat) → (a <B b ≡ Equal) → canonical a ≡ canonical b
|
comparisonEqual : (a b : BinNat) → (a <Bcomp b ≡ Equal) → canonical a ≡ canonical b
|
||||||
comparisonEqual [] [] pr = refl
|
comparisonEqual [] [] pr = refl
|
||||||
comparisonEqual [] (zero :: b) pr with inspect (canonical b)
|
comparisonEqual [] (zero :: b) pr with inspect (canonical b)
|
||||||
comparisonEqual [] (zero :: b) pr | [] with≡ p rewrite p = refl
|
comparisonEqual [] (zero :: b) pr | [] with≡ p rewrite p = refl
|
||||||
@@ -226,7 +229,7 @@ private
|
|||||||
comparisonEqual (one :: a) (zero :: b) pr = exFalso (equalContaminated' a b pr)
|
comparisonEqual (one :: a) (zero :: b) pr = exFalso (equalContaminated' a b pr)
|
||||||
comparisonEqual (one :: a) (one :: b) pr = applyEquality (one ::_) (comparisonEqual a b pr)
|
comparisonEqual (one :: a) (one :: b) pr = applyEquality (one ::_) (comparisonEqual a b pr)
|
||||||
|
|
||||||
equalSymmetric : (n m : BinNat) → n <B m ≡ Equal → m <B n ≡ Equal
|
equalSymmetric : (n m : BinNat) → n <Bcomp m ≡ Equal → m <Bcomp n ≡ Equal
|
||||||
equalSymmetric [] [] n=m = refl
|
equalSymmetric [] [] n=m = refl
|
||||||
equalSymmetric [] (zero :: m) n=m rewrite equalSymmetric [] m n=m = refl
|
equalSymmetric [] (zero :: m) n=m rewrite equalSymmetric [] m n=m = refl
|
||||||
equalSymmetric (zero :: n) [] n=m rewrite equalSymmetric n [] n=m = refl
|
equalSymmetric (zero :: n) [] n=m rewrite equalSymmetric n [] n=m = refl
|
||||||
@@ -235,7 +238,7 @@ private
|
|||||||
equalSymmetric (one :: n) (zero :: m) n=m = exFalso (equalContaminated' n m n=m)
|
equalSymmetric (one :: n) (zero :: m) n=m = exFalso (equalContaminated' n m n=m)
|
||||||
equalSymmetric (one :: n) (one :: m) n=m = equalSymmetric n m n=m
|
equalSymmetric (one :: n) (one :: m) n=m = equalSymmetric n m n=m
|
||||||
|
|
||||||
equalToFirstGreater : (state : Compare) → (a b : BinNat) → go<B Equal a b ≡ FirstGreater → go<B state a b ≡ FirstGreater
|
equalToFirstGreater : (state : Compare) → (a b : BinNat) → go<Bcomp Equal a b ≡ FirstGreater → go<Bcomp state a b ≡ FirstGreater
|
||||||
equalToFirstGreater FirstGreater [] (zero :: b) pr = equalToFirstGreater FirstGreater [] b pr
|
equalToFirstGreater FirstGreater [] (zero :: b) pr = equalToFirstGreater FirstGreater [] b pr
|
||||||
equalToFirstGreater FirstGreater (zero :: a) [] pr = refl
|
equalToFirstGreater FirstGreater (zero :: a) [] pr = refl
|
||||||
equalToFirstGreater FirstGreater (zero :: a) (zero :: b) pr = equalToFirstGreater FirstGreater a b pr
|
equalToFirstGreater FirstGreater (zero :: a) (zero :: b) pr = equalToFirstGreater FirstGreater a b pr
|
||||||
@@ -252,7 +255,7 @@ private
|
|||||||
equalToFirstGreater FirstLess (one :: a) (zero :: b) pr = pr
|
equalToFirstGreater FirstLess (one :: a) (zero :: b) pr = pr
|
||||||
equalToFirstGreater FirstLess (one :: a) (one :: b) pr = equalToFirstGreater FirstLess a b pr
|
equalToFirstGreater FirstLess (one :: a) (one :: b) pr = equalToFirstGreater FirstLess a b pr
|
||||||
|
|
||||||
equalToFirstLess : (state : Compare) → (a b : BinNat) → go<B Equal a b ≡ FirstLess → go<B state a b ≡ FirstLess
|
equalToFirstLess : (state : Compare) → (a b : BinNat) → go<Bcomp Equal a b ≡ FirstLess → go<Bcomp state a b ≡ FirstLess
|
||||||
equalToFirstLess FirstLess [] b pr = refl
|
equalToFirstLess FirstLess [] b pr = refl
|
||||||
equalToFirstLess FirstLess (zero :: a) [] pr = equalToFirstLess FirstLess a [] pr
|
equalToFirstLess FirstLess (zero :: a) [] pr = equalToFirstLess FirstLess a [] pr
|
||||||
equalToFirstLess FirstLess (zero :: a) (zero :: b) pr = equalToFirstLess FirstLess a b pr
|
equalToFirstLess FirstLess (zero :: a) (zero :: b) pr = equalToFirstLess FirstLess a b pr
|
||||||
@@ -264,7 +267,7 @@ private
|
|||||||
equalToFirstLess FirstGreater [] (one :: b) pr = refl
|
equalToFirstLess FirstGreater [] (one :: b) pr = refl
|
||||||
equalToFirstLess FirstGreater (zero :: a) [] pr = transitivity (t a) (equalToFirstLess FirstGreater a [] pr)
|
equalToFirstLess FirstGreater (zero :: a) [] pr = transitivity (t a) (equalToFirstLess FirstGreater a [] pr)
|
||||||
where
|
where
|
||||||
t : (a : BinNat) → FirstGreater ≡ go<B FirstGreater a []
|
t : (a : BinNat) → FirstGreater ≡ go<Bcomp FirstGreater a []
|
||||||
t [] = refl
|
t [] = refl
|
||||||
t (zero :: a) = refl
|
t (zero :: a) = refl
|
||||||
t (one :: a) = refl
|
t (one :: a) = refl
|
||||||
@@ -276,7 +279,7 @@ private
|
|||||||
zeroNotSucc : (n : ℕ) (b : BinNat) → (canonical b ≡ []) → (binNatToN b ≡ succ n) → False
|
zeroNotSucc : (n : ℕ) (b : BinNat) → (canonical b ≡ []) → (binNatToN b ≡ succ n) → False
|
||||||
zeroNotSucc n b b=0 b>0 rewrite binNatToNZero' b b=0 = naughtE b>0
|
zeroNotSucc n b b=0 b>0 rewrite binNatToNZero' b b=0 = naughtE b>0
|
||||||
|
|
||||||
chopFirstBit : (m n : BinNat) {b : Bit} (s : Compare) → go<B s (b :: m) (b :: n) ≡ go<B s m n
|
chopFirstBit : (m n : BinNat) {b : Bit} (s : Compare) → go<Bcomp s (b :: m) (b :: n) ≡ go<Bcomp s m n
|
||||||
chopFirstBit m n {zero} Equal = refl
|
chopFirstBit m n {zero} Equal = refl
|
||||||
chopFirstBit m n {one} Equal = refl
|
chopFirstBit m n {one} Equal = refl
|
||||||
chopFirstBit m n {zero} FirstLess = refl
|
chopFirstBit m n {zero} FirstLess = refl
|
||||||
@@ -312,7 +315,7 @@ private
|
|||||||
succNotLess : {n : ℕ} → succ n <N n → False
|
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)))
|
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 : (a b : BinNat) → a <BInherited b ≡ a <Bcomp b
|
||||||
<BIsInherited [] b with TotalOrder.totality ℕTotalOrder 0 (binNatToN b)
|
<BIsInherited [] b with TotalOrder.totality ℕTotalOrder 0 (binNatToN b)
|
||||||
<BIsInherited [] b | inl (inl x) with inspect (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) | 0 with≡ pr rewrite binNatToNZero b pr | pr = exFalso (TotalOrder.irreflexive (ℕTotalOrder) x)
|
||||||
@@ -333,7 +336,7 @@ private
|
|||||||
t | inl (inl x) = refl
|
t | inl (inl x) = refl
|
||||||
t | inl (inr x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x a<b))
|
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)
|
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) a<b)
|
||||||
indHyp : FirstLess ≡ go<B Equal a b
|
indHyp : FirstLess ≡ go<Bcomp Equal a b
|
||||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited 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) | 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 (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))
|
||||||
@@ -346,7 +349,7 @@ private
|
|||||||
t | inl (inl x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x b<a))
|
t | inl (inl x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x b<a))
|
||||||
t | inl (inr x) = refl
|
t | inl (inr x) = refl
|
||||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
||||||
indHyp : FirstGreater ≡ go<B Equal a b
|
indHyp : FirstGreater ≡ go<Bcomp Equal a b
|
||||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited 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) | 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 (zero :: a) (one :: b) | inr 2a=2b+1 = exFalso (parity (binNatToN b) (binNatToN a) (equalityCommutative 2a=2b+1))
|
||||||
@@ -359,7 +362,7 @@ private
|
|||||||
t | inl (inr x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x a<b))
|
t | inl (inr x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x a<b))
|
||||||
t | inl (inl x) = refl
|
t | inl (inl x) = refl
|
||||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) a<b)
|
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) a<b)
|
||||||
indHyp : FirstLess ≡ go<B Equal a b
|
indHyp : FirstLess ≡ go<Bcomp Equal a b
|
||||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited 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) | 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 (inl 2a+1<2b) | inr a=b rewrite a=b = exFalso (succNotLess 2a+1<2b)
|
||||||
@@ -372,8 +375,70 @@ private
|
|||||||
t | inl (inl x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x b<a))
|
t | inl (inl x) = exFalso (TotalOrder.irreflexive (ℕTotalOrder) (TotalOrder.<Transitive (ℕTotalOrder) x b<a))
|
||||||
t | inl (inr x) = refl
|
t | inl (inr x) = refl
|
||||||
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
t | inr x rewrite x = exFalso (TotalOrder.irreflexive (ℕTotalOrder) b<a)
|
||||||
indHyp : FirstGreater ≡ go<B Equal a b
|
indHyp : FirstGreater ≡ go<Bcomp Equal a b
|
||||||
indHyp = transitivity (equalityCommutative t) (<BIsInherited 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) | 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) (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 (one :: a) (one :: b) = transitivity (chopDouble a b one) (<BIsInherited a b)
|
||||||
|
|
||||||
|
_<B_ : BinNat → BinNat → Set
|
||||||
|
a <B b = (a <Bcomp b) ≡ FirstLess
|
||||||
|
|
||||||
|
translate : (a b : BinNat) → (a <B b) → (binNatToN a) <N (binNatToN b)
|
||||||
|
translate a b a<b with <BIsInherited a b
|
||||||
|
... | r with TotalOrder.totality ℕTotalOrder (binNatToN a) (binNatToN b)
|
||||||
|
... | inl (inl x) = x
|
||||||
|
... | inl (inr x) = exFalso (badCompare'' (transitivity (equalityCommutative a<b) (equalityCommutative r)))
|
||||||
|
... | inr x = exFalso (badCompare (transitivity r a<b))
|
||||||
|
|
||||||
|
private
|
||||||
|
totality : (a b : BinNat) → ((a <B b) || (b <B a)) || (canonical a ≡ canonical b)
|
||||||
|
totality [] [] = inr refl
|
||||||
|
totality [] (zero :: b) with totality [] b
|
||||||
|
... | inl (inl x) = inl (inl x)
|
||||||
|
... | inl (inr x) = inl (inr x)
|
||||||
|
... | inr x with canonical b
|
||||||
|
... | [] = inr refl
|
||||||
|
totality [] (one :: b) = inl (inl refl)
|
||||||
|
totality (zero :: a) [] with totality a []
|
||||||
|
... | inl (inl x) = inl (inl x)
|
||||||
|
... | inl (inr x) = inl (inr x)
|
||||||
|
... | inr x with canonical a
|
||||||
|
... | [] = inr refl
|
||||||
|
totality (zero :: a) (zero :: b) with totality a b
|
||||||
|
... | inl (inl x) = inl (inl x)
|
||||||
|
... | inl (inr x) = inl (inr x)
|
||||||
|
... | inr x rewrite x = inr refl
|
||||||
|
totality (zero :: a) (one :: b) with totality a b
|
||||||
|
... | inl (inl x) = inl (inl (equalToFirstLess FirstLess a b x))
|
||||||
|
... | inr x rewrite canonicalSecond a b FirstLess | canonicalFirst a (canonical b) FirstLess | x = inl (inl (lemma1 (canonical b)))
|
||||||
|
... | inl (inr x) with equalToFirstLess FirstGreater b a x
|
||||||
|
... | r = inl (inr r)
|
||||||
|
totality (one :: a) [] = inl (inr refl)
|
||||||
|
totality (one :: a) (zero :: b) with totality a b
|
||||||
|
... | inr x rewrite canonicalSecond b a FirstLess | canonicalFirst b (canonical a) FirstLess | x = inl (inr (lemma1 (canonical b)))
|
||||||
|
... | inl (inr x) = inl (inr (equalToFirstLess FirstLess b a x))
|
||||||
|
... | inl (inl x) with equalToFirstLess FirstGreater a b x
|
||||||
|
... | r = inl (inl r)
|
||||||
|
totality (one :: a) (one :: b) with totality a b
|
||||||
|
... | inl (inl x) = inl (inl x)
|
||||||
|
... | inl (inr x) = inl (inr x)
|
||||||
|
... | inr x rewrite x = inr refl
|
||||||
|
|
||||||
|
translate' : (a b : ℕ) → (a <N b) → (NToBinNat a) <B (NToBinNat b)
|
||||||
|
translate' a b a<b with totality (NToBinNat a) (NToBinNat b)
|
||||||
|
... | inl (inl x) = x
|
||||||
|
... | inl (inr x) with translate (NToBinNat b) (NToBinNat a) x
|
||||||
|
... | m = exFalso (lessIrreflexive (lessTransitive a<b (identityOfIndiscernablesLeft _<N_ (identityOfIndiscernablesRight _<N_ m (nToN a)) (nToN b))))
|
||||||
|
translate' a b a<b | inr x rewrite NToBinNatInj a b x = exFalso (lessIrreflexive a<b)
|
||||||
|
|
||||||
|
private
|
||||||
|
<BTransitive : (a b c : BinNat) → (a <B b) → (b <B c) → a <B c
|
||||||
|
<BTransitive a b c a<b b<c with translate' (binNatToN a) (binNatToN c) (PartialOrder.<Transitive (TotalOrder.order ℕTotalOrder) (translate a b a<b) (translate b c b<c))
|
||||||
|
... | r rewrite binToBin a | binToBin c = transitivity (canonicalFirst a c Equal) (transitivity (canonicalSecond (canonical a) c Equal) r)
|
||||||
|
|
||||||
|
-- This order fails to be total because [] is not literally equal to 0::[] .
|
||||||
|
BinNatOrder : PartialOrder BinNat
|
||||||
|
PartialOrder._<_ (BinNatOrder) = _<B_
|
||||||
|
PartialOrder.irreflexive (BinNatOrder) {x} bad = badCompare (transitivity (equalityCommutative (compareRefl x)) bad)
|
||||||
|
PartialOrder.<Transitive (BinNatOrder) {a} {b} {c} a<b b<c = <BTransitive a b c a<b b<c
|
||||||
|
|||||||
@@ -25,378 +25,378 @@ private
|
|||||||
... | bl with go zero a a
|
... | bl with go zero a a
|
||||||
aMinusAGo (one :: a) | bl | yes x rewrite yesInjective bl = refl
|
aMinusAGo (one :: a) | bl | yes x rewrite yesInjective bl = refl
|
||||||
|
|
||||||
aMinusALemma : (a : BinNat) → mapMaybe canonical (mapMaybe (_::_ zero) (go zero a a)) ≡ yes []
|
aMinusALemma : (a : BinNat) → mapMaybe canonical (mapMaybe (_::_ zero) (go zero a a)) ≡ yes []
|
||||||
aMinusALemma a with inspect (go zero a a)
|
aMinusALemma a with inspect (go zero a a)
|
||||||
aMinusALemma a | no with≡ x with aMinusAGo a
|
aMinusALemma a | no with≡ x with aMinusAGo a
|
||||||
... | r rewrite x = exFalso (noNotYes r)
|
... | r rewrite x = exFalso (noNotYes r)
|
||||||
aMinusALemma a | yes xs with≡ pr with inspect (canonical xs)
|
aMinusALemma a | yes xs with≡ pr with inspect (canonical xs)
|
||||||
aMinusALemma a | yes xs with≡ pr | [] with≡ pr2 rewrite pr | pr2 = refl
|
aMinusALemma a | yes xs with≡ pr | [] with≡ pr2 rewrite pr | pr2 = refl
|
||||||
aMinusALemma a | yes xs with≡ pr | (x :: t) with≡ pr2 with aMinusAGo a
|
aMinusALemma a | yes xs with≡ pr | (x :: t) with≡ pr2 with aMinusAGo a
|
||||||
... | b rewrite pr | pr2 = exFalso (nonEmptyNotEmpty (yesInjective b))
|
... | b rewrite pr | pr2 = exFalso (nonEmptyNotEmpty (yesInjective b))
|
||||||
|
|
||||||
aMinusA : (a : BinNat) → mapMaybe canonical (a -B a) ≡ yes []
|
aMinusA : (a : BinNat) → mapMaybe canonical (a -B a) ≡ yes []
|
||||||
aMinusA [] = refl
|
aMinusA [] = refl
|
||||||
aMinusA (zero :: a) = aMinusALemma a
|
aMinusA (zero :: a) = aMinusALemma a
|
||||||
aMinusA (one :: a) = aMinusALemma a
|
aMinusA (one :: a) = aMinusALemma a
|
||||||
|
|
||||||
goOne : (a b : BinNat) → mapMaybe canonical (go one (incr a) b) ≡ mapMaybe canonical (go zero a b)
|
goOne : (a b : BinNat) → mapMaybe canonical (go one (incr a) b) ≡ mapMaybe canonical (go zero a b)
|
||||||
goOne [] [] = refl
|
goOne [] [] = refl
|
||||||
goOne [] (zero :: b) with inspect (go zero [] b)
|
goOne [] (zero :: b) with inspect (go zero [] b)
|
||||||
goOne [] (zero :: b) | no with≡ pr rewrite pr = refl
|
goOne [] (zero :: b) | no with≡ pr rewrite pr = refl
|
||||||
goOne [] (zero :: b) | yes x with≡ pr with goZeroEmpty b pr
|
goOne [] (zero :: b) | yes x with≡ pr with goZeroEmpty b pr
|
||||||
... | t with inspect (canonical x)
|
... | t with inspect (canonical x)
|
||||||
goOne [] (zero :: b) | yes x with≡ pr | t | [] with≡ pr2 rewrite pr | pr2 = refl
|
goOne [] (zero :: b) | yes x with≡ pr | t | [] with≡ pr2 rewrite pr | pr2 = refl
|
||||||
goOne [] (zero :: b) | yes x with≡ pr | t | (x₁ :: y) with≡ pr2 with goZeroEmpty' b pr
|
goOne [] (zero :: b) | yes x with≡ pr | t | (x₁ :: y) with≡ pr2 with goZeroEmpty' b pr
|
||||||
... | bl = exFalso (nonEmptyNotEmpty (transitivity (equalityCommutative pr2) bl))
|
... | bl = exFalso (nonEmptyNotEmpty (transitivity (equalityCommutative pr2) bl))
|
||||||
goOne [] (one :: b) with inspect (go one [] b)
|
goOne [] (one :: b) with inspect (go one [] b)
|
||||||
goOne [] (one :: b) | no with≡ pr rewrite pr = refl
|
goOne [] (one :: b) | no with≡ pr rewrite pr = refl
|
||||||
goOne [] (one :: b) | yes x with≡ pr = exFalso (goOneEmpty b pr)
|
goOne [] (one :: b) | yes x with≡ pr = exFalso (goOneEmpty b pr)
|
||||||
goOne (zero :: a) [] = refl
|
goOne (zero :: a) [] = refl
|
||||||
goOne (zero :: a) (zero :: b) = refl
|
goOne (zero :: a) (zero :: b) = refl
|
||||||
goOne (zero :: a) (one :: b) = refl
|
goOne (zero :: a) (one :: b) = refl
|
||||||
goOne (one :: a) [] with inspect (go one (incr a) [])
|
goOne (one :: a) [] with inspect (go one (incr a) [])
|
||||||
goOne (one :: a) [] | no with≡ pr with goOne a []
|
goOne (one :: a) [] | no with≡ pr with goOne a []
|
||||||
... | bl rewrite pr | goEmpty a = exFalso (noNotYes bl)
|
... | bl rewrite pr | goEmpty a = exFalso (noNotYes bl)
|
||||||
goOne (one :: a) [] | yes y with≡ pr with goOne a []
|
goOne (one :: a) [] | yes y with≡ pr with goOne a []
|
||||||
... | bl rewrite pr = applyEquality (λ i → yes (one :: i)) (yesInjective (transitivity bl (applyEquality (mapMaybe canonical) (goEmpty a))))
|
... | bl rewrite pr = applyEquality (λ i → yes (one :: i)) (yesInjective (transitivity bl (applyEquality (mapMaybe canonical) (goEmpty a))))
|
||||||
goOne (one :: a) (zero :: b) with inspect (go zero a b)
|
goOne (one :: a) (zero :: b) with inspect (go zero a b)
|
||||||
goOne (one :: a) (zero :: b) | no with≡ pr with inspect (go one (incr a) b)
|
goOne (one :: a) (zero :: b) | no with≡ pr with inspect (go one (incr a) b)
|
||||||
goOne (one :: a) (zero :: b) | no with≡ pr | no with≡ x rewrite pr | x = refl
|
goOne (one :: a) (zero :: b) | no with≡ pr | no with≡ x rewrite pr | x = refl
|
||||||
goOne (one :: a) (zero :: b) | no with≡ pr | yes y with≡ x with goOne a b
|
goOne (one :: a) (zero :: b) | no with≡ pr | yes y with≡ x with goOne a b
|
||||||
... | f rewrite pr | x = exFalso (noNotYes (equalityCommutative f))
|
... | f rewrite pr | x = exFalso (noNotYes (equalityCommutative f))
|
||||||
goOne (one :: a) (zero :: b) | yes y with≡ pr with inspect (go one (incr a) b)
|
goOne (one :: a) (zero :: b) | yes y with≡ pr with inspect (go one (incr a) b)
|
||||||
goOne (one :: a) (zero :: b) | yes y with≡ pr | no with≡ x with goOne a b
|
goOne (one :: a) (zero :: b) | yes y with≡ pr | no with≡ x with goOne a b
|
||||||
... | f rewrite pr | x = exFalso (noNotYes f)
|
... | f rewrite pr | x = exFalso (noNotYes f)
|
||||||
goOne (one :: a) (zero :: b) | yes y with≡ pr | yes z with≡ x rewrite pr | x = applyEquality (λ i → yes (one :: i)) (yesInjective (transitivity (transitivity (applyEquality (mapMaybe canonical) (equalityCommutative x)) (goOne a b)) (applyEquality (mapMaybe canonical) pr)))
|
goOne (one :: a) (zero :: b) | yes y with≡ pr | yes z with≡ x rewrite pr | x = applyEquality (λ i → yes (one :: i)) (yesInjective (transitivity (transitivity (applyEquality (mapMaybe canonical) (equalityCommutative x)) (goOne a b)) (applyEquality (mapMaybe canonical) pr)))
|
||||||
goOne (one :: a) (one :: b) with inspect (go zero a b)
|
goOne (one :: a) (one :: b) with inspect (go zero a b)
|
||||||
goOne (one :: a) (one :: b) | no with≡ pr with inspect (go one (incr a) b)
|
goOne (one :: a) (one :: b) | no with≡ pr with inspect (go one (incr a) b)
|
||||||
goOne (one :: a) (one :: b) | no with≡ pr | no with≡ pr2 rewrite pr | pr2 = refl
|
goOne (one :: a) (one :: b) | no with≡ pr | no with≡ pr2 rewrite pr | pr2 = refl
|
||||||
goOne (one :: a) (one :: b) | no with≡ pr | yes x with≡ pr2 rewrite pr | pr2 = exFalso (noNotYes (transitivity (applyEquality (mapMaybe canonical) (equalityCommutative pr)) (transitivity (equalityCommutative (goOne a b)) (applyEquality (mapMaybe canonical) pr2))))
|
goOne (one :: a) (one :: b) | no with≡ pr | yes x with≡ pr2 rewrite pr | pr2 = exFalso (noNotYes (transitivity (applyEquality (mapMaybe canonical) (equalityCommutative pr)) (transitivity (equalityCommutative (goOne a b)) (applyEquality (mapMaybe canonical) pr2))))
|
||||||
goOne (one :: a) (one :: b) | yes y with≡ pr with inspect (go one (incr a) b)
|
goOne (one :: a) (one :: b) | yes y with≡ pr with inspect (go one (incr a) b)
|
||||||
goOne (one :: a) (one :: b) | yes y with≡ pr | yes z with≡ pr2 rewrite pr | pr2 = applyEquality yes t
|
goOne (one :: a) (one :: b) | yes y with≡ pr | yes z with≡ pr2 rewrite pr | pr2 = applyEquality yes t
|
||||||
where
|
where
|
||||||
u : canonical z ≡ canonical y
|
u : canonical z ≡ canonical y
|
||||||
u = yesInjective (transitivity (transitivity (equalityCommutative (applyEquality (mapMaybe canonical) pr2)) (goOne a b)) (applyEquality (mapMaybe canonical) pr))
|
u = yesInjective (transitivity (transitivity (equalityCommutative (applyEquality (mapMaybe canonical) pr2)) (goOne a b)) (applyEquality (mapMaybe canonical) pr))
|
||||||
t : canonical (zero :: z) ≡ canonical (zero :: y)
|
t : canonical (zero :: z) ≡ canonical (zero :: y)
|
||||||
t with inspect (canonical z)
|
t with inspect (canonical z)
|
||||||
t | [] with≡ pr1 rewrite equalityCommutative u | pr1 = refl
|
t | [] with≡ pr1 rewrite equalityCommutative u | pr1 = refl
|
||||||
t | (x :: bl) with≡ pr rewrite equalityCommutative u | pr = refl
|
t | (x :: bl) with≡ pr rewrite equalityCommutative u | pr = refl
|
||||||
goOne (one :: a) (one :: b) | yes y with≡ pr | no with≡ pr2 rewrite pr | pr2 = exFalso (noNotYes (transitivity (equalityCommutative (applyEquality (mapMaybe canonical) pr2)) (transitivity (goOne a b) (applyEquality (mapMaybe canonical) pr))))
|
goOne (one :: a) (one :: b) | yes y with≡ pr | no with≡ pr2 rewrite pr | pr2 = exFalso (noNotYes (transitivity (equalityCommutative (applyEquality (mapMaybe canonical) pr2)) (transitivity (goOne a b) (applyEquality (mapMaybe canonical) pr))))
|
||||||
|
|
||||||
plusThenMinus : (a b : BinNat) → mapMaybe canonical ((a +B b) -B b) ≡ yes (canonical a)
|
plusThenMinus : (a b : BinNat) → mapMaybe canonical ((a +B b) -B b) ≡ yes (canonical a)
|
||||||
plusThenMinus [] b = aMinusA b
|
plusThenMinus [] b = aMinusA b
|
||||||
plusThenMinus (zero :: a) [] = refl
|
plusThenMinus (zero :: a) [] = refl
|
||||||
plusThenMinus (zero :: a) (zero :: b) = t
|
plusThenMinus (zero :: a) (zero :: b) = t
|
||||||
where
|
where
|
||||||
t : mapMaybe canonical (mapMaybe (zero ::_) (go zero (a +B b) b)) ≡ yes (canonical (zero :: a))
|
t : mapMaybe canonical (mapMaybe (zero ::_) (go zero (a +B b) b)) ≡ yes (canonical (zero :: a))
|
||||||
t with inspect (go zero (a +B b) b)
|
t with inspect (go zero (a +B b) b)
|
||||||
t | no with≡ x with plusThenMinus a b
|
t | no with≡ x with plusThenMinus a b
|
||||||
... | bl rewrite x = exFalso (noNotYes bl)
|
... | bl rewrite x = exFalso (noNotYes bl)
|
||||||
t | yes y with≡ x with plusThenMinus a b
|
t | yes y with≡ x with plusThenMinus a b
|
||||||
... | f rewrite x = applyEquality yes u
|
... | f rewrite x = applyEquality yes u
|
||||||
where
|
where
|
||||||
u : canonical (zero :: y) ≡ canonical (zero :: a)
|
u : canonical (zero :: y) ≡ canonical (zero :: a)
|
||||||
u with inspect (canonical y)
|
u with inspect (canonical y)
|
||||||
u | [] with≡ pr rewrite pr | equalityCommutative (yesInjective f) = refl
|
u | [] with≡ pr rewrite pr | equalityCommutative (yesInjective f) = refl
|
||||||
u | (x :: bl) with≡ pr rewrite pr | equalityCommutative (yesInjective f) = refl
|
u | (x :: bl) with≡ pr rewrite pr | equalityCommutative (yesInjective f) = refl
|
||||||
plusThenMinus (zero :: a) (one :: b) = t
|
plusThenMinus (zero :: a) (one :: b) = t
|
||||||
where
|
where
|
||||||
t : mapMaybe canonical (mapMaybe (zero ::_) (go zero (a +B b) b)) ≡ yes (canonical (zero :: a))
|
t : mapMaybe canonical (mapMaybe (zero ::_) (go zero (a +B b) b)) ≡ yes (canonical (zero :: a))
|
||||||
t with inspect (go zero (a +B b) b)
|
t with inspect (go zero (a +B b) b)
|
||||||
t | no with≡ x with plusThenMinus a b
|
t | no with≡ x with plusThenMinus a b
|
||||||
... | bl rewrite x = exFalso (noNotYes bl)
|
... | bl rewrite x = exFalso (noNotYes bl)
|
||||||
t | yes y with≡ x with plusThenMinus a b
|
t | yes y with≡ x with plusThenMinus a b
|
||||||
... | f rewrite x = applyEquality yes u
|
... | f rewrite x = applyEquality yes u
|
||||||
where
|
where
|
||||||
u : canonical (zero :: y) ≡ canonical (zero :: a)
|
u : canonical (zero :: y) ≡ canonical (zero :: a)
|
||||||
u with inspect (canonical y)
|
u with inspect (canonical y)
|
||||||
u | [] with≡ pr rewrite pr | equalityCommutative (yesInjective f) = refl
|
u | [] with≡ pr rewrite pr | equalityCommutative (yesInjective f) = refl
|
||||||
u | (x :: bl) with≡ pr rewrite pr | equalityCommutative (yesInjective f) = refl
|
u | (x :: bl) with≡ pr rewrite pr | equalityCommutative (yesInjective f) = refl
|
||||||
plusThenMinus (one :: a) [] = refl
|
plusThenMinus (one :: a) [] = refl
|
||||||
plusThenMinus (one :: a) (zero :: b) = t
|
plusThenMinus (one :: a) (zero :: b) = t
|
||||||
where
|
where
|
||||||
t : mapMaybe canonical (mapMaybe (_::_ one) (go zero (a +B b) b)) ≡ yes (one :: canonical a)
|
t : mapMaybe canonical (mapMaybe (_::_ one) (go zero (a +B b) b)) ≡ yes (one :: canonical a)
|
||||||
t with inspect (go zero (a +B b) b)
|
t with inspect (go zero (a +B b) b)
|
||||||
t | no with≡ x with plusThenMinus a b
|
t | no with≡ x with plusThenMinus a b
|
||||||
... | bl rewrite x = exFalso (noNotYes bl)
|
... | bl rewrite x = exFalso (noNotYes bl)
|
||||||
t | yes y with≡ x with plusThenMinus a b
|
t | yes y with≡ x with plusThenMinus a b
|
||||||
... | bl rewrite x = applyEquality (λ i → yes (one :: i)) (yesInjective bl)
|
... | bl rewrite x = applyEquality (λ i → yes (one :: i)) (yesInjective bl)
|
||||||
plusThenMinus (one :: a) (one :: b) = t
|
plusThenMinus (one :: a) (one :: b) = t
|
||||||
where
|
where
|
||||||
t : mapMaybe canonical (mapMaybe (_::_ one) (go one (incr (a +B b)) b)) ≡ yes (one :: canonical a)
|
t : mapMaybe canonical (mapMaybe (_::_ one) (go one (incr (a +B b)) b)) ≡ yes (one :: canonical a)
|
||||||
t with inspect (go one (incr (a +B b)) b)
|
t with inspect (go one (incr (a +B b)) b)
|
||||||
t | no with≡ x with goOne (a +B b) b
|
t | no with≡ x with goOne (a +B b) b
|
||||||
... | f rewrite x | plusThenMinus a b = exFalso (noNotYes f)
|
... | f rewrite x | plusThenMinus a b = exFalso (noNotYes f)
|
||||||
t | yes y with≡ x with goOne (a +B b) b
|
t | yes y with≡ x with goOne (a +B b) b
|
||||||
... | f rewrite x | plusThenMinus a b = applyEquality (λ i → yes (one :: i)) (yesInjective f)
|
... | f rewrite x | plusThenMinus a b = applyEquality (λ i → yes (one :: i)) (yesInjective f)
|
||||||
|
|
||||||
subLemma : (a b : ℕ) → a <N b → succ (a +N a) <N b +N b
|
subLemma : (a b : ℕ) → a <N b → succ (a +N a) <N b +N b
|
||||||
subLemma a b a<b with TotalOrder.totality ℕTotalOrder (succ (a +N a)) (b +N b)
|
subLemma a b a<b with TotalOrder.totality ℕTotalOrder (succ (a +N a)) (b +N b)
|
||||||
subLemma a b a<b | inl (inl x) = x
|
subLemma a b a<b | inl (inl x) = x
|
||||||
subLemma a b a<b | inl (inr x) = exFalso (noIntegersBetweenXAndSuccX (a +N a) (addStrongInequalities a<b a<b) x)
|
subLemma a b a<b | inl (inr x) = exFalso (noIntegersBetweenXAndSuccX (a +N a) (addStrongInequalities a<b a<b) x)
|
||||||
subLemma a b a<b | inr x = exFalso (parity a b (transitivity (applyEquality (succ a +N_) (Semiring.sumZeroRight ℕSemiring a)) (transitivity x (applyEquality (b +N_) (equalityCommutative (Semiring.sumZeroRight ℕSemiring b))))))
|
subLemma a b a<b | inr x = exFalso (parity a b (transitivity (applyEquality (succ a +N_) (Semiring.sumZeroRight ℕSemiring a)) (transitivity x (applyEquality (b +N_) (equalityCommutative (Semiring.sumZeroRight ℕSemiring b))))))
|
||||||
|
|
||||||
subLemma2 : (a b : ℕ) → a <N b → 2 *N a <N succ (2 *N b)
|
subLemma2 : (a b : ℕ) → a <N b → 2 *N a <N succ (2 *N b)
|
||||||
subLemma2 a b a<b with TotalOrder.totality ℕTotalOrder (2 *N a) (succ (2 *N b))
|
subLemma2 a b a<b with TotalOrder.totality ℕTotalOrder (2 *N a) (succ (2 *N b))
|
||||||
subLemma2 a b a<b | inl (inl x) = x
|
subLemma2 a b a<b | inl (inl x) = x
|
||||||
subLemma2 a b a<b | inl (inr x) = exFalso (TotalOrder.irreflexive ℕTotalOrder (TotalOrder.<Transitive ℕTotalOrder x (TotalOrder.<Transitive ℕTotalOrder (lessRespectsMultiplicationLeft a b 2 a<b (le 1 refl)) (le 0 refl))))
|
subLemma2 a b a<b | inl (inr x) = exFalso (TotalOrder.irreflexive ℕTotalOrder (TotalOrder.<Transitive ℕTotalOrder x (TotalOrder.<Transitive ℕTotalOrder (lessRespectsMultiplicationLeft a b 2 a<b (le 1 refl)) (le 0 refl))))
|
||||||
subLemma2 a b a<b | inr x = exFalso (parity b a (equalityCommutative x))
|
subLemma2 a b a<b | inr x = exFalso (parity b a (equalityCommutative x))
|
||||||
|
|
||||||
subtraction : (a b : BinNat) → a -B b ≡ no → binNatToN a <N binNatToN b
|
subtraction : (a b : BinNat) → a -B b ≡ no → binNatToN a <N binNatToN b
|
||||||
subtraction' : (a b : BinNat) → go one a b ≡ no → (binNatToN a <N binNatToN b) || (binNatToN a ≡ binNatToN b)
|
subtraction' : (a b : BinNat) → go one a b ≡ no → (binNatToN a <N binNatToN b) || (binNatToN a ≡ binNatToN b)
|
||||||
|
|
||||||
subtraction' [] [] pr = inr refl
|
subtraction' [] [] pr = inr refl
|
||||||
subtraction' [] (x :: b) pr with TotalOrder.totality ℕTotalOrder 0 (binNatToN (x :: b))
|
subtraction' [] (x :: b) pr with TotalOrder.totality ℕTotalOrder 0 (binNatToN (x :: b))
|
||||||
subtraction' [] (x :: b) pr | inl (inl x₁) = inl x₁
|
subtraction' [] (x :: b) pr | inl (inl x₁) = inl x₁
|
||||||
subtraction' [] (x :: b) pr | inr x₁ = inr x₁
|
subtraction' [] (x :: b) pr | inr x₁ = inr x₁
|
||||||
subtraction' (zero :: a) [] pr with subtraction' a [] (mapMaybePreservesNo pr)
|
subtraction' (zero :: a) [] pr with subtraction' a [] (mapMaybePreservesNo pr)
|
||||||
subtraction' (zero :: a) [] pr | inr x rewrite x = inr refl
|
subtraction' (zero :: a) [] pr | inr x rewrite x = inr refl
|
||||||
subtraction' (zero :: a) (zero :: b) pr with subtraction' a b (mapMaybePreservesNo pr)
|
subtraction' (zero :: a) (zero :: b) pr with subtraction' a b (mapMaybePreservesNo pr)
|
||||||
subtraction' (zero :: a) (zero :: b) pr | inl x = inl (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 x (le 1 refl))
|
subtraction' (zero :: a) (zero :: b) pr | inl x = inl (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 x (le 1 refl))
|
||||||
subtraction' (zero :: a) (zero :: b) pr | inr x rewrite x = inr refl
|
subtraction' (zero :: a) (zero :: b) pr | inr x rewrite x = inr refl
|
||||||
subtraction' (zero :: a) (one :: b) pr with subtraction' a b (mapMaybePreservesNo pr)
|
subtraction' (zero :: a) (one :: b) pr with subtraction' a b (mapMaybePreservesNo pr)
|
||||||
subtraction' (zero :: a) (one :: b) pr | inl x = inl (subLemma2 (binNatToN a) (binNatToN b) x)
|
subtraction' (zero :: a) (one :: b) pr | inl x = inl (subLemma2 (binNatToN a) (binNatToN b) x)
|
||||||
subtraction' (zero :: a) (one :: b) pr | inr x rewrite x = inl (le zero refl)
|
subtraction' (zero :: a) (one :: b) pr | inr x rewrite x = inl (le zero refl)
|
||||||
subtraction' (one :: a) (zero :: b) pr with subtraction a b (mapMaybePreservesNo pr)
|
subtraction' (one :: a) (zero :: b) pr with subtraction a b (mapMaybePreservesNo pr)
|
||||||
... | t rewrite Semiring.sumZeroRight ℕSemiring (binNatToN a) | Semiring.sumZeroRight ℕSemiring (binNatToN b) = inl (subLemma (binNatToN a) (binNatToN b) t)
|
... | t rewrite Semiring.sumZeroRight ℕSemiring (binNatToN a) | Semiring.sumZeroRight ℕSemiring (binNatToN b) = inl (subLemma (binNatToN a) (binNatToN b) t)
|
||||||
subtraction' (one :: a) (one :: b) pr with subtraction' a b (mapMaybePreservesNo pr)
|
subtraction' (one :: a) (one :: b) pr with subtraction' a b (mapMaybePreservesNo pr)
|
||||||
subtraction' (one :: a) (one :: b) pr | inl x = inl (succPreservesInequality (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 x (le 1 refl)))
|
subtraction' (one :: a) (one :: b) pr | inl x = inl (succPreservesInequality (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 x (le 1 refl)))
|
||||||
subtraction' (one :: a) (one :: b) pr | inr x rewrite x = inr refl
|
subtraction' (one :: a) (one :: b) pr | inr x rewrite x = inr refl
|
||||||
|
|
||||||
subtraction [] (zero :: b) pr with inspect (binNatToN b)
|
subtraction [] (zero :: b) pr with inspect (binNatToN b)
|
||||||
subtraction [] (zero :: b) pr | zero with≡ pr1 = exFalso (noNotYes (transitivity (applyEquality (mapMaybe canonical) (equalityCommutative pr)) (transitivity (goPreservesCanonicalRight zero [] b) (transitivity (applyEquality (λ i → mapMaybe canonical (go zero [] i)) (binNatToNZero b pr1)) refl))))
|
subtraction [] (zero :: b) pr | zero with≡ pr1 = exFalso (noNotYes (transitivity (applyEquality (mapMaybe canonical) (equalityCommutative pr)) (transitivity (goPreservesCanonicalRight zero [] b) (transitivity (applyEquality (λ i → mapMaybe canonical (go zero [] i)) (binNatToNZero b pr1)) refl))))
|
||||||
subtraction [] (zero :: b) pr | (succ bl) with≡ pr1 rewrite pr | pr1 = succIsPositive _
|
subtraction [] (zero :: b) pr | (succ bl) with≡ pr1 rewrite pr | pr1 = succIsPositive _
|
||||||
subtraction [] (one :: b) pr = succIsPositive _
|
subtraction [] (one :: b) pr = succIsPositive _
|
||||||
subtraction (zero :: a) (zero :: b) pr = lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 u (le 1 refl)
|
subtraction (zero :: a) (zero :: b) pr = lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 u (le 1 refl)
|
||||||
where
|
where
|
||||||
u : binNatToN a <N binNatToN b
|
u : binNatToN a <N binNatToN b
|
||||||
u = subtraction a b (mapMaybePreservesNo pr)
|
u = subtraction a b (mapMaybePreservesNo pr)
|
||||||
subtraction (zero :: a) (one :: b) pr with subtraction' a b (mapMaybePreservesNo pr)
|
subtraction (zero :: a) (one :: b) pr with subtraction' a b (mapMaybePreservesNo pr)
|
||||||
subtraction (zero :: a) (one :: b) pr | inl x = subLemma2 (binNatToN a) (binNatToN b) x
|
subtraction (zero :: a) (one :: b) pr | inl x = subLemma2 (binNatToN a) (binNatToN b) x
|
||||||
subtraction (zero :: a) (one :: b) pr | inr x rewrite x = le zero refl
|
subtraction (zero :: a) (one :: b) pr | inr x rewrite x = le zero refl
|
||||||
subtraction (one :: a) (zero :: b) pr rewrite Semiring.sumZeroRight ℕSemiring (binNatToN a) | Semiring.sumZeroRight ℕSemiring (binNatToN b) = subLemma (binNatToN a) (binNatToN b) u
|
subtraction (one :: a) (zero :: b) pr rewrite Semiring.sumZeroRight ℕSemiring (binNatToN a) | Semiring.sumZeroRight ℕSemiring (binNatToN b) = subLemma (binNatToN a) (binNatToN b) u
|
||||||
where
|
where
|
||||||
u : binNatToN a <N binNatToN b
|
u : binNatToN a <N binNatToN b
|
||||||
u = subtraction a b (mapMaybePreservesNo pr)
|
u = subtraction a b (mapMaybePreservesNo pr)
|
||||||
subtraction (one :: a) (one :: b) pr = succPreservesInequality (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 u (le 1 refl))
|
subtraction (one :: a) (one :: b) pr = succPreservesInequality (lessRespectsMultiplicationLeft (binNatToN a) (binNatToN b) 2 u (le 1 refl))
|
||||||
where
|
where
|
||||||
u : binNatToN a <N binNatToN b
|
u : binNatToN a <N binNatToN b
|
||||||
u = subtraction a b (mapMaybePreservesNo pr)
|
u = subtraction a b (mapMaybePreservesNo pr)
|
||||||
|
|
||||||
subLemma4 : (a b : BinNat) {t : BinNat} → go one a b ≡ no → go zero a b ≡ yes t → canonical t ≡ []
|
subLemma4 : (a b : BinNat) {t : BinNat} → go one a b ≡ no → go zero a b ≡ yes t → canonical t ≡ []
|
||||||
subLemma4 [] [] {t} pr1 pr2 rewrite yesInjective (equalityCommutative pr2) = refl
|
subLemma4 [] [] {t} pr1 pr2 rewrite yesInjective (equalityCommutative pr2) = refl
|
||||||
subLemma4 [] (x :: b) {t} pr1 pr2 = goZeroEmpty' (x :: b) pr2
|
subLemma4 [] (x :: b) {t} pr1 pr2 = goZeroEmpty' (x :: b) pr2
|
||||||
subLemma4 (zero :: a) [] {t} pr1 pr2 with inspect (go one a [])
|
subLemma4 (zero :: a) [] {t} pr1 pr2 with inspect (go one a [])
|
||||||
subLemma4 (zero :: a) [] {t} pr1 pr2 | no with≡ pr3 with subLemma4 a [] pr3 (goEmpty a)
|
subLemma4 (zero :: a) [] {t} pr1 pr2 | no with≡ pr3 with subLemma4 a [] pr3 (goEmpty a)
|
||||||
... | bl with applyEquality canonical (yesInjective pr2)
|
... | bl with applyEquality canonical (yesInjective pr2)
|
||||||
... | th rewrite bl = equalityCommutative th
|
... | th rewrite bl = equalityCommutative th
|
||||||
subLemma4 (zero :: a) [] {t} pr1 pr2 | yes x with≡ pr3 rewrite pr3 = exFalso (noNotYes (equalityCommutative pr1))
|
subLemma4 (zero :: a) [] {t} pr1 pr2 | yes x with≡ pr3 rewrite pr3 = exFalso (noNotYes (equalityCommutative pr1))
|
||||||
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 with inspect (go one a b)
|
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 with inspect (go one a b)
|
||||||
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 | no with≡ pr3 with inspect (go zero a b)
|
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 | no with≡ pr3 with inspect (go zero a b)
|
||||||
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 | no with≡ pr3 | no with≡ pr4 rewrite pr4 = exFalso (noNotYes pr2)
|
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 | no with≡ pr3 | no with≡ pr4 rewrite pr4 = exFalso (noNotYes pr2)
|
||||||
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 | no with≡ pr3 | yes x with≡ pr4 with subLemma4 a b pr3 pr4
|
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 | no with≡ pr3 | yes x with≡ pr4 with subLemma4 a b pr3 pr4
|
||||||
... | bl rewrite pr3 | pr4 = ans
|
... | bl rewrite pr3 | pr4 = ans
|
||||||
where
|
where
|
||||||
ans : canonical t ≡ []
|
ans : canonical t ≡ []
|
||||||
ans rewrite equalityCommutative (applyEquality canonical (yesInjective pr2)) | bl = refl
|
ans rewrite equalityCommutative (applyEquality canonical (yesInjective pr2)) | bl = refl
|
||||||
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 | yes x with≡ pr3 rewrite pr3 = exFalso (noNotYes (equalityCommutative pr1))
|
subLemma4 (zero :: a) (zero :: b) {t} pr1 pr2 | yes x with≡ pr3 rewrite pr3 = exFalso (noNotYes (equalityCommutative pr1))
|
||||||
subLemma4 (zero :: a) (one :: b) {t} pr1 pr2 with go one a b
|
subLemma4 (zero :: a) (one :: b) {t} pr1 pr2 with go one a b
|
||||||
... | no = exFalso (noNotYes pr2)
|
... | no = exFalso (noNotYes pr2)
|
||||||
subLemma4 (zero :: a) (one :: b) {t} pr1 pr2 | yes x = exFalso (noNotYes (equalityCommutative pr1))
|
subLemma4 (zero :: a) (one :: b) {t} pr1 pr2 | yes x = exFalso (noNotYes (equalityCommutative pr1))
|
||||||
subLemma4 (one :: a) (zero :: b) {t} pr1 pr2 with go zero a b
|
subLemma4 (one :: a) (zero :: b) {t} pr1 pr2 with go zero a b
|
||||||
subLemma4 (one :: a) (zero :: b) {t} pr1 pr2 | no = exFalso (noNotYes pr2)
|
subLemma4 (one :: a) (zero :: b) {t} pr1 pr2 | no = exFalso (noNotYes pr2)
|
||||||
subLemma4 (one :: a) (zero :: b) {t} pr1 pr2 | yes x = exFalso (noNotYes (equalityCommutative pr1))
|
subLemma4 (one :: a) (zero :: b) {t} pr1 pr2 | yes x = exFalso (noNotYes (equalityCommutative pr1))
|
||||||
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 with inspect (go zero a b)
|
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 with inspect (go zero a b)
|
||||||
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 | no with≡ pr3 rewrite pr3 = exFalso (noNotYes pr2)
|
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 | no with≡ pr3 rewrite pr3 = exFalso (noNotYes pr2)
|
||||||
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 | yes x with≡ pr3 with inspect (go one a b)
|
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 | yes x with≡ pr3 with inspect (go one a b)
|
||||||
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 | yes x with≡ pr3 | no with≡ pr4 with subLemma4 a b pr4 pr3
|
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 | yes x with≡ pr3 | no with≡ pr4 with subLemma4 a b pr4 pr3
|
||||||
... | bl rewrite pr3 | pr4 | bl = ans
|
... | bl rewrite pr3 | pr4 | bl = ans
|
||||||
where
|
where
|
||||||
ans : canonical t ≡ []
|
ans : canonical t ≡ []
|
||||||
ans rewrite equalityCommutative (applyEquality canonical (yesInjective pr2)) | bl = refl
|
ans rewrite equalityCommutative (applyEquality canonical (yesInjective pr2)) | bl = refl
|
||||||
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 | yes x with≡ pr3 | yes x₁ with≡ pr4 rewrite pr4 = exFalso (noNotYes (equalityCommutative pr1))
|
subLemma4 (one :: a) (one :: b) {t} pr1 pr2 | yes x with≡ pr3 | yes x₁ with≡ pr4 rewrite pr4 = exFalso (noNotYes (equalityCommutative pr1))
|
||||||
|
|
||||||
goOneFromZero : (a b : BinNat) → go zero a b ≡ no → go one a b ≡ no
|
goOneFromZero : (a b : BinNat) → go zero a b ≡ no → go one a b ≡ no
|
||||||
goOneFromZero [] (zero :: b) pr = refl
|
goOneFromZero [] (zero :: b) pr = refl
|
||||||
goOneFromZero [] (one :: b) pr = refl
|
goOneFromZero [] (one :: b) pr = refl
|
||||||
goOneFromZero (zero :: a) (zero :: b) pr rewrite goOneFromZero a b (mapMaybePreservesNo pr) = refl
|
goOneFromZero (zero :: a) (zero :: b) pr rewrite goOneFromZero a b (mapMaybePreservesNo pr) = refl
|
||||||
goOneFromZero (zero :: a) (one :: b) pr rewrite (mapMaybePreservesNo pr) = refl
|
goOneFromZero (zero :: a) (one :: b) pr rewrite (mapMaybePreservesNo pr) = refl
|
||||||
goOneFromZero (one :: a) (zero :: b) pr rewrite (mapMaybePreservesNo pr) = refl
|
goOneFromZero (one :: a) (zero :: b) pr rewrite (mapMaybePreservesNo pr) = refl
|
||||||
goOneFromZero (one :: a) (one :: b) pr rewrite goOneFromZero a b (mapMaybePreservesNo pr) = refl
|
goOneFromZero (one :: a) (one :: b) pr rewrite goOneFromZero a b (mapMaybePreservesNo pr) = refl
|
||||||
|
|
||||||
subLemma5 : (a b : BinNat) → mapMaybe canonical (go zero a b) ≡ yes [] → go one a b ≡ no
|
subLemma5 : (a b : BinNat) → mapMaybe canonical (go zero a b) ≡ yes [] → go one a b ≡ no
|
||||||
subLemma5 [] b pr = goOneEmpty' b
|
subLemma5 [] b pr = goOneEmpty' b
|
||||||
subLemma5 (zero :: a) [] pr with inspect (canonical a)
|
subLemma5 (zero :: a) [] pr with inspect (canonical a)
|
||||||
subLemma5 (zero :: a) [] pr | (z :: zs) with≡ pr2 rewrite pr2 = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
subLemma5 (zero :: a) [] pr | (z :: zs) with≡ pr2 rewrite pr2 = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
||||||
subLemma5 (zero :: a) [] pr | [] with≡ pr2 rewrite pr2 = applyEquality (mapMaybe (one ::_)) (subLemma5 a [] (transitivity (applyEquality (mapMaybe canonical) (goEmpty a)) (applyEquality yes pr2)))
|
subLemma5 (zero :: a) [] pr | [] with≡ pr2 rewrite pr2 = applyEquality (mapMaybe (one ::_)) (subLemma5 a [] (transitivity (applyEquality (mapMaybe canonical) (goEmpty a)) (applyEquality yes pr2)))
|
||||||
subLemma5 (zero :: a) (zero :: b) pr with inspect (go zero a b)
|
subLemma5 (zero :: a) (zero :: b) pr with inspect (go zero a b)
|
||||||
subLemma5 (zero :: a) (zero :: b) pr | no with≡ pr2 rewrite pr2 = exFalso (noNotYes pr)
|
subLemma5 (zero :: a) (zero :: b) pr | no with≡ pr2 rewrite pr2 = exFalso (noNotYes pr)
|
||||||
subLemma5 (zero :: a) (zero :: b) pr | yes x with≡ pr2 with inspect (canonical x)
|
subLemma5 (zero :: a) (zero :: b) pr | yes x with≡ pr2 with inspect (canonical x)
|
||||||
subLemma5 (zero :: a) (zero :: b) pr | yes x with≡ pr2 | [] with≡ pr3 rewrite pr | pr2 | pr3 = applyEquality (mapMaybe (one ::_)) (subLemma5 a b (transitivity (applyEquality (mapMaybe canonical) pr2) (applyEquality yes pr3)))
|
subLemma5 (zero :: a) (zero :: b) pr | yes x with≡ pr2 | [] with≡ pr3 rewrite pr | pr2 | pr3 = applyEquality (mapMaybe (one ::_)) (subLemma5 a b (transitivity (applyEquality (mapMaybe canonical) pr2) (applyEquality yes pr3)))
|
||||||
subLemma5 (zero :: a) (zero :: b) pr | yes x with≡ pr2 | (x₁ :: bl) with≡ pr3 rewrite pr | pr2 | pr3 = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
subLemma5 (zero :: a) (zero :: b) pr | yes x with≡ pr2 | (x₁ :: bl) with≡ pr3 rewrite pr | pr2 | pr3 = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
||||||
subLemma5 (zero :: a) (one :: b) pr with (go one a b)
|
subLemma5 (zero :: a) (one :: b) pr with (go one a b)
|
||||||
subLemma5 (zero :: a) (one :: b) pr | no = exFalso (noNotYes pr)
|
subLemma5 (zero :: a) (one :: b) pr | no = exFalso (noNotYes pr)
|
||||||
subLemma5 (zero :: a) (one :: b) pr | yes y = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
subLemma5 (zero :: a) (one :: b) pr | yes y = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
||||||
subLemma5 (one :: a) (zero :: b) pr with go zero a b
|
subLemma5 (one :: a) (zero :: b) pr with go zero a b
|
||||||
subLemma5 (one :: a) (zero :: b) pr | no = exFalso (noNotYes pr)
|
subLemma5 (one :: a) (zero :: b) pr | no = exFalso (noNotYes pr)
|
||||||
subLemma5 (one :: a) (zero :: b) pr | yes x = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
subLemma5 (one :: a) (zero :: b) pr | yes x = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
||||||
subLemma5 (one :: a) (one :: b) pr with inspect (go zero a b)
|
subLemma5 (one :: a) (one :: b) pr with inspect (go zero a b)
|
||||||
subLemma5 (one :: a) (one :: b) pr | yes x with≡ pr2 with inspect (canonical x)
|
subLemma5 (one :: a) (one :: b) pr | yes x with≡ pr2 with inspect (canonical x)
|
||||||
subLemma5 (one :: a) (one :: b) pr | yes x with≡ pr2 | [] with≡ pr3 rewrite pr | pr2 | pr3 = applyEquality (mapMaybe (one ::_)) (subLemma5 a b (transitivity (applyEquality (mapMaybe canonical) pr2) (applyEquality yes pr3)))
|
subLemma5 (one :: a) (one :: b) pr | yes x with≡ pr2 | [] with≡ pr3 rewrite pr | pr2 | pr3 = applyEquality (mapMaybe (one ::_)) (subLemma5 a b (transitivity (applyEquality (mapMaybe canonical) pr2) (applyEquality yes pr3)))
|
||||||
subLemma5 (one :: a) (one :: b) pr | yes x with≡ pr2 | (x₁ :: y) with≡ pr3 rewrite pr | pr2 | pr3 = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
subLemma5 (one :: a) (one :: b) pr | yes x with≡ pr2 | (x₁ :: y) with≡ pr3 rewrite pr | pr2 | pr3 = exFalso (nonEmptyNotEmpty (yesInjective pr))
|
||||||
subLemma5 (one :: a) (one :: b) pr | no with≡ pr2 rewrite pr2 = exFalso (noNotYes pr)
|
subLemma5 (one :: a) (one :: b) pr | no with≡ pr2 rewrite pr2 = exFalso (noNotYes pr)
|
||||||
|
|
||||||
subLemma3 : (a b : BinNat) → go zero a b ≡ no → (go zero (incr a) b ≡ no) || (mapMaybe canonical (go zero (incr a) b) ≡ yes [])
|
subLemma3 : (a b : BinNat) → go zero a b ≡ no → (go zero (incr a) b ≡ no) || (mapMaybe canonical (go zero (incr a) b) ≡ yes [])
|
||||||
subLemma3 a b pr with inspect (go zero (incr a) b)
|
subLemma3 a b pr with inspect (go zero (incr a) b)
|
||||||
subLemma3 a b pr | no with≡ x = inl x
|
subLemma3 a b pr | no with≡ x = inl x
|
||||||
subLemma3 [] (zero :: b) pr | yes y with≡ pr1 rewrite pr = exFalso (noNotYes pr1)
|
subLemma3 [] (zero :: b) pr | yes y with≡ pr1 rewrite pr = exFalso (noNotYes pr1)
|
||||||
subLemma3 [] (one :: b) pr | yes y with≡ pr1 with inspect (go zero [] b)
|
subLemma3 [] (one :: b) pr | yes y with≡ pr1 with inspect (go zero [] b)
|
||||||
subLemma3 [] (one :: b) pr | yes y with≡ pr1 | no with≡ pr2 rewrite pr1 | pr2 = exFalso (noNotYes pr1)
|
subLemma3 [] (one :: b) pr | yes y with≡ pr1 | no with≡ pr2 rewrite pr1 | pr2 = exFalso (noNotYes pr1)
|
||||||
subLemma3 [] (one :: b) pr | yes y with≡ pr1 | yes x with≡ pr2 with goZeroEmpty' b pr2
|
subLemma3 [] (one :: b) pr | yes y with≡ pr1 | yes x with≡ pr2 with goZeroEmpty' b pr2
|
||||||
... | f rewrite pr1 | pr2 | equalityCommutative (yesInjective pr1) | f = inr refl
|
... | f rewrite pr1 | pr2 | equalityCommutative (yesInjective pr1) | f = inr refl
|
||||||
subLemma3 (zero :: a) (zero :: b) pr | yes y with≡ pr1 rewrite mapMaybePreservesNo pr = exFalso (noNotYes pr1)
|
subLemma3 (zero :: a) (zero :: b) pr | yes y with≡ pr1 rewrite mapMaybePreservesNo pr = exFalso (noNotYes pr1)
|
||||||
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 with inspect (go zero a b)
|
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 with inspect (go zero a b)
|
||||||
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 | no with≡ pr2 rewrite pr1 | pr2 = exFalso (noNotYes pr1)
|
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 | no with≡ pr2 rewrite pr1 | pr2 = exFalso (noNotYes pr1)
|
||||||
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 | yes x with≡ pr2 with inspect (canonical x)
|
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 | yes x with≡ pr2 with inspect (canonical x)
|
||||||
... | [] with≡ pr3 rewrite pr1 | pr2 | equalityCommutative (yesInjective pr1) | pr3 = inr refl
|
... | [] with≡ pr3 rewrite pr1 | pr2 | equalityCommutative (yesInjective pr1) | pr3 = inr refl
|
||||||
... | (z :: zs) with≡ pr3 with inspect (go one a b)
|
... | (z :: zs) with≡ pr3 with inspect (go one a b)
|
||||||
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 | yes x with≡ pr2 | (z :: zs) with≡ pr3 | no with≡ pr4 rewrite pr1 | pr2 | pr3 | pr4 = exFalso (nonEmptyNotEmpty (transitivity (equalityCommutative pr3) (subLemma4 a b pr4 pr2)))
|
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 | yes x with≡ pr2 | (z :: zs) with≡ pr3 | no with≡ pr4 rewrite pr1 | pr2 | pr3 | pr4 = exFalso (nonEmptyNotEmpty (transitivity (equalityCommutative pr3) (subLemma4 a b pr4 pr2)))
|
||||||
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 | yes x with≡ pr2 | (z :: zs) with≡ pr3 | yes x₁ with≡ pr4 rewrite pr1 | pr2 | pr3 | pr4 = exFalso (noNotYes (equalityCommutative pr))
|
subLemma3 (zero :: a) (one :: b) pr | yes y with≡ pr1 | yes x with≡ pr2 | (z :: zs) with≡ pr3 | yes x₁ with≡ pr4 rewrite pr1 | pr2 | pr3 | pr4 = exFalso (noNotYes (equalityCommutative pr))
|
||||||
subLemma3 (one :: a) (zero :: b) pr | yes y with≡ pr1 with subLemma3 a b (mapMaybePreservesNo pr)
|
subLemma3 (one :: a) (zero :: b) pr | yes y with≡ pr1 with subLemma3 a b (mapMaybePreservesNo pr)
|
||||||
subLemma3 (one :: a) (zero :: b) pr | yes y with≡ pr1 | inl x rewrite x = inl refl
|
subLemma3 (one :: a) (zero :: b) pr | yes y with≡ pr1 | inl x rewrite x = inl refl
|
||||||
subLemma3 (one :: a) (zero :: b) pr | yes y with≡ pr1 | inr x with inspect (go zero (incr a) b)
|
subLemma3 (one :: a) (zero :: b) pr | yes y with≡ pr1 | inr x with inspect (go zero (incr a) b)
|
||||||
... | no with≡ pr2 rewrite pr1 | pr2 = exFalso (noNotYes x)
|
... | no with≡ pr2 rewrite pr1 | pr2 = exFalso (noNotYes x)
|
||||||
... | yes z with≡ pr2 rewrite pr1 | pr2 = inr (applyEquality yes (transitivity (transitivity (applyEquality canonical (yesInjective (equalityCommutative pr1))) r) (yesInjective x)))
|
... | yes z with≡ pr2 rewrite pr1 | pr2 = inr (applyEquality yes (transitivity (transitivity (applyEquality canonical (yesInjective (equalityCommutative pr1))) r) (yesInjective x)))
|
||||||
where
|
where
|
||||||
r : canonical (zero :: z) ≡ canonical z
|
r : canonical (zero :: z) ≡ canonical z
|
||||||
r rewrite yesInjective x = refl
|
r rewrite yesInjective x = refl
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 with subLemma3 a b (mapMaybePreservesNo pr)
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 with subLemma3 a b (mapMaybePreservesNo pr)
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inl x with inspect (go one (incr a) b)
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inl x with inspect (go one (incr a) b)
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inl th | no with≡ pr2 rewrite pr2 = exFalso (noNotYes pr1)
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inl th | no with≡ pr2 rewrite pr2 = exFalso (noNotYes pr1)
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inl th | yes x with≡ pr2 with goOneFromZero (incr a) b th
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inl th | yes x with≡ pr2 with goOneFromZero (incr a) b th
|
||||||
... | bad rewrite pr2 = exFalso (noNotYes (equalityCommutative bad))
|
... | bad rewrite pr2 = exFalso (noNotYes (equalityCommutative bad))
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr x with inspect (go one (incr a) b)
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr x with inspect (go one (incr a) b)
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr x | no with≡ pr2 rewrite pr2 = exFalso (noNotYes pr1)
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr x | no with≡ pr2 rewrite pr2 = exFalso (noNotYes pr1)
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 with inspect (go zero (incr a) b)
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 with inspect (go zero (incr a) b)
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 | no with≡ pr3 rewrite pr3 = exFalso (noNotYes th)
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 | no with≡ pr3 rewrite pr3 = exFalso (noNotYes th)
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 | yes x with≡ pr3 with inspect (go zero a b)
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 | yes x with≡ pr3 with inspect (go zero a b)
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 | yes x with≡ pr3 | no with≡ pr4 rewrite pr1 | th | pr2 | pr3 | pr4 | equalityCommutative (yesInjective pr1) = exFalso false
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 | yes x with≡ pr3 | no with≡ pr4 rewrite pr1 | th | pr2 | pr3 | pr4 | equalityCommutative (yesInjective pr1) = exFalso false
|
||||||
where
|
where
|
||||||
false : False
|
false : False
|
||||||
false with applyEquality (mapMaybe canonical) pr3
|
false with applyEquality (mapMaybe canonical) pr3
|
||||||
... | f rewrite th | subLemma5 (incr a) b f = exFalso (noNotYes pr2)
|
... | f rewrite th | subLemma5 (incr a) b f = exFalso (noNotYes pr2)
|
||||||
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 | yes x with≡ pr3 | yes w with≡ pr4 rewrite pr4 = exFalso (noNotYes (equalityCommutative pr))
|
subLemma3 (one :: a) (one :: b) pr | yes y with≡ pr1 | inr th | yes z with≡ pr2 | yes x with≡ pr3 | yes w with≡ pr4 rewrite pr4 = exFalso (noNotYes (equalityCommutative pr))
|
||||||
|
|
||||||
goIncrOne : (a b : BinNat) → mapMaybe canonical (go one a b) ≡ mapMaybe canonical (go zero a (incr b))
|
goIncrOne : (a b : BinNat) → mapMaybe canonical (go one a b) ≡ mapMaybe canonical (go zero a (incr b))
|
||||||
goIncrOne [] b rewrite goOneEmpty' b | goZeroIncr b = refl
|
goIncrOne [] b rewrite goOneEmpty' b | goZeroIncr b = refl
|
||||||
goIncrOne (zero :: a) [] = refl
|
goIncrOne (zero :: a) [] = refl
|
||||||
goIncrOne (zero :: a) (zero :: b) = refl
|
goIncrOne (zero :: a) (zero :: b) = refl
|
||||||
goIncrOne (zero :: a) (one :: b) with inspect (go one a b)
|
goIncrOne (zero :: a) (one :: b) with inspect (go one a b)
|
||||||
goIncrOne (zero :: a) (one :: b) | no with≡ pr1 with inspect (go zero a (incr b))
|
goIncrOne (zero :: a) (one :: b) | no with≡ pr1 with inspect (go zero a (incr b))
|
||||||
goIncrOne (zero :: a) (one :: b) | no with≡ pr1 | no with≡ pr2 rewrite pr1 | pr2 = refl
|
goIncrOne (zero :: a) (one :: b) | no with≡ pr1 | no with≡ pr2 rewrite pr1 | pr2 = refl
|
||||||
goIncrOne (zero :: a) (one :: b) | no with≡ pr1 | yes x with≡ pr2 with goIncrOne a b
|
goIncrOne (zero :: a) (one :: b) | no with≡ pr1 | yes x with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr1 | pr2 = exFalso (noNotYes f)
|
... | f rewrite pr1 | pr2 = exFalso (noNotYes f)
|
||||||
goIncrOne (zero :: a) (one :: b) | yes x with≡ pr1 with inspect (go zero a (incr b))
|
goIncrOne (zero :: a) (one :: b) | yes x with≡ pr1 with inspect (go zero a (incr b))
|
||||||
goIncrOne (zero :: a) (one :: b) | yes x with≡ pr1 | no with≡ pr2 with goIncrOne a b
|
goIncrOne (zero :: a) (one :: b) | yes x with≡ pr1 | no with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr1 | pr2 = exFalso (noNotYes (equalityCommutative f))
|
... | f rewrite pr1 | pr2 = exFalso (noNotYes (equalityCommutative f))
|
||||||
goIncrOne (zero :: a) (one :: b) | yes x with≡ pr1 | yes y with≡ pr2 with goIncrOne a b
|
goIncrOne (zero :: a) (one :: b) | yes x with≡ pr1 | yes y with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr1 | pr2 | yesInjective f = refl
|
... | f rewrite pr1 | pr2 | yesInjective f = refl
|
||||||
goIncrOne (one :: a) [] rewrite goEmpty a = refl
|
goIncrOne (one :: a) [] rewrite goEmpty a = refl
|
||||||
goIncrOne (one :: a) (zero :: b) = refl
|
goIncrOne (one :: a) (zero :: b) = refl
|
||||||
goIncrOne (one :: a) (one :: b) with inspect (go one a b)
|
goIncrOne (one :: a) (one :: b) with inspect (go one a b)
|
||||||
goIncrOne (one :: a) (one :: b) | no with≡ pr with inspect (go zero a (incr b))
|
goIncrOne (one :: a) (one :: b) | no with≡ pr with inspect (go zero a (incr b))
|
||||||
goIncrOne (one :: a) (one :: b) | no with≡ pr | no with≡ pr2 with goIncrOne a b
|
goIncrOne (one :: a) (one :: b) | no with≡ pr | no with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr | pr2 = refl
|
... | f rewrite pr | pr2 = refl
|
||||||
goIncrOne (one :: a) (one :: b) | no with≡ pr | yes x with≡ pr2 with goIncrOne a b
|
goIncrOne (one :: a) (one :: b) | no with≡ pr | yes x with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr | pr2 = exFalso (noNotYes f)
|
... | f rewrite pr | pr2 = exFalso (noNotYes f)
|
||||||
goIncrOne (one :: a) (one :: b) | yes x with≡ pr with inspect (go zero a (incr b))
|
goIncrOne (one :: a) (one :: b) | yes x with≡ pr with inspect (go zero a (incr b))
|
||||||
goIncrOne (one :: a) (one :: b) | yes x with≡ pr | no with≡ pr2 with goIncrOne a b
|
goIncrOne (one :: a) (one :: b) | yes x with≡ pr | no with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr | pr2 = exFalso (noNotYes (equalityCommutative f))
|
... | f rewrite pr | pr2 = exFalso (noNotYes (equalityCommutative f))
|
||||||
goIncrOne (one :: a) (one :: b) | yes x with≡ pr | yes y with≡ pr2 with goIncrOne a b
|
goIncrOne (one :: a) (one :: b) | yes x with≡ pr | yes y with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr | pr2 | yesInjective f = refl
|
... | f rewrite pr | pr2 | yesInjective f = refl
|
||||||
|
|
||||||
goIncrIncr : (a b : BinNat) → mapMaybe canonical (go zero (incr a) (incr b)) ≡ mapMaybe canonical (go zero a b)
|
goIncrIncr : (a b : BinNat) → mapMaybe canonical (go zero (incr a) (incr b)) ≡ mapMaybe canonical (go zero a b)
|
||||||
goIncrIncr [] [] = refl
|
goIncrIncr [] [] = refl
|
||||||
goIncrIncr [] (zero :: b) with inspect (go zero [] b)
|
goIncrIncr [] (zero :: b) with inspect (go zero [] b)
|
||||||
... | no with≡ pr rewrite goIncrIncr [] b | pr = refl
|
... | no with≡ pr rewrite goIncrIncr [] b | pr = refl
|
||||||
... | yes y with≡ pr rewrite goIncrIncr [] b | pr | goZeroEmpty' b {y} pr = refl
|
... | yes y with≡ pr rewrite goIncrIncr [] b | pr | goZeroEmpty' b {y} pr = refl
|
||||||
goIncrIncr [] (one :: b) rewrite goZeroIncr b = refl
|
goIncrIncr [] (one :: b) rewrite goZeroIncr b = refl
|
||||||
goIncrIncr (zero :: a) [] rewrite goEmpty a = refl
|
goIncrIncr (zero :: a) [] rewrite goEmpty a = refl
|
||||||
goIncrIncr (zero :: a) (zero :: b) = refl
|
goIncrIncr (zero :: a) (zero :: b) = refl
|
||||||
goIncrIncr (zero :: a) (one :: b) with inspect (go zero a (incr b))
|
goIncrIncr (zero :: a) (one :: b) with inspect (go zero a (incr b))
|
||||||
goIncrIncr (zero :: a) (one :: b) | no with≡ pr with inspect (go one a b)
|
goIncrIncr (zero :: a) (one :: b) | no with≡ pr with inspect (go one a b)
|
||||||
goIncrIncr (zero :: a) (one :: b) | no with≡ pr | no with≡ pr2 rewrite pr | pr2 = refl
|
goIncrIncr (zero :: a) (one :: b) | no with≡ pr | no with≡ pr2 rewrite pr | pr2 = refl
|
||||||
goIncrIncr (zero :: a) (one :: b) | no with≡ pr | yes x with≡ pr2 with goIncrOne a b
|
goIncrIncr (zero :: a) (one :: b) | no with≡ pr | yes x with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr | pr2 = exFalso (noNotYes (equalityCommutative f))
|
... | f rewrite pr | pr2 = exFalso (noNotYes (equalityCommutative f))
|
||||||
goIncrIncr (zero :: a) (one :: b) | yes y with≡ pr with inspect (go one a b)
|
goIncrIncr (zero :: a) (one :: b) | yes y with≡ pr with inspect (go one a b)
|
||||||
goIncrIncr (zero :: a) (one :: b) | yes y with≡ pr | yes z with≡ pr2 with goIncrOne a b
|
goIncrIncr (zero :: a) (one :: b) | yes y with≡ pr | yes z with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr | pr2 = applyEquality (λ i → yes (one :: i)) (equalityCommutative (yesInjective f))
|
... | f rewrite pr | pr2 = applyEquality (λ i → yes (one :: i)) (equalityCommutative (yesInjective f))
|
||||||
goIncrIncr (zero :: a) (one :: b) | yes y with≡ pr | no with≡ pr2 with goIncrOne a b
|
goIncrIncr (zero :: a) (one :: b) | yes y with≡ pr | no with≡ pr2 with goIncrOne a b
|
||||||
... | f rewrite pr | pr2 = exFalso (noNotYes f)
|
... | f rewrite pr | pr2 = exFalso (noNotYes f)
|
||||||
goIncrIncr (one :: a) [] with goOne a []
|
goIncrIncr (one :: a) [] with goOne a []
|
||||||
... | f with go one (incr a) []
|
... | f with go one (incr a) []
|
||||||
goIncrIncr (one :: a) [] | f | no rewrite goEmpty a = exFalso (noNotYes f)
|
goIncrIncr (one :: a) [] | f | no rewrite goEmpty a = exFalso (noNotYes f)
|
||||||
goIncrIncr (one :: a) [] | f | yes x rewrite goEmpty a | yesInjective f = refl
|
goIncrIncr (one :: a) [] | f | yes x rewrite goEmpty a | yesInjective f = refl
|
||||||
goIncrIncr (one :: a) (zero :: b) with goOne a b
|
goIncrIncr (one :: a) (zero :: b) with goOne a b
|
||||||
... | f with go one (incr a) b
|
... | f with go one (incr a) b
|
||||||
goIncrIncr (one :: a) (zero :: b) | f | no with go zero a b
|
goIncrIncr (one :: a) (zero :: b) | f | no with go zero a b
|
||||||
goIncrIncr (one :: a) (zero :: b) | f | no | no = refl
|
goIncrIncr (one :: a) (zero :: b) | f | no | no = refl
|
||||||
goIncrIncr (one :: a) (zero :: b) | f | yes x with go zero a b
|
goIncrIncr (one :: a) (zero :: b) | f | yes x with go zero a b
|
||||||
goIncrIncr (one :: a) (zero :: b) | f | yes x | yes x₁ rewrite yesInjective f = refl
|
goIncrIncr (one :: a) (zero :: b) | f | yes x | yes x₁ rewrite yesInjective f = refl
|
||||||
goIncrIncr (one :: a) (one :: b) with goIncrIncr a b
|
goIncrIncr (one :: a) (one :: b) with goIncrIncr a b
|
||||||
... | f with go zero a b
|
... | f with go zero a b
|
||||||
goIncrIncr (one :: a) (one :: b) | f | no with go zero (incr a) (incr b)
|
goIncrIncr (one :: a) (one :: b) | f | no with go zero (incr a) (incr b)
|
||||||
goIncrIncr (one :: a) (one :: b) | f | no | no = refl
|
goIncrIncr (one :: a) (one :: b) | f | no | no = refl
|
||||||
goIncrIncr (one :: a) (one :: b) | f | yes x with go zero (incr a) (incr b)
|
goIncrIncr (one :: a) (one :: b) | f | yes x with go zero (incr a) (incr b)
|
||||||
goIncrIncr (one :: a) (one :: b) | f | yes x | yes x₁ rewrite yesInjective f = refl
|
goIncrIncr (one :: a) (one :: b) | f | yes x | yes x₁ rewrite yesInjective f = refl
|
||||||
|
|
||||||
subtractionConverse : (a b : ℕ) → a <N b → go zero (NToBinNat a) (NToBinNat b) ≡ no
|
subtractionConverse : (a b : ℕ) → a <N b → go zero (NToBinNat a) (NToBinNat b) ≡ no
|
||||||
subtractionConverse zero (succ b) a<b with NToBinNat b
|
subtractionConverse zero (succ b) a<b with NToBinNat b
|
||||||
subtractionConverse zero (succ b) a<b | [] = refl
|
subtractionConverse zero (succ b) a<b | [] = refl
|
||||||
subtractionConverse zero (succ b) a<b | zero :: bl = refl
|
subtractionConverse zero (succ b) a<b | zero :: bl = refl
|
||||||
subtractionConverse zero (succ b) a<b | one :: bl = goZeroIncr bl
|
subtractionConverse zero (succ b) a<b | one :: bl = goZeroIncr bl
|
||||||
subtractionConverse (succ a) (succ b) a<b with inspect (NToBinNat a)
|
subtractionConverse (succ a) (succ b) a<b with inspect (NToBinNat a)
|
||||||
subtractionConverse (succ a) (succ b) a<b | [] with≡ pr with inspect (NToBinNat b)
|
subtractionConverse (succ a) (succ b) a<b | [] with≡ pr with inspect (NToBinNat b)
|
||||||
subtractionConverse (succ a) (succ b) a<b | [] with≡ pr | [] with≡ pr2 rewrite NToBinNatZero a pr | NToBinNatZero b pr2 = exFalso (TotalOrder.irreflexive ℕTotalOrder a<b)
|
subtractionConverse (succ a) (succ b) a<b | [] with≡ pr | [] with≡ pr2 rewrite NToBinNatZero a pr | NToBinNatZero b pr2 = exFalso (TotalOrder.irreflexive ℕTotalOrder a<b)
|
||||||
subtractionConverse (succ a) (succ zero) a<b | [] with≡ pr | (zero :: y) with≡ pr2 rewrite NToBinNatZero a pr | pr2 = exFalso (TotalOrder.irreflexive ℕTotalOrder a<b)
|
subtractionConverse (succ a) (succ zero) a<b | [] with≡ pr | (zero :: y) with≡ pr2 rewrite NToBinNatZero a pr | pr2 = exFalso (TotalOrder.irreflexive ℕTotalOrder a<b)
|
||||||
subtractionConverse (succ a) (succ (succ b)) a<b | [] with≡ pr | (zero :: y) with≡ pr2 with inspect (go zero [] y)
|
subtractionConverse (succ a) (succ (succ b)) a<b | [] with≡ pr | (zero :: y) with≡ pr2 with inspect (go zero [] y)
|
||||||
... | no with≡ pr3 rewrite NToBinNatZero a pr | pr2 | pr3 = refl
|
... | no with≡ pr3 rewrite NToBinNatZero a pr | pr2 | pr3 = refl
|
||||||
... | yes t with≡ pr3 with applyEquality canonical pr2
|
... | yes t with≡ pr3 with applyEquality canonical pr2
|
||||||
... | g rewrite (goZeroEmpty y pr3) = exFalso (incrNonzero (NToBinNat b) g)
|
... | g rewrite (goZeroEmpty y pr3) = exFalso (incrNonzero (NToBinNat b) g)
|
||||||
subtractionConverse (succ a) (succ b) a<b | [] with≡ pr | (one :: y) with≡ pr2 rewrite NToBinNatZero a pr | pr2 = applyEquality (mapMaybe (one ::_)) (goZeroIncr y)
|
subtractionConverse (succ a) (succ b) a<b | [] with≡ pr | (one :: y) with≡ pr2 rewrite NToBinNatZero a pr | pr2 = applyEquality (mapMaybe (one ::_)) (goZeroIncr y)
|
||||||
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr with inspect (NToBinNat b)
|
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr with inspect (NToBinNat b)
|
||||||
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | [] with≡ pr2 rewrite NToBinNatZero b pr2 = exFalso (bad a<b)
|
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | [] with≡ pr2 rewrite NToBinNatZero b pr2 = exFalso (bad a<b)
|
||||||
where
|
where
|
||||||
bad : {a : ℕ} → succ a <N 1 → False
|
bad : {a : ℕ} → succ a <N 1 → False
|
||||||
bad {zero} (le zero ())
|
bad {zero} (le zero ())
|
||||||
bad {zero} (le (succ x) ())
|
bad {zero} (le (succ x) ())
|
||||||
bad {succ a} (le zero ())
|
bad {succ a} (le zero ())
|
||||||
bad {succ a} (le (succ x) ())
|
bad {succ a} (le (succ x) ())
|
||||||
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (zero :: z) with≡ pr2 rewrite pr | pr2 = applyEquality (mapMaybe (zero ::_)) (mapMaybePreservesNo u)
|
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (zero :: z) with≡ pr2 rewrite pr | pr2 = applyEquality (mapMaybe (zero ::_)) (mapMaybePreservesNo u)
|
||||||
where
|
where
|
||||||
t : go zero (NToBinNat a) (NToBinNat b) ≡ no
|
t : go zero (NToBinNat a) (NToBinNat b) ≡ no
|
||||||
t = subtractionConverse a b (canRemoveSuccFrom<N a<b)
|
t = subtractionConverse a b (canRemoveSuccFrom<N a<b)
|
||||||
u : go zero (zero :: y) (zero :: z) ≡ no
|
u : go zero (zero :: y) (zero :: z) ≡ no
|
||||||
u = transitivity (transitivity {x = _} {go zero (NToBinNat a) (zero :: z)} (applyEquality (λ i → go zero i (zero :: z)) (equalityCommutative pr)) (applyEquality (go zero (NToBinNat a)) (equalityCommutative pr2))) t
|
u = transitivity (transitivity {x = _} {go zero (NToBinNat a) (zero :: z)} (applyEquality (λ i → go zero i (zero :: z)) (equalityCommutative pr)) (applyEquality (go zero (NToBinNat a)) (equalityCommutative pr2))) t
|
||||||
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (one :: z) with≡ pr2 with subtractionConverse a (succ b) (le (succ (_<N_.x a<b)) (transitivity (applyEquality succ (transitivity (applyEquality succ (Semiring.commutative ℕSemiring (_<N_.x a<b) a)) (Semiring.commutative ℕSemiring (succ a) (_<N_.x a<b)))) (_<N_.proof a<b)))
|
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (one :: z) with≡ pr2 with subtractionConverse a (succ b) (le (succ (_<N_.x a<b)) (transitivity (applyEquality succ (transitivity (applyEquality succ (Semiring.commutative ℕSemiring (_<N_.x a<b) a)) (Semiring.commutative ℕSemiring (succ a) (_<N_.x a<b)))) (_<N_.proof a<b)))
|
||||||
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (one :: z) with≡ pr2 | thing=no with subLemma3 (NToBinNat a) (incr (NToBinNat b)) thing=no
|
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (one :: z) with≡ pr2 | thing=no with subLemma3 (NToBinNat a) (incr (NToBinNat b)) thing=no
|
||||||
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (one :: z) with≡ pr2 | thing=no | inl x = x
|
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (one :: z) with≡ pr2 | thing=no | inl x = x
|
||||||
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (one :: z) with≡ pr2 | thing=no | inr x rewrite pr | pr2 | mapMaybePreservesNo thing=no = exFalso (noNotYes x)
|
subtractionConverse (succ a) (succ b) a<b | (zero :: y) with≡ pr | (one :: z) with≡ pr2 | thing=no | inr x rewrite pr | pr2 | mapMaybePreservesNo thing=no = exFalso (noNotYes x)
|
||||||
subtractionConverse (succ a) (succ b) a<b | (one :: y) with≡ pr with goIncrIncr (NToBinNat a) (NToBinNat b)
|
subtractionConverse (succ a) (succ b) a<b | (one :: y) with≡ pr with goIncrIncr (NToBinNat a) (NToBinNat b)
|
||||||
... | f rewrite subtractionConverse a b (canRemoveSuccFrom<N a<b) = mapMaybePreservesNo f
|
... | f rewrite subtractionConverse a b (canRemoveSuccFrom<N a<b) = mapMaybePreservesNo f
|
||||||
|
|
||||||
bad : (b : ℕ) {t : BinNat} → incr (NToBinNat b) ≡ zero :: t → canonical t ≡ [] → False
|
bad : (b : ℕ) {t : BinNat} → incr (NToBinNat b) ≡ zero :: t → canonical t ≡ [] → False
|
||||||
bad b {c} t pr with applyEquality canonical t
|
bad b {c} t pr with applyEquality canonical t
|
||||||
... | bl with canonical c
|
... | bl with canonical c
|
||||||
bad b {c} t pr | bl | [] = exFalso (incrNonzero (NToBinNat b) bl)
|
bad b {c} t pr | bl | [] = exFalso (incrNonzero (NToBinNat b) bl)
|
||||||
|
|
||||||
lemma6 : (a : BinNat) (b : ℕ) → canonical a ≡ [] → NToBinNat b ≡ one :: a → a ≡ []
|
lemma6 : (a : BinNat) (b : ℕ) → canonical a ≡ [] → NToBinNat b ≡ one :: a → a ≡ []
|
||||||
lemma6 [] b pr1 pr2 = refl
|
lemma6 [] b pr1 pr2 = refl
|
||||||
lemma6 (a :: as) b pr1 pr2 with applyEquality canonical pr2
|
lemma6 (a :: as) b pr1 pr2 with applyEquality canonical pr2
|
||||||
lemma6 (a :: as) b pr1 pr2 | th rewrite pr1 | equalityCommutative (NToBinNatIsCanonical b) | pr2 = exFalso (bad' th)
|
lemma6 (a :: as) b pr1 pr2 | th rewrite pr1 | equalityCommutative (NToBinNatIsCanonical b) | pr2 = exFalso (bad' th)
|
||||||
where
|
where
|
||||||
bad' : one :: a :: as ≡ one :: [] → False
|
bad' : one :: a :: as ≡ one :: [] → False
|
||||||
bad' ()
|
bad' ()
|
||||||
|
|
||||||
doublingLemma : (y : BinNat) → NToBinNat (2 *N binNatToN y) ≡ canonical (zero :: y)
|
doublingLemma : (y : BinNat) → NToBinNat (2 *N binNatToN y) ≡ canonical (zero :: y)
|
||||||
doublingLemma y with inspect (canonical y)
|
doublingLemma y with inspect (canonical y)
|
||||||
@@ -409,58 +409,58 @@ private
|
|||||||
doubling : (a : ℕ) {y : BinNat} → (NToBinNat a ≡ zero :: y) → binNatToN y +N (binNatToN y +N 0) ≡ a
|
doubling : (a : ℕ) {y : BinNat} → (NToBinNat a ≡ zero :: y) → binNatToN y +N (binNatToN y +N 0) ≡ a
|
||||||
doubling a {y} pr = NToBinNatInj (binNatToN y +N (binNatToN y +N zero)) a (transitivity (transitivity (equalityCommutative (NToBinNatIsCanonical (binNatToN y +N (binNatToN y +N zero)))) (doublingLemma y)) (applyEquality canonical (equalityCommutative pr)))
|
doubling a {y} pr = NToBinNatInj (binNatToN y +N (binNatToN y +N zero)) a (transitivity (transitivity (equalityCommutative (NToBinNatIsCanonical (binNatToN y +N (binNatToN y +N zero)))) (doublingLemma y)) (applyEquality canonical (equalityCommutative pr)))
|
||||||
|
|
||||||
subtraction2 : (a b : ℕ) {t : BinNat} → (NToBinNat a) -B (NToBinNat b) ≡ yes t → (binNatToN t) +N b ≡ a
|
subtraction2 : (a b : ℕ) {t : BinNat} → (NToBinNat a) -B (NToBinNat b) ≡ yes t → (binNatToN t) +N b ≡ a
|
||||||
subtraction2 zero zero {t} pr rewrite yesInjective (equalityCommutative pr) = refl
|
subtraction2 zero zero {t} pr rewrite yesInjective (equalityCommutative pr) = refl
|
||||||
subtraction2 zero (succ b) pr with goZeroEmpty (NToBinNat (succ b)) pr
|
subtraction2 zero (succ b) pr with goZeroEmpty (NToBinNat (succ b)) pr
|
||||||
... | t = exFalso (incrNonzero (NToBinNat b) t)
|
... | t = exFalso (incrNonzero (NToBinNat b) t)
|
||||||
subtraction2 (succ a) b {t} pr with inspect (NToBinNat a)
|
subtraction2 (succ a) b {t} pr with inspect (NToBinNat a)
|
||||||
subtraction2 (succ a) b {t} pr | [] with≡ pr2 with inspect (NToBinNat b)
|
subtraction2 (succ a) b {t} pr | [] with≡ pr2 with inspect (NToBinNat b)
|
||||||
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | [] with≡ pr3 rewrite pr2 | pr3 | equalityCommutative (yesInjective pr) | NToBinNatZero a pr2 | NToBinNatZero b pr3 = refl
|
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | [] with≡ pr3 rewrite pr2 | pr3 | equalityCommutative (yesInjective pr) | NToBinNatZero a pr2 | NToBinNatZero b pr3 = refl
|
||||||
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (zero :: bl) with≡ pr3 with inspect (go zero [] bl)
|
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (zero :: bl) with≡ pr3 with inspect (go zero [] bl)
|
||||||
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (zero :: bl) with≡ pr3 | no with≡ pr4 rewrite pr2 | pr3 | pr4 = exFalso (noNotYes pr)
|
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (zero :: bl) with≡ pr3 | no with≡ pr4 rewrite pr2 | pr3 | pr4 = exFalso (noNotYes pr)
|
||||||
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (zero :: bl) with≡ pr3 | yes x with≡ pr4 with goZeroEmpty bl pr4
|
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (zero :: bl) with≡ pr3 | yes x with≡ pr4 with goZeroEmpty bl pr4
|
||||||
subtraction2 (succ a) (succ b) {t} pr | [] with≡ pr2 | (zero :: bl) with≡ pr3 | yes x with≡ pr4 | r with goZeroEmpty' bl pr4
|
subtraction2 (succ a) (succ b) {t} pr | [] with≡ pr2 | (zero :: bl) with≡ pr3 | yes x with≡ pr4 | r with goZeroEmpty' bl pr4
|
||||||
... | s rewrite pr2 | pr3 | pr4 | r | equalityCommutative (yesInjective pr) | NToBinNatZero a pr2 = exFalso (bad b pr3 r)
|
... | s rewrite pr2 | pr3 | pr4 | r | equalityCommutative (yesInjective pr) | NToBinNatZero a pr2 = exFalso (bad b pr3 r)
|
||||||
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (one :: bl) with≡ pr3 with inspect (go zero [] bl)
|
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (one :: bl) with≡ pr3 with inspect (go zero [] bl)
|
||||||
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (one :: bl) with≡ pr3 | no with≡ pr4 rewrite pr2 | pr3 | pr4 = exFalso (noNotYes pr)
|
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (one :: bl) with≡ pr3 | no with≡ pr4 rewrite pr2 | pr3 | pr4 = exFalso (noNotYes pr)
|
||||||
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (one :: bl) with≡ pr3 | yes x with≡ pr4 with goZeroEmpty bl pr4
|
subtraction2 (succ a) b {t} pr | [] with≡ pr2 | (one :: bl) with≡ pr3 | yes x with≡ pr4 with goZeroEmpty bl pr4
|
||||||
... | u with goZeroEmpty' bl pr4
|
... | u with goZeroEmpty' bl pr4
|
||||||
... | v rewrite pr2 | pr3 | pr4 | u | NToBinNatZero a pr2 | lemma6 bl b u pr3 | equalityCommutative (yesInjective pr4) | equalityCommutative (yesInjective pr) = ans pr3
|
... | v rewrite pr2 | pr3 | pr4 | u | NToBinNatZero a pr2 | lemma6 bl b u pr3 | equalityCommutative (yesInjective pr4) | equalityCommutative (yesInjective pr) = ans pr3
|
||||||
where
|
where
|
||||||
z : bl ≡ []
|
z : bl ≡ []
|
||||||
z = lemma6 bl b u pr3
|
z = lemma6 bl b u pr3
|
||||||
ans : (NToBinNat b ≡ one :: bl) → b ≡ 1
|
ans : (NToBinNat b ≡ one :: bl) → b ≡ 1
|
||||||
ans pr with applyEquality binNatToN pr
|
ans pr with applyEquality binNatToN pr
|
||||||
... | th rewrite z = transitivity (equalityCommutative (nToN b)) th
|
... | th rewrite z = transitivity (equalityCommutative (nToN b)) th
|
||||||
subtraction2 (succ a) b pr | (x :: y) with≡ pr2 with inspect (NToBinNat b)
|
subtraction2 (succ a) b pr | (x :: y) with≡ pr2 with inspect (NToBinNat b)
|
||||||
subtraction2 (succ a) b pr | (zero :: y) with≡ pr2 | [] with≡ pr3 rewrite NToBinNatZero b pr3 | pr2 | pr3 | equalityCommutative (yesInjective pr) = applyEquality succ (transitivity (Semiring.sumZeroRight ℕSemiring _) (doubling a pr2))
|
subtraction2 (succ a) b pr | (zero :: y) with≡ pr2 | [] with≡ pr3 rewrite NToBinNatZero b pr3 | pr2 | pr3 | equalityCommutative (yesInjective pr) = applyEquality succ (transitivity (Semiring.sumZeroRight ℕSemiring _) (doubling a pr2))
|
||||||
subtraction2 (succ a) b pr | (one :: y) with≡ pr2 | [] with≡ pr3 rewrite NToBinNatZero b pr3 | pr2 | pr3 | equalityCommutative (yesInjective pr) = transitivity (Semiring.sumZeroRight ℕSemiring (binNatToN (incr y) +N (binNatToN (incr y) +N zero))) (equalityCommutative (transitivity (equalityCommutative (nToN (succ a))) (applyEquality binNatToN (transitivity (equalityCommutative (NToBinNatSucc a)) (applyEquality incr pr2)))))
|
subtraction2 (succ a) b pr | (one :: y) with≡ pr2 | [] with≡ pr3 rewrite NToBinNatZero b pr3 | pr2 | pr3 | equalityCommutative (yesInjective pr) = transitivity (Semiring.sumZeroRight ℕSemiring (binNatToN (incr y) +N (binNatToN (incr y) +N zero))) (equalityCommutative (transitivity (equalityCommutative (nToN (succ a))) (applyEquality binNatToN (transitivity (equalityCommutative (NToBinNatSucc a)) (applyEquality incr pr2)))))
|
||||||
subtraction2 (succ a) (succ b) {t} pr | (y :: ys) with≡ pr2 | (z :: zs) with≡ pr3 = transitivity (transitivity (Semiring.commutative ℕSemiring (binNatToN t) (succ b)) (applyEquality succ (transitivity (Semiring.commutative ℕSemiring b (binNatToN t)) (applyEquality (_+N b) (equalityCommutative (binNatToNIsCanonical t)))))) (applyEquality succ inter)
|
subtraction2 (succ a) (succ b) {t} pr | (y :: ys) with≡ pr2 | (z :: zs) with≡ pr3 = transitivity (transitivity (Semiring.commutative ℕSemiring (binNatToN t) (succ b)) (applyEquality succ (transitivity (Semiring.commutative ℕSemiring b (binNatToN t)) (applyEquality (_+N b) (equalityCommutative (binNatToNIsCanonical t)))))) (applyEquality succ inter)
|
||||||
where
|
where
|
||||||
inter : binNatToN (canonical t) +N b ≡ a
|
inter : binNatToN (canonical t) +N b ≡ a
|
||||||
inter with inspect (go zero (NToBinNat a) (NToBinNat b))
|
inter with inspect (go zero (NToBinNat a) (NToBinNat b))
|
||||||
inter | no with≡ pr4 with goIncrIncr (NToBinNat a) (NToBinNat b)
|
inter | no with≡ pr4 with goIncrIncr (NToBinNat a) (NToBinNat b)
|
||||||
... | f rewrite pr | pr4 = exFalso (noNotYes (equalityCommutative f))
|
... | f rewrite pr | pr4 = exFalso (noNotYes (equalityCommutative f))
|
||||||
inter | yes x with≡ pr4 with goIncrIncr (NToBinNat a) (NToBinNat b)
|
inter | yes x with≡ pr4 with goIncrIncr (NToBinNat a) (NToBinNat b)
|
||||||
... | f with subtraction2 a b {x} pr4
|
... | f with subtraction2 a b {x} pr4
|
||||||
... | g = transitivity (applyEquality (_+N b) (transitivity (applyEquality binNatToN h) (binNatToNIsCanonical x))) g
|
... | g = transitivity (applyEquality (_+N b) (transitivity (applyEquality binNatToN h) (binNatToNIsCanonical x))) g
|
||||||
where
|
where
|
||||||
h : (canonical t) ≡ (canonical x)
|
h : (canonical t) ≡ (canonical x)
|
||||||
h rewrite pr | pr4 = yesInjective f
|
h rewrite pr | pr4 = yesInjective f
|
||||||
|
|
||||||
|
|
||||||
subtraction2' : (a b : ℕ) {t : BinNat} → (NToBinNat a) -B (NToBinNat b) ≡ yes t → b ≤N a
|
subtraction2' : (a b : ℕ) {t : BinNat} → (NToBinNat a) -B (NToBinNat b) ≡ yes t → b ≤N a
|
||||||
subtraction2' a b {t} pr with subtraction2 a b pr
|
subtraction2' a b {t} pr with subtraction2 a b pr
|
||||||
... | f with binNatToN t
|
... | f with binNatToN t
|
||||||
subtraction2' a b {t} pr | f | zero = inr f
|
subtraction2' a b {t} pr | f | zero = inr f
|
||||||
subtraction2' a b {t} pr | f | succ g = inl (le g f)
|
subtraction2' a b {t} pr | f | succ g = inl (le g f)
|
||||||
|
|
||||||
subtraction2'' : (a b : ℕ) → (pr : b ≤N a) → mapMaybe binNatToN ((NToBinNat a) -B (NToBinNat b)) ≡ yes (subtractionNResult.result (-N pr))
|
subtraction2'' : (a b : ℕ) → (pr : b ≤N a) → mapMaybe binNatToN ((NToBinNat a) -B (NToBinNat b)) ≡ yes (subtractionNResult.result (-N pr))
|
||||||
subtraction2'' a b pr with -N pr
|
subtraction2'' a b pr with -N pr
|
||||||
subtraction2'' a b pr | record { result = result ; pr = subPr } with inspect (go zero (NToBinNat a) (NToBinNat b))
|
subtraction2'' a b pr | record { result = result ; pr = subPr } with inspect (go zero (NToBinNat a) (NToBinNat b))
|
||||||
subtraction2'' a b (inl pr) | record { result = result ; pr = subPr } | no with≡ pr2 with subtraction (NToBinNat a) (NToBinNat b) pr2
|
subtraction2'' a b (inl pr) | record { result = result ; pr = subPr } | no with≡ pr2 with subtraction (NToBinNat a) (NToBinNat b) pr2
|
||||||
... | bl rewrite nToN a | nToN b = exFalso (TotalOrder.irreflexive ℕTotalOrder (TotalOrder.<Transitive ℕTotalOrder pr bl))
|
... | bl rewrite nToN a | nToN b = exFalso (TotalOrder.irreflexive ℕTotalOrder (TotalOrder.<Transitive ℕTotalOrder pr bl))
|
||||||
subtraction2'' a b (inr pr) | record { result = result ; pr = subPr } | no with≡ pr2 with subtraction (NToBinNat a) (NToBinNat b) pr2
|
subtraction2'' a b (inr pr) | record { result = result ; pr = subPr } | no with≡ pr2 with subtraction (NToBinNat a) (NToBinNat b) pr2
|
||||||
... | bl rewrite nToN a | nToN b | pr = exFalso (TotalOrder.irreflexive ℕTotalOrder bl)
|
... | bl rewrite nToN a | nToN b | pr = exFalso (TotalOrder.irreflexive ℕTotalOrder bl)
|
||||||
subtraction2'' a b pr | record { result = result ; pr = subPr } | yes x with≡ pr2 with subtraction2 a b pr2
|
subtraction2'' a b pr | record { result = result ; pr = subPr } | yes x with≡ pr2 with subtraction2 a b pr2
|
||||||
... | f rewrite pr2 | Semiring.commutative ℕSemiring (binNatToN x) b = applyEquality yes (canSubtractFromEqualityLeft {b} {binNatToN x} (transitivity f (equalityCommutative subPr)))
|
... | f rewrite pr2 | Semiring.commutative ℕSemiring (binNatToN x) b = applyEquality yes (canSubtractFromEqualityLeft {b} {binNatToN x} (transitivity f (equalityCommutative subPr)))
|
||||||
|
|||||||
@@ -16,12 +16,6 @@ numbers<N : (N : ℕ) → List ℕ
|
|||||||
numbers<N zero = []
|
numbers<N zero = []
|
||||||
numbers<N (succ N) = N :: numbers<N N
|
numbers<N (succ N) = N :: numbers<N N
|
||||||
|
|
||||||
filter' : {a b : _} {A : Set a} {f : A → Set b} (decidable : (x : A) → (f x) || (f x → False)) → List A → List A
|
|
||||||
filter' {f} decid [] = []
|
|
||||||
filter' {f} decid (x :: xs) with decid x
|
|
||||||
filter' {f} decid (x :: xs) | inl fx = x :: filter' decid xs
|
|
||||||
filter' {f} decid (x :: xs) | inr Notfx = filter' decid xs
|
|
||||||
|
|
||||||
filtered : (N : ℕ) → List ℕ
|
filtered : (N : ℕ) → List ℕ
|
||||||
filtered N = filter' (orDecidable (divisionDecidable 3) (divisionDecidable 5)) (numbers<N N)
|
filtered N = filter' (orDecidable (divisionDecidable 3) (divisionDecidable 5)) (numbers<N N)
|
||||||
|
|
||||||
@@ -31,5 +25,5 @@ ans n = binNatToN (fold _+B_ (NToBinNat 0) (map NToBinNat (filtered n)))
|
|||||||
t : ans 10 ≡ 23
|
t : ans 10 ≡ 23
|
||||||
t = refl
|
t = refl
|
||||||
|
|
||||||
--q : ans 1000 ≡ 0 -- takes about 15secs for me to reduce the term that fills this hole
|
--q : ans 1000 ≡ {!233168!} -- takes about 15secs for me to reduce the term that fills this hole
|
||||||
--q = refl
|
--q = refl
|
||||||
|
|||||||
176
ProjectEuler/Problem2.agda
Normal file
176
ProjectEuler/Problem2.agda
Normal file
@@ -0,0 +1,176 @@
|
|||||||
|
{-# OPTIONS --warning=error --safe --guardedness --without-K #-}
|
||||||
|
|
||||||
|
open import LogicalFormulae
|
||||||
|
open import Agda.Primitive using (Level; lzero; lsuc; _⊔_)
|
||||||
|
open import Numbers.Naturals.Semiring
|
||||||
|
open import Numbers.Naturals.Naturals
|
||||||
|
open import Numbers.Naturals.Order
|
||||||
|
open import Numbers.Naturals.EuclideanAlgorithm
|
||||||
|
open import Lists.Lists
|
||||||
|
open import Numbers.Primes.PrimeNumbers
|
||||||
|
open import Decidable.Relations
|
||||||
|
open import Numbers.BinaryNaturals.Definition
|
||||||
|
open import Numbers.BinaryNaturals.Addition
|
||||||
|
open import Numbers.BinaryNaturals.Order
|
||||||
|
open import Sequences
|
||||||
|
open import Vectors
|
||||||
|
open import Orders.Total.Definition
|
||||||
|
open import Setoids.Orders.Partial.Definition
|
||||||
|
open import Setoids.Orders.Partial.Sequences
|
||||||
|
open import Setoids.Orders.Total.Definition
|
||||||
|
open import Setoids.Setoids
|
||||||
|
open import Functions.Definition
|
||||||
|
open import Semirings.Definition
|
||||||
|
|
||||||
|
module ProjectEuler.Problem2 where
|
||||||
|
|
||||||
|
fibUnary : ℕ → ℕ
|
||||||
|
fibUnary zero = 1
|
||||||
|
fibUnary (succ zero) = 1
|
||||||
|
fibUnary (succ (succ n)) = fibUnary (succ n) +N fibUnary n
|
||||||
|
|
||||||
|
fibUnaryStrictlyPositive : (a : ℕ) → 0 <N fibUnary a
|
||||||
|
fibUnaryStrictlyPositive zero = le zero refl
|
||||||
|
fibUnaryStrictlyPositive (succ zero) = le zero refl
|
||||||
|
fibUnaryStrictlyPositive (succ (succ a)) = addStrongInequalities (fibUnaryStrictlyPositive (succ a)) (fibUnaryStrictlyPositive a)
|
||||||
|
|
||||||
|
fibUnaryIncreasing : (a : ℕ) → (fibUnary (succ a)) <N (fibUnary (succ (succ a)))
|
||||||
|
fibUnaryIncreasing zero = le zero refl
|
||||||
|
fibUnaryIncreasing (succ a) = identityOfIndiscernablesLeft _<N_ (additionPreservesInequalityOnLeft (fibUnary (succ a) +N fibUnary a) (fibUnaryStrictlyPositive (succ a))) (Semiring.sumZeroRight ℕSemiring (fibUnary (succ a) +N fibUnary a))
|
||||||
|
|
||||||
|
fibUnaryBiggerThanN : (a : ℕ) → (succ (succ (succ (succ a)))) <N fibUnary (succ (succ (succ (succ a))))
|
||||||
|
fibUnaryBiggerThanN zero = le zero refl
|
||||||
|
fibUnaryBiggerThanN (succ a) = TotalOrder.<Transitive ℕTotalOrder (succPreservesInequality (fibUnaryBiggerThanN a)) (ans ((fibUnary (succ a) +N fibUnary a) +N fibUnary (succ a)) ans')
|
||||||
|
where
|
||||||
|
ans : {t : ℕ} → (u : ℕ) → 1 <N u → succ t <N t +N u
|
||||||
|
ans {t} u (le x proof) rewrite Semiring.commutative ℕSemiring x 1 = le x (transitivity (applyEquality succ (Semiring.commutative ℕSemiring x (succ t))) (transitivity (applyEquality (λ i → succ (succ i)) (Semiring.commutative ℕSemiring t x)) (transitivity (applyEquality (_+N t) proof) (Semiring.commutative ℕSemiring u t))))
|
||||||
|
ans' : 1 <N (fibUnary (succ a) +N fibUnary a) +N fibUnary (succ a)
|
||||||
|
ans' with fibUnaryStrictlyPositive (succ a)
|
||||||
|
... | fibPos with fibUnary (succ a)
|
||||||
|
ans' | fibPos | succ bl rewrite Semiring.commutative ℕSemiring (bl +N fibUnary a) (succ bl) = succPreservesInequality (le (bl +N (bl +N fibUnary a)) (Semiring.sumZeroRight ℕSemiring _))
|
||||||
|
|
||||||
|
fibUnaryArchimedean : (a : ℕ) → Sg ℕ (λ i → a <N fibUnary i)
|
||||||
|
fibUnaryArchimedean zero = 0 , le zero refl
|
||||||
|
fibUnaryArchimedean (succ zero) = 2 , le zero refl
|
||||||
|
fibUnaryArchimedean (succ (succ zero)) = 3 , le zero refl
|
||||||
|
fibUnaryArchimedean (succ (succ (succ zero))) = 4 , le 1 refl
|
||||||
|
fibUnaryArchimedean (succ (succ (succ (succ a)))) = (succ (succ (succ (succ a)))) , fibUnaryBiggerThanN a
|
||||||
|
|
||||||
|
record FibEntry : Set where
|
||||||
|
field
|
||||||
|
prev : BinNat
|
||||||
|
curr : BinNat
|
||||||
|
|
||||||
|
nextFib : FibEntry → FibEntry
|
||||||
|
nextFib record { prev = prev ; curr = curr } = record { prev = curr ; curr = prev +B curr }
|
||||||
|
|
||||||
|
fib : Sequence BinNat
|
||||||
|
fib = Sequences.map FibEntry.curr (unfold nextFib record { prev = NToBinNat 0 ; curr = NToBinNat 1 })
|
||||||
|
|
||||||
|
fibMove : (n : ℕ) → FibEntry.prev (index (unfold nextFib (record { prev = [] ; curr = one :: [] })) (succ n)) ≡ FibEntry.curr (index (unfold nextFib (record { prev = [] ; curr = one :: [] })) n)
|
||||||
|
fibMove zero = refl
|
||||||
|
fibMove (succ n) rewrite indexAndUnfold nextFib (record { prev = [] ; curr = one :: [] }) (succ n) = refl
|
||||||
|
|
||||||
|
fibAlternative : (N : ℕ) → index fib N ≡ FibEntry.curr (index (unfold nextFib (record { prev = [] ; curr = one :: [] })) N)
|
||||||
|
fibAlternative n rewrite equalityCommutative (mapAndIndex (unfold nextFib record { prev = NToBinNat 0 ; curr = NToBinNat 1 }) FibEntry.curr n) = refl
|
||||||
|
|
||||||
|
fibAlternative' : (n : ℕ) → FibEntry.curr (index (unfold nextFib (record { prev = [] ; curr = one :: [] })) (succ n)) ≡ FibEntry.prev (index (unfold nextFib (record { prev = [] ; curr = one :: [] })) n) +B FibEntry.curr (index (unfold nextFib (record { prev = [] ; curr = one :: [] })) n)
|
||||||
|
fibAlternative' zero = refl
|
||||||
|
fibAlternative' (succ n) rewrite indexAndUnfold nextFib (record { prev = [] ; curr = one :: [] }) (succ n) = refl
|
||||||
|
|
||||||
|
fibsCanonical : (n : ℕ) → canonical (index fib n) ≡ index fib n
|
||||||
|
fibsCanonical zero = refl
|
||||||
|
fibsCanonical (succ zero) = refl
|
||||||
|
fibsCanonical (succ (succ n)) = transitivity (applyEquality canonical {index fib (succ (succ n))} {FibEntry.prev (index (unfold nextFib (nextFib (record { prev = [] ; curr = one :: [] }))) n) +B FibEntry.curr (index (unfold nextFib (nextFib (record { prev = [] ; curr = one :: [] }))) n)} (transitivity (fibAlternative (succ (succ n))) (fibAlternative' (succ n)))) (transitivity (sumCanonical (FibEntry.prev (index (unfold nextFib (nextFib (record { prev = [] ; curr = one :: [] }))) n)) (FibEntry.curr (index (unfold nextFib (nextFib (record { prev = [] ; curr = one :: [] }))) n)) (transitivity (transitivity (applyEquality canonical (fibMove n)) (transitivity (applyEquality canonical (equalityCommutative (fibAlternative n))) (transitivity (fibsCanonical n) (fibAlternative n)))) (equalityCommutative (fibMove n))) (transitivity (applyEquality canonical (mapAndIndex (unfold nextFib (nextFib (record { prev = [] ; curr = one :: [] }))) FibEntry.curr n)) (transitivity (fibsCanonical (succ n)) (equalityCommutative (mapAndIndex (unfold nextFib (nextFib (record { prev = [] ; curr = one :: [] }))) FibEntry.curr n))))) (equalityCommutative (transitivity (fibAlternative (succ (succ n))) (fibAlternative' (succ n)))))
|
||||||
|
|
||||||
|
fibStart : take 5 fib ≡ vecMap NToBinNat (1 ,- 1 ,- 2 ,- 3 ,- 5 ,- [])
|
||||||
|
fibStart = refl
|
||||||
|
|
||||||
|
fibsMatch : (n : ℕ) → binNatToN (index fib n) ≡ fibUnary n
|
||||||
|
fibsMatch zero = refl
|
||||||
|
fibsMatch (succ zero) = refl
|
||||||
|
fibsMatch (succ (succ n)) rewrite equalityCommutative (fibsMatch (succ n)) | equalityCommutative (fibsMatch n) | equalityCommutative (mapAndIndex (unfold nextFib record { prev = NToBinNat 0 ; curr = NToBinNat 1 }) FibEntry.curr (succ (succ n))) | indexAndUnfold nextFib (record { prev = [] ; curr = one :: [] }) (succ n) | equalityCommutative (mapAndIndex (unfold nextFib (nextFib (record { prev = [] ; curr = one :: [] }))) FibEntry.curr n) | equalityCommutative (mapAndIndex (unfold nextFib (record { prev = [] ; curr = one :: [] })) FibEntry.curr n) | indexAndUnfold nextFib (nextFib (record { prev = [] ; curr = one :: [] })) n | indexAndUnfold nextFib (record { prev = [] ; curr = one :: [] }) n = ans
|
||||||
|
where
|
||||||
|
x = FibEntry.curr (index (unfold nextFib (record { prev = [] ; curr = one :: [] })) n)
|
||||||
|
y = FibEntry.prev (index (unfold nextFib (record { prev = [] ; curr = one :: [] })) n)
|
||||||
|
ans : binNatToN (x +B (y +B x)) ≡ binNatToN (y +B x) +N binNatToN x
|
||||||
|
ans rewrite +BCommutative x (y +B x) = +BIsHom (y +B x) x
|
||||||
|
|
||||||
|
fibsMatch' : (n : ℕ) → NToBinNat (fibUnary n) ≡ index fib n
|
||||||
|
fibsMatch' n = transitivity (applyEquality NToBinNat (equalityCommutative (fibsMatch n))) (transitivity (binToBin (index fib n)) (fibsCanonical n))
|
||||||
|
|
||||||
|
ArchimedeanSequence : {a b c : _} {A : Set a} {S : Setoid {a} {b} A} {_<_ : Rel {a} {c} A} (pOrder : SetoidPartialOrder S _<_) (S : Sequence A) → Set (a ⊔ c)
|
||||||
|
ArchimedeanSequence {A = A} {_<_ = _<_} _ S = (x : A) → Sg ℕ (λ n → x < (index S n))
|
||||||
|
|
||||||
|
archimImpliesTailArchim : {a b c : _} {A : Set a} {S : Setoid {a} {b} A} {_<_ : Rel {a} {c} A} (pOrder : SetoidPartialOrder S _<_) {S : Sequence A} → ArchimedeanSequence pOrder S → (Sg ℕ (λ i → index S 0 < index S i)) → ArchimedeanSequence pOrder (Sequence.tail S)
|
||||||
|
archimImpliesTailArchim {S} pOrder arch 0small x with arch x
|
||||||
|
archimImpliesTailArchim pOrder {S} arch (zero , S0<SN) x | zero , pr = exFalso (SetoidPartialOrder.irreflexive pOrder S0<SN)
|
||||||
|
archimImpliesTailArchim pOrder {S} arch (succ N , S0<SN) x | zero , pr = N , SetoidPartialOrder.<Transitive pOrder pr S0<SN
|
||||||
|
archimImpliesTailArchim pOrder arch 0small x | succ N , pr = N , pr
|
||||||
|
|
||||||
|
takeUpTo : {a b c : _} {A : Set a} {S : Setoid {a} {b} A} {_<_ : Rel {a} {c} A} {pOrder : SetoidPartialOrder S _<_} {seq : Sequence A} → (arch : ArchimedeanSequence pOrder seq) → (lim : A) → List A
|
||||||
|
takeUpTo {seq = S} arch lim with arch lim
|
||||||
|
takeUpTo {seq = S} arch lim | zero , pr = []
|
||||||
|
takeUpTo {seq = S} arch lim | succ N , pr = vecToList (take N S)
|
||||||
|
|
||||||
|
archim : ArchimedeanSequence (partialOrderToSetoidPartialOrder BinNatOrder) fib
|
||||||
|
archim x with fibUnaryArchimedean (binNatToN x)
|
||||||
|
archim x | N , pr = N , u
|
||||||
|
where
|
||||||
|
t : (canonical x) <B (NToBinNat (binNatToN (index (Sequences.map FibEntry.curr (unfold nextFib (record { prev = [] ; curr = one :: [] }))) N)))
|
||||||
|
t rewrite (fibsMatch N) = identityOfIndiscernablesLeft _<B_ (translate' _ _ pr) (binToBin x)
|
||||||
|
u : x <B (index (Sequences.map FibEntry.curr (unfold nextFib (record { prev = [] ; curr = one :: [] }))) N)
|
||||||
|
u rewrite equalityCommutative (mapAndIndex (unfold nextFib (record { prev = [] ; curr = one :: [] })) FibEntry.curr N) with transitivity (canonicalFirst x (NToBinNat (fibUnary N)) Equal) (identityOfIndiscernablesLeft _<B_ (translate' (binNatToN x) (fibUnary N) pr) (binToBin x))
|
||||||
|
... | r = identityOfIndiscernablesRight {a = x} {b = NToBinNat (fibUnary N)} {c = FibEntry.curr (index (unfold nextFib (record { prev = [] ; curr = one :: [] })) N)} _<B_ r (transitivity (fibsMatch' N) (fibAlternative N))
|
||||||
|
|
||||||
|
isEven : BinNat → Set
|
||||||
|
isEven [] = True
|
||||||
|
isEven (zero :: xs) = True
|
||||||
|
isEven (one :: xs) = False
|
||||||
|
|
||||||
|
isEvenAgrees : (n : BinNat) → isEven n → 2 ∣ (binNatToN n)
|
||||||
|
isEvenAgrees [] nEven = divides (record { quot = zero ; rem = zero ; pr = refl ; remIsSmall = inl (le 1 refl) ; quotSmall = inl (le 1 refl)}) refl
|
||||||
|
isEvenAgrees (zero :: n) nEven = divides (record { quot = binNatToN n ; rem = zero ; pr = Semiring.sumZeroRight ℕSemiring _ ; remIsSmall = inl (le 1 refl) ; quotSmall = inl (le 1 refl) }) refl
|
||||||
|
|
||||||
|
isEvenIncrs : (n : BinNat) → isEven n → isEven (incr (incr n))
|
||||||
|
isEvenIncrs [] nEven = record {}
|
||||||
|
isEvenIncrs (zero :: n) nEven = record {}
|
||||||
|
|
||||||
|
isEvenAgrees' : (n : ℕ) → 2 ∣ n → isEven (NToBinNat n)
|
||||||
|
isEvenAgrees' zero nEven = record {}
|
||||||
|
isEvenAgrees' (succ zero) (divides record { quot = (succ zero) ; rem = zero ; pr = () ; remIsSmall = remIsSmall ; quotSmall = (inl x) } refl)
|
||||||
|
isEvenAgrees' (succ zero) (divides record { quot = (succ (succ quot)) ; rem = zero ; pr = () ; remIsSmall = remIsSmall ; quotSmall = (inl x) } refl)
|
||||||
|
isEvenAgrees' (succ (succ n)) (divides record { quot = succ quot ; rem = zero ; pr = pr ; remIsSmall = remIsSmall ; quotSmall = inl 0<2 } refl) with isEvenAgrees' n (divides record { quot = quot ; rem = zero ; pr = transitivity (transitivity (Semiring.sumZeroRight ℕSemiring _) (Semiring.commutative ℕSemiring quot (quot +N 0))) (succInjective (succInjective (transitivity (equalityCommutative (applyEquality succ (transitivity (Semiring.sumZeroRight ℕSemiring (quot +N succ (quot +N zero))) (Semiring.commutative ℕSemiring quot (succ (quot +N 0)))))) pr))) ; remIsSmall = remIsSmall ; quotSmall = inl 0<2 } refl)
|
||||||
|
... | bl = isEvenIncrs (NToBinNat n) bl
|
||||||
|
|
||||||
|
isEvenWellDefined : (n m : BinNat) → canonical n ≡ canonical m → isEven n → isEven m
|
||||||
|
isEvenWellDefined [] [] n=m nEven = record {}
|
||||||
|
isEvenWellDefined [] (zero :: m) n=m nEven = record {}
|
||||||
|
isEvenWellDefined (zero :: n) [] n=m nEven = record {}
|
||||||
|
isEvenWellDefined (zero :: n) (zero :: m) n=m nEven = record {}
|
||||||
|
isEvenWellDefined (zero :: n) (one :: m) n=m nEven with canonical n
|
||||||
|
isEvenWellDefined (zero :: n) (one :: m) () nEven | []
|
||||||
|
isEvenWellDefined (zero :: n) (one :: m) () nEven | x :: bl
|
||||||
|
|
||||||
|
isEvenDecidable : DecidableRelation isEven
|
||||||
|
isEvenDecidable [] = inl (record {})
|
||||||
|
isEvenDecidable (zero :: x₁) = inl (record {})
|
||||||
|
isEvenDecidable (one :: x₁) = inr (λ x → x)
|
||||||
|
|
||||||
|
increasing : StrictlyIncreasing (partialOrderToSetoidPartialOrder BinNatOrder) (Sequence.tail fib)
|
||||||
|
increasing m = SetoidPartialOrder.<WellDefined (partialOrderToSetoidPartialOrder BinNatOrder) (fibsMatch' (succ m)) (fibsMatch' (succ (succ m))) (translate' (fibUnary (succ m)) (fibUnary (succ (succ m))) (fibUnaryIncreasing m))
|
||||||
|
|
||||||
|
-- increasingNaturalsBound : (S : Sequence ℕ) → StrictlyIncreasing S → (bound : ℕ) → List ℕ
|
||||||
|
-- increasingNaturalsBound s n = {!!}
|
||||||
|
|
||||||
|
{-
|
||||||
|
fibsLessThan4Mil : List BinNat
|
||||||
|
fibsLessThan4Mil = takeUpToMonotone {tOrder = BinNatTOrder} (archimImpliesTailArchim {tOrder = BinNatTOrder} archim (2 , ordersAgree 1 2 (le zero refl))) increasing (one :: one :: one :: one :: zero :: one :: zero :: zero :: zero :: zero :: one :: zero :: zero :: one :: zero :: zero :: zero :: zero :: zero :: zero :: zero :: one :: [])
|
||||||
|
|
||||||
|
evens : List BinNat
|
||||||
|
evens = filter' isEvenDecidable fibsLessThan4Mil
|
||||||
|
|
||||||
|
ans : BinNat
|
||||||
|
ans = fold _+B_ [] evens
|
||||||
|
|
||||||
|
-}
|
||||||
@@ -83,3 +83,11 @@ Sequence.tail (subsequence x selector increasing) = subsequence (tailFrom (succ
|
|||||||
take : {a : _} {A : Set a} (n : ℕ) (s : Sequence A) → Vec A n
|
take : {a : _} {A : Set a} (n : ℕ) (s : Sequence A) → Vec A n
|
||||||
take zero s = []
|
take zero s = []
|
||||||
take (succ n) s = Sequence.head s ,- take n (Sequence.tail s)
|
take (succ n) s = Sequence.head s ,- take n (Sequence.tail s)
|
||||||
|
|
||||||
|
unfold : {a : _} {A : Set a} → (A → A) → A → Sequence A
|
||||||
|
Sequence.head (unfold f a) = a
|
||||||
|
Sequence.tail (unfold f a) = unfold f (f a)
|
||||||
|
|
||||||
|
indexAndUnfold : {a : _} {A : Set a} (f : A → A) (start : A) (n : ℕ) → index (unfold f start) (succ n) ≡ f (index (unfold f start) n)
|
||||||
|
indexAndUnfold f s zero = refl
|
||||||
|
indexAndUnfold f s (succ n) = indexAndUnfold f (f s) n
|
||||||
|
|||||||
@@ -6,7 +6,7 @@ open import LogicalFormulae
|
|||||||
open import Orders.Total.Definition
|
open import Orders.Total.Definition
|
||||||
open import Orders.Partial.Definition
|
open import Orders.Partial.Definition
|
||||||
open import Setoids.Setoids
|
open import Setoids.Setoids
|
||||||
open import Functions
|
open import Functions.Definition
|
||||||
open import Sequences
|
open import Sequences
|
||||||
open import Setoids.Orders.Partial.Definition
|
open import Setoids.Orders.Partial.Definition
|
||||||
|
|
||||||
|
|||||||
@@ -14,6 +14,8 @@ data Vec {a : _} (X : Set a) : ℕ -> Set a where
|
|||||||
[] : Vec X zero
|
[] : Vec X zero
|
||||||
_,-_ : {n : ℕ} -> X -> Vec X n -> Vec X (succ n)
|
_,-_ : {n : ℕ} -> X -> Vec X n -> Vec X (succ n)
|
||||||
|
|
||||||
|
infixr 10 _,-_
|
||||||
|
|
||||||
vecLen : {a : _} {X : Set a} {n : ℕ} → Vec X n → ℕ
|
vecLen : {a : _} {X : Set a} {n : ℕ} → Vec X n → ℕ
|
||||||
vecLen {a} {X} {n} v = n
|
vecLen {a} {X} {n} v = n
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user