Browse Source

Finish probability work with a bunch of postulates.

gas-move-test
Thomas Kerber 6 months ago
parent
commit
caf15b9d2f
Signed by: Thomas Kerber <tk@drwx.org> GPG Key ID: 8489B911F9ED617B
2 changed files with 97 additions and 70 deletions
  1. 51
    48
      Yggdrasil/Probability.agda
  2. 46
    22
      Yggdrasil/Rational.agda

+ 51
- 48
Yggdrasil/Probability.agda View File

@@ -1,38 +1,38 @@
1 1
 module Yggdrasil.Probability where
2 2
 
3
-open import Data.List using (List; _∷_; []; map; filter; length)
3
+open import Agda.Builtin.FromNat using (Number)
4
+import Data.Nat.Literals as ℕLit
5
+import Data.Rational.Literals as ℚLit
6
+import Data.Integer.Literals as ℤLit
7
+open import Data.List using (List; _∷_; []; map; filter; length; foldr)
4 8
 open import Data.Fin using (Fin; zero; suc)
5
-open import Data.Integer using (+_; _-_) renaming (_*_ to _ℤ*_)
6
-open import Data.Nat using (ℕ; zero; suc; _≤_; s≤s) renaming (_*_ to _ℕ*_; _≤?_ to _ℕ≤?_)
9
+open import Data.Integer using (ℤ; +_; _-_) renaming (_*_ to _ℤ*_)
10
+open import Data.Nat using (ℕ; zero; suc; s≤s) renaming (_*_ to _ℕ*_; _≤?_ to _ℕ≤?_; _≤_ to _ℕ≤_)
11
+open import Data.Nat.Literals
7 12
 open import Data.Nat.Properties using (≤-trans; ≤-refl)
8 13
 open import Data.List.Properties using (length-filter; length-map)
9 14
 open import Data.Product using (_×_; ∃; ∃-syntax; proj₁) renaming (_,_ to ⟨_,_⟩)
10
-open import Data.Rational using (ℚ; _÷_) renaming (_≤?_ to _ℚ≤?_)
15
+open import Data.Rational using (ℚ) renaming (_≤?_ to _ℚ≤?_; _≤_ to _ℚ≤_)
11 16
 open import Relation.Nullary using (Dec; yes; no; ¬_)
12 17
 open import Relation.Nullary.Decidable using (True; fromWitness)
13 18
 open import Relation.Binary.PropositionalEquality using (_≡_; refl; trans; cong)
14 19
 open import Level using (Level; Lift; lift) renaming (suc to lsuc)
15 20
 open import Yggdrasil.List using (_∈_; with-proof)
21
+import Yggdrasil.Rational as ℚ
16 22
 
17
-record [0,1] : Set where
18
-  field
19
-    q : ℚ
20
-    ≤1 : True (q ℚ≤? (+ 1 ÷ 1))
21
-    0≤ : True ((+ 0 ÷ 1) ℚ≤? q)
23
+instance
24
+  ℕnumber : Number ℕ
25
+  ℕnumber = ℕLit.number
26
+  ℤnumber : Number ℤ
27
+  ℤnumber = ℤLit.number
28
+  ℚnumber : Number ℚ
29
+  ℚnumber = ℚLit.number
22 30
 
23
-interval : (q : ℚ) → {≤1 : True (q ℚ≤? (+ 1 ÷ 1))} →
24
-  {0≤ : True ((+ 0 ÷ 1) ℚ≤? q)} → [0,1]
25
-interval q {≤1} {0≤} = record { q = q; ≤1 = ≤1; 0≤ = 0≤ }
31
+case : ℚ → ℚ → ℚ → ℚ
32
+case Pr[A] Pr[B∣A] Pr[B∣¬A] = Pr[A] ℚ.* Pr[B∣A] ℚ.+ (1 ℚ.- Pr[A]) ℚ.* Pr[B∣¬A]
26 33
 
27
-postulate
28
-  _ℚ+_ : ℚ → ℚ → ℚ
29
-  1-_ : [0,1] → [0,1]
30
-  _*_ : [0,1] → [0,1] → [0,1]
31
-  case : [0,1] → [0,1] → [0,1] → [0,1]
32
-  _/_ : (n : ℕ) → (m : ℕ) → {n≤m : True (n ℕ≤? m)} → [0,1]
33
-  sum-[0,1] : List [0,1] → ℚ
34
-  -- Absolute difference
35
-  _δ_ : [0,1] → [0,1] → [0,1]
34
+sum : List ℚ → ℚ
35
+sum = foldr (ℚ._+_) 0
36 36
 
37 37
 PrFin : ∀ {ℓ} → ℕ → Set ℓ
38 38
 PrFin {ℓ} n = Lift ℓ (Fin (suc (suc n)))
@@ -53,43 +53,46 @@ data Dist {ℓ : Level} : Set ℓ → Set (lsuc ℓ) where
53 53
   sample : ∀ {n : ℕ} → Dist (PrFin n)
54 54
   bind : ∀ {A B : Set ℓ} → Dist A → (A → Dist B) → Dist B
55 55
 
56
-≡⇒≤ : {a b : ℕ} → a ≡ b → a ≤ b
56
+≡⇒≤ : {a b : ℕ} → a ≡ b → a ≤ b
57 57
 ≡⇒≤ refl = ≤-refl
58 58
 
59 59
 data Pr[_[_]]≡_ {ℓ : Level} : {A : Set ℓ} → (P : A → Set ℓ) → Dist A →
60
-    [0,1] → Set (lsuc ℓ) where
60
+     → Set (lsuc ℓ) where
61 61
   pure-zero : {A : Set ℓ} {P : A → Set ℓ} → (x : A) → ¬ (P x) →
62
-    Pr[ P [ pure x ]]≡ (interval (+ 0 ÷ 1))
62
+    Pr[ P [ pure x ]]≡ 0
63 63
   pure-one : {A : Set ℓ} {P : A → Set ℓ} → (x : A) → P x →
64
-    Pr[ P [ pure x ]]≡ (interval (+ 1 ÷ 1))
64
+    Pr[ P [ pure x ]]≡ 1
65 65
   sample-count : {n : ℕ} {P : PrFin n → Set ℓ} →
66 66
     (dec : (f : PrFin n) → Dec (P f)) →
67
-    Pr[ P [ sample {n = n} ]]≡ (_/_ (count dec) (suc (suc n)) {fromWitness (
68
-      ≤-trans (length-filter dec (map lift (all-fin (suc (suc n)))))
69
-      (s≤s (s≤s (≡⇒≤
70
-        (trans (length-map lift (map suc (map suc (all-fin n))))
71
-        (trans (length-map suc (map suc (all-fin n)))
72
-        (trans (length-map suc (all-fin n)) (length-all-fin n)))))))
73
-    )})
67
+    Pr[ P [ sample {n = n} ]]≡ (+ (count dec) ℚ.÷ (suc (suc n)))
74 68
   conditional : {A B : Set ℓ} {D : Dist A} {f : A → Dist B} {P₁ : A → Set ℓ}
75
-    {P₂ : B → Set ℓ} {p₁ p₂ p₃ : [0,1]} →
69
+    {P₂ : B → Set ℓ} {p₁ p₂ p₃ : ℚ} →
76 70
     Pr[ P₁ [ D ]]≡ p₁ → 
77 71
     ((x : A) → P₁ x → Pr[ P₂ [ f x ]]≡ p₂) →
78 72
     ((x : A) → ¬ (P₁ x) → Pr[ P₂ [ f x ]]≡ p₃) → 
79 73
     Pr[ P₂ [ bind D f ]]≡ (case p₁ p₂ p₃)
80 74
 
81
-data _≈[_]≈_ {ℓ : Level} {A : Set ℓ} : Dist A → ℚ → Dist A → Set (lsuc ℓ) where
82
-  finite : (d₁ d₂ : Dist A) → (xs : List A) →
83
-    (pr₁ : (x : A) → x ∈ xs → ∃[ p ] Pr[ _≡ x [ d₁ ]]≡ p) →
84
-    (pr₂ : (x : A) → x ∈ xs → ∃[ p ] Pr[ _≡ x [ d₂ ]]≡ p) →
85
-    (ε : ℚ) →
86
-    sum-[0,1] (map (λ{
87
-      ⟨ x , x∈xs ⟩ → proj₁ (pr₁ x x∈xs)
88
-    }) (with-proof xs)) ≡ + 1 ÷ 1 →
89
-    sum-[0,1] (map (λ{
90
-      ⟨ x , x∈xs ⟩ → proj₁ (pr₂ x x∈xs)
91
-    }) (with-proof xs)) ≡ + 1 ÷ 1 →
92
-    sum-[0,1] (map (λ{
93
-      ⟨ x , x∈xs ⟩ → proj₁ (pr₁ x x∈xs) δ proj₁ (pr₂ x x∈xs)
94
-    }) (with-proof xs)) ≡ ε →
95
-    d₁ ≈[ ε ]≈ d₂
75
+record _≈[_]≈_ {ℓ : Level} {A : Set ℓ} (d₁ : Dist A) (ε : ℚ) (d₂ : Dist A) : Set (lsuc ℓ) where
76
+  field
77
+    elements : List A
78
+    pr₁ : (x : A) → x ∈ elements → ∃[ p ] Pr[ _≡ x [ d₁ ]]≡ p
79
+    pr₂ : (x : A) → x ∈ elements → ∃[ p ] Pr[ _≡ x [ d₂ ]]≡ p
80
+    elements-complete-d₁ : sum (map (λ{
81
+        ⟨ x , x∈xs ⟩ → proj₁ (pr₁ x x∈xs)
82
+      }) (with-proof elements)) ≡ 1
83
+    elements-complete-d₂ : sum (map (λ{
84
+        ⟨ x , x∈xs ⟩ → proj₁ (pr₂ x x∈xs)
85
+      }) (with-proof elements)) ≡ 1
86
+    ε-error : sum (map (λ{
87
+        ⟨ x , x∈xs ⟩ → ℚ.∣ proj₁ (pr₁ x x∈xs) ℚ.- proj₁ (pr₂ x x∈xs) ∣
88
+      }) (with-proof elements)) ℚ≤ ε
89
+
90
+_≃_ : {ℓ : Level} {A : Set ℓ} (d₁ d₂ : Dist A) → Set (lsuc ℓ)
91
+d₁ ≃ d₂ = d₁ ≈[ 0 ]≈ d₂
92
+
93
+postulate
94
+  ≈-trans : {ℓ : Level} {A : Set ℓ} {d₁ d₂ d₃ : Dist A} {ε₁ ε₂ : ℚ} →
95
+    d₁ ≈[ ε₁ ]≈ d₂ → d₂ ≈[ ε₂ ]≈ d₃ → d₁ ≈[ ε₁ ℚ.+ ε₂ ]≈ d₃
96
+  ≈-sym : {ℓ : Level} {A : Set ℓ} {d₁ d₂ : Dist A} {ε : ℚ} → d₁ ≈[ ε ]≈ d₂ →
97
+    d₂ ≈[ ε ]≈ d₁
98
+  ≈-refl : {ℓ : Level} {A : Set ℓ} {d : Dist A} → d ≃ d

+ 46
- 22
Yggdrasil/Rational.agda View File

@@ -1,13 +1,13 @@
1 1
 module Yggdrasil.Rational where
2 2
 
3 3
 open import Data.Bool using (true; false; T)
4
-open import Data.Integer using (ℤ; ∣_∣; _◃_; sign; +_) renaming (_+_ to _ℤ+_; _*_ to _ℤ*_)
5
-open import Data.Nat as ℕ using (ℕ; suc; zero) renaming (_+_ to _ℕ+_; _*_ to _ℕ*_)
4
+open import Data.Integer as ℤ using (ℤ; +_)
5
+open import Data.Nat as ℕ using (ℕ; suc; zero)
6 6
 open import Data.Nat.GCD using (GCD; gcd)
7 7
 open import Data.Nat.Divisibility using (_∣_; divides)
8 8
 open import Data.Nat.Coprimality using (coprime?; gcd-coprime)
9 9
 open import Data.Product renaming (_,_ to ⟨_,_⟩)
10
-open import Data.Rational using (ℚ; _÷_)
10
+open import Data.Rational using (ℚ) renaming (_÷_ to _÷†_)
11 11
 open import Data.Unit using (⊤; tt)
12 12
 open import Data.Empty using (⊥)
13 13
 open import Data.Sign using (Sign) renaming (+ to s+; - to s-)
@@ -17,32 +17,56 @@ open import Relation.Binary.PropositionalEquality using (_≡_; refl)
17 17
 
18 18
 open ℚ
19 19
 
20
-¬0*¬0≡¬0 : {a b : ℕ} → ¬ (a ≡ 0) → ¬ (b ≡ 0) → ¬ (a ℕ* b ≡ 0)
21
-¬0*¬0≡¬0 = ?
20
+infixl 6 _+_ _-_
21
+infixl 7 _*_ _÷_
22 22
 
23
-¬0≡¬0*¬0 : {a b : ℕ} → ¬ (0 ≡ a ℕ* b) → ¬ (b ≡ 0)
24
-¬0≡¬0*¬0 = ?
23
+postulate
24
+  _÷_ : ℤ → (d : ℕ) → {d≢0 : False (d ℕ.≟ 0)} → ℚ
25 25
 
26
-_+_ : ℚ → ℚ → ℚ
27
-a + b with gcd (suc (denominator-1 a)) (suc (denominator-1 b))
28
-... | ⟨ c , denom-gcd ⟩ with GCD.commonDivisor denom-gcd
29
-...   | ⟨ divides d₁ d₁*c≡da , divides d₂ d₂*c≡db ⟩ = let
30
-        d′ = d₁ ℕ* d₂ ℕ* c
31
-        n′ = ((numerator a) ℤ* (+ d₂)) ℤ+ ((numerator b) ℤ* (+ d₁))
32
-        d′≢0 = ?
33
-      in _÷_ n′ d′
34
-        {fromWitness (λ{ {i} ⟨ i∣n′ , i∣d′ ⟩ → 
35
-          -- Coprime because: d₁ coprime d₂, d₁ coprime n₁, d₂ coprime n₂, n₁,
36
-          -- n₂ coprime c
37
-          ?})}
38
-        {?}
26
+∣_∣ : ℚ → ℚ
27
+∣ q ∣ = _÷†_ (+ ℤ.∣ numerator q ∣) (suc (denominator-1 q)) {isCoprime q}
28
+
29
+-_ : ℚ → ℚ
30
+- q = _÷_ (ℤ.- numerator q) (suc (denominator-1 q))
39 31
 
32
+_+_ : ℚ → ℚ → ℚ
33
+a + b = let
34
+    n-a = numerator a
35
+    d-a = suc (denominator-1 a)
36
+    n-b = numerator b
37
+    d-b = suc (denominator-1 b)
38
+    n-c = n-a ℤ.* (+ d-b) ℤ.+ n-b ℤ.* (+ d-a)
39
+    d-c = d-a ℕ.* d-b
40
+  in n-c ÷ d-c
40 41
 
41 42
 _*_ : ℚ → ℚ → ℚ
42
-a * b = ?
43
+a * b = let
44
+    n-a = numerator a
45
+    d-a = suc (denominator-1 a)
46
+    n-b = numerator b
47
+    d-b = suc (denominator-1 b)
48
+    n-c = n-a ℤ.* n-b
49
+    d-c = d-a ℕ.* d-b
50
+  in n-c ÷ d-c
43 51
 
44 52
 _-_ : ℚ → ℚ → ℚ
45
-a - b = ?
53
+a - b = a + (- b)
54
+
55
+
56
+--gcd (suc (denominator-1 a)) (suc (denominator-1 b))
57
+--... | ⟨ c , denom-gcd ⟩ with GCD.commonDivisor denom-gcd
58
+--...   | ⟨ divides d₁ d₁*c≡da , divides d₂ d₂*c≡db ⟩ = let
59
+--        d′ = d₁ ℕ* d₂ ℕ* c
60
+--        n′ = ((numerator a) ℤ* (+ d₂)) ℤ+ ((numerator b) ℤ* (+ d₁))
61
+--        d′≢0 = ?
62
+--      in _÷_ n′ d′
63
+--        {fromWitness (λ{ {i} ⟨ i∣n′ , i∣d′ ⟩ → 
64
+--          -- Coprime because: d₁ coprime d₂, d₁ coprime n₁, d₂ coprime n₂, n₁,
65
+--          -- n₂ coprime c
66
+--          ?})}
67
+--        {?}
68
+
69
+
46 70
 
47 71
 --data ℚ′ : Set where
48 72
 --  _÷′_ : ℤ → (d : ℕ) → {d≢0 : False (d ℕ.≟ 0)} → ℚ′

Loading…
Cancel
Save