/-
Copyright (c) 2023 Wojciech Nawrocki. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Wojciech Nawrocki
-/

import ProofChecker.Model.PropVars

/-! Reasoning about definitional extensions. -/

namespace PropTerm

variable [DecidableEq ν]

theorem equivalentOver_def_ext {x : ν} {X : Set ν} (φ ψ : PropTerm ν) :
    ↑φ.semVars ⊆ X → ↑ψ.semVars ⊆ X → x ∉ X → equivalentOver X φ (φ ⊓ .biImpl (.var x) ψ) := by
  intro hφ hψ hMem τ
  constructor
  case mp =>
    intro ⟨σ₁, hAgree, h₁⟩
    let σ₂ := σ₁.set x (ψ.eval σ₁)
    have hAgree₂₁ : σ₂.agreeOn X σ₁ := σ₁.agreeOn_set_of_not_mem _ hMem
    have : σ₂.agreeOn X τ := hAgree₂₁.trans hAgree
    have : σ₂ ⊨ φ := agreeOn_semVars (hAgree₂₁.subset hφ) |>.mpr h₁
    have : σ₂ ⊨ ψ ↔ σ₁ ⊨ ψ := agreeOn_semVars (hAgree₂₁.subset hψ)
    have : σ₂ ⊨ .biImpl (.var x) ψ := by aesop
    exact ⟨σ₂, by assumption, satisfies_conj.mpr (by constructor <;> assumption)⟩
  case mpr =>
    intro ⟨σ₂, hAgree, h₂⟩
    exact ⟨σ₂, hAgree, (satisfies_conj.mp h₂).left⟩

theorem equivalentOver_def_self {x : ν} {X : Set ν} (φ : PropTerm ν) :
    x ∉ X → ↑φ.semVars ⊆ X → equivalentOver X (.var x ⊓ .biImpl (.var x) φ) φ := by
  intro hMem hφ τ
  constructor
  case mp =>
    intro ⟨σ₁, hAgree, h₁⟩
    simp only [satisfies_conj, satisfies_biImpl] at h₁
    exact ⟨σ₁, hAgree, h₁.right.mp h₁.left⟩
  case mpr =>
    intro ⟨σ₂, hAgree, h₂⟩
    let σ₁ := σ₂.set x ⊤
    have hAgree₁₂ : σ₁.agreeOn X σ₂ := σ₂.agreeOn_set_of_not_mem _ hMem
    have : σ₁.agreeOn X τ := hAgree₁₂.trans hAgree
    have : σ₁ ⊨ φ := agreeOn_semVars (hAgree₁₂.subset hφ) |>.mpr h₂
    exact ⟨σ₁, by assumption, satisfies_conj.mpr (by simp (config := {zeta := false}) [this])⟩

theorem hasUniqueExtension_def_ext {X : Set ν} (x : ν) (φ ψ : PropTerm ν) :
    ↑ψ.semVars ⊆ X → hasUniqueExtension X (insert x X) (φ ⊓ .biImpl (.var x) ψ) := by
  intro hψ σ₁ σ₂ h₁ h₂ hAgree
  suffices σ₁ ⊨ .var x ↔ σ₂ ⊨ .var x by
    intro x h
    cases Set.mem_insert_iff.mp h
    next h =>
      simp only [satisfies_var, ← Bool.eq_iff_eq_true_iff] at this
      rw [h, this]
    next h => exact hAgree _ h
  have := agreeOn_semVars (hAgree.subset hψ)
  constructor <;> simp_all

theorem disj_def_eq (x : ν) (φ₁ φ₂ : PropTerm ν) :
    ((.var x)ᶜ ⊔ (φ₁ ⊔ φ₂)) ⊓ ((.var x ⊔ φ₁ᶜ) ⊓ (.var x ⊔ φ₂ᶜ)) = .biImpl (.var x) (φ₁ ⊔ φ₂) := by
  ext τ
  cases h : τ x <;> simp [not_or, h]

theorem equivalentOver_disj_def_ext {x : ν} {X : Set ν} (φ φ₁ φ₂ : PropTerm ν) :
    ↑φ.semVars ⊆ X → ↑φ₁.semVars ⊆ X → ↑φ₂.semVars ⊆ X → x ∉ X →
    equivalentOver X φ (φ ⊓ ((.var x)ᶜ ⊔ φ₁ ⊔ φ₂) ⊓ (.var x ⊔ φ₁ᶜ) ⊓ (.var x ⊔ φ₂ᶜ)) := by
  intro hφ h₁ h₂ hMem
  simp [sup_assoc, inf_assoc, disj_def_eq]
  have := Finset.coe_subset.mpr (semVars_disj φ₁ φ₂)
  apply equivalentOver_def_ext _ _ hφ (subset_trans this (by simp [*])) hMem

-- TODO: bigConj_def_eq

end PropTerm


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

! This file was ported from Lean 3 source module algebra.lie.cartan_subalgebra
! leanprover-community/mathlib commit 938fead7abdc0cbbca8eba7a1052865a169dc102
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.Nilpotent
import Mathbin.Algebra.Lie.Normalizer

/-!
# Cartan subalgebras

Cartan subalgebras are one of the most important concepts in Lie theory. We define them here.
The standard example is the set of diagonal matrices in the Lie algebra of matrices.

## Main definitions

  * `lie_submodule.is_ucs_limit`
  * `lie_subalgebra.is_cartan_subalgebra`
  * `lie_subalgebra.is_cartan_subalgebra_iff_is_ucs_limit`

## Tags

lie subalgebra, normalizer, idealizer, cartan subalgebra
-/

universe u v w w₁ w₂

variable {R : Type u} {L : Type v}

variable [CommRing R] [LieRing L] [LieAlgebra R L] (H : LieSubalgebra R L)

/-- Given a Lie module `M` of a Lie algebra `L`, `lie_submodule.is_ucs_limit` is the proposition
that a Lie submodule `N ⊆ M` is the limiting value for the upper central series.

This is a characteristic property of Cartan subalgebras with the roles of `L`, `M`, `N` played by
`H`, `L`, `H`, respectively. See `lie_subalgebra.is_cartan_subalgebra_iff_is_ucs_limit`. -/
def LieSubmodule.IsUcsLimit {M : Type _} [AddCommGroup M] [Module R M] [LieRingModule L M]
    [LieModule R L M] (N : LieSubmodule R L M) : Prop :=
  ∃ k, ∀ l, k ≤ l → (⊥ : LieSubmodule R L M).ucs l = N
#align lie_submodule.is_ucs_limit LieSubmodule.IsUcsLimit

namespace LieSubalgebra

/-- A Cartan subalgebra is a nilpotent, self-normalizing subalgebra. -/
class IsCartanSubalgebra : Prop where
  nilpotent : LieAlgebra.IsNilpotent R H
  self_normalizing : H.normalizer = H
#align lie_subalgebra.is_cartan_subalgebra LieSubalgebra.IsCartanSubalgebra

instance [H.IsCartanSubalgebra] : LieAlgebra.IsNilpotent R H :=
  IsCartanSubalgebra.nilpotent

@[simp]
theorem normalizer_eq_self_of_isCartanSubalgebra (H : LieSubalgebra R L) [H.IsCartanSubalgebra] :
    H.toLieSubmodule.normalizer = H.toLieSubmodule := by
  rw [← LieSubmodule.coe_to_submodule_eq_iff, coe_normalizer_eq_normalizer,
    is_cartan_subalgebra.self_normalizing, coe_to_lie_submodule]
#align lie_subalgebra.normalizer_eq_self_of_is_cartan_subalgebra LieSubalgebra.normalizer_eq_self_of_isCartanSubalgebra

@[simp]
theorem ucs_eq_self_of_isCartanSubalgebra (H : LieSubalgebra R L) [H.IsCartanSubalgebra] (k : ℕ) :
    H.toLieSubmodule.ucs k = H.toLieSubmodule :=
  by
  induction' k with k ih
  · simp
  · simp [ih]
#align lie_subalgebra.ucs_eq_self_of_is_cartan_subalgebra LieSubalgebra.ucs_eq_self_of_isCartanSubalgebra

theorem isCartanSubalgebra_iff_isUcsLimit : H.IsCartanSubalgebra ↔ H.toLieSubmodule.IsUcsLimit :=
  by
  constructor
  · intro h
    have h₁ : _root_.lie_algebra.is_nilpotent R H := by infer_instance
    obtain ⟨k, hk⟩ := H.to_lie_submodule.is_nilpotent_iff_exists_self_le_ucs.mp h₁
    replace hk : H.to_lie_submodule = LieSubmodule.ucs k ⊥ :=
      le_antisymm hk
        (LieSubmodule.ucs_le_of_normalizer_eq_self H.normalizer_eq_self_of_is_cartan_subalgebra k)
    refine' ⟨k, fun l hl => _⟩
    rw [← Nat.sub_add_cancel hl, LieSubmodule.ucs_add, ← hk,
      LieSubalgebra.ucs_eq_self_of_isCartanSubalgebra]
  · rintro ⟨k, hk⟩
    exact
      { nilpotent := by
          dsimp only [LieAlgebra.IsNilpotent]
          erw [H.to_lie_submodule.is_nilpotent_iff_exists_lcs_eq_bot]
          use k
          rw [_root_.eq_bot_iff, LieSubmodule.lcs_le_iff, hk k (le_refl k)]
          exact le_refl _
        self_normalizing := by
          have hk' := hk (k + 1) k.le_succ
          rw [LieSubmodule.ucs_succ, hk k (le_refl k)] at hk'
          rw [← LieSubalgebra.coe_to_submodule_eq_iff, ← LieSubalgebra.coe_normalizer_eq_normalizer,
            hk', LieSubalgebra.coe_toLieSubmodule] }
#align lie_subalgebra.is_cartan_subalgebra_iff_is_ucs_limit LieSubalgebra.isCartanSubalgebra_iff_isUcsLimit

end LieSubalgebra

@[simp]
theorem LieIdeal.normalizer_eq_top {R : Type u} {L : Type v} [CommRing R] [LieRing L]
    [LieAlgebra R L] (I : LieIdeal R L) : (I : LieSubalgebra R L).normalizer = ⊤ :=
  by
  ext x
  simpa only [LieSubalgebra.mem_normalizer_iff, LieSubalgebra.mem_top, iff_true_iff] using
    fun y hy => I.lie_mem hy
#align lie_ideal.normalizer_eq_top LieIdeal.normalizer_eq_top

open LieIdeal

/-- A nilpotent Lie algebra is its own Cartan subalgebra. -/
instance LieAlgebra.top_isCartanSubalgebra_of_nilpotent [LieAlgebra.IsNilpotent R L] :
    LieSubalgebra.IsCartanSubalgebra (⊤ : LieSubalgebra R L)
    where
  nilpotent := inferInstance
  self_normalizing := by rw [← top_coe_lie_subalgebra, normalizer_eq_top, top_coe_lie_subalgebra]
#align lie_algebra.top_is_cartan_subalgebra_of_nilpotent LieAlgebra.top_isCartanSubalgebra_of_nilpotent


/-
Copyright (c) 2020 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Adam Topaz
-/

import category_theory.concrete_category.bundled
import category_theory.full_subcategory
import category_theory.skeletal
import data.fin.basic
import data.fintype.basic

/-!
# The category of finite types.

We define the category of finite types, denoted `Fintype` as
(bundled) types with a `fintype` instance.

We also define `Fintype.skeleton`, the standard skeleton of `Fintype` whose objects are `fin n`
for `n : ℕ`. We prove that the obvious inclusion functor `Fintype.skeleton ⥤ Fintype` is an
equivalence of categories in `Fintype.skeleton.equivalence`.
We prove that `Fintype.skeleton` is a skeleton of `Fintype` in `Fintype.is_skeleton`.
-/

open_locale classical
open category_theory

/-- The category of finite types. -/
def Fintype := bundled fintype

namespace Fintype

instance : has_coe_to_sort Fintype Type* := bundled.has_coe_to_sort

/-- Construct a bundled `Fintype` from the underlying type and typeclass. -/
def of (X : Type*) [fintype X] : Fintype := bundled.of X
instance : inhabited Fintype := ⟨⟨pempty⟩⟩
instance {X : Fintype} : fintype X := X.2

instance : category Fintype := induced_category.category bundled.α

/-- The fully faithful embedding of `Fintype` into the category of types. -/
@[derive [full, faithful], simps]
def incl : Fintype ⥤ Type* := induced_functor _

instance : concrete_category Fintype := ⟨incl⟩

@[simp] lemma id_apply (X : Fintype) (x : X) : (𝟙 X : X → X) x = x := rfl
@[simp] lemma comp_apply {X Y Z : Fintype} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) :
  (f ≫ g) x = g (f x) := rfl

universe u
/--
The "standard" skeleton for `Fintype`. This is the full subcategory of `Fintype` spanned by objects
of the form `ulift (fin n)` for `n : ℕ`. We parameterize the objects of `Fintype.skeleton`
directly as `ulift ℕ`, as the type `ulift (fin m) ≃ ulift (fin n)` is
nonempty if and only if `n = m`. Specifying universes, `skeleton : Type u` is a small
skeletal category equivalent to `Fintype.{u}`.
-/
def skeleton : Type u := ulift ℕ

namespace skeleton

/-- Given any natural number `n`, this creates the associated object of `Fintype.skeleton`. -/
def mk : ℕ → skeleton := ulift.up

instance : inhabited skeleton := ⟨mk 0⟩

/-- Given any object of `Fintype.skeleton`, this returns the associated natural number. -/
def len : skeleton → ℕ := ulift.down

@[ext]
lemma ext (X Y : skeleton) : X.len = Y.len → X = Y := ulift.ext _ _

instance : small_category skeleton.{u} :=
{ hom := λ X Y, ulift.{u} (fin X.len) → ulift.{u} (fin Y.len),
  id := λ _, id,
  comp := λ _ _ _ f g, g ∘ f }

lemma is_skeletal : skeletal skeleton.{u} := λ X Y ⟨h⟩, ext _ _ $ fin.equiv_iff_eq.mp $
  nonempty.intro $
{ to_fun := λ x, (h.hom ⟨x⟩).down,
  inv_fun := λ x, (h.inv ⟨x⟩).down,
  left_inv := begin
    intro a,
    change ulift.down _ = _,
    rw ulift.up_down,
    change ((h.hom ≫ h.inv) _).down = _,
    simpa,
  end,
  right_inv := begin
    intro a,
    change ulift.down _ = _,
    rw ulift.up_down,
    change ((h.inv ≫ h.hom) _).down = _,
    simpa,
  end }

/-- The canonical fully faithful embedding of `Fintype.skeleton` into `Fintype`. -/
def incl : skeleton.{u} ⥤ Fintype.{u} :=
{ obj := λ X, Fintype.of (ulift (fin X.len)),
  map := λ _ _ f, f }

instance : full incl := { preimage := λ _ _ f, f }
instance : faithful incl := {}
instance : ess_surj incl :=
ess_surj.mk $ λ X, let F := fintype.equiv_fin X in ⟨mk (fintype.card X), nonempty.intro
  { hom := F.symm ∘ ulift.down,
    inv := ulift.up ∘ F }⟩

noncomputable instance : is_equivalence incl :=
equivalence.of_fully_faithfully_ess_surj _

/-- The equivalence between `Fintype.skeleton` and `Fintype`. -/
noncomputable def equivalence : skeleton ≌ Fintype := incl.as_equivalence

@[simp] lemma incl_mk_nat_card (n : ℕ) : fintype.card (incl.obj (mk n)) = n :=
begin
  convert finset.card_fin n,
  apply fintype.of_equiv_card,
end

end skeleton

/-- `Fintype.skeleton` is a skeleton of `Fintype`. -/
noncomputable def is_skeleton : is_skeleton_of Fintype skeleton skeleton.incl :=
{ skel := skeleton.is_skeletal,
  eqv := by apply_instance }

end Fintype


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.uniform_space.cauchy
import topology.uniform_space.separation
import topology.dense_embedding

/-!
# Theory of complete separated uniform spaces.

This file is for elementary lemmas that depend on both Cauchy filters and separation.
-/

open filter
open_locale topological_space filter

variables {α : Type*}

/-In a separated space, a complete set is closed -/
lemma is_complete.is_closed  [uniform_space α] [separated_space α] {s : set α} (h : is_complete s) :
  is_closed s :=
is_closed_iff_cluster_pt.2 $ λ a ha, begin
  let f := 𝓝[s] a,
  have : cauchy f := cauchy_nhds.mono' ha inf_le_left,
  rcases h f this (inf_le_right) with ⟨y, ys, fy⟩,
  rwa (tendsto_nhds_unique' ha inf_le_left fy : a = y)
end

namespace dense_inducing
open filter
variables [topological_space α] {β : Type*} [topological_space β]
variables {γ : Type*} [uniform_space γ] [complete_space γ] [separated_space γ]

lemma continuous_extend_of_cauchy {e : α → β} {f : α → γ}
  (de : dense_inducing e) (h : ∀ b : β, cauchy (map f (comap e $ 𝓝 b))) :
  continuous (de.extend f) :=
de.continuous_extend $ λ b, complete_space.complete (h b)

end dense_inducing


theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro,
  exact hp,
  apply and.intro,
  exact hq,
  exact hp
end


/-
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 order.height
! leanprover-community/mathlib commit bf27744463e9620ca4e4ebe951fe83530ae6949b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Enat.Lattice
import Mathbin.Order.OrderIsoNat
import Mathbin.Tactic.Tfae

/-!

# Maximal length of chains

This file contains lemmas to work with the maximal length of strictly descending finite
sequences (chains) in a partial order.

## Main definition

- `set.subchain`: The set of strictly ascending lists of `α` contained in a `set α`.
- `set.chain_height`: The maximal length of a strictly ascending sequence in a partial order.
This is defined as the maximum of the lengths of `set.subchain`s, valued in `ℕ∞`.

## Main results

- `set.exists_chain_of_le_chain_height`: For each `n : ℕ` such that `n ≤ s.chain_height`, there
  exists `s.subchain` of length `n`.
- `set.chain_height_mono`: If `s ⊆ t` then `s.chain_height ≤ t.chain_height`.
- `set.chain_height_image`: If `f` is an order embedding, then
  `(f '' s).chain_height = s.chain_height`.
- `set.chain_height_insert_of_forall_lt`: If `∀ y ∈ s, y < x`, then
  `(insert x s).chain_height = s.chain_height + 1`.
- `set.chain_height_insert_of_lt_forall`: If `∀ y ∈ s, x < y`, then
  `(insert x s).chain_height = s.chain_height + 1`.
- `set.chain_height_union_eq`: If `∀ x ∈ s, ∀ y ∈ t, s ≤ t`, then
  `(s ∪ t).chain_height = s.chain_height + t.chain_height`.
- `set.well_founded_gt_of_chain_height_ne_top`:
  If `s` has finite height, then `>` is well-founded on `s`.
- `set.well_founded_lt_of_chain_height_ne_top`:
  If `s` has finite height, then `<` is well-founded on `s`.

-/

open List OrderDual

universe u v

variable {α β : Type _}

namespace Set

section LT

variable [LT α] [LT β] (s t : Set α)

/-- The set of strictly ascending lists of `α` contained in a `set α`. -/
def subchain : Set (List α) :=
  { l | l.Chain' (· < ·) ∧ ∀ i ∈ l, i ∈ s }
#align set.subchain Set.subchain

theorem nil_mem_subchain : [] ∈ s.subchain :=
  ⟨trivial, fun x hx => hx.elim⟩
#align set.nil_mem_subchain Set.nil_mem_subchain

variable {s} {l : List α} {a : α}

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem cons_mem_subchain_iff :
    (a::l) ∈ s.subchain ↔ a ∈ s ∧ l ∈ s.subchain ∧ ∀ b ∈ l.head?, a < b :=
  by
  refine'
    ⟨fun h =>
      ⟨h.2 _ (Or.inl rfl), ⟨(chain'_cons'.mp h.1).2, fun i hi => h.2 _ (Or.inr hi)⟩,
        (chain'_cons'.mp h.1).1⟩,
      _⟩
  rintro ⟨h₁, h₂, h₃⟩
  constructor
  · rw [chain'_cons']
    exact ⟨h₃, h₂.1⟩
  · rintro i (rfl | hi)
    exacts[h₁, h₂.2 _ hi]
#align set.cons_mem_subchain_iff Set.cons_mem_subchain_iff

instance : Nonempty s.subchain :=
  ⟨⟨[], s.nil_mem_subchain⟩⟩

variable (s)

/-- The maximal length of a strictly ascending sequence in a partial order. -/
noncomputable def chainHeight : ℕ∞ :=
  ⨆ l ∈ s.subchain, length l
#align set.chain_height Set.chainHeight

theorem chainHeight_eq_supᵢ_subtype : s.chainHeight = ⨆ l : s.subchain, l.1.length :=
  supᵢ_subtype'
#align set.chain_height_eq_supr_subtype Set.chainHeight_eq_supᵢ_subtype

theorem exists_chain_of_le_chainHeight {n : ℕ} (hn : ↑n ≤ s.chainHeight) :
    ∃ l ∈ s.subchain, length l = n :=
  by
  cases' (le_top : s.chain_height ≤ ⊤).eq_or_lt with ha ha <;>
    rw [chain_height_eq_supr_subtype] at ha
  · obtain ⟨_, ⟨⟨l, h₁, h₂⟩, rfl⟩, h₃⟩ :=
      not_bdd_above_iff'.mp ((WithTop.supr_coe_eq_top _).mp ha) n
    exact
      ⟨l.take n, ⟨h₁.take _, fun x h => h₂ _ <| take_subset _ _ h⟩,
        (l.length_take n).trans <| min_eq_left <| le_of_not_ge h₃⟩
  · rw [WithTop.supr_coe_lt_top] at ha
    obtain ⟨⟨l, h₁, h₂⟩, e : l.length = _⟩ := Nat.supₛ_mem (Set.range_nonempty _) ha
    refine'
      ⟨l.take n, ⟨h₁.take _, fun x h => h₂ _ <| take_subset _ _ h⟩,
        (l.length_take n).trans <| min_eq_left <| _⟩
    rwa [e, ← WithTop.coe_le_coe, supₛ_range, WithTop.coe_supᵢ _ ha, ← chain_height_eq_supr_subtype]
#align set.exists_chain_of_le_chain_height Set.exists_chain_of_le_chainHeight

theorem le_chainHeight_tFAE (n : ℕ) :
    TFAE [↑n ≤ s.chainHeight, ∃ l ∈ s.subchain, length l = n, ∃ l ∈ s.subchain, n ≤ length l] :=
  by
  tfae_have 1 → 2; · exact s.exists_chain_of_le_chain_height
  tfae_have 2 → 3;
  · rintro ⟨l, hls, he⟩
    exact ⟨l, hls, he.ge⟩
  tfae_have 3 → 1;
  · rintro ⟨l, hs, hn⟩
    exact le_supᵢ₂_of_le l hs (WithTop.coe_le_coe.2 hn)
  tfae_finish
#align set.le_chain_height_tfae Set.le_chainHeight_tFAE

variable {s t}

theorem le_chainHeight_iff {n : ℕ} : ↑n ≤ s.chainHeight ↔ ∃ l ∈ s.subchain, length l = n :=
  (le_chainHeight_tFAE s n).out 0 1
#align set.le_chain_height_iff Set.le_chainHeight_iff

theorem length_le_chainHeight_of_mem_subchain (hl : l ∈ s.subchain) : ↑l.length ≤ s.chainHeight :=
  le_chainHeight_iff.mpr ⟨l, hl, rfl⟩
#align set.length_le_chain_height_of_mem_subchain Set.length_le_chainHeight_of_mem_subchain

theorem chainHeight_eq_top_iff : s.chainHeight = ⊤ ↔ ∀ n, ∃ l ∈ s.subchain, length l = n :=
  by
  refine' ⟨fun h n => le_chain_height_iff.1 (le_top.trans_eq h.symm), fun h => _⟩
  contrapose! h; obtain ⟨n, hn⟩ := WithTop.ne_top_iff_exists.1 h
  exact
    ⟨n + 1, fun l hs =>
      (Nat.lt_succ_iff.2 <|
          WithTop.coe_le_coe.1 <| (length_le_chain_height_of_mem_subchain hs).trans_eq hn.symm).Ne⟩
#align set.chain_height_eq_top_iff Set.chainHeight_eq_top_iff

@[simp]
theorem one_le_chainHeight_iff : 1 ≤ s.chainHeight ↔ s.Nonempty :=
  by
  change ((1 : ℕ) : ENat) ≤ _ ↔ _
  rw [Set.le_chainHeight_iff]
  constructor
  · rintro ⟨_ | ⟨x, xs⟩, ⟨h₁, h₂⟩, h₃⟩
    · cases h₃
    · exact ⟨x, h₂ _ (Or.inl rfl)⟩
  · rintro ⟨x, hx⟩
    exact ⟨[x], ⟨chain.nil, fun y h => (list.mem_singleton.mp h).symm ▸ hx⟩, rfl⟩
#align set.one_le_chain_height_iff Set.one_le_chainHeight_iff

@[simp]
theorem chainHeight_eq_zero_iff : s.chainHeight = 0 ↔ s = ∅ := by
  rw [← not_iff_not, ← Ne.def, ← bot_eq_zero, ← bot_lt_iff_ne_bot, bot_eq_zero, ←
    ENat.one_le_iff_pos, one_le_chain_height_iff, nonempty_iff_ne_empty]
#align set.chain_height_eq_zero_iff Set.chainHeight_eq_zero_iff

@[simp]
theorem chainHeight_empty : (∅ : Set α).chainHeight = 0 :=
  chainHeight_eq_zero_iff.2 rfl
#align set.chain_height_empty Set.chainHeight_empty

@[simp]
theorem chainHeight_of_isEmpty [IsEmpty α] : s.chainHeight = 0 :=
  chainHeight_eq_zero_iff.mpr (Subsingleton.elim _ _)
#align set.chain_height_of_is_empty Set.chainHeight_of_isEmpty

theorem le_chainHeight_add_nat_iff {n m : ℕ} :
    ↑n ≤ s.chainHeight + m ↔ ∃ l ∈ s.subchain, n ≤ length l + m := by
  simp_rw [← tsub_le_iff_right, ← WithTop.coe_sub, (le_chain_height_tfae s (n - m)).out 0 2]
#align set.le_chain_height_add_nat_iff Set.le_chainHeight_add_nat_iff

theorem chainHeight_add_le_chainHeight_add (s : Set α) (t : Set β) (n m : ℕ) :
    s.chainHeight + n ≤ t.chainHeight + m ↔
      ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l + n ≤ length l' + m :=
  by
  refine'
    ⟨fun e l h =>
      le_chain_height_add_nat_iff.1
        ((add_le_add_right (length_le_chain_height_of_mem_subchain h) _).trans e),
      fun H => _⟩
  by_cases s.chain_height = ⊤
  · suffices t.chain_height = ⊤ by
      rw [this, top_add]
      exact le_top
    rw [chain_height_eq_top_iff] at h⊢
    intro k
    rw [(le_chain_height_tfae t k).out 1 2]
    obtain ⟨l, hs, hl⟩ := h (k + m)
    obtain ⟨l', ht, hl'⟩ := H l hs
    exact ⟨l', ht, (add_le_add_iff_right m).1 <| trans (hl.symm.trans_le le_self_add) hl'⟩
  · obtain ⟨k, hk⟩ := WithTop.ne_top_iff_exists.1 h
    obtain ⟨l, hs, hl⟩ := le_chain_height_iff.1 hk.le
    rw [← hk, ← hl]
    exact le_chain_height_add_nat_iff.2 (H l hs)
#align set.chain_height_add_le_chain_height_add Set.chainHeight_add_le_chainHeight_add

theorem chainHeight_le_chainHeight_tFAE (s : Set α) (t : Set β) :
    TFAE
      [s.chainHeight ≤ t.chainHeight, ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l = length l',
        ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l ≤ length l'] :=
  by
  tfae_have 1 ↔ 3; · convert← chain_height_add_le_chain_height_add s t 0 0 <;> apply add_zero
  tfae_have 2 ↔ 3;
  · refine' forall₂_congr fun l hl => _
    simp_rw [← (le_chain_height_tfae t l.length).out 1 2, eq_comm]
  tfae_finish
#align set.chain_height_le_chain_height_tfae Set.chainHeight_le_chainHeight_tFAE

theorem chainHeight_le_chainHeight_iff {t : Set β} :
    s.chainHeight ≤ t.chainHeight ↔ ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l = length l' :=
  (chainHeight_le_chainHeight_tFAE s t).out 0 1
#align set.chain_height_le_chain_height_iff Set.chainHeight_le_chainHeight_iff

theorem chainHeight_le_chainHeight_iff_le {t : Set β} :
    s.chainHeight ≤ t.chainHeight ↔ ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l ≤ length l' :=
  (chainHeight_le_chainHeight_tFAE s t).out 0 2
#align set.chain_height_le_chain_height_iff_le Set.chainHeight_le_chainHeight_iff_le

theorem chainHeight_mono (h : s ⊆ t) : s.chainHeight ≤ t.chainHeight :=
  chainHeight_le_chainHeight_iff.2 fun l hl => ⟨l, ⟨hl.1, fun i hi => h <| hl.2 i hi⟩, rfl⟩
#align set.chain_height_mono Set.chainHeight_mono

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem chainHeight_image (f : α → β) (hf : ∀ {x y}, x < y ↔ f x < f y) (s : Set α) :
    (f '' s).chainHeight = s.chainHeight :=
  by
  apply le_antisymm <;> rw [chain_height_le_chain_height_iff]
  · suffices ∀ l ∈ (f '' s).subchain, ∃ l' ∈ s.subchain, map f l' = l
      by
      intro l hl
      obtain ⟨l', h₁, rfl⟩ := this l hl
      exact ⟨l', h₁, length_map _ _⟩
    intro l
    induction' l with x xs hx
    · exact fun _ => ⟨nil, ⟨trivial, fun _ h => h.elim⟩, rfl⟩
    · intro h
      rw [cons_mem_subchain_iff] at h
      obtain ⟨⟨x, hx', rfl⟩, h₁, h₂⟩ := h
      obtain ⟨l', h₃, rfl⟩ := hx h₁
      refine' ⟨x::l', set.cons_mem_subchain_iff.mpr ⟨hx', h₃, _⟩, rfl⟩
      cases l'
      · simp
      · simpa [← hf] using h₂
  · intro l hl
    refine' ⟨l.map f, ⟨_, _⟩, _⟩
    · simp_rw [chain'_map, ← hf]
      exact hl.1
    · intro _ e
      obtain ⟨a, ha, rfl⟩ := mem_map.mp e
      exact Set.mem_image_of_mem _ (hl.2 _ ha)
    · rw [length_map]
#align set.chain_height_image Set.chainHeight_image

variable (s)

@[simp]
theorem chainHeight_dual : (ofDual ⁻¹' s).chainHeight = s.chainHeight := by
  apply le_antisymm <;>
    · rw [chain_height_le_chain_height_iff]
      rintro l ⟨h₁, h₂⟩
      exact
        ⟨l.reverse, ⟨chain'_reverse.mpr h₁, fun i h => h₂ i (mem_reverse.mp h)⟩,
          (length_reverse _).symm⟩
#align set.chain_height_dual Set.chainHeight_dual

end LT

section Preorder

variable (s t : Set α) [Preorder α]

theorem chainHeight_eq_supᵢ_Ici : s.chainHeight = ⨆ i ∈ s, (s ∩ Set.Ici i).chainHeight :=
  by
  apply le_antisymm
  · refine' supᵢ₂_le _
    rintro (_ | ⟨x, xs⟩) h
    · exact zero_le _
    · apply le_trans _ (le_supᵢ₂ x (cons_mem_subchain_iff.mp h).1)
      apply length_le_chain_height_of_mem_subchain
      refine' ⟨h.1, fun i hi => ⟨h.2 i hi, _⟩⟩
      cases hi
      · exact hi.symm.le
      cases' chain'_iff_pairwise.mp h.1 with _ _ h'
      exact (h' _ hi).le
  · exact supᵢ₂_le fun i hi => chain_height_mono <| Set.inter_subset_left _ _
#align set.chain_height_eq_supr_Ici Set.chainHeight_eq_supᵢ_Ici

theorem chainHeight_eq_supᵢ_Iic : s.chainHeight = ⨆ i ∈ s, (s ∩ Set.Iic i).chainHeight :=
  by
  simp_rw [← chain_height_dual (_ ∩ _)]
  rw [← chain_height_dual, chain_height_eq_supr_Ici]
  rfl
#align set.chain_height_eq_supr_Iic Set.chainHeight_eq_supᵢ_Iic

variable {s t}

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem chainHeight_insert_of_forall_gt (a : α) (hx : ∀ b ∈ s, a < b) :
    (insert a s).chainHeight = s.chainHeight + 1 :=
  by
  rw [← add_zero (insert a s).chainHeight]
  change (insert a s).chainHeight + (0 : ℕ) = s.chain_height + (1 : ℕ)
  apply le_antisymm <;> rw [chain_height_add_le_chain_height_add]
  · rintro (_ | ⟨y, ys⟩) h
    · exact ⟨[], nil_mem_subchain _, zero_le _⟩
    · have h' := cons_mem_subchain_iff.mp h
      refine' ⟨ys, ⟨h'.2.1.1, fun i hi => _⟩, by simp⟩
      apply (h'.2.1.2 i hi).resolve_left
      rintro rfl
      cases' chain'_iff_pairwise.mp h.1 with _ _ hy
      cases' h'.1 with h' h'
      exacts[(hy _ hi).Ne h', not_le_of_gt (hy _ hi) (hx _ h').le]
  · intro l hl
    refine' ⟨a::l, ⟨_, _⟩, by simp⟩
    · rw [chain'_cons']
      exact ⟨fun y hy => hx _ (hl.2 _ (mem_of_mem_head' hy)), hl.1⟩
    · rintro x (rfl | hx)
      exacts[Or.inl (Set.mem_singleton x), Or.inr (hl.2 x hx)]
#align set.chain_height_insert_of_forall_gt Set.chainHeight_insert_of_forall_gt

theorem chainHeight_insert_of_forall_lt (a : α) (ha : ∀ b ∈ s, b < a) :
    (insert a s).chainHeight = s.chainHeight + 1 :=
  by
  rw [← chain_height_dual, ← chain_height_dual s]
  exact chain_height_insert_of_forall_gt _ ha
#align set.chain_height_insert_of_forall_lt Set.chainHeight_insert_of_forall_lt

theorem chainHeight_union_le : (s ∪ t).chainHeight ≤ s.chainHeight + t.chainHeight := by
  classical
    refine' supᵢ₂_le fun l hl => _
    let l₁ := l.filter (· ∈ s)
    let l₂ := l.filter (· ∈ t)
    have hl₁ : ↑l₁.length ≤ s.chain_height :=
      by
      apply Set.length_le_chainHeight_of_mem_subchain
      exact ⟨hl.1.Sublist (filter_sublist _), fun i h => (of_mem_filter h : _)⟩
    have hl₂ : ↑l₂.length ≤ t.chain_height :=
      by
      apply Set.length_le_chainHeight_of_mem_subchain
      exact ⟨hl.1.Sublist (filter_sublist _), fun i h => (of_mem_filter h : _)⟩
    refine' le_trans _ (add_le_add hl₁ hl₂)
    simp_rw [← WithTop.coe_add, WithTop.coe_le_coe, ← Multiset.coe_card, ← Multiset.card_add, ←
      Multiset.coe_filter]
    rw [Multiset.filter_add_filter, multiset.filter_eq_self.mpr, Multiset.card_add]
    exacts[le_add_right rfl.le, hl.2]
#align set.chain_height_union_le Set.chainHeight_union_le

theorem chainHeight_union_eq (s t : Set α) (H : ∀ a ∈ s, ∀ b ∈ t, a < b) :
    (s ∪ t).chainHeight = s.chainHeight + t.chainHeight :=
  by
  cases h : t.chain_height
  · rw [WithTop.none_eq_top, add_top, eq_top_iff, ← WithTop.none_eq_top, ← h]
    exact Set.chainHeight_mono (Set.subset_union_right _ _)
  apply le_antisymm
  · rw [← h]
    exact chain_height_union_le
  rw [WithTop.some_eq_coe, ← add_zero (s ∪ t).chainHeight, ← WithTop.coe_zero,
    chain_height_add_le_chain_height_add]
  intro l hl
  obtain ⟨l', hl', rfl⟩ := exists_chain_of_le_chain_height t h.symm.le
  refine' ⟨l ++ l', ⟨chain'.append hl.1 hl'.1 fun x hx y hy => _, fun i hi => _⟩, by simp⟩
  · exact H x (hl.2 _ <| mem_of_mem_last' hx) y (hl'.2 _ <| mem_of_mem_head' hy)
  · rw [mem_append] at hi
    cases hi
    exacts[Or.inl (hl.2 _ hi), Or.inr (hl'.2 _ hi)]
#align set.chain_height_union_eq Set.chainHeight_union_eq

theorem wellFoundedGT_of_chainHeight_ne_top (s : Set α) (hs : s.chainHeight ≠ ⊤) :
    WellFoundedGT s := by
  obtain ⟨n, hn⟩ := WithTop.ne_top_iff_exists.1 hs
  refine' ⟨RelEmbedding.wellFounded_iff_no_descending_seq.2 ⟨fun f => _⟩⟩
  refine' n.lt_succ_self.not_le (WithTop.coe_le_coe.1 <| hn.symm ▸ _)
  refine'
    le_supᵢ₂_of_le _
      ⟨chain'_map_of_chain' coe (fun _ _ => id)
          (chain'_iff_pairwise.2 <| pairwise_of_fn.2 fun i j => f.map_rel_iff.2),
        fun i h => _⟩
      _
  · exact n.succ
  · obtain ⟨a, ha, rfl⟩ := mem_map.1 h
    exact a.prop
  · rw [length_map, length_of_fn]
    exact le_rfl
#align set.well_founded_gt_of_chain_height_ne_top Set.wellFoundedGT_of_chainHeight_ne_top

theorem wellFoundedLT_of_chainHeight_ne_top (s : Set α) (hs : s.chainHeight ≠ ⊤) :
    WellFoundedLT s :=
  wellFoundedGT_of_chainHeight_ne_top (ofDual ⁻¹' s) <| by rwa [chain_height_dual]
#align set.well_founded_lt_of_chain_height_ne_top Set.wellFoundedLT_of_chainHeight_ne_top

end Preorder

end Set


namespace hidden

constant le : ℕ → ℕ → Prop
axiom le.refl {x : ℕ} : le x x
axiom le.step {x y : ℕ} : le x y → le x (y + 1)

attribute [simp] le.refl le.step
attribute [refl] le.refl

-- Examples:
  -- Implicit arguments:
  example : le 3 3 := le.refl
  example : le 2 3 := le.step le.refl
  -- example : le 2 3 := le.step (⊢ le 2 2)
  example : le 1 3 := le.step (le.step le.refl)
  -- example : le 1 3 := le.step (⊢ le 1 2)
  -- example : le 1 3 := le.step (le.step (⊢ le 1 1))

  -- Explicit arguments:
  example : le 3 3 := @le.refl 3
  example : le 2 3 := @le.step _ _ le.refl
  example : le 1 3 := @le.step _ _ (@le.step _ _ le.refl)

lemma zero_less_nat (n : ℕ) : le 0 n :=
begin
  induction n with n ih,
  case nat.zero { exact le.refl }, -- ⊢ le 0 0
  case nat.succ { -- ih : le 0 n
    exact le.step ih, -- ⊢ le 0 n.succ
  },
end

#print zero_less_nat
-- λ (n : ℕ),
-- nat.rec le.refl (λ (n : ℕ) (ih : le 0 n), ih.step) n

lemma zero_less_nat₂ (n : ℕ) : le 0 n :=
begin
  apply nat.rec,
  -- and we have 2 goals:
  -- first: ⊢ le 0 0
  { exact le.refl },
  -- second: ⊢ ∀ (n : ℕ), le 0 n → le 0 n.succ
  { exact @le.step 0 },
end

#print nat.rec
#print nat.rec_on

lemma zero_less_nat₃ (n : ℕ) : le 0 n :=
  nat.rec le.refl (@le.step 0) n
  -- nat.rec le.refl (assume m, sorry) n
  -- nat.rec (⊢ le 0 0) (⊢ ∀ (n : ℕ), le 0 n → le 0 n.succ) n

#print zero_less_nat₃ -- λ (n : ℕ), nat.rec le.refl le.step n

lemma zero_less_nat₄ (n : ℕ) : le 0 n :=
  nat.rec le.refl (λ (m : ℕ), @le.step 0 m) n

#print zero_less_nat₄ -- λ (n : ℕ), nat.rec le.refl (λ (m : ℕ), le.step) n

-- try #1
example (n : ℕ) : n ≠ 0 → le 1 n :=
begin
  assume ne_zero : n ≠ 0, -- we in state A
  rw (ne.def n 0) at ne_zero,
  by_cases n = 0,
  apply absurd h ne_zero, -- the same state as state A
  sorry,
end

lemma le.branch {a b : ℕ} : le a b → a = b ∨ le a.succ b :=
begin
  assume le_a_b : le a b,
  by_cases (a = b),
  { left, exact h },
  {
    right,
    sorry,
  },

end

lemma ex1 (n : ℕ) : n ≠ 0 → le 1 n :=
begin
  intro ne_zero,
  have h : le 0 n := zero_less_nat n,
  type_check @le.branch 0 n, -- le 0 n → 0 = n ∨ le (0 + 1) n
  type_check le.branch h, -- 0 = n ∨ le (0 + 1) n
  have h_cases := le.branch h,

  cases h_cases with n_eq_zero n_ge_one, {
    type_check ((ne.def n) 0).mpr, -- we have two options: .mp and .mpr
    type_check ((ne.def n) 0).mp, -- but we need only .mp
    have ne_zero' := ((ne.def n) 0).mp ne_zero,
    exact absurd n_eq_zero.symm ne_zero',
  }, {
    exact n_ge_one,
  },
end

#print ex1
-- λ (n : ℕ) (ne_zero : n ≠ 0),
--   (zero_less_nat n).branch.dcases_on (λ (n_eq_zero : 0 = n), absurd n_eq_zero.symm ((ne.def n 0).mp ne_zero))
--     (λ (n_ge_one : le 1 n), n_ge_one)

lemma ex1₂ (n : ℕ) : n ≠ 0 → le 1 n :=
begin
  intro ne_zero,
  have h_cases := le.branch (zero_less_nat n),
  have ne_zero' := ((ne.def n) 0).mp ne_zero,
  type_check h_cases, -- 0 = n ∨ le 1 n
  apply (
    or.elim
      h_cases
      (λ (zero_eq_n : 0 = n), absurd zero_eq_n.symm ne_zero') -- λ zero_eq_n, ... also works
      (λ (x : le 1 n), x) -- ~ identity function (λ x, x) = id
  ),
end

lemma ex1₃ (n : ℕ) : n ≠ 0 → le 1 n :=
begin
  intro ne_zero,
  have h_cases : 0 = n ∨ le 1 n := le.branch (zero_less_nat n),
  have ne_zero' := ((ne.def n) 0).mp ne_zero,
  apply (
    or.elim
      h_cases
      (λ h₁, absurd _ ne_zero')
      (λ h₂, _) -- (λ h₂, h₂) ~ id
  ),
  exact h₁.symm, -- first goal
  exact h₂, -- second goal
end

lemma ex1₄ (n : ℕ) : n ≠ 0 → le 1 n :=
begin
  intro ne_zero,
  have h_cases : 0 = n ∨ le 1 n := le.branch (zero_less_nat n),
  have ne_zero' := ((ne.def n) 0).mp ne_zero,
  apply or.elim,
  apply h_cases,
  -- apply (λ h₁, absurd (eq.symm h₁) _),
  -- exact ne_zero',
  apply (λ h₁, absurd _ ne_zero), -- ne_zero ~ ne_zero'
  exact h₁.symm,
  exact id,
end

#print ex1₂
#print ex1₃
#print ex1₄ -- short proof
-- λ (n : ℕ) (ne_zero : n ≠ 0),
--   (zero_less_nat n).branch.elim
--     (λ (h₁ : 0 = n), absurd h₁.symm ne_zero)
--     id

-- Structured proof #1
lemma ex1₅ (n : ℕ) : n ≠ 0 → le 1 n :=
  assume ne_zero : n ≠ 0,
  have h_cases : 0 = n ∨ le 1 n, from le.branch (zero_less_nat n),
  h_cases.elim
    (λ h₁, absurd h₁.symm ne_zero)
    id

-- Structured proof #2
lemma ex1₆ (n : ℕ) : n ≠ 0 → le 1 n :=
  λ ne_zero : n ≠ 0, (zero_less_nat n).branch.elim
    (λ h₁ : 0 = n, absurd h₁.symm ne_zero)
    (λ h₂ : le 1 n, h₂)

example (n : ℕ) : n ≠ 0 ∧ n ≠ 1 → le 2 n := sorry
example (n : ℕ) : ¬(le n 1) → le 2 n := sorry
example (n m : ℕ) : ¬(le n m) → le m.succ n := sorry

example (n : ℕ) : le n (n+1) := le.step le.refl
example (n m : ℕ) : le n (n+m) := sorry

example (n : ℕ) : le n (2*n) :=
begin
  induction n with n ih,
  case nat.zero { exact le.refl },
  have h₂ := le.step (le.step ih),
  change le n (2 * n.succ) at h₂,
  have h₃ : n = 2 * n ∨ le n.succ (2 * n) := le.branch ih,
  cases h₃ with n_eq_two_n le_nsucc_two_n,
  {
    -- 1st way:
    -- have helper : ∀ m : ℕ, m ≠ 0 → n = m * n → n = 0, from sorry,
    -- rw (helper 2) _ n_eq_two_n,
    -- -- rw nat.mul,
    -- exact le.step le.refl,
    -- have two_ne_zero : 2 ≠ 0, from dec_trivial,
    -- exact two_ne_zero,

    -- 2nd way:
    -- have helper : ∀ m : ℕ, le 1 m → n = m * n → n = 0, from sorry,
    -- have n_zero: n = 0 := (helper 2) (le.step le.refl) n_eq_2n,
    -- rw n_zero,
    -- exact le.step le.refl,

    -- 3rd way:
    rw ←nat.add_one,
    change le _ (2 * n + 2),
    rw ←n_eq_two_n,
    exact le.step le.refl,
  },
  {
    exact le.step (le.step le_nsucc_two_n),
  },
end

example (n : ℕ) : le (2*n) (3*n) := sorry

example (n a b : ℕ) : le a b → le (a*n) (b*n) := sorry
example (a b n m : ℕ) : le a b → le m n → le (a*m) (b*n) := sorry

lemma not_le_succ_le_succ {m n : ℕ}: le (n + 1) m → le (m + 1) n → false :=
begin
  assume h₁ h₂,
  have helper : ∀ a b, ¬(le a b) ↔ le a.succ b, from sorry,
  have p1: Prop, sorry,
  have p2: Prop, sorry,
  have k : p1 = p2, sorry,
  type_check (eq.mp k),
  have h₃ : ¬le n m := (helper n m).mpr h₁,

end

-- which lemma are simplest for proving without other?
lemma not_le_succ_le_succ' {m n : ℕ}: ¬(le (n + 1) m ∧ le (m + 1) n) :=
  λ ⟨h₁, h₂⟩, (@not_le_succ_le_succ m n) h₁ h₂

example (n m : ℕ) : n = m ↔ le n m ∧ le m n :=
begin
  apply iff.intro, {
    assume n_eq_m : n = m,
    rw n_eq_m,
    rw and_self,
  }, {
    assume h_and : le n m ∧ le m n,
    -- by_cases (n = m), ~ by_contradiction
    -- { exact h },
    -- exfalso,
    by_contradiction n_neq_m,
    have h₁ := le.branch h_and.1,
    have h₂ := le.branch h_and.2,
    clear h_and,
    cases h₁; cases h₂; try { contradiction },
    exact absurd h₂.symm n_neq_m,
    change le (n+1) _ at h₁,
    change le (m+1) _ at h₂,
    -- apply (@not_le_succ_le_succ m n) h₁ h₂,
    exact (@not_le_succ_le_succ' m n) ⟨h₁, h₂⟩,
  },
end

end hidden


/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Adam Topaz

! This file was ported from Lean 3 source module algebraic_topology.topological_simplex
! leanprover-community/mathlib commit 6ca1a09bc9aa75824bf97388c9e3b441fc4ccf3f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.SimplexCategory
import Mathbin.Topology.Category.Top.Basic
import Mathbin.Topology.Instances.Nnreal

/-!
# Topological simplices

We define the natural functor from `simplex_category` to `Top` sending `[n]` to the
topological `n`-simplex.
This is used to define `Top.to_sSet` in `algebraic_topology.simpliciaL_set`.
-/

noncomputable section

namespace SimplexCategory

open Simplicial NNReal BigOperators Classical

attribute [local instance]
  CategoryTheory.ConcreteCategory.hasCoeToSort CategoryTheory.ConcreteCategory.hasCoeToFun

/-- The topological simplex associated to `x : simplex_category`.
  This is the object part of the functor `simplex_category.to_Top`. -/
def toTopObj (x : SimplexCategory) :=
  { f : x → ℝ≥0 | (∑ i, f i) = 1 }
#align simplex_category.to_Top_obj SimplexCategory.toTopObj

instance (x : SimplexCategory) : CoeFun x.toTopObj fun _ => x → ℝ≥0 :=
  ⟨fun f => (f : x → ℝ≥0)⟩

@[ext]
theorem toTopObj.ext {x : SimplexCategory} (f g : x.toTopObj) : (f : x → ℝ≥0) = g → f = g :=
  Subtype.ext
#align simplex_category.to_Top_obj.ext SimplexCategory.toTopObj.ext

/-- A morphism in `simplex_category` induces a map on the associated topological spaces. -/
def toTopMap {x y : SimplexCategory} (f : x ⟶ y) : x.toTopObj → y.toTopObj := fun g =>
  ⟨fun i => ∑ j in Finset.univ.filterₓ fun k => f k = i, g j,
    by
    simp only [[anonymous], Finset.sum_congr, to_Top_obj, Set.mem_setOf]
    rw [← Finset.sum_bunionᵢ]
    convert g.2
    · rw [Finset.eq_univ_iff_forall]
      intro i
      rw [Finset.mem_bunionᵢ]
      exact ⟨f i, by simp, by simp⟩
    · intro i hi j hj h
      rw [Function.onFun, disjoint_iff_inf_le]
      intro e he
      apply h
      simp only [true_and_iff, Finset.inf_eq_inter, Finset.mem_univ, Finset.mem_filter,
        Finset.mem_inter] at he
      rw [← he.1, ← he.2]⟩
#align simplex_category.to_Top_map SimplexCategory.toTopMap

@[simp]
theorem coe_toTopMap {x y : SimplexCategory} (f : x ⟶ y) (g : x.toTopObj) (i : y) :
    toTopMap f g i = ∑ j in Finset.univ.filterₓ fun k => f k = i, g j :=
  rfl
#align simplex_category.coe_to_Top_map SimplexCategory.coe_toTopMap

@[continuity]
theorem continuous_toTopMap {x y : SimplexCategory} (f : x ⟶ y) : Continuous (toTopMap f) :=
  Continuous.subtype_mk
    (continuous_pi fun i =>
      continuous_finset_sum _ fun j hj => (continuous_apply _).comp continuous_subtype_val)
    _
#align simplex_category.continuous_to_Top_map SimplexCategory.continuous_toTopMap

/-- The functor associating the topological `n`-simplex to `[n] : simplex_category`. -/
@[simps]
def toTop : SimplexCategory ⥤ TopCat
    where
  obj x := TopCat.of x.toTopObj
  map x y f := ⟨toTopMap f⟩
  map_id' := by
    intro x
    ext (f i) : 3
    change (finset.univ.filter fun k => k = i).Sum _ = _
    simp [Finset.sum_filter]
  map_comp' := by
    intro x y z f g
    ext (h i) : 3
    dsimp
    erw [← Finset.sum_bunionᵢ]
    apply Finset.sum_congr
    · exact Finset.ext fun j => ⟨fun hj => by simpa using hj, fun hj => by simpa using hj⟩
    · tauto
    · intro j hj k hk h
      rw [Function.onFun, disjoint_iff_inf_le]
      intro e he
      apply h
      simp only [true_and_iff, Finset.inf_eq_inter, Finset.mem_univ, Finset.mem_filter,
        Finset.mem_inter] at he
      rw [← he.1, ← he.2]
#align simplex_category.to_Top SimplexCategory.toTop

end SimplexCategory