Browse Source

Start working on probability stuff.

gas-move-test
Thomas Kerber 6 months ago
parent
commit
5286d8340f
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
4 changed files with 141 additions and 13 deletions
  1. 26
    1
      Yggdrasil/List.agda
  2. 75
    0
      Yggdrasil/Probability.agda
  3. 39
    12
      Yggdrasil/Security.agda
  4. 1
    0
      Yggdrasil/World.agda

+ 26
- 1
Yggdrasil/List.agda View File

@@ -1,8 +1,33 @@
1 1
 module Yggdrasil.List where
2 2
 
3
-open import Data.List using (List; _∷_)
3
+open import Data.List using (List; _∷_; []; map)
4
+open import Data.Product using (_×_; Σ; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
4 5
 open import Level using (Level)
6
+open import Relation.Binary.PropositionalEquality using (_≡_; refl)
5 7
 
6 8
 data _∈_ {ℓ : Level} {A : Set ℓ} : A → List A → Set ℓ where
7 9
   here : {x : A} {xs : List A} → x ∈ (x ∷ xs)
8 10
   there : {x y : A} {xs : List A} → y ∈ xs → y ∈ (x ∷ xs)
11
+
12
+with-proof : ∀ {ℓ} {A : Set ℓ} → (l : List A) → List (Σ A (_∈ l))
13
+with-proof [] = []
14
+with-proof (x ∷ xs) = ⟨ x , here ⟩ ∷ map (λ{⟨ x , ∈xs ⟩ → ⟨ x , there ∈xs ⟩})
15
+  (with-proof xs)
16
+
17
+head-≡ : ∀ {ℓ} {A : Set ℓ} {l₁ l₂ : List A} {x y : A} → x ∷ l₁ ≡ y ∷ l₂ → x ≡ y
18
+head-≡ refl = refl
19
+
20
+tail-≡ : ∀ {ℓ} {A : Set ℓ} {l₁ l₂ : List A} {x y : A} → x ∷ l₁ ≡ y ∷ l₂ →
21
+  l₁ ≡ l₂
22
+tail-≡ refl = refl
23
+
24
+map≡-implies-∈≡ : ∀ {ℓ} {A B C : Set ℓ} {f₁ : A → C} {f₂ : B → C} {l₁ : List A}
25
+  {l₂ : List B} {x : A} → map f₁ l₁ ≡ map f₂ l₂ →
26
+  x ∈ l₁ → ∃[ y ] ((y ∈ l₂) × (f₁ x ≡ f₂ y))
27
+map≡-implies-∈≡ {l₁ = x ∷ xs} {l₂ = []} () here
28
+map≡-implies-∈≡ {l₁ = x ∷ xs} {l₂ = []} () (there ∈xs)
29
+map≡-implies-∈≡ {l₁ = x ∷ xs} {l₂ = y ∷ ys} map≡ here =
30
+  ⟨ y , ⟨ here , head-≡ map≡ ⟩ ⟩
31
+map≡-implies-∈≡ {l₁ = x ∷ xs} {l₂ = y ∷ ys} map≡ (there ∈xs) = let
32
+    ⟨ y , ⟨ ∈ys , x≡y ⟩ ⟩ = map≡-implies-∈≡ (tail-≡ map≡) ∈xs
33
+  in ⟨ y , ⟨ there ∈ys , x≡y ⟩ ⟩

+ 75
- 0
Yggdrasil/Probability.agda View File

@@ -0,0 +1,75 @@
1
+module Yggdrasil.Probability where
2
+
3
+open import Data.List using (List; _∷_; []; map; filter; length)
4
+open import Data.Fin using (Fin; zero; suc)
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 (ℚ; _÷_; _≤?_)
9
+open import Relation.Nullary using (Dec; yes; no; ¬_)
10
+open import Relation.Nullary.Decidable using (True)
11
+open import Level using (Level; Lift; lift) renaming (suc to lsuc)
12
+
13
+data [0,1] : Set where
14
+  interval : (q : ℚ) → {≤1 : True (q ≤? (+ 1 ÷ 1))} {0≤ : True ((+ 0 ÷ 1) ≤? q)} → [0,1]
15
+
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}
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
+_/_ = ?
45
+
46
+PrFin : ∀ {ℓ} → ℕ → Set ℓ
47
+PrFin {ℓ} n = Lift ℓ (Fin (suc (suc n)))
48
+
49
+all-fin : (n : ℕ) → List (Fin n)
50
+all-fin zero = []
51
+all-fin (suc n) = zero ∷ map suc (all-fin n)
52
+
53
+count : ∀ {ℓ n} {P : PrFin {ℓ} n → Set ℓ} → ((f : PrFin {ℓ} n) → Dec (P f)) → ℕ
54
+count {n = n} dec = length (filter dec (map lift (all-fin (suc (suc n)))))
55
+
56
+data Dist {ℓ : Level} : Set ℓ → Set (lsuc ℓ) where
57
+  pure : ∀ {A : Set ℓ} → A → Dist A
58
+  sample : ∀ {n : ℕ} → Dist (PrFin n)
59
+  bind : ∀ {A B : Set ℓ} → Dist A → (A → Dist B) → Dist B
60
+
61
+data Pr[_[_]]≡_ {ℓ : Level} : {A : Set ℓ} → (P : A → Set ℓ) → Dist A →
62
+    [0,1] → Set (lsuc ℓ) where
63
+  pure-zero : {A : Set ℓ} {P : A → Set ℓ} → (x : A) → ¬ (P x) →
64
+    Pr[ P [ pure x ]]≡ (interval (+ 0 ÷ 1))
65
+  pure-one : {A : Set ℓ} {P : A → Set ℓ} → (x : A) → P x →
66
+    Pr[ P [ pure x ]]≡ (interval (+ 1 ÷ 1))
67
+  sample-count : {n : ℕ} {P : PrFin n → Set ℓ} →
68
+    (dec : (f : PrFin n) → Dec (P f)) →
69
+    Pr[ P [ sample {n = n} ]]≡ (count dec / suc (suc n))
70
+  conditional : {A B : Set ℓ} {D : Dist A} {f : A → Dist B} {P₁ : A → Set ℓ}
71
+    {P₂ : B → Set ℓ} {p₁ p₂ p₃ : [0,1]} →
72
+    Pr[ P₁ [ D ]]≡ p₁ → 
73
+    ((x : A) → P₁ x → Pr[ P₂ [ f x ]]≡ p₂) →
74
+    ((x : A) → ¬ (P₁ x) → Pr[ P₂ [ f x ]]≡ p₃) → 
75
+    Pr[ P₂ [ bind D f ]]≡ (case p₁ p₂ p₃)

+ 39
- 12
Yggdrasil/Security.agda View File

@@ -1,12 +1,16 @@
1 1
 module Yggdrasil.Security where
2 2
 
3
-open import Data.List using (map)
4
-open import Data.Product using (_×_; Σ; Σ-syntax; proj₁; proj₂; ∃; ∃-syntax)
5
-open import Level using (Level) renaming (suc to lsuc)
6
-open import Relation.Binary.PropositionalEquality using (_≡_)
7
-open import Yggdrasil.List using (_∈_)
8
-open import Yggdrasil.World using (WorldType; World; Call; Strategy; weaken)
3
+open import Data.List using (_∷_; []; map)
4
+open import Data.Product using (_×_; Σ; Σ-syntax; proj₁; proj₂; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
5
+open import Data.Nat using (ℕ)
6
+open import Data.Maybe using (Maybe) renaming (map to mmap)
7
+open import Data.Unit using (⊤; tt)
8
+open import Level using (Level; Lift; lift) renaming (suc to lsuc)
9
+open import Relation.Binary.PropositionalEquality using (_≡_; refl)
10
+open import Yggdrasil.List using (_∈_; here; there; with-proof; map≡-implies-∈≡)
11
+open import Yggdrasil.World using (WorldType; WorldState; World; Call; Strategy; Node; Action↑; weaken; call; call↓; _↑_; stnode; _∷_; []; exec)
9 12
 open WorldType
13
+open Node
10 14
 
11 15
 data Guess {ℓ : Level} : Set ℓ where
12 16
   real? ideal? : Guess
@@ -16,7 +20,6 @@ data Outcome : Set where
16 20
 
17 21
 record RouterConfig {ℓ : Level} : Set (lsuc ℓ) where
18 22
   field
19
-    ref   : Guess {ℓ}
20 23
     real  : World ℓ
21 24
     ideal : World ℓ
22 25
     sim   : Σ[ σ ∈ Set ℓ ] (σ × (∀ {c} → σ → c ∈ adv (proj₁ ideal) →
@@ -26,15 +29,39 @@ record RouterConfig {ℓ : Level} : Set (lsuc ℓ) where
26 29
 open RouterConfig
27 30
 
28 31
 router-world-type : ∀ {ℓ} → RouterConfig {ℓ} → WorldType ℓ
29
-router-world-type = ?
32
+router-world-type {ℓ} rc = record
33
+  { node = router-node
34
+  ; adv = []
35
+  ; hon = map (λ{c → call (Call.A (proj₁ c)) (Call.B (proj₁ c)) (hon-map′ c)})
36
+    (with-proof (hon (proj₁ (ideal rc))))
37
+  }
38
+  where
39
+    router-node : Node ℓ
40
+    router-node = record
41
+      { state = Σ (Guess {ℓ}) (λ{ ideal? → Lift ℓ ⊤ ; real? → proj₁ (sim rc)})
42
+      ; chld  = proj₁ (ideal rc) ∷ proj₁ (real rc) ∷ []
43
+      ; qry   = []
44
+      } 
45
+    hon-map′ : (c : Σ (Call ℓ (node (proj₁ (ideal rc)))) (_∈ (hon (proj₁ (ideal rc))))) →
46
+      state router-node → (x : Call.A (proj₁ c)) →
47
+      (state router-node) × Action↑ router-node (Call.B (proj₁ c) x)
48
+    hon-map′ ⟨ call A B δ , ∈ideal ⟩ ⟨ ideal? , lift tt ⟩ x
49
+      = ⟨ ⟨ ideal? , lift tt ⟩ , call↓ ∈ideal x ↑ here ⟩
50
+    hon-map′ ⟨ call A B δ , ∈ideal ⟩ ⟨ real? , σ ⟩ x with map≡-implies-∈≡ (hon-≡ rc) ∈ideal
51
+    ... | ⟨ _ , ⟨ ∈real , refl ⟩ ⟩ = ⟨ ⟨ real? , σ ⟩ , call↓ ∈real x ↑ there here ⟩
30 52
 
31
-router-world : ∀ {ℓ} → RouterConfig {ℓ} → Guess {ℓ} → World ℓ
32
-router-world = ?
53
+router-world-state : ∀ {ℓ} → (rc : RouterConfig {ℓ}) → Guess {ℓ} →
54
+  WorldState (router-world-type rc)
55
+router-world-state rc real? = stnode ⟨ real? , proj₁ (proj₂ (sim rc)) ⟩
56
+  (proj₂ (ideal rc) ∷ proj₂ (real rc) ∷ [])
57
+router-world-state rc ideal? = stnode ⟨ ideal? , lift tt ⟩
58
+  (proj₂ (ideal rc) ∷ proj₂ (real rc) ∷ [])
33 59
 
34 60
 router-strategy : ∀ {ℓ A} → (rc : RouterConfig {ℓ}) →
35 61
   Strategy (proj₁ (ideal rc)) A → Strategy (router-world-type rc) A
36 62
 router-strategy = ?
37 63
 
38 64
 yggdrasil-game : ∀ {ℓ} → (rc : RouterConfig {ℓ}) →
39
-  Strategy (proj₁ (ideal rc)) Guess → Guess {ℓ} → Outcome
40
-yggdrasil-game = ?
65
+  Strategy (proj₁ (ideal rc)) Guess → Guess {ℓ} → ℕ → Maybe (Guess {ℓ})
66
+yggdrasil-game rc str world gas = mmap proj₁ (exec (router-strategy rc str)
67
+  (router-world-state rc world) gas)

+ 1
- 0
Yggdrasil/World.agda View File

@@ -38,6 +38,7 @@ open Node
38 38
 
39 39
 record Call (ℓ : Level) (N : Node ℓ) : Set (lsuc ℓ) where
40 40
   inductive
41
+  constructor call
41 42
   field
42 43
     A : Set ℓ
43 44
     B : A → Set ℓ

Loading…
Cancel
Save