diff --git a/master/Data.List.Relation.Binary.Sublist.DecSetoid.html b/master/Data.List.Relation.Binary.Sublist.DecSetoid.html index 1092a00479..dc7f8e81fa 100644 --- a/master/Data.List.Relation.Binary.Sublist.DecSetoid.html +++ b/master/Data.List.Relation.Binary.Sublist.DecSetoid.html @@ -37,7 +37,7 @@ -- Additional relational properties _⊆?_ : Decidable _⊆_ -_⊆?_ = HeterogeneousProperties.sublist? _≟_ +_⊆?_ = HeterogeneousProperties.sublist? _≟_ ⊆-isDecPartialOrder : IsDecPartialOrder _≋_ _⊆_ ⊆-isDecPartialOrder = record diff --git a/master/Data.List.Relation.Binary.Sublist.Heterogeneous.Properties.html b/master/Data.List.Relation.Binary.Sublist.Heterogeneous.Properties.html index a6ea206419..962e2485bd 100644 --- a/master/Data.List.Relation.Binary.Sublist.Heterogeneous.Properties.html +++ b/master/Data.List.Relation.Binary.Sublist.Heterogeneous.Properties.html @@ -40,687 +40,703 @@ open import Relation.Binary.Structures using (IsPreorder; IsPartialOrder; IsDecPartialOrder) open import Relation.Binary.PropositionalEquality.Core as using (_≡_) +import Relation.Binary.Reasoning.Preorder as ≲-Reasoning +open import Relation.Binary.Reasoning.Syntax + +private + variable + a b c d e p q r s t : Level + A : Set a + B : Set b + C : Set c + D : Set d + x : A + y : B + as cs xs : List A + bs ds ys : List B + ass : List (List A) + bss : List (List B) + m n : + +------------------------------------------------------------------------ +-- Injectivity of constructors + +module _ {R : REL A B r} where + + ∷-injectiveˡ : {px qx : R x y} {pxs qxs : Sublist R xs ys} + (Sublist R (x xs) (y ys) px pxs) (qx qxs) px qx + ∷-injectiveˡ ≡.refl = ≡.refl + + ∷-injectiveʳ : {px qx : R x y} {pxs qxs : Sublist R xs ys} + (Sublist R (x xs) (y ys) px pxs) (qx qxs) pxs qxs + ∷-injectiveʳ ≡.refl = ≡.refl + + ∷ʳ-injective : {pxs qxs : Sublist R xs ys} + (Sublist R xs (y ys) y ∷ʳ pxs) (y ∷ʳ qxs) pxs qxs + ∷ʳ-injective ≡.refl = ≡.refl + +module _ {R : REL A B r} where + + length-mono-≤ : Sublist R as bs length as length bs + length-mono-≤ [] = z≤n + length-mono-≤ (y ∷ʳ rs) = ℕ.m≤n⇒m≤1+n (length-mono-≤ rs) + length-mono-≤ (r rs) = s≤s (length-mono-≤ rs) + +------------------------------------------------------------------------ +-- Conversion to and from Pointwise (proto-reflexivity) + + fromPointwise : Pointwise R Sublist R + fromPointwise [] = [] + fromPointwise (p ps) = p fromPointwise ps + + toPointwise : length as length bs + Sublist R as bs Pointwise R as bs + toPointwise {bs = []} eq [] = [] + toPointwise {bs = b bs} eq (r rs) = r toPointwise (ℕ.suc-injective eq) rs + toPointwise {bs = b bs} eq (b ∷ʳ rs) = + contradiction (s≤s (length-mono-≤ rs)) (ℕ.<-irrefl eq) + +------------------------------------------------------------------------ +-- Various functions' outputs are sublists + +-- These lemmas are generalisations of results of the form `f xs ⊆ xs`. +-- (where _⊆_ stands for Sublist R). If R is reflexive then we can +-- indeed obtain `f xs ⊆ xs` from `xs ⊆ ys → f xs ⊆ ys`. The other +-- direction is only true if R is both reflexive and transitive. + +module _ {R : REL A B r} where + + tail-Sublist : Sublist R as bs + Maybe.All as Sublist R as bs) (tail as) + tail-Sublist [] = nothing + tail-Sublist (b ∷ʳ ps) = Maybe.map (b ∷ʳ_) (tail-Sublist ps) + tail-Sublist (p ps) = just (_ ∷ʳ ps) + + take-Sublist : n Sublist R as bs Sublist R (take n as) bs + take-Sublist n (y ∷ʳ rs) = y ∷ʳ take-Sublist n rs + take-Sublist zero rs = minimum _ + take-Sublist (suc n) [] = [] + take-Sublist (suc n) (r rs) = r take-Sublist n rs + + drop-Sublist : n Sublist R (Sublist R ∘′ drop n) + drop-Sublist n (y ∷ʳ rs) = y ∷ʳ drop-Sublist n rs + drop-Sublist zero rs = rs + drop-Sublist (suc n) [] = [] + drop-Sublist (suc n) (r rs) = _ ∷ʳ drop-Sublist n rs + +module _ {R : REL A B r} {P : Pred A p} (P? : U.Decidable P) where + + takeWhile-Sublist : Sublist R as bs Sublist R (takeWhile P? as) bs + takeWhile-Sublist [] = [] + takeWhile-Sublist (y ∷ʳ rs) = y ∷ʳ takeWhile-Sublist rs + takeWhile-Sublist {a as} (r rs) with does (P? a) + ... | true = r takeWhile-Sublist rs + ... | false = minimum _ + + dropWhile-Sublist : Sublist R as bs Sublist R (dropWhile P? as) bs + dropWhile-Sublist [] = [] + dropWhile-Sublist (y ∷ʳ rs) = y ∷ʳ dropWhile-Sublist rs + dropWhile-Sublist {a as} (r rs) with does (P? a) + ... | true = _ ∷ʳ dropWhile-Sublist rs + ... | false = r rs + + filter-Sublist : Sublist R as bs Sublist R (filter P? as) bs + filter-Sublist [] = [] + filter-Sublist (y ∷ʳ rs) = y ∷ʳ filter-Sublist rs + filter-Sublist {a as} (r rs) with does (P? a) + ... | true = r filter-Sublist rs + ... | false = _ ∷ʳ filter-Sublist rs + +------------------------------------------------------------------------ +-- Various functions are increasing wrt _⊆_ + +-- We write f⁺ for the proof that `xs ⊆ ys → f xs ⊆ f ys` +-- and f⁻ for the one that `f xs ⊆ f ys → xs ⊆ ys`. + +module _ {R : REL A B r} where + +------------------------------------------------------------------------ +-- _∷_ + + ∷ˡ⁻ : Sublist R (x xs) ys Sublist R xs ys + ∷ˡ⁻ (y ∷ʳ rs) = y ∷ʳ ∷ˡ⁻ rs + ∷ˡ⁻ (r rs) = _ ∷ʳ rs + + ∷ʳ⁻ : ¬ R x y Sublist R (x xs) (y ys) + Sublist R (x xs) ys + ∷ʳ⁻ ¬r (y ∷ʳ rs) = rs + ∷ʳ⁻ ¬r (r rs) = contradiction r ¬r + + ∷⁻ : Sublist R (x xs) (y ys) Sublist R xs ys + ∷⁻ (y ∷ʳ rs) = ∷ˡ⁻ rs + ∷⁻ (x rs) = rs + +module _ {R : REL C D r} where + +------------------------------------------------------------------------ +-- map + + map⁺ : (f : A C) (g : B D) + Sublist a b R (f a) (g b)) as bs + Sublist R (List.map f as) (List.map g bs) + map⁺ f g [] = [] + map⁺ f g (y ∷ʳ rs) = g y ∷ʳ map⁺ f g rs + map⁺ f g (r rs) = r map⁺ f g rs + + map⁻ : (f : A C) (g : B D) + Sublist R (List.map f as) (List.map g bs) + Sublist a b R (f a) (g b)) as bs + map⁻ {as = []} {bs} f g rs = minimum _ + map⁻ {as = a as} {b bs} f g (_ ∷ʳ rs) = b ∷ʳ map⁻ f g rs + map⁻ {as = a as} {b bs} f g (r rs) = r map⁻ f g rs + + +module _ {R : REL A B r} where + +------------------------------------------------------------------------ +-- _++_ + + ++⁺ : Sublist R as bs Sublist R cs ds + Sublist R (as ++ cs) (bs ++ ds) + ++⁺ [] cds = cds + ++⁺ (y ∷ʳ abs) cds = y ∷ʳ ++⁺ abs cds + ++⁺ (ab abs) cds = ab ++⁺ abs cds + + ++⁻ : length as length bs + Sublist R (as ++ cs) (bs ++ ds) Sublist R cs ds + ++⁻ {as = []} {[]} eq rs = rs + ++⁻ {as = a as} {b bs} eq rs = ++⁻ (ℕ.suc-injective eq) (∷⁻ rs) + + ++ˡ : (cs : List B) Sublist R as bs Sublist R as (cs ++ bs) + ++ˡ zs = ++⁺ (minimum zs) + + ++ʳ : (cs : List B) Sublist R as bs Sublist R as (bs ++ cs) + ++ʳ cs [] = minimum cs + ++ʳ cs (y ∷ʳ rs) = y ∷ʳ ++ʳ cs rs + ++ʳ cs (r rs) = r ++ʳ cs rs + + +------------------------------------------------------------------------ +-- concat + + concat⁺ : Sublist (Sublist R) ass bss + Sublist R (concat ass) (concat bss) + concat⁺ [] = [] + concat⁺ (y ∷ʳ rss) = ++ˡ y (concat⁺ rss) + concat⁺ (rs rss) = ++⁺ rs (concat⁺ rss) + +------------------------------------------------------------------------ +-- take / drop + + take⁺ : m n Pointwise R as bs + Sublist R (take m as) (take n bs) + take⁺ z≤n ps = minimum _ + take⁺ (s≤s m≤n) [] = [] + take⁺ (s≤s m≤n) (p ps) = p take⁺ m≤n ps + + drop⁺ : m n Sublist R as bs + Sublist R (drop m as) (drop n bs) + drop⁺ (z≤n {m}) rs = drop-Sublist m rs + drop⁺ (s≤s m≥n) [] = [] + drop⁺ (s≤s m≥n) (y ∷ʳ rs) = drop⁺ (ℕ.m≤n⇒m≤1+n m≥n) rs + drop⁺ (s≤s m≥n) (r rs) = drop⁺ m≥n rs + + drop⁺-≥ : m n Pointwise R as bs + Sublist R (drop m as) (drop n bs) + drop⁺-≥ m≥n pw = drop⁺ m≥n (fromPointwise pw) + + drop⁺-⊆ : m Sublist R as bs + Sublist R (drop m as) (drop m bs) + drop⁺-⊆ m = drop⁺ (ℕ.≤-refl {m}) + +module _ {R : REL A B r} {P : Pred A p} {Q : Pred B q} + (P? : U.Decidable P) (Q? : U.Decidable Q) where + + ⊆-takeWhile-Sublist : (∀ {a b} R a b P a Q b) + Pointwise R as bs + Sublist R (takeWhile P? as) (takeWhile Q? bs) + ⊆-takeWhile-Sublist rp⇒q [] = [] + ⊆-takeWhile-Sublist {a as} {b bs} rp⇒q (p ps) with P? a | Q? b + ... | false because _ | _ = minimum _ + ... | true because _ | true because _ = p ⊆-takeWhile-Sublist rp⇒q ps + ... | yes pa | no ¬qb = contradiction (rp⇒q p pa) ¬qb + + ⊇-dropWhile-Sublist : (∀ {a b} R a b Q b P a) + Pointwise R as bs + Sublist R (dropWhile P? as) (dropWhile Q? bs) + ⊇-dropWhile-Sublist rq⇒p [] = [] + ⊇-dropWhile-Sublist {a as} {b bs} rq⇒p (p ps) with P? a | Q? b + ... | true because _ | true because _ = ⊇-dropWhile-Sublist rq⇒p ps + ... | true because _ | false because _ = + b ∷ʳ dropWhile-Sublist P? (fromPointwise ps) + ... | false because _ | false because _ = p fromPointwise ps + ... | no ¬pa | yes qb = contradiction (rq⇒p p qb) ¬pa + + ⊆-filter-Sublist : (∀ {a b} R a b P a Q b) + Sublist R as bs Sublist R (filter P? as) (filter Q? bs) + ⊆-filter-Sublist rp⇒q [] = [] + ⊆-filter-Sublist rp⇒q (y ∷ʳ rs) with does (Q? y) + ... | true = y ∷ʳ ⊆-filter-Sublist rp⇒q rs + ... | false = ⊆-filter-Sublist rp⇒q rs + ⊆-filter-Sublist {a as} {b bs} rp⇒q (r rs) with P? a | Q? b + ... | true because _ | true because _ = r ⊆-filter-Sublist rp⇒q rs + ... | false because _ | true because _ = _ ∷ʳ ⊆-filter-Sublist rp⇒q rs + ... | false because _ | false because _ = ⊆-filter-Sublist rp⇒q rs + ... | yes pa | no ¬qb = contradiction (rp⇒q r pa) ¬qb + +module _ {R : Rel A r} {P : Pred A p} (P? : U.Decidable P) where + + takeWhile-filter : Pointwise R as as + Sublist R (takeWhile P? as) (filter P? as) + takeWhile-filter [] = [] + takeWhile-filter {a as} (p ps) with does (P? a) + ... | true = p takeWhile-filter ps + ... | false = minimum _ + + filter-dropWhile : Pointwise R as as + Sublist R (filter P? as) (dropWhile (¬? P?) as) + filter-dropWhile [] = [] + filter-dropWhile {a as} (p ps) with does (P? a) + ... | true = p filter-Sublist P? (fromPointwise ps) + ... | false = filter-dropWhile ps + +------------------------------------------------------------------------ +-- reverse + +module _ {R : REL A B r} where + + reverseAcc⁺ : Sublist R as bs Sublist R cs ds + Sublist R (reverseAcc cs as) (reverseAcc ds bs) + reverseAcc⁺ [] cds = cds + reverseAcc⁺ (y ∷ʳ abs) cds = reverseAcc⁺ abs (y ∷ʳ cds) + reverseAcc⁺ (r abs) cds = reverseAcc⁺ abs (r cds) + + ʳ++⁺ : Sublist R as bs Sublist R cs ds + Sublist R (as ʳ++ cs) (bs ʳ++ ds) + ʳ++⁺ = reverseAcc⁺ + + reverse⁺ : Sublist R as bs Sublist R (reverse as) (reverse bs) + reverse⁺ rs = reverseAcc⁺ rs [] + + reverse⁻ : Sublist R (reverse as) (reverse bs) Sublist R as bs + reverse⁻ {as = as} {bs = bs} p = cast (reverse⁺ p) where + cast = ≡.subst₂ (Sublist R) (List.reverse-involutive as) (List.reverse-involutive bs) + +------------------------------------------------------------------------ +-- Inversion lemmas + +module _ {R : REL A B r} where + + ∷⁻¹ : R x y Sublist R xs ys Sublist R (x xs) (y ys) + ∷⁻¹ r = mk⇔ (r ∷_) ∷⁻ + + ∷ʳ⁻¹ : ¬ R x y Sublist R (x xs) ys Sublist R (x xs) (y ys) + ∷ʳ⁻¹ ¬r = mk⇔ (_ ∷ʳ_) (∷ʳ⁻ ¬r) + +------------------------------------------------------------------------ +-- Empty special case + +module _ {R : REL A B r} where + + Sublist-[]-universal : U.Universal (Sublist R []) + Sublist-[]-universal [] = [] + Sublist-[]-universal (_ _) = _ ∷ʳ Sublist-[]-universal _ + + Sublist-[]-irrelevant : U.Irrelevant (Sublist R []) + Sublist-[]-irrelevant [] [] = ≡.refl + Sublist-[]-irrelevant (y ∷ʳ p) (.y ∷ʳ q) = ≡.cong (y ∷ʳ_) (Sublist-[]-irrelevant p q) + +------------------------------------------------------------------------ +-- (to/from)Any is a bijection + + toAny-injective :{p q : Sublist R [ x ] xs} toAny p toAny q p q + toAny-injective {p = y ∷ʳ p} {y ∷ʳ q} = + ≡.cong (y ∷ʳ_) ∘′ toAny-injective ∘′ there-injective + toAny-injective {p = _ p} {_ q} = + ≡.cong₂ (flip _∷_) (Sublist-[]-irrelevant p q) ∘′ here-injective + + fromAny-injective : {p q : Any (R x) xs} + fromAny {R = R} p fromAny q p q + fromAny-injective {p = here px} {here qx} = ≡.cong here ∘′ ∷-injectiveˡ + fromAny-injective {p = there p} {there q} = + ≡.cong there ∘′ fromAny-injective ∘′ ∷ʳ-injective + + toAny∘fromAny≗id : (p : Any (R x) xs) toAny (fromAny {R = R} p) p + toAny∘fromAny≗id (here px) = ≡.refl + toAny∘fromAny≗id (there p) = ≡.cong there (toAny∘fromAny≗id p) + + Sublist-[x]-bijection : (Sublist R [ x ] xs) (Any (R x) xs) + Sublist-[x]-bijection = mk⤖ (toAny-injective , strictlySurjective⇒surjective < fromAny , toAny∘fromAny≗id >) + +------------------------------------------------------------------------ +-- Relational properties + +module Reflexivity + {R : Rel A r} + (R-refl : Reflexive R) where + + reflexive : _≡_ Sublist R + reflexive ≡.refl = fromPointwise (Pw.refl R-refl) + + refl : Reflexive (Sublist R) + refl = reflexive ≡.refl + +open Reflexivity public + +module Transitivity + {R : REL A B r} {S : REL B C s} {T : REL A C t} + (rs⇒t : Trans R S T) where + + trans : Trans (Sublist R) (Sublist S) (Sublist T) + trans rs (y ∷ʳ ss) = y ∷ʳ trans rs ss + trans (y ∷ʳ rs) (s ss) = _ ∷ʳ trans rs ss + trans (r rs) (s ss) = rs⇒t r s trans rs ss + trans [] [] = [] + +open Transitivity public + +module Antisymmetry + {R : REL A B r} {S : REL B A s} {E : REL A B e} + (rs⇒e : Antisym R S E) where -private - variable - a b c d e p q r s t : Level - A : Set a - B : Set b - C : Set c - D : Set d - x : A - y : B - as cs xs : List A - bs ds ys : List B - ass : List (List A) - bss : List (List B) - m n : - ------------------------------------------------------------------------- --- Injectivity of constructors - -module _ {R : REL A B r} where - - ∷-injectiveˡ : {px qx : R x y} {pxs qxs : Sublist R xs ys} - (Sublist R (x xs) (y ys) px pxs) (qx qxs) px qx - ∷-injectiveˡ ≡.refl = ≡.refl - - ∷-injectiveʳ : {px qx : R x y} {pxs qxs : Sublist R xs ys} - (Sublist R (x xs) (y ys) px pxs) (qx qxs) pxs qxs - ∷-injectiveʳ ≡.refl = ≡.refl - - ∷ʳ-injective : {pxs qxs : Sublist R xs ys} - (Sublist R xs (y ys) y ∷ʳ pxs) (y ∷ʳ qxs) pxs qxs - ∷ʳ-injective ≡.refl = ≡.refl - -module _ {R : REL A B r} where - - length-mono-≤ : Sublist R as bs length as length bs - length-mono-≤ [] = z≤n - length-mono-≤ (y ∷ʳ rs) = ℕ.m≤n⇒m≤1+n (length-mono-≤ rs) - length-mono-≤ (r rs) = s≤s (length-mono-≤ rs) - ------------------------------------------------------------------------- --- Conversion to and from Pointwise (proto-reflexivity) - - fromPointwise : Pointwise R Sublist R - fromPointwise [] = [] - fromPointwise (p ps) = p fromPointwise ps - - toPointwise : length as length bs - Sublist R as bs Pointwise R as bs - toPointwise {bs = []} eq [] = [] - toPointwise {bs = b bs} eq (r rs) = r toPointwise (ℕ.suc-injective eq) rs - toPointwise {bs = b bs} eq (b ∷ʳ rs) = - contradiction (s≤s (length-mono-≤ rs)) (ℕ.<-irrefl eq) - ------------------------------------------------------------------------- --- Various functions' outputs are sublists - --- These lemmas are generalisations of results of the form `f xs ⊆ xs`. --- (where _⊆_ stands for Sublist R). If R is reflexive then we can --- indeed obtain `f xs ⊆ xs` from `xs ⊆ ys → f xs ⊆ ys`. The other --- direction is only true if R is both reflexive and transitive. - -module _ {R : REL A B r} where - - tail-Sublist : Sublist R as bs - Maybe.All as Sublist R as bs) (tail as) - tail-Sublist [] = nothing - tail-Sublist (b ∷ʳ ps) = Maybe.map (b ∷ʳ_) (tail-Sublist ps) - tail-Sublist (p ps) = just (_ ∷ʳ ps) - - take-Sublist : n Sublist R as bs Sublist R (take n as) bs - take-Sublist n (y ∷ʳ rs) = y ∷ʳ take-Sublist n rs - take-Sublist zero rs = minimum _ - take-Sublist (suc n) [] = [] - take-Sublist (suc n) (r rs) = r take-Sublist n rs - - drop-Sublist : n Sublist R (Sublist R ∘′ drop n) - drop-Sublist n (y ∷ʳ rs) = y ∷ʳ drop-Sublist n rs - drop-Sublist zero rs = rs - drop-Sublist (suc n) [] = [] - drop-Sublist (suc n) (r rs) = _ ∷ʳ drop-Sublist n rs - -module _ {R : REL A B r} {P : Pred A p} (P? : U.Decidable P) where - - takeWhile-Sublist : Sublist R as bs Sublist R (takeWhile P? as) bs - takeWhile-Sublist [] = [] - takeWhile-Sublist (y ∷ʳ rs) = y ∷ʳ takeWhile-Sublist rs - takeWhile-Sublist {a as} (r rs) with does (P? a) - ... | true = r takeWhile-Sublist rs - ... | false = minimum _ - - dropWhile-Sublist : Sublist R as bs Sublist R (dropWhile P? as) bs - dropWhile-Sublist [] = [] - dropWhile-Sublist (y ∷ʳ rs) = y ∷ʳ dropWhile-Sublist rs - dropWhile-Sublist {a as} (r rs) with does (P? a) - ... | true = _ ∷ʳ dropWhile-Sublist rs - ... | false = r rs - - filter-Sublist : Sublist R as bs Sublist R (filter P? as) bs - filter-Sublist [] = [] - filter-Sublist (y ∷ʳ rs) = y ∷ʳ filter-Sublist rs - filter-Sublist {a as} (r rs) with does (P? a) - ... | true = r filter-Sublist rs - ... | false = _ ∷ʳ filter-Sublist rs - ------------------------------------------------------------------------- --- Various functions are increasing wrt _⊆_ - --- We write f⁺ for the proof that `xs ⊆ ys → f xs ⊆ f ys` --- and f⁻ for the one that `f xs ⊆ f ys → xs ⊆ ys`. - -module _ {R : REL A B r} where - ------------------------------------------------------------------------- --- _∷_ - - ∷ˡ⁻ : Sublist R (x xs) ys Sublist R xs ys - ∷ˡ⁻ (y ∷ʳ rs) = y ∷ʳ ∷ˡ⁻ rs - ∷ˡ⁻ (r rs) = _ ∷ʳ rs - - ∷ʳ⁻ : ¬ R x y Sublist R (x xs) (y ys) - Sublist R (x xs) ys - ∷ʳ⁻ ¬r (y ∷ʳ rs) = rs - ∷ʳ⁻ ¬r (r rs) = contradiction r ¬r - - ∷⁻ : Sublist R (x xs) (y ys) Sublist R xs ys - ∷⁻ (y ∷ʳ rs) = ∷ˡ⁻ rs - ∷⁻ (x rs) = rs - -module _ {R : REL C D r} where - ------------------------------------------------------------------------- --- map - - map⁺ : (f : A C) (g : B D) - Sublist a b R (f a) (g b)) as bs - Sublist R (List.map f as) (List.map g bs) - map⁺ f g [] = [] - map⁺ f g (y ∷ʳ rs) = g y ∷ʳ map⁺ f g rs - map⁺ f g (r rs) = r map⁺ f g rs - - map⁻ : (f : A C) (g : B D) - Sublist R (List.map f as) (List.map g bs) - Sublist a b R (f a) (g b)) as bs - map⁻ {as = []} {bs} f g rs = minimum _ - map⁻ {as = a as} {b bs} f g (_ ∷ʳ rs) = b ∷ʳ map⁻ f g rs - map⁻ {as = a as} {b bs} f g (r rs) = r map⁻ f g rs - - -module _ {R : REL A B r} where - ------------------------------------------------------------------------- --- _++_ - - ++⁺ : Sublist R as bs Sublist R cs ds - Sublist R (as ++ cs) (bs ++ ds) - ++⁺ [] cds = cds - ++⁺ (y ∷ʳ abs) cds = y ∷ʳ ++⁺ abs cds - ++⁺ (ab abs) cds = ab ++⁺ abs cds - - ++⁻ : length as length bs - Sublist R (as ++ cs) (bs ++ ds) Sublist R cs ds - ++⁻ {as = []} {[]} eq rs = rs - ++⁻ {as = a as} {b bs} eq rs = ++⁻ (ℕ.suc-injective eq) (∷⁻ rs) - - ++ˡ : (cs : List B) Sublist R as bs Sublist R as (cs ++ bs) - ++ˡ zs = ++⁺ (minimum zs) - - ++ʳ : (cs : List B) Sublist R as bs Sublist R as (bs ++ cs) - ++ʳ cs [] = minimum cs - ++ʳ cs (y ∷ʳ rs) = y ∷ʳ ++ʳ cs rs - ++ʳ cs (r rs) = r ++ʳ cs rs - - ------------------------------------------------------------------------- --- concat - - concat⁺ : Sublist (Sublist R) ass bss - Sublist R (concat ass) (concat bss) - concat⁺ [] = [] - concat⁺ (y ∷ʳ rss) = ++ˡ y (concat⁺ rss) - concat⁺ (rs rss) = ++⁺ rs (concat⁺ rss) - ------------------------------------------------------------------------- --- take / drop - - take⁺ : m n Pointwise R as bs - Sublist R (take m as) (take n bs) - take⁺ z≤n ps = minimum _ - take⁺ (s≤s m≤n) [] = [] - take⁺ (s≤s m≤n) (p ps) = p take⁺ m≤n ps - - drop⁺ : m n Sublist R as bs - Sublist R (drop m as) (drop n bs) - drop⁺ (z≤n {m}) rs = drop-Sublist m rs - drop⁺ (s≤s m≥n) [] = [] - drop⁺ (s≤s m≥n) (y ∷ʳ rs) = drop⁺ (ℕ.m≤n⇒m≤1+n m≥n) rs - drop⁺ (s≤s m≥n) (r rs) = drop⁺ m≥n rs - - drop⁺-≥ : m n Pointwise R as bs - Sublist R (drop m as) (drop n bs) - drop⁺-≥ m≥n pw = drop⁺ m≥n (fromPointwise pw) - - drop⁺-⊆ : m Sublist R as bs - Sublist R (drop m as) (drop m bs) - drop⁺-⊆ m = drop⁺ (ℕ.≤-refl {m}) - -module _ {R : REL A B r} {P : Pred A p} {Q : Pred B q} - (P? : U.Decidable P) (Q? : U.Decidable Q) where - - ⊆-takeWhile-Sublist : (∀ {a b} R a b P a Q b) - Pointwise R as bs - Sublist R (takeWhile P? as) (takeWhile Q? bs) - ⊆-takeWhile-Sublist rp⇒q [] = [] - ⊆-takeWhile-Sublist {a as} {b bs} rp⇒q (p ps) with P? a | Q? b - ... | false because _ | _ = minimum _ - ... | true because _ | true because _ = p ⊆-takeWhile-Sublist rp⇒q ps - ... | yes pa | no ¬qb = contradiction (rp⇒q p pa) ¬qb - - ⊇-dropWhile-Sublist : (∀ {a b} R a b Q b P a) - Pointwise R as bs - Sublist R (dropWhile P? as) (dropWhile Q? bs) - ⊇-dropWhile-Sublist rq⇒p [] = [] - ⊇-dropWhile-Sublist {a as} {b bs} rq⇒p (p ps) with P? a | Q? b - ... | true because _ | true because _ = ⊇-dropWhile-Sublist rq⇒p ps - ... | true because _ | false because _ = - b ∷ʳ dropWhile-Sublist P? (fromPointwise ps) - ... | false because _ | false because _ = p fromPointwise ps - ... | no ¬pa | yes qb = contradiction (rq⇒p p qb) ¬pa - - ⊆-filter-Sublist : (∀ {a b} R a b P a Q b) - Sublist R as bs Sublist R (filter P? as) (filter Q? bs) - ⊆-filter-Sublist rp⇒q [] = [] - ⊆-filter-Sublist rp⇒q (y ∷ʳ rs) with does (Q? y) - ... | true = y ∷ʳ ⊆-filter-Sublist rp⇒q rs - ... | false = ⊆-filter-Sublist rp⇒q rs - ⊆-filter-Sublist {a as} {b bs} rp⇒q (r rs) with P? a | Q? b - ... | true because _ | true because _ = r ⊆-filter-Sublist rp⇒q rs - ... | false because _ | true because _ = _ ∷ʳ ⊆-filter-Sublist rp⇒q rs - ... | false because _ | false because _ = ⊆-filter-Sublist rp⇒q rs - ... | yes pa | no ¬qb = contradiction (rp⇒q r pa) ¬qb - -module _ {R : Rel A r} {P : Pred A p} (P? : U.Decidable P) where - - takeWhile-filter : Pointwise R as as - Sublist R (takeWhile P? as) (filter P? as) - takeWhile-filter [] = [] - takeWhile-filter {a as} (p ps) with does (P? a) - ... | true = p takeWhile-filter ps - ... | false = minimum _ - - filter-dropWhile : Pointwise R as as - Sublist R (filter P? as) (dropWhile (¬? P?) as) - filter-dropWhile [] = [] - filter-dropWhile {a as} (p ps) with does (P? a) - ... | true = p filter-Sublist P? (fromPointwise ps) - ... | false = filter-dropWhile ps - ------------------------------------------------------------------------- --- reverse - -module _ {R : REL A B r} where - - reverseAcc⁺ : Sublist R as bs Sublist R cs ds - Sublist R (reverseAcc cs as) (reverseAcc ds bs) - reverseAcc⁺ [] cds = cds - reverseAcc⁺ (y ∷ʳ abs) cds = reverseAcc⁺ abs (y ∷ʳ cds) - reverseAcc⁺ (r abs) cds = reverseAcc⁺ abs (r cds) - - ʳ++⁺ : Sublist R as bs Sublist R cs ds - Sublist R (as ʳ++ cs) (bs ʳ++ ds) - ʳ++⁺ = reverseAcc⁺ - - reverse⁺ : Sublist R as bs Sublist R (reverse as) (reverse bs) - reverse⁺ rs = reverseAcc⁺ rs [] - - reverse⁻ : Sublist R (reverse as) (reverse bs) Sublist R as bs - reverse⁻ {as = as} {bs = bs} p = cast (reverse⁺ p) where - cast = ≡.subst₂ (Sublist R) (List.reverse-involutive as) (List.reverse-involutive bs) - ------------------------------------------------------------------------- --- Inversion lemmas - -module _ {R : REL A B r} where - - ∷⁻¹ : R x y Sublist R xs ys Sublist R (x xs) (y ys) - ∷⁻¹ r = mk⇔ (r ∷_) ∷⁻ - - ∷ʳ⁻¹ : ¬ R x y Sublist R (x xs) ys Sublist R (x xs) (y ys) - ∷ʳ⁻¹ ¬r = mk⇔ (_ ∷ʳ_) (∷ʳ⁻ ¬r) - ------------------------------------------------------------------------- --- Empty special case - -module _ {R : REL A B r} where - - Sublist-[]-universal : U.Universal (Sublist R []) - Sublist-[]-universal [] = [] - Sublist-[]-universal (_ _) = _ ∷ʳ Sublist-[]-universal _ - - Sublist-[]-irrelevant : U.Irrelevant (Sublist R []) - Sublist-[]-irrelevant [] [] = ≡.refl - Sublist-[]-irrelevant (y ∷ʳ p) (.y ∷ʳ q) = ≡.cong (y ∷ʳ_) (Sublist-[]-irrelevant p q) - ------------------------------------------------------------------------- --- (to/from)Any is a bijection - - toAny-injective :{p q : Sublist R [ x ] xs} toAny p toAny q p q - toAny-injective {p = y ∷ʳ p} {y ∷ʳ q} = - ≡.cong (y ∷ʳ_) ∘′ toAny-injective ∘′ there-injective - toAny-injective {p = _ p} {_ q} = - ≡.cong₂ (flip _∷_) (Sublist-[]-irrelevant p q) ∘′ here-injective - - fromAny-injective : {p q : Any (R x) xs} - fromAny {R = R} p fromAny q p q - fromAny-injective {p = here px} {here qx} = ≡.cong here ∘′ ∷-injectiveˡ - fromAny-injective {p = there p} {there q} = - ≡.cong there ∘′ fromAny-injective ∘′ ∷ʳ-injective - - toAny∘fromAny≗id : (p : Any (R x) xs) toAny (fromAny {R = R} p) p - toAny∘fromAny≗id (here px) = ≡.refl - toAny∘fromAny≗id (there p) = ≡.cong there (toAny∘fromAny≗id p) - - Sublist-[x]-bijection : (Sublist R [ x ] xs) (Any (R x) xs) - Sublist-[x]-bijection = mk⤖ (toAny-injective , strictlySurjective⇒surjective < fromAny , toAny∘fromAny≗id >) - ------------------------------------------------------------------------- --- Relational properties - -module Reflexivity - {R : Rel A r} - (R-refl : Reflexive R) where - - reflexive : _≡_ Sublist R - reflexive ≡.refl = fromPointwise (Pw.refl R-refl) - - refl : Reflexive (Sublist R) - refl = reflexive ≡.refl - -open Reflexivity public - -module Transitivity - {R : REL A B r} {S : REL B C s} {T : REL A C t} - (rs⇒t : Trans R S T) where - - trans : Trans (Sublist R) (Sublist S) (Sublist T) - trans rs (y ∷ʳ ss) = y ∷ʳ trans rs ss - trans (y ∷ʳ rs) (s ss) = _ ∷ʳ trans rs ss - trans (r rs) (s ss) = rs⇒t r s trans rs ss - trans [] [] = [] - -open Transitivity public - -module Antisymmetry - {R : REL A B r} {S : REL B A s} {E : REL A B e} - (rs⇒e : Antisym R S E) where - - open ℕ.≤-Reasoning - - antisym : Antisym (Sublist R) (Sublist S) (Pointwise E) - antisym [] [] = [] - antisym (r rs) (s ss) = rs⇒e r s antisym rs ss - -- impossible cases - antisym (_∷ʳ_ {xs} {ys₁} y rs) (_∷ʳ_ {ys₂} {zs} z ss) = - contradiction (begin - length (y ys₁) ≤⟨ length-mono-≤ ss - length zs ≤⟨ ℕ.n≤1+n (length zs) - length (z zs) ≤⟨ length-mono-≤ rs - length ys₁ ) $ ℕ.<-irrefl ≡.refl - antisym (_∷ʳ_ {xs} {ys₁} y rs) (_∷_ {y} {ys₂} {z} {zs} s ss) = - contradiction (begin - length (z zs) ≤⟨ length-mono-≤ rs - length ys₁ ≤⟨ length-mono-≤ ss - length zs ) $ ℕ.<-irrefl ≡.refl - antisym (_∷_ {x} {xs} {y} {ys₁} r rs) (_∷ʳ_ {ys₂} {zs} z ss) = - contradiction (begin - length (y ys₁) ≤⟨ length-mono-≤ ss - length xs ≤⟨ length-mono-≤ rs - length ys₁ ) $ ℕ.<-irrefl ≡.refl - -open Antisymmetry public - -module _ {R : REL A B r} (R? : Decidable R) where - - sublist? : Decidable (Sublist R) - sublist? [] ys = yes (minimum ys) - sublist? (x xs) [] = no λ () - sublist? (x xs) (y ys) with R? x y - ... | true because [r] = - Dec.map (∷⁻¹ (invert [r])) (sublist? xs ys) - ... | false because [¬r] = - Dec.map (∷ʳ⁻¹ (invert [¬r])) (sublist? (x xs) ys) - -module _ {E : Rel A e} {R : Rel A r} where - - isPreorder : IsPreorder E R IsPreorder (Pointwise E) (Sublist R) - isPreorder ER-isPreorder = record - { isEquivalence = Pw.isEquivalence ER.isEquivalence - ; reflexive = fromPointwise Pw.map ER.reflexive - ; trans = trans ER.trans - } where module ER = IsPreorder ER-isPreorder - - isPartialOrder : IsPartialOrder E R IsPartialOrder (Pointwise E) (Sublist R) - isPartialOrder ER-isPartialOrder = record - { isPreorder = isPreorder ER.isPreorder - ; antisym = antisym ER.antisym - } where module ER = IsPartialOrder ER-isPartialOrder - - isDecPartialOrder : IsDecPartialOrder E R - IsDecPartialOrder (Pointwise E) (Sublist R) - isDecPartialOrder ER-isDecPartialOrder = record - { isPartialOrder = isPartialOrder ER.isPartialOrder - ; _≟_ = Pw.decidable ER._≟_ - ; _≤?_ = sublist? ER._≤?_ - } where module ER = IsDecPartialOrder ER-isDecPartialOrder - -preorder : Preorder a e r Preorder _ _ _ -preorder ER-preorder = record - { isPreorder = isPreorder ER.isPreorder - } where module ER = Preorder ER-preorder - -poset : Poset a e r Poset _ _ _ -poset ER-poset = record - { isPartialOrder = isPartialOrder ER.isPartialOrder - } where module ER = Poset ER-poset - -decPoset : DecPoset a e r DecPoset _ _ _ -decPoset ER-poset = record - { isDecPartialOrder = isDecPartialOrder ER.isDecPartialOrder - } where module ER = DecPoset ER-poset - ------------------------------------------------------------------------- --- Properties of disjoint sublists - -module Disjointness {a b r} {A : Set a} {B : Set b} {R : REL A B r} where - - private - infix 4 _⊆_ - _⊆_ = Sublist R - - -- Forgetting the union - - DisjointUnion→Disjoint : {xs ys zs us} {τ₁ : xs zs} {τ₂ : ys zs} {τ : us zs} - DisjointUnion τ₁ τ₂ τ Disjoint τ₁ τ₂ - DisjointUnion→Disjoint [] = [] - DisjointUnion→Disjoint (y ∷ₙ u) = y ∷ₙ DisjointUnion→Disjoint u - DisjointUnion→Disjoint (x≈y ∷ₗ u) = x≈y ∷ₗ DisjointUnion→Disjoint u - DisjointUnion→Disjoint (x≈y ∷ᵣ u) = x≈y ∷ᵣ DisjointUnion→Disjoint u - - -- Reconstructing the union - - Disjoint→DisjointUnion : {xs ys zs} {τ₁ : xs zs} {τ₂ : ys zs} - Disjoint τ₁ τ₂ ∃₂ λ us (τ : us zs) DisjointUnion τ₁ τ₂ τ - Disjoint→DisjointUnion [] = _ , _ , [] - Disjoint→DisjointUnion (y ∷ₙ u) = _ , _ , y ∷ₙ proj₂ (proj₂ (Disjoint→DisjointUnion u)) - Disjoint→DisjointUnion (x≈y ∷ₗ u) = _ , _ , x≈y ∷ₗ proj₂ (proj₂ (Disjoint→DisjointUnion u)) - Disjoint→DisjointUnion (x≈y ∷ᵣ u) = _ , _ , x≈y ∷ᵣ proj₂ (proj₂ (Disjoint→DisjointUnion u)) - - -- Disjoint is decidable - - ⊆-disjoint? : {xs ys zs} (τ₁ : xs zs) (τ₂ : ys zs) Dec (Disjoint τ₁ τ₂) - ⊆-disjoint? [] [] = yes [] - -- Present in both sublists: not disjoint. - ⊆-disjoint? (x≈z τ₁) (y≈z τ₂) = no λ() - -- Present in either sublist: ok. - ⊆-disjoint? (y ∷ʳ τ₁) (x≈y τ₂) = - Dec.map′ (x≈y ∷ᵣ_) (λ{ (_ ∷ᵣ d) d }) (⊆-disjoint? τ₁ τ₂) - ⊆-disjoint? (x≈y τ₁) (y ∷ʳ τ₂) = - Dec.map′ (x≈y ∷ₗ_) (λ{ (_ ∷ₗ d) d }) (⊆-disjoint? τ₁ τ₂) - -- Present in neither sublist: ok. - ⊆-disjoint? (y ∷ʳ τ₁) (.y ∷ʳ τ₂) = - Dec.map′ (y ∷ₙ_) (λ{ (_ ∷ₙ d) d }) (⊆-disjoint? τ₁ τ₂) - - -- Disjoint is proof-irrelevant - - Disjoint-irrelevant : ∀{xs ys zs} Irrelevant (Disjoint {R = R} {xs} {ys} {zs}) - Disjoint-irrelevant [] [] = ≡.refl - Disjoint-irrelevant (y ∷ₙ d₁) (.y ∷ₙ d₂) = ≡.cong (y ∷ₙ_) (Disjoint-irrelevant d₁ d₂) - Disjoint-irrelevant (x≈y ∷ₗ d₁) (.x≈y ∷ₗ d₂) = ≡.cong (x≈y ∷ₗ_) (Disjoint-irrelevant d₁ d₂) - Disjoint-irrelevant (x≈y ∷ᵣ d₁) (.x≈y ∷ᵣ d₂) = ≡.cong (x≈y ∷ᵣ_) (Disjoint-irrelevant d₁ d₂) - - -- Note: DisjointUnion is not proof-irrelevant unless the underlying relation R is. - -- The proof is not entirely trivial, thus, we leave it for future work: - -- - -- DisjointUnion-irrelevant : Irrelevant R → - -- ∀{xs ys us zs} {τ : us ⊆ zs} → - -- Irrelevant (λ (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) → DisjointUnion τ₁ τ₂ τ) - - -- Irreflexivity - - Disjoint-irrefl′ : ∀{xs ys} {τ : xs ys} Disjoint τ τ Null xs - Disjoint-irrefl′ [] = [] - Disjoint-irrefl′ (y ∷ₙ d) = Disjoint-irrefl′ d - - Disjoint-irrefl : ∀{x xs ys} Irreflexive {A = x xs ys } _≡_ Disjoint - Disjoint-irrefl ≡.refl x with Disjoint-irrefl′ x - ... | () _ - - -- Symmetry - - DisjointUnion-sym : {xs ys xys} {zs} {τ₁ : xs zs} {τ₂ : ys zs} {τ : xys zs} - DisjointUnion τ₁ τ₂ τ DisjointUnion τ₂ τ₁ τ - DisjointUnion-sym [] = [] - DisjointUnion-sym (y ∷ₙ d) = y ∷ₙ DisjointUnion-sym d - DisjointUnion-sym (x≈y ∷ₗ d) = x≈y ∷ᵣ DisjointUnion-sym d - DisjointUnion-sym (x≈y ∷ᵣ d) = x≈y ∷ₗ DisjointUnion-sym d - - Disjoint-sym : {xs ys} {zs} {τ₁ : xs zs} {τ₂ : ys zs} - Disjoint τ₁ τ₂ Disjoint τ₂ τ₁ - Disjoint-sym [] = [] - Disjoint-sym (y ∷ₙ d) = y ∷ₙ Disjoint-sym d - Disjoint-sym (x≈y ∷ₗ d) = x≈y ∷ᵣ Disjoint-sym d - Disjoint-sym (x≈y ∷ᵣ d) = x≈y ∷ₗ Disjoint-sym d - - -- Empty sublist - - DisjointUnion-[]ˡ : ∀{xs ys} {ε : [] ys} {τ : xs ys} DisjointUnion ε τ τ - DisjointUnion-[]ˡ {ε = []} {τ = []} = [] - DisjointUnion-[]ˡ {ε = y ∷ʳ ε} {τ = y ∷ʳ τ} = y ∷ₙ DisjointUnion-[]ˡ - DisjointUnion-[]ˡ {ε = y ∷ʳ ε} {τ = x≈y τ} = x≈y ∷ᵣ DisjointUnion-[]ˡ - - DisjointUnion-[]ʳ : ∀{xs ys} {ε : [] ys} {τ : xs ys} DisjointUnion τ ε τ - DisjointUnion-[]ʳ {ε = []} {τ = []} = [] - DisjointUnion-[]ʳ {ε = y ∷ʳ ε} {τ = y ∷ʳ τ} = y ∷ₙ DisjointUnion-[]ʳ - DisjointUnion-[]ʳ {ε = y ∷ʳ ε} {τ = x≈y τ} = x≈y ∷ₗ DisjointUnion-[]ʳ - - -- A sublist τ : x∷xs ⊆ ys can be split into two disjoint sublists - -- [x] ⊆ ys (canonical choice) and (∷ˡ⁻ τ) : xs ⊆ ys. - - DisjointUnion-fromAny∘toAny-∷ˡ⁻ : {x xs ys} (τ : (x xs) ys) DisjointUnion (fromAny (toAny τ)) (∷ˡ⁻ τ) τ - DisjointUnion-fromAny∘toAny-∷ˡ⁻ (y ∷ʳ τ) = y ∷ₙ DisjointUnion-fromAny∘toAny-∷ˡ⁻ τ - DisjointUnion-fromAny∘toAny-∷ˡ⁻ (xRy τ) = xRy ∷ₗ DisjointUnion-[]ˡ - - -- Disjoint union of three mutually disjoint lists. - -- - -- τᵢⱼ denotes the disjoint union of τᵢ and τⱼ: DisjointUnion τᵢ τⱼ τᵢⱼ - - record DisjointUnion³ - {xs ys zs ts} (τ₁ : xs ts) (τ₂ : ys ts) (τ₃ : zs ts) - {xys xzs yzs} (τ₁₂ : xys ts) (τ₁₃ : xzs ts) (τ₂₃ : yzs ts) : Set (a b r) where - field - {union³} : List A - sub³ : union³ ts - join₁ : DisjointUnion τ₁ τ₂₃ sub³ - join₂ : DisjointUnion τ₂ τ₁₃ sub³ - join₃ : DisjointUnion τ₃ τ₁₂ sub³ - - infixr 5 _∷ʳ-DisjointUnion³_ _∷₁-DisjointUnion³_ _∷₂-DisjointUnion³_ _∷₃-DisjointUnion³_ - - -- Weakening the target list ts of a disjoint union. - - _∷ʳ-DisjointUnion³_ : - {xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} - {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} - y - DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ - DisjointUnion³ (y ∷ʳ τ₁) (y ∷ʳ τ₂) (y ∷ʳ τ₃) (y ∷ʳ τ₁₂) (y ∷ʳ τ₁₃) (y ∷ʳ τ₂₃) - y ∷ʳ-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record - { sub³ = y ∷ʳ σ - ; join₁ = y ∷ₙ d₁ - ; join₂ = y ∷ₙ d₂ - ; join₃ = y ∷ₙ d₃ - } - - -- Adding an element to the first list. - - _∷₁-DisjointUnion³_ : - {xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} - {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} - {x y} (xRy : R x y) - DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ - DisjointUnion³ (xRy τ₁) (y ∷ʳ τ₂) (y ∷ʳ τ₃) (xRy τ₁₂) (xRy τ₁₃) (y ∷ʳ τ₂₃) - xRy ∷₁-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record - { sub³ = xRy σ - ; join₁ = xRy ∷ₗ d₁ - ; join₂ = xRy ∷ᵣ d₂ - ; join₃ = xRy ∷ᵣ d₃ - } - - -- Adding an element to the second list. - - _∷₂-DisjointUnion³_ : - {xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} - {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} - {x y} (xRy : R x y) - DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ - DisjointUnion³ (y ∷ʳ τ₁) (xRy τ₂) (y ∷ʳ τ₃) (xRy τ₁₂) (y ∷ʳ τ₁₃) (xRy τ₂₃) - xRy ∷₂-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record - { sub³ = xRy σ - ; join₁ = xRy ∷ᵣ d₁ - ; join₂ = xRy ∷ₗ d₂ - ; join₃ = xRy ∷ᵣ d₃ - } - - -- Adding an element to the third list. - - _∷₃-DisjointUnion³_ : - {xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} - {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} - {x y} (xRy : R x y) - DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ - DisjointUnion³ (y ∷ʳ τ₁) (y ∷ʳ τ₂) (xRy τ₃) (y ∷ʳ τ₁₂) (xRy τ₁₃) (xRy τ₂₃) - xRy ∷₃-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record - { sub³ = xRy σ - ; join₁ = xRy ∷ᵣ d₁ - ; join₂ = xRy ∷ᵣ d₂ - ; join₃ = xRy ∷ₗ d₃ - } - - -- Computing the disjoint union of three disjoint lists. - - disjointUnion³ : ∀{xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} - {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} - DisjointUnion τ₁ τ₂ τ₁₂ - DisjointUnion τ₁ τ₃ τ₁₃ - DisjointUnion τ₂ τ₃ τ₂₃ - DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ - disjointUnion³ [] [] [] = record { sub³ = [] ; join₁ = [] ; join₂ = [] ; join₃ = [] } - disjointUnion³ (y ∷ₙ d₁₂) (.y ∷ₙ d₁₃) (.y ∷ₙ d₂₃) = y ∷ʳ-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ - disjointUnion³ (y ∷ₙ d₁₂) (xRy ∷ᵣ d₁₃) (.xRy ∷ᵣ d₂₃) = xRy ∷₃-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ - disjointUnion³ (xRy ∷ᵣ d₁₂) (y ∷ₙ d₁₃) (.xRy ∷ₗ d₂₃) = xRy ∷₂-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ - disjointUnion³ (xRy ∷ₗ d₁₂) (.xRy ∷ₗ d₁₃) (y ∷ₙ d₂₃) = xRy ∷₁-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ - disjointUnion³ (xRy ∷ᵣ d₁₂) (xRy′ ∷ᵣ d₁₃) () - - -- If a sublist τ is disjoint to two lists σ₁ and σ₂, - -- then also to their disjoint union σ. - - disjoint⇒disjoint-to-union : ∀{xs ys zs yzs ts} - {τ : xs ts} {σ₁ : ys ts} {σ₂ : zs ts} {σ : yzs ts} - Disjoint τ σ₁ Disjoint τ σ₂ DisjointUnion σ₁ σ₂ σ Disjoint τ σ - disjoint⇒disjoint-to-union d₁ d₂ u = let - _ , _ , u₁ = Disjoint→DisjointUnion d₁ - _ , _ , u₂ = Disjoint→DisjointUnion d₂ - in DisjointUnion→Disjoint (DisjointUnion³.join₁ (disjointUnion³ u₁ u₂ u)) - -open Disjointness public - --- Monotonicity of disjointness. - -module DisjointnessMonotonicity - {R : REL A B r} {S : REL B C s} {T : REL A C t} - (rs⇒t : Trans R S T) where - - -- We can enlarge and convert the target list of a disjoint union. - - weakenDisjointUnion : {xs ys xys zs ws} - {τ₁ : Sublist R xs zs} - {τ₂ : Sublist R ys zs} - {τ : Sublist R xys zs} (σ : Sublist S zs ws) - DisjointUnion τ₁ τ₂ τ - DisjointUnion (trans rs⇒t τ₁ σ) (trans rs⇒t τ₂ σ) (trans rs⇒t τ σ) - weakenDisjointUnion [] [] = [] - weakenDisjointUnion (w ∷ʳ σ) d = w ∷ₙ weakenDisjointUnion σ d - weakenDisjointUnion (_ σ) (y ∷ₙ d) = _ ∷ₙ weakenDisjointUnion σ d - weakenDisjointUnion (zSw σ) (xRz ∷ₗ d) = rs⇒t xRz zSw ∷ₗ weakenDisjointUnion σ d - weakenDisjointUnion (zSw σ) (yRz ∷ᵣ d) = rs⇒t yRz zSw ∷ᵣ weakenDisjointUnion σ d - - weakenDisjoint : {xs ys zs ws} - {τ₁ : Sublist R xs zs} - {τ₂ : Sublist R ys zs} (σ : Sublist S zs ws) - Disjoint τ₁ τ₂ - Disjoint (trans rs⇒t τ₁ σ) (trans rs⇒t τ₂ σ) - weakenDisjoint [] [] = [] - weakenDisjoint (w ∷ʳ σ) d = w ∷ₙ weakenDisjoint σ d - weakenDisjoint (_ σ) (y ∷ₙ d) = _ ∷ₙ weakenDisjoint σ d - weakenDisjoint (zSw σ) (xRz ∷ₗ d) = rs⇒t xRz zSw ∷ₗ weakenDisjoint σ d - weakenDisjoint (zSw σ) (yRz ∷ᵣ d) = rs⇒t yRz zSw ∷ᵣ weakenDisjoint σ d - - -- Lists remain disjoint when elements are removed. - - shrinkDisjoint : {us vs xs ys zs} - (σ₁ : Sublist R us xs) {τ₁ : Sublist S xs zs} - (σ₂ : Sublist R vs ys) {τ₂ : Sublist S ys zs} - Disjoint τ₁ τ₂ - Disjoint (trans rs⇒t σ₁ τ₁) (trans rs⇒t σ₂ τ₂) - shrinkDisjoint σ₁ σ₂ (y ∷ₙ d) = y ∷ₙ shrinkDisjoint σ₁ σ₂ d - shrinkDisjoint (x ∷ʳ σ₁) σ₂ (xSz ∷ₗ d) = _ ∷ₙ shrinkDisjoint σ₁ σ₂ d - shrinkDisjoint (uRx σ₁) σ₂ (xSz ∷ₗ d) = rs⇒t uRx xSz ∷ₗ shrinkDisjoint σ₁ σ₂ d - shrinkDisjoint σ₁ (y ∷ʳ σ₂) (ySz ∷ᵣ d) = _ ∷ₙ shrinkDisjoint σ₁ σ₂ d - shrinkDisjoint σ₁ (vRy σ₂) (ySz ∷ᵣ d) = rs⇒t vRy ySz ∷ᵣ shrinkDisjoint σ₁ σ₂ d - shrinkDisjoint [] [] [] = [] - -open DisjointnessMonotonicity public + open ℕ.≤-Reasoning + + antisym : Antisym (Sublist R) (Sublist S) (Pointwise E) + antisym [] [] = [] + antisym (r rs) (s ss) = rs⇒e r s antisym rs ss + -- impossible cases + antisym (_∷ʳ_ {xs} {ys₁} y rs) (_∷ʳ_ {ys₂} {zs} z ss) = + contradiction (begin + length (y ys₁) ≤⟨ length-mono-≤ ss + length zs ≤⟨ ℕ.n≤1+n (length zs) + length (z zs) ≤⟨ length-mono-≤ rs + length ys₁ ) $ ℕ.<-irrefl ≡.refl + antisym (_∷ʳ_ {xs} {ys₁} y rs) (_∷_ {y} {ys₂} {z} {zs} s ss) = + contradiction (begin + length (z zs) ≤⟨ length-mono-≤ rs + length ys₁ ≤⟨ length-mono-≤ ss + length zs ) $ ℕ.<-irrefl ≡.refl + antisym (_∷_ {x} {xs} {y} {ys₁} r rs) (_∷ʳ_ {ys₂} {zs} z ss) = + contradiction (begin + length (y ys₁) ≤⟨ length-mono-≤ ss + length xs ≤⟨ length-mono-≤ rs + length ys₁ ) $ ℕ.<-irrefl ≡.refl + +open Antisymmetry public + +module _ {R : REL A B r} (R? : Decidable R) where + + sublist? : Decidable (Sublist R) + sublist? [] ys = yes (minimum ys) + sublist? (x xs) [] = no λ () + sublist? (x xs) (y ys) with R? x y + ... | true because [r] = + Dec.map (∷⁻¹ (invert [r])) (sublist? xs ys) + ... | false because [¬r] = + Dec.map (∷ʳ⁻¹ (invert [¬r])) (sublist? (x xs) ys) + +module _ {E : Rel A e} {R : Rel A r} where + + isPreorder : IsPreorder E R IsPreorder (Pointwise E) (Sublist R) + isPreorder ER-isPreorder = record + { isEquivalence = Pw.isEquivalence ER.isEquivalence + ; reflexive = fromPointwise Pw.map ER.reflexive + ; trans = trans ER.trans + } where module ER = IsPreorder ER-isPreorder + + isPartialOrder : IsPartialOrder E R IsPartialOrder (Pointwise E) (Sublist R) + isPartialOrder ER-isPartialOrder = record + { isPreorder = isPreorder ER.isPreorder + ; antisym = antisym ER.antisym + } where module ER = IsPartialOrder ER-isPartialOrder + + isDecPartialOrder : IsDecPartialOrder E R + IsDecPartialOrder (Pointwise E) (Sublist R) + isDecPartialOrder ER-isDecPartialOrder = record + { isPartialOrder = isPartialOrder ER.isPartialOrder + ; _≟_ = Pw.decidable ER._≟_ + ; _≤?_ = sublist? ER._≤?_ + } where module ER = IsDecPartialOrder ER-isDecPartialOrder + +preorder : Preorder a e r Preorder _ _ _ +preorder ER-preorder = record + { isPreorder = isPreorder ER.isPreorder + } where module ER = Preorder ER-preorder + +poset : Poset a e r Poset _ _ _ +poset ER-poset = record + { isPartialOrder = isPartialOrder ER.isPartialOrder + } where module ER = Poset ER-poset + +decPoset : DecPoset a e r DecPoset _ _ _ +decPoset ER-poset = record + { isDecPartialOrder = isDecPartialOrder ER.isDecPartialOrder + } where module ER = DecPoset ER-poset + +------------------------------------------------------------------------ +-- Reasoning over sublists +------------------------------------------------------------------------ + +module ⊆-Reasoning ( : Preorder a e r) where + + open Preorder using (module Eq) + + open ≲-Reasoning (preorder ) public + renaming (≲-go to ⊆-go; ≈-go to ≋-go) + + open ⊆-syntax _IsRelatedTo_ _IsRelatedTo_ ⊆-go public + open ≋-syntax _IsRelatedTo_ _IsRelatedTo_ ≋-go (Pw.symmetric Eq.sym) public + +------------------------------------------------------------------------ +-- Properties of disjoint sublists + +module Disjointness {a b r} {A : Set a} {B : Set b} {R : REL A B r} where + + private + infix 4 _⊆_ + _⊆_ = Sublist R + + -- Forgetting the union + + DisjointUnion→Disjoint : {xs ys zs us} {τ₁ : xs zs} {τ₂ : ys zs} {τ : us zs} + DisjointUnion τ₁ τ₂ τ Disjoint τ₁ τ₂ + DisjointUnion→Disjoint [] = [] + DisjointUnion→Disjoint (y ∷ₙ u) = y ∷ₙ DisjointUnion→Disjoint u + DisjointUnion→Disjoint (x≈y ∷ₗ u) = x≈y ∷ₗ DisjointUnion→Disjoint u + DisjointUnion→Disjoint (x≈y ∷ᵣ u) = x≈y ∷ᵣ DisjointUnion→Disjoint u + + -- Reconstructing the union + + Disjoint→DisjointUnion : {xs ys zs} {τ₁ : xs zs} {τ₂ : ys zs} + Disjoint τ₁ τ₂ ∃₂ λ us (τ : us zs) DisjointUnion τ₁ τ₂ τ + Disjoint→DisjointUnion [] = _ , _ , [] + Disjoint→DisjointUnion (y ∷ₙ u) = _ , _ , y ∷ₙ proj₂ (proj₂ (Disjoint→DisjointUnion u)) + Disjoint→DisjointUnion (x≈y ∷ₗ u) = _ , _ , x≈y ∷ₗ proj₂ (proj₂ (Disjoint→DisjointUnion u)) + Disjoint→DisjointUnion (x≈y ∷ᵣ u) = _ , _ , x≈y ∷ᵣ proj₂ (proj₂ (Disjoint→DisjointUnion u)) + + -- Disjoint is decidable + + ⊆-disjoint? : {xs ys zs} (τ₁ : xs zs) (τ₂ : ys zs) Dec (Disjoint τ₁ τ₂) + ⊆-disjoint? [] [] = yes [] + -- Present in both sublists: not disjoint. + ⊆-disjoint? (x≈z τ₁) (y≈z τ₂) = no λ() + -- Present in either sublist: ok. + ⊆-disjoint? (y ∷ʳ τ₁) (x≈y τ₂) = + Dec.map′ (x≈y ∷ᵣ_) (λ{ (_ ∷ᵣ d) d }) (⊆-disjoint? τ₁ τ₂) + ⊆-disjoint? (x≈y τ₁) (y ∷ʳ τ₂) = + Dec.map′ (x≈y ∷ₗ_) (λ{ (_ ∷ₗ d) d }) (⊆-disjoint? τ₁ τ₂) + -- Present in neither sublist: ok. + ⊆-disjoint? (y ∷ʳ τ₁) (.y ∷ʳ τ₂) = + Dec.map′ (y ∷ₙ_) (λ{ (_ ∷ₙ d) d }) (⊆-disjoint? τ₁ τ₂) + + -- Disjoint is proof-irrelevant + + Disjoint-irrelevant : ∀{xs ys zs} Irrelevant (Disjoint {R = R} {xs} {ys} {zs}) + Disjoint-irrelevant [] [] = ≡.refl + Disjoint-irrelevant (y ∷ₙ d₁) (.y ∷ₙ d₂) = ≡.cong (y ∷ₙ_) (Disjoint-irrelevant d₁ d₂) + Disjoint-irrelevant (x≈y ∷ₗ d₁) (.x≈y ∷ₗ d₂) = ≡.cong (x≈y ∷ₗ_) (Disjoint-irrelevant d₁ d₂) + Disjoint-irrelevant (x≈y ∷ᵣ d₁) (.x≈y ∷ᵣ d₂) = ≡.cong (x≈y ∷ᵣ_) (Disjoint-irrelevant d₁ d₂) + + -- Note: DisjointUnion is not proof-irrelevant unless the underlying relation R is. + -- The proof is not entirely trivial, thus, we leave it for future work: + -- + -- DisjointUnion-irrelevant : Irrelevant R → + -- ∀{xs ys us zs} {τ : us ⊆ zs} → + -- Irrelevant (λ (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) → DisjointUnion τ₁ τ₂ τ) + + -- Irreflexivity + + Disjoint-irrefl′ : ∀{xs ys} {τ : xs ys} Disjoint τ τ Null xs + Disjoint-irrefl′ [] = [] + Disjoint-irrefl′ (y ∷ₙ d) = Disjoint-irrefl′ d + + Disjoint-irrefl : ∀{x xs ys} Irreflexive {A = x xs ys } _≡_ Disjoint + Disjoint-irrefl ≡.refl x with Disjoint-irrefl′ x + ... | () _ + + -- Symmetry + + DisjointUnion-sym : {xs ys xys} {zs} {τ₁ : xs zs} {τ₂ : ys zs} {τ : xys zs} + DisjointUnion τ₁ τ₂ τ DisjointUnion τ₂ τ₁ τ + DisjointUnion-sym [] = [] + DisjointUnion-sym (y ∷ₙ d) = y ∷ₙ DisjointUnion-sym d + DisjointUnion-sym (x≈y ∷ₗ d) = x≈y ∷ᵣ DisjointUnion-sym d + DisjointUnion-sym (x≈y ∷ᵣ d) = x≈y ∷ₗ DisjointUnion-sym d + + Disjoint-sym : {xs ys} {zs} {τ₁ : xs zs} {τ₂ : ys zs} + Disjoint τ₁ τ₂ Disjoint τ₂ τ₁ + Disjoint-sym [] = [] + Disjoint-sym (y ∷ₙ d) = y ∷ₙ Disjoint-sym d + Disjoint-sym (x≈y ∷ₗ d) = x≈y ∷ᵣ Disjoint-sym d + Disjoint-sym (x≈y ∷ᵣ d) = x≈y ∷ₗ Disjoint-sym d + + -- Empty sublist + + DisjointUnion-[]ˡ : ∀{xs ys} {ε : [] ys} {τ : xs ys} DisjointUnion ε τ τ + DisjointUnion-[]ˡ {ε = []} {τ = []} = [] + DisjointUnion-[]ˡ {ε = y ∷ʳ ε} {τ = y ∷ʳ τ} = y ∷ₙ DisjointUnion-[]ˡ + DisjointUnion-[]ˡ {ε = y ∷ʳ ε} {τ = x≈y τ} = x≈y ∷ᵣ DisjointUnion-[]ˡ + + DisjointUnion-[]ʳ : ∀{xs ys} {ε : [] ys} {τ : xs ys} DisjointUnion τ ε τ + DisjointUnion-[]ʳ {ε = []} {τ = []} = [] + DisjointUnion-[]ʳ {ε = y ∷ʳ ε} {τ = y ∷ʳ τ} = y ∷ₙ DisjointUnion-[]ʳ + DisjointUnion-[]ʳ {ε = y ∷ʳ ε} {τ = x≈y τ} = x≈y ∷ₗ DisjointUnion-[]ʳ + + -- A sublist τ : x∷xs ⊆ ys can be split into two disjoint sublists + -- [x] ⊆ ys (canonical choice) and (∷ˡ⁻ τ) : xs ⊆ ys. + + DisjointUnion-fromAny∘toAny-∷ˡ⁻ : {x xs ys} (τ : (x xs) ys) DisjointUnion (fromAny (toAny τ)) (∷ˡ⁻ τ) τ + DisjointUnion-fromAny∘toAny-∷ˡ⁻ (y ∷ʳ τ) = y ∷ₙ DisjointUnion-fromAny∘toAny-∷ˡ⁻ τ + DisjointUnion-fromAny∘toAny-∷ˡ⁻ (xRy τ) = xRy ∷ₗ DisjointUnion-[]ˡ + + -- Disjoint union of three mutually disjoint lists. + -- + -- τᵢⱼ denotes the disjoint union of τᵢ and τⱼ: DisjointUnion τᵢ τⱼ τᵢⱼ + + record DisjointUnion³ + {xs ys zs ts} (τ₁ : xs ts) (τ₂ : ys ts) (τ₃ : zs ts) + {xys xzs yzs} (τ₁₂ : xys ts) (τ₁₃ : xzs ts) (τ₂₃ : yzs ts) : Set (a b r) where + field + {union³} : List A + sub³ : union³ ts + join₁ : DisjointUnion τ₁ τ₂₃ sub³ + join₂ : DisjointUnion τ₂ τ₁₃ sub³ + join₃ : DisjointUnion τ₃ τ₁₂ sub³ + + infixr 5 _∷ʳ-DisjointUnion³_ _∷₁-DisjointUnion³_ _∷₂-DisjointUnion³_ _∷₃-DisjointUnion³_ + + -- Weakening the target list ts of a disjoint union. + + _∷ʳ-DisjointUnion³_ : + {xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} + {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} + y + DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ + DisjointUnion³ (y ∷ʳ τ₁) (y ∷ʳ τ₂) (y ∷ʳ τ₃) (y ∷ʳ τ₁₂) (y ∷ʳ τ₁₃) (y ∷ʳ τ₂₃) + y ∷ʳ-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record + { sub³ = y ∷ʳ σ + ; join₁ = y ∷ₙ d₁ + ; join₂ = y ∷ₙ d₂ + ; join₃ = y ∷ₙ d₃ + } + + -- Adding an element to the first list. + + _∷₁-DisjointUnion³_ : + {xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} + {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} + {x y} (xRy : R x y) + DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ + DisjointUnion³ (xRy τ₁) (y ∷ʳ τ₂) (y ∷ʳ τ₃) (xRy τ₁₂) (xRy τ₁₃) (y ∷ʳ τ₂₃) + xRy ∷₁-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record + { sub³ = xRy σ + ; join₁ = xRy ∷ₗ d₁ + ; join₂ = xRy ∷ᵣ d₂ + ; join₃ = xRy ∷ᵣ d₃ + } + + -- Adding an element to the second list. + + _∷₂-DisjointUnion³_ : + {xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} + {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} + {x y} (xRy : R x y) + DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ + DisjointUnion³ (y ∷ʳ τ₁) (xRy τ₂) (y ∷ʳ τ₃) (xRy τ₁₂) (y ∷ʳ τ₁₃) (xRy τ₂₃) + xRy ∷₂-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record + { sub³ = xRy σ + ; join₁ = xRy ∷ᵣ d₁ + ; join₂ = xRy ∷ₗ d₂ + ; join₃ = xRy ∷ᵣ d₃ + } + + -- Adding an element to the third list. + + _∷₃-DisjointUnion³_ : + {xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} + {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} + {x y} (xRy : R x y) + DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ + DisjointUnion³ (y ∷ʳ τ₁) (y ∷ʳ τ₂) (xRy τ₃) (y ∷ʳ τ₁₂) (xRy τ₁₃) (xRy τ₂₃) + xRy ∷₃-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record + { sub³ = xRy σ + ; join₁ = xRy ∷ᵣ d₁ + ; join₂ = xRy ∷ᵣ d₂ + ; join₃ = xRy ∷ₗ d₃ + } + + -- Computing the disjoint union of three disjoint lists. + + disjointUnion³ : ∀{xs ys zs ts} {τ₁ : xs ts} {τ₂ : ys ts} {τ₃ : zs ts} + {xys xzs yzs} {τ₁₂ : xys ts} {τ₁₃ : xzs ts} {τ₂₃ : yzs ts} + DisjointUnion τ₁ τ₂ τ₁₂ + DisjointUnion τ₁ τ₃ τ₁₃ + DisjointUnion τ₂ τ₃ τ₂₃ + DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ + disjointUnion³ [] [] [] = record { sub³ = [] ; join₁ = [] ; join₂ = [] ; join₃ = [] } + disjointUnion³ (y ∷ₙ d₁₂) (.y ∷ₙ d₁₃) (.y ∷ₙ d₂₃) = y ∷ʳ-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ + disjointUnion³ (y ∷ₙ d₁₂) (xRy ∷ᵣ d₁₃) (.xRy ∷ᵣ d₂₃) = xRy ∷₃-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ + disjointUnion³ (xRy ∷ᵣ d₁₂) (y ∷ₙ d₁₃) (.xRy ∷ₗ d₂₃) = xRy ∷₂-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ + disjointUnion³ (xRy ∷ₗ d₁₂) (.xRy ∷ₗ d₁₃) (y ∷ₙ d₂₃) = xRy ∷₁-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ + disjointUnion³ (xRy ∷ᵣ d₁₂) (xRy′ ∷ᵣ d₁₃) () + + -- If a sublist τ is disjoint to two lists σ₁ and σ₂, + -- then also to their disjoint union σ. + + disjoint⇒disjoint-to-union : ∀{xs ys zs yzs ts} + {τ : xs ts} {σ₁ : ys ts} {σ₂ : zs ts} {σ : yzs ts} + Disjoint τ σ₁ Disjoint τ σ₂ DisjointUnion σ₁ σ₂ σ Disjoint τ σ + disjoint⇒disjoint-to-union d₁ d₂ u = let + _ , _ , u₁ = Disjoint→DisjointUnion d₁ + _ , _ , u₂ = Disjoint→DisjointUnion d₂ + in DisjointUnion→Disjoint (DisjointUnion³.join₁ (disjointUnion³ u₁ u₂ u)) + +open Disjointness public + +-- Monotonicity of disjointness. + +module DisjointnessMonotonicity + {R : REL A B r} {S : REL B C s} {T : REL A C t} + (rs⇒t : Trans R S T) where + + -- We can enlarge and convert the target list of a disjoint union. + + weakenDisjointUnion : {xs ys xys zs ws} + {τ₁ : Sublist R xs zs} + {τ₂ : Sublist R ys zs} + {τ : Sublist R xys zs} (σ : Sublist S zs ws) + DisjointUnion τ₁ τ₂ τ + DisjointUnion (trans rs⇒t τ₁ σ) (trans rs⇒t τ₂ σ) (trans rs⇒t τ σ) + weakenDisjointUnion [] [] = [] + weakenDisjointUnion (w ∷ʳ σ) d = w ∷ₙ weakenDisjointUnion σ d + weakenDisjointUnion (_ σ) (y ∷ₙ d) = _ ∷ₙ weakenDisjointUnion σ d + weakenDisjointUnion (zSw σ) (xRz ∷ₗ d) = rs⇒t xRz zSw ∷ₗ weakenDisjointUnion σ d + weakenDisjointUnion (zSw σ) (yRz ∷ᵣ d) = rs⇒t yRz zSw ∷ᵣ weakenDisjointUnion σ d + + weakenDisjoint : {xs ys zs ws} + {τ₁ : Sublist R xs zs} + {τ₂ : Sublist R ys zs} (σ : Sublist S zs ws) + Disjoint τ₁ τ₂ + Disjoint (trans rs⇒t τ₁ σ) (trans rs⇒t τ₂ σ) + weakenDisjoint [] [] = [] + weakenDisjoint (w ∷ʳ σ) d = w ∷ₙ weakenDisjoint σ d + weakenDisjoint (_ σ) (y ∷ₙ d) = _ ∷ₙ weakenDisjoint σ d + weakenDisjoint (zSw σ) (xRz ∷ₗ d) = rs⇒t xRz zSw ∷ₗ weakenDisjoint σ d + weakenDisjoint (zSw σ) (yRz ∷ᵣ d) = rs⇒t yRz zSw ∷ᵣ weakenDisjoint σ d + + -- Lists remain disjoint when elements are removed. + + shrinkDisjoint : {us vs xs ys zs} + (σ₁ : Sublist R us xs) {τ₁ : Sublist S xs zs} + (σ₂ : Sublist R vs ys) {τ₂ : Sublist S ys zs} + Disjoint τ₁ τ₂ + Disjoint (trans rs⇒t σ₁ τ₁) (trans rs⇒t σ₂ τ₂) + shrinkDisjoint σ₁ σ₂ (y ∷ₙ d) = y ∷ₙ shrinkDisjoint σ₁ σ₂ d + shrinkDisjoint (x ∷ʳ σ₁) σ₂ (xSz ∷ₗ d) = _ ∷ₙ shrinkDisjoint σ₁ σ₂ d + shrinkDisjoint (uRx σ₁) σ₂ (xSz ∷ₗ d) = rs⇒t uRx xSz ∷ₗ shrinkDisjoint σ₁ σ₂ d + shrinkDisjoint σ₁ (y ∷ʳ σ₂) (ySz ∷ᵣ d) = _ ∷ₙ shrinkDisjoint σ₁ σ₂ d + shrinkDisjoint σ₁ (vRy σ₂) (ySz ∷ᵣ d) = rs⇒t vRy ySz ∷ᵣ shrinkDisjoint σ₁ σ₂ d + shrinkDisjoint [] [] [] = [] + +open DisjointnessMonotonicity public \ No newline at end of file diff --git a/master/Data.List.Relation.Binary.Sublist.Heterogeneous.Solver.html b/master/Data.List.Relation.Binary.Sublist.Heterogeneous.Solver.html index 0418d409bc..227de89012 100644 --- a/master/Data.List.Relation.Binary.Sublist.Heterogeneous.Solver.html +++ b/master/Data.List.Relation.Binary.Sublist.Heterogeneous.Solver.html @@ -118,11 +118,11 @@ private keep-it : {n a b} a ⊆I b (xs ys : RList n) xs ⊆R ys (a xs) ⊆R (b ys) - keep-it (var a≡b) xs ys hyp ρ = ++⁺ (reflexive R-refl (cong _ a≡b)) (hyp ρ) + keep-it (var a≡b) xs ys hyp ρ = ++⁺ (reflexive R-refl (cong _ a≡b)) (hyp ρ) keep-it (val rab) xs ys hyp ρ = rab hyp ρ skip-it : {n} it (d e : RList n) d ⊆R e d ⊆R (it e) - skip-it it d ys hyp ρ = ++ˡ ( it ⟧I ρ) (hyp ρ) + skip-it it d ys hyp ρ = ++ˡ ( it ⟧I ρ) (hyp ρ) -- Solver for items solveI : {n} (a b : Item n) Maybe (a ⊆I b) diff --git a/master/Data.List.Relation.Binary.Sublist.Propositional.Example.UniqueBoundVariables.html b/master/Data.List.Relation.Binary.Sublist.Propositional.Example.UniqueBoundVariables.html index 3c0d09edeb..ed7e069769 100644 --- a/master/Data.List.Relation.Binary.Sublist.Propositional.Example.UniqueBoundVariables.html +++ b/master/Data.List.Relation.Binary.Sublist.Propositional.Example.UniqueBoundVariables.html @@ -29,14 +29,14 @@ ; separateˡ; Separation ) open import Data.List.Relation.Binary.Sublist.Propositional.Properties using - ( ∷ˡ⁻ + ( ∷ˡ⁻ ; ⊆-trans-assoc ; from∈∘to∈; from∈∘lookup; lookup-⊆-trans ; ⊆-pushoutˡ-is-wpo - ; Disjoint→DisjointUnion; DisjointUnion→Disjoint - ; Disjoint-sym; DisjointUnion-inj₁; DisjointUnion-inj₂; DisjointUnion-[]ʳ - ; weakenDisjoint; weakenDisjointUnion; shrinkDisjointˡ - ; disjoint⇒disjoint-to-union; DisjointUnion-fromAny∘toAny-∷ˡ⁻ + ; Disjoint→DisjointUnion; DisjointUnion→Disjoint + ; Disjoint-sym; DisjointUnion-inj₁; DisjointUnion-inj₂; DisjointUnion-[]ʳ + ; weakenDisjoint; weakenDisjointUnion; shrinkDisjointˡ + ; disjoint⇒disjoint-to-union; DisjointUnion-fromAny∘toAny-∷ˡ⁻ ; equalize-separators ) @@ -127,12 +127,12 @@ Tm β a Tm (⊆-trans β γ) a weakenBV γ (var noBV x) = var noBV (lookup γ x) - weakenBV γ (app t u t#u) = app (weakenBV γ t) (weakenBV γ u) (weakenDisjointUnion γ t#u) + weakenBV γ (app t u t#u) = app (weakenBV γ t) (weakenBV γ u) (weakenDisjointUnion γ t#u) weakenBV γ (abs y y# t) = abs y′ y′# (weakenBV γ t) where y′ = lookup γ y -- Typing: y′# : DisjointUnion (from∈ y′) (⊆-trans β\y γ) (⊆-trans β γ) - y′# = subst DisjointUnion _ _) (sym (from∈∘lookup _ _)) (weakenDisjointUnion γ y#) + y′# = subst DisjointUnion _ _) (sym (from∈∘lookup _ _)) (weakenDisjointUnion γ y#) -- We bring de Bruijn terms into scope as Exp. @@ -202,12 +202,12 @@ (let t′ = weakenBV γ t) δ e ~ β t δ′ e ~ β′ t′ -weaken~ γ (var refl δ#β) = var (lookup-⊆-trans γ _) (weakenDisjoint γ δ#β) +weaken~ γ (var refl δ#β) = var (lookup-⊆-trans γ _) (weakenDisjoint γ δ#β) weaken~ γ (abs y#δ y#β d) = abs y′#δ′ y′#β′ (weaken~ γ d) where - y′#δ′ = subst DisjointUnion _ _) (sym (from∈∘lookup _ _)) (weakenDisjointUnion γ y#δ) - y′#β′ = subst DisjointUnion _ _) (sym (from∈∘lookup _ _)) (weakenDisjointUnion γ y#β) -weaken~ γ (app dₜ dᵤ t#u) = app (weaken~ γ dₜ) (weaken~ γ dᵤ) (weakenDisjointUnion γ t#u) + y′#δ′ = subst DisjointUnion _ _) (sym (from∈∘lookup _ _)) (weakenDisjointUnion γ y#δ) + y′#β′ = subst DisjointUnion _ _) (sym (from∈∘lookup _ _)) (weakenDisjointUnion γ y#β) +weaken~ γ (app dₜ dᵤ t#u) = app (weaken~ γ dₜ) (weaken~ γ dᵤ) (weakenDisjointUnion γ t#u) -- Lemma: If δ ⊢ e ~ β ▷ t, then -- the (potentially) free variables δ of the de Bruijn term e @@ -218,15 +218,15 @@ disjoint-fv-bv {β = } (abs y⊎δ y⊎β d) = δ#yβ where - δ#y = Disjoint-sym (DisjointUnion→Disjoint y⊎δ) + δ#y = Disjoint-sym (DisjointUnion→Disjoint y⊎δ) yδ#β = disjoint-fv-bv d δ⊆yδ,eq = DisjointUnion-inj₂ y⊎δ δ⊆yδ = proj₁ δ⊆yδ,eq eq = proj₂ δ⊆yδ,eq - δ#β = subst Disjoint _) eq (shrinkDisjointˡ δ⊆yδ yδ#β) - δ#yβ = disjoint⇒disjoint-to-union δ#y δ#β y⊎β + δ#β = subst Disjoint _) eq (shrinkDisjointˡ δ⊆yδ yδ#β) + δ#yβ = disjoint⇒disjoint-to-union δ#y δ#β y⊎β -disjoint-fv-bv (app dₜ dᵤ βₜ⊎βᵤ) = disjoint⇒disjoint-to-union δ#βₜ δ#βᵤ βₜ⊎βᵤ +disjoint-fv-bv (app dₜ dᵤ βₜ⊎βᵤ) = disjoint⇒disjoint-to-union δ#βₜ δ#βᵤ βₜ⊎βᵤ where δ#βₜ = disjoint-fv-bv dₜ δ#βᵤ = disjoint-fv-bv dᵤ @@ -261,7 +261,7 @@ dB→Named (var x) = record { emb = ⊆-refl -- Γ := Δ ; bound = minimum _ -- no bound variables - ; relate = var refl (DisjointUnion→Disjoint DisjointUnion-[]ʳ) + ; relate = var refl (DisjointUnion→Disjoint DisjointUnion-[]ʳ) } -- For the translation of an abstraction @@ -289,15 +289,15 @@ z : a Γ z = to∈ [a]⊆Γ = from∈ z - δ̇ = ∷ˡ⁻ - [a]⊆Γ⊎δ = DisjointUnion-fromAny∘toAny-∷ˡ⁻ + δ̇ = ∷ˡ⁻ + [a]⊆Γ⊎δ = DisjointUnion-fromAny∘toAny-∷ˡ⁻ [a]⊆aΔ : [ a ] (a Δ) [a]⊆aΔ = refl minimum _ eq : ⊆-trans [a]⊆aΔ [a]⊆Γ eq = sym (from∈∘to∈ _) z#β : Disjoint [a]⊆Γ β - z#β = subst Disjoint β) eq (shrinkDisjointˡ [a]⊆aΔ zδ#β) - z⊎β = Disjoint→DisjointUnion z#β + z#β = subst Disjoint β) eq (shrinkDisjointˡ [a]⊆aΔ zδ#β) + z⊎β = Disjoint→DisjointUnion z#β -- For the translation of an application (f e) we have by induction -- hypothesis two independent extensions δ₁ : Δ ⊆ Γ₁ and δ₂ : Δ ⊆ Γ₂ @@ -351,9 +351,9 @@ β₁′ = ⊆-trans β₁ ϕ₁ β₂′ = ⊆-trans β₂ ϕ₂ δ₁′#β₁′ : Disjoint δ₁′ β₁′ - δ₁′#β₁′ = weakenDisjoint ϕ₁ δ₁#β₁ + δ₁′#β₁′ = weakenDisjoint ϕ₁ δ₁#β₁ δ₂′#β₂′ : Disjoint δ₂′ β₂′ - δ₂′#β₂′ = weakenDisjoint ϕ₂ δ₂#β₂ + δ₂′#β₂′ = weakenDisjoint ϕ₂ δ₂#β₂ δ₁′≡δ₂′ : δ₁′ δ₂′ δ₁′≡δ₂′ = ⊆-pushoutˡ-is-wpo δ₁ δ₂ δ₂′#β₁′ : Disjoint δ₂′ β₁′ @@ -368,7 +368,7 @@ β₂″ = Separation.separated₂ sep -- produce their disjoint union - uni = Disjoint→DisjointUnion (Separation.disjoint sep) + uni = Disjoint→DisjointUnion (Separation.disjoint sep) β̇ = proj₁ (proj₂ uni) β₁″⊎β₂″ : DisjointUnion β₁″ β₂″ β̇ β₁″⊎β₂″ = proj₂ (proj₂ uni) @@ -381,14 +381,14 @@ δ₁″≡δ₂″ : δ₁″ δ₂″ δ₁″≡δ₂″ = equalize-separators δ₂′#β₁′ δ₂′#β₂′ δ₁″#β₁″ : Disjoint δ₁″ β₁″ - δ₁″#β₁″ = weakenDisjoint γ₁ δ₂′#β₁′ + δ₁″#β₁″ = weakenDisjoint γ₁ δ₂′#β₁′ δ₂″#β₂″ : Disjoint δ₂″ β₂″ - δ₂″#β₂″ = weakenDisjoint γ₂ δ₂′#β₂′ + δ₂″#β₂″ = weakenDisjoint γ₂ δ₂′#β₂′ δ̇ = δ₂″ δ₂″#β₁″ : Disjoint δ₂″ β₁″ δ₂″#β₁″ = subst Disjoint β₁″) δ₁″≡δ₂″ δ₁″#β₁″ δ̇#β̇ : Disjoint δ̇ β̇ - δ̇#β̇ = disjoint⇒disjoint-to-union δ₂″#β₁″ δ₂″#β₂″ β₁″⊎β₂″ + δ̇#β̇ = disjoint⇒disjoint-to-union δ₂″#β₁″ δ₂″#β₂″ β₁″⊎β₂″ -- Combined weakening from Γᵢ to Γ γ₁′ = ⊆-trans ϕ₁ γ₁ diff --git a/master/Data.List.Relation.Binary.Sublist.Propositional.Properties.html b/master/Data.List.Relation.Binary.Sublist.Propositional.Properties.html index 9fde19cac7..f8abae23c6 100644 --- a/master/Data.List.Relation.Binary.Sublist.Propositional.Properties.html +++ b/master/Data.List.Relation.Binary.Sublist.Propositional.Properties.html @@ -44,7 +44,7 @@ module _ {A : Set a} where open SetoidProperties (setoid A) public - hiding (map⁺; ⊆-trans-idˡ; ⊆-trans-idʳ; ⊆-trans-assoc) + hiding (map⁺; ⊆-trans-idˡ; ⊆-trans-idʳ; ⊆-trans-assoc) ------------------------------------------------------------------------ -- Relationship between _⊆_ and Setoid._⊆_ @@ -62,16 +62,16 @@ -- Functoriality of map map⁺ : (f : A B) xs ys map f xs map f ys -map⁺ f = SetoidProperties.map⁺ (setoid _) (setoid _) (cong f) +map⁺ f = SetoidProperties.map⁺ (setoid _) (setoid _) (cong f) ------------------------------------------------------------------------ -- Category laws for _⊆_ ⊆-trans-idˡ : {τ : xs ys} ⊆-trans ⊆-refl τ τ -⊆-trans-idˡ {τ = τ} = SetoidProperties.⊆-trans-idˡ (setoid _) _ refl) τ +⊆-trans-idˡ {τ = τ} = SetoidProperties.⊆-trans-idˡ (setoid _) _ refl) τ ⊆-trans-idʳ : {τ : xs ys} ⊆-trans τ ⊆-refl τ -⊆-trans-idʳ {τ = τ} = SetoidProperties.⊆-trans-idʳ (setoid _) trans-reflʳ τ +⊆-trans-idʳ {τ = τ} = SetoidProperties.⊆-trans-idʳ (setoid _) trans-reflʳ τ -- Note: The associativity law is oriented such that rewriting with it -- may trigger reductions of ⊆-trans, which matches first on its @@ -80,24 +80,24 @@ ⊆-trans-assoc : {τ₁ : ws xs} {τ₂ : xs ys} {τ₃ : ys zs} ⊆-trans τ₁ (⊆-trans τ₂ τ₃) ⊆-trans (⊆-trans τ₁ τ₂) τ₃ ⊆-trans-assoc {τ₁ = τ₁} {τ₂ = τ₂} {τ₃ = τ₃} = - SetoidProperties.⊆-trans-assoc (setoid _) p _ _ ≡.sym (trans-assoc p)) τ₁ τ₂ τ₃ + SetoidProperties.⊆-trans-assoc (setoid _) p _ _ ≡.sym (trans-assoc p)) τ₁ τ₂ τ₃ ------------------------------------------------------------------------ -- Laws concerning ⊆-trans and ∷ˡ⁻ ⊆-trans-∷ˡ⁻ᵣ : {τ : xs ys} {σ : (y ys) zs} - ⊆-trans τ (∷ˡ⁻ σ) ⊆-trans (y ∷ʳ τ) σ + ⊆-trans τ (∷ˡ⁻ σ) ⊆-trans (y ∷ʳ τ) σ ⊆-trans-∷ˡ⁻ᵣ {σ = x σ} = refl ⊆-trans-∷ˡ⁻ᵣ {σ = y ∷ʳ σ} = cong (y ∷ʳ_) ⊆-trans-∷ˡ⁻ᵣ ⊆-trans-∷ˡ⁻ₗ : {τ : (x xs) ys} {σ : ys zs} - ⊆-trans (∷ˡ⁻ τ) σ ∷ˡ⁻ (⊆-trans τ σ) + ⊆-trans (∷ˡ⁻ τ) σ ∷ˡ⁻ (⊆-trans τ σ) ⊆-trans-∷ˡ⁻ₗ {σ = y ∷ʳ σ} = cong (y ∷ʳ_) ⊆-trans-∷ˡ⁻ₗ ⊆-trans-∷ˡ⁻ₗ {τ = y ∷ʳ τ} {σ = refl σ} = cong (y ∷ʳ_) ⊆-trans-∷ˡ⁻ₗ ⊆-trans-∷ˡ⁻ₗ {τ = refl τ} {σ = refl σ} = refl ⊆-∷ˡ⁻trans-∷ : {τ : xs ys} {σ : (y ys) zs} - ∷ˡ⁻ (⊆-trans (refl τ) σ) ⊆-trans (y ∷ʳ τ) σ + ∷ˡ⁻ (⊆-trans (refl τ) σ) ⊆-trans (y ∷ʳ τ) σ ⊆-∷ˡ⁻trans-∷ {σ = y ∷ʳ σ} = cong (y ∷ʳ_) ⊆-∷ˡ⁻trans-∷ ⊆-∷ˡ⁻trans-∷ {σ = refl σ} = refl @@ -183,14 +183,14 @@ from∈∘to∈ : (τ : x xs ys) from∈ (to∈ τ) ⊆-trans (refl minimum xs) τ -from∈∘to∈ (x≡y τ) = cong (x≡y ∷_) ([]⊆-irrelevant _ _) +from∈∘to∈ (x≡y τ) = cong (x≡y ∷_) ([]⊆-irrelevant _ _) from∈∘to∈ (y ∷ʳ τ) = cong (y ∷ʳ_) (from∈∘to∈ τ) from∈∘lookup : (τ : xs ys) (i : x xs) from∈ (lookup τ i) ⊆-trans (from∈ i) τ from∈∘lookup (y ∷ʳ τ) i = cong (y ∷ʳ_) (from∈∘lookup τ i) from∈∘lookup (_ τ) (there i) = cong (_ ∷ʳ_) (from∈∘lookup τ i) -from∈∘lookup (refl τ) (here refl) = cong (refl ∷_) ([]⊆-irrelevant _ _) +from∈∘lookup (refl τ) (here refl) = cong (refl ∷_) ([]⊆-irrelevant _ _) ------------------------------------------------------------------------ -- Weak pushout (wpo) diff --git a/master/Data.List.Relation.Binary.Sublist.Setoid.Properties.html b/master/Data.List.Relation.Binary.Sublist.Setoid.Properties.html index fcd0057fe8..6b5704d47d 100644 --- a/master/Data.List.Relation.Binary.Sublist.Setoid.Properties.html +++ b/master/Data.List.Relation.Binary.Sublist.Setoid.Properties.html @@ -25,362 +25,374 @@ open import Function.Bundles using (_⇔_; _⤖_) open import Level open import Relation.Binary.Definitions using () renaming (Decidable to Decidable₂) -open import Relation.Binary.PropositionalEquality.Core as - using (_≡_; refl; sym; cong; cong₂) -open import Relation.Binary.Structures using (IsDecTotalOrder) -open import Relation.Unary using (Pred; Decidable; Universal; Irrelevant) -open import Relation.Nullary.Negation using (¬_) -open import Relation.Nullary.Decidable using (¬?; yes; no) +import Relation.Binary.Properties.Setoid as SetoidProperties +open import Relation.Binary.PropositionalEquality.Core as + using (_≡_; refl; sym; cong; cong₂) +import Relation.Binary.Reasoning.Preorder as ≲-Reasoning +open import Relation.Binary.Reasoning.Syntax +open import Relation.Binary.Structures using (IsDecTotalOrder) +open import Relation.Unary using (Pred; Decidable; Universal; Irrelevant) +open import Relation.Nullary.Negation using (¬_) +open import Relation.Nullary.Decidable using (¬?; yes; no) -import Data.List.Relation.Binary.Equality.Setoid as SetoidEquality -import Data.List.Relation.Binary.Sublist.Setoid as SetoidSublist -import Data.List.Relation.Binary.Sublist.Heterogeneous - as Hetero -import Data.List.Relation.Binary.Sublist.Heterogeneous.Properties - as HeteroProperties -import Data.List.Membership.Setoid as SetoidMembership +import Data.List.Relation.Binary.Equality.Setoid as SetoidEquality +import Data.List.Relation.Binary.Sublist.Setoid as SetoidSublist +import Data.List.Relation.Binary.Sublist.Heterogeneous + as Hetero +import Data.List.Relation.Binary.Sublist.Heterogeneous.Properties + as HeteroProperties +import Data.List.Membership.Setoid as SetoidMembership -open Setoid S using (_≈_; trans) renaming (Carrier to A; refl to ≈-refl) -open SetoidEquality S using (_≋_; ≋-refl; ≋-reflexive; ≋-setoid) -open SetoidSublist S hiding (map) +open Setoid S using (_≈_; trans) renaming (Carrier to A; refl to ≈-refl) +open SetoidEquality S using (_≋_; ≋-refl; ≋-reflexive; ≋-setoid) +open SetoidSublist S hiding (map) +open SetoidProperties S using (≈-preorder) -private - variable - p q r s t : Level - a b x y : A - as bs cs ds xs ys : List A - xss yss : List (List A) - P : Pred A p - Q : Pred A q - m n : +private + variable + p q r s t : Level + a b x y : A + as bs cs ds xs ys : List A + xss yss : List (List A) + P : Pred A p + Q : Pred A q + m n : ------------------------------------------------------------------------- --- Injectivity of constructors ------------------------------------------------------------------------- +------------------------------------------------------------------------ +-- Injectivity of constructors +------------------------------------------------------------------------ -module _ where +module _ where - ∷-injectiveˡ : {px qx : x y} {pxs qxs : xs ys} - ((x xs) (y ys) px pxs) (qx qxs) px qx - ∷-injectiveˡ refl = refl + ∷-injectiveˡ : {px qx : x y} {pxs qxs : xs ys} + ((x xs) (y ys) px pxs) (qx qxs) px qx + ∷-injectiveˡ refl = refl - ∷-injectiveʳ : {px qx : x y} {pxs qxs : xs ys} - ((x xs) (y ys) px pxs) (qx qxs) pxs qxs - ∷-injectiveʳ refl = refl + ∷-injectiveʳ : {px qx : x y} {pxs qxs : xs ys} + ((x xs) (y ys) px pxs) (qx qxs) pxs qxs + ∷-injectiveʳ refl = refl - ∷ʳ-injective : {pxs qxs : xs ys} y ∷ʳ pxs y ∷ʳ qxs pxs qxs - ∷ʳ-injective refl = refl + ∷ʳ-injective : {pxs qxs : xs ys} y ∷ʳ pxs y ∷ʳ qxs pxs qxs + ∷ʳ-injective refl = refl ------------------------------------------------------------------------- --- Categorical properties ------------------------------------------------------------------------- +------------------------------------------------------------------------ +-- Categorical properties +------------------------------------------------------------------------ -module _ (trans-reflˡ : {x y} (p : x y) trans ≈-refl p p) where +module _ (trans-reflˡ : {x y} (p : x y) trans ≈-refl p p) where - ⊆-trans-idˡ : (pxs : xs ys) ⊆-trans ⊆-refl pxs pxs - ⊆-trans-idˡ [] = refl - ⊆-trans-idˡ (y ∷ʳ pxs) = cong (y ∷ʳ_) (⊆-trans-idˡ pxs) - ⊆-trans-idˡ (x pxs) = cong₂ _∷_ (trans-reflˡ x) (⊆-trans-idˡ pxs) + ⊆-trans-idˡ : (pxs : xs ys) ⊆-trans ⊆-refl pxs pxs + ⊆-trans-idˡ [] = refl + ⊆-trans-idˡ (y ∷ʳ pxs) = cong (y ∷ʳ_) (⊆-trans-idˡ pxs) + ⊆-trans-idˡ (x pxs) = cong₂ _∷_ (trans-reflˡ x) (⊆-trans-idˡ pxs) -module _ (trans-reflʳ : {x y} (p : x y) trans p ≈-refl p) where +module _ (trans-reflʳ : {x y} (p : x y) trans p ≈-refl p) where - ⊆-trans-idʳ : (pxs : xs ys) ⊆-trans pxs ⊆-refl pxs - ⊆-trans-idʳ [] = refl - ⊆-trans-idʳ (y ∷ʳ pxs) = cong (y ∷ʳ_) (⊆-trans-idʳ pxs) - ⊆-trans-idʳ (x pxs) = cong₂ _∷_ (trans-reflʳ x) (⊆-trans-idʳ pxs) + ⊆-trans-idʳ : (pxs : xs ys) ⊆-trans pxs ⊆-refl pxs + ⊆-trans-idʳ [] = refl + ⊆-trans-idʳ (y ∷ʳ pxs) = cong (y ∷ʳ_) (⊆-trans-idʳ pxs) + ⊆-trans-idʳ (x pxs) = cong₂ _∷_ (trans-reflʳ x) (⊆-trans-idʳ pxs) -module _ (≈-assoc : {w x y z} (p : w x) (q : x y) (r : y z) - trans p (trans q r) trans (trans p q) r) where +module _ (≈-assoc : {w x y z} (p : w x) (q : x y) (r : y z) + trans p (trans q r) trans (trans p q) r) where - ⊆-trans-assoc : (ps : as bs) (qs : bs cs) (rs : cs ds) - ⊆-trans ps (⊆-trans qs rs) ⊆-trans (⊆-trans ps qs) rs - ⊆-trans-assoc ps qs (_ ∷ʳ rs) = cong (_ ∷ʳ_) (⊆-trans-assoc ps qs rs) - ⊆-trans-assoc ps (_ ∷ʳ qs) (_ rs) = cong (_ ∷ʳ_) (⊆-trans-assoc ps qs rs) - ⊆-trans-assoc (_ ∷ʳ ps) (_ qs) (_ rs) = cong (_ ∷ʳ_) (⊆-trans-assoc ps qs rs) - ⊆-trans-assoc (p ps) (q qs) (r rs) = cong₂ _∷_ (≈-assoc p q r) (⊆-trans-assoc ps qs rs) - ⊆-trans-assoc [] [] [] = refl + ⊆-trans-assoc : (ps : as bs) (qs : bs cs) (rs : cs ds) + ⊆-trans ps (⊆-trans qs rs) ⊆-trans (⊆-trans ps qs) rs + ⊆-trans-assoc ps qs (_ ∷ʳ rs) = cong (_ ∷ʳ_) (⊆-trans-assoc ps qs rs) + ⊆-trans-assoc ps (_ ∷ʳ qs) (_ rs) = cong (_ ∷ʳ_) (⊆-trans-assoc ps qs rs) + ⊆-trans-assoc (_ ∷ʳ ps) (_ qs) (_ rs) = cong (_ ∷ʳ_) (⊆-trans-assoc ps qs rs) + ⊆-trans-assoc (p ps) (q qs) (r rs) = cong₂ _∷_ (≈-assoc p q r) (⊆-trans-assoc ps qs rs) + ⊆-trans-assoc [] [] [] = refl ------------------------------------------------------------------------- --- Various functions' outputs are sublists ------------------------------------------------------------------------- +------------------------------------------------------------------------ +-- Reasoning over sublists +------------------------------------------------------------------------ -tail-⊆ : xs Maybe.All (_⊆ xs) (tail xs) -tail-⊆ xs = HeteroProperties.tail-Sublist ⊆-refl +module ⊆-Reasoning = HeteroProperties.⊆-Reasoning ≈-preorder -take-⊆ : n xs take n xs xs -take-⊆ n xs = HeteroProperties.take-Sublist n ⊆-refl +------------------------------------------------------------------------ +-- Various functions' outputs are sublists +------------------------------------------------------------------------ -drop-⊆ : n xs drop n xs xs -drop-⊆ n xs = HeteroProperties.drop-Sublist n ⊆-refl +tail-⊆ : xs Maybe.All (_⊆ xs) (tail xs) +tail-⊆ xs = HeteroProperties.tail-Sublist ⊆-refl -module _ (P? : Decidable P) where +take-⊆ : n xs take n xs xs +take-⊆ n xs = HeteroProperties.take-Sublist n ⊆-refl - takeWhile-⊆ : xs takeWhile P? xs xs - takeWhile-⊆ xs = HeteroProperties.takeWhile-Sublist P? ⊆-refl +drop-⊆ : n xs drop n xs xs +drop-⊆ n xs = HeteroProperties.drop-Sublist n ⊆-refl - dropWhile-⊆ : xs dropWhile P? xs xs - dropWhile-⊆ xs = HeteroProperties.dropWhile-Sublist P? ⊆-refl +module _ (P? : Decidable P) where - filter-⊆ : xs filter P? xs xs - filter-⊆ xs = HeteroProperties.filter-Sublist P? ⊆-refl + takeWhile-⊆ : xs takeWhile P? xs xs + takeWhile-⊆ xs = HeteroProperties.takeWhile-Sublist P? ⊆-refl -module _ (P? : Decidable P) where + dropWhile-⊆ : xs dropWhile P? xs xs + dropWhile-⊆ xs = HeteroProperties.dropWhile-Sublist P? ⊆-refl - takeWhile⊆filter : xs takeWhile P? xs filter P? xs - takeWhile⊆filter xs = HeteroProperties.takeWhile-filter P? {xs} ≋-refl + filter-⊆ : xs filter P? xs xs + filter-⊆ xs = HeteroProperties.filter-Sublist P? ⊆-refl - filter⊆dropWhile : xs filter P? xs dropWhile (¬? P?) xs - filter⊆dropWhile xs = HeteroProperties.filter-dropWhile P? {xs} ≋-refl +module _ (P? : Decidable P) where ------------------------------------------------------------------------- --- Various list functions are increasing wrt _⊆_ ------------------------------------------------------------------------- --- We write f⁺ for the proof that `xs ⊆ ys → f xs ⊆ f ys` --- and f⁻ for the one that `f xs ⊆ f ys → xs ⊆ ys`. + takeWhile⊆filter : xs takeWhile P? xs filter P? xs + takeWhile⊆filter xs = HeteroProperties.takeWhile-filter P? {xs} ≋-refl -module _ where + filter⊆dropWhile : xs filter P? xs dropWhile (¬? P?) xs + filter⊆dropWhile xs = HeteroProperties.filter-dropWhile P? {xs} ≋-refl - ∷ˡ⁻ : a as bs as bs - ∷ˡ⁻ = HeteroProperties.∷ˡ⁻ +------------------------------------------------------------------------ +-- Various list functions are increasing wrt _⊆_ +------------------------------------------------------------------------ +-- We write f⁺ for the proof that `xs ⊆ ys → f xs ⊆ f ys` +-- and f⁻ for the one that `f xs ⊆ f ys → xs ⊆ ys`. - ∷ʳ⁻ : ¬ (a b) a as b bs a as bs - ∷ʳ⁻ = HeteroProperties.∷ʳ⁻ +module _ where - ∷⁻ : a as b bs as bs - ∷⁻ = HeteroProperties.∷⁻ + ∷ˡ⁻ : a as bs as bs + ∷ˡ⁻ = HeteroProperties.∷ˡ⁻ ------------------------------------------------------------------------- --- map + ∷ʳ⁻ : ¬ (a b) a as b bs a as bs + ∷ʳ⁻ = HeteroProperties.∷ʳ⁻ -module _ {b } (R : Setoid b ) where + ∷⁻ : a as b bs as bs + ∷⁻ = HeteroProperties.∷⁻ - open Setoid R using () renaming (Carrier to B; _≈_ to _≈′_) - open SetoidSublist R using () renaming (_⊆_ to _⊆′_) +------------------------------------------------------------------------ +-- map - map⁺ : {as bs} {f : A B} f Preserves _≈_ _≈′_ - as bs map f as ⊆′ map f bs - map⁺ {f = f} f-resp as⊆bs = - HeteroProperties.map⁺ f f (SetoidSublist.map S f-resp as⊆bs) +module _ {b } (R : Setoid b ) where ------------------------------------------------------------------------- --- _++_ + open Setoid R using () renaming (Carrier to B; _≈_ to _≈′_) + open SetoidSublist R using () renaming (_⊆_ to _⊆′_) -module _ where + map⁺ : {as bs} {f : A B} f Preserves _≈_ _≈′_ + as bs map f as ⊆′ map f bs + map⁺ {f = f} f-resp as⊆bs = + HeteroProperties.map⁺ f f (SetoidSublist.map S f-resp as⊆bs) - ++⁺ˡ : cs as bs as cs ++ bs - ++⁺ˡ = HeteroProperties.++ˡ +------------------------------------------------------------------------ +-- _++_ - ++⁺ʳ : cs as bs as bs ++ cs - ++⁺ʳ = HeteroProperties.++ʳ +module _ where - ++⁺ : as bs cs ds as ++ cs bs ++ ds - ++⁺ = HeteroProperties.++⁺ + ++⁺ˡ : cs as bs as cs ++ bs + ++⁺ˡ = HeteroProperties.++ˡ - ++⁻ : length as length bs as ++ cs bs ++ ds cs ds - ++⁻ = HeteroProperties.++⁻ + ++⁺ʳ : cs as bs as bs ++ cs + ++⁺ʳ = HeteroProperties.++ʳ ------------------------------------------------------------------------- --- concat + ++⁺ : as bs cs ds as ++ cs bs ++ ds + ++⁺ = HeteroProperties.++⁺ -module _ where + ++⁻ : length as length bs as ++ cs bs ++ ds cs ds + ++⁻ = HeteroProperties.++⁻ - concat⁺ : Hetero.Sublist _⊆_ xss yss - concat xss concat yss - concat⁺ = HeteroProperties.concat⁺ +------------------------------------------------------------------------ +-- concat - open SetoidMembership ≋-setoid using (_∈_) - open SetoidSublist ≋-setoid - using () - renaming (map to map-≋; from∈ to from∈-≋) +module _ where - xs∈xss⇒xs⊆concat[xss] : xs xss xs concat xss - xs∈xss⇒xs⊆concat[xss] {xs = xs} xs∈xss - = ⊆-trans (⊆-reflexive (≋-reflexive (sym (++-identityʳ xs)))) - (concat⁺ (map-≋ ⊆-reflexive (from∈-≋ xs∈xss))) + concat⁺ : Hetero.Sublist _⊆_ xss yss + concat xss concat yss + concat⁺ = HeteroProperties.concat⁺ - all⊆concat : (xss : List (List A)) All (_⊆ concat xss) xss - all⊆concat _ = tabulateₛ ≋-setoid xs∈xss⇒xs⊆concat[xss] + open SetoidMembership ≋-setoid using (_∈_) + open SetoidSublist ≋-setoid + using () + renaming (map to map-≋; from∈ to from∈-≋) ------------------------------------------------------------------------- --- take + xs∈xss⇒xs⊆concat[xss] : xs xss xs concat xss + xs∈xss⇒xs⊆concat[xss] {xs = xs} {xss = xss} xs∈xss = begin + xs ≈⟨ ≋-reflexive (++-identityʳ xs) + xs ++ [] ⊆⟨ concat⁺ (map-≋ ⊆-reflexive (from∈-≋ xs∈xss)) + concat xss + where open ⊆-Reasoning -module _ where + all⊆concat : (xss : List (List A)) All (_⊆ concat xss) xss + all⊆concat _ = tabulateₛ ≋-setoid xs∈xss⇒xs⊆concat[xss] - take⁺ : m n take m xs take n xs - take⁺ m≤n = HeteroProperties.take⁺ m≤n ≋-refl +------------------------------------------------------------------------ +-- take ------------------------------------------------------------------------- --- drop +module _ where -module _ where + take⁺ : m n take m xs take n xs + take⁺ m≤n = HeteroProperties.take⁺ m≤n ≋-refl - drop⁺ : m n xs ys drop m xs drop n ys - drop⁺ = HeteroProperties.drop⁺ +------------------------------------------------------------------------ +-- drop -module _ where +module _ where - drop⁺-≥ : m n drop m xs drop n xs - drop⁺-≥ m≥n = drop⁺ m≥n ⊆-refl + drop⁺ : m n xs ys drop m xs drop n ys + drop⁺ = HeteroProperties.drop⁺ -module _ where +module _ where - drop⁺-⊆ : n xs ys drop n xs drop n ys - drop⁺-⊆ n xs⊆ys = drop⁺ {n} ℕ.≤-refl xs⊆ys + drop⁺-≥ : m n drop m xs drop n xs + drop⁺-≥ m≥n = drop⁺ m≥n ⊆-refl ------------------------------------------------------------------------- --- takeWhile / dropWhile +module _ where -module _ (P? : Decidable P) (Q? : Decidable Q) where + drop⁺-⊆ : n xs ys drop n xs drop n ys + drop⁺-⊆ n xs⊆ys = drop⁺ {n} ℕ.≤-refl xs⊆ys - takeWhile⁺ : {xs} (∀ {a b} a b P a Q b) - takeWhile P? xs takeWhile Q? xs - takeWhile⁺ {xs} P⇒Q = HeteroProperties.⊆-takeWhile-Sublist P? Q? {xs} P⇒Q ≋-refl +------------------------------------------------------------------------ +-- takeWhile / dropWhile - dropWhile⁺ : {xs} (∀ {a b} a b Q b P a) - dropWhile P? xs dropWhile Q? xs - dropWhile⁺ {xs} P⇒Q = HeteroProperties.⊇-dropWhile-Sublist P? Q? {xs} P⇒Q ≋-refl +module _ (P? : Decidable P) (Q? : Decidable Q) where ------------------------------------------------------------------------- --- filter + takeWhile⁺ : {xs} (∀ {a b} a b P a Q b) + takeWhile P? xs takeWhile Q? xs + takeWhile⁺ {xs} P⇒Q = HeteroProperties.⊆-takeWhile-Sublist P? Q? {xs} P⇒Q ≋-refl -module _ (P? : Decidable P) (Q? : Decidable Q) where + dropWhile⁺ : {xs} (∀ {a b} a b Q b P a) + dropWhile P? xs dropWhile Q? xs + dropWhile⁺ {xs} P⇒Q = HeteroProperties.⊇-dropWhile-Sublist P? Q? {xs} P⇒Q ≋-refl - filter⁺ : (∀ {a b} a b P a Q b) - as bs filter P? as filter Q? bs - filter⁺ = HeteroProperties.⊆-filter-Sublist P? Q? +------------------------------------------------------------------------ +-- filter ------------------------------------------------------------------------- --- reverse +module _ (P? : Decidable P) (Q? : Decidable Q) where -module _ where + filter⁺ : (∀ {a b} a b P a Q b) + as bs filter P? as filter Q? bs + filter⁺ = HeteroProperties.⊆-filter-Sublist P? Q? - reverseAcc⁺ : as bs cs ds - reverseAcc cs as reverseAcc ds bs - reverseAcc⁺ = HeteroProperties.reverseAcc⁺ +------------------------------------------------------------------------ +-- reverse - ʳ++⁺ : as bs cs ds - as ʳ++ cs bs ʳ++ ds - ʳ++⁺ = reverseAcc⁺ +module _ where - reverse⁺ : as bs reverse as reverse bs - reverse⁺ = HeteroProperties.reverse⁺ + reverseAcc⁺ : as bs cs ds + reverseAcc cs as reverseAcc ds bs + reverseAcc⁺ = HeteroProperties.reverseAcc⁺ - reverse⁻ : reverse as reverse bs as bs - reverse⁻ = HeteroProperties.reverse⁻ + ʳ++⁺ : as bs cs ds + as ʳ++ cs bs ʳ++ ds + ʳ++⁺ = reverseAcc⁺ ------------------------------------------------------------------------- --- merge + reverse⁺ : as bs reverse as reverse bs + reverse⁺ = HeteroProperties.reverse⁺ -module _ {ℓ′} {_≤_ : Rel A ℓ′} (_≤?_ : Decidable₂ _≤_) where + reverse⁻ : reverse as reverse bs as bs + reverse⁻ = HeteroProperties.reverse⁻ - ⊆-mergeˡ : xs ys xs merge _≤?_ xs ys - ⊆-mergeˡ [] ys = minimum ys - ⊆-mergeˡ (x xs) [] = ⊆-refl - ⊆-mergeˡ (x xs) (y ys) - with x ≤? y | ⊆-mergeˡ xs (y ys) - | ⊆-mergeˡ (x xs) ys - ... | yes x≤y | rec | _ = ≈-refl rec - ... | no x≰y | _ | rec = y ∷ʳ rec +------------------------------------------------------------------------ +-- merge - ⊆-mergeʳ : xs ys ys merge _≤?_ xs ys - ⊆-mergeʳ [] ys = ⊆-refl - ⊆-mergeʳ (x xs) [] = minimum (merge _≤?_ (x xs) []) - ⊆-mergeʳ (x xs) (y ys) - with x ≤? y | ⊆-mergeʳ xs (y ys) - | ⊆-mergeʳ (x xs) ys - ... | yes x≤y | rec | _ = x ∷ʳ rec - ... | no x≰y | _ | rec = ≈-refl rec +module _ {ℓ′} {_≤_ : Rel A ℓ′} (_≤?_ : Decidable₂ _≤_) where ------------------------------------------------------------------------- --- Inversion lemmas ------------------------------------------------------------------------- + ⊆-mergeˡ : xs ys xs merge _≤?_ xs ys + ⊆-mergeˡ [] ys = minimum ys + ⊆-mergeˡ (x xs) [] = ⊆-refl + ⊆-mergeˡ (x xs) (y ys) + with x ≤? y | ⊆-mergeˡ xs (y ys) + | ⊆-mergeˡ (x xs) ys + ... | yes x≤y | rec | _ = ≈-refl rec + ... | no x≰y | _ | rec = y ∷ʳ rec -module _ where + ⊆-mergeʳ : xs ys ys merge _≤?_ xs ys + ⊆-mergeʳ [] ys = ⊆-refl + ⊆-mergeʳ (x xs) [] = minimum (merge _≤?_ (x xs) []) + ⊆-mergeʳ (x xs) (y ys) + with x ≤? y | ⊆-mergeʳ xs (y ys) + | ⊆-mergeʳ (x xs) ys + ... | yes x≤y | rec | _ = x ∷ʳ rec + ... | no x≰y | _ | rec = ≈-refl rec - ∷⁻¹ : a b as bs a as b bs - ∷⁻¹ = HeteroProperties.∷⁻¹ +------------------------------------------------------------------------ +-- Inversion lemmas +------------------------------------------------------------------------ - ∷ʳ⁻¹ : ¬ (a b) a as bs a as b bs - ∷ʳ⁻¹ = HeteroProperties.∷ʳ⁻¹ +module _ where ------------------------------------------------------------------------- --- Other ------------------------------------------------------------------------- + ∷⁻¹ : a b as bs a as b bs + ∷⁻¹ = HeteroProperties.∷⁻¹ -module _ where + ∷ʳ⁻¹ : ¬ (a b) a as bs a as b bs + ∷ʳ⁻¹ = HeteroProperties.∷ʳ⁻¹ - length-mono-≤ : as bs length as length bs - length-mono-≤ = HeteroProperties.length-mono-≤ +------------------------------------------------------------------------ +-- Other +------------------------------------------------------------------------ ------------------------------------------------------------------------- --- Conversion to and from list equality +module _ where - to-≋ : length as length bs as bs as bs - to-≋ = HeteroProperties.toPointwise + length-mono-≤ : as bs length as length bs + length-mono-≤ = HeteroProperties.length-mono-≤ ------------------------------------------------------------------------- --- Empty special case +------------------------------------------------------------------------ +-- Conversion to and from list equality - []⊆-universal : Universal ([] ⊆_) - []⊆-universal = HeteroProperties.Sublist-[]-universal + to-≋ : length as length bs as bs as bs + to-≋ = HeteroProperties.toPointwise - []⊆-irrelevant : Irrelevant ([] ⊆_) - []⊆-irrelevant = HeteroProperties.Sublist-[]-irrelevant +------------------------------------------------------------------------ +-- Empty special case ------------------------------------------------------------------------- --- (to/from)∈ is a bijection + []⊆-universal : Universal ([] ⊆_) + []⊆-universal = HeteroProperties.Sublist-[]-universal -module _ where + []⊆-irrelevant : Irrelevant ([] ⊆_) + []⊆-irrelevant = HeteroProperties.Sublist-[]-irrelevant - open SetoidMembership S using (_∈_) +------------------------------------------------------------------------ +-- (to/from)∈ is a bijection - to∈-injective : {p q : [ x ] xs} to∈ p to∈ q p q - to∈-injective = HeteroProperties.toAny-injective +module _ where - from∈-injective : {p q : x xs} from∈ p from∈ q p q - from∈-injective = HeteroProperties.fromAny-injective + open SetoidMembership S using (_∈_) - to∈∘from∈≗id : (p : x xs) to∈ (from∈ p) p - to∈∘from∈≗id = HeteroProperties.toAny∘fromAny≗id + to∈-injective : {p q : [ x ] xs} to∈ p to∈ q p q + to∈-injective = HeteroProperties.toAny-injective - [x]⊆xs⤖x∈xs : ([ x ] xs) (x xs) - [x]⊆xs⤖x∈xs = HeteroProperties.Sublist-[x]-bijection + from∈-injective : {p q : x xs} from∈ p from∈ q p q + from∈-injective = HeteroProperties.fromAny-injective ------------------------------------------------------------------------- --- Properties of Disjoint(ness) and DisjointUnion + to∈∘from∈≗id : (p : x xs) to∈ (from∈ p) p + to∈∘from∈≗id = HeteroProperties.toAny∘fromAny≗id -open HeteroProperties.Disjointness {R = _≈_} public -open HeteroProperties.DisjointnessMonotonicity {R = _≈_} {S = _≈_} {T = _≈_} trans public + [x]⊆xs⤖x∈xs : ([ x ] xs) (x xs) + [x]⊆xs⤖x∈xs = HeteroProperties.Sublist-[x]-bijection --- Shrinking one of two disjoint lists preserves disjointness. +------------------------------------------------------------------------ +-- Properties of Disjoint(ness) and DisjointUnion --- We would have liked to define shrinkDisjointˡ σ = shrinkDisjoint σ ⊆-refl --- but alas, this is only possible for groupoids, not setoids in general. +open HeteroProperties.Disjointness {R = _≈_} public +open HeteroProperties.DisjointnessMonotonicity {R = _≈_} {S = _≈_} {T = _≈_} trans public -shrinkDisjointˡ : {xs ys zs us} {τ₁ : xs zs} {τ₂ : ys zs} (σ : us xs) - Disjoint τ₁ τ₂ - Disjoint (⊆-trans σ τ₁) τ₂ --- Not affected by σ: -shrinkDisjointˡ σ (y ∷ₙ d) = y ∷ₙ shrinkDisjointˡ σ d -shrinkDisjointˡ σ (y≈z ∷ᵣ d) = y≈z ∷ᵣ shrinkDisjointˡ σ d --- In σ: keep x. -shrinkDisjointˡ (u≈x σ) (x≈z ∷ₗ d) = trans u≈x x≈z ∷ₗ shrinkDisjointˡ σ d --- Not in σ: drop x. -shrinkDisjointˡ (x ∷ʳ σ) (x≈z ∷ₗ d) = _ ∷ₙ shrinkDisjointˡ σ d -shrinkDisjointˡ [] [] = [] +-- Shrinking one of two disjoint lists preserves disjointness. -shrinkDisjointʳ : {xs ys zs vs} {τ₁ : xs zs} {τ₂ : ys zs} (σ : vs ys) - Disjoint τ₁ τ₂ - Disjoint τ₁ (⊆-trans σ τ₂) --- Not affected by σ: -shrinkDisjointʳ σ (y ∷ₙ d) = y ∷ₙ shrinkDisjointʳ σ d -shrinkDisjointʳ σ (x≈z ∷ₗ d) = x≈z ∷ₗ shrinkDisjointʳ σ d --- In σ: keep y. -shrinkDisjointʳ (v≈y σ) (y≈z ∷ᵣ d) = trans v≈y y≈z ∷ᵣ shrinkDisjointʳ σ d --- Not in σ: drop y. -shrinkDisjointʳ (y ∷ʳ σ) (y≈z ∷ᵣ d) = _ ∷ₙ shrinkDisjointʳ σ d -shrinkDisjointʳ [] [] = [] +-- We would have liked to define shrinkDisjointˡ σ = shrinkDisjoint σ ⊆-refl +-- but alas, this is only possible for groupoids, not setoids in general. + +shrinkDisjointˡ : {xs ys zs us} {τ₁ : xs zs} {τ₂ : ys zs} (σ : us xs) + Disjoint τ₁ τ₂ + Disjoint (⊆-trans σ τ₁) τ₂ +-- Not affected by σ: +shrinkDisjointˡ σ (y ∷ₙ d) = y ∷ₙ shrinkDisjointˡ σ d +shrinkDisjointˡ σ (y≈z ∷ᵣ d) = y≈z ∷ᵣ shrinkDisjointˡ σ d +-- In σ: keep x. +shrinkDisjointˡ (u≈x σ) (x≈z ∷ₗ d) = trans u≈x x≈z ∷ₗ shrinkDisjointˡ σ d +-- Not in σ: drop x. +shrinkDisjointˡ (x ∷ʳ σ) (x≈z ∷ₗ d) = _ ∷ₙ shrinkDisjointˡ σ d +shrinkDisjointˡ [] [] = [] + +shrinkDisjointʳ : {xs ys zs vs} {τ₁ : xs zs} {τ₂ : ys zs} (σ : vs ys) + Disjoint τ₁ τ₂ + Disjoint τ₁ (⊆-trans σ τ₂) +-- Not affected by σ: +shrinkDisjointʳ σ (y ∷ₙ d) = y ∷ₙ shrinkDisjointʳ σ d +shrinkDisjointʳ σ (x≈z ∷ₗ d) = x≈z ∷ₗ shrinkDisjointʳ σ d +-- In σ: keep y. +shrinkDisjointʳ (v≈y σ) (y≈z ∷ᵣ d) = trans v≈y y≈z ∷ᵣ shrinkDisjointʳ σ d +-- Not in σ: drop y. +shrinkDisjointʳ (y ∷ʳ σ) (y≈z ∷ᵣ d) = _ ∷ₙ shrinkDisjointʳ σ d +shrinkDisjointʳ [] [] = [] \ No newline at end of file diff --git a/master/Data.List.Relation.Binary.Sublist.Setoid.html b/master/Data.List.Relation.Binary.Sublist.Setoid.html index ec172364cc..5a09a0e63b 100644 --- a/master/Data.List.Relation.Binary.Sublist.Setoid.html +++ b/master/Data.List.Relation.Binary.Sublist.Setoid.html @@ -88,16 +88,16 @@ -- Relational properties holding for Setoid case ⊆-reflexive : _≋_ _⊆_ -⊆-reflexive = HeterogeneousProperties.fromPointwise +⊆-reflexive = HeterogeneousProperties.fromPointwise -open HeterogeneousProperties.Reflexivity {R = _≈_} refl public using () - renaming (refl to ⊆-refl) -- ⊆-refl : Reflexive _⊆_ +open HeterogeneousProperties.Reflexivity {R = _≈_} refl public using () + renaming (refl to ⊆-refl) -- ⊆-refl : Reflexive _⊆_ -open HeterogeneousProperties.Transitivity {R = _≈_} {S = _≈_} {T = _≈_} trans public using () - renaming (trans to ⊆-trans) -- ⊆-trans : Transitive _⊆_ +open HeterogeneousProperties.Transitivity {R = _≈_} {S = _≈_} {T = _≈_} trans public using () + renaming (trans to ⊆-trans) -- ⊆-trans : Transitive _⊆_ -open HeterogeneousProperties.Antisymmetry {R = _≈_} {S = _≈_} x≈y _ x≈y) public using () - renaming (antisym to ⊆-antisym) -- ⊆-antisym : Antisymmetric _≋_ _⊆_ +open HeterogeneousProperties.Antisymmetry {R = _≈_} {S = _≈_} x≈y _ x≈y) public using () + renaming (antisym to ⊆-antisym) -- ⊆-antisym : Antisymmetric _≋_ _⊆_ ⊆-isPreorder : IsPreorder _≋_ _⊆_ ⊆-isPreorder = record diff --git a/master/Data.List.Relation.Unary.Sorted.TotalOrder.Properties.html b/master/Data.List.Relation.Unary.Sorted.TotalOrder.Properties.html index 0e9d9599bb..5db64c4e6f 100644 --- a/master/Data.List.Relation.Unary.Sorted.TotalOrder.Properties.html +++ b/master/Data.List.Relation.Unary.Sorted.TotalOrder.Properties.html @@ -138,10 +138,10 @@ module SP = SublistProperties S ⊆-mergeˡ : xs ys xs merge _≤?_ xs ys - ⊆-mergeˡ = SP.⊆-mergeˡ _≤?_ + ⊆-mergeˡ = SP.⊆-mergeˡ _≤?_ ⊆-mergeʳ : xs ys ys merge _≤?_ xs ys - ⊆-mergeʳ = SP.⊆-mergeʳ _≤?_ + ⊆-mergeʳ = SP.⊆-mergeʳ _≤?_ ------------------------------------------------------------------------ -- filter