Files
agdaproofs/PrimeNumbers.agda
2019-01-10 22:36:55 +00:00

803 lines
64 KiB
Agda
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{-# OPTIONS --warning=error --safe #-}
open import LogicalFormulae
open import Numbers.Naturals
open import WellFoundedInduction
open import KeyValue
open import KeyValueWithDomain
open import Orders
open import Vectors
open import Maybe
module PrimeNumbers where
record divisionAlgResult (a : ) (b : ) : Set where
field
quot :
rem :
pr : a *N quot +N rem b
remIsSmall : (rem <N a) || (a 0)
quotSmall : (0 <N a) || ((0 a) && (quot 0))
divAlgLessLemma : (a b : ) (0 <N a) (r : divisionAlgResult a b) (divisionAlgResult.quot r 0) || (divisionAlgResult.rem r <N b)
divAlgLessLemma zero b pr _ = exFalso (lessIrreflexive pr)
divAlgLessLemma (succ a) b _ record { quot = zero ; rem = a%b ; pr = pr ; remIsSmall = remIsSmall } = inl refl
divAlgLessLemma (succ a) b _ record { quot = (succ a/b) ; rem = a%b ; pr = pr ; remIsSmall = remIsSmall } = inr record { x = a/b +N a *N succ (a/b) ; proof = pr }
modUniqueLemma : {rem1 rem2 a : } (quot1 quot2 : ) rem1 <N a rem2 <N a a *N quot1 +N rem1 a *N quot2 +N rem2 rem1 rem2
modUniqueLemma {rem1} {rem2} {a} zero zero rem1<a rem2<a pr rewrite productZeroIsZeroRight a = pr
modUniqueLemma {rem1} {rem2} {a} zero (succ quot2) rem1<a rem2<a pr rewrite productZeroIsZeroRight a | pr | multiplicationNIsCommutative a (succ quot2) | additionNIsAssociative a (quot2 *N a) rem2 = exFalso (cannotAddAndEnlarge' {a} {quot2 *N a +N rem2} rem1<a)
modUniqueLemma {rem1} {rem2} {a} (succ quot1) zero rem1<a rem2<a pr rewrite productZeroIsZeroRight a | equalityCommutative pr | multiplicationNIsCommutative a (succ quot1) | additionNIsAssociative a (quot1 *N a) rem1 = exFalso (cannotAddAndEnlarge' {a} {quot1 *N a +N rem1} rem2<a)
modUniqueLemma {rem1} {rem2} {a} (succ quot1) (succ quot2) rem1<a rem2<a pr rewrite multiplicationNIsCommutative a (succ quot1) | multiplicationNIsCommutative a (succ quot2) | additionNIsAssociative a (quot1 *N a) rem1 | additionNIsAssociative a (quot2 *N a) rem2 = modUniqueLemma {rem1} {rem2} {a} quot1 quot2 rem1<a rem2<a (go {a}{quot1}{rem1}{quot2}{rem2} pr)
where
go : {a quot1 rem1 quot2 rem2 : } (a +N (quot1 *N a +N rem1) a +N (quot2 *N a +N rem2)) a *N quot1 +N rem1 a *N quot2 +N rem2
go {a} {quot1} {rem1} {quot2} {rem2} pr rewrite multiplicationNIsCommutative quot1 a | multiplicationNIsCommutative quot2 a = canSubtractFromEqualityLeft {a} pr
modIsUnique : {a b : } (div1 div2 : divisionAlgResult a b) divisionAlgResult.rem div1 divisionAlgResult.rem div2
modIsUnique {zero} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = remIsSmall1 } record { quot = quot ; rem = rem ; pr = pr ; remIsSmall = remIsSmall } = transitivity pr1 (equalityCommutative pr)
modIsUnique {succ a} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = (inl y) } record { quot = quot ; rem = rem ; pr = pr ; remIsSmall = (inl x) } = modUniqueLemma {rem1} {rem} {succ a} quot1 quot y x (transitivity pr1 (equalityCommutative pr))
modIsUnique {succ a} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = (inr ()) } record { quot = quot ; rem = rem ; pr = pr ; remIsSmall = (inl x) }
modIsUnique {succ a} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = remIsSmall1 } record { quot = quot ; rem = rem ; pr = pr ; remIsSmall = (inr ()) }
transferAddition : (a b c : ) (a +N b) +N c (a +N c) +N b
transferAddition a b c rewrite (additionNIsAssociative a b c) = p a b c
where
p : (a b c : ) a +N (b +N c) (a +N c) +N b
p a b c rewrite (additionNIsCommutative b c) = equalityCommutative (additionNIsAssociative a c b)
divisionAlgLemma : (x b : ) x *N zero +N b b
divisionAlgLemma x b rewrite (productZeroIsZeroRight x) = refl
divisionAlgLemma2 : (x b : ) (x b) x *N succ zero +N zero b
divisionAlgLemma2 x b pr rewrite (productWithOneRight x) = equalityCommutative (transitivity (equalityCommutative pr) (equalityCommutative (addZeroRight x)))
divisionAlgLemma3 : {a x : } (p : succ a <N succ x) (subtractionNResult.result (-N (inl p))) <N (succ x)
divisionAlgLemma3 {a} {x} p = -NIsDecreasing {a} {succ x} p
divisionAlgLemma4 : (p a q : ) ((p +N a *N p) +N q) +N succ a succ ((p +N a *N succ p) +N q)
divisionAlgLemma4 p a q = ans
where
r : ((p +N a *N p) +N q) +N succ a succ (((p +N a *N p) +N q) +N a)
ans : ((p +N a *N p) +N q) +N succ a succ ((p +N a *N succ p) +N q)
s : ((p +N a *N p) +N q) +N a (p +N a *N succ p) +N q
t : (p +N a *N p) +N a p +N a *N succ p
s = transitivity (transferAddition (p +N a *N p) q a) (applyEquality (λ i i +N q) t)
ans = identityOfIndiscernablesRight (((p +N a *N p) +N q) +N succ a) (succ (((p +N a *N p) +N q) +N a)) (succ ((p +N a *N succ p) +N q)) _≡_ r (applyEquality succ s)
r = succExtracts ((p +N a *N p) +N q) a
t = transitivity (additionNIsAssociative p (a *N p) a) (applyEquality (λ n p +N n) (equalityCommutative (aSucB a p)))
divisionAlg : (a : ) (b : ) divisionAlgResult a b
divisionAlg zero = λ b record { quot = zero ; rem = b ; pr = refl ; remIsSmall = inr refl ; quotSmall = inr (record { fst = refl ; snd = refl }) }
divisionAlg (succ a) = rec <NWellfounded (λ n divisionAlgResult (succ a) n) go
where
go : (x : ) (indHyp : (y : ) (y<x : y <N x) divisionAlgResult (succ a) y)
divisionAlgResult (succ a) x
go zero prop = record { quot = zero ; rem = zero ; pr = divisionAlgLemma (succ a) zero ; remIsSmall = inl (succIsPositive a) ; quotSmall = inl (succIsPositive a) }
go (succ x) indHyp with orderIsTotal (succ a) (succ x)
go (succ x) indHyp | inl (inl sa<sx) with indHyp (subtractionNResult.result (-N (inl sa<sx))) (divisionAlgLemma3 sa<sx)
... | record { quot = prevQuot ; rem = prevRem ; pr = prevPr ; remIsSmall = smallRem } = p
where
p : divisionAlgResult (succ a) (succ x)
addedA : (succ a *N prevQuot +N prevRem) +N (succ a) subtractionNResult.result (-N (inl sa<sx)) +N (succ a)
addedA' : (succ a *N prevQuot +N prevRem) +N succ a succ x
addedA'' : (succ a *N succ prevQuot) +N prevRem succ x
addedA''' : succ ((prevQuot +N a *N succ prevQuot) +N prevRem) succ x
addedA''' = identityOfIndiscernablesLeft ((succ a *N succ prevQuot) +N prevRem) (succ x) (succ ((prevQuot +N a *N succ prevQuot) +N prevRem)) _≡_ addedA'' refl
p = record { quot = succ prevQuot ; rem = prevRem ; pr = addedA''' ; remIsSmall = smallRem ; quotSmall = inl (succIsPositive a) }
addedA = applyEquality (λ n n +N succ a) prevPr
addedA' = identityOfIndiscernablesRight ((succ a *N prevQuot +N prevRem) +N succ a) (subtractionNResult.result (-N (inl sa<sx)) +N (succ a)) (succ x) _≡_ addedA (addMinus {succ a} {succ x} (inl sa<sx))
addedA'' = identityOfIndiscernablesLeft ((succ a *N prevQuot +N prevRem) +N succ a) (succ x) ((succ a *N succ prevQuot) +N prevRem) _≡_ addedA' (divisionAlgLemma4 prevQuot a prevRem)
go (succ x) indHyp | inr (sa=sx) = record { quot = succ zero ; rem = zero ; pr = divisionAlgLemma2 (succ a) (succ x) sa=sx ; remIsSmall = inl (succIsPositive a) ; quotSmall = inl (succIsPositive a) }
go (succ x) indHyp | inl (inr (sx<sa)) = record { quot = zero ; rem = succ x ; pr = divisionAlgLemma (succ a) (succ x) ; remIsSmall = inl sx<sa ; quotSmall = inl (succIsPositive a) }
data __ : Set where
divides : {a b : } (res : divisionAlgResult a b) divisionAlgResult.rem res zero a b
dividesEqualityLemma'' : {a b : } (quot1 quot2 : ) (quot1 quot2) (rem : ) (pr1 : (quot1 +N a *N quot1) +N rem b) (pr2 : (quot2 +N a *N quot2) +N rem b) (y : rem <N succ a) (x1 : zero <N succ a) record { quot = quot1 ; rem = rem ; pr = pr1 ; remIsSmall = inl y ; quotSmall = inl x1 } record { quot = quot2 ; rem = rem ; pr = pr2 ; remIsSmall = inl y ; quotSmall = inl x1}
dividesEqualityLemma'' {a} {b} q1 .q1 refl rem pr1 pr2 y x1 rewrite reflRefl pr1 pr2 = refl
dividesEqualityLemma' : {a b : } (quot1 quot2 : ) (rem : ) (pr1 : (quot1 +N a *N quot1) +N rem b) (pr2 : (quot2 +N a *N quot2) +N rem b) (y : rem <N succ a) (y2 : rem <N succ a) (x1 : zero <N succ a) record { quot = quot1 ; rem = rem ; pr = pr1 ; remIsSmall = inl y ; quotSmall = inl x1 } record { quot = quot2 ; rem = rem ; pr = pr2 ; remIsSmall = inl y2 ; quotSmall = inl x1}
dividesEqualityLemma' {a} {b} quot1 quot2 rem pr1 pr2 y y2 x1 rewrite <NRefl y2 y = dividesEqualityLemma'' quot1 quot2 (equalityCommutative lemm'') rem pr1 pr2 y x1
where
lemm : (succ a) *N quot2 +N rem (succ a) *N quot1 +N rem
lemm rewrite equalityCommutative pr1 = pr2
lemm' : (succ a) *N quot2 (succ a) *N quot1
lemm' = canSubtractFromEqualityRight lemm
lemm'' : quot2 quot1
lemm'' = productCancelsLeft (succ a) quot2 quot1 (succIsPositive a) lemm'
dividesEqualityLemma : {a b : } (quot1 quot2 : ) (rem1 rem2 : ) (pr1 : (quot1 +N a *N quot1) +N rem1 b) (pr2 : (quot2 +N a *N quot2) +N rem2 b) (rem1 rem2) (y : rem1 <N succ a) (y2 : rem2 <N succ a) (x1 : zero <N succ a) record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = inl y ; quotSmall = inl x1 } record { quot = quot2 ; rem = rem2 ; pr = pr2 ; remIsSmall = inl y2 ; quotSmall = inl x1}
dividesEqualityLemma {a} {b} quot1 quot2 rem1 rem2 pr1 pr2 remEq y y2 x1 rewrite remEq = dividesEqualityLemma' quot1 quot2 rem2 pr1 pr2 y y2 x1
dividesEqualityPr : {a b : } (res1 res2 : divisionAlgResult a b) res1 res2
dividesEqualityPr {zero} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = remIsSmall1 ; quotSmall = (inl (le x ())) } record { quot = quot2 ; rem = rem2 ; pr = pr2 ; remIsSmall = remIsSmall2 ; quotSmall = quotSmall2 }
dividesEqualityPr {zero} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = remIsSmall1 ; quotSmall = (inr (fst ,, snd)) } record { quot = quot2 ; rem = rem2 ; pr = pr2 ; remIsSmall = remIsSmall2 ; quotSmall = (inl (le x ())) }
dividesEqualityPr {zero} {b} record { quot = .0 ; rem = rem1 ; pr = pr1 ; remIsSmall = (inl (le x ())) ; quotSmall = (inr (refl ,, refl)) } record { quot = .0 ; rem = rem2 ; pr = pr2 ; remIsSmall = remIsSmall2 ; quotSmall = (inr (refl ,, refl)) }
dividesEqualityPr {zero} {b} record { quot = .0 ; rem = rem1 ; pr = pr1 ; remIsSmall = (inr refl) ; quotSmall = (inr (refl ,, refl)) } record { quot = .0 ; rem = rem2 ; pr = pr2 ; remIsSmall = (inl (le x ())) ; quotSmall = (inr (refl ,, refl)) }
dividesEqualityPr {zero} {.rem1} record { quot = .0 ; rem = rem1 ; pr = refl ; remIsSmall = (inr refl) ; quotSmall = (inr (refl ,, refl)) } record { quot = .0 ; rem = .rem1 ; pr = refl ; remIsSmall = (inr refl) ; quotSmall = (inr (refl ,, refl)) } = refl
dividesEqualityPr {succ a} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = (inl y) ; quotSmall = (inl x) } record { quot = quot2 ; rem = rem2 ; pr = pr2 ; remIsSmall = (inl y2) ; quotSmall = (inl x1) } rewrite <NRefl x x1 = dividesEqualityLemma quot1 quot2 rem1 rem2 pr1 pr2 remsEqual y y2 x1
where
remsEqual : rem1 rem2
remsEqual = modIsUnique (record { quot = quot1 ; rem = rem1 ; pr = pr1 ; quotSmall = (inl x) ; remIsSmall = (inl y) }) (record { quot = quot2 ; rem = rem2 ; pr = pr2 ; remIsSmall = (inl y2) ; quotSmall = (inl x1) })
dividesEqualityPr {succ a} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = (inl y) ; quotSmall = (inl x) } record { quot = quot2 ; rem = rem2 ; pr = pr2 ; remIsSmall = (inr ()) ; quotSmall = (inl x1) }
dividesEqualityPr {succ a} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = (inr ()) ; quotSmall = (inl x) } record { quot = quot2 ; rem = rem2 ; pr = pr2 ; remIsSmall = remIsSmall2 ; quotSmall = (inl x1) }
dividesEqualityPr {succ a} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = remIsSmall1 ; quotSmall = (inl x) } record { quot = quot2 ; rem = rem2 ; pr = pr2 ; remIsSmall = remIsSmall2 ; quotSmall = (inr (() ,, snd)) }
dividesEqualityPr {succ a} {b} record { quot = quot1 ; rem = rem1 ; pr = pr1 ; remIsSmall = remIsSmall1 ; quotSmall = (inr (() ,, snd)) } record { quot = quot2 ; rem = rem2 ; pr = pr2 ; remIsSmall = remIsSmall2 ; quotSmall = quotSmall2 }
dividesEquality : {a b : } (res1 res2 : a b) res1 res2
dividesEquality (divides res1 x1) (divides res2 x2) rewrite dividesEqualityPr res1 res2 = applyEquality (λ i divides res2 i) (reflRefl x1 x2)
data notDiv : Set where
doesNotDivide : {a b : } (res : divisionAlgResult a b) 0 <N divisionAlgResult.rem res notDiv a b
zeroDividesNothing : (a : ) zero succ a False
zeroDividesNothing a (divides record { quot = quot ; rem = rem ; pr = pr } x) = naughtE p
where
p : zero succ a
p = transitivity (equalityCommutative x) pr
twoDividesFour : succ (succ zero) succ (succ (succ (succ zero)))
twoDividesFour = divides {(succ (succ zero))} {succ (succ (succ (succ zero)))} (record { quot = succ (succ zero) ; rem = zero ; pr = refl ; remIsSmall = inl (succIsPositive 1) ; quotSmall = inl (succIsPositive 1) }) refl
record Prime (p : ) : Set where
field
p>1 : 1 <N p
pr : forall {i : } i p i <N p zero <N i i (succ zero)
record Composite (n : ) : Set where
field
n>1 : 1 <N n
divisor :
dividesN : divisor n
divisorLessN : divisor <N n
divisorNot1 : 1 <N divisor
divisorPrime : Prime divisor
noSmallerDivisors : i i <N divisor 1 <N i i n False
notBothPrimeAndComposite : {n : } Composite n Prime n False
notBothPrimeAndComposite {n} record { n>1 = n>1 ; divisor = divisor ; dividesN = dividesN ; divisorLessN = divisorLessN ; divisorNot1 = divisorNot1 } record { p>1 = p>1 ; pr = pr } = lessImpliesNotEqual divisorNot1 (equalityCommutative div=1)
where
div=1 : divisor 1
div=1 = pr {divisor} dividesN divisorLessN (orderIsTransitive (succIsPositive 0) divisorNot1)
zeroIsNotPrime : Prime 0 False
zeroIsNotPrime record { p>1 = p>1 ; pr = pr } = zeroNeverGreater p>1
oneIsNotPrime : Prime 1 False
oneIsNotPrime record { p>1 = (le x proof) ; pr = pr } = naughtE (equalityCommutative absurd')
where
absurd : x +N 1 0
absurd = succInjective proof
absurd' : succ x 0
absurd' rewrite additionNIsCommutative 1 x = absurd
twoIsPrime : Prime 2
Prime.p>1 twoIsPrime = succPreservesInequality (succIsPositive 0)
Prime.pr twoIsPrime {i} i|2 i<2 0<i with orderIsTotal i (succ (succ zero))
Prime.pr twoIsPrime {zero} i|2 i<2 (le x ()) | order
Prime.pr twoIsPrime {succ zero} i|2 i<2 0<i | order = refl
Prime.pr twoIsPrime {succ (succ zero)} i|2 i<2 0<i | order = exFalso (lessImpliesNotEqual {2} i<2 refl)
Prime.pr twoIsPrime {succ (succ (succ i))} i|2 i<2 0<i | inl (inl x) = exFalso (orderIsIrreflexive i<2 (succPreservesInequality (succPreservesInequality (succIsPositive i))))
Prime.pr twoIsPrime {succ (succ (succ i))} i|2 i<2 0<i | inl (inr twoLessThree) = exFalso (orderIsIrreflexive twoLessThree i<2)
Prime.pr twoIsPrime {succ (succ (succ i))} i|2 i<2 0<i | inr ()
compositeImpliesNotPrime : (m p : ) (succ zero <N m) (m <N p) (m p) Prime p False
compositeImpliesNotPrime zero p (le x ()) _ mDivP pPrime
compositeImpliesNotPrime (succ zero) p mLarge _ mDivP pPrime = lessImpliesNotEqual {succ zero} {succ zero} mLarge refl
compositeImpliesNotPrime (succ (succ m)) zero _ _ mDivP ()
compositeImpliesNotPrime (succ (succ m)) (succ zero) _ _ mDivP primeP = exFalso (oneIsNotPrime primeP)
compositeImpliesNotPrime (succ (succ m)) (succ (succ p)) _ mLessP mDivP pPrime = false
where
r = succ (succ m)
q = succ (succ p)
rEqOne : r succ zero
rEqOne = (Prime.pr pPrime) {r} mDivP mLessP (succIsPositive (succ m))
false : False
false = succIsNonzero (succInjective rEqOne)
fourIsNotPrime : Prime 4 False
fourIsNotPrime = compositeImpliesNotPrime (succ (succ zero)) (succ (succ (succ (succ zero)))) (le zero refl) (le (succ zero) refl) twoDividesFour
record hcfData (a b : ) : Set where
field
c :
c|a : c a
c|b : c b
hcf : x x a x b x c
record Coprime (a : ) (b : ) : Set where
field
hcf : hcfData a b
hcfNot1 : 1 <N hcfData.c hcf
record numberLessThan (n : ) : Set where
field
a :
a<n : a <N n
upper :
upper = n
numberLessThanEquality : {n : } (a b : numberLessThan n) (numberLessThan.a a numberLessThan.a b) a b
numberLessThanEquality record { a = a ; a<n = a<n } record { a = b ; a<n = b<n } pr rewrite pr | <NRefl b<n a<n = refl
numberLessThanOrder : (n : ) TotalOrder (numberLessThan n)
PartialOrder._<_ (TotalOrder.order (numberLessThanOrder n)) = λ a b (numberLessThan.a a) <N numberLessThan.a b
PartialOrder.irreflexive (TotalOrder.order (numberLessThanOrder n)) pr = lessIrreflexive pr
PartialOrder.transitive (TotalOrder.order (numberLessThanOrder n)) pr1 pr2 = orderIsTransitive pr1 pr2
TotalOrder.totality (numberLessThanOrder n) a b with TotalOrder.totality TotalOrder (numberLessThan.a a) (numberLessThan.a b)
TotalOrder.totality (numberLessThanOrder n) a b | inl (inl x) = inl (inl x)
TotalOrder.totality (numberLessThanOrder n) a b | inl (inr x) = inl (inr x)
TotalOrder.totality (numberLessThanOrder n) a b | inr x rewrite x = inr (numberLessThanEquality a b x)
numberLessThanInject : {newMax : } (max : ) (n : numberLessThan max) (max <N newMax) (numberLessThan newMax)
numberLessThanInject max record { a = n ; a<n = n<max } max<newMax = record { a = n ; a<n = PartialOrder.transitive (TotalOrder.order TotalOrder) n<max max<newMax }
numberLessThanInjectComp : {max : } (a b : ) (i : numberLessThan b) (pr : b <N a) (pr2 : a <N max) numberLessThanInject {max} a (numberLessThanInject {a} b i pr) pr2 numberLessThanInject {max} b i (PartialOrder.transitive (TotalOrder.order TotalOrder) pr pr2)
numberLessThanInjectComp {max} a b record { a = i ; a<n = i<max } b<a a<max = numberLessThanEquality _ _ refl
allNumbersLessThanDescending : (n : ) Vec (numberLessThan n) n
allNumbersLessThanDescending zero = []
allNumbersLessThanDescending (succ n) = record { a = n ; a<n = le zero refl } ,- vecMap (λ i numberLessThanInject {succ n} (numberLessThan.upper i) i (le zero refl)) (allNumbersLessThanDescending n)
allNumbersLessThan : (n : ) Vec (numberLessThan n) n
allNumbersLessThan n = vecRev (allNumbersLessThanDescending n)
record extensionalHCF (a b : ) : Set where
field
c :
c|a : c a
c|b : c b
field
zeroCase : ((a 0) & (b 0) & (c 0)) || ((0 <N a) || (0 <N b))
hcfExtension : MapWithDomain (numberLessThan c) (Sg (numberLessThan c) (λ i ((notDiv (numberLessThan.a i) a) || (notDiv (numberLessThan.a i) b)) || ((numberLessThan.a i) a & (numberLessThan.a i) b & (numberLessThan.a i) c))) (numberLessThanOrder c)
hcfExtensionIsRightLength : vecLen (MapWithDomain.domain hcfExtension) c
{-
hcfsContains : {a b r : } → (hcf : extensionalHCF a b) → (r<hcf : r <N extensionalHCF.c hcf) → vecContains (MapWithDomain.domain (extensionalHCF.hcfExtension hcf)) record { a = r ; a<n = r<hcf }
hcfsContains = {!!}
hcfsEquivalent : {a b : } → hcfData a b → extensionalHCF a b
hcfsEquivalent {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; hcf = hcf } = record { c = c ; c|a = c|a ; c|b = c|b ; hcfExtension = hcfsMap ; hcfExtensionIsRightLength = {!!} ; zeroCase = {!!} }
where
pair : Set
pair = (Sg (numberLessThan c) (λ i → ((notDiv (numberLessThan.a i) a) || (notDiv (numberLessThan.a i) b)) || ((numberLessThan.a i) a & (numberLessThan.a i) b & (numberLessThan.a i) c)))
allHcfs : Map (numberLessThan c) pair (numberLessThanOrder c)
allHcfs = {!!}
hcfsMap : MapWithDomain (numberLessThan c) (Sg (numberLessThan c) (λ i → ((notDiv (numberLessThan.a i) a) || (notDiv (numberLessThan.a i) b)) || ((numberLessThan.a i) a & (numberLessThan.a i) b & (numberLessThan.a i) c))) (numberLessThanOrder c)
hcfsMap = {!!}
-}
positiveTimes : {a b : } (succ a *N succ b <N succ a) False
positiveTimes {a} {b} pr = zeroNeverGreater f'
where
g : succ a *N succ b <N succ a *N succ 0
g rewrite multiplicationNIsCommutative a 1 | additionNIsCommutative a 0 = pr
f : succ b <N succ 0
f = cancelInequalityLeft {succ a} {succ b} g
f' : b <N 0
f' = canRemoveSuccFrom<N f
biggerThanCantDivideLemma : {a b : } (a <N b) (b a) a 0
biggerThanCantDivideLemma {zero} {b} a<b b|a = refl
biggerThanCantDivideLemma {succ a} {zero} a<b (divides record { quot = quot ; rem = .0 ; pr = pr ; remIsSmall = remIsSmall ; quotSmall = (inl (le x ())) } refl)
biggerThanCantDivideLemma {succ a} {zero} a<b (divides record { quot = quot ; rem = .0 ; pr = () ; remIsSmall = remIsSmall ; quotSmall = (inr x) } refl)
biggerThanCantDivideLemma {succ a} {succ b} a<b (divides record { quot = zero ; rem = .0 ; pr = pr ; remIsSmall = remIsSmall ; quotSmall = quotSmall } refl) rewrite additionNIsCommutative (b *N zero) 0 | multiplicationNIsCommutative b 0 = naughtE pr
biggerThanCantDivideLemma {succ a} {succ b} a<b (divides record { quot = (succ quot) ; rem = .0 ; pr = pr ; remIsSmall = remIsSmall ; quotSmall = quotSmall } refl) rewrite additionNIsCommutative (quot +N b *N succ quot) 0 | equalityCommutative pr = exFalso (positiveTimes {b} {quot} a<b)
biggerThanCantDivide : {a b : } (x : ) (TotalOrder.max TotalOrder a b) <N x (x a) (x b) (a 0) && (b 0)
biggerThanCantDivide {a} {b} x pr x|a x|b with TotalOrder.totality TotalOrder a b
biggerThanCantDivide {a} {b} x pr x|a x|b | inl (inl a<b) = exFalso (zeroNeverGreater f')
where
f : b 0
f = biggerThanCantDivideLemma pr x|b
f' : a <N 0
f' rewrite equalityCommutative f = a<b
biggerThanCantDivide {a} {b} x pr x|a x|b | inl (inr b<a) = exFalso (zeroNeverGreater f')
where
f : a 0
f = biggerThanCantDivideLemma pr x|a
f' : b <N 0
f' rewrite equalityCommutative f = b<a
biggerThanCantDivide {a} {b} x pr x|a x|b | inr a=b = (transitivity a=b f ,, f)
where
f : b 0
f = biggerThanCantDivideLemma pr x|b
aDivA : (a : ) a a
aDivA zero = divides (record { quot = 0 ; rem = 0 ; pr = equalityCommutative (oneTimesPlusZero zero) ; remIsSmall = inr refl ; quotSmall = inr (refl ,, refl) }) refl
aDivA (succ a) = divides (record { quot = 1 ; rem = 0 ; pr = equalityCommutative (oneTimesPlusZero (succ a)) ; remIsSmall = inl (succIsPositive a) ; quotSmall = inl (succIsPositive a) }) refl
aDivZero : (a : ) a zero
aDivZero zero = aDivA zero
aDivZero (succ a) = divides (record { quot = zero ; rem = zero ; pr = lemma (succ a) ; remIsSmall = inl (succIsPositive a) ; quotSmall = inl (succIsPositive a) }) refl
where
lemma : (b : ) b *N zero +N zero zero
lemma b rewrite (addZeroRight (b *N zero)) = productZeroIsZeroRight b
maxDivides : (a b : ) ((TotalOrder.max TotalOrder a b) a) (TotalOrder.max TotalOrder a b) b (((a 0) && (0 <N b)) || ((b 0) && (0 <N a))) || (a b)
maxDivides a b max|a max|b with TotalOrder.totality TotalOrder a b
maxDivides a b max|a max|b | inl (inl a<b) = inl (inl (record { fst = gg ; snd = identityOfIndiscernablesLeft _ _ _ _<N_ a<b gg}))
where
gg : a 0
gg = biggerThanCantDivideLemma {a} {b} a<b max|a
maxDivides a b max|a max|b | inl (inr b<a) = inl (inr (record { fst = gg ; snd = identityOfIndiscernablesLeft _ _ _ _<N_ b<a gg }))
where
gg : b 0
gg = biggerThanCantDivideLemma b<a max|b
maxDivides a .a a|max b|max | inr refl = inr refl
{-
hcfsEquivalent' : {a b : } → extensionalHCF a b → hcfData a b
hcfData.c (hcfsEquivalent' {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; hcfExtension = hcfExtension }) = c
hcfData.c|a (hcfsEquivalent' {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; hcfExtension = hcfExtension }) = c|a
hcfData.c|b (hcfsEquivalent' {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; hcfExtension = hcfExtension }) = c|b
hcfData.hcf (hcfsEquivalent' {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; hcfExtension = hcfExtension }) x x|a x|b with orderIsTotal x c
hcfData.hcf (hcfsEquivalent' {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; zeroCase = zeroCase ; hcfExtension = hcfExtension ; hcfExtensionIsRightLength = hIRL }) x x|a x|b | inl (inl x<c) = {!!}
where
xLess : numberLessThan c
xLess = record { a = x ; a<n = x<c }
pair : Set
pair = Sg (numberLessThan c) (λ i → (notDiv (numberLessThan.a i) a || notDiv (numberLessThan.a i) b) || (numberLessThan.a i a) & numberLessThan.a i b & (numberLessThan.a i c))
pr : Sg pair λ p → (lookup (MapWithDomain.map hcfExtension) xLess ≡ {!!})
pr = MapWithDomain.lookup' hcfExtension xLess (hcfsContains {a} {b} {x} (record { c = c ; c|a = c|a ; c|b = c|b ; zeroCase = zeroCase ; hcfExtension = hcfExtension ; hcfExtensionIsRightLength = hIRL }) x<c)
hcfData.hcf (hcfsEquivalent' {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; zeroCase = _ ; hcfExtension = hcfExtension ; hcfExtensionIsRightLength = _ }) x x|a x|b | inl (inr c<x) = {!!}
hcfData.hcf (hcfsEquivalent' {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; zeroCase = _ ; hcfExtension = hcfExtension ; hcfExtensionIsRightLength = _ }) x x|a x|b | inr x=c rewrite x=c = aDivA c
extensionalHCFEquality : {a b : }{h1 h2 : extensionalHCF a b} → (extensionalHCF.c h1 ≡ extensionalHCF.c h2) → h1 ≡ h2
extensionalHCFEquality {a} {b} {record { c = c1 ; c|a = c|a1 ; c|b = c|b1 ; hcfExtension = hcfExtension1 }} {record { c = c2 ; c|a = c|a2 ; c|b = c|b2 ; hcfExtension = hcfExtension2 }} pr rewrite pr = {!!}
-}
record extendedHcf (a b : ) : Set where
field
hcf : hcfData a b
c :
c = hcfData.c hcf
field
extended1 :
extended2 :
extendedProof : (a *N extended1 b *N extended2 +N c) || (a *N extended1 +N c b *N extended2)
divEqualityLemma1 : {a b c : } b zero b *N c +N 0 a a b
divEqualityLemma1 {a} {.0} {c} refl pr = equalityCommutative pr
divEquality : {a b : } a b b a a b
divEquality {a} {b} (divides record { quot = quotAB ; rem = .0 ; pr = prAB ; remIsSmall = _ ; quotSmall = quotSmallAB } refl) (divides record { quot = quot ; rem = .0 ; pr = pr ; remIsSmall = _ ; quotSmall = (inl x) } refl) rewrite additionNIsCommutative (b *N quot) 0 | additionNIsCommutative (a *N quotAB) 0 | equalityCommutative pr | equalityCommutative (multiplicationNIsAssociative b quot quotAB) = res
where
lem : {b r : } b *N r b (0 <N b) r 1
lem {zero} {r} pr ()
lem {succ b} {zero} pr _ rewrite multiplicationNIsCommutative b 0 = naughtE pr
lem {succ b} {succ zero} pr _ = refl
lem {succ b} {succ (succ r)} pr _ rewrite multiplicationNIsCommutative b (succ (succ r)) | additionNIsCommutative (succ r) (b +N (b +N r *N b)) | additionNIsAssociative b (b +N r *N b) (succ r) | additionNIsCommutative (b +N r *N b) (succ r) = exFalso (cannotAddAndEnlarge'' {succ b} pr)
p : quot *N quotAB 1
p = lem prAB x
q : quot 1
q = _&&_.fst (productOneImpliesOperandsOne p)
res : b *N quot b
res rewrite q | multiplicationNIsCommutative b 1 | additionNIsCommutative b 0 = refl
divEquality {.0} {.0} (divides record { quot = quotAB ; rem = .0 ; pr = prAB ; remIsSmall = _ ; quotSmall = quotSmallAB } refl) (divides record { quot = quot ; rem = .0 ; pr = refl ; remIsSmall = _ ; quotSmall = (inr (refl ,, snd)) } refl) = refl
hcfWelldefined : {a b : } (ab : hcfData a b) (ab' : hcfData a b) (hcfData.c ab hcfData.c ab')
hcfWelldefined {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; hcf = hcf } record { c = c' ; c|a = c|a' ; c|b = c|b' ; hcf = hcf' } with hcf c' c|a' c|b'
... | c'DivC with hcf' c c|a c|b
... | cDivC' = divEquality cDivC' c'DivC
reverseHCF : {a b : } (ab : extendedHcf a b) extendedHcf b a
reverseHCF {a} {b} record { hcf = record { c = c ; c|a = c|a ; c|b = c|b ; hcf = hcf } ; extended1 = extended1 ; extended2 = extended2 ; extendedProof = (inl x) } = record { hcf = record { c = c ; c|a = c|b ; c|b = c|a ; hcf = λ x z z₁ hcf x z₁ z } ; extended1 = extended2 ; extended2 = extended1 ; extendedProof = inr (equalityCommutative x) }
reverseHCF {a} {b} record { hcf = record { c = c ; c|a = c|a ; c|b = c|b ; hcf = hcf } ; extended1 = extended1 ; extended2 = extended2 ; extendedProof = (inr x) } = record { hcf = record { c = c ; c|a = c|b ; c|b = c|a ; hcf = λ x z z₁ hcf x z₁ z } ; extended1 = extended2 ; extended2 = extended1 ; extendedProof = inl (equalityCommutative x) }
oneDivN : (a : ) 1 a
oneDivN a = divides (record { quot = a ; rem = zero ; pr = pr ; remIsSmall = inl (succIsPositive zero) ; quotSmall = inl (le zero refl) }) refl
where
pr : (a +N zero) +N zero a
pr rewrite addZeroRight (a +N zero) = addZeroRight a
hcfZero : (a : ) extendedHcf zero a
hcfZero a = record { hcf = record { c = a ; c|a = aDivZero a ; c|b = aDivA a ; hcf = λ _ _ p p } ; extended1 = 0 ; extended2 = 1 ; extendedProof = inr (equalityCommutative (productWithOneRight a))}
hcfOne : (a : ) extendedHcf 1 a
hcfOne a = record { hcf = record { c = 1 ; c|a = aDivA 1 ; c|b = oneDivN a ; hcf = λ _ z _ z } ; extended1 = 1 ; extended2 = 0 ; extendedProof = inl g }
where
g : 1 a *N 0 +N 1
g rewrite multiplicationNIsCommutative a 0 = refl
zeroIsValidRem : (a : ) (0 <N a) || (a 0)
zeroIsValidRem zero = inr refl
zeroIsValidRem (succ a) = inl (succIsPositive a)
dividesBothImpliesDividesSum : {a x y : } a x a y a (x +N y)
dividesBothImpliesDividesSum {a} {x} {y} (divides record { quot = xDivA ; rem = .0 ; pr = prA ; quotSmall = qsm1 } refl) (divides record { quot = quot ; rem = .0 ; pr = pr ; quotSmall = qsm2 } refl) = divides (record { quot = xDivA +N quot ; rem = 0 ; pr = go {a} {x} {y} {xDivA} {quot} pr prA ; remIsSmall = zeroIsValidRem a ; quotSmall = (quotSmall qsm1 qsm2) }) refl
where
go : {a x y quot quot2 : } (a *N quot2 +N zero y) (a *N quot +N zero x) a *N (quot +N quot2) +N zero x +N y
go {a} {x} {y} {quot} {quot2} pr1 pr2 rewrite addZeroRight (a *N quot) = identityOfIndiscernablesLeft (a *N (quot +N quot2)) (x +N y) (a *N (quot +N quot2) +N zero) _≡_ t (equalityCommutative (addZeroRight (a *N (quot +N quot2))))
where
t : a *N (quot +N quot2) x +N y
t rewrite addZeroRight (a *N quot2) = transitivity (productDistributes a quot quot2) p
where
s : a *N quot +N a *N quot2 x +N a *N quot2
s = applyEquality (λ n n +N a *N quot2) pr2
r : x +N a *N quot2 x +N y
r = applyEquality (λ n x +N n) pr1
p : a *N quot +N a *N quot2 x +N y
p = transitivity s r
quotSmall : ((0 <N a) || ((0 a) && (xDivA 0))) ((0 <N a) || ((0 a) && (quot 0))) (0 <N a) || ((0 a) && (xDivA +N quot 0))
quotSmall (inl x1) (inl x2) = inl x1
quotSmall (inl x1) (inr x2) = inl x1
quotSmall (inr x1) (inl x2) = inl x2
quotSmall (inr (a=0 ,, bl)) (inr (_ ,, bl2)) = inr (a=0 ,, ans)
where
ans : xDivA +N quot 0
ans rewrite bl | bl2 = refl
dividesBothImpliesDividesDifference : {a b c : } a b a c (c<b : c <N b) a (subtractionNResult.result (-N (inl c<b)))
dividesBothImpliesDividesDifference {zero} {b} {.0} prab (divides record { quot = quot ; rem = .0 ; pr = refl } refl) c<b = prab
dividesBothImpliesDividesDifference {succ a} {b} {c} (divides record { quot = bDivSA ; rem = .0 ; pr = pr } refl) (divides record { quot = cDivSA ; rem = .0 ; pr = pr2 } refl) c<b rewrite (addZeroRight (succ a *N cDivSA)) | (addZeroRight (succ a *N bDivSA)) = divides (record { quot = subtractionNResult.result bDivSA-cDivSA ; rem = 0 ; pr = identityOfIndiscernablesLeft (succ a *N (subtractionNResult.result bDivSA-cDivSA)) (subtractionNResult.result (-N (inl c<b))) (succ a *N (subtractionNResult.result bDivSA-cDivSA) +N zero) _≡_ (identityOfIndiscernablesLeft (la-ka) (subtractionNResult.result (-N (inl c<b))) (succ a *N (subtractionNResult.result bDivSA-cDivSA)) _≡_ s (equalityCommutative q)) (equalityCommutative (addZeroRight _)) ; remIsSmall = inl (succIsPositive a) ; quotSmall = inl (succIsPositive a) }) refl
where
p : cDivSA <N bDivSA
p rewrite (equalityCommutative pr2) | (equalityCommutative pr) = cancelInequalityLeft {succ a} {cDivSA} {bDivSA} c<b
bDivSA-cDivSA : subtractionNResult cDivSA bDivSA (inl p)
bDivSA-cDivSA = -N {cDivSA} {bDivSA} (inl p)
la-ka = subtractionNResult.result (-N {succ a *N cDivSA} {succ a *N bDivSA} (inl (lessRespectsMultiplicationLeft cDivSA bDivSA (succ a) p (succIsPositive a))))
q : (succ a *N (subtractionNResult.result bDivSA-cDivSA)) la-ka
q = subtractProduct {succ a} {cDivSA} {bDivSA} (succIsPositive a) p
s : la-ka subtractionNResult.result (-N {c} {b} (inl c<b))
s = equivalentSubtraction (succ a *N cDivSA) b (succ a *N bDivSA) c (lessRespectsMultiplicationLeft cDivSA bDivSA (succ a) p (succIsPositive a)) c<b g
where
g : (succ a *N cDivSA) +N b (succ a *N bDivSA) +N c
g rewrite equalityCommutative pr2 | equalityCommutative pr = additionNIsCommutative (cDivSA +N a *N cDivSA) (bDivSA +N a *N bDivSA)
euclidLemma1 : {a b : } (a<b : a <N b) (t : ) a +N b <N t a +N (subtractionNResult.result (-N (inl a<b))) <N t
euclidLemma1 {zero} {b} zero<b t b<t = b<t
euclidLemma1 {succ a} {b} sa<b t sa+b<t = identityOfIndiscernablesLeft (subtractionNResult.result (-N (inl sa<b)) +N succ a) t (succ a +N (subtractionNResult.result (-N (inl sa<b)))) _<N_ q (additionNIsCommutative (subtractionNResult.result (-N (inl sa<b))) (succ a))
where
p : b <N t
p = orderIsTransitive (le a refl) sa+b<t
q : (subtractionNResult.result (-N (inl sa<b))) +N succ a <N t
q = identityOfIndiscernablesLeft b t (subtractionNResult.result (-N (inl sa<b)) +N succ a) _<N_ p (equalityCommutative (addMinus (inl sa<b)))
euclidLemma2 : {a b max : } (succ (a +N b) <N max) b <N max
euclidLemma2 {a} {b} {max} pr = lessTransitive {b} {succ (a +N b)} {max} (lemma a b) pr
where
lemma : (a b : ) b <N succ (a +N b)
lemma a zero = succIsPositive (a +N zero)
lemma a (succ b) = succPreservesInequality (collapseSuccOnRight {b} {a} {b} (lemma a b))
euclidLemma3 : {a b max : } (succ (succ (a +N b)) <N max) succ b <N max
euclidLemma3 {a} {b} {max} pr = euclidLemma2 {a} {succ b} {max} (identityOfIndiscernablesLeft (succ (succ (a +N b))) max (succ (a +N succ b)) _<N_ pr (applyEquality succ (equalityCommutative (succExtracts a b))))
euclidLemma4 : (a b c d h : ) (sa<b : (succ a) <N b) (pr : subtractionNResult.result (-N (inl sa<b)) *N c (succ a) *N d +N h) b *N c (succ a) *N (d +N c) +N h
euclidLemma4 a b zero d h sa<b pr rewrite addZeroRight d | productZeroIsZeroRight b | productZeroIsZeroRight (subtractionNResult.result (-N (inl sa<b))) = pr
euclidLemma4 a b (succ c) d h sa<b pr rewrite subtractProduct' (succIsPositive c) sa<b = transitivity q' r'
where
q : (succ c) *N b succ (a +N c *N succ a) +N ((succ a) *N d +N h)
q = moveOneSubtraction {succ (a +N c *N succ a)} {b +N c *N b} {(succ a) *N d +N h} {inl _} pr
q' : b *N succ c succ (a +N c *N succ a) +N ((succ a) *N d +N h)
q' rewrite multiplicationNIsCommutative b (succ c) = q
r' : ((succ c) *N succ a) +N (((succ a) *N d) +N h) ((succ a) *N (d +N succ c)) +N h
r' rewrite equalityCommutative (additionNIsAssociative ((succ c) *N succ a) ((succ a) *N d) h) = applyEquality (λ t t +N h) {((succ c) *N succ a) +N ((succ a) *N d)} {(succ a) *N (d +N succ c)} (go (succ c) (succ a) d)
where
go' : (a b c : ) b *N a +N b *N c b *N (c +N a)
go : (a b c : ) a *N b +N b *N c b *N (c +N a)
go a b c rewrite multiplicationNIsCommutative a b = go' a b c
go' a b c rewrite additionNIsCommutative (b *N a) (b *N c) = equalityCommutative (productDistributes b c a)
euclidLemma5 : (a b c d h : ) (sa<b : (succ a) <N b) (pr : subtractionNResult.result (-N (inl sa<b)) *N c +N h (succ a) *N d) (succ a) *N (d +N c) b *N c +N h
euclidLemma5 a b c d h sa<b pr with (-N (inl sa<b))
euclidLemma5 a b zero d h sa<b pr | record { result = result ; pr = sub } rewrite addZeroRight d | productZeroIsZeroRight b | productZeroIsZeroRight result = equalityCommutative pr
euclidLemma5 a b (succ c) d h sa<b pr | record { result = result ; pr = sub } rewrite subtractProduct' (succIsPositive c) sa<b | equalityCommutative sub = pv''
where
p : succ a *N d result *N succ c +N h
p = equalityCommutative pr
p' : a *N succ c +N succ a *N d (a *N succ c) +N ((result *N succ c) +N h)
p' = applyEquality (λ t a *N succ c +N t) p
p'' : a *N succ c +N succ a *N d (a *N succ c +N result *N succ c) +N h
p'' rewrite (additionNIsAssociative (a *N succ c) (result *N succ c) h) = p'
p''' : a *N succ c +N succ a *N d (a +N result) *N succ c +N h
p''' rewrite productDistributes' a result (succ c) = p''
pv : c +N (a *N succ c +N succ a *N d) (c +N (a +N result) *N succ c) +N h
pv rewrite additionNIsAssociative c ((a +N result) *N succ c) h = applyEquality (λ t c +N t) p'''
pv' : (succ c) +N (a *N succ c +N succ a *N d) succ ((c +N (a +N result) *N succ c) +N h)
pv' = applyEquality succ pv
pv'' : (succ a) *N (d +N succ c) succ ((c +N (a +N result) *N succ c) +N h)
pv'' = identityOfIndiscernablesLeft ((succ c) +N (a *N succ c +N succ a *N d)) _ ((succ a) *N (d +N succ c)) _≡_ pv' (go a c d)
where
go : (a c d : ) (succ c) +N (a *N succ c +N ((succ a) *N d)) (succ a) *N (d +N succ c)
go a c d rewrite equalityCommutative (additionNIsAssociative (succ c) (a *N succ c) ((succ a) *N d)) = go'
where
go' : (succ a) *N (succ c) +N (succ a) *N d (succ a) *N (d +N succ c)
go' rewrite additionNIsCommutative d (succ c) = equalityCommutative (productDistributes (succ a) (succ c) d)
euclid : (a b : ) extendedHcf a b
euclid a b = inducted (succ a +N b) a b (a<SuccA (a +N b))
where
P : Set
P sum = (a b : ) a +N b <N sum extendedHcf a b
go'' : {a b : } (maxsum : ) (a <N b) (a +N b <N maxsum) ( y y <N maxsum P y) extendedHcf a b
go'' {zero} {b} maxSum zero<b b<maxsum indHyp = hcfZero b
go'' {1} {b} maxSum 1<b b<maxsum indHyp = hcfOne b
go'' {succ (succ a)} {b} maxSum ssa<b ssa+b<maxsum indHyp with (indHyp (succ b) (euclidLemma3 {a} {b} {maxSum} ssa+b<maxsum)) (subtractionNResult.result (-N (inl ssa<b))) (succ (succ a)) (identityOfIndiscernablesLeft b (succ b) (subtractionNResult.result (-N (inl ssa<b)) +N succ (succ a)) _<N_ (a<SuccA b) (equalityCommutative (addMinus (inl ssa<b))))
go'' {succ (succ a)} {b} maxSum ssa<b ssa+b<maxsum indHyp | record { hcf = record { c = c ; c|a = c|a ; c|b = c|b ; hcf = hcf } ; extended1 = extended1 ; extended2 = extended2 ; extendedProof = inl extendedProof } = record { hcf = record { c = c ; c|a = c|b ; c|b = hcfDivB'' ; hcf = λ div prDivSSA prDivB hcf div (dividesBothImpliesDividesDifference prDivB prDivSSA ssa<b) prDivSSA } ; extended2 = extended1; extended1 = extended2 +N extended1 ; extendedProof = inr (equalityCommutative (euclidLemma4 (succ a) b extended1 extended2 c ssa<b extendedProof)) }
where
hcfDivB : c ((succ (succ a)) +N (subtractionNResult.result (-N (inl ssa<b))))
hcfDivB = dividesBothImpliesDividesSum {c} {succ (succ a)} { subtractionNResult.result (-N (inl ssa<b))} c|b c|a
hcfDivB' : c ((subtractionNResult.result (-N (inl ssa<b))) +N (succ (succ a)))
hcfDivB' = identityOfIndiscernablesRight c ((succ (succ a)) +N (subtractionNResult.result (-N (inl ssa<b)))) ((subtractionNResult.result (-N (inl ssa<b))) +N (succ (succ a))) __ hcfDivB (additionNIsCommutative (succ (succ a)) ( subtractionNResult.result (-N (inl ssa<b))))
hcfDivB'' : c b
hcfDivB'' = identityOfIndiscernablesRight c ((subtractionNResult.result (-N (inl ssa<b))) +N (succ (succ a))) b __ hcfDivB' (addMinus (inl ssa<b))
go'' {succ (succ a)} {b} maxSum ssa<b ssa+b<maxsum indHyp | record { hcf = record { c = c ; c|a = c|a ; c|b = c|b ; hcf = hcf } ; extended1 = extended1 ; extended2 = extended2 ; extendedProof = inr extendedProof } = record { hcf = record { c = c ; c|a = c|b ; c|b = hcfDivB'' ; hcf = λ div prDivSSA prDivB hcf div (dividesBothImpliesDividesDifference prDivB prDivSSA ssa<b) prDivSSA } ; extended2 = extended1; extended1 = extended2 +N extended1 ; extendedProof = inl (euclidLemma5 (succ a) b extended1 extended2 c ssa<b extendedProof) }
where
hcfDivB : c ((succ (succ a)) +N (subtractionNResult.result (-N (inl ssa<b))))
hcfDivB = dividesBothImpliesDividesSum {c} {succ (succ a)} { subtractionNResult.result (-N (inl ssa<b))} c|b c|a
hcfDivB' : c ((subtractionNResult.result (-N (inl ssa<b))) +N (succ (succ a)))
hcfDivB' = identityOfIndiscernablesRight c ((succ (succ a)) +N (subtractionNResult.result (-N (inl ssa<b)))) ((subtractionNResult.result (-N (inl ssa<b))) +N (succ (succ a))) __ hcfDivB (additionNIsCommutative (succ (succ a)) ( subtractionNResult.result (-N (inl ssa<b))))
hcfDivB'' : c b
hcfDivB'' = identityOfIndiscernablesRight c ((subtractionNResult.result (-N (inl ssa<b))) +N (succ (succ a))) b __ hcfDivB' (addMinus (inl ssa<b))
go' : (maxSum a b : ) (a +N b <N maxSum) ( y y <N maxSum P y) extendedHcf a b
go' maxSum a b a+b<maxsum indHyp with orderIsTotal a b
go' maxSum a b a+b<maxsum indHyp | inl (inl a<b) = go'' maxSum a<b a+b<maxsum indHyp
go' maxSum a b a+b<maxsum indHyp | inl (inr b<a) = reverseHCF (go'' maxSum b<a (identityOfIndiscernablesLeft (a +N b) maxSum (b +N a) _<N_ a+b<maxsum (additionNIsCommutative a b)) indHyp)
go' maxSum a .a _ indHyp | inr refl = record { hcf = record { c = a ; c|a = aDivA a ; c|b = aDivA a ; hcf = λ _ _ z z } ; extended1 = 0 ; extended2 = 1 ; extendedProof = inr s}
where
s : a *N zero +N a a *N 1
s rewrite multiplicationNIsCommutative a zero | productWithOneRight a = refl
go : x ( y y <N x P y) P x
go maxSum indHyp = λ a b a+b<maxSum go' maxSum a b a+b<maxSum indHyp
inducted : x P x
inducted = rec <NWellfounded P go
divisorIsSmaller : {a b : } a succ b succ b <N a False
divisorIsSmaller {a} {b} (divides record { quot = zero ; rem = .0 ; pr = pr } refl) sb<a rewrite addZeroRight (a *N zero) = go
where
go : False
go rewrite productZeroIsZeroRight a = naughtE pr
divisorIsSmaller {a} {b} (divides record { quot = (succ quot) ; rem = .0 ; pr = pr } refl) sb<a rewrite addZeroRight (a *N succ quot) = go
where
go : False
go rewrite equalityCommutative pr = go'
where
go' : False
go' rewrite multiplicationNIsCommutative a (succ quot) = cannotAddAndEnlarge' sb<a
primeDivisorIs1OrP : {a p : } (prime : Prime p) (a p) (a 1) || (a p)
primeDivisorIs1OrP {zero} {zero} prime a|p = inr refl
primeDivisorIs1OrP {zero} {succ p} prime a|p = exFalso (zeroDividesNothing p a|p)
primeDivisorIs1OrP {succ zero} {p} prime a|p = inl refl
primeDivisorIs1OrP {succ (succ a)} {p} prime a|p with orderIsTotal (succ (succ a)) p
primeDivisorIs1OrP {succ (succ a)} {p} prime a|p | inl (inl ssa<p) = go p prime a|p ssa<p
where
go : (n : ) Prime n succ (succ a) n succ (succ a) <N n (succ (succ a) 1) || (succ (succ a) p)
go zero pr x|n n<n = exFalso (zeroIsNotPrime pr)
go (succ zero) pr x|n n<n = exFalso (oneIsNotPrime pr)
go (succ (succ n)) pr x|n n<n = inl ((Prime.pr pr) {succ (succ a)} x|n n<n (succIsPositive (succ a)))
primeDivisorIs1OrP {succ (succ a)} {zero} prime a|p | inl (inr x) = exFalso (zeroIsNotPrime prime)
primeDivisorIs1OrP {succ (succ a)} {succ p} prime a|p | inl (inr x) = exFalso (divisorIsSmaller {succ (succ a)} {p} a|p x)
primeDivisorIs1OrP {succ (succ a)} {p} prime a|p | inr x = inr x
hcfPrimeIsOne' : {p : } {a : } (Prime p) (0 <N divisionAlgResult.rem (divisionAlg p a)) (extendedHcf.c (euclid a p) 1) || (extendedHcf.c (euclid a p) p)
hcfPrimeIsOne' {p} {a} pPrime pCoprimeA with euclid a p
hcfPrimeIsOne' {p} {a} pPrime pCoprimeA | record { hcf = record { c = hcf ; c|a = hcf|a ; c|b = hcf|p ; hcf = hcfPr } } with divisionAlg p a
hcfPrimeIsOne' {p} {a} pPrime pCoprimeA | record { hcf = record { c = hcf ; c|a = hcf|a ; c|b = hcf|p ; hcf = hcfPr } } | record { quot = quot ; rem = rem ; pr = prPDivA } with primeDivisorIs1OrP pPrime hcf|p
hcfPrimeIsOne' {p} {a} pPrime pCoprimeA | record { hcf = record { c = hcf ; c|a = hcf|a ; c|b = hcf|p ; hcf = hcfPr } } | record { quot = quot ; rem = rem ; pr = prPDivA } | inl x = inl x
hcfPrimeIsOne' {p} {a} pPrime pCoprimeA | record { hcf = record { c = hcf ; c|a = hcf|a ; c|b = hcf|p ; hcf = hcfPr } } | record { quot = quot ; rem = rem ; pr = prPDivA } | inr x = inr x
divisionDecidable : (a b : ) (a b) || ((a b) False)
divisionDecidable zero zero = inl (aDivA zero)
divisionDecidable zero (succ b) = inr f
where
f : zero succ b False
f (divides record { quot = quot ; rem = rem ; pr = pr ; remIsSmall = remIsSmall } x) rewrite x = naughtE pr
divisionDecidable (succ a) b with divisionAlg (succ a) b
divisionDecidable (succ a) b | record { quot = quot ; rem = zero ; pr = pr ; remIsSmall = remSmall } = inl (divides (record { quot = quot ; rem = zero ; pr = pr ; remIsSmall = remSmall ; quotSmall = inl (succIsPositive a) }) refl)
divisionDecidable (succ a) b | record { quot = b/a ; rem = succ rem ; pr = prANotDivB ; remIsSmall = inr p } = naughtE (equalityCommutative p)
divisionDecidable (succ a) b | record { quot = b/a ; rem = succ rem ; pr = prANotDivB ; remIsSmall = inl p } = inr f
where
f : (succ a) b False
f (divides record { quot = b/a' ; rem = .0 ; pr = pr } refl) rewrite addZeroRight ((succ a) *N b/a') = naughtE (modUniqueLemma {zero} {succ rem} {succ a} b/a' b/a (succIsPositive a) p comp')
where
comp : (succ a) *N b/a' (succ a) *N b/a +N succ rem
comp = transitivity pr (equalityCommutative prANotDivB)
comp' : (succ a) *N b/a' +N zero (succ a) *N b/a +N succ rem
comp' rewrite addZeroRight (succ a *N b/a') = comp
doesNotDivideImpliesNonzeroRem : (a b : ) ((a b) False) 0 <N divisionAlgResult.rem (divisionAlg a b)
doesNotDivideImpliesNonzeroRem a b pr with divisionAlg a b
doesNotDivideImpliesNonzeroRem a b pr | record { quot = quot ; rem = rem ; pr = divAlgPr ; remIsSmall = remIsSmall } with zeroIsValidRem rem
doesNotDivideImpliesNonzeroRem a b pr | record { quot = quot ; rem = rem ; pr = divAlgPr ; remIsSmall = remIsSmall } | inl x = x
doesNotDivideImpliesNonzeroRem a b pr | record { quot = quot ; rem = rem ; pr = divAlgPr ; remIsSmall = remIsSmall ; quotSmall = quotSmall } | inr x = exFalso (pr aDivB)
where
aDivB : a b
aDivB = divides (record { quot = quot ; rem = rem ; pr = divAlgPr ; remIsSmall = remIsSmall ; quotSmall = quotSmall }) x
hcfPrimeIsOne : {p : } {a : } (Prime p) ((p a) False) extendedHcf.c (euclid a p) 1
hcfPrimeIsOne {p} {a} pPrime pr with hcfPrimeIsOne' {p} {a} pPrime (doesNotDivideImpliesNonzeroRem p a pr)
hcfPrimeIsOne {p} {a} pPrime pr | inl x = x
hcfPrimeIsOne {p} {a} pPrime pr | inr x with euclid a p
hcfPrimeIsOne {p} {a} pPrime pr | inr x | record { hcf = record { c = c ; c|a = c|a ; c|b = c|b ; hcf = hcf } ; extended1 = extended1 ; extended2 = extended2 ; extendedProof = extendedProof } rewrite x = exFalso (pr c|a)
reduceEquationMod : {a b c : } (d : ) (a b) (a c) b c +N d a d
reduceEquationMod {a} {b} {c} 0 a|b a|c pr = aDivZero a
reduceEquationMod {a} {b} {c} (succ d) (divides record { quot = b/a ; rem = .0 ; pr = prb/a ; remIsSmall = r1 ; quotSmall = qSm1 } refl) (divides record { quot = c/a ; rem = .0 ; pr = prc/a ; remIsSmall = r2 ; quotSmall = qSm2 } refl) b=c+d = identityOfIndiscernablesRight a (subtractionNResult.result (-N (inl c<b))) (succ d) __ a|b-c ex'
where
c<b : c <N b
c<b rewrite succExtracts c d | additionNIsCommutative c d = le d (equalityCommutative b=c+d)
a|b-c : a subtractionNResult.result (-N (inl c<b))
a|b-c = dividesBothImpliesDividesDifference (divides record { quot = b/a ; rem = 0 ; pr = prb/a ; remIsSmall = r1 ; quotSmall = qSm1 } refl) (divides record { quot = c/a ; rem = 0 ; pr = prc/a ; remIsSmall = r2 ; quotSmall = qSm2 } refl) c<b
ex : subtractionNResult.result (-N {c} {b} (inl c<b)) subtractionNResult.result (-N {0} {succ d} (inl (succIsPositive d)))
ex = equivalentSubtraction c (succ d) b 0 (c<b) (succIsPositive d) (equalityCommutative (identityOfIndiscernablesLeft b (c +N succ d) (b +N 0) _≡_ b=c+d (equalityCommutative (addZeroRight b))))
ex' : subtractionNResult.result (-N {c} {b} (inl c<b)) succ d
ex' = identityOfIndiscernablesRight (subtractionNResult.result (-N (inl c<b))) (subtractionNResult.result (-N (inl (succIsPositive d)))) (succ d) _≡_ ex refl
primesArePrime : {p : } {a b : } (Prime p) p (a *N b) (p a) || (p b)
primesArePrime {p} {a} {b} pPrime pr with divisionDecidable p a
primesArePrime {p} {a} {b} pPrime pr | inl p|a = inl p|a
primesArePrime {p} {a} {b} pPrime (divides record {quot = ab/p ; rem = .0 ; pr = p|ab ; remIsSmall = _ ; quotSmall = quotSmall } refl) | inr notp|a = inr (answer ex'')
where
euc : extendedHcf a p
euc = euclid a p
h : extendedHcf.c euc 1
h = hcfPrimeIsOne {p} {a} pPrime notp|a
x = extendedHcf.extended1 euc
y = extendedHcf.extended2 euc
extended : ((a *N x) p *N y +N extendedHcf.c euc) || (a *N x +N extendedHcf.c euc p *N y)
extended = extendedHcf.extendedProof euc
extended' : (a *N x p *N y +N 1) || (a *N x +N 1 p *N y)
extended' rewrite equalityCommutative h = extended
extended'' : ((a *N x p *N y +N 1) || (a *N x +N 1 p *N y)) (b *N (a *N x) b *N (p *N y +N 1)) || (b *N (a *N x +N 1) b *N (p *N y))
extended'' (inl z) = inl (applyEquality (λ t b *N t) z)
extended'' (inr z) = inr (applyEquality (λ t b *N t) z)
ex : (b *N (a *N x) b *N (p *N y +N 1)) || (b *N (a *N x +N 1) b *N (p *N y)) ((b *N a) *N x (b *N (p *N y) +N b)) || (((b *N a) *N x +N b) b *N (p *N y))
ex (inl z) rewrite multiplicationNIsAssociative b a x | productDistributes b (p *N y) 1 | productWithOneRight b = inl z
ex (inr z) rewrite productDistributes b (a *N x) 1 | multiplicationNIsAssociative b a x | productWithOneRight b = inr z
ex' : ((a *N b) *N x ((p *N y) *N b +N b)) || (((a *N b) *N x +N b) (p *N y) *N b)
ex' rewrite multiplicationNIsCommutative a b | multiplicationNIsCommutative (p *N y) b = ex (extended'' extended')
ex'' : ((a *N b) *N x (p *N (y *N b) +N b)) || (((a *N b) *N x +N b) p *N (y *N b))
ex'' rewrite multiplicationNIsAssociative (p) y b = ex'
inter1 : p (a *N b) *N x
inter1 = divides (record {quot = ab/p *N x ; rem = 0 ; pr = g ; remIsSmall = zeroIsValidRem p ; quotSmall = qsm quotSmall}) refl
where
g' : p *N ab/p a *N b
g' rewrite addZeroRight (p *N ab/p) = p|ab
g'' : p *N (ab/p *N x) (a *N b) *N x
g'' rewrite multiplicationNIsAssociative (p) ab/p x = applyEquality (λ t t *N x) g'
g : p *N (ab/p *N x) +N 0 (a *N b) *N x
g rewrite addZeroRight (p *N (ab/p *N x)) = g''
qsm : ((0 <N p) || ((0 p) && (ab/p 0))) (0 <N p) || ((0 p) && (ab/p *N x 0))
qsm (inl pr) = inl pr
qsm (inr (pr1 ,, pr2)) = inr (pr1 ,, blah)
where
blah : ab/p *N x 0
blah rewrite pr2 = refl
inter2 : ((0 <N p) || ((0 p) && (ab/p 0))) p (p *N (y *N b))
inter2 (inl 0<p) = divides (record {quot = y *N b ; rem = 0 ; pr = addZeroRight (p *N (y *N b)) ; remIsSmall = zeroIsValidRem p ; quotSmall = inl 0<p }) refl
inter2 (inr (0=p ,, ab/p=0)) = divides (record {quot = y *N b ; rem = 0 ; pr = addZeroRight (p *N (y *N b)) ; remIsSmall = zeroIsValidRem p ; quotSmall = inr (0=p ,, blah) }) refl
where
oneZero : (a 0) || (b 0)
oneZero rewrite additionNIsCommutative (p *N ab/p) 0 | ab/p=0 | equalityCommutative 0=p = productZeroImpliesOperandZero (equalityCommutative p|ab)
blah : y *N b 0
blah with oneZero
blah | inl x1 = exFalso (notp|a p|a)
where
p|a : p a
p|a rewrite x1 = aDivZero p
blah | inr x1 rewrite x1 = productZeroIsZeroRight y
answer : ((a *N b) *N x (p *N (y *N b) +N b)) || (((a *N b) *N x +N b) p *N (y *N b)) (p b)
answer (inl z) = reduceEquationMod {p} b inter1 (inter2 quotSmall) z
answer (inr z) = reduceEquationMod {p} b (inter2 quotSmall) inter1 (equalityCommutative z)
primesAreBiggerThanOne : {p : } Prime p (1 <N p)
primesAreBiggerThanOne {zero} record { p>1 = (le x ()) ; pr = pr }
primesAreBiggerThanOne {succ zero} pr = exFalso (oneIsNotPrime pr)
primesAreBiggerThanOne {succ (succ p)} pr = succPreservesInequality (succIsPositive p)
primesAreBiggerThanZero : {p : } Prime p 0 <N p
primesAreBiggerThanZero {p} pr = orderIsTransitive (succIsPositive 0) (primesAreBiggerThanOne pr)
record notDividedByLessThan (a : ) (firstPossibleDivisor : ) : Set where
field
previousDoNotDivide : x 1 <N x x <N firstPossibleDivisor x a False
alternativePrime : {a : } 1 <N a notDividedByLessThan a a Prime a
alternativePrime {a} 1<a record { previousDoNotDivide = previousDoNotDivide } = record { pr = pr ; p>1 = 1<a}
where
pr : {x : } (x|a : x a) (x<a : x <N a) (0<x : zero <N x) x 1
pr {zero} _ _ (le x ())
pr {succ zero} _ _ _ = refl
pr {succ (succ x)} x|a x<a 0<x = exFalso (previousDoNotDivide (succ (succ x)) (succPreservesInequality (succIsPositive x)) x<a x|a)
divisibilityTransitive : {a b c : } a b b c a c
divisibilityTransitive {a} {b} {c} (divides record { quot = b/a ; rem = .0 ; pr = prDivAB ; remIsSmall = remIsSmallAB ; quotSmall = quotSmall } refl) (divides record { quot = c/b ; rem = .0 ; pr = prDivBC ; remIsSmall = remIsSmallBC } refl) = divides record { quot = b/a *N c/b ; rem = 0 ; pr = p ; remIsSmall = zeroIsValidRem a ; quotSmall = qsm quotSmall } refl
where
p : a *N (b/a *N c/b) +N 0 c
p rewrite addZeroRight (a *N (b/a *N c/b)) | addZeroRight (b *N c/b) | addZeroRight (a *N b/a) | multiplicationNIsAssociative a b/a c/b | prDivAB | prDivBC = refl
qsm : ((0 <N a) || (0 a) && (b/a 0)) ((0 <N a) || (0 a) && (b/a *N c/b 0))
qsm (inl x) = inl x
qsm (inr (p1 ,, p2)) = inr (p1 ,, blah)
where
blah : b/a *N c/b 0
blah rewrite p2 = refl
compositeOrPrimeLemma : {a b : } notDividedByLessThan b a a b {i : } (i a) (i <N a) (0 <N i) i 1
compositeOrPrimeLemma {a} {b} record { previousDoNotDivide = previousDoNotDivide } a|b {zero} i|a i<a 0<i = exFalso (lessIrreflexive 0<i)
compositeOrPrimeLemma {a} {b} record { previousDoNotDivide = previousDoNotDivide } a|b {succ zero} i|a i<a 0<i = refl
compositeOrPrimeLemma {a} {b} record { previousDoNotDivide = previousDoNotDivide } a|b {succ (succ i)} i|a i<a 0<i = exFalso (previousDoNotDivide (succ (succ i)) (succPreservesInequality (succIsPositive i)) i<a (divisibilityTransitive i|a a|b) )
compositeOrPrime : (a : ) (1 <N a) (Composite a) || (Prime a)
compositeOrPrime a pr = go''' go''
where
base : notDividedByLessThan a 2
base = record { previousDoNotDivide = λ x 1<x x<2 _ noIntegersBetweenXAndSuccX 1 1<x x<2 }
go : {firstPoss : } notDividedByLessThan a firstPoss ((notDividedByLessThan a (succ firstPoss)) || ((firstPoss a) && (firstPoss <N a))) || (firstPoss a)
go' : (firstPoss : ) (((notDividedByLessThan a firstPoss) || (Composite a))) || (notDividedByLessThan a a)
go'' : (notDividedByLessThan a a) || (Composite a)
go'' with go' a
... | inr x = inl x
... | inl x = x
go''' : ((notDividedByLessThan a a) || (Composite a)) ((Composite a) || (Prime a))
go''' (inl x) = inr (alternativePrime pr x)
go''' (inr x) = inl x
go' (zero) = inl (inl (record { previousDoNotDivide = λ x 1<x x<0 _ zeroNeverGreater x<0 }))
go' (succ 0) = inl (inl (record { previousDoNotDivide = λ x 1<x x<1 _ orderIsIrreflexive x<1 1<x }))
go' (succ (succ zero)) = inl (inl base)
go' (succ (succ (succ firstPoss))) with go' (succ (succ firstPoss))
go' (succ (succ (succ firstPoss))) | inl (inl x) with go {succ (succ firstPoss)} x
go' (succ (succ (succ firstPoss))) | inl (inl x) | inl (inl x1) = inl (inl x1)
go' (succ (succ (succ firstPoss))) | inl (inl x) | inl (inr x1) = inl (inr record { noSmallerDivisors = λ i i<ssFP 1<i i|a notDividedByLessThan.previousDoNotDivide x i 1<i i<ssFP i|a ; n>1 = pr ; divisor = succ (succ firstPoss) ; dividesN = _&&_.fst x1 ; divisorLessN = _&&_.snd x1 ; divisorNot1 = succPreservesInequality (succIsPositive firstPoss) ; divisorPrime = record { p>1 = succPreservesInequality (succIsPositive firstPoss) ; pr = compositeOrPrimeLemma {succ (succ firstPoss)} {a} x (_&&_.fst x1) } })
go' (succ (succ (succ firstPoss))) | inl (inl x) | inr y rewrite y = inr x
go' (succ (succ (succ firstPoss))) | inl (inr x) = inl (inr x)
go' (succ (succ (succ firstPoss))) | inr x = inr x
go {zero} pr = inl (inl (record { previousDoNotDivide = λ x 1<x x<1 _ orderIsIrreflexive x<1 1<x}))
go {succ firstPoss} knownCoprime with orderIsTotal (succ firstPoss) a
go {succ firstPoss} knownCoprime | inr x = inr x
go {succ firstPoss} knownCoprime | inl (inl sFP<a) with divisionAlg (succ firstPoss) a
go {succ firstPoss} knownCoprime | inl (inl sFP<a) | record { quot = quot ; rem = zero ; pr = pr ; remIsSmall = remIsSmall } = inl (inr record { fst = (divides (record { quot = quot ; rem = zero ; remIsSmall = remIsSmall ; pr = pr ; quotSmall = inl (succIsPositive firstPoss) }) refl) ; snd = sFP<a })
go {succ firstPoss} knownCoprime | inl (inl sFP<a) | record { quot = quot ; rem = succ rem ; pr = pr ; remIsSmall = remIsSmall } = inl next
where
previous : x 1 <N x x <N succ firstPoss x a False
previous = notDividedByLessThan.previousDoNotDivide knownCoprime
next : notDividedByLessThan a (succ (succ firstPoss)) || (((succ firstPoss) a) && (succ firstPoss <N a))
next with divisionAlg (succ firstPoss) a
next | record { quot = quot ; rem = zero ; pr = pr ; remIsSmall = remIsSmall } = inr (record { fst = divides record { quot = quot ; rem = zero ; pr = pr ; remIsSmall = remIsSmall ; quotSmall = inl (succIsPositive firstPoss) } refl ; snd = sFP<a } )
next | record { quot = quot ; rem = succ rem ; pr = pr ; remIsSmall = remIsSmall } = inl record { previousDoNotDivide = (next' record { quot = quot ; rem = succ rem ; pr = pr ; remIsSmall = remIsSmall ; quotSmall = inl (succIsPositive firstPoss) } (succIsPositive rem)) }
where
next' : (res : divisionAlgResult (succ firstPoss) a) (pr : 0 <N divisionAlgResult.rem res) (x : ) 1 <N x x <N succ (succ firstPoss) x a False
next' (res) (prDiv) x 1<x x<ssFirstposs x|a with orderIsTotal x (succ firstPoss)
next' (res) (prDiv) x 1<x x<ssFirstposs x|a | inl (inl x<sFirstPoss) = previous x 1<x x<sFirstPoss x|a
next' (res) (prDiv) x 1<x x<ssFirstposs x|a | inl (inr sFirstPoss<x) = noIntegersBetweenXAndSuccX (succ firstPoss) sFirstPoss<x x<ssFirstposs
next' res prDiv x 1<x x<ssFirstposs (divides res1 x1) | inr x=sFirstPoss rewrite equalityCommutative x=sFirstPoss = g
where
g : False
g with modIsUnique res res1
... | r rewrite r = lessImpliesNotEqual prDiv (equalityCommutative x1)
go {succ firstPoss} record { previousDoNotDivide = previousDoNotDivide } | inl (inr a<sFP) = exFalso (previousDoNotDivide a pr a<sFP (aDivA a))
primeDivPrimeImpliesEqual : {p1 p2 : } Prime p1 Prime p2 p1 p2 p1 p2
primeDivPrimeImpliesEqual {p1} {p2} pr1 pr2 p1|p2 with orderIsTotal p1 p2
primeDivPrimeImpliesEqual {p1} {p2} pr1 record { p>1 = p>1 ; pr = pr } p1|p2 | inl (inl p1<p2) with pr p1|p2 p1<p2 (primesAreBiggerThanZero {p1} pr1)
... | p1=1 = exFalso (oneIsNotPrime contr)
where
contr : Prime 1
contr rewrite p1=1 = pr1
primeDivPrimeImpliesEqual {p1} {zero} pr1 pr2 p1|p2 | inl (inr p1>p2) = exFalso (zeroIsNotPrime pr2)
primeDivPrimeImpliesEqual {p1} {succ p2} pr1 pr2 p1|p2 | inl (inr p1>p2) = exFalso (divisorIsSmaller p1|p2 p1>p2)
primeDivPrimeImpliesEqual {p1} {p2} pr1 pr2 p1|p2 | inr p1=p2 = p1=p2
mult1Lemma : {a b : } a *N succ b 1 (a 1) && (b 0)
mult1Lemma {a} {b} pr = record { fst = _&&_.fst p ; snd = q}
where
p : (a 1) && (succ b 1)
p = productOneImpliesOperandsOne pr
q : b zero
q = succInjective (_&&_.snd p)
oneHasNoDivisors : {a : } a 1 a 1
oneHasNoDivisors {a} (divides record { quot = zero ; rem = .0 ; pr = pr ; remIsSmall = remIsSmall } refl) rewrite addZeroRight (a *N zero) | multiplicationNIsCommutative a zero | addZeroRight a = naughtE pr
oneHasNoDivisors {a} (divides record { quot = (succ quot) ; rem = .0 ; pr = pr ; remIsSmall = remIsSmall } refl) rewrite addZeroRight (a *N succ quot) = _&&_.fst (mult1Lemma pr)
notSmallerMeansGE : {a b : } (a <N b False) b ≤N a
notSmallerMeansGE {a} {b} notA<b with orderIsTotal a b
notSmallerMeansGE {a} {b} notA<b | inl (inl x) = exFalso (notA<b x)
notSmallerMeansGE {a} {b} notA<b | inl (inr x) = inl x
notSmallerMeansGE {a} {b} notA<b | inr x = inr (equalityCommutative x)