diff --git a/CONTRIBUTORS.toml b/CONTRIBUTORS.toml
index f011a114e6..a2f7281d57 100644
--- a/CONTRIBUTORS.toml
+++ b/CONTRIBUTORS.toml
@@ -242,3 +242,8 @@ github = "UlrikBuchholtz"
displayName = "Garrett Figueroa"
usernames = [ "Garrett Figueroa", "djspacewhale" ]
github = "djspacewhale"
+
+[[contributors]]
+displayName = "Viktor Yudov"
+usernames = [ "Viktor Yudov" ]
+github = "spcfox"
diff --git a/src/foundation-core/decidable-propositions.lagda.md b/src/foundation-core/decidable-propositions.lagda.md
index 7134f32b4b..ca6173c9fc 100644
--- a/src/foundation-core/decidable-propositions.lagda.md
+++ b/src/foundation-core/decidable-propositions.lagda.md
@@ -11,13 +11,16 @@ open import foundation.coproduct-types
open import foundation.decidable-types
open import foundation.dependent-pair-types
open import foundation.double-negation
+open import foundation.empty-types
+open import foundation.equivalences
+open import foundation.logical-equivalences
open import foundation.negation
open import foundation.propositional-truncations
+open import foundation.small-types
open import foundation.unit-type
open import foundation.universe-levels
open import foundation-core.cartesian-product-types
-open import foundation-core.empty-types
open import foundation-core.function-types
open import foundation-core.functoriality-dependent-pair-types
open import foundation-core.propositions
@@ -189,3 +192,33 @@ is-merely-decidable-is-decidable-trunc-Prop A (inl x) =
is-merely-decidable-is-decidable-trunc-Prop A (inr f) =
unit-trunc-Prop (inr (f ∘ unit-trunc-Prop))
```
+
+### TODO
+
+```agda
+-- TODO: not only for decidable
+equiv-empty-is-decidable-prop :
+ {l : Level} {A : UU l} → is-decidable-prop A → ¬ A → A ≃ empty
+equiv-empty-is-decidable-prop {l} {A} (is-p , _) contra =
+ equiv-iff (A , is-p) empty-Prop contra ex-falso
+
+-- TODO: not only for decidable
+equiv-unit-is-decidable-prop :
+ {l : Level} {A : UU l} → is-decidable-prop A → A → A ≃ unit
+equiv-unit-is-decidable-prop {l} {A} (is-p , _) a =
+ equiv-iff (A , is-p) unit-Prop (λ _ → star) (λ _ → a)
+
+equiv-empty-or-unit-is-decidable-prop :
+ {l : Level} {A : UU l} → is-decidable-prop A → (A ≃ unit) + (A ≃ empty)
+equiv-empty-or-unit-is-decidable-prop {l} {A} H@(_ , is-d) with is-d
+... | inl contra = inl (equiv-unit-is-decidable-prop H contra)
+... | inr a = inr (equiv-empty-is-decidable-prop H a)
+
+-- TODO: move to foundation
+is-small-prop-is-decidable-prop :
+ {l1 : Level} (l2 : Level) (A : UU l1) → is-decidable-prop A → is-small l2 A
+is-small-prop-is-decidable-prop l2 A H
+ with equiv-empty-or-unit-is-decidable-prop H
+... | inl e = is-small-equiv unit e (raise-unit l2 , compute-raise-unit l2)
+... | inr e = is-small-equiv empty e (raise-empty l2 , compute-raise-empty l2)
+```
diff --git a/src/foundation-core/injective-maps.lagda.md b/src/foundation-core/injective-maps.lagda.md
index ea67f3fc16..5abe1559c3 100644
--- a/src/foundation-core/injective-maps.lagda.md
+++ b/src/foundation-core/injective-maps.lagda.md
@@ -90,6 +90,11 @@ module _
is-injective h → is-injective g → is-injective (g ∘ h)
is-injective-comp is-inj-h is-inj-g = is-inj-h ∘ is-inj-g
+ injection-comp :
+ injection A B → injection B C → injection A C
+ injection-comp (f , is-inj-f) (g , is-inj-g) =
+ g ∘ f , is-injective-comp is-inj-f is-inj-g
+
is-injective-left-map-triangle :
(f : A → C) (g : B → C) (h : A → B) → f ~ (g ∘ h) →
is-injective h → is-injective g → is-injective f
diff --git a/src/foundation.lagda.md b/src/foundation.lagda.md
index 563cc1c995..28dcaf1f4a 100644
--- a/src/foundation.lagda.md
+++ b/src/foundation.lagda.md
@@ -38,6 +38,7 @@ open import foundation.binary-homotopies public
open import foundation.binary-operations-unordered-pairs-of-types public
open import foundation.binary-reflecting-maps-equivalence-relations public
open import foundation.binary-relations public
+open import foundation.binary-relations-transitive-closures public
open import foundation.binary-relations-with-extensions public
open import foundation.binary-relations-with-lifts public
open import foundation.binary-transport public
diff --git a/src/foundation/binary-relations-transitive-closures.lagda.md b/src/foundation/binary-relations-transitive-closures.lagda.md
new file mode 100644
index 0000000000..13c5a9b454
--- /dev/null
+++ b/src/foundation/binary-relations-transitive-closures.lagda.md
@@ -0,0 +1,120 @@
+# Transitive Closures
+
+```agda
+module foundation.binary-relations-transitive-closures where
+```
+
+Imports
+
+```agda
+open import foundation.binary-relations
+open import foundation.propositional-truncations
+open import foundation.universe-levels
+
+open import foundation-core.function-types
+open import foundation-core.propositions
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 : Level} {A : UU l1}
+ where
+
+ data transitive-closure (R : Relation l2 A) : Relation (l1 ⊔ l2) A
+ where
+ transitive-closure-base : {x y : A} → R x y → transitive-closure R x y
+ transitive-closure-step :
+ {x y z : A} → R x y → transitive-closure R y z → transitive-closure R x z
+
+ is-transitive-transitive-closure :
+ (R : Relation l2 A) → is-transitive (transitive-closure R)
+ is-transitive-transitive-closure
+ R x y z c-yz (transitive-closure-base r-xy) =
+ transitive-closure-step r-xy c-yz
+ is-transitive-transitive-closure
+ R x y z c-yz (transitive-closure-step {y = u} r-xu c-uy) =
+ transitive-closure-step r-xu
+ ( is-transitive-transitive-closure R u y z c-yz c-uy)
+
+ transitive-closure-preserves-reflexivity :
+ (R : Relation l2 A) →
+ is-reflexive R →
+ is-reflexive (transitive-closure R)
+ transitive-closure-preserves-reflexivity R is-refl x =
+ transitive-closure-base (is-refl x)
+
+ transitive-closure-preserves-symmetry :
+ (R : Relation l2 A) →
+ is-symmetric R →
+ is-symmetric (transitive-closure R)
+ transitive-closure-preserves-symmetry R is-sym x y
+ (transitive-closure-base r) =
+ transitive-closure-base (is-sym x y r)
+ transitive-closure-preserves-symmetry
+ R is-sym x y (transitive-closure-step {y = u} r-xu c-uy) =
+ is-transitive-transitive-closure R y u x
+ ( transitive-closure-base (is-sym x u r-xu))
+ ( transitive-closure-preserves-symmetry R is-sym u y c-uy)
+```
+
+### Transitive closure of a relation valued in propositions
+
+```agda
+ transitive-closure-Prop :
+ (R : Relation-Prop l2 A) → Relation-Prop (l1 ⊔ l2) A
+ transitive-closure-Prop R x y =
+ trunc-Prop (transitive-closure (type-Relation-Prop R) x y)
+
+ is-transitive-transitive-closure-Prop :
+ (R : Relation-Prop l2 A) →
+ is-transitive-Relation-Prop (transitive-closure-Prop R)
+ is-transitive-transitive-closure-Prop R x y z c-yz c-xy =
+ apply-twice-universal-property-trunc-Prop
+ ( c-yz)
+ ( c-xy)
+ ( transitive-closure-Prop R x z)
+ ( λ r-yz r-xy →
+ unit-trunc-Prop
+ ( is-transitive-transitive-closure
+ ( type-Relation-Prop R)
+ ( x)
+ ( y)
+ ( z)
+ ( r-yz)
+ ( r-xy)))
+
+ transitive-closure-Prop-preserves-reflexivity :
+ (R : Relation-Prop l2 A) →
+ is-reflexive-Relation-Prop R →
+ is-reflexive-Relation-Prop (transitive-closure-Prop R)
+ transitive-closure-Prop-preserves-reflexivity R is-refl x =
+ unit-trunc-Prop
+ ( transitive-closure-preserves-reflexivity
+ ( type-Relation-Prop R)
+ ( is-refl)
+ ( x))
+
+ transitive-closure-Prop-preserves-symmetry :
+ (R : Relation-Prop l2 A) →
+ is-symmetric-Relation-Prop R →
+ is-symmetric-Relation-Prop (transitive-closure-Prop R)
+ transitive-closure-Prop-preserves-symmetry R is-sym x y =
+ map-universal-property-trunc-Prop
+ ( transitive-closure-Prop R y x)
+ ( λ r-xy →
+ unit-trunc-Prop
+ ( transitive-closure-preserves-symmetry
+ ( type-Relation-Prop R)
+ ( is-sym)
+ ( x)
+ ( y)
+ ( r-xy)))
+```
diff --git a/src/foundation/decidable-types.lagda.md b/src/foundation/decidable-types.lagda.md
index 3bed2fac28..9ef913eedd 100644
--- a/src/foundation/decidable-types.lagda.md
+++ b/src/foundation/decidable-types.lagda.md
@@ -270,3 +270,15 @@ module _
is-decidable-raise (inl p) = inl (map-raise p)
is-decidable-raise (inr np) = inr (λ p' → np (map-inv-raise p'))
```
+
+### For decidable type `Q` `¬ Q → ¬ P` implies `P → Q`
+
+```agda
+contraposition-is-decidable :
+ {l1 l2 : Level} {P : UU l1} {Q : UU l2} →
+ is-decidable Q →
+ (¬ Q → ¬ P) →
+ P → Q
+contraposition-is-decidable {Q = Q} (inl q) f p = q
+contraposition-is-decidable {Q = Q} (inr nq) f p = ex-falso (f nq p)
+```
diff --git a/src/foundation/equivalence-classes.lagda.md b/src/foundation/equivalence-classes.lagda.md
index 71954bae57..0d2aee702b 100644
--- a/src/foundation/equivalence-classes.lagda.md
+++ b/src/foundation/equivalence-classes.lagda.md
@@ -7,22 +7,29 @@ module foundation.equivalence-classes where
Imports
```agda
+open import foundation.action-on-identifications-functions
open import foundation.conjunction
+open import foundation.constant-type-families
+open import foundation.dependent-identifications
open import foundation.dependent-pair-types
open import foundation.effective-maps-equivalence-relations
+open import foundation.equality-dependent-pair-types
open import foundation.existential-quantification
open import foundation.functoriality-propositional-truncation
open import foundation.fundamental-theorem-of-identity-types
+open import foundation.homotopies
open import foundation.inhabited-subtypes
open import foundation.locally-small-types
open import foundation.logical-equivalences
open import foundation.propositional-truncations
open import foundation.reflecting-maps-equivalence-relations
+open import foundation.sets
open import foundation.slice
open import foundation.small-types
open import foundation.subtype-identity-principle
open import foundation.subtypes
open import foundation.surjective-maps
+open import foundation.transport-along-identifications
open import foundation.universal-property-image
open import foundation.universe-levels
@@ -30,10 +37,10 @@ open import foundation-core.cartesian-product-types
open import foundation-core.embeddings
open import foundation-core.equivalence-relations
open import foundation-core.equivalences
+open import foundation-core.function-types
open import foundation-core.functoriality-dependent-pair-types
open import foundation-core.identity-types
open import foundation-core.propositions
-open import foundation-core.sets
open import foundation-core.torsorial-type-families
```
@@ -137,6 +144,9 @@ module _
is-set-equivalence-class =
is-set-type-subtype is-equivalence-class-Prop is-set-subtype
+ is-in-self-equivalence-class : (a : A) → is-in-equivalence-class (class a) a
+ is-in-self-equivalence-class a = refl-equivalence-relation R a
+
equivalence-class-Set : Set (l1 ⊔ lsuc l2)
pr1 equivalence-class-Set = equivalence-class
pr2 equivalence-class-Set = is-set-equivalence-class
@@ -383,6 +393,199 @@ module _
map-inv-equiv (is-effective-class x y)
```
+### TODO: title
+
+```agda
+ is-retraction-apply-effectiveness-class :
+ (x y : A) →
+ apply-effectiveness-class' {x} {y} ∘ apply-effectiveness-class {x} {y} ~ id
+ is-retraction-apply-effectiveness-class x y p =
+ eq-is-prop (is-set-equivalence-class R (class R x) (class R y))
+
+ eq-class-in-common-class :
+ (c : equivalence-class R) {a a' : A} →
+ is-in-equivalence-class R c a →
+ is-in-equivalence-class R c a' →
+ class R a = class R a'
+ eq-class-in-common-class c {a} {a'} a-in-c a'-in-c =
+ equational-reasoning
+ class R a
+ = c by eq-effective-quotient' a c a-in-c
+ = class R a' by inv (eq-effective-quotient' a' c a'-in-c)
+
+ -- sim-equivalence-relation-in-class :
+ -- {a a' : A} →
+ -- is-in-equivalence-class R (class R a) a' →
+ -- sim-equivalence-relation R a a'
+ -- sim-equivalence-relation-in-class {a} {a'} a'-in-c =
+ -- apply-effectiveness-class
+ -- ( eq-class-in-common-class (class R a') {! !} {! !})
+ -- -- apply-effectiveness-class (eq-class-in-common-class c a-in-c a'-in-c)
+
+ sim-equivalence-relation-in-same-class :
+ (c : equivalence-class R) {a a' : A} →
+ is-in-equivalence-class R c a →
+ is-in-equivalence-class R c a' →
+ sim-equivalence-relation R a a'
+ sim-equivalence-relation-in-same-class c {a} {a'} a-in-c a'-in-c =
+ apply-effectiveness-class (eq-class-in-common-class c a-in-c a'-in-c)
+
+ sim-equivalence-relation-in-class :
+ {a a' : A} →
+ is-in-equivalence-class R (class R a) a' →
+ sim-equivalence-relation R a a'
+ sim-equivalence-relation-in-class {a} {a'} a'-in-c =
+ sim-equivalence-relation-in-same-class
+ ( class R a)
+ ( is-in-self-equivalence-class R a)
+ ( a'-in-c)
+```
+
+### TODO: Eliminator
+
+```agda
+ module _
+ {l3 : Level} (B : equivalence-class R → Set l3)
+ (f : (a : A) → type-Set (B (class R a)))
+ (H :
+ (a a' : A) →
+ (s : sim-equivalence-relation R a a') →
+ dependent-identification
+ ( type-Set ∘ B)
+ ( apply-effectiveness-class' s)
+ ( f a)
+ ( f a'))
+ where
+
+ private
+ b : equivalence-class R → UU (l1 ⊔ l2 ⊔ l3)
+ b c =
+ Σ ( type-Set (B c))
+ ( λ b →
+ (a : A) →
+ (a-in-c : is-in-equivalence-class R c a) →
+ tr (type-Set ∘ B) (eq-class-equivalence-class R c a-in-c) (f a) = b)
+
+ is-prop-b : (c : equivalence-class R) → is-prop (b c)
+ is-prop-b c =
+ is-prop-all-elements-equal
+ ( λ (b , h) (b' , h') →
+ ( eq-pair-Σ
+ ( apply-universal-property-trunc-Prop
+ ( is-inhabited-subtype-equivalence-class R c)
+ ( b = b' , is-set-type-Set (B c) b b')
+ ( λ (a , a-in-c) → inv (h a a-in-c) ∙ h' a a-in-c))
+ ( eq-is-prop
+ ( is-prop-Π
+ ( λ a →
+ ( is-prop-Π
+ ( λ a-in-c →
+ ( is-set-type-Set (B c)
+ ( tr (type-Set ∘ B)
+ ( eq-class-equivalence-class R c a-in-c)
+ ( f a))
+ ( b')))))))))
+
+ b-instance-class : (a : A) → b (class R a)
+ pr1 (b-instance-class a) = f a
+ pr2 (b-instance-class a) a' a'-in-c =
+ equational-reasoning
+ tr (type-Set ∘ B) _ (f a')
+ = tr (type-Set ∘ B) _ (f a')
+ by
+ ap
+ ( λ p → tr (type-Set ∘ B) p (f a'))
+ ( eq-is-prop (is-set-equivalence-class R _ _))
+ = f a by inv-dependent-identification _ _ (H a a' a'-in-c)
+
+ b-instance : (c : equivalence-class R) → b c
+ b-instance c =
+ apply-universal-property-trunc-Prop
+ ( is-inhabited-subtype-equivalence-class R c)
+ ( b c , is-prop-b c)
+ ( λ (a , a-in-c) →
+ ( tr b (eq-effective-quotient' a c a-in-c) (b-instance-class a)))
+
+ ind-equivalence-class : (c : equivalence-class R) → type-Set (B c)
+ ind-equivalence-class = pr1 ∘ b-instance
+
+ compute-ind-equivalence-class :
+ (a : A) → ind-equivalence-class (class R a) = f a
+ compute-ind-equivalence-class a =
+ ap pr1
+ { x = b-instance (class R a)}
+ { y = b-instance-class a}
+ ( eq-is-prop (is-prop-b (class R a)))
+
+ rec-equivalence-class :
+ {l3 : Level} (B : Set l3) →
+ (f : A → type-Set B) →
+ ((a a' : A) → sim-equivalence-relation R a a' → f a = f a') →
+ equivalence-class R → type-Set B
+ rec-equivalence-class {l3} B f H =
+ ind-equivalence-class (λ _ → B) f
+ -- TODO: duplicate code
+ ( λ a a' s →
+ equational-reasoning
+ tr (type-Set ∘ (λ _ → B)) (apply-effectiveness-class' s) (f a)
+ = f a
+ by tr-constant-type-family (apply-effectiveness-class' s) (f a)
+ = f a'
+ by H a a' s)
+
+ ind-equivalence-class-prop :
+ {l3 : Level} (B : equivalence-class R → Prop l3) →
+ (f : (a : A) → type-Prop (B (class R a))) →
+ (c : equivalence-class R) → type-Prop (B c)
+ ind-equivalence-class-prop B f =
+ ind-equivalence-class (λ a → set-Prop (B a)) f
+ ( λ a a' _ → eq-is-prop (is-prop-type-Prop (B (class R a'))))
+
+ rec-equivalence-class-prop :
+ {l3 : Level} (B : Prop l3) →
+ (f : A → type-Prop B) →
+ equivalence-class R → type-Prop B
+ rec-equivalence-class-prop B f =
+ rec-equivalence-class (set-Prop B) f
+ ( λ a a' _ → eq-is-prop (is-prop-type-Prop B))
+
+ compute-rec-equivalence-class :
+ {l3 : Level} (B : Set l3) →
+ (f : A → type-Set B) →
+ (H : (a a' : A) → sim-equivalence-relation R a a' → f a = f a') →
+ (a : A) →
+ rec-equivalence-class B f H (class R a) = f a
+ compute-rec-equivalence-class B f H =
+ compute-ind-equivalence-class (λ _ → B) f
+ -- TODO: duplicate code
+ ( λ a a' s →
+ equational-reasoning
+ tr (type-Set ∘ (λ _ → B)) (apply-effectiveness-class' s) (f a)
+ = f a
+ by tr-constant-type-family (apply-effectiveness-class' s) (f a)
+ = f a'
+ by H a a' s)
+
+ compute-rec-equivalence-class' :
+ {l3 : Level} (B : Set l3) →
+ (f : A → type-Set B) →
+ (H : (a a' : A) → sim-equivalence-relation R a a' → f a = f a') →
+ (c : equivalence-class R) →
+ (a : A) →
+ (a-in-c : is-in-equivalence-class R c a) →
+ rec-equivalence-class B f H c = f a
+ compute-rec-equivalence-class' B f H c a a-in-c =
+ equational-reasoning
+ rec-equivalence-class B f H c
+ = rec-equivalence-class B f H (class R a)
+ by
+ ap
+ ( rec-equivalence-class B f H)
+ ( inv (eq-effective-quotient' a c a-in-c))
+ = f a
+ by compute-rec-equivalence-class B f H a
+```
+
### The map `class` into the type of equivalence classes is surjective and effective
```agda
diff --git a/src/foundation/injective-maps.lagda.md b/src/foundation/injective-maps.lagda.md
index 38991f22b2..d8e2ce7c56 100644
--- a/src/foundation/injective-maps.lagda.md
+++ b/src/foundation/injective-maps.lagda.md
@@ -9,16 +9,23 @@ open import foundation-core.injective-maps public
Imports
```agda
+open import foundation.decidable-types
open import foundation.dependent-pair-types
+open import foundation.functoriality-propositional-truncation
+open import foundation.inhabited-types
open import foundation.logical-equivalences
+open import foundation.surjective-maps
open import foundation.universe-levels
+open import foundation-core.coproduct-types
open import foundation-core.embeddings
open import foundation-core.empty-types
+open import foundation-core.fibers-of-maps
open import foundation-core.identity-types
open import foundation-core.negation
open import foundation-core.propositional-maps
open import foundation-core.propositions
+open import foundation-core.retractions
open import foundation-core.sets
```
@@ -104,3 +111,34 @@ module _
pr1 (is-injective-Prop H f) = is-injective f
pr2 (is-injective-Prop H f) = is-prop-is-injective H f
```
+
+### TODO: Title
+
+```agda
+module _
+ {l1 l2 : Level} {A : UU l1} {B : UU l2}
+ (f : A → B)
+ (is-injective-f : is-injective f)
+ (dec : (b : B) → is-decidable (fiber f b))
+ where
+
+ retraction-is-injective : A → retraction f
+ pr1 (retraction-is-injective a0) b with dec b
+ ... | inl (a , _) = a
+ ... | inr _ = a0
+ pr2 (retraction-is-injective _) a with dec (f a)
+ ... | inl (a , eq) = is-injective-f eq
+ ... | inr contra = ex-falso (contra (a , refl))
+
+ surjective-is-injective : A → B ↠ A
+ pr1 (surjective-is-injective a) =
+ map-retraction f (retraction-is-injective a)
+ pr2 (surjective-is-injective a) =
+ is-surjective-has-section
+ ( pair f
+ ( is-retraction-map-retraction f
+ ( retraction-is-injective a)))
+
+ is-inhabited-inv-surjections : is-inhabited A → is-inhabited (B ↠ A)
+ is-inhabited-inv-surjections = map-trunc-Prop surjective-is-injective
+```
diff --git a/src/foundation/intersections-subtypes.lagda.md b/src/foundation/intersections-subtypes.lagda.md
index 3ff9cc3f3b..2838e427d0 100644
--- a/src/foundation/intersections-subtypes.lagda.md
+++ b/src/foundation/intersections-subtypes.lagda.md
@@ -10,13 +10,15 @@ module foundation.intersections-subtypes where
open import foundation.conjunction
open import foundation.decidable-subtypes
open import foundation.dependent-pair-types
+open import foundation.identity-types
open import foundation.large-locale-of-subtypes
open import foundation.powersets
+open import foundation.subtypes
+open import foundation.transport-along-identifications
open import foundation.universe-levels
open import foundation-core.decidable-propositions
open import foundation-core.propositions
-open import foundation-core.subtypes
open import order-theory.greatest-lower-bounds-large-posets
```
@@ -59,6 +61,9 @@ module _
pr1 (p x r)
pr2 (pr2 (is-greatest-binary-lower-bound-intersection-subtype R) p) x r =
pr2 (p x r)
+
+ infixr 15 _∩_
+ _∩_ = intersection-subtype
```
### The intersection of two decidable subtypes
@@ -85,3 +90,118 @@ module _
{I : UU l2} (P : I → subtype l3 X) → subtype (l2 ⊔ l3) X
intersection-family-of-subtypes {I} P x = Π-Prop I (λ i → P i x)
```
+
+## TODO: Change title
+
+```agda
+-- It's too simple =)
+-- module _
+-- {l1 l2 l3 : Level} {X : UU l1} (P : subtype l2 X) (Q : subtype l3 X)
+-- where
+
+-- is-commutative-subtype-intersection :
+-- P ∩ Q ⊆ Q ∩ P
+-- is-commutative-subtype-intersection x (in-P , in-Q) = in-Q , in-P
+
+module _
+ {l1 l2 l3 : Level} {X : UU l1} (P : subtype l2 X) (Q : subtype l3 X)
+ where
+
+ subtype-intersection-left : P ∩ Q ⊆ P
+ subtype-intersection-left _ = pr1
+
+ subtype-intersection-right : P ∩ Q ⊆ Q
+ subtype-intersection-right _ = pr2
+
+ subtype-both-intersection :
+ {l4 : Level} (S : subtype l4 X) →
+ S ⊆ P → S ⊆ Q → S ⊆ P ∩ Q
+ pr1 (subtype-both-intersection S S-sub-P S-sub-Q x in-S) = S-sub-P x in-S
+ pr2 (subtype-both-intersection S S-sub-P S-sub-Q x in-S) = S-sub-Q x in-S
+
+ intersection-subtype-left-subtype : P ⊆ Q → P ⊆ P ∩ Q
+ intersection-subtype-left-subtype P-sub-Q =
+ subtype-both-intersection P (refl-leq-subtype P) P-sub-Q
+
+ intersection-subtype-right-subtype : Q ⊆ P → Q ⊆ P ∩ Q
+ intersection-subtype-right-subtype Q-sub-P =
+ subtype-both-intersection Q Q-sub-P (refl-leq-subtype Q)
+
+ equiv-intersection-subtype-left :
+ P ⊆ Q → equiv-subtypes (P ∩ Q) P
+ equiv-intersection-subtype-left P-sub-Q =
+ equiv-antisymmetric-leq-subtype
+ ( P ∩ Q)
+ ( P)
+ ( subtype-intersection-left)
+ ( intersection-subtype-left-subtype P-sub-Q)
+
+ equiv-intersection-subtype-right :
+ Q ⊆ P → equiv-subtypes (P ∩ Q) Q
+ equiv-intersection-subtype-right Q-sub-P =
+ equiv-antisymmetric-leq-subtype
+ ( P ∩ Q)
+ ( Q)
+ ( subtype-intersection-right)
+ ( intersection-subtype-right-subtype Q-sub-P)
+
+module _
+ {l1 : Level} {X : UU l1}
+ where
+
+ is-reflexivity-intersection :
+ {l2 : Level} (P : subtype l2 X) → P ∩ P = P
+ is-reflexivity-intersection P =
+ antisymmetric-leq-subtype _ _
+ ( subtype-intersection-left P P)
+ ( subtype-both-intersection
+ ( P)
+ ( P)
+ ( P)
+ ( refl-leq-subtype P)
+ ( refl-leq-subtype P))
+
+ is-commutative-subtype-intersection :
+ {l2 l3 : Level} (P : subtype l2 X) (Q : subtype l3 X) →
+ P ∩ Q ⊆ Q ∩ P
+ is-commutative-subtype-intersection P Q =
+ subtype-both-intersection Q P
+ ( P ∩ Q)
+ ( subtype-intersection-right P Q)
+ ( subtype-intersection-left P Q)
+
+ is-commutative-intersection :
+ {l2 l3 : Level} (P : subtype l2 X) (Q : subtype l3 X) →
+ P ∩ Q = Q ∩ P
+ is-commutative-intersection P Q =
+ antisymmetric-leq-subtype _ _
+ ( is-commutative-subtype-intersection P Q)
+ ( is-commutative-subtype-intersection Q P)
+
+ intersection-subtype-left-sublevels :
+ {l2 : Level} (l3 : Level) (P : subtype (l2 ⊔ l3) X) (Q : subtype l2 X) →
+ P ⊆ Q → P ∩ Q = P
+ intersection-subtype-left-sublevels _ P Q P-sub-Q =
+ antisymmetric-leq-subtype _ _
+ ( subtype-intersection-left P Q)
+ ( intersection-subtype-left-subtype P Q P-sub-Q)
+
+ intersection-subtype-right-sublevels :
+ {l2 : Level} (l3 : Level) (P : subtype l2 X) (Q : subtype (l2 ⊔ l3) X) →
+ Q ⊆ P → P ∩ Q = Q
+ intersection-subtype-right-sublevels l3 P Q Q-sub-P =
+ tr
+ ( _= Q)
+ ( is-commutative-intersection Q P)
+ ( intersection-subtype-left-sublevels l3 Q P Q-sub-P)
+
+ intersection-subtype-left :
+ {l2 : Level} (P Q : subtype l2 X) →
+ P ⊆ Q → P ∩ Q = P
+ intersection-subtype-left = intersection-subtype-left-sublevels lzero
+
+ intersection-subtype-right :
+ {l2 : Level} (P Q : subtype l2 X) →
+ Q ⊆ P → P ∩ Q = Q
+ intersection-subtype-right = intersection-subtype-right-sublevels lzero
+```
diff --git a/src/foundation/law-of-excluded-middle.lagda.md b/src/foundation/law-of-excluded-middle.lagda.md
index d82d58a594..bad4ef5d35 100644
--- a/src/foundation/law-of-excluded-middle.lagda.md
+++ b/src/foundation/law-of-excluded-middle.lagda.md
@@ -7,15 +7,24 @@ module foundation.law-of-excluded-middle where
Imports
```agda
+open import foundation.booleans
+open import foundation.decidable-propositions
open import foundation.decidable-types
open import foundation.dependent-pair-types
+open import foundation.propositions
+open import foundation.raising-universe-levels
+open import foundation.small-types
+open import foundation.subtypes
open import foundation.universe-levels
-open import foundation-core.decidable-propositions
+open import foundation-core.coproduct-types
+open import foundation-core.equality-dependent-pair-types
+open import foundation-core.equivalences
+open import foundation-core.identity-types
open import foundation-core.negation
-open import foundation-core.propositions
open import univalent-combinatorics.2-element-types
+open import univalent-combinatorics.finite-types
```
@@ -29,12 +38,42 @@ The {{#concept "law of excluded middle" Agda=LEM}} asserts that any
## Definition
```agda
-LEM : (l : Level) → UU (lsuc l)
-LEM l = (P : Prop l) → is-decidable (type-Prop P)
+module _
+ (l : Level)
+ where
+
+ LEM-Prop : Prop (lsuc l)
+ LEM-Prop = Π-Prop (Prop l) is-decidable-Prop
+
+ LEM : UU (lsuc l)
+ LEM = type-Prop LEM-Prop
+
+apply-LEM : {l : Level} → LEM l → {P : UU l} → is-prop P → is-decidable P
+apply-LEM lem {P} is-prop-P = lem (P , is-prop-P)
```
## Properties
+-- implies contraposition
+
+### The law of excluded middle implies the contraposition of a proposition
+
+```agda
+contraposition :
+ {l1 l2 : Level} → LEM l2 → {P : UU l1} (Q : Prop l2) →
+ (¬ (type-Prop Q) → ¬ P) →
+ P → type-Prop Q
+contraposition lem Q = contraposition-is-decidable (lem Q)
+```
+
+### TODO
+
+```agda
+lower-LEM : {l1 : Level} (l2 : Level) → LEM (l1 ⊔ l2) → LEM l1
+lower-LEM l2 lem P =
+ is-decidable-equiv (compute-raise l2 (type-Prop P)) (lem (raise-Prop l2 P))
+```
+
### Given LEM, we obtain a map from the type of propositions to the type of decidable propositions
```agda
@@ -45,6 +84,62 @@ pr1 (pr2 (decidable-prop-Prop lem P)) = is-prop-type-Prop P
pr2 (pr2 (decidable-prop-Prop lem P)) = lem P
```
+### Given LEM, Prop equiv Decidable-Prop
+
+```agda
+prop-equiv-decidable-prop :
+ {l : Level} → LEM l → Prop l ≃ Decidable-Prop l
+prop-equiv-decidable-prop lem =
+ pair
+ ( decidable-prop-Prop lem)
+ ( is-equiv-is-invertible
+ ( prop-Decidable-Prop)
+ ( λ P →
+ ( eq-pair-Σ
+ ( refl)
+ ( eq-is-prop (is-prop-is-decidable-prop (type-Decidable-Prop P)))))
+ ( λ P → eq-pair-Σ refl (eq-is-prop (is-prop-is-prop (type-Prop P)))))
+
+is-finite-Prop-LEM : {l : Level} → LEM l → is-finite (Prop l)
+is-finite-Prop-LEM lem =
+ is-finite-equiv'
+ ( equiv-bool-Decidable-Prop ∘e prop-equiv-decidable-prop lem)
+ ( is-finite-bool)
+
+is-small-Prop-LEM : {l1 : Level} (l2 : Level) → LEM l1 → is-small l2 (Prop l1)
+is-small-Prop-LEM {l1} l2 lem =
+ is-small-equiv
+ ( Decidable-Prop l1)
+ ( prop-equiv-decidable-prop lem)
+ ( is-small-Decidable-Prop l1 l2)
+
+is-small-type-Prop-LEM :
+ {l1 : Level} (l2 : Level) → LEM l1 → (P : Prop l1) → is-small l2 (type-Prop P)
+is-small-type-Prop-LEM l2 lem P =
+ is-small-prop-is-decidable-prop l2 (type-Prop P) (is-prop-type-Prop P , lem P)
+
+-- is-small-type-Prop-LEM :
+-- {l1 : Level} (l2 : Level) → LEM l1 → is-small l2 (type-Prop l1)
+-- is-small-type-Prop-LEM {l1} {l2} lem =
+-- ?
+-- -- is-small-Π
+-- -- (is-small-Prop-LEM l2 lem)
+-- -- (λ P → is-small-Π (is-small-Prop-LEM l2 lem) (λ _ → is-small-Prop-LEM l2 lem))
+```
+
+### Given LEM, type subtype is small
+
+```agda
+is-small-type-subtype-LEM :
+ {l1 l2 : Level} {A : UU l1} (P : subtype l2 A) →
+ LEM l2 →
+ is-small l1 (type-subtype P)
+is-small-type-subtype-LEM {l1} {l2} {A} P lem =
+ is-small-Σ {l1} {l2} {l1} {l1}
+ (is-small' {l1} {A})
+ (λ x → is-small-type-Prop-LEM l1 lem (P x))
+```
+
### The unrestricted law of excluded middle does not hold
```agda
diff --git a/src/foundation/propositional-resizing.lagda.md b/src/foundation/propositional-resizing.lagda.md
index 46d48494aa..5b08324f27 100644
--- a/src/foundation/propositional-resizing.lagda.md
+++ b/src/foundation/propositional-resizing.lagda.md
@@ -7,9 +7,18 @@ module foundation.propositional-resizing where
Imports
```agda
+open import foundation.decidable-types
open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.negation
+open import foundation.raising-universe-levels
+open import foundation.unit-type
open import foundation.universe-levels
+open import foundation-core.coproduct-types
+open import foundation-core.equivalences
open import foundation-core.propositions
open import foundation-core.subtypes
```
@@ -35,6 +44,47 @@ propositional-resizing l1 l2 =
( λ Ω → (P : Prop l2) → Σ (pr1 Ω) (λ u → type-equiv-Prop (pr2 Ω u) P))
```
+## TODO
+
+```agda
+module _
+ {l1 l2 : Level} ((Ω , prop-resize) : propositional-resizing l1 l2)
+ where
+
+ resize : Prop l2 → Prop l1
+ resize P = pr2 Ω (pr1 (prop-resize P))
+
+ is-equiv-resize : (P : Prop l2) → type-equiv-Prop (resize P) P
+ is-equiv-resize P = pr2 (prop-resize P)
+
+unit-equiv-true :
+ {l : Level} (P : Prop l) → type-Prop P → type-equiv-Prop unit-Prop P
+pr1 (unit-equiv-true P p) _ = p
+pr2 (unit-equiv-true P p) =
+ is-equiv-has-converse-is-prop is-prop-unit (is-prop-type-Prop P) (λ _ → star)
+
+empty-equiv-false :
+ {l : Level} (P : Prop l) → ¬ (type-Prop P) → type-equiv-Prop empty-Prop P
+pr1 (empty-equiv-false P np) = ex-falso
+pr2 (empty-equiv-false P np) =
+ is-equiv-has-converse-is-prop is-prop-empty (is-prop-type-Prop P) np
+
+propositional-resizing-LEM :
+ (l1 : Level) {l2 : Level} → LEM l2 → propositional-resizing l1 l2
+pr1 (pr1 (propositional-resizing-LEM l1 lem)) = raise-unit l1 + raise-unit l1
+pr2 (pr1 (propositional-resizing-LEM l1 lem)) (inl _) = raise-unit-Prop l1
+pr2 (pr1 (propositional-resizing-LEM l1 lem)) (inr _) = raise-empty-Prop l1
+pr2 (propositional-resizing-LEM l1 lem) P with lem P
+... | inl p =
+ pair
+ ( inl raise-star)
+ ( unit-equiv-true P p ∘e inv-equiv (compute-raise l1 unit))
+... | inr np =
+ pair
+ ( inr raise-star)
+ ( empty-equiv-false P np ∘e inv-equiv (compute-raise l1 empty))
+```
+
## See also
- [The large locale of propositions](foundation.large-locale-of-propositions.md)
diff --git a/src/foundation/subtypes.lagda.md b/src/foundation/subtypes.lagda.md
index b181a9a10d..b202c8798e 100644
--- a/src/foundation/subtypes.lagda.md
+++ b/src/foundation/subtypes.lagda.md
@@ -15,6 +15,7 @@ open import foundation.equality-dependent-function-types
open import foundation.fundamental-theorem-of-identity-types
open import foundation.logical-equivalences
open import foundation.propositional-extensionality
+open import foundation.raising-universe-levels
open import foundation.universe-levels
open import foundation-core.cartesian-product-types
@@ -143,9 +144,35 @@ module _
{l1 : Level} {A : UU l1}
where
+ antisymmetric-leq-subtype :
+ {l2 : Level} (P Q : subtype l2 A) → P ⊆ Q → Q ⊆ P → P = Q
+ antisymmetric-leq-subtype P Q H K =
+ eq-has-same-elements-subtype P Q (λ x → (H x , K x))
+```
+
+### TODO: equiv subtypes
+
+```agda
+module _
+ {l1 : Level} {A : UU l1}
+ where
+
+ equiv-subtypes :
+ {l2 l3 : Level} (P : subtype l2 A) (Q : subtype l3 A) → UU (l1 ⊔ l2 ⊔ l3)
+ equiv-subtypes P Q = (x : A) → is-in-subtype P x ≃ is-in-subtype Q x
+
+ inv-equiv-subtypes :
+ {l2 l3 : Level} (P : subtype l2 A) (Q : subtype l3 A) →
+ equiv-subtypes P Q → equiv-subtypes Q P
+ inv-equiv-subtypes P Q e x = inv-equiv (e x)
+
+ id-equiv-subtypes :
+ {l2 : Level} (P : subtype l2 A) → equiv-subtypes P P
+ id-equiv-subtypes P x = id-equiv
+
equiv-antisymmetric-leq-subtype :
- {l2 l3 : Level} (P : subtype l2 A) (Q : subtype l3 A) → P ⊆ Q → Q ⊆ P →
- (x : A) → is-in-subtype P x ≃ is-in-subtype Q x
+ {l2 l3 : Level} (P : subtype l2 A) (Q : subtype l3 A) →
+ P ⊆ Q → Q ⊆ P → equiv-subtypes P Q
equiv-antisymmetric-leq-subtype P Q H K x =
equiv-iff-is-prop
( is-prop-is-in-subtype P x)
@@ -153,10 +180,16 @@ module _
( H x)
( K x)
- antisymmetric-leq-subtype :
- {l2 : Level} (P Q : subtype l2 A) → P ⊆ Q → Q ⊆ P → P = Q
- antisymmetric-leq-subtype P Q H K =
- eq-has-same-elements-subtype P Q (λ x → (H x , K x))
+ subset-equiv-subtypes :
+ {l2 l3 : Level} (P : subtype l2 A) (Q : subtype l3 A) →
+ equiv-subtypes P Q → P ⊆ Q
+ subset-equiv-subtypes P Q e x = map-equiv (e x)
+
+ inv-subset-equiv-subtypes :
+ {l2 l3 : Level} (P : subtype l2 A) (Q : subtype l3 A) →
+ equiv-subtypes P Q → Q ⊆ P
+ inv-subset-equiv-subtypes P Q =
+ subset-equiv-subtypes Q P ∘ inv-equiv-subtypes P Q
```
### The type of all subtypes of a type is a set
@@ -174,6 +207,19 @@ pr1 (subtype-Set l2 A) = subtype l2 A
pr2 (subtype-Set l2 A) = is-set-subtype
```
+### TODO: raise subtype
+
+```agda
+raise-subtype :
+ {l1 l2 : Level} {A : UU l1} (l3 : Level) → subtype l2 A → subtype (l2 ⊔ l3) A
+raise-subtype l3 P x = raise-Prop l3 (P x)
+
+compute-raise-subtype :
+ {l1 l2 : Level} {A : UU l1} (l3 : Level) (S : subtype l2 A) →
+ equiv-subtypes S (raise-subtype l3 S)
+compute-raise-subtype l3 S x = compute-raise l3 (type-Prop (S x))
+```
+
### Characterisation of embeddings into subtypes
```agda
diff --git a/src/foundation/surjective-maps.lagda.md b/src/foundation/surjective-maps.lagda.md
index a22a750dac..808d18f658 100644
--- a/src/foundation/surjective-maps.lagda.md
+++ b/src/foundation/surjective-maps.lagda.md
@@ -463,6 +463,14 @@ module _
is-surjective g → is-surjective h → is-surjective (g ∘ h)
is-surjective-comp {g} {h} =
is-surjective-left-map-triangle (g ∘ h) g h refl-htpy
+
+ surjection-comp : B ↠ X → A ↠ B → A ↠ X
+ surjection-comp g h =
+ pair
+ (map-surjection g ∘ map-surjection h)
+ (is-surjective-comp
+ ( is-surjective-map-surjection g)
+ ( is-surjective-map-surjection h))
```
### Functoriality of products preserves being surjective
diff --git a/src/foundation/unions-subtypes.lagda.md b/src/foundation/unions-subtypes.lagda.md
index f1bd0aee75..c36dd462aa 100644
--- a/src/foundation/unions-subtypes.lagda.md
+++ b/src/foundation/unions-subtypes.lagda.md
@@ -10,13 +10,16 @@ module foundation.unions-subtypes where
open import foundation.decidable-subtypes
open import foundation.dependent-pair-types
open import foundation.disjunction
+open import foundation.function-types
+open import foundation.identity-types
open import foundation.large-locale-of-subtypes
+open import foundation.logical-equivalences
open import foundation.powersets
open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.subtypes
open import foundation.universe-levels
-open import foundation-core.subtypes
-
open import order-theory.least-upper-bounds-large-posets
```
@@ -38,6 +41,9 @@ module _
union-subtype : subtype l1 X → subtype l2 X → subtype (l1 ⊔ l2) X
union-subtype P Q x = (P x) ∨ (Q x)
+
+ infixr 10 _∪_
+ _∪_ = union-subtype
```
### Unions of decidable subtypes
@@ -88,3 +94,164 @@ module _
( union-family-of-subtypes B x)
( λ (i , q) → unit-trunc-Prop (i , H i x q))
```
+
+## TODO: Change title
+
+```agda
+module _
+ {l1 l2 l3 : Level} {X : UU l1} (P : subtype l2 X) (Q : subtype l3 X)
+ where
+
+ subtype-union-left : P ⊆ P ∪ Q
+ -- subtype-union-left x = inl-disjunction-Prop (P x) (Q x)
+ subtype-union-left x = inl-disjunction
+
+ subtype-union-right : Q ⊆ P ∪ Q
+ -- subtype-union-right x = inr-disjunction-Prop (P x) (Q x)
+ subtype-union-right x = inr-disjunction
+
+ elim-union-subtype :
+ {l4 : Level} (f : X → Prop l4) →
+ ((x : X) → is-in-subtype P x → type-Prop (f x)) →
+ ((x : X) → is-in-subtype Q x → type-Prop (f x)) →
+ (x : X) → is-in-subtype (P ∪ Q) x → type-Prop (f x)
+ elim-union-subtype f H-P H-Q x = elim-disjunction (f x) (H-P x) (H-Q x)
+
+ elim-union-subtype' :
+ {l4 : Level} (R : Prop l4) →
+ ((x : X) → is-in-subtype P x → type-Prop R) →
+ ((x : X) → is-in-subtype Q x → type-Prop R) →
+ (x : X) → is-in-subtype (P ∪ Q) x → type-Prop R
+ elim-union-subtype' R = elim-union-subtype (λ _ → R)
+ -- elim-disjunction-Prop (P x) (Q x) R (H-P x , H-Q x)
+
+ subtype-union-both :
+ {l4 : Level} (S : subtype l4 X) → P ⊆ S → Q ⊆ S → P ∪ Q ⊆ S
+ subtype-union-both = elim-union-subtype
+
+module _
+ {l1 l2 l3 : Level} {X : UU l1} (P : subtype l2 X) (Q : subtype l3 X)
+ where
+
+ subset-union-comm :
+ P ∪ Q ⊆ Q ∪ P
+ subset-union-comm =
+ subtype-union-both P Q (Q ∪ P)
+ ( subtype-union-right Q P)
+ ( subtype-union-left Q P)
+
+module _
+ {l1 l2 l3 l4 : Level} {X : UU l1}
+ (P : subtype l2 X) (Q : subtype l3 X) (S : subtype l4 X)
+ where
+
+ forward-subset-union-assoc : P ∪ (Q ∪ S) ⊆ (P ∪ Q) ∪ S
+ forward-subset-union-assoc =
+ subtype-union-both P (Q ∪ S) ((P ∪ Q) ∪ S)
+ ( transitive-leq-subtype P (P ∪ Q) ((P ∪ Q) ∪ S)
+ ( subtype-union-left (P ∪ Q) S)
+ ( subtype-union-left P Q))
+ ( subtype-union-both Q S ((P ∪ Q) ∪ S)
+ ( transitive-leq-subtype Q (P ∪ Q) ((P ∪ Q) ∪ S)
+ ( subtype-union-left (P ∪ Q) S)
+ ( subtype-union-right P Q))
+ ( subtype-union-right (P ∪ Q) S))
+
+ backward-subset-union-assoc : (P ∪ Q) ∪ S ⊆ P ∪ (Q ∪ S)
+ backward-subset-union-assoc =
+ subtype-union-both (P ∪ Q) S (P ∪ (Q ∪ S))
+ ( subtype-union-both P Q (P ∪ (Q ∪ S))
+ ( subtype-union-left P (Q ∪ S))
+ ( transitive-leq-subtype Q (Q ∪ S) (P ∪ (Q ∪ S))
+ ( subtype-union-right P (Q ∪ S))
+ ( subtype-union-left Q S)))
+ ( transitive-leq-subtype S (Q ∪ S) (P ∪ (Q ∪ S))
+ ( subtype-union-right P (Q ∪ S))
+ ( subtype-union-right Q S))
+
+module _
+ {l1 : Level} {X : UU l1}
+ where
+
+ subset-union-subsets :
+ {l2 l3 l4 l5 : Level}
+ (P1 : subtype l2 X) (Q1 : subtype l3 X)
+ (P2 : subtype l4 X) (Q2 : subtype l5 X) →
+ P1 ⊆ P2 → Q1 ⊆ Q2 →
+ P1 ∪ Q1 ⊆ P2 ∪ Q2
+ subset-union-subsets P1 Q1 P2 Q2 P1-sub-P2 Q1-sub-Q2 =
+ subtype-union-both P1 Q1 (P2 ∪ Q2)
+ ( transitive-leq-subtype P1 P2 (P2 ∪ Q2)
+ ( subtype-union-left P2 Q2)
+ ( P1-sub-P2))
+ ( transitive-leq-subtype Q1 Q2 (P2 ∪ Q2)
+ ( subtype-union-right P2 Q2)
+ ( Q1-sub-Q2))
+
+ subset-union-subset-left :
+ {l2 l3 l4 : Level}
+ (P1 : subtype l2 X) (P2 : subtype l3 X) (Q : subtype l4 X) →
+ P1 ⊆ P2 →
+ P1 ∪ Q ⊆ P2 ∪ Q
+ subset-union-subset-left P1 P2 Q P1-sub-P2 =
+ subset-union-subsets P1 Q P2 Q P1-sub-P2 (refl-leq-subtype Q)
+
+ subset-union-subset-right :
+ {l2 l3 l4 : Level}
+ (P : subtype l2 X) (Q1 : subtype l3 X) (Q2 : subtype l4 X) →
+ Q1 ⊆ Q2 →
+ union-subtype P Q1 ⊆ union-subtype P Q2
+ subset-union-subset-right P Q1 Q2 Q1-sub-Q2 =
+ subset-union-subsets P Q1 P Q2 (refl-leq-subtype P) Q1-sub-Q2
+
+module _
+ {l1 l2 l3 l4 : Level} {X : UU l1}
+ (P : subtype l2 X) (Q : subtype l3 X) (S : subtype l4 X)
+ where
+
+ union-swap-1-2 :
+ P ∪ (Q ∪ S) ⊆ Q ∪ (P ∪ S)
+ union-swap-1-2 =
+ transitive-leq-subtype (P ∪ (Q ∪ S)) ((Q ∪ P) ∪ S) (Q ∪ (P ∪ S))
+ ( backward-subset-union-assoc Q P S)
+ ( transitive-leq-subtype (P ∪ (Q ∪ S)) ((P ∪ Q) ∪ S) ((Q ∪ P) ∪ S)
+ ( subset-union-subset-left (P ∪ Q) (Q ∪ P) S
+ ( subset-union-comm P Q))
+ ( forward-subset-union-assoc P Q S))
+
+module _
+ {l1 l2 : Level} {X : UU l1} (P : subtype l2 X)
+ where
+
+ subtype-union-same : union-subtype P P ⊆ P
+ subtype-union-same =
+ subtype-union-both P P P (refl-leq-subtype P) (refl-leq-subtype P)
+
+ eq-union-same : P = union-subtype P P
+ eq-union-same =
+ antisymmetric-leq-subtype
+ ( P)
+ ( union-subtype P P)
+ ( subtype-union-left P P)
+ ( subtype-union-same)
+
+module _
+ {l1 l2 : Level} {X : UU l1} (P : subtype l2 X) (Q : subtype l2 X)
+ where
+
+ eq-union-subset-left : P ⊆ Q → P ∪ Q = Q
+ eq-union-subset-left P-sub-Q =
+ antisymmetric-leq-subtype
+ ( P ∪ Q)
+ ( Q)
+ ( subtype-union-both P Q Q P-sub-Q (refl-leq-subtype Q))
+ ( subtype-union-right P Q)
+
+ eq-union-subset-right : Q ⊆ P → P ∪ Q = P
+ eq-union-subset-right Q-sub-P =
+ antisymmetric-leq-subtype
+ ( P ∪ Q)
+ ( P)
+ ( subtype-union-both P Q P (refl-leq-subtype P) Q-sub-P)
+ ( subtype-union-left P Q)
+```
diff --git a/src/lists.lagda.md b/src/lists.lagda.md
index 18b0ea48f3..380000e74e 100644
--- a/src/lists.lagda.md
+++ b/src/lists.lagda.md
@@ -11,6 +11,7 @@ open import lists.flattening-lists public
open import lists.functoriality-lists public
open import lists.lists public
open import lists.lists-discrete-types public
+open import lists.lists-subtypes public
open import lists.permutation-lists public
open import lists.permutation-vectors public
open import lists.predicates-on-lists public
diff --git a/src/lists/concatenation-lists.lagda.md b/src/lists/concatenation-lists.lagda.md
index 3607cc2fa2..18a0a0e797 100644
--- a/src/lists/concatenation-lists.lagda.md
+++ b/src/lists/concatenation-lists.lagda.md
@@ -17,6 +17,8 @@ open import foundation.identity-types
open import foundation.sets
open import foundation.universe-levels
+open import foundation-core.coproduct-types
+
open import group-theory.monoids
open import lists.lists
@@ -172,3 +174,32 @@ tail-concat-list' (cons a nil) y = refl
tail-concat-list' (cons a (cons b x)) y =
ap (cons b) (tail-concat-list' (cons b x) y)
```
+
+### TODO: Concats
+
+```agda
+in-concat-left :
+ {l : Level} {A : UU l} (l1 l2 : list A)
+ {a : A} → a ∈-list l1 → a ∈-list (concat-list l1 l2)
+in-concat-left _ _ (is-head a _) =
+ is-head a _
+in-concat-left _ l2 (is-in-tail a x l1 in-l1) =
+ is-in-tail a x (concat-list l1 l2) (in-concat-left l1 l2 in-l1)
+
+in-concat-right :
+ {l : Level} {A : UU l} (l1 l2 : list A)
+ {a : A} → a ∈-list l2 → a ∈-list (concat-list l1 l2)
+in-concat-right nil l2 in-l2 = in-l2
+in-concat-right (cons x l1) l2 in-l2 =
+ is-in-tail _ x (concat-list l1 l2) (in-concat-right l1 l2 in-l2)
+
+in-concat-list :
+ {l : Level} {A : UU l} (l1 l2 : list A)
+ {a : A} → a ∈-list (concat-list l1 l2) → (a ∈-list l1) + (a ∈-list l2)
+in-concat-list nil l2 {a} in-list = inr in-list
+in-concat-list (cons x l1) l2 {.x} (is-head .x _) = inl (is-head x l1)
+in-concat-list (cons x l1) l2 {a} (is-in-tail .a .x _ in-list)
+ with in-concat-list l1 l2 in-list
+... | inl in-l1 = inl (is-in-tail a x l1 in-l1)
+... | inr in-l2 = inr in-l2
+```
diff --git a/src/lists/functoriality-lists.lagda.md b/src/lists/functoriality-lists.lagda.md
index ce61ae6805..9a90d76af6 100644
--- a/src/lists/functoriality-lists.lagda.md
+++ b/src/lists/functoriality-lists.lagda.md
@@ -257,3 +257,27 @@ map-snoc-list :
map-snoc-list f nil a = refl
map-snoc-list f (cons b x) a = ap (cons (f b)) (map-snoc-list f x a)
```
+
+### TODO: maybe another file
+
+```agda
+dependent-map-list :
+ {l1 l2 : Level} {A : UU l1} {B : UU l2}
+ (l : list A) (f : (a : A) → a ∈-list l → B) →
+ list B
+dependent-map-list nil f = nil
+dependent-map-list {A = A} {B} (cons x l) f =
+ cons (f x (is-head x l)) (dependent-map-list l f')
+ where
+ f' : (a : A) → a ∈-list l → B
+ f' a list-subtype = f a (is-in-tail a x l list-subtype)
+
+in-dependent-map-list :
+ {l1 l2 : Level} {A : UU l1} {B : UU l2}
+ {l : list A} (f : (a : A) → a ∈-list l → B)
+ {a : A} (a-in-l : a ∈-list l) →
+ f a a-in-l ∈-list dependent-map-list l f
+in-dependent-map-list f (is-head _ l) = is-head _ _
+in-dependent-map-list {A = A} {B} f (is-in-tail _ x l a-in-l) =
+ is-in-tail _ _ _ (in-dependent-map-list _ a-in-l)
+```
diff --git a/src/lists/lists-subtypes.lagda.md b/src/lists/lists-subtypes.lagda.md
new file mode 100644
index 0000000000..4b0d2ab0a4
--- /dev/null
+++ b/src/lists/lists-subtypes.lagda.md
@@ -0,0 +1,237 @@
+# Lists subtypes
+
+```agda
+module lists.lists-subtypes where
+```
+
+Imports
+
+```agda
+open import foundation.decidable-types
+open import foundation.dependent-pair-types
+open import foundation.disjunction
+open import foundation.existential-quantification
+open import foundation.inhabited-subtypes
+open import foundation.intersections-subtypes
+open import foundation.logical-equivalences
+open import foundation.propositional-truncations
+open import foundation.unions-subtypes
+open import foundation.universe-levels
+
+open import foundation-core.cartesian-product-types
+open import foundation-core.coproduct-types
+open import foundation-core.empty-types
+open import foundation-core.function-types
+open import foundation-core.negation
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+
+open import lists.concatenation-lists
+open import lists.lists
+open import lists.reversing-lists
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l : Level} {A : UU l}
+ where
+
+ list-subtype : list A → subtype l A
+ list-subtype l a = trunc-Prop (a ∈-list l)
+
+ not-in-list-nil : {a : A} → ¬ (is-in-subtype (list-subtype nil) a)
+ not-in-list-nil = map-universal-property-trunc-Prop empty-Prop (λ ())
+
+ subset-list-subtype-nil :
+ {l2 : Level} (S : subtype l2 A) → list-subtype nil ⊆ S
+ subset-list-subtype-nil S _ = ex-falso ∘ not-in-list-nil
+
+ in-list-subtype-in-list :
+ {a : A} {l : list A} → a ∈-list l → is-in-subtype (list-subtype l) a
+ in-list-subtype-in-list = unit-trunc-Prop
+
+ subset-tail-list-subtype :
+ {a : A} {l : list A} → list-subtype l ⊆ list-subtype (cons a l)
+ subset-tail-list-subtype {a} {l} x =
+ map-universal-property-trunc-Prop
+ ( list-subtype (cons a l) x)
+ ( in-list-subtype-in-list ∘ is-in-tail x a l)
+
+ head-in-list-subtype :
+ {a : A} {l : list A} → is-in-subtype (list-subtype (cons a l)) a
+ head-in-list-subtype {a} {l} = in-list-subtype-in-list (is-head a l)
+
+ is-decidable-is-inhabited-list-subtype :
+ (l : list A) → is-decidable (is-inhabited-subtype (list-subtype l))
+ is-decidable-is-inhabited-list-subtype nil =
+ inr
+ ( map-universal-property-trunc-Prop
+ ( empty-Prop)
+ ( λ (x , in-list) → not-in-list-nil in-list))
+ is-decidable-is-inhabited-list-subtype (cons x xs) =
+ inl (unit-trunc-Prop (x , head-in-list-subtype))
+
+ subset-list-subtype-cons :
+ {a : A} {l : list A} →
+ {l2 : Level} (S : subtype l2 A) →
+ is-in-subtype S a →
+ list-subtype l ⊆ S →
+ list-subtype (cons a l) ⊆ S
+ subset-list-subtype-cons {a} {l} S a-in-S l-sub-S x =
+ map-universal-property-trunc-Prop
+ ( S x)
+ ( λ where
+ (is-head .x .l) → a-in-S
+ (is-in-tail .x .a .l t) → l-sub-S x (in-list-subtype-in-list t))
+
+ subset-list-subtype-reverse-list :
+ (l : list A) → list-subtype l ⊆ list-subtype (reverse-list l)
+ subset-list-subtype-reverse-list l x =
+ map-universal-property-trunc-Prop
+ ( list-subtype (reverse-list l) x)
+ ( in-list-subtype-in-list ∘ forward-contains-reverse-list x l)
+
+ subset-list-subtype-concat-union :
+ {l1 l2 : list A} →
+ list-subtype (concat-list l1 l2) ⊆ list-subtype l1 ∪ list-subtype l2
+ subset-list-subtype-concat-union {nil} {l2} =
+ subtype-union-right (list-subtype nil) (list-subtype l2)
+ subset-list-subtype-concat-union {cons x l1} {l2} =
+ subset-list-subtype-cons
+ ( list-subtype (cons x l1) ∪ list-subtype l2)
+ ( subtype-union-left (list-subtype (cons x l1)) (list-subtype l2) x
+ ( head-in-list-subtype))
+ ( transitive-leq-subtype
+ ( list-subtype (concat-list l1 l2))
+ ( list-subtype l1 ∪ list-subtype l2)
+ ( list-subtype (cons x l1) ∪ list-subtype l2)
+ ( subset-union-subset-left
+ ( list-subtype l1)
+ ( list-subtype (cons x l1))
+ ( list-subtype l2)
+ ( subset-tail-list-subtype))
+ ( subset-list-subtype-concat-union))
+
+ subset-list-subset-concat-left :
+ (l1 l2 : list A) →
+ list-subtype l1 ⊆ list-subtype (concat-list l1 l2)
+ subset-list-subset-concat-left l1 l2 x =
+ map-universal-property-trunc-Prop
+ ( list-subtype (concat-list l1 l2) x)
+ ( in-list-subtype-in-list ∘ in-concat-left l1 l2)
+
+ subset-list-subset-concat-right :
+ (l1 l2 : list A) →
+ list-subtype l2 ⊆ list-subtype (concat-list l1 l2)
+ subset-list-subset-concat-right l1 l2 x =
+ map-universal-property-trunc-Prop
+ ( list-subtype (concat-list l1 l2) x)
+ ( in-list-subtype-in-list ∘ in-concat-right l1 l2)
+
+ subset-list-subtype-union-concat :
+ {l1 l2 : list A} →
+ list-subtype l1 ∪ list-subtype l2 ⊆ list-subtype (concat-list l1 l2)
+ subset-list-subtype-union-concat {l1} {l2} =
+ subtype-union-both
+ ( list-subtype l1)
+ ( list-subtype l2)
+ ( list-subtype (concat-list l1 l2))
+ ( subset-list-subset-concat-left l1 l2)
+ ( subset-list-subset-concat-right l1 l2)
+
+ iff-subset-head-tail :
+ {l2 : Level} (x : A) (l : list A) (a : subtype l2 A) →
+ (list-subtype (cons x l) ⊆ a) ↔ is-in-subtype a x × (list-subtype l ⊆ a)
+ pr1 (pr1 (iff-subset-head-tail x l a) leq) =
+ leq x head-in-list-subtype
+ pr2 (pr1 (iff-subset-head-tail x l a) leq) =
+ transitive-leq-subtype (list-subtype l) (list-subtype (cons x l)) a
+ ( leq)
+ ( subset-tail-list-subtype)
+ pr2 (iff-subset-head-tail x xs a) (x-in-a , leq) =
+ subset-list-subtype-cons a x-in-a leq
+
+ lists-in-union-lists :
+ {l2 l3 : Level}
+ (xs : list A) (a : subtype l2 A) (b : subtype l3 A) →
+ list-subtype xs ⊆ union-subtype a b →
+ exists-structure ( list A × list A)
+ ( λ (xsl , xsr) →
+ ( list-subtype xs ⊆ list-subtype xsl ∪ list-subtype xsr) ×
+ ( list-subtype xsl ⊆ a) ×
+ ( list-subtype xsr ⊆ b))
+ lists-in-union-lists nil a b sub =
+ intro-exists (nil , nil)
+ ( triple
+ ( subset-list-subtype-nil (list-subtype nil ∪ list-subtype nil))
+ ( subset-list-subtype-nil a)
+ ( subset-list-subtype-nil b))
+ lists-in-union-lists (cons x xs) a b leq =
+ apply-universal-property-trunc-Prop
+ ( lists-in-union-lists xs a b
+ ( transitive-leq-subtype
+ ( list-subtype xs)
+ ( list-subtype (cons x xs))
+ ( union-subtype a b)
+ ( leq)
+ ( subset-tail-list-subtype)))
+ ( exists-structure-Prop _ _)
+ ( λ ((xsl , xsr) , leq-lists , leq-xsl , leq-xsr) →
+ ( elim-disjunction (exists-structure-Prop _ _)
+ ( λ x-in-a →
+ ( intro-exists (cons x xsl , xsr)
+ ( triple
+ ( subset-list-subtype-cons
+ ( list-subtype (cons x xsl) ∪ list-subtype xsr)
+ ( subtype-union-left
+ ( list-subtype (cons x xsl))
+ ( list-subtype xsr)
+ ( x)
+ ( head-in-list-subtype))
+ ( transitive-leq-subtype
+ ( list-subtype xs)
+ ( list-subtype xsl ∪ list-subtype xsr)
+ ( list-subtype (cons x xsl) ∪ list-subtype xsr)
+ ( subset-union-subset-left
+ ( list-subtype xsl)
+ ( list-subtype (cons x xsl))
+ ( list-subtype xsr)
+ ( subset-tail-list-subtype))
+ ( leq-lists)))
+ ( backward-implication (iff-subset-head-tail x xsl a)
+ ( x-in-a , leq-xsl))
+ ( leq-xsr))))
+ ( λ x-in-b →
+ ( intro-exists (xsl , cons x xsr)
+ ( triple
+ ( subset-list-subtype-cons
+ ( list-subtype xsl ∪ list-subtype (cons x xsr))
+ ( subtype-union-right
+ ( list-subtype xsl)
+ ( list-subtype (cons x xsr))
+ ( x)
+ ( head-in-list-subtype))
+ ( transitive-leq-subtype
+ ( list-subtype xs)
+ ( list-subtype xsl ∪ list-subtype xsr)
+ ( list-subtype xsl ∪ list-subtype (cons x xsr))
+ ( subset-union-subset-right
+ ( list-subtype xsl)
+ ( list-subtype xsr)
+ ( list-subtype (cons x xsr))
+ ( subset-tail-list-subtype))
+ ( leq-lists)))
+ ( leq-xsl)
+ ( backward-implication (iff-subset-head-tail x xsr b)
+ ( x-in-b , leq-xsr)))))
+ ( leq x head-in-list-subtype)))
+```
diff --git a/src/lists/lists.lagda.md b/src/lists/lists.lagda.md
index 3a019086f1..59175a778c 100644
--- a/src/lists/lists.lagda.md
+++ b/src/lists/lists.lagda.md
@@ -31,6 +31,8 @@ open import foundation.truncated-types
open import foundation.truncation-levels
open import foundation.unit-type
open import foundation.universe-levels
+
+open import univalent-combinatorics.standard-finite-types
```
@@ -125,6 +127,48 @@ is-nonnil-is-cons-list l ((a , l') , refl) q =
is-nonnil-cons-list a l' q
```
+### TODO: change title
+
+```agda
+last-in-snoc-list :
+ {l : Level} {A : UU l} (xs : list A) (x : A) → x ∈-list (snoc xs x)
+last-in-snoc-list nil x = is-head x nil
+last-in-snoc-list (cons y xs) x =
+ is-in-tail x y (snoc xs x) (last-in-snoc-list xs x)
+
+rest-in-snoc-list :
+ {l : Level} {A : UU l} (xs : list A) (x y : A) →
+ y ∈-list xs → y ∈-list (snoc xs x)
+rest-in-snoc-list (cons y xs) x .y (is-head .y .xs) = is-head y (snoc xs x)
+rest-in-snoc-list (cons y xs) x z (is-in-tail .z .y .xs in-list) =
+ is-in-tail z y (snoc xs x) (rest-in-snoc-list xs x z in-list)
+```
+
+### TODO: change title
+
+```agda
+module _
+ {l : Level} {A : UU l}
+ where
+
+ component-list : (l : list A) → Fin (length-list l) → A
+ component-list (cons x l) (inl k) = component-list l k
+ component-list (cons x l) (inr k) = x
+
+ index-in-list : (a : A) (l : list A) → a ∈-list l → Fin (length-list l)
+ index-in-list a (cons .a l) (is-head .a .l) =
+ inr star
+ index-in-list a (cons x l) (is-in-tail .a .x .l in-list) =
+ inl (index-in-list a l in-list)
+
+ eq-component-list-index-in-list :
+ (a : A) (l : list A) (in-list : a ∈-list l) →
+ a = component-list l (index-in-list a l in-list)
+ eq-component-list-index-in-list a .(cons a l) (is-head .a l) = refl
+ eq-component-list-index-in-list a .(cons x l) (is-in-tail .a x l in-list) =
+ eq-component-list-index-in-list a l in-list
+```
+
### A list that uses cons is not nil
```agda
diff --git a/src/lists/reversing-lists.lagda.md b/src/lists/reversing-lists.lagda.md
index 551bed29c5..9de38ce0a7 100644
--- a/src/lists/reversing-lists.lagda.md
+++ b/src/lists/reversing-lists.lagda.md
@@ -130,4 +130,16 @@ remove-last-element-reverse-list x =
( inv (reverse-reverse-list (remove-last-element-list (reverse-list x)))) ∙
( ( inv (ap reverse-list (tail-reverse-list (reverse-list x)))) ∙
( ap (reverse-list ∘ tail-list) (reverse-reverse-list x)))
+
+forward-contains-reverse-list :
+ {l1 : Level} {A : UU l1} (x : A) (xs : list A) →
+ (x ∈-list xs) → (x ∈-list (reverse-list xs))
+forward-contains-reverse-list x (cons .x xs) (is-head .x .xs) =
+ last-in-snoc-list (reverse-list xs) x
+forward-contains-reverse-list x (cons y xs) (is-in-tail .x .y .xs x-in-list) =
+ rest-in-snoc-list
+ ( reverse-list xs)
+ ( y)
+ ( x)
+ ( forward-contains-reverse-list x xs x-in-list)
```
diff --git a/src/modal-logic.lagda.md b/src/modal-logic.lagda.md
new file mode 100644
index 0000000000..eda8e000aa
--- /dev/null
+++ b/src/modal-logic.lagda.md
@@ -0,0 +1,32 @@
+# Modal logic
+
+```agda
+module modal-logic where
+
+open import modal-logic.axioms public
+open import modal-logic.canonical-model-theorem public
+open import modal-logic.canonical-theories public
+open import modal-logic.closed-under-subformulas-theories public
+open import modal-logic.completeness public
+open import modal-logic.completeness-k public
+open import modal-logic.completeness-s5 public
+open import modal-logic.decision-procedure public
+open import modal-logic.deduction public
+open import modal-logic.filtrated-kripke-classes public
+open import modal-logic.filtration-lemma public
+open import modal-logic.finite-approximability public
+open import modal-logic.formulas public
+open import modal-logic.formulas-deduction public
+open import modal-logic.kripke-models-filtrations public
+open import modal-logic.kripke-semantics public
+open import modal-logic.l-complete-theories public
+open import modal-logic.l-consistent-theories public
+open import modal-logic.lindenbaum public
+open import modal-logic.minimal-kripke-filtration public
+open import modal-logic.minimal-transitive-kripke-filtration public
+open import modal-logic.modal-logic-k public
+open import modal-logic.modal-logic-s5 public
+open import modal-logic.soundness public
+open import modal-logic.subformulas public
+open import modal-logic.weak-deduction public
+```
diff --git a/src/modal-logic/axioms.lagda.md b/src/modal-logic/axioms.lagda.md
new file mode 100644
index 0000000000..2bb56ee567
--- /dev/null
+++ b/src/modal-logic/axioms.lagda.md
@@ -0,0 +1,189 @@
+# Modal logic axioms
+
+```agda
+module modal-logic.axioms where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-binary-functions
+open import foundation.action-on-identifications-dependent-functions
+open import foundation.action-on-identifications-functions
+open import foundation.contractible-types
+open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.existential-quantification
+open import foundation.function-extensionality
+open import foundation.inhabited-types
+open import foundation.propositional-truncations
+open import foundation.raising-universe-levels
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+open import foundation-core.dependent-identifications
+open import foundation-core.equality-dependent-pair-types
+open import foundation-core.function-types
+open import foundation-core.identity-types
+open import foundation-core.injective-maps
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+open import foundation-core.transport-along-identifications
+
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+open import modal-logic.soundness
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l : Level} (i : Set l)
+ where
+
+ ax-1-parameter :
+ (h : modal-formula i → modal-formula i) → is-injective h → modal-theory l i
+ pr1 (ax-1-parameter h inj f) = Σ (modal-formula i) (λ a → f = h a)
+ pr2 (ax-1-parameter h inj f) (a , refl) =
+ is-prop-is-contr
+ ( is-contr-Σ-is-prop a refl
+ ( λ b → is-set-modal-formula (h a) (h b))
+ ( λ x → inj))
+ ( a , refl)
+
+ ax-2-parameters :
+ (h : modal-formula i → modal-formula i → modal-formula i) →
+ ({x x' y y' : modal-formula i} → h x y = h x' y' → x = x') →
+ ({x x' y y' : modal-formula i} → h x y = h x' y' → y = y') →
+ modal-theory l i
+ pr1 (ax-2-parameters h inj-1 inj-2 f) =
+ Σ (modal-formula i) (λ a → Σ (modal-formula i) (λ b → f = h a b))
+ pr2 (ax-2-parameters h inj-1 inj-2 f) (a , b , refl) =
+ is-prop-is-contr
+ ( is-contr-Σ-is-prop a (b , refl)
+ ( λ x → is-prop-type-Prop (ax-1-parameter (h x) inj-2 (h a b)))
+ ( λ x (y , e) → inj-1 e))
+ ( a , b , refl)
+
+ ax-3-parameters :
+ (h :
+ modal-formula i → modal-formula i → modal-formula i → modal-formula i) →
+ ({x x' y y' z z' : modal-formula i} → h x y z = h x' y' z' → x = x') →
+ ({x x' y y' z z' : modal-formula i} → h x y z = h x' y' z' → y = y') →
+ ({x x' y y' z z' : modal-formula i} → h x y z = h x' y' z' → z = z') →
+ modal-theory l i
+ pr1 (ax-3-parameters h inj-1 inj-2 inj-3 f) =
+ Σ ( modal-formula i)
+ ( λ a →
+ ( Σ (modal-formula i)
+ ( λ b → Σ (modal-formula i) ( λ c → f = h a b c))))
+ pr2 (ax-3-parameters h inj-1 inj-2 inj-3 f) (a , b , c , refl) =
+ is-prop-is-contr
+ ( is-contr-Σ-is-prop a (b , c , refl)
+ ( λ x → is-prop-type-Prop (ax-2-parameters (h x) inj-2 inj-3 (h a b c)))
+ ( λ x (y , z , e) → inj-1 e))
+ ( a , b , c , refl)
+
+ ax-k : modal-theory l i
+ ax-k =
+ ax-2-parameters
+ ( λ a b → a →ₘ b →ₘ a)
+ ( eq-implication-left)
+ ( eq-implication-left ∘ eq-implication-right)
+
+ ax-s : modal-theory l i
+ ax-s =
+ ax-3-parameters
+ ( λ a b c → (a →ₘ b →ₘ c) →ₘ (a →ₘ b) →ₘ a →ₘ c)
+ ( eq-implication-left ∘ eq-implication-left)
+ ( eq-implication-left ∘ eq-implication-right ∘ eq-implication-left)
+ ( eq-implication-right ∘ eq-implication-right ∘ eq-implication-left)
+
+ ax-n : modal-theory l i
+ ax-n =
+ ax-2-parameters
+ ( λ a b → □ₘ (a →ₘ b) →ₘ □ₘ a →ₘ □ₘ b)
+ ( eq-implication-left ∘ eq-box ∘ eq-implication-left)
+ ( eq-implication-right ∘ eq-box ∘ eq-implication-left)
+
+ ax-dn : modal-theory l i
+ ax-dn = ax-1-parameter (λ a → ¬¬ₘ a →ₘ a) eq-implication-right
+
+ ax-m : modal-theory l i
+ ax-m = ax-1-parameter (λ a → □ₘ a →ₘ a) eq-implication-right
+
+ ax-b : modal-theory l i
+ ax-b = ax-1-parameter (λ a → a →ₘ □ₘ ◇ₘ a) eq-implication-left
+
+ ax-d : modal-theory l i
+ ax-d = ax-1-parameter (λ a → □ₘ a →ₘ ◇ₘ a) (eq-box ∘ eq-implication-left)
+
+ ax-4 : modal-theory l i
+ ax-4 = ax-1-parameter (λ a → □ₘ a →ₘ □ₘ □ₘ a) (eq-box ∘ eq-implication-left)
+
+ ax-5 : modal-theory l i
+ ax-5 =
+ ax-1-parameter ( λ a → ◇ₘ a →ₘ □ₘ ◇ₘ a) ( eq-diamond ∘ eq-implication-left)
+
+module _
+ {l1 l2 : Level}
+ (i : Set l1)
+ (l3 l4 : Level)
+ where
+
+ ax-k-soundness : soundness (ax-k i) (all-models l2 l3 i l4)
+ ax-k-soundness .(a →ₘ b →ₘ a) (a , b , refl) M _ x fa _ = fa
+
+ ax-s-soundness : soundness (ax-s i) (all-models l2 l3 i l4)
+ ax-s-soundness
+ .((a →ₘ b →ₘ c) →ₘ (a →ₘ b) →ₘ a →ₘ c)
+ (a , b , c , refl)
+ M in-class x fabc fab fa =
+ fabc fa (fab fa)
+
+ ax-n-soundness : soundness (ax-n i) (all-models l2 l3 i l4)
+ ax-n-soundness
+ .(□ₘ (a →ₘ b) →ₘ □ₘ a →ₘ □ₘ b)
+ (a , b , refl)
+ M in-class x fab fa y r =
+ fab y r (fa y r)
+
+ ax-dn-soundness : soundness (ax-dn i) (decidable-kripke-models l2 l3 i l4)
+ ax-dn-soundness .(¬¬ₘ a →ₘ a) (a , refl) M is-dec x f
+ with (is-dec a x)
+ ... | inl fa = fa
+ ... | inr fna = raise-ex-falso _ (f (λ fa -> map-raise (fna fa)))
+
+ ax-m-soundness : soundness (ax-m i) (reflexive-kripke-models l2 l3 i l4)
+ ax-m-soundness .(□ₘ a →ₘ a) (a , refl) M is-refl x fa = fa x (is-refl x)
+
+ ax-b-soundness : soundness (ax-b i) (symmetry-kripke-models l2 l3 i l4)
+ ax-b-soundness .(a →ₘ □ₘ ◇ₘ a) (a , refl) M is-sym x fa y r contra =
+ contra x (is-sym x y r) fa
+
+ ax-d-soundness : soundness (ax-d i) (serial-kripke-models l2 l3 i l4)
+ ax-d-soundness .(□ₘ a →ₘ ◇ₘ a) (a , refl) M is-serial x fa contra =
+ map-raise
+ ( apply-universal-property-trunc-Prop
+ ( is-serial x)
+ ( empty-Prop)
+ ( λ (y , r) → map-inv-raise (contra y r (fa y r))))
+
+ ax-4-soundness : soundness (ax-4 i) (transitive-kripke-models l2 l3 i l4)
+ ax-4-soundness .(□ₘ a →ₘ □ₘ □ₘ a) (a , refl) M is-trans x fa y r-xy z r-yz =
+ fa z (is-trans x y z r-yz r-xy)
+
+ ax-5-sooundness : soundness (ax-5 i) (euclidean-kripke-models l2 l3 i l4)
+ ax-5-sooundness .(◇ₘ a →ₘ □ₘ ◇ₘ a) (a , refl) M is-eucl x fa y r-xy contra =
+ fa (λ z r-xz → contra z (is-eucl x y z r-xy r-xz))
+```
diff --git a/src/modal-logic/canonical-model-theorem.lagda.md b/src/modal-logic/canonical-model-theorem.lagda.md
new file mode 100644
index 0000000000..dd310c9297
--- /dev/null
+++ b/src/modal-logic/canonical-model-theorem.lagda.md
@@ -0,0 +1,590 @@
+# Canonical model theorem
+
+```agda
+module modal-logic.canonical-model-theorem where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-functions
+open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.function-types
+open import foundation.identity-types
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.negation
+open import foundation.propositional-resizing
+open import foundation.propositional-truncations
+open import foundation.raising-universe-levels
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.transport-along-identifications
+open import foundation.unions-subtypes
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+open import foundation-core.propositions
+
+open import lists.lists
+open import lists.lists-subtypes
+open import lists.reversing-lists
+
+open import modal-logic.axioms
+open import modal-logic.completeness
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+open import modal-logic.l-complete-theories
+open import modal-logic.l-consistent-theories
+open import modal-logic.lindenbaum
+open import modal-logic.modal-logic-k
+open import modal-logic.weak-deduction
+
+open import order-theory.zorn
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 : Level} {i : Set l1}
+ (logic : modal-theory l2 i)
+ (is-logic : is-modal-logic logic)
+ (is-cons : is-consistent-modal-logic logic)
+ (is-normal : is-normal-modal-logic logic)
+ (zorn : Zorn (lsuc l1 ⊔ lsuc l2) (l1 ⊔ l2) l2)
+ (prop-resize : propositional-resizing (l1 ⊔ l2) (lsuc (l1 ⊔ l2)))
+ where
+
+ private
+ is-weak-logic : is-weak-modal-logic logic
+ is-weak-logic = is-weak-modal-logic-is-modal-logic is-logic
+
+ contains-ax-k : ax-k i ⊆ logic
+ contains-ax-k =
+ transitive-leq-subtype (ax-k i) (modal-logic-K i) logic
+ ( is-normal)
+ ( K-contains-ax-k i)
+
+ contains-ax-s : ax-s i ⊆ logic
+ contains-ax-s =
+ transitive-leq-subtype (ax-s i) (modal-logic-K i) logic
+ ( is-normal)
+ ( K-contains-ax-s i)
+
+ contains-ax-n : ax-n i ⊆ logic
+ contains-ax-n =
+ transitive-leq-subtype (ax-n i) (modal-logic-K i) logic
+ ( is-normal)
+ ( K-contains-ax-n i)
+
+ contains-ax-dn : ax-dn i ⊆ logic
+ contains-ax-dn =
+ transitive-leq-subtype (ax-dn i) (modal-logic-K i) logic
+ ( is-normal)
+ ( K-contains-ax-dn i)
+
+ canonical-kripke-model :
+ kripke-model (lsuc l1 ⊔ lsuc l2) (l1 ⊔ l2) i (l1 ⊔ l2)
+ pr1 (pr1 canonical-kripke-model) =
+ L-complete-theory logic (l1 ⊔ l2)
+ pr2 (pr1 canonical-kripke-model) =
+ is-inhabited-L-complete-theory
+ ( logic)
+ ( prop-resize)
+ ( zorn)
+ ( is-weak-logic)
+ ( is-cons)
+ ( contains-ax-k)
+ ( contains-ax-s)
+ pr1 (pr2 canonical-kripke-model) x y =
+ Π-Prop
+ ( modal-formula i)
+ ( λ a →
+ ( modal-theory-L-complete-theory logic x (□ₘ a) ⇒
+ modal-theory-L-complete-theory logic y a))
+ pr2 (pr2 canonical-kripke-model) n x =
+ modal-theory-L-complete-theory logic x (varₘ n)
+
+ module _
+ (lem : LEM (l1 ⊔ l2))
+ where
+
+ module _
+ (x@((theory , is-cons) , is-comp) : L-complete-theory logic (l1 ⊔ l2))
+ where
+
+ private
+ contains-ax-k' : ax-k i ⊆ theory
+ contains-ax-k' =
+ transitive-leq-subtype (ax-k i) logic theory
+ ( subset-logic-L-complete-theory logic lzero x)
+ ( contains-ax-k)
+
+ contains-ax-s' : ax-s i ⊆ theory
+ contains-ax-s' =
+ transitive-leq-subtype (ax-s i) logic theory
+ ( subset-logic-L-complete-theory logic lzero x)
+ ( contains-ax-s)
+
+ contains-ax-dn' : ax-dn i ⊆ theory
+ contains-ax-dn' =
+ transitive-leq-subtype (ax-dn i) logic theory
+ ( subset-logic-L-complete-theory logic lzero x)
+ ( contains-ax-dn)
+
+ contains-ax-n' : ax-n i ⊆ theory
+ contains-ax-n' =
+ transitive-leq-subtype (ax-n i) logic theory
+ ( subset-logic-L-complete-theory logic lzero x)
+ ( contains-ax-n)
+
+ contains-ax-k-union :
+ {l : Level} (t : modal-theory l i) → ax-k i ⊆ logic ∪ t
+ contains-ax-k-union t =
+ transitive-leq-subtype (ax-k i) logic (logic ∪ t)
+ ( subtype-union-left logic t)
+ ( contains-ax-k)
+
+ contains-ax-s-union :
+ {l : Level} (t : modal-theory l i) → ax-s i ⊆ logic ∪ t
+ contains-ax-s-union t =
+ transitive-leq-subtype (ax-s i) logic (logic ∪ t)
+ ( subtype-union-left logic t)
+ ( contains-ax-s)
+
+ is-disjuctive-theory : is-disjuctive-modal-theory theory
+ is-disjuctive-theory =
+ is-disjuctive-L-complete-theory logic x
+ ( contains-ax-k)
+ ( contains-ax-s)
+ ( contains-ax-dn)
+ ( lem)
+
+ L-complete-theory-implication :
+ {a b : modal-formula i} →
+ (is-in-subtype theory a → is-in-subtype theory b) →
+ is-in-subtype theory (a →ₘ b)
+ L-complete-theory-implication {a} {b} f with is-disjuctive-theory a
+ ... | inl a-in-logic =
+ is-weak-modal-logic-L-complete-theory logic lzero x (a →ₘ b)
+ ( forward-implication
+ ( deduction-theorem theory contains-ax-k' contains-ax-s' a b)
+ ( weak-modal-logic-closure-monotic
+ { ax₁ = theory}
+ { ax₂ = theory-add-formula a theory}
+ ( subset-add-formula a theory)
+ ( b)
+ ( weak-modal-logic-closure-ax (f a-in-logic))))
+ ... | inr not-a-in-logic =
+ is-weak-modal-logic-L-complete-theory logic lzero x (a →ₘ b)
+ ( forward-implication
+ ( deduction-theorem theory contains-ax-k' contains-ax-s' a b)
+ ( logic-ex-falso
+ ( theory-add-formula a theory)
+ ( transitive-subset-add-formula a theory (ax-k i) contains-ax-k')
+ ( transitive-subset-add-formula a theory (ax-s i) contains-ax-s')
+ ( transitive-subset-add-formula a theory
+ ( ax-dn i)
+ ( contains-ax-dn'))
+ ( a)
+ ( b)
+ ( weak-modal-logic-closure-ax (formula-in-add-formula a theory))
+ ( weak-modal-logic-closure-monotic
+ { ax₁ = theory}
+ { ax₂ = theory-add-formula a theory}
+ ( subset-add-formula a theory)
+ ( ¬ₘ a)
+ ( weak-modal-logic-closure-ax not-a-in-logic))))
+
+ L-complete-theory-box :
+ {a : modal-formula i} →
+ ( (y : L-complete-theory logic (l1 ⊔ l2)) →
+ relation-kripke-model i canonical-kripke-model x y →
+ is-in-subtype (modal-theory-L-complete-theory logic y) a) →
+ is-in-subtype theory (□ₘ a)
+ L-complete-theory-box {a} f with is-disjuctive-theory (□ₘ a)
+ ... | inl box-a-in-logic = box-a-in-logic
+ ... | inr not-box-a-in-logic =
+ ex-falso
+ ( apply-universal-property-trunc-Prop
+ ( lindenbaum logic contains-ax-k contains-ax-s zorn prop-resize
+ ( y , is-L-consistent-y))
+ ( empty-Prop)
+ ( λ (w , y-leq-w) →
+ ( is-consistent-modal-theory-L-complete-theory logic w
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory logic lzero w)
+ ( y-leq-w (¬ₘ a)
+ ( formula-in-add-formula
+ ( ¬ₘ a)
+ ( unbox-modal-theory theory)))
+ ( f w (λ b → y-leq-w b ∘ y-contains-unbox))))))
+ where
+ y : modal-theory (l1 ⊔ l2) i
+ y = theory-add-formula (¬ₘ a) (unbox-modal-theory theory)
+
+ y-contains-unbox :
+ {b : modal-formula i} →
+ is-in-subtype theory (□ₘ b) →
+ is-in-subtype y b
+ y-contains-unbox {b} =
+ subset-add-formula (¬ₘ a) (unbox-modal-theory theory) b
+
+ list-to-implications :
+ modal-formula i → (l : list (modal-formula i)) → modal-formula i
+ list-to-implications f nil = f
+ list-to-implications f (cons g l) = list-to-implications (g →ₘ f) l
+
+ list-to-implications-rev :
+ modal-formula i → (l : list (modal-formula i)) → modal-formula i
+ list-to-implications-rev f nil = f
+ list-to-implications-rev f (cons g l) =
+ g →ₘ list-to-implications-rev f l
+
+ list-to-implication-rev-snoc :
+ (f g : modal-formula i) (l : list (modal-formula i)) →
+ list-to-implications f (snoc l g) = g →ₘ list-to-implications f l
+ list-to-implication-rev-snoc f g nil = refl
+ list-to-implication-rev-snoc f g (cons h l) =
+ list-to-implication-rev-snoc (h →ₘ f) g l
+
+ eq-reverse-list-to-implications :
+ (f : modal-formula i) (l : list (modal-formula i)) →
+ list-to-implications f (reverse-list l) = list-to-implications-rev f l
+ eq-reverse-list-to-implications f nil = refl
+ eq-reverse-list-to-implications f (cons g l) =
+ ( list-to-implication-rev-snoc f g (reverse-list l)) ∙
+ ( ap (λ x → g →ₘ x) (eq-reverse-list-to-implications f l))
+
+ move-assumptions-right :
+ (f : modal-formula i) (l : list (modal-formula i)) →
+ is-in-subtype (weak-modal-logic-closure (logic ∪ list-subtype l)) f →
+ is-in-subtype
+ ( weak-modal-logic-closure logic)
+ ( list-to-implications f l)
+ move-assumptions-right f nil =
+ weak-modal-logic-closure-monotic
+ ( subtype-union-both
+ ( logic)
+ ( list-subtype nil)
+ ( logic)
+ ( refl-leq-subtype logic)
+ ( subset-list-subtype-nil logic))
+ ( f)
+ move-assumptions-right f (cons c l) in-logic =
+ move-assumptions-right (c →ₘ f) l
+ ( forward-implication
+ ( deduction-theorem
+ ( logic ∪ list-subtype l)
+ ( contains-ax-k-union (list-subtype l))
+ ( contains-ax-s-union (list-subtype l))
+ ( c)
+ ( f))
+ ( weak-modal-logic-closure-monotic
+ ( transitive-leq-subtype
+ ( logic ∪ list-subtype (cons c l))
+ ( logic ∪ theory-add-formula c (list-subtype l))
+ ( theory-add-formula c (logic ∪ list-subtype l))
+ ( theory-add-formula-union-right c logic (list-subtype l))
+ ( subset-union-subset-right logic
+ ( list-subtype (cons c l))
+ ( theory-add-formula c (list-subtype l))
+ ( subset-list-subtype-cons
+ ( theory-add-formula c (list-subtype l))
+ ( formula-in-add-formula c (list-subtype l))
+ ( subset-add-formula c (list-subtype l)))))
+ ( f)
+ ( in-logic)))
+
+ α :
+ (l : list (modal-formula i)) →
+ list-subtype l ⊆ unbox-modal-theory theory →
+ is-in-subtype theory (□ₘ (list-to-implications-rev a l)) →
+ is-in-subtype theory (□ₘ a)
+ α nil sub in-logic = in-logic
+ α (cons c l) sub in-logic =
+ α l
+ ( transitive-leq-subtype
+ ( list-subtype l)
+ ( list-subtype (cons c l))
+ ( unbox-modal-theory theory)
+ ( sub)
+ ( subset-tail-list-subtype))
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory logic lzero x)
+ { a = □ₘ c}
+ { b = □ₘ list-to-implications-rev a l}
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory logic lzero x)
+ { a = □ₘ (c →ₘ list-to-implications-rev a l)}
+ { b = □ₘ c →ₘ □ₘ (list-to-implications-rev a l)}
+ ( contains-ax-n' _ (c , list-to-implications-rev a l , refl))
+ ( in-logic))
+ ( sub c head-in-list-subtype))
+
+ β :
+ (l : list (modal-formula i)) →
+ list-subtype l ⊆ unbox-modal-theory theory →
+ is-in-subtype (weak-modal-logic-closure (logic ∪ list-subtype l)) a →
+ is-in-subtype theory (□ₘ a)
+ β l sub in-logic =
+ α l sub
+ ( subset-logic-L-complete-theory logic lzero x
+ ( □ₘ list-to-implications-rev a l)
+ ( modal-logic-nec is-logic
+ ( tr
+ ( is-in-subtype logic)
+ ( eq-reverse-list-to-implications a l)
+ ( is-weak-logic
+ ( list-to-implications a (reverse-list l))
+ ( move-assumptions-right a (reverse-list l)
+ ( weak-modal-logic-closure-monotic
+ ( subset-union-subset-right logic
+ ( list-subtype l)
+ ( list-subtype (reverse-list l))
+ ( subset-list-subtype-reverse-list l))
+ ( a)
+ ( in-logic)))))))
+
+ γ :
+ (l : list (modal-formula i)) →
+ list-subtype l ⊆ unbox-modal-theory theory →
+ is-contradictory-modal-logic
+ ( weak-modal-logic-closure
+ ( theory-add-formula (¬ₘ a) (logic ∪ list-subtype l))) →
+ is-in-subtype theory (□ₘ a)
+ γ l sub is-cont =
+ β l sub
+ ( weak-modal-logic-closure-mp {a = ¬¬ₘ a} {b = a}
+ ( weak-modal-logic-closure-ax
+ ( subtype-union-left logic (list-subtype l) (¬¬ₘ a →ₘ a)
+ ( contains-ax-dn (¬¬ₘ a →ₘ a) (a , refl))))
+ ( forward-implication
+ ( deduction-theorem
+ ( logic ∪ list-subtype l)
+ ( contains-ax-k-union (list-subtype l))
+ ( contains-ax-s-union (list-subtype l))
+ ( ¬ₘ a)
+ ( ⊥ₘ))
+ ( is-cont)))
+
+ δ :
+ (l : list (modal-formula i)) →
+ list-subtype l ⊆ unbox-modal-theory theory →
+ is-contradictory-modal-logic
+ ( weak-modal-logic-closure
+ ( logic ∪ (theory-add-formula (¬ₘ a) (list-subtype l)))) →
+ is-in-subtype theory (□ₘ a)
+ δ l sub is-cont =
+ γ l sub
+ ( is-contradictory-modal-logic-monotic
+ ( weak-modal-logic-closure
+ ( logic ∪ theory-add-formula (¬ₘ a) (list-subtype l)))
+ ( weak-modal-logic-closure
+ ( theory-add-formula (¬ₘ a) (logic ∪ list-subtype l)))
+ ( weak-modal-logic-closure-monotic
+ ( theory-add-formula-union-right (¬ₘ a) logic (list-subtype l)))
+ ( is-cont))
+
+ ε :
+ (l : list (modal-formula i)) →
+ list-subtype l ⊆ logic ∪ y →
+ is-contradictory-modal-logic
+ ( weak-modal-logic-closure (list-subtype l)) →
+ is-in-subtype theory (□ₘ a)
+ ε l sub is-cont =
+ apply-universal-property-trunc-Prop
+ ( lists-in-union-lists l logic y sub)
+ ( theory (□ₘ a))
+ ( λ ((l-ax , l-y) , sub-union , l-ax-sub-logic , l-y-sub-y) →
+ ( apply-universal-property-trunc-Prop
+ ( lists-in-union-lists l-y
+ ( Id-modal-formula-Prop (¬ₘ a))
+ ( unbox-modal-theory theory)
+ ( l-y-sub-y))
+ ( theory (□ₘ a))
+ ( λ ((l-not-a , l-box) , sub-union' , l-not-a-sub , l-box-sub) →
+ ( δ
+ ( l-box)
+ ( l-box-sub)
+ ( is-contradictory-modal-logic-monotic
+ ( weak-modal-logic-closure (list-subtype l))
+ ( weak-modal-logic-closure
+ ( logic ∪
+ theory-add-formula (¬ₘ a) (list-subtype l-box)))
+ ( weak-modal-logic-closure-monotic
+ ( transitive-leq-subtype
+ ( list-subtype l)
+ ( list-subtype l-ax ∪ list-subtype l-y)
+ ( logic ∪
+ theory-add-formula (¬ₘ a) (list-subtype l-box))
+ ( subset-union-subsets
+ ( list-subtype l-ax)
+ ( list-subtype l-y)
+ ( logic)
+ ( theory-add-formula (¬ₘ a) (list-subtype l-box))
+ ( l-ax-sub-logic)
+ ( transitive-leq-subtype
+ ( list-subtype l-y)
+ ( list-subtype l-not-a ∪ list-subtype l-box)
+ ( theory-add-formula (¬ₘ a) (list-subtype l-box))
+ ( subtype-union-both
+ ( list-subtype l-not-a)
+ ( list-subtype l-box)
+ ( theory-add-formula
+ ( ¬ₘ a)
+ ( list-subtype l-box))
+ ( transitive-leq-subtype
+ ( list-subtype l-not-a)
+ ( Id-modal-formula-Prop (¬ₘ a))
+ ( theory-add-formula (¬ₘ a)
+ ( list-subtype l-box))
+ ( subtype-union-left
+ ( Id-modal-formula-Prop (¬ₘ a))
+ ( list-subtype l-box))
+ ( l-not-a-sub))
+ ( subset-add-formula
+ ( ¬ₘ a)
+ ( list-subtype l-box)))
+ ( sub-union')))
+ ( sub-union)))
+ ( is-cont))))))
+
+ is-L-consistent-y : is-L-consistent-theory logic y
+ is-L-consistent-y =
+ map-universal-property-trunc-Prop
+ ( empty-Prop)
+ ( λ d-bot →
+ ( is-consistent-modal-theory-L-complete-theory logic x
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory logic lzero x)
+ ( not-box-a-in-logic)
+ ( ε
+ ( list-assumptions-weak-deduction d-bot)
+ ( subset-theory-list-assumptions-weak-deduction d-bot)
+ ( is-in-weak-modal-logic-closure-weak-deduction
+ ( is-assumptions-list-assumptions-weak-deduction
+ ( d-bot)))))))
+
+ canonical-model-theorem-pointwise :
+ (a : modal-formula i)
+ (x : L-complete-theory logic (l1 ⊔ l2)) →
+ type-iff-Prop
+ ( modal-theory-L-complete-theory logic x a)
+ ( (canonical-kripke-model , x) ⊨ₘ a)
+ pr1 (canonical-model-theorem-pointwise (varₘ n) x) = map-raise
+ pr1 (canonical-model-theorem-pointwise ⊥ₘ x) =
+ map-raise ∘ is-consistent-modal-theory-L-complete-theory logic x
+ pr1 (canonical-model-theorem-pointwise (a →ₘ b) x) in-logic f =
+ forward-implication
+ ( canonical-model-theorem-pointwise b x)
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory logic lzero x)
+ ( in-logic)
+ ( backward-implication (canonical-model-theorem-pointwise a x) f))
+ pr1 (canonical-model-theorem-pointwise (□ₘ a) x) in-logic y xRy =
+ forward-implication
+ ( canonical-model-theorem-pointwise a y)
+ ( xRy a in-logic)
+ pr2 (canonical-model-theorem-pointwise (varₘ n) x) = map-inv-raise
+ pr2 (canonical-model-theorem-pointwise ⊥ₘ x) (map-raise ())
+ pr2 (canonical-model-theorem-pointwise (a →ₘ b) x) f =
+ L-complete-theory-implication x
+ ( λ in-x →
+ ( backward-implication
+ ( canonical-model-theorem-pointwise b x)
+ ( f
+ ( forward-implication
+ ( canonical-model-theorem-pointwise a x)
+ ( in-x)))))
+ pr2 (canonical-model-theorem-pointwise (□ₘ a) x) f =
+ L-complete-theory-box x
+ ( λ y xRy →
+ ( backward-implication
+ ( canonical-model-theorem-pointwise a y)
+ ( f y xRy)))
+
+ canonical-model-theorem :
+ (a : modal-formula i) →
+ type-iff-Prop (logic a) (canonical-kripke-model ⊨Mₘ a)
+ pr1 (canonical-model-theorem a) in-logic x =
+ forward-implication
+ ( canonical-model-theorem-pointwise a x)
+ ( subset-logic-L-complete-theory logic lzero x a in-logic)
+ pr2 (canonical-model-theorem a) =
+ contraposition (lower-LEM l1 lem) (logic a)
+ ( λ na f →
+ ( apply-universal-property-trunc-Prop
+ ( lindenbaum logic contains-ax-k contains-ax-s zorn prop-resize
+ ( x , is-L-consistent-x na))
+ ( empty-Prop)
+ ( λ (w , leq) →
+ ( is-consistent-modal-theory-L-complete-theory logic w
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory logic lzero w)
+ ( leq (¬ₘ a) not-a-in-x)
+ ( backward-implication
+ ( canonical-model-theorem-pointwise a w)
+ ( f w)))))))
+ where
+ x : modal-theory (l1 ⊔ l2) i
+ x = raise-subtype l2 (Id-modal-formula-Prop (¬ₘ a))
+
+ not-a-in-x : is-in-subtype x ( ¬ₘ a)
+ not-a-in-x =
+ subset-equiv-subtypes (Id-modal-formula-Prop (¬ₘ a)) x
+ ( compute-raise-subtype l2 (Id-modal-formula-Prop (¬ₘ a)))
+ ( ¬ₘ a)
+ ( refl)
+
+ is-L-consistent-x :
+ ¬ (is-in-subtype logic a) → is-L-consistent-theory logic x
+ is-L-consistent-x a-not-in-logic bot-in-logic =
+ a-not-in-logic
+ ( modal-logic-mp is-logic
+ {a = ¬¬ₘ a}
+ {b = a}
+ ( contains-ax-dn (¬¬ₘ a →ₘ a) (a , refl))
+ ( is-logic (¬¬ₘ a)
+ ( subset-weak-modal-logic-closure-modal-logic-closure (¬¬ₘ a)
+ ( forward-implication
+ ( deduction-theorem logic contains-ax-k contains-ax-s
+ ( ¬ₘ a)
+ ( ⊥ₘ))
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-both logic x
+ ( theory-add-formula (¬ₘ a) logic)
+ ( subtype-union-right
+ ( Id-modal-formula-Prop (¬ₘ a)) logic)
+ ( transitive-leq-subtype x ( Id-modal-formula-Prop (¬ₘ a))
+ ( theory-add-formula (¬ₘ a) logic)
+ ( subtype-union-left
+ ( Id-modal-formula-Prop (¬ₘ a))
+ ( logic))
+ ( inv-subset-equiv-subtypes
+ (Id-modal-formula-Prop (¬ₘ a))
+ ( x)
+ ( compute-raise-subtype l2
+ ( Id-modal-formula-Prop (¬ₘ a))))))
+ ( ⊥ₘ)
+ ( bot-in-logic))))))
+
+ canonical-model-completness :
+ {l3 : Level}
+ (C : model-class (lsuc l1 ⊔ lsuc l2) (l1 ⊔ l2) i (l1 ⊔ l2) l3) →
+ is-in-subtype C canonical-kripke-model →
+ completeness logic C
+ canonical-model-completness C model-in-class a a-in-class-logic =
+ backward-implication
+ ( canonical-model-theorem a)
+ ( a-in-class-logic canonical-kripke-model model-in-class)
+```
diff --git a/src/modal-logic/canonical-theories.lagda.md b/src/modal-logic/canonical-theories.lagda.md
new file mode 100644
index 0000000000..126b5be099
--- /dev/null
+++ b/src/modal-logic/canonical-theories.lagda.md
@@ -0,0 +1,161 @@
+# Canonical threories
+
+```agda
+module modal-logic.canonical-theories where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.identity-types
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.propositional-resizing
+open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+
+open import modal-logic.axioms
+open import modal-logic.canonical-model-theorem
+open import modal-logic.completeness
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+open import modal-logic.l-complete-theories
+open import modal-logic.modal-logic-k
+open import modal-logic.modal-logic-s5
+open import modal-logic.soundness
+open import modal-logic.weak-deduction
+
+open import order-theory.zorn
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 : Level}
+ (i : Set l1)
+ (zorn : Zorn (lsuc l1) l1 l1)
+ (prop-resize : propositional-resizing l1 (lsuc l1))
+ (logic : modal-theory l1 i)
+ (is-logic : is-modal-logic logic)
+ (is-cons : is-consistent-modal-logic logic)
+ (is-normal : is-normal-modal-logic logic)
+ where
+
+ private
+ contains-ax-k : ax-k i ⊆ logic
+ contains-ax-k =
+ transitive-leq-subtype
+ ( ax-k i)
+ ( modal-logic-K i)
+ ( logic)
+ ( is-normal)
+ ( K-contains-ax-k i)
+
+ contains-ax-s : ax-s i ⊆ logic
+ contains-ax-s =
+ transitive-leq-subtype
+ ( ax-s i)
+ ( modal-logic-K i)
+ ( logic)
+ ( is-normal)
+ ( K-contains-ax-s i)
+
+ contains-ax-dn : ax-dn i ⊆ logic
+ contains-ax-dn =
+ transitive-leq-subtype
+ ( ax-dn i)
+ ( modal-logic-K i)
+ ( logic)
+ ( is-normal)
+ ( K-contains-ax-dn i)
+
+ is-canonical-ax-m :
+ ax-m i ⊆ logic →
+ is-in-subtype
+ ( reflexive-kripke-models (lsuc l1) l1 i l1)
+ ( canonical-kripke-model
+ ( logic)
+ ( is-logic)
+ ( is-cons)
+ ( is-normal)
+ ( zorn)
+ ( prop-resize))
+ is-canonical-ax-m ax-m-subset x a box-a-in-x =
+ weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory logic lzero x)
+ ( subset-logic-L-complete-theory logic lzero x
+ ( □ₘ a →ₘ a)
+ ( ax-m-subset (□ₘ a →ₘ a) (a , refl)))
+ ( box-a-in-x)
+
+ is-canonical-ax-b :
+ LEM l1 →
+ ax-b i ⊆ logic →
+ is-in-subtype
+ ( symmetry-kripke-models (lsuc l1) l1 i l1)
+ ( canonical-kripke-model
+ ( logic)
+ ( is-logic)
+ ( is-cons)
+ ( is-normal)
+ ( zorn)
+ ( prop-resize))
+ is-canonical-ax-b lem ax-b-subset x y xRy a box-a-in-y =
+ lemma-box-diamond-L-complete logic x
+ ( contains-ax-k)
+ ( contains-ax-s)
+ ( contains-ax-dn)
+ ( lem)
+ ( is-logic)
+ ( is-normal)
+ ( y)
+ ( λ b →
+ ( map-universal-property-trunc-Prop
+ ( modal-theory-L-complete-theory logic y b)
+ ( λ where
+ (c , c-in-x , refl) →
+ ( xRy (◇ₘ c)
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory logic lzero x)
+ ( subset-logic-L-complete-theory logic lzero x (c →ₘ □ₘ ◇ₘ c)
+ ( ax-b-subset (c →ₘ □ₘ ◇ₘ c) (c , refl)))
+ ( c-in-x))))))
+ ( a)
+ ( box-a-in-y)
+
+ is-canonical-ax-4 :
+ ax-4 i ⊆ logic →
+ is-in-subtype
+ ( transitive-kripke-models (lsuc l1) l1 i l1)
+ ( canonical-kripke-model
+ ( logic)
+ ( is-logic)
+ ( is-cons)
+ ( is-normal)
+ ( zorn)
+ ( prop-resize))
+ is-canonical-ax-4 ax-4-subset x y z yRz xRy a box-a-in-x =
+ yRz a
+ ( xRy (□ₘ a)
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory logic lzero x)
+ ( subset-logic-L-complete-theory logic lzero x
+ ( □ₘ a →ₘ □ₘ □ₘ a)
+ ( ax-4-subset (□ₘ a →ₘ □ₘ □ₘ a) (a , refl)))
+ ( box-a-in-x)))
+```
diff --git a/src/modal-logic/closed-under-subformulas-theories.lagda.md b/src/modal-logic/closed-under-subformulas-theories.lagda.md
new file mode 100644
index 0000000000..eeb4f8dc8b
--- /dev/null
+++ b/src/modal-logic/closed-under-subformulas-theories.lagda.md
@@ -0,0 +1,95 @@
+# Closed under subformulas theories
+
+```agda
+module modal-logic.closed-under-subformulas-theories where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-functions
+open import foundation.binary-relations
+open import foundation.binary-relations-transitive-closures
+open import foundation.coproduct-types
+open import foundation.decidable-types
+open import foundation.dependent-pair-types
+open import foundation.equivalence-classes
+open import foundation.equivalences
+open import foundation.existential-quantification
+open import foundation.function-extensionality
+open import foundation.function-types
+open import foundation.identity-types
+open import foundation.inhabited-types
+open import foundation.logical-equivalences
+open import foundation.negation
+open import foundation.propositional-extensionality
+open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.raising-universe-levels
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.cartesian-product-types
+open import foundation-core.embeddings
+open import foundation-core.equality-dependent-pair-types
+open import foundation-core.equivalence-relations
+open import foundation-core.injective-maps
+open import foundation-core.transport-along-identifications
+
+open import modal-logic.axioms
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+
+open import univalent-combinatorics.finite-types
+```
+
+
+
+## Idea
+
+Theory is closed under subformulas if every subformula of a formula in the
+theory is also in the theory.
+
+## Definition
+
+```agda
+module _
+ {l1 l2 : Level} {i : Set l1} (theory : modal-theory l2 i)
+ where
+
+ is-modal-theory-has-subboxes-Prop : Prop (l1 ⊔ l2)
+ is-modal-theory-has-subboxes-Prop =
+ implicit-Π-Prop (modal-formula i) (λ a → theory (□ₘ a) ⇒ theory a)
+
+ is-modal-theory-has-subboxes : UU (l1 ⊔ l2)
+ is-modal-theory-has-subboxes = type-Prop is-modal-theory-has-subboxes-Prop
+
+ is-modal-theory-has-subimps-Prop : Prop (l1 ⊔ l2)
+ is-modal-theory-has-subimps-Prop =
+ implicit-Π-Prop (modal-formula i × modal-formula i)
+ ( λ (a , b) → theory (a →ₘ b) ⇒ product-Prop (theory a) (theory b))
+
+ is-modal-theory-has-subimps : UU (l1 ⊔ l2)
+ is-modal-theory-has-subimps = type-Prop is-modal-theory-has-subimps-Prop
+
+ is-modal-theory-closed-under-subformulas-Prop : Prop (l1 ⊔ l2)
+ is-modal-theory-closed-under-subformulas-Prop =
+ product-Prop
+ ( is-modal-theory-has-subboxes-Prop)
+ ( is-modal-theory-has-subimps-Prop)
+
+ is-modal-theory-closed-under-subformulas : UU (l1 ⊔ l2)
+ is-modal-theory-closed-under-subformulas =
+ type-Prop is-modal-theory-closed-under-subformulas-Prop
+
+ is-has-subboxes-is-closed-under-subformulas :
+ is-modal-theory-closed-under-subformulas → is-modal-theory-has-subboxes
+ is-has-subboxes-is-closed-under-subformulas = pr1
+
+ is-has-subimps-is-closed-under-subformulas :
+ is-modal-theory-closed-under-subformulas → is-modal-theory-has-subimps
+ is-has-subimps-is-closed-under-subformulas = pr2
+```
diff --git a/src/modal-logic/completeness-k.lagda.md b/src/modal-logic/completeness-k.lagda.md
new file mode 100644
index 0000000000..c0ae16bff5
--- /dev/null
+++ b/src/modal-logic/completeness-k.lagda.md
@@ -0,0 +1,77 @@
+# Completeness of K
+
+```agda
+module modal-logic.completeness-k where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-functions
+open import foundation.cartesian-product-types
+open import foundation.coproduct-types
+open import foundation.dependent-pair-types
+open import foundation.disjunction
+open import foundation.empty-types
+open import foundation.existential-quantification
+open import foundation.function-types
+open import foundation.identity-types
+open import foundation.inhabited-types
+open import foundation.intersections-subtypes
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.negation
+open import foundation.propositional-resizing
+open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.raising-universe-levels
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.transport-along-identifications
+open import foundation.unions-subtypes
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import modal-logic.axioms
+open import modal-logic.canonical-model-theorem
+open import modal-logic.completeness
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+open import modal-logic.modal-logic-k
+open import modal-logic.soundness
+open import modal-logic.weak-deduction
+
+open import order-theory.zorn
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 : Level}
+ (i : Set l1)
+ (lem : LEM l1)
+ (zorn : Zorn (lsuc l1) l1 l1)
+ (prop-resize : propositional-resizing l1 (lsuc l1))
+ where
+
+ completeness-K : completeness (modal-logic-K i) (all-models (lsuc l1) l1 i l1)
+ completeness-K =
+ canonical-model-completness
+ ( modal-logic-K i)
+ ( is-modal-logic-K i)
+ ( is-consistent-K i)
+ ( is-normal-modal-logic-K i)
+ ( zorn)
+ ( prop-resize)
+ ( lem)
+ ( all-models (lsuc l1) l1 i l1)
+ ( star)
+```
diff --git a/src/modal-logic/completeness-s5.lagda.md b/src/modal-logic/completeness-s5.lagda.md
new file mode 100644
index 0000000000..6be7337d8e
--- /dev/null
+++ b/src/modal-logic/completeness-s5.lagda.md
@@ -0,0 +1,113 @@
+# Completeness of S5
+
+```agda
+module modal-logic.completeness-s5 where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-functions
+open import foundation.cartesian-product-types
+open import foundation.coproduct-types
+open import foundation.dependent-pair-types
+open import foundation.disjunction
+open import foundation.empty-types
+open import foundation.existential-quantification
+open import foundation.function-types
+open import foundation.identity-types
+open import foundation.inhabited-types
+open import foundation.intersections-subtypes
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.negation
+open import foundation.propositional-resizing
+open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.raising-universe-levels
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.transport-along-identifications
+open import foundation.unions-subtypes
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import modal-logic.axioms
+open import modal-logic.canonical-model-theorem
+open import modal-logic.canonical-theories
+open import modal-logic.completeness
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+open import modal-logic.modal-logic-s5
+open import modal-logic.soundness
+open import modal-logic.weak-deduction
+
+open import order-theory.zorn
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 : Level}
+ (i : Set l1)
+ (lem : LEM l1)
+ (zorn : Zorn (lsuc l1) l1 l1)
+ (prop-resize : propositional-resizing l1 (lsuc l1))
+ where
+
+ S5-canonical-model-is-equivalence :
+ is-in-subtype
+ ( equivalence-kripke-models (lsuc l1) l1 i l1)
+ ( canonical-kripke-model
+ ( modal-logic-S5 i)
+ ( is-modal-logic-S5 i)
+ ( is-consistent-S5 i)
+ ( is-normal-modal-logic-S5 i)
+ ( zorn)
+ ( prop-resize))
+ S5-canonical-model-is-equivalence =
+ triple
+ ( is-canonical-ax-m i zorn prop-resize
+ ( modal-logic-S5 i)
+ ( is-modal-logic-S5 i)
+ ( is-consistent-S5 i)
+ ( is-normal-modal-logic-S5 i)
+ ( modal-logic-S5-contains-ax-m i))
+ ( is-canonical-ax-b i zorn prop-resize
+ ( modal-logic-S5 i)
+ ( is-modal-logic-S5 i)
+ ( is-consistent-S5 i)
+ ( is-normal-modal-logic-S5 i)
+ ( lem)
+ ( modal-logic-S5-contains-ax-b i))
+ ( is-canonical-ax-4 i zorn prop-resize
+ ( modal-logic-S5 i)
+ ( is-modal-logic-S5 i)
+ ( is-consistent-S5 i)
+ ( is-normal-modal-logic-S5 i)
+ ( modal-logic-S5-contains-ax-4 i))
+
+ completeness-S5 :
+ completeness
+ ( modal-logic-S5 i)
+ ( equivalence-kripke-models (lsuc l1) l1 i l1)
+ completeness-S5 =
+ canonical-model-completness
+ ( modal-logic-S5 i)
+ ( is-modal-logic-S5 i)
+ ( is-consistent-S5 i)
+ ( is-normal-modal-logic-S5 i)
+ ( zorn)
+ ( prop-resize)
+ ( lem)
+ ( equivalence-kripke-models (lsuc l1) l1 i l1)
+ ( S5-canonical-model-is-equivalence)
+```
diff --git a/src/modal-logic/completeness.lagda.md b/src/modal-logic/completeness.lagda.md
new file mode 100644
index 0000000000..4ef7f28e94
--- /dev/null
+++ b/src/modal-logic/completeness.lagda.md
@@ -0,0 +1,46 @@
+# Modal logic completeness
+
+```agda
+module modal-logic.completeness where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.inhabited-types
+open import foundation.intersections-subtypes
+open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.transport-along-identifications
+open import foundation.unions-subtypes
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 l3 l4 l5 l6 : Level} {i : Set l1}
+ where
+
+ completeness :
+ modal-theory l2 i →
+ model-class l3 l4 i l5 l6 →
+ UU (l1 ⊔ l2 ⊔ lsuc l3 ⊔ lsuc l4 ⊔ lsuc l5 ⊔ l6)
+ completeness logic C = class-modal-logic C ⊆ logic
+```
diff --git a/src/modal-logic/decision-procedure.lagda.md b/src/modal-logic/decision-procedure.lagda.md
new file mode 100644
index 0000000000..2cee89ab6f
--- /dev/null
+++ b/src/modal-logic/decision-procedure.lagda.md
@@ -0,0 +1,81 @@
+# Modal logic decision
+
+```agda
+module modal-logic.decision-procedure where
+```
+
+Imports
+
+```agda
+open import foundation.booleans
+open import foundation.decidable-types
+open import foundation.dependent-pair-types
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+
+open import modal-logic.completeness
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+open import modal-logic.soundness
+
+open import univalent-combinatorics.decidable-dependent-function-types
+open import univalent-combinatorics.finite-types
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l3 l4 l5 l6 : Level}
+ (i : Set l1)
+ (C : model-class l3 l4 i l5 l6)
+ (C-sub-fin : C ⊆ finite-decidable-kripke-models l3 l4 i l5)
+ (C-is-fin : is-finite (type-subtype C))
+ where
+
+ decision-procedure' :
+ (a : modal-formula i) →
+ is-decidable
+ ( (M : type-subtype C) → type-Prop (inclusion-subtype C M ⊨Mₘ a))
+ decision-procedure' a =
+ is-decidable-Π-is-finite
+ ( C-is-fin)
+ ( λ (M , M-in-C) →
+ ( is-finite-model-valuate-decidable-kripke-models i M
+ ( C-sub-fin M M-in-C)
+ ( a)))
+
+ decision-procedure : (a : modal-formula i) → bool
+ decision-procedure a with decision-procedure' a
+ ... | inl _ = true
+ ... | inr _ = false
+
+ decision-procedure-correctness :
+ {l2 : Level} (theory : modal-theory l2 i) →
+ soundness theory C →
+ completeness theory C →
+ (a : modal-formula i) →
+ is-in-subtype theory a ↔ type-prop-bool (decision-procedure a)
+ pr1 (decision-procedure-correctness theory sound complete a) in-theory
+ with decision-procedure' a
+ ... | inl _ = star
+ ... | inr not-valid-in-C =
+ not-valid-in-C (λ (M , M-in-C) x → sound a in-theory M M-in-C x)
+ pr2 (decision-procedure-correctness theory sound complete a) _
+ with decision-procedure' a
+ ... | inl valid-in-C = complete a (λ M M-in-C → valid-in-C (M , M-in-C))
+```
diff --git a/src/modal-logic/deduction.lagda.md b/src/modal-logic/deduction.lagda.md
new file mode 100644
index 0000000000..2b0c57d3eb
--- /dev/null
+++ b/src/modal-logic/deduction.lagda.md
@@ -0,0 +1,338 @@
+# Modal logic deduction
+
+```agda
+module modal-logic.deduction where
+```
+
+Imports
+
+```agda
+open import foundation.conjunction
+open import foundation.coproduct-types
+open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.existential-quantification
+open import foundation.function-types
+open import foundation.identity-types
+open import foundation.negation
+open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.unions-subtypes
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.cartesian-product-types
+
+open import modal-logic.formulas
+```
+
+
+
+## Idea
+
+The deduction system of modal logic is defined inductively as follows:
+
+a ∈ T ------ (AX) T ⊢ a
+
+T ⊢ a → b T ⊢ a ------------------ (MP) T ⊢ b
+
+T ⊢ a ------ (NEC) T ⊢ □a
+
+where `T` is a set of formulas and `a`, `b` are formulas.
+
+Modal logic generated by a set of axioms is the smallest set of formulas that
+contains the axioms and is closed under the deduction system.
+
+## Definition
+
+### Theory of modal formulas
+
+```agda
+module _
+ {l1 : Level} (l2 : Level) (i : Set l1)
+ where
+
+ modal-theory : UU (l1 ⊔ lsuc l2)
+ modal-theory = subtype l2 (modal-formula i)
+```
+
+### Deduction system
+
+```agda
+module _
+ {l1 l2 : Level} {i : Set l1}
+ where
+
+ infix 5 _⊢ₘ_
+
+ data _⊢ₘ_ (axioms : modal-theory l2 i) : modal-formula i → UU (l1 ⊔ l2) where
+ modal-ax : {a : modal-formula i} → is-in-subtype axioms a → axioms ⊢ₘ a
+ modal-mp :
+ {a b : modal-formula i} → axioms ⊢ₘ a →ₘ b → axioms ⊢ₘ a → axioms ⊢ₘ b
+ modal-nec : {a : modal-formula i} → axioms ⊢ₘ a → axioms ⊢ₘ □ₘ a
+```
+
+### Closure of a theory under the deduction system
+
+```agda
+ modal-logic-closure : modal-theory l2 i → modal-theory (l1 ⊔ l2) i
+ modal-logic-closure axioms a = trunc-Prop (axioms ⊢ₘ a)
+```
+
+### Modal logic predicate
+
+```agda
+ is-modal-logic-Prop : modal-theory l2 i → Prop (l1 ⊔ l2)
+ is-modal-logic-Prop theory =
+ leq-prop-subtype (modal-logic-closure theory) theory
+
+ is-modal-logic : modal-theory l2 i → UU (l1 ⊔ l2)
+ is-modal-logic = type-Prop ∘ is-modal-logic-Prop
+```
+
+### TODO: Title
+
+```agda
+ is-in-modal-logic-closure-deduction :
+ {axioms : modal-theory l2 i} {a : modal-formula i} →
+ axioms ⊢ₘ a → is-in-subtype (modal-logic-closure axioms) a
+ is-in-modal-logic-closure-deduction = unit-trunc-Prop
+
+ is-contradictory-modal-logic-Prop : modal-theory l2 i → Prop l2
+ is-contradictory-modal-logic-Prop logic = logic ⊥ₘ
+
+ is-contradictory-modal-logic : modal-theory l2 i → UU l2
+ is-contradictory-modal-logic = type-Prop ∘ is-contradictory-modal-logic-Prop
+
+ is-consistent-modal-logic-Prop : modal-theory l2 i → Prop l2
+ is-consistent-modal-logic-Prop = neg-Prop ∘ is-contradictory-modal-logic-Prop
+
+ is-consistent-modal-logic : modal-theory l2 i → UU l2
+ is-consistent-modal-logic = type-Prop ∘ is-consistent-modal-logic-Prop
+
+module _
+ {l1 : Level} {i : Set l1}
+ where
+
+ is-contradictory-modal-logic-monotic :
+ {l2 l3 : Level} (ax₁ : modal-theory l2 i) (ax₂ : modal-theory l3 i) →
+ ax₁ ⊆ ax₂ →
+ is-contradictory-modal-logic ax₁ →
+ is-contradictory-modal-logic ax₂
+ is-contradictory-modal-logic-monotic ax₁ ax₂ leq = leq ⊥ₘ
+
+ is-consistent-modal-logic-antimonotic :
+ {l2 l3 : Level} (ax₁ : modal-theory l2 i) (ax₂ : modal-theory l3 i) →
+ ax₁ ⊆ ax₂ →
+ is-consistent-modal-logic ax₂ →
+ is-consistent-modal-logic ax₁
+ is-consistent-modal-logic-antimonotic ax₁ ax₂ leq is-cons =
+ is-cons ∘ is-contradictory-modal-logic-monotic ax₁ ax₂ leq
+
+module _
+ {l1 l2 : Level} {i : Set l1} {axioms : modal-theory l2 i}
+ where
+
+ modal-logic-closure-ax :
+ {a : modal-formula i} →
+ is-in-subtype axioms a →
+ is-in-subtype (modal-logic-closure axioms) a
+ modal-logic-closure-ax = unit-trunc-Prop ∘ modal-ax
+
+ modal-logic-closure-mp :
+ {a b : modal-formula i} →
+ is-in-subtype (modal-logic-closure axioms) (a →ₘ b) →
+ is-in-subtype (modal-logic-closure axioms) a →
+ is-in-subtype (modal-logic-closure axioms) b
+ modal-logic-closure-mp {a} {b} tdab tda =
+ apply-twice-universal-property-trunc-Prop tdab tda
+ ( modal-logic-closure axioms b)
+ ( λ dab da → unit-trunc-Prop (modal-mp dab da))
+
+ modal-logic-closure-nec :
+ {a : modal-formula i} →
+ is-in-subtype (modal-logic-closure axioms) a →
+ is-in-subtype (modal-logic-closure axioms) (□ₘ a)
+ modal-logic-closure-nec {a} =
+ map-universal-property-trunc-Prop
+ ( modal-logic-closure axioms (□ₘ a))
+ ( λ da → unit-trunc-Prop (modal-nec da))
+
+module _
+ {l1 l2 : Level} {i : Set l1}
+ {logic : modal-theory l2 i} (is-logic : is-modal-logic logic)
+ where
+
+ modal-logic-mp :
+ {a b : modal-formula i} →
+ is-in-subtype logic (a →ₘ b) →
+ is-in-subtype logic a →
+ is-in-subtype logic b
+ modal-logic-mp {a} {b} dab da =
+ is-logic b
+ ( modal-logic-closure-mp
+ ( modal-logic-closure-ax dab)
+ ( modal-logic-closure-ax da))
+
+ modal-logic-nec :
+ {a : modal-formula i} →
+ is-in-subtype logic a →
+ is-in-subtype logic (□ₘ a)
+ modal-logic-nec {a} d =
+ is-logic (□ₘ a) (modal-logic-closure-nec (modal-logic-closure-ax d))
+
+module _
+ {l1 : Level} {i : Set l1}
+ where
+
+ axioms-subset-modal-logic :
+ {l2 : Level} (axioms : modal-theory l2 i) →
+ axioms ⊆ modal-logic-closure axioms
+ axioms-subset-modal-logic _ a H = unit-trunc-Prop (modal-ax H)
+
+ modal-logic-closed :
+ {l2 : Level} {axioms : modal-theory l2 i} {a : modal-formula i} →
+ modal-logic-closure axioms ⊢ₘ a →
+ is-in-subtype (modal-logic-closure axioms) a
+ modal-logic-closed (modal-ax x) = x
+ modal-logic-closed (modal-mp dab da) =
+ modal-logic-closure-mp (modal-logic-closed dab) (modal-logic-closed da)
+ modal-logic-closed (modal-nec d) =
+ modal-logic-closure-nec (modal-logic-closed d)
+
+ -- TODO: refactor
+ is-modal-logic-modal-logic-closure :
+ {l2 : Level}
+ (axioms : modal-theory l2 i) →
+ is-modal-logic (modal-logic-closure axioms)
+ is-modal-logic-modal-logic-closure axioms a =
+ map-universal-property-trunc-Prop
+ ( modal-logic-closure axioms a)
+ ( modal-logic-closed)
+
+module _
+ {l1 l2 l3 : Level} {i : Set l1}
+ {ax₁ : modal-theory l2 i} {ax₂ : modal-theory l3 i}
+ (leq : ax₁ ⊆ ax₂)
+ where
+
+ deduction-monotic : {a : modal-formula i} → ax₁ ⊢ₘ a → ax₂ ⊢ₘ a
+ deduction-monotic (modal-ax x) = modal-ax (leq _ x)
+ deduction-monotic (modal-mp dab da) =
+ modal-mp (deduction-monotic dab) (deduction-monotic da)
+ deduction-monotic (modal-nec d) = modal-nec (deduction-monotic d)
+
+ modal-logic-monotic : modal-logic-closure ax₁ ⊆ modal-logic-closure ax₂
+ modal-logic-monotic a =
+ map-universal-property-trunc-Prop
+ ( modal-logic-closure ax₂ a)
+ ( unit-trunc-Prop ∘ deduction-monotic)
+
+module _
+ {l1 l2 l3 : Level} {i : Set l1}
+ {ax₁ : modal-theory l2 i} {ax₂ : modal-theory l3 i}
+ where
+
+ subset-modal-logic-if-subset-axioms :
+ ax₁ ⊆ modal-logic-closure ax₂ →
+ modal-logic-closure ax₁ ⊆ modal-logic-closure ax₂
+ subset-modal-logic-if-subset-axioms leq =
+ transitive-leq-subtype
+ ( modal-logic-closure ax₁)
+ ( modal-logic-closure (modal-logic-closure ax₂))
+ ( modal-logic-closure ax₂)
+ ( is-modal-logic-modal-logic-closure ax₂)
+ ( modal-logic-monotic leq)
+
+module _
+ {l1 l2 : Level} {i : Set l1}
+ (a : modal-formula i)
+ (theory : modal-theory l2 i)
+ where
+
+ -- TODO: make Id-formula to be a function for 1 element modal-theory
+ theory-add-formula : modal-theory (l1 ⊔ l2) i
+ theory-add-formula = (Id-modal-formula-Prop a) ∪ theory
+
+ formula-in-add-formula : is-in-subtype theory-add-formula a
+ formula-in-add-formula =
+ subtype-union-left (Id-modal-formula-Prop a) theory a refl
+
+ subset-add-formula : theory ⊆ theory-add-formula
+ subset-add-formula = subtype-union-right (Id-modal-formula-Prop a) theory
+
+ transitive-subset-add-formula :
+ {l3 : Level} (theory' : modal-theory l3 i) →
+ theory' ⊆ theory →
+ theory' ⊆ theory-add-formula
+ transitive-subset-add-formula theory' leq =
+ transitive-leq-subtype theory' theory theory-add-formula
+ ( subset-add-formula)
+ ( leq)
+
+ elim-theory-add-formula :
+ {l3 : Level} (P : modal-formula i → Prop l3) →
+ type-Prop (P a) →
+ ((x : modal-formula i) → is-in-subtype theory x → type-Prop (P x)) →
+ (x : modal-formula i) → is-in-subtype theory-add-formula x → type-Prop (P x)
+ elim-theory-add-formula P H-a H-rest =
+ elim-union-subtype (Id-modal-formula-Prop a) theory P
+ ( λ where .a refl → H-a)
+ ( H-rest)
+
+ subset-theory-add-formula :
+ {l3 : Level} (theory' : modal-theory l3 i) →
+ is-in-subtype theory' a →
+ theory ⊆ theory' →
+ theory-add-formula ⊆ theory'
+ subset-theory-add-formula theory' a-in =
+ subtype-union-both
+ ( Id-modal-formula-Prop a)
+ ( theory)
+ ( theory')
+ ( λ where .a refl → a-in)
+
+module _
+ {l1 l2 : Level} {i : Set l1}
+ where
+
+ unbox-modal-theory : modal-theory l2 i → modal-theory l2 i
+ unbox-modal-theory theory a = theory (□ₘ a)
+
+ diamond-modal-theory : modal-theory l2 i → modal-theory (l1 ⊔ l2) i
+ diamond-modal-theory theory a =
+ exists-structure-Prop
+ ( modal-formula i)
+ ( λ b → is-in-subtype theory b × (a = ◇ₘ b))
+
+module _
+ {l1 : Level} {i : Set l1}
+ where
+
+ is-disjuctive-modal-theory :
+ {l2 : Level} → modal-theory l2 i → UU (l1 ⊔ l2)
+ is-disjuctive-modal-theory theory =
+ (a : modal-formula i) → is-in-subtype theory a + is-in-subtype theory (¬ₘ a)
+
+ theory-add-formula-union-right :
+ (a : modal-formula i)
+ {l2 l3 : Level}
+ (theory : modal-theory l2 i)
+ (theory' : modal-theory l3 i) →
+ theory ∪ theory-add-formula a theory' ⊆
+ theory-add-formula a (theory ∪ theory')
+ theory-add-formula-union-right a theory theory' =
+ union-swap-1-2 theory (Id-modal-formula-Prop a) theory'
+
+ inv-theory-add-formula-union-right :
+ (a : modal-formula i)
+ {l2 l3 : Level}
+ (theory : modal-theory l2 i)
+ (theory' : modal-theory l3 i) →
+ theory-add-formula a (theory ∪ theory') ⊆
+ theory ∪ theory-add-formula a theory'
+ inv-theory-add-formula-union-right a theory theory' =
+ union-swap-1-2 (Id-modal-formula-Prop a) theory theory'
+```
diff --git a/src/modal-logic/filtrated-kripke-classes.lagda.md b/src/modal-logic/filtrated-kripke-classes.lagda.md
new file mode 100644
index 0000000000..74498cab63
--- /dev/null
+++ b/src/modal-logic/filtrated-kripke-classes.lagda.md
@@ -0,0 +1,137 @@
+# Filtrated Kripke Classes
+
+```agda
+module modal-logic.filtrated-kripke-classes where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.equivalence-classes
+open import foundation.existential-quantification
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.universe-levels
+
+open import foundation-core.cartesian-product-types
+open import foundation-core.identity-types
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+
+open import lists.lists-subtypes
+
+open import modal-logic.closed-under-subformulas-theories
+open import modal-logic.completeness
+open import modal-logic.deduction
+open import modal-logic.filtration-lemma
+open import modal-logic.formulas
+open import modal-logic.kripke-models-filtrations
+open import modal-logic.kripke-semantics
+open import modal-logic.soundness
+open import modal-logic.subformulas
+
+open import univalent-combinatorics.finite-types
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 l3 l4 l5 l6 l7 l8 : Level} (i : Set l3)
+ (C : model-class l1 l2 i l4 l5)
+ (filtration : modal-theory l3 i →
+ kripke-model l1 l2 i l4 →
+ kripke-model l6 l7 i l8)
+ where
+
+ filtrate-class :
+ model-class l6 l7 i l8 ( l3 ⊔ l5 ⊔ lsuc (l1 ⊔ l2 ⊔ l4 ⊔ l6 ⊔ l7 ⊔ l8))
+ filtrate-class M* =
+ exists-structure-Prop (modal-formula i × type-subtype C)
+ ( λ (a , M , _) → M* = filtration (subformulas a) M)
+
+ module _
+ (filtration-is-filtration :
+ ((M , _) : type-subtype C)
+ (theory : modal-theory l3 i) →
+ is-modal-theory-closed-under-subformulas theory →
+ is-kripke-model-filtration theory M (filtration theory M))
+ where
+
+ is-finite-filtrate-class :
+ LEM (lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4)) →
+ filtrate-class ⊆ finite-kripke-models l6 l7 i l8
+ is-finite-filtrate-class lem M* =
+ elim-exists
+ ( finite-kripke-models l6 l7 i l8 M*)
+ ( λ where
+ (a , M , M-in-C) refl →
+ ( is-finite-equiv
+ ( equiv-is-kripke-model-filtration
+ ( subformulas a)
+ ( M)
+ ( M*)
+ ( filtration-is-filtration
+ ( M , M-in-C)
+ ( subformulas a)
+ ( is-modal-theory-closed-under-subformulas-subformulas a)))
+ ( is-finite-equivalence-classes-filtration i M lem
+ ( subformulas a)
+ ( is-finite-subformulas-list
+ ( lower-LEM (lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4)) lem)
+ ( a)))))
+
+ filtrate-completeness :
+ {l9 : Level} (logic : modal-theory l9 i) →
+ completeness logic C →
+ completeness logic filtrate-class
+ filtrate-completeness logic complete a in-logic =
+ complete a
+ ( λ M M-in-class x →
+ ( backward-implication
+ ( filtration-lemma
+ ( subformulas a)
+ ( is-modal-theory-closed-under-subformulas-subformulas a)
+ ( M)
+ ( filtration (subformulas a) M)
+ ( filtration-is-filtration
+ ( M , M-in-class)
+ ( subformulas a)
+ ( is-modal-theory-closed-under-subformulas-subformulas a))
+ ( a)
+ ( head-in-list-subtype)
+ ( x))
+ ( in-logic
+ ( filtration (subformulas a) M)
+ ( intro-exists (a , M , M-in-class) refl)
+ ( map-equiv-is-kripke-model-filtration
+ ( subformulas a)
+ ( M)
+ ( filtration (subformulas a) M)
+ ( filtration-is-filtration
+ ( M , M-in-class)
+ ( subformulas a)
+ ( is-modal-theory-closed-under-subformulas-subformulas a))
+ ( class (Φ-equivalence (subformulas a) M) x)))))
+
+ filtrate-soundness :
+ {l9 l10 : Level} (logic : modal-theory l9 i) →
+ (C₂ : model-class l6 l7 i l8 l10) →
+ filtrate-class ⊆ C₂ →
+ soundness logic C₂ →
+ soundness logic filtrate-class
+ filtrate-soundness logic C₂ H =
+ transitive-leq-subtype
+ ( logic)
+ ( class-modal-logic C₂)
+ ( class-modal-logic filtrate-class)
+ ( class-modal-logic-monotic filtrate-class C₂ H)
+```
diff --git a/src/modal-logic/filtration-lemma.lagda.md b/src/modal-logic/filtration-lemma.lagda.md
new file mode 100644
index 0000000000..54c6434001
--- /dev/null
+++ b/src/modal-logic/filtration-lemma.lagda.md
@@ -0,0 +1,208 @@
+# Kripke models filtrations theorem
+
+```agda
+module modal-logic.filtration-lemma where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-functions
+open import foundation.binary-relations
+open import foundation.coproduct-types
+open import foundation.decidable-types
+open import foundation.dependent-pair-types
+open import foundation.equivalence-classes
+open import foundation.equivalences
+open import foundation.existential-quantification
+open import foundation.function-types
+open import foundation.identity-types
+open import foundation.inhabited-types
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.raising-universe-levels
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.transport-along-identifications
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.cartesian-product-types
+open import foundation-core.embeddings
+open import foundation-core.equivalence-relations
+open import foundation-core.invertible-maps
+
+open import modal-logic.closed-under-subformulas-theories
+open import modal-logic.completeness
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-models-filtrations
+open import modal-logic.kripke-semantics
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 l3 l4 l5 l6 l7 l8 : Level} {i : Set l3}
+ (theory : modal-theory l5 i)
+ (theory-is-closed : is-modal-theory-closed-under-subformulas theory)
+ (M : kripke-model l1 l2 i l4) (M* : kripke-model l6 l7 i l8)
+ where
+
+ filtration-lemma :
+ (is-filtration : is-kripke-model-filtration theory M M*)
+ (a : modal-formula i) →
+ is-in-subtype theory a →
+ (x : type-kripke-model i M) →
+ type-iff-Prop
+ ( (M , x) ⊨ₘ a)
+ ( pair
+ ( M*)
+ ( map-equiv-is-kripke-model-filtration theory M M* is-filtration
+ ( class (Φ-equivalence theory M) x))
+ ⊨ₘ a)
+ pr1 (filtration-lemma is-filtration (varₘ n) in-theory x)
+ f =
+ map-raise
+ ( forward-implication
+ ( is-filtration-valuate-is-kripke-model-filtration
+ ( theory)
+ ( M)
+ ( M*)
+ ( is-filtration)
+ ( n)
+ ( in-theory)
+ ( x))
+ ( map-inv-raise f))
+ pr1 (filtration-lemma is-filtration ⊥ₘ in-theory x) =
+ map-raise ∘ map-inv-raise
+ pr1 (filtration-lemma is-filtration (a →ₘ b) in-theory x)
+ fab fa =
+ let (a-in-theory , b-in-theory) =
+ is-has-subimps-is-closed-under-subformulas
+ ( theory)
+ ( theory-is-closed)
+ ( in-theory)
+ in forward-implication
+ ( filtration-lemma is-filtration b
+ ( b-in-theory)
+ ( x))
+ ( fab
+ ( backward-implication
+ ( filtration-lemma is-filtration a
+ ( a-in-theory)
+ ( x))
+ ( fa)))
+ pr1 (filtration-lemma is-filtration (□ₘ a) in-theory x)
+ f y* r-xy =
+ apply-universal-property-trunc-Prop
+ ( is-inhabited-subtype-equivalence-class
+ ( Φ-equivalence theory M)
+ ( map-inv-equiv-is-kripke-model-filtration theory M M*
+ ( is-filtration)
+ ( y*)))
+ ( (M* , y*) ⊨ₘ a)
+ ( λ (y , y-in-class) →
+ ( let y*-id-class =
+ concat
+ ( ap
+ ( map-equiv-is-kripke-model-filtration theory M M*
+ ( is-filtration))
+ ( eq-class-equivalence-class
+ ( Φ-equivalence theory M)
+ ( map-inv-equiv-is-kripke-model-filtration theory M
+ ( M*)
+ ( is-filtration)
+ ( y*))
+ ( y-in-class)))
+ ( y*)
+ ( is-retraction-map-retraction-map-equiv
+ ( inv-equiv
+ ( equiv-is-kripke-model-filtration theory M M*
+ ( is-filtration)))
+ ( y*))
+ in tr
+ ( λ z* → type-Prop ((M* , z*) ⊨ₘ a))
+ ( y*-id-class)
+ ( forward-implication
+ ( filtration-lemma is-filtration a
+ ( is-has-subboxes-is-closed-under-subformulas
+ ( theory)
+ ( theory-is-closed)
+ ( in-theory))
+ ( y))
+ ( filtration-relation-upper-bound-is-kripke-model-filtration
+ ( theory)
+ ( M)
+ ( M*)
+ ( is-filtration)
+ ( a)
+ ( in-theory)
+ ( x)
+ ( y)
+ ( tr
+ ( relation-kripke-model i M*
+ ( map-equiv-is-kripke-model-filtration theory M M*
+ ( is-filtration)
+ ( class (Φ-equivalence theory M) x)))
+ ( inv y*-id-class)
+ ( r-xy))
+ (f)))))
+ pr2 (filtration-lemma is-filtration (varₘ n) in-theory x)
+ f =
+ map-raise
+ ( backward-implication
+ ( is-filtration-valuate-is-kripke-model-filtration theory M M*
+ ( is-filtration)
+ ( n)
+ ( in-theory)
+ ( x))
+ ( map-inv-raise f))
+ pr2 (filtration-lemma is-filtration ⊥ₘ in-theory x) =
+ map-raise ∘ map-inv-raise
+ pr2 (filtration-lemma is-filtration (a →ₘ b) in-theory x)
+ fab fa =
+ let (a-in-theory , b-in-theory) =
+ is-has-subimps-is-closed-under-subformulas
+ ( theory)
+ ( theory-is-closed)
+ ( in-theory)
+ in backward-implication
+ ( filtration-lemma is-filtration b
+ ( b-in-theory)
+ ( x))
+ ( fab
+ ( forward-implication
+ ( filtration-lemma is-filtration a
+ ( a-in-theory)
+ ( x))
+ ( fa)))
+ pr2 (filtration-lemma is-filtration (□ₘ a) in-theory x)
+ f y r-xy =
+ backward-implication
+ ( filtration-lemma is-filtration a
+ ( is-has-subboxes-is-closed-under-subformulas
+ ( theory)
+ ( theory-is-closed)
+ ( in-theory))
+ ( y))
+ ( f
+ ( map-equiv-is-kripke-model-filtration theory M M* is-filtration
+ ( class (Φ-equivalence theory M) y))
+ ( filtration-relation-lower-bound-is-kripke-model-filtration theory
+ ( M)
+ ( M*)
+ ( is-filtration)
+ ( x)
+ ( y)
+ ( r-xy)))
+```
diff --git a/src/modal-logic/finite-approximability.lagda.md b/src/modal-logic/finite-approximability.lagda.md
new file mode 100644
index 0000000000..b3179123e5
--- /dev/null
+++ b/src/modal-logic/finite-approximability.lagda.md
@@ -0,0 +1,193 @@
+# Finite approximability
+
+```agda
+module modal-logic.finite-approximability where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.existential-quantification
+open import foundation.law-of-excluded-middle
+open import foundation.propositional-resizing
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.cartesian-product-types
+open import foundation-core.identity-types
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+
+open import modal-logic.closed-under-subformulas-theories
+open import modal-logic.completeness
+open import modal-logic.completeness-k
+open import modal-logic.completeness-s5
+open import modal-logic.deduction
+open import modal-logic.filtrated-kripke-classes
+open import modal-logic.kripke-models-filtrations
+open import modal-logic.kripke-semantics
+open import modal-logic.minimal-kripke-filtration
+open import modal-logic.minimal-transitive-kripke-filtration
+open import modal-logic.modal-logic-k
+open import modal-logic.modal-logic-s5
+open import modal-logic.soundness
+open import modal-logic.subformulas
+
+open import order-theory.zorn
+
+open import univalent-combinatorics.finite-types
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 : Level} (i : Set l1)
+ where
+ is-finitely-approximable-Prop :
+ {l2 : Level} (l3 l4 l5 l6 : Level) →
+ modal-theory l2 i →
+ Prop (l1 ⊔ l2 ⊔ lsuc l3 ⊔ lsuc l4 ⊔ lsuc l5 ⊔ lsuc l6)
+ is-finitely-approximable-Prop l3 l4 l5 l6 logic =
+ exists-structure-Prop
+ ( model-class l3 l4 i l5 l6)
+ ( λ C →
+ ( C ⊆ finite-kripke-models l3 l4 i l5) ×
+ ( soundness logic C) ×
+ ( completeness logic C))
+
+ is-finitely-approximable :
+ {l2 : Level} (l3 l4 l5 l6 : Level) →
+ modal-theory l2 i →
+ UU (l1 ⊔ l2 ⊔ lsuc l3 ⊔ lsuc l4 ⊔ lsuc l5 ⊔ lsuc l6)
+ is-finitely-approximable l3 l4 l5 l6 logic =
+ type-Prop (is-finitely-approximable-Prop l3 l4 l5 l6 logic)
+
+ module _
+ {l2 l3 l4 l5 l6 l7 l8 l9 l10 : Level}
+ (C : model-class l2 l3 i l4 l5)
+ (filtration : modal-theory l1 i →
+ kripke-model l2 l3 i l4 →
+ kripke-model l6 l7 i l8)
+ (is-filtration :
+ ((M , _) : type-subtype C) (theory : modal-theory l1 i) →
+ is-modal-theory-closed-under-subformulas theory →
+ is-kripke-model-filtration theory M (filtration theory M))
+ (logic : modal-theory l9 i)
+ (complete : completeness logic C)
+ (C₂ : model-class l6 l7 i l8 l10)
+ (leq : filtrate-class i C filtration ⊆ C₂)
+ (sound : soundness logic C₂)
+ where
+
+ is-finitely-approximable-filtration :
+ LEM (lsuc l1 ⊔ lsuc l2 ⊔ lsuc l3 ⊔ lsuc l4) →
+ is-finitely-approximable l6 l7 l8
+ (l1 ⊔ l5 ⊔ lsuc (l2 ⊔ l3 ⊔ l4 ⊔ l6 ⊔ l7 ⊔ l8)) logic
+ is-finitely-approximable-filtration lem =
+ intro-exists (filtrate-class i C filtration)
+ ( triple
+ ( is-finite-filtrate-class i C filtration is-filtration lem)
+ ( filtrate-soundness i C filtration logic C₂ leq sound)
+ ( filtrate-completeness i C filtration is-filtration logic complete))
+
+ module _
+ (lem : LEM (lsuc (lsuc l1)))
+ (zorn : Zorn (lsuc l1) l1 l1)
+ (prop-resize : propositional-resizing l1 (lsuc l1))
+ where
+
+ is-finitely-approximable-K :
+ is-finitely-approximable
+ ( lsuc (lsuc l1))
+ ( lsuc l1)
+ ( lsuc l1)
+ ( lsuc (lsuc (lsuc l1)))
+ ( modal-logic-K i)
+ is-finitely-approximable-K =
+ is-finitely-approximable-filtration
+ ( all-models (lsuc l1) l1 i l1)
+ ( minimal-kripke-model-filtration)
+ ( λ (M , _) theory is-closed →
+ ( is-kripke-model-filtration-minimal-kripke-model-filtration
+ ( theory)
+ ( M)
+ ( is-closed)))
+ ( modal-logic-K i)
+ ( completeness-K i (lower-LEM (lsuc (lsuc l1)) lem) zorn prop-resize)
+ ( all-models (lsuc (lsuc l1)) (lsuc l1) i (lsuc l1))
+ ( λ _ _ → star)
+ ( transitive-leq-subtype
+ ( modal-logic-K i)
+ ( class-modal-logic
+ ( decidable-kripke-models (lsuc (lsuc l1)) (lsuc l1) i (lsuc l1)))
+ ( class-modal-logic
+ ( all-models (lsuc (lsuc l1)) (lsuc l1) i (lsuc l1)))
+ ( class-modal-logic-monotic
+ ( all-models (lsuc (lsuc l1)) (lsuc l1) i (lsuc l1))
+ ( decidable-kripke-models (lsuc (lsuc l1)) (lsuc l1) i (lsuc l1))
+ ( all-models-is-decidable i lem))
+ ( soundness-K i))
+ ( lem)
+
+ is-finitely-approximable-S5 :
+ is-finitely-approximable
+ ( lsuc (lsuc l1))
+ ( lsuc (lsuc l1))
+ ( lsuc l1)
+ ( lsuc (lsuc (lsuc l1)))
+ ( modal-logic-S5 i)
+ is-finitely-approximable-S5 =
+ is-finitely-approximable-filtration
+ ( equivalence-kripke-models (lsuc l1) l1 i l1)
+ ( minimal-transitive-kripke-model-filtration)
+ ( λ (M , in-equiv) theory is-closed →
+ ( is-filtration-minimal-transitive-kripke-model-filtration
+ ( theory)
+ ( M)
+ ( is-closed)
+ ( pr2 (pr2 in-equiv)))) -- TODO: refactor
+ ( modal-logic-S5 i)
+ ( completeness-S5 i (lower-LEM (lsuc (lsuc l1)) lem) zorn prop-resize)
+ ( equivalence-kripke-models
+ (lsuc (lsuc l1)) (lsuc (lsuc l1)) i (lsuc l1))
+ ( λ M* →
+ ( elim-exists
+ ( equivalence-kripke-models
+ (lsuc (lsuc l1)) (lsuc (lsuc l1)) i (lsuc l1) M*)
+ ( λ where
+ ( a , M , in-equiv) refl →
+ ( minimal-transitive-filtration-preserves-equivalence
+ ( subformulas a)
+ ( M)
+ ( is-modal-theory-closed-under-subformulas-subformulas a)
+ ( in-equiv)))))
+ ( transitive-leq-subtype
+ ( modal-logic-S5 i)
+ ( class-modal-logic
+ ( decidable-subclass i
+ ( equivalence-kripke-models
+ (lsuc (lsuc l1)) (lsuc (lsuc l1)) i (lsuc l1))))
+ ( class-modal-logic
+ ( equivalence-kripke-models
+ (lsuc (lsuc l1)) (lsuc (lsuc l1)) i (lsuc l1)))
+ ( class-modal-logic-monotic
+ ( equivalence-kripke-models
+ (lsuc (lsuc l1)) (lsuc (lsuc l1)) i (lsuc l1))
+ ( decidable-subclass i
+ ( equivalence-kripke-models
+ (lsuc (lsuc l1)) (lsuc (lsuc l1)) i (lsuc l1)))
+ ( subset-decidable-subclass-lem i lem
+ ( equivalence-kripke-models
+ (lsuc (lsuc l1)) (lsuc (lsuc l1)) i (lsuc l1))))
+ ( soundness-S5 i))
+ ( lem)
+```
diff --git a/src/modal-logic/formulas-deduction.lagda.md b/src/modal-logic/formulas-deduction.lagda.md
new file mode 100644
index 0000000000..a49a213e4c
--- /dev/null
+++ b/src/modal-logic/formulas-deduction.lagda.md
@@ -0,0 +1,251 @@
+# Formulas deduction
+
+```agda
+module modal-logic.formulas-deduction where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.logical-equivalences
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.unions-subtypes
+open import foundation.universe-levels
+
+open import foundation-core.identity-types
+
+open import modal-logic.axioms
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.modal-logic-k
+open import modal-logic.weak-deduction
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 : Level} (i : Set l1)
+ (axioms : modal-theory l2 i)
+ (is-normal : is-normal-modal-logic axioms)
+ where
+
+ private
+ contains-ax-k : ax-k i ⊆ axioms
+ contains-ax-k =
+ transitive-leq-subtype
+ ( ax-k i)
+ ( modal-logic-K i)
+ ( axioms)
+ ( is-normal)
+ ( K-contains-ax-k i)
+
+ contains-ax-s : ax-s i ⊆ axioms
+ contains-ax-s =
+ transitive-leq-subtype
+ ( ax-s i)
+ ( modal-logic-K i)
+ ( axioms)
+ ( is-normal)
+ ( K-contains-ax-s i)
+
+ contains-ax-n : ax-n i ⊆ axioms
+ contains-ax-n =
+ transitive-leq-subtype
+ ( ax-n i)
+ ( modal-logic-K i)
+ ( axioms)
+ ( is-normal)
+ ( K-contains-ax-n i)
+
+ contains-ax-dn : ax-dn i ⊆ axioms
+ contains-ax-dn =
+ transitive-leq-subtype
+ ( ax-dn i)
+ ( modal-logic-K i)
+ ( axioms)
+ ( is-normal)
+ ( K-contains-ax-dn i)
+
+ weak-modal-logic-const :
+ (a : modal-formula i) {b : modal-formula i} →
+ is-in-subtype (weak-modal-logic-closure axioms) b →
+ is-in-subtype (weak-modal-logic-closure axioms) (a →ₘ b)
+ weak-modal-logic-const a {b} b-in-logic =
+ weak-modal-logic-closure-mp
+ ( weak-modal-logic-closure-ax
+ ( contains-ax-k (b →ₘ a →ₘ b) (b , a , refl)))
+ ( b-in-logic)
+
+ modal-logic-const :
+ (a : modal-formula i) {b : modal-formula i} →
+ is-in-subtype (modal-logic-closure axioms) b →
+ is-in-subtype (modal-logic-closure axioms) (a →ₘ b)
+ modal-logic-const a {b} b-in-logic =
+ modal-logic-closure-mp
+ ( modal-logic-closure-ax
+ ( contains-ax-k (b →ₘ a →ₘ b) (b , a , refl)))
+ ( b-in-logic)
+
+ weak-modal-logic-transitivity :
+ {a b c : modal-formula i} →
+ is-in-subtype (weak-modal-logic-closure axioms) (b →ₘ c) →
+ is-in-subtype (weak-modal-logic-closure axioms) (a →ₘ b) →
+ is-in-subtype (weak-modal-logic-closure axioms) (a →ₘ c)
+ weak-modal-logic-transitivity {a} {b} {c} bc ab =
+ weak-modal-logic-closure-mp
+ ( weak-modal-logic-closure-mp
+ ( weak-modal-logic-closure-ax
+ ( contains-ax-s _ (a , b , c , refl)))
+ ( weak-modal-logic-const a bc))
+ ( ab)
+
+ modal-logic-transitivity :
+ {a b c : modal-formula i} →
+ is-in-subtype (modal-logic-closure axioms) (b →ₘ c) →
+ is-in-subtype (modal-logic-closure axioms) (a →ₘ b) →
+ is-in-subtype (modal-logic-closure axioms) (a →ₘ c)
+ modal-logic-transitivity {a} {b} {c} bc ab =
+ modal-logic-closure-mp
+ ( modal-logic-closure-mp
+ ( modal-logic-closure-ax
+ ( contains-ax-s _ (a , b , c , refl)))
+ ( modal-logic-const a bc))
+ ( ab)
+
+ modal-logic-implication-box' :
+ {a b : modal-formula i} →
+ is-in-subtype (modal-logic-closure axioms) (a →ₘ b) →
+ is-in-subtype (modal-logic-closure axioms) (□ₘ a →ₘ □ₘ b)
+ modal-logic-implication-box' {a} {b} ab =
+ modal-logic-closure-mp
+ ( modal-logic-closure-ax
+ ( contains-ax-n (□ₘ (a →ₘ b) →ₘ □ₘ a →ₘ □ₘ b) (a , b , refl)))
+ ( modal-logic-closure-nec ab)
+
+ modal-logic-implication-box :
+ {a b : modal-formula i} →
+ is-in-subtype (modal-logic-closure axioms) (a →ₘ b) →
+ is-in-subtype (modal-logic-closure axioms) (□ₘ a) →
+ is-in-subtype (modal-logic-closure axioms) (□ₘ b)
+ modal-logic-implication-box {a} {b} ab box-a =
+ modal-logic-closure-mp
+ ( modal-logic-closure-mp
+ ( modal-logic-closure-ax
+ ( contains-ax-n (□ₘ (a →ₘ b) →ₘ □ₘ a →ₘ □ₘ b) (a , b , refl)))
+ ( modal-logic-closure-nec ab))
+ ( box-a)
+
+ weak-modal-logic-implication-dn :
+ (a : modal-formula i) →
+ is-in-subtype (weak-modal-logic-closure axioms) (a →ₘ ¬¬ₘ a)
+ weak-modal-logic-implication-dn a =
+ inv-deduction-ex-falso axioms contains-ax-k contains-ax-s contains-ax-dn
+ ( a)
+ ( ⊥ₘ)
+
+ modal-logic-implication-dn :
+ (a : modal-formula i) →
+ is-in-subtype (modal-logic-closure axioms) (a →ₘ ¬¬ₘ a)
+ modal-logic-implication-dn a =
+ subset-weak-modal-logic-closure-modal-logic-closure (a →ₘ ¬¬ₘ a)
+ ( weak-modal-logic-implication-dn a)
+
+ weak-modal-logic-implication-negate :
+ {a b : modal-formula i} →
+ is-in-subtype axioms (a →ₘ b) →
+ is-in-subtype (weak-modal-logic-closure axioms) (¬ₘ b →ₘ ¬ₘ a)
+ weak-modal-logic-implication-negate {a} {b} ab =
+ forward-implication
+ ( deduction-theorem axioms contains-ax-k contains-ax-s (¬ₘ b) (¬ₘ a))
+ ( forward-implication
+ ( deduction-theorem
+ ( theory-add-formula (¬ₘ b) axioms)
+ ( contains-ax-k')
+ ( contains-ax-s')
+ ( a)
+ ( ⊥ₘ))
+ ( logic-ex-falso
+ ( theory-add-formula a (theory-add-formula (¬ₘ b) axioms))
+ ( contains-ax-k'')
+ ( contains-ax-s'')
+ ( contains-ax-dn'')
+ ( b)
+ ( ⊥ₘ)
+ ( weak-modal-logic-closure-mp
+ ( weak-modal-logic-closure-ax
+ ( subset-add-formula a (theory-add-formula (¬ₘ b) axioms)
+ ( a →ₘ b)
+ ( subset-add-formula (¬ₘ b) axioms (a →ₘ b) ab)))
+ ( weak-modal-logic-closure-ax
+ ( formula-in-add-formula a (theory-add-formula (¬ₘ b) axioms))))
+ ( weak-modal-logic-closure-ax
+ ( subset-add-formula a (theory-add-formula (¬ₘ b) axioms)
+ ( ¬ₘ b)
+ ( formula-in-add-formula (¬ₘ b) axioms)))))
+ where
+ contains-ax-k' : ax-k i ⊆ theory-add-formula (¬ₘ b) axioms
+ contains-ax-k' =
+ transitive-subset-add-formula (¬ₘ b) axioms (ax-k i) contains-ax-k
+
+ contains-ax-s' : ax-s i ⊆ theory-add-formula (¬ₘ b) axioms
+ contains-ax-s' =
+ transitive-subset-add-formula (¬ₘ b) axioms (ax-s i) contains-ax-s
+
+ contains-ax-k'' :
+ ax-k i ⊆ theory-add-formula a (theory-add-formula (¬ₘ b) axioms)
+ contains-ax-k'' =
+ transitive-subset-add-formula a (theory-add-formula (¬ₘ b) axioms)
+ ( ax-k i)
+ ( contains-ax-k')
+
+ contains-ax-s'' :
+ ax-s i ⊆ theory-add-formula a (theory-add-formula (¬ₘ b) axioms)
+ contains-ax-s'' =
+ transitive-subset-add-formula a (theory-add-formula (¬ₘ b) axioms)
+ ( ax-s i)
+ ( contains-ax-s')
+
+ contains-ax-dn'' :
+ ax-dn i ⊆ theory-add-formula a (theory-add-formula (¬ₘ b) axioms)
+ contains-ax-dn'' =
+ transitive-subset-add-formula a (theory-add-formula (¬ₘ b) axioms)
+ ( ax-dn i)
+ ( transitive-subset-add-formula (¬ₘ b) axioms (ax-dn i) contains-ax-dn)
+
+ modal-logic-implication-negate :
+ {a b : modal-formula i} →
+ is-in-subtype axioms (a →ₘ b) →
+ is-in-subtype (modal-logic-closure axioms) (¬ₘ b →ₘ ¬ₘ a)
+ modal-logic-implication-negate {a} {b} ab =
+ subset-weak-modal-logic-closure-modal-logic-closure (¬ₘ b →ₘ ¬ₘ a)
+ ( weak-modal-logic-implication-negate ab)
+
+ modal-logic-diamond-negate :
+ {a : modal-formula i} →
+ is-in-subtype (modal-logic-closure axioms) (◇ₘ ¬ₘ a) →
+ is-in-subtype (modal-logic-closure axioms) (¬ₘ □ₘ a)
+ modal-logic-diamond-negate {a} dia-a =
+ modal-logic-transitivity
+ ( dia-a)
+ ( modal-logic-implication-box' (modal-logic-implication-dn a))
+
+ modal-logic-diamond-negate-implication :
+ {a : modal-formula i} →
+ is-modal-logic axioms →
+ is-in-subtype axioms (◇ₘ ¬ₘ a →ₘ ¬ₘ □ₘ a)
+ modal-logic-diamond-negate-implication {a} is-logic =
+ is-logic (◇ₘ ¬ₘ a →ₘ ¬ₘ □ₘ a)
+ ( modal-logic-implication-negate
+ ( is-logic (□ₘ a →ₘ □ₘ ¬¬ₘ a)
+ ( modal-logic-implication-box'
+ ( modal-logic-implication-dn a))))
+```
diff --git a/src/modal-logic/formulas.lagda.md b/src/modal-logic/formulas.lagda.md
new file mode 100644
index 0000000000..73012bcf6b
--- /dev/null
+++ b/src/modal-logic/formulas.lagda.md
@@ -0,0 +1,200 @@
+# Modal logic formulas
+
+```agda
+module modal-logic.formulas where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-functions
+open import foundation.cartesian-product-types
+open import foundation.contractible-types
+open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.equality-cartesian-product-types
+open import foundation.equivalences
+open import foundation.identity-types
+open import foundation.propositions
+open import foundation.raising-universe-levels
+open import foundation.sets
+open import foundation.transport-along-identifications
+open import foundation.unit-type
+open import foundation.universe-levels
+```
+
+
+
+## Idea
+
+The formula of modal logic is defined inductively as follows:
+
+- A variable is a formula.
+- ⊥ is a formula.
+- If `a` and `b` are formulas, then `a → b` is a formula.
+- If `a` is a formula, then □`a` is a formula.
+
+## Definition
+
+### Inductive definition of formulas
+
+```agda
+module _
+ {l : Level}
+ where
+
+ infixr 8 _→ₘ_
+ infixr 25 □ₘ_
+
+ data modal-formula (i : Set l) : UU l where
+ varₘ : type-Set i → modal-formula i
+ ⊥ₘ : modal-formula i
+ _→ₘ_ : modal-formula i → modal-formula i → modal-formula i
+ □ₘ_ : modal-formula i → modal-formula i
+```
+
+### Additional notations
+
+```agda
+module _
+ {l : Level} {i : Set l}
+ where
+
+ infixr 25 ¬ₘ_
+ infixr 25 ¬¬ₘ_
+ infixl 10 _∨ₘ_
+ infixl 15 _∧ₘ_
+ infixr 25 ◇ₘ_
+
+ ¬ₘ_ : modal-formula i → modal-formula i
+ ¬ₘ a = a →ₘ ⊥ₘ
+
+ ¬¬ₘ_ : modal-formula i → modal-formula i
+ ¬¬ₘ a = ¬ₘ ¬ₘ a
+
+ _∨ₘ_ : modal-formula i → modal-formula i → modal-formula i
+ a ∨ₘ b = ¬ₘ a →ₘ b
+
+ _∧ₘ_ : modal-formula i → modal-formula i → modal-formula i
+ a ∧ₘ b = ¬ₘ (a →ₘ ¬ₘ b)
+
+ ⊤ₘ : modal-formula i
+ ⊤ₘ = ¬ₘ ⊥ₘ
+
+ ◇ₘ_ : modal-formula i → modal-formula i
+ ◇ₘ a = ¬ₘ □ₘ ¬ₘ a
+```
+
+### If formulas are equal, then their subformulas are equal
+
+```agda
+ eq-implication-left : {a b c d : modal-formula i} → a →ₘ b = c →ₘ d → a = c
+ eq-implication-left refl = refl
+
+ eq-implication-right : {a b c d : modal-formula i} → a →ₘ b = c →ₘ d → b = d
+ eq-implication-right refl = refl
+
+ eq-box : {a b : modal-formula i} → □ₘ a = □ₘ b → a = b
+ eq-box refl = refl
+
+ eq-diamond : {a b : modal-formula i} → ◇ₘ a = ◇ₘ b → a = b
+ eq-diamond refl = refl
+```
+
+## Properties
+
+### Characterizing the identity type of formulas
+
+```agda
+module _
+ {l : Level} {i : Set l}
+ where
+
+ Eq-formula : modal-formula i → modal-formula i → UU l
+ Eq-formula (varₘ n) (varₘ m) = n = m
+ Eq-formula (varₘ _) ⊥ₘ = raise-empty l
+ Eq-formula (varₘ _) (_ →ₘ _) = raise-empty l
+ Eq-formula (varₘ -) (□ₘ _) = raise-empty l
+ Eq-formula ⊥ₘ (varₘ _) = raise-empty l
+ Eq-formula ⊥ₘ ⊥ₘ = raise-unit l
+ Eq-formula ⊥ₘ (_ →ₘ _) = raise-empty l
+ Eq-formula ⊥ₘ (□ₘ _) = raise-empty l
+ Eq-formula (_ →ₘ _) (varₘ _) = raise-empty l
+ Eq-formula (_ →ₘ _) ⊥ₘ = raise-empty l
+ Eq-formula (a →ₘ b) (c →ₘ d) = (Eq-formula a c) × (Eq-formula b d)
+ Eq-formula (_ →ₘ _) (□ₘ _) = raise-empty l
+ Eq-formula (□ₘ _) (varₘ _) = raise-empty l
+ Eq-formula (□ₘ _) ⊥ₘ = raise-empty l
+ Eq-formula (□ₘ _) (_ →ₘ _) = raise-empty l
+ Eq-formula (□ₘ a) (□ₘ c) = Eq-formula a c
+
+ refl-Eq-formula : (a : modal-formula i) → Eq-formula a a
+ refl-Eq-formula (varₘ n) = refl
+ refl-Eq-formula ⊥ₘ = raise-star
+ refl-Eq-formula (a →ₘ b) = (refl-Eq-formula a) , (refl-Eq-formula b)
+ refl-Eq-formula (□ₘ a) = refl-Eq-formula a
+
+ Eq-eq-modal-formula : {a b : modal-formula i} → a = b → Eq-formula a b
+ Eq-eq-modal-formula {a} refl = refl-Eq-formula a
+
+ eq-Eq-modal-formula : {a b : modal-formula i} → Eq-formula a b → a = b
+ eq-Eq-modal-formula {varₘ _} {varₘ _} refl = refl
+ eq-Eq-modal-formula {varₘ _} {⊥ₘ} (map-raise ())
+ eq-Eq-modal-formula {varₘ _} {_ →ₘ _} (map-raise ())
+ eq-Eq-modal-formula {varₘ _} {□ₘ _} (map-raise ())
+ eq-Eq-modal-formula {⊥ₘ} {varₘ _} (map-raise ())
+ eq-Eq-modal-formula {⊥ₘ} {⊥ₘ} _ = refl
+ eq-Eq-modal-formula {⊥ₘ} {_ →ₘ _} (map-raise ())
+ eq-Eq-modal-formula {⊥ₘ} {□ₘ _} (map-raise ())
+ eq-Eq-modal-formula {_ →ₘ _} {varₘ _} (map-raise ())
+ eq-Eq-modal-formula {_ →ₘ _} {⊥ₘ} (map-raise ())
+ eq-Eq-modal-formula {a →ₘ b} {c →ₘ d} (eq1 , eq2) =
+ ap (λ (x , y) → x →ₘ y)
+ ( eq-pair (eq-Eq-modal-formula eq1) (eq-Eq-modal-formula eq2))
+ eq-Eq-modal-formula {_ →ₘ _} {□ₘ _} (map-raise ())
+ eq-Eq-modal-formula {□ₘ _} {varₘ _} (map-raise ())
+ eq-Eq-modal-formula {□ₘ _} {⊥ₘ} (map-raise ())
+ eq-Eq-modal-formula {□ₘ _} {_ →ₘ _} (map-raise ())
+ eq-Eq-modal-formula {□ₘ _} {□ₘ _} eq = ap □ₘ_ (eq-Eq-modal-formula eq)
+
+ is-prop-Eq-modal-formula : (a b : modal-formula i) → is-prop (Eq-formula a b)
+ is-prop-Eq-modal-formula (varₘ n) (varₘ m) = is-prop-type-Prop (Id-Prop i n m)
+ is-prop-Eq-modal-formula (varₘ _) ⊥ₘ = is-prop-raise-empty
+ is-prop-Eq-modal-formula (varₘ _) (_ →ₘ _) = is-prop-raise-empty
+ is-prop-Eq-modal-formula (varₘ -) (□ₘ _) = is-prop-raise-empty
+ is-prop-Eq-modal-formula ⊥ₘ (varₘ _) = is-prop-raise-empty
+ is-prop-Eq-modal-formula ⊥ₘ ⊥ₘ = is-prop-raise-unit
+ is-prop-Eq-modal-formula ⊥ₘ (_ →ₘ _) = is-prop-raise-empty
+ is-prop-Eq-modal-formula ⊥ₘ (□ₘ _) = is-prop-raise-empty
+ is-prop-Eq-modal-formula (_ →ₘ _) (varₘ _) = is-prop-raise-empty
+ is-prop-Eq-modal-formula (_ →ₘ _) ⊥ₘ = is-prop-raise-empty
+ is-prop-Eq-modal-formula (a →ₘ b) (c →ₘ d) =
+ is-prop-product
+ ( is-prop-Eq-modal-formula a c)
+ ( is-prop-Eq-modal-formula b d)
+ is-prop-Eq-modal-formula (_ →ₘ _) (□ₘ _) = is-prop-raise-empty
+ is-prop-Eq-modal-formula (□ₘ _) (varₘ _) = is-prop-raise-empty
+ is-prop-Eq-modal-formula (□ₘ _) ⊥ₘ = is-prop-raise-empty
+ is-prop-Eq-modal-formula (□ₘ _) (_ →ₘ _) = is-prop-raise-empty
+ is-prop-Eq-modal-formula (□ₘ a) (□ₘ c) = is-prop-Eq-modal-formula a c
+```
+
+### A formula is a set
+
+```agda
+ is-set-modal-formula : is-set (modal-formula i)
+ is-set-modal-formula =
+ is-set-prop-in-id
+ ( Eq-formula)
+ ( is-prop-Eq-modal-formula)
+ ( refl-Eq-formula)
+ ( λ _ _ → eq-Eq-modal-formula)
+
+modal-formula-Set : {l : Level} (i : Set l) → Set l
+pr1 (modal-formula-Set i) = modal-formula i
+pr2 (modal-formula-Set i) = is-set-modal-formula
+
+Id-modal-formula-Prop :
+ {l : Level} {i : Set l} → modal-formula i → modal-formula i → Prop l
+Id-modal-formula-Prop {i = i} = Id-Prop (modal-formula-Set i)
+```
diff --git a/src/modal-logic/kripke-models-filtrations.lagda.md b/src/modal-logic/kripke-models-filtrations.lagda.md
new file mode 100644
index 0000000000..8dc5679228
--- /dev/null
+++ b/src/modal-logic/kripke-models-filtrations.lagda.md
@@ -0,0 +1,343 @@
+# Kripke models filtrations
+
+```agda
+module modal-logic.kripke-models-filtrations where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-functions
+open import foundation.dependent-pair-types
+open import foundation.equivalence-classes
+open import foundation.existential-quantification
+open import foundation.function-extensionality
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.propositional-extensionality
+open import foundation.propositional-truncations
+open import foundation.sets
+open import foundation.universe-levels
+
+open import foundation-core.cartesian-product-types
+open import foundation-core.equivalence-relations
+open import foundation-core.equivalences
+open import foundation-core.function-types
+open import foundation-core.identity-types
+open import foundation-core.injective-maps
+open import foundation-core.propositions
+open import foundation-core.subtypes
+open import foundation-core.transport-along-identifications
+
+open import modal-logic.axioms
+open import modal-logic.closed-under-subformulas-theories
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+
+open import univalent-combinatorics.finite-types
+open import univalent-combinatorics.function-types
+open import univalent-combinatorics.subfinite-types
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 l3 l4 l5 : Level} {i : Set l3}
+ (theory : modal-theory l5 i)
+ (M : kripke-model l1 l2 i l4)
+ where
+
+ Φ-equivalence :
+ equivalence-relation (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5) (type-kripke-model i M)
+ pr1 Φ-equivalence x y =
+ Π-Prop
+ ( modal-formula i)
+ ( λ a →
+ ( function-Prop
+ ( is-in-subtype theory a)
+ ( (M , x) ⊨ₘ a ⇔ (M , y) ⊨ₘ a)))
+ pr1 (pr2 Φ-equivalence) x a in-theory = id , id
+ pr1 (pr2 (pr2 Φ-equivalence)) x y r a in-theory =
+ inv-iff (r a in-theory)
+ pr2 (pr2 (pr2 Φ-equivalence)) x y z r-xy r-yz a in-theory =
+ r-xy a in-theory ∘iff r-yz a in-theory
+
+ map-function-equivalence-class-Set :
+ Set (lsuc l1 ⊔ lsuc l2 ⊔ l3 ⊔ lsuc l4 ⊔ l5)
+ map-function-equivalence-class-Set =
+ function-Set (type-subtype theory) (Prop-Set (l1 ⊔ l2 ⊔ l4))
+
+ map-function-worlds :
+ type-kripke-model i M → type-Set map-function-equivalence-class-Set
+ map-function-worlds x (a , _) = (M , x) ⊨ₘ a
+
+ map-function-worlds-correct :
+ (x y : type-kripke-model i M) →
+ sim-equivalence-relation Φ-equivalence x y →
+ map-function-worlds x = map-function-worlds y
+ map-function-worlds-correct x y s =
+ eq-htpy
+ ( λ (a , a-in-theory) →
+ ( eq-iff' ((M , x) ⊨ₘ a) ((M , y) ⊨ₘ a) (s a a-in-theory)))
+
+ map-function-equivalence-class :
+ equivalence-class Φ-equivalence →
+ type-subtype theory → Prop (l1 ⊔ l2 ⊔ l4)
+ map-function-equivalence-class =
+ rec-equivalence-class Φ-equivalence
+ ( map-function-equivalence-class-Set)
+ ( map-function-worlds)
+ ( map-function-worlds-correct)
+
+ is-injective-map-function-equivalence-class :
+ is-injective map-function-equivalence-class
+ is-injective-map-function-equivalence-class {x-class} {y-class} p =
+ apply-twice-universal-property-trunc-Prop
+ ( is-inhabited-subtype-equivalence-class Φ-equivalence x-class)
+ ( is-inhabited-subtype-equivalence-class Φ-equivalence y-class)
+ ( pair
+ ( x-class = y-class)
+ ( is-set-equivalence-class Φ-equivalence x-class y-class))
+ ( λ (x , x-in-class) (y , y-in-class) →
+ ( eq-share-common-element-equivalence-class Φ-equivalence
+ ( x-class)
+ ( y-class)
+ ( intro-exists x
+ ( pair
+ ( x-in-class)
+ ( transitive-is-in-equivalence-class Φ-equivalence
+ ( y-class)
+ ( y)
+ ( x)
+ ( y-in-class)
+ ( λ a a-in-theory →
+ ( iff-eq
+ ( inv
+ ( ap (λ f → f (a , a-in-theory))
+ ( equational-reasoning
+ map-function-worlds x
+ = map-function-equivalence-class x-class
+ by
+ inv
+ ( compute-rec-equivalence-class'
+ ( Φ-equivalence)
+ ( map-function-equivalence-class-Set)
+ ( map-function-worlds)
+ ( map-function-worlds-correct)
+ ( x-class)
+ ( x)
+ ( x-in-class))
+ = map-function-equivalence-class y-class
+ by p
+ = map-function-worlds y
+ by
+ compute-rec-equivalence-class'
+ ( Φ-equivalence)
+ ( map-function-equivalence-class-Set)
+ ( map-function-worlds)
+ ( map-function-worlds-correct)
+ ( y-class)
+ ( y)
+ ( y-in-class)))))))))))
+
+ injection-map-function-equivalence-class :
+ injection
+ ( equivalence-class Φ-equivalence)
+ ( type-subtype theory → Prop (l1 ⊔ l2 ⊔ l4))
+ pr1 injection-map-function-equivalence-class =
+ map-function-equivalence-class
+ pr2 injection-map-function-equivalence-class =
+ is-injective-map-function-equivalence-class
+
+ module _
+ {l6 l7 l8 : Level} (M* : kripke-model l6 l7 i l8)
+ where
+
+ is-filtration-valuate-Prop :
+ equivalence-class Φ-equivalence ≃ type-kripke-model i M* →
+ Prop (l1 ⊔ l3 ⊔ l4 ⊔ l5 ⊔ l8)
+ is-filtration-valuate-Prop e =
+ Π-Prop (type-Set i)
+ ( λ n →
+ ( theory (varₘ n) ⇒
+ ( Π-Prop (type-kripke-model i M)
+ ( λ x → iff-Prop
+ ( valuate-kripke-model i M n x)
+ ( valuate-kripke-model i M* n
+ ( map-equiv e (class Φ-equivalence x)))))))
+
+ is-filtration-valuate :
+ equivalence-class Φ-equivalence ≃ type-kripke-model i M* →
+ UU (l1 ⊔ l3 ⊔ l4 ⊔ l5 ⊔ l8)
+ is-filtration-valuate = type-Prop ∘ is-filtration-valuate-Prop
+
+ filtration-relation-lower-bound-Prop :
+ equivalence-class Φ-equivalence ≃ type-kripke-model i M* →
+ Prop (l1 ⊔ l2 ⊔ l7)
+ filtration-relation-lower-bound-Prop e =
+ Π-Prop (type-kripke-model i M)
+ ( λ x →
+ ( Π-Prop (type-kripke-model i M)
+ ( λ y →
+ ( function-Prop (relation-kripke-model i M x y)
+ ( relation-Prop-kripke-model i M*
+ ( map-equiv e (class Φ-equivalence x))
+ ( map-equiv e (class Φ-equivalence y)))))))
+
+ filtration-relation-lower-bound :
+ equivalence-class Φ-equivalence ≃ type-kripke-model i M* →
+ UU (l1 ⊔ l2 ⊔ l7)
+ filtration-relation-lower-bound =
+ type-Prop ∘ filtration-relation-lower-bound-Prop
+
+ filtration-relation-upper-bound-Prop :
+ equivalence-class Φ-equivalence ≃ type-kripke-model i M* →
+ Prop (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5 ⊔ l7)
+ filtration-relation-upper-bound-Prop e =
+ Π-Prop (modal-formula i)
+ ( λ a →
+ ( function-Prop (is-in-subtype theory (□ₘ a))
+ ( Π-Prop (type-kripke-model i M)
+ ( λ x →
+ ( Π-Prop (type-kripke-model i M)
+ ( λ y →
+ ( function-Prop
+ ( relation-kripke-model i M*
+ ( map-equiv e (class Φ-equivalence x))
+ ( map-equiv e (class Φ-equivalence y)))
+ ( (M , x) ⊨ₘ □ₘ a ⇒ (M , y) ⊨ₘ a))))))))
+
+ filtration-relation-upper-bound :
+ equivalence-class Φ-equivalence ≃ type-kripke-model i M* →
+ UU (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5 ⊔ l7)
+ filtration-relation-upper-bound =
+ type-Prop ∘ filtration-relation-upper-bound-Prop
+
+ is-kripke-model-filtration :
+ UU (lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5) ⊔ l6 ⊔ l7 ⊔ l8)
+ is-kripke-model-filtration =
+ Σ ( equivalence-class Φ-equivalence ≃ type-kripke-model i M*)
+ ( λ e →
+ ( product
+ ( is-filtration-valuate e)
+ ( product
+ ( filtration-relation-lower-bound e)
+ ( filtration-relation-upper-bound e))))
+
+ equiv-is-kripke-model-filtration :
+ is-kripke-model-filtration →
+ equivalence-class Φ-equivalence ≃ type-kripke-model i M*
+ equiv-is-kripke-model-filtration = pr1
+
+ map-equiv-is-kripke-model-filtration :
+ is-kripke-model-filtration →
+ equivalence-class Φ-equivalence → type-kripke-model i M*
+ map-equiv-is-kripke-model-filtration =
+ map-equiv ∘ equiv-is-kripke-model-filtration
+
+ map-inv-equiv-is-kripke-model-filtration :
+ is-kripke-model-filtration →
+ type-kripke-model i M* → equivalence-class Φ-equivalence
+ map-inv-equiv-is-kripke-model-filtration =
+ map-inv-equiv ∘ equiv-is-kripke-model-filtration
+
+ is-filtration-valuate-is-kripke-model-filtration :
+ (e : is-kripke-model-filtration) →
+ is-filtration-valuate (equiv-is-kripke-model-filtration e)
+ is-filtration-valuate-is-kripke-model-filtration = pr1 ∘ pr2
+
+ filtration-relation-lower-bound-is-kripke-model-filtration :
+ (e : is-kripke-model-filtration) →
+ filtration-relation-lower-bound (equiv-is-kripke-model-filtration e)
+ filtration-relation-lower-bound-is-kripke-model-filtration =
+ pr1 ∘ pr2 ∘ pr2
+
+ filtration-relation-upper-bound-is-kripke-model-filtration :
+ (e : is-kripke-model-filtration) →
+ filtration-relation-upper-bound (equiv-is-kripke-model-filtration e)
+ filtration-relation-upper-bound-is-kripke-model-filtration =
+ pr2 ∘ pr2 ∘ pr2
+
+ class-x-eq-x*' :
+ (e : equivalence-class Φ-equivalence ≃ type-kripke-model i M*) →
+ (x : type-kripke-model i M)
+ (x* : type-kripke-model i M*) →
+ is-in-equivalence-class Φ-equivalence (map-inv-equiv e x*) x →
+ map-equiv e (class Φ-equivalence x) = x*
+ class-x-eq-x*' e x x* x-in-x* =
+ concat
+ ( ap
+ ( map-equiv e)
+ ( eq-class-equivalence-class Φ-equivalence
+ ( map-inv-equiv e x*)
+ ( x-in-x*)))
+ ( x*)
+ ( is-section-map-section-map-equiv e x*)
+
+ class-x-eq-x* :
+ (is-filt : is-kripke-model-filtration)
+ (x : type-kripke-model i M)
+ (x* : type-kripke-model i M*) →
+ is-in-equivalence-class Φ-equivalence
+ ( map-inv-equiv-is-kripke-model-filtration is-filt x*) x →
+ map-equiv-is-kripke-model-filtration is-filt (class Φ-equivalence x) = x*
+ class-x-eq-x* = class-x-eq-x*' ∘ equiv-is-kripke-model-filtration
+
+ filtration-relation-preserves-reflexivity :
+ (e : equivalence-class Φ-equivalence ≃ type-kripke-model i M*) →
+ type-Prop (filtration-relation-lower-bound-Prop e) →
+ is-in-subtype (reflexive-kripke-models l1 l2 i l4) M →
+ is-in-subtype (reflexive-kripke-models l6 l7 i l8) M*
+ filtration-relation-preserves-reflexivity e bound is-refl x* =
+ apply-universal-property-trunc-Prop
+ ( is-inhabited-subtype-equivalence-class Φ-equivalence
+ ( map-inv-equiv e x*))
+ ( relation-Prop-kripke-model i M* x* x*)
+ ( λ (x , x-in-x*) →
+ ( tr
+ ( λ y → relation-kripke-model i M* y y)
+ ( class-x-eq-x*' e x x* x-in-x*)
+ ( bound x x (is-refl x))))
+
+ filtration-preserves-reflexivity :
+ is-kripke-model-filtration →
+ is-in-subtype (reflexive-kripke-models l1 l2 i l4) M →
+ is-in-subtype (reflexive-kripke-models l6 l7 i l8) M*
+ filtration-preserves-reflexivity is-filt is-refl class =
+ apply-universal-property-trunc-Prop
+ ( is-inhabited-subtype-equivalence-class Φ-equivalence
+ ( map-inv-equiv-is-kripke-model-filtration is-filt class))
+ ( relation-Prop-kripke-model i M* class class)
+ ( λ (x , in-class) →
+ ( tr
+ ( λ y → relation-kripke-model i M* y y)
+ ( class-x-eq-x* is-filt x class in-class)
+ ( filtration-relation-lower-bound-is-kripke-model-filtration
+ ( is-filt)
+ ( x)
+ ( x)
+ ( is-refl x))))
+
+module _
+ {l1 l2 l3 l4 l5 : Level} (i : Set l3)
+ (M : kripke-model l1 l2 i l4)
+ (lem : LEM (lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5)))
+ (theory : modal-theory l5 i)
+ (is-fin : is-finite (type-subtype theory))
+ where
+
+ is-finite-equivalence-classes-filtration :
+ is-finite (equivalence-class (Φ-equivalence theory M))
+ is-finite-equivalence-classes-filtration =
+ is-finite-injection lem
+ ( injection-map-function-equivalence-class theory M)
+ ( is-finite-function-type is-fin (is-finite-Prop-LEM (lower-LEM _ lem)))
+```
diff --git a/src/modal-logic/kripke-semantics.lagda.md b/src/modal-logic/kripke-semantics.lagda.md
new file mode 100644
index 0000000000..c5e15b3d91
--- /dev/null
+++ b/src/modal-logic/kripke-semantics.lagda.md
@@ -0,0 +1,344 @@
+# Krikpe semantics
+
+```agda
+module modal-logic.kripke-semantics where
+```
+
+Imports
+
+```agda
+open import foundation.binary-relations
+open import foundation.cartesian-product-types
+open import foundation.coproduct-types
+open import foundation.decidable-propositions
+open import foundation.decidable-relations
+open import foundation.decidable-types
+open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.existential-quantification
+open import foundation.function-extensionality
+open import foundation.function-types
+open import foundation.inhabited-types
+open import foundation.intersections-subtypes
+open import foundation.iterated-dependent-product-types
+open import foundation.law-of-excluded-middle
+open import foundation.negation
+open import foundation.propositional-extensionality
+open import foundation.propositions
+open import foundation.raising-universe-levels
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.equivalence-relations
+open import foundation-core.identity-types
+
+open import modal-logic.deduction
+open import modal-logic.formulas
+
+open import univalent-combinatorics.decidable-dependent-function-types
+open import univalent-combinatorics.finite-types
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+### Semantics
+
+```agda
+module _
+ (l1 l2 : Level) {l3 : Level} (i : Set l3) (l4 : Level)
+ where
+
+ kripke-model : UU (lsuc l1 ⊔ lsuc l2 ⊔ l3 ⊔ lsuc l4)
+ kripke-model =
+ Σ ( Inhabited-Type l1)
+ ( λ w →
+ ( product
+ ( Relation-Prop l2 (type-Inhabited-Type w))
+ ( type-Set i → type-Inhabited-Type w → Prop l4)))
+
+module _
+ {l1 l2 l3 l4 : Level} (i : Set l3)
+ where
+
+ Inhabited-Type-kripke-model : kripke-model l1 l2 i l4 → Inhabited-Type l1
+ Inhabited-Type-kripke-model = pr1
+
+ type-kripke-model : kripke-model l1 l2 i l4 → UU l1
+ type-kripke-model = type-Inhabited-Type ∘ Inhabited-Type-kripke-model
+
+ is-inhabited-type-kripke-model :
+ (M : kripke-model l1 l2 i l4) → is-inhabited (type-kripke-model M)
+ is-inhabited-type-kripke-model =
+ is-inhabited-type-Inhabited-Type ∘ Inhabited-Type-kripke-model
+
+ relation-Prop-kripke-model :
+ (M : kripke-model l1 l2 i l4) → Relation-Prop l2 (type-kripke-model M)
+ relation-Prop-kripke-model = pr1 ∘ pr2
+
+ relation-kripke-model :
+ (M : kripke-model l1 l2 i l4) → Relation l2 (type-kripke-model M)
+ relation-kripke-model = type-Relation-Prop ∘ relation-Prop-kripke-model
+
+ valuate-kripke-model :
+ (M : kripke-model l1 l2 i l4) → type-Set i → type-kripke-model M → Prop l4
+ valuate-kripke-model = pr2 ∘ pr2
+
+module _
+ (l1 l2 : Level) {l3 : Level} (i : Set l3) (l4 : Level)
+ where
+
+ model-class : (l5 : Level) → UU (lsuc l1 ⊔ lsuc l2 ⊔ l3 ⊔ lsuc l4 ⊔ lsuc l5)
+ model-class l5 = subtype l5 (kripke-model l1 l2 i l4)
+
+ all-models : model-class lzero
+ all-models _ = unit-Prop
+
+module _
+ {l1 l2 l3 l4 : Level} (i : Set l3)
+ where
+
+ all-models-is-largest-class :
+ {l5 : Level} (C : model-class l1 l2 i l4 l5) → C ⊆ all-models l1 l2 i l4
+ all-models-is-largest-class _ _ _ = star
+
+-- TODO: move to binary relations
+module _
+ {l1 l2 : Level} {A : UU l1} (R : Relation l2 A)
+ where
+
+ is-serial : UU (l1 ⊔ l2)
+ -- is-serial = (x : A) → ∃ A (λ y → R x y)
+ is-serial = (x : A) → exists-structure A (λ y → R x y)
+
+ is-euclidean : UU (l1 ⊔ l2)
+ is-euclidean = (x y z : A) → R x y → R x z → R y z
+
+module _
+ {l1 l2 : Level} {A : UU l1} (R : Relation-Prop l2 A)
+ where
+
+ is-serial-Relation-Prop : UU (l1 ⊔ l2)
+ is-serial-Relation-Prop = is-serial (type-Relation-Prop R)
+
+ is-prop-is-serial-Relation-Prop : is-prop is-serial-Relation-Prop
+ is-prop-is-serial-Relation-Prop =
+ is-prop-Π (λ x → is-prop-exists-structure A _)
+
+ is-euclidean-Relation-Prop : UU (l1 ⊔ l2)
+ is-euclidean-Relation-Prop = is-euclidean (type-Relation-Prop R)
+
+ is-prop-is-euclidean-Relation-Prop : is-prop is-euclidean-Relation-Prop
+ is-prop-is-euclidean-Relation-Prop =
+ is-prop-iterated-Π 3
+ ( λ x y z →
+ ( is-prop-function-type
+ ( is-prop-function-type (is-prop-type-Relation-Prop R y z))))
+
+module _
+ (l1 l2 : Level) {l3 : Level} (i : Set l3) (l4 : Level)
+ where
+
+ relation-property-class :
+ {l5 : Level} →
+ ({A : UU l1} → subtype l5 (Relation-Prop l2 A)) →
+ model-class l1 l2 i l4 l5
+ relation-property-class property M =
+ property (relation-Prop-kripke-model i M)
+
+ reflexive-kripke-models : model-class l1 l2 i l4 (l1 ⊔ l2)
+ reflexive-kripke-models =
+ relation-property-class
+ ( λ x →
+ ( is-reflexive-Relation-Prop x , is-prop-is-reflexive-Relation-Prop x))
+
+ symmetry-kripke-models : model-class l1 l2 i l4 (l1 ⊔ l2)
+ symmetry-kripke-models =
+ relation-property-class
+ ( λ x →
+ ( is-symmetric-Relation-Prop x , is-prop-is-symmetric-Relation-Prop x))
+
+ transitive-kripke-models : model-class l1 l2 i l4 (l1 ⊔ l2)
+ transitive-kripke-models =
+ relation-property-class
+ ( λ x →
+ ( pair
+ ( is-transitive-Relation-Prop x)
+ ( is-prop-is-transitive-Relation-Prop x)))
+
+ serial-kripke-models : model-class l1 l2 i l4 (l1 ⊔ l2)
+ serial-kripke-models =
+ relation-property-class
+ ( λ x →
+ ( is-serial-Relation-Prop x , is-prop-is-serial-Relation-Prop x))
+
+ euclidean-kripke-models : model-class l1 l2 i l4 (l1 ⊔ l2)
+ euclidean-kripke-models =
+ relation-property-class
+ ( λ x →
+ ( is-euclidean-Relation-Prop x , is-prop-is-euclidean-Relation-Prop x))
+
+ equivalence-kripke-models : model-class l1 l2 i l4 (l1 ⊔ l2)
+ equivalence-kripke-models =
+ relation-property-class is-equivalence-relation-Prop
+
+module _
+ {l1 l2 l3 l4 : Level} {i : Set l3}
+ where
+
+ infix 7 _⊨ₘ_
+ infix 7 _⊨Mₘ_
+ infix 7 _⊨Cₘ_
+
+ _⊨ₘ_ :
+ Σ (kripke-model l1 l2 i l4) (type-kripke-model i) →
+ modal-formula i →
+ Prop (l1 ⊔ l2 ⊔ l4)
+ (M , x) ⊨ₘ varₘ n = raise-Prop (l1 ⊔ l2) (valuate-kripke-model i M n x)
+ (M , x) ⊨ₘ ⊥ₘ = raise-empty-Prop (l1 ⊔ l2 ⊔ l4)
+ (M , x) ⊨ₘ a →ₘ b = (M , x) ⊨ₘ a ⇒ (M , x) ⊨ₘ b
+ (M , x) ⊨ₘ □ₘ a =
+ Π-Prop
+ ( type-kripke-model i M)
+ ( λ y → function-Prop (relation-kripke-model i M x y) ((M , y) ⊨ₘ a))
+
+ _⊨Mₘ_ : kripke-model l1 l2 i l4 → modal-formula i → Prop (l1 ⊔ l2 ⊔ l4)
+ M ⊨Mₘ a = Π-Prop (type-kripke-model i M) (λ x → (M , x) ⊨ₘ a)
+
+ _⊨Cₘ_ :
+ {l5 : Level} →
+ model-class l1 l2 i l4 l5 →
+ modal-formula i →
+ Prop (lsuc l1 ⊔ lsuc l2 ⊔ l3 ⊔ lsuc l4 ⊔ l5)
+ C ⊨Cₘ a =
+ Π-Prop
+ ( kripke-model l1 l2 i l4)
+ ( λ M → function-Prop (is-in-subtype C M) (M ⊨Mₘ a))
+
+ class-modal-logic :
+ {l5 : Level} →
+ model-class l1 l2 i l4 l5 →
+ modal-theory (lsuc l1 ⊔ lsuc l2 ⊔ l3 ⊔ lsuc l4 ⊔ l5) i
+ class-modal-logic = _⊨Cₘ_
+
+ -- TODO: rename
+ class-modal-logic-monotic :
+ {l5 l6 : Level}
+ (C₁ : model-class l1 l2 i l4 l5)
+ (C₂ : model-class l1 l2 i l4 l6) →
+ C₁ ⊆ C₂ →
+ class-modal-logic C₂ ⊆ class-modal-logic C₁
+ class-modal-logic-monotic C₁ C₂ sub _ in-modal-logic-C₂ M in-C₁ =
+ in-modal-logic-C₂ M (sub M in-C₁)
+
+module _
+ (l1 l2 : Level)
+ {l3 : Level} (i : Set l3)
+ (l4 : Level)
+ where
+
+ decidable-kripke-models : model-class l1 l2 i l4 (l1 ⊔ l2 ⊔ l3 ⊔ l4)
+ decidable-kripke-models M =
+ Π-Prop
+ ( modal-formula i)
+ ( λ a →
+ ( Π-Prop
+ ( type-kripke-model i M)
+ ( λ x → is-decidable-Prop ((M , x) ⊨ₘ a))))
+
+ finite-kripke-models : model-class l1 l2 i l4 l1
+ finite-kripke-models = is-finite-Prop ∘ type-kripke-model i
+
+ finite-decidable-kripke-models : model-class l1 l2 i l4 (l1 ⊔ l2 ⊔ l3 ⊔ l4)
+ finite-decidable-kripke-models M =
+ product-Prop
+ ( is-finite-Prop (type-kripke-model i M))
+ ( product-Prop
+ ( Π-Prop
+ ( type-kripke-model i M)
+ ( λ x →
+ ( Π-Prop
+ ( type-kripke-model i M)
+ ( λ y → is-decidable-Prop (relation-Prop-kripke-model i M x y)))))
+ ( Π-Prop
+ ( type-kripke-model i M)
+ ( λ x →
+ ( Π-Prop
+ ( type-Set i)
+ ( λ n → is-decidable-Prop (valuate-kripke-model i M n x))))))
+
+module _
+ {l1 l2 l3 l4 : Level} (i : Set l3)
+ where
+
+ finite-decidable-subclass-decidable-models :
+ finite-decidable-kripke-models l1 l2 i l4 ⊆
+ decidable-kripke-models l1 l2 i l4
+ finite-decidable-subclass-decidable-models M (w-is-fin , dec-r , dec-v) =
+ lemma
+ where
+ lemma :
+ (a : modal-formula i) (x : type-kripke-model i M) →
+ is-decidable (type-Prop ((M , x) ⊨ₘ a))
+ lemma (varₘ n) x =
+ is-decidable-raise (l1 ⊔ l2) _ (dec-v x n)
+ lemma ⊥ₘ x =
+ inr map-inv-raise
+ lemma (a →ₘ b) x =
+ is-decidable-function-type (lemma a x) (lemma b x)
+ lemma (□ₘ a) x =
+ is-decidable-Π-is-finite
+ ( w-is-fin)
+ ( λ y → is-decidable-function-type (dec-r x y) (lemma a y))
+
+ is-finite-model-valuate-decidable-kripke-models :
+ (M : kripke-model l1 l2 i l4) →
+ is-in-subtype (finite-decidable-kripke-models l1 l2 i l4) M →
+ (a : modal-formula i) →
+ is-decidable (type-Prop (M ⊨Mₘ a))
+ is-finite-model-valuate-decidable-kripke-models M sub-fin a =
+ is-decidable-Π-is-finite
+ ( pr1 (sub-fin))
+ ( finite-decidable-subclass-decidable-models M sub-fin a)
+
+ decidable-subclass :
+ {l5 : Level} →
+ model-class l1 l2 i l4 l5 →
+ model-class l1 l2 i l4 (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5)
+ decidable-subclass C = (decidable-kripke-models l1 l2 i l4) ∩ C
+
+ finite-subclass :
+ {l5 : Level} →
+ model-class l1 l2 i l4 l5 →
+ model-class l1 l2 i l4 (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5)
+ finite-subclass C = (finite-decidable-kripke-models l1 l2 i l4) ∩ C
+
+module _
+ {l1 l2 l3 l4 : Level} (i : Set l3)
+ (lem : LEM (l1 ⊔ l2 ⊔ l4))
+ where
+
+ all-models-is-decidable :
+ all-models l1 l2 i l4 ⊆ decidable-kripke-models l1 l2 i l4
+ all-models-is-decidable M _ a x = lem ((M , x) ⊨ₘ a)
+
+ subset-decidable-subclass-lem :
+ {l5 : Level} (C : model-class l1 l2 i l4 l5) →
+ C ⊆ decidable-subclass i C
+ subset-decidable-subclass-lem C =
+ subtype-both-intersection (decidable-kripke-models l1 l2 i l4) C C
+ ( transitive-leq-subtype
+ ( C)
+ ( all-models l1 l2 i l4)
+ ( decidable-kripke-models l1 l2 i l4)
+ ( all-models-is-decidable)
+ ( all-models-is-largest-class i C))
+ ( refl-leq-subtype C)
+```
diff --git a/src/modal-logic/l-complete-theories.lagda.md b/src/modal-logic/l-complete-theories.lagda.md
new file mode 100644
index 0000000000..349a083394
--- /dev/null
+++ b/src/modal-logic/l-complete-theories.lagda.md
@@ -0,0 +1,753 @@
+# L-complete theories
+
+```agda
+module modal-logic.l-complete-theories where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-functions
+open import foundation.binary-relations
+open import foundation.dependent-pair-types
+open import foundation.disjunction
+open import foundation.empty-types
+open import foundation.existential-quantification
+open import foundation.inhabited-subtypes
+open import foundation.inhabited-types
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.propositional-resizing
+open import foundation.propositional-truncations
+open import foundation.subtypes
+open import foundation.transport-along-identifications
+open import foundation.unions-subtypes
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+open import foundation-core.equality-dependent-pair-types
+open import foundation-core.function-types
+open import foundation-core.identity-types
+open import foundation-core.negation
+open import foundation-core.propositions
+open import foundation-core.sets
+
+open import lists.lists
+open import lists.lists-subtypes
+
+open import modal-logic.axioms
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.formulas-deduction
+open import modal-logic.l-consistent-theories
+open import modal-logic.modal-logic-k
+open import modal-logic.weak-deduction
+
+open import order-theory.chains-posets
+open import order-theory.maximal-elements-posets
+open import order-theory.posets
+open import order-theory.subposets
+open import order-theory.subtypes-leq-posets
+open import order-theory.upper-bounds-chains-posets
+open import order-theory.zorn
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 : Level} {i : Set l1}
+ (logic : modal-theory l2 i)
+ where
+
+ is-L-complete-theory-Prop :
+ {l3 : Level} → L-consistent-theory logic l3 → Prop (l1 ⊔ l2 ⊔ lsuc l3)
+ is-L-complete-theory-Prop {l3} =
+ is-maximal-element-Poset-Prop (L-consistent-theories-Poset logic l3)
+
+ is-L-complete-theory :
+ {l3 : Level} → L-consistent-theory logic l3 → UU (l1 ⊔ l2 ⊔ lsuc l3)
+ is-L-complete-theory = type-Prop ∘ is-L-complete-theory-Prop
+
+ L-complete-theory : (l3 : Level) → UU (l1 ⊔ l2 ⊔ lsuc l3)
+ L-complete-theory l3 = type-subtype (is-L-complete-theory-Prop {l3})
+
+ L-consistent-theory-L-complete-theory :
+ {l3 : Level} → L-complete-theory l3 → L-consistent-theory logic l3
+ L-consistent-theory-L-complete-theory =
+ inclusion-subtype is-L-complete-theory-Prop
+
+ is-L-complete-theory-L-consistent-theory :
+ {l3 : Level} (theory : L-complete-theory l3) →
+ is-L-complete-theory (L-consistent-theory-L-complete-theory theory)
+ is-L-complete-theory-L-consistent-theory =
+ is-in-subtype-inclusion-subtype is-L-complete-theory-Prop
+
+ modal-theory-L-complete-theory :
+ {l3 : Level} → L-complete-theory l3 → modal-theory l3 i
+ modal-theory-L-complete-theory =
+ modal-theory-L-consistent-theory logic ∘
+ L-consistent-theory-L-complete-theory
+
+ is-L-consistent-theory-modal-theory-L-complete-theory :
+ {l3 : Level} (theory : L-complete-theory l3) →
+ is-L-consistent-theory logic (modal-theory-L-complete-theory theory)
+ is-L-consistent-theory-modal-theory-L-complete-theory =
+ is-L-consistent-theory-modal-theory-L-consistent-theory logic ∘
+ L-consistent-theory-L-complete-theory
+
+ is-consistent-modal-theory-L-complete-theory :
+ {l3 : Level} (theory : L-complete-theory l3) →
+ is-consistent-modal-logic (modal-theory-L-complete-theory theory)
+ is-consistent-modal-theory-L-complete-theory =
+ is-consistent-modal-theory-L-consistent-theory logic ∘
+ L-consistent-theory-L-complete-theory
+
+ module _
+ {l3 : Level}
+ (((theory , is-cons) , is-comp) : L-complete-theory (l1 ⊔ l2 ⊔ l3))
+ (theory' : modal-theory l3 i)
+ where
+
+ eq-is-L-consistent-union-L-complete :
+ is-L-consistent-theory logic (theory' ∪ theory) →
+ theory' ∪ theory = theory
+ eq-is-L-consistent-union-L-complete is-L-cons =
+ ap
+ ( modal-theory-L-consistent-theory logic)
+ ( is-comp
+ ( theory' ∪ theory , is-L-cons)
+ ( subtype-union-right theory' theory))
+
+ union-L-consistent :
+ {l3 : Level} →
+ L-consistent-theory logic l3 →
+ L-consistent-theory logic (l1 ⊔ l2 ⊔ l3)
+ pr1 (union-L-consistent (theory , is-cons)) =
+ weak-modal-logic-closure (logic ∪ theory)
+ pr2 (union-L-consistent (theory , is-cons)) bot-in-logic =
+ is-cons
+ ( transitive-leq-subtype
+ ( weak-modal-logic-closure
+ ( logic ∪ weak-modal-logic-closure (logic ∪ theory)))
+ ( weak-modal-logic-closure (weak-modal-logic-closure (logic ∪ theory)))
+ ( weak-modal-logic-closure (logic ∪ theory))
+ ( is-weak-modal-logic-weak-modal-logic-closure)
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-both
+ ( logic)
+ ( weak-modal-logic-closure (logic ∪ theory))
+ ( weak-modal-logic-closure (logic ∪ theory))
+ ( transitive-leq-subtype
+ ( logic)
+ ( logic ∪ theory)
+ ( weak-modal-logic-closure (logic ∪ theory))
+ ( subset-axioms-weak-modal-logic-closure)
+ ( subtype-union-left logic theory))
+ ( refl-leq-subtype (weak-modal-logic-closure (logic ∪ theory)))))
+ ( ⊥ₘ)
+ ( bot-in-logic))
+
+ module _
+ (l3 : Level)
+ (t@((theory , is-cons) , is-comp) : L-complete-theory (l1 ⊔ l2 ⊔ l3))
+ where
+
+ eq-union-L-consistent :
+ weak-modal-logic-closure (logic ∪ theory) = theory
+ eq-union-L-consistent =
+ ap
+ ( modal-theory-L-consistent-theory logic)
+ ( is-comp
+ ( union-L-consistent (theory , is-cons))
+ ( transitive-leq-subtype
+ ( theory)
+ ( logic ∪ theory)
+ ( weak-modal-logic-closure (logic ∪ theory))
+ ( subset-axioms-weak-modal-logic-closure)
+ ( subtype-union-right logic theory)))
+
+ subset-union-L-consistent :
+ weak-modal-logic-closure (logic ∪ theory) ⊆ theory
+ subset-union-L-consistent =
+ inv-tr
+ ( _⊆ theory)
+ ( eq-union-L-consistent)
+ ( refl-leq-subtype theory)
+
+ subset-union-logic-L-complete-theory :
+ logic ∪ theory ⊆ theory
+ subset-union-logic-L-complete-theory =
+ transitive-leq-subtype
+ ( logic ∪ theory)
+ ( modal-theory-L-consistent-theory logic
+ ( union-L-consistent (theory , is-cons)))
+ ( theory)
+ ( subset-union-L-consistent)
+ ( subset-axioms-weak-modal-logic-closure)
+
+ subset-logic-L-complete-theory : logic ⊆ theory
+ subset-logic-L-complete-theory =
+ transitive-leq-subtype
+ ( logic)
+ ( logic ∪ theory)
+ ( theory)
+ ( subset-union-logic-L-complete-theory)
+ ( subtype-union-left logic theory)
+
+ is-weak-modal-logic-L-complete-theory : is-weak-modal-logic theory
+ is-weak-modal-logic-L-complete-theory =
+ transitive-leq-subtype
+ ( weak-modal-logic-closure theory)
+ ( modal-theory-L-consistent-theory logic
+ ( union-L-consistent (theory , is-cons)))
+ ( theory)
+ ( subset-union-L-consistent)
+ ( weak-modal-logic-closure-monotic (subtype-union-right logic theory))
+
+ module _
+ {l3 : Level}
+ (t@((theory , is-cons) , is-comp) : L-complete-theory (l1 ⊔ l2 ⊔ l3))
+ (theory' : modal-theory l3 i)
+ where
+
+ eq-is-consistent-union-L-complete :
+ is-consistent-modal-logic (weak-modal-logic-closure (theory' ∪ theory)) →
+ theory' ∪ theory = theory
+ eq-is-consistent-union-L-complete is-cons' =
+ eq-is-L-consistent-union-L-complete t theory'
+ ( is-consistent-modal-logic-antimonotic
+ ( weak-modal-logic-closure (logic ∪ (theory' ∪ theory)))
+ ( weak-modal-logic-closure (theory' ∪ theory))
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-both logic (theory' ∪ theory) (theory' ∪ theory)
+ ( transitive-leq-subtype
+ ( logic)
+ ( theory)
+ ( theory' ∪ theory)
+ ( subtype-union-right theory' theory)
+ ( subset-logic-L-complete-theory l3 t))
+ ( refl-leq-subtype (theory' ∪ theory))))
+ ( is-cons'))
+
+ module _
+ (t@((theory , is-cons) , is-comp) : L-complete-theory (l1 ⊔ l2))
+ (contains-ax-k : ax-k i ⊆ logic)
+ (contains-ax-s : ax-s i ⊆ logic)
+ (contains-ax-dn : ax-dn i ⊆ logic)
+ where
+
+ private
+ contains-ax-k' : ax-k i ⊆ theory
+ contains-ax-k' =
+ transitive-leq-subtype (ax-k i) logic theory
+ ( subset-logic-L-complete-theory lzero t)
+ ( contains-ax-k)
+
+ contains-ax-s' : ax-s i ⊆ theory
+ contains-ax-s' =
+ transitive-leq-subtype (ax-s i) logic theory
+ ( subset-logic-L-complete-theory lzero t)
+ ( contains-ax-s)
+
+ contains-ax-dn' : ax-dn i ⊆ theory
+ contains-ax-dn' =
+ transitive-leq-subtype (ax-dn i) logic theory
+ ( subset-logic-L-complete-theory lzero t)
+ ( contains-ax-dn)
+
+ is-L-consistent-add-formula-not-in-logic :
+ {a : modal-formula i} →
+ ¬ (is-in-subtype theory a) →
+ is-L-consistent-theory logic (theory-add-formula (¬ₘ a) theory)
+ is-L-consistent-add-formula-not-in-logic {a} not-in-logic bot-in-logic =
+ not-in-logic
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory lzero t)
+ ( contains-ax-dn' (¬¬ₘ a →ₘ a) (a , refl))
+ ( is-weak-modal-logic-L-complete-theory lzero t (¬¬ₘ a)
+ ( forward-implication
+ ( deduction-theorem
+ ( theory)
+ ( contains-ax-k')
+ ( contains-ax-s')
+ ( ¬ₘ a)
+ ( ⊥ₘ))
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-both logic (theory-add-formula (¬ₘ a) theory)
+ ( theory-add-formula (¬ₘ a) theory)
+ ( transitive-leq-subtype
+ ( logic)
+ ( theory)
+ ( theory-add-formula (¬ₘ a) theory)
+ ( subset-add-formula (¬ₘ a) theory)
+ ( subset-logic-L-complete-theory lzero t))
+ ( refl-leq-subtype (theory-add-formula (¬ₘ a) theory)))
+ ( ⊥ₘ)
+ ( bot-in-logic)))))
+
+ contains-negation-not-contains-formula-L-complete-theory :
+ {a : modal-formula i} →
+ ¬ (is-in-subtype theory a) →
+ is-in-subtype theory (¬ₘ a)
+ contains-negation-not-contains-formula-L-complete-theory {a} not-in-logic =
+ tr
+ ( λ t → is-in-subtype t (¬ₘ a))
+ ( eq-is-L-consistent-union-L-complete t
+ ( Id-modal-formula-Prop (¬ₘ a))
+ ( is-L-consistent-add-formula-not-in-logic not-in-logic))
+ ( formula-in-add-formula (¬ₘ a) theory)
+
+ module _
+ (lem : LEM (l1 ⊔ l2))
+ where
+
+ is-disjuctive-L-complete-theory :
+ is-disjuctive-modal-theory theory
+ is-disjuctive-L-complete-theory a with lem (theory a)
+ ... | inl a-in-logic = inl a-in-logic
+ ... | inr a-not-in-logic =
+ inr
+ ( contains-negation-not-contains-formula-L-complete-theory
+ ( a-not-in-logic))
+
+ -- TODO: move from module
+ lemma-box-diamond-L-complete :
+ is-modal-logic logic →
+ is-normal-modal-logic logic →
+ (((theory' , _) , _) : L-complete-theory (l1 ⊔ l2)) →
+ diamond-modal-theory theory ⊆ theory' →
+ unbox-modal-theory theory' ⊆ theory
+ lemma-box-diamond-L-complete is-logic is-normal x leq a box-a-in-x
+ with is-disjuctive-L-complete-theory a
+ ... | inl a-in-t = a-in-t
+ ... | inr not-a-in-t =
+ ex-falso
+ ( is-consistent-modal-theory-L-complete-theory x
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory lzero x)
+ { a = □ₘ a}
+ ( weak-modal-logic-mp
+ ( is-weak-modal-logic-L-complete-theory lzero x)
+ { a = ◇ₘ ¬ₘ a}
+ ( subset-logic-L-complete-theory lzero x (◇ₘ ¬ₘ a →ₘ ¬ₘ □ₘ a)
+ ( modal-logic-diamond-negate-implication i logic is-normal
+ ( is-logic)))
+ ( leq (◇ₘ ¬ₘ a) (intro-exists (¬ₘ a) (not-a-in-t , refl))))
+ ( box-a-in-x)))
+
+ is-inhabited-L-complete-exists-complete-L-consistent-theory :
+ {l3 : Level} →
+ exists (L-consistent-theory logic l3) is-L-complete-theory-Prop →
+ is-inhabited (L-complete-theory l3)
+ is-inhabited-L-complete-exists-complete-L-consistent-theory {l3} =
+ elim-exists
+ ( is-inhabited-Prop (L-complete-theory l3))
+ ( λ theory is-comp → unit-trunc-Prop (theory , is-comp))
+
+ module _
+ {l3 l4 : Level}
+ (C : chain-Poset l4 (L-consistent-theories-Poset logic l3))
+ where
+
+ private
+ P : Poset (l1 ⊔ l2 ⊔ lsuc l3) (l1 ⊔ l3)
+ P = L-consistent-theories-Poset logic l3
+
+ modal-theory-chain-element :
+ type-chain-Poset P C → modal-theory l3 i
+ modal-theory-chain-element =
+ modal-theory-L-consistent-theory logic ∘
+ type-Poset-type-chain-Poset P C
+
+ L-union : type-chain-Poset P C → modal-theory (l1 ⊔ l2 ⊔ l3) i
+ L-union x =
+ weak-modal-logic-closure (logic ∪ modal-theory-chain-element x)
+
+ theory-subset-L-union :
+ (x : type-chain-Poset P C) → modal-theory-chain-element x ⊆ L-union x
+ theory-subset-L-union x =
+ transitive-leq-subtype
+ ( modal-theory-chain-element x)
+ ( logic ∪ modal-theory-chain-element x)
+ ( L-union x)
+ ( subset-axioms-weak-modal-logic-closure)
+ ( subtype-union-right logic (modal-theory-chain-element x))
+
+ leq-L-union :
+ (x y : type-chain-Poset P C) →
+ modal-theory-chain-element x ⊆ modal-theory-chain-element y →
+ L-union x ⊆ L-union y
+ leq-L-union x y leq =
+ weak-modal-logic-closure-monotic
+ ( subset-union-subset-right logic
+ ( modal-theory-chain-element x)
+ ( modal-theory-chain-element y)
+ ( leq))
+
+ chain-union-modal-theory :
+ modal-theory (l1 ⊔ l2 ⊔ lsuc l3 ⊔ l4) i
+ chain-union-modal-theory a =
+ ∃ (type-chain-Poset P C) (λ x → modal-theory-chain-element x a)
+
+ is-inhabited-chain-is-inhabited-chain-union :
+ is-inhabited-subtype (chain-union-modal-theory) →
+ is-inhabited (type-chain-Poset P C)
+ is-inhabited-chain-is-inhabited-chain-union =
+ map-universal-property-trunc-Prop
+ ( is-inhabited-Prop (type-chain-Poset P C))
+ ( λ (x , x-in-union) →
+ ( apply-universal-property-trunc-Prop
+ ( x-in-union)
+ ( is-inhabited-Prop (type-chain-Poset P C))
+ ( λ (c , _) → unit-trunc-Prop c)))
+
+ exists-chain-element-with-formula-Prop :
+ (a : modal-formula i) → Prop (l1 ⊔ l2 ⊔ lsuc l3 ⊔ l4)
+ exists-chain-element-with-formula-Prop a =
+ ∃ (type-chain-Poset P C)
+ ( λ x →
+ ( weak-modal-logic-closure (logic ∪ modal-theory-chain-element x) a))
+
+ exists-chain-element-with-formula :
+ (a : modal-formula i) → UU (l1 ⊔ l2 ⊔ lsuc l3 ⊔ l4)
+ exists-chain-element-with-formula =
+ type-Prop ∘ exists-chain-element-with-formula-Prop
+
+ module _
+ (contains-ax-k : ax-k i ⊆ logic)
+ (contains-ax-s : ax-s i ⊆ logic)
+ where
+
+ private
+ contains-ax-k' :
+ {l5 : Level} (theory : modal-theory l5 i) → ax-k i ⊆ logic ∪ theory
+ contains-ax-k' theory =
+ transitive-leq-subtype (ax-k i) logic (logic ∪ theory)
+ ( subtype-union-left logic theory)
+ ( contains-ax-k)
+
+ contains-ax-s' :
+ {l5 : Level} (theory : modal-theory l5 i) → ax-s i ⊆ logic ∪ theory
+ contains-ax-s' theory =
+ transitive-leq-subtype (ax-s i) logic (logic ∪ theory)
+ ( subtype-union-left logic theory)
+ ( contains-ax-s)
+
+ L-union-deduction-theorem :
+ (l : list (modal-formula i)) →
+ (h a : modal-formula i) →
+ is-in-subtype
+ ( weak-modal-logic-closure (logic ∪ list-subtype (cons h l))) a →
+ is-in-subtype
+ ( weak-modal-logic-closure (logic ∪ list-subtype l)) (h →ₘ a)
+ L-union-deduction-theorem l h a in-logic =
+ forward-implication
+ ( deduction-theorem
+ ( logic ∪ list-subtype l)
+ ( contains-ax-k' (list-subtype l))
+ ( contains-ax-s' (list-subtype l))
+ ( h)
+ ( a))
+ ( weak-modal-logic-closure-monotic
+ ( transitive-leq-subtype
+ ( logic ∪ list-subtype (cons h l))
+ ( logic ∪ theory-add-formula h (list-subtype l))
+ ( theory-add-formula h (logic ∪ list-subtype l))
+ ( theory-add-formula-union-right h logic (list-subtype l))
+ ( subset-union-subset-right
+ ( logic)
+ ( list-subtype (cons h l))
+ ( theory-add-formula h (list-subtype l))
+ ( backward-subset-head-add h l)))
+ ( a)
+ ( in-logic))
+
+ in-chain-in-chain-union-assumptions :
+ is-inhabited (type-chain-Poset P C) →
+ (l : list (modal-formula i)) →
+ list-subtype l ⊆ chain-union-modal-theory →
+ {a : modal-formula i} →
+ is-in-subtype (weak-modal-logic-closure (logic ∪ list-subtype l)) a →
+ exists-chain-element-with-formula a
+ in-chain-in-chain-union-assumptions is-inh nil leq {a} in-logic =
+ apply-universal-property-trunc-Prop
+ ( is-inh)
+ ( exists-chain-element-with-formula-Prop a)
+ ( λ x →
+ ( intro-exists x
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-both logic (list-subtype nil)
+ ( logic ∪ modal-theory-chain-element x)
+ ( subtype-union-left logic (modal-theory-chain-element x))
+ ( subset-list-subtype-nil
+ ( logic ∪ modal-theory-chain-element x)))
+ ( a)
+ ( in-logic))))
+ in-chain-in-chain-union-assumptions is-inh (cons h l) leq {a} in-logic =
+ apply-twice-universal-property-trunc-Prop
+ ( leq h (head-in-list-subtype))
+ ( in-chain-in-chain-union-assumptions is-inh l
+ ( transitive-leq-subtype
+ ( list-subtype l)
+ ( list-subtype (cons h l))
+ ( chain-union-modal-theory)
+ ( leq)
+ ( subset-tail-list-subtype))
+ ( L-union-deduction-theorem l h a in-logic))
+ ( exists-chain-element-with-formula-Prop a)
+ ( λ (x , h-in-x) (y , ha-in-y) →
+ ( elim-disjunction
+ ( exists-chain-element-with-formula-Prop a)
+ ( λ x-leq-y →
+ ( intro-exists y
+ ( weak-modal-logic-closure-mp
+ ( ha-in-y)
+ ( leq-L-union x y x-leq-y h
+ ( theory-subset-L-union x h h-in-x)))))
+ ( λ y-leq-x →
+ ( intro-exists x
+ ( weak-modal-logic-closure-mp
+ ( leq-L-union y x y-leq-x (h →ₘ a) ha-in-y)
+ ( theory-subset-L-union x h h-in-x))))
+ ( is-chain-Subposet-chain-Poset P C x y)))
+
+ in-chain-in-list :
+ (l : list (modal-formula i)) →
+ list-subtype l ⊆ chain-union-modal-theory →
+ {a : modal-formula i} →
+ ¬ is-in-subtype (weak-modal-logic-closure logic) a →
+ is-in-subtype (weak-modal-logic-closure (logic ∪ list-subtype l)) a →
+ exists-chain-element-with-formula a
+ in-chain-in-list l leq {a} not-in-logic in-union =
+ in-chain-in-chain-union-assumptions
+ ( is-inhabited-chain-is-inhabited-chain-union
+ ( rec-coproduct
+ ( map-is-inhabited (λ (x , in-list) → x , leq x in-list))
+ ( λ not-inh →
+ ( ex-falso
+ ( not-in-logic
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-both
+ ( logic)
+ ( list-subtype l)
+ ( logic)
+ ( refl-leq-subtype logic)
+ ( λ x in-list →
+ ( ex-falso
+ ( not-inh (unit-trunc-Prop (x , in-list))))))
+ ( a)
+ ( in-union)))))
+ ( is-decidable-is-inhabited-list-subtype l)))
+ ( l)
+ ( leq)
+ ( in-union)
+
+ in-chain-in-chain-union :
+ {a : modal-formula i} →
+ ¬ is-in-subtype (weak-modal-logic-closure logic) a →
+ is-in-subtype
+ ( weak-modal-logic-closure (logic ∪ chain-union-modal-theory))
+ ( a) →
+ exists-chain-element-with-formula a
+ in-chain-in-chain-union {a} not-in-logic =
+ map-universal-property-trunc-Prop
+ ( exists-chain-element-with-formula-Prop a)
+ ( λ d →
+ ( apply-universal-property-trunc-Prop
+ ( lists-in-union-lists
+ ( list-assumptions-weak-deduction d)
+ ( logic)
+ ( chain-union-modal-theory)
+ ( subset-theory-list-assumptions-weak-deduction d))
+ ( exists-chain-element-with-formula-Prop a)
+ ( λ ((logic-l , theory-l) , leq-lists , leq-logic , leq-theory) →
+ ( in-chain-in-list theory-l leq-theory not-in-logic
+ ( weak-modal-logic-closure-monotic
+ { ax₁ = list-subtype logic-l ∪ list-subtype theory-l}
+ ( subset-union-subset-left
+ ( list-subtype logic-l)
+ ( logic)
+ ( list-subtype theory-l)
+ ( leq-logic))
+ ( a)
+ ( weak-modal-logic-closure-monotic leq-lists a
+ ( is-in-weak-modal-logic-closure-weak-deduction
+ (is-assumptions-list-assumptions-weak-deduction
+ ( d)))))))))
+
+ is-L-consistent-theory-chain-union-modal-theory :
+ is-consistent-modal-logic (weak-modal-logic-closure logic) →
+ is-L-consistent-theory logic chain-union-modal-theory
+ is-L-consistent-theory-chain-union-modal-theory is-cons in-logic =
+ apply-universal-property-trunc-Prop
+ ( in-chain-in-chain-union is-cons in-logic)
+ ( empty-Prop)
+ ( λ (x , in-logic') →
+ ( is-L-consistent-theory-modal-theory-L-consistent-theory
+ ( logic)
+ ( type-Poset-type-chain-Poset P C x)
+ ( in-logic')))
+
+ module _
+ {l3 l4 : Level}
+ (prop-resize : propositional-resizing l3 (l1 ⊔ l2 ⊔ lsuc l3 ⊔ l4))
+ where
+
+ private
+ P : Poset (l1 ⊔ l2 ⊔ lsuc l3) (l1 ⊔ l3)
+ P = L-consistent-theories-Poset logic l3
+
+ resized-chain-union-modal-theory : chain-Poset l4 P → modal-theory l3 i
+ resized-chain-union-modal-theory C =
+ resize prop-resize ∘ chain-union-modal-theory C
+
+ equiv-resized-chain-union-modal-theory :
+ (C : chain-Poset l4 P) →
+ equiv-subtypes
+ (resized-chain-union-modal-theory C)
+ (chain-union-modal-theory C)
+ equiv-resized-chain-union-modal-theory C a =
+ is-equiv-resize prop-resize (chain-union-modal-theory C a)
+
+ module _
+ (contains-ax-k : ax-k i ⊆ logic)
+ (contains-ax-s : ax-s i ⊆ logic)
+ where
+
+ is-L-consistent-resized-chain-union-modal-theory :
+ (C : chain-Poset l4 P) →
+ is-consistent-modal-logic (weak-modal-logic-closure logic) →
+ is-L-consistent-theory logic (resized-chain-union-modal-theory C)
+ is-L-consistent-resized-chain-union-modal-theory C is-cons =
+ is-L-consistent-antimonotic logic
+ ( resized-chain-union-modal-theory C)
+ ( chain-union-modal-theory C)
+ ( subset-equiv-subtypes
+ ( resized-chain-union-modal-theory C)
+ ( chain-union-modal-theory C)
+ ( equiv-resized-chain-union-modal-theory C))
+ ( is-L-consistent-theory-chain-union-modal-theory C
+ ( contains-ax-k)
+ ( contains-ax-s)
+ ( is-cons))
+
+ resized-chain-union-L-consistent-theory :
+ (C : chain-Poset l4 P) →
+ is-consistent-modal-logic (weak-modal-logic-closure logic) →
+ L-consistent-theory logic l3
+ pr1 (resized-chain-union-L-consistent-theory C is-cons) =
+ resized-chain-union-modal-theory C
+ pr2 (resized-chain-union-L-consistent-theory C is-cons) =
+ is-L-consistent-resized-chain-union-modal-theory C is-cons
+
+ union-is-chain-upper-bound :
+ (C : chain-Poset l4 P) →
+ (is-cons : is-consistent-modal-logic (weak-modal-logic-closure logic)) →
+ is-chain-upper-bound P C
+ ( resized-chain-union-L-consistent-theory C is-cons)
+ union-is-chain-upper-bound C _ x =
+ transitive-leq-subtype
+ ( modal-theory-L-consistent-theory logic
+ ( type-Poset-type-chain-Poset
+ ( L-consistent-theories-Poset logic l3)
+ ( C)
+ ( x)))
+ ( chain-union-modal-theory C)
+ ( resized-chain-union-modal-theory C)
+ ( inv-subset-equiv-subtypes
+ ( resized-chain-union-modal-theory C)
+ ( chain-union-modal-theory C)
+ ( equiv-resized-chain-union-modal-theory C))
+ ( λ a in-theory → intro-exists x in-theory)
+
+ extend-L-consistent-theory :
+ Zorn (l1 ⊔ l2 ⊔ lsuc l3) (l1 ⊔ l3) l4 →
+ is-inhabited (L-consistent-theory logic l3) →
+ is-inhabited (L-complete-theory l3)
+ extend-L-consistent-theory zorn is-inh =
+ map-universal-property-trunc-Prop
+ ( is-inhabited-Prop (L-complete-theory l3))
+ ( λ theory →
+ ( zorn
+ ( L-consistent-theories-Poset logic l3)
+ ( λ C →
+ ( intro-exists
+ ( resized-chain-union-L-consistent-theory C
+ ( is-consistent-closure-logic-L-consistent-theory logic
+ ( theory)))
+ ( union-is-chain-upper-bound C
+ ( is-consistent-closure-logic-L-consistent-theory logic
+ ( theory)))))))
+ ( is-inh)
+
+ module _
+ {l3 : Level}
+ (prop-resize : propositional-resizing (l1 ⊔ l2) (lsuc l1 ⊔ lsuc l2 ⊔ l3))
+ (zorn : Zorn (lsuc l1 ⊔ lsuc l2) (l1 ⊔ l2) l3)
+ (is-logic : is-weak-modal-logic logic)
+ (is-cons : is-consistent-modal-logic logic)
+ (contains-ax-k : ax-k i ⊆ logic)
+ (contains-ax-s : ax-s i ⊆ logic)
+ where
+
+ is-inhabited-L-complete-theory :
+ is-inhabited (L-complete-theory (l1 ⊔ l2))
+ is-inhabited-L-complete-theory =
+ extend-L-consistent-theory prop-resize contains-ax-k contains-ax-s zorn
+ ( map-is-inhabited
+ ( λ (t , t-is-cons) →
+ ( pair
+ ( raise-subtype l1 t)
+ ( is-L-consistent-antimonotic logic (raise-subtype l1 t) t
+ ( inv-subset-equiv-subtypes t (raise-subtype l1 t)
+ ( compute-raise-subtype l1 t))
+ ( t-is-cons))))
+ ( is-inhabited-L-consistent-theory logic is-logic is-cons))
+
+module _
+ {l1 : Level} {i : Set l1}
+ {l2 l3 : Level}
+ (logic₁ : modal-theory l2 i)
+ (logic₂ : modal-theory l3 i)
+ (theory : modal-theory (l1 ⊔ l2 ⊔ l3) i)
+ (is-cons₁ : is-L-consistent-theory logic₁ theory)
+ (is-cons₂ : is-L-consistent-theory logic₂ theory)
+ where
+
+ universal-L-complete-theory :
+ is-L-complete-theory logic₁ (theory , is-cons₁) →
+ is-L-complete-theory logic₂ (theory , is-cons₂)
+ universal-L-complete-theory is-comp (theory' , is-cons') leq =
+ eq-pair-Σ
+ ( equational-proof)
+ ( eq-is-prop
+ ( is-prop-type-Prop (is-L-consistent-theory-Prop logic₂ theory)))
+ where
+ complete-theory : L-complete-theory logic₁ (l1 ⊔ l2 ⊔ l3)
+ complete-theory = (theory , is-cons₁) , is-comp
+
+ equational-proof : theory' = theory
+ equational-proof =
+ equational-reasoning
+ theory'
+ = theory' ∪ theory
+ by inv (eq-union-subset-right theory' theory leq)
+ = theory
+ by eq-is-consistent-union-L-complete logic₁ complete-theory theory'
+ ( is-consistent-modal-logic-antimonotic
+ ( weak-modal-logic-closure (theory' ∪ theory))
+ ( weak-modal-logic-closure theory')
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-both theory' theory theory'
+ ( refl-leq-subtype theory')
+ ( leq)))
+ ( is-consistent-closure-L-consistent-theory logic₂
+ ( theory' , is-cons')))
+```
diff --git a/src/modal-logic/l-consistent-theories.lagda.md b/src/modal-logic/l-consistent-theories.lagda.md
new file mode 100644
index 0000000000..da8b6be749
--- /dev/null
+++ b/src/modal-logic/l-consistent-theories.lagda.md
@@ -0,0 +1,190 @@
+# L-consistent theories
+
+```agda
+module modal-logic.l-consistent-theories where
+```
+
+Imports
+
+```agda
+open import foundation.action-on-identifications-functions
+open import foundation.binary-relations
+open import foundation.dependent-pair-types
+open import foundation.disjunction
+open import foundation.inhabited-types
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.propositional-truncations
+open import foundation.transport-along-identifications
+open import foundation.unions-subtypes
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+open import foundation-core.function-types
+open import foundation-core.identity-types
+open import foundation-core.negation
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+
+open import modal-logic.axioms
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.weak-deduction
+
+open import order-theory.maximal-elements-posets
+open import order-theory.posets
+open import order-theory.subposets
+open import order-theory.subtypes-leq-posets
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 : Level} {i : Set l1}
+ (logic : modal-theory l2 i)
+ where
+
+ is-L-consistent-theory-Prop :
+ {l3 : Level} → modal-theory l3 i → Prop (l1 ⊔ l2 ⊔ l3)
+ is-L-consistent-theory-Prop theory =
+ is-consistent-modal-logic-Prop (weak-modal-logic-closure (logic ∪ theory))
+
+ is-L-consistent-theory :
+ {l3 : Level} → modal-theory l3 i → UU (l1 ⊔ l2 ⊔ l3)
+ is-L-consistent-theory = type-Prop ∘ is-L-consistent-theory-Prop
+
+ L-consistent-theory : (l3 : Level) → UU (l1 ⊔ l2 ⊔ lsuc l3)
+ L-consistent-theory l3 = type-subtype (is-L-consistent-theory-Prop {l3})
+
+ modal-theory-L-consistent-theory :
+ {l3 : Level} → L-consistent-theory l3 → modal-theory l3 i
+ modal-theory-L-consistent-theory =
+ inclusion-subtype is-L-consistent-theory-Prop
+
+ is-L-consistent-theory-modal-theory-L-consistent-theory :
+ {l3 : Level} (theory : L-consistent-theory l3) →
+ is-L-consistent-theory (modal-theory-L-consistent-theory theory)
+ is-L-consistent-theory-modal-theory-L-consistent-theory =
+ is-in-subtype-inclusion-subtype is-L-consistent-theory-Prop
+
+ is-consistent-closure-L-consistent-theory :
+ {l3 : Level} (theory : L-consistent-theory l3) →
+ is-consistent-modal-logic
+ ( weak-modal-logic-closure (modal-theory-L-consistent-theory theory))
+ is-consistent-closure-L-consistent-theory theory =
+ is-consistent-modal-logic-antimonotic
+ ( weak-modal-logic-closure (modal-theory-L-consistent-theory theory))
+ ( weak-modal-logic-closure
+ (logic ∪ modal-theory-L-consistent-theory theory))
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-right logic (modal-theory-L-consistent-theory theory)))
+ ( is-L-consistent-theory-modal-theory-L-consistent-theory theory)
+
+ is-consistent-modal-theory-L-consistent-theory :
+ {l3 : Level} (theory : L-consistent-theory l3) →
+ is-consistent-modal-logic (modal-theory-L-consistent-theory theory)
+ is-consistent-modal-theory-L-consistent-theory theory =
+ is-consistent-modal-logic-antimonotic
+ ( modal-theory-L-consistent-theory theory)
+ ( weak-modal-logic-closure (modal-theory-L-consistent-theory theory))
+ ( subset-axioms-weak-modal-logic-closure)
+ ( is-consistent-closure-L-consistent-theory theory)
+
+ is-consistent-closure-logic-L-consistent-theory :
+ {l3 : Level} (theory : L-consistent-theory l3) →
+ is-consistent-modal-logic (weak-modal-logic-closure logic)
+ is-consistent-closure-logic-L-consistent-theory theory =
+ is-consistent-modal-logic-antimonotic
+ ( weak-modal-logic-closure logic)
+ ( weak-modal-logic-closure
+ ( logic ∪ modal-theory-L-consistent-theory theory))
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-left logic (modal-theory-L-consistent-theory theory)))
+ ( is-L-consistent-theory-modal-theory-L-consistent-theory theory)
+
+ is-L-consistent-antimonotic :
+ {l3 l4 : Level}
+ (theory₁ : modal-theory l3 i) →
+ (theory₂ : modal-theory l4 i) →
+ theory₁ ⊆ theory₂ →
+ is-L-consistent-theory theory₂ →
+ is-L-consistent-theory theory₁
+ is-L-consistent-antimonotic theory₁ theory₂ leq =
+ is-consistent-modal-logic-antimonotic
+ ( weak-modal-logic-closure (logic ∪ theory₁))
+ ( weak-modal-logic-closure (logic ∪ theory₂))
+ ( weak-modal-logic-closure-monotic
+ ( subset-union-subset-right logic theory₁ theory₂ leq))
+
+ L-consistent-theory-leq-Prop :
+ {l3 : Level} → Relation-Prop (l1 ⊔ l3) (L-consistent-theory l3)
+ L-consistent-theory-leq-Prop x y =
+ leq-prop-subtype
+ ( modal-theory-L-consistent-theory x)
+ ( modal-theory-L-consistent-theory y)
+
+ L-consistent-theory-leq :
+ {l3 : Level} → Relation (l1 ⊔ l3) (L-consistent-theory l3)
+ L-consistent-theory-leq = type-Relation-Prop L-consistent-theory-leq-Prop
+
+ theories-Poset : (l3 : Level) → Poset (l1 ⊔ lsuc l3) (l1 ⊔ l3)
+ theories-Poset l3 = subtypes-leq-Poset l3 (modal-formula i)
+
+ L-consistent-theories-Poset :
+ (l3 : Level) → Poset (l1 ⊔ l2 ⊔ lsuc l3) (l1 ⊔ l3)
+ L-consistent-theories-Poset l3 =
+ poset-Subposet (theories-Poset l3) (is-L-consistent-theory-Prop)
+
+ module _
+ (is-logic : is-weak-modal-logic logic)
+ (is-cons : is-consistent-modal-logic logic)
+ where
+
+ is-L-consistent-theory-logic :
+ is-L-consistent-theory logic
+ is-L-consistent-theory-logic =
+ is-consistent-modal-logic-antimonotic
+ ( weak-modal-logic-closure (logic ∪ logic))
+ ( logic)
+ ( transitive-leq-subtype
+ ( weak-modal-logic-closure (logic ∪ logic))
+ ( weak-modal-logic-closure logic)
+ ( logic)
+ ( is-logic)
+ ( weak-modal-logic-closure-monotic
+ ( subtype-union-both logic logic logic
+ ( refl-leq-subtype logic)
+ ( refl-leq-subtype logic))))
+ (is-cons)
+
+ is-inhabited-L-consistent-theory : is-inhabited (L-consistent-theory l2)
+ is-inhabited-L-consistent-theory =
+ unit-trunc-Prop (logic , is-L-consistent-theory-logic)
+
+module _
+ {l1 : Level} {i : Set l1}
+ where
+
+ is-L-consistent-antimonotic-logic :
+ {l2 l3 l4 : Level}
+ (logic₁ : modal-theory l2 i) →
+ (logic₂ : modal-theory l3 i) →
+ (theory : modal-theory l4 i) →
+ logic₁ ⊆ logic₂ →
+ is-L-consistent-theory logic₂ theory →
+ is-L-consistent-theory logic₁ theory
+ is-L-consistent-antimonotic-logic logic₁ logic₂ theory leq =
+ is-consistent-modal-logic-antimonotic
+ ( weak-modal-logic-closure (logic₁ ∪ theory))
+ ( weak-modal-logic-closure (logic₂ ∪ theory))
+ ( weak-modal-logic-closure-monotic
+ ( subset-union-subset-left logic₁ logic₂ theory leq))
+```
diff --git a/src/modal-logic/lindenbaum.lagda.md b/src/modal-logic/lindenbaum.lagda.md
new file mode 100644
index 0000000000..5bfa7b4a9a
--- /dev/null
+++ b/src/modal-logic/lindenbaum.lagda.md
@@ -0,0 +1,140 @@
+# Lindenbaum's lemma
+
+```agda
+module modal-logic.lindenbaum where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.existential-quantification
+open import foundation.propositional-resizing
+open import foundation.propositional-truncations
+open import foundation.unions-subtypes
+open import foundation.universe-levels
+
+open import foundation-core.function-types
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+
+open import modal-logic.axioms
+open import modal-logic.deduction
+open import modal-logic.l-complete-theories
+open import modal-logic.l-consistent-theories
+open import modal-logic.weak-deduction
+
+open import order-theory.zorn
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 l3 : Level} {i : Set l1}
+ (logic : modal-theory l2 i)
+ (contains-ax-k : ax-k i ⊆ logic)
+ (contains-ax-s : ax-s i ⊆ logic)
+ (zorn : Zorn (lsuc (l1 ⊔ l2 ⊔ l3)) (l1 ⊔ l2 ⊔ l3) l3)
+ (prop-resize : propositional-resizing (l1 ⊔ l2 ⊔ l3) (lsuc (l1 ⊔ l2 ⊔ l3)))
+ (x@(theory , is-cons) : L-consistent-theory logic (l1 ⊔ l2 ⊔ l3))
+ where
+
+ lindenbaum :
+ exists (L-complete-theory logic (l1 ⊔ l2 ⊔ l3))
+ ( λ y →
+ ( leq-prop-subtype
+ ( modal-theory-L-consistent-theory logic x)
+ ( modal-theory-L-complete-theory logic y)))
+ lindenbaum =
+ apply-universal-property-trunc-Prop
+ ( extend-L-consistent-theory L prop-resize contains-ax-k' contains-ax-s'
+ ( zorn)
+ ( is-inhabited-L-consistent-theory L
+ ( is-weak-modal-logic-weak-modal-logic-closure)
+ ( is-cons)))
+ ( ∃ (L-complete-theory logic (l1 ⊔ l2 ⊔ l3))
+ ( λ y →
+ ( leq-prop-subtype
+ ( modal-theory-L-consistent-theory logic x)
+ ( modal-theory-L-complete-theory logic y))))
+ ( λ y →
+ ( intro-exists
+ ( result-L-complete y)
+ ( subset-theory-transofrm-L-complete y)))
+ where
+ L : modal-theory (l1 ⊔ l2 ⊔ l3) i
+ L = weak-modal-logic-closure (logic ∪ theory)
+
+ subset-logic-L : logic ⊆ L
+ subset-logic-L =
+ transitive-leq-subtype
+ ( logic)
+ ( logic ∪ theory)
+ ( weak-modal-logic-closure (logic ∪ theory))
+ ( subset-axioms-weak-modal-logic-closure)
+ ( subtype-union-left logic theory)
+
+ contains-ax-k' : ax-k i ⊆ L
+ contains-ax-k' =
+ transitive-leq-subtype (ax-k i) logic L subset-logic-L contains-ax-k
+
+ contains-ax-s' : ax-s i ⊆ L
+ contains-ax-s' =
+ transitive-leq-subtype (ax-s i) logic L subset-logic-L contains-ax-s
+
+ is-L-consistent-result :
+ (y : L-complete-theory L (l1 ⊔ l2 ⊔ l3)) →
+ is-L-consistent-theory logic (modal-theory-L-complete-theory L y)
+ is-L-consistent-result y =
+ is-L-consistent-antimonotic-logic
+ ( logic)
+ ( weak-modal-logic-closure (logic ∪ theory))
+ ( modal-theory-L-complete-theory L y)
+ ( subset-logic-L)
+ ( is-L-consistent-theory-modal-theory-L-complete-theory L y)
+
+ result-L-consistent :
+ L-complete-theory L (l1 ⊔ l2 ⊔ l3) →
+ L-consistent-theory logic (l1 ⊔ l2 ⊔ l3)
+ pr1 (result-L-consistent y) = modal-theory-L-complete-theory L y
+ pr2 (result-L-consistent y) = is-L-consistent-result y
+
+ is-L-complete-result :
+ (y : L-complete-theory L (l1 ⊔ l2 ⊔ l3)) →
+ is-L-complete-theory logic (result-L-consistent y)
+ is-L-complete-result y =
+ universal-L-complete-theory L logic
+ ( modal-theory-L-complete-theory L y)
+ ( is-L-consistent-theory-modal-theory-L-complete-theory L y)
+ ( is-L-consistent-result y)
+ ( is-L-complete-theory-L-consistent-theory L y)
+
+ result-L-complete :
+ L-complete-theory L (l1 ⊔ l2 ⊔ l3) →
+ L-complete-theory logic (l1 ⊔ l2 ⊔ l3)
+ pr1 (pr1 (result-L-complete y)) = modal-theory-L-complete-theory L y
+ pr2 (pr1 (result-L-complete y)) = is-L-consistent-result y
+ pr2 (result-L-complete y) = is-L-complete-result y
+
+ subset-theory-transofrm-L-complete :
+ (y : L-complete-theory L (l1 ⊔ l2 ⊔ l3)) →
+ theory ⊆ modal-theory-L-complete-theory logic (result-L-complete y)
+ subset-theory-transofrm-L-complete y =
+ ( transitive-leq-subtype theory L
+ ( modal-theory-L-complete-theory L y)
+ ( subset-logic-L-complete-theory L l3 y)
+ ( transitive-leq-subtype
+ ( theory)
+ ( logic ∪ theory)
+ ( L)
+ ( subset-axioms-weak-modal-logic-closure)
+ ( subtype-union-right logic theory)))
+```
diff --git a/src/modal-logic/minimal-kripke-filtration.lagda.md b/src/modal-logic/minimal-kripke-filtration.lagda.md
new file mode 100644
index 0000000000..d8ee284138
--- /dev/null
+++ b/src/modal-logic/minimal-kripke-filtration.lagda.md
@@ -0,0 +1,163 @@
+# Minimal Kripke filtration
+
+```agda
+module modal-logic.minimal-kripke-filtration where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.equivalence-classes
+open import foundation.existential-quantification
+open import foundation.inhabited-types
+open import foundation.logical-equivalences
+open import foundation.raising-universe-levels
+open import foundation.universe-levels
+
+open import foundation-core.cartesian-product-types
+open import foundation-core.equivalences
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+
+open import modal-logic.closed-under-subformulas-theories
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-models-filtrations
+open import modal-logic.kripke-semantics
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 l3 l4 l5 : Level} {i : Set l3}
+ (theory : modal-theory l5 i)
+ (M : kripke-model l1 l2 i l4)
+ where
+
+ minimal-kripke-model-filtration :
+ kripke-model
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5)
+ ( i)
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5)
+ pr1 (pr1 minimal-kripke-model-filtration) =
+ equivalence-class (Φ-equivalence theory M)
+ pr2 (pr1 minimal-kripke-model-filtration) =
+ map-is-inhabited
+ ( class (Φ-equivalence theory M))
+ ( is-inhabited-type-kripke-model i M)
+ pr1 (pr2 minimal-kripke-model-filtration) x* y* =
+ exists-structure-Prop ( type-kripke-model i M × type-kripke-model i M)
+ ( λ (x , y) →
+ relation-kripke-model i M x y ×
+ is-in-equivalence-class (Φ-equivalence theory M) x* x ×
+ is-in-equivalence-class (Φ-equivalence theory M) y* y)
+ pr2 (pr2 minimal-kripke-model-filtration) n x* =
+ function-Prop
+ ( is-in-subtype theory (varₘ n))
+ ( Π-Prop (type-kripke-model i M)
+ ( λ x →
+ function-Prop
+ ( is-in-equivalence-class (Φ-equivalence theory M) x* x)
+ ( valuate-kripke-model i M n x)))
+```
+
+## Properties
+
+### Minimal kripke filtration is a filtration function
+
+```agda
+ module _
+ (theory-is-closed : is-modal-theory-closed-under-subformulas theory)
+ where
+
+ is-kripke-model-filtration-minimal-kripke-model-filtration :
+ is-kripke-model-filtration theory M minimal-kripke-model-filtration
+ pr1 is-kripke-model-filtration-minimal-kripke-model-filtration =
+ id-equiv
+ pr1 (pr2 is-kripke-model-filtration-minimal-kripke-model-filtration)
+ n in-theory x =
+ pair
+ ( λ val-n in-theory y eq-xy →
+ map-inv-raise
+ ( forward-implication
+ ( eq-xy (varₘ n) in-theory)
+ ( map-raise val-n)))
+ ( λ val-n → val-n in-theory x (λ _ _ → id-iff))
+ pr1 (pr2 (pr2 is-kripke-model-filtration-minimal-kripke-model-filtration))
+ x y r =
+ intro-exists (x , y) (r , (λ _ _ → id-iff) , (λ _ _ → id-iff))
+ pr2 (pr2 (pr2 is-kripke-model-filtration-minimal-kripke-model-filtration))
+ a box-in-theory x y r-xy x-forces-box =
+ elim-exists
+ ( (M , y) ⊨ₘ a)
+ ( λ (x' , y') (r-xy' , iff-x , iff-y) →
+ backward-implication
+ ( iff-y a
+ ( is-has-subboxes-is-closed-under-subformulas
+ ( theory)
+ ( theory-is-closed)
+ ( box-in-theory)))
+ ( forward-implication
+ ( iff-x (□ₘ a) box-in-theory)
+ ( x-forces-box)
+ ( y')
+ ( r-xy')))
+ ( r-xy)
+```
+
+### Minimal kripke filtration preserves reflexivity
+
+```agda
+ minimal-filtration-preserves-reflexivity :
+ is-in-subtype (reflexive-kripke-models l1 l2 i l4) M →
+ is-in-subtype
+ ( reflexive-kripke-models
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5)
+ ( i)
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( minimal-kripke-model-filtration)
+ minimal-filtration-preserves-reflexivity =
+ filtration-preserves-reflexivity theory M
+ ( minimal-kripke-model-filtration)
+ ( is-kripke-model-filtration-minimal-kripke-model-filtration)
+```
+
+### Minimal kripke filtration preserves symmetry
+
+```agda
+ minimal-filtration-preserves-symmetry :
+ is-in-subtype (symmetry-kripke-models l1 l2 i l4) M →
+ is-in-subtype
+ ( symmetry-kripke-models
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5)
+ ( i)
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( minimal-kripke-model-filtration)
+ minimal-filtration-preserves-symmetry is-sym x* y* =
+ elim-exists
+ ( relation-Prop-kripke-model i minimal-kripke-model-filtration y* x*)
+ ( λ (x , y) (r-xy , x-in-x* , y-in-y*) →
+ intro-exists (y , x) (is-sym x y r-xy , y-in-y* , x-in-x*))
+
+-- module _
+-- {l1 l2 l3 l4 l5 : Level} {i : Set l3}
+-- where
+
+-- test :
+-- is-class-filtration-function i l2 l3 l4 l5 (all-models _ _ i _)
+-- ( minimal-kripke-model-filtration)
+-- test theory is-closed (M , _) =
+-- is-kripke-model-filtration-minimal-kripke-model-filtration theory M is-closed
+```
diff --git a/src/modal-logic/minimal-transitive-kripke-filtration.lagda.md b/src/modal-logic/minimal-transitive-kripke-filtration.lagda.md
new file mode 100644
index 0000000000..3ef2311931
--- /dev/null
+++ b/src/modal-logic/minimal-transitive-kripke-filtration.lagda.md
@@ -0,0 +1,233 @@
+# Minimal transitive Kripke filtration
+
+```agda
+module modal-logic.minimal-transitive-kripke-filtration where
+```
+
+Imports
+
+```agda
+open import foundation.binary-relations-transitive-closures
+open import foundation.dependent-pair-types
+open import foundation.equivalence-classes
+open import foundation.logical-equivalences
+open import foundation.propositional-truncations
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.identity-types
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+
+open import modal-logic.axioms
+open import modal-logic.closed-under-subformulas-theories
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-models-filtrations
+open import modal-logic.kripke-semantics
+open import modal-logic.minimal-kripke-filtration
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 l3 l4 l5 : Level} {i : Set l3}
+ (theory : modal-theory l5 i)
+ (M : kripke-model l1 l2 i l4)
+ where
+
+ minimal-transitive-kripke-model-filtration :
+ kripke-model
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( i)
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5)
+ pr1 minimal-transitive-kripke-model-filtration =
+ Inhabited-Type-kripke-model i (minimal-kripke-model-filtration theory M)
+ pr1 (pr2 minimal-transitive-kripke-model-filtration) =
+ transitive-closure-Prop
+ ( relation-Prop-kripke-model i (minimal-kripke-model-filtration theory M))
+ pr2 (pr2 minimal-transitive-kripke-model-filtration) =
+ valuate-kripke-model i (minimal-kripke-model-filtration theory M)
+```
+
+## Properties
+
+### Minimal transitive kripke filtration is transitive
+
+```agda
+ minimal-transitive-filtration-is-transitive :
+ is-in-subtype
+ ( transitive-kripke-models
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( i)
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( minimal-transitive-kripke-model-filtration)
+ minimal-transitive-filtration-is-transitive =
+ is-transitive-transitive-closure-Prop
+ ( relation-Prop-kripke-model i
+ ( minimal-kripke-model-filtration theory M))
+```
+
+### Minimal transitive filtration is a filtration function
+
+```agda
+ module _
+ (theory-is-closed : is-modal-theory-closed-under-subformulas theory)
+ where
+
+ is-filtration-minimal-transitive-kripke-model-filtration :
+ is-in-subtype (transitive-kripke-models l1 l2 i l4) M →
+ is-kripke-model-filtration theory M
+ ( minimal-transitive-kripke-model-filtration)
+ pr1 (is-filtration-minimal-transitive-kripke-model-filtration M-is-trans) =
+ equiv-is-kripke-model-filtration theory M
+ ( minimal-kripke-model-filtration theory M)
+ ( is-kripke-model-filtration-minimal-kripke-model-filtration theory M
+ ( theory-is-closed))
+ pr1 (pr2
+ (is-filtration-minimal-transitive-kripke-model-filtration M-is-trans)) =
+ is-filtration-valuate-is-kripke-model-filtration theory M
+ ( minimal-kripke-model-filtration theory M)
+ ( is-kripke-model-filtration-minimal-kripke-model-filtration theory M
+ ( theory-is-closed))
+ pr1 (pr2 (pr2
+ (is-filtration-minimal-transitive-kripke-model-filtration M-is-trans)))
+ x y r =
+ -- TODO: Refactor
+ unit-trunc-Prop
+ ( transitive-closure-base
+ ( filtration-relation-lower-bound-is-kripke-model-filtration
+ ( theory)
+ ( M)
+ ( minimal-kripke-model-filtration theory M)
+ ( is-kripke-model-filtration-minimal-kripke-model-filtration
+ ( theory)
+ ( M)
+ ( theory-is-closed))
+ ( x)
+ ( y)
+ ( r)))
+ pr2 (pr2 (pr2
+ (is-filtration-minimal-transitive-kripke-model-filtration M-is-trans)))
+ a box-in-theory x y r-xy x-forces-box =
+ apply-universal-property-trunc-Prop
+ ( r-xy)
+ ( (M , y) ⊨ₘ a)
+ ( λ r → α x r x-forces-box)
+ where
+ α :
+ (x : type-kripke-model i M) →
+ transitive-closure
+ ( relation-kripke-model i (minimal-kripke-model-filtration theory M))
+ ( class (Φ-equivalence theory M) x)
+ ( class (Φ-equivalence theory M) y) →
+ type-Prop ((M , x) ⊨ₘ □ₘ a) →
+ type-Prop ((M , y) ⊨ₘ a)
+ α x (transitive-closure-base r) x-forces-box =
+ filtration-relation-upper-bound-is-kripke-model-filtration theory M
+ ( minimal-kripke-model-filtration theory M)
+ ( is-kripke-model-filtration-minimal-kripke-model-filtration theory M
+ ( theory-is-closed))
+ ( a)
+ ( box-in-theory)
+ ( x)
+ ( y)
+ ( r)
+ ( x-forces-box)
+ α x (transitive-closure-step {y = z*} r-xz c-zy) x-forces-box =
+ apply-universal-property-trunc-Prop
+ ( is-inhabited-subtype-equivalence-class (Φ-equivalence theory M) z*)
+ ( (M , y) ⊨ₘ a)
+ ( λ (z , z-in-z*) →
+ β z
+ (eq-class-equivalence-class (Φ-equivalence theory M) z* z-in-z*))
+ where
+ β :
+ (z : type-kripke-model i M) →
+ class (Φ-equivalence theory M) z = z* →
+ type-Prop ((M , y) ⊨ₘ a)
+ β z refl =
+ apply-universal-property-trunc-Prop
+ ( r-xz)
+ ( (M , y) ⊨ₘ a)
+ ( λ ((x' , z') , r-xz' , iff-x , iff-z) →
+ α z c-zy
+ ( backward-implication
+ ( iff-z (□ₘ a) box-in-theory)
+ ( ax-4-soundness i _ _ _ (a , refl) M M-is-trans
+ ( x')
+ ( forward-implication
+ ( iff-x (□ₘ a) box-in-theory)
+ ( x-forces-box))
+ ( z')
+ ( r-xz'))))
+```
+
+### Minimal transitive kripke filtration preserves symmetry
+
+```agda
+ minimal-transitive-filtration-preserves-reflexivity :
+ is-in-subtype (reflexive-kripke-models l1 l2 i l4) M →
+ is-in-subtype
+ ( reflexive-kripke-models
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( i)
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( minimal-transitive-kripke-model-filtration)
+ minimal-transitive-filtration-preserves-reflexivity is-refl =
+ transitive-closure-Prop-preserves-reflexivity
+ ( relation-Prop-kripke-model i
+ ( minimal-kripke-model-filtration theory M))
+ ( minimal-filtration-preserves-reflexivity theory M theory-is-closed
+ ( is-refl))
+```
+
+### Minimal transitive kripke filtration preserves symmetry
+
+```agda
+ minimal-transitive-filtration-preserves-symmetry :
+ is-in-subtype (symmetry-kripke-models l1 l2 i l4) M →
+ is-in-subtype
+ ( symmetry-kripke-models
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( i)
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( minimal-transitive-kripke-model-filtration)
+ minimal-transitive-filtration-preserves-symmetry is-sym =
+ transitive-closure-Prop-preserves-symmetry
+ ( relation-Prop-kripke-model i
+ ( minimal-kripke-model-filtration theory M))
+ ( minimal-filtration-preserves-symmetry theory M theory-is-closed
+ ( is-sym))
+```
+
+### Minimal transitive kripke filtration preserves equivalence
+
+```agda
+ minimal-transitive-filtration-preserves-equivalence :
+ is-in-subtype (equivalence-kripke-models l1 l2 i l4) M →
+ is-in-subtype
+ ( equivalence-kripke-models
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( lsuc (l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( i)
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4 ⊔ l5))
+ ( minimal-transitive-kripke-model-filtration)
+ minimal-transitive-filtration-preserves-equivalence (is-refl , is-sym , _) =
+ triple
+ ( minimal-transitive-filtration-preserves-reflexivity is-refl)
+ ( minimal-transitive-filtration-preserves-symmetry is-sym)
+ ( minimal-transitive-filtration-is-transitive)
+```
diff --git a/src/modal-logic/modal-logic-k.lagda.md b/src/modal-logic/modal-logic-k.lagda.md
new file mode 100644
index 0000000000..fcaf873cdb
--- /dev/null
+++ b/src/modal-logic/modal-logic-k.lagda.md
@@ -0,0 +1,206 @@
+# Modal logic K
+
+```agda
+module modal-logic.modal-logic-k where
+```
+
+Imports
+
+```agda
+open import foundation.decidable-types
+open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.inhabited-types
+open import foundation.intersections-subtypes
+open import foundation.negation
+open import foundation.propositional-truncations
+open import foundation.raising-universe-levels
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.unions-subtypes
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+
+open import modal-logic.axioms
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+open import modal-logic.soundness
+
+open import univalent-combinatorics.finite-types
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l : Level} (i : Set l)
+ where
+
+ -- TODO: refactor
+ modal-logic-K-axioms : modal-theory l i
+ modal-logic-K-axioms = ((ax-k i ∪ ax-s i) ∪ ax-n i) ∪ ax-dn i
+
+ modal-logic-K : modal-theory l i
+ modal-logic-K = modal-logic-closure modal-logic-K-axioms
+
+ is-modal-logic-K : is-modal-logic modal-logic-K
+ is-modal-logic-K = is-modal-logic-modal-logic-closure modal-logic-K-axioms
+
+ K-axioms-contains-ax-k : ax-k i ⊆ modal-logic-K-axioms
+ K-axioms-contains-ax-k =
+ transitive-leq-subtype
+ ( ax-k i)
+ ( ax-k i ∪ ax-s i)
+ ( modal-logic-K-axioms)
+ ( transitive-leq-subtype
+ ( ax-k i ∪ ax-s i)
+ ( (ax-k i ∪ ax-s i) ∪ ax-n i)
+ ( modal-logic-K-axioms)
+ ( subtype-union-left ((ax-k i ∪ ax-s i) ∪ ax-n i) (ax-dn i))
+ ( subtype-union-left (ax-k i ∪ ax-s i) (ax-n i)))
+ ( subtype-union-left (ax-k i) (ax-s i))
+
+ K-axioms-contains-ax-s : ax-s i ⊆ modal-logic-K-axioms
+ K-axioms-contains-ax-s =
+ transitive-leq-subtype
+ ( ax-s i)
+ ( ax-k i ∪ ax-s i)
+ ( modal-logic-K-axioms)
+ ( transitive-leq-subtype
+ ( ax-k i ∪ ax-s i)
+ ( (ax-k i ∪ ax-s i) ∪ ax-n i)
+ ( modal-logic-K-axioms)
+ ( subtype-union-left ((ax-k i ∪ ax-s i) ∪ ax-n i) (ax-dn i))
+ ( subtype-union-left (ax-k i ∪ ax-s i) (ax-n i)))
+ ( subtype-union-right (ax-k i) (ax-s i))
+
+ K-axioms-contains-ax-n : ax-n i ⊆ modal-logic-K-axioms
+ K-axioms-contains-ax-n =
+ transitive-leq-subtype
+ ( ax-n i)
+ ( (ax-k i ∪ ax-s i) ∪ ax-n i)
+ ( modal-logic-K-axioms)
+ ( subtype-union-left ((ax-k i ∪ ax-s i) ∪ ax-n i) (ax-dn i))
+ ( subtype-union-right (ax-k i ∪ ax-s i) (ax-n i))
+
+ K-axioms-contains-ax-dn : ax-dn i ⊆ modal-logic-K-axioms
+ K-axioms-contains-ax-dn =
+ subtype-union-right ((ax-k i ∪ ax-s i) ∪ ax-n i) (ax-dn i)
+
+ K-contains-ax-k : ax-k i ⊆ modal-logic-K
+ K-contains-ax-k =
+ transitive-leq-subtype
+ ( ax-k i)
+ ( modal-logic-K-axioms)
+ ( modal-logic-K)
+ ( axioms-subset-modal-logic modal-logic-K-axioms)
+ ( K-axioms-contains-ax-k)
+
+ K-contains-ax-s : ax-s i ⊆ modal-logic-K
+ K-contains-ax-s =
+ transitive-leq-subtype
+ ( ax-s i)
+ ( modal-logic-K-axioms)
+ ( modal-logic-K)
+ ( axioms-subset-modal-logic modal-logic-K-axioms)
+ ( K-axioms-contains-ax-s)
+
+ K-contains-ax-n : ax-n i ⊆ modal-logic-K
+ K-contains-ax-n =
+ transitive-leq-subtype
+ ( ax-n i)
+ ( modal-logic-K-axioms)
+ ( modal-logic-K)
+ ( axioms-subset-modal-logic modal-logic-K-axioms)
+ ( K-axioms-contains-ax-n)
+
+ K-contains-ax-dn : ax-dn i ⊆ modal-logic-K
+ K-contains-ax-dn =
+ transitive-leq-subtype
+ ( ax-dn i)
+ ( modal-logic-K-axioms)
+ ( modal-logic-K)
+ ( axioms-subset-modal-logic modal-logic-K-axioms)
+ ( K-axioms-contains-ax-dn)
+
+is-normal-modal-logic :
+ {l1 l2 : Level} {i : Set l1} → modal-theory l2 i → UU (l1 ⊔ l2)
+is-normal-modal-logic {i = i} logic = modal-logic-K i ⊆ logic
+
+is-normal-modal-logic-K :
+ {l1 : Level} (i : Set l1) → is-normal-modal-logic (modal-logic-K i)
+is-normal-modal-logic-K i = refl-leq-subtype (modal-logic-K i)
+
+module _
+ {l1 l2 l3 l4 : Level} (i : Set l1)
+ where
+
+ soundness-K-axioms :
+ soundness (modal-logic-K-axioms i) (decidable-kripke-models l2 l3 i l4)
+ soundness-K-axioms =
+ soundness-union-subclass-right-sublevels
+ ( (ax-k i ∪ ax-s i) ∪ ax-n i)
+ ( ax-dn i)
+ ( l1 ⊔ l2 ⊔ l3 ⊔ l4)
+ ( all-models l2 l3 i l4)
+ ( decidable-kripke-models l2 l3 i l4)
+ ( soundness-union-same-class
+ ( ax-k i ∪ ax-s i)
+ ( ax-n i)
+ ( all-models l2 l3 i l4)
+ ( soundness-union-same-class
+ ( ax-k i)
+ ( ax-s i)
+ ( all-models l2 l3 i l4)
+ ( ax-k-soundness i l3 l4)
+ ( ax-s-soundness i l3 l4))
+ ( ax-n-soundness i l3 l4))
+ ( ax-dn-soundness i l3 l4)
+ ( all-models-is-largest-class i (decidable-kripke-models l2 l3 i l4))
+
+ soundness-K : soundness (modal-logic-K i) (decidable-kripke-models l2 l3 i l4)
+ soundness-K =
+ soundness-modal-logic
+ ( decidable-kripke-models l2 l3 i l4)
+ ( soundness-K-axioms)
+
+ soundness-K-finite :
+ soundness (modal-logic-K i) (finite-decidable-kripke-models l2 l3 i l4)
+ soundness-K-finite =
+ soundness-subclass
+ ( modal-logic-K i)
+ ( decidable-kripke-models l2 l3 i l4)
+ ( finite-decidable-kripke-models l2 l3 i l4)
+ ( finite-decidable-subclass-decidable-models i)
+ ( soundness-K)
+
+module _
+ {l1 : Level} (i : Set l1)
+ where
+
+ is-consistent-K : is-consistent-modal-logic (modal-logic-K i)
+ is-consistent-K bot-in-logic =
+ map-inv-raise
+ ( soundness-K-finite
+ ( i)
+ ( ⊥ₘ)
+ ( bot-in-logic)
+ ( triple
+ ( unit , unit-trunc-Prop star)
+ ( λ _ _ → empty-Prop)
+ ( λ _ _ → empty-Prop))
+ ( triple
+ ( is-finite-unit)
+ ( λ _ _ → inr (λ r → r))
+ ( λ _ _ → is-decidable-empty))
+ ( star))
+```
diff --git a/src/modal-logic/modal-logic-s5.lagda.md b/src/modal-logic/modal-logic-s5.lagda.md
new file mode 100644
index 0000000000..0e83448786
--- /dev/null
+++ b/src/modal-logic/modal-logic-s5.lagda.md
@@ -0,0 +1,231 @@
+# Modal logic S5
+
+```agda
+module modal-logic.modal-logic-s5 where
+```
+
+Imports
+
+```agda
+open import foundation.decidable-types
+open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.intersections-subtypes
+open import foundation.propositional-truncations
+open import foundation.raising-universe-levels
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.unions-subtypes
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+
+open import modal-logic.axioms
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+open import modal-logic.modal-logic-k
+open import modal-logic.soundness
+
+open import univalent-combinatorics.finite-types
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l : Level} (i : Set l)
+ where
+
+ modal-logic-S5-axioms : modal-theory l i
+ modal-logic-S5-axioms = modal-logic-K-axioms i ∪ ax-m i ∪ ax-b i ∪ ax-4 i
+
+ modal-logic-S5 : modal-theory l i
+ modal-logic-S5 = modal-logic-closure modal-logic-S5-axioms
+
+ is-modal-logic-S5 : is-modal-logic modal-logic-S5
+ is-modal-logic-S5 = is-modal-logic-modal-logic-closure modal-logic-S5-axioms
+
+ is-normal-modal-logic-S5 : is-normal-modal-logic modal-logic-S5
+ is-normal-modal-logic-S5 =
+ modal-logic-monotic
+ ( subtype-union-left
+ ( modal-logic-K-axioms i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i)))
+
+ modal-logic-S5-axioms-contains-ax-m : ax-m i ⊆ modal-logic-S5-axioms
+ modal-logic-S5-axioms-contains-ax-m =
+ transitive-leq-subtype
+ ( ax-m i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i))
+ ( modal-logic-K-axioms i ∪ (ax-m i ∪ (ax-b i ∪ ax-4 i)))
+ ( subtype-union-right
+ ( modal-logic-K-axioms i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i)))
+ ( subtype-union-left
+ ( ax-m i)
+ ( ax-b i ∪ ax-4 i))
+
+ modal-logic-S5-axioms-contains-ax-b : ax-b i ⊆ modal-logic-S5-axioms
+ modal-logic-S5-axioms-contains-ax-b =
+ transitive-leq-subtype
+ ( ax-b i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i))
+ ( modal-logic-K-axioms i ∪ (ax-m i ∪ (ax-b i ∪ ax-4 i)))
+ ( subtype-union-right
+ ( modal-logic-K-axioms i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i)))
+ ( transitive-leq-subtype
+ ( ax-b i)
+ ( ax-b i ∪ ax-4 i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i))
+ ( subtype-union-right (ax-m i) (ax-b i ∪ ax-4 i))
+ ( subtype-union-left (ax-b i) (ax-4 i)))
+
+ modal-logic-S5-axioms-contains-ax-4 : ax-4 i ⊆ modal-logic-S5-axioms
+ modal-logic-S5-axioms-contains-ax-4 =
+ transitive-leq-subtype
+ ( ax-4 i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i))
+ ( modal-logic-K-axioms i ∪ (ax-m i ∪ (ax-b i ∪ ax-4 i)))
+ ( subtype-union-right
+ ( modal-logic-K-axioms i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i)))
+ ( transitive-leq-subtype
+ ( ax-4 i)
+ ( ax-b i ∪ ax-4 i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i))
+ ( subtype-union-right (ax-m i) (ax-b i ∪ ax-4 i))
+ ( subtype-union-right (ax-b i) (ax-4 i)))
+
+ modal-logic-S5-contains-ax-m : ax-m i ⊆ modal-logic-S5
+ modal-logic-S5-contains-ax-m =
+ transitive-leq-subtype
+ ( ax-m i)
+ ( modal-logic-S5-axioms)
+ ( modal-logic-S5)
+ ( axioms-subset-modal-logic modal-logic-S5-axioms)
+ ( modal-logic-S5-axioms-contains-ax-m)
+
+ modal-logic-S5-contains-ax-b : ax-b i ⊆ modal-logic-S5
+ modal-logic-S5-contains-ax-b =
+ transitive-leq-subtype
+ ( ax-b i)
+ ( modal-logic-S5-axioms)
+ ( modal-logic-S5)
+ ( axioms-subset-modal-logic modal-logic-S5-axioms)
+ ( modal-logic-S5-axioms-contains-ax-b)
+
+ modal-logic-S5-contains-ax-4 : ax-4 i ⊆ modal-logic-S5
+ modal-logic-S5-contains-ax-4 =
+ transitive-leq-subtype
+ ( ax-4 i)
+ ( modal-logic-S5-axioms)
+ ( modal-logic-S5)
+ ( axioms-subset-modal-logic modal-logic-S5-axioms)
+ ( modal-logic-S5-axioms-contains-ax-4)
+
+module _
+ {l1 l2 l3 l4 : Level} (i : Set l1)
+ where
+
+ soundness-S5-additional-axioms :
+ soundness
+ ( ax-m i ∪ ax-b i ∪ ax-4 i)
+ (equivalence-kripke-models l2 l3 i l4)
+ soundness-S5-additional-axioms =
+ soundness-union
+ ( ax-m i)
+ ( ax-b i ∪ ax-4 i)
+ ( reflexive-kripke-models l2 l3 i l4)
+ ( symmetry-kripke-models l2 l3 i l4 ∩ transitive-kripke-models l2 l3 i l4)
+ ( ax-m-soundness i l3 l4)
+ ( soundness-union
+ ( ax-b i)
+ ( ax-4 i)
+ ( symmetry-kripke-models l2 l3 i l4)
+ ( transitive-kripke-models l2 l3 i l4)
+ ( ax-b-soundness i l3 l4)
+ ( ax-4-soundness i l3 l4))
+
+ soundness-S5-axioms :
+ soundness
+ ( modal-logic-S5-axioms i)
+ ( decidable-subclass i (equivalence-kripke-models l2 l3 i l4))
+ soundness-S5-axioms =
+ soundness-union
+ ( modal-logic-K-axioms i)
+ ( ax-m i ∪ (ax-b i ∪ ax-4 i))
+ ( decidable-kripke-models l2 l3 i l4)
+ ( equivalence-kripke-models l2 l3 i l4)
+ ( soundness-K-axioms i)
+ ( soundness-S5-additional-axioms)
+
+ soundness-S5 :
+ soundness
+ ( modal-logic-S5 i)
+ ( decidable-subclass i (equivalence-kripke-models l2 l3 i l4))
+ soundness-S5 =
+ soundness-modal-logic
+ ( decidable-subclass i (equivalence-kripke-models l2 l3 i l4))
+ ( soundness-S5-axioms)
+
+ soundness-S5-finite :
+ soundness
+ ( modal-logic-S5 i)
+ ( finite-subclass i (equivalence-kripke-models l2 l3 i l4))
+ soundness-S5-finite =
+ soundness-subclass
+ ( modal-logic-S5 i)
+ ( decidable-subclass i (equivalence-kripke-models l2 l3 i l4))
+ ( finite-subclass i (equivalence-kripke-models l2 l3 i l4))
+ ( subtype-both-intersection
+ ( decidable-kripke-models l2 l3 i l4)
+ ( equivalence-kripke-models l2 l3 i l4)
+ ( finite-subclass i (equivalence-kripke-models l2 l3 i l4))
+ ( transitive-leq-subtype
+ ( finite-subclass i (equivalence-kripke-models l2 l3 i l4))
+ ( finite-decidable-kripke-models l2 l3 i l4)
+ ( decidable-kripke-models l2 l3 i l4)
+ ( finite-decidable-subclass-decidable-models i)
+ ( subtype-intersection-left
+ ( finite-decidable-kripke-models l2 l3 i l4)
+ ( equivalence-kripke-models l2 l3 i l4)))
+ ( subtype-intersection-right
+ ( finite-decidable-kripke-models l2 l3 i l4)
+ ( equivalence-kripke-models l2 l3 i l4)))
+ ( soundness-S5)
+
+module _
+ {l1 : Level} (i : Set l1)
+ where
+
+ is-consistent-S5 : is-consistent-modal-logic (modal-logic-S5 i)
+ is-consistent-S5 bot-in-logic =
+ map-inv-raise
+ ( soundness-S5-finite
+ ( i)
+ ( ⊥ₘ)
+ ( bot-in-logic)
+ ( triple
+ ( unit , unit-trunc-Prop star)
+ ( λ _ _ → unit-Prop)
+ ( λ _ _ → unit-Prop))
+ ( pair
+ ( triple
+ ( is-finite-unit)
+ ( λ _ _ → inl star)
+ ( λ _ _ → is-decidable-unit))
+ ( triple
+ ( λ x → star)
+ ( λ x y _ → star)
+ ( λ x y z _ _ → star)))
+ ( star))
+```
diff --git a/src/modal-logic/soundness.lagda.md b/src/modal-logic/soundness.lagda.md
new file mode 100644
index 0000000000..105a142e77
--- /dev/null
+++ b/src/modal-logic/soundness.lagda.md
@@ -0,0 +1,205 @@
+# Modal logic soundness
+
+```agda
+module modal-logic.soundness where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.inhabited-types
+open import foundation.intersections-subtypes
+open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.transport-along-identifications
+open import foundation.unions-subtypes
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+
+open import modal-logic.deduction
+open import modal-logic.formulas
+open import modal-logic.kripke-semantics
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+soundness :
+ {l1 l2 l3 l4 l5 l6 : Level} {i : Set l1} →
+ modal-theory l2 i →
+ model-class l3 l4 i l5 l6 →
+ UU (l1 ⊔ l2 ⊔ lsuc l3 ⊔ lsuc l4 ⊔ lsuc l5 ⊔ l6)
+soundness logic C = logic ⊆ class-modal-logic C
+```
+
+## Properties
+
+```agda
+module _
+ {l1 l2 l3 l4 l5 l6 : Level}
+ {i : Set l1} {axioms : modal-theory l2 i}
+ (C : model-class l3 l4 i l5 l6)
+ where
+
+ soundness-axioms :
+ soundness axioms C →
+ {a : modal-formula i} →
+ axioms ⊢ₘ a →
+ type-Prop (C ⊨Cₘ a)
+ soundness-axioms H (modal-ax x) = H _ x
+ soundness-axioms H (modal-mp dab da) M in-class x =
+ soundness-axioms H dab M in-class x (soundness-axioms H da M in-class x)
+ soundness-axioms H (modal-nec d) M in-class _ y _ =
+ soundness-axioms H d M in-class y
+
+ soundness-modal-logic :
+ soundness axioms C → soundness (modal-logic-closure axioms) C
+ soundness-modal-logic H a =
+ map-universal-property-trunc-Prop (C ⊨Cₘ a) (soundness-axioms H)
+
+module _
+ {l1 l2 l3 l4 l5 l6 l7 : Level}
+ {i : Set l1} (logic : modal-theory l2 i)
+ (C₁ : model-class l3 l4 i l5 l6) (C₂ : model-class l3 l4 i l5 l7)
+ where
+
+ soundness-subclass : C₂ ⊆ C₁ → soundness logic C₁ → soundness logic C₂
+ soundness-subclass sub =
+ transitive-leq-subtype
+ ( logic)
+ ( class-modal-logic C₁)
+ ( class-modal-logic C₂)
+ ( class-modal-logic-monotic C₂ C₁ sub)
+
+module _
+ {l1 l2 l3 l4 l5 l6 l7 l8 : Level}
+ {i : Set l1} (theory₁ : modal-theory l2 i) (theory₂ : modal-theory l3 i)
+ (C₁ : model-class l4 l5 i l6 l7) (C₂ : model-class l4 l5 i l6 l8)
+ (sound₁ : soundness theory₁ C₁) (sound₂ : soundness theory₂ C₂)
+ where
+
+ forces-in-intersection :
+ (M : kripke-model l4 l5 i l6) →
+ is-in-subtype (C₁ ∩ C₂) M →
+ (a : modal-formula i) →
+ is-in-subtype theory₁ a + is-in-subtype theory₂ a →
+ type-Prop (M ⊨Mₘ a)
+ forces-in-intersection M in-class a (inl d) =
+ sound₁ a d M (subtype-intersection-left C₁ C₂ M in-class)
+ forces-in-intersection M in-class a (inr d) =
+ sound₂ a d M (subtype-intersection-right C₁ C₂ M in-class)
+
+ soundness-union : soundness (theory₁ ∪ theory₂) (C₁ ∩ C₂)
+ soundness-union a is-theory M in-class =
+ apply-universal-property-trunc-Prop
+ ( is-theory)
+ ( M ⊨Mₘ a)
+ ( forces-in-intersection M in-class a)
+
+ soundness-modal-logic-union :
+ soundness (modal-logic-closure (theory₁ ∪ theory₂)) (C₁ ∩ C₂)
+ soundness-modal-logic-union =
+ soundness-modal-logic (C₁ ∩ C₂) soundness-union
+
+module _
+ {l1 l2 l3 l4 l5 l6 l7 : Level}
+ {i : Set l1} (ax₁ : modal-theory l2 i) (ax₂ : modal-theory l3 i)
+ where
+
+ soundness-union-subclass-left-sublevels :
+ (l8 : Level)
+ (C₁ : model-class l4 l5 i l6 (l7 ⊔ l8)) (C₂ : model-class l4 l5 i l6 l7)
+ (sound₁ : soundness ax₁ C₁) (sound₂ : soundness ax₂ C₂) →
+ C₁ ⊆ C₂ →
+ soundness (ax₁ ∪ ax₂) C₁
+ soundness-union-subclass-left-sublevels
+ l8 C₁ C₂ sound₁ sound₂ C₁-sub-C₂ =
+ tr
+ ( soundness (ax₁ ∪ ax₂))
+ ( intersection-subtype-left-sublevels l8 C₁ C₂ C₁-sub-C₂)
+ ( soundness-union ax₁ ax₂ C₁ C₂ sound₁ sound₂)
+
+ soundness-union-subclass-right-sublevels :
+ (l8 : Level)
+ (C₁ : model-class l4 l5 i l6 l7) (C₂ : model-class l4 l5 i l6 (l7 ⊔ l8))
+ (sound₁ : soundness ax₁ C₁) (sound₂ : soundness ax₂ C₂) →
+ C₂ ⊆ C₁ →
+ soundness (ax₁ ∪ ax₂) C₂
+ soundness-union-subclass-right-sublevels
+ l8 C₁ C₂ sound₁ sound₂ C₂-sub-C₁ =
+ tr
+ ( soundness (ax₁ ∪ ax₂))
+ ( intersection-subtype-right-sublevels l8 C₁ C₂ C₂-sub-C₁)
+ ( soundness-union ax₁ ax₂ C₁ C₂ sound₁ sound₂)
+
+ soundness-modal-logic-union-subclass-left-sublevels :
+ (l8 : Level)
+ (C₁ : model-class l4 l5 i l6 (l7 ⊔ l8)) (C₂ : model-class l4 l5 i l6 l7)
+ (sound₁ : soundness ax₁ C₁) (sound₂ : soundness ax₂ C₂) →
+ C₁ ⊆ C₂ →
+ soundness (modal-logic-closure (ax₁ ∪ ax₂)) C₁
+ soundness-modal-logic-union-subclass-left-sublevels
+ l8 C₁ C₂ sound₁ sound₂ C₁-sub-C₂ =
+ tr
+ ( soundness (modal-logic-closure (ax₁ ∪ ax₂)))
+ ( intersection-subtype-left-sublevels l8 C₁ C₂ C₁-sub-C₂)
+ ( soundness-modal-logic-union ax₁ ax₂ C₁ C₂ sound₁ sound₂)
+
+ soundness-modal-logic-union-subclass-right-sublevels :
+ (l8 : Level)
+ (C₁ : model-class l4 l5 i l6 l7) (C₂ : model-class l4 l5 i l6 (l7 ⊔ l8))
+ (sound₁ : soundness ax₁ C₁) (sound₂ : soundness ax₂ C₂) →
+ C₂ ⊆ C₁ →
+ soundness (modal-logic-closure (ax₁ ∪ ax₂)) C₂
+ soundness-modal-logic-union-subclass-right-sublevels
+ l8 C₁ C₂ sound₁ sound₂ C₂-sub-C₁ =
+ tr
+ ( soundness (modal-logic-closure (ax₁ ∪ ax₂)))
+ ( intersection-subtype-right-sublevels l8 C₁ C₂ C₂-sub-C₁)
+ ( soundness-modal-logic-union ax₁ ax₂ C₁ C₂ sound₁ sound₂)
+
+ soundness-modal-logic-union-subclass-left :
+ (C₁ : model-class l4 l5 i l6 l7) (C₂ : model-class l4 l5 i l6 l7)
+ (sound₁ : soundness ax₁ C₁) (sound₂ : soundness ax₂ C₂) →
+ C₁ ⊆ C₂ →
+ soundness (modal-logic-closure (ax₁ ∪ ax₂)) C₁
+ soundness-modal-logic-union-subclass-left =
+ soundness-modal-logic-union-subclass-left-sublevels lzero
+
+ soundness-modal-logic-union-subclass-right :
+ (C₁ : model-class l4 l5 i l6 l7) (C₂ : model-class l4 l5 i l6 l7)
+ (sound₁ : soundness ax₁ C₁) (sound₂ : soundness ax₂ C₂) →
+ C₂ ⊆ C₁ →
+ soundness (modal-logic-closure (ax₁ ∪ ax₂)) C₂
+ soundness-modal-logic-union-subclass-right =
+ soundness-modal-logic-union-subclass-right-sublevels lzero
+
+module _
+ {l1 l2 l3 l4 l5 l6 l7 : Level}
+ {i : Set l1} (ax₁ : modal-theory l2 i) (ax₂ : modal-theory l3 i)
+ (C : model-class l4 l5 i l6 l7)
+ (sound₁ : soundness ax₁ C) (sound₂ : soundness ax₂ C)
+ where
+
+ soundness-union-same-class : soundness (ax₁ ∪ ax₂) C
+ soundness-union-same-class =
+ tr
+ ( soundness (ax₁ ∪ ax₂))
+ ( is-reflexivity-intersection C)
+ ( soundness-union ax₁ ax₂ C C sound₁ sound₂)
+
+ soundness-modal-logic-union-same-class :
+ soundness (modal-logic-closure (ax₁ ∪ ax₂)) C
+ soundness-modal-logic-union-same-class =
+ soundness-modal-logic C soundness-union-same-class
+```
diff --git a/src/modal-logic/subformulas.lagda.md b/src/modal-logic/subformulas.lagda.md
new file mode 100644
index 0000000000..283bd22de1
--- /dev/null
+++ b/src/modal-logic/subformulas.lagda.md
@@ -0,0 +1,180 @@
+# Modal logic subformulas
+
+```agda
+module modal-logic.subformulas where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.functoriality-propositional-truncation
+open import foundation.law-of-excluded-middle
+open import foundation.propositional-truncations
+open import foundation.universe-levels
+
+open import foundation-core.cartesian-product-types
+open import foundation-core.coproduct-types
+open import foundation-core.function-types
+open import foundation-core.propositions
+open import foundation-core.sets
+open import foundation-core.subtypes
+
+open import lists.concatenation-lists
+open import lists.lists
+open import lists.lists-subtypes
+
+open import modal-logic.closed-under-subformulas-theories
+open import modal-logic.deduction
+open import modal-logic.formulas
+
+open import univalent-combinatorics.finite-types
+open import univalent-combinatorics.function-types
+open import univalent-combinatorics.kuratowsky-finite-sets
+```
+
+
+
+## Idea
+
+The subformulas of a modal formula are the formulas that occur in the formula.
+
+## Definition
+
+```agda
+module _
+ {l : Level} {i : Set l}
+ where
+
+ subformulas-list : modal-formula i → list (modal-formula i)
+ subformulas-list a = cons a (rest a)
+ where
+ rest : modal-formula i → list (modal-formula i)
+ rest (varₘ x) = nil
+ rest ⊥ₘ = nil
+ rest (a →ₘ b) = concat-list (subformulas-list a) (subformulas-list b)
+ rest (□ₘ a) = subformulas-list a
+
+ subformulas : modal-formula i → modal-theory l i
+ subformulas a = list-subtype (subformulas-list a)
+```
+
+### Subformulas is closed under subformulas
+
+```agda
+ subformulas-list-has-subimpl :
+ (a : modal-formula i) {x y : modal-formula i} →
+ (x →ₘ y) ∈-list subformulas-list a →
+ (x ∈-list subformulas-list a) × (y ∈-list subformulas-list a)
+ subformulas-list-has-subimpl .(x →ₘ y) {x} {y} (is-head .(x →ₘ y) _) =
+ pair
+ ( is-in-tail x (x →ₘ y) _
+ ( in-concat-left
+ ( subformulas-list x)
+ ( subformulas-list y)
+ ( is-head x _)))
+ ( is-in-tail y (x →ₘ y) _
+ ( in-concat-right
+ ( subformulas-list x)
+ ( subformulas-list y)
+ ( is-head y _)))
+ subformulas-list-has-subimpl
+ (a →ₘ b) {x} {y} (is-in-tail .(x →ₘ y) .(a →ₘ b) _ xy-list-subtype)
+ with
+ in-concat-list
+ ( subformulas-list a)
+ ( subformulas-list b)
+ ( xy-list-subtype)
+ ... | inl xy-in-left =
+ let (x-in-tail , y-in-tail) = subformulas-list-has-subimpl a xy-in-left
+ in pair
+ ( is-in-tail x (a →ₘ b) _
+ ( in-concat-left (subformulas-list a) (subformulas-list b) x-in-tail))
+ ( is-in-tail y (a →ₘ b) _
+ ( in-concat-left (subformulas-list a) (subformulas-list b) y-in-tail))
+ ... | inr xy-in-right =
+ let (x-in-tail , y-in-tail) = subformulas-list-has-subimpl b xy-in-right
+ in pair
+ ( is-in-tail x (a →ₘ b) _
+ ( in-concat-right (subformulas-list a) (subformulas-list b) x-in-tail))
+ ( is-in-tail y (a →ₘ b) _
+ ( in-concat-right (subformulas-list a) (subformulas-list b) y-in-tail))
+ subformulas-list-has-subimpl
+ (□ₘ a) {x} {y} (is-in-tail .(x →ₘ y) .(□ₘ a) _ xy-list-subtype) =
+ let (x-in-tail , y-in-tail) =
+ subformulas-list-has-subimpl a xy-list-subtype
+ in (is-in-tail x (□ₘ a) _ x-in-tail) , (is-in-tail y (□ₘ a) _ y-in-tail)
+
+ subformulas-list-has-subbox :
+ (a : modal-formula i) {x : modal-formula i} →
+ □ₘ x ∈-list subformulas-list a →
+ x ∈-list subformulas-list a
+ subformulas-list-has-subbox .(□ₘ x) {x} (is-head .(□ₘ x) _) =
+ is-in-tail x (□ₘ x) _ (is-head x _)
+ subformulas-list-has-subbox
+ (a →ₘ b) {x} (is-in-tail .(□ₘ x) .(a →ₘ b) _ x-list-subtype)
+ with
+ in-concat-list (subformulas-list a) (subformulas-list b) x-list-subtype
+ ... | inl x-in-left =
+ is-in-tail x (a →ₘ b) _
+ ( in-concat-left (subformulas-list a) (subformulas-list b)
+ ( subformulas-list-has-subbox a x-in-left))
+ ... | inr x-in-right =
+ is-in-tail x (a →ₘ b) _
+ ( in-concat-right (subformulas-list a) (subformulas-list b)
+ ( subformulas-list-has-subbox b x-in-right))
+ subformulas-list-has-subbox
+ (□ₘ a) {x} (is-in-tail .(□ₘ x) .(□ₘ a) _ x-list-subtype) =
+ is-in-tail x (□ₘ a) _ (subformulas-list-has-subbox a x-list-subtype)
+
+ is-modal-theory-has-subboxes-subformulas :
+ (a : modal-formula i) → is-modal-theory-has-subboxes (subformulas a)
+ is-modal-theory-has-subboxes-subformulas a =
+ map-trunc-Prop (subformulas-list-has-subbox a)
+
+ is-modal-theory-has-subimps-subformulas :
+ (a : modal-formula i) → is-modal-theory-has-subimps (subformulas a)
+ is-modal-theory-has-subimps-subformulas a =
+ map-distributive-trunc-product-Prop ∘
+ map-trunc-Prop (subformulas-list-has-subimpl a)
+
+ is-modal-theory-closed-under-subformulas-subformulas :
+ (a : modal-formula i) →
+ is-modal-theory-closed-under-subformulas (subformulas a)
+ is-modal-theory-closed-under-subformulas-subformulas a =
+ pair
+ ( is-modal-theory-has-subboxes-subformulas a)
+ ( is-modal-theory-has-subimps-subformulas a)
+
+ is-kuratowsky-finite-subformulas-list :
+ (a : modal-formula i) →
+ is-kuratowsky-finite-set (set-subset (modal-formula-Set i) (subformulas a))
+ is-kuratowsky-finite-subformulas-list a =
+ is-kuratowski-finite-list-subtype (modal-formula-Set i) (subformulas-list a)
+```
+
+TODO: Remove
+
+### TODO: Classical facts
+
+```agda
+ is-finite-subformulas-list :
+ LEM l →
+ (a : modal-formula i) →
+ is-finite (type-subtype (subformulas a))
+ is-finite-subformulas-list lem a =
+ is-finite-is-kuratowsky-finite-set
+ ( set-subset (modal-formula-Set i) (subformulas a))
+ ( lem)
+ ( is-kuratowsky-finite-subformulas-list a)
+
+ is-finite-subtypes-subformulas-list :
+ {l2 : Level} →
+ LEM (l ⊔ l2) →
+ (a : modal-formula i) →
+ is-finite (type-subtype (subformulas a) → Prop l2)
+ is-finite-subtypes-subformulas-list {l2} lem a =
+ is-finite-function-type
+ ( is-finite-subformulas-list (lower-LEM l2 lem) a)
+ ( is-finite-Prop-LEM (lower-LEM l lem))
+```
diff --git a/src/modal-logic/weak-deduction.lagda.md b/src/modal-logic/weak-deduction.lagda.md
new file mode 100644
index 0000000000..72df82f3a4
--- /dev/null
+++ b/src/modal-logic/weak-deduction.lagda.md
@@ -0,0 +1,543 @@
+# Weak deduction
+
+```agda
+module modal-logic.weak-deduction where
+```
+
+Imports
+
+```agda
+open import foundation.cartesian-product-types
+open import foundation.conjunction
+open import foundation.coproduct-types
+open import foundation.dependent-pair-types
+open import foundation.disjunction
+open import foundation.empty-types
+open import foundation.equivalences
+open import foundation.existential-quantification
+open import foundation.function-types
+open import foundation.identity-types
+open import foundation.logical-equivalences
+open import foundation.propositional-truncations
+open import foundation.propositions
+open import foundation.sets
+open import foundation.subtypes
+open import foundation.unions-subtypes
+open import foundation.unit-type
+open import foundation.universe-levels
+
+open import foundation-core.negation
+
+open import lists.concatenation-lists
+open import lists.lists
+open import lists.lists-subtypes
+open import lists.reversing-lists
+
+open import modal-logic.axioms
+open import modal-logic.deduction
+open import modal-logic.formulas
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 : Level} {i : Set l1}
+ where
+
+ is-weak-deduction-Prop :
+ {axioms : modal-theory l2 i} {a : modal-formula i} →
+ axioms ⊢ₘ a →
+ Prop lzero
+ is-weak-deduction-Prop (modal-ax x) = unit-Prop
+ is-weak-deduction-Prop (modal-mp dab da) =
+ is-weak-deduction-Prop dab ∧ is-weak-deduction-Prop da
+ is-weak-deduction-Prop (modal-nec d) = empty-Prop
+
+ is-weak-deduction :
+ {axioms : modal-theory l2 i} {a : modal-formula i} → axioms ⊢ₘ a → UU lzero
+ is-weak-deduction = type-Prop ∘ is-weak-deduction-Prop
+
+ infix 5 _⊢ₘw_
+
+ _⊢ₘw_ : modal-theory l2 i → modal-formula i → UU (l1 ⊔ l2)
+ axioms ⊢ₘw a = type-subtype (is-weak-deduction-Prop {axioms} {a})
+
+ deduction-weak-deduction :
+ {axioms : modal-theory l2 i} {a : modal-formula i} →
+ axioms ⊢ₘw a →
+ axioms ⊢ₘ a
+ deduction-weak-deduction = inclusion-subtype is-weak-deduction-Prop
+
+ is-weak-deduction-deduction-weak-deduction :
+ {axioms : modal-theory l2 i} {a : modal-formula i} (d : axioms ⊢ₘw a) →
+ is-weak-deduction (deduction-weak-deduction d)
+ is-weak-deduction-deduction-weak-deduction =
+ is-in-subtype-inclusion-subtype is-weak-deduction-Prop
+
+ weak-deduction-ax :
+ {axioms : modal-theory l2 i} {a : modal-formula i} →
+ is-in-subtype axioms a →
+ axioms ⊢ₘw a
+ weak-deduction-ax in-axioms = modal-ax in-axioms , star
+
+ weak-deduction-mp :
+ {axioms : modal-theory l2 i} {a b : modal-formula i} →
+ axioms ⊢ₘw (a →ₘ b) →
+ axioms ⊢ₘw a →
+ axioms ⊢ₘw b
+ weak-deduction-mp (dab , is-w-dab) (da , is-w-da) =
+ modal-mp dab da , is-w-dab , is-w-da
+
+ ind-weak-deduction :
+ {l : Level} {axioms : modal-theory l2 i}
+ (P : {a : modal-formula i} → axioms ⊢ₘw a → UU l) →
+ ( {a : modal-formula i} (in-axioms : is-in-subtype axioms a) →
+ P (weak-deduction-ax in-axioms)) →
+ ( {a b : modal-formula i} (dab : axioms ⊢ₘw a →ₘ b) (da : axioms ⊢ₘw a) →
+ P dab → P da → P (weak-deduction-mp dab da)) →
+ {a : modal-formula i} (wd : axioms ⊢ₘw a) → P wd
+ ind-weak-deduction P H-ax H-mp (modal-ax in-axioms , _) =
+ H-ax in-axioms
+ ind-weak-deduction P H-ax H-mp (modal-mp dba db , is-w-dba , is-w-db) =
+ H-mp _ _
+ ( ind-weak-deduction P H-ax H-mp (dba , is-w-dba))
+ ( ind-weak-deduction P H-ax H-mp (db , is-w-db))
+
+ rec-weak-deduction :
+ {l : Level} {axioms : modal-theory l2 i} {P : UU l} →
+ ( {a : modal-formula i} (in-axioms : is-in-subtype axioms a) → P) →
+ ( {a b : modal-formula i} (dab : axioms ⊢ₘw a →ₘ b) (da : axioms ⊢ₘw a) →
+ P → P → P) →
+ {a : modal-formula i} (wd : axioms ⊢ₘw a) → P
+ rec-weak-deduction {P = P} = ind-weak-deduction (λ _ → P)
+
+ weak-modal-logic-closure : modal-theory l2 i → modal-theory (l1 ⊔ l2) i
+ weak-modal-logic-closure axioms a = trunc-Prop (axioms ⊢ₘw a)
+
+ is-weak-modal-logic-Prop : modal-theory l2 i → Prop (l1 ⊔ l2)
+ is-weak-modal-logic-Prop theory =
+ leq-prop-subtype (weak-modal-logic-closure theory) theory
+
+ is-weak-modal-logic : modal-theory l2 i → UU (l1 ⊔ l2)
+ is-weak-modal-logic = type-Prop ∘ is-weak-modal-logic-Prop
+
+ is-in-weak-modal-logic-closure-weak-deduction :
+ {axioms : modal-theory l2 i} {a : modal-formula i} →
+ axioms ⊢ₘw a → is-in-subtype (weak-modal-logic-closure axioms) a
+ is-in-weak-modal-logic-closure-weak-deduction = unit-trunc-Prop
+
+ subset-weak-modal-logic-closure-modal-logic-closure :
+ {axioms : modal-theory l2 i} →
+ weak-modal-logic-closure axioms ⊆ modal-logic-closure axioms
+ subset-weak-modal-logic-closure-modal-logic-closure {axioms} a =
+ map-universal-property-trunc-Prop
+ ( modal-logic-closure axioms a)
+ ( is-in-modal-logic-closure-deduction ∘ deduction-weak-deduction)
+
+ is-weak-modal-logic-is-modal-logic :
+ {theory : modal-theory l2 i} →
+ is-modal-logic theory →
+ is-weak-modal-logic theory
+ is-weak-modal-logic-is-modal-logic {theory} is-m =
+ transitive-leq-subtype
+ ( weak-modal-logic-closure theory)
+ ( modal-logic-closure theory)
+ ( theory)
+ ( is-m)
+ ( subset-weak-modal-logic-closure-modal-logic-closure)
+
+module _
+ {l1 l2 : Level} {i : Set l1} {axioms : modal-theory l2 i}
+ where
+
+ weak-modal-logic-closure-ax :
+ {a : modal-formula i} →
+ is-in-subtype axioms a →
+ is-in-subtype (weak-modal-logic-closure axioms) a
+ weak-modal-logic-closure-ax =
+ is-in-weak-modal-logic-closure-weak-deduction ∘ weak-deduction-ax
+
+ weak-modal-logic-closure-mp :
+ {a b : modal-formula i} →
+ is-in-subtype (weak-modal-logic-closure axioms) (a →ₘ b) →
+ is-in-subtype (weak-modal-logic-closure axioms) a →
+ is-in-subtype (weak-modal-logic-closure axioms) b
+ weak-modal-logic-closure-mp {a} {b} twdab twda =
+ apply-twice-universal-property-trunc-Prop twdab twda
+ ( weak-modal-logic-closure axioms b)
+ ( λ wdab wda →
+ ( is-in-weak-modal-logic-closure-weak-deduction
+ ( weak-deduction-mp wdab wda)))
+
+module _
+ {l1 l2 : Level} {i : Set l1}
+ {theory : modal-theory l2 i}
+ (is-w : is-weak-modal-logic theory)
+ where
+
+ weak-modal-logic-mp :
+ {a b : modal-formula i} →
+ is-in-subtype theory (a →ₘ b) →
+ is-in-subtype theory a →
+ is-in-subtype theory b
+ weak-modal-logic-mp {a} {b} dab da =
+ is-w b
+ ( weak-modal-logic-closure-mp
+ ( weak-modal-logic-closure-ax dab)
+ ( weak-modal-logic-closure-ax da))
+
+module _
+ {l1 l2 : Level} {i : Set l1} {axioms : modal-theory l2 i}
+ where
+
+ weak-modal-logic-closed :
+ {a : modal-formula i} → weak-modal-logic-closure axioms ⊢ₘw a →
+ is-in-subtype (weak-modal-logic-closure axioms) a
+ weak-modal-logic-closed =
+ ind-weak-deduction _
+ ( λ in-axioms → in-axioms)
+ ( λ _ _ in-logic-ab in-logic-a →
+ ( weak-modal-logic-closure-mp in-logic-ab in-logic-a))
+
+ is-weak-modal-logic-weak-modal-logic-closure :
+ is-weak-modal-logic (weak-modal-logic-closure axioms)
+ is-weak-modal-logic-weak-modal-logic-closure a =
+ map-universal-property-trunc-Prop
+ ( weak-modal-logic-closure axioms a)
+ ( weak-modal-logic-closed)
+
+ subset-axioms-weak-modal-logic-closure :
+ axioms ⊆ weak-modal-logic-closure axioms
+ subset-axioms-weak-modal-logic-closure a = weak-modal-logic-closure-ax
+
+module _
+ {l1 l2 l3 : Level} {i : Set l1}
+ {ax₁ : modal-theory l2 i}
+ {ax₂ : modal-theory l3 i}
+ (leq : ax₁ ⊆ ax₂)
+ where
+
+ weak-deduction-monotic : {a : modal-formula i} → ax₁ ⊢ₘw a → ax₂ ⊢ₘw a
+ weak-deduction-monotic =
+ ind-weak-deduction _
+ ( λ {a} in-axioms → weak-deduction-ax (leq a in-axioms))
+ ( λ _ _ dab da → weak-deduction-mp dab da)
+
+ weak-modal-logic-closure-monotic :
+ weak-modal-logic-closure ax₁ ⊆ weak-modal-logic-closure ax₂
+ weak-modal-logic-closure-monotic a =
+ map-universal-property-trunc-Prop
+ ( weak-modal-logic-closure ax₂ a)
+ ( is-in-weak-modal-logic-closure-weak-deduction ∘ weak-deduction-monotic)
+
+module _
+ {l1 l2 l3 : Level} {i : Set l1}
+ {ax₁ : modal-theory l2 i}
+ {ax₂ : modal-theory l3 i}
+ where
+
+ subset-weak-modal-logic-subset-axioms :
+ ax₁ ⊆ weak-modal-logic-closure ax₂ →
+ weak-modal-logic-closure ax₁ ⊆ weak-modal-logic-closure ax₂
+ subset-weak-modal-logic-subset-axioms leq =
+ transitive-leq-subtype
+ ( weak-modal-logic-closure ax₁)
+ ( weak-modal-logic-closure (weak-modal-logic-closure ax₂))
+ ( weak-modal-logic-closure ax₂)
+ ( is-weak-modal-logic-weak-modal-logic-closure)
+ ( weak-modal-logic-closure-monotic leq)
+
+module _
+ {l1 : Level} {i : Set l1}
+ where
+
+ backward-subset-head-add :
+ (a : modal-formula i) (l : list (modal-formula i)) →
+ list-subtype (cons a l) ⊆ theory-add-formula a (list-subtype l)
+ backward-subset-head-add a l =
+ subset-list-subtype-cons
+ ( theory-add-formula a (list-subtype l))
+ ( formula-in-add-formula a (list-subtype l))
+ ( subset-add-formula a (list-subtype l))
+
+module _
+ {l1 l2 : Level} {i : Set l1}
+ (axioms : modal-theory l2 i)
+ where
+
+ backward-deduction-theorem :
+ {a b : modal-formula i} →
+ axioms ⊢ₘw a →ₘ b →
+ theory-add-formula a axioms ⊢ₘw b
+ backward-deduction-theorem {a} wab =
+ weak-deduction-mp
+ ( weak-deduction-monotic
+ ( subset-add-formula a axioms)
+ ( wab))
+ ( weak-deduction-ax (formula-in-add-formula a axioms))
+
+ module _
+ (contains-ax-k : ax-k i ⊆ axioms)
+ (contains-ax-s : ax-s i ⊆ axioms)
+ where
+
+ -- TODO: move to file with deduction
+ deduction-a->a :
+ (a : modal-formula i) → axioms ⊢ₘw a →ₘ a
+ deduction-a->a a =
+ weak-deduction-mp
+ ( weak-deduction-mp
+ ( weak-deduction-ax (contains-ax-s _ (a , a →ₘ a , a , refl)))
+ ( weak-deduction-ax (contains-ax-k _ (a , a →ₘ a , refl))))
+ ( weak-deduction-ax (contains-ax-k _ (a , a , refl)))
+
+ forward-deduction-theorem :
+ (a : modal-formula i) {b : modal-formula i} →
+ theory-add-formula a axioms ⊢ₘw b →
+ is-in-subtype (weak-modal-logic-closure axioms) (a →ₘ b)
+ forward-deduction-theorem a =
+ ind-weak-deduction _
+ ( λ {b} b-in-axioms →
+ ( elim-theory-add-formula a axioms
+ ( λ x → weak-modal-logic-closure axioms (a →ₘ x))
+ ( is-in-weak-modal-logic-closure-weak-deduction (deduction-a->a a))
+ ( λ x x-in-axioms →
+ ( weak-modal-logic-closure-mp
+ ( weak-modal-logic-closure-ax
+ ( contains-ax-k (x →ₘ a →ₘ x) (x , a , refl)))
+ ( weak-modal-logic-closure-ax x-in-axioms)))
+ ( b)
+ ( b-in-axioms)))
+ ( λ {b} {c} _ _ dabc dab →
+ ( weak-modal-logic-closure-mp
+ ( weak-modal-logic-closure-mp
+ ( weak-modal-logic-closure-ax
+ ( contains-ax-s _ (a , b , c , refl)))
+ ( dabc))
+ ( dab)))
+
+ deduction-theorem :
+ (a b : modal-formula i) →
+ type-iff-Prop
+ ( weak-modal-logic-closure (theory-add-formula a axioms) b)
+ ( weak-modal-logic-closure axioms (a →ₘ b))
+ pr1 (deduction-theorem a b) =
+ map-universal-property-trunc-Prop
+ ( weak-modal-logic-closure axioms (a →ₘ b))
+ ( forward-deduction-theorem a)
+ pr2 (deduction-theorem a b) =
+ map-universal-property-trunc-Prop
+ ( weak-modal-logic-closure (theory-add-formula a axioms) b)
+ ( is-in-weak-modal-logic-closure-weak-deduction ∘
+ backward-deduction-theorem)
+```
+
+### TODO: List of assumptions
+
+```agda
+module _
+ {l1 : Level} {i : Set l1}
+ where
+
+ list-assumptions-weak-deduction :
+ {l2 : Level} {theory : modal-theory l2 i} {a : modal-formula i} →
+ theory ⊢ₘw a → list (modal-formula i)
+ list-assumptions-weak-deduction =
+ rec-weak-deduction
+ ( λ {a} _ → cons a nil)
+ ( λ _ _ l1 l2 → concat-list l1 l2)
+
+ subset-theory-list-assumptions-weak-deduction :
+ {l2 : Level} {theory : modal-theory l2 i} {a : modal-formula i} →
+ (d : theory ⊢ₘw a) →
+ list-subtype (list-assumptions-weak-deduction d) ⊆ theory
+ subset-theory-list-assumptions-weak-deduction {theory = theory} =
+ ind-weak-deduction
+ ( λ d → list-subtype (list-assumptions-weak-deduction d) ⊆ theory)
+ ( λ {a} in-axioms →
+ ( subset-list-subtype-cons theory in-axioms
+ ( subset-list-subtype-nil theory)))
+ ( λ dab da sub1 sub2 →
+ ( transitive-leq-subtype
+ ( list-subtype
+ ( concat-list
+ ( list-assumptions-weak-deduction dab)
+ ( list-assumptions-weak-deduction da)))
+ ( list-subtype (list-assumptions-weak-deduction dab) ∪
+ list-subtype (list-assumptions-weak-deduction da))
+ ( theory)
+ ( subtype-union-both
+ ( list-subtype (list-assumptions-weak-deduction dab))
+ ( list-subtype (list-assumptions-weak-deduction da))
+ ( theory)
+ ( sub1)
+ ( sub2))
+ ( subset-list-subtype-concat-union)))
+
+ is-assumptions-list-assumptions-weak-deduction :
+ {l2 : Level} {theory : modal-theory l2 i} {a : modal-formula i} →
+ (d : theory ⊢ₘw a) →
+ list-subtype (list-assumptions-weak-deduction d) ⊢ₘw a
+ is-assumptions-list-assumptions-weak-deduction {theory = theory} =
+ ind-weak-deduction
+ ( λ {a} d → list-subtype (list-assumptions-weak-deduction d) ⊢ₘw a)
+ ( λ _ → weak-deduction-ax head-in-list-subtype)
+ ( λ dab da rab ra →
+ ( weak-deduction-monotic
+ {ax₁ = list-subtype (list-assumptions-weak-deduction dab) ∪
+ list-subtype (list-assumptions-weak-deduction da)}
+ ( subset-list-subtype-union-concat)
+ ( weak-deduction-mp
+ ( weak-deduction-monotic
+ ( subtype-union-left
+ ( list-subtype (list-assumptions-weak-deduction dab))
+ ( list-subtype (list-assumptions-weak-deduction da)))
+ ( rab))
+ ( weak-deduction-monotic
+ ( subtype-union-right
+ ( list-subtype (list-assumptions-weak-deduction dab))
+ ( list-subtype (list-assumptions-weak-deduction da)))
+ ( ra)))))
+
+module _
+ {l1 l2 : Level} {i : Set l1} (axioms : modal-theory l2 i)
+ (contains-ax-k : ax-k i ⊆ axioms)
+ (contains-ax-s : ax-s i ⊆ axioms)
+ (contains-ax-dn : ax-dn i ⊆ axioms)
+ where
+
+ -- TODO: move to formulas-deduction
+
+ deduction-ex-falso :
+ (a b : modal-formula i) →
+ is-in-subtype (weak-modal-logic-closure axioms) (¬ₘ a →ₘ a →ₘ b)
+ deduction-ex-falso a b =
+ forward-implication
+ ( deduction-theorem axioms contains-ax-k contains-ax-s (¬ₘ a) (a →ₘ b))
+ ( forward-implication
+ ( deduction-theorem
+ ( theory-add-formula (¬ₘ a) axioms)
+ ( contains-ax-k')
+ ( contains-ax-s')
+ ( a)
+ ( b))
+ ( weak-modal-logic-closure-mp {a = ¬¬ₘ b}
+ ( weak-modal-logic-closure-ax
+ ( contains-ax-dn'' (¬¬ₘ b →ₘ b) (b , refl)))
+ ( weak-modal-logic-closure-mp {a = ⊥ₘ}
+ ( weak-modal-logic-closure-ax
+ ( contains-ax-k'' (⊥ₘ →ₘ ¬ₘ b →ₘ ⊥ₘ) (⊥ₘ , ¬ₘ b , refl)))
+ ( weak-modal-logic-closure-mp {a = a}
+ ( weak-modal-logic-closure-ax
+ ( subset-add-formula a
+ ( theory-add-formula (¬ₘ a) axioms)
+ ( ¬ₘ a)
+ ( formula-in-add-formula (¬ₘ a) axioms)))
+ ( weak-modal-logic-closure-ax
+ ( formula-in-add-formula a
+ ( theory-add-formula (¬ₘ a) axioms)))))))
+ where
+ contains-ax-k' : ax-k i ⊆ theory-add-formula (¬ₘ a) axioms
+ contains-ax-k' =
+ transitive-subset-add-formula (¬ₘ a) axioms (ax-k i) contains-ax-k
+
+ contains-ax-s' : ax-s i ⊆ theory-add-formula (¬ₘ a) axioms
+ contains-ax-s' =
+ transitive-subset-add-formula (¬ₘ a) axioms (ax-s i) contains-ax-s
+
+ contains-ax-k'' :
+ ax-k i ⊆ theory-add-formula a (theory-add-formula (¬ₘ a) axioms)
+ contains-ax-k'' =
+ transitive-subset-add-formula a (theory-add-formula (¬ₘ a) axioms)
+ ( ax-k i)
+ ( contains-ax-k')
+
+ contains-ax-dn'' :
+ ax-dn i ⊆ theory-add-formula a (theory-add-formula (¬ₘ a) axioms)
+ contains-ax-dn'' =
+ transitive-subset-add-formula a
+ ( theory-add-formula (¬ₘ a) axioms)
+ ( ax-dn i)
+ ( transitive-subset-add-formula (¬ₘ a) axioms (ax-dn i) contains-ax-dn)
+
+ logic-ex-falso :
+ (a b : modal-formula i) →
+ is-in-subtype (weak-modal-logic-closure axioms) a →
+ is-in-subtype (weak-modal-logic-closure axioms) (¬ₘ a) →
+ is-in-subtype (weak-modal-logic-closure axioms) b
+ logic-ex-falso a b a-in-logic not-a-in-logic =
+ weak-modal-logic-closure-mp
+ ( weak-modal-logic-closure-mp
+ ( deduction-ex-falso a b)
+ ( not-a-in-logic))
+ ( a-in-logic)
+module _
+ {l1 l2 : Level} {i : Set l1} (axioms : modal-theory l2 i)
+ (contains-ax-k : ax-k i ⊆ axioms)
+ (contains-ax-s : ax-s i ⊆ axioms)
+ (contains-ax-dn : ax-dn i ⊆ axioms)
+ where
+
+ inv-deduction-ex-falso :
+ (a b : modal-formula i) →
+ is-in-subtype (weak-modal-logic-closure axioms) (a →ₘ ¬ₘ a →ₘ b)
+ inv-deduction-ex-falso a b =
+ forward-implication
+ ( deduction-theorem axioms contains-ax-k contains-ax-s a (¬ₘ a →ₘ b))
+ ( forward-implication
+ ( deduction-theorem
+ ( theory-add-formula a axioms)
+ ( contains-ax-k')
+ ( contains-ax-s')
+ ( ¬ₘ a)
+ ( b))
+ ( logic-ex-falso
+ ( theory-add-formula (a →ₘ ⊥ₘ) (theory-add-formula a axioms))
+ ( contains-ax-k'')
+ ( contains-ax-s'')
+ ( contains-ax-dn'')
+ ( a)
+ ( b)
+ ( weak-modal-logic-closure-ax
+ ( subset-add-formula (¬ₘ a) (theory-add-formula a axioms) a
+ ( formula-in-add-formula a axioms)))
+ ( weak-modal-logic-closure-ax
+ ( formula-in-add-formula (¬ₘ a) (theory-add-formula a axioms)))))
+ where
+ contains-ax-k' : ax-k i ⊆ theory-add-formula a axioms
+ contains-ax-k' =
+ transitive-subset-add-formula a axioms (ax-k i) contains-ax-k
+
+ contains-ax-s' : ax-s i ⊆ theory-add-formula a axioms
+ contains-ax-s' =
+ transitive-subset-add-formula a axioms (ax-s i) contains-ax-s
+
+ contains-ax-k'' :
+ ax-k i ⊆ theory-add-formula (¬ₘ a) (theory-add-formula a axioms)
+ contains-ax-k'' =
+ transitive-subset-add-formula (¬ₘ a) (theory-add-formula a axioms)
+ ( ax-k i)
+ ( contains-ax-k')
+
+ contains-ax-s'' :
+ ax-s i ⊆ theory-add-formula (¬ₘ a) (theory-add-formula a axioms)
+ contains-ax-s'' =
+ transitive-subset-add-formula (¬ₘ a) (theory-add-formula a axioms)
+ ( ax-s i)
+ ( contains-ax-s')
+
+ contains-ax-dn'' :
+ ax-dn i ⊆ theory-add-formula (¬ₘ a) (theory-add-formula a axioms)
+ contains-ax-dn'' =
+ transitive-subset-add-formula (¬ₘ a)
+ ( theory-add-formula a axioms)
+ ( ax-dn i)
+ ( transitive-subset-add-formula a axioms (ax-dn i) contains-ax-dn)
+```
diff --git a/src/order-theory.lagda.md b/src/order-theory.lagda.md
index 1ce9b78699..128c153630 100644
--- a/src/order-theory.lagda.md
+++ b/src/order-theory.lagda.md
@@ -75,6 +75,7 @@ open import order-theory.lower-sets-large-posets public
open import order-theory.lower-types-preorders public
open import order-theory.maximal-chains-posets public
open import order-theory.maximal-chains-preorders public
+open import order-theory.maximal-elements-posets public
open import order-theory.meet-semilattices public
open import order-theory.meet-suplattices public
open import order-theory.nuclei-large-locales public
@@ -100,15 +101,18 @@ open import order-theory.similarity-of-order-preserving-maps-large-posets public
open import order-theory.similarity-of-order-preserving-maps-large-preorders public
open import order-theory.subposets public
open import order-theory.subpreorders public
+open import order-theory.subtypes-leq-posets public
open import order-theory.suplattices public
open import order-theory.top-elements-large-posets public
open import order-theory.top-elements-posets public
open import order-theory.top-elements-preorders public
open import order-theory.total-orders public
open import order-theory.total-preorders public
+open import order-theory.upper-bounds-chains-posets public
open import order-theory.upper-bounds-large-posets public
open import order-theory.upper-bounds-posets public
open import order-theory.upper-sets-large-posets public
open import order-theory.well-founded-orders public
open import order-theory.well-founded-relations public
+open import order-theory.zorn public
```
diff --git a/src/order-theory/chains-posets.lagda.md b/src/order-theory/chains-posets.lagda.md
index 609bdfb03e..c3eaf21e1b 100644
--- a/src/order-theory/chains-posets.lagda.md
+++ b/src/order-theory/chains-posets.lagda.md
@@ -7,7 +7,11 @@ module order-theory.chains-posets where
Imports
```agda
+open import foundation.dependent-pair-types
+open import foundation.existential-quantification
+open import foundation.function-types
open import foundation.propositions
+open import foundation.subtypes
open import foundation.universe-levels
open import order-theory.chains-preorders
@@ -53,9 +57,18 @@ module _
sub-preorder-chain-Poset =
sub-preorder-chain-Preorder (preorder-Poset X) C
+ is-chain-Subposet-chain-Poset :
+ is-chain-Subposet X sub-preorder-chain-Poset
+ is-chain-Subposet-chain-Poset =
+ is-chain-Subpreorder-chain-Preorder (preorder-Poset X) C
+
type-chain-Poset : UU (l1 ⊔ l3)
type-chain-Poset = type-chain-Preorder (preorder-Poset X) C
+ type-Poset-type-chain-Poset : type-chain-Poset → type-Poset X
+ type-Poset-type-chain-Poset =
+ type-Preorder-type-chain-Preorder (preorder-Poset X) C
+
module _
{l1 l2 : Level} (X : Poset l1 l2)
where
diff --git a/src/order-theory/chains-preorders.lagda.md b/src/order-theory/chains-preorders.lagda.md
index edcc516f32..c53a1bb8f1 100644
--- a/src/order-theory/chains-preorders.lagda.md
+++ b/src/order-theory/chains-preorders.lagda.md
@@ -58,9 +58,17 @@ module _
sub-preorder-chain-Preorder : type-Preorder X → Prop l3
sub-preorder-chain-Preorder = pr1 C
+ is-chain-Subpreorder-chain-Preorder :
+ is-chain-Subpreorder X sub-preorder-chain-Preorder
+ is-chain-Subpreorder-chain-Preorder = pr2 C
+
type-chain-Preorder : UU (l1 ⊔ l3)
type-chain-Preorder = type-subtype sub-preorder-chain-Preorder
+ type-Preorder-type-chain-Preorder : type-chain-Preorder → type-Preorder X
+ type-Preorder-type-chain-Preorder =
+ inclusion-subtype sub-preorder-chain-Preorder
+
module _
{l1 l2 : Level} (X : Preorder l1 l2)
where
diff --git a/src/order-theory/maximal-elements-posets.lagda.md b/src/order-theory/maximal-elements-posets.lagda.md
new file mode 100644
index 0000000000..b807d310ab
--- /dev/null
+++ b/src/order-theory/maximal-elements-posets.lagda.md
@@ -0,0 +1,46 @@
+# Maximal elements in posets
+
+```agda
+module order-theory.maximal-elements-posets where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.universe-levels
+
+open import foundation-core.identity-types
+open import foundation-core.propositions
+
+open import order-theory.posets
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 l2 : Level} (X : Poset l1 l2)
+ where
+
+ is-maximal-element-Poset-Prop : type-Poset X → Prop (l1 ⊔ l2)
+ is-maximal-element-Poset-Prop x =
+ Π-Prop
+ ( type-Poset X)
+ ( λ y →
+ ( function-Prop (leq-Poset X x y) (y = x , is-set-type-Poset X y x)))
+
+ is-maximal-element-Poset : type-Poset X → UU (l1 ⊔ l2)
+ is-maximal-element-Poset x = type-Prop (is-maximal-element-Poset-Prop x)
+
+ is-prop-is-maximal-element-Poset :
+ (x : type-Poset X) → is-prop (is-maximal-element-Poset x)
+ is-prop-is-maximal-element-Poset x =
+ is-prop-type-Prop (is-maximal-element-Poset-Prop x)
+```
diff --git a/src/order-theory/subtypes-leq-posets.lagda.md b/src/order-theory/subtypes-leq-posets.lagda.md
new file mode 100644
index 0000000000..9a96cc9b6b
--- /dev/null
+++ b/src/order-theory/subtypes-leq-posets.lagda.md
@@ -0,0 +1,40 @@
+# Subtypes leq Posets
+
+```agda
+module order-theory.subtypes-leq-posets where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.subtypes
+open import foundation.universe-levels
+
+open import order-theory.posets
+open import order-theory.preorders
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ {l1 : Level} (l2 : Level) (A : UU l1)
+ where
+
+ subtypes-leq-Preorder : Preorder (l1 ⊔ lsuc l2) (l1 ⊔ l2)
+ pr1 subtypes-leq-Preorder = subtype l2 A
+ pr1 (pr2 subtypes-leq-Preorder) = leq-prop-subtype
+ pr1 (pr2 (pr2 subtypes-leq-Preorder)) = refl-leq-subtype
+ pr2 (pr2 (pr2 subtypes-leq-Preorder)) = transitive-leq-subtype
+
+ subtypes-leq-Poset : Poset (l1 ⊔ lsuc l2) (l1 ⊔ l2)
+ pr1 subtypes-leq-Poset = subtypes-leq-Preorder
+ pr2 subtypes-leq-Poset = antisymmetric-leq-subtype
+```
diff --git a/src/order-theory/upper-bounds-chains-posets.lagda.md b/src/order-theory/upper-bounds-chains-posets.lagda.md
new file mode 100644
index 0000000000..aba3dbbe68
--- /dev/null
+++ b/src/order-theory/upper-bounds-chains-posets.lagda.md
@@ -0,0 +1,48 @@
+# Upper bounds of chains in posets
+
+```agda
+module order-theory.upper-bounds-chains-posets where
+```
+
+Imports
+
+```agda
+open import foundation.existential-quantification
+open import foundation.universe-levels
+
+open import foundation-core.function-types
+open import foundation-core.propositions
+
+open import order-theory.chains-posets
+open import order-theory.posets
+open import order-theory.upper-bounds-posets
+```
+
+
+
+## Idea
+
+An **upper bound** of a chain `C` in a poset `P` is an element `x` such that for
+every element `y` in `C`, `y ≤ x` holds.
+
+## Definition
+
+```agda
+module _
+ {l1 l2 l3 : Level} (X : Poset l1 l2) (C : chain-Poset l3 X)
+ where
+
+ is-chain-upper-bound-Prop : type-Poset X → Prop (l1 ⊔ l2 ⊔ l3)
+ is-chain-upper-bound-Prop =
+ is-upper-bound-family-of-elements-Poset-Prop X
+ ( type-Poset-type-chain-Poset X C)
+
+ is-chain-upper-bound : type-Poset X → UU (l1 ⊔ l2 ⊔ l3)
+ is-chain-upper-bound = type-Prop ∘ is-chain-upper-bound-Prop
+
+ has-chain-upper-bound-Prop : Prop (l1 ⊔ l2 ⊔ l3)
+ has-chain-upper-bound-Prop = ∃ (type-Poset X) is-chain-upper-bound-Prop
+
+ has-chain-upper-bound : UU (l1 ⊔ l2 ⊔ l3)
+ has-chain-upper-bound = type-Prop has-chain-upper-bound-Prop
+```
diff --git a/src/order-theory/zorn.lagda.md b/src/order-theory/zorn.lagda.md
new file mode 100644
index 0000000000..ecc4021460
--- /dev/null
+++ b/src/order-theory/zorn.lagda.md
@@ -0,0 +1,103 @@
+# Zorn's lemma
+
+```agda
+module order-theory.zorn where
+```
+
+Imports
+
+```agda
+open import foundation.dependent-pair-types
+open import foundation.empty-types
+open import foundation.existential-quantification
+open import foundation.inhabited-types
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
+open import foundation.propositional-truncations
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+open import foundation-core.propositions
+
+open import order-theory.chains-posets
+open import order-theory.maximal-elements-posets
+open import order-theory.posets
+open import order-theory.upper-bounds-chains-posets
+```
+
+
+
+## Idea
+
+TODO
+
+## Definition
+
+```agda
+module _
+ (l1 l2 l3 : Level)
+ where
+
+ Zorn-Prop : Prop (lsuc l1 ⊔ lsuc l2 ⊔ lsuc l3)
+ Zorn-Prop =
+ Π-Prop
+ ( Poset l1 l2)
+ ( λ X →
+ ( function-Prop
+ ( (C : chain-Poset l3 X) → has-chain-upper-bound X C)
+ ( ∃ (type-Poset X) (is-maximal-element-Poset-Prop X))))
+
+ Zorn : UU (lsuc l1 ⊔ lsuc l2 ⊔ lsuc l3)
+ Zorn = type-Prop Zorn-Prop
+
+ Zorn-non-empty-Prop : Prop (lsuc l1 ⊔ lsuc l2 ⊔ lsuc l3)
+ Zorn-non-empty-Prop =
+ Π-Prop
+ ( Poset l1 l2)
+ ( λ X →
+ ( function-Prop
+ ( is-inhabited (type-Poset X))
+ ( function-Prop
+ ( (C : chain-Poset l3 X) →
+ is-inhabited (type-chain-Poset X C) →
+ has-chain-upper-bound X C)
+ ( ∃ (type-Poset X) (is-maximal-element-Poset-Prop X)))))
+
+ Zorn-non-empty : UU (lsuc l1 ⊔ lsuc l2 ⊔ lsuc l3)
+ Zorn-non-empty = type-Prop Zorn-non-empty-Prop
+
+ Zorn-Zorn-non-empty : Zorn-non-empty → Zorn
+ Zorn-Zorn-non-empty zorn X H =
+ zorn X
+ ( apply-universal-property-trunc-Prop
+ ( H
+ ( pair
+ ( λ _ → raise-empty-Prop l3)
+ ( λ (_ , f) → raise-ex-falso l3 f)))
+ ( is-inhabited-Prop (type-Poset X))
+ ( λ (x , _) → unit-trunc-Prop x))
+ ( λ C _ → H C)
+
+ module _
+ (lem : LEM (l1 ⊔ l3))
+ where
+
+ Zorn-non-empty-Zorn : Zorn → Zorn-non-empty
+ Zorn-non-empty-Zorn zorn X is-inhabited-X H = zorn X chain-upper-bound
+ where
+ chain-upper-bound : (C : chain-Poset l3 X) → has-chain-upper-bound X C
+ chain-upper-bound C with lem (is-inhabited-Prop (type-chain-Poset X C))
+ ... | inl is-inhabited-C = H C is-inhabited-C
+ ... | inr is-empty-C =
+ apply-universal-property-trunc-Prop
+ ( is-inhabited-X)
+ ( has-chain-upper-bound-Prop X C)
+ ( λ x →
+ ( intro-exists x
+ ( λ (y , y-in-C) →
+ ( ex-falso (is-empty-C (intro-exists y y-in-C))))))
+
+ iff-Zorn-non-empty-Zorn : type-iff-Prop Zorn-non-empty-Prop Zorn-Prop
+ pr1 (iff-Zorn-non-empty-Zorn) = Zorn-Zorn-non-empty
+ pr2 (iff-Zorn-non-empty-Zorn) = Zorn-non-empty-Zorn
+```
diff --git a/src/univalent-combinatorics.lagda.md b/src/univalent-combinatorics.lagda.md
index 0cbecf9212..08dc38f9f3 100644
--- a/src/univalent-combinatorics.lagda.md
+++ b/src/univalent-combinatorics.lagda.md
@@ -98,6 +98,7 @@ open import univalent-combinatorics.standard-finite-trees public
open import univalent-combinatorics.standard-finite-types public
open import univalent-combinatorics.steiner-systems public
open import univalent-combinatorics.steiner-triple-systems public
+open import univalent-combinatorics.subfinite-types public
open import univalent-combinatorics.sums-of-natural-numbers public
open import univalent-combinatorics.surjective-maps public
open import univalent-combinatorics.symmetric-difference public
diff --git a/src/univalent-combinatorics/kuratowsky-finite-sets.lagda.md b/src/univalent-combinatorics/kuratowsky-finite-sets.lagda.md
index adc3eb2069..c89b708ef4 100644
--- a/src/univalent-combinatorics/kuratowsky-finite-sets.lagda.md
+++ b/src/univalent-combinatorics/kuratowsky-finite-sets.lagda.md
@@ -12,12 +12,25 @@ open import elementary-number-theory.natural-numbers
open import foundation.decidable-equality
open import foundation.dependent-pair-types
open import foundation.existential-quantification
+open import foundation.functoriality-propositional-truncation
+open import foundation.law-of-excluded-middle
+open import foundation.logical-equivalences
open import foundation.propositional-truncations
open import foundation.propositions
open import foundation.sets
+open import foundation.subtypes
open import foundation.surjective-maps
open import foundation.universe-levels
+open import foundation-core.equivalences
+open import foundation-core.function-types
+open import foundation-core.identity-types
+open import foundation-core.transport-along-identifications
+
+open import lists.functoriality-lists
+open import lists.lists
+open import lists.lists-subtypes
+
open import univalent-combinatorics.equality-finite-types
open import univalent-combinatorics.finite-types
open import univalent-combinatorics.image-of-maps
@@ -63,6 +76,78 @@ module _
is-kuratowsky-finite-set-𝔽-Kuratowsky = pr2 X
```
+## Second definition
+
+```agda
+is-kuratowsky-finite-set-list-Prop : {l : Level} → Set l → Prop l
+is-kuratowsky-finite-set-list-Prop X =
+ exists-structure-Prop (list (type-Set X))
+ ( λ l → (x : type-Set X) → is-in-subtype (list-subtype l) x)
+
+is-kuratowsky-finite-set-list : {l : Level} → Set l → UU l
+is-kuratowsky-finite-set-list X =
+ type-Prop (is-kuratowsky-finite-set-list-Prop X)
+
+is-kuratowsky-finite-set-is-kuratowsky-finite-set-list :
+ {l : Level} (X : Set l) →
+ is-kuratowsky-finite-set-list X → is-kuratowsky-finite-set X
+is-kuratowsky-finite-set-is-kuratowsky-finite-set-list X =
+ elim-exists
+ ( is-kuratowsky-finite-set-Prop X)
+ ( λ l all-list-subtype →
+ intro-exists (length-list l)
+ ( pair
+ ( component-list l)
+ ( λ x →
+ map-trunc-Prop
+ ( λ in-list →
+ pair
+ ( index-in-list x l in-list)
+ ( inv (eq-component-list-index-in-list x l in-list)))
+ ( all-list-subtype x))))
+
+-- TODO: prove another implication
+```
+
+### Kuratowky finite subsets
+
+```agda
+is-kuratowsky-finite-subset :
+ {l1 l2 : Level} (A : Set l1) (B : subtype l2 (type-Set A))
+ (l : list (type-Set A)) →
+ equiv-subtypes B (list-subtype l) →
+ is-kuratowsky-finite-set (set-subset A B)
+is-kuratowsky-finite-subset A B l e =
+ is-kuratowsky-finite-set-is-kuratowsky-finite-set-list
+ ( set-subset A B)
+ ( intro-exists l'
+ ( λ (a , in-B) →
+ map-trunc-Prop
+ ( λ a-in-l →
+ tr
+ ( λ i → (a , i) ∈-list l')
+ ( eq-is-prop (is-prop-type-Prop (B a)))
+ ( in-dependent-map-list _ a-in-l))
+ ( map-equiv (e a) in-B)))
+ where
+ l' : list (type-subtype B)
+ l' =
+ dependent-map-list l
+ ( λ a in-list →
+ a , map-section-map-equiv (e a) (in-list-subtype-in-list in-list))
+```
+
+### List subtype is Kuratowky finite
+
+```agda
+is-kuratowski-finite-list-subtype :
+ {l1 : Level} (A : Set l1) (l : list (type-Set A)) →
+ is-kuratowsky-finite-set (set-subset A (list-subtype l))
+is-kuratowski-finite-list-subtype A l =
+ is-kuratowsky-finite-subset A (list-subtype l) l
+ ( id-equiv-subtypes (list-subtype l))
+```
+
## Properties
### A Kuratowsky finite set is finite if and only if it has decidable equality
@@ -85,3 +170,54 @@ has-decidable-equality-is-finite-type-𝔽-Kuratowsky :
has-decidable-equality-is-finite-type-𝔽-Kuratowsky X H =
has-decidable-equality-is-finite H
```
+
+### Kuratowsky finite sets are closed under surjections
+
+```agda
+is-kuratowsky-finite-set-surjection :
+ {l1 l2 : Level} (X : Set l1) (Y : Set l2) →
+ type-Set X ↠ type-Set Y →
+ is-kuratowsky-finite-set X →
+ is-kuratowsky-finite-set Y
+is-kuratowsky-finite-set-surjection X Y f =
+ elim-exists
+ ( is-kuratowsky-finite-set-Prop Y)
+ ( λ n g → intro-exists n (surjection-comp f g))
+```
+
+### Any finite set is Kuratowsky finite
+
+```agda
+is-kuratowsky-finite-set-is-finite :
+ {l : Level} (X : Set l) →
+ is-finite (type-Set X) →
+ is-kuratowsky-finite-set X
+is-kuratowsky-finite-set-is-finite X =
+ elim-exists
+ ( is-kuratowsky-finite-set-Prop X)
+ ( λ n e → intro-exists n (map-equiv e , is-surjective-map-equiv e))
+```
+
+### Classical facts
+
+```agda
+is-finite-is-kuratowsky-finite-set :
+ {l : Level} (X : Set l) →
+ LEM l →
+ is-kuratowsky-finite-set X → is-finite (type-Set X)
+is-finite-is-kuratowsky-finite-set X lem is-fin =
+ is-finite-has-decidable-equality-type-𝔽-Kuratowsky
+ ( X , is-fin)
+ ( λ x y → lem (Id-Prop X x y))
+
+is-finite-surjection :
+ {l1 l2 : Level} (X : Set l1) (Y : Set l2) →
+ LEM l2 →
+ type-Set X ↠ type-Set Y →
+ is-finite (type-Set X) →
+ is-finite (type-Set Y)
+is-finite-surjection X Y lem f is-fin =
+ is-finite-is-kuratowsky-finite-set Y lem
+ ( is-kuratowsky-finite-set-surjection X Y f
+ ( is-kuratowsky-finite-set-is-finite X is-fin))
+```
diff --git a/src/univalent-combinatorics/subfinite-types.lagda.md b/src/univalent-combinatorics/subfinite-types.lagda.md
new file mode 100644
index 0000000000..bc071e76fd
--- /dev/null
+++ b/src/univalent-combinatorics/subfinite-types.lagda.md
@@ -0,0 +1,120 @@
+# Subfinite types
+
+```agda
+module univalent-combinatorics.subfinite-types where
+```
+
+Imports
+
+```agda
+open import elementary-number-theory.natural-numbers
+
+open import foundation.dependent-pair-types
+open import foundation.existential-quantification
+open import foundation.inhabited-types
+open import foundation.injective-maps
+open import foundation.law-of-excluded-middle
+open import foundation.propositional-truncations
+open import foundation.sets
+open import foundation.universe-levels
+
+open import foundation-core.coproduct-types
+open import foundation-core.equivalences
+open import foundation-core.function-types
+open import foundation-core.propositions
+
+open import univalent-combinatorics.finite-types
+open import univalent-combinatorics.kuratowsky-finite-sets
+open import univalent-combinatorics.standard-finite-types
+```
+
+
+
+## Idea
+
+A subfinite type is a set `X` for which there exists an injection into `X` from
+a standard finite type. In other words, the subfinite types are the subset of a
+standard finite type.
+
+## Definition
+
+```agda
+is-subfinite-Prop : {l : Level} → UU l → Prop l
+is-subfinite-Prop X =
+ exists-structure-Prop ℕ (λ n → injection X (Fin n))
+
+is-subfinite : {l : Level} → UU l → UU l
+is-subfinite X = type-Prop (is-subfinite-Prop X)
+```
+
+### Subfinite types are sets
+
+```agda
+is-set-is-subfinite : {l : Level} {X : UU l} → is-subfinite X → is-set X
+is-set-is-subfinite {X = X} =
+ elim-exists
+ ( is-set-Prop X)
+ ( λ n (f , is-inj) → is-set-is-injective (is-set-Fin n) is-inj)
+
+Set-is-subfinite : {l : Level} {X : UU l} → is-subfinite X → Set l
+Set-is-subfinite {X = X} is-sub = X , is-set-is-subfinite is-sub
+```
+
+### Subfinite sets are closed under injections
+
+```agda
+is-subfinite-injection :
+ {l1 l2 : Level} {X : UU l1} {Y : UU l2} →
+ injection X Y →
+ is-subfinite Y →
+ is-subfinite X
+is-subfinite-injection {X = X} f =
+ elim-exists
+ ( is-subfinite-Prop X)
+ ( λ n g → intro-exists n (injection-comp f g))
+```
+
+### Any finite set is subfinite
+
+```agda
+is-subfinite-is-finite : {l : Level} {X : UU l} → is-finite X → is-subfinite X
+is-subfinite-is-finite {X = X} =
+ elim-exists
+ ( is-subfinite-Prop X)
+ ( λ n e →
+ intro-exists n
+ ( map-inv-equiv e , λ {_} {_} → is-injective-map-inv-equiv e))
+```
+
+### Classical facts
+
+```agda
+is-finite-is-subfinite :
+ {l : Level} {X : UU l} → LEM l → is-subfinite X → is-finite X
+is-finite-is-subfinite {X = X} lem is-sub with lem (is-inhabited-Prop X)
+... | inl is-inh =
+ elim-exists
+ ( is-finite-Prop X)
+ ( λ n (f , is-inj) →
+ ( apply-universal-property-trunc-Prop
+ ( is-inhabited-inv-surjections f is-inj
+ ( apply-LEM lem ∘ is-prop-map-is-injective (is-set-Fin n) is-inj)
+ ( is-inh))
+ ( is-finite-Prop X)
+ ( λ g →
+ is-finite-is-kuratowsky-finite-set
+ ( Set-is-subfinite is-sub)
+ ( lem)
+ ( intro-exists n g))))
+ ( is-sub)
+... | inr not-inh = is-finite-is-empty (not-inh ∘ unit-trunc-Prop)
+
+is-finite-injection :
+ {l1 l2 : Level} {X : UU l1} {Y : UU l2} →
+ LEM l1 →
+ injection X Y →
+ is-finite Y →
+ is-finite X
+is-finite-injection lem f =
+ is-finite-is-subfinite lem ∘ is-subfinite-injection f ∘ is-subfinite-is-finite
+```