Rejig key-value (#41)

Everything/Safe.agda

@@ -35,8 +35,8 @@ open import DecidableSet
 
 open import Vectors
 
-open import KeyValue
-open import KeyValueWithDomain
+open import KeyValue.KeyValue
+open import KeyValue.LinearStore.Definition
 
 open import Maybe
 open import Orders

KeyValue/KeyValue.agda

@@ -0,0 +1,22 @@
+{-# OPTIONS --warning=error --safe --without-K #-}
+
+open import LogicalFormulae
+open import Orders
+open import Maybe
+open import Agda.Primitive using (Level; lzero; lsuc; _⊔_)
+open import Vectors
+
+open import Numbers.Naturals.Naturals
+open import Numbers.Naturals.Order
+
+module KeyValue.KeyValue where
+  record KeyValue {a b c : _} (keys : Set a) (values : Set b) (maps : Set c) : Set (a ⊔ b ⊔ c) where
+    field
+      tryFind : maps → keys → Maybe values
+      add : (map : maps) → keys → values → maps
+      empty : maps
+      count : maps → ℕ
+      lookupAfterAdd : (map : maps) → (k : keys) → (v : values) → tryFind (add map k v) k ≡ yes v
+      lookupAfterAdd' : (map : maps) → (k1 : keys) → (v : values) → (k2 : keys) → (k1 ≡ k2) || (tryFind (add map k1 v) k2 ≡ tryFind map k2)
+      countAfterAdd' : (map : maps) → (k : keys) → (v : values) → (tryFind map k ≡ no) → count (add map k v) ≡ succ (count map)
+      countAfterAdd : (map : maps) → (k : keys) → (v1 v2 : values) → (tryFind map k ≡ yes v2) → count (add map k v1) ≡ count map

KeyValue/LinearStore/Definition.agda

@@ -0,0 +1,35 @@
+{-# OPTIONS --warning=error --safe --without-K #-}
+
+open import KeyValue.LinearStore.Implementation
+open import KeyValue.KeyValue
+open import Orders
+open import LogicalFormulae
+open import Maybe
+
+module KeyValue.LinearStore.Definition where
+  LinearStore : {a b c : _} (keys : Set a) (values : Set b) (keyOrder : TotalOrder {_} {c} keys) → KeyValue keys values (Map keys values keyOrder)
+  KeyValue.tryFind (LinearStore keys values keyOrder) = lookup {keys = keys} {values} {keyOrder}
+  KeyValue.add (LinearStore keys values keyOrder) = addMap
+  KeyValue.empty (LinearStore keys values keyOrder) = empty
+  KeyValue.count (LinearStore keys values keyOrder) = count {keys = keys} {values} {keyOrder}
+  KeyValue.lookupAfterAdd (LinearStore keys values keyOrder) empty k v with TotalOrder.totality keyOrder k k
+  KeyValue.lookupAfterAdd (LinearStore keys values keyOrder) empty k v | inl (inl x) = exFalso (TotalOrder.irreflexive keyOrder x)
+  KeyValue.lookupAfterAdd (LinearStore keys values keyOrder) empty k v | inl (inr x) = exFalso (TotalOrder.irreflexive keyOrder x)
+  KeyValue.lookupAfterAdd (LinearStore keys values keyOrder) empty k v | inr x = refl
+  KeyValue.lookupAfterAdd (LinearStore keys values keyOrder) (nonempty x) k v = lookupReducedSucceedsAfterAdd k v x
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) empty k1 v k2 with TotalOrder.totality keyOrder k1 k2
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) empty k1 v k2 | inl (inl x) = inr refl
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) empty k1 v k2 | inl (inr x) = inr refl
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) empty k1 v k2 | inr x = inl x
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) (nonempty x) k1 v k2 with TotalOrder.totality keyOrder k1 k2
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) (nonempty map) k1 v k2 | inl (inl x) with inspect (lookupReduced map k2)
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) (nonempty map) k1 v k2 | inl (inl x) | no with≡ pr rewrite pr = inr (lookupReducedFailsAfterUnrelatedAdd k1 v k2 (inl x) map pr)
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) (nonempty map) k1 v k2 | inl (inl x) | (yes lookedUp) with≡ pr rewrite pr = inr (lookupReducedSucceedsAfterUnrelatedAdd k1 v k2 lookedUp (inl x) map pr)
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) (nonempty map) k1 v k2 | inl (inr x) with inspect (lookupReduced map k2)
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) (nonempty map) k1 v k2 | inl (inr x) | no with≡ pr rewrite pr = inr (lookupReducedFailsAfterUnrelatedAdd k1 v k2 (inr x) map pr)
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) (nonempty map) k1 v k2 | inl (inr x) | yes lookedUp with≡ pr rewrite pr = inr (lookupReducedSucceedsAfterUnrelatedAdd k1 v k2 lookedUp (inr x) map pr)
+  KeyValue.lookupAfterAdd' (LinearStore keys values keyOrder) (nonempty map) k1 v k2 | inr x = inl x
+  KeyValue.countAfterAdd' (LinearStore keys values keyOrder) empty _ _ _ = refl
+  KeyValue.countAfterAdd' (LinearStore keys values keyOrder) (nonempty x) k v = countReducedBehavesWhenAddingNotPresent k v x
+  KeyValue.countAfterAdd (LinearStore keys values keyOrder) empty _ _ _ ()
+  KeyValue.countAfterAdd (LinearStore keys values keyOrder) (nonempty map) k v1 v2 = countReducedBehavesWhenAddingPresent k v1 v2 map

KeyValue/LinearStore/Implementation.agda

@@ -9,7 +9,7 @@ open import Vectors
 open import Numbers.Naturals.Naturals
 open import Numbers.Naturals.Order
 
-module KeyValue where
+module KeyValue.LinearStore.Implementation where
   record ReducedMap {a b c : _} (keys : Set a) (values : Set b) (keyOrder : TotalOrder {_} {c} keys) (min : keys) : Set (a ⊔ b ⊔ c)
   record ReducedMap {a} {b} {c} keys values keyOrder min where
     inductive

KeyValueWithDomain.agda

@@ -1,20 +0,0 @@
-{-# OPTIONS --warning=error --safe --without-K #-}
-
-open import LogicalFormulae
-open import Orders
-open import Maybe
-open import Agda.Primitive using (Level; lzero; lsuc; _⊔_)
-open import KeyValue
-open import Vectors
-
-open import Numbers.Naturals.Naturals
-
-module KeyValueWithDomain where
-
-  record MapWithDomain {a b c : _} (keyDom : Set a) (values : Set b) (keyOrder : TotalOrder {_} {c} keyDom) : Set (a ⊔ b ⊔ c) where
-    field
-      map : Map keyDom values keyOrder
-      domain : Vec keyDom (count map)
-      domainIsIt : keys map ≡ domain
-    lookup' : (key : keyDom) → (vecContains domain key) → Sg values (λ v → lookup map key ≡ yes v)
-    lookup' k cont rewrite equalityCommutative domainIsIt = lookupCertain {keyOrder = keyOrder} map k cont

PrimeNumbers.agda

@@ -7,8 +7,7 @@ open import Numbers.Naturals.Multiplication -- TODO - remove this dependency
 open import Numbers.Naturals.Order -- TODO - remove this dependency
 open import Numbers.Naturals.WithK
 open import WellFoundedInduction
-open import KeyValue
-open import KeyValueWithDomain
+open import KeyValue.KeyValue
 open import Orders
 open import Vectors
 open import Maybe
@@ -249,31 +248,6 @@ module PrimeNumbers where
     allNumbersLessThan : (n : ℕ) → Vec (numberLessThan n) n
     allNumbersLessThan n = vecRev (allNumbersLessThanDescending n)
 
-    record extensionalHCF (a b : ℕ) : Set where
-      field
-        c : ℕ
-        c|a : c ∣ a
-        c|b : c ∣ b
-      field
-        zeroCase : ((a ≡ 0) & (b ≡ 0) & (c ≡ 0)) || ((0 <N a) || (0 <N b))
-        hcfExtension : MapWithDomain (numberLessThan c) (Sg (numberLessThan c) (λ i → ((notDiv (numberLessThan.a i) a) || (notDiv (numberLessThan.a i) b)) || ((numberLessThan.a i) ∣ a & (numberLessThan.a i) ∣ b & (numberLessThan.a i) ∣ c))) (numberLessThanOrder c)
-        hcfExtensionIsRightLength : vecLen (MapWithDomain.domain hcfExtension) ≡ c
-
-{-
-    hcfsContains : {a b r : ℕ} → (hcf : extensionalHCF a b) → (r<hcf : r <N extensionalHCF.c hcf) → vecContains (MapWithDomain.domain (extensionalHCF.hcfExtension hcf)) record { a = r ; a<n = r<hcf }
-    hcfsContains = {!!}
-
-    hcfsEquivalent : {a b : ℕ} → hcfData a b → extensionalHCF a b
-    hcfsEquivalent {a} {b} record { c = c ; c|a = c|a ; c|b = c|b ; hcf = hcf } = record { c = c ; c|a = c|a ; c|b = c|b ; hcfExtension = hcfsMap ; hcfExtensionIsRightLength = {!!} ; zeroCase = {!!} }
-      where
-        pair : Set
-        pair = (Sg (numberLessThan c) (λ i → ((notDiv (numberLessThan.a i) a) || (notDiv (numberLessThan.a i) b)) || ((numberLessThan.a i) ∣ a & (numberLessThan.a i) ∣ b & (numberLessThan.a i) ∣ c)))
-        allHcfs : Map (numberLessThan c) pair (numberLessThanOrder c)
-        allHcfs = {!!}
-        hcfsMap : MapWithDomain (numberLessThan c) (Sg (numberLessThan c) (λ i → ((notDiv (numberLessThan.a i) a) || (notDiv (numberLessThan.a i) b)) || ((numberLessThan.a i) ∣ a & (numberLessThan.a i) ∣ b & (numberLessThan.a i) ∣ c))) (numberLessThanOrder c)
-        hcfsMap = {!!}
--}
-
     positiveTimes : {a b : ℕ} → (succ a *N succ b <N succ a) → False
     positiveTimes {a} {b} pr = zeroNeverGreater f'
       where

RedBlackTree.agda

@@ -3,8 +3,9 @@
 open import LogicalFormulae
 open import Functions
 open import Maybe
+open import Orders
 
-open import Naturals
+open import Numbers.Naturals.Naturals
 
 module RedBlackTree where
   record BinaryTreeNode {a : _} (carrier : Set a) (order : TotalOrder carrier) (minValue : Maybe carrier) (maxValue : Maybe carrier) : Set a
@@ -15,7 +16,7 @@ module RedBlackTree where
     inductive
     field
       value : carrier
-      min<=val : TotalOrder._<_ order min val
+      min<=val : TotalOrder._<_ order minValue maxValue
       leftChild : Maybe (Sg (BinaryTreeNode {a} carrier order minValue (yes value)) (λ i → TotalOrder._<_ order (valueExtractor {a} {carrier} {order} i) value))
       rightChild : Maybe (Sg (BinaryTreeNode {a} carrier order (yes value) maxValue) (λ i → TotalOrder._<_ order value (valueExtractor i)))