[ refactor ] add Relation.Unary.Unique

CHANGELOG.md

@@ -396,6 +396,11 @@ Additions to existing modules
   *-almostCancelʳ-≡ : AlmostRightCancellative 0 _*_
   ```
 
+* In `Data.Product`:
+  ```agda
+  ∃!-≐ : P ≐ Q → ∃! _≈_ P → ∃! _≈_ Q
+  ```
+
 * In `Data.Rational.Properties`:
   ```agda
   ↥[i/1]≡i  : (i : ℤ) → ↥ (i / 1) ≡ i
@@ -427,3 +432,15 @@ Additions to existing modules
     StarRightDestructive  : ∀ (_+_ _*_ : Fun₂ A) (_⋆ : Fun₁ A) → Set _
     StarDestructive       : ∀ (_+_ _*_ : Fun₂ A) (_⋆ : Fun₁ A) → Set _
   ```
+
+* In `Relation.Unary`:
+  ```agda
+  Unique          : (A → A → Set ℓ₁) (P : Pred A ℓ₂) → Pred A _
+  UniqueGivenThat : (A → A → Set ℓ₁) (P : Pred A ℓ₂) → Pred A _
+  UniqueSuchThat  : (A → A → Set ℓ₁) (P : Pred A ℓ₂) → Pred A _
+  ```
+
+* In `Relation.Unary.Properties`:
+  ```agda
+  unique-given-suchthat : P ∩ UniqueGivenThat _≈_ P ≐ P ∩ UniqueSuchThat _≈_ P
+  ```

src/Data/List/Relation/Binary/Distance/Levenshtein/Core.agda

@@ -16,10 +16,11 @@ There are no backwards compatibility guarantees whatsoever on its content."
 open import Data.Nat.Base using (ℕ; _≤_; _+_)
 open import Level using (_⊔_)
 open import Relation.Binary.PropositionalEquality.Core using (_≡_)
+open import Relation.Unary using (UniqueGivenThat)
 
 -- These definitions surely need to go somewhere else
 Unique : ∀ {a ℓ} {A : Set a} (dist : A → A → ℕ → Set ℓ) → Set (a ⊔ ℓ)
-Unique dist = ∀ x y k l → dist x y k → dist x y l → k ≡ l
+Unique dist = ∀ x y k → UniqueGivenThat _≡_ (dist x y) k
 
 Triangle : ∀ {a ℓ} {A : Set a} (dist : A → A → ℕ → Set ℓ) → Set (a ⊔ ℓ)
 Triangle dist = ∀ x y z k l m → dist x y k → dist y z l → dist x z m → m ≤ k + l

src/Data/List/Relation/Binary/Distance/Levenshtein/Dist/Setoid.agda

@@ -83,11 +83,11 @@ symmetric (d , m) .edit = Edit.symmetric d
 symmetric (d , m) .minimal = λ c d′ → m c (Edit.symmetric d′)
 
 -- The relation is indeed unique
-unique : Unique {A = List A} Dist
-unique _ _ _ _ (dk , mk) (dl , ml) = ≤-antisym (mk _ dl) (ml _ dk)
+unique : Unique Dist
+unique _ _ _ (dk , mk) (dl , ml) = ≤-antisym (ml _ dk) (mk _ dl)
 
 -- And it respects the triangle inequality
-triangle : Triangle {A = List A} Dist
+triangle : Triangle Dist
 triangle _ _ _ _ _ _ (dlm , _) (dmr , _) (dlr , mlr)
   = let (m , dlr′ , m≤) = Edit.compose dlm dmr in
   ≤-trans (mlr m dlr′) m≤

src/Data/List/Relation/Binary/Distance/Levenshtein/Edit/Setoid.agda

@@ -86,14 +86,14 @@ open import Data.List.Relation.Binary.Distance.Levenshtein.Core
 module _ (x : A) where
 
   -- the "distance" defined by the relation is not unique
-  not-unique : ¬ Unique {A = List A} Edit
+  not-unique : ¬ Unique Edit
   not-unique unique =
     let xs = x ∷ []
-        hyp = unique xs xs 0 1 reflexive (swap done)
-    in 0≢1+n hyp
+        hyp = unique xs xs 0 reflexive (swap done)
+    in 0≢1+n (sym hyp)
 
   -- the relation does not satisfy the triangle inequality
-  not-triangle : ¬ (Triangle {A = List A} Edit)
+  not-triangle : ¬ Triangle Edit
   not-triangle triangle =
       let xs = x ∷ []
           hyp = triangle xs xs xs 0 0 1 reflexive reflexive (swap done)

src/Data/Product.agda

@@ -8,8 +8,13 @@
 
 module Data.Product where
 
+open import Function.Base using (_∘_; _$_)
+open import Function.Bundles using (_↔_; mk↔ₛ′)
 open import Level using (Level; _⊔_)
+open import Relation.Binary.Core using (Rel)
 open import Relation.Nullary.Negation.Core using (¬_)
+open import Relation.Unary using (Pred; _≐_; UniqueSuchThat)
+open import Relation.Unary.Properties using (≐-sym)
 
 private
   variable
@@ -48,11 +53,6 @@ zipWith _∙_ _∘_ _*_ (a , p) (b , q) = (a ∙ b) * (p ∘ q)
 ∄ : ∀ {A : Set a} → (A → Set b) → Set (a ⊔ b)
 ∄ P = ¬ ∃ P
 
--- Unique existence (parametrised by an underlying equality).
-
-∃! : {A : Set a} → (A → A → Set ℓ) → (A → Set b) → Set (a ⊔ b ⊔ ℓ)
-∃! _≈_ B = ∃ λ x → B x × (∀ {y} → B y → x ≈ y)
-
 -- Syntax
 
 infix 2 ∄-syntax
@@ -61,3 +61,14 @@ infix 2 ∄-syntax
 ∄-syntax = ∄
 
 syntax ∄-syntax (λ x → B) = ∄[ x ] B
+
+------------------------------------------------------------------------
+-- Unique existence (parameterised by an underlying equality).
+
+module _ (_≈_ : Rel A ℓ) where
+
+  ∃! : (P : Pred A p) → Set _
+  ∃! P = ∃ (UniqueSuchThat _≈_ P)
+
+  ∃!-≐ : {P : Pred A p} {Q : Pred A q} → P ≐ Q → ∃! P → ∃! Q
+  ∃!-≐ (P⊆Q , Q⊆P) = map₂ (map P⊆Q λ !P → !P ∘ Q⊆P)

src/Relation/Unary.agda

@@ -198,6 +198,19 @@ Decidable P = ∀ x → Dec (P x)
 ⌊_⌋ : {P : Pred A ℓ} → Decidable P → Pred A ℓ
 ⌊ P? ⌋ a = Lift _ (True (P? a))
 
+-- Uniqueness
+
+module _ (_≈_ : A → A → Set ℓ₁) (P : Pred A ℓ₂) where
+
+  Unique : Pred A _
+  Unique x = ∀ {z} → P z → z ≈ x
+
+  UniqueGivenThat : Pred A _
+  UniqueGivenThat x = P x → Unique x
+
+  UniqueSuchThat : Pred A _
+  UniqueSuchThat x = P x × Unique x
+
 ------------------------------------------------------------------------
 -- Operations on sets
 

src/Relation/Unary/Properties.agda

@@ -8,7 +8,8 @@
 
 module Relation.Unary.Properties where
 
-open import Data.Product.Base as Product using (_×_; _,_; -,_; swap; proj₁; zip′; curry)
+open import Data.Product.Base as Product
+  using (_×_; _,_; -,_; swap; proj₁; zip′; curry)
 open import Data.Sum.Base using (inj₁; inj₂)
 open import Data.Unit.Base using (tt)
 open import Function.Base using (id; _$_; _∘_; _∘₂_)
@@ -335,3 +336,12 @@ U-irrelevant a b = refl
 
 ∁-irrelevant : (P : Pred A ℓ) → Irrelevant (∁ P)
 ∁-irrelevant P a b = refl
+
+------------------------------------------------------------------------
+-- Uniqueness properties
+
+unique-given-suchthat : {_≈_ : Rel A ℓ₁} {P : Pred A ℓ₂} →
+                        P ∩ UniqueGivenThat _≈_ P ≐ P ∩ UniqueSuchThat _≈_ P
+unique-given-suchthat =
+  (λ (Px , !Px) → Px , Px , (!Px Px)) , Product.map₂ λ (_ , !Px) → λ _ → !Px
+-- Product.map₂ (λ !Px → {!!} , !Px _)