/-
Copyright (c) 2019 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Mario Carneiro, Isabel Longbottom, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.pgame
import Mathlib.PostPort

universes u_1 u

namespace Mathlib

/-!
# Combinatorial games.

In this file we define the quotient of pre-games by the equivalence relation `p ≈ q ↔ p ≤ q ∧ q ≤
p`, and construct an instance `add_comm_group game`, as well as an instance `partial_order game`
(although note carefully the warning that the `<` field in this instance is not the usual relation
on combinatorial games).
-/

protected instance pgame.setoid : setoid pgame :=
  setoid.mk (fun (x y : pgame) => pgame.equiv x y) sorry

/-- The type of combinatorial games. In ZFC, a combinatorial game is constructed from
  two sets of combinatorial games that have been constructed at an earlier
  stage. To do this in type theory, we say that a combinatorial pre-game is built
  inductively from two families of combinatorial games indexed over any type
  in Type u. The resulting type `pgame.{u}` lives in `Type (u+1)`,
  reflecting that it is a proper class in ZFC.
  A combinatorial game is then constructed by quotienting by the equivalence
  `x ≈ y ↔ x ≤ y ∧ y ≤ x`. -/
def game := quotient pgame.setoid

namespace game

/-- The relation `x ≤ y` on games. -/
def le : game → game → Prop := quotient.lift₂ (fun (x y : pgame) => x ≤ y) sorry

protected instance has_le : HasLessEq game := { LessEq := le }

theorem le_refl (x : game) : x ≤ x := quot.induction_on x fun (x : pgame) => pgame.le_refl x

theorem le_trans (x : game) (y : game) (z : game) : x ≤ y → y ≤ z → x ≤ z :=
  quot.induction_on x
    fun (x : pgame) =>
      quot.induction_on y fun (y : pgame) => quot.induction_on z fun (z : pgame) => pgame.le_trans

theorem le_antisymm (x : game) (y : game) : x ≤ y → y ≤ x → x = y := sorry

/-- The relation `x < y` on games. -/
-- We don't yet make this into an instance, because it will conflict with the (incorrect) notion

-- of `<` provided by `partial_order` later.

def lt : game → game → Prop := quotient.lift₂ (fun (x y : pgame) => x < y) sorry

theorem not_le {x : game} {y : game} : ¬x ≤ y ↔ lt y x :=
  quot.induction_on x fun (x : pgame) => quot.induction_on y fun (y : pgame) => pgame.not_le

protected instance has_zero : HasZero game := { zero := quotient.mk 0 }

protected instance inhabited : Inhabited game := { default := 0 }

protected instance has_one : HasOne game := { one := quotient.mk 1 }

/-- The negation of `{L | R}` is `{-R | -L}`. -/
def neg : game → game := Quot.lift (fun (x : pgame) => quotient.mk (-x)) sorry

protected instance has_neg : Neg game := { neg := neg }

/-- The sum of `x = {xL | xR}` and `y = {yL | yR}` is `{xL + y, x + yL | xR + y, x + yR}`. -/
def add : game → game → game := quotient.lift₂ (fun (x y : pgame) => quotient.mk (x + y)) sorry

protected instance has_add : Add game := { add := add }

theorem add_assoc (x : game) (y : game) (z : game) : x + y + z = x + (y + z) :=
  quot.induction_on x
    fun (x : pgame) =>
      quot.induction_on y
        fun (y : pgame) => quot.induction_on z fun (z : pgame) => quot.sound pgame.add_assoc_equiv

protected instance add_semigroup : add_semigroup game := add_semigroup.mk Add.add add_assoc

theorem add_zero (x : game) : x + 0 = x :=
  quot.induction_on x fun (x : pgame) => quot.sound (pgame.add_zero_equiv x)

theorem zero_add (x : game) : 0 + x = x :=
  quot.induction_on x fun (x : pgame) => quot.sound (pgame.zero_add_equiv x)

protected instance add_monoid : add_monoid game :=
  add_monoid.mk add_semigroup.add add_semigroup.add_assoc 0 zero_add add_zero

theorem add_left_neg (x : game) : -x + x = 0 :=
  quot.induction_on x fun (x : pgame) => quot.sound pgame.add_left_neg_equiv

protected instance add_group : add_group game :=
  add_group.mk add_monoid.add add_monoid.add_assoc add_monoid.zero add_monoid.zero_add
    add_monoid.add_zero Neg.neg
    (sub_neg_monoid.sub._default add_monoid.add add_monoid.add_assoc add_monoid.zero
      add_monoid.zero_add add_monoid.add_zero Neg.neg)
    add_left_neg

theorem add_comm (x : game) (y : game) : x + y = y + x :=
  quot.induction_on x
    fun (x : pgame) => quot.induction_on y fun (y : pgame) => quot.sound pgame.add_comm_equiv

protected instance add_comm_semigroup : add_comm_semigroup game :=
  add_comm_semigroup.mk add_semigroup.add add_semigroup.add_assoc add_comm

protected instance add_comm_group : add_comm_group game :=
  add_comm_group.mk add_comm_semigroup.add add_comm_semigroup.add_assoc add_group.zero
    add_group.zero_add add_group.add_zero add_group.neg add_group.sub add_group.add_left_neg
    add_comm_semigroup.add_comm

theorem add_le_add_left (a : game) (b : game) : a ≤ b → ∀ (c : game), c + a ≤ c + b := sorry

-- While it is very tempting to define a `partial_order` on games, and prove

-- that games form an `ordered_add_comm_group`, it is a bit dangerous.

-- The relations `≤` and `<` on games do not satisfy

-- `lt_iff_le_not_le : ∀ a b : α, a < b ↔ (a ≤ b ∧ ¬ b ≤ a)`

-- (Consider `a = 0`, `b = star`.)

-- (`lt_iff_le_not_le` is satisfied by surreal numbers, however.)

-- Thus we can not use `<` when defining a `partial_order`.

-- Because of this issue, we define the `partial_order` and `ordered_add_comm_group` instances,

-- but do not actually mark them as instances, for safety.

/-- The `<` operation provided by this partial order is not the usual `<` on games! -/
def game_partial_order : partial_order game :=
  partial_order.mk LessEq (preorder.lt._default LessEq) le_refl le_trans le_antisymm

/-- The `<` operation provided by this `ordered_add_comm_group` is not the usual `<` on games! -/
def ordered_add_comm_group_game : ordered_add_comm_group game :=
  ordered_add_comm_group.mk add_comm_group.add add_comm_group.add_assoc add_comm_group.zero
    add_comm_group.zero_add add_comm_group.add_zero add_comm_group.neg add_comm_group.sub
    add_comm_group.add_left_neg add_comm_group.add_comm partial_order.le partial_order.lt
    partial_order.le_refl partial_order.le_trans partial_order.le_antisymm add_le_add_left

end Mathlib


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import order.hom.basic
import order.bounded_order

/-!
# Lattice homomorphisms

This file defines (bounded) lattice homomorphisms.

We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
be satisfied by itself and all stricter types.

## Types of morphisms

* `top_hom`: Maps which preserve `⊤`.
* `bot_hom`: Maps which preserve `⊥`.
* `sup_hom`: Maps which preserve `⊔`.
* `inf_hom`: Maps which preserve `⊓`.
* `lattice_hom`: Lattice homomorphisms. Maps which preserve `⊔` and `⊓`.
* `bounded_lattice_hom`: Bounded lattice homomorphisms. Maps which preserve `⊤`, `⊥`, `⊔` and `⊓`.

## Typeclasses

* `top_hom_class`
* `bot_hom_class`
* `sup_hom_class`
* `inf_hom_class`
* `lattice_hom_class`
* `bounded_lattice_hom_class`

## TODO

Do we need more intersections between `bot_hom`, `top_hom` and lattice homomorphisms?
-/

open function

variables {F α β γ δ : Type*}

/-- The type of `⊤`-preserving functions from `α` to `β`. -/
structure top_hom (α β : Type*) [has_top α] [has_top β] :=
(to_fun   : α → β)
(map_top' : to_fun ⊤ = ⊤)

/-- The type of `⊥`-preserving functions from `α` to `β`. -/
structure bot_hom (α β : Type*) [has_bot α] [has_bot β] :=
(to_fun   : α → β)
(map_bot' : to_fun ⊥ = ⊥)

/-- The type of `⊔`-preserving functions from `α` to `β`. -/
structure sup_hom (α β : Type*) [has_sup α] [has_sup β] :=
(to_fun   : α → β)
(map_sup' (a b : α) : to_fun (a ⊔ b) = to_fun a ⊔ to_fun b)

/-- The type of `⊓`-preserving functions from `α` to `β`. -/
structure inf_hom (α β : Type*) [has_inf α] [has_inf β] :=
(to_fun   : α → β)
(map_inf' (a b : α) : to_fun (a ⊓ b) = to_fun a ⊓ to_fun b)

/-- The type of lattice homomorphisms from `α` to `β`. -/
structure lattice_hom (α β : Type*) [lattice α] [lattice β] extends sup_hom α β :=
(map_inf' (a b : α) : to_fun (a ⊓ b) = to_fun a ⊓ to_fun b)

/-- The type of bounded lattice homomorphisms from `α` to `β`. -/
structure bounded_lattice_hom (α β : Type*) [lattice α] [lattice β] [bounded_order α]
  [bounded_order β]
  extends lattice_hom α β :=
(map_top' : to_fun ⊤ = ⊤)
(map_bot' : to_fun ⊥ = ⊥)

/-- `top_hom_class F α β` states that `F` is a type of `⊤`-preserving morphisms.

You should extend this class when you extend `sup_hom`. -/
class top_hom_class (F : Type*) (α β : out_param $ Type*) [has_top α] [has_top β]
  extends fun_like F α (λ _, β) :=
(map_top (f : F) : f ⊤ = ⊤)

/-- `bot_hom_class F α β` states that `F` is a type of `⊥`-preserving morphisms.

You should extend this class when you extend `sup_hom`. -/
class bot_hom_class (F : Type*) (α β : out_param $ Type*) [has_bot α] [has_bot β]
  extends fun_like F α (λ _, β) :=
(map_bot (f : F) : f ⊥ = ⊥)

/-- `sup_hom_class F α β` states that `F` is a type of `⊔`-preserving morphisms.

You should extend this class when you extend `sup_hom`. -/
class sup_hom_class (F : Type*) (α β : out_param $ Type*) [has_sup α] [has_sup β]
  extends fun_like F α (λ _, β) :=
(map_sup (f : F) (a b : α) : f (a ⊔ b) = f a ⊔ f b)

/-- `inf_hom_class F α β` states that `F` is a type of `⊓`-preserving morphisms.

You should extend this class when you extend `inf_hom`. -/
class inf_hom_class (F : Type*) (α β : out_param $ Type*) [has_inf α] [has_inf β]
  extends fun_like F α (λ _, β) :=
(map_inf (f : F) (a b : α) : f (a ⊓ b) = f a ⊓ f b)

/-- `lattice_hom_class F α β` states that `F` is a type of lattice morphisms.

You should extend this class when you extend `sup_hom`. -/
class lattice_hom_class (F : Type*) (α β : out_param $ Type*) [lattice α] [lattice β]
  extends sup_hom_class F α β :=
(map_inf (f : F) (a b : α) : f (a ⊓ b) = f a ⊓ f b)

/-- `bounded_lattice_hom_class F α β` states that `F` is a type of bounded lattice morphisms.

You should extend this class when you extend `bounded_lattice_hom`. -/
class bounded_lattice_hom_class (F : Type*) (α β : out_param $ Type*) [lattice α] [lattice β]
  [bounded_order α] [bounded_order β]
  extends lattice_hom_class F α β :=
(map_top (f : F) : f ⊤ = ⊤)
(map_bot (f : F) : f ⊥ = ⊥)

export top_hom_class (map_top)
export bot_hom_class (map_bot)
export sup_hom_class (map_sup)
export inf_hom_class (map_inf)

attribute [simp] map_top map_bot map_sup map_inf

@[priority 100] -- See note [lower instance priority]
instance sup_hom_class.to_order_hom_class [semilattice_sup α] [semilattice_sup β]
  [sup_hom_class F α β] :
  order_hom_class F α β :=
⟨λ f a b h, by rw [←sup_eq_right, ←map_sup, sup_eq_right.2 h]⟩

@[priority 100] -- See note [lower instance priority]
instance inf_hom_class.to_order_hom_class [semilattice_inf α] [semilattice_inf β]
  [inf_hom_class F α β] : order_hom_class F α β :=
⟨λ f a b h, by rw [←inf_eq_left, ←map_inf, inf_eq_left.2 h]⟩

@[priority 100] -- See note [lower instance priority]
instance lattice_hom_class.to_inf_hom_class [lattice α] [lattice β] [lattice_hom_class F α β] :
  inf_hom_class F α β :=
{ .. ‹lattice_hom_class F α β› }

@[priority 100] -- See note [lower instance priority]
instance bounded_lattice_hom_class.to_top_hom_class [lattice α] [lattice β]
  [bounded_order α] [bounded_order β] [bounded_lattice_hom_class F α β] :
  top_hom_class F α β :=
{ .. ‹bounded_lattice_hom_class F α β› }

@[priority 100] -- See note [lower instance priority]
instance bounded_lattice_hom_class.to_bot_hom_class [lattice α] [lattice β]
  [bounded_order α] [bounded_order β] [bounded_lattice_hom_class F α β] :
  bot_hom_class F α β :=
{ .. ‹bounded_lattice_hom_class F α β› }

instance [has_top α] [has_top β] [top_hom_class F α β] : has_coe_t F (top_hom α β) :=
⟨λ f, ⟨f, map_top f⟩⟩

instance [has_bot α] [has_bot β] [bot_hom_class F α β] : has_coe_t F (bot_hom α β) :=
⟨λ f, ⟨f, map_bot f⟩⟩

instance [has_sup α] [has_sup β] [sup_hom_class F α β] : has_coe_t F (sup_hom α β) :=
⟨λ f, ⟨f, map_sup f⟩⟩

instance [has_inf α] [has_inf β] [inf_hom_class F α β] : has_coe_t F (inf_hom α β) :=
⟨λ f, ⟨f, map_inf f⟩⟩

instance [lattice α] [lattice β] [lattice_hom_class F α β] : has_coe_t F (lattice_hom α β) :=
⟨λ f, { to_fun := f, map_sup' := map_sup f, map_inf' := map_inf f }⟩

instance [lattice α] [lattice β] [bounded_order α] [bounded_order β]
  [bounded_lattice_hom_class F α β] : has_coe_t F (bounded_lattice_hom α β) :=
⟨λ f, { to_fun := f, map_top' := map_top f, map_bot' := map_bot f, ..(f : lattice_hom α β) }⟩

/-! ### Top homomorphisms -/

namespace top_hom
variables [has_top α]

section has_top
variables [has_top β] [has_top γ] [has_top δ]

instance : top_hom_class (top_hom α β) α β :=
{ coe := top_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_top := top_hom.map_top' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (top_hom α β) (λ _, α → β) := ⟨λ f, f.to_fun⟩

@[simp] lemma to_fun_eq_coe {f : top_hom α β} : f.to_fun = (f : α → β) := rfl

@[ext] lemma ext {f g : top_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

/-- Copy of a `top_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : top_hom α β) (f' : α → β) (h : f' = f) : top_hom α β :=
{ to_fun := f',
  map_top' := h.symm ▸ f.map_top' }

instance : inhabited (top_hom α β) := ⟨⟨λ _, ⊤, rfl⟩⟩

variables (α)

/-- `id` as a `top_hom`. -/
protected def id : top_hom α α := ⟨id, rfl⟩

@[simp] lemma coe_id : ⇑(top_hom.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : top_hom.id α a = a := rfl

/-- Composition of `top_hom`s as a `top_hom`. -/
def comp (f : top_hom β γ) (g : top_hom α β) : top_hom α γ :=
{ to_fun := f ∘ g,
  map_top' := by rw [comp_apply, map_top, map_top] }

@[simp] lemma coe_comp (f : top_hom β γ) (g : top_hom α β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp] lemma comp_apply (f : top_hom β γ) (g : top_hom α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma comp_assoc (f : top_hom γ δ) (g : top_hom β γ) (h : top_hom α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : top_hom α β) : f.comp (top_hom.id α) = f := top_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : top_hom α β) : (top_hom.id β).comp f = f := top_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : top_hom β γ} {f : top_hom α β} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, top_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : top_hom β γ} {f₁ f₂ : top_hom α β} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, top_hom.ext $ λ a, hg $
  by rw [←top_hom.comp_apply, h, top_hom.comp_apply], congr_arg _⟩

end has_top

instance [preorder β] [has_top β] : preorder (top_hom α β) :=
preorder.lift (coe_fn : top_hom α β → α → β)

instance [partial_order β] [has_top β] : partial_order (top_hom α β) :=
partial_order.lift _ fun_like.coe_injective

section order_top
variables [preorder β] [order_top β]

instance : order_top (top_hom α β) := ⟨⟨⊤, rfl⟩, λ _, le_top⟩

@[simp] lemma coe_top : ⇑(⊤ : top_hom α β) = ⊤ := rfl
@[simp] lemma top_apply (a : α) : (⊤ : top_hom α β) a = ⊤ := rfl

end order_top

section semilattice_inf
variables [semilattice_inf β] [order_top β] (f g : top_hom α β)

instance : has_inf (top_hom α β) :=
⟨λ f g, ⟨f ⊓ g, by rw [pi.inf_apply, map_top, map_top, inf_top_eq]⟩⟩

instance : semilattice_inf (top_hom α β) := fun_like.coe_injective.semilattice_inf _ $ λ _ _, rfl

@[simp] lemma coe_inf : ⇑(f ⊓ g) = f ⊓ g := rfl
@[simp] lemma inf_apply (a : α) : (f ⊓ g) a = f a ⊓ g a := rfl

end semilattice_inf

section semilattice_sup
variables [semilattice_sup β] [order_top β] (f g : top_hom α β)

instance : has_sup (top_hom α β) :=
⟨λ f g, ⟨f ⊔ g, by rw [pi.sup_apply, map_top, map_top, sup_top_eq]⟩⟩

instance : semilattice_sup (top_hom α β) := fun_like.coe_injective.semilattice_sup _ $ λ _ _, rfl

@[simp] lemma coe_sup : ⇑(f ⊔ g) = f ⊔ g := rfl
@[simp] lemma sup_apply (a : α) : (f ⊔ g) a = f a ⊔ g a := rfl

end semilattice_sup

instance [lattice β] [order_top β] : lattice (top_hom α β) :=
fun_like.coe_injective.lattice _ (λ _ _, rfl) (λ _ _, rfl)

instance [distrib_lattice β] [order_top β] : distrib_lattice (top_hom α β) :=
fun_like.coe_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl)

end top_hom

/-! ### Bot homomorphisms -/

namespace bot_hom
variables [has_bot α]

section has_bot
variables [has_bot β] [has_bot γ] [has_bot δ]

instance : bot_hom_class (bot_hom α β) α β :=
{ coe := bot_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_bot := bot_hom.map_bot' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (bot_hom α β) (λ _, α → β) := ⟨λ f, f.to_fun⟩

@[simp] lemma to_fun_eq_coe {f : bot_hom α β} : f.to_fun = (f : α → β) := rfl

@[ext] lemma ext {f g : bot_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

/-- Copy of a `bot_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : bot_hom α β) (f' : α → β) (h : f' = f) : bot_hom α β :=
{ to_fun := f',
  map_bot' := h.symm ▸ f.map_bot' }

instance : inhabited (bot_hom α β) := ⟨⟨λ _, ⊥, rfl⟩⟩

variables (α)

/-- `id` as a `bot_hom`. -/
protected def id : bot_hom α α := ⟨id, rfl⟩

@[simp] lemma coe_id : ⇑(bot_hom.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : bot_hom.id α a = a := rfl

/-- Composition of `bot_hom`s as a `bot_hom`. -/
def comp (f : bot_hom β γ) (g : bot_hom α β) : bot_hom α γ :=
{ to_fun := f ∘ g,
  map_bot' := by rw [comp_apply, map_bot, map_bot] }

@[simp] lemma coe_comp (f : bot_hom β γ) (g : bot_hom α β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp] lemma comp_apply (f : bot_hom β γ) (g : bot_hom α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma comp_assoc (f : bot_hom γ δ) (g : bot_hom β γ) (h : bot_hom α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : bot_hom α β) : f.comp (bot_hom.id α) = f := bot_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : bot_hom α β) : (bot_hom.id β).comp f = f := bot_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : bot_hom β γ} {f : bot_hom α β} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, bot_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : bot_hom β γ} {f₁ f₂ : bot_hom α β} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, bot_hom.ext $ λ a, hg $
  by rw [←bot_hom.comp_apply, h, bot_hom.comp_apply], congr_arg _⟩

end has_bot

instance [preorder β] [has_bot β] : preorder (bot_hom α β) :=
preorder.lift (coe_fn : bot_hom α β → α → β)

instance [partial_order β] [has_bot β] : partial_order (bot_hom α β) :=
partial_order.lift _ fun_like.coe_injective

section order_bot
variables [preorder β] [order_bot β]

instance : order_bot (bot_hom α β) := ⟨⟨⊥, rfl⟩, λ _, bot_le⟩

@[simp] lemma coe_bot : ⇑(⊥ : bot_hom α β) = ⊥ := rfl
@[simp] lemma bot_apply (a : α) : (⊥ : bot_hom α β) a = ⊥ := rfl

end order_bot

section semilattice_inf
variables [semilattice_inf β] [order_bot β] (f g : bot_hom α β)

instance : has_inf (bot_hom α β) :=
⟨λ f g, ⟨f ⊓ g, by rw [pi.inf_apply, map_bot, map_bot, inf_bot_eq]⟩⟩

instance : semilattice_inf (bot_hom α β) := fun_like.coe_injective.semilattice_inf _ $ λ _ _, rfl

@[simp] lemma coe_inf : ⇑(f ⊓ g) = f ⊓ g := rfl
@[simp] lemma inf_apply (a : α) : (f ⊓ g) a = f a ⊓ g a := rfl

end semilattice_inf

section semilattice_sup
variables [semilattice_sup β] [order_bot β] (f g : bot_hom α β)

instance : has_sup (bot_hom α β) :=
⟨λ f g, ⟨f ⊔ g, by rw [pi.sup_apply, map_bot, map_bot, sup_bot_eq]⟩⟩

instance : semilattice_sup (bot_hom α β) := fun_like.coe_injective.semilattice_sup _ $ λ _ _, rfl

@[simp] lemma coe_sup : ⇑(f ⊔ g) = f ⊔ g := rfl
@[simp] lemma sup_apply (a : α) : (f ⊔ g) a = f a ⊔ g a := rfl

end semilattice_sup

instance [lattice β] [order_bot β] : lattice (bot_hom α β) :=
fun_like.coe_injective.lattice _ (λ _ _, rfl) (λ _ _, rfl)

instance [distrib_lattice β] [order_bot β] : distrib_lattice (bot_hom α β) :=
fun_like.coe_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl)

end bot_hom

/-! ### Supremum homomorphisms -/

namespace sup_hom
variables [has_sup α]

section has_sup
variables [has_sup β] [has_sup γ] [has_sup δ]

instance : sup_hom_class (sup_hom α β) α β :=
{ coe := sup_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_sup := sup_hom.map_sup' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (sup_hom α β) (λ _, α → β) := ⟨λ f, f.to_fun⟩

@[simp] lemma to_fun_eq_coe {f : sup_hom α β} : f.to_fun = (f : α → β) := rfl

@[ext] lemma ext {f g : sup_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

/-- Copy of a `sup_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : sup_hom α β) (f' : α → β) (h : f' = f) : sup_hom α β :=
{ to_fun := f',
  map_sup' := h.symm ▸ f.map_sup' }

variables (α)

/-- `id` as a `sup_hom`. -/
protected def id : sup_hom α α := ⟨id, λ a b, rfl⟩

instance : inhabited (sup_hom α α) := ⟨sup_hom.id α⟩

@[simp] lemma coe_id : ⇑(sup_hom.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : sup_hom.id α a = a := rfl

/-- Composition of `sup_hom`s as a `sup_hom`. -/
def comp (f : sup_hom β γ) (g : sup_hom α β) : sup_hom α γ :=
{ to_fun := f ∘ g,
  map_sup' := λ a b, by rw [comp_apply, map_sup, map_sup] }

@[simp] lemma coe_comp (f : sup_hom β γ) (g : sup_hom α β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp] lemma comp_apply (f : sup_hom β γ) (g : sup_hom α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma comp_assoc (f : sup_hom γ δ) (g : sup_hom β γ) (h : sup_hom α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : sup_hom α β) : f.comp (sup_hom.id α) = f := sup_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : sup_hom α β) : (sup_hom.id β).comp f = f := sup_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : sup_hom β γ} {f : sup_hom α β} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, sup_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : sup_hom β γ} {f₁ f₂ : sup_hom α β} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, sup_hom.ext $ λ a, hg $
  by rw [←sup_hom.comp_apply, h, sup_hom.comp_apply], congr_arg _⟩

end has_sup

variables [semilattice_sup β]

instance : has_sup (sup_hom α β) :=
⟨λ f g, ⟨f ⊔ g, λ a b, by { rw [pi.sup_apply, map_sup, map_sup], exact sup_sup_sup_comm _ _ _ _ }⟩⟩

instance : semilattice_sup (sup_hom α β) := fun_like.coe_injective.semilattice_sup _ $ λ f g, rfl

@[simp] lemma coe_sup (f g : sup_hom α β) : ⇑(f ⊔ g) = f ⊔ g := rfl
@[simp] lemma sup_apply (f g : sup_hom α β) (a : α): (f ⊔ g) a = f a ⊔ g a := rfl

variables (α)

/-- The constant function as a `sup_hom`. -/
def const (b : β) : sup_hom α β := ⟨λ _, b, λ _ _, sup_idem.symm⟩

@[simp] lemma coe_const (b : β) : ⇑(const α b) = function.const α b := rfl
@[simp] lemma const_apply (b : β) (a : α) : const α b a = b := rfl

end sup_hom

/-! ### Infimum homomorphisms -/

namespace inf_hom
variables [has_inf α]

section has_inf
variables [has_inf β] [has_inf γ] [has_inf δ]

instance : inf_hom_class (inf_hom α β) α β :=
{ coe := inf_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_inf := inf_hom.map_inf' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (inf_hom α β) (λ _, α → β) := ⟨λ f, f.to_fun⟩

@[simp] lemma to_fun_eq_coe {f : inf_hom α β} : f.to_fun = (f : α → β) := rfl

@[ext] lemma ext {f g : inf_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

/-- Copy of a `inf_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : inf_hom α β) (f' : α → β) (h : f' = f) : inf_hom α β :=
{ to_fun := f',
  map_inf' := h.symm ▸ f.map_inf' }

variables (α)

/-- `id` as an `inf_hom`. -/
protected def id : inf_hom α α := ⟨id, λ a b, rfl⟩

instance : inhabited (inf_hom α α) := ⟨inf_hom.id α⟩

@[simp] lemma coe_id : ⇑(inf_hom.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : inf_hom.id α a = a := rfl

/-- Composition of `inf_hom`s as a `inf_hom`. -/
def comp (f : inf_hom β γ) (g : inf_hom α β) : inf_hom α γ :=
{ to_fun := f ∘ g,
  map_inf' := λ a b, by rw [comp_apply, map_inf, map_inf] }

@[simp] lemma coe_comp (f : inf_hom β γ) (g : inf_hom α β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp] lemma comp_apply (f : inf_hom β γ) (g : inf_hom α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma comp_assoc (f : inf_hom γ δ) (g : inf_hom β γ) (h : inf_hom α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : inf_hom α β) : f.comp (inf_hom.id α) = f := inf_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : inf_hom α β) : (inf_hom.id β).comp f = f := inf_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : inf_hom β γ} {f : inf_hom α β} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, inf_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : inf_hom β γ} {f₁ f₂ : inf_hom α β} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, inf_hom.ext $ λ a, hg $
  by rw [←inf_hom.comp_apply, h, inf_hom.comp_apply], congr_arg _⟩

end has_inf

variables [semilattice_inf β]

instance : has_inf (inf_hom α β) :=
⟨λ f g, ⟨f ⊓ g, λ a b, by { rw [pi.inf_apply, map_inf, map_inf], exact inf_inf_inf_comm _ _ _ _ }⟩⟩

instance : semilattice_inf (inf_hom α β) := fun_like.coe_injective.semilattice_inf _ $ λ f g, rfl

@[simp] lemma coe_inf (f g : inf_hom α β) : ⇑(f ⊓ g) = f ⊓ g := rfl
@[simp] lemma inf_apply (f g : inf_hom α β) (a : α) : (f ⊓ g) a = f a ⊓ g a := rfl

variables (α)

/-- The constant function as an `inf_hom`. -/
def const (b : β) : inf_hom α β := ⟨λ _, b, λ _ _, inf_idem.symm⟩

@[simp] lemma coe_const (b : β) : ⇑(const α b) = function.const α b := rfl
@[simp] lemma const_apply (b : β) (a : α) : const α b a = b := rfl

end inf_hom

/-! ### Lattice homomorphisms -/

namespace lattice_hom
variables [lattice α] [lattice β] [lattice γ] [lattice δ]

/-- Reinterpret a `lattice_hom` as an `inf_hom`. -/
def to_inf_hom (f : lattice_hom α β) : inf_hom α β := { ..f }

instance : lattice_hom_class (lattice_hom α β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by obtain ⟨⟨_, _⟩, _⟩ := f; obtain ⟨⟨_, _⟩, _⟩ := g; congr',
  map_sup := λ f, f.map_sup',
  map_inf := λ f, f.map_inf' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (lattice_hom α β) (λ _, α → β) := ⟨λ f, f.to_fun⟩

@[simp] lemma to_fun_eq_coe {f : lattice_hom α β} : f.to_fun = (f : α → β) := rfl

@[ext] lemma ext {f g : lattice_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

/-- Copy of a `lattice_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : lattice_hom α β) (f' : α → β) (h : f' = f) : lattice_hom α β :=
{ to_fun := f',
  .. f.to_sup_hom.copy f' $ by { ext, exact congr_fun h _ },
  .. f.to_inf_hom.copy f' $ by { ext, exact congr_fun h _ } }

variables (α)

/-- `id` as a `lattice_hom`. -/
protected def id : lattice_hom α α :=
{ to_fun := id,
  map_sup' := λ _ _, rfl,
  map_inf' := λ _ _, rfl }

instance : inhabited (lattice_hom α α) := ⟨lattice_hom.id α⟩

@[simp] lemma coe_id : ⇑(lattice_hom.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : lattice_hom.id α a = a := rfl

/-- Composition of `lattice_hom`s as a `lattice_hom`. -/
def comp (f : lattice_hom β γ) (g : lattice_hom α β) : lattice_hom α γ :=
{ ..f.to_sup_hom.comp g.to_sup_hom, ..f.to_inf_hom.comp g.to_inf_hom }

@[simp] lemma coe_comp (f : lattice_hom β γ) (g : lattice_hom α β) : (f.comp g : α → γ) = f ∘ g :=
rfl
@[simp] lemma comp_apply (f : lattice_hom β γ) (g : lattice_hom α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma coe_comp_sup_hom (f : lattice_hom β γ) (g : lattice_hom α β) :
  (f.comp g : sup_hom α γ) = (f : sup_hom β γ).comp g := rfl
@[simp] lemma coe_comp_inf_hom (f : lattice_hom β γ) (g : lattice_hom α β) :
  (f.comp g : inf_hom α γ) = (f : inf_hom β γ).comp g := rfl
@[simp] lemma comp_assoc (f : lattice_hom γ δ) (g : lattice_hom β γ) (h : lattice_hom α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : lattice_hom α β) : f.comp (lattice_hom.id α) = f :=
lattice_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : lattice_hom α β) : (lattice_hom.id β).comp f = f :=
lattice_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : lattice_hom β γ} {f : lattice_hom α β} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, lattice_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : lattice_hom β γ} {f₁ f₂ : lattice_hom α β} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, lattice_hom.ext $ λ a, hg $
  by rw [←lattice_hom.comp_apply, h, lattice_hom.comp_apply], congr_arg _⟩

end lattice_hom

namespace order_hom_class
variables (α β) [linear_order α] [lattice β] [order_hom_class F α β]

/-- An order homomorphism from a linear order is a lattice homomorphism. -/
@[reducible] def to_lattice_hom_class : lattice_hom_class F α β :=
{ map_sup := λ f a b, begin
    obtain h | h := le_total a b,
    { rw [sup_eq_right.2 h, sup_eq_right.2 (order_hom_class.mono f h : f a ≤ f b)] },
    { rw [sup_eq_left.2 h, sup_eq_left.2 (order_hom_class.mono f h : f b ≤ f a)] }
  end,
  map_inf := λ f a b, begin
    obtain h | h := le_total a b,
    { rw [inf_eq_left.2 h, inf_eq_left.2 (order_hom_class.mono f h : f a ≤ f b)] },
    { rw [inf_eq_right.2 h, inf_eq_right.2 (order_hom_class.mono f h : f b ≤ f a)] }
  end,
  .. ‹order_hom_class F α β› }

/-- Reinterpret an order homomorphism to a linear order as a `lattice_hom`. -/
def to_lattice_hom (f : F) : lattice_hom α β :=
by { haveI : lattice_hom_class F α β := order_hom_class.to_lattice_hom_class α β, exact f }

@[simp] lemma coe_to_lattice_hom (f : F) : ⇑(to_lattice_hom α β f) = f := rfl
@[simp] lemma to_lattice_hom_apply (f : F) (a : α) : to_lattice_hom α β f a = f a := rfl

end order_hom_class

/-! ### Bounded lattice homomorphisms -/

namespace bounded_lattice_hom
variables [lattice α] [lattice β] [lattice γ] [lattice δ] [bounded_order α] [bounded_order β]
  [bounded_order γ] [bounded_order δ]

/-- Reinterpret a `bounded_lattice_hom` as a `top_hom`. -/
def to_top_hom (f : bounded_lattice_hom α β) : top_hom α β := { ..f }

/-- Reinterpret a `bounded_lattice_hom` as a `bot_hom`. -/
def to_bot_hom (f : bounded_lattice_hom α β) : bot_hom α β := { ..f }

instance : bounded_lattice_hom_class (bounded_lattice_hom α β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := f; obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := g; congr',
  map_sup := λ f, f.map_sup',
  map_inf := λ f, f.map_inf',
  map_top := λ f, f.map_top',
  map_bot := λ f, f.map_bot' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (bounded_lattice_hom α β) (λ _, α → β) := ⟨λ f, f.to_fun⟩

@[simp] lemma to_fun_eq_coe {f : bounded_lattice_hom α β} : f.to_fun = (f : α → β) := rfl

@[ext] lemma ext {f g : bounded_lattice_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

/-- Copy of a `bounded_lattice_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities. -/
protected def copy (f : bounded_lattice_hom α β) (f' : α → β) (h : f' = f) :
  bounded_lattice_hom α β :=
{ to_fun := f',
  .. f.to_lattice_hom.copy f' $ by { ext, exact congr_fun h _ },
  .. f.to_top_hom.copy f' $ by { ext, exact congr_fun h _ },
  .. f.to_bot_hom.copy f' $ by { ext, exact congr_fun h _ } }

variables (α)

/-- `id` as a `bounded_lattice_hom`. -/
protected def id : bounded_lattice_hom α α :=
{ to_fun := id,
  map_sup' := λ _ _, rfl,
  map_inf' := λ _ _, rfl,
  map_top' := rfl,
  map_bot' := rfl }

instance : inhabited (bounded_lattice_hom α α) := ⟨bounded_lattice_hom.id α⟩

@[simp] lemma coe_id : ⇑(bounded_lattice_hom.id α) = id := rfl

variables {α}

@[simp] lemma id_apply (a : α) : bounded_lattice_hom.id α a = a := rfl

/-- Composition of `bounded_lattice_hom`s as a `bounded_lattice_hom`. -/
def comp (f : bounded_lattice_hom β γ) (g : bounded_lattice_hom α β) : bounded_lattice_hom α γ :=
{ ..f.to_lattice_hom.comp g.to_lattice_hom,
  ..f.to_top_hom.comp g.to_top_hom, ..f.to_bot_hom.comp g.to_bot_hom }

@[simp] lemma coe_comp (f : bounded_lattice_hom β γ) (g : bounded_lattice_hom α β) :
  (f.comp g : α → γ) = f ∘ g :=
rfl
@[simp] lemma comp_apply (f : bounded_lattice_hom β γ) (g : bounded_lattice_hom α β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp] lemma coe_comp_lattice_hom (f : bounded_lattice_hom β γ) (g : bounded_lattice_hom α β) :
  (f.comp g : lattice_hom α γ) = (f : lattice_hom β γ).comp g := rfl
@[simp] lemma coe_comp_sup_hom (f : bounded_lattice_hom β γ) (g : bounded_lattice_hom α β) :
  (f.comp g : sup_hom α γ) = (f : sup_hom β γ).comp g := rfl
@[simp] lemma coe_comp_inf_hom (f : bounded_lattice_hom β γ) (g : bounded_lattice_hom α β) :
  (f.comp g : inf_hom α γ) = (f : inf_hom β γ).comp g := rfl
@[simp] lemma comp_assoc (f : bounded_lattice_hom γ δ) (g : bounded_lattice_hom β γ)
  (h : bounded_lattice_hom α β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : bounded_lattice_hom α β) : f.comp (bounded_lattice_hom.id α) = f :=
bounded_lattice_hom.ext $ λ a, rfl
@[simp] lemma id_comp (f : bounded_lattice_hom α β) : (bounded_lattice_hom.id β).comp f = f :=
bounded_lattice_hom.ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : bounded_lattice_hom β γ} {f : bounded_lattice_hom α β}
  (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, bounded_lattice_hom.ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : bounded_lattice_hom β γ} {f₁ f₂ : bounded_lattice_hom α β}
  (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, bounded_lattice_hom.ext $ λ a, hg $
  by rw [←bounded_lattice_hom.comp_apply, h, bounded_lattice_hom.comp_apply], congr_arg _⟩

end bounded_lattice_hom


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import .regularity_lemma
import .triangle_counting

/-!
# Triangle counting lemma
-/

open finset fintype
open_locale classical

variables {α : Type*} [fintype α] {G : simple_graph α}

namespace simple_graph

lemma reduced_edges_card_aux [nonempty α] {ε : ℝ} {P : finpartition (univ : finset α)} (hε : 0 < ε)
  (hP : P.is_equipartition) (hPε : P.is_uniform G (ε/8)) (hP' : 4 / ε ≤ P.parts.card) :
  2 * (G.edge_finset.card - (reduced_graph G ε P).edge_finset.card : ℝ) < 2 * ε * (card α)^2 :=
begin
  have i : univ.filter (λ (xy : α × α), (G.reduced_graph ε P).adj xy.1 xy.2) ⊆
    univ.filter (λ (xy : α × α), G.adj xy.1 xy.2),
  { apply monotone_filter_right,
    rintro ⟨x,y⟩,
    apply reduced_graph_le },
  rw mul_sub,
  norm_cast,
  rw [nat.cast_pow, double_edge_finset_card_eq, double_edge_finset_card_eq,
    ←nat.cast_sub (card_le_of_subset i), ←card_sdiff i],
  refine (nat.cast_le.2 (card_le_of_subset reduced_double_edges)).trans_lt _,
  refine (nat.cast_le.2 (card_union_le _ _)).trans_lt _,
  rw nat.cast_add,
  refine (add_le_add_right (nat.cast_le.2 (card_union_le _ _)) _).trans_lt _,
  rw nat.cast_add,
  have h₁ : 0 ≤ ε/4, linarith,
  refine (add_le_add_left (sum_sparse h₁ P hP) _).trans_lt _,
  rw add_right_comm,
  refine (add_le_add_left (internal_killed_card' hε hP hP') _).trans_lt _,
  rw add_assoc,
  have h₂ : 0 < ε/8, linarith,
  refine (add_lt_add_right (sum_irreg_pairs_le_of_uniform' h₂ P hP hPε) _).trans_le _,
  apply le_of_eq,
  ring,
end

lemma triangle_removal_2 {ε : ℝ} (hε : 0 < ε) (hε₁ : ε ≤ 1) (hG : G.triangle_free_far ε) :
  triangle_removal_bound ε * (card α)^3 ≤ G.triangle_finset.card :=
begin
  let l : ℕ := nat.ceil (4/ε),
  have hl : 4/ε ≤ l := nat.le_ceil (4/ε),
  let ε' : ℝ := ε/8,
  have hε' : 0 < ε/8 := by linarith,
  casesI is_empty_or_nonempty α with i i,
  { simp [fintype.card_eq_zero] },
  cases lt_or_le (card α) l with hl' hl',
  { have : (card α : ℝ)^3 < l^3 :=
      pow_lt_pow_of_lt_left (nat.cast_lt.2 hl') (nat.cast_nonneg _) (by norm_num),
    refine (mul_le_mul_of_nonneg_left this.le (triangle_removal_bound_pos hε hε₁).le).trans _,
    apply (triangle_removal_bound_mul_cube_lt hε).le.trans,
    simp only [nat.one_le_cast],
    apply hG.triangle_finset_card_pos hε },
  obtain ⟨P, hP₁, hP₂, hP₃, hP₄⟩ := szemeredi_regularity G l hε' hl',
  have : 4/ε ≤ P.parts.card := hl.trans (nat.cast_le.2 hP₂),
  have k := reduced_edges_card_aux hε hP₁ hP₄ this,
  rw mul_assoc at k,
  replace k := lt_of_mul_lt_mul_left k zero_le_two,
  obtain ⟨t, ht⟩ := has_triangle_of_few_edges_removed G reduced_graph_le hG k,
  apply triangle_removal_aux hε hε₁ hP₁ hP₃ ht,
end

/-- If there are not too many triangles, then you can remove some edges to remove all triangles. -/
lemma triangle_removal {ε : ℝ} (hε : 0 < ε) (hε₁ : ε ≤ 1)
  (hG : (G.triangle_finset.card : ℝ) < triangle_removal_bound ε * (card α)^3) :
  ∃ (G' ≤ G),
    (G.edge_finset.card - G'.edge_finset.card : ℝ) < ε * (card α)^2
      ∧ G'.no_triangles :=
begin
  by_contra,
  push_neg at h,
  have : G.triangle_free_far ε,
  { intros G' hG hG',
    apply le_of_not_lt,
    intro i,
    apply h G' hG i hG' },
  apply not_le_of_lt hG (triangle_removal_2 hε hε₁ this),
end

end simple_graph