Browse Source

Build rational arithmetic.

gas-move-test
Thomas Kerber 6 months ago
parent
commit
75eaa518c1
Signed by: Thomas Kerber <tk@drwx.org> GPG Key ID: 8489B911F9ED617B
1 changed files with 38 additions and 48 deletions
  1. 38
    48
      Yggdrasil/Rational.agda

+ 38
- 48
Yggdrasil/Rational.agda View File

@@ -1,11 +1,11 @@
1 1
 module Yggdrasil.Rational where
2 2
 
3 3
 open import Data.Bool using (true; false; T)
4
-open import Data.Integer as ℤ using (ℤ; +_)
4
+open import Data.Integer as ℤ using (ℤ; +_; -[1+_])
5 5
 open import Data.Nat as ℕ using (ℕ; suc; zero)
6 6
 open import Data.Nat.GCD as GCD using (GCD; gcd)
7 7
 open import Data.Nat.Divisibility using (_∣_; divides)
8
-open import Data.Nat.Coprimality using (coprime?; gcd-coprime; Bézout-coprime)
8
+open import Data.Nat.Coprimality using (Coprime; coprime?; gcd-coprime; Bézout-coprime)
9 9
 open import Data.Nat.Properties using (*-comm; *-assoc)
10 10
 open import Data.Product renaming (_,_ to ⟨_,_⟩)
11 11
 open import Data.Rational using (ℚ) renaming (_÷_ to _÷†_)
@@ -13,9 +13,9 @@ open import Data.Unit using (⊤; tt)
13 13
 open import Data.Empty using (⊥; ⊥-elim)
14 14
 open import Data.Sign using (Sign) renaming (+ to s+; - to s-)
15 15
 open import Relation.Nullary using (yes; no; ¬_)
16
-open import Relation.Nullary.Decidable using (True; False; ⌊_⌋; fromWitness)
16
+open import Relation.Nullary.Decidable using (True; False; ⌊_⌋; fromWitness; fromWitnessFalse)
17 17
 import Relation.Binary.PropositionalEquality as Eq
18
-open Eq using (_≡_; _≢_; refl; subst₂; sym; cong)
18
+open Eq using (_≡_; _≢_; refl; subst₂; sym; cong; trans)
19 19
 open Eq.≡-Reasoning using (_≡⟨_⟩_; _∎; begin_)
20 20
 
21 21
 open ℚ
@@ -23,14 +23,22 @@ open ℚ
23 23
 infixl 6 _+_ _-_
24 24
 infixl 7 _*_ _÷_
25 25
 
26
-1+≢*0 : ∀ x y → suc x ≢ y ℕ.* 0
27
-1+≢*0 x zero ()
28
-1+≢*0 x (suc y) = 1+≢*0 x y
26
+private
27
+  1+≢*0 : ∀ x y → suc x ≢ y ℕ.* 0
28
+  1+≢*0 x zero ()
29
+  1+≢*0 x (suc y) = 1+≢*0 x y
30
+
31
+  1≢0 : ∀ {n} → suc n ≢ zero
32
+  1≢0 ()
29 33
 
30 34
 simp : ∀ x y-1 → ℚ
31 35
 simp x y-1 with GCD.Bézout.lemma x (suc y-1)
32
-... | GCD.Bézout.result 0 (GCD.is ⟨ _ , divides y′ y-eq ⟩ _) _ = ⊥-elim (1+≢*0 y-1 y′ y-eq)
33
-... | GCD.Bézout.result (suc d-1) (GCD.is ⟨ divides x′ x-eq , divides y′ y-eq ⟩ _) bézout = _÷†_ (+ x′) y′ {fromWitness {!(Bézout-coprime bézout′)!}}
36
+... | GCD.Bézout.result 0 (GCD.is ⟨ _ , divides y′ y-eq ⟩ _) _ =
37
+  ⊥-elim (1+≢*0 y-1 y′ y-eq)
38
+... | GCD.Bézout.result (suc d-1)
39
+      (GCD.is ⟨ divides x′ x-eq , divides y′ y-eq ⟩ _) bézout =
40
+        _÷†_ (+ x′) y′ {fromWitness (λ {i} → Bézout-coprime bézout′)}
41
+          {fromWitnessFalse y′≢0}
34 42
   where
35 43
     y = suc y-1
36 44
     d = suc d-1
@@ -38,23 +46,32 @@ simp x y-1 with GCD.Bézout.lemma x (suc y-1)
38 46
     bézout′ : GCD.Bézout.Identity d (x′ ℕ.* d) (y′ ℕ.* d)
39 47
     bézout′ = subst₂ (GCD.Bézout.Identity d) x-eq y-eq bézout
40 48
 
41
-    eq-prf : x ℕ.* y′ ≡ x′ ℕ.* y
42
-    eq-prf = begin
43
-      x ℕ.* y′           ≡⟨ cong (λ z → z ℕ.* y′) x-eq ⟩
44
-      x′ ℕ.* d ℕ.* y′    ≡⟨ *-assoc x′ d y′ ⟩
45
-      x′ ℕ.* (d ℕ.* y′)  ≡⟨ sym (cong (ℕ._*_ x′) (*-comm y′ d)) ⟩
46
-      x′ ℕ.* (y′ ℕ.* d)  ≡⟨ sym (cong (ℕ._*_ x′) y-eq)  ⟩
47
-      x′ ℕ.* y           ∎
49
+    y′≢0 : y′ ≢ 0
50
+    y′≢0 y′≡0 = ⊥-elim (1≢0 (trans y-eq (cong (ℕ._* d) y′≡0)))
48 51
 
49
-postulate
50
-  _÷_ : ℤ → (d : ℕ) → {d≢0 : False (d ℕ.≟ 0)} → ℚ
52
+-_ : ℚ → ℚ
53
+- q = _÷†_ (ℤ.- numerator q) (suc (denominator-1 q))
54
+  {fromWitness (λ{ {i} ⟨ i∣n , i∣d ⟩ → coprime q ⟨ ∣-abs⇒∣abs i (numerator q) i∣n , i∣d ⟩})}
55
+  where
56
+    -abs≡abs : ∀ i → ℤ.∣ ℤ.- i ∣ ≡ ℤ.∣ i ∣
57
+    -abs≡abs (+ zero) = refl
58
+    -abs≡abs (+ (suc n)) = refl
59
+    -abs≡abs -[1+ n ] = refl
60
+
61
+    ∣-abs⇒∣abs : ∀ i j → i ∣ ℤ.∣ ℤ.- j ∣ → i ∣ ℤ.∣ j ∣
62
+    ∣-abs⇒∣abs i j (divides k j=k*i) = divides k (sym (begin
63
+      k ℕ.* i      ≡⟨ sym j=k*i ⟩
64
+      ℤ.∣ ℤ.- j ∣  ≡⟨ -abs≡abs j ⟩
65
+      ℤ.∣ j ∣      ∎))
66
+    
67
+_÷_ : ℤ → (d : ℕ) → {d≢0 : False (d ℕ.≟ 0)} → ℚ
68
+_÷_ n zero {}
69
+(+ n) ÷ (suc d-1) = simp n d-1
70
+(-[1+ n-1 ]) ÷ (suc d-1) = - simp (suc n-1) d-1
51 71
 
52 72
 ∣_∣ : ℚ → ℚ
53 73
 ∣ q ∣ = _÷†_ (+ ℤ.∣ numerator q ∣) (suc (denominator-1 q)) {isCoprime q}
54 74
 
55
--_ : ℚ → ℚ
56
-- q = _÷_ (ℤ.- numerator q) (suc (denominator-1 q))
57
-
58 75
 _+_ : ℚ → ℚ → ℚ
59 76
 a + b = let
60 77
     n-a = numerator a
@@ -77,46 +94,3 @@ a * b = let
77 94
 
78 95
 _-_ : ℚ → ℚ → ℚ
79 96
 a - b = a + (- b)
80
-
81
-
82
---gcd (suc (denominator-1 a)) (suc (denominator-1 b))
83
---... | ⟨ c , denom-gcd ⟩ with GCD.commonDivisor denom-gcd
84
---...   | ⟨ divides d₁ d₁*c≡da , divides d₂ d₂*c≡db ⟩ = let
85
-
86
-
87
-
88
---data ℚ′ : Set where
89
---
90
---∣◃∣-≡ : (n : ℕ) → (s : Sign) → ∣ s ◃ n ∣ ≡ n
91
---∣◃∣-≡ = ?
92
---
93
---normalise : ℚ′ → ℚ
94
---normalise (_÷′_ n zero {()})
95
---normalise (n ÷′ suc d) with gcd ∣ n ∣ (suc d)
96
-----... | ⟨ 1 , gcd ⟩ = record
97
-----  { numerator = n
98
-----  ; denominator-1 = d
99
-----  ; isCoprime = fromWitness {Q = coprime? ∣ n ∣ (suc d)} (gcd-coprime gcd) }
100
---... | ⟨ _ , gcd₁ ⟩ with GCD.commonDivisor gcd₁
101
---...   | ⟨ divides n′ _ , divides d′ _ ⟩ with d′ | gcd n′ d′ | sign n
102
---...     | suc d′ | ⟨ suc (suc m) , gcd₂ ⟩ | _ = ?
103
---...     | suc d′ | ⟨ 1 , gcd₂ ⟩ | s+ = record
104
---with coprime? ∣ n ∣ (suc d)
105
---... | yes cp = record
106
---... | no ¬cp = ?

Loading…
Cancel
Save