/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura
-/
import mathlib4_experiments.Tactic.Split
import mathlib4_experiments.Tactic.Refl

section miscellany

/-- Ex falso, the nondependent eliminator for the `empty` type. -/
def Empty.elim {C : Sort _} (a : Empty) : C := nomatch a

instance : Subsingleton Empty := ⟨λ a => a.elim⟩

/-

## Basic API for prod

-/

theorem Prod.ext_iff : ∀ (p q : α × β),
  p = q ↔ p.1 = q.1 ∧ p.2 = q.2
| (p1, p2), (q1, q2) => by
  split;
    intro h;
    rw h;
    split;
      rfl;
    rfl;
  skip;
  intro ⟨(h1 : p1 = q1), (h2 : p2 = q2)⟩;
  rw [h1, h2];

@[simp] theorem eq_iff_true_of_subsingleton [Subsingleton α] (x y : α) :
  x = y ↔ True :=
by
  split;
    simp;
  intro _;
  apply Subsingleton.elim;

instance Subsingleton.prod {α β : Type _}
  [Subsingleton α] [Subsingleton β] :
  Subsingleton (α × β) :=
⟨by
  intro a b;
  cases a;
  cases b;
  -- todo(yakov) : ext tactic
  rw Prod.ext_iff;
  split;
    allGoals { simp }; ⟩

/-

Kenny term mode version

instance {α : Type u} {β : Type v} [Subsingleton α] [Subsingleton β] : Subsingleton (α × β) :=
⟨λ ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ => congr (congrArg _ $ Subsingleton.elim _ _) (Subsingleton.elim _ _)⟩

-/
instance : DecidableEq Empty := λa => a.elim

instance sort.inhabited : Inhabited (Sort _) := ⟨PUnit⟩
instance sort.inhabited' :
  Inhabited (@Inhabited.default (Sort _) _) := ⟨PUnit.unit⟩

instance psum.inhabited_left {α β}
  [Inhabited α] : Inhabited (PSum α β) :=
⟨PSum.inl Inhabited.default⟩

instance psum.inhabited_right {α β}
  [Inhabited β] : Inhabited (PSum α β) :=
⟨PSum.inr Inhabited.default⟩

instance decidable_eq_of_subsingleton
  {α} [Subsingleton α] : DecidableEq α
| a, b => isTrue (Subsingleton.elim a b)

theorem subsingleton_of_forall_eq {α : Sort _}
  (x : α) (h : ∀ y, y = x) : Subsingleton α :=
⟨λ a b => (h a).symm ▸ (h b).symm ▸ rfl⟩

theorem subsingleton_iff_forall_eq {α : Sort _} (x : α) :
  Subsingleton α ↔ ∀ y, y = x :=
⟨λ h y => @Subsingleton.elim _ h y x, subsingleton_of_forall_eq x⟩

/-!

# I don't understand coercions in Lean 4 so I'm skipping this stuff

-- @[simp] theorem coe_coe {α β γ} [Coe α β] [has_coe_t β γ]
--   (a : α) : (a : γ) = (a : β) := rfl
-- /-- Add an instance to "undo" coercion transitivity into a chain of coercions, because
--    most simp lemmas are stated with respect to simple coercions and will not match when
--    part of a chain. -/
-- @[simp] theorem coe_coe {α β γ} [Coe α β] [has_coe_t β γ]
--   (a : α) : (a : γ) = (a : β) := rfl

-- theorem coe_fn_coe_trans
--   {α β γ} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_fun γ]
--   (x : α) : @coe_fn α _ x = @coe_fn β _ x := rfl

-- @[simp] theorem coe_fn_coe_base
--   {α β} [has_coe α β] [has_coe_to_fun β]
--   (x : α) : @coe_fn α _ x = @coe_fn β _ x := rfl

-- theorem coe_sort_coe_trans
--   {α β γ} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_sort γ]
--   (x : α) : @coe_sort α _ x = @coe_sort β _ x := rfl

-- /--
-- Many structures such as bundled morphisms coerce to functions so that you can
-- transparently apply them to arguments. For example, if `e : α ≃ β` and `a : α`
-- then you can write `e a` and this is elaborated as `⇑e a`. This type of
-- coercion is implemented using the `has_coe_to_fun` type class. There is one
-- important consideration:

-- If a type coerces to another type which in turn coerces to a function,
-- then it **must** implement `has_coe_to_fun` directly:
-- ```lean
-- structure sparkling_equiv (α β) extends α ≃ β

-- -- if we add a `has_coe` instance,
-- instance {α β} : has_coe (sparkling_equiv α β) (α ≃ β) :=
-- ⟨sparkling_equiv.to_equiv⟩

-- -- then a `has_coe_to_fun` instance **must** be added as well:
-- instance {α β} : has_coe_to_fun (sparkling_equiv α β) :=
-- ⟨λ _, α → β, λ f, f.to_equiv.to_fun⟩
-- ```

-- (Rationale: if we do not declare the direct coercion, then `⇑e a` is not in
-- simp-normal form. The lemma `coe_fn_coe_base` will unfold it to `⇑↑e a`. This
-- often causes loops in the simplifier.)
-- -/
-- --library_note "function coercion"

-- @[simp] theorem coe_sort_coe_base
--   {α β} [has_coe α β] [has_coe_to_sort β]
--   (x : α) : @coe_sort α _ x = @coe_sort β _ x := rfl
-/

/-- `pempty` is the universe-polymorphic analogue of `empty`. -/
--@[derive decidable_eq]
inductive PEmpty : Type u

/-- Ex falso, the nondependent eliminator for the `pempty` type. -/
def PEmpty.elim {C : Sort v} : PEmpty → C :=
λ a => nomatch a

instance subsingleton_pempty : Subsingleton PEmpty := ⟨λ a => a.elim⟩

@[simp] theorem not_nonempty_pempty : ¬ Nonempty PEmpty :=
λ ⟨h⟩ => h.elim

@[simp] theorem forall_pempty {P : PEmpty → Prop} :
  (∀ x : PEmpty, P x) ↔ True :=
⟨λ _ => trivial, λ _ x => x.elim⟩

@[simp] theorem exists_pempty {P : PEmpty → Prop} :
  (∃ x : PEmpty, P x) ↔ False :=
⟨λ ⟨x, _⟩ => x.elim, False.elim⟩

-- TODO -- find out how to do this using equation compiler
theorem congr_arg_heq {α} {β : α → Sort u} (f : ∀ a, β a) :
  ∀ {a₁ a₂ : α}, a₁ = a₂ → f a₁ ≅ f a₂
| _, _, (Eq.refl _) => HEq.rfl

-- this will work when I switch to nightly, apparently?
macro "lemma" n:declId sig:declSig val:declVal : command => `(theorem $n $sig $val)

theorem plift.down_inj {α : Sort u} : ∀ (a b : PLift α), a.down = b.down → a = b
| ⟨_⟩, ⟨_⟩, (Eq.refl _) => rfl

-- don't know analogue in Lean 4
-- attribute [symm] ne.symm

lemma ne_comm {α} {a b : α} : a ≠ b ↔ b ≠ a := ⟨Ne.symm, Ne.symm⟩

@[simp] theorem eq_iff_eq_cancel_left {b c : α} :
  (∀ {a}, a = b ↔ a = c) ↔ (b = c) :=
⟨λ h => by rw [← h], λ h a => by rw h; refl⟩

@[simp] theorem eq_iff_eq_cancel_right {a b : α} :
  (∀ {c}, a = c ↔ b = c) ↔ (a = b) :=
⟨λ h => by rw h, λ h a => by rw h; refl⟩

/-- Wrapper for adding elementary propositions to the type class systems.
Warning: this can easily be abused. See the rest of this docstring for details.

Certain propositions should not be treated as a class globally,
but sometimes it is very convenient to be able to use the type class system
in specific circumstances.

For example, `zmod p` is a field if and only if `p` is a prime number.
In order to be able to find this field instance automatically by type class search,
we have to turn `p.prime` into an instance implicit assumption.

On the other hand, making `nat.prime` a class would require a major refactoring of the library,
and it is questionable whether making `nat.prime` a class is desirable at all.
The compromise is to add the assumption `[fact p.prime]` to `zmod.field`.

In particular, this class is not intended for turning the type class system
into an automated theorem prover for first order logic. -/
class fact (p : Prop) : Prop := (out' : p)

def fact.out (p : Prop) [c : fact p] : p := fact.out'

lemma fact.elim {p : Prop} (h : fact p) : p := h.1
lemma fact_iff {p : Prop} : fact p ↔ p := ⟨λ h => h.1, λ h => ⟨h⟩⟩

end miscellany

/-!
### Declarations about propositional connectives
-/

theorem false_ne_true : False ≠ True
| h => h.symm ▸ trivial

section propositional

variable {a b c d : Prop}

/-! ### Declarations about `implies` -/

-- instance : is_refl Prop iff := ⟨iff.refl⟩
-- instance : IsTrans Prop iff := ⟨λ _ _ _ => iff.trans⟩

theorem iff_of_eq (e : a = b) : a ↔ b := e ▸ Iff.rfl

theorem iff_iff_eq : (a ↔ b) ↔ a = b := ⟨propext, iff_of_eq⟩

@[simp] theorem eq_iff_iff {p q : Prop} : (p = q) ↔ (p ↔ q) := iff_iff_eq.symm

-- can't find in Lean 4
theorem iff_true_intro {P : Prop} : P → (P ↔ True) :=
λ h => ⟨λ _=> trivial, λ _ => h⟩

@[simp] theorem imp_self : (a → a) ↔ True := iff_true_intro id

theorem imp_intro {α β : Prop} (h : α) : β → α := λ _ => h

theorem imp_false : (a → False) ↔ ¬ a := Iff.rfl

theorem imp_and_distrib {α} : (α → b ∧ c) ↔ (α → b) ∧ (α → c) :=
⟨λ h => ⟨λ ha => (h ha).left, λ ha => (h ha).right⟩,
 λ h ha => ⟨h.left ha, h.right ha⟩⟩

@[simp] theorem and_imp : (a ∧ b → c) ↔ (a → b → c) :=
Iff.intro (λ h ha hb => h ⟨ha, hb⟩) (λ h ⟨ha, hb⟩ => h ha hb)

theorem iff_def {a b : Prop} : (a ↔ b) ↔ (a → b) ∧ (b → a) :=
⟨λ ⟨h1, h2⟩ => ⟨h1, h2⟩, λ ⟨h1, h2⟩ => ⟨h1, h2⟩⟩

theorem And.comm {P Q : Prop} : P ∧ Q ↔ Q ∧ P :=
⟨λ ⟨h1, h2⟩ => ⟨h2, h1⟩, λ ⟨h1, h2⟩ => ⟨h2, h1⟩⟩

theorem iff_def' : (a ↔ b) ↔ (b → a) ∧ (a → b) :=
iff_def.trans And.comm

theorem imp_true_iff {α : Sort u} : (α → True) ↔ True :=
iff_true_intro $ λ _ => trivial

theorem imp_iff_right (ha : a) : (a → b) ↔ b :=
⟨λ f => f ha, imp_intro⟩

/-! ### Declarations about `not` -/

/-- Ex falso for negation. From `¬ a` and `a` anything follows. This is the same as `absurd` with
the arguments flipped, but it is in the `not` namespace so that projection notation can be used. -/
def not.elim {α : Sort u} (H1 : ¬a) (H2 : a) : α := absurd H2 H1

@[reducible] theorem not.imp {a b : Prop} (H2 : ¬b) (H1 : a → b) : ¬a := mt H1 H2

theorem not_not_of_not_imp : ¬(a → b) → ¬¬a :=
mt not.elim

theorem not_of_not_imp {a : Prop} : ¬(a → b) → ¬b :=
mt imp_intro

theorem dec_em (p : Prop) [Decidable p] : p ∨ ¬p := Decidable.em p

theorem em (p : Prop) : p ∨ ¬ p := Classical.em _

theorem or_not {p : Prop} : p ∨ ¬ p := em _

/- all propositions are Decidable -/
noncomputable local instance (priority := low) propDecidable (a : Prop) : Decidable a :=
  Classical.choice <| match em a with
    | Or.inl h => ⟨isTrue h⟩
    | Or.inr h => ⟨isFalse h⟩

theorem by_contradiction {p} : (¬p → False) → p := Decidable.byContradiction

-- alias by_contradiction ← by_contra
theorem by_contra {p} : (¬p → False) → p := Decidable.byContradiction

/-
In most of mathlib, we use the law of excluded middle (LEM) and the axiom of choice (AC) freely.
The `decidable` namespace contains versions of lemmas from the root namespace that explicitly
attempt to avoid the axiom of choice, usually by adding decidability assumptions on the inputs.

You can check if a lemma uses the axiom of choice by using `#print axioms foo` and seeing if
`classical.choice` appears in the list.
-/
--library_note "decidable namespace"

/-
As mathlib is primarily classical,
if the type signature of a `def` or `lemma` does not require any `decidable` instances to state,
it is preferable not to introduce any `decidable` instances that are needed in the proof
as arguments, but rather to use the `classical` tactic as needed.

In the other direction, when `decidable` instances do appear in the type signature,
it is better to use explicitly introduced ones rather than allowing Lean to automatically infer
classical ones, as these may cause instance mismatch errors later.
-/
--library_note "decidable arguments"

lemma not_not_intro {P : Prop} : P → ¬ ¬ P := λ hp h => h hp

-- See Note [decidable namespace]
protected theorem decidable.not_not [Decidable a] : ¬¬a ↔ a :=
Iff.intro Decidable.byContradiction not_not_intro

/-- The Double Negation Theorem: `¬ ¬ P` is equivalent to `P`.
The left-to-right direction, double negation elimination (DNE),
is classically true but not constructively. -/
@[simp] theorem not_not : ¬¬a ↔ a := decidable.not_not

theorem of_not_not : ¬¬a → a := by_contra

-- See Note [decidable namespace]
protected theorem decidable.of_not_imp [Decidable a] (h : ¬ (a → b)) : a :=
Decidable.byContradiction (not_not_of_not_imp h)

theorem of_not_imp : ¬ (a → b) → a := decidable.of_not_imp

-- See Note [decidable namespace]
protected theorem decidable.not_imp_symm [Decidable a] (h : ¬a → b) (hb : ¬b) : a :=
Decidable.byContradiction $ hb ∘ h

theorem not.decidable_imp_symm [Decidable a] : (¬a → b) → ¬b → a := decidable.not_imp_symm

theorem not.imp_symm : (¬a → b) → ¬b → a := not.decidable_imp_symm

-- See Note [decidable namespace]
protected theorem decidable.not_imp_comm [Decidable a] [Decidable b] : (¬a → b) ↔ (¬b → a) :=
⟨not.decidable_imp_symm, not.decidable_imp_symm⟩

theorem not_imp_comm : (¬a → b) ↔ (¬b → a) := decidable.not_imp_comm

@[simp] theorem imp_not_self : (a → ¬a) ↔ ¬a := ⟨λ h ha => h ha ha, λ h _ => h⟩

theorem decidable.not_imp_self [Decidable a] : (¬a → a) ↔ a := by
  have this := @imp_not_self (¬a);
  rw decidable.not_not at this;
  assumption;

@[simp] theorem not_imp_self : (¬a → a) ↔ a := decidable.not_imp_self

theorem imp.swap : (a → b → c) ↔ (b → a → c) :=
⟨flip, flip⟩

theorem imp_not_comm : (a → ¬b) ↔ (b → ¬a) :=
imp.swap

/-! ### Declarations about `and` -/

theorem and_congr_right (h : a → (b ↔ c)) : a ∧ b ↔ a ∧ c :=
⟨λ ⟨ha, hb⟩ => ⟨ha, (h ha).1 hb⟩ , λ ⟨ha, hc⟩ => ⟨ha, (h ha).2 hc⟩⟩

theorem and_congr_left (h : c → (a ↔ b)) : a ∧ c ↔ b ∧ c :=
And.comm.trans $ (and_congr_right h).trans And.comm

lemma and_congr {a b c d : Prop} : (a ↔ c) → (b ↔ d) → (a ∧ b ↔ c ∧ d) :=
λ ⟨hac, hca⟩ ⟨hbd, hdb⟩ =>
  ⟨λ ⟨ha, hb⟩ => ⟨hac ha, hbd hb⟩, λ ⟨hc, hd⟩ => ⟨hca hc, hdb hd⟩⟩

theorem and_congr_left' (h : a ↔ b) : a ∧ c ↔ b ∧ c := and_congr h Iff.rfl

theorem and_congr_right' (h : b ↔ c) : a ∧ b ↔ a ∧ c := and_congr Iff.rfl h

theorem not_and_of_not_left (b : Prop) : ¬a → ¬(a ∧ b) :=
mt And.left

theorem not_and_of_not_right (a : Prop) {b : Prop} : ¬b → ¬(a ∧ b) :=
mt And.right

theorem and.imp {a b c d : Prop} : (a → c) → (b → d) → a ∧ b → c ∧ d :=
λ hac hbd ⟨ha, hb⟩ => ⟨hac ha, hbd hb⟩

theorem and.imp_left (h : a → b) : a ∧ c → b ∧ c :=
and.imp h id

theorem and.imp_right (h : a → b) : c ∧ a → c ∧ b :=
and.imp id h

-- and.left_comm : ∀ {a b c : Prop}, a ∧ b ∧ c ↔ b ∧ a ∧ c

theorem and.left_comm {a b c : Prop} : a ∧ b ∧ c ↔ b ∧ a ∧ c :=
⟨λ ⟨ha, hb, hc⟩ => ⟨hb, ha, hc⟩, λ ⟨hb, ha, hc⟩ => ⟨ha, hb, hc⟩⟩

@[simp] theorem Iff_self {p : Prop} : (p ↔ p) ↔ True :=
⟨λ _ => trivial, λ _ => Iff.rfl⟩

lemma and.right_comm : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b :=
by simp only [and.left_comm, And.comm, Iff_self]

lemma and.rotate : a ∧ b ∧ c ↔ b ∧ c ∧ a :=
by simp only [and.left_comm, And.comm, Iff_self]

theorem and_not_self_iff (a : Prop) : a ∧ ¬ a ↔ False :=
⟨λ h => (h.right) (h.left), (λ h => h.elim)⟩

theorem not_and_self_iff (a : Prop) : ¬ a ∧ a ↔ False :=
Iff.intro (λ ⟨hna, ha⟩ => hna ha) False.elim

theorem and_iff_left_of_imp {a b : Prop} (h : a → b) : (a ∧ b) ↔ a :=
Iff.intro And.left (λ ha => ⟨ha, h ha⟩)

theorem and_iff_right_of_imp {a b : Prop} (h : b → a) : (a ∧ b) ↔ b :=
Iff.intro And.right (λ hb => ⟨h hb, hb⟩)

@[simp] theorem and_iff_left_iff_imp {a b : Prop} : ((a ∧ b) ↔ a) ↔ (a → b) :=
⟨λ h ha => (h.2 ha).2, and_iff_left_of_imp⟩

@[simp] theorem and_iff_right_iff_imp {a b : Prop} : ((a ∧ b) ↔ b) ↔ (b → a) :=
⟨λ h ha => (h.2 ha).1, and_iff_right_of_imp⟩

@[simp] theorem and.congr_right_iff : (a ∧ b ↔ a ∧ c) ↔ (a → (b ↔ c)) :=
⟨λ h ha => by simp [ha] at h; exact h, and_congr_right⟩

/-

TO_BE_PORTED

#check @and.congr_right_iff

example : ∀ {a b c : Prop}, a ∧ b ↔ a ∧ c ↔ a → (b ↔ c) := sorry
example : ∀ {a b c : Prop}, a ↔ a ↔ a := sorry

@[simp] theorem and.congr_left_iff : (a ∧ c ↔ b ∧ c) ↔ c → (a ↔ b) :=
by simp only [And.comm, ← and.congr_right_iff]

@[simp] lemma and_self_left : a ∧ a ∧ b ↔ a ∧ b :=
⟨λ h, ⟨h.1, h.2.2⟩, λ h, ⟨h.1, h.1, h.2⟩⟩

@[simp] lemma and_self_right : (a ∧ b) ∧ b ↔ a ∧ b :=
⟨λ h, ⟨h.1.1, h.2⟩, λ h, ⟨⟨h.1, h.2⟩, h.2⟩⟩

/-! ### Declarations about `or` -/

theorem or_congr_left (h : a ↔ b) : a ∨ c ↔ b ∨ c := or_congr h iff.rfl

theorem or_congr_right (h : b ↔ c) : a ∨ b ↔ a ∨ c := or_congr iff.rfl h

theorem or.right_comm : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b := by rw [or_assoc, or_assoc, or_comm b]

theorem or_of_or_of_imp_of_imp (h₁ : a ∨ b) (h₂ : a → c) (h₃ : b → d) : c ∨ d :=
or.imp h₂ h₃ h₁

theorem or_of_or_of_imp_left (h₁ : a ∨ c) (h : a → b) : b ∨ c :=
or.imp_left h h₁

theorem or_of_or_of_imp_right (h₁ : c ∨ a) (h : a → b) : c ∨ b :=
or.imp_right h h₁

theorem or.elim3 (h : a ∨ b ∨ c) (ha : a → d) (hb : b → d) (hc : c → d) : d :=
or.elim h ha (assume h₂, or.elim h₂ hb hc)

theorem or_imp_distrib : (a ∨ b → c) ↔ (a → c) ∧ (b → c) :=
⟨assume h, ⟨assume ha, h (or.inl ha), assume hb, h (or.inr hb)⟩,
  assume ⟨ha, hb⟩, or.rec ha hb⟩

-- See Note [decidable namespace]
protected theorem decidable.or_iff_not_imp_left [decidable a] : a ∨ b ↔ (¬ a → b) :=
⟨or.resolve_left, λ h, dite _ or.inl (or.inr ∘ h)⟩

theorem or_iff_not_imp_left : a ∨ b ↔ (¬ a → b) := decidable.or_iff_not_imp_left

-- See Note [decidable namespace]
protected theorem decidable.or_iff_not_imp_right [decidable b] : a ∨ b ↔ (¬ b → a) :=
or.comm.trans decidable.or_iff_not_imp_left

theorem or_iff_not_imp_right : a ∨ b ↔ (¬ b → a) := decidable.or_iff_not_imp_right

-- See Note [decidable namespace]
protected theorem decidable.not_imp_not [decidable a] : (¬ a → ¬ b) ↔ (b → a) :=
⟨assume h hb, decidable.by_contradiction $ assume na, h na hb, mt⟩

theorem not_imp_not : (¬ a → ¬ b) ↔ (b → a) := decidable.not_imp_not

@[simp] theorem or_iff_left_iff_imp : (a ∨ b ↔ a) ↔ (b → a) :=
⟨λ h hb, h.1 (or.inr hb), or_iff_left_of_imp⟩

@[simp] theorem or_iff_right_iff_imp : (a ∨ b ↔ b) ↔ (a → b) :=
by rw [or_comm, or_iff_left_iff_imp]

/-! ### Declarations about distributivity -/

/-- `∧` distributes over `∨` (on the left). -/
theorem and_or_distrib_left : a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) :=
⟨λ ⟨ha, hbc⟩, hbc.imp (and.intro ha) (and.intro ha),
 or.rec (and.imp_right or.inl) (and.imp_right or.inr)⟩

/-- `∧` distributes over `∨` (on the right). -/
theorem or_and_distrib_right : (a ∨ b) ∧ c ↔ (a ∧ c) ∨ (b ∧ c) :=
(and.comm.trans and_or_distrib_left).trans (or_congr and.comm and.comm)

/-- `∨` distributes over `∧` (on the left). -/
theorem or_and_distrib_left : a ∨ (b ∧ c) ↔ (a ∨ b) ∧ (a ∨ c) :=
⟨or.rec (λha, and.intro (or.inl ha) (or.inl ha)) (and.imp or.inr or.inr),
 and.rec $ or.rec (imp_intro ∘ or.inl) (or.imp_right ∘ and.intro)⟩

/-- `∨` distributes over `∧` (on the right). -/
theorem and_or_distrib_right : (a ∧ b) ∨ c ↔ (a ∨ c) ∧ (b ∨ c) :=
(or.comm.trans or_and_distrib_left).trans (and_congr or.comm or.comm)

@[simp] lemma or_self_left : a ∨ a ∨ b ↔ a ∨ b :=
⟨λ h, h.elim or.inl id, λ h, h.elim or.inl (or.inr ∘ or.inr)⟩

@[simp] lemma or_self_right : (a ∨ b) ∨ b ↔ a ∨ b :=
⟨λ h, h.elim id or.inr, λ h, h.elim (or.inl ∘ or.inl) or.inr⟩

/-! Declarations about `iff` -/

theorem iff_of_true (ha : a) (hb : b) : a ↔ b :=
⟨λ_, hb, λ _, ha⟩

theorem iff_of_false (ha : ¬a) (hb : ¬b) : a ↔ b :=
⟨ha.elim, hb.elim⟩

theorem iff_true_left (ha : a) : (a ↔ b) ↔ b :=
⟨λ h, h.1 ha, iff_of_true ha⟩

theorem iff_true_right (ha : a) : (b ↔ a) ↔ b :=
iff.comm.trans (iff_true_left ha)

theorem iff_false_left (ha : ¬a) : (a ↔ b) ↔ ¬b :=
⟨λ h, mt h.2 ha, iff_of_false ha⟩

theorem iff_false_right (ha : ¬a) : (b ↔ a) ↔ ¬b :=
iff.comm.trans (iff_false_left ha)

@[simp]
lemma iff_mpr_iff_true_intro {P : Prop} (h : P) : iff.mpr (iff_true_intro h) true.intro = h := rfl

-- See Note [decidable namespace]
protected theorem decidable.not_or_of_imp [decidable a] (h : a → b) : ¬ a ∨ b :=
if ha : a then or.inr (h ha) else or.inl ha

theorem not_or_of_imp : (a → b) → ¬ a ∨ b := decidable.not_or_of_imp

-- See Note [decidable namespace]
protected theorem decidable.imp_iff_not_or [decidable a] : (a → b) ↔ (¬ a ∨ b) :=
⟨decidable.not_or_of_imp, or.neg_resolve_left⟩

theorem imp_iff_not_or : (a → b) ↔ (¬ a ∨ b) := decidable.imp_iff_not_or

-- See Note [decidable namespace]
protected theorem decidable.imp_or_distrib [decidable a] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) :=
by simp [decidable.imp_iff_not_or, or.comm, or.left_comm]

theorem imp_or_distrib : (a → b ∨ c) ↔ (a → b) ∨ (a → c) := decidable.imp_or_distrib

-- See Note [decidable namespace]
protected theorem decidable.imp_or_distrib' [decidable b] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) :=
by by_cases b; simp [h, or_iff_right_of_imp ((∘) false.elim)]

theorem imp_or_distrib' : (a → b ∨ c) ↔ (a → b) ∨ (a → c) := decidable.imp_or_distrib'

theorem not_imp_of_and_not : a ∧ ¬ b → ¬ (a → b)
| ⟨ha, hb⟩ h := hb $ h ha

-- See Note [decidable namespace]
protected theorem decidable.not_imp [decidable a] : ¬(a → b) ↔ a ∧ ¬b :=
⟨λ h, ⟨decidable.of_not_imp h, not_of_not_imp h⟩, not_imp_of_and_not⟩

theorem not_imp : ¬(a → b) ↔ a ∧ ¬b := decidable.not_imp

-- for monotonicity
lemma imp_imp_imp (h₀ : c → a) (h₁ : b → d) : (a → b) → (c → d) :=
assume (h₂ : a → b), h₁ ∘ h₂ ∘ h₀

-- See Note [decidable namespace]
protected theorem decidable.peirce (a b : Prop) [decidable a] : ((a → b) → a) → a :=
if ha : a then λ h, ha else λ h, h ha.elim

theorem peirce (a b : Prop) : ((a → b) → a) → a := decidable.peirce _ _

theorem peirce' {a : Prop} (H : ∀ b : Prop, (a → b) → a) : a := H _ id

-- See Note [decidable namespace]
protected theorem decidable.not_iff_not [decidable a] [decidable b] : (¬ a ↔ ¬ b) ↔ (a ↔ b) :=
by rw [@iff_def (¬ a), @iff_def' a]; exact and_congr decidable.not_imp_not decidable.not_imp_not

theorem not_iff_not : (¬ a ↔ ¬ b) ↔ (a ↔ b) := decidable.not_iff_not

-- See Note [decidable namespace]
protected theorem decidable.not_iff_comm [decidable a] [decidable b] : (¬ a ↔ b) ↔ (¬ b ↔ a) :=
by rw [@iff_def (¬ a), @iff_def (¬ b)]; exact and_congr decidable.not_imp_comm imp_not_comm

theorem not_iff_comm : (¬ a ↔ b) ↔ (¬ b ↔ a) := decidable.not_iff_comm

-- See Note [decidable namespace]
protected theorem decidable.not_iff : ∀ [decidable b], ¬ (a ↔ b) ↔ (¬ a ↔ b) :=
by intro h; cases h; simp only [h, iff_true, iff_false]

theorem not_iff : ¬ (a ↔ b) ↔ (¬ a ↔ b) := decidable.not_iff

-- See Note [decidable namespace]
protected theorem decidable.iff_not_comm [decidable a] [decidable b] : (a ↔ ¬ b) ↔ (b ↔ ¬ a) :=
by rw [@iff_def a, @iff_def b]; exact and_congr imp_not_comm decidable.not_imp_comm

theorem iff_not_comm : (a ↔ ¬ b) ↔ (b ↔ ¬ a) := decidable.iff_not_comm

-- See Note [decidable namespace]
protected theorem decidable.iff_iff_and_or_not_and_not [decidable b] :
  (a ↔ b) ↔ (a ∧ b) ∨ (¬ a ∧ ¬ b) :=
by { split; intro h,
     { rw h; by_cases b; [left,right]; split; assumption },
     { cases h with h h; cases h; split; intro; { contradiction <|> assumption } } }

theorem iff_iff_and_or_not_and_not : (a ↔ b) ↔ (a ∧ b) ∨ (¬ a ∧ ¬ b) :=
decidable.iff_iff_and_or_not_and_not

lemma decidable.iff_iff_not_or_and_or_not [decidable a] [decidable b] :
  (a ↔ b) ↔ ((¬a ∨ b) ∧ (a ∨ ¬b)) :=
begin
  rw [iff_iff_implies_and_implies a b],
  simp only [decidable.imp_iff_not_or, or.comm]
end

lemma iff_iff_not_or_and_or_not : (a ↔ b) ↔ ((¬a ∨ b) ∧ (a ∨ ¬b)) :=
decidable.iff_iff_not_or_and_or_not

-- See Note [decidable namespace]
protected theorem decidable.not_and_not_right [decidable b] : ¬(a ∧ ¬b) ↔ (a → b) :=
⟨λ h ha, h.decidable_imp_symm $ and.intro ha, λ h ⟨ha, hb⟩, hb $ h ha⟩

theorem not_and_not_right : ¬(a ∧ ¬b) ↔ (a → b) := decidable.not_and_not_right

/-- Transfer decidability of `a` to decidability of `b`, if the propositions are equivalent.
**Important**: this function should be used instead of `rw` on `decidable b`, because the
kernel will get stuck reducing the usage of `propext` otherwise,
and `dec_trivial` will not work. -/
@[inline] def decidable_of_iff (a : Prop) (h : a ↔ b) [D : decidable a] : decidable b :=
decidable_of_decidable_of_iff D h

/-- Transfer decidability of `b` to decidability of `a`, if the propositions are equivalent.
This is the same as `decidable_of_iff` but the iff is flipped. -/
@[inline] def decidable_of_iff' (b : Prop) (h : a ↔ b) [D : decidable b] : decidable a :=
decidable_of_decidable_of_iff D h.symm

/-- Prove that `a` is decidable by constructing a boolean `b` and a proof that `b ↔ a`.
(This is sometimes taken as an alternate definition of decidability.) -/
def decidable_of_bool : ∀ (b : bool) (h : b ↔ a), decidable a
| tt h := is_true (h.1 rfl)
| ff h := is_false (mt h.2 bool.ff_ne_tt)

/-! ### De Morgan's laws -/

theorem not_and_of_not_or_not (h : ¬ a ∨ ¬ b) : ¬ (a ∧ b)
| ⟨ha, hb⟩ := or.elim h (absurd ha) (absurd hb)

-- See Note [decidable namespace]
protected theorem decidable.not_and_distrib [decidable a] : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
⟨λ h, if ha : a then or.inr (λ hb, h ⟨ha, hb⟩) else or.inl ha, not_and_of_not_or_not⟩

-- See Note [decidable namespace]
protected theorem decidable.not_and_distrib' [decidable b] : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
⟨λ h, if hb : b then or.inl (λ ha, h ⟨ha, hb⟩) else or.inr hb, not_and_of_not_or_not⟩

/-- One of de Morgan's laws: the negation of a conjunction is logically equivalent to the
disjunction of the negations. -/
theorem not_and_distrib : ¬ (a ∧ b) ↔ ¬a ∨ ¬b := decidable.not_and_distrib

@[simp] theorem not_and : ¬ (a ∧ b) ↔ (a → ¬ b) := and_imp

theorem not_and' : ¬ (a ∧ b) ↔ b → ¬a :=
not_and.trans imp_not_comm

/-- One of de Morgan's laws: the negation of a disjunction is logically equivalent to the
conjunction of the negations. -/
theorem not_or_distrib : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b :=
⟨λ h, ⟨λ ha, h (or.inl ha), λ hb, h (or.inr hb)⟩,
 λ ⟨h₁, h₂⟩ h, or.elim h h₁ h₂⟩

-- See Note [decidable namespace]
protected theorem decidable.or_iff_not_and_not [decidable a] [decidable b] : a ∨ b ↔ ¬ (¬a ∧ ¬b) :=
by rw [← not_or_distrib, decidable.not_not]

theorem or_iff_not_and_not : a ∨ b ↔ ¬ (¬a ∧ ¬b) := decidable.or_iff_not_and_not

-- See Note [decidable namespace]
protected theorem decidable.and_iff_not_or_not [decidable a] [decidable b] :
  a ∧ b ↔ ¬ (¬ a ∨ ¬ b) :=
by rw [← decidable.not_and_distrib, decidable.not_not]

theorem and_iff_not_or_not : a ∧ b ↔ ¬ (¬ a ∨ ¬ b) := decidable.and_iff_not_or_not

end propositional

/-! ### Declarations about equality -/

section equality
variables {α : Sort*} {a b : α}

@[simp] theorem heq_iff_eq : a == b ↔ a = b :=
⟨eq_of_heq, heq_of_eq⟩

theorem proof_irrel_heq {p q : Prop} (hp : p) (hq : q) : hp == hq :=
have p = q, from propext ⟨λ _, hq, λ _, hp⟩,
by subst q; refl

theorem ne_of_mem_of_not_mem {α β} [has_mem α β] {s : β} {a b : α}
  (h : a ∈ s) : b ∉ s → a ≠ b :=
mt $ λ e, e ▸ h

lemma ne_of_apply_ne {α β : Sort*} (f : α → β) {x y : α} (h : f x ≠ f y) : x ≠ y :=
λ (w : x = y), h (congr_arg f w)

theorem eq_equivalence : equivalence (@eq α) :=
⟨eq.refl, @eq.symm _, @eq.trans _⟩

/-- Transport through trivial families is the identity. -/
@[simp]
lemma eq_rec_constant {α : Sort*} {a a' : α} {β : Sort*} (y : β) (h : a = a') :
  (@eq.rec α a (λ a, β) y a' h) = y :=
by { cases h, refl, }

@[simp]
lemma eq_mp_eq_cast {α β : Sort*} (h : α = β) : eq.mp h = cast h := rfl

@[simp]
lemma eq_mpr_eq_cast {α β : Sort*} (h : α = β) : eq.mpr h = cast h.symm := rfl

@[simp]
lemma cast_cast : ∀ {α β γ : Sort*} (ha : α = β) (hb : β = γ) (a : α),
  cast hb (cast ha a) = cast (ha.trans hb) a
| _ _ _ rfl rfl a := rfl

@[simp] lemma congr_refl_left {α β : Sort*} (f : α → β) {a b : α} (h : a = b) :
  congr (eq.refl f) h = congr_arg f h :=
rfl

@[simp] lemma congr_refl_right {α β : Sort*} {f g : α → β} (h : f = g) (a : α) :
  congr h (eq.refl a) = congr_fun h a :=
rfl

@[simp] lemma congr_arg_refl {α β : Sort*} (f : α → β) (a : α) :
  congr_arg f (eq.refl a) = eq.refl (f a) :=
rfl

@[simp] lemma congr_fun_rfl {α β : Sort*} (f : α → β) (a : α) :
  congr_fun (eq.refl f) a = eq.refl (f a) :=
rfl

@[simp] lemma congr_fun_congr_arg {α β γ : Sort*} (f : α → β → γ) {a a' : α} (p : a = a') (b : β) :
  congr_fun (congr_arg f p) b = congr_arg (λ a, f a b) p :=
rfl

lemma heq_of_cast_eq :
  ∀ {α β : Sort*} {a : α} {a' : β} (e : α = β) (h₂ : cast e a = a'), a == a'
| α ._ a a' rfl h := eq.rec_on h (heq.refl _)

lemma rec_heq_of_heq {β} {C : α → Sort*} {x : C a} {y : β} (eq : a = b) (h : x == y) :
  @eq.rec α a C x b eq == y :=
by subst eq; exact h

protected lemma eq.congr {x₁ x₂ y₁ y₂ : α} (h₁ : x₁ = y₁) (h₂ : x₂ = y₂) :
  (x₁ = x₂) ↔ (y₁ = y₂) :=
by { subst h₁, subst h₂ }

lemma eq.congr_left {x y z : α} (h : x = y) : x = z ↔ y = z := by rw [h]
lemma eq.congr_right {x y z : α} (h : x = y) : z = x ↔ z = y := by rw [h]

lemma congr_arg2 {α β γ : Type*} (f : α → β → γ) {x x' : α} {y y' : β}
  (hx : x = x') (hy : y = y') : f x y = f x' y' :=
by { subst hx, subst hy }

end equality

/-! ### Declarations about quantifiers -/

section quantifiers
variables {α : Sort*} {β : Sort*} {p q : α → Prop} {b : Prop}

lemma forall_imp (h : ∀ a, p a → q a) : (∀ a, p a) → ∀ a, q a :=
λ h' a, h a (h' a)

lemma forall₂_congr {p q : α → β → Prop} (h : ∀ a b, p a b ↔ q a b) :
  (∀ a b, p a b) ↔ (∀ a b, q a b) :=
forall_congr (λ a, forall_congr (h a))

lemma forall₃_congr {γ : Sort*} {p q : α → β → γ → Prop}
  (h : ∀ a b c, p a b c ↔ q a b c) :
  (∀ a b c, p a b c) ↔ (∀ a b c, q a b c) :=
forall_congr (λ a, forall₂_congr (h a))

lemma forall₄_congr {γ δ : Sort*} {p q : α → β → γ → δ → Prop}
  (h : ∀ a b c d, p a b c d ↔ q a b c d) :
  (∀ a b c d, p a b c d) ↔ (∀ a b c d, q a b c d) :=
forall_congr (λ a, forall₃_congr (h a))

lemma Exists.imp (h : ∀ a, (p a → q a)) (p : ∃ a, p a) : ∃ a, q a := exists_imp_exists h p

lemma exists_imp_exists' {p : α → Prop} {q : β → Prop} (f : α → β) (hpq : ∀ a, p a → q (f a))
  (hp : ∃ a, p a) : ∃ b, q b :=
exists.elim hp (λ a hp', ⟨_, hpq _ hp'⟩)

lemma exists₂_congr {p q : α → β → Prop} (h : ∀ a b, p a b ↔ q a b) :
  (∃ a b, p a b) ↔ (∃ a b, q a b) :=
exists_congr (λ a, exists_congr (h a))

lemma exists₃_congr {γ : Sort*} {p q : α → β → γ → Prop}
  (h : ∀ a b c, p a b c ↔ q a b c) :
  (∃ a b c, p a b c) ↔ (∃ a b c, q a b c) :=
exists_congr (λ a, exists₂_congr (h a))

lemma exists₄_congr {γ δ : Sort*} {p q : α → β → γ → δ → Prop}
  (h : ∀ a b c d, p a b c d ↔ q a b c d) :
  (∃ a b c d, p a b c d) ↔ (∃ a b c d, q a b c d) :=
exists_congr (λ a, exists₃_congr (h a))

theorem forall_swap {p : α → β → Prop} : (∀ x y, p x y) ↔ ∀ y x, p x y :=
⟨function.swap, function.swap⟩

theorem exists_swap {p : α → β → Prop} : (∃ x y, p x y) ↔ ∃ y x, p x y :=
⟨λ ⟨x, y, h⟩, ⟨y, x, h⟩, λ ⟨y, x, h⟩, ⟨x, y, h⟩⟩

@[simp] theorem exists_imp_distrib : ((∃ x, p x) → b) ↔ ∀ x, p x → b :=
⟨λ h x hpx, h ⟨x, hpx⟩, λ h ⟨x, hpx⟩, h x hpx⟩

/--
Extract an element from a existential statement, using `classical.some`.
-/
-- This enables projection notation.
@[reducible] noncomputable def Exists.some {p : α → Prop} (P : ∃ a, p a) : α := classical.some P

/--
Show that an element extracted from `P : ∃ a, p a` using `P.some` satisfies `p`.
-/
lemma Exists.some_spec {p : α → Prop} (P : ∃ a, p a) : p (P.some) := classical.some_spec P

--theorem forall_not_of_not_exists (h : ¬ ∃ x, p x) : ∀ x, ¬ p x :=
--forall_imp_of_exists_imp h

theorem not_exists_of_forall_not (h : ∀ x, ¬ p x) : ¬ ∃ x, p x :=
exists_imp_distrib.2 h

@[simp] theorem not_exists : (¬ ∃ x, p x) ↔ ∀ x, ¬ p x :=
exists_imp_distrib

theorem not_forall_of_exists_not : (∃ x, ¬ p x) → ¬ ∀ x, p x
| ⟨x, hn⟩ h := hn (h x)

-- See Note [decidable namespace]
protected theorem decidable.not_forall {p : α → Prop}
  [decidable (∃ x, ¬ p x)] [∀ x, decidable (p x)] : (¬ ∀ x, p x) ↔ ∃ x, ¬ p x :=
⟨not.decidable_imp_symm $ λ nx x, nx.decidable_imp_symm $ λ h, ⟨x, h⟩,
 not_forall_of_exists_not⟩

@[simp] theorem not_forall {p : α → Prop} : (¬ ∀ x, p x) ↔ ∃ x, ¬ p x := decidable.not_forall

-- See Note [decidable namespace]
protected theorem decidable.not_forall_not [decidable (∃ x, p x)] :
  (¬ ∀ x, ¬ p x) ↔ ∃ x, p x :=
(@decidable.not_iff_comm _ _ _ (decidable_of_iff (¬ ∃ x, p x) not_exists)).1 not_exists

theorem not_forall_not : (¬ ∀ x, ¬ p x) ↔ ∃ x, p x := decidable.not_forall_not

-- See Note [decidable namespace]
protected theorem decidable.not_exists_not [∀ x, decidable (p x)] : (¬ ∃ x, ¬ p x) ↔ ∀ x, p x :=
by simp [decidable.not_not]

@[simp] theorem not_exists_not : (¬ ∃ x, ¬ p x) ↔ ∀ x, p x := decidable.not_exists_not

-- TODO: duplicate of a lemma in core
theorem forall_true_iff : (α → true) ↔ true :=
implies_true_iff α

-- Unfortunately this causes simp to loop sometimes, so we
-- add the 2 and 3 cases as simp lemmas instead
theorem forall_true_iff' (h : ∀ a, p a ↔ true) : (∀ a, p a) ↔ true :=
iff_true_intro (λ _, of_iff_true (h _))

@[simp] theorem forall_2_true_iff {β : α → Sort*} : (∀ a, β a → true) ↔ true :=
forall_true_iff' $ λ _, forall_true_iff

@[simp] theorem forall_3_true_iff {β : α → Sort*} {γ : Π a, β a → Sort*} :
  (∀ a (b : β a), γ a b → true) ↔ true :=
forall_true_iff' $ λ _, forall_2_true_iff

@[simp] theorem forall_const (α : Sort*) [i : nonempty α] : (α → b) ↔ b :=
⟨i.elim, λ hb x, hb⟩

@[simp] theorem exists_const (α : Sort*) [i : nonempty α] : (∃ x : α, b) ↔ b :=
⟨λ ⟨x, h⟩, h, i.elim exists.intro⟩

theorem forall_and_distrib : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
⟨λ h, ⟨λ x, (h x).left, λ x, (h x).right⟩, λ ⟨h₁, h₂⟩ x, ⟨h₁ x, h₂ x⟩⟩

theorem exists_or_distrib : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
⟨λ ⟨x, hpq⟩, hpq.elim (λ hpx, or.inl ⟨x, hpx⟩) (λ hqx, or.inr ⟨x, hqx⟩),
 λ hepq, hepq.elim (λ ⟨x, hpx⟩, ⟨x, or.inl hpx⟩) (λ ⟨x, hqx⟩, ⟨x, or.inr hqx⟩)⟩

@[simp] theorem exists_and_distrib_left {q : Prop} {p : α → Prop} :
  (∃x, q ∧ p x) ↔ q ∧ (∃x, p x) :=
⟨λ ⟨x, hq, hp⟩, ⟨hq, x, hp⟩, λ ⟨hq, x, hp⟩, ⟨x, hq, hp⟩⟩

@[simp] theorem exists_and_distrib_right {q : Prop} {p : α → Prop} :
  (∃x, p x ∧ q) ↔ (∃x, p x) ∧ q :=
by simp [and_comm]

@[simp] theorem forall_eq {a' : α} : (∀a, a = a' → p a) ↔ p a' :=
⟨λ h, h a' rfl, λ h a e, e.symm ▸ h⟩

@[simp] theorem forall_eq' {a' : α} : (∀a, a' = a → p a) ↔ p a' :=
by simp [@eq_comm _ a']

-- this lemma is needed to simplify the output of `list.mem_cons_iff`
@[simp] theorem forall_eq_or_imp {a' : α} : (∀ a, a = a' ∨ q a → p a) ↔ p a' ∧ ∀ a, q a → p a :=
by simp only [or_imp_distrib, forall_and_distrib, forall_eq]

@[simp] theorem exists_eq {a' : α} : ∃ a, a = a' := ⟨_, rfl⟩

@[simp] theorem exists_eq' {a' : α} : ∃ a, a' = a := ⟨_, rfl⟩

@[simp] theorem exists_eq_left {a' : α} : (∃ a, a = a' ∧ p a) ↔ p a' :=
⟨λ ⟨a, e, h⟩, e ▸ h, λ h, ⟨_, rfl, h⟩⟩

@[simp] theorem exists_eq_right {a' : α} : (∃ a, p a ∧ a = a') ↔ p a' :=
(exists_congr $ by exact λ a, and.comm).trans exists_eq_left

@[simp] theorem exists_eq_right_right {a' : α} :
  (∃ (a : α), p a ∧ b ∧ a = a') ↔ p a' ∧ b :=
⟨λ ⟨_, hp, hq, rfl⟩, ⟨hp, hq⟩, λ ⟨hp, hq⟩, ⟨a', hp, hq, rfl⟩⟩

@[simp] theorem exists_eq_right_right' {a' : α} :
  (∃ (a : α), p a ∧ b ∧ a' = a) ↔ p a' ∧ b :=
⟨λ ⟨_, hp, hq, rfl⟩, ⟨hp, hq⟩, λ ⟨hp, hq⟩, ⟨a', hp, hq, rfl⟩⟩

@[simp] theorem exists_apply_eq_apply {α β : Type*} (f : α → β) (a' : α) : ∃ a, f a = f a' :=
⟨a', rfl⟩

@[simp] theorem exists_apply_eq_apply' {α β : Type*} (f : α → β) (a' : α) : ∃ a, f a' = f a :=
⟨a', rfl⟩

@[simp] theorem exists_exists_and_eq_and {f : α → β} {p : α → Prop} {q : β → Prop} :
  (∃ b, (∃ a, p a ∧ f a = b) ∧ q b) ↔ ∃ a, p a ∧ q (f a) :=
⟨λ ⟨b, ⟨a, ha, hab⟩, hb⟩, ⟨a, ha, hab.symm ▸ hb⟩, λ ⟨a, hp, hq⟩, ⟨f a, ⟨a, hp, rfl⟩, hq⟩⟩

@[simp] theorem exists_exists_eq_and {f : α → β} {p : β → Prop} :
  (∃ b, (∃ a, f a = b) ∧ p b) ↔ ∃ a, p (f a) :=
⟨λ ⟨b, ⟨a, ha⟩, hb⟩, ⟨a, ha.symm ▸ hb⟩, λ ⟨a, ha⟩, ⟨f a, ⟨a, rfl⟩, ha⟩⟩

@[simp] theorem forall_apply_eq_imp_iff {f : α → β} {p : β → Prop} :
  (∀ a, ∀ b, f a = b → p b) ↔ (∀ a, p (f a)) :=
⟨λ h a, h a (f a) rfl, λ h a b hab, hab ▸ h a⟩

@[simp] theorem forall_apply_eq_imp_iff' {f : α → β} {p : β → Prop} :
  (∀ b, ∀ a, f a = b → p b) ↔ (∀ a, p (f a)) :=
by { rw forall_swap, simp }

@[simp] theorem forall_eq_apply_imp_iff {f : α → β} {p : β → Prop} :
  (∀ a, ∀ b, b = f a → p b) ↔ (∀ a, p (f a)) :=
by simp [@eq_comm _ _ (f _)]

@[simp] theorem forall_eq_apply_imp_iff' {f : α → β} {p : β → Prop} :
  (∀ b, ∀ a, b = f a → p b) ↔ (∀ a, p (f a)) :=
by { rw forall_swap, simp }

@[simp] theorem forall_apply_eq_imp_iff₂ {f : α → β} {p : α → Prop} {q : β → Prop} :
  (∀ b, ∀ a, p a → f a = b → q b) ↔ ∀ a, p a → q (f a) :=
⟨λ h a ha, h (f a) a ha rfl, λ h b a ha hb, hb ▸ h a ha⟩

@[simp] theorem exists_eq_left' {a' : α} : (∃ a, a' = a ∧ p a) ↔ p a' :=
by simp [@eq_comm _ a']

@[simp] theorem exists_eq_right' {a' : α} : (∃ a, p a ∧ a' = a) ↔ p a' :=
by simp [@eq_comm _ a']

theorem exists_comm {p : α → β → Prop} : (∃ a b, p a b) ↔ ∃ b a, p a b :=
⟨λ ⟨a, b, h⟩, ⟨b, a, h⟩, λ ⟨b, a, h⟩, ⟨a, b, h⟩⟩

theorem forall_or_of_or_forall (h : b ∨ ∀x, p x) (x) : b ∨ p x :=
h.imp_right $ λ h₂, h₂ x

-- See Note [decidable namespace]
protected theorem decidable.forall_or_distrib_left {q : Prop} {p : α → Prop} [decidable q] :
  (∀x, q ∨ p x) ↔ q ∨ (∀x, p x) :=
⟨λ h, if hq : q then or.inl hq else or.inr $ λ x, (h x).resolve_left hq,
  forall_or_of_or_forall⟩

theorem forall_or_distrib_left {q : Prop} {p : α → Prop} :
  (∀x, q ∨ p x) ↔ q ∨ (∀x, p x) := decidable.forall_or_distrib_left

-- See Note [decidable namespace]
protected theorem decidable.forall_or_distrib_right {q : Prop} {p : α → Prop} [decidable q] :
  (∀x, p x ∨ q) ↔ (∀x, p x) ∨ q :=
by simp [or_comm, decidable.forall_or_distrib_left]

theorem forall_or_distrib_right {q : Prop} {p : α → Prop} :
  (∀x, p x ∨ q) ↔ (∀x, p x) ∨ q := decidable.forall_or_distrib_right

/-- A predicate holds everywhere on the image of a surjective functions iff
    it holds everywhere. -/
theorem forall_iff_forall_surj
  {α β : Type*} {f : α → β} (h : function.surjective f) {P : β → Prop} :
  (∀ a, P (f a)) ↔ ∀ b, P b :=
⟨λ ha b, by cases h b with a hab; rw ←hab; exact ha a, λ hb a, hb $ f a⟩

@[simp] theorem exists_prop {p q : Prop} : (∃ h : p, q) ↔ p ∧ q :=
⟨λ ⟨h₁, h₂⟩, ⟨h₁, h₂⟩, λ ⟨h₁, h₂⟩, ⟨h₁, h₂⟩⟩

@[simp] theorem exists_false : ¬ (∃a:α, false) := assume ⟨a, h⟩, h

@[simp] lemma exists_unique_false : ¬ (∃! (a : α), false) := assume ⟨a, h, h'⟩, h

theorem Exists.fst {p : b → Prop} : Exists p → b
| ⟨h, _⟩ := h

theorem Exists.snd {p : b → Prop} : ∀ h : Exists p, p h.fst
| ⟨_, h⟩ := h

theorem forall_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∀ h' : p, q h') ↔ q h :=
@forall_const (q h) p ⟨h⟩

theorem exists_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∃ h' : p, q h') ↔ q h :=
@exists_const (q h) p ⟨h⟩

theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬ p) :
  (∀ h' : p, q h') ↔ true :=
iff_true_intro $ λ h, hn.elim h

theorem exists_prop_of_false {p : Prop} {q : p → Prop} : ¬ p → ¬ (∃ h' : p, q h') :=
mt Exists.fst

@[congr] lemma exists_prop_congr {p p' : Prop} {q q' : p → Prop}
  (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : Exists q ↔ ∃ h : p', q' (hp.2 h) :=
⟨λ ⟨_, _⟩, ⟨hp.1 ‹_›, (hq _).1 ‹_›⟩, λ ⟨_, _⟩, ⟨_, (hq _).2 ‹_›⟩⟩

@[congr] lemma exists_prop_congr' {p p' : Prop} {q q' : p → Prop}
  (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : Exists q = ∃ h : p', q' (hp.2 h) :=
propext (exists_prop_congr hq _)

@[simp] lemma exists_true_left (p : true → Prop) : (∃ x, p x) ↔ p true.intro :=
exists_prop_of_true _

@[simp] lemma exists_false_left (p : false → Prop) : ¬ ∃ x, p x :=
exists_prop_of_false not_false

lemma exists_unique.exists {α : Sort*} {p : α → Prop} (h : ∃! x, p x) : ∃ x, p x :=
exists.elim h (λ x hx, ⟨x, and.left hx⟩)

lemma exists_unique.unique {α : Sort*} {p : α → Prop} (h : ∃! x, p x)
  {y₁ y₂ : α} (py₁ : p y₁) (py₂ : p y₂) : y₁ = y₂ :=
unique_of_exists_unique h py₁ py₂

@[congr] lemma forall_prop_congr {p p' : Prop} {q q' : p → Prop}
  (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : (∀ h, q h) ↔ ∀ h : p', q' (hp.2 h) :=
⟨λ h1 h2, (hq _).1 (h1 (hp.2 _)), λ h1 h2, (hq _).2 (h1 (hp.1 h2))⟩

@[congr] lemma forall_prop_congr' {p p' : Prop} {q q' : p → Prop}
  (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : (∀ h, q h) = ∀ h : p', q' (hp.2 h) :=
propext (forall_prop_congr hq _)

@[simp] lemma forall_true_left (p : true → Prop) : (∀ x, p x) ↔ p true.intro :=
forall_prop_of_true _

@[simp] lemma forall_false_left (p : false → Prop) : (∀ x, p x) ↔ true :=
forall_prop_of_false not_false

@[simp] lemma exists_unique_iff_exists {α : Sort*} [subsingleton α] {p : α → Prop} :
  (∃! x, p x) ↔ ∃ x, p x :=
⟨λ h, h.exists, Exists.imp $ λ x hx, ⟨hx, λ y _, subsingleton.elim y x⟩⟩

lemma exists_unique.elim2 {α : Sort*} {p : α → Sort*} [∀ x, subsingleton (p x)]
  {q : Π x (h : p x), Prop} {b : Prop} (h₂ : ∃! x (h : p x), q x h)
  (h₁ : ∀ x (h : p x), q x h → (∀ y (hy : p y), q y hy → y = x) → b) : b :=
begin
  simp only [exists_unique_iff_exists] at h₂,
  apply h₂.elim,
  exact λ x ⟨hxp, hxq⟩ H, h₁ x hxp hxq (λ y hyp hyq, H y ⟨hyp, hyq⟩)
end

lemma exists_unique.intro2 {α : Sort*} {p : α → Sort*} [∀ x, subsingleton (p x)]
  {q : Π (x : α) (h : p x), Prop} (w : α) (hp : p w) (hq : q w hp)
  (H : ∀ y (hy : p y), q y hy → y = w) :
  ∃! x (hx : p x), q x hx :=
begin
  simp only [exists_unique_iff_exists],
  exact exists_unique.intro w ⟨hp, hq⟩ (λ y ⟨hyp, hyq⟩, H y hyp hyq)
end

lemma exists_unique.exists2 {α : Sort*} {p : α → Sort*} {q : Π (x : α) (h : p x), Prop}
  (h : ∃! x (hx : p x), q x hx) :
  ∃ x (hx : p x), q x hx :=
h.exists.imp (λ x hx, hx.exists)

lemma exists_unique.unique2 {α : Sort*} {p : α → Sort*} [∀ x, subsingleton (p x)]
  {q : Π (x : α) (hx : p x), Prop} (h : ∃! x (hx : p x), q x hx)
  {y₁ y₂ : α} (hpy₁ : p y₁) (hqy₁ : q y₁ hpy₁)
  (hpy₂ : p y₂) (hqy₂ : q y₂ hpy₂) : y₁ = y₂ :=
begin
  simp only [exists_unique_iff_exists] at h,
  exact h.unique ⟨hpy₁, hqy₁⟩ ⟨hpy₂, hqy₂⟩
end

end quantifiers

/-! ### Classical lemmas -/

namespace classical
variables {α : Sort*} {p : α → Prop}

theorem cases {p : Prop → Prop} (h1 : p true) (h2 : p false) : ∀a, p a :=
assume a, cases_on a h1 h2

/- use shortened names to avoid conflict when classical namespace is open. -/
noncomputable lemma dec (p : Prop) : decidable p := -- see Note [classical lemma]
by apply_instance
noncomputable lemma dec_pred (p : α → Prop) : decidable_pred p := -- see Note [classical lemma]
by apply_instance
noncomputable lemma dec_rel (p : α → α → Prop) : decidable_rel p := -- see Note [classical lemma]
by apply_instance
noncomputable lemma dec_eq (α : Sort*) : decidable_eq α := -- see Note [classical lemma]
by apply_instance

/--
We make decidability results that depends on `classical.choice` noncomputable lemmas.
* We have to mark them as noncomputable, because otherwise Lean will try to generate bytecode
  for them, and fail because it depends on `classical.choice`.
* We make them lemmas, and not definitions, because otherwise later definitions will raise
  \"failed to generate bytecode\" errors when writing something like
  `letI := classical.dec_eq _`.
Cf. <https://leanprover-community.github.io/archive/stream/113488-general/topic/noncomputable.20theorem.html>
-/
library_note "classical lemma"

/-- Construct a function from a default value `H0`, and a function to use if there exists a value
satisfying the predicate. -/
@[elab_as_eliminator]
noncomputable def {u} exists_cases {C : Sort u} (H0 : C) (H : ∀ a, p a → C) : C :=
if h : ∃ a, p a then H (classical.some h) (classical.some_spec h) else H0

lemma some_spec2 {α : Sort*} {p : α → Prop} {h : ∃a, p a}
  (q : α → Prop) (hpq : ∀a, p a → q a) : q (some h) :=
hpq _ $ some_spec _

/-- A version of classical.indefinite_description which is definitionally equal to a pair -/
noncomputable def subtype_of_exists {α : Type*} {P : α → Prop} (h : ∃ x, P x) : {x // P x} :=
⟨classical.some h, classical.some_spec h⟩

end classical

/-- This function has the same type as `exists.rec_on`, and can be used to case on an equality,
but `exists.rec_on` can only eliminate into Prop, while this version eliminates into any universe
using the axiom of choice. -/
@[elab_as_eliminator]
noncomputable def {u} exists.classical_rec_on
 {α} {p : α → Prop} (h : ∃ a, p a) {C : Sort u} (H : ∀ a, p a → C) : C :=
H (classical.some h) (classical.some_spec h)

/-! ### Declarations about bounded quantifiers -/

section bounded_quantifiers
variables {α : Sort*} {r p q : α → Prop} {P Q : ∀ x, p x → Prop} {b : Prop}

theorem bex_def : (∃ x (h : p x), q x) ↔ ∃ x, p x ∧ q x :=
⟨λ ⟨x, px, qx⟩, ⟨x, px, qx⟩, λ ⟨x, px, qx⟩, ⟨x, px, qx⟩⟩

theorem bex.elim {b : Prop} : (∃ x h, P x h) → (∀ a h, P a h → b) → b
| ⟨a, h₁, h₂⟩ h' := h' a h₁ h₂

theorem bex.intro (a : α) (h₁ : p a) (h₂ : P a h₁) : ∃ x (h : p x), P x h :=
⟨a, h₁, h₂⟩

theorem ball_congr (H : ∀ x h, P x h ↔ Q x h) :
  (∀ x h, P x h) ↔ (∀ x h, Q x h) :=
forall_congr $ λ x, forall_congr (H x)

theorem bex_congr (H : ∀ x h, P x h ↔ Q x h) :
  (∃ x h, P x h) ↔ (∃ x h, Q x h) :=
exists_congr $ λ x, exists_congr (H x)

theorem bex_eq_left {a : α} : (∃ x (_ : x = a), p x) ↔ p a :=
by simp only [exists_prop, exists_eq_left]

theorem ball.imp_right (H : ∀ x h, (P x h → Q x h))
  (h₁ : ∀ x h, P x h) (x h) : Q x h :=
H _ _ $ h₁ _ _

theorem bex.imp_right (H : ∀ x h, (P x h → Q x h)) :
  (∃ x h, P x h) → ∃ x h, Q x h
| ⟨x, h, h'⟩ := ⟨_, _, H _ _ h'⟩

theorem ball.imp_left (H : ∀ x, p x → q x)
  (h₁ : ∀ x, q x → r x) (x) (h : p x) : r x :=
h₁ _ $ H _ h

theorem bex.imp_left (H : ∀ x, p x → q x) :
  (∃ x (_ : p x), r x) → ∃ x (_ : q x), r x
| ⟨x, hp, hr⟩ := ⟨x, H _ hp, hr⟩

theorem ball_of_forall (h : ∀ x, p x) (x) : p x :=
h x

theorem forall_of_ball (H : ∀ x, p x) (h : ∀ x, p x → q x) (x) : q x :=
h x $ H x

theorem bex_of_exists (H : ∀ x, p x) : (∃ x, q x) → ∃ x (_ : p x), q x
| ⟨x, hq⟩ := ⟨x, H x, hq⟩

theorem exists_of_bex : (∃ x (_ : p x), q x) → ∃ x, q x
| ⟨x, _, hq⟩ := ⟨x, hq⟩

@[simp] theorem bex_imp_distrib : ((∃ x h, P x h) → b) ↔ (∀ x h, P x h → b) :=
by simp

theorem not_bex : (¬ ∃ x h, P x h) ↔ ∀ x h, ¬ P x h :=
bex_imp_distrib

theorem not_ball_of_bex_not : (∃ x h, ¬ P x h) → ¬ ∀ x h, P x h
| ⟨x, h, hp⟩ al := hp $ al x h

-- See Note [decidable namespace]
protected theorem decidable.not_ball [decidable (∃ x h, ¬ P x h)] [∀ x h, decidable (P x h)] :
  (¬ ∀ x h, P x h) ↔ (∃ x h, ¬ P x h) :=
⟨not.decidable_imp_symm $ λ nx x h, nx.decidable_imp_symm $ λ h', ⟨x, h, h'⟩,
 not_ball_of_bex_not⟩

theorem not_ball : (¬ ∀ x h, P x h) ↔ (∃ x h, ¬ P x h) := decidable.not_ball

theorem ball_true_iff (p : α → Prop) : (∀ x, p x → true) ↔ true :=
iff_true_intro (λ h hrx, trivial)

theorem ball_and_distrib : (∀ x h, P x h ∧ Q x h) ↔ (∀ x h, P x h) ∧ (∀ x h, Q x h) :=
iff.trans (forall_congr $ λ x, forall_and_distrib) forall_and_distrib

theorem bex_or_distrib : (∃ x h, P x h ∨ Q x h) ↔ (∃ x h, P x h) ∨ (∃ x h, Q x h) :=
iff.trans (exists_congr $ λ x, exists_or_distrib) exists_or_distrib

theorem ball_or_left_distrib : (∀ x, p x ∨ q x → r x) ↔ (∀ x, p x → r x) ∧ (∀ x, q x → r x) :=
iff.trans (forall_congr $ λ x, or_imp_distrib) forall_and_distrib

theorem bex_or_left_distrib :
  (∃ x (_ : p x ∨ q x), r x) ↔ (∃ x (_ : p x), r x) ∨ (∃ x (_ : q x), r x) :=
by simp only [exists_prop]; exact
iff.trans (exists_congr $ λ x, or_and_distrib_right) exists_or_distrib

end bounded_quantifiers

namespace classical
local attribute [instance] prop_decidable

theorem not_ball {α : Sort*} {p : α → Prop} {P : Π (x : α), p x → Prop} :
  (¬ ∀ x h, P x h) ↔ (∃ x h, ¬ P x h) := _root_.not_ball

end classical

lemma ite_eq_iff {α} {p : Prop} [decidable p] {a b c : α} :
  (if p then a else b) = c ↔ p ∧ a = c ∨ ¬p ∧ b = c :=
by by_cases p; simp *

@[simp] lemma ite_eq_left_iff {α} {p : Prop} [decidable p] {a b : α} :
  (if p then a else b) = a ↔ (¬p → b = a) :=
by by_cases p; simp *

@[simp] lemma ite_eq_right_iff {α} {p : Prop} [decidable p] {a b : α} :
  (if p then a else b) = b ↔ (p → a = b) :=
by by_cases p; simp *

/-! ### Declarations about `nonempty` -/

section nonempty
universe variables u v w
variables {α : Type u} {β : Type v} {γ : α → Type w}

attribute [simp] nonempty_of_inhabited

@[priority 20]
instance has_zero.nonempty [has_zero α] : nonempty α := ⟨0⟩
@[priority 20]
instance has_one.nonempty [has_one α] : nonempty α := ⟨1⟩

lemma exists_true_iff_nonempty {α : Sort*} : (∃a:α, true) ↔ nonempty α :=
iff.intro (λ⟨a, _⟩, ⟨a⟩) (λ⟨a⟩, ⟨a, trivial⟩)

@[simp] lemma nonempty_Prop {p : Prop} : nonempty p ↔ p :=
iff.intro (assume ⟨h⟩, h) (assume h, ⟨h⟩)

lemma not_nonempty_iff_imp_false : ¬ nonempty α ↔ α → false :=
⟨λ h a, h ⟨a⟩, λ h ⟨a⟩, h a⟩

@[simp] lemma nonempty_sigma : nonempty (Σa:α, γ a) ↔ (∃a:α, nonempty (γ a)) :=
iff.intro (assume ⟨⟨a, c⟩⟩, ⟨a, ⟨c⟩⟩) (assume ⟨a, ⟨c⟩⟩, ⟨⟨a, c⟩⟩)

@[simp] lemma nonempty_subtype {α : Sort u} {p : α → Prop} : nonempty (subtype p) ↔ (∃a:α, p a) :=
iff.intro (assume ⟨⟨a, h⟩⟩, ⟨a, h⟩) (assume ⟨a, h⟩, ⟨⟨a, h⟩⟩)

@[simp] lemma nonempty_prod : nonempty (α × β) ↔ (nonempty α ∧ nonempty β) :=
iff.intro (assume ⟨⟨a, b⟩⟩, ⟨⟨a⟩, ⟨b⟩⟩) (assume ⟨⟨a⟩, ⟨b⟩⟩, ⟨⟨a, b⟩⟩)

@[simp] lemma nonempty_pprod {α : Sort u} {β : Sort v} :
  nonempty (pprod α β) ↔ (nonempty α ∧ nonempty β) :=
iff.intro (assume ⟨⟨a, b⟩⟩, ⟨⟨a⟩, ⟨b⟩⟩) (assume ⟨⟨a⟩, ⟨b⟩⟩, ⟨⟨a, b⟩⟩)

@[simp] lemma nonempty_sum : nonempty (α ⊕ β) ↔ (nonempty α ∨ nonempty β) :=
iff.intro
  (assume ⟨h⟩, match h with sum.inl a := or.inl ⟨a⟩ | sum.inr b := or.inr ⟨b⟩ end)
  (assume h, match h with or.inl ⟨a⟩ := ⟨sum.inl a⟩ | or.inr ⟨b⟩ := ⟨sum.inr b⟩ end)

@[simp] lemma nonempty_psum {α : Sort u} {β : Sort v} :
  nonempty (psum α β) ↔ (nonempty α ∨ nonempty β) :=
iff.intro
  (assume ⟨h⟩, match h with psum.inl a := or.inl ⟨a⟩ | psum.inr b := or.inr ⟨b⟩ end)
  (assume h, match h with or.inl ⟨a⟩ := ⟨psum.inl a⟩ | or.inr ⟨b⟩ := ⟨psum.inr b⟩ end)

@[simp] lemma nonempty_psigma {α : Sort u} {β : α → Sort v} :
  nonempty (psigma β) ↔ (∃a:α, nonempty (β a)) :=
iff.intro (assume ⟨⟨a, c⟩⟩, ⟨a, ⟨c⟩⟩) (assume ⟨a, ⟨c⟩⟩, ⟨⟨a, c⟩⟩)

@[simp] lemma nonempty_empty : ¬ nonempty empty :=
assume ⟨h⟩, h.elim

@[simp] lemma nonempty_ulift : nonempty (ulift α) ↔ nonempty α :=
iff.intro (assume ⟨⟨a⟩⟩, ⟨a⟩) (assume ⟨a⟩, ⟨⟨a⟩⟩)

@[simp] lemma nonempty_plift {α : Sort u} : nonempty (plift α) ↔ nonempty α :=
iff.intro (assume ⟨⟨a⟩⟩, ⟨a⟩) (assume ⟨a⟩, ⟨⟨a⟩⟩)

@[simp] lemma nonempty.forall {α : Sort u} {p : nonempty α → Prop} :
  (∀h:nonempty α, p h) ↔ (∀a, p ⟨a⟩) :=
iff.intro (assume h a, h _) (assume h ⟨a⟩, h _)

@[simp] lemma nonempty.exists {α : Sort u} {p : nonempty α → Prop} :
  (∃h:nonempty α, p h) ↔ (∃a, p ⟨a⟩) :=
iff.intro (assume ⟨⟨a⟩, h⟩, ⟨a, h⟩) (assume ⟨a, h⟩, ⟨⟨a⟩, h⟩)

lemma classical.nonempty_pi {α : Sort u} {β : α → Sort v} :
  nonempty (Πa:α, β a) ↔ (∀a:α, nonempty (β a)) :=
iff.intro (assume ⟨f⟩ a, ⟨f a⟩) (assume f, ⟨assume a, classical.choice $ f a⟩)

/-- Using `classical.choice`, lifts a (`Prop`-valued) `nonempty` instance to a (`Type`-valued)
  `inhabited` instance. `classical.inhabited_of_nonempty` already exists, in
  `core/init/classical.lean`, but the assumption is not a type class argument,
  which makes it unsuitable for some applications. -/
noncomputable def classical.inhabited_of_nonempty' {α : Sort u} [h : nonempty α] : inhabited α :=
⟨classical.choice h⟩

/-- Using `classical.choice`, extracts a term from a `nonempty` type. -/
@[reducible] protected noncomputable def nonempty.some {α : Sort u} (h : nonempty α) : α :=
classical.choice h

/-- Using `classical.choice`, extracts a term from a `nonempty` type. -/
@[reducible] protected noncomputable def classical.arbitrary (α : Sort u) [h : nonempty α] : α :=
classical.choice h

/-- Given `f : α → β`, if `α` is nonempty then `β` is also nonempty.
  `nonempty` cannot be a `functor`, because `functor` is restricted to `Type`. -/
lemma nonempty.map {α : Sort u} {β : Sort v} (f : α → β) : nonempty α → nonempty β
| ⟨h⟩ := ⟨f h⟩

protected lemma nonempty.map2 {α β γ : Sort*} (f : α → β → γ) : nonempty α → nonempty β → nonempty γ
| ⟨x⟩ ⟨y⟩ := ⟨f x y⟩

protected lemma nonempty.congr {α : Sort u} {β : Sort v} (f : α → β) (g : β → α) :
  nonempty α ↔ nonempty β :=
⟨nonempty.map f, nonempty.map g⟩

lemma nonempty.elim_to_inhabited {α : Sort*} [h : nonempty α] {p : Prop}
  (f : inhabited α → p) : p :=
h.elim $ f ∘ inhabited.mk

instance {α β} [h : nonempty α] [h2 : nonempty β] : nonempty (α × β) :=
h.elim $ λ g, h2.elim $ λ g2, ⟨⟨g, g2⟩⟩

end nonempty

section ite

/-- A `dite` whose results do not actually depend on the condition may be reduced to an `ite`. -/
@[simp]
lemma dite_eq_ite (P : Prop) [decidable P] {α : Sort*} (x y : α) :
  dite P (λ h, x) (λ h, y) = ite P x y := rfl

/-- A function applied to a `dite` is a `dite` of that function applied to each of the branches. -/
lemma apply_dite {α β : Sort*} (f : α → β) (P : Prop) [decidable P] (x : P → α) (y : ¬P → α) :
  f (dite P x y) = dite P (λ h, f (x h)) (λ h, f (y h)) :=
by { by_cases h : P; simp [h] }

/-- A function applied to a `ite` is a `ite` of that function applied to each of the branches. -/
lemma apply_ite {α β : Sort*} (f : α → β) (P : Prop) [decidable P] (x y : α) :
  f (ite P x y) = ite P (f x) (f y) :=
apply_dite f P (λ _, x) (λ _, y)

/-- A two-argument function applied to two `dite`s is a `dite` of that two-argument function
applied to each of the branches. -/
lemma apply_dite2 {α β γ : Sort*} (f : α → β → γ) (P : Prop) [decidable P] (a : P → α)
  (b : ¬P → α) (c : P → β) (d : ¬P → β) :
  f (dite P a b) (dite P c d) = dite P (λ h, f (a h) (c h)) (λ h, f (b h) (d h)) :=
by { by_cases h : P; simp [h] }

/-- A two-argument function applied to two `ite`s is a `ite` of that two-argument function
applied to each of the branches. -/
lemma apply_ite2 {α β γ : Sort*} (f : α → β → γ) (P : Prop) [decidable P] (a b : α) (c d : β) :
  f (ite P a b) (ite P c d) = ite P (f a c) (f b d) :=
apply_dite2 f P (λ _, a) (λ _, b) (λ _, c) (λ _, d)

/-- A 'dite' producing a `Pi` type `Π a, β a`, applied to a value `x : α`
is a `dite` that applies either branch to `x`. -/
lemma dite_apply {α : Sort*} {β : α → Sort*} (P : Prop) [decidable P]
  (f : P → Π a, β a) (g : ¬ P → Π a, β a) (x : α) :
  (dite P f g) x = dite P (λ h, f h x) (λ h, g h x) :=
by { by_cases h : P; simp [h] }

/-- A 'ite' producing a `Pi` type `Π a, β a`, applied to a value `x : α`
is a `ite` that applies either branch to `x` -/
lemma ite_apply {α : Sort*} {β : α → Sort*} (P : Prop) [decidable P]
  (f g : Π a, β a) (x : α) :
  (ite P f g) x = ite P (f x) (g x) :=
dite_apply P (λ _, f) (λ _, g) x

/-- Negation of the condition `P : Prop` in a `dite` is the same as swapping the branches. -/
@[simp] lemma dite_not {α : Sort*} (P : Prop) [decidable P] (x : ¬ P → α) (y : ¬¬ P → α) :
  dite (¬ P) x y = dite P (λ h, y (not_not_intro h)) x :=
by { by_cases h : P; simp [h] }

/-- Negation of the condition `P : Prop` in a `ite` is the same as swapping the branches. -/
@[simp] lemma ite_not {α : Sort*} (P : Prop) [decidable P] (x y : α) :
  ite (¬ P) x y = ite P y x :=
dite_not P (λ _, x) (λ _, y)

lemma ite_and {α} {p q : Prop} [decidable p] [decidable q] {x y : α} :
  ite (p ∧ q) x y = ite p (ite q x y) y :=
by { by_cases hp : p; by_cases hq : q; simp [hp, hq] }

end ite
-/


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

The Kleisli construction on the Type category

TODO: generalise this to work with category_theory.monad
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.category.default
import Mathlib.PostPort

universes u v u_1 u_2

namespace Mathlib

namespace category_theory

def Kleisli (m : Type u → Type v) [Monad m] :=
  Type u

def Kleisli.mk (m : Type u → Type v) [Monad m] (α : Type u) : Kleisli m :=
  α

protected instance Kleisli.category_struct {m : Type u_1 → Type u_2} [Monad m] : category_struct (Kleisli m) :=
  category_struct.mk (fun (α : Kleisli m) (x : α) => pure x) fun (X Y Z : Kleisli m) (f : X ⟶ Y) (g : Y ⟶ Z) => f >=> g

protected instance Kleisli.category {m : Type u_1 → Type u_2} [Monad m] [is_lawful_monad m] : category (Kleisli m) :=
  category.mk

@[simp] theorem Kleisli.id_def {m : Type u_1 → Type u_2} [Monad m] [is_lawful_monad m] (α : Kleisli m) : 𝟙 = pure :=
  rfl

theorem Kleisli.comp_def {m : Type u_1 → Type u_2} [Monad m] [is_lawful_monad m] (α : Kleisli m) (β : Kleisli m) (γ : Kleisli m) (xs : α ⟶ β) (ys : β ⟶ γ) (a : α) : category_struct.comp xs ys a = xs a >>= ys :=
  rfl


import Mathlib.Tactic.IrreducibleDef

/-- Add two natural numbers, but not during unification. -/
irreducible_def frobnicate (a b : Nat) :=
  a + b

example : frobnicate a 0 = a := by
  simp [frobnicate_def]

irreducible_def justAsArbitrary [Inhabited α] : α :=
  default

irreducible_def withoutType := 42

irreducible_def withEquations : Nat → Nat
  | 0 => 42
  | _n+1 => 314

irreducible_def withUniv.{u, v} := (Type v, Type u)
example : withUniv.{u, v} = (Type v, Type u) := by rw [withUniv_def]


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.adjunction.default
import Mathlib.category_theory.elements
import Mathlib.category_theory.limits.functor_category
import Mathlib.category_theory.limits.preserves.limits
import Mathlib.category_theory.limits.shapes.terminal
import Mathlib.category_theory.limits.types
import Mathlib.PostPort

universes u₁ u₂

namespace Mathlib

/-!
# Colimit of representables

This file constructs an adjunction `yoneda_adjunction` between `(Cᵒᵖ ⥤ Type u)` and `ℰ` given a
functor `A : C ⥤ ℰ`, where the right adjoint sends `(E : ℰ)` to `c ↦ (A.obj c ⟶ E)` (provided `ℰ`
has colimits).

This adjunction is used to show that every presheaf is a colimit of representables.

Further, the left adjoint `colimit_adj.extend_along_yoneda : (Cᵒᵖ ⥤ Type u) ⥤ ℰ` satisfies
`yoneda ⋙ L ≅ A`, that is, an extension of `A : C ⥤ ℰ` to `(Cᵒᵖ ⥤ Type u) ⥤ ℰ` through
`yoneda : C ⥤ Cᵒᵖ ⥤ Type u`. It is the left Kan extension of `A` along the yoneda embedding,
sometimes known as the Yoneda extension.

`unique_extension_along_yoneda` shows `extend_along_yoneda` is unique amongst cocontinuous functors
with this property, establishing the presheaf category as the free cocompletion of a small category.

## Tags
colimit, representable, presheaf, free cocompletion

## References
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]
* https://ncatlab.org/nlab/show/Yoneda+extension
-/

namespace category_theory

namespace colimit_adj

/--
The functor taking `(E : ℰ) (c : Cᵒᵖ)` to the homset `(A.obj C ⟶ E)`. It is shown in `L_adjunction`
that this functor has a left adjoint (provided `E` has colimits) given by taking colimits over
categories of elements.
In the case where `ℰ = Cᵒᵖ ⥤ Type u` and `A = yoneda`, this functor is isomorphic to the identity.

Defined as in [MM92], Chapter I, Section 5, Theorem 2.
-/
def restricted_yoneda {C : Type u₁} [small_category C] {ℰ : Type u₂} [category ℰ] (A : C ⥤ ℰ) :
    ℰ ⥤ Cᵒᵖ ⥤ Type u₁ :=
  yoneda ⋙ functor.obj (whiskering_left (Cᵒᵖ) (ℰᵒᵖ) (Type u₁)) (functor.op A)

/--
The functor `restricted_yoneda` is isomorphic to the identity functor when evaluated at the yoneda
embedding.
-/
def restricted_yoneda_yoneda {C : Type u₁} [small_category C] : restricted_yoneda yoneda ≅ 𝟭 :=
  nat_iso.of_components
    (fun (P : Cᵒᵖ ⥤ Type u₁) =>
      nat_iso.of_components (fun (X : Cᵒᵖ) => yoneda_sections_small (opposite.unop X) P) sorry)
    sorry

/--
(Implementation). The equivalence of homsets which helps construct the left adjoint to
`colimit_adj.restricted_yoneda`.
It is shown in `restrict_yoneda_hom_equiv_natural` that this is a natural bijection.
-/
def restrict_yoneda_hom_equiv {C : Type u₁} [small_category C] {ℰ : Type u₂} [category ℰ]
    (A : C ⥤ ℰ) (P : Cᵒᵖ ⥤ Type u₁) (E : ℰ)
    {c : limits.cocone (functor.left_op (category_of_elements.π P) ⋙ A)} (t : limits.is_colimit c) :
    (limits.cocone.X c ⟶ E) ≃ (P ⟶ functor.obj (restricted_yoneda A) E) :=
  equiv.trans (iso.to_equiv (limits.is_colimit.hom_iso' t E))
    (equiv.mk
      (fun
        (k :
        Subtype
          fun
            (p :
            (j : functor.elements Pᵒᵖ) →
              functor.obj (functor.left_op (category_of_elements.π P) ⋙ A) j ⟶ E) =>
            ∀ {j j' : functor.elements Pᵒᵖ} (f : j ⟶ j'),
              functor.map (functor.left_op (category_of_elements.π P) ⋙ A) f ≫ p j' = p j) =>
        nat_trans.mk
          fun (c : Cᵒᵖ) (p : functor.obj P c) => subtype.val k (opposite.op (sigma.mk c p)))
      (fun (τ : P ⟶ functor.obj (restricted_yoneda A) E) =>
        { val :=
            fun (p : functor.elements Pᵒᵖ) =>
              nat_trans.app τ (sigma.fst (opposite.unop p)) (sigma.snd (opposite.unop p)),
          property := sorry })
      sorry sorry)

/--
(Implementation). Show that the bijection in `restrict_yoneda_hom_equiv` is natural (on the right).
-/
theorem restrict_yoneda_hom_equiv_natural {C : Type u₁} [small_category C] {ℰ : Type u₂}
    [category ℰ] (A : C ⥤ ℰ) (P : Cᵒᵖ ⥤ Type u₁) (E₁ : ℰ) (E₂ : ℰ) (g : E₁ ⟶ E₂)
    {c : limits.cocone (functor.left_op (category_of_elements.π P) ⋙ A)} (t : limits.is_colimit c)
    (k : limits.cocone.X c ⟶ E₁) :
    coe_fn (restrict_yoneda_hom_equiv A P E₂ t) (k ≫ g) =
        coe_fn (restrict_yoneda_hom_equiv A P E₁ t) k ≫ functor.map (restricted_yoneda A) g :=
  sorry

/--
The left adjoint to the functor `restricted_yoneda` (shown in `yoneda_adjunction`). It is also an
extension of `A` along the yoneda embedding (shown in `is_extension_along_yoneda`), in particular
it is the left Kan extension of `A` through the yoneda embedding.
-/
def extend_along_yoneda {C : Type u₁} [small_category C] {ℰ : Type u₂} [category ℰ] (A : C ⥤ ℰ)
    [limits.has_colimits ℰ] : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ :=
  adjunction.left_adjoint_of_equiv
    (fun (P : Cᵒᵖ ⥤ Type u₁) (E : ℰ) =>
      restrict_yoneda_hom_equiv A P E
        (limits.colimit.is_colimit (functor.left_op (category_of_elements.π P) ⋙ A)))
    sorry

@[simp] theorem extend_along_yoneda_obj {C : Type u₁} [small_category C] {ℰ : Type u₂} [category ℰ]
    (A : C ⥤ ℰ) [limits.has_colimits ℰ] (P : Cᵒᵖ ⥤ Type u₁) :
    functor.obj (extend_along_yoneda A) P =
        limits.colimit (functor.left_op (category_of_elements.π P) ⋙ A) :=
  rfl

/--
Show `extend_along_yoneda` is left adjoint to `restricted_yoneda`.

The construction of [MM92], Chapter I, Section 5, Theorem 2.
-/
def yoneda_adjunction {C : Type u₁} [small_category C] {ℰ : Type u₂} [category ℰ] (A : C ⥤ ℰ)
    [limits.has_colimits ℰ] : extend_along_yoneda A ⊣ restricted_yoneda A :=
  adjunction.adjunction_of_equiv_left
    (fun (P : Cᵒᵖ ⥤ Type u₁) (E : ℰ) =>
      restrict_yoneda_hom_equiv A P E
        (limits.colimit.is_colimit (functor.left_op (category_of_elements.π P) ⋙ A)))
    (extend_along_yoneda._proof_4 A)

/--
The initial object in the category of elements for a representable functor. In `is_initial` it is
shown that this is initial.
-/
def elements.initial {C : Type u₁} [small_category C] (A : C) :
    functor.elements (functor.obj yoneda A) :=
  sigma.mk (opposite.op A) 𝟙

/--
Show that `elements.initial A` is initial in the category of elements for the `yoneda` functor.
-/
def is_initial {C : Type u₁} [small_category C] (A : C) : limits.is_initial (elements.initial A) :=
  limits.is_colimit.mk
    fun (s : limits.cocone (functor.empty (functor.elements (functor.obj yoneda A)))) =>
      { val := has_hom.hom.op (sigma.snd (limits.cocone.X s)), property := sorry }

/--
`extend_along_yoneda A` is an extension of `A` to the presheaf category along the yoneda embedding.
`unique_extension_along_yoneda` shows it is unique among functors preserving colimits with this
property (up to isomorphism).

The first part of [MM92], Chapter I, Section 5, Corollary 4.
See Property 1 of https://ncatlab.org/nlab/show/Yoneda+extension#properties.
-/
def is_extension_along_yoneda {C : Type u₁} [small_category C] {ℰ : Type u₂} [category ℰ]
    (A : C ⥤ ℰ) [limits.has_colimits ℰ] : yoneda ⋙ extend_along_yoneda A ≅ A :=
  nat_iso.of_components
    (fun (X : C) =>
      limits.is_colimit.cocone_point_unique_up_to_iso
        (limits.colimit.is_colimit
          (functor.left_op (category_of_elements.π (functor.obj yoneda X)) ⋙ A))
        (limits.colimit_of_diagram_terminal (limits.terminal_op_of_initial (is_initial X))
          (functor.left_op (category_of_elements.π (functor.obj yoneda X)) ⋙ A)))
    sorry

/-- See Property 2 of https://ncatlab.org/nlab/show/Yoneda+extension#properties. -/
protected instance extend_along_yoneda.category_theory.limits.preserves_colimits {C : Type u₁}
    [small_category C] {ℰ : Type u₂} [category ℰ] (A : C ⥤ ℰ) [limits.has_colimits ℰ] :
    limits.preserves_colimits (extend_along_yoneda A) :=
  adjunction.left_adjoint_preserves_colimits (yoneda_adjunction A)

end colimit_adj

/--
Since `extend_along_yoneda A` is adjoint to `restricted_yoneda A`, if we use `A = yoneda`
then `restricted_yoneda A` is isomorphic to the identity, and so `extend_along_yoneda A` is as well.
-/
def extend_along_yoneda_yoneda {C : Type u₁} [small_category C] :
    colimit_adj.extend_along_yoneda yoneda ≅ 𝟭 :=
  adjunction.nat_iso_of_right_adjoint_nat_iso (colimit_adj.yoneda_adjunction yoneda) adjunction.id
    colimit_adj.restricted_yoneda_yoneda

/--
A functor to the presheaf category in which everything in the image is representable (witnessed
by the fact that it factors through the yoneda embedding).
`cocone_of_representable` gives a cocone for this functor which is a colimit and has point `P`.
-/
-- Maybe this should be reducible or an abbreviation?

def functor_to_representables {C : Type u₁} [small_category C] (P : Cᵒᵖ ⥤ Type u₁) :
    functor.elements Pᵒᵖ ⥤ Cᵒᵖ ⥤ Type u₁ :=
  functor.left_op (category_of_elements.π P) ⋙ yoneda

/--
This is a cocone with point `P` for the functor `functor_to_representables P`. It is shown in
`colimit_of_representable P` that this cocone is a colimit: that is, we have exhibited an arbitrary
presheaf `P` as a colimit of representables.

The construction of [MM92], Chapter I, Section 5, Corollary 3.
-/
def cocone_of_representable {C : Type u₁} [small_category C] (P : Cᵒᵖ ⥤ Type u₁) :
    limits.cocone (functor_to_representables P) :=
  limits.cocone.extend (limits.colimit.cocone (functor_to_representables P))
    (nat_trans.app (iso.hom extend_along_yoneda_yoneda) P)

@[simp] theorem cocone_of_representable_X {C : Type u₁} [small_category C] (P : Cᵒᵖ ⥤ Type u₁) :
    limits.cocone.X (cocone_of_representable P) = P :=
  rfl

/-- An explicit formula for the legs of the cocone `cocone_of_representable`. -/
-- Marking this as a simp lemma seems to make things more awkward.

theorem cocone_of_representable_ι_app {C : Type u₁} [small_category C] (P : Cᵒᵖ ⥤ Type u₁)
    (j : functor.elements Pᵒᵖ) :
    nat_trans.app (limits.cocone.ι (cocone_of_representable P)) j =
        iso.inv
          (yoneda_sections_small (functor.obj (functor.left_op (category_of_elements.π P)) j)
            (functor.obj
              (functor.obj (functor.const (functor.elements Pᵒᵖ))
                (limits.cocone.X (cocone_of_representable P)))
              j))
          (sigma.snd (opposite.unop j)) :=
  sorry

/-- The legs of the cocone `cocone_of_representable` are natural in the choice of presheaf. -/
theorem cocone_of_representable_naturality {C : Type u₁} [small_category C] {P₁ : Cᵒᵖ ⥤ Type u₁}
    {P₂ : Cᵒᵖ ⥤ Type u₁} (α : P₁ ⟶ P₂) (j : functor.elements P₁ᵒᵖ) :
    nat_trans.app (limits.cocone.ι (cocone_of_representable P₁)) j ≫ α =
        nat_trans.app (limits.cocone.ι (cocone_of_representable P₂))
          (functor.obj (functor.op (category_of_elements.map α)) j) :=
  sorry

/--
The cocone with point `P` given by `the_cocone` is a colimit: that is, we have exhibited an
arbitrary presheaf `P` as a colimit of representables.

The result of [MM92], Chapter I, Section 5, Corollary 3.
-/
def colimit_of_representable {C : Type u₁} [small_category C] (P : Cᵒᵖ ⥤ Type u₁) :
    limits.is_colimit (cocone_of_representable P) :=
  limits.is_colimit.of_point_iso (limits.colimit.is_colimit (functor_to_representables P))

/--
Given two functors L₁ and L₂ which preserve colimits, if they agree when restricted to the
representable presheaves then they agree everywhere.
-/
def nat_iso_of_nat_iso_on_representables {C : Type u₁} [small_category C] {ℰ : Type u₂} [category ℰ]
    (L₁ : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) (L₂ : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) [limits.preserves_colimits L₁]
    [limits.preserves_colimits L₂] (h : yoneda ⋙ L₁ ≅ yoneda ⋙ L₂) : L₁ ≅ L₂ :=
  nat_iso.of_components
    (fun (P : Cᵒᵖ ⥤ Type u₁) =>
      limits.is_colimit.cocone_points_iso_of_nat_iso
        (limits.is_colimit_of_preserves L₁ (colimit_of_representable P))
        (limits.is_colimit_of_preserves L₂ (colimit_of_representable P))
        (functor.associator (functor.left_op (category_of_elements.π P)) yoneda L₁ ≪≫
          iso_whisker_left (functor.left_op (category_of_elements.π P)) h))
    sorry

/--
Show that `extend_along_yoneda` is the unique colimit-preserving functor which extends `A` to
the presheaf category.

The second part of [MM92], Chapter I, Section 5, Corollary 4.
See Property 3 of https://ncatlab.org/nlab/show/Yoneda+extension#properties.
-/
def unique_extension_along_yoneda {C : Type u₁} [small_category C] {ℰ : Type u₂} [category ℰ]
    (A : C ⥤ ℰ) [limits.has_colimits ℰ] (L : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) (hL : yoneda ⋙ L ≅ A)
    [limits.preserves_colimits L] : L ≅ colimit_adj.extend_along_yoneda A :=
  nat_iso_of_nat_iso_on_representables L (colimit_adj.extend_along_yoneda A)
    (hL ≪≫ iso.symm (colimit_adj.is_extension_along_yoneda A))

/--
If `L` preserves colimits and `ℰ` has them, then it is a left adjoint. This is a special case of
`is_left_adjoint_of_preserves_colimits` used to prove that.
-/
def is_left_adjoint_of_preserves_colimits_aux {C : Type u₁} [small_category C] {ℰ : Type u₂}
    [category ℰ] [limits.has_colimits ℰ] (L : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) [limits.preserves_colimits L] :
    is_left_adjoint L :=
  is_left_adjoint.mk (colimit_adj.restricted_yoneda (yoneda ⋙ L))
    (adjunction.of_nat_iso_left (colimit_adj.yoneda_adjunction (yoneda ⋙ L))
      (iso.symm (unique_extension_along_yoneda (yoneda ⋙ L) L (iso.refl (yoneda ⋙ L)))))

/--
If `L` preserves colimits and `ℰ` has them, then it is a left adjoint. Note this is a (partial)
converse to `left_adjoint_preserves_colimits`.
-/
def is_left_adjoint_of_preserves_colimits {C : Type u₁} [small_category C] {ℰ : Type u₂}
    [category ℰ] [limits.has_colimits ℰ] (L : (C ⥤ Type u₁) ⥤ ℰ) [limits.preserves_colimits L] :
    is_left_adjoint L :=
  let e : Cᵒᵖᵒᵖ ⥤ Type u₁ ≌ C ⥤ Type u₁ := equivalence.congr_left (op_op_equivalence C);
  let t : is_left_adjoint (equivalence.functor e ⋙ L) :=
    is_left_adjoint_of_preserves_colimits_aux (equivalence.functor e ⋙ L);
  adjunction.left_adjoint_of_nat_iso (equivalence.inv_fun_id_assoc e L)

end Mathlib


import tactic
import tactic.induction

import .base .game

noncomputable theory
open_locale classical

lemma induct_s_at {P : State → Prop} {pw n : ℕ} {g : Game pw}
  (h₁ : P g.s)
  (h₂ : ∀ {s : State} {ma},
  P s → A_move_valid pw s.board ma → P (apply_A_move s ma))
  (h₃ : ∀ {s : State} {md}, P s → D_move_valid s.board md → P (apply_D_move s md))
  (hf : ∀ {s : State}, P s → P s.finish) :
  P (g.play n).s :=
begin
  induction n with n ih,
  { assumption },
  { rw [play_at_succ'], let g₁ := _, change g.play n with g₁ at ih ⊢,
    rw Game.play_move, split_ifs with h₄, swap, { assumption },
    let a := g₁.a, let d := g₁.d,
    have h₅ : ∃ (s' : State), play_D_move_at g₁ h₄ = init_game a d s' ∧ P s',
    { let s' := apply_D_move g₁.s (d.f g₁.s h₄).m, use s',
      exact ⟨rfl, h₃ ih (d.f _ _).h⟩ },
    rcases h₅ with ⟨s', h₅, h₆⟩, rw h₅, clear h₅,
    rw play_A_move_at, split_ifs with h₅,
    { exact h₂ h₆ (a.f s' _ _).h },
    { exact hf h₆ }},
end

lemma induct_s {P : State → Prop} {pw : ℕ} {a : A pw} {d : D}
  (h₁ : P state₀)
  (h₂ : ∀ {s : State} {ma},
  P s → A_move_valid pw s.board ma → P (apply_A_move s ma))
  (h₃ : ∀ {s : State} {md}, P s → D_move_valid s.board md → P (apply_D_move s md))
  (hf : ∀ {s : State}, P s → P s.finish) :
  all_s a d P :=
by { intro n, apply induct_s_at; assumption }

lemma induct_b {P : Board → Prop} {pw : ℕ} {a : A pw} {d : D}
  (h₁ : P board₀)
  (h₂ : ∀ {b : Board} {ma}, P b → A_move_valid pw b ma → P (apply_A_move_b b ma))
  (h₃ : ∀ {b : Board} {md}, P b → D_move_valid b md → P (apply_D_move_b b md)) :
  all_b a d P :=
begin
  apply induct_s,
  { exact h₁ },
  { rintro s ma h₄ h₅, exact h₂ h₄ h₅ },
  { rintro s ma h₄ h₅, exact h₃ h₄ h₅ },
  { intro s, exact id },
end

lemma simulate_add {pw : ℕ} {a : A pw} {d : D} {n₁ n₂ : ℕ} :
  simulate a d (n₁ + n₂) = (simulate a d n₁).play n₂ :=
by { rw add_comm, apply function.iterate_add_apply }

lemma not_play_act_of_not_act {pw n : ℕ} {g : Game pw}
  (h : ¬g.act) : ¬(g.play n).act :=
by { apply @induct_s_at (λ s, ¬s.act); intros; assumption <|> exact not_false }

lemma act_of_act_play {pw n : ℕ} {g : Game pw}
  (h : (g.play n).act) : g.act :=
by { contrapose h, exact not_play_act_of_not_act h }

lemma play_eq_iff_states_eq {pw n : ℕ} {g : Game pw}
  (h : (g.play n).s = g.s) : g.play n = g :=
begin
  ext,
  { exact play_at_players_eq.1 },
  { exact play_at_players_eq.2 },
  { exact h },
end

lemma play_eq_of_not_act' {pw n : ℕ} {g : Game pw}
  (h : ¬g.act) : g.play n = g :=
begin
  rw play_eq_iff_states_eq, induction n with n ih,
  { refl },
  { rw play_at_succ',
    let g₁ : Game pw := _, change g.play n with g₁ at ih ⊢, have h₁ : ¬g₁.act,
    { change ¬g₁.s.act, rwa ih },
    rwa play_move_at_not_act h₁ },
end

lemma simulate_eq_of_not_act {pw n₁ n₂ : ℕ} {a : A pw} {d : D}
  (h₁ : ¬(simulate a d n₁).act)
  (h₂ : ¬(simulate a d n₂).act) :
  simulate a d n₁ = simulate a d n₂ :=
begin
  wlog h₃ : n₂ ≤ n₁,
  obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le h₃,
  rw simulate_add at h₁ ⊢,
  let g : Game pw := _, change simulate a d n₂ with g at h₁ h₂ ⊢,
  exact play_eq_of_not_act' h₂,
end

lemma play_move_len_le {pw : ℕ} {g : Game pw} :
  g.play_move.s.len ≤ g.s.len + 2 :=
begin
  rw Game.play_move, split_ifs,
  { have h₁ : (play_D_move_at g h).s.len = g.s.len + 1,
    { rw hist_len_play_D_move_at },
    rw play_A_move_at, split_ifs with h₂,
    { rw [hist_len_play_A_move_at', h₁] },
    { change (play_D_move_at g h).s.finish.len ≤ _, rw [hist_len_finish, h₁],
      apply add_le_add_left, dec_trivial }},
  { exact le_add_right (le_refl _) },
end

lemma play_len_le {pw n : ℕ} {g : Game pw} :
  (g.play n).s.len ≤ g.s.len + n * 2 :=
begin
  induction n with n ih,
  { refl },
  { rw play_at_succ', let g₁ : Game pw := _, change g.play n with g₁ at ih ⊢,
    transitivity, exact play_move_len_le, rw [nat.succ_mul, ←add_assoc],
    apply add_le_add_right ih },
end

lemma simulate_len_le {pw n : ℕ} {a : A pw} {d : D} :
  (simulate a d n).s.len ≤ n * 2 :=
begin
  change ((simulate a d 0).play n).s.len ≤ n * 2 + (simulate a d 0).s.len,
  rw add_comm (n * 2), exact play_len_le,
end

lemma exi_A_wins_of_invariant {P : State → Prop} {pw : ℕ} {d : D} {s₀ : State}
  (h₀ : P s₀)
  (hP : ∀ (s : State), P s → s.act)
  (hm : ∀ (s s' : State) hs, P s → s' = apply_D_move s (d.f s hs).m →
    ∃ (ma : Valid_A_move pw s'.board), P (apply_A_move s' ma.m)) :
  ∃ (a : A pw), (init_game a d s₀).A_wins :=
begin
  let a : A pw,
  { refine ⟨λ s' hs' hvm, _⟩, refine (_ : ∃ (ma : Valid_A_move pw s'.board),
      ∀ (s : State) hs, P s → s' = apply_D_move s (d.f s hs).m →
      P (apply_A_move s' ma.m)).some,
    by_cases h₁ : ∃ (s : State) hs, P s ∧ s' = apply_D_move s (d.f s hs).m,
    { rcases h₁ with ⟨s, hs, h₁, h₂⟩, specialize hm s s' hs h₁ h₂,
      cases hm with ma hm, use ma, intros, assumption },
    { refine ⟨⟨_, hvm.some_spec⟩, _⟩, rintro s₁ hs₁ h₂ h₃, push_neg at h₁,
      specialize h₁ s₁ hs₁, push_neg at h₁, specialize h₁ h₂, contradiction }},
  use a, rintro n, apply hP, induction n with n ih,
  { assumption },
  { rw play_at_succ', let g : Game pw := _,
    change (init_game a d s₀).play n with g at ih ⊢,
    have hs := hP _ ih, rw play_move_at_act hs, let s := g.s,
    let s' := apply_D_move s (d.f s hs).m,
    have h₁ : play_D_move_at g hs = init_game a d s',
    { ext,
      { exact play_at_players_eq.1 },
      { exact play_at_players_eq.2 },
      { change apply_D_move _ _ = apply_D_move _ _, congr,
        exact play_at_players_eq.2 }},
    rw h₁, clear h₁, have hvm : A_has_valid_move pw s'.board,
    { specialize hm s s' hs ih rfl, cases hm with ma hma, exact ⟨_, ma.h⟩ },
    rw [play_A_move_at, dif_pos], swap, { split; assumption },
    change P (apply_A_move s' (a.f s' hs hvm).m),
    generalize hma : a.f s' hs hvm = ma,
    change Exists.some _ = _ at hma, generalize_proofs h₁ at hma,
    have h₂ := h₁.some_spec s hs ih rfl, subst hma, assumption },
end

lemma play_eq_of_not_act {pw n k : ℕ} {a : A pw} {d : D} {s : State}
  (h₁ : ¬((init_game a d s).play n).act)
  (h₂ : ¬((init_game a d s).play k).act) :
  (init_game a d s).play n = (init_game a d s).play k :=
begin
  wlog h₃ : k ≤ n, obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h₃,
  rw play_add, exact play_eq_of_not_act' h₂,
end

lemma not_act_of_descend (f : State → ℕ) (P : State → Prop)
  {pw n : ℕ} {a : A pw} {d : D} {s₀ : State}
  (hp₀ : f s₀ < n)
  (hp₁ : P s₀)
  (hp₂ : ∀ (s s' : State) hs hs' hvm, P s → s' = apply_D_move s (d.f s hs).m →
    P (apply_A_move s' (a.f s' hs' hvm).m))
  (hp₃ : ∀ (s s' : State) hs hs' hvm, P s → s' = apply_D_move s (d.f s hs).m →
    f (apply_A_move s' (a.f s' hs' hvm).m) < f s) :
  ¬((init_game a d s₀).play n).act :=
begin
  have h₀ : ∀ (n : ℕ) (s : State), s = ((init_game a d s₀).play n).s →
    s.act → P s,
  { clear' hp₀ n, rintro n _ rfl hs₁,
    rw ←Game.act at hs₁, induction n with n ih,
    { exact hp₁ },
    { rw play_at_succ' at hs₁ ⊢, let g : Game pw := _,
      change (init_game a d s₀).play n with g at ih hs₁ ⊢,
      obtain ⟨s', hs, hs', hvm, h₁, h₂⟩ :=
        play_move_state_eq_of_act_play_move hs₁, rw h₂,
      have ha : g.a = a := play_at_players_eq.1, rw ha at *, clear ha,
      have hd : g.d = d := play_at_players_eq.2, rw hd at *, clear hd,
      apply hp₂,
      { exact ih hs },
      { exact h₁ }}},
  suffices h : ∀ (n : ℕ) (s : State), s = ((init_game a d s₀).play n).s →
    s.act → f s + n ≤ f s₀,
  { apply mt (h n _ rfl), push_neg, apply nat.lt_add_left, exact hp₀ },
  clear' n hp₀, rintro n _ rfl hs₁, induction n with n ih,
  { refl },
  { rw play_at_succ' at hs₁ ⊢, let g : Game pw := _,
    change (init_game a d s₀).play n with g at ih hs₁ ⊢,
    obtain ⟨s', hs, hs', hvm, h₁, h₂⟩ :=
      play_move_state_eq_of_act_play_move hs₁, rw h₂,
    have ha : g.a = a := play_at_players_eq.1, rw ha at *, clear ha,
    have hd : g.d = d := play_at_players_eq.2, rw hd at *, clear hd,
    specialize ih hs,
    have h : f (apply_A_move s' (a.f s' hs' hvm).m) < f g.s,
    { apply hp₃,
      { apply h₀,
        { refl },
        { exact hs } },
      { exact h₁ }},
    replace h : f (apply_A_move s' (a.f s' hs' hvm).m) + n < f g.s + n,
    { exact add_lt_add_right h n },
    rw ←nat.succ_le_iff at h, rw nat.add_succ, exact h.trans ih },
end

lemma not_act_of_descend_single_moves (f : State → ℕ) (P : State → Prop)
  {pw n : ℕ} {a : A pw} {d : D} {s₀ : State}
  (hp₀ : f s₀ < n)
  (hp₁ : P s₀)
  (hp₂ : ∀ (s : State) hs hvm, P s → P (apply_A_move s (a.f s hs hvm).m))
  (hp₃ : ∀ (s : State) hs, P s → P (apply_D_move s (d.f s hs).m))
  (hp₄ : ∀ (s : State) hs hvm, P s → f (apply_A_move s (a.f s hs hvm).m) ≤ f s)
  (hp₅ : ∀ (s : State) hs, P s → f (apply_D_move s (d.f s hs).m) < f s) :
  ¬((init_game a d s₀).play n).act :=
begin
  apply not_act_of_descend f P hp₀ hp₁,
  { rintro s s' hs hs' hvm h₁ rfl, apply hp₂, apply hp₃, exact h₁ },
  { rintro s s' hs hs' hvm h₁ h₂, let s₁ : State := _, change f s₁ < _,
    have h₃ : f s' < f s,
    { subst s', apply hp₅, exact h₁ },
    have h₄ : f s₁ ≤ f s',
    { subst s', apply hp₄, apply hp₃, exact h₁ },
    exact gt_of_gt_of_ge h₃ h₄ },
end

lemma not_act_of_descend_play_move' (f : State → ℕ) (P : State → Prop)
  {pw n : ℕ} {a : A pw} {d : D} {s₀ : State}
  (hp₀ : f s₀ < n)
  (hp₁ : P s₀)
  (hp₂ : ∀ (g : Game pw), g.play_move.act → P g.s → P g.play_move.s)
  (hp₃ : ∀ (g : Game pw), g.play_move.act → P g.s → f g.play_move.s < f g.s) :
  ¬((init_game a d s₀).play n).act :=
begin
  have h : ∀ (Q : State → State → Prop),
    (∀ (g : Game pw), g.play_move.act → P g.s → Q g.s g.play_move.s) →
    ∀ (s s' : State) hs hs' hvm, P s → s' = apply_D_move s (d.f s hs).m →
    Q s (apply_A_move s' (a.f s' hs' hvm).m),
  { rintro Q hQ, rintro s s' hs hs' hvm h₁ h₂,
    have hs₁ : (init_game a d s).play_move.act,
    { subst s', exact act_play_move_of_A_hvm hvm },
    specialize hQ (init_game a d s) hs₁ h₁,
    obtain ⟨s', hs, hs', hvm, h₃, h₄⟩ := play_move_state_eq_of_act_play_move hs₁,
    rw h₄ at hQ, subst_vars, exact hQ },
  apply not_act_of_descend f P hp₀ hp₁,
  { exact h (λ (s₁ s₂ : State), P s₂) hp₂ },
  { exact h (λ (s₁ s₂ : State), f s₂ < f s₁) hp₃ },
end

lemma not_act_of_descend_play_move (f : State → ℕ) (P : State → Prop)
  {pw n : ℕ} {a : A pw} {d : D} {s₀ : State}
  (hp₀ : f s₀ < n)
  (hp₁ : P s₀)
  (hp₂ : ∀ (s : State), (init_game a d s).play_move.act → P s →
    P (init_game a d s).play_move.s)
  (hp₃ : ∀ (s : State), (init_game a d s).play_move.act → P s →
    f (init_game a d s).play_move.s < f s) :
  ¬((init_game a d s₀).play n).act :=
begin
  have h : ∀ (Q : State → State → Prop),
    (∀ (s : State), (init_game a d s).play_move.act → P s →
      Q s (init_game a d s).play_move.s) →
    ∀ (s s' : State) hs hs' hvm, P s → s' = apply_D_move s (d.f s hs).m →
    Q s (apply_A_move s' (a.f s' hs' hvm).m),
  { rintro Q hQ, rintro s s' hs hs' hvm h₁ h₂,
    have hs₁ : (init_game a d s).play_move.act,
    { subst s', exact act_play_move_of_A_hvm hvm },
    specialize hQ s hs₁ h₁,
    obtain ⟨s', hs, hs', hvm, h₃, h₄⟩ := play_move_state_eq_of_act_play_move hs₁,
    rw h₄ at hQ, subst_vars, exact hQ },
  apply not_act_of_descend f P hp₀ hp₁,
  { exact h (λ (s₁ s₂ : State), P s₂) hp₂ },
  { exact h (λ (s₁ s₂ : State), f s₂ < f s₁) hp₃ },
end

lemma not_act_of_descend_play_move_valid (f : State → ℕ) (P : State → Prop)
  {pw n : ℕ} {a : A pw} {d : D} {s₀ : State}
  (h₀ : valid_state pw s₀)
  (hp₀ : f s₀ < n)
  (hp₁ : P s₀)
  (hp₂ : ∀ (s : State), valid_state pw s →
    (init_game a d s).play_move.act → P s →
    P (init_game a d s).play_move.s)
  (hp₃ : ∀ (s : State), valid_state pw s →
    (init_game a d s).play_move.act → P s →
    f (init_game a d s).play_move.s < f s) :
  ¬((init_game a d s₀).play n).act :=
begin
  have h : ∀ (Q : State → State → Prop),
    (∀ (s : State), valid_state pw s →
      (init_game a d s).play_move.act → P s →
      Q s (init_game a d s).play_move.s) →
    ∀ (s s' : State) hs hs' hvm, valid_state pw s →
      P s → s' = apply_D_move s (d.f s hs).m →
    Q s (apply_A_move s' (a.f s' hs' hvm).m),
  { rintro Q hQ, rintro s s' hs hs' hvm hh₀ h₁ h₂,
    have hs₁ : (init_game a d s).play_move.act,
    { subst s', exact act_play_move_of_A_hvm hvm },
    specialize hQ s hh₀ hs₁ h₁,
    obtain ⟨s', hs, hs', hvm, h₃, h₄⟩ := play_move_state_eq_of_act_play_move hs₁,
    rw h₄ at hQ, subst_vars, exact hQ },
  apply not_act_of_descend f (λ s, valid_state pw s ∧ P s) hp₀ ⟨h₀, hp₁⟩,
  {
    convert h (λ (s₁ s₂ : State), P s₂) _,
    {
      ext,
      split; intro h₁,
      {
        rintro s s' hs hs' hvm hh hp hr,
        exact (h₁ s s' hs hs' hvm ⟨hh, hp⟩ hr).2,
      },
      {
        rintro s s' hs hs' hvm hh hp,
        fsplit,
        {
          -- apply valid_state_apply_A_move,
          sorry
        },
        {
          exact h₁ s s' hs hs' hvm hh.1 hh.2 hp,
        },
      },
    },
    sorry
  },
  {
    -- apply h (λ (s₁ s₂ : State), f s₂ < f s₁),
    sorry
  },
end

lemma A_mem_squares_of_valid_state {pw : ℕ} {s : State}
  (h : valid_state pw s) :
  s.board.A ∈ s.board.squares :=
begin
  rcases h with ⟨a, d, n, rfl⟩,
  apply @induct_s (λ (s : State), s.board.A ∈ s.board.squares),
  { triv },
  { rintro s p h₁ h, exact h.2.2 },
  { rintro s ⟨- | p⟩ h₁ h,
    { exact h₁ },
    { simp_rw [apply_D_move, apply_D_move_b, apply_move, set.mem_diff],
      exact ⟨h₁, h.1.symm⟩ }},
  { rintro s h, exact h },
end


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro

Denumerable (countably infinite) types, as a typeclass extending
encodable. This is used to provide explicit encode/decode functions
from nat, where the functions are known inverses of each other.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.encodable.basic
import Mathlib.data.sigma.default
import Mathlib.data.fintype.basic
import Mathlib.data.list.min_max
import Mathlib.PostPort

universes u_1 l u_2 u_3

namespace Mathlib

/-- A denumerable type is one which is (constructively) bijective with ℕ.
  Although we already have a name for this property, namely `α ≃ ℕ`,
  we are here interested in using it as a typeclass. -/
class denumerable (α : Type u_1) extends encodable α where
  decode_inv : ∀ (n : ℕ), ∃ (a : α), ∃ (H : a ∈ encodable.decode α n), encodable.encode a = n

namespace denumerable

theorem decode_is_some (α : Type u_1) [denumerable α] (n : ℕ) :
    ↥(option.is_some (encodable.decode α n)) :=
  iff.mpr option.is_some_iff_exists (Exists.imp (fun (a : α) => Exists.fst) (decode_inv n))

def of_nat (α : Type u_1) [f : denumerable α] (n : ℕ) : α := option.get (decode_is_some α n)

@[simp] theorem decode_eq_of_nat (α : Type u_1) [denumerable α] (n : ℕ) :
    encodable.decode α n = some (of_nat α n) :=
  option.eq_some_of_is_some (decode_is_some α n)

@[simp] theorem of_nat_of_decode {α : Type u_1} [denumerable α] {n : ℕ} {b : α}
    (h : encodable.decode α n = some b) : of_nat α n = b :=
  option.some.inj (Eq.trans (Eq.symm (decode_eq_of_nat α n)) h)

@[simp] theorem encode_of_nat {α : Type u_1} [denumerable α] (n : ℕ) :
    encodable.encode (of_nat α n) = n :=
  sorry

@[simp] theorem of_nat_encode {α : Type u_1} [denumerable α] (a : α) :
    of_nat α (encodable.encode a) = a :=
  of_nat_of_decode (encodable.encodek a)

def eqv (α : Type u_1) [denumerable α] : α ≃ ℕ :=
  equiv.mk encodable.encode (of_nat α) of_nat_encode encode_of_nat

def mk' {α : Type u_1} (e : α ≃ ℕ) : denumerable α := mk sorry

def of_equiv (α : Type u_1) {β : Type u_2} [denumerable α] (e : β ≃ α) : denumerable β := mk sorry

@[simp] theorem of_equiv_of_nat (α : Type u_1) {β : Type u_2} [denumerable α] (e : β ≃ α) (n : ℕ) :
    of_nat β n = coe_fn (equiv.symm e) (of_nat α n) :=
  sorry

def equiv₂ (α : Type u_1) (β : Type u_2) [denumerable α] [denumerable β] : α ≃ β :=
  equiv.trans (eqv α) (equiv.symm (eqv β))

protected instance nat : denumerable ℕ := mk sorry

@[simp] theorem of_nat_nat (n : ℕ) : of_nat ℕ n = n := rfl

protected instance option {α : Type u_1} [denumerable α] : denumerable (Option α) := mk sorry

protected instance sum {α : Type u_1} {β : Type u_2} [denumerable α] [denumerable β] :
    denumerable (α ⊕ β) :=
  mk sorry

protected instance sigma {α : Type u_1} [denumerable α] {γ : α → Type u_3}
    [(a : α) → denumerable (γ a)] : denumerable (sigma γ) :=
  mk sorry

@[simp] theorem sigma_of_nat_val {α : Type u_1} [denumerable α] {γ : α → Type u_3}
    [(a : α) → denumerable (γ a)] (n : ℕ) :
    of_nat (sigma γ) n =
        sigma.mk (of_nat α (prod.fst (nat.unpair n)))
          (of_nat (γ (of_nat α (prod.fst (nat.unpair n)))) (prod.snd (nat.unpair n))) :=
  sorry

protected instance prod {α : Type u_1} {β : Type u_2} [denumerable α] [denumerable β] :
    denumerable (α × β) :=
  of_equiv (sigma fun (_x : α) => β) (equiv.symm (equiv.sigma_equiv_prod α β))

@[simp] theorem prod_of_nat_val {α : Type u_1} {β : Type u_2} [denumerable α] [denumerable β]
    (n : ℕ) :
    of_nat (α × β) n = (of_nat α (prod.fst (nat.unpair n)), of_nat β (prod.snd (nat.unpair n))) :=
  sorry

@[simp] theorem prod_nat_of_nat : of_nat (ℕ × ℕ) = nat.unpair := sorry

protected instance int : denumerable ℤ := mk' equiv.int_equiv_nat

protected instance pnat : denumerable ℕ+ := mk' equiv.pnat_equiv_nat

protected instance ulift {α : Type u_1} [denumerable α] : denumerable (ulift α) :=
  of_equiv α equiv.ulift

protected instance plift {α : Type u_1} [denumerable α] : denumerable (plift α) :=
  of_equiv α equiv.plift

def pair {α : Type u_1} [denumerable α] : α × α ≃ α := equiv₂ (α × α) α

end denumerable

namespace nat.subtype

theorem exists_succ {s : set ℕ} [infinite ↥s] (x : ↥s) : ∃ (n : ℕ), subtype.val x + n + 1 ∈ s :=
  sorry

def succ {s : set ℕ} [infinite ↥s] [decidable_pred s] (x : ↥s) : ↥s :=
  (fun (h : ∃ (m : ℕ), subtype.val x + m + 1 ∈ s) =>
      { val := subtype.val x + nat.find h + 1, property := sorry })
    (exists_succ x)

theorem succ_le_of_lt {s : set ℕ} [infinite ↥s] [decidable_pred s] {x : ↥s} {y : ↥s} (h : y < x) :
    succ y ≤ x :=
  sorry

theorem le_succ_of_forall_lt_le {s : set ℕ} [infinite ↥s] [decidable_pred s] {x : ↥s} {y : ↥s}
    (h : ∀ (z : ↥s), z < x → z ≤ y) : x ≤ succ y :=
  sorry

theorem lt_succ_self {s : set ℕ} [infinite ↥s] [decidable_pred s] (x : ↥s) : x < succ x :=
  lt_of_le_of_lt (le_add_right (le_refl (subtype.val x)))
    (lt_succ_self (subtype.val x + nat.find (exists_succ x)))

theorem lt_succ_iff_le {s : set ℕ} [infinite ↥s] [decidable_pred s] {x : ↥s} {y : ↥s} :
    x < succ y ↔ x ≤ y :=
  { mp :=
      fun (h : x < succ y) => le_of_not_gt fun (h' : x > y) => not_le_of_gt h (succ_le_of_lt h'),
    mpr := fun (h : x ≤ y) => lt_of_le_of_lt h (lt_succ_self y) }

def of_nat (s : set ℕ) [decidable_pred s] [infinite ↥s] : ℕ → ↥s := sorry

theorem of_nat_surjective_aux {s : set ℕ} [infinite ↥s] [decidable_pred s] {x : ℕ} (hx : x ∈ s) :
    ∃ (n : ℕ), of_nat s n = { val := x, property := hx } :=
  sorry

theorem of_nat_surjective {s : set ℕ} [infinite ↥s] [decidable_pred s] :
    function.surjective (of_nat s) :=
  sorry

def denumerable (s : set ℕ) [decidable_pred s] [infinite ↥s] : denumerable ↥s :=
  denumerable.of_equiv ℕ (equiv.mk to_fun_aux (of_nat s) sorry sorry)

end nat.subtype

namespace denumerable

def of_encodable_of_infinite (α : Type u_1) [encodable α] [infinite α] : denumerable α :=
  let _inst : decidable_pred (set.range encodable.encode) := encodable.decidable_range_encode α;
  let _inst_3 : infinite ↥(set.range encodable.encode) := sorry;
  let _inst_4 : denumerable ↥(set.range encodable.encode) :=
    nat.subtype.denumerable (set.range encodable.encode);
  of_equiv (↥(set.range encodable.encode)) (encodable.equiv_range_encode α)

end Mathlib


import tactic
import data.set.finite
import data.real.basic
import data.real.ereal
import linear_algebra.affine_space.independent
import analysis.convex.basic
import topology.sequences

noncomputable theory
open set affine topological_space
open_locale affine filter big_operators

variables  {V : Type*} [add_comm_group V] [module ℝ V]
variables [affine_space V V]

variables {k n : ℕ}

variables (Δ : simplex ℝ V n)

def pts (C : simplex ℝ V k) : set V := convex_hull (C.points '' univ)

structure triangulation :=
(simps : set (@simplex ℝ V V _ _ _ _ n) )
(cov : (⋃ s ∈ simps, (pts s)) = pts Δ)
--(inter : ∀ s t ∈ simps, (pts s) ∩ (pts t) ≠ ∅ → ∃ (m : ℕ) (st m),
--  (pts s) ∩ (pts t) = pts st)
-- exercici: escriure la condició d'intersecció fent servir "face".

lemma fixed_point_of_epsilon_fixed (X : Type) [metric_space X]
  [hsq : seq_compact_space X]
  (f : X → X) (hf : continuous f)
  (h : ∀ (ε : ℝ), 0 < ε → ∃ x, dist x (f x) < ε) :
  ∃ x : X, f x = x :=
begin
  have hpos : ∀ (n : ℕ), 0 < 1 / ((n+1) : ℝ), by apply nat.one_div_pos_of_nat,
  let a : ℕ → X := λ n, classical.some (h (1 / ((n+1) : ℝ)) (hpos n)),
  have ha : ∀ n, dist (a n) (f (a n)) < 1 / ((n+1) : ℝ) :=
    λ n, classical.some_spec (h (1 / ((n+1) : ℝ)) (hpos n)),
  have exists_lim : ∃ (z ∈ univ) (Φ : ℕ → ℕ),
    strict_mono Φ ∧ filter.tendsto (a ∘ Φ) filter.at_top (nhds z),
  { apply hsq.seq_compact_univ,
    exact λ n, by trivial },
  obtain ⟨z, ⟨_, ⟨Φ, ⟨hΦ1, hΦ2⟩⟩⟩ ⟩ := exists_lim,
  use z,
  suffices : ∀ ε > 0, dist z (f z) ≤ ε,
  {
    rw [←dist_le_zero, dist_comm],
    exact le_of_forall_le_of_dense this,
  },
  intros ε hε,
  have H1 : ∀ δ, 0 < δ →  ∃ (n : ℕ), ∀ m ≥ n, dist z ((a ∘ Φ) m) < δ,
  {
    intros δ hδ,
    rw seq_tendsto_iff at hΦ2,
    specialize hΦ2 (metric.ball z (δ)) (by rwa [metric.mem_ball, dist_self]) (metric.is_open_ball),
    simp only [metric.mem_ball, dist_comm] at hΦ2,
    exact hΦ2,
  },
  have H2 : ∃ (n : ℕ), ∀ m ≥ n, dist ((a∘Φ) m) (f ((a∘Φ) m)) ≤ ε/3,
  {
    have hkey : ∃ (n : ℕ), 1 / ((n+1):ℝ) < ε/3,
    { have hnlarge : ∃ (n : ℕ), (n :ℝ) > 3 / ε := exists_nat_gt (3 / ε),
      obtain ⟨n, hn⟩:= hnlarge,
      use n,
      refine (inv_lt_inv _ (hpos n)).mp _, by linarith,
      field_simp,
      linarith },
    obtain ⟨n, hn⟩ := hkey,
    use n,
    intros m hm,
    specialize ha (Φ m),
    have hmn : 1 / ((m + 1) : ℝ) ≤ 1 / ((n + 1) : ℝ), by exact nat.one_div_le_one_div hm,
    have hinc : 1 / ((Φ m) + 1:ℝ) ≤ 1 / ((m + 1):ℝ), by exact nat.one_div_le_one_div (strict_mono.id_le hΦ1 m),
    linarith,
  },
  have H3 : ∃ (n : ℕ), ∀ m ≥ n, dist (f ((a∘Φ) m)) (f z) < ε/3 :=
      let ⟨δ, ⟨hδpos, h'⟩⟩ := (metric.continuous_iff.1 hf) z (ε/3) (by linarith), ⟨n1, hn1⟩ := H1 δ hδpos in
        ⟨n1, λ m hm, let h := hn1 m hm in h' (a (Φ m)) (by rwa dist_comm)⟩,
  obtain ⟨⟨n1, hn1⟩, ⟨n2, hn2⟩, ⟨n3, hn3⟩⟩ := ⟨H1 (ε / 3) (by linarith), H2, H3⟩,
  let n := max (max n1 n2) n3,
  specialize hn1 n (le_of_max_le_left (le_max_left (max n1 n2) n3)),
  specialize hn2 n (le_trans (le_max_right n1 n2) (le_max_left (max n1 n2) n3)),
  specialize hn3 n (le_max_right (max n1 n2) n3),
  calc
  dist z (f z) ≤ dist z ((a ∘ Φ) n)
                + dist ((a ∘ Φ) n) (f ((a ∘ Φ) n))
                + dist (f ((a ∘ Φ) n)) (f z) : dist_triangle4 z ((a ∘ Φ) n) (f ((a ∘ Φ) n)) (f z)
  ... ≤ ε/3 + ε/3 + ε/3 : by { linarith [hn1, hn2, hn3] }
  ... = ε : by {ring},
end

lemma le_min_right_or_left {α : Type*} [linear_order α] (a b : α) : a ≤ min a b ∨ b ≤ min a b :=
by cases (le_total a b) with h; simp [true_or, le_min rfl.ge h]; exact or.inr h

lemma max_le_right_or_left {α : Type*} [linear_order α] (a b : α) : max a b ≤ a ∨ max a b ≤ b :=
by cases (le_total a b) with h; simp [true_or, max_le rfl.ge h]; exact or.inr h

lemma edist_lt_of_diam_lt {X : Type*} [pseudo_emetric_space X] (s : set X)  {d : ennreal} :
  emetric.diam s < d → ∀ (x ∈ s) (y ∈ s), edist x y < d :=
λ h x hx y hy, gt_of_gt_of_ge h (emetric.edist_le_diam_of_mem hx hy)

lemma enndiameter_growth' {X : Type} [pseudo_emetric_space X] {S : set X}
  {f : X → X} (hf : uniform_continuous_on f S) : ∀ ε > 0,  ∃ δ > 0,
  ∀ T ⊆ S, emetric.diam T < δ → emetric.diam (f '' T) ≤ ε :=
λ ε hε, let ⟨δ, hδ, H⟩ := emetric.uniform_continuous_on_iff.1 hf ε hε in
  ⟨δ, hδ, λ R hR hdR, emetric.diam_image_le_iff.2
  (λ x hx y hy, le_of_lt (H (hR hx) (hR hy) (edist_lt_of_diam_lt R hdR x hx y hy)))⟩

lemma enndiameter_growth {X : Type} [pseudo_emetric_space X] {S : set X}
  {f : X → X} (hf : uniform_continuous_on f S) : ∀ ε > 0,  ∃ δ > 0,
  ∀ T ⊆ S, emetric.diam T < δ → emetric.diam (f '' T) < ε :=
begin
  intros ε hε,
  set γ := min 1 (ε/2) with hhγ,
  have hγ : γ > 0,
  { cases (le_min_right_or_left 1 (ε/2)),
    { exact lt_of_lt_of_le (ennreal.zero_lt_one) h },
    { exact lt_of_lt_of_le (ennreal.div_pos_iff.2 ⟨ne_of_gt hε, ennreal.two_ne_top⟩) h } },
  obtain ⟨δ, hδ, H⟩ := enndiameter_growth' hf γ hγ,
  have hγε: γ < ε,
  { cases (lt_or_ge 1 ε),
    { exact lt_of_le_of_lt (min_le_left 1 (ε/2)) h },
    { have hεtop := ne_of_lt (lt_of_le_of_lt h (lt_of_le_of_ne le_top ennreal.one_ne_top)),
      exact lt_of_le_of_lt (min_le_right 1 (ε/2)) (ennreal.half_lt_self (ne_of_gt hε) hεtop) } },
  exact ⟨δ, hδ, (λ R hR hdR, lt_of_le_of_lt (H R hR hdR) hγε)⟩,
end

lemma diameter_growth (X : Type) [metric_space X] (S : set X)
  (f : X → X) (hf : uniform_continuous_on f S) (ε : ℝ) (hε : 0 < ε) :
  ∃ δ > 0, ∀ T ⊆ S, metric.bounded T → metric.diam T ≤ δ →
  metric.bounded (f '' T) ∧ metric.diam (f '' T) ≤ ε :=
begin
  sorry
end

variables {d : ℕ}
local notation `E` := fin d → ℝ

def H := {x : E | (∑ (i : fin d), x i) = 1}

variables (f: E → E)

lemma of_real_neg_real_equiv {x : ℝ} (hx : 0 ≤ x) : (ennreal.of_real x : ereal) = (x : ereal) :=
begin
  rw (ennreal.of_real_eq_coe_nnreal hx),
  exact rfl,
end

lemma abs_sub_leq (a b : real) (r : ennreal) (h1 : (a : ereal) ≤ (b : ereal) + r) (h2 : (a : ereal) ≥ (b : ereal) - r) :
  ennreal.of_real (abs (a - b)) ≤ r :=
begin
  cases (abs_choice (a - b)),
  { have : (a : ereal) - (b : ereal) ≤ (r : ereal),
    { rcases (ereal.cases (r : ereal)) with h_1 | ⟨x, hx⟩ | h_3,
      { have hr0: (r : ereal) < 0,
        { rw h_1,
          exact ereal.bot_lt_zero },
        have h0r:= ereal.coe_ennreal_nonneg r,
        rw lt_iff_not_ge at hr0,
        contradiction },
      { let hb := le_of_eq (eq.refl (-↑b)),
        obtain hh := add_le_add h1 hb,
        have hr : b + x + -b = x, by ring,
        have hbr : (b : ereal) + (r : ereal) + - (b :ereal) = (r : ereal),
        { rw hx,
          exact (congr_arg coe (eq.symm hr)).symm },
        rwa ← hbr },
      { rw h_3,
        exact with_top.le_none } },
    exact ereal.coe_ennreal_le_coe_ennreal_iff.mp (by rwa [of_real_neg_real_equiv (abs_nonneg (a - b)), h]) },
  { have hab : -(a - b) = b - a, by ring,
    have : (b : ereal) - (a : ereal) ≤ (r : ereal),
    { rcases (ereal.cases (r : ereal)) with h_1 |⟨x, hx⟩ | h_3,
      { have hr0: (r : ereal) < 0,
        { rw h_1,
          exact ereal.bot_lt_zero },
        have h0r:= ereal.coe_ennreal_nonneg r,
        rw lt_iff_not_ge at hr0,
        contradiction },
      {
        rw hx at *,
        change (((b - a) : ℝ) : ereal) ≤ x,
        change (a : ereal ) ≥ (((b - x) : ℝ) : ereal) at h2,
        simp only [ge_iff_le, eq_self_iff_true, neg_sub, ereal.coe_le_coe_iff] at *,
        linarith },
      { rw h_3,
        exact with_top.le_none } },
    exact ereal.coe_ennreal_le_coe_ennreal_iff.mp (by rwa [of_real_neg_real_equiv (abs_nonneg (a - b)), h, hab]) },
end

example (x y : E) : edist x y = ennreal.of_real (∑ i, (x i - y i)^2) :=
begin
  sorry
end

lemma points_coordinates_bounded_distance (x y : E) (i : fin d) :
  ennreal.of_real (abs (x i - y i)) ≤ edist x y :=
begin
  unfold edist,

  sorry
end

lemma points_coordinates_bounded_diam (S : set E) (x y : E) (hx : x ∈ S) (hy : y ∈ S)
(i : fin d) : ennreal.of_real (abs (x i - y i)) ≤ emetric.diam S :=
begin
  sorry
end

-- per tota coordenada i, existeix un vertex v tal que la coordenada i-èssima
-- és la primera que complex que f(v)_i < f(v)
def is_sperner_set (f: E → E) (S : set E)  :=
  ∀ i: fin d, ∃ v : E, v ∈ S ∧
  (∀ j < i, (f v) j ≥  (v j)) ∧ (((f v) i) < v i)

lemma epsilon_fixed_condition
{f : E → E} {S : set E} (hs : S ⊆ H) (hd : 0 < d)
(hf : uniform_continuous_on f S)
{ε : real} (hε : 0 < ε)
: ∃ δ, 0 < δ ∧
∀ T ⊆ S,
  metric.bounded T → metric.diam T < δ →
  is_sperner_set f T →
  ∀ x ∈ T, dist (f x) x < ε :=
begin
  let ε₁ := ε / (2 * d),
  have h₁ := div_pos hε (mul_pos zero_lt_two (nat.cast_pos.mpr hd)),
  obtain ⟨δ₀, hδ₀pos, hδ₀⟩ := metric.uniform_continuous_on_iff.mp hf ε₁ h₁,
  let δ := min δ₀ (ε₁/2),
  use δ,
  split,
  { cases le_min_right_or_left δ₀ (ε₁/2),
    { exact gt_of_ge_of_gt h hδ₀pos },
    { exact lt_min hδ₀pos (half_pos h₁) } },
  intros T hTS hbT hdT hfT x hx,
  have hmost : ∀ (i : fin d) (hi : (i : ℕ) ≠ d-1),
    abs (((f x) i)-(x i))
     ≤ δ + (metric.diam (f '' T)),
  {
    intros i hi,
    rw abs_sub_le_iff,
    split,
    {
      sorry
    },
    {
      sorry
    }
  },
  have hlast : abs(((f x) ⟨d-1, buffer.lt_aux_2 hd⟩)) - x ⟨d-1, buffer.lt_aux_2 hd⟩ ≤ (d-1) * (δ + (metric.diam (f '' T))),
  {
    sorry
  },
  sorry
end