Mercurial > hg > Members > kono > Proof > automaton
view automaton-in-agda/src/prime.agda @ 227:a61f121c34a4
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 23 Jun 2021 18:10:18 +0900 |
parents | 6e8b163ca737 |
children | b21027d1d4a9 |
line wrap: on
line source
module prime where open import Data.Nat open import Data.Nat.Properties open import Data.Empty open import Data.Unit using (⊤ ; tt) open import Relation.Nullary open import Relation.Binary.PropositionalEquality open import Relation.Binary.Definitions open import gcd open import nat record Prime (i : ℕ ) : Set where field p>1 : i > 1 isPrime : ( j : ℕ ) → j < i → 0 < j → gcd i j ≡ 1 record NonPrime ( n : ℕ ) : Set where field factor : ℕ prime : Prime factor dividable : Dividable factor n PrimeP : ( n : ℕ ) → Dec ( Prime n ) PrimeP 0 = no (λ p → ⊥-elim ( nat-<> (Prime.p>1 p) (s≤s z≤n))) PrimeP 1 = no (λ p → ⊥-elim ( nat-≤> (Prime.p>1 p) (s≤s (≤-refl)))) PrimeP (suc (suc n)) = isPrime1 (suc (suc n)) (suc n) (s≤s (s≤s z≤n)) a<sa (λ i m<i i<n → isp0 (suc n) i (<to≤ m<i) i<n ) where isp0 : (n : ℕ) (i : ℕ) ( n<i : n ≤ i) ( i<n : i < suc n ) → gcd (suc n) i ≡ 1 isp0 n i n<i i<n with <-cmp i n ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> n<i a) ... | tri≈ ¬a refl ¬c = gcd203 i ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> c i<n ) isPrime1 : ( n m : ℕ ) → n > 1 → m < n → ( (i : ℕ) → m < i → i < n → gcd n i ≡ 1 ) → Dec ( Prime n ) isPrime1 n zero n>1 m<n lt = yes record { isPrime = λ j j<i 0<j → lt j 0<j j<i ; p>1 = n>1 } isPrime1 n (suc m) n>1 m<n lt with <-cmp (gcd n (suc m)) 1 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> ( gcd>0 n (suc m) (<-trans (s≤s z≤n) n>1) (s≤s z≤n)) a ) ... | tri≈ ¬a b ¬c = isPrime1 n m n>1 (<-trans a<sa m<n) isp1 where -- lt : (i : ℕ) → suc m ≤ i → suc i ≤ n → gcd1 n n i i ≡ 1 isp1 : (i : ℕ) → m < i → i < n → gcd n i ≡ 1 isp1 i m<i i<n with <-cmp (suc m) i ... | tri< a ¬b ¬c = lt i a i<n ... | tri≈ ¬a m=i ¬c = subst (λ k → gcd n k ≡ 1) m=i b -- gcd n (suc m) ≡ 1 → gcd n i ≡ 1 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> m<i c) -- suc i ≤ suc m → i < m ... | tri> ¬a ¬b c = no ( λ p → nat-≡< (sym (Prime.isPrime p (suc m) m<n (s≤s z≤n) )) c ) open import logic open _∧_ record Pair≤ : Set where field ox oy : ℕ ox<oy : ox ≤ oy open Pair≤ nonPrime1 : { n : ℕ } → 1 < n → ¬ Prime n → NonPrime n nonPrime1 {n} 1<n np = f-induction {_} {_} {Pair≤} {λ op → G (ox op) (oy op) → NonPrime n } (λ op → oy op - ox op ) I record { ox = n ; oy = n ; ox<oy = ≤-refl } {!!} where record G (p g : ℕ) : Set where field 1<p : 1 < p div : Dividable p n npr : g > 0 → ¬ Prime p is-g : (j : ℕ) → g ≤ j → j < p → gcd p j ≡ 1 is-g= : {g p : ℕ} → g ≡ p → (j : ℕ) → g ≤ j → j < p → gcd p j ≡ 1 is-g= eq _ g≤j j<p = ⊥-elim ( nat-≡< eq (≤-trans (s≤s g≤j ) j<p)) next : Pair≤ → Pair≤ next record { ox = ox ; oy = oy ; ox<oy = ox<oy } = record { ox = ox ; oy = gcd oy ox ; ox<oy = {!!} } ind : {p : Pair≤ } → (G (ox (next p)) (oy (next p)) → NonPrime n) → G (ox p) (oy p) → NonPrime n ind {p} prev g = {!!} where next1 : ( m : ℕ ) → ℕ → {!!} → {!!} -- G.g g ≡ m → G next1 0 _ _ = g next1 _ 0 _ = g next1 (suc m) 1 sm=g = {!!} --record g { g = m ; npr = λ lt → G.npr g {!!} ; is-g = {!!} } next1 (suc m) (suc (suc f)) _ with PrimeP (suc (suc f)) ... | yes p = {!!} -- record { p = suc (suc f) ; g = 0 ; 1<p = Prime.p>1 p ; div = {!!} ; npr = λ () ; is-g = {!!} } ... | no np = {!!} -- record { p = suc (suc f) ; g = suc (suc f) ; 1<p = s≤s (s≤s z≤n) ; div = {!!} ; npr = λ lt → np ; is-g = is-g= refl } pzero : (p : Pair≤ ) → (oy p - ox p) ≡ zero → G (ox p) (oy p) → NonPrime n pzero p eq g = record { factor = {!!} ; prime = record { p>1 = G.1<p g ; isPrime = {!!} } ; dividable = G.div g } decline : (p : Pair≤ ) → 0 < (oy p - ox p) → (oy (next p) - ox (next p)) < (oy p - ox p) decline = {!!} I : Finduction Pair≤ _ (λ op → oy op - ox op ) I = record { pnext = next ; fzero = λ {p} → pzero p ; decline = λ {p} → decline p ; ind = λ {p} → ind {p} } nonPrime : { n : ℕ } → 1 < n → ¬ Prime n → NonPrime n nonPrime {n} 1<n np = np1 n (λ j n≤j j<n → ⊥-elim (nat-≤> n≤j j<n ) ) where mg1 : (m : ℕ )→ ( (j : ℕ ) → suc m ≤ j → j < n → gcd n j ≡ 1 ) → gcd n (suc m) ≡ 1 → (j : ℕ) → m ≤ j → j < n → gcd n j ≡ 1 mg1 m mg gcd j m<j j<n with <-cmp j (suc m) ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> (≤-trans {!!} m<j) a) ... | tri≈ ¬a refl ¬c = gcd ... | tri> ¬a ¬b c = mg j {!!} j<n np1 : ( m : ℕ ) → ( (j : ℕ ) → m ≤ j → j < n → gcd n j ≡ 1 ) → NonPrime n np1 zero mg = ⊥-elim ( np record { isPrime = λ j lt _ → mg j z≤n lt ; p>1 = 1<n } ) -- zero < j , j < n np1 (suc m) mg with <-cmp ( gcd n (suc m) ) 1 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> ( gcd>0 n (suc m) (<-trans (s≤s z≤n) 1<n) (s≤s z≤n)) a ) ... | tri≈ ¬a b ¬c = np1 m (mg1 m mg b ) ... | tri> ¬a ¬b c with PrimeP ( gcd n (suc m) ) ... | yes y = record { factor = gcd n (suc m) ; prime = y ; dividable = proj1 (gcd-divable n (suc m) ) } ... | no ngcd = np1 m (mg1 m mg {!!} ) prime-is-infinite : (max-prime : ℕ ) → ¬ ( (j : ℕ) → max-prime < j → ¬ Prime j ) prime-is-infinite zero pmax = pmax 3 (s≤s z≤n) record { isPrime = λ n lt 0<j → pif3 n lt 0<j ; p>1 = s≤s (s≤s z≤n) } where pif3 : (n : ℕ) → n < 3 → 0 < n → gcd 3 n ≡ 1 pif3 .1 (s≤s (s≤s z≤n)) _ = refl pif3 .2 (s≤s (s≤s (s≤s z≤n))) _ = refl prime-is-infinite (suc m) pmax = getPrime where factorial : (n : ℕ) → ℕ factorial zero = 1 factorial (suc n) = (suc n) * (factorial n) prime<max : (n : ℕ ) → Prime n → n < suc (suc m) prime<max n p with <-cmp n (suc m) ... | tri< a ¬b ¬c = ≤-trans a refl-≤s ... | tri≈ ¬a refl ¬c = ≤-refl ... | tri> ¬a ¬b c = ⊥-elim ( pmax n c p ) factorial-mono : (n : ℕ) → factorial n ≤ factorial (suc n) factorial-mono n = begin factorial n ≤⟨ x≤x+y ⟩ factorial n + n * factorial n ≡⟨ refl ⟩ (suc n) * factorial n ≡⟨ refl ⟩ factorial (suc n) ∎ where open ≤-Reasoning factorial≥1 : {m : ℕ} → 1 ≤ factorial m factorial≥1 {zero} = ≤-refl factorial≥1 {suc m} = begin 1 ≤⟨ s≤s z≤n ⟩ (suc m) * 1 ≤⟨ *-monoʳ-≤ (suc m) (factorial≥1 {m}) ⟩ (suc m) * factorial m ≡⟨ refl ⟩ factorial (suc m) ∎ where open ≤-Reasoning m<factorial : (m : ℕ) → m ≤ factorial m m<factorial zero = z≤n m<factorial (suc m) = begin suc m ≡⟨ cong suc (+-comm 0 _) ⟩ 1 * suc m ≡⟨ *-comm 1 _ ⟩ (suc m) * 1 ≤⟨ *-monoʳ-≤ (suc m) (factorial≥1 {m}) ⟩ (suc m) * factorial m ≡⟨ refl ⟩ factorial (suc m) ∎ where open ≤-Reasoning -- *-monoˡ-≤ (suc m) {!!} f>m : suc m < suc (factorial (suc m)) f>m = begin suc (suc m) ≡⟨ cong (λ k → 1 + suc k ) (+-comm _ m) ⟩ suc (1 + 1 * m) ≡⟨ cong (λ k → suc (1 + k )) (*-comm 1 m) ⟩ suc (1 + m * 1) ≤⟨ s≤s (s≤s (*-monoʳ-≤ m (factorial≥1 {m}) )) ⟩ suc (1 + m * factorial m) ≤⟨ s≤s (+-monoˡ-≤ _ (factorial≥1 {m})) ⟩ suc (factorial m + m * factorial m) ≡⟨ refl ⟩ suc (factorial (suc m)) ∎ where open ≤-Reasoning fact< : (m n : ℕ) → 0 < n → n < suc (suc m) → Dividable n ( factorial (suc m) ) fact< zero 1 0<n (s≤s (s≤s z≤n)) = record { factor = 1 ; is-factor = refl } fact< (suc m) (suc zero) 0<n n<m = record { factor = factorial (suc (suc m)) ; is-factor = begin factorial (suc (suc m)) * 1 + 0 ≡⟨ +-comm _ 0 ⟩ factorial (suc (suc m)) * 1 ≡⟨ m*1=m ⟩ (suc (suc m)) * factorial (suc m) ≡⟨ refl ⟩ factorial (suc (suc m)) ∎ } where open ≡-Reasoning fact< (suc m) (suc (suc n)) 0<n n<m with <-cmp (suc (suc n)) (suc (suc m)) ... | tri< a ¬b ¬c = record { factor = suc (suc m) * Dividable.factor fact1 ; is-factor = fact2 } where fact1 : Dividable (suc (suc n)) (factorial (suc m )) fact1 = fact< m (suc (suc n)) 0<n a d = (fact< m (suc (suc n)) 0<n a) fact2 : suc (suc m) * Dividable.factor d * suc (suc n) + 0 ≡ factorial (suc (suc m)) fact2 = begin suc (suc m) * Dividable.factor d * suc (suc n) + 0 ≡⟨ +-comm _ 0 ⟩ suc (suc m) * Dividable.factor d * suc (suc n) ≡⟨ *-assoc (suc (suc m)) (Dividable.factor d) ( suc (suc n)) ⟩ suc (suc m) * (Dividable.factor d * suc (suc n)) ≡⟨ cong (λ k → suc (suc m) * k ) ( +-comm 0 (Dividable.factor d * suc (suc n)) ) ⟩ suc (suc m) * (Dividable.factor d * suc (suc n) + 0) ≡⟨ cong (λ k → suc (suc m) * k ) (Dividable.is-factor d) ⟩ suc (suc m) * factorial (suc m) ≡⟨ refl ⟩ factorial (suc (suc m)) ∎ where open ≡-Reasoning ... | tri≈ ¬a b ¬c = record { factor = factorial (suc m) ; is-factor = begin factorial (suc m) * suc (suc n) + 0 ≡⟨ +-comm _ 0 ⟩ factorial (suc m) * suc (suc n) ≡⟨ *-comm (factorial (suc m)) (suc (suc n)) ⟩ (suc (suc n)) * factorial (suc m) ≡⟨ cong (λ k → k * factorial (suc m) ) b ⟩ (suc (suc m)) * factorial (suc m) ≡⟨ refl ⟩ factorial (suc (suc m)) ∎ } where open ≡-Reasoning ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> c n<m) fact : (n : ℕ) → Prime n → Dividable n ( factorial (suc m) ) fact n p = fact< m n (<-trans (s≤s z≤n) (Prime.p>1 p)) ( prime<max n p ) -- div+1 : { i k : ℕ } → k > 1 → Dividable k i → ¬ Dividable k (suc i) getPrime : ⊥ getPrime with PrimeP ( suc (factorial (suc m)) ) ... | yes p = pmax _ f>m p ... | no np = div+1 (Prime.p>1 (NonPrime.prime p1)) (fact (NonPrime.factor p1) (NonPrime.prime p1) ) (NonPrime.dividable p1) where p1 : NonPrime ( suc (factorial (suc m)) ) p1 = nonPrime (begin 2 ≤⟨ s≤s ( s≤s z≤n) ⟩ suc (suc m) ≤⟨ s≤s (m<factorial (suc m)) ⟩ suc (factorial (suc m)) ∎ ) np where open ≤-Reasoning