/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson

! This file was ported from Lean 3 source module model_theory.satisfiability
! leanprover-community/mathlib commit d565b3df44619c1498326936be16f1a935df0728
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.ModelTheory.Ultraproducts
import Mathbin.ModelTheory.Bundled
import Mathbin.ModelTheory.Skolem

/-!
# First-Order Satisfiability
This file deals with the satisfiability of first-order theories, as well as equivalence over them.

## Main Definitions
* `first_order.language.Theory.is_satisfiable`: `T.is_satisfiable` indicates that `T` has a nonempty
model.
* `first_order.language.Theory.is_finitely_satisfiable`: `T.is_finitely_satisfiable` indicates that
every finite subset of `T` is satisfiable.
* `first_order.language.Theory.is_complete`: `T.is_complete` indicates that `T` is satisfiable and
models each sentence or its negation.
* `first_order.language.Theory.semantically_equivalent`: `T.semantically_equivalent φ ψ` indicates
that `φ` and `ψ` are equivalent formulas or sentences in models of `T`.
* `cardinal.categorical`: A theory is `κ`-categorical if all models of size `κ` are isomorphic.

## Main Results
* The Compactness Theorem, `first_order.language.Theory.is_satisfiable_iff_is_finitely_satisfiable`,
shows that a theory is satisfiable iff it is finitely satisfiable.
* `first_order.language.complete_theory.is_complete`: The complete theory of a structure is
complete.
* `first_order.language.Theory.exists_large_model_of_infinite_model` shows that any theory with an
infinite model has arbitrarily large models.
* `first_order.language.Theory.exists_elementary_embedding_card_eq`: The Upward Löwenheim–Skolem
Theorem: If `κ` is a cardinal greater than the cardinalities of `L` and an infinite `L`-structure
`M`, then `M` has an elementary extension of cardinality `κ`.

## Implementation Details
* Satisfiability of an `L.Theory` `T` is defined in the minimal universe containing all the symbols
of `L`. By Löwenheim-Skolem, this is equivalent to satisfiability in any universe.

-/

universe u v w w'

open Cardinal CategoryTheory

open Cardinal FirstOrder

namespace FirstOrder

namespace Language

variable {L : Language.{u, v}} {T : L.Theory} {α : Type w} {n : ℕ}

namespace Theory

variable (T)

/-- A theory is satisfiable if a structure models it. -/
def IsSatisfiable : Prop :=
  Nonempty (ModelCat.{u, v, max u v} T)
#align first_order.language.Theory.is_satisfiable FirstOrder.Language.Theory.IsSatisfiable

/-- A theory is finitely satisfiable if all of its finite subtheories are satisfiable. -/
def IsFinitelySatisfiable : Prop :=
  ∀ T0 : Finset L.Sentence, (T0 : L.Theory) ⊆ T → (T0 : L.Theory).IsSatisfiable
#align first_order.language.Theory.is_finitely_satisfiable FirstOrder.Language.Theory.IsFinitelySatisfiable

variable {T} {T' : L.Theory}

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem Model.isSatisfiable (M : Type w) [n : Nonempty M] [S : L.Structure M] [M ⊨ T] :
    T.IsSatisfiable :=
  ⟨((⊥ : Substructure _ (ModelCat.of T M)).elementarySkolem₁Reduct.toModel T).Shrink⟩
#align first_order.language.Theory.model.is_satisfiable FirstOrder.Language.Theory.Model.isSatisfiable

theorem IsSatisfiable.mono (h : T'.IsSatisfiable) (hs : T ⊆ T') : T.IsSatisfiable :=
  ⟨(Theory.Model.mono (ModelCat.is_model h.some) hs).Bundled⟩
#align first_order.language.Theory.is_satisfiable.mono FirstOrder.Language.Theory.IsSatisfiable.mono

theorem isSatisfiable_empty (L : Language.{u, v}) : IsSatisfiable (∅ : L.Theory) :=
  ⟨default⟩
#align first_order.language.Theory.is_satisfiable_empty FirstOrder.Language.Theory.isSatisfiable_empty

theorem isSatisfiable_of_isSatisfiable_onTheory {L' : Language.{w, w'}} (φ : L →ᴸ L')
    (h : (φ.onTheory T).IsSatisfiable) : T.IsSatisfiable :=
  Model.isSatisfiable (h.some.reduct φ)
#align first_order.language.Theory.is_satisfiable_of_is_satisfiable_on_Theory FirstOrder.Language.Theory.isSatisfiable_of_isSatisfiable_onTheory

theorem isSatisfiable_onTheory_iff {L' : Language.{w, w'}} {φ : L →ᴸ L'} (h : φ.Injective) :
    (φ.onTheory T).IsSatisfiable ↔ T.IsSatisfiable := by
  classical
    refine' ⟨is_satisfiable_of_is_satisfiable_on_Theory φ, fun h' => _⟩
    haveI : Inhabited h'.some := Classical.inhabited_of_nonempty'
    exact model.is_satisfiable (h'.some.default_expansion h)
#align first_order.language.Theory.is_satisfiable_on_Theory_iff FirstOrder.Language.Theory.isSatisfiable_onTheory_iff

theorem IsSatisfiable.isFinitelySatisfiable (h : T.IsSatisfiable) : T.IsFinitelySatisfiable :=
  fun _ => h.mono
#align first_order.language.Theory.is_satisfiable.is_finitely_satisfiable FirstOrder.Language.Theory.IsSatisfiable.isFinitelySatisfiable

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The Compactness Theorem of first-order logic: A theory is satisfiable if and only if it is
finitely satisfiable. -/
theorem isSatisfiable_iff_isFinitelySatisfiable {T : L.Theory} :
    T.IsSatisfiable ↔ T.IsFinitelySatisfiable :=
  ⟨Theory.IsSatisfiable.isFinitelySatisfiable, fun h => by
    classical
      set M : ∀ T0 : Finset T, Type max u v := fun T0 =>
        (h (T0.map (Function.Embedding.subtype fun x => x ∈ T)) T0.map_subtype_subset).some with hM
      let M' := Filter.Product (↑(Ultrafilter.of (Filter.atTop : Filter (Finset T)))) M
      have h' : M' ⊨ T := by
        refine' ⟨fun φ hφ => _⟩
        rw [ultraproduct.sentence_realize]
        refine'
          Filter.Eventually.filter_mono (Ultrafilter.of_le _)
            (Filter.eventually_atTop.2
              ⟨{⟨φ, hφ⟩}, fun s h' =>
                Theory.realize_sentence_of_mem (s.map (Function.Embedding.subtype fun x => x ∈ T))
                  _⟩)
        simp only [Finset.coe_map, Function.Embedding.coe_subtype, Set.mem_image, Finset.mem_coe,
          Subtype.exists, Subtype.coe_mk, exists_and_right, exists_eq_right]
        exact ⟨hφ, h' (Finset.mem_singleton_self _)⟩
      exact ⟨Model.of T M'⟩⟩
#align first_order.language.Theory.is_satisfiable_iff_is_finitely_satisfiable FirstOrder.Language.Theory.isSatisfiable_iff_isFinitelySatisfiable

theorem isSatisfiable_directed_union_iff {ι : Type _} [Nonempty ι] {T : ι → L.Theory}
    (h : Directed (· ⊆ ·) T) : Theory.IsSatisfiable (⋃ i, T i) ↔ ∀ i, (T i).IsSatisfiable :=
  by
  refine' ⟨fun h' i => h'.mono (Set.subset_unionᵢ _ _), fun h' => _⟩
  rw [is_satisfiable_iff_is_finitely_satisfiable, is_finitely_satisfiable]
  intro T0 hT0
  obtain ⟨i, hi⟩ := h.exists_mem_subset_of_finset_subset_bUnion hT0
  exact (h' i).mono hi
#align first_order.language.Theory.is_satisfiable_directed_union_iff FirstOrder.Language.Theory.isSatisfiable_directed_union_iff

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem isSatisfiable_union_distinctConstantsTheory_of_card_le (T : L.Theory) (s : Set α)
    (M : Type w') [Nonempty M] [L.Structure M] [M ⊨ T]
    (h : Cardinal.lift.{w'} (#s) ≤ Cardinal.lift.{w} (#M)) :
    ((L.lhomWithConstants α).onTheory T ∪ L.distinctConstantsTheory s).IsSatisfiable :=
  by
  haveI : Inhabited M := Classical.inhabited_of_nonempty inferInstance
  rw [Cardinal.lift_mk_le'] at h
  letI : (constants_on α).Structure M := constants_on.Structure (Function.extend coe h.some default)
  have : M ⊨ (L.Lhom_with_constants α).onTheory T ∪ L.distinct_constants_theory s :=
    by
    refine' ((Lhom.on_Theory_model _ _).2 inferInstance).union _
    rw [model_distinct_constants_theory]
    refine' fun a as b bs ab => _
    rw [← Subtype.coe_mk a as, ← Subtype.coe_mk b bs, ← Subtype.ext_iff]
    exact
      h.some.injective
        ((subtype.coe_injective.extend_apply h.some default ⟨a, as⟩).symm.trans
          (ab.trans (subtype.coe_injective.extend_apply h.some default ⟨b, bs⟩)))
  exact model.is_satisfiable M
#align first_order.language.Theory.is_satisfiable_union_distinct_constants_theory_of_card_le FirstOrder.Language.Theory.isSatisfiable_union_distinctConstantsTheory_of_card_le

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem isSatisfiable_union_distinctConstantsTheory_of_infinite (T : L.Theory) (s : Set α)
    (M : Type w') [L.Structure M] [M ⊨ T] [Infinite M] :
    ((L.lhomWithConstants α).onTheory T ∪ L.distinctConstantsTheory s).IsSatisfiable := by
  classical
    rw [distinct_constants_theory_eq_Union, Set.union_unionᵢ, is_satisfiable_directed_union_iff]
    ·
      exact fun t =>
        is_satisfiable_union_distinct_constants_theory_of_card_le T _ M
          ((lift_le_aleph_0.2 (finset_card_lt_aleph_0 _).le).trans
            (aleph_0_le_lift.2 (aleph_0_le_mk M)))
    · refine' (monotone_const.union (monotone_distinct_constants_theory.comp _)).directed_le
      simp only [Finset.coe_map, Function.Embedding.coe_subtype]
      exact set.monotone_image.comp fun _ _ => Finset.coe_subset.2
#align first_order.language.Theory.is_satisfiable_union_distinct_constants_theory_of_infinite FirstOrder.Language.Theory.isSatisfiable_union_distinctConstantsTheory_of_infinite

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Any theory with an infinite model has arbitrarily large models. -/
theorem exists_large_model_of_infinite_model (T : L.Theory) (κ : Cardinal.{w}) (M : Type w')
    [L.Structure M] [M ⊨ T] [Infinite M] :
    ∃ N : ModelCat.{_, _, max u v w} T, Cardinal.lift.{max u v w} κ ≤ (#N) :=
  by
  obtain ⟨N⟩ :=
    is_satisfiable_union_distinct_constants_theory_of_infinite T (Set.univ : Set κ.out) M
  refine' ⟨(N.is_model.mono (Set.subset_union_left _ _)).Bundled.reduct _, _⟩
  haveI : N ⊨ distinct_constants_theory _ _ := N.is_model.mono (Set.subset_union_right _ _)
  simp only [Model.reduct_carrier, coe_of, Model.carrier_eq_coe]
  refine' trans (lift_le.2 (le_of_eq (Cardinal.mk_out κ).symm)) _
  rw [← mk_univ]
  refine' (card_le_of_model_distinct_constants_theory L Set.univ N).trans (lift_le.1 _)
  rw [lift_lift]
#align first_order.language.Theory.exists_large_model_of_infinite_model FirstOrder.Language.Theory.exists_large_model_of_infinite_model

theorem isSatisfiable_unionᵢ_iff_isSatisfiable_unionᵢ_finset {ι : Type _} (T : ι → L.Theory) :
    IsSatisfiable (⋃ i, T i) ↔ ∀ s : Finset ι, IsSatisfiable (⋃ i ∈ s, T i) := by
  classical
    refine'
      ⟨fun h s => h.mono (Set.unionᵢ_mono fun _ => Set.unionᵢ_subset_iff.2 fun _ => refl _),
        fun h => _⟩
    rw [is_satisfiable_iff_is_finitely_satisfiable]
    intro s hs
    rw [Set.unionᵢ_eq_unionᵢ_finset] at hs
    obtain ⟨t, ht⟩ := Directed.exists_mem_subset_of_finset_subset_bunionᵢ _ hs
    · exact (h t).mono ht
    ·
      exact
        Monotone.directed_le fun t1 t2 h =>
          Set.unionᵢ_mono fun _ => Set.unionᵢ_mono' fun h1 => ⟨h h1, refl _⟩
#align first_order.language.Theory.is_satisfiable_Union_iff_is_satisfiable_Union_finset FirstOrder.Language.Theory.isSatisfiable_unionᵢ_iff_isSatisfiable_unionᵢ_finset

end Theory

variable (L)

/-- A version of The Downward Löwenheim–Skolem theorem where the structure `N` elementarily embeds
into `M`, but is not by type a substructure of `M`, and thus can be chosen to belong to the universe
of the cardinal `κ`.
 -/
theorem exists_elementaryEmbedding_card_eq_of_le (M : Type w') [L.Structure M] [Nonempty M]
    (κ : Cardinal.{w}) (h1 : ℵ₀ ≤ κ) (h2 : lift.{w} L.card ≤ Cardinal.lift.{max u v} κ)
    (h3 : lift.{w'} κ ≤ Cardinal.lift.{w} (#M)) :
    ∃ N : Bundled L.Structure, Nonempty (N ↪ₑ[L] M) ∧ (#N) = κ :=
  by
  obtain ⟨S, _, hS⟩ := exists_elementary_substructure_card_eq L ∅ κ h1 (by simp) h2 h3
  have : Small.{w} S :=
    by
    rw [← lift_inj.{_, w + 1}, lift_lift, lift_lift] at hS
    exact small_iff_lift_mk_lt_univ.2 (lt_of_eq_of_lt hS κ.lift_lt_univ')
  refine'
    ⟨(equivShrink S).bundledInduced L,
      ⟨S.subtype.comp (Equiv.bundledInducedEquiv L _).symm.toElementaryEmbedding⟩,
      lift_inj.1 (trans _ hS)⟩
  simp only [Equiv.bundledInduced_α, lift_mk_shrink']
#align first_order.language.exists_elementary_embedding_card_eq_of_le FirstOrder.Language.exists_elementaryEmbedding_card_eq_of_le

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The Upward Löwenheim–Skolem Theorem: If `κ` is a cardinal greater than the cardinalities of `L`
and an infinite `L`-structure `M`, then `M` has an elementary extension of cardinality `κ`. -/
theorem exists_elementaryEmbedding_card_eq_of_ge (M : Type w') [L.Structure M] [iM : Infinite M]
    (κ : Cardinal.{w}) (h1 : Cardinal.lift.{w} L.card ≤ Cardinal.lift.{max u v} κ)
    (h2 : Cardinal.lift.{w} (#M) ≤ Cardinal.lift.{w'} κ) :
    ∃ N : Bundled L.Structure, Nonempty (M ↪ₑ[L] N) ∧ (#N) = κ :=
  by
  obtain ⟨N0, hN0⟩ := (L.elementary_diagram M).exists_large_model_of_infinite_model κ M
  let f0 := elementary_embedding.of_models_elementary_diagram L M N0
  rw [← lift_le.{max w w', max u v}, lift_lift, lift_lift] at h2
  obtain ⟨N, ⟨NN0⟩, hN⟩ :=
    exists_elementary_embedding_card_eq_of_le (L[[M]]) N0 κ
      (aleph_0_le_lift.1 ((aleph_0_le_lift.2 (aleph_0_le_mk M)).trans h2)) _ (hN0.trans _)
  · letI := (Lhom_with_constants L M).reduct N
    haveI h : N ⊨ L.elementary_diagram M :=
      (NN0.Theory_model_iff (L.elementary_diagram M)).2 inferInstance
    refine' ⟨bundled.of N, ⟨_⟩, hN⟩
    apply elementary_embedding.of_models_elementary_diagram L M N
  · simp only [card_with_constants, lift_add, lift_lift]
    rw [add_comm, add_eq_max (aleph_0_le_lift.2 (infinite_iff.1 iM)), max_le_iff]
    rw [← lift_le.{_, w'}, lift_lift, lift_lift] at h1
    exact ⟨h2, h1⟩
  · rw [← lift_umax', lift_id]
#align first_order.language.exists_elementary_embedding_card_eq_of_ge FirstOrder.Language.exists_elementaryEmbedding_card_eq_of_ge

/-- The Löwenheim–Skolem Theorem: If `κ` is a cardinal greater than the cardinalities of `L`
and an infinite `L`-structure `M`, then there is an elementary embedding in the appropriate
direction between then `M` and a structure of cardinality `κ`. -/
theorem exists_elementaryEmbedding_card_eq (M : Type w') [L.Structure M] [iM : Infinite M]
    (κ : Cardinal.{w}) (h1 : ℵ₀ ≤ κ) (h2 : lift.{w} L.card ≤ Cardinal.lift.{max u v} κ) :
    ∃ N : Bundled L.Structure, (Nonempty (N ↪ₑ[L] M) ∨ Nonempty (M ↪ₑ[L] N)) ∧ (#N) = κ :=
  by
  cases le_or_gt (lift.{w'} κ) (Cardinal.lift.{w} (#M))
  · obtain ⟨N, hN1, hN2⟩ := exists_elementary_embedding_card_eq_of_le L M κ h1 h2 h
    exact ⟨N, Or.inl hN1, hN2⟩
  · obtain ⟨N, hN1, hN2⟩ := exists_elementary_embedding_card_eq_of_ge L M κ h2 (le_of_lt h)
    exact ⟨N, Or.inr hN1, hN2⟩
#align first_order.language.exists_elementary_embedding_card_eq FirstOrder.Language.exists_elementaryEmbedding_card_eq

/-- A consequence of the Löwenheim–Skolem Theorem: If `κ` is a cardinal greater than the
cardinalities of `L` and an infinite `L`-structure `M`, then there is a structure of cardinality `κ`
elementarily equivalent to `M`. -/
theorem exists_elementarilyEquivalent_card_eq (M : Type w') [L.Structure M] [Infinite M]
    (κ : Cardinal.{w}) (h1 : ℵ₀ ≤ κ) (h2 : lift.{w} L.card ≤ Cardinal.lift.{max u v} κ) :
    ∃ N : CategoryTheory.Bundled L.Structure, (M ≅[L] N) ∧ (#N) = κ :=
  by
  obtain ⟨N, NM | MN, hNκ⟩ := exists_elementary_embedding_card_eq L M κ h1 h2
  · exact ⟨N, NM.some.elementarily_equivalent.symm, hNκ⟩
  · exact ⟨N, MN.some.elementarily_equivalent, hNκ⟩
#align first_order.language.exists_elementarily_equivalent_card_eq FirstOrder.Language.exists_elementarilyEquivalent_card_eq

variable {L}

namespace Theory

theorem exists_model_card_eq (h : ∃ M : ModelCat.{u, v, max u v} T, Infinite M) (κ : Cardinal.{w})
    (h1 : ℵ₀ ≤ κ) (h2 : Cardinal.lift.{w} L.card ≤ Cardinal.lift.{max u v} κ) :
    ∃ N : ModelCat.{u, v, w} T, (#N) = κ :=
  by
  cases' h with M MI
  obtain ⟨N, hN, rfl⟩ := exists_elementarily_equivalent_card_eq L M κ h1 h2
  haveI : Nonempty N := hN.nonempty
  exact ⟨hN.Theory_model.bundled, rfl⟩
#align first_order.language.Theory.exists_model_card_eq FirstOrder.Language.Theory.exists_model_card_eq

variable (T)

/-- A theory models a (bounded) formula when any of its nonempty models realizes that formula on all
  inputs.-/
def ModelsBoundedFormula (φ : L.BoundedFormula α n) : Prop :=
  ∀ (M : ModelCat.{u, v, max u v} T) (v : α → M) (xs : Fin n → M), φ.realize v xs
#align first_order.language.Theory.models_bounded_formula FirstOrder.Language.Theory.ModelsBoundedFormula

-- mathport name: models_bounded_formula
infixl:51
  " ⊨ " =>-- input using \|= or \vDash, but not using \models
  ModelsBoundedFormula

variable {T}

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem models_formula_iff {φ : L.Formula α} :
    T ⊨ φ ↔ ∀ (M : ModelCat.{u, v, max u v} T) (v : α → M), φ.realize v :=
  forall_congr' fun M => forall_congr' fun v => Unique.forall_iff
#align first_order.language.Theory.models_formula_iff FirstOrder.Language.Theory.models_formula_iff

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem models_sentence_iff {φ : L.Sentence} : T ⊨ φ ↔ ∀ M : ModelCat.{u, v, max u v} T, M ⊨ φ :=
  models_formula_iff.trans (forall_congr' fun M => Unique.forall_iff)
#align first_order.language.Theory.models_sentence_iff FirstOrder.Language.Theory.models_sentence_iff

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem models_sentence_of_mem {φ : L.Sentence} (h : φ ∈ T) : T ⊨ φ :=
  models_sentence_iff.2 fun _ => realize_sentence_of_mem T h
#align first_order.language.Theory.models_sentence_of_mem FirstOrder.Language.Theory.models_sentence_of_mem

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem models_iff_not_satisfiable (φ : L.Sentence) : T ⊨ φ ↔ ¬IsSatisfiable (T ∪ {φ.Not}) :=
  by
  rw [models_sentence_iff, is_satisfiable]
  refine'
    ⟨fun h1 h2 =>
      (sentence.realize_not _).1
        (realize_sentence_of_mem (T ∪ {formula.not φ})
          (Set.subset_union_right _ _ (Set.mem_singleton _)))
        (h1 (h2.some.subtheory_Model (Set.subset_union_left _ _))),
      fun h M => _⟩
  contrapose! h
  rw [← sentence.realize_not] at h
  refine'
    ⟨{  carrier := M
        is_model := ⟨fun ψ hψ => hψ.elim (realize_sentence_of_mem _) fun h' => _⟩ }⟩
  rw [Set.mem_singleton_iff.1 h']
  exact h
#align first_order.language.Theory.models_iff_not_satisfiable FirstOrder.Language.Theory.models_iff_not_satisfiable

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem ModelsBoundedFormula.realize_sentence {φ : L.Sentence} (h : T ⊨ φ) (M : Type _)
    [L.Structure M] [M ⊨ T] [Nonempty M] : M ⊨ φ :=
  by
  rw [models_iff_not_satisfiable] at h
  contrapose! h
  have : M ⊨ T ∪ {formula.not φ} :=
    by
    simp only [Set.union_singleton, model_iff, Set.mem_insert_iff, forall_eq_or_imp,
      sentence.realize_not]
    rw [← model_iff]
    exact ⟨h, inferInstance⟩
  exact model.is_satisfiable M
#align first_order.language.Theory.models_bounded_formula.realize_sentence FirstOrder.Language.Theory.ModelsBoundedFormula.realize_sentence

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- A theory is complete when it is satisfiable and models each sentence or its negation. -/
def IsComplete (T : L.Theory) : Prop :=
  T.IsSatisfiable ∧ ∀ φ : L.Sentence, T ⊨ φ ∨ T ⊨ φ.Not
#align first_order.language.Theory.is_complete FirstOrder.Language.Theory.IsComplete

namespace IsComplete

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem models_not_iff (h : T.IsComplete) (φ : L.Sentence) : T ⊨ φ.Not ↔ ¬T ⊨ φ :=
  by
  cases' h.2 φ with hφ hφn
  · simp only [hφ, not_true, iff_false_iff]
    rw [models_sentence_iff, not_forall]
    refine' ⟨h.1.some, _⟩
    simp only [sentence.realize_not, Classical.not_not]
    exact models_sentence_iff.1 hφ _
  · simp only [hφn, true_iff_iff]
    intro hφ
    rw [models_sentence_iff] at *
    exact hφn h.1.some (hφ _)
#align first_order.language.Theory.is_complete.models_not_iff FirstOrder.Language.Theory.IsComplete.models_not_iff

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem realize_sentence_iff (h : T.IsComplete) (φ : L.Sentence) (M : Type _) [L.Structure M]
    [M ⊨ T] [Nonempty M] : M ⊨ φ ↔ T ⊨ φ :=
  by
  cases' h.2 φ with hφ hφn
  · exact iff_of_true (hφ.realize_sentence M) hφ
  ·
    exact
      iff_of_false ((sentence.realize_not M).1 (hφn.realize_sentence M))
        ((h.models_not_iff φ).1 hφn)
#align first_order.language.Theory.is_complete.realize_sentence_iff FirstOrder.Language.Theory.IsComplete.realize_sentence_iff

end IsComplete

/-- A theory is maximal when it is satisfiable and contains each sentence or its negation.
  Maximal theories are complete. -/
def IsMaximal (T : L.Theory) : Prop :=
  T.IsSatisfiable ∧ ∀ φ : L.Sentence, φ ∈ T ∨ φ.Not ∈ T
#align first_order.language.Theory.is_maximal FirstOrder.Language.Theory.IsMaximal

theorem IsMaximal.isComplete (h : T.IsMaximal) : T.IsComplete :=
  h.imp_right (forall_imp fun _ => Or.imp models_sentence_of_mem models_sentence_of_mem)
#align first_order.language.Theory.is_maximal.is_complete FirstOrder.Language.Theory.IsMaximal.isComplete

theorem IsMaximal.mem_or_not_mem (h : T.IsMaximal) (φ : L.Sentence) : φ ∈ T ∨ φ.Not ∈ T :=
  h.2 φ
#align first_order.language.Theory.is_maximal.mem_or_not_mem FirstOrder.Language.Theory.IsMaximal.mem_or_not_mem

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem IsMaximal.mem_of_models (h : T.IsMaximal) {φ : L.Sentence} (hφ : T ⊨ φ) : φ ∈ T :=
  by
  refine' (h.mem_or_not_mem φ).resolve_right fun con => _
  rw [models_iff_not_satisfiable, Set.union_singleton, Set.insert_eq_of_mem Con] at hφ
  exact hφ h.1
#align first_order.language.Theory.is_maximal.mem_of_models FirstOrder.Language.Theory.IsMaximal.mem_of_models

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem IsMaximal.mem_iff_models (h : T.IsMaximal) (φ : L.Sentence) : φ ∈ T ↔ T ⊨ φ :=
  ⟨models_sentence_of_mem, h.mem_of_models⟩
#align first_order.language.Theory.is_maximal.mem_iff_models FirstOrder.Language.Theory.IsMaximal.mem_iff_models

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Two (bounded) formulas are semantically equivalent over a theory `T` when they have the same
interpretation in every model of `T`. (This is also known as logical equivalence, which also has a
proof-theoretic definition.) -/
def SemanticallyEquivalent (T : L.Theory) (φ ψ : L.BoundedFormula α n) : Prop :=
  T ⊨ φ.Iff ψ
#align first_order.language.Theory.semantically_equivalent FirstOrder.Language.Theory.SemanticallyEquivalent

@[refl]
theorem SemanticallyEquivalent.refl (φ : L.BoundedFormula α n) : T.SemanticallyEquivalent φ φ :=
  fun M v xs => by rw [bounded_formula.realize_iff]
#align first_order.language.Theory.semantically_equivalent.refl FirstOrder.Language.Theory.SemanticallyEquivalent.refl

instance : IsRefl (L.BoundedFormula α n) T.SemanticallyEquivalent :=
  ⟨SemanticallyEquivalent.refl⟩

@[symm]
theorem SemanticallyEquivalent.symm {φ ψ : L.BoundedFormula α n}
    (h : T.SemanticallyEquivalent φ ψ) : T.SemanticallyEquivalent ψ φ := fun M v xs =>
  by
  rw [bounded_formula.realize_iff, Iff.comm, ← bounded_formula.realize_iff]
  exact h M v xs
#align first_order.language.Theory.semantically_equivalent.symm FirstOrder.Language.Theory.SemanticallyEquivalent.symm

@[trans]
theorem SemanticallyEquivalent.trans {φ ψ θ : L.BoundedFormula α n}
    (h1 : T.SemanticallyEquivalent φ ψ) (h2 : T.SemanticallyEquivalent ψ θ) :
    T.SemanticallyEquivalent φ θ := fun M v xs =>
  by
  have h1' := h1 M v xs
  have h2' := h2 M v xs
  rw [bounded_formula.realize_iff] at *
  exact ⟨h2'.1 ∘ h1'.1, h1'.2 ∘ h2'.2⟩
#align first_order.language.Theory.semantically_equivalent.trans FirstOrder.Language.Theory.SemanticallyEquivalent.trans

theorem SemanticallyEquivalent.realize_bd_iff {φ ψ : L.BoundedFormula α n} {M : Type max u v}
    [ne : Nonempty M] [str : L.Structure M] [hM : T.Model M] (h : T.SemanticallyEquivalent φ ψ)
    {v : α → M} {xs : Fin n → M} : φ.realize v xs ↔ ψ.realize v xs :=
  BoundedFormula.realize_iff.1 (h (ModelCat.of T M) v xs)
#align first_order.language.Theory.semantically_equivalent.realize_bd_iff FirstOrder.Language.Theory.SemanticallyEquivalent.realize_bd_iff

theorem SemanticallyEquivalent.realize_iff {φ ψ : L.Formula α} {M : Type max u v} [ne : Nonempty M]
    [str : L.Structure M] (hM : T.Model M) (h : T.SemanticallyEquivalent φ ψ) {v : α → M} :
    φ.realize v ↔ ψ.realize v :=
  h.realize_bd_iff
#align first_order.language.Theory.semantically_equivalent.realize_iff FirstOrder.Language.Theory.SemanticallyEquivalent.realize_iff

/-- Semantic equivalence forms an equivalence relation on formulas. -/
def semanticallyEquivalentSetoid (T : L.Theory) : Setoid (L.BoundedFormula α n)
    where
  R := SemanticallyEquivalent T
  iseqv := ⟨fun _ => refl _, fun a b h => h.symm, fun _ _ _ h1 h2 => h1.trans h2⟩
#align first_order.language.Theory.semantically_equivalent_setoid FirstOrder.Language.Theory.semanticallyEquivalentSetoid

protected theorem SemanticallyEquivalent.all {φ ψ : L.BoundedFormula α (n + 1)}
    (h : T.SemanticallyEquivalent φ ψ) : T.SemanticallyEquivalent φ.all ψ.all :=
  by
  simp_rw [semantically_equivalent, models_bounded_formula, bounded_formula.realize_iff,
    bounded_formula.realize_all]
  exact fun M v xs => forall_congr' fun a => h.realize_bd_iff
#align first_order.language.Theory.semantically_equivalent.all FirstOrder.Language.Theory.SemanticallyEquivalent.all

protected theorem SemanticallyEquivalent.ex {φ ψ : L.BoundedFormula α (n + 1)}
    (h : T.SemanticallyEquivalent φ ψ) : T.SemanticallyEquivalent φ.ex ψ.ex :=
  by
  simp_rw [semantically_equivalent, models_bounded_formula, bounded_formula.realize_iff,
    bounded_formula.realize_ex]
  exact fun M v xs => exists_congr fun a => h.realize_bd_iff
#align first_order.language.Theory.semantically_equivalent.ex FirstOrder.Language.Theory.SemanticallyEquivalent.ex

protected theorem SemanticallyEquivalent.not {φ ψ : L.BoundedFormula α n}
    (h : T.SemanticallyEquivalent φ ψ) : T.SemanticallyEquivalent φ.Not ψ.Not :=
  by
  simp_rw [semantically_equivalent, models_bounded_formula, bounded_formula.realize_iff,
    bounded_formula.realize_not]
  exact fun M v xs => not_congr h.realize_bd_iff
#align first_order.language.Theory.semantically_equivalent.not FirstOrder.Language.Theory.SemanticallyEquivalent.not

protected theorem SemanticallyEquivalent.imp {φ ψ φ' ψ' : L.BoundedFormula α n}
    (h : T.SemanticallyEquivalent φ ψ) (h' : T.SemanticallyEquivalent φ' ψ') :
    T.SemanticallyEquivalent (φ.imp φ') (ψ.imp ψ') :=
  by
  simp_rw [semantically_equivalent, models_bounded_formula, bounded_formula.realize_iff,
    bounded_formula.realize_imp]
  exact fun M v xs => imp_congr h.realize_bd_iff h'.realize_bd_iff
#align first_order.language.Theory.semantically_equivalent.imp FirstOrder.Language.Theory.SemanticallyEquivalent.imp

end Theory

namespace CompleteTheory

variable (L) (M : Type w) [L.Structure M]

theorem isSatisfiable [Nonempty M] : (L.completeTheory M).IsSatisfiable :=
  Theory.Model.isSatisfiable M
#align first_order.language.complete_theory.is_satisfiable FirstOrder.Language.completeTheory.isSatisfiable

theorem mem_or_not_mem (φ : L.Sentence) : φ ∈ L.completeTheory M ∨ φ.Not ∈ L.completeTheory M := by
  simp_rw [complete_theory, Set.mem_setOf_eq, sentence.realize, formula.realize_not, or_not]
#align first_order.language.complete_theory.mem_or_not_mem FirstOrder.Language.completeTheory.mem_or_not_mem

theorem isMaximal [Nonempty M] : (L.completeTheory M).IsMaximal :=
  ⟨isSatisfiable L M, mem_or_not_mem L M⟩
#align first_order.language.complete_theory.is_maximal FirstOrder.Language.completeTheory.isMaximal

theorem isComplete [Nonempty M] : (L.completeTheory M).IsComplete :=
  (completeTheory.isMaximal L M).IsComplete
#align first_order.language.complete_theory.is_complete FirstOrder.Language.completeTheory.isComplete

end CompleteTheory

namespace BoundedFormula

variable (φ ψ : L.BoundedFormula α n)

theorem semanticallyEquivalent_not_not : T.SemanticallyEquivalent φ φ.Not.Not := fun M v xs => by
  simp
#align first_order.language.bounded_formula.semantically_equivalent_not_not FirstOrder.Language.BoundedFormula.semanticallyEquivalent_not_not

theorem imp_semanticallyEquivalent_not_sup : T.SemanticallyEquivalent (φ.imp ψ) (φ.Not ⊔ ψ) :=
  fun M v xs => by simp [imp_iff_not_or]
#align first_order.language.bounded_formula.imp_semantically_equivalent_not_sup FirstOrder.Language.BoundedFormula.imp_semanticallyEquivalent_not_sup

theorem sup_semanticallyEquivalent_not_inf_not :
    T.SemanticallyEquivalent (φ ⊔ ψ) (φ.Not ⊓ ψ.Not).Not := fun M v xs => by simp [imp_iff_not_or]
#align first_order.language.bounded_formula.sup_semantically_equivalent_not_inf_not FirstOrder.Language.BoundedFormula.sup_semanticallyEquivalent_not_inf_not

theorem inf_semanticallyEquivalent_not_sup_not :
    T.SemanticallyEquivalent (φ ⊓ ψ) (φ.Not ⊔ ψ.Not).Not := fun M v xs => by
  simp [and_iff_not_or_not]
#align first_order.language.bounded_formula.inf_semantically_equivalent_not_sup_not FirstOrder.Language.BoundedFormula.inf_semanticallyEquivalent_not_sup_not

theorem all_semanticallyEquivalent_not_ex_not (φ : L.BoundedFormula α (n + 1)) :
    T.SemanticallyEquivalent φ.all φ.Not.ex.Not := fun M v xs => by simp
#align first_order.language.bounded_formula.all_semantically_equivalent_not_ex_not FirstOrder.Language.BoundedFormula.all_semanticallyEquivalent_not_ex_not

theorem ex_semanticallyEquivalent_not_all_not (φ : L.BoundedFormula α (n + 1)) :
    T.SemanticallyEquivalent φ.ex φ.Not.all.Not := fun M v xs => by simp
#align first_order.language.bounded_formula.ex_semantically_equivalent_not_all_not FirstOrder.Language.BoundedFormula.ex_semanticallyEquivalent_not_all_not

theorem semanticallyEquivalent_all_liftAt : T.SemanticallyEquivalent φ (φ.liftAt 1 n).all :=
  fun M v xs => by
  skip
  rw [realize_iff, realize_all_lift_at_one_self]
#align first_order.language.bounded_formula.semantically_equivalent_all_lift_at FirstOrder.Language.BoundedFormula.semanticallyEquivalent_all_liftAt

end BoundedFormula

namespace Formula

variable (φ ψ : L.Formula α)

theorem semanticallyEquivalent_not_not : T.SemanticallyEquivalent φ φ.Not.Not :=
  φ.semanticallyEquivalent_not_not
#align first_order.language.formula.semantically_equivalent_not_not FirstOrder.Language.Formula.semanticallyEquivalent_not_not

theorem imp_semanticallyEquivalent_not_sup : T.SemanticallyEquivalent (φ.imp ψ) (φ.Not ⊔ ψ) :=
  φ.imp_semanticallyEquivalent_not_sup ψ
#align first_order.language.formula.imp_semantically_equivalent_not_sup FirstOrder.Language.Formula.imp_semanticallyEquivalent_not_sup

theorem sup_semanticallyEquivalent_not_inf_not :
    T.SemanticallyEquivalent (φ ⊔ ψ) (φ.Not ⊓ ψ.Not).Not :=
  φ.sup_semanticallyEquivalent_not_inf_not ψ
#align first_order.language.formula.sup_semantically_equivalent_not_inf_not FirstOrder.Language.Formula.sup_semanticallyEquivalent_not_inf_not

theorem inf_semanticallyEquivalent_not_sup_not :
    T.SemanticallyEquivalent (φ ⊓ ψ) (φ.Not ⊔ ψ.Not).Not :=
  φ.inf_semanticallyEquivalent_not_sup_not ψ
#align first_order.language.formula.inf_semantically_equivalent_not_sup_not FirstOrder.Language.Formula.inf_semanticallyEquivalent_not_sup_not

end Formula

namespace BoundedFormula

theorem IsQf.induction_on_sup_not {P : L.BoundedFormula α n → Prop} {φ : L.BoundedFormula α n}
    (h : IsQf φ) (hf : P (⊥ : L.BoundedFormula α n))
    (ha : ∀ ψ : L.BoundedFormula α n, IsAtomic ψ → P ψ)
    (hsup : ∀ {φ₁ φ₂} (h₁ : P φ₁) (h₂ : P φ₂), P (φ₁ ⊔ φ₂)) (hnot : ∀ {φ} (h : P φ), P φ.Not)
    (hse :
      ∀ {φ₁ φ₂ : L.BoundedFormula α n} (h : Theory.SemanticallyEquivalent ∅ φ₁ φ₂), P φ₁ ↔ P φ₂) :
    P φ :=
  IsQf.rec_on h hf ha fun φ₁ φ₂ _ _ h1 h2 =>
    (hse (φ₁.imp_semanticallyEquivalent_not_sup φ₂)).2 (hsup (hnot h1) h2)
#align first_order.language.bounded_formula.is_qf.induction_on_sup_not FirstOrder.Language.BoundedFormula.IsQf.induction_on_sup_not

theorem IsQf.induction_on_inf_not {P : L.BoundedFormula α n → Prop} {φ : L.BoundedFormula α n}
    (h : IsQf φ) (hf : P (⊥ : L.BoundedFormula α n))
    (ha : ∀ ψ : L.BoundedFormula α n, IsAtomic ψ → P ψ)
    (hinf : ∀ {φ₁ φ₂} (h₁ : P φ₁) (h₂ : P φ₂), P (φ₁ ⊓ φ₂)) (hnot : ∀ {φ} (h : P φ), P φ.Not)
    (hse :
      ∀ {φ₁ φ₂ : L.BoundedFormula α n} (h : Theory.SemanticallyEquivalent ∅ φ₁ φ₂), P φ₁ ↔ P φ₂) :
    P φ :=
  h.induction_on_sup_not hf ha
    (fun φ₁ φ₂ h1 h2 =>
      (hse (φ₁.sup_semanticallyEquivalent_not_inf_not φ₂)).2 (hnot (hinf (hnot h1) (hnot h2))))
    (fun _ => hnot) fun _ _ => hse
#align first_order.language.bounded_formula.is_qf.induction_on_inf_not FirstOrder.Language.BoundedFormula.IsQf.induction_on_inf_not

theorem semanticallyEquivalent_toPrenex (φ : L.BoundedFormula α n) :
    (∅ : L.Theory).SemanticallyEquivalent φ φ.toPrenex := fun M v xs => by
  rw [realize_iff, realize_to_prenex]
#align first_order.language.bounded_formula.semantically_equivalent_to_prenex FirstOrder.Language.BoundedFormula.semanticallyEquivalent_toPrenex

theorem induction_on_all_ex {P : ∀ {m}, L.BoundedFormula α m → Prop} (φ : L.BoundedFormula α n)
    (hqf : ∀ {m} {ψ : L.BoundedFormula α m}, IsQf ψ → P ψ)
    (hall : ∀ {m} {ψ : L.BoundedFormula α (m + 1)} (h : P ψ), P ψ.all)
    (hex : ∀ {m} {φ : L.BoundedFormula α (m + 1)} (h : P φ), P φ.ex)
    (hse :
      ∀ {m} {φ₁ φ₂ : L.BoundedFormula α m} (h : Theory.SemanticallyEquivalent ∅ φ₁ φ₂),
        P φ₁ ↔ P φ₂) :
    P φ := by
  suffices h' : ∀ {m} {φ : L.bounded_formula α m}, φ.IsPrenex → P φ
  · exact (hse φ.semantically_equivalent_to_prenex).2 (h' φ.to_prenex_is_prenex)
  intro m φ hφ
  induction' hφ with _ _ hφ _ _ _ hφ _ _ _ hφ
  · exact hqf hφ
  · exact hall hφ
  · exact hex hφ
#align first_order.language.bounded_formula.induction_on_all_ex FirstOrder.Language.BoundedFormula.induction_on_all_ex

theorem induction_on_exists_not {P : ∀ {m}, L.BoundedFormula α m → Prop} (φ : L.BoundedFormula α n)
    (hqf : ∀ {m} {ψ : L.BoundedFormula α m}, IsQf ψ → P ψ)
    (hnot : ∀ {m} {φ : L.BoundedFormula α m} (h : P φ), P φ.Not)
    (hex : ∀ {m} {φ : L.BoundedFormula α (m + 1)} (h : P φ), P φ.ex)
    (hse :
      ∀ {m} {φ₁ φ₂ : L.BoundedFormula α m} (h : Theory.SemanticallyEquivalent ∅ φ₁ φ₂),
        P φ₁ ↔ P φ₂) :
    P φ :=
  φ.induction_on_all_ex (fun _ _ => hqf)
    (fun _ φ hφ => (hse φ.all_semanticallyEquivalent_not_ex_not).2 (hnot (hex (hnot hφ))))
    (fun _ _ => hex) fun _ _ _ => hse
#align first_order.language.bounded_formula.induction_on_exists_not FirstOrder.Language.BoundedFormula.induction_on_exists_not

end BoundedFormula

end Language

end FirstOrder

namespace Cardinal

open FirstOrder FirstOrder.Language

variable {L : Language.{u, v}} (κ : Cardinal.{w}) (T : L.Theory)

/-- A theory is `κ`-categorical if all models of size `κ` are isomorphic. -/
def Categorical : Prop :=
  ∀ M N : T.ModelCat, (#M) = κ → (#N) = κ → Nonempty (M ≃[L] N)
#align cardinal.categorical Cardinal.Categorical

/-- The Łoś–Vaught Test : a criterion for categorical theories to be complete. -/
theorem Categorical.isComplete (h : κ.Categorical T) (h1 : ℵ₀ ≤ κ)
    (h2 : Cardinal.lift.{w} L.card ≤ Cardinal.lift.{max u v} κ) (hS : T.IsSatisfiable)
    (hT : ∀ M : Theory.ModelCat.{u, v, max u v} T, Infinite M) : T.IsComplete :=
  ⟨hS, fun φ =>
    by
    obtain ⟨N, hN⟩ := Theory.exists_model_card_eq ⟨hS.some, hT hS.some⟩ κ h1 h2
    rw [Theory.models_sentence_iff, Theory.models_sentence_iff]
    by_contra con
    push_neg  at con
    obtain ⟨⟨MF, hMF⟩, MT, hMT⟩ := Con
    rw [sentence.realize_not, Classical.not_not] at hMT
    refine' hMF _
    haveI := hT MT
    haveI := hT MF
    obtain ⟨NT, MNT, hNT⟩ := exists_elementarily_equivalent_card_eq L MT κ h1 h2
    obtain ⟨NF, MNF, hNF⟩ := exists_elementarily_equivalent_card_eq L MF κ h1 h2
    obtain ⟨TF⟩ := h (MNT.to_Model T) (MNF.to_Model T) hNT hNF
    exact
      ((MNT.realize_sentence φ).trans
            ((TF.realize_sentence φ).trans (MNF.realize_sentence φ).symm)).1
        hMT⟩
#align cardinal.categorical.is_complete Cardinal.Categorical.isComplete

theorem empty_theory_categorical (T : Language.empty.Theory) : κ.Categorical T := fun M N hM hN =>
  by rw [empty.nonempty_equiv_iff, hM, hN]
#align cardinal.empty_Theory_categorical Cardinal.empty_theory_categorical

theorem empty_infinite_Theory_isComplete : Language.empty.infiniteTheory.IsComplete :=
  (empty_theory_categorical ℵ₀ _).IsComplete ℵ₀ _ le_rfl (by simp)
    ⟨Theory.Model.bundled ((model_infiniteTheory_iff Language.empty).2 Nat.infinite)⟩ fun M =>
    (model_infiniteTheory_iff Language.empty).1 M.is_model
#align cardinal.empty_infinite_Theory_is_complete Cardinal.empty_infinite_Theory_isComplete

end Cardinal


import data.list.basic .nat

import .simp_omega

variables {α β : Type}

namespace list

@[omega] def set [has_zero α] (i) : list α → ℕ → list α
| (j::is) 0     := i::is
| []      0     := [i]
| (j::is) (k+1) := j::(set is k)
| []      (k+1) := 0::(set ([] : list α) k)
notation as `{` m `↦` a `}` := set a as m

lemma length_set [has_zero α] {a : α} :
  ∀ {m as}, (as{m ↦ a}).length = _root_.max as.length (m+1)
| 0 [] := rfl
| 0 (a::as) :=
  begin
    rw max_eq_left, refl,
    simp [nat.le_add_right],
  end
| (m+1) [] :=
  begin
    rw max_eq_right, simp_omega [list.length],
    rw @length_set m, rw max_eq_right,
    repeat {apply zero_le}
  end
| (m+1) (a::as) :=
  begin
    simp_omega [list.length, nat.max_succ_succ],
    rw @length_set m,
  end

@[omega] def get [has_zero α] : nat → list α → α
| _ [] := (0 : α)
| 0 (i::is) := i
| (n+1) (i::is) := get n is

@[omega] lemma get_nil [has_zero α] {k} : get k [] = (0 : α) :=
begin cases k; refl end

lemma get_eq_zero_of_le [has_zero α] :
  ∀ k {as : list α}, as.length ≤ k → get k as = (0 : α)
| 0 [] h1 := rfl
| 0 (a::as) h1 := by cases h1
| (k+1) [] h1 := rfl
| (k+1) (a::as) h1 :=
  begin
    simp_omega, apply get_eq_zero_of_le k,
    rw ← nat.succ_le_succ_iff, apply h1,
  end

lemma get_set [has_zero α] {a : α} :
  ∀ {k} {as}, as{k ↦ a}.get k = a
| 0 as := begin cases as; refl end
| (k+1) as :=
  begin cases as; {simp_omega, apply get_set} end

lemma mem_get_of_le [has_zero α] :
  ∀ {n} {as : list α},
  n < as.length → as.get n ∈ as
| _ [] h1 := by cases h1
| 0 (a::as) _ := or.inl rfl
| (n+1) (a::as) h1 :=
  begin
    simp_omega, apply or.inr,
    apply mem_get_of_le,
    apply nat.lt_of_succ_lt_succ h1,
  end

lemma mem_get_of_ne_zero [has_zero α] :
  ∀ {n} {as : list α},
  as.get n ≠ 0 → as.get n ∈ as
| _ [] h1 := begin exfalso, apply h1, rw get_nil end
| 0 (a::as) h1 := or.inl rfl
| (n+1) (a::as) h1 :=
  begin
    simp_omega,
    apply (or.inr (mem_get_of_ne_zero _)),
    apply h1
  end

lemma eq_get_of_mem [has_zero α] {a} :
  ∀ {as : list α}, a ∈ as → ∃ n, a = (as.get n)
| [] h := by cases h
| (b::as) h :=
  begin
    rw mem_cons_iff at h, cases h,
    { existsi 0, apply h },
    { cases eq_get_of_mem h with n h2,
      existsi (n+1), apply h2 }
  end

lemma forall_val_of_forall_mem [has_zero α] {p : α → Prop} {as : list α} :
  p 0 → (∀ x ∈ as, p x) → (∀ n, p (as.get n)) | h1 h2 n :=
begin
  by_cases h3 : n < as.length,
  { apply h2 _ (mem_get_of_le h3) },
  { rw not_lt at h3,
    rw get_eq_zero_of_le _ h3, apply h1 }
end

@[omega] def add [has_add α] : list α → list α → list α
| as1 [] := as1
| [] as2 := as2
| (a1::as1) (a2::as2) := ((a1+a2)::(add as1 as2))

@[omega] lemma nil_add [has_add α] (as : list α) :
add [] as = as := by cases as; refl

@[omega] lemma add_nil [has_add α] (as : list α) :
add as [] = as := by cases as; refl

@[omega] lemma get_add [add_monoid α] :
  ∀ {k} {is js : list α},
  (add is js).get k = (is.get k + js.get k)
| 0     is      []      := by simp_omega
| 0     []      js      := by simp_omega
| 0     (i::is) (j::js) := by simp_omega
| (k+1) []      js      := by simp_omega
| (k+1) is      []      := by simp_omega
| (k+1) (i::is) (j::js) := by simp_omega [get_add]

lemma length_add [has_add α] :
  ∀ {is js : list α}, (add is js).length = max is.length js.length
| [] js := begin simp_omega, rw max_eq_right, apply zero_le end
| is [] := begin simp_omega, rw max_eq_left, apply zero_le end
| (i::is) (j::js) :=
  by simp_omega [list.length,
     nat.max_succ_succ, length_add]

@[omega] def mul₁ [has_mul α] (a) : list α → list α
| []      := []
| (b::as) := a * b::(mul₁ as)

infix `*₁` : 250 := mul₁

@[omega] def div₁ [has_div α] (d) : list α → list α
| []      := []
| (a::as) := (a/d)::(div₁ as)

@[omega] def neg [has_neg α] : list α → list α
| []      := []
| (a::as) := -a::(neg as)

@[omega] lemma get_neg [add_group α] :
  ∀ {k} {as : list α}, as.neg.get k = -(as.get k)
| _ []          := by simp_omega
| 0 (a::as)     := by simp_omega
| (k+1) (a::as) := begin simp_omega [get_neg] end

@[omega] lemma length_neg [has_neg α] :
  ∀ as : list α, (as).neg.length = as.length
| []      := rfl
| (a::as) := by simp_omega [list.length, length_neg]

@[omega] def sub [has_neg α] [has_sub α] : list α → list α → list α
| [] []        := []
| [] (a2::as2) := neg (a2::as2)
| (a1::as1) [] := a1::as1
| (a1::as1) (a2::as2) := (a1-a2)::(sub as1 as2)

@[omega] lemma sub_nil [has_neg α] [has_sub α] (as : list α) :
sub as [] = as := by cases as; refl

@[omega] lemma nil_sub [has_neg α] [has_sub α] (as : list α) :
sub [] as = as.neg := by cases as; refl

@[omega] lemma get_sub [add_group α] : --[has_zero α] [has_neg α] [has_sub α] :
  ∀ {k} {is js : list α},
  (sub is js).get k = (is.get k - js.get k)
| 0     is      []      := by simp_omega
| 0     []      js      := by simp_omega
| 0     (i::is) (j::js) := by simp_omega
| (k+1) []      js      := by simp_omega
| (k+1) is      []      := by simp_omega
| (k+1) (i::is) (j::js) := by simp_omega [get_sub]

lemma length_sub [has_neg α] [has_sub α] :
  ∀ {is js : list α}, (sub is js).length = max is.length js.length
| [] js := begin simp_omega, rw max_eq_right, apply zero_le end
| is [] := begin simp_omega, rw max_eq_left, apply zero_le end
| (i::is) (j::js) :=
  by simp_omega [list.length,
     nat.max_succ_succ, length_sub]

def max [inhabited α] [decidable_linear_order α] : list α → α
| []           := @inhabited.default α _
| [a]          := a
| (a1::a2::as) := _root_.max a1 (max (a2::as))

def map_with_idx_core (f : nat → α → β) : nat → list α → list β
| k []      := []
| k (a::as) := f k a::(map_with_idx_core (k+1) as)

def map_with_idx (f : nat → α → β) (as : list α) : list β :=
map_with_idx_core f 0 as

def snoc_if_oob : nat → α → list α → list α
| m a as := if m < as.length then as else as ++ [a]

local attribute [instance] classical.dec

lemma not_exists_mem_not {P : α → Prop} {as : list α} :
  ¬ (∃ x ∈ as, ¬ P x) ↔ ∀ x ∈ as, P x :=
begin
  constructor; intro h1,
  { intros x h2, by_contra h3,
    apply h1, refine ⟨x,h2,h3⟩ },
  { intro h2, cases h2 with x h2,
    cases h2 with h2 h3, apply h3 (h1 _ h2) }
end

lemma forall_mem_cons_of {p : α → Prop} {a : α} {as : list α} :
  p a → (∀ x ∈ as, p x) → (∀ x ∈ (a::as), p x) :=
begin
  intros h1 h2, rw forall_mem_cons,
  constructor; assumption
end

lemma forall_mem_of_subset {p : α → Prop} {as1 as2 : list α} :
  as1 ⊆ as2 → (∀ x ∈ as2, p x) → (∀ x ∈ as1, p x) :=
begin
  intros h1 h2 a h3, apply h2,
  rw subset_def at h1, apply h1 h3
end

def equiv [has_zero α] (l1 l2 : list α) : Prop :=
∀ m, l1.get m = l2.get m

lemma get_set_eq_of_ne [has_zero α] {a : α} :
  ∀ {as : list α} {k} m, m ≠ k → as{k ↦ a}.get m = as.get m
| as 0 m h1 :=
  begin
    cases m, contradiction, cases as, simp_omega, refl
  end
| as (k+1) m h1 :=
  begin
    cases as; cases m; simp_omega,
    { rw get_set_eq_of_ne, simp_omega,
      intro hc, apply h1, simp [hc] },
    { apply get_set_eq_of_ne, intro hc,
      apply h1, simp [hc], }
  end

lemma map_add_map [has_add α] (f g : α → α) :
  ∀ {as : list α}, as.map (λ x, f x + g x) = add (as.map f) (as.map g)
| []      := rfl
| (a::as) := begin simp_omega [@map_add_map as], constructor; refl end

lemma get_map [has_zero α] [has_zero β] {f : α → β} :
  ∀ {n} {as : list α}, n < as.length → (as.map f).get n = f (as.get n)
| _ [] h := by cases h
| 0 (a::as) h := rfl
| (n+1) (a::as) h :=
  begin
    simp only [map, get], apply get_map,
    simp only [length, nat.lt_succ_iff] at h,
    apply h,
  end

lemma get_map' [has_zero α] [has_zero β] {f : α → β} {n} {as : list α} :
  f 0 = 0 → (as.map f).get n = f (as.get n) :=
begin
  intro h1, by_cases h2 : n < as.length,
  { apply get_map h2 },
  { rw not_lt at h2,
    rw [get_eq_zero_of_le _ h2, get_eq_zero_of_le, h1],
    rw [length_map], apply h2 }
end

end list


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton
-/
import tactic.tidy
import topology.continuous_function.basic
import topology.homeomorph
import topology.subset_properties
import topology.maps

/-!
# The compact-open topology

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

In this file, we define the compact-open topology on the set of continuous maps between two
topological spaces.

## Main definitions

* `compact_open` is the compact-open topology on `C(α, β)`. It is declared as an instance.
* `continuous_map.coev` is the coevaluation map `β → C(α, β × α)`. It is always continuous.
* `continuous_map.curry` is the currying map `C(α × β, γ) → C(α, C(β, γ))`. This map always exists
  and it is continuous as long as `α × β` is locally compact.
* `continuous_map.uncurry` is the uncurrying map `C(α, C(β, γ)) → C(α × β, γ)`. For this map to
  exist, we need `β` to be locally compact. If `α` is also locally compact, then this map is
  continuous.
* `homeomorph.curry` combines the currying and uncurrying operations into a homeomorphism
  `C(α × β, γ) ≃ₜ C(α, C(β, γ))`. This homeomorphism exists if `α` and `β` are locally compact.

## Tags

compact-open, curry, function space
-/

open set
open_locale topology

namespace continuous_map

section compact_open
variables {α : Type*} {β : Type*} {γ : Type*}
variables [topological_space α] [topological_space β] [topological_space γ]

/-- A generating set for the compact-open topology (when `s` is compact and `u` is open). -/
def compact_open.gen (s : set α) (u : set β) : set C(α,β) := {f | f '' s ⊆ u}

@[simp] lemma gen_empty (u : set β) : compact_open.gen (∅ : set α) u = set.univ :=
set.ext (λ f, iff_true_intro ((congr_arg (⊆ u) (image_empty f)).mpr u.empty_subset))

@[simp] lemma gen_univ (s : set α) : compact_open.gen s (set.univ : set β) = set.univ :=
set.ext (λ f, iff_true_intro (f '' s).subset_univ)

@[simp] lemma gen_inter (s : set α) (u v : set β) :
  compact_open.gen s (u ∩ v) = compact_open.gen s u ∩ compact_open.gen s v :=
set.ext (λ f, subset_inter_iff)

@[simp] lemma gen_union (s t : set α) (u : set β) :
  compact_open.gen (s ∪ t) u = compact_open.gen s u ∩ compact_open.gen t u :=
set.ext (λ f, (iff_of_eq (congr_arg (⊆ u) (image_union f s t))).trans union_subset_iff)

lemma gen_empty_right {s : set α} (h : s.nonempty) : compact_open.gen s (∅ : set β) = ∅ :=
eq_empty_of_forall_not_mem $ λ f, (h.image _).not_subset_empty

-- The compact-open topology on the space of continuous maps α → β.
instance compact_open : topological_space C(α, β) :=
topological_space.generate_from
  {m | ∃ (s : set α) (hs : is_compact s) (u : set β) (hu : is_open u), m = compact_open.gen s u}

protected lemma is_open_gen {s : set α} (hs : is_compact s) {u : set β} (hu : is_open u) :
  is_open (compact_open.gen s u) :=
topological_space.generate_open.basic _ (by dsimp [mem_set_of_eq]; tauto)

section functorial

variables (g : C(β, γ))

private lemma preimage_gen {s : set α} (hs : is_compact s) {u : set γ} (hu : is_open u) :
  continuous_map.comp g ⁻¹' (compact_open.gen s u) = compact_open.gen s (g ⁻¹' u) :=
begin
  ext ⟨f, _⟩,
  change g ∘ f '' s ⊆ u ↔ f '' s ⊆ g ⁻¹' u,
  rw [image_comp, image_subset_iff]
end

/-- C(α, -) is a functor. -/
lemma continuous_comp : continuous (continuous_map.comp g : C(α, β) → C(α, γ)) :=
continuous_generated_from $ assume m ⟨s, hs, u, hu, hm⟩,
  by rw [hm, preimage_gen g hs hu]; exact continuous_map.is_open_gen hs (hu.preimage g.2)

variable (f : C(α, β))

private lemma image_gen {s : set α} (hs : is_compact s) {u : set γ} (hu : is_open u) :
  (λ g : C(β, γ), g.comp f) ⁻¹' compact_open.gen s u = compact_open.gen (f '' s) u :=
begin
  ext ⟨g, _⟩,
  change g ∘ f '' s ⊆ u ↔ g '' (f '' s) ⊆ u,
  rw set.image_comp,
end

/-- C(-, γ) is a functor. -/
lemma continuous_comp_left : continuous (λ g, g.comp f : C(β, γ) → C(α, γ)) :=
continuous_generated_from $ assume m ⟨s, hs, u, hu, hm⟩,
  by { rw [hm, image_gen f hs hu], exact continuous_map.is_open_gen (hs.image f.2) hu }

/-- Composition is a continuous map from `C(α, β) × C(β, γ)` to `C(α, γ)`, provided that `β` is
  locally compact. This is Prop. 9 of Chap. X, §3, №. 4 of Bourbaki's *Topologie Générale*. -/
lemma continuous_comp' [locally_compact_space β] :
  continuous (λ x : C(α, β) × C(β, γ), x.2.comp x.1) :=
continuous_generated_from begin
  rintros M ⟨K, hK, U, hU, rfl⟩,
  conv { congr, rw [compact_open.gen, preimage_set_of_eq],
    congr, funext, rw [coe_comp, image_comp, image_subset_iff] },
  rw is_open_iff_forall_mem_open,
  rintros ⟨φ₀, ψ₀⟩ H,
  obtain ⟨L, hL, hKL, hLU⟩ := exists_compact_between (hK.image φ₀.2) (hU.preimage ψ₀.2) H,
  use {φ : C(α, β) | φ '' K ⊆ interior L} ×ˢ {ψ : C(β, γ) | ψ '' L ⊆ U},
  use λ ⟨φ, ψ⟩ ⟨hφ, hψ⟩, subset_trans hφ (interior_subset.trans $ image_subset_iff.mp hψ),
  use (continuous_map.is_open_gen hK is_open_interior).prod (continuous_map.is_open_gen hL hU),
  exact mem_prod.mpr ⟨hKL, image_subset_iff.mpr hLU⟩,
end

lemma continuous.comp' {X : Type*} [topological_space X] [locally_compact_space β]
  {f : X → C(α, β)} {g : X → C(β, γ)} (hf : continuous f) (hg : continuous g) :
  continuous (λ x, (g x).comp (f x)) :=
continuous_comp'.comp (hf.prod_mk hg : continuous $ λ x, (f x, g x))

end functorial

section ev

variables {α β}

/-- The evaluation map `C(α, β) × α → β` is continuous if `α` is locally compact.

See also `continuous_map.continuous_eval` -/
lemma continuous_eval' [locally_compact_space α] : continuous (λ p : C(α, β) × α, p.1 p.2) :=
continuous_iff_continuous_at.mpr $ assume ⟨f, x⟩ n hn,
  let ⟨v, vn, vo, fxv⟩ := mem_nhds_iff.mp hn in
  have v ∈ 𝓝 (f x), from is_open.mem_nhds vo fxv,
  let ⟨s, hs, sv, sc⟩ :=
    locally_compact_space.local_compact_nhds x (f ⁻¹' v)
      (f.continuous.tendsto x this) in
  let ⟨u, us, uo, xu⟩ := mem_nhds_iff.mp hs in
  show (λ p : C(α, β) × α, p.1 p.2) ⁻¹' n ∈ 𝓝 (f, x), from
  let w := compact_open.gen s v ×ˢ u in
  have w ⊆ (λ p : C(α, β) × α, p.1 p.2) ⁻¹' n, from assume ⟨f', x'⟩ ⟨hf', hx'⟩, calc
    f' x' ∈ f' '' s  : mem_image_of_mem f' (us hx')
    ...       ⊆ v            : hf'
    ...       ⊆ n            : vn,
  have is_open w, from (continuous_map.is_open_gen sc vo).prod uo,
  have (f, x) ∈ w, from ⟨image_subset_iff.mpr sv, xu⟩,
  mem_nhds_iff.mpr ⟨w, by assumption, by assumption, by assumption⟩

/-- See also `continuous_map.continuous_eval_const` -/
lemma continuous_eval_const' [locally_compact_space α] (a : α) : continuous (λ f : C(α, β), f a) :=
continuous_eval'.comp (continuous_id.prod_mk continuous_const)

/-- See also `continuous_map.continuous_coe` -/
lemma continuous_coe' [locally_compact_space α] : @continuous (C(α, β)) (α → β) _ _ coe_fn :=
continuous_pi continuous_eval_const'

instance [t2_space β] : t2_space C(α, β) :=
⟨ begin
    intros f₁ f₂ h,
    obtain ⟨x, hx⟩ := not_forall.mp (mt (fun_like.ext f₁ f₂) h),
    obtain ⟨u, v, hu, hv, hxu, hxv, huv⟩ := t2_separation hx,
    refine ⟨compact_open.gen {x} u, compact_open.gen {x} v, continuous_map.is_open_gen
      is_compact_singleton hu, continuous_map.is_open_gen is_compact_singleton hv, _, _, _⟩,
    { rwa [compact_open.gen, mem_set_of_eq, image_singleton, singleton_subset_iff] },
    { rwa [compact_open.gen, mem_set_of_eq, image_singleton, singleton_subset_iff] },
    { rw [disjoint_iff_inter_eq_empty, ←gen_inter, huv.inter_eq,
        gen_empty_right (singleton_nonempty _)] }
  end ⟩

end ev

section Inf_induced

lemma compact_open_le_induced (s : set α) :
  (continuous_map.compact_open : topological_space C(α, β))
  ≤ topological_space.induced (continuous_map.restrict s) continuous_map.compact_open :=
begin
  simp only [induced_generate_from_eq, continuous_map.compact_open],
  apply topological_space.generate_from_anti,
  rintros b ⟨a, ⟨c, hc, u, hu, rfl⟩, rfl⟩,
  refine ⟨coe '' c, hc.image continuous_subtype_coe, u, hu, _⟩,
  ext f,
  simp only [compact_open.gen, mem_set_of_eq, mem_preimage, continuous_map.coe_restrict],
  rw image_comp f (coe : s → α),
end

/-- The compact-open topology on `C(α, β)` is equal to the infimum of the compact-open topologies
on `C(s, β)` for `s` a compact subset of `α`.  The key point of the proof is that the union of the
compact subsets of `α` is equal to the union of compact subsets of the compact subsets of `α`. -/
lemma compact_open_eq_Inf_induced :
  (continuous_map.compact_open : topological_space C(α, β))
  = ⨅ (s : set α) (hs : is_compact s),
    topological_space.induced (continuous_map.restrict s) continuous_map.compact_open :=
begin
  refine le_antisymm _ _,
  { refine le_infi₂ _,
    exact λ s hs, compact_open_le_induced s },
  simp only [← generate_from_Union, induced_generate_from_eq, continuous_map.compact_open],
  apply topological_space.generate_from_anti,
  rintros _ ⟨s, hs, u, hu, rfl⟩,
  rw mem_Union₂,
  refine ⟨s, hs, _, ⟨univ, is_compact_iff_is_compact_univ.mp hs, u, hu, rfl⟩, _⟩,
  ext f,
  simp only [compact_open.gen, mem_set_of_eq, mem_preimage, continuous_map.coe_restrict],
  rw image_comp f (coe : s → α),
  simp
end

/-- For any subset `s` of `α`, the restriction of continuous functions to `s` is continuous as a
function from `C(α, β)` to `C(s, β)` with their respective compact-open topologies. -/
lemma continuous_restrict (s : set α) : continuous (λ F : C(α, β), F.restrict s) :=
by { rw continuous_iff_le_induced, exact compact_open_le_induced s }

lemma nhds_compact_open_eq_Inf_nhds_induced (f : C(α, β)) :
  𝓝 f = ⨅ s (hs : is_compact s), (𝓝 (f.restrict s)).comap (continuous_map.restrict s) :=
by { rw [compact_open_eq_Inf_induced], simp [nhds_infi, nhds_induced] }

lemma tendsto_compact_open_restrict {ι : Type*} {l : filter ι} {F : ι → C(α, β)} {f : C(α, β)}
  (hFf : filter.tendsto F l (𝓝 f)) (s : set α) :
  filter.tendsto (λ i, (F i).restrict s) l (𝓝 (f.restrict s)) :=
(continuous_restrict s).continuous_at.tendsto.comp hFf

lemma tendsto_compact_open_iff_forall {ι : Type*} {l : filter ι} (F : ι → C(α, β)) (f : C(α, β)) :
  filter.tendsto F l (𝓝 f)
  ↔ ∀ s (hs : is_compact s), filter.tendsto (λ i, (F i).restrict s) l (𝓝 (f.restrict s)) :=
by { rw [compact_open_eq_Inf_induced], simp [nhds_infi, nhds_induced, filter.tendsto_comap_iff] }

/-- A family `F` of functions in `C(α, β)` converges in the compact-open topology, if and only if
it converges in the compact-open topology on each compact subset of `α`. -/
lemma exists_tendsto_compact_open_iff_forall [locally_compact_space α] [t2_space α] [t2_space β]
  {ι : Type*} {l : filter ι} [filter.ne_bot l] (F : ι → C(α, β)) :
  (∃ f, filter.tendsto F l (𝓝 f))
  ↔ ∀ (s : set α) (hs : is_compact s), ∃ f, filter.tendsto (λ i, (F i).restrict s) l (𝓝 f) :=
begin
  split,
  { rintros ⟨f, hf⟩ s hs,
    exact ⟨f.restrict s, tendsto_compact_open_restrict hf s⟩ },
  { intros h,
    choose f hf using h,
    -- By uniqueness of limits in a `t2_space`, since `λ i, F i x` tends to both `f s₁ hs₁ x` and
    -- `f s₂ hs₂ x`, we have `f s₁ hs₁ x = f s₂ hs₂ x`
    have h : ∀ s₁ (hs₁ : is_compact s₁) s₂ (hs₂ : is_compact s₂) (x : α) (hxs₁ : x ∈ s₁)
      (hxs₂ : x ∈ s₂), f s₁ hs₁ ⟨x, hxs₁⟩ = f s₂ hs₂ ⟨x, hxs₂⟩,
    { rintros s₁ hs₁ s₂ hs₂ x hxs₁ hxs₂,
      haveI := is_compact_iff_compact_space.mp hs₁,
      haveI := is_compact_iff_compact_space.mp hs₂,
      have h₁ := (continuous_eval_const' (⟨x, hxs₁⟩ : s₁)).continuous_at.tendsto.comp (hf s₁ hs₁),
      have h₂ := (continuous_eval_const' (⟨x, hxs₂⟩ : s₂)).continuous_at.tendsto.comp (hf s₂ hs₂),
      exact tendsto_nhds_unique h₁ h₂ },
    -- So glue the `f s hs` together and prove that this glued function `f₀` is a limit on each
    -- compact set `s`
    have hs : ∀ x : α, ∃ s (hs : is_compact s), s ∈ 𝓝 x,
    { intros x,
      obtain ⟨s, hs, hs'⟩ := exists_compact_mem_nhds x,
      exact ⟨s, hs, hs'⟩ },
    refine ⟨lift_cover' _ _ h hs, _⟩,
    rw tendsto_compact_open_iff_forall,
    intros s hs,
    rw lift_cover_restrict',
    exact hf s hs }
end

end Inf_induced

section coev

variables (α β)

/-- The coevaluation map `β → C(α, β × α)` sending a point `x : β` to the continuous function
on `α` sending `y` to `(x, y)`. -/
def coev (b : β) : C(α, β × α) := ⟨prod.mk b, continuous_const.prod_mk continuous_id⟩

variables {α β}
lemma image_coev {y : β} (s : set α) : (coev α β y) '' s = ({y} : set β) ×ˢ s := by tidy

-- The coevaluation map β → C(α, β × α) is continuous (always).
lemma continuous_coev : continuous (coev α β) :=
continuous_generated_from $ begin
  rintros _ ⟨s, sc, u, uo, rfl⟩,
  rw is_open_iff_forall_mem_open,
  intros y hy,
  change (coev α β y) '' s ⊆ u at hy,
  rw image_coev s at hy,
  rcases generalized_tube_lemma is_compact_singleton sc uo hy
    with ⟨v, w, vo, wo, yv, sw, vwu⟩,
  refine ⟨v, _, vo, singleton_subset_iff.mp yv⟩,
  intros y' hy',
  change (coev α β y') '' s ⊆ u,
  rw image_coev s,
  exact subset.trans (prod_mono (singleton_subset_iff.mpr hy') sw) vwu
end

end coev

section curry

/-- Auxiliary definition, see `continuous_map.curry` and `homeomorph.curry`. -/
def curry' (f : C(α × β, γ)) (a : α) : C(β, γ) := ⟨function.curry f a⟩

/-- If a map `α × β → γ` is continuous, then its curried form `α → C(β, γ)` is continuous. -/
lemma continuous_curry' (f : C(α × β, γ)) : continuous (curry' f) :=
have hf : curry' f = continuous_map.comp f ∘ coev _ _, by { ext, refl },
hf ▸ continuous.comp (continuous_comp f) continuous_coev

/-- To show continuity of a map `α → C(β, γ)`, it suffices to show that its uncurried form
    `α × β → γ` is continuous. -/
lemma continuous_of_continuous_uncurry (f : α → C(β, γ))
  (h : continuous (function.uncurry (λ x y, f x y))) : continuous f :=
by { convert continuous_curry' ⟨_, h⟩, ext, refl }

/-- The curried form of a continuous map `α × β → γ` as a continuous map `α → C(β, γ)`.
    If `a × β` is locally compact, this is continuous. If `α` and `β` are both locally
    compact, then this is a homeomorphism, see `homeomorph.curry`. -/
def curry (f : C(α × β, γ)) : C(α, C(β, γ)) :=
⟨_, continuous_curry' f⟩

/-- The currying process is a continuous map between function spaces. -/
lemma continuous_curry [locally_compact_space (α × β)] :
  continuous (curry : C(α × β, γ) → C(α, C(β, γ))) :=
begin
  apply continuous_of_continuous_uncurry,
  apply continuous_of_continuous_uncurry,
  rw ←homeomorph.comp_continuous_iff' (homeomorph.prod_assoc _ _ _).symm,
  convert continuous_eval';
  tidy
end

@[simp]
lemma curry_apply (f : C(α × β, γ)) (a : α) (b : β) : f.curry a b = f (a, b) := rfl

/-- The uncurried form of a continuous map `α → C(β, γ)` is a continuous map `α × β → γ`. -/
lemma continuous_uncurry_of_continuous [locally_compact_space β] (f : C(α, C(β, γ))) :
  continuous (function.uncurry (λ x y, f x y)) :=
continuous_eval'.comp $ f.continuous.prod_map continuous_id

/-- The uncurried form of a continuous map `α → C(β, γ)` as a continuous map `α × β → γ` (if `β` is
    locally compact). If `α` is also locally compact, then this is a homeomorphism between the two
    function spaces, see `homeomorph.curry`. -/
@[simps] def uncurry [locally_compact_space β] (f : C(α, C(β, γ))) : C(α × β, γ) :=
⟨_, continuous_uncurry_of_continuous f⟩

/-- The uncurrying process is a continuous map between function spaces. -/
lemma continuous_uncurry [locally_compact_space α] [locally_compact_space β] :
  continuous (uncurry : C(α, C(β, γ)) → C(α × β, γ)) :=
begin
  apply continuous_of_continuous_uncurry,
  rw ←homeomorph.comp_continuous_iff' (homeomorph.prod_assoc _ _ _),
  apply continuous.comp continuous_eval' (continuous.prod_map continuous_eval' continuous_id);
  apply_instance
end

/-- The family of constant maps: `β → C(α, β)` as a continuous map. -/
def const' : C(β, C(α, β)) := curry ⟨prod.fst, continuous_fst⟩

@[simp] lemma coe_const' : (const' : β → C(α, β)) = const α := rfl

lemma continuous_const' : continuous (const α : β → C(α, β)) := const'.continuous

end curry

end compact_open

end continuous_map

open continuous_map

namespace homeomorph
variables {α : Type*} {β : Type*} {γ : Type*}
variables [topological_space α] [topological_space β] [topological_space γ]

/-- Currying as a homeomorphism between the function spaces `C(α × β, γ)` and `C(α, C(β, γ))`. -/
def curry [locally_compact_space α] [locally_compact_space β] : C(α × β, γ) ≃ₜ C(α, C(β, γ)) :=
⟨⟨curry, uncurry, by tidy, by tidy⟩, continuous_curry, continuous_uncurry⟩

/-- If `α` has a single element, then `β` is homeomorphic to `C(α, β)`. -/
def continuous_map_of_unique [unique α] : β ≃ₜ C(α, β) :=
{ to_fun := const α,
  inv_fun := λ f, f default,
  left_inv := λ a, rfl,
  right_inv := λ f, by { ext, rw unique.eq_default a, refl },
  continuous_to_fun := continuous_const',
  continuous_inv_fun := continuous_eval'.comp (continuous_id.prod_mk continuous_const) }

@[simp]

@[simp] lemma continuous_map_of_unique_symm_apply [unique α] (f : C(α, β)) :
  continuous_map_of_unique.symm f = f default :=
rfl

end homeomorph

section quotient_map

variables {X₀ X Y Z : Type*} [topological_space X₀] [topological_space X]
  [topological_space Y] [topological_space Z] [locally_compact_space Y] {f : X₀ → X}

lemma quotient_map.continuous_lift_prod_left (hf : quotient_map f) {g : X × Y → Z}
  (hg : continuous (λ p : X₀ × Y, g (f p.1, p.2))) : continuous g :=
begin
  let Gf : C(X₀, C(Y, Z)) := continuous_map.curry ⟨_, hg⟩,
  have h : ∀ x : X, continuous (λ y, g (x, y)),
  { intros x,
    obtain ⟨x₀, rfl⟩ := hf.surjective x,
    exact (Gf x₀).continuous },
  let G : X → C(Y, Z) := λ x, ⟨_, h x⟩,
  have : continuous G,
  { rw hf.continuous_iff,
    exact Gf.continuous },
  convert continuous_map.continuous_uncurry_of_continuous ⟨G, this⟩,
  ext x,
  cases x,
  refl,
end

lemma quotient_map.continuous_lift_prod_right (hf : quotient_map f) {g : Y × X → Z}
  (hg : continuous (λ p : Y × X₀, g (p.1, f p.2))) : continuous g :=
begin
  have : continuous (λ p : X₀ × Y, g ((prod.swap p).1, f (prod.swap p).2)),
  { exact hg.comp continuous_swap },
  have : continuous (λ p : X₀ × Y, (g ∘ prod.swap) (f p.1, p.2)) := this,
  convert (hf.continuous_lift_prod_left this).comp continuous_swap,
  ext x,
  simp,
end

end quotient_map


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll
-/
import analysis.locally_convex.basic
import analysis.locally_convex.balanced_core_hull
import analysis.seminorm
import topology.bornology.basic
import topology.algebra.uniform_group
import topology.uniform_space.cauchy

/-!
# Von Neumann Boundedness

This file defines natural or von Neumann bounded sets and proves elementary properties.

## Main declarations

* `bornology.is_vonN_bounded`: A set `s` is von Neumann-bounded if every neighborhood of zero
absorbs `s`.
* `bornology.vonN_bornology`: The bornology made of the von Neumann-bounded sets.

## Main results

* `bornology.is_vonN_bounded.of_topological_space_le`: A coarser topology admits more
von Neumann-bounded sets.
* `bornology.is_vonN_bounded.image`: A continuous linear image of a bounded set is bounded.
* `bornology.is_vonN_bounded_iff_smul_tendsto_zero`: Given any sequence `ε` of scalars which tends
  to `𝓝[≠] 0`, we have that a set `S` is bounded if and only if for any sequence `x : ℕ → S`,
  `ε • x` tends to 0. This shows that bounded sets are completely determined by sequences, which is
  the key fact for proving that sequential continuity implies continuity for linear maps defined on
  a bornological space

## References

* [Bourbaki, *Topological Vector Spaces*][bourbaki1987]

-/

variables {𝕜 𝕜' E E' F ι : Type*}

open set filter
open_locale topology pointwise

namespace bornology

section semi_normed_ring

section has_zero

variables (𝕜)
variables [semi_normed_ring 𝕜] [has_smul 𝕜 E] [has_zero E]
variables [topological_space E]

/-- A set `s` is von Neumann bounded if every neighborhood of 0 absorbs `s`. -/
def is_vonN_bounded (s : set E) : Prop := ∀ ⦃V⦄, V ∈ 𝓝 (0 : E) → absorbs 𝕜 V s

variables (E)

@[simp] lemma is_vonN_bounded_empty : is_vonN_bounded 𝕜 (∅ : set E) :=
λ _ _, absorbs_empty

variables {𝕜 E}

lemma is_vonN_bounded_iff (s : set E) : is_vonN_bounded 𝕜 s ↔ ∀ V ∈ 𝓝 (0 : E), absorbs 𝕜 V s :=
iff.rfl

lemma _root_.filter.has_basis.is_vonN_bounded_basis_iff {q : ι → Prop} {s : ι → set E} {A : set E}
  (h : (𝓝 (0 : E)).has_basis q s) :
  is_vonN_bounded 𝕜 A ↔ ∀ i (hi : q i), absorbs 𝕜 (s i) A :=
begin
  refine ⟨λ hA i hi, hA (h.mem_of_mem hi), λ hA V hV, _⟩,
  rcases h.mem_iff.mp hV with ⟨i, hi, hV⟩,
  exact (hA i hi).mono_left hV,
end

/-- Subsets of bounded sets are bounded. -/
lemma is_vonN_bounded.subset {s₁ s₂ : set E} (h : s₁ ⊆ s₂) (hs₂ : is_vonN_bounded 𝕜 s₂) :
  is_vonN_bounded 𝕜 s₁ :=
λ V hV, (hs₂ hV).mono_right h

/-- The union of two bounded sets is bounded. -/

end has_zero

end semi_normed_ring

section multiple_topologies

variables [semi_normed_ring 𝕜] [add_comm_group E] [module 𝕜 E]

/-- If a topology `t'` is coarser than `t`, then any set `s` that is bounded with respect to
`t` is bounded with respect to `t'`. -/
lemma is_vonN_bounded.of_topological_space_le {t t' : topological_space E} (h : t ≤ t') {s : set E}
  (hs : @is_vonN_bounded 𝕜 E _ _ _ t s) : @is_vonN_bounded 𝕜 E _ _ _ t' s :=
λ V hV, hs $ (le_iff_nhds t t').mp h 0 hV

end multiple_topologies

section image

variables {𝕜₁ 𝕜₂ : Type*} [normed_division_ring 𝕜₁] [normed_division_ring 𝕜₂]
  [add_comm_group E] [module 𝕜₁ E] [add_comm_group F] [module 𝕜₂ F]
  [topological_space E] [topological_space F]

/-- A continuous linear image of a bounded set is bounded. -/
lemma is_vonN_bounded.image {σ : 𝕜₁ →+* 𝕜₂} [ring_hom_surjective σ] [ring_hom_isometric σ]
  {s : set E} (hs : is_vonN_bounded 𝕜₁ s) (f : E →SL[σ] F) :
  is_vonN_bounded 𝕜₂ (f '' s) :=
begin
  let σ' := ring_equiv.of_bijective σ ⟨σ.injective, σ.is_surjective⟩,
  have σ_iso : isometry σ := add_monoid_hom_class.isometry_of_norm σ
    (λ x, ring_hom_isometric.is_iso),
  have σ'_symm_iso : isometry σ'.symm := σ_iso.right_inv σ'.right_inv,
  have f_tendsto_zero := f.continuous.tendsto 0,
  rw map_zero at f_tendsto_zero,
  intros V hV,
  rcases hs (f_tendsto_zero hV) with ⟨r, hrpos, hr⟩,
  refine ⟨r, hrpos, λ a ha, _⟩,
  rw ← σ'.apply_symm_apply a,
  have hanz : a ≠ 0 := norm_pos_iff.mp (hrpos.trans_le ha),
  have : σ'.symm a ≠ 0 := (map_ne_zero σ'.symm.to_ring_hom).mpr hanz,
  change _ ⊆ σ _ • _,
  rw [set.image_subset_iff, preimage_smul_setₛₗ _ _ _ f this.is_unit],
  refine hr (σ'.symm a) _,
  rwa σ'_symm_iso.norm_map_of_map_zero (map_zero _)
end

end image

section sequence

variables {𝕝 : Type*} [normed_field 𝕜] [nontrivially_normed_field 𝕝] [add_comm_group E] [module 𝕜 E]
  [module 𝕝 E] [topological_space E] [has_continuous_smul 𝕝 E]

lemma is_vonN_bounded.smul_tendsto_zero {S : set E} {ε : ι → 𝕜} {x : ι → E} {l : filter ι}
  (hS : is_vonN_bounded 𝕜 S) (hxS : ∀ᶠ n in l, x n ∈ S) (hε : tendsto ε l (𝓝 0)) :
  tendsto (ε • x) l (𝓝 0) :=
begin
  rw tendsto_def at *,
  intros V hV,
  rcases hS hV with ⟨r, r_pos, hrS⟩,
  filter_upwards [hxS, hε _ (metric.ball_mem_nhds 0 $ inv_pos.mpr r_pos)] with n hnS hnr,
  by_cases this : ε n = 0,
  { simp [this, mem_of_mem_nhds hV] },
  { rw [mem_preimage, mem_ball_zero_iff, lt_inv (norm_pos_iff.mpr this) r_pos, ← norm_inv] at hnr,
    rw [mem_preimage, pi.smul_apply', ← set.mem_inv_smul_set_iff₀ this],
    exact hrS _ (hnr.le) hnS },
end

lemma is_vonN_bounded_of_smul_tendsto_zero {ε : ι → 𝕝} {l : filter ι} [l.ne_bot]
  (hε : ∀ᶠ n in l, ε n ≠ 0) {S : set E}
  (H : ∀ x : ι → E, (∀ n, x n ∈ S) → tendsto (ε • x) l (𝓝 0)) :
  is_vonN_bounded 𝕝 S :=
begin
  rw (nhds_basis_balanced 𝕝 E).is_vonN_bounded_basis_iff,
  by_contra' H',
  rcases H' with ⟨V, ⟨hV, hVb⟩, hVS⟩,
  have : ∀ᶠ n in l, ∃ x : S, (ε n) • (x : E) ∉ V,
  { filter_upwards [hε] with n hn,
    rw absorbs at hVS,
    push_neg at hVS,
    rcases hVS _ (norm_pos_iff.mpr $ inv_ne_zero hn) with ⟨a, haε, haS⟩,
    rcases set.not_subset.mp haS with ⟨x, hxS, hx⟩,
    refine ⟨⟨x, hxS⟩, λ hnx, _⟩,
    rw ← set.mem_inv_smul_set_iff₀ hn at hnx,
    exact hx (hVb.smul_mono haε hnx) },
  rcases this.choice with ⟨x, hx⟩,
  refine filter.frequently_false l (filter.eventually.frequently _),
  filter_upwards [hx, (H (coe ∘ x) (λ n, (x n).2)).eventually (eventually_mem_set.mpr hV)]
    using λ n, id
end

/-- Given any sequence `ε` of scalars which tends to `𝓝[≠] 0`, we have that a set `S` is bounded
  if and only if for any sequence `x : ℕ → S`, `ε • x` tends to 0. This actually works for any
  indexing type `ι`, but in the special case `ι = ℕ` we get the important fact that convergent
  sequences fully characterize bounded sets. -/
lemma is_vonN_bounded_iff_smul_tendsto_zero {ε : ι → 𝕝} {l : filter ι} [l.ne_bot]
  (hε : tendsto ε l (𝓝[≠] 0)) {S : set E} :
  is_vonN_bounded 𝕝 S ↔ ∀ x : ι → E, (∀ n, x n ∈ S) → tendsto (ε • x) l (𝓝 0) :=
⟨λ hS x hxS, hS.smul_tendsto_zero (eventually_of_forall hxS) (le_trans hε nhds_within_le_nhds),
  is_vonN_bounded_of_smul_tendsto_zero (hε self_mem_nhds_within)⟩

end sequence

section normed_field

variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E]
variables [topological_space E] [has_continuous_smul 𝕜 E]

/-- Singletons are bounded. -/
lemma is_vonN_bounded_singleton (x : E) : is_vonN_bounded 𝕜 ({x} : set E) :=
λ V hV, (absorbent_nhds_zero hV).absorbs

/-- The union of all bounded set is the whole space. -/
lemma is_vonN_bounded_covers : ⋃₀ (set_of (is_vonN_bounded 𝕜)) = (set.univ : set E) :=
set.eq_univ_iff_forall.mpr (λ x, set.mem_sUnion.mpr
  ⟨{x}, is_vonN_bounded_singleton _, set.mem_singleton _⟩)

variables (𝕜 E)

/-- The von Neumann bornology defined by the von Neumann bounded sets.

Note that this is not registered as an instance, in order to avoid diamonds with the
metric bornology.-/
@[reducible] -- See note [reducible non-instances]
def vonN_bornology : bornology E :=
bornology.of_bounded (set_of (is_vonN_bounded 𝕜)) (is_vonN_bounded_empty 𝕜 E)
  (λ _ hs _ ht, hs.subset ht) (λ _ hs _, hs.union) is_vonN_bounded_singleton

variables {E}

@[simp] lemma is_bounded_iff_is_vonN_bounded {s : set E} :
  @is_bounded _ (vonN_bornology 𝕜 E) s ↔ is_vonN_bounded 𝕜 s :=
is_bounded_of_bounded_iff _

end normed_field

end bornology

section uniform_add_group

variables (𝕜) [nontrivially_normed_field 𝕜] [add_comm_group E] [module 𝕜 E]
variables [uniform_space E] [uniform_add_group E] [has_continuous_smul 𝕜 E]

lemma totally_bounded.is_vonN_bounded {s : set E} (hs : totally_bounded s) :
  bornology.is_vonN_bounded 𝕜 s :=
begin
  rw totally_bounded_iff_subset_finite_Union_nhds_zero at hs,
  intros U hU,
  have h : filter.tendsto (λ (x : E × E), x.fst + x.snd) (𝓝 (0,0)) (𝓝 ((0 : E) + (0 : E))) :=
    tendsto_add,
  rw add_zero at h,
  have h' := (nhds_basis_balanced 𝕜 E).prod (nhds_basis_balanced 𝕜 E),
  simp_rw [←nhds_prod_eq, id.def] at h',
  rcases h.basis_left h' U hU with ⟨x, hx, h''⟩,
  rcases hs x.snd hx.2.1 with ⟨t, ht, hs⟩,
  refine absorbs.mono_right _ hs,
  rw ht.absorbs_Union,
  have hx_fstsnd : x.fst + x.snd ⊆ U,
  { intros z hz,
    rcases set.mem_add.mp hz with ⟨z1, z2, hz1, hz2, hz⟩,
    have hz' : (z1, z2) ∈ x.fst ×ˢ x.snd := ⟨hz1, hz2⟩,
    simpa only [hz] using h'' hz' },
  refine λ y hy, absorbs.mono_left _ hx_fstsnd,
  rw [←set.singleton_vadd, vadd_eq_add],
  exact (absorbent_nhds_zero hx.1.1).absorbs.add hx.2.2.absorbs_self,
end

end uniform_add_group

section vonN_bornology_eq_metric

variables (𝕜 E) [nontrivially_normed_field 𝕜] [seminormed_add_comm_group E] [normed_space 𝕜 E]

namespace normed_space

lemma is_vonN_bounded_ball (r : ℝ) :
  bornology.is_vonN_bounded 𝕜 (metric.ball (0 : E) r) :=
begin
  rw [metric.nhds_basis_ball.is_vonN_bounded_basis_iff, ← ball_norm_seminorm 𝕜 E],
  exact λ ε hε, (norm_seminorm 𝕜 E).ball_zero_absorbs_ball_zero hε
end

lemma is_vonN_bounded_closed_ball (r : ℝ) :
  bornology.is_vonN_bounded 𝕜 (metric.closed_ball (0 : E) r) :=
(is_vonN_bounded_ball 𝕜 E (r+1)).subset (metric.closed_ball_subset_ball $ by linarith)

lemma is_vonN_bounded_iff (s : set E) :
  bornology.is_vonN_bounded 𝕜 s ↔ bornology.is_bounded s :=
begin
  rw [← metric.bounded_iff_is_bounded, metric.bounded_iff_subset_ball (0 : E)],
  split,
  { intros h,
    rcases h (metric.ball_mem_nhds 0 zero_lt_one) with ⟨ρ, hρ, hρball⟩,
    rcases normed_field.exists_lt_norm 𝕜 ρ with ⟨a, ha⟩,
    specialize hρball a ha.le,
    rw [← ball_norm_seminorm 𝕜 E, seminorm.smul_ball_zero (norm_pos_iff.1 $ hρ.trans ha),
        ball_norm_seminorm, mul_one] at hρball,
    exact ⟨‖a‖, hρball.trans metric.ball_subset_closed_ball⟩ },
  { exact λ ⟨C, hC⟩, (is_vonN_bounded_closed_ball 𝕜 E C).subset hC }
end

lemma is_vonN_bounded_iff' (s : set E) :
  bornology.is_vonN_bounded 𝕜 s ↔ ∃ r : ℝ, ∀ (x : E) (hx : x ∈ s), ‖x‖ ≤ r :=
by rw [normed_space.is_vonN_bounded_iff, ←metric.bounded_iff_is_bounded, bounded_iff_forall_norm_le]

lemma image_is_vonN_bounded_iff (f : E' → E) (s : set E') :
  bornology.is_vonN_bounded 𝕜 (f '' s) ↔ ∃ r : ℝ, ∀ (x : E') (hx : x ∈ s), ‖f x‖ ≤ r :=
by simp_rw [is_vonN_bounded_iff', set.ball_image_iff]

/-- In a normed space, the von Neumann bornology (`bornology.vonN_bornology`) is equal to the
metric bornology. -/
lemma vonN_bornology_eq : bornology.vonN_bornology 𝕜 E = pseudo_metric_space.to_bornology :=
begin
  rw bornology.ext_iff_is_bounded,
  intro s,
  rw bornology.is_bounded_iff_is_vonN_bounded,
  exact is_vonN_bounded_iff 𝕜 E s
end

variable (𝕜)

lemma is_bounded_iff_subset_smul_ball {s : set E} :
  bornology.is_bounded s ↔ ∃ a : 𝕜, s ⊆ a • metric.ball 0 1 :=
begin
  rw ← is_vonN_bounded_iff 𝕜,
  split,
  { intros h,
    rcases h (metric.ball_mem_nhds 0 zero_lt_one) with ⟨ρ, hρ, hρball⟩,
    rcases normed_field.exists_lt_norm 𝕜 ρ with ⟨a, ha⟩,
    exact ⟨a, hρball a ha.le⟩ },
  { rintros ⟨a, ha⟩,
    exact ((is_vonN_bounded_ball 𝕜 E 1).image (a • 1 : E →L[𝕜] E)).subset ha }
end

lemma is_bounded_iff_subset_smul_closed_ball {s : set E} :
  bornology.is_bounded s ↔ ∃ a : 𝕜, s ⊆ a • metric.closed_ball 0 1 :=
begin
  split,
  { rw is_bounded_iff_subset_smul_ball 𝕜,
    exact exists_imp_exists
      (λ a ha, ha.trans $ set.smul_set_mono $ metric.ball_subset_closed_ball) },
  { rw ← is_vonN_bounded_iff 𝕜,
    rintros ⟨a, ha⟩,
    exact ((is_vonN_bounded_closed_ball 𝕜 E 1).image (a • 1 : E →L[𝕜] E)).subset ha }
end

end normed_space

end vonN_bornology_eq_metric


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_200 :
  139 % 11 = 7 :=
begin
  norm_num,
end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.witt_vector.frobenius
import Mathlib.ring_theory.witt_vector.verschiebung
import Mathlib.ring_theory.witt_vector.mul_p
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
## Identities between operations on the ring of Witt vectors

In this file we derive common identities between the Frobenius and Verschiebung operators.

## Main declarations

* `frobenius_verschiebung`: the composition of Frobenius and Verschiebung is multiplication by `p`
* `verschiebung_mul_frobenius`: the “projection formula”: `V(x * F y) = V x * y`
-/

namespace witt_vector

/-- The composition of Frobenius and Verschiebung is multiplication by `p`. -/
theorem frobenius_verschiebung {p : ℕ} {R : Type u_1} [fact (nat.prime p)] [comm_ring R]
    (x : witt_vector p R) : coe_fn frobenius (coe_fn verschiebung x) = x * ↑p :=
  sorry

/-- Verschiebung is the same as multiplication by `p` on the ring of Witt vectors of `zmod p`. -/
theorem verschiebung_zmod {p : ℕ} [fact (nat.prime p)] (x : witt_vector p (zmod p)) :
    coe_fn verschiebung x = x * ↑p :=
  sorry

theorem coeff_p_pow {p : ℕ} {R : Type u_1} [fact (nat.prime p)] [comm_ring R] [char_p R p] (i : ℕ) :
    coeff (↑p ^ i) i = 1 :=
  sorry

/-- The “projection formula” for Frobenius and Verschiebung. -/
theorem verschiebung_mul_frobenius {p : ℕ} {R : Type u_1} [fact (nat.prime p)] [comm_ring R]
    (x : witt_vector p R) (y : witt_vector p R) :
    coe_fn verschiebung (x * coe_fn frobenius y) = coe_fn verschiebung x * y :=
  sorry

end Mathlib


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek

! This file was ported from Lean 3 source module tactic.omega.nat.dnf
! leanprover-community/mathlib commit 402f8982dddc1864bd703da2d6e2ee304a866973
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.ProdSigma
import Mathbin.Tactic.Omega.Clause
import Mathbin.Tactic.Omega.Nat.Form

/-!
# DNF transformation
-/

namespace Omega

namespace Nat

open Omega.Nat

@[simp]
def dnfCore : Preform → List Clause
  | p ∨* q => dnf_core p ++ dnf_core q
  | p ∧* q => (List.product (dnf_core p) (dnf_core q)).map fun pq => Clause.append pq.fst pq.snd
  | t =* s => [([Term.sub (canonize s) (canonize t)], [])]
  | t ≤* s => [([], [Term.sub (canonize s) (canonize t)])]
  | ¬* _ => []
#align omega.nat.dnf_core Omega.Nat.dnfCore

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic omega.nat.preform.induce -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
theorem exists_clause_holds_core {v : Nat → Nat} :
    ∀ {p : Preform},
      p.NegFree → p.SubFree → p.Holds v → ∃ c ∈ dnfCore p, Clause.Holds (fun x => ↑(v x)) c :=
  by
  run_tac
    preform.induce sorry
  · apply List.exists_mem_cons_of
    constructor
    rw [List.forall_mem_singleton]
    cases' h0 with ht hs
    simp only [val_canonize ht, val_canonize hs, term.val_sub, preform.holds, sub_eq_add_neg] at *
    rw [h2, add_neg_self]
    apply List.forall_mem_nil
  · apply List.exists_mem_cons_of
    constructor
    apply List.forall_mem_nil
    rw [List.forall_mem_singleton]
    simp only [val_canonize h0.left, val_canonize h0.right, term.val_sub, preform.holds,
      sub_eq_add_neg] at *
    rw [← sub_eq_add_neg, le_sub_comm, sub_zero, Int.ofNat_le]
    assumption
  · cases h1
  ·
    cases' h2 with h2 h2 <;> [· cases' ihp h1.left h0.left h2 with c h3,
              · cases' ihq h1.right h0.right h2 with c h3] <;>
            cases' h3 with h3 h4 <;>
          refine' ⟨c, list.mem_append.elim_right _, h4⟩ <;>
        [left, right] <;>
      assumption
  · rcases ihp h1.left h0.left h2.left with ⟨cp, hp1, hp2⟩
    rcases ihq h1.right h0.right h2.right with ⟨cq, hq1, hq2⟩
    refine' ⟨clause.append cp cq, ⟨_, clause.holds_append hp2 hq2⟩⟩
    simp only [dnf_core, List.mem_map]
    refine' ⟨(cp, cq), ⟨_, rfl⟩⟩
    rw [List.mem_product]
    constructor <;> assumption
#align omega.nat.exists_clause_holds_core Omega.Nat.exists_clause_holds_core

def Term.varsCore (is : List Int) : List Bool :=
  is.map fun i => if i = 0 then false else true
#align omega.nat.term.vars_core Omega.Nat.Term.varsCore

/-- Return a list of bools that encodes which variables have nonzero coefficients -/
def Term.vars (t : Term) : List Bool :=
  Term.varsCore t.snd
#align omega.nat.term.vars Omega.Nat.Term.vars

def Bools.or : List Bool → List Bool → List Bool
  | [], bs2 => bs2
  | bs1, [] => bs1
  | b1 :: bs1, b2 :: bs2 => (b1 || b2) :: bools.or bs1 bs2
#align omega.nat.bools.or Omega.Nat.Bools.or

/-- Return a list of bools that encodes which variables have nonzero coefficients in any one of the
input terms. -/
def Terms.vars : List Term → List Bool
  | [] => []
  | t :: ts => Bools.or (Term.vars t) (terms.vars ts)
#align omega.nat.terms.vars Omega.Nat.Terms.vars

open List.Func

-- get notation for list.func.set
def nonnegConstsCore : Nat → List Bool → List Term
  | _, [] => []
  | k, ff :: bs => nonneg_consts_core (k + 1) bs
  | k, tt :: bs => ⟨0, [] {k ↦ 1}⟩ :: nonneg_consts_core (k + 1) bs
#align omega.nat.nonneg_consts_core Omega.Nat.nonnegConstsCore

def nonnegConsts (bs : List Bool) : List Term :=
  nonnegConstsCore 0 bs
#align omega.nat.nonneg_consts Omega.Nat.nonnegConsts

def nonnegate : Clause → Clause
  | (eqs, les) =>
    let xs := Terms.vars eqs
    let ys := Terms.vars les
    let bs := Bools.or xs ys
    (eqs, nonnegConsts bs ++ les)
#align omega.nat.nonnegate Omega.Nat.nonnegate

/-- DNF transformation -/
def dnf (p : Preform) : List Clause :=
  (dnfCore p).map nonnegate
#align omega.nat.dnf Omega.Nat.dnf

theorem holds_nonnegConstsCore {v : Nat → Int} (h1 : ∀ x, 0 ≤ v x) :
    ∀ m bs, ∀ t ∈ nonnegConstsCore m bs, 0 ≤ Term.val v t
  | _, [] => fun _ h2 => by cases h2
  | k, ff :: bs => holds_nonneg_consts_core (k + 1) bs
  | k, tt :: bs => by
    simp only [nonneg_consts_core]
    rw [List.forall_mem_cons]
    constructor
    · simp only [term.val, one_mul, zero_add, coeffs.val_set]
      apply h1
    · apply holds_nonneg_consts_core (k + 1) bs
#align omega.nat.holds_nonneg_consts_core Omega.Nat.holds_nonnegConstsCore

theorem holds_nonnegConsts {v : Nat → Int} {bs : List Bool} :
    (∀ x, 0 ≤ v x) → ∀ t ∈ nonnegConsts bs, 0 ≤ Term.val v t
  | h1 => by apply holds_nonneg_consts_core h1
#align omega.nat.holds_nonneg_consts Omega.Nat.holds_nonnegConsts

theorem exists_clause_holds {v : Nat → Nat} {p : Preform} :
    p.NegFree → p.SubFree → p.Holds v → ∃ c ∈ dnf p, Clause.Holds (fun x => ↑(v x)) c :=
  by
  intro h1 h2 h3
  rcases exists_clause_holds_core h1 h2 h3 with ⟨c, h4, h5⟩
  exists nonnegate c
  have h6 : nonnegate c ∈ dnf p := by
    simp only [dnf]
    rw [List.mem_map]
    refine' ⟨c, h4, rfl⟩
  refine' ⟨h6, _⟩
  cases' c with eqs les
  simp only [nonnegate, clause.holds]
  constructor
  apply h5.left
  rw [List.forall_mem_append]
  apply And.intro (holds_nonneg_consts _) h5.right
  intro x
  apply Int.coe_nat_nonneg
#align omega.nat.exists_clause_holds Omega.Nat.exists_clause_holds

theorem exists_clause_sat {p : Preform} :
    p.NegFree → p.SubFree → p.Sat → ∃ c ∈ dnf p, Clause.Sat c :=
  by
  intro h1 h2 h3; cases' h3 with v h3
  rcases exists_clause_holds h1 h2 h3 with ⟨c, h4, h5⟩
  refine' ⟨c, h4, _, h5⟩
#align omega.nat.exists_clause_sat Omega.Nat.exists_clause_sat

theorem unsat_of_unsat_dnf (p : Preform) :
    p.NegFree → p.SubFree → Clauses.Unsat (dnf p) → p.Unsat :=
  by
  intro hnf hsf h1 h2; apply h1
  apply exists_clause_sat hnf hsf h2
#align omega.nat.unsat_of_unsat_dnf Omega.Nat.unsat_of_unsat_dnf

end Nat

end Omega


import topology.algebra.order.compact
import topology.instances.real

/-- A variant of `is_compact.exists_forall_le` for real-valued functions that does not require the
assumption `s.nonempty`. -/
lemma is_compact.exists_forall_le' {β : Type*} [topological_space β]
  {s : set β} (hs : is_compact s)
  {f : β → ℝ} (hf : continuous_on f s) {a : ℝ} (hf' : ∀ b ∈ s, a < f b) :
  ∃ a', a < a' ∧ ∀ b ∈ s, a' ≤ f b :=
begin
  rcases s.eq_empty_or_nonempty with rfl | hs',
  { exact ⟨a + 1, by simp only [lt_add_iff_pos_right, zero_lt_one], λ b hb, by simpa using hb⟩, },
  { obtain ⟨x, hx, hx'⟩ := hs.exists_forall_le hs' hf,
    exact ⟨f x, hf' x hx, hx'⟩, },
end


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/

import ring_theory.graded_algebra.basic
import algebra.graded_mul_action
import algebra.direct_sum.decomposition
import algebra.module.big_operators

/-!
# Graded Module

Given an `R`-algebra `A` graded by `𝓐`, a graded `A`-module `M` is expressed as
`direct_sum.decomposition 𝓜` and `set_like.has_graded_smul 𝓐 𝓜`.
Then `⨁ i, 𝓜 i` is an `A`-module and is isomorphic to `M`.

## Tags

graded module
-/

section

open_locale direct_sum

variables {ι : Type*} (A : ι → Type*) (M : ι → Type*)

namespace direct_sum
open graded_monoid

/-- A graded version of `distrib_mul_action`. -/
class gdistrib_mul_action [add_monoid ι] [gmonoid A] [Π i, add_monoid (M i)]
  extends gmul_action A M :=
(smul_add {i j} (a : A i) (b c : M j) : smul a (b + c) = smul a b + smul a c)
(smul_zero {i j} (a : A i) : smul a (0 : M j) = 0)

/-- A graded version of `module`. -/
class gmodule [add_monoid ι] [Π i, add_monoid (A i)] [Π i, add_monoid (M i)]
  [gmonoid A] extends gdistrib_mul_action A M :=
(add_smul {i j} (a a' : A i) (b : M j) : smul (a + a') b = smul a b + smul a' b)
(zero_smul {i j} (b : M j) : smul (0 : A i) b = 0)

/-- A graded version of `semiring.to_module`. -/
instance gsemiring.to_gmodule [decidable_eq ι] [add_monoid ι]
  [Π (i : ι), add_comm_monoid (A i)] [gsemiring A] :
  gmodule A A :=
{ smul_add := λ _ _, gsemiring.mul_add,
  smul_zero := λ i j, gsemiring.mul_zero,
  add_smul := λ i j, gsemiring.add_mul,
  zero_smul := λ i j, gsemiring.zero_mul,
  ..gmonoid.to_gmul_action A }

variables [add_monoid ι] [Π (i : ι), add_comm_monoid (A i)] [Π i, add_comm_monoid (M i)]

/-- The piecewise multiplication from the `has_mul` instance, as a bundled homomorphism. -/
@[simps] def gsmul_hom [gmonoid A] [gmodule A M] {i j} :
  A i →+ M j →+ M (i + j) :=
{ to_fun := λ a,
  { to_fun := λ b, ghas_smul.smul a b,
    map_zero' := gdistrib_mul_action.smul_zero _,
    map_add' := gdistrib_mul_action.smul_add _ },
  map_zero' := add_monoid_hom.ext $ λ a, gmodule.zero_smul a,
  map_add' := λ a₁ a₂, add_monoid_hom.ext $ λ b, gmodule.add_smul _ _ _}

namespace gmodule

/-- For graded monoid `A` and a graded module `M` over `A`. `gmodule.smul_add_monoid_hom` is the
`⨁ᵢ Aᵢ`-scalar multiplication on `⨁ᵢ Mᵢ` induced by `gsmul_hom`. -/
def smul_add_monoid_hom
  [decidable_eq ι] [gmonoid A] [gmodule A M] :
  (⨁ i, A i) →+ (⨁ i, M i) →+ (⨁ i, M i) :=
to_add_monoid $ λ i, add_monoid_hom.flip $
  to_add_monoid $ λ j, add_monoid_hom.flip $
    (of M _).comp_hom.comp $ gsmul_hom A M

section

open graded_monoid direct_sum gmodule

instance [decidable_eq ι] [gmonoid A] [gmodule A M] :
  has_smul (⨁ i, A i) (⨁ i, M i) :=
{ smul := λ x y, smul_add_monoid_hom A M x y }

@[simp] lemma smul_def [decidable_eq ι] [gmonoid A] [gmodule A M]
  (x : ⨁ i, A i) (y : ⨁ i, M i) : x • y = smul_add_monoid_hom _ _ x y := rfl

@[simp] lemma smul_add_monoid_hom_apply_of_of [decidable_eq ι] [gmonoid A] [gmodule A M]
  {i j} (x : A i) (y : M j) :
  smul_add_monoid_hom A M (direct_sum.of A i x) (of M j y) =
  of M (i + j) (ghas_smul.smul x y) :=
by simp [smul_add_monoid_hom]

@[simp] lemma of_smul_of [decidable_eq ι] [gmonoid A] [gmodule A M]
  {i j} (x : A i) (y : M j) :
  direct_sum.of A i x • of M j y = of M (i + j) (ghas_smul.smul x y) :=
smul_add_monoid_hom_apply_of_of _ _ _ _

open add_monoid_hom

-- Almost identical to the proof of `direct_sum.one_mul`
private lemma one_smul [decidable_eq ι] [gmonoid A] [gmodule A M] (x : ⨁ i, M i) :
  (1 : ⨁ i, A i) • x = x :=
suffices smul_add_monoid_hom A M 1 = add_monoid_hom.id (⨁ i, M i),
  from add_monoid_hom.congr_fun this x,
begin
  apply direct_sum.add_hom_ext, intros i xi,
  unfold has_one.one,
  rw smul_add_monoid_hom_apply_of_of,
  exact direct_sum.of_eq_of_graded_monoid_eq (one_smul (graded_monoid A) $ graded_monoid.mk i xi),
end

-- Almost identical to the proof of `direct_sum.mul_assoc`
private lemma mul_smul [decidable_eq ι] [gsemiring A] [gmodule A M]
  (a b : ⨁ i, A i) (c : ⨁ i, M i) : (a * b) • c = a • (b • c) :=
suffices (smul_add_monoid_hom A M).comp_hom.comp (direct_sum.mul_hom A)
      -- `λ a b c, (a * b) • c` as a bundled hom
      = (add_monoid_hom.comp_hom add_monoid_hom.flip_hom $
          (smul_add_monoid_hom A M).flip.comp_hom.comp $ smul_add_monoid_hom A M).flip,
      -- `λ a b c, a • (b • c)` as a bundled hom
  from add_monoid_hom.congr_fun (add_monoid_hom.congr_fun (add_monoid_hom.congr_fun this a) b) c,
begin
  ext ai ax bi bx ci cx : 6,
  dsimp only [coe_comp, function.comp_app, comp_hom_apply_apply, flip_apply, flip_hom_apply],
  rw [smul_add_monoid_hom_apply_of_of, smul_add_monoid_hom_apply_of_of,
    direct_sum.mul_hom_of_of, smul_add_monoid_hom_apply_of_of],
  exact direct_sum.of_eq_of_graded_monoid_eq
    (mul_smul (graded_monoid.mk ai ax) (graded_monoid.mk bi bx) (graded_monoid.mk ci cx)),
end

/-- The `module` derived from `gmodule A M`. -/
instance module [decidable_eq ι] [gsemiring A] [gmodule A M] :
  module (⨁ i, A i) (⨁ i, M i) :=
{ smul := (•),
  one_smul := one_smul _ _,
  mul_smul := mul_smul _ _,
  smul_add := λ r, (smul_add_monoid_hom A M r).map_add,
  smul_zero := λ r, (smul_add_monoid_hom A M r).map_zero,
  add_smul := λ r s x, by simp only [smul_def, map_add, add_monoid_hom.add_apply],
  zero_smul := λ x, by simp only [smul_def, map_zero, add_monoid_hom.zero_apply] }

end

end gmodule

end direct_sum

end

open_locale direct_sum big_operators

variables {ι R A M σ σ' : Type*}
variables [add_monoid ι] [comm_semiring R] [semiring A] [algebra R A]
variables (𝓐 : ι → σ') [set_like σ' A]
variables (𝓜 : ι → σ)

namespace set_like

include σ' A σ M

instance gmul_action [add_monoid M] [distrib_mul_action A M]
  [set_like σ M] [set_like.graded_monoid 𝓐] [set_like.has_graded_smul 𝓐 𝓜] :
  graded_monoid.gmul_action (λ i, 𝓐 i) (λ i, 𝓜 i) :=
{ one_smul := λ ⟨i, m⟩, sigma.subtype_ext (zero_add _) (one_smul _ _),
  mul_smul := λ ⟨i, a⟩ ⟨j, a'⟩ ⟨k, b⟩, sigma.subtype_ext (add_assoc _ _ _) (mul_smul _ _ _),
  ..set_like.ghas_smul 𝓐 𝓜 }

instance gdistrib_mul_action [add_monoid M] [distrib_mul_action A M]
  [set_like σ M] [add_submonoid_class σ M] [set_like.graded_monoid 𝓐]
  [set_like.has_graded_smul 𝓐 𝓜] :
  direct_sum.gdistrib_mul_action (λ i, 𝓐 i) (λ i, 𝓜 i) :=
{ smul_add := λ i j a b c, subtype.ext $ smul_add _ _ _,
  smul_zero := λ i j a, subtype.ext $ smul_zero _,
  ..set_like.gmul_action 𝓐 𝓜 }

variables [add_comm_monoid M] [module A M] [set_like σ M] [add_submonoid_class σ' A]
  [add_submonoid_class σ M] [set_like.graded_monoid 𝓐] [set_like.has_graded_smul 𝓐 𝓜]

/-- `[set_like.graded_monoid 𝓐] [set_like.has_graded_smul 𝓐 𝓜]` is the internal version of graded
  module, the internal version can be translated into the external version `gmodule`. -/
instance gmodule : direct_sum.gmodule (λ i, 𝓐 i) (λ i, 𝓜 i) :=
{ smul := λ i j x y, ⟨(x : A) • (y : M), set_like.has_graded_smul.smul_mem x.2 y.2⟩,
  add_smul := λ i j a a' b, subtype.ext $ add_smul _ _ _,
  zero_smul := λ i j b, subtype.ext $ zero_smul _ _,
  ..set_like.gdistrib_mul_action 𝓐 𝓜}

end set_like

namespace graded_module

include σ' A σ M

variables [add_comm_monoid M] [module A M] [set_like σ M] [add_submonoid_class σ' A]
  [add_submonoid_class σ M] [set_like.graded_monoid 𝓐] [set_like.has_graded_smul 𝓐 𝓜]

/--
The smul multiplication of `A` on `⨁ i, 𝓜 i` from `(⨁ i, 𝓐 i) →+ (⨁ i, 𝓜 i) →+ ⨁ i, 𝓜 i`
turns `⨁ i, 𝓜 i` into an `A`-module
-/
def is_module [decidable_eq ι] [graded_ring 𝓐] :
  module A (⨁ i, 𝓜 i) :=
{ smul := λ a b, direct_sum.decompose 𝓐 a • b,
  .. module.comp_hom _ (direct_sum.decompose_ring_equiv 𝓐 : A ≃+* ⨁ i, 𝓐 i).to_ring_hom }

local attribute [instance] graded_module.is_module

/--
`⨁ i, 𝓜 i` and `M` are isomorphic as `A`-modules.
"The internal version" and "the external version" are isomorphism as `A`-modules.
-/
def linear_equiv [decidable_eq ι] [graded_ring 𝓐]
  [direct_sum.decomposition 𝓜] :
  M ≃ₗ[A] ⨁ i, 𝓜 i :=
{ to_fun := direct_sum.decompose_add_equiv 𝓜,
  map_smul' := λ x y, begin
    classical,
    rw [← direct_sum.sum_support_decompose 𝓐 x, map_sum, finset.sum_smul, map_sum,
      finset.sum_smul, finset.sum_congr rfl (λ i hi, _)],
    rw [ring_hom.id_apply, ← direct_sum.sum_support_decompose 𝓜 y, map_sum, finset.smul_sum,
      map_sum, finset.smul_sum, finset.sum_congr rfl (λ j hj, _)],
    simp only [(•), direct_sum.decompose_add_equiv_apply, direct_sum.decompose_coe,
      direct_sum.gmodule.smul_add_monoid_hom_apply_of_of],
    convert direct_sum.decompose_coe 𝓜 _,
    refl,
  end,
  .. direct_sum.decompose_add_equiv 𝓜 }

end graded_module


-- Copyright © 2019 François G. Dorais. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.

import .basic
import .unital
import .quasigroup

set_option default_priority 0

namespace algebra

signature loop (α : Type*) :=
(op : α → α → α)
(ldiv : α → α → α)
(rdiv : α → α → α)
(id : α)

namespace loop_sig
variables {α : Type*} (s : loop_sig α)

abbreviation linv (x : α) : α := s.rdiv s.id x -- (λ x, e / x)

abbreviation rinv (x : α) : α := s.ldiv x s.id -- (λ x, x \ e)

@[signature_instance]
definition to_quasigroup : quasigroup_sig α :=
{ op := s.op
, ldiv := s.ldiv
, rdiv := s.rdiv
}

@[signature_instance]
definition to_unital : unital_sig α :=
{ op := s.op
, id := s.id
}

end loop_sig

variables {α : Type*} (s : loop_sig α)
local infix ∙ := s.op
local infix \ := s.ldiv
local infix / := s.rdiv
local notation `e` := s.id

@[theory]
class loop : Prop := intro ::
(left_identity : identity.op_left_identity s.op s.id)
(right_identity : identity.op_right_identity s.op s.id)
(left_cancel : identity.op_left_cancellative s.op)
(right_cancel : identity.op_right_cancellative s.op)
(left_division : identity.op_left_division s.op s.ldiv)
(right_division : identity.op_right_division s.op s.rdiv)

namespace loop
variable [i : loop s]
include i

@[identity_instance]
theorem left_inverse : identity.op_left_inverse s.op s.linv s.id :=
λ x, op_right_division s.op s.rdiv x e

@[identity_instance]
theorem right_inverse : identity.op_right_inverse s.op s.rinv s.id :=
λ x, op_left_division s.op s.ldiv x e

instance to_quasigroup : quasigroup s.to_quasigroup := quasigroup.infer _

instance to_cancel_unital : cancel_unital s.to_unital := cancel_unital.infer _

end loop

end algebra