Browse Source

Distributional equality.

gas-move-test
Thomas Kerber 6 months ago
parent
commit
1e2909c992
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
1 changed files with 55 additions and 35 deletions
  1. 55
    35
      Yggdrasil/Probability.agda

+ 55
- 35
Yggdrasil/Probability.agda View File

@@ -3,45 +3,36 @@ module Yggdrasil.Probability where
3 3
 open import Data.List using (List; _∷_; []; map; filter; length)
4 4
 open import Data.Fin using (Fin; zero; suc)
5 5
 open import Data.Integer using (+_; _-_) renaming (_*_ to _ℤ*_)
6
-open import Data.Nat using (ℕ; zero; suc) renaming (_*_ to _ℕ*_)
7
-open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
8
-open import Data.Rational using (ℚ; _÷_; _≤?_)
6
+open import Data.Nat using (ℕ; zero; suc; _≤_; s≤s) renaming (_*_ to _ℕ*_; _≤?_ to _ℕ≤?_)
7
+open import Data.Nat.Properties using (≤-trans; ≤-refl)
8
+open import Data.List.Properties using (length-filter; length-map)
9
+open import Data.Product using (_×_; ∃; ∃-syntax; proj₁) renaming (_,_ to ⟨_,_⟩)
10
+open import Data.Rational using (ℚ; _÷_) renaming (_≤?_ to _ℚ≤?_)
9 11
 open import Relation.Nullary using (Dec; yes; no; ¬_)
10
-open import Relation.Nullary.Decidable using (True)
12
+open import Relation.Nullary.Decidable using (True; fromWitness)
13
+open import Relation.Binary.PropositionalEquality using (_≡_; refl; trans; cong)
11 14
 open import Level using (Level; Lift; lift) renaming (suc to lsuc)
15
+open import Yggdrasil.List using (_∈_; with-proof)
12 16
 
13
-data [0,1] : Set where
14
-  interval : (q : ℚ) → {≤1 : True (q ≤? (+ 1 ÷ 1))} {0≤ : True ((+ 0 ÷ 1) ≤? q)} → [0,1]
17
+record [0,1] : Set where
18
+  field
19
+    q : ℚ
20
+    ≤1 : True (q ℚ≤? (+ 1 ÷ 1))
21
+    0≤ : True ((+ 0 ÷ 1) ℚ≤? q)
15 22
 
16
-1-_ : [0,1] → [0,1]
17
-1- (interval q {q≤1} {0≤q}) = let
18
-    n = ℚ.numerator q
19
-    d = suc (ℚ.denominator-1 q)
20
-    n′ = + d - n
21
-    n′∣̷d = ?
22
-    1-q = _÷_ n′ d {n′∣̷d}
23
-    1-q≤1 = ?
24
-    0≤1-q = ?
25
-  in interval 1-q {1-q≤1} {0≤1-q}
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≤ }
26 26
 
27
-_*_ : [0,1] → [0,1] → [0,1]
28
-(interval q₁ {q₁≤1} {0≤q₁}) * (interval q₂ {q₂≤1} {0≤q₂}) = let
29
-    n₁ = ℚ.numerator q₁
30
-    n₂ = ℚ.numerator q₂
31
-    d₁ = suc (ℚ.denominator-1 q₁)
32
-    d₂ = suc (ℚ.denominator-1 q₂)
33
-    n′ = n₁ ℤ* n₂
34
-    d′ = d₁ ℕ* d₂
35
-    q₁*q₂ = ?
36
-    q₁*q₂≤1 = ?
37
-    0≤q₁*q₂ = ?
38
-  in interval q₁*q₂ {q₁*q₂≤1} {0≤q₁*q₂}
39
-
40
-case : [0,1] → [0,1] → [0,1] → [0,1]
41
-case = ?
42
-
43
-_/_ : ℕ → ℕ → [0,1]
44
-_/_ = ?
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]
45 36
 
46 37
 PrFin : ∀ {ℓ} → ℕ → Set ℓ
47 38
 PrFin {ℓ} n = Lift ℓ (Fin (suc (suc n)))
@@ -50,6 +41,10 @@ all-fin : (n : ℕ) → List (Fin n)
50 41
 all-fin zero = []
51 42
 all-fin (suc n) = zero ∷ map suc (all-fin n)
52 43
 
44
+length-all-fin : (n : ℕ) → length (all-fin n) ≡ n
45
+length-all-fin zero = refl
46
+length-all-fin (suc n) = cong suc (trans (length-map suc (all-fin n)) (length-all-fin n))
47
+
53 48
 count : ∀ {ℓ n} {P : PrFin {ℓ} n → Set ℓ} → ((f : PrFin {ℓ} n) → Dec (P f)) → ℕ
54 49
 count {n = n} dec = length (filter dec (map lift (all-fin (suc (suc n)))))
55 50
 
@@ -58,6 +53,9 @@ data Dist {ℓ : Level} : Set ℓ → Set (lsuc ℓ) where
58 53
   sample : ∀ {n : ℕ} → Dist (PrFin n)
59 54
   bind : ∀ {A B : Set ℓ} → Dist A → (A → Dist B) → Dist B
60 55
 
56
+≡⇒≤ : {a b : ℕ} → a ≡ b → a ≤ b
57
+≡⇒≤ refl = ≤-refl
58
+
61 59
 data Pr[_[_]]≡_ {ℓ : Level} : {A : Set ℓ} → (P : A → Set ℓ) → Dist A →
62 60
     [0,1] → Set (lsuc ℓ) where
63 61
   pure-zero : {A : Set ℓ} {P : A → Set ℓ} → (x : A) → ¬ (P x) →
@@ -66,10 +64,32 @@ data Pr[_[_]]≡_ {ℓ : Level} : {A : Set ℓ} → (P : A → Set ℓ) → Dist
66 64
     Pr[ P [ pure x ]]≡ (interval (+ 1 ÷ 1))
67 65
   sample-count : {n : ℕ} {P : PrFin n → Set ℓ} →
68 66
     (dec : (f : PrFin n) → Dec (P f)) →
69
-    Pr[ P [ sample {n = n} ]]≡ (count dec / suc (suc n))
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
+    )})
70 74
   conditional : {A B : Set ℓ} {D : Dist A} {f : A → Dist B} {P₁ : A → Set ℓ}
71 75
     {P₂ : B → Set ℓ} {p₁ p₂ p₃ : [0,1]} →
72 76
     Pr[ P₁ [ D ]]≡ p₁ → 
73 77
     ((x : A) → P₁ x → Pr[ P₂ [ f x ]]≡ p₂) →
74 78
     ((x : A) → ¬ (P₁ x) → Pr[ P₂ [ f x ]]≡ p₃) → 
75 79
     Pr[ P₂ [ bind D f ]]≡ (case p₁ p₂ p₃)
80
+
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₂

Loading…
Cancel
Save