Primes and mod-n into the fold (#47)

This commit is contained in:
Patrick Stevens
2019-10-02 18:59:46 +01:00
committed by GitHub
parent 00ce1dfdf8
commit 21ee0f899d
10 changed files with 48 additions and 39 deletions

View File

@@ -0,0 +1,268 @@
{-# OPTIONS --warning=error --safe #-}
open import LogicalFormulae
open import Numbers.Naturals.Naturals
open import Numbers.Naturals.Addition
open import Numbers.Naturals.Order
open import Numbers.Primes.PrimeNumbers
open import WellFoundedInduction
open import Semirings.Definition
open import Orders
module Numbers.Primes.IntegerFactorisation where
-- Represent a factorisation into increasing factors
-- Note that 0 cannot be expressed this way.
record factorisationNonunit (minFactor : ) (a : ) : Set where
inductive
field
1<a : 1 <N a
firstFactor :
firstFactorNontrivial : 1 <N firstFactor
firstFactorBiggerMin : minFactor ≤N firstFactor
firstFactorDivision : divisionAlgResult firstFactor a
firstFactorDivides : divisionAlgResult.rem firstFactorDivision 0
firstFactorPrime : Prime firstFactor
otherFactorsNumber :
otherFactors : ((divisionAlgResult.quot firstFactorDivision 1) && (otherFactorsNumber 0)) || (((1 <N divisionAlgResult.quot firstFactorDivision) && (factorisationNonunit firstFactor (divisionAlgResult.quot firstFactorDivision))))
lemma : (p : ) p *N 1 +N 0 p
lemma p rewrite Semiring.sumZeroRight Semiring (p *N 1) | Semiring.productOneRight Semiring p = refl
lemma' : {a b : } a *N zero +N 0 b b zero
lemma' {a} {b} pr rewrite Semiring.sumZeroRight Semiring (a *N zero) | Semiring.productZeroRight Semiring a = equalityCommutative pr
primeFactorisation : {p : } (pr : Prime p) factorisationNonunit 1 p
primeFactorisation {p} record { p>1 = p>1 ; pr = pr } = record {1<a = p>1 ; firstFactor = p ; firstFactorNontrivial = p>1 ; firstFactorBiggerMin = inl p>1 ; firstFactorDivision = record { quot = 1 ; rem = 0 ; pr = lemma p ; remIsSmall = zeroIsValidRem p ; quotSmall = inl (TotalOrder.transitive TotalOrder (le zero refl) p>1) } ; firstFactorDivides = refl ; firstFactorPrime = record { p>1 = p>1 ; pr = pr} ; otherFactors = inl record { fst = refl ; snd = refl } ; otherFactorsNumber = 0 }
where
proof : (s : ) s *N 1 +N 0 s
proof s rewrite Semiring.sumZeroRight Semiring (s *N 1) | multiplicationNIsCommutative s 1 | Semiring.sumZeroRight Semiring s = refl
twoAsFact : factorisationNonunit 2 2
factorisationNonunit.1<a twoAsFact = succPreservesInequality (succIsPositive 0)
factorisationNonunit.firstFactor twoAsFact = 2
factorisationNonunit.firstFactorNontrivial twoAsFact = succPreservesInequality (succIsPositive 0)
factorisationNonunit.firstFactorBiggerMin twoAsFact = inr refl
factorisationNonunit.firstFactorDivision twoAsFact = record { quot = 1 ; rem = 0 ; remIsSmall = zeroIsValidRem 2 ; pr = refl ; quotSmall = inl (le 1 refl) }
factorisationNonunit.firstFactorDivides twoAsFact = refl
factorisationNonunit.firstFactorPrime twoAsFact = twoIsPrime
factorisationNonunit.otherFactorsNumber twoAsFact = 0
factorisationNonunit.otherFactors twoAsFact = inl record { fst = refl ; snd = refl }
fourFact : factorisationNonunit 1 4
factorisationNonunit.1<a fourFact = succPreservesInequality (succIsPositive 2)
factorisationNonunit.firstFactor fourFact = 2
factorisationNonunit.firstFactorNontrivial fourFact = succPreservesInequality (succIsPositive 0)
factorisationNonunit.firstFactorBiggerMin fourFact = inl (succPreservesInequality (succIsPositive 0))
factorisationNonunit.firstFactorDivision fourFact = record { quot = 2 ; rem = 0 ; remIsSmall = zeroIsValidRem 2 ; pr = refl ; quotSmall = inl (le 1 refl) }
factorisationNonunit.firstFactorDivides fourFact = refl
factorisationNonunit.firstFactorPrime fourFact = twoIsPrime
factorisationNonunit.otherFactorsNumber fourFact = 1
factorisationNonunit.otherFactors fourFact = inr record { fst = succPreservesInequality (succIsPositive 0) ; snd = twoAsFact }
lessLemma : {y : } (1 <N y) (zero <N y)
lessLemma {.(succ (x +N 1))} (le x refl) = succIsPositive (x +N 1)
canReduceFactorBound : {a i j : } factorisationNonunit i a j <N i factorisationNonunit j a
canReduceFactorBound {a} {i} {j} record { 1<a = 1<a ; firstFactor = firstFactor ; firstFactorNontrivial = firstFactorNontrivial ; firstFactorBiggerMin = inl ff<i ; firstFactorDivision = firstFactorDivision ; firstFactorDivides = firstFactorDivides ; firstFactorPrime = firstFactorPrime ; otherFactors = otherFactors } j<i = record { 1<a = 1<a ; firstFactor = firstFactor ; firstFactorNontrivial = firstFactorNontrivial ; firstFactorBiggerMin = inl (lessTransitive j<i ff<i) ; firstFactorDivision = firstFactorDivision ; firstFactorDivides = firstFactorDivides ; firstFactorPrime = firstFactorPrime ; otherFactors = otherFactors }
canReduceFactorBound {a} {i} {j} record { 1<a = 1<a ; firstFactor = firstFactor ; firstFactorNontrivial = firstFactorNontrivial ; firstFactorBiggerMin = inr ff=i ; firstFactorDivision = firstFactorDivision ; firstFactorDivides = firstFactorDivides ; firstFactorPrime = firstFactorPrime ; otherFactors = otherFactors } j<i = record { 1<a = 1<a ; firstFactor = firstFactor ; firstFactorNontrivial = firstFactorNontrivial ; firstFactorBiggerMin = inl (identityOfIndiscernablesRight j i firstFactor _<N_ j<i ff=i) ; firstFactorDivision = firstFactorDivision ; firstFactorDivides = firstFactorDivides ; firstFactorPrime = firstFactorPrime ; otherFactors = otherFactors }
canReduceFactorBound' : {a i j : } factorisationNonunit i a j ≤N i factorisationNonunit j a
canReduceFactorBound' {a} {i} {j} factA (inl x) = canReduceFactorBound factA x
canReduceFactorBound' {a} {i} {.i} factA (inr refl) = factA
canIncreaseFactorBound : {a i : } (fact : factorisationNonunit 1 a) ( x 1 <N x x <N i x a False) (i ≤N factorisationNonunit.firstFactor fact) factorisationNonunit i a
canIncreaseFactorBound {a} {i} record { 1<a = 1<a ; firstFactor = firstFactor ; firstFactorNontrivial = firstFactorNontrivial ; firstFactorBiggerMin = firstFactorBiggerMin ; firstFactorDivision = firstFactorDivision ; firstFactorDivides = firstFactorDivides ; firstFactorPrime = firstFactorPrime ; otherFactors = otherFactors } noSmaller iSmallEnough = record { 1<a = 1<a ; firstFactor = firstFactor ; firstFactorNontrivial = Prime.p>1 firstFactorPrime ; firstFactorBiggerMin = iSmallEnough ; firstFactorDivision = firstFactorDivision ; firstFactorDivides = firstFactorDivides ; firstFactorPrime = firstFactorPrime ; otherFactors = otherFactors }
-- Get the smallest prime factor of the number
everyNumberHasAPrimeFactor : {a : } (1 <N a) Sg (λ i ((i a) && (1 <N i)) && ((Prime i) && ( x x <N i 1 <N x x a False)))
everyNumberHasAPrimeFactor {a} 1<a with compositeOrPrime a 1<a
everyNumberHasAPrimeFactor {a} 1<a | inl record { n>1 = n>1 ; divisor = divisor ; dividesN = dividesN ; divisorLessN = divisorLessN ; divisorNot1 = divisorNot1 ; divisorPrime = divisorPrime ; noSmallerDivisors = noSmallerDivisors } = ( divisor , record { fst = record { fst = dividesN ; snd = divisorNot1 } ; snd = record { fst = divisorPrime ; snd = noSmallerDivisors } } )
everyNumberHasAPrimeFactor {a} 1<a | inr x = (a , record { fst = record { fst = aDivA a ; snd = 1<a } ; snd = record { fst = x ; snd = λ y y<a 1<y y|a lessImpliesNotEqual 1<y (equalityCommutative (Prime.pr x y|a y<a (lessLemma 1<y))) }} )
lemma2 : {a b c : } 1 <N a 0 <N b a *N b +N 0 c b <N c
lemma2 {zero} {b} {c} 1<a _ pr = exFalso (zeroNeverGreater 1<a)
lemma2 {succ zero} {b} {c} 1<a _ pr = exFalso (lessIrreflexive 1<a)
lemma2 {succ (succ a)} {zero} {zero} 1<a t pr = exFalso (lessIrreflexive t)
lemma2 {succ (succ a)} {zero} {succ c} 1<a t pr = succIsPositive c
lemma2 {succ (succ a)} {succ b} {c} 1<a t pr = le (b +N (a *N succ b)) go
where
assocLemm : (a b c : ) (a +N b) +N c (a +N c) +N b
assocLemm a b c rewrite equalityCommutative (Semiring.+Associative Semiring a b c) | Semiring.commutative Semiring b c | Semiring.+Associative Semiring a c b = refl
go : succ ((b +N a *N succ b) +N succ b) c
go rewrite Semiring.sumZeroRight Semiring (succ (b +N succ (b +N a *N succ b))) | equalityCommutative (assocLemm b (succ b) (a *N succ b)) | Semiring.+Associative Semiring b (succ b) (a *N succ b) = pr
factorIntegerLemma : (x : ) (indHyp : (y : ) (y<x : y <N x) ((y <N 2) || (factorisationNonunit 1 y))) ((x <N 2) || (factorisationNonunit 1 x))
factorIntegerLemma zero indHyp = inl (succIsPositive 1)
factorIntegerLemma (succ zero) indHyp = inl (succPreservesInequality (succIsPositive 0))
factorIntegerLemma (succ (succ x)) indHyp with everyNumberHasAPrimeFactor {succ (succ x)} (succPreservesInequality (succIsPositive x))
factorIntegerLemma (succ (succ x)) indHyp | a , record { fst = record { fst = divides record {quot = zero ; rem = .0 ; pr = ssxDivA ; remIsSmall = r } refl ; snd = 1<a }; snd = record { fst = primeA ; snd = smallerFactors } } rewrite Semiring.sumZeroRight Semiring (a *N zero) | multiplicationNIsCommutative a 0 = naughtE ssxDivA
factorIntegerLemma (succ (succ x)) indHyp | a , record { fst = record { fst = divides record {quot = succ zero ; rem = .0 ; pr = ssxDivA ; remIsSmall = r } refl ; snd = 1<a }; snd = record { fst = primeA ; snd = smallerFactors } } = inr record { 1<a = succPreservesInequality (succIsPositive x) ; firstFactor = a ; firstFactorNontrivial = Prime.p>1 primeA ; firstFactorBiggerMin = inl (Prime.p>1 primeA) ; firstFactorDivision = record { quot = 1 ; rem = 0 ; pr = ssxDivA ; remIsSmall = r ; quotSmall = inl (TotalOrder.transitive TotalOrder (le zero refl) 1<a) } ; firstFactorDivides = refl ; firstFactorPrime = record { p>1 = Prime.p>1 primeA ; pr = Prime.pr primeA } ; otherFactors = inl record { fst = refl ; snd = refl } ; otherFactorsNumber = 0 }
factorIntegerLemma (succ (succ x)) indHyp | a , record { fst = record { fst = divides record {quot = succ (succ qu) ; rem = .0 ; pr = ssxDivA ; remIsSmall = remSmall } refl ; snd = 1<a }; snd = record { fst = primeA ; snd = smallerFactors } } = inr record { 1<a = succPreservesInequality (succIsPositive x) ; firstFactor = a ; firstFactorNontrivial = Prime.p>1 primeA ; firstFactorBiggerMin = inl (Prime.p>1 primeA) ; firstFactorDivision = record { quot = succ (succ qu) ; rem = 0 ; pr = ssxDivA ; remIsSmall = remSmall ; quotSmall = inl (TotalOrder.transitive TotalOrder (le zero refl) 1<a) } ; firstFactorDivides = refl ; firstFactorPrime = record { p>1 = Prime.p>1 primeA ; pr = Prime.pr primeA } ; otherFactors = inr record {fst = succPreservesInequality (succIsPositive qu) ; snd = factNonunit} ; otherFactorsNumber = succ (factorisationNonunit.otherFactorsNumber indHypRes') }
where
indHypRes : ((succ (succ qu)) <N 2) || factorisationNonunit 1 (succ (succ qu))
indHypRes = indHyp (succ (succ qu)) (lemma2 {a} {succ (succ qu)} {succ (succ x)} 1<a (succIsPositive (succ qu)) ssxDivA)
indHypRes' : factorisationNonunit 1 (succ (succ qu))
indHypRes' with indHypRes
indHypRes' | inl y = exFalso (zeroNeverGreater (canRemoveSuccFrom<N (canRemoveSuccFrom<N y)))
indHypRes' | inr y = y
z|ssx : (z : ) z succ (succ qu) z succ (succ x)
z|ssx z z|ssq = (divisibilityTransitive z|ssq (divides (record { quot = a ; rem = 0 ; pr = identityOfIndiscernablesLeft (a *N succ (succ qu) +N 0) (succ (succ x)) (succ (succ qu) *N a +N 0) _≡_ ssxDivA (applyEquality (λ t t +N 0) (multiplicationNIsCommutative a (succ (succ qu)))) ; remIsSmall = zeroIsValidRem (succ (succ qu)) ; quotSmall = inl (succIsPositive _) }) refl))
factNonunit : factorisationNonunit a (succ (succ qu))
factNonunit with orderIsTotal a (factorisationNonunit.firstFactor indHypRes')
factNonunit | inl (inl a<ff) = canIncreaseFactorBound indHypRes' (λ z 1<z z<a z|ssq smallerFactors z z<a 1<z (z|ssx z z|ssq)) (inl a<ff)
factNonunit | inl (inr ff<a) = exFalso (smallerFactors (factorisationNonunit.firstFactor indHypRes') ff<a (factorisationNonunit.firstFactorNontrivial indHypRes') (z|ssx (factorisationNonunit.firstFactor indHypRes') (divides (factorisationNonunit.firstFactorDivision indHypRes') (factorisationNonunit.firstFactorDivides indHypRes'))))
factNonunit | inr ff=a = canIncreaseFactorBound indHypRes' (λ z 1<z z<a z|ssq smallerFactors z z<a 1<z (divisibilityTransitive z|ssq (divides (record { quot = a ; rem = 0 ; pr = identityOfIndiscernablesLeft (a *N succ (succ qu) +N 0) (succ (succ x)) (succ (succ qu) *N a +N 0) _≡_ ssxDivA (applyEquality (λ t t +N 0) (multiplicationNIsCommutative a (succ (succ qu)))) ; remIsSmall = zeroIsValidRem (succ (succ qu)) ; quotSmall = inl (succIsPositive _) }) refl))) (inr ff=a)
factorInteger : (a : ) (1 <N a) factorisationNonunit 1 a
factorInteger a 1<a with (rec <NWellfounded (λ n (n <N 2) || (factorisationNonunit 1 n))) factorIntegerLemma
... | bl with bl a
factorInteger a 1<a | bl | inl x = exFalso (noIntegersBetweenXAndSuccX 1 1<a x)
factorInteger a 1<a | bl | inr x = x
lessTransLemma : {p i j : } p <N i i ≤N j p <N j
lessTransLemma {p} {i} {j} p<i (inl x) = orderIsTransitive p<i x
lessTransLemma {p} {i} {j} p<i (inr x) rewrite x = p<i
lemma4' : {quot rem b : } (quot +N quot) +N rem succ b quot <N succ b
lemma4' {zero} {rem} {b} pr = succIsPositive b
lemma4' {succ quot} {rem} {b} pr rewrite equalityCommutative (Semiring.+Associative Semiring quot (succ quot) rem) = succPreservesInequality (le (quot +N rem) (succInjective (transitivity (applyEquality succ (Semiring.commutative Semiring _ quot)) pr)))
lemma4 : {quot a rem b : } (a *N quot +N rem succ b) (1 <N a) (quot <N succ b)
lemma4 {quot} {zero} {rem} {b} pr 1<a = exFalso (zeroNeverGreater 1<a)
lemma4 {quot} {succ zero} {rem} {b} pr 1<a = exFalso (lessIrreflexive 1<a)
lemma4 {quot} {succ (succ zero)} {rem} {b} pr 1<a rewrite Semiring.sumZeroRight Semiring quot = lemma4' pr
lemma4 {quot} {succ (succ (succ a))} {rem} {b} pr 1<a = lemma4 {quot} {succ (succ a)} {quot +N rem} {b} p' (succPreservesInequality (succIsPositive a))
where
p' : (quot +N (quot +N a *N quot)) +N (quot +N rem) succ b
p' rewrite Semiring.commutative Semiring quot (quot +N (quot +N a *N quot)) | Semiring.+Associative Semiring (quot +N (quot +N a *N quot)) quot rem = pr
noSmallerFactors : {a i p : } (factorisationNonunit i a) (Prime p) (p <N i) (p a) False
noSmallerFactors {a} {i} {p} factA pPrime p<i p|a with rec <NWellfounded (λ b (factorisationNonunit i b) p b False)
... | indHyp = (indHyp prf) a factA p|a
where
prf : (x : ) (ind : (y : ) (y<x : y <N x) (factY : factorisationNonunit i y) (p|y : p y) False) (factX : factorisationNonunit i x) (p|x : p x) False
prf x ind record { 1<a = 1<a ; firstFactor = firstFactor ; firstFactorNontrivial = firstFactorNontrivial ; firstFactorBiggerMin = firstFactorBiggerMin ; firstFactorDivision = firstFactorDivision ; firstFactorDivides = firstFactorDivides ; firstFactorPrime = firstFactorPrime ; otherFactors = (inl record { fst = quotFirstfact=1 ; snd = otherFactorsNumber }) } p|x = cannotBeLeqAndG i<=firstFactor p<i
where
x=firstFact : firstFactor *N 1 +N 0 x
x=firstFact rewrite equalityCommutative firstFactorDivides | equalityCommutative quotFirstfact=1 = divisionAlgResult.pr firstFactorDivision
x=firstFact' : firstFactor x
x=firstFact' = transitivity (equalityCommutative (lemma firstFactor)) x=firstFact
p|firstFact : p firstFactor
p|firstFact rewrite x=firstFact' = p|x
p=firstFact : p firstFactor
p=firstFact = primeDivPrimeImpliesEqual pPrime firstFactorPrime p|firstFact
i<=firstFactor : i ≤N p
i<=firstFactor rewrite p=firstFact = firstFactorBiggerMin
prf zero ind record { 1<a = 1<a ; firstFactor = firstFactor ; firstFactorNontrivial = firstFactorNontrivial ; firstFactorBiggerMin = firstFactorBiggerMin ; firstFactorDivision = firstFactorDivision ; firstFactorDivides = firstFactorDivides ; firstFactorPrime = firstFactorPrime ; otherFactors = (inr otherFact) } p|x = zeroNeverGreater 1<a
prf (succ x) ind record { 1<a = 1<a ; firstFactor = firstFactor ; firstFactorNontrivial = firstFactorNontrivial ; firstFactorBiggerMin = firstFactorBiggerMin ; firstFactorDivision = firstFactorDivision ; firstFactorDivides = firstFactorDivides ; firstFactorPrime = firstFactorPrime ; otherFactors = (inr otherFact) } p|x = ind (divisionAlgResult.quot firstFactorDivision) (lemma4 {divisionAlgResult.quot firstFactorDivision} {firstFactor} {divisionAlgResult.rem firstFactorDivision} {x} (divisionAlgResult.pr (firstFactorDivision)) (primesAreBiggerThanOne firstFactorPrime)) (canReduceFactorBound' (_&&_.snd otherFact) firstFactorBiggerMin) (p|q p|ffOrQ)
where
succXNotSmaller : succ x <N firstFactor False
succXNotSmaller = divisorIsSmaller {firstFactor} {x} (divides firstFactorDivision firstFactorDivides)
succXNotSmaller' : firstFactor ≤N succ x
succXNotSmaller' = notSmallerMeansGE succXNotSmaller
inter : firstFactor *N (divisionAlgResult.quot firstFactorDivision) +N divisionAlgResult.rem firstFactorDivision (succ x)
inter = divisionAlgResult.pr firstFactorDivision
inter' : firstFactor *N (divisionAlgResult.quot firstFactorDivision) +N 0 (succ x)
inter' rewrite equalityCommutative firstFactorDivides = inter
inter'' : firstFactor *N (divisionAlgResult.quot firstFactorDivision) (succ x)
inter'' rewrite equalityCommutative (Semiring.sumZeroRight Semiring (firstFactor *N (divisionAlgResult.quot firstFactorDivision))) = inter'
p|ff*q : p firstFactor *N (divisionAlgResult.quot firstFactorDivision)
p|ff*q rewrite inter'' = p|x
p|ffOrQ : (p firstFactor) || (p divisionAlgResult.quot firstFactorDivision)
p|ffOrQ = primesArePrime pPrime p|ff*q
p|ffIsFalse : (p firstFactor) False
p|ffIsFalse p|ff = lessIrreflexive (lessTransLemma p<i i<=p)
where
p=ff : p firstFactor
p=ff = primeDivPrimeImpliesEqual pPrime firstFactorPrime p|ff
i<=p : i ≤N p
i<=p rewrite p=ff = firstFactorBiggerMin
p|q : ((p firstFactor) || (p divisionAlgResult.quot firstFactorDivision)) (p divisionAlgResult.quot firstFactorDivision)
p|q (inl fls) = exFalso (p|ffIsFalse fls)
p|q (inr res) = res
lemma3 : {a : } a 0 1 <N a False
lemma3 {a} a=0 pr rewrite a=0 = zeroNeverGreater pr
firstFactorUniqueLemma : {i : } (a : ) (1 <N a) (f1 : factorisationNonunit i a) (f2 : factorisationNonunit i a) (factorisationNonunit.firstFactor f1 <N factorisationNonunit.firstFactor f2) False
firstFactorUniqueLemma {i} a 1<a f1 f2 ff1<ff2 = go
where
p1 = factorisationNonunit.firstFactor f1
rem1 = divisionAlgResult.quot (factorisationNonunit.firstFactorDivision f1)
p2 = factorisationNonunit.firstFactor f2
rem2 = divisionAlgResult.quot (factorisationNonunit.firstFactorDivision f2)
p1<p2 : p1 <N p2
p1<p2 = ff1<ff2
a=p2rem2 : a p2 *N rem2
a=p2rem2 with divisionAlgResult.pr (factorisationNonunit.firstFactorDivision f2)
... | ff rewrite factorisationNonunit.firstFactorDivides f2 | Semiring.sumZeroRight Semiring (factorisationNonunit.firstFactor f2 *N divisionAlgResult.quot (factorisationNonunit.firstFactorDivision f2)) = equalityCommutative ff
p1|second : (p1 p2) || (p1 rem2)
p1|second = primesArePrime {p1} {p2} {rem2} (factorisationNonunit.firstFactorPrime f1) lem
where
lem : p1 (p2 *N rem2)
lem = identityOfIndiscernablesRight p1 a (p2 *N rem2) __ (divides (factorisationNonunit.firstFactorDivision f1) (factorisationNonunit.firstFactorDivides f1)) a=p2rem2
p1|second' : ((p1 p2) || (p1 rem2)) ((p1 p2) || (p1 rem2))
p1|second' (inl x) = inl (primeDivPrimeImpliesEqual (factorisationNonunit.firstFactorPrime f1) (factorisationNonunit.firstFactorPrime f2) x)
p1|second' (inr x) = inr x
p1|second'' : (p1 p2) || (p1 rem2)
p1|second'' = p1|second' p1|second
go : False
go with p1|second''
go | inl x = lessImpliesNotEqual ff1<ff2 x
go | inr x with factorisationNonunit.otherFactors f2
go | inr x | inl record { fst = rem2=1 ; snd = _ } rewrite rem2=1 = exFalso (oneIsNotPrime res)
where
1prime' : Prime p1 Prime 1
1prime' = applyEquality Prime (oneHasNoDivisors x)
res : Prime 1
res rewrite equalityCommutative 1prime' = (factorisationNonunit.firstFactorPrime f1)
go | inr x | inr p1|rem2 with factorisationNonunit.otherFactors f2
go | inr x | inr p1|rem2 | inl record { fst = rem2=1 ; snd = _ } rewrite rem2=1 = exFalso (oneIsNotPrime res)
where
1prime' : Prime p1 Prime 1
1prime' = applyEquality Prime (oneHasNoDivisors x)
res : Prime 1
res rewrite equalityCommutative 1prime' = (factorisationNonunit.firstFactorPrime f1)
go | inr x | inr p1|rem2 | inr factorRem2 = noSmallerFactors (_&&_.snd factorRem2) (factorisationNonunit.firstFactorPrime f1) p1<p2 x
firstFactorUnique : {i : } (a : ) (1 <N a) (f1 : factorisationNonunit i a) (f2 : factorisationNonunit i a) (factorisationNonunit.firstFactor f1 factorisationNonunit.firstFactor f2)
firstFactorUnique {i} a 1<a f1 f2 with orderIsTotal (factorisationNonunit.firstFactor f1) (factorisationNonunit.firstFactor f2)
firstFactorUnique {i} a 1<a f1 f2 | inl (inl f1<f2) = exFalso (firstFactorUniqueLemma a 1<a f1 f2 f1<f2)
firstFactorUnique {i} a 1<a f1 f2 | inl (inr f2<f1) = exFalso (firstFactorUniqueLemma a 1<a f2 f1 f2<f1)
firstFactorUnique {i} a 1<a f1 f2 | inr x = x
factorListLemma : {i : } (a : ) (1 <N a) (f1 : factorisationNonunit i a) (f2 : factorisationNonunit i a) (divisionAlgResult.quot (factorisationNonunit.firstFactorDivision f2)) (divisionAlgResult.quot (factorisationNonunit.firstFactorDivision f1))
factorListLemma {i} a 1<a f1 f2 with firstFactorUnique {i} a 1<a f1 f2
... | firstFactEqual = res
where
div1 : divisionAlgResult (factorisationNonunit.firstFactor f1) a
div1 = factorisationNonunit.firstFactorDivision f1
rem1=0 : divisionAlgResult.rem div1 0
rem1=0 = factorisationNonunit.firstFactorDivides f1
pr1 : (factorisationNonunit.firstFactor f1) *N (divisionAlgResult.quot div1) +N 0 a
pr1 rewrite equalityCommutative rem1=0 = divisionAlgResult.pr div1
pr1' : (factorisationNonunit.firstFactor f1) *N (divisionAlgResult.quot div1) a
pr1' rewrite equalityCommutative (Semiring.sumZeroRight Semiring ((factorisationNonunit.firstFactor f1) *N (divisionAlgResult.quot div1))) = pr1
div2 : divisionAlgResult (factorisationNonunit.firstFactor f2) a
div2 = factorisationNonunit.firstFactorDivision f2
rem2=0 : divisionAlgResult.rem div2 0
rem2=0 = factorisationNonunit.firstFactorDivides f2
pr2 : (factorisationNonunit.firstFactor f2) *N (divisionAlgResult.quot div2) +N 0 a
pr2 rewrite equalityCommutative rem2=0 = divisionAlgResult.pr div2
pr2' : (factorisationNonunit.firstFactor f2) *N (divisionAlgResult.quot div2) a
pr2' rewrite equalityCommutative (Semiring.sumZeroRight Semiring ((factorisationNonunit.firstFactor f2) *N (divisionAlgResult.quot div2))) = pr2
pr : (factorisationNonunit.firstFactor f2) *N (divisionAlgResult.quot div2) (factorisationNonunit.firstFactor f1) *N (divisionAlgResult.quot div1)
pr = transitivity pr2' (equalityCommutative pr1')
pr' : (factorisationNonunit.firstFactor f1) *N (divisionAlgResult.quot div2) (factorisationNonunit.firstFactor f1) *N (divisionAlgResult.quot div1)
pr' = identityOfIndiscernablesLeft ((factorisationNonunit.firstFactor f2) *N (divisionAlgResult.quot div2)) ((factorisationNonunit.firstFactor f1) *N (divisionAlgResult.quot div1)) ((factorisationNonunit.firstFactor f1) *N (divisionAlgResult.quot div2)) _≡_ pr (applyEquality (λ t t *N divisionAlgResult.quot div2) (equalityCommutative firstFactEqual))
positive : zero <N factorisationNonunit.firstFactor f1
positive = lessTransitive (succIsPositive 0) (factorisationNonunit.firstFactorNontrivial f1)
res : divisionAlgResult.quot div2 divisionAlgResult.quot div1
res = productCancelsLeft (factorisationNonunit.firstFactor f1) (divisionAlgResult.quot div2) (divisionAlgResult.quot div1) positive pr'
factorListSameLength : {i : } (a : ) (1 <N a) (f1 : factorisationNonunit i a) (f2 : factorisationNonunit i a) (divisionAlgResult.quot (factorisationNonunit.firstFactorDivision f1) 1) divisionAlgResult.quot (factorisationNonunit.firstFactorDivision f2) 1
factorListSameLength {i} a 1<a f1 f2 quot=1 with firstFactorUnique {i} a 1<a f1 f2
... | firstFactEqual with factorListLemma {i} a 1<a f1 f2
... | eq = transitivity eq quot=1

View File

@@ -0,0 +1,782 @@
{-# OPTIONS --warning=error --safe #-}
open import LogicalFormulae
open import Numbers.Naturals.Naturals
open import Numbers.Naturals.Addition -- TODO - remove this dependency
open import Numbers.Naturals.Multiplication -- TODO - remove this dependency
open import Numbers.Naturals.Order -- TODO - remove this dependency
open import Numbers.Naturals.WithK
open import WellFoundedInduction
open import KeyValue.KeyValue
open import Orders
open import Vectors
open import Maybe
open import WithK
open import Semirings.Definition
module Numbers.Primes.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 (TotalOrder.irreflexive TotalOrder 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 Semiring.productZeroRight Semiring a = pr
modUniqueLemma {rem1} {rem2} {a} zero (succ quot2) rem1<a rem2<a pr rewrite Semiring.productZeroRight Semiring a | pr | multiplicationNIsCommutative a (succ quot2) | equalityCommutative (Semiring.+Associative Semiring 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 Semiring.productZeroRight Semiring a | equalityCommutative pr | multiplicationNIsCommutative a (succ quot1) | equalityCommutative (Semiring.+Associative Semiring 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) | equalityCommutative (Semiring.+Associative Semiring a (quot1 *N a) rem1) | equalityCommutative (Semiring.+Associative Semiring 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 equalityCommutative (Semiring.+Associative Semiring 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 = transitivity (applyEquality (a +N_) (Semiring.commutative Semiring b c)) (Semiring.+Associative Semiring a c b)
divisionAlgLemma : (x b : ) x *N zero +N b b
divisionAlgLemma x b rewrite (Semiring.productZeroRight Semiring x) = refl
divisionAlgLemma2 : (x b : ) (x b) x *N succ zero +N zero b
divisionAlgLemma2 x b pr rewrite (Semiring.productOneRight Semiring x) = equalityCommutative (transitivity (equalityCommutative pr) (equalityCommutative (Semiring.sumZeroRight Semiring 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 = TotalOrder.irreflexive TotalOrder 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)
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)