/-
Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn

! This file was ported from Lean 3 source module model_theory.basic
! leanprover-community/mathlib commit 369525b73f229ccd76a6ec0e0e0bf2be57599768
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fin.VecNotation
import Mathlib.SetTheory.Cardinal.Basic

/-!
# Basics on First-Order Structures
This file defines first-order languages and structures in the style of the
[Flypitch project](https://flypitch.github.io/), as well as several important maps between
structures.

## Main Definitions
* A `FirstOrder.Language` defines a language as a pair of functions from the natural numbers to
  `Type l`. One sends `n` to the type of `n`-ary functions, and the other sends `n` to the type of
  `n`-ary relations.
* A `FirstOrder.Language.Structure` interprets the symbols of a given `FirstOrder.Language` in the
  context of a given type.
* A `FirstOrder.Language.Hom`, denoted `M →[L] N`, is a map from the `L`-structure `M` to the
  `L`-structure `N` that commutes with the interpretations of functions, and which preserves the
  interpretations of relations (although only in the forward direction).
* A `FirstOrder.Language.Embedding`, denoted `M ↪[L] N`, is an embedding from the `L`-structure `M`
  to the `L`-structure `N` that commutes with the interpretations of functions, and which preserves
  the interpretations of relations in both directions.
* A `FirstOrder.Language.ElementaryEmbedding`, denoted `M ↪ₑ[L] N`, is an embedding from the
  `L`-structure `M` to the `L`-structure `N` that commutes with the realizations of all formulas.
* A `FirstOrder.Language.Equiv`, denoted `M ≃[L] N`, is an equivalence from the `L`-structure `M`
  to the `L`-structure `N` that commutes with the interpretations of functions, and which preserves
  the interpretations of relations in both directions.

## TODO

Use `[Countable L.symbols]` instead of `[L.countable]`.

## References
For the Flypitch project:
- [J. Han, F. van Doorn, *A formal proof of the independence of the continuum hypothesis*]
[flypitch_cpp]
- [J. Han, F. van Doorn, *A formalization of forcing and the unprovability of
the continuum hypothesis*][flypitch_itp]

-/

universe u v u' v' w w'

open Cardinal

open Cardinal

namespace FirstOrder

/-! ### Languages and Structures -/

-- intended to be used with explicit universe parameters
/-- A first-order language consists of a type of functions of every natural-number arity and a
  type of relations of every natural-number arity. -/
@[nolint checkUnivs]
structure Language where
  /-- For every arity, a `Type _` of functions of that arity -/
  Functions : ℕ → Type u
  /-- For every arity, a `Type _` of relations of that arity -/
  Relations : ℕ → Type v
#align first_order.language FirstOrder.Language

/-- Used to define `FirstOrder.Language₂`. -/
--@[simp]
def Sequence₂ (a₀ a₁ a₂ : Type u) : ℕ → Type u
  | 0 => a₀
  | 1 => a₁
  | 2 => a₂
  | _ => PEmpty
#align first_order.sequence₂ FirstOrder.Sequence₂

namespace Sequence₂

variable (a₀ a₁ a₂ : Type u)

instance inhabited₀ [h : Inhabited a₀] : Inhabited (Sequence₂ a₀ a₁ a₂ 0) :=
  h
#align first_order.sequence₂.inhabited₀ FirstOrder.Sequence₂.inhabited₀

instance inhabited₁ [h : Inhabited a₁] : Inhabited (Sequence₂ a₀ a₁ a₂ 1) :=
  h
#align first_order.sequence₂.inhabited₁ FirstOrder.Sequence₂.inhabited₁

instance inhabited₂ [h : Inhabited a₂] : Inhabited (Sequence₂ a₀ a₁ a₂ 2) :=
  h
#align first_order.sequence₂.inhabited₂ FirstOrder.Sequence₂.inhabited₂

instance {n : ℕ} : IsEmpty (Sequence₂ a₀ a₁ a₂ (n + 3)) := inferInstanceAs (IsEmpty PEmpty)

@[simp]
theorem lift_mk {i : ℕ} :
    Cardinal.lift.{v,u} (#Sequence₂ a₀ a₁ a₂ i)
      = (#Sequence₂ (ULift.{v,u} a₀) (ULift.{v,u} a₁) (ULift.{v,u} a₂) i) := by
  rcases i with (_ | _ | _ | i) <;>
    simp only [Sequence₂, mk_uLift, mk_fintype, Fintype.card_of_isEmpty, Nat.cast_zero, lift_zero]
#align first_order.sequence₂.lift_mk FirstOrder.Sequence₂.lift_mk

@[simp]
theorem sum_card : (Cardinal.sum fun i => #Sequence₂ a₀ a₁ a₂ i) = (#a₀) + (#a₁) + (#a₂) := by
  rw [sum_nat_eq_add_sum_succ, sum_nat_eq_add_sum_succ, sum_nat_eq_add_sum_succ]
  simp [add_assoc, Sequence₂]
#align first_order.sequence₂.sum_card FirstOrder.Sequence₂.sum_card

end Sequence₂

namespace Language

/-- A constructor for languages with only constants, unary and binary functions, and
unary and binary relations. -/
@[simps]
protected def mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) : Language :=
  ⟨Sequence₂ c f₁ f₂, Sequence₂ PEmpty r₁ r₂⟩
#align first_order.language.mk₂ FirstOrder.Language.mk₂

/-- The empty language has no symbols. -/
protected def empty : Language :=
  ⟨fun _ => Empty, fun _ => Empty⟩
#align first_order.language.empty FirstOrder.Language.empty

instance : Inhabited Language :=
  ⟨Language.empty⟩

/-- The sum of two languages consists of the disjoint union of their symbols. -/
protected def sum (L : Language.{u, v}) (L' : Language.{u', v'}) : Language :=
  ⟨fun n => Sum (L.Functions n) (L'.Functions n), fun n => Sum (L.Relations n) (L'.Relations n)⟩
#align first_order.language.sum FirstOrder.Language.sum

variable (L : Language.{u, v})

/-- The type of constants in a given language. -/
-- Porting note: The linter does not exist yet, according to Algebra.Hom.GroupAction.
-- @[nolint has_nonempty_instance]
protected def Constants :=
  L.Functions 0
#align first_order.language.constants FirstOrder.Language.Constants

@[simp]
theorem constants_mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) :
    (Language.mk₂ c f₁ f₂ r₁ r₂).Constants = c :=
  rfl
#align first_order.language.constants_mk₂ FirstOrder.Language.constants_mk₂

/-- The type of symbols in a given language. -/
-- Porting note: The linter does not exist yet, according to Algebra.Hom.GroupAction.
-- @[nolint has_nonempty_instance]
def Symbols :=
  Sum (Σl, L.Functions l) (Σl, L.Relations l)
#align first_order.language.symbols FirstOrder.Language.Symbols

/-- The cardinality of a language is the cardinality of its type of symbols. -/
def card : Cardinal :=
  #L.Symbols
#align first_order.language.card FirstOrder.Language.card

/-- A language is relational when it has no function symbols. -/
class IsRelational : Prop where
  /-- There are no function symbols in the language. -/
  empty_functions : ∀ n, IsEmpty (L.Functions n)
#align first_order.language.is_relational FirstOrder.Language.IsRelational

/-- A language is algebraic when it has no relation symbols. -/
class IsAlgebraic : Prop where
  /-- There are no relation symbols in the language. -/
  empty_relations : ∀ n, IsEmpty (L.Relations n)
#align first_order.language.is_algebraic FirstOrder.Language.IsAlgebraic

variable {L} {L' : Language.{u', v'}}

theorem card_eq_card_functions_add_card_relations :
    L.card =
      (Cardinal.sum fun l => Cardinal.lift.{v} (#L.Functions l)) +
        Cardinal.sum fun l => Cardinal.lift.{u} (#L.Relations l) := by
  simp [card, Symbols]
#align
  first_order.language.card_eq_card_functions_add_card_relations
  FirstOrder.Language.card_eq_card_functions_add_card_relations

instance [L.IsRelational] {n : ℕ} : IsEmpty (L.Functions n) :=
  IsRelational.empty_functions n

instance [L.IsAlgebraic] {n : ℕ} : IsEmpty (L.Relations n) :=
  IsAlgebraic.empty_relations n

instance isRelational_of_empty_functions {symb : ℕ → Type _} :
    IsRelational ⟨fun _ => Empty, symb⟩ :=
  ⟨fun _ => instIsEmptyEmpty⟩
#align
  first_order.language.is_relational_of_empty_functions
  FirstOrder.Language.isRelational_of_empty_functions

instance isAlgebraic_of_empty_relations {symb : ℕ → Type _} : IsAlgebraic ⟨symb, fun _ => Empty⟩ :=
  ⟨fun _ => instIsEmptyEmpty⟩
#align
  first_order.language.is_algebraic_of_empty_relations
  FirstOrder.Language.isAlgebraic_of_empty_relations

instance isRelational_empty : IsRelational Language.empty :=
  Language.isRelational_of_empty_functions
#align first_order.language.is_relational_empty FirstOrder.Language.isRelational_empty

instance isAlgebraic_empty : IsAlgebraic Language.empty :=
  Language.isAlgebraic_of_empty_relations
#align first_order.language.is_algebraic_empty FirstOrder.Language.isAlgebraic_empty

instance isRelational_sum [L.IsRelational] [L'.IsRelational] : IsRelational (L.sum L') :=
  ⟨fun _ => instIsEmptySum⟩
#align first_order.language.is_relational_sum FirstOrder.Language.isRelational_sum

instance isAlgebraic_sum [L.IsAlgebraic] [L'.IsAlgebraic] : IsAlgebraic (L.sum L') :=
  ⟨fun _ => instIsEmptySum⟩
#align first_order.language.is_algebraic_sum FirstOrder.Language.isAlgebraic_sum

instance isRelational_mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v} [h0 : IsEmpty c] [h1 : IsEmpty f₁]
    [h2 : IsEmpty f₂] : IsRelational (Language.mk₂ c f₁ f₂ r₁ r₂) :=
  ⟨fun n =>
    Nat.casesOn n h0 fun n => Nat.casesOn n h1 fun n => Nat.casesOn n h2 fun _ =>
      inferInstanceAs (IsEmpty PEmpty)⟩
#align first_order.language.is_relational_mk₂ FirstOrder.Language.isRelational_mk₂

instance isAlgebraic_mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v} [h1 : IsEmpty r₁] [h2 : IsEmpty r₂] :
    IsAlgebraic (Language.mk₂ c f₁ f₂ r₁ r₂) :=
  ⟨fun n =>
    Nat.casesOn n (inferInstanceAs (IsEmpty PEmpty)) fun n =>
      Nat.casesOn n h1 fun n => Nat.casesOn n h2 fun _ => inferInstanceAs (IsEmpty PEmpty)⟩
#align first_order.language.is_algebraic_mk₂ FirstOrder.Language.isAlgebraic_mk₂

instance subsingleton_mk₂_functions {c f₁ f₂ : Type u} {r₁ r₂ : Type v} [h0 : Subsingleton c]
    [h1 : Subsingleton f₁] [h2 : Subsingleton f₂] {n : ℕ} :
    Subsingleton ((Language.mk₂ c f₁ f₂ r₁ r₂).Functions n) :=
  Nat.casesOn n h0 fun n =>
    Nat.casesOn n h1 fun n => Nat.casesOn n h2 fun _ => ⟨fun x => PEmpty.elim x⟩
#align
  first_order.language.subsingleton_mk₂_functions
  FirstOrder.Language.subsingleton_mk₂_functions

instance subsingleton_mk₂_relations {c f₁ f₂ : Type u} {r₁ r₂ : Type v} [h1 : Subsingleton r₁]
    [h2 : Subsingleton r₂] {n : ℕ} : Subsingleton ((Language.mk₂ c f₁ f₂ r₁ r₂).Relations n) :=
  Nat.casesOn n ⟨fun x => PEmpty.elim x⟩ fun n =>
    Nat.casesOn n h1 fun n => Nat.casesOn n h2 fun _ => ⟨fun x => PEmpty.elim x⟩
#align
  first_order.language.subsingleton_mk₂_relations
  FirstOrder.Language.subsingleton_mk₂_relations

@[simp]
theorem empty_card : Language.empty.card = 0 := by simp [card_eq_card_functions_add_card_relations]
#align first_order.language.empty_card FirstOrder.Language.empty_card

instance isEmpty_empty : IsEmpty Language.empty.Symbols := by
  simp only [Language.Symbols, isEmpty_sum, isEmpty_sigma]
  exact ⟨fun _ => inferInstance, fun _ => inferInstance⟩
#align first_order.language.is_empty_empty FirstOrder.Language.isEmpty_empty

instance Countable.countable_functions [h : Countable L.Symbols] : Countable (Σl, L.Functions l) :=
  @Function.Injective.countable _ _ h _ Sum.inl_injective
#align
  first_order.language.countable.countable_functions
  FirstOrder.Language.Countable.countable_functions

@[simp]
theorem card_functions_sum (i : ℕ) :
    (#(L.sum L').Functions i)
      = (Cardinal.lift.{u'} (#L.Functions i) + Cardinal.lift.{u} (#L'.Functions i) : Cardinal) := by
  simp [Language.sum]
#align first_order.language.card_functions_sum FirstOrder.Language.card_functions_sum

@[simp]
theorem card_relations_sum (i : ℕ) :
    (#(L.sum L').Relations i) =
      Cardinal.lift.{v'} (#L.Relations i) + Cardinal.lift.{v} (#L'.Relations i) := by
  simp [Language.sum]
#align first_order.language.card_relations_sum FirstOrder.Language.card_relations_sum

@[simp]
theorem card_sum :
    (L.sum L').card = Cardinal.lift.{max u' v'} L.card + Cardinal.lift.{max u v} L'.card := by
  simp only [card_eq_card_functions_add_card_relations, card_functions_sum, card_relations_sum,
    sum_add_distrib', lift_add, lift_sum, lift_lift]
  simp only [add_assoc, add_comm (Cardinal.sum fun i => (#L'.Functions i).lift)]
#align first_order.language.card_sum FirstOrder.Language.card_sum

@[simp]
theorem card_mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) :
    (Language.mk₂ c f₁ f₂ r₁ r₂).card =
      Cardinal.lift.{v} (#c) + Cardinal.lift.{v} (#f₁) + Cardinal.lift.{v} (#f₂) +
          Cardinal.lift.{u} (#r₁) + Cardinal.lift.{u} (#r₂) := by
  simp [card_eq_card_functions_add_card_relations, add_assoc]

#align first_order.language.card_mk₂ FirstOrder.Language.card_mk₂

variable (L) (M : Type w)

/-- A first-order structure on a type `M` consists of interpretations of all the symbols in a given
  language. Each function of arity `n` is interpreted as a function sending tuples of length `n`
  (modeled as `(Fin n → M)`) to `M`, and a relation of arity `n` is a function from tuples of length
  `n` to `Prop`. -/
@[ext]
class Structure where
  /-- Interpretation of the function symbols -/
  funMap : ∀ {n}, L.Functions n → (Fin n → M) → M
  /-- Interpretation of the relation symbols -/
  rel_map : ∀ {n}, L.Relations n → (Fin n → M) → Prop
set_option linter.uppercaseLean3 false in
#align first_order.language.Structure FirstOrder.Language.Structure

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

open Structure

/-- Used for defining `FirstOrder.Language.Theory.Model.inhabited`. -/
def inhabited.trivialStructure {α : Type _} [Inhabited α] : L.Structure α :=
  ⟨default, default⟩
#align
  first_order.language.inhabited.trivial_structure
  FirstOrder.Language.inhabited.trivialStructure

/-! ### Maps -/

/-- A homomorphism between first-order structures is a function that commutes with the
  interpretations of functions and maps tuples in one structure where a given relation is true to
  tuples in the second structure where that relation is still true. -/
structure Hom where
  /-- The underlying function of a homomorphism of structures -/
  toFun : M → N
  /-- The homomorphism commutes with the interpretations of the function symbols -/
  -- Porting note:
  -- The autoparam here used to be `obviously`. We would like to replace it with `aesop`
  -- but that isn't currently sufficient.
  -- See https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/Aesop.20and.20cases
  -- If that can be improved, we should change this to `by aesop` and remove the proofs below.
  map_fun' : ∀ {n} (f : L.Functions n) (x), toFun (funMap f x) = funMap f (toFun ∘ x) := by
    intros; trivial
  /-- The homomorphism sends related elements to related elements -/
  map_rel' : ∀ {n} (r : L.Relations n) (x), rel_map r x → rel_map r (toFun ∘ x) := by
    -- Porting note: see porting note on `Hom.map_fun'`
    intros; trivial
#align first_order.language.hom FirstOrder.Language.Hom

@[inherit_doc]
scoped[FirstOrder] notation:25 A " →[" L "] " B => FirstOrder.Language.Hom L A B

/-- An embedding of first-order structures is an embedding that commutes with the
  interpretations of functions and relations. -/
structure Embedding extends M ↪ N where
  map_fun' : ∀ {n} (f : L.Functions n) (x), toFun (funMap f x) = funMap f (toFun ∘ x) := by
    -- Porting note: see porting note on `Hom.map_fun'`
    intros; trivial
  map_rel' : ∀ {n} (r : L.Relations n) (x), rel_map r (toFun ∘ x) ↔ rel_map r x := by
    -- Porting note: see porting note on `Hom.map_fun'`
    intros; trivial
#align first_order.language.embedding FirstOrder.Language.Embedding

@[inherit_doc]
scoped[FirstOrder] notation:25 A " ↪[" L "] " B => FirstOrder.Language.Embedding L A B

/-- An equivalence of first-order structures is an equivalence that commutes with the
  interpretations of functions and relations. -/
structure Equiv extends M ≃ N where
  map_fun' : ∀ {n} (f : L.Functions n) (x), toFun (funMap f x) = funMap f (toFun ∘ x) := by
    -- Porting note: see porting note on `Hom.map_fun'`
    intros; trivial
  map_rel' : ∀ {n} (r : L.Relations n) (x), rel_map r (toFun ∘ x) ↔ rel_map r x := by
    -- Porting note: see porting note on `Hom.map_fun'`
    intros; trivial
#align first_order.language.equiv FirstOrder.Language.Equiv

@[inherit_doc]
scoped[FirstOrder] notation:25 A " ≃[" L "] " B => FirstOrder.Language.Equiv L A B

-- Porting note: was [L.Structure P] and [L.Structure Q]
-- The former reported an error.
variable {L M N} {P : Type _} [Structure L P] {Q : Type _} [Structure L Q]

--Porting note: new definition
/-- Interpretation of a constant symbol -/
@[coe]
def constantMap (c : L.Constants) : M := funMap c default

instance : CoeTC L.Constants M :=
  ⟨constantMap⟩

theorem funMap_eq_coe_constants {c : L.Constants} {x : Fin 0 → M} : funMap c x = c :=
  congr rfl (funext finZeroElim)
#align first_order.language.fun_map_eq_coe_constants FirstOrder.Language.funMap_eq_coe_constants

/-- Given a language with a nonempty type of constants, any structure will be nonempty. This cannot
  be a global instance, because `L` becomes a metavariable. -/
theorem nonempty_of_nonempty_constants [h : Nonempty L.Constants] : Nonempty M :=
  h.map (↑)
#align
  first_order.language.nonempty_of_nonempty_constants
  FirstOrder.Language.nonempty_of_nonempty_constants

/-- The function map for `FirstOrder.Language.Structure₂`. -/
def funMap₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v} (c' : c → M) (f₁' : f₁ → M → M)
    (f₂' : f₂ → M → M → M) : ∀ {n}, (Language.mk₂ c f₁ f₂ r₁ r₂).Functions n → (Fin n → M) → M
  | 0, f, _ => c' f
  | 1, f, x => f₁' f (x 0)
  | 2, f, x => f₂' f (x 0) (x 1)
  | _ + 3, f, _ => PEmpty.elim f
#align first_order.language.fun_map₂ FirstOrder.Language.funMap₂

/-- The relation map for `FirstOrder.Language.Structure₂`. -/
def RelMap₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v} (r₁' : r₁ → Set M) (r₂' : r₂ → M → M → Prop) :
    ∀ {n}, (Language.mk₂ c f₁ f₂ r₁ r₂).Relations n → (Fin n → M) → Prop
  | 0, r, _ => PEmpty.elim r
  | 1, r, x => x 0 ∈ r₁' r
  | 2, r, x => r₂' r (x 0) (x 1)
  | _ + 3, r, _ => PEmpty.elim r
#align first_order.language.rel_map₂ FirstOrder.Language.RelMap₂

/-- A structure constructor to match `FirstOrder.Language₂`. -/
protected def Structure.mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v} (c' : c → M) (f₁' : f₁ → M → M)
    (f₂' : f₂ → M → M → M) (r₁' : r₁ → Set M) (r₂' : r₂ → M → M → Prop) :
    (Language.mk₂ c f₁ f₂ r₁ r₂).Structure M :=
  ⟨funMap₂ c' f₁' f₂', RelMap₂ r₁' r₂'⟩
set_option linter.uppercaseLean3 false in
#align first_order.language.Structure.mk₂ FirstOrder.Language.Structure.mk₂

namespace Structure

variable {c f₁ f₂ : Type u} {r₁ r₂ : Type v}

variable {c' : c → M} {f₁' : f₁ → M → M} {f₂' : f₂ → M → M → M}

variable {r₁' : r₁ → Set M} {r₂' : r₂ → M → M → Prop}

@[simp]
theorem funMap_apply₀ (c₀ : c) {x : Fin 0 → M} :
    @Structure.funMap _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 0 c₀ x = c' c₀ :=
  rfl
set_option linter.uppercaseLean3 false in
#align first_order.language.Structure.fun_map_apply₀ FirstOrder.Language.Structure.funMap_apply₀

@[simp]
theorem funMap_apply₁ (f : f₁) (x : M) :
    @Structure.funMap _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 1 f ![x] = f₁' f x :=
  rfl
set_option linter.uppercaseLean3 false in
#align first_order.language.Structure.fun_map_apply₁ FirstOrder.Language.Structure.funMap_apply₁

@[simp]
theorem funMap_apply₂ (f : f₂) (x y : M) :
    @Structure.funMap _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 2 f ![x, y] = f₂' f x y :=
  rfl
set_option linter.uppercaseLean3 false in
#align first_order.language.Structure.fun_map_apply₂ FirstOrder.Language.Structure.funMap_apply₂

@[simp]
theorem relMap_apply₁ (r : r₁) (x : M) :
    @Structure.rel_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 1 r ![x] = (x ∈ r₁' r) :=
  rfl
set_option linter.uppercaseLean3 false in
#align first_order.language.Structure.rel_map_apply₁ FirstOrder.Language.Structure.relMap_apply₁

@[simp]
theorem relMap_apply₂ (r : r₂) (x y : M) :
    @Structure.rel_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 2 r ![x, y] = r₂' r x y :=
  rfl
set_option linter.uppercaseLean3 false in
#align first_order.language.Structure.rel_map_apply₂ FirstOrder.Language.Structure.relMap_apply₂

end Structure

/-- `HomClass L F M N` states that `F` is a type of `L`-homomorphisms. You should extend this
  typeclass when you extend `FirstOrder.Language.Hom`. -/
class HomClass (L : outParam Language) (F : Type _) (M N : outParam <| Type _)
  [FunLike F M fun _ => N] [L.Structure M] [L.Structure N] where
  map_fun : ∀ (φ : F) {n} (f : L.Functions n) (x), φ (funMap f x) = funMap f (φ ∘ x)
  map_rel : ∀ (φ : F) {n} (r : L.Relations n) (x), rel_map r x → rel_map r (φ ∘ x)
#align first_order.language.hom_class FirstOrder.Language.HomClass

/-- `StrongHomClass L F M N` states that `F` is a type of `L`-homomorphisms which preserve
  relations in both directions. -/
class StrongHomClass (L : outParam Language) (F : Type _) (M N : outParam <| Type _)
  [FunLike F M fun _ => N] [L.Structure M] [L.Structure N] where
  map_fun : ∀ (φ : F) {n} (f : L.Functions n) (x), φ (funMap f x) = funMap f (φ ∘ x)
  map_rel : ∀ (φ : F) {n} (r : L.Relations n) (x), rel_map r (φ ∘ x) ↔ rel_map r x
#align first_order.language.strong_hom_class FirstOrder.Language.StrongHomClass

--Porting note: using implicit brackets for `Structure` arguments
instance (priority := 100) StrongHomClass.homClass {F M N} {_ : L.Structure M}
    {_ : L.Structure N} [FunLike F M fun _ => N] [StrongHomClass L F M N] : HomClass L F M N where
  map_fun := StrongHomClass.map_fun
  map_rel φ _ R x := (StrongHomClass.map_rel φ R x).2
#align first_order.language.strong_hom_class.hom_class FirstOrder.Language.StrongHomClass.homClass

/-- Not an instance to avoid a loop. -/
def HomClass.strongHomClassOfIsAlgebraic [L.IsAlgebraic] {F M N} [L.Structure M] [L.Structure N]
    [FunLike F M fun _ => N] [HomClass L F M N] : StrongHomClass L F M N where
  map_fun := HomClass.map_fun
  map_rel _ n R _ := (IsAlgebraic.empty_relations n).elim R
#align
  first_order.language.hom_class.strong_hom_class_of_is_algebraic
  FirstOrder.Language.HomClass.strongHomClassOfIsAlgebraic

theorem HomClass.map_constants {F M N} [L.Structure M] [L.Structure N] [FunLike F M fun _ => N]
    [HomClass L F M N] (φ : F) (c : L.Constants) : φ c = c :=
  (HomClass.map_fun φ c default).trans (congr rfl (funext default))
#align first_order.language.hom_class.map_constants FirstOrder.Language.HomClass.map_constants

attribute [inherit_doc FirstOrder.Language.Hom.map_fun'] FirstOrder.Language.Embedding.map_fun'
  FirstOrder.Language.HomClass.map_fun FirstOrder.Language.StrongHomClass.map_fun
  FirstOrder.Language.Equiv.map_fun'

attribute [inherit_doc FirstOrder.Language.Hom.map_rel'] FirstOrder.Language.Embedding.map_rel'
  FirstOrder.Language.HomClass.map_rel FirstOrder.Language.StrongHomClass.map_rel
  FirstOrder.Language.Equiv.map_rel'

namespace Hom

instance funLike : FunLike (M →[L] N) M fun _ => N where
  coe := Hom.toFun
  coe_injective' f g h := by cases f; cases g; cases h; rfl
#align first_order.language.hom.fun_like FirstOrder.Language.Hom.funLike

instance homClass : HomClass L (M →[L] N) M N where
  map_fun := map_fun'
  map_rel := map_rel'
#align first_order.language.hom.hom_class FirstOrder.Language.Hom.homClass

instance [L.IsAlgebraic] : StrongHomClass L (M →[L] N) M N :=
  HomClass.strongHomClassOfIsAlgebraic

instance hasCoeToFun : CoeFun (M →[L] N) fun _ => M → N :=
  FunLike.hasCoeToFun
#align first_order.language.hom.has_coe_to_fun FirstOrder.Language.Hom.hasCoeToFun

@[simp]
theorem toFun_eq_coe {f : M →[L] N} : f.toFun = (f : M → N) :=
  rfl
#align first_order.language.hom.to_fun_eq_coe FirstOrder.Language.Hom.toFun_eq_coe

@[ext]
theorem ext ⦃f g : M →[L] N⦄ (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext f g h
#align first_order.language.hom.ext FirstOrder.Language.Hom.ext

theorem ext_iff {f g : M →[L] N} : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align first_order.language.hom.ext_iff FirstOrder.Language.Hom.ext_iff

@[simp]
theorem map_fun (φ : M →[L] N) {n : ℕ} (f : L.Functions n) (x : Fin n → M) :
    φ (funMap f x) = funMap f (φ ∘ x) :=
  HomClass.map_fun φ f x
#align first_order.language.hom.map_fun FirstOrder.Language.Hom.map_fun

@[simp]
theorem map_constants (φ : M →[L] N) (c : L.Constants) : φ c = c :=
  HomClass.map_constants φ c
#align first_order.language.hom.map_constants FirstOrder.Language.Hom.map_constants

@[simp]
theorem map_rel (φ : M →[L] N) {n : ℕ} (r : L.Relations n) (x : Fin n → M) :
    rel_map r x → rel_map r (φ ∘ x) :=
  HomClass.map_rel φ r x
#align first_order.language.hom.map_rel FirstOrder.Language.Hom.map_rel

variable (L) (M)

/-- The identity map from a structure to itself. -/
@[refl]
def id : M →[L] M where
  toFun m := m
#align first_order.language.hom.id FirstOrder.Language.Hom.id

variable {L} {M}

instance : Inhabited (M →[L] M) :=
  ⟨id L M⟩

@[simp]
theorem id_apply (x : M) : id L M x = x :=
  rfl
#align first_order.language.hom.id_apply FirstOrder.Language.Hom.id_apply

/-- Composition of first-order homomorphisms. -/
@[trans]
def comp (hnp : N →[L] P) (hmn : M →[L] N) : M →[L] P where
  toFun := hnp ∘ hmn
  -- Porting note: should be done by autoparam?
  map_fun' _ _ := by simp; rfl
  -- Porting note: should be done by autoparam?
  map_rel' _ _ h := map_rel _ _ _ (map_rel _ _ _ h)
#align first_order.language.hom.comp FirstOrder.Language.Hom.comp

@[simp]
theorem comp_apply (g : N →[L] P) (f : M →[L] N) (x : M) : g.comp f x = g (f x) :=
  rfl
#align first_order.language.hom.comp_apply FirstOrder.Language.Hom.comp_apply

/-- Composition of first-order homomorphisms is associative. -/
theorem comp_assoc (f : M →[L] N) (g : N →[L] P) (h : P →[L] Q) :
    (h.comp g).comp f = h.comp (g.comp f) :=
  rfl
#align first_order.language.hom.comp_assoc FirstOrder.Language.Hom.comp_assoc

end Hom

/-- Any element of a `HomClass` can be realized as a first_order homomorphism. -/
def HomClass.toHom {F M N} [L.Structure M] [L.Structure N] [FunLike F M fun _ => N]
    [HomClass L F M N] : F → M →[L] N := fun φ =>
  ⟨φ, HomClass.map_fun φ, HomClass.map_rel φ⟩
#align first_order.language.hom_class.to_hom FirstOrder.Language.HomClass.toHom

namespace Embedding

instance embeddingLike : EmbeddingLike (M ↪[L] N) M N where
  coe f := f.toFun
  injective' f := f.toEmbedding.injective
  coe_injective' f g h := by
    cases f
    cases g
    congr
    ext x
    exact Function.funext_iff.1 h x
#align first_order.language.embedding.embedding_like FirstOrder.Language.Embedding.embeddingLike

instance strongHomClass : StrongHomClass L (M ↪[L] N) M N where
  map_fun := map_fun'
  map_rel := map_rel'
#align first_order.language.embedding.strong_hom_class FirstOrder.Language.Embedding.strongHomClass

instance hasCoeToFun : CoeFun (M ↪[L] N) fun _ => M → N :=
  FunLike.hasCoeToFun
#align first_order.language.embedding.has_coe_to_fun FirstOrder.Language.Embedding.hasCoeToFun

@[simp]
theorem map_fun (φ : M ↪[L] N) {n : ℕ} (f : L.Functions n) (x : Fin n → M) :
    φ (funMap f x) = funMap f (φ ∘ x) :=
  HomClass.map_fun φ f x
#align first_order.language.embedding.map_fun FirstOrder.Language.Embedding.map_fun

@[simp]
theorem map_constants (φ : M ↪[L] N) (c : L.Constants) : φ c = c :=
  HomClass.map_constants φ c
#align first_order.language.embedding.map_constants FirstOrder.Language.Embedding.map_constants

@[simp]
theorem map_rel (φ : M ↪[L] N) {n : ℕ} (r : L.Relations n) (x : Fin n → M) :
    rel_map r (φ ∘ x) ↔ rel_map r x :=
  StrongHomClass.map_rel φ r x
#align first_order.language.embedding.map_rel FirstOrder.Language.Embedding.map_rel

/-- A first-order embedding is also a first-order homomorphism. -/
def toHom : (M ↪[L] N) → M →[L] N :=
  HomClass.toHom
#align first_order.language.embedding.to_hom FirstOrder.Language.Embedding.toHom

@[simp]

theorem coe_injective : @Function.Injective (M ↪[L] N) (M → N) (↑)
  | f, g, h => by
    cases f
    cases g
    congr
    ext x
    exact Function.funext_iff.1 h x
#align first_order.language.embedding.coe_injective FirstOrder.Language.Embedding.coe_injective

@[ext]
theorem ext ⦃f g : M ↪[L] N⦄ (h : ∀ x, f x = g x) : f = g :=
  coe_injective (funext h)
#align first_order.language.embedding.ext FirstOrder.Language.Embedding.ext

theorem ext_iff {f g : M ↪[L] N} : f = g ↔ ∀ x, f x = g x :=
  ⟨fun h _ => h ▸ rfl, fun h => ext h⟩
#align first_order.language.embedding.ext_iff FirstOrder.Language.Embedding.ext_iff

theorem injective (f : M ↪[L] N) : Function.Injective f :=
  f.toEmbedding.injective
#align first_order.language.embedding.injective FirstOrder.Language.Embedding.injective

/-- In an algebraic language, any injective homomorphism is an embedding. -/
@[simps!]
def ofInjective [L.IsAlgebraic] {f : M →[L] N} (hf : Function.Injective f) : M ↪[L] N :=
  { f with
    inj' := hf
    map_rel' := fun {_} r x => StrongHomClass.map_rel f r x }
#align first_order.language.embedding.of_injective FirstOrder.Language.Embedding.ofInjective

@[simp]
theorem coeFn_ofInjective [L.IsAlgebraic] {f : M →[L] N} (hf : Function.Injective f) :
    (ofInjective hf : M → N) = f :=
  rfl
#align
  first_order.language.embedding.coe_fn_of_injective
  FirstOrder.Language.Embedding.coeFn_ofInjective

@[simp]
theorem ofInjective_toHom [L.IsAlgebraic] {f : M →[L] N} (hf : Function.Injective f) :
    (ofInjective hf).toHom = f := by
  ext; simp
#align
  first_order.language.embedding.of_injective_to_hom
  FirstOrder.Language.Embedding.ofInjective_toHom

variable (L) (M)

/-- The identity embedding from a structure to itself. -/
@[refl]
def refl : M ↪[L] M where toEmbedding := Function.Embedding.refl M
#align first_order.language.embedding.refl FirstOrder.Language.Embedding.refl

variable {L} {M}

instance : Inhabited (M ↪[L] M) :=
  ⟨refl L M⟩

@[simp]
theorem refl_apply (x : M) : refl L M x = x :=
  rfl
#align first_order.language.embedding.refl_apply FirstOrder.Language.Embedding.refl_apply

/-- Composition of first-order embeddings. -/
@[trans]
def comp (hnp : N ↪[L] P) (hmn : M ↪[L] N) : M ↪[L] P where
  toFun := hnp ∘ hmn
  inj' := hnp.injective.comp hmn.injective
  -- Porting note: should be done by autoparam?
  map_fun' := by intros; simp only [Function.comp_apply, map_fun]; trivial
  -- Porting note: should be done by autoparam?
  map_rel' := by intros; rw [Function.comp.assoc, map_rel, map_rel]
#align first_order.language.embedding.comp FirstOrder.Language.Embedding.comp

@[simp]
theorem comp_apply (g : N ↪[L] P) (f : M ↪[L] N) (x : M) : g.comp f x = g (f x) :=
  rfl
#align first_order.language.embedding.comp_apply FirstOrder.Language.Embedding.comp_apply

/-- Composition of first-order embeddings is associative. -/
theorem comp_assoc (f : M ↪[L] N) (g : N ↪[L] P) (h : P ↪[L] Q) :
    (h.comp g).comp f = h.comp (g.comp f) :=
  rfl
#align first_order.language.embedding.comp_assoc FirstOrder.Language.Embedding.comp_assoc

@[simp]
theorem comp_toHom (hnp : N ↪[L] P) (hmn : M ↪[L] N) :
    (hnp.comp hmn).toHom = hnp.toHom.comp hmn.toHom := by
  ext
  simp only [coe_toHom, comp_apply, Hom.comp_apply]
#align first_order.language.embedding.comp_to_hom FirstOrder.Language.Embedding.comp_toHom

end Embedding

/-- Any element of an injective `StrongHomClass` can be realized as a first_order embedding. -/
def StrongHomClass.toEmbedding {F M N} [L.Structure M] [L.Structure N] [EmbeddingLike F M N]
    [StrongHomClass L F M N] : F → M ↪[L] N := fun φ =>
  ⟨⟨φ, EmbeddingLike.injective φ⟩, StrongHomClass.map_fun φ, StrongHomClass.map_rel φ⟩
#align
  first_order.language.strong_hom_class.to_embedding
  FirstOrder.Language.StrongHomClass.toEmbedding

namespace Equiv

instance : EquivLike (M ≃[L] N) M N where
  coe f := f.toFun
  inv f := f.invFun
  left_inv f := f.left_inv
  right_inv f := f.right_inv
  coe_injective' f g h₁ h₂ := by
    cases f
    cases g
    simp only [mk.injEq]
    ext x
    exact Function.funext_iff.1 h₁ x

instance : StrongHomClass L (M ≃[L] N) M N where
  map_fun := map_fun'
  map_rel := map_rel'

/-- The inverse of a first-order equivalence is a first-order equivalence. -/
@[symm]
def symm (f : M ≃[L] N) : N ≃[L] M :=
  {
    f.toEquiv.symm with
    map_fun' := @fun n f' x => by
      simp only [Equiv.toFun_as_coe]
      rw [Equiv.symm_apply_eq]
      refine' Eq.trans _ (f.map_fun' f' (f.toEquiv.symm ∘ x)).symm
      rw [← Function.comp.assoc, Equiv.toFun_as_coe, Equiv.self_comp_symm, Function.comp.left_id]
    map_rel' := @fun n r x => by
      simp only [Equiv.toFun_as_coe]
      refine' (f.map_rel' r (f.toEquiv.symm ∘ x)).symm.trans _
      rw [← Function.comp.assoc, Equiv.toFun_as_coe, Equiv.self_comp_symm, Function.comp.left_id] }
#align first_order.language.equiv.symm FirstOrder.Language.Equiv.symm

instance hasCoeToFun : CoeFun (M ≃[L] N) fun _ => M → N :=
  FunLike.hasCoeToFun
#align first_order.language.equiv.has_coe_to_fun FirstOrder.Language.Equiv.hasCoeToFun

@[simp]
theorem apply_symm_apply (f : M ≃[L] N) (a : N) : f (f.symm a) = a :=
  f.toEquiv.apply_symm_apply a
#align first_order.language.equiv.apply_symm_apply FirstOrder.Language.Equiv.apply_symm_apply

@[simp]
theorem symm_apply_apply (f : M ≃[L] N) (a : M) : f.symm (f a) = a :=
  f.toEquiv.symm_apply_apply a
#align first_order.language.equiv.symm_apply_apply FirstOrder.Language.Equiv.symm_apply_apply

@[simp]
theorem map_fun (φ : M ≃[L] N) {n : ℕ} (f : L.Functions n) (x : Fin n → M) :
    φ (funMap f x) = funMap f (φ ∘ x) :=
  HomClass.map_fun φ f x
#align first_order.language.equiv.map_fun FirstOrder.Language.Equiv.map_fun

@[simp]
theorem map_constants (φ : M ≃[L] N) (c : L.Constants) : φ c = c :=
  HomClass.map_constants φ c
#align first_order.language.equiv.map_constants FirstOrder.Language.Equiv.map_constants

@[simp]
theorem map_rel (φ : M ≃[L] N) {n : ℕ} (r : L.Relations n) (x : Fin n → M) :
    rel_map r (φ ∘ x) ↔ rel_map r x :=
  StrongHomClass.map_rel φ r x
#align first_order.language.equiv.map_rel FirstOrder.Language.Equiv.map_rel

/-- A first-order equivalence is also a first-order embedding. -/
def toEmbedding : (M ≃[L] N) → M ↪[L] N :=
  StrongHomClass.toEmbedding
#align first_order.language.equiv.to_embedding FirstOrder.Language.Equiv.toEmbedding

/-- A first-order equivalence is also a first-order homomorphism. -/
def toHom : (M ≃[L] N) → M →[L] N :=
  HomClass.toHom
#align first_order.language.equiv.to_hom FirstOrder.Language.Equiv.toHom

@[simp]
theorem toEmbedding_toHom (f : M ≃[L] N) : f.toEmbedding.toHom = f.toHom :=
  rfl
#align first_order.language.equiv.to_embedding_to_hom FirstOrder.Language.Equiv.toEmbedding_toHom

@[simp]
theorem coe_toHom {f : M ≃[L] N} : (f.toHom : M → N) = (f : M → N) :=
  rfl
#align first_order.language.equiv.coe_to_hom FirstOrder.Language.Equiv.coe_toHom

@[simp]
theorem coe_toEmbedding (f : M ≃[L] N) : (f.toEmbedding : M → N) = (f : M → N) :=
  rfl
#align first_order.language.equiv.coe_to_embedding FirstOrder.Language.Equiv.coe_toEmbedding

theorem coe_injective : @Function.Injective (M ≃[L] N) (M → N) (↑) :=
  FunLike.coe_injective
#align first_order.language.equiv.coe_injective FirstOrder.Language.Equiv.coe_injective

@[ext]
theorem ext ⦃f g : M ≃[L] N⦄ (h : ∀ x, f x = g x) : f = g :=
  coe_injective (funext h)
#align first_order.language.equiv.ext FirstOrder.Language.Equiv.ext

theorem ext_iff {f g : M ≃[L] N} : f = g ↔ ∀ x, f x = g x :=
  ⟨fun h _ => h ▸ rfl, fun h => ext h⟩
#align first_order.language.equiv.ext_iff FirstOrder.Language.Equiv.ext_iff

theorem bijective (f : M ≃[L] N) : Function.Bijective f :=
  EquivLike.bijective f
#align first_order.language.equiv.bijective FirstOrder.Language.Equiv.bijective

theorem injective (f : M ≃[L] N) : Function.Injective f :=
  EquivLike.injective f
#align first_order.language.equiv.injective FirstOrder.Language.Equiv.injective

theorem surjective (f : M ≃[L] N) : Function.Surjective f :=
  EquivLike.surjective f
#align first_order.language.equiv.surjective FirstOrder.Language.Equiv.surjective

variable (L) (M)

/-- The identity equivalence from a structure to itself. -/
@[refl]
def refl : M ≃[L] M where toEquiv := _root_.Equiv.refl M
#align first_order.language.equiv.refl FirstOrder.Language.Equiv.refl

variable {L} {M}

instance : Inhabited (M ≃[L] M) :=
  ⟨refl L M⟩

@[simp]
theorem refl_apply (x : M) : refl L M x = x := by simp [refl]; rfl
#align first_order.language.equiv.refl_apply FirstOrder.Language.Equiv.refl_apply

/-- Composition of first-order equivalences. -/
@[trans]
def comp (hnp : N ≃[L] P) (hmn : M ≃[L] N) : M ≃[L] P :=
  { hmn.toEquiv.trans hnp.toEquiv with
    toFun := hnp ∘ hmn
    -- Porting note: should be done by autoparam?
    map_fun' := by intros; simp only [Function.comp_apply, map_fun]; trivial
    -- Porting note: should be done by autoparam?
    map_rel' := by intros; rw [Function.comp.assoc, map_rel, map_rel] }
#align first_order.language.equiv.comp FirstOrder.Language.Equiv.comp

@[simp]
theorem comp_apply (g : N ≃[L] P) (f : M ≃[L] N) (x : M) : g.comp f x = g (f x) :=
  rfl
#align first_order.language.equiv.comp_apply FirstOrder.Language.Equiv.comp_apply

/-- Composition of first-order homomorphisms is associative. -/
theorem comp_assoc (f : M ≃[L] N) (g : N ≃[L] P) (h : P ≃[L] Q) :
    (h.comp g).comp f = h.comp (g.comp f) :=
  rfl
#align first_order.language.equiv.comp_assoc FirstOrder.Language.Equiv.comp_assoc

end Equiv

/-- Any element of a bijective `StrongHomClass` can be realized as a first_order isomorphism. -/
def StrongHomClass.toEquiv {F M N} [L.Structure M] [L.Structure N] [EquivLike F M N]
    [StrongHomClass L F M N] : F → M ≃[L] N := fun φ =>
  ⟨⟨φ, EquivLike.inv φ, EquivLike.left_inv φ, EquivLike.right_inv φ⟩, StrongHomClass.map_fun φ,
    StrongHomClass.map_rel φ⟩
#align first_order.language.strong_hom_class.to_equiv FirstOrder.Language.StrongHomClass.toEquiv

section SumStructure

variable (L₁ L₂ : Language) (S : Type _) [L₁.Structure S] [L₂.Structure S]

instance sumStructure : (L₁.sum L₂).Structure S where
  funMap := @fun _ => Sum.elim funMap funMap
  rel_map := @fun _ => Sum.elim rel_map rel_map
set_option linter.uppercaseLean3 false in
#align first_order.language.sum_Structure FirstOrder.Language.sumStructure

variable {L₁ L₂ S}

@[simp]
theorem funMap_sum_inl {n : ℕ} (f : L₁.Functions n) :
    @funMap (L₁.sum L₂) S _ n (Sum.inl f) = funMap f :=
  rfl
#align first_order.language.fun_map_sum_inl FirstOrder.Language.funMap_sum_inl

@[simp]
theorem funMap_sum_inr {n : ℕ} (f : L₂.Functions n) :
    @funMap (L₁.sum L₂) S _ n (Sum.inr f) = funMap f :=
  rfl
#align first_order.language.fun_map_sum_inr FirstOrder.Language.funMap_sum_inr

@[simp]
theorem relMap_sum_inl {n : ℕ} (R : L₁.Relations n) :
    @rel_map (L₁.sum L₂) S _ n (Sum.inl R) = rel_map R :=
  rfl
#align first_order.language.rel_map_sum_inl FirstOrder.Language.relMap_sum_inl

@[simp]
theorem relMap_sum_inr {n : ℕ} (R : L₂.Relations n) :
    @rel_map (L₁.sum L₂) S _ n (Sum.inr R) = rel_map R :=
  rfl
#align first_order.language.rel_map_sum_inr FirstOrder.Language.relMap_sum_inr

end SumStructure

section Empty

section

variable [Language.empty.Structure M] [Language.empty.Structure N]

@[simp]
theorem empty.nonempty_embedding_iff :
    Nonempty (M ↪[Language.empty] N) ↔ Cardinal.lift.{w'} (#M) ≤ Cardinal.lift.{w} (#N) :=
  _root_.trans ⟨Nonempty.map fun f => f.toEmbedding, Nonempty.map fun f => { toEmbedding := f }⟩
    Cardinal.lift_mk_le'.symm
#align
  first_order.language.empty.nonempty_embedding_iff
  FirstOrder.Language.empty.nonempty_embedding_iff

@[simp]
theorem empty.nonempty_equiv_iff :
    Nonempty (M ≃[Language.empty] N) ↔ Cardinal.lift.{w'} (#M) = Cardinal.lift.{w} (#N) :=
  _root_.trans ⟨Nonempty.map fun f => f.toEquiv, Nonempty.map fun f => { toEquiv := f }⟩
    Cardinal.lift_mk_eq'.symm
#align first_order.language.empty.nonempty_equiv_iff FirstOrder.Language.empty.nonempty_equiv_iff

end

instance emptyStructure : Language.empty.Structure M :=
  ⟨Empty.elim, Empty.elim⟩
set_option linter.uppercaseLean3 false in
#align first_order.language.empty_Structure FirstOrder.Language.emptyStructure

instance : Unique (Language.empty.Structure M) :=
  ⟨⟨Language.emptyStructure⟩, fun a => by
    ext _ f <;> exact Empty.elim f⟩

instance (priority := 100) strongHomClassEmpty {F M N} [FunLike F M fun _ => N] :
    StrongHomClass Language.empty F M N :=
  ⟨fun _ _ f => Empty.elim f, fun _ _ r => Empty.elim r⟩
#align first_order.language.strong_hom_class_empty FirstOrder.Language.strongHomClassEmpty

/-- Makes a `Language.empty.hom` out of any function. -/
@[simps]
def _root_.Function.emptyHom (f : M → N) : M →[Language.empty] N where toFun := f
#align function.empty_hom Function.emptyHom

/-- Makes a `Language.empty.embedding` out of any function. -/
--@[simps] Porting note: commented out and lemmas added manually
def _root_.Embedding.empty (f : M ↪ N) : M ↪[Language.empty] N where toEmbedding := f
#align embedding.empty Embedding.empty

@[simp]
theorem toFun_embedding_empty (f : M ↪ N) : (Embedding.empty f : M → N) = f :=
  rfl

@[simp]
theorem toEmbedding_embedding_empty (f : M ↪ N) : (Embedding.empty f).toEmbedding = f :=
  rfl

/-- Makes a `Language.empty.equiv` out of any function. -/
--@[simps] Porting note: commented out and lemmas added manually
def _root_.Equiv.empty (f : M ≃ N) : M ≃[Language.empty] N where toEquiv := f
#align equiv.empty Equiv.empty

@[simp]
theorem toFun_equiv_empty (f : M ≃ N) : (Equiv.empty f : M → N) = f :=
  rfl

@[simp]
theorem toEquiv_equiv_empty (f : M ≃ N) : (Equiv.empty f).toEquiv = f :=
  rfl

end Empty

end Language

end FirstOrder

namespace Equiv

open FirstOrder FirstOrder.Language FirstOrder.Language.Structure

open FirstOrder

variable {L : Language} {M : Type _} {N : Type _} [L.Structure M]

/-- A structure induced by a bijection. -/
@[simps!]
def inducedStructure (e : M ≃ N) : L.Structure N :=
  ⟨fun f x => e (funMap f (e.symm ∘ x)), fun r x => rel_map r (e.symm ∘ x)⟩
set_option linter.uppercaseLean3 false in
#align equiv.induced_Structure Equiv.inducedStructure

/-- A bijection as a first-order isomorphism with the induced structure on the codomain. -/
--@[simps!] Porting note: commented out and lemmas added manually
def inducedStructureEquiv (e : M ≃ N) : @Language.Equiv L M N _ (inducedStructure e) := by
  letI : L.Structure N := inducedStructure e
  exact
  { e with
    map_fun' := @fun n f x => by simp [← Function.comp.assoc e.symm e x]
    map_rel' := @fun n r x => by simp [← Function.comp.assoc e.symm e x] }
set_option linter.uppercaseLean3 false in
#align equiv.induced_Structure_equiv Equiv.inducedStructureEquiv

@[simp]
theorem toEquiv_inducedStructureEquiv (e : M ≃ N) :
    @Language.Equiv.toEquiv L M N _ (inducedStructure e) (inducedStructureEquiv e) = e :=
  rfl

@[simp]
theorem toFun_inducedStructureEquiv (e : M ≃ N) :
    FunLike.coe (@inducedStructureEquiv L M N _ e) = e :=
  rfl

@[simp]
theorem toFun_inducedStructureEquiv_Symm (e : M ≃ N) :
  (by
    letI : L.Structure N := inducedStructure e
    exact FunLike.coe (@inducedStructureEquiv L M N _ e).symm) = (e.symm : N → M) :=
  rfl

end Equiv


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Jeremy Avigad
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic

universes u v u₁ u₂ v₁ v₂

namespace Mathlib

@[simp] theorem prod.mk.eta {α : Type u} {β : Type v} {p : α × β} : (prod.fst p, prod.snd p) = p :=
  prod.cases_on p
    fun (p_fst : α) (p_snd : β) =>
      idRhs
        ((prod.fst (p_fst, p_snd), prod.snd (p_fst, p_snd)) =
          (prod.fst (p_fst, p_snd), prod.snd (p_fst, p_snd)))
        rfl

protected instance prod.inhabited {α : Type u} {β : Type v} [Inhabited α] [Inhabited β] :
    Inhabited (α × β) :=
  { default := (Inhabited.default, Inhabited.default) }

protected instance prod.decidable_eq {α : Type u} {β : Type v} [h₁ : DecidableEq α]
    [h₂ : DecidableEq β] : DecidableEq (α × β) :=
  sorry

protected instance prod.has_lt {α : Type u} {β : Type v} [HasLess α] [HasLess β] :
    HasLess (α × β) :=
  { Less :=
      fun (s t : α × β) =>
        prod.fst s < prod.fst t ∨ prod.fst s = prod.fst t ∧ prod.snd s < prod.snd t }

protected instance prod_has_decidable_lt {α : Type u} {β : Type v} [HasLess α] [HasLess β]
    [DecidableEq α] [DecidableEq β] [DecidableRel Less] [DecidableRel Less] (s : α × β)
    (t : α × β) : Decidable (s < t) :=
  or.decidable

theorem prod.lt_def {α : Type u} {β : Type v} [HasLess α] [HasLess β] (s : α × β) (t : α × β) :
    s < t = (prod.fst s < prod.fst t ∨ prod.fst s = prod.fst t ∧ prod.snd s < prod.snd t) :=
  rfl

def prod.map {α₁ : Type u₁} {α₂ : Type u₂} {β₁ : Type v₁} {β₂ : Type v₂} (f : α₁ → α₂) (g : β₁ → β₂)
    (x : α₁ × β₁) : α₂ × β₂ :=
  (f (prod.fst x), g (prod.snd x))

end Mathlib


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

import Mathlib.Tactic.IntervalCases
import Mathlib.Tactic.Set

example (n : ℕ) : True := by
  fail_if_success interval_cases n
  trivial

example (n : ℕ) (_ : 2 ≤ n) : True := by
  fail_if_success interval_cases n
  trivial

example (n m : ℕ) (_ : n ≤ m) : True := by
  fail_if_success interval_cases n
  trivial

example (n : ℕ) (w₂ : n < 0) : False := by interval_cases n

example (n : ℕ) (w₂ : n < 1) : n = 0 := by
  interval_cases n
  rfl -- done for free in the mathlib3 version

example (n : ℕ) (w₂ : n < 2) : n = 0 ∨ n = 1 := by
  interval_cases n
  . left; rfl
  . right; rfl

example (n : ℕ) (w₁ : 1 ≤ n) (w₂ : n < 3) : n = 1 ∨ n = 2 := by
  interval_cases n
  . left; rfl
  . right; rfl

example (n : ℕ) (w₁ : 1 ≤ n) (w₂ : n < 3) : n = 1 ∨ n = 2 := by
  interval_cases using w₁, w₂
  . left; rfl
  . right; rfl

-- make sure we only pick up bounds on the specified variable:
example (n m : ℕ) (w₁ : 1 ≤ n) (w₂ : n < 3) (_ : m < 2) : n = 1 ∨ n = 2 := by
  interval_cases n
  . left; rfl
  . right; rfl

example (n : ℕ) (w₁ : 1 < n) (w₂ : n < 4) : n = 2 ∨ n = 3 := by
  interval_cases n
  . left; rfl
  . right; rfl

example (n : ℕ) (w₁ : n ≥ 3) (w₂ : n < 5) : n = 3 ∨ n = 4 := by
  interval_cases n
  . left; rfl
  . right; rfl

example (n : ℕ) (w₀ : n ≥ 2) (w₁ : n ≥ 3) (w₂ : n < 5) : n = 3 ∨ n = 4 := by
  interval_cases n
  . left; rfl
  . right; rfl

example (n : ℕ) (w₁ : n > 2) (w₂ : n < 5) : n = 3 ∨ n = 4 := by
  interval_cases n
  . left; rfl
  . right; rfl

example (n : ℕ) (w₁ : n > 2) (w₂ : n ≤ 4) : n = 3 ∨ n = 4 := by
  interval_cases n
  . left; rfl
  . right; rfl

example (n : ℕ) (w₁ : 2 < n) (w₂ : 4 ≥ n) : n = 3 ∨ n = 4 := by
  interval_cases n
  . left; rfl
  . right; rfl

example (n : ℕ) (h1 : 4 < n) (h2 : n ≤ 6) : n < 20 := by
  interval_cases n
  . guard_target =ₛ 5 < 20; norm_num
  . guard_target =ₛ 6 < 20; norm_num

example (n : ℕ) (w₁ : n % 3 < 1) : n % 3 = 0 := by
  interval_cases h : n % 3
  · guard_hyp h : n % 3 = 0
    rfl

example (n : ℕ) (w₁ : n % 3 < 1) : n % 3 = 0 := by
  interval_cases n % 3
  rfl
  -- the Lean 3 version had a different goal state after the `interval_cases`
  -- the `n % 3` was not substituted, instead there was a hypothesis `h : n % 3 = 0` provided
  -- so the proof was:
  -- assumption

example (n : ℕ) (h1 : 4 ≤ n) (h2 : n < 10) : n < 20 := by
  interval_cases using h1, h2
  all_goals { norm_num }

-- example (n : ℕ+) (w₂ : n < 1) : False := by interval_cases n

-- example (n : ℕ+) (w₂ : n < 2) : n = 1 := by interval_cases n

-- example (n : ℕ+) (h1 : 4 ≤ n) (h2 : n < 5) : n = 4 := by interval_cases n

-- example (n : ℕ+) (w₁ : 2 < n) (w₂ : 4 ≥ n) : n = 3 ∨ n = 4 := by
--   interval_cases n,
--   { guard_target' (3 : ℕ+) = 3 ∨ (3 : ℕ+) = 4, left; rfl },
--   { guard_target' (4 : ℕ+) = 3 ∨ (4 : ℕ+) = 4, right; rfl },

-- example (n : ℕ+) (w₁ : 1 < n) (w₂ : n < 4) : n = 2 ∨ n = 3 := by
--   { interval_cases n, { left; rfl }, { right; rfl }, }

-- example (n : ℕ+) (w₂ : n < 3) : n = 1 ∨ n = 2 := by
--   { interval_cases n, { left; rfl }, { right; rfl }, }

-- example (n : ℕ+) (w₂ : n < 4) : n = 1 ∨ n = 2 ∨ n = 3 := by
--   { interval_cases n, { left; rfl }, { right, left; rfl }, { right, right; rfl }, }

example (z : ℤ) (h1 : z ≥ -3) (h2 : z < 2) : z < 20 := by
  interval_cases using h1, h2
  all_goals { norm_num }

example (z : ℤ) (h1 : z ≥ -3) (h2 : z < 2) : z < 20 := by
  interval_cases z
  . guard_target =ₛ (-3 : ℤ) < 20
    norm_num
  . guard_target =ₛ (-2 : ℤ) < 20
    norm_num
  . guard_target =ₛ (-1 : ℤ) < 20
    norm_num
  . guard_target =ₛ (0 : ℤ) < 20
    norm_num
  . guard_target =ₛ (1 : ℤ) < 20
    norm_num

example (n : ℕ) : n % 2 = 0 ∨ n % 2 = 1 := by
  set r := n % 2 with hr
  have h2 : r < 2 := by
    exact Nat.mod_lt _ (by decide)
  interval_cases hrv : r -- Porting note: old syntax was `interval_cases r with hrv`
  . left; exact hrv.symm.trans hrv
               --^ hover says `hrv : r = 0` and jumps to `hrv :` above
  . right; exact hrv.symm.trans hrv
               --^ hover says `hrv : r = 1` and jumps to `hrv :` above

/- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/interval_cases.20bug -/
example {x : ℕ} (hx2 : x < 2) (h : False) : False := by
  have : x ≤ 1
  -- `interval_cases` deliberately not focussed,
  -- this is testing that the `interval_cases` only acts on `have` side goal, not on both
  interval_cases x
  . exact zero_le_one
  . rfl -- done for free in the mathlib3 version
  exact h

/-
In Lean 3 this one didn't work! It reported:
  `deep recursion was detected at 'expression equality test'`
-/
example (n : ℕ) (w₁ : n > 1000000) (w₁ : n < 1000002) : n < 2000000 := by
  interval_cases n
  norm_num


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import set_theory.game.short

/-!
# Games described via "the state of the board".

We provide a simple mechanism for constructing combinatorial (pre-)games, by describing
"the state of the board", and providing an upper bound on the number of turns remaining.

## Implementation notes

We're very careful to produce a computable definition, so small games can be evaluated
using `dec_trivial`. To achieve this, I've had to rely solely on induction on natural numbers:
relying on general well-foundedness seems to be poisonous to computation?

See `set_theory/game/domineering` for an example using this construction.
-/

universe u

namespace pgame

/--
`pgame_state S` describes how to interpret `s : S` as a state of a combinatorial game.
Use `pgame.of_state s` or `game.of_state s` to construct the game.

`pgame_state.L : S → finset S` and `pgame_state.R : S → finset S` describe the states reachable
by a move by Left or Right. `pgame_state.turn_bound : S → ℕ` gives an upper bound on the number of
possible turns remaining from this state.
-/
class state (S : Type u) :=
(turn_bound : S → ℕ)
(L : S → finset S)
(R : S → finset S)
(left_bound : ∀ {s t : S} (m : t ∈ L s), turn_bound t < turn_bound s)
(right_bound : ∀ {s t : S} (m : t ∈ R s), turn_bound t < turn_bound s)

open state

variables {S : Type u} [state S]

lemma turn_bound_ne_zero_of_left_move {s t : S} (m : t ∈ L s) : turn_bound s ≠ 0 :=
begin
  intro h,
  have t := state.left_bound m,
  rw h at t,
  exact nat.not_succ_le_zero _ t,
end
lemma turn_bound_ne_zero_of_right_move {s t : S} (m : t ∈ R s) : turn_bound s ≠ 0 :=
begin
  intro h,
  have t := state.right_bound m,
  rw h at t,
  exact nat.not_succ_le_zero _ t,
end

lemma turn_bound_of_left {s t : S} (m : t ∈ L s) (n : ℕ) (h : turn_bound s ≤ n + 1) :
  turn_bound t ≤ n :=
nat.le_of_lt_succ (nat.lt_of_lt_of_le (left_bound m) h)
lemma turn_bound_of_right {s t : S} (m : t ∈ R s) (n : ℕ) (h : turn_bound s ≤ n + 1) :
  turn_bound t ≤ n :=
nat.le_of_lt_succ (nat.lt_of_lt_of_le (right_bound m) h)

/--
Construct a `pgame` from a state and a (not necessarily optimal) bound on the number of
turns remaining.
-/
def of_state_aux : Π (n : ℕ) (s : S) (h : turn_bound s ≤ n), pgame
| 0 s h     := pgame.mk {t // t ∈ L s} {t // t ∈ R s}
    (λ t, begin exfalso, exact turn_bound_ne_zero_of_left_move t.2 (nonpos_iff_eq_zero.mp h) end)
    (λ t, begin exfalso, exact turn_bound_ne_zero_of_right_move t.2 (nonpos_iff_eq_zero.mp h) end)
| (n+1) s h :=
  pgame.mk {t // t ∈ L s} {t // t ∈ R s}
    (λ t, of_state_aux n t (turn_bound_of_left t.2 n h))
    (λ t, of_state_aux n t (turn_bound_of_right t.2 n h))

/-- Two different (valid) turn bounds give equivalent games. -/
def of_state_aux_relabelling : Π (s : S) (n m : ℕ) (hn : turn_bound s ≤ n) (hm : turn_bound s ≤ m),
  relabelling (of_state_aux n s hn) (of_state_aux m s hm)
| s 0 0 hn hm :=
  begin
    dsimp [pgame.of_state_aux],
    fsplit, refl, refl,
    { intro i, dsimp at i, exfalso,
      exact turn_bound_ne_zero_of_left_move i.2 (nonpos_iff_eq_zero.mp hn) },
    { intro j, dsimp at j, exfalso,
      exact turn_bound_ne_zero_of_right_move j.2 (nonpos_iff_eq_zero.mp hm) }
  end
| s 0 (m+1) hn hm :=
  begin
    dsimp [pgame.of_state_aux],
    fsplit, refl, refl,
    { intro i, dsimp at i, exfalso,
      exact turn_bound_ne_zero_of_left_move i.2 (nonpos_iff_eq_zero.mp hn) },
    { intro j, dsimp at j, exfalso,
      exact turn_bound_ne_zero_of_right_move j.2 (nonpos_iff_eq_zero.mp hn) }
  end
| s (n+1) 0 hn hm :=
  begin
    dsimp [pgame.of_state_aux],
    fsplit, refl, refl,
    { intro i, dsimp at i, exfalso,
      exact turn_bound_ne_zero_of_left_move i.2 (nonpos_iff_eq_zero.mp hm) },
    { intro j, dsimp at j, exfalso,
      exact turn_bound_ne_zero_of_right_move j.2 (nonpos_iff_eq_zero.mp hm) }
  end
| s (n+1) (m+1) hn hm :=
  begin
    dsimp [pgame.of_state_aux],
    fsplit, refl, refl,
    { intro i,
      apply of_state_aux_relabelling, },
    { intro j,
      apply of_state_aux_relabelling, }
  end

/-- Construct a combinatorial `pgame` from a state. -/
def of_state (s : S) : pgame := of_state_aux (turn_bound s) s (refl _)

/-- The equivalence between `left_moves` for a `pgame` constructed using `of_state_aux _ s _`, and
`L s`. -/
def left_moves_of_state_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n) :
  left_moves (of_state_aux n s h) ≃ {t // t ∈ L s} :=
by induction n; refl

/-- The equivalence between `left_moves` for a `pgame` constructed using `of_state s`, and `L s`. -/
def left_moves_of_state (s : S) : left_moves (of_state s) ≃ {t // t ∈ L s} :=
left_moves_of_state_aux _ _

/-- The equivalence between `right_moves` for a `pgame` constructed using `of_state_aux _ s _`, and
`R s`. -/
def right_moves_of_state_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n) :
  right_moves (of_state_aux n s h) ≃ {t // t ∈ R s} :=
by induction n; refl

/-- The equivalence between `right_moves` for a `pgame` constructed using `of_state s`, and
`R s`. -/
def right_moves_of_state (s : S) : right_moves (of_state s) ≃ {t // t ∈ R s} :=
right_moves_of_state_aux _ _

/--
The relabelling showing `move_left` applied to a game constructed using `of_state_aux`
has itself been constructed using `of_state_aux`.
-/
def relabelling_move_left_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n)
  (t : left_moves (of_state_aux n s h)) :
  relabelling
    (move_left (of_state_aux n s h) t)
    (of_state_aux (n-1) (((left_moves_of_state_aux n h) t) : S)
      ((turn_bound_of_left ((left_moves_of_state_aux n h) t).2 (n-1)
        (nat.le_trans h le_tsub_add)))) :=
begin
  induction n,
  { have t' := (left_moves_of_state_aux 0 h) t,
    exfalso, exact turn_bound_ne_zero_of_left_move t'.2 (nonpos_iff_eq_zero.mp h), },
  { refl },
end
/--
The relabelling showing `move_left` applied to a game constructed using `of`
has itself been constructed using `of`.
-/
def relabelling_move_left (s : S) (t : left_moves (of_state s)) :
  relabelling
    (move_left (of_state s) t)
    (of_state (((left_moves_of_state s).to_fun t) : S)) :=
begin
  transitivity,
  apply relabelling_move_left_aux,
  apply of_state_aux_relabelling,
end
/--
The relabelling showing `move_right` applied to a game constructed using `of_state_aux`
has itself been constructed using `of_state_aux`.
-/
def relabelling_move_right_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n)
  (t : right_moves (of_state_aux n s h)) :
  relabelling
    (move_right (of_state_aux n s h) t)
    (of_state_aux (n-1) (((right_moves_of_state_aux n h) t) : S)
      ((turn_bound_of_right ((right_moves_of_state_aux n h) t).2 (n-1)
        (nat.le_trans h le_tsub_add)))) :=
begin
  induction n,
  { have t' := (right_moves_of_state_aux 0 h) t,
    exfalso, exact turn_bound_ne_zero_of_right_move t'.2 (nonpos_iff_eq_zero.mp h), },
  { refl },
end
/--
The relabelling showing `move_right` applied to a game constructed using `of`
has itself been constructed using `of`.
-/
def relabelling_move_right (s : S) (t : right_moves (of_state s)) :
  relabelling
    (move_right (of_state s) t)
    (of_state (((right_moves_of_state s).to_fun t) : S)) :=
begin
  transitivity,
  apply relabelling_move_right_aux,
  apply of_state_aux_relabelling,
end

instance fintype_left_moves_of_state_aux (n : ℕ) (s : S) (h : turn_bound s ≤ n) :
  fintype (left_moves (of_state_aux n s h)) :=
begin
  apply fintype.of_equiv _ (left_moves_of_state_aux _ _).symm,
  apply_instance,
end
instance fintype_right_moves_of_state_aux (n : ℕ) (s : S) (h : turn_bound s ≤ n) :
  fintype (right_moves (of_state_aux n s h)) :=
begin
  apply fintype.of_equiv _ (right_moves_of_state_aux _ _).symm,
  apply_instance,
end

instance short_of_state_aux : Π (n : ℕ) {s : S} (h : turn_bound s ≤ n), short (of_state_aux n s h)
| 0 s h :=
  short.mk'
  (λ i, begin
    have i := (left_moves_of_state_aux _ _).to_fun i,
    exfalso,
    exact turn_bound_ne_zero_of_left_move i.2 (nonpos_iff_eq_zero.mp h),
  end)
  (λ j, begin
    have j := (right_moves_of_state_aux _ _).to_fun j,
    exfalso,
    exact turn_bound_ne_zero_of_right_move j.2 (nonpos_iff_eq_zero.mp h),
  end)
| (n+1) s h :=
  short.mk'
  (λ i, short_of_relabelling (relabelling_move_left_aux (n+1) h i).symm (short_of_state_aux n _))
  (λ j, short_of_relabelling (relabelling_move_right_aux (n+1) h j).symm (short_of_state_aux n _))

instance short_of_state (s : S) : short (of_state s) :=
begin
  dsimp [pgame.of_state],
  apply_instance
end

end pgame

namespace game

/-- Construct a combinatorial `game` from a state. -/
def of_state {S : Type u} [pgame.state S] (s : S) : game := ⟦pgame.of_state s⟧

end game


-- Chapter 3
variable (p q r : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := by
  apply Iff.intro <;>
  . intro h
    apply And.intro h.right h.left

example : p ∨ q ↔ q ∨ p := by
  apply Iff.intro <;>
  . intro h
    cases h with
    | inl hp => apply Or.inr hp
    | inr hq => apply Or.inl hq

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by
  apply Iff.intro
  . intro h
    apply And.intro h.left.left (And.intro h.left.right h.right)
  . intro h
    apply And.intro (And.intro h.left h.right.left) h.right.right

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := by
  apply Iff.intro
  . intro h
    cases h with
    | inl hl =>
      cases hl with
      | inl hll => apply Or.inl hll
      | inr hlr => apply Or.inr (Or.inl hlr)
    | inr hr => apply Or.inr (Or.inr hr)
  . intro h
    cases h with
    | inl hl => apply Or.inl (Or.inl hl)
    | inr hr =>
      cases hr with
      | inl hrl => apply Or.inl (Or.inr hrl)
      | inr hrr => apply Or.inr hrr

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  apply Iff.intro
  . intro ⟨h1, h2⟩
    cases h2 with
    | inl h2l => apply Or.inl ⟨h1, h2l⟩
    | inr h2r => apply Or.inr ⟨h1, h2r⟩
  . intro h
    cases h with
    | inl hl => apply And.intro hl.left (Or.inl hl.right)
    | inr hr => apply And.intro hr.left (Or.inr hr.right)

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by
  apply Iff.intro
  . intro h
    cases h with
    | inl hl => apply And.intro (Or.inl hl) (Or.inl hl)
    | inr hr => apply And.intro (Or.inr hr.left) (Or.inr hr.right)
  . intro h
    cases h.left with
    | inl hl => apply Or.inl hl
    | inr hr =>
      cases h.right with
      | inl hl => apply Or.inl hl
      | inr hrr => apply Or.inr ⟨hr, hrr⟩

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := by
  apply Iff.intro
  . intro h h2
    apply (h h2.left) h2.right
  . intro h hp hq
    apply h (And.intro hp hq)

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := by
  apply Iff.intro
  . intro h
    constructor
    . intro hp
      apply h (Or.inl hp)
    . intro hq
      apply h (Or.inr hq)
  . intro h h2
    apply Or.elim h2 h.left h.right

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := by
  apply Iff.intro
  . intro h
    constructor
    intro hp
    . apply h (Or.inl hp)
    intro hq
    . apply h (Or.inr hq)
  . intro h h2
    apply h2.elim h.left h.right

example : ¬p ∨ ¬q → ¬(p ∧ q) := by
  intro h h2
  cases h with
  | inl hl => apply hl h2.left
  | inr hr => apply hr h2.right

example : ¬(p ∧ ¬p) := by
  intro h
  apply h.right h.left

example : p ∧ ¬q → ¬(p → q) := by
  intro h1 h2
  apply h1.right (h2 h1.left)

example : ¬p → (p → q) := by
  intro h1 h2
  apply absurd h2 h1

example : (¬p ∨ q) → (p → q) := by
  intro h1 h2
  cases h1 with
  | inl hl => apply absurd h2 hl
  | inr hr => apply hr

example : p ∨ False ↔ p := by
  apply Iff.intro
  . intro h
    cases h with
    | inl hl => apply hl
    | inr hr => apply False.elim hr
  . intro h
    apply Or.inl h

example : p ∧ False ↔ False := by
  apply Iff.intro
  . intro h
    apply h.right
  . intro h
    apply False.elim h

example : (p → q) → (¬q → ¬p) := by
  intro h1 h2 h3
  apply h2 (h1 h3)

open Classical

example : (p → q ∨ r) → ((p → q) ∨ (p → r)) := by
  intro h
  cases (em p) with
  | inl hp =>
    apply (h hp).elim
    . intro hq
      apply Or.inl (λ _ : p => hq)
    . intro hr
      apply Or.inr (λ _ : p => hr)
  | inr hnp =>
    apply Or.inl (λ hp : p => absurd hp hnp)

example : ¬(p ∧ q) → ¬p ∨ ¬q := by
  intro h
  cases (em p) with
  | inl hp =>
    cases (em q) with
    | inl hq =>
      apply absurd (And.intro hp hq) h
    | inr hnq =>
      apply Or.inr
      assumption
  | inr hnp =>
    apply Or.inl
    assumption

example : ¬(p → q) → p ∧ ¬q := by
  intro h
  cases (em q) with
  | inl hq =>
    apply absurd (λ _ : p => hq) h
  | inr hnq =>
    cases (em p) with
    | inl hp =>
      apply And.intro
      repeat assumption
    | inr hnp =>
      exact False.elim (h (λ hp : p => absurd hp hnp))

example : (p → q) → (¬p ∨ q) := by
  intro h
  cases (em p) with
  | inl hp =>
    apply Or.inr
    exact h hp
  | inr hnp =>
    apply Or.inl
    assumption

example : (¬q → ¬p) → (p → q) := by
  intro h hp
  cases (em q) with
  | inl hq => assumption
  | inr hnq => apply absurd hp (h hnq)

example : p ∨ ¬p := by
  apply (em p)

example : (((p → q) → p) → p) := by
  intro h
  cases (em p) with
  | inl hp => assumption
  | inr hnp => apply h (λ hp : p => absurd hp hnp)

example : ¬(p ↔ ¬p) := by
  intro ⟨h1, h2⟩ -- assume for contradiction that p ↔ ¬p

  have hnp : ¬p := λ hp => (h1 hp) hp
  have hp : p := h2 hnp
  exact hnp hp

-- Chapter 4
variable (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := by
  apply Iff.intro
  . intro h
    constructor
    . apply (λ ha : α => (h ha).left)
    . apply (λ ha : α => (h ha).right)
  . intro h
    apply (λ ha : α => And.intro (h.left ha) (h.right ha))

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := by
  intro h1 h2
  apply (λ ha : α => (h1 ha) (h2 ha))

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := by
  intro h
  cases h with
  | inl hl =>
    apply (λ ha : α => Or.inl (hl ha))
  | inr hr =>
    apply (λ ha : α => Or.inr (hr ha))

variable (r : Prop)

open Classical

example : α → ((∀ _ : α, r) ↔ r) := by
  intro h
  apply Iff.intro
  . intro hr
    apply hr h
  . intro hr _
    exact hr

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := by
  apply Iff.intro
  . intro h
    cases (em r) with
    | inl hr => exact Or.inr hr
    | inr hnr =>
      apply Or.inl
        (λ ha : α => Or.elim (h ha)
          (λ hpa : p ha => hpa)
          (λ hr : r => absurd hr hnr))
  . intro h
    apply (λ ha : α =>
      Or.elim h
        (λ hpa : (∀ (x : α), p x) => Or.inl (hpa ha))
        (λ hr : r => Or.inr hr))

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := by
  apply Iff.intro
  . intro h hr
    apply (λ ha : α => (h ha) hr )
  . intro h
    apply (λ ha : α =>
      λ hr : r => (h hr) ha )

variable (men : Type) (barber : men)
variable (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False := by
  have hb := h barber
  cases (em (shaves barber barber)) with
  | inl hsbb => apply (hb.mp hsbb) hsbb
  | inr hnsbb => apply hnsbb (hb.mpr hnsbb)

example : (∃ _ : α, r) → r := by
  intro h
  cases h with
  | intro hx hf => apply hf

example (a : α) : r → (∃ _ : α, r) := by
  intro h
  constructor
  assumption
  assumption

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := by
  apply Iff.intro
  . intro h
    cases h with
    | intro hx hf =>
      have hl := Exists.intro hx hf.left
      exact And.intro hl hf.right
  . intro h
    cases h.left with
    | intro hx hf => apply Exists.intro hx ⟨hf, h.right⟩

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := by
  apply Iff.intro
  . intro h
    cases h with
    | intro hx hf =>
      cases hf with
      | inl hfl => exact Or.inl (Exists.intro hx hfl)
      | inr hfr => exact Or.inr (Exists.intro hx hfr)
  . intro h
    cases h with
    | inl hl =>
      cases hl with
      | intro hx hf => apply Exists.intro hx (Or.inl hf)
    | inr hr =>
      cases hr with
      | intro hx hf => apply Exists.intro hx (Or.inr hf)

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := by
  apply Iff.intro
  . intro h1 h2
    cases h2 with
    | intro hx hf => exact hf (h1 hx)
  . intro h
    apply (λ ha : α =>
      Or.elim (em (p ha))
      (λ hpa : p ha => hpa)
      (λ hnpa : ¬(p ha) => absurd (Exists.intro ha hnpa) h))

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := by
  apply Iff.intro
  . intro h1 h2
    cases h1 with
    | intro hx hf => apply (h2 hx) hf
  . intro h1
    apply (byContradiction fun h2 : ¬(∃ x, p x) =>
          h1 fun x : α =>
            fun hx : p x =>
              h2 ⟨x, hx⟩)

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := by
  apply Iff.intro
  . intro h
    apply (λ ha : α =>
      λ hpx : p ha => h (Exists.intro ha hpx))
  . intro h1 h2
    cases h2 with
    | intro hx hf => apply (h1 hx) hf

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := by
  apply Iff.intro
  . intro h
    apply byContradiction
        fun h2 : ¬(∃ x, ¬ p x) =>
          h fun x : α =>
            Or.elim (em (p x))
              (fun hpx : p x => hpx)
              (fun hnpx : ¬(p x) => absurd ⟨x, hnpx⟩ h2 )
  . intro h1 h2
    cases h1 with
    | intro hx hf => apply hf (h2 hx)

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := by
  apply Iff.intro
  . intro h1 h2
    cases h2 with
    | intro hx hf => apply (h1 hx) hf
  . intro h
    apply (λ ha : α =>
      λ hpa : p ha => h (Exists.intro ha hpa))

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r := by
  apply Iff.intro
  . intro h1 h2
    cases h1 with
    | intro hx hf => apply hf (h2 hx)
  . intro h
    cases em (∀ (x : α), p x) with
    | inl hem => apply Exists.intro a (λ _ : p a => h hem )
    | inr hnem =>
      apply (fun hnap : ¬ ∀ x, p x =>
        byContradiction
          (fun hnex : ¬ ∃ x, p x → r =>
            have hap : ∀ x, p x :=
              fun x =>
              byContradiction
                (fun hnp : ¬ p x =>
                  have hex : ∃ x, p x → r := ⟨x, (fun hp => absurd hp hnp)⟩
                  show False from hnex hex)
            show False from hnap hap))
      assumption

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := by
  apply Iff.intro
  . intro h1 h2
    cases h1 with
    | intro hx hf =>
      apply Exists.intro hx (hf h2)
  . intro h
    cases (em r) with
    | inl hl =>
      cases h hl with
      | intro hx hf =>
        apply Exists.intro hx (λ _ : r => hf)
    | inr h2 =>
      apply Exists.intro a (fun hr : r =>
            absurd hr h2)

-- Chapter 5
example (p q r : Prop) (hp : p)
  : (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) := by
  repeat (first | exact Or.inl hp | exact Or.inr (Or.inl hp) | exact Or.inr (Or.inr hp) | constructor)


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.ring.ulift
import data.equiv.module

/-!
# `ulift` instances for module and multiplicative actions

This file defines instances for module, mul_action and related structures on `ulift` types.

(Recall `ulift α` is just a "copy" of a type `α` in a higher universe.)

We also provide `ulift.module_equiv : ulift M ≃ₗ[R] M`.

-/

namespace ulift
universes u v w
variable {R : Type u}
variable {M : Type v}
variable {N : Type w}

instance has_scalar_left [has_scalar R M] :
  has_scalar (ulift R) M :=
⟨λ s x, s.down • x⟩

@[simp] lemma smul_down [has_scalar R M] (s : ulift R) (x : M) : (s • x) = s.down • x := rfl

@[simp]
lemma smul_down' [has_scalar R M] (s : R) (x : ulift M) :
  (s • x).down = s • x.down :=
rfl

instance is_scalar_tower [has_scalar R M] [has_scalar M N] [has_scalar R N]
  [is_scalar_tower R M N] : is_scalar_tower (ulift R) M N :=
⟨λ x y z, show (x.down • y) • z = x.down • y • z, from smul_assoc _ _ _⟩

instance is_scalar_tower' [has_scalar R M] [has_scalar M N] [has_scalar R N]
  [is_scalar_tower R M N] : is_scalar_tower R (ulift M) N :=
⟨λ x y z, show (x • y.down) • z = x • y.down • z, from smul_assoc _ _ _⟩

instance is_scalar_tower'' [has_scalar R M] [has_scalar M N] [has_scalar R N]
  [is_scalar_tower R M N] : is_scalar_tower R M (ulift N) :=
⟨λ x y z, show up ((x • y) • z.down) = ⟨x • y • z.down⟩, by rw smul_assoc⟩

instance mul_action [monoid R] [mul_action R M] :
  mul_action (ulift R) M :=
{ smul := (•),
  mul_smul := λ r s f, by { cases r, cases s, simp [mul_smul], },
  one_smul := λ f, by { simp [one_smul], } }

instance mul_action' [monoid R] [mul_action R M] :
  mul_action R (ulift M) :=
{ smul := (•),
  mul_smul := λ r s f, by { cases f, ext, simp [mul_smul], },
  one_smul := λ f, by { ext, simp [one_smul], } }

instance distrib_mul_action [monoid R] [add_monoid M] [distrib_mul_action R M] :
  distrib_mul_action (ulift R) M :=
{ smul_zero := λ c, by { cases c, simp [smul_zero], },
  smul_add := λ c f g, by { cases c, simp [smul_add], },
  ..ulift.mul_action }

instance distrib_mul_action' [monoid R] [add_monoid M] [distrib_mul_action R M] :
  distrib_mul_action R (ulift M) :=
{ smul_zero := λ c, by { ext, simp [smul_zero], },
  smul_add := λ c f g, by { ext, simp [smul_add], },
  ..ulift.mul_action' }

instance mul_distrib_mul_action [monoid R] [monoid M] [mul_distrib_mul_action R M] :
  mul_distrib_mul_action (ulift R) M :=
{ smul_one := λ c, by { cases c, simp [smul_one], },
  smul_mul := λ c f g, by { cases c, simp [smul_mul'], },
  ..ulift.mul_action }

instance mul_distrib_mul_action' [monoid R] [monoid M] [mul_distrib_mul_action R M] :
  mul_distrib_mul_action R (ulift M) :=
{ smul_one := λ c, by { ext, simp [smul_one], },
  smul_mul := λ c f g, by { ext, simp [smul_mul'], },
  ..ulift.mul_action' }

instance module [semiring R] [add_comm_monoid M] [module R M] :
  module (ulift R) M :=
{ add_smul := λ c f g, by { cases c, simp [add_smul], },
  zero_smul := λ f, by { simp [zero_smul], },
  ..ulift.distrib_mul_action }

instance module' [semiring R] [add_comm_monoid M] [module R M] :
  module R (ulift M) :=
{ add_smul := by { intros, ext1, apply add_smul },
  zero_smul := by { intros, ext1, apply zero_smul } }

/--
The `R`-linear equivalence between `ulift M` and `M`.
-/
def module_equiv [semiring R] [add_comm_monoid M] [module R M] : ulift M ≃ₗ[R] M :=
{ to_fun := ulift.down,
  inv_fun := ulift.up,
  map_smul' := λ r x, rfl,
  map_add' := λ x y, rfl,
  left_inv := by tidy,
  right_inv := by tidy, }

end ulift


/-
Copyright (c) 2020 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.translations
/-!
# Stabilisation of gcf Computations Under Termination

## Summary

We show that the continuants and convergents of a gcf stabilise once the gcf terminates.
-/

namespace generalized_continued_fraction
open generalized_continued_fraction as gcf
variables {K : Type*} {g : gcf K} {n m : ℕ}

/-- If a gcf terminated at position `n`, it also terminated at `m ≥ n`.-/
lemma terminated_stable (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.terminated_at m :=
g.s.terminated_stable n_le_m terminated_at_n

variable [division_ring K]

lemma continuants_aux_stable_step_of_terminated (terminated_at_n : g.terminated_at n) :
  g.continuants_aux (n + 2) = g.continuants_aux (n + 1) :=
by { rw [terminated_at_iff_s_none] at terminated_at_n,
     simp only [terminated_at_n, continuants_aux] }

lemma continuants_aux_stable_of_terminated (succ_n_le_m : (n + 1) ≤ m)
  (terminated_at_n : g.terminated_at n) :
  g.continuants_aux m = g.continuants_aux (n + 1) :=
begin
  induction succ_n_le_m with m succ_n_le_m IH,
  { refl },
  { have : g.continuants_aux (m + 1) = g.continuants_aux m, by
    { have : n ≤ m - 1, from nat.le_pred_of_lt succ_n_le_m,
      have : g.terminated_at (m - 1), from terminated_stable this terminated_at_n,
      have stable_step : g.continuants_aux (m - 1 + 2) = g.continuants_aux (m - 1 + 1), from
        continuants_aux_stable_step_of_terminated this,
      have one_le_m : 1 ≤ m, from nat.one_le_of_lt succ_n_le_m,
      have : m - 1 + 2 = m + 2 - 1, from (nat.sub_add_comm one_le_m).symm,
      have : m - 1 + 1 = m + 1 - 1, from (nat.sub_add_comm one_le_m).symm,
      simpa [*] using stable_step },
    exact (eq.trans this IH) }
end

lemma convergents'_aux_stable_step_of_terminated {s : seq $ gcf.pair K}
  (terminated_at_n : s.terminated_at n) :
  convergents'_aux s (n + 1) = convergents'_aux s n :=
begin
  change s.nth n = none at terminated_at_n,
  induction n with n IH generalizing s,
  case nat.zero
  { simp only [convergents'_aux, terminated_at_n, seq.head] },
  case nat.succ
  { cases s_head_eq : s.head with gp_head,
    case option.none { simp only [convergents'_aux, s_head_eq] },
    case option.some
    { have : s.tail.terminated_at n, by simp only [seq.terminated_at, s.nth_tail, terminated_at_n],
      simp only [convergents'_aux, s_head_eq, (IH this)] } }
end

lemma convergents'_aux_stable_of_terminated {s : seq $ gcf.pair K} (n_le_m : n ≤ m)
  (terminated_at_n : s.terminated_at n) :
  convergents'_aux s m = convergents'_aux s n :=
begin
  induction n_le_m with m n_le_m IH generalizing s,
  { refl },
  { cases s_head_eq : s.head with gp_head,
    case option.none { cases n; simp only [convergents'_aux, s_head_eq] },
    case option.some
    { have : convergents'_aux s (n + 1) = convergents'_aux s n, from
        convergents'_aux_stable_step_of_terminated terminated_at_n,
      rw [←this],
      have : s.tail.terminated_at n, by
        simpa only [seq.terminated_at, seq.nth_tail] using (s.le_stable n.le_succ terminated_at_n),
      have : convergents'_aux s.tail m = convergents'_aux s.tail n, from IH this,
      simp only [convergents'_aux, s_head_eq, this] } }
end

lemma numerators_stable_of_terminated (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.numerators m = g.numerators n :=
by simp only [num_eq_conts_a, (continuants_stable_of_terminated n_le_m terminated_at_n)]

lemma denominators_stable_of_terminated (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.denominators m = g.denominators n :=
by simp only [denom_eq_conts_b, (continuants_stable_of_terminated n_le_m terminated_at_n)]

lemma convergents_stable_of_terminated (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.convergents m = g.convergents n :=
by simp only [convergents, (denominators_stable_of_terminated n_le_m terminated_at_n),
  (numerators_stable_of_terminated n_le_m terminated_at_n)]

lemma convergents'_stable_of_terminated (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.convergents' m = g.convergents' n :=
by simp only [convergents', (convergents'_aux_stable_of_terminated n_le_m terminated_at_n)]

end generalized_continued_fraction


import tactic linear_algebra.linear_independent

variables {ι : Type*} {R : Type*} {V' : Type*} {M : Type*}

section one

variables {v : ι → M} [semiring R] [add_comm_monoid M] [module R M] {a b : R}

lemma linear_independent_empty_type' (h : ¬ nonempty ι) : linear_independent R v :=
begin
 rw [linear_independent_iff],
 intros,
 ext i,
 exact false.elim (h ⟨i⟩)
end

lemma linear_independent_Union_of_directed' {η : Type*}
  {s : η → set M} (hs : directed (⊆) s)
  (h : ∀ i, linear_independent R (λ x, x : s i → M)) :
  linear_independent R (λ x, x : (⋃ i, s i) → M) :=
begin
  by_cases hη : nonempty η,
  { resetI,
    refine linear_independent_of_finite (⋃ i, s i) (λ t ht ft, _),
    rcases set.finite_subset_Union ft ht with ⟨I, fi, hI⟩,
    rcases hs.finset_le fi.to_finset with ⟨i, hi⟩,
    exact (h i).mono (set.subset.trans hI $ set.bUnion_subset $
      λ j hj, hi j (fi.mem_to_finset.2 hj)) },
  { refine (linear_independent_empty _ _).mono _,
    rintro _ ⟨_, ⟨i, _⟩, _⟩, exact hη ⟨i⟩ }
end

end one

section two

open set module submodule

variables [ring R] [add_comm_group M] [module R M]

lemma exists_maximal_independent'' (s : ι → M) : ∃ I : set ι, linear_independent R (λ x : I, s x) ∧
  ∀ i ∉ I, ∃ a : R, a ≠ 0 ∧ a • s i ∈ span R (s '' I) :=
begin
  classical,
  rcases exists_maximal_independent' R s with ⟨I, hIlinind, hImaximal⟩,
  use [I, hIlinind],
  intros i hi,
  specialize hImaximal (I ∪ {i}) (by simp),
  set J := I ∪ {i} with hJ,
  have memJ : ∀ {x}, x ∈ J ↔ x = i ∨ x ∈ I, by simp [hJ],
  have hiJ : i ∈ J := by simp,
  have h := mt hImaximal _, swap,
  { intro h2,
    rw h2 at hi,
    exact absurd hiJ hi },
  obtain ⟨f, supp_f, sum_f, f_ne⟩ := linear_dependent_comp_subtype.mp h,
  have hfi : f i ≠ 0,
  { contrapose hIlinind,
    refine linear_dependent_comp_subtype.mpr ⟨f, _, sum_f, f_ne⟩,
    simp only [finsupp.mem_supported, hJ] at ⊢ supp_f,
    rintro x hx,
    refine (memJ.mp (supp_f hx)).resolve_left _,
    rintro rfl,
    exact hIlinind (finsupp.mem_support_iff.mp hx) },
  use [f i, hfi],
  have hfi' : i ∈ f.support := finsupp.mem_support_iff.mpr hfi,
  rw [← finset.insert_erase hfi', finset.sum_insert (finset.not_mem_erase _ _),
      add_eq_zero_iff_eq_neg] at sum_f,
  rw sum_f,
  refine neg_mem _ (sum_mem _ (λ c hc, smul_mem _ _ (subset_span ⟨c, _, rfl⟩))),
  exact (memJ.mp (supp_f (finset.erase_subset _ _ hc))).resolve_left (finset.ne_of_mem_erase hc),
end

end two


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

! This file was ported from Lean 3 source module algebraic_geometry.morphisms.universally_closed
! leanprover-community/mathlib commit a8ae1b3f7979249a0af6bc7cf20c1f6bf656ca73
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicGeometry.Morphisms.Basic
import Mathbin.Topology.LocalAtTarget

/-!
# Universally closed morphism

A morphism of schemes `f : X ⟶ Y` is universally closed if `X ×[Y] Y' ⟶ Y'` is a closed map
for all base change `Y' ⟶ Y`.

We show that being universally closed is local at the target, and is stable under compositions and
base changes.

-/

noncomputable section

open CategoryTheory CategoryTheory.Limits Opposite TopologicalSpace

universe v u

namespace AlgebraicGeometry

variable {X Y : Scheme.{u}} (f : X ⟶ Y)

open CategoryTheory.MorphismProperty

open AlgebraicGeometry.MorphismProperty (topologically)

/-- A morphism of schemes `f : X ⟶ Y` is universally closed if the base change `X ×[Y] Y' ⟶ Y'`
along any morphism `Y' ⟶ Y` is (topologically) a closed map.
-/
@[mk_iff]
class UniversallyClosed (f : X ⟶ Y) : Prop where
  out : universally (topologically @IsClosedMap) f
#align algebraic_geometry.universally_closed AlgebraicGeometry.UniversallyClosed

theorem universallyClosed_eq : @UniversallyClosed = universally (topologically @IsClosedMap) := by
  ext (X Y f); rw [universally_closed_iff]
#align algebraic_geometry.universally_closed_eq AlgebraicGeometry.universallyClosed_eq

theorem universallyClosed_respectsIso : RespectsIso @UniversallyClosed :=
  universallyClosed_eq.symm ▸ universally_respectsIso (topologically @IsClosedMap)
#align algebraic_geometry.universally_closed_respects_iso AlgebraicGeometry.universallyClosed_respectsIso

theorem universallyClosed_stableUnderBaseChange : StableUnderBaseChange @UniversallyClosed :=
  universallyClosed_eq.symm ▸ universally_stableUnderBaseChange (topologically @IsClosedMap)
#align algebraic_geometry.universally_closed_stable_under_base_change AlgebraicGeometry.universallyClosed_stableUnderBaseChange

theorem universallyClosed_stableUnderComposition : StableUnderComposition @UniversallyClosed :=
  by
  rw [universally_closed_eq]
  exact stable_under_composition.universally fun X Y Z f g hf hg => IsClosedMap.comp hg hf
#align algebraic_geometry.universally_closed_stable_under_composition AlgebraicGeometry.universallyClosed_stableUnderComposition

instance universallyClosed_type_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z)
    [hf : UniversallyClosed f] [hg : UniversallyClosed g] : UniversallyClosed (f ≫ g) :=
  universallyClosed_stableUnderComposition f g hf hg
#align algebraic_geometry.universally_closed_type_comp AlgebraicGeometry.universallyClosed_type_comp

instance universallyClosed_fst {X Y Z : Scheme} (f : X ⟶ Z) (g : Y ⟶ Z) [hg : UniversallyClosed g] :
    UniversallyClosed (pullback.fst : pullback f g ⟶ _) :=
  universallyClosed_stableUnderBaseChange.fst f g hg
#align algebraic_geometry.universally_closed_fst AlgebraicGeometry.universallyClosed_fst

instance universallyClosed_snd {X Y Z : Scheme} (f : X ⟶ Z) (g : Y ⟶ Z) [hf : UniversallyClosed f] :
    UniversallyClosed (pullback.snd : pullback f g ⟶ _) :=
  universallyClosed_stableUnderBaseChange.snd f g hf
#align algebraic_geometry.universally_closed_snd AlgebraicGeometry.universallyClosed_snd

theorem morphismRestrict_base {X Y : Scheme} (f : X ⟶ Y) (U : Opens Y.carrier) :
    ⇑(f ∣_ U).1.base = U.1.restrictPreimage f.1 :=
  funext fun x => Subtype.ext <| morphismRestrict_base_coe f U x
#align algebraic_geometry.morphism_restrict_base AlgebraicGeometry.morphismRestrict_base

theorem universallyClosedIsLocalAtTarget : PropertyIsLocalAtTarget @UniversallyClosed :=
  by
  rw [universally_closed_eq]
  apply universally_is_local_at_target_of_morphism_restrict
  ·
    exact
      stable_under_composition.respects_iso (fun X Y Z f g hf hg => IsClosedMap.comp hg hf)
        fun X Y f => (TopCat.homeoOfIso (Scheme.forget_to_Top.map_iso f)).IsClosedMap
  · intro X Y f ι U hU H
    simp_rw [topologically, morphism_restrict_base] at H
    exact (isClosedMap_iff_isClosedMap_of_supᵢ_eq_top hU).mpr H
#align algebraic_geometry.universally_closed_is_local_at_target AlgebraicGeometry.universallyClosedIsLocalAtTarget

theorem UniversallyClosed.openCover_iff {X Y : Scheme.{u}} (f : X ⟶ Y)
    (𝒰 : Scheme.OpenCover.{u} Y) :
    UniversallyClosed f ↔ ∀ i, UniversallyClosed (pullback.snd : pullback f (𝒰.map i) ⟶ _) :=
  universallyClosedIsLocalAtTarget.openCover_iff f 𝒰
#align algebraic_geometry.universally_closed.open_cover_iff AlgebraicGeometry.UniversallyClosed.openCover_iff

end AlgebraicGeometry


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/

import data.nat.upto
import data.stream.basic
import data.pfun

/-!
# Fixed point

This module defines a generic `fix` operator for defining recursive
computations that are not necessarily well-founded or productive.
An instance is defined for `roption`.

## Main definition

 * class `has_fix`
 * `roption.fix`
-/

universes u v

open_locale classical
variables {α : Type*} {β : α → Type*}

/-- `has_fix α` gives us a way to calculate the fixed point
of function of type `α → α`. -/
class has_fix (α : Type*) :=
(fix : (α → α) → α)

namespace roption

open roption nat nat.upto

section basic

variables (f : (Π a, roption $ β a) → (Π a, roption $ β a))

/-- A series of successive, finite approximation of the fixed point of `f`, defined by
`approx f n = f^[n] ⊥`. The limit of this chain is the fixed point of `f`. -/
def fix.approx : stream $ Π a, roption $ β a
| 0 := ⊥
| (nat.succ i) := f (fix.approx i)

/-- loop body for finding the fixed point of `f` -/
def fix_aux {p : ℕ → Prop} (i : nat.upto p)
  (g : Π j : nat.upto p, i < j → Π a, roption $ β a) : Π a, roption $ β a :=
f $ λ x : α,
assert (¬p (i.val)) $ λ h : ¬ p (i.val),
g (i.succ h) (nat.lt_succ_self _) x

/-- The least fixed point of `f`.

If `f` is a continuous function (according to complete partial orders),
it satisfies the equations:

  1. `fix f = f (fix f)`          (is a fixed point)
  2. `∀ X, f X ≤ X → fix f ≤ X`   (least fixed point)
-/
protected def fix (x : α) : roption $ β x :=
roption.assert (∃ i, (fix.approx f i x).dom) $ λ h,
well_founded.fix.{1} (nat.upto.wf h) (fix_aux f) nat.upto.zero x

protected lemma fix_def {x : α} (h' : ∃ i, (fix.approx f i x).dom) :
  roption.fix f x = fix.approx f (nat.succ $ nat.find h') x :=
begin
  let p := λ (i : ℕ), (fix.approx f i x).dom,
  have : p (nat.find h') := nat.find_spec h',
  generalize hk : nat.find h' = k,
  replace hk : nat.find h' = k + (@upto.zero p).val := hk,
  rw hk at this,
  revert hk,
  dsimp [roption.fix], rw assert_pos h', revert this,
  generalize : upto.zero = z, intros,
  suffices : ∀ x',
    well_founded.fix (fix._proof_1 f x h') (fix_aux f) z x' = fix.approx f (succ k) x',
    from this _,
  induction k generalizing z; intro,
  { rw [fix.approx,well_founded.fix_eq,fix_aux],
    congr, ext : 1, rw assert_neg, refl,
    rw nat.zero_add at this,
    simpa only [not_not, subtype.val_eq_coe] },
  { rw [fix.approx,well_founded.fix_eq,fix_aux],
    congr, ext : 1,
    have hh : ¬(fix.approx f (z.val) x).dom,
    { apply nat.find_min h',
      rw [hk,nat.succ_add,← nat.add_succ],
      apply nat.lt_of_succ_le,
      apply nat.le_add_left },
    rw succ_add_eq_succ_add at this hk,
    rw [assert_pos hh, k_ih (upto.succ z hh) this hk] }
end

end basic

end roption

namespace roption

instance : has_fix (roption α) :=
⟨λ f, roption.fix (λ x u, f (x u)) ()⟩

end roption

open sigma

namespace pi

instance roption.has_fix {β} : has_fix (α → roption β) := ⟨roption.fix⟩

end pi