/-
Copyright (c) 2020 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro, Yury G. Kudryashov

! This file was ported from Lean 3 source module order.rel_classes
! leanprover-community/mathlib commit bc7d81beddb3d6c66f71449c5bc76c38cb77cf9e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Basic
import Mathbin.Logic.IsEmpty

/-!
# Unbundled relation classes

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

In this file we prove some properties of `is_*` classes defined in `init.algebra.classes`. The main
difference between these classes and the usual order classes (`preorder` etc) is that usual classes
extend `has_le` and/or `has_lt` while these classes take a relation as an explicit argument.

-/

universe u v

variable {α : Type u} {β : Type v} {r : α → α → Prop} {s : β → β → Prop}

open Function

#print of_eq /-
theorem of_eq [IsRefl α r] : ∀ {a b}, a = b → r a b
  | _, _, ⟨h⟩ => refl _
#align of_eq of_eq
-/

#print comm /-
theorem comm [IsSymm α r] {a b : α} : r a b ↔ r b a :=
  ⟨symm, symm⟩
#align comm comm
-/

#print antisymm' /-
theorem antisymm' [IsAntisymm α r] {a b : α} : r a b → r b a → b = a := fun h h' => antisymm h' h
#align antisymm' antisymm'
-/

#print antisymm_iff /-
theorem antisymm_iff [IsRefl α r] [IsAntisymm α r] {a b : α} : r a b ∧ r b a ↔ a = b :=
  ⟨fun h => antisymm h.1 h.2, by
    rintro rfl
    exact ⟨refl _, refl _⟩⟩
#align antisymm_iff antisymm_iff
-/

#print antisymm_of /-
/-- A version of `antisymm` with `r` explicit.

This lemma matches the lemmas from lean core in `init.algebra.classes`, but is missing there.  -/
@[elab_without_expected_type]
theorem antisymm_of (r : α → α → Prop) [IsAntisymm α r] {a b : α} : r a b → r b a → a = b :=
  antisymm
#align antisymm_of antisymm_of
-/

#print antisymm_of' /-
/-- A version of `antisymm'` with `r` explicit.

This lemma matches the lemmas from lean core in `init.algebra.classes`, but is missing there.  -/
@[elab_without_expected_type]
theorem antisymm_of' (r : α → α → Prop) [IsAntisymm α r] {a b : α} : r a b → r b a → b = a :=
  antisymm'
#align antisymm_of' antisymm_of'
-/

#print comm_of /-
/-- A version of `comm` with `r` explicit.

This lemma matches the lemmas from lean core in `init.algebra.classes`, but is missing there.  -/
theorem comm_of (r : α → α → Prop) [IsSymm α r] {a b : α} : r a b ↔ r b a :=
  comm
#align comm_of comm_of
-/

#print IsRefl.swap /-
theorem IsRefl.swap (r) [IsRefl α r] : IsRefl α (swap r) :=
  ⟨refl_of r⟩
#align is_refl.swap IsRefl.swap
-/

#print IsIrrefl.swap /-
theorem IsIrrefl.swap (r) [IsIrrefl α r] : IsIrrefl α (swap r) :=
  ⟨irrefl_of r⟩
#align is_irrefl.swap IsIrrefl.swap
-/

#print IsTrans.swap /-
theorem IsTrans.swap (r) [IsTrans α r] : IsTrans α (swap r) :=
  ⟨fun a b c h₁ h₂ => trans_of r h₂ h₁⟩
#align is_trans.swap IsTrans.swap
-/

#print IsAntisymm.swap /-
theorem IsAntisymm.swap (r) [IsAntisymm α r] : IsAntisymm α (swap r) :=
  ⟨fun a b h₁ h₂ => antisymm h₂ h₁⟩
#align is_antisymm.swap IsAntisymm.swap
-/

#print IsAsymm.swap /-
theorem IsAsymm.swap (r) [IsAsymm α r] : IsAsymm α (swap r) :=
  ⟨fun a b h₁ h₂ => asymm_of r h₂ h₁⟩
#align is_asymm.swap IsAsymm.swap
-/

#print IsTotal.swap /-
theorem IsTotal.swap (r) [IsTotal α r] : IsTotal α (swap r) :=
  ⟨fun a b => (total_of r a b).symm⟩
#align is_total.swap IsTotal.swap
-/

#print IsTrichotomous.swap /-
theorem IsTrichotomous.swap (r) [IsTrichotomous α r] : IsTrichotomous α (swap r) :=
  ⟨fun a b => by simpa [swap, or_comm, or_left_comm] using trichotomous_of r a b⟩
#align is_trichotomous.swap IsTrichotomous.swap
-/

#print IsPreorder.swap /-
theorem IsPreorder.swap (r) [IsPreorder α r] : IsPreorder α (swap r) :=
  { @IsRefl.swap α r _, @IsTrans.swap α r _ with }
#align is_preorder.swap IsPreorder.swap
-/

#print IsStrictOrder.swap /-
theorem IsStrictOrder.swap (r) [IsStrictOrder α r] : IsStrictOrder α (swap r) :=
  { @IsIrrefl.swap α r _, @IsTrans.swap α r _ with }
#align is_strict_order.swap IsStrictOrder.swap
-/

#print IsPartialOrder.swap /-
theorem IsPartialOrder.swap (r) [IsPartialOrder α r] : IsPartialOrder α (swap r) :=
  { @IsPreorder.swap α r _, @IsAntisymm.swap α r _ with }
#align is_partial_order.swap IsPartialOrder.swap
-/

#print IsTotalPreorder.swap /-
theorem IsTotalPreorder.swap (r) [IsTotalPreorder α r] : IsTotalPreorder α (swap r) :=
  { @IsPreorder.swap α r _, @IsTotal.swap α r _ with }
#align is_total_preorder.swap IsTotalPreorder.swap
-/

#print IsLinearOrder.swap /-
theorem IsLinearOrder.swap (r) [IsLinearOrder α r] : IsLinearOrder α (swap r) :=
  { @IsPartialOrder.swap α r _, @IsTotal.swap α r _ with }
#align is_linear_order.swap IsLinearOrder.swap
-/

#print IsAsymm.isAntisymm /-
protected theorem IsAsymm.isAntisymm (r) [IsAsymm α r] : IsAntisymm α r :=
  ⟨fun x y h₁ h₂ => (asymm h₁ h₂).elim⟩
#align is_asymm.is_antisymm IsAsymm.isAntisymm
-/

#print IsAsymm.isIrrefl /-
protected theorem IsAsymm.isIrrefl [IsAsymm α r] : IsIrrefl α r :=
  ⟨fun a h => asymm h h⟩
#align is_asymm.is_irrefl IsAsymm.isIrrefl
-/

#print IsTotal.isTrichotomous /-
protected theorem IsTotal.isTrichotomous (r) [IsTotal α r] : IsTrichotomous α r :=
  ⟨fun a b => or_left_comm.1 (Or.inr <| total_of r a b)⟩
#align is_total.is_trichotomous IsTotal.isTrichotomous
-/

#print IsTotal.to_isRefl /-
-- see Note [lower instance priority]
instance (priority := 100) IsTotal.to_isRefl (r) [IsTotal α r] : IsRefl α r :=
  ⟨fun a => (or_self_iff _).1 <| total_of r a a⟩
#align is_total.to_is_refl IsTotal.to_isRefl
-/

#print ne_of_irrefl /-
theorem ne_of_irrefl {r} [IsIrrefl α r] : ∀ {x y : α}, r x y → x ≠ y
  | _, _, h, rfl => irrefl _ h
#align ne_of_irrefl ne_of_irrefl
-/

#print ne_of_irrefl' /-
theorem ne_of_irrefl' {r} [IsIrrefl α r] : ∀ {x y : α}, r x y → y ≠ x
  | _, _, h, rfl => irrefl _ h
#align ne_of_irrefl' ne_of_irrefl'
-/

#print not_rel_of_subsingleton /-
theorem not_rel_of_subsingleton (r) [IsIrrefl α r] [Subsingleton α] (x y) : ¬r x y :=
  Subsingleton.elim x y ▸ irrefl x
#align not_rel_of_subsingleton not_rel_of_subsingleton
-/

#print rel_of_subsingleton /-
theorem rel_of_subsingleton (r) [IsRefl α r] [Subsingleton α] (x y) : r x y :=
  Subsingleton.elim x y ▸ refl x
#align rel_of_subsingleton rel_of_subsingleton
-/

#print empty_relation_apply /-
@[simp]
theorem empty_relation_apply (a b : α) : EmptyRelation a b ↔ False :=
  Iff.rfl
#align empty_relation_apply empty_relation_apply
-/

#print eq_empty_relation /-
theorem eq_empty_relation (r) [IsIrrefl α r] [Subsingleton α] : r = EmptyRelation :=
  funext₂ <| by simpa using not_rel_of_subsingleton r
#align eq_empty_relation eq_empty_relation
-/

instance : IsIrrefl α EmptyRelation :=
  ⟨fun a => id⟩

#print trans_trichotomous_left /-
theorem trans_trichotomous_left [IsTrans α r] [IsTrichotomous α r] {a b c : α} :
    ¬r b a → r b c → r a c := by
  intro h₁ h₂; rcases trichotomous_of r a b with (h₃ | h₃ | h₃)
  exact trans h₃ h₂; rw [h₃]; exact h₂; exfalso; exact h₁ h₃
#align trans_trichotomous_left trans_trichotomous_left
-/

#print trans_trichotomous_right /-
theorem trans_trichotomous_right [IsTrans α r] [IsTrichotomous α r] {a b c : α} :
    r a b → ¬r c b → r a c := by
  intro h₁ h₂; rcases trichotomous_of r b c with (h₃ | h₃ | h₃)
  exact trans h₁ h₃; rw [← h₃]; exact h₁; exfalso; exact h₂ h₃
#align trans_trichotomous_right trans_trichotomous_right
-/

#print transitive_of_trans /-
theorem transitive_of_trans (r : α → α → Prop) [IsTrans α r] : Transitive r := fun _ _ _ => trans
#align transitive_of_trans transitive_of_trans
-/

#print extensional_of_trichotomous_of_irrefl /-
/-- In a trichotomous irreflexive order, every element is determined by the set of predecessors. -/
theorem extensional_of_trichotomous_of_irrefl (r : α → α → Prop) [IsTrichotomous α r] [IsIrrefl α r]
    {a b : α} (H : ∀ x, r x a ↔ r x b) : a = b :=
  ((@trichotomous _ r _ a b).resolve_left <| mt (H _).2 <| irrefl a).resolve_right <|
    mt (H _).1 <| irrefl b
#align extensional_of_trichotomous_of_irrefl extensional_of_trichotomous_of_irrefl
-/

#print partialOrderOfSO /-
/-- Construct a partial order from a `is_strict_order` relation.

See note [reducible non-instances]. -/
@[reducible]
def partialOrderOfSO (r) [IsStrictOrder α r] : PartialOrder α
    where
  le x y := x = y ∨ r x y
  lt := r
  le_refl x := Or.inl rfl
  le_trans x y z h₁ h₂ :=
    match y, z, h₁, h₂ with
    | _, _, Or.inl rfl, h₂ => h₂
    | _, _, h₁, Or.inl rfl => h₁
    | _, _, Or.inr h₁, Or.inr h₂ => Or.inr (trans h₁ h₂)
  le_antisymm x y h₁ h₂ :=
    match y, h₁, h₂ with
    | _, Or.inl rfl, h₂ => rfl
    | _, h₁, Or.inl rfl => rfl
    | _, Or.inr h₁, Or.inr h₂ => (asymm h₁ h₂).elim
  lt_iff_le_not_le x y :=
    ⟨fun h => ⟨Or.inr h, not_or_of_not (fun e => by rw [e] at h <;> exact irrefl _ h) (asymm h)⟩,
      fun ⟨h₁, h₂⟩ => h₁.resolve_left fun e => h₂ <| e ▸ Or.inl rfl⟩
#align partial_order_of_SO partialOrderOfSO
-/

#print linearOrderOfSTO /-
/-- Construct a linear order from an `is_strict_total_order` relation.

See note [reducible non-instances]. -/
@[reducible]
def linearOrderOfSTO (r) [IsStrictTotalOrder α r] [∀ x y, Decidable ¬r x y] : LinearOrder α :=
  {
    partialOrderOfSO
      r with
    le_total := fun x y =>
      match y, trichotomous_of r x y with
      | y, Or.inl h => Or.inl (Or.inr h)
      | _, Or.inr (Or.inl rfl) => Or.inl (Or.inl rfl)
      | _, Or.inr (Or.inr h) => Or.inr (Or.inr h)
    decidableLe := fun x y =>
      decidable_of_iff (¬r y x)
        ⟨fun h => ((trichotomous_of r y x).resolve_left h).imp Eq.symm id, fun h =>
          h.elim (fun h => h ▸ irrefl_of _ _) (asymm_of r)⟩ }
#align linear_order_of_STO linearOrderOfSTO
-/

#print IsStrictTotalOrder.swap /-
theorem IsStrictTotalOrder.swap (r) [IsStrictTotalOrder α r] : IsStrictTotalOrder α (swap r) :=
  { IsTrichotomous.swap r, IsStrictOrder.swap r with }
#align is_strict_total_order.swap IsStrictTotalOrder.swap
-/

/-! ### Order connection -/

#print IsOrderConnected /-
/-- A connected order is one satisfying the condition `a < c → a < b ∨ b < c`.
  This is recognizable as an intuitionistic substitute for `a ≤ b ∨ b ≤ a` on
  the constructive reals, and is also known as negative transitivity,
  since the contrapositive asserts transitivity of the relation `¬ a < b`.  -/
class IsOrderConnected (α : Type u) (lt : α → α → Prop) : Prop where
  conn : ∀ a b c, lt a c → lt a b ∨ lt b c
#align is_order_connected IsOrderConnected
-/

#print IsOrderConnected.neg_trans /-
theorem IsOrderConnected.neg_trans {r : α → α → Prop} [IsOrderConnected α r] {a b c} (h₁ : ¬r a b)
    (h₂ : ¬r b c) : ¬r a c :=
  mt (IsOrderConnected.conn a b c) <| by simp [h₁, h₂]
#align is_order_connected.neg_trans IsOrderConnected.neg_trans
-/

#print isStrictWeakOrder_of_isOrderConnected /-
theorem isStrictWeakOrder_of_isOrderConnected [IsAsymm α r] [IsOrderConnected α r] :
    IsStrictWeakOrder α r :=
  {
    @IsAsymm.isIrrefl α r
      _ with
    trans := fun a b c h₁ h₂ => (IsOrderConnected.conn _ c _ h₁).resolve_right (asymm h₂)
    incomp_trans := fun a b c ⟨h₁, h₂⟩ ⟨h₃, h₄⟩ =>
      ⟨IsOrderConnected.neg_trans h₁ h₃, IsOrderConnected.neg_trans h₄ h₂⟩ }
#align is_strict_weak_order_of_is_order_connected isStrictWeakOrder_of_isOrderConnected
-/

#print isStrictOrderConnected_of_isStrictTotalOrder /-
-- see Note [lower instance priority]
instance (priority := 100) isStrictOrderConnected_of_isStrictTotalOrder [IsStrictTotalOrder α r] :
    IsOrderConnected α r :=
  ⟨fun a b c h =>
    (trichotomous _ _).imp_right fun o => o.elim (fun e => e ▸ h) fun h' => trans h' h⟩
#align is_order_connected_of_is_strict_total_order isStrictOrderConnected_of_isStrictTotalOrder
-/

#print isStrictTotalOrder_of_isStrictTotalOrder /-
-- see Note [lower instance priority]
instance (priority := 100) isStrictTotalOrder_of_isStrictTotalOrder [IsStrictTotalOrder α r] :
    IsStrictWeakOrder α r :=
  { isStrictWeakOrder_of_isOrderConnected with }
#align is_strict_weak_order_of_is_strict_total_order isStrictTotalOrder_of_isStrictTotalOrder
-/

/-! ### Well-order -/

#print IsWellFounded /-
/-- A well-founded relation. Not to be confused with `is_well_order`. -/
@[mk_iff]
class IsWellFounded (α : Type u) (r : α → α → Prop) : Prop where
  wf : WellFounded r
#align is_well_founded IsWellFounded
-/

instance WellFoundedRelation.isWellFounded [h : WellFoundedRelation α] :
    IsWellFounded α WellFoundedRelation.R :=
  { h with }
#align has_well_founded.is_well_founded WellFoundedRelation.isWellFounded

namespace IsWellFounded

variable (r) [IsWellFounded α r]

#print IsWellFounded.induction /-
/-- Induction on a well-founded relation. -/
theorem induction {C : α → Prop} : ∀ a, (∀ x, (∀ y, r y x → C y) → C x) → C a :=
  wf.induction
#align is_well_founded.induction IsWellFounded.induction
-/

#print IsWellFounded.apply /-
/-- All values are accessible under the well-founded relation. -/
theorem apply : ∀ a, Acc r a :=
  wf.apply
#align is_well_founded.apply IsWellFounded.apply
-/

#print IsWellFounded.fix /-
/-- Creates data, given a way to generate a value from all that compare as less under a well-founded
relation. See also `is_well_founded.fix_eq`. -/
def fix {C : α → Sort _} : (∀ x : α, (∀ y : α, r y x → C y) → C x) → ∀ x : α, C x :=
  wf.fix
#align is_well_founded.fix IsWellFounded.fix
-/

/- warning: is_well_founded.fix_eq -> IsWellFounded.fix_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (r : α -> α -> Prop) [_inst_1 : IsWellFounded.{u1} α r] {C : α -> Sort.{u2}} (F : forall (x : α), (forall (y : α), (r y x) -> (C y)) -> (C x)) (x : α), Eq.{u2} (C x) (IsWellFounded.fix.{u1, u2} α r _inst_1 (fun (y : α) => C y) F x) (F x (fun (y : α) (h : r y x) => IsWellFounded.fix.{u1, u2} α r _inst_1 C F y))
but is expected to have type
  forall {α : Type.{u2}} (r : α -> α -> Prop) [_inst_1 : IsWellFounded.{u2} α r] {C : α -> Sort.{u1}} (F : forall (x : α), (forall (y : α), (r y x) -> (C y)) -> (C x)) (x : α), Eq.{u1} (C x) (IsWellFounded.fix.{u2, u1} α r _inst_1 (fun (y : α) => C y) F x) (F x (fun (y : α) (h : r y x) => IsWellFounded.fix.{u2, u1} α r _inst_1 (fun (y : α) => C y) F y))
Case conversion may be inaccurate. Consider using '#align is_well_founded.fix_eq IsWellFounded.fix_eqₓ'. -/
/-- The value from `is_well_founded.fix` is built from the previous ones as specified. -/
theorem fix_eq {C : α → Sort _} (F : ∀ x : α, (∀ y : α, r y x → C y) → C x) :
    ∀ x, fix r F x = F x fun y h => fix r F y :=
  wf.fix_eq F
#align is_well_founded.fix_eq IsWellFounded.fix_eq

/-- Derive a `has_well_founded` instance from an `is_well_founded` instance. -/
def toHasWellFounded : WellFoundedRelation α :=
  ⟨r, IsWellFounded.wf⟩
#align is_well_founded.to_has_well_founded IsWellFounded.toHasWellFounded

end IsWellFounded

#print WellFounded.asymmetric /-
theorem WellFounded.asymmetric {α : Sort _} {r : α → α → Prop} (h : WellFounded r) :
    ∀ ⦃a b⦄, r a b → ¬r b a
  | a => fun b hab hba => WellFounded.asymmetric hba hab termination_by' ⟨_, h⟩
#align well_founded.asymmetric WellFounded.asymmetric
-/

-- see Note [lower instance priority]
instance (priority := 100) IsWellFounded.isAsymm (r : α → α → Prop) [IsWellFounded α r] :
    IsAsymm α r :=
  ⟨IsWellFounded.wf.asymmetric⟩
#align is_well_founded.is_asymm IsWellFounded.isAsymm

-- see Note [lower instance priority]
instance (priority := 100) IsWellFounded.isIrrefl (r : α → α → Prop) [IsWellFounded α r] :
    IsIrrefl α r :=
  IsAsymm.isIrrefl
#align is_well_founded.is_irrefl IsWellFounded.isIrrefl

#print WellFoundedLT /-
/-- A class for a well founded relation `<`. -/
@[reducible]
def WellFoundedLT (α : Type _) [LT α] : Prop :=
  IsWellFounded α (· < ·)
#align well_founded_lt WellFoundedLT
-/

#print WellFoundedGT /-
/-- A class for a well founded relation `>`. -/
@[reducible]
def WellFoundedGT (α : Type _) [LT α] : Prop :=
  IsWellFounded α (· > ·)
#align well_founded_gt WellFoundedGT
-/

-- See note [lower instance priority]
instance (priority := 100) (α : Type _) [LT α] [h : WellFoundedLT α] : WellFoundedGT αᵒᵈ :=
  h

-- See note [lower instance priority]
instance (priority := 100) (α : Type _) [LT α] [h : WellFoundedGT α] : WellFoundedLT αᵒᵈ :=
  h

#print wellFoundedGT_dual_iff /-
theorem wellFoundedGT_dual_iff (α : Type _) [LT α] : WellFoundedGT αᵒᵈ ↔ WellFoundedLT α :=
  ⟨fun h => ⟨h.wf⟩, fun h => ⟨h.wf⟩⟩
#align well_founded_gt_dual_iff wellFoundedGT_dual_iff
-/

#print wellFoundedLT_dual_iff /-
theorem wellFoundedLT_dual_iff (α : Type _) [LT α] : WellFoundedLT αᵒᵈ ↔ WellFoundedGT α :=
  ⟨fun h => ⟨h.wf⟩, fun h => ⟨h.wf⟩⟩
#align well_founded_lt_dual_iff wellFoundedLT_dual_iff
-/

#print IsWellOrder /-
/-- A well order is a well-founded linear order. -/
class IsWellOrder (α : Type u) (r : α → α → Prop) extends IsTrichotomous α r, IsTrans α r,
  IsWellFounded α r : Prop
#align is_well_order IsWellOrder
-/

-- see Note [lower instance priority]
instance (priority := 100) IsWellOrder.isStrictTotalOrder {α} (r : α → α → Prop) [IsWellOrder α r] :
    IsStrictTotalOrder α r where
#align is_well_order.is_strict_total_order IsWellOrder.isStrictTotalOrder

-- see Note [lower instance priority]
instance (priority := 100) IsWellOrder.isTrichotomous {α} (r : α → α → Prop) [IsWellOrder α r] :
    IsTrichotomous α r := by infer_instance
#align is_well_order.is_trichotomous IsWellOrder.isTrichotomous

-- see Note [lower instance priority]
instance (priority := 100) IsWellOrder.isTrans {α} (r : α → α → Prop) [IsWellOrder α r] :
    IsTrans α r := by infer_instance
#align is_well_order.is_trans IsWellOrder.isTrans

-- see Note [lower instance priority]
instance (priority := 100) IsWellOrder.isIrrefl {α} (r : α → α → Prop) [IsWellOrder α r] :
    IsIrrefl α r := by infer_instance
#align is_well_order.is_irrefl IsWellOrder.isIrrefl

-- see Note [lower instance priority]
instance (priority := 100) IsWellOrder.isAsymm {α} (r : α → α → Prop) [IsWellOrder α r] :
    IsAsymm α r := by infer_instance
#align is_well_order.is_asymm IsWellOrder.isAsymm

namespace WellFoundedLT

variable [LT α] [WellFoundedLT α]

#print WellFoundedLT.induction /-
/-- Inducts on a well-founded `<` relation. -/
theorem induction {C : α → Prop} : ∀ a, (∀ x, (∀ y, y < x → C y) → C x) → C a :=
  IsWellFounded.induction _
#align well_founded_lt.induction WellFoundedLT.induction
-/

#print WellFoundedLT.apply /-
/-- All values are accessible under the well-founded `<`. -/
theorem apply : ∀ a : α, Acc (· < ·) a :=
  IsWellFounded.apply _
#align well_founded_lt.apply WellFoundedLT.apply
-/

#print WellFoundedLT.fix /-
/-- Creates data, given a way to generate a value from all that compare as lesser. See also
`well_founded_lt.fix_eq`. -/
def fix {C : α → Sort _} : (∀ x : α, (∀ y : α, y < x → C y) → C x) → ∀ x : α, C x :=
  IsWellFounded.fix (· < ·)
#align well_founded_lt.fix WellFoundedLT.fix
-/

/- warning: well_founded_lt.fix_eq -> WellFoundedLT.fix_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LT.{u1} α] [_inst_2 : WellFoundedLT.{u1} α _inst_1] {C : α -> Sort.{u2}} (F : forall (x : α), (forall (y : α), (LT.lt.{u1} α _inst_1 y x) -> (C y)) -> (C x)) (x : α), Eq.{u2} (C x) (WellFoundedLT.fix.{u1, u2} α _inst_1 _inst_2 (fun (y : α) => C y) F x) (F x (fun (y : α) (h : LT.lt.{u1} α _inst_1 y x) => WellFoundedLT.fix.{u1, u2} α _inst_1 _inst_2 C F y))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : LT.{u2} α] [_inst_2 : WellFoundedLT.{u2} α _inst_1] {C : α -> Sort.{u1}} (F : forall (x : α), (forall (y : α), (LT.lt.{u2} α _inst_1 y x) -> (C y)) -> (C x)) (x : α), Eq.{u1} (C x) (WellFoundedLT.fix.{u2, u1} α _inst_1 _inst_2 (fun (y : α) => C y) F x) (F x (fun (y : α) (h : LT.lt.{u2} α _inst_1 y x) => WellFoundedLT.fix.{u2, u1} α _inst_1 _inst_2 (fun (y : α) => C y) F y))
Case conversion may be inaccurate. Consider using '#align well_founded_lt.fix_eq WellFoundedLT.fix_eqₓ'. -/
/-- The value from `well_founded_lt.fix` is built from the previous ones as specified. -/
theorem fix_eq {C : α → Sort _} (F : ∀ x : α, (∀ y : α, y < x → C y) → C x) :
    ∀ x, fix F x = F x fun y h => fix F y :=
  IsWellFounded.fix_eq _ F
#align well_founded_lt.fix_eq WellFoundedLT.fix_eq

/-- Derive a `has_well_founded` instance from a `well_founded_lt` instance. -/
def toHasWellFounded : WellFoundedRelation α :=
  IsWellFounded.toHasWellFounded (· < ·)
#align well_founded_lt.to_has_well_founded WellFoundedLT.toHasWellFounded

end WellFoundedLT

namespace WellFoundedGT

variable [LT α] [WellFoundedGT α]

#print WellFoundedGT.induction /-
/-- Inducts on a well-founded `>` relation. -/
theorem induction {C : α → Prop} : ∀ a, (∀ x, (∀ y, x < y → C y) → C x) → C a :=
  IsWellFounded.induction _
#align well_founded_gt.induction WellFoundedGT.induction
-/

#print WellFoundedGT.apply /-
/-- All values are accessible under the well-founded `>`. -/
theorem apply : ∀ a : α, Acc (· > ·) a :=
  IsWellFounded.apply _
#align well_founded_gt.apply WellFoundedGT.apply
-/

#print WellFoundedGT.fix /-
/-- Creates data, given a way to generate a value from all that compare as greater. See also
`well_founded_gt.fix_eq`. -/
def fix {C : α → Sort _} : (∀ x : α, (∀ y : α, x < y → C y) → C x) → ∀ x : α, C x :=
  IsWellFounded.fix (· > ·)
#align well_founded_gt.fix WellFoundedGT.fix
-/

/- warning: well_founded_gt.fix_eq -> WellFoundedGT.fix_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LT.{u1} α] [_inst_2 : WellFoundedGT.{u1} α _inst_1] {C : α -> Sort.{u2}} (F : forall (x : α), (forall (y : α), (LT.lt.{u1} α _inst_1 x y) -> (C y)) -> (C x)) (x : α), Eq.{u2} (C x) (WellFoundedGT.fix.{u1, u2} α _inst_1 _inst_2 (fun (y : α) => C y) F x) (F x (fun (y : α) (h : LT.lt.{u1} α _inst_1 x y) => WellFoundedGT.fix.{u1, u2} α _inst_1 _inst_2 C F y))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : LT.{u2} α] [_inst_2 : WellFoundedGT.{u2} α _inst_1] {C : α -> Sort.{u1}} (F : forall (x : α), (forall (y : α), (LT.lt.{u2} α _inst_1 x y) -> (C y)) -> (C x)) (x : α), Eq.{u1} (C x) (WellFoundedGT.fix.{u2, u1} α _inst_1 _inst_2 (fun (y : α) => C y) F x) (F x (fun (y : α) (h : LT.lt.{u2} α _inst_1 x y) => WellFoundedGT.fix.{u2, u1} α _inst_1 _inst_2 (fun (y : α) => C y) F y))
Case conversion may be inaccurate. Consider using '#align well_founded_gt.fix_eq WellFoundedGT.fix_eqₓ'. -/
/-- The value from `well_founded_gt.fix` is built from the successive ones as specified. -/
theorem fix_eq {C : α → Sort _} (F : ∀ x : α, (∀ y : α, x < y → C y) → C x) :
    ∀ x, fix F x = F x fun y h => fix F y :=
  IsWellFounded.fix_eq _ F
#align well_founded_gt.fix_eq WellFoundedGT.fix_eq

/-- Derive a `has_well_founded` instance from a `well_founded_gt` instance. -/
def toHasWellFounded : WellFoundedRelation α :=
  IsWellFounded.toHasWellFounded (· > ·)
#align well_founded_gt.to_has_well_founded WellFoundedGT.toHasWellFounded

end WellFoundedGT

#print IsWellOrder.linearOrder /-
/-- Construct a decidable linear order from a well-founded linear order. -/
noncomputable def IsWellOrder.linearOrder (r : α → α → Prop) [IsWellOrder α r] : LinearOrder α :=
  letI := fun x y => Classical.dec ¬r x y
  linearOrderOfSTO r
#align is_well_order.linear_order IsWellOrder.linearOrder
-/

#print IsWellOrder.toHasWellFounded /-
/-- Derive a `has_well_founded` instance from a `is_well_order` instance. -/
def IsWellOrder.toHasWellFounded [LT α] [hwo : IsWellOrder α (· < ·)] : WellFoundedRelation α
    where
  R := (· < ·)
  wf := hwo.wf
#align is_well_order.to_has_well_founded IsWellOrder.toHasWellFounded
-/

#print Subsingleton.isWellOrder /-
-- This isn't made into an instance as it loops with `is_irrefl α r`.
theorem Subsingleton.isWellOrder [Subsingleton α] (r : α → α → Prop) [hr : IsIrrefl α r] :
    IsWellOrder α r :=
  { hr with
    trichotomous := fun a b => Or.inr <| Or.inl <| Subsingleton.elim a b
    trans := fun a b c h => (not_rel_of_subsingleton r a b h).elim
    wf := ⟨fun a => ⟨_, fun y h => (not_rel_of_subsingleton r y a h).elim⟩⟩ }
#align subsingleton.is_well_order Subsingleton.isWellOrder
-/

instance EmptyRelation.isWellOrder [Subsingleton α] : IsWellOrder α EmptyRelation :=
  Subsingleton.isWellOrder _
#align empty_relation.is_well_order EmptyRelation.isWellOrder

instance (priority := 100) IsEmpty.isWellOrder [IsEmpty α] (r : α → α → Prop) : IsWellOrder α r
    where
  trichotomous := isEmptyElim
  trans := isEmptyElim
  wf := wellFounded_of_isEmpty r
#align is_empty.is_well_order IsEmpty.isWellOrder

instance Prod.Lex.isWellFounded [IsWellFounded α r] [IsWellFounded β s] :
    IsWellFounded (α × β) (Prod.Lex r s) :=
  ⟨WellFounded.prod_lex IsWellFounded.wf IsWellFounded.wf⟩
#align prod.lex.is_well_founded Prod.Lex.isWellFounded

instance Prod.Lex.isWellOrder [IsWellOrder α r] [IsWellOrder β s] :
    IsWellOrder (α × β) (Prod.Lex r s)
    where
  trichotomous := fun ⟨a₁, a₂⟩ ⟨b₁, b₂⟩ =>
    match @trichotomous _ r _ a₁ b₁ with
    | Or.inl h₁ => Or.inl <| Prod.Lex.left _ _ h₁
    | Or.inr (Or.inr h₁) => Or.inr <| Or.inr <| Prod.Lex.left _ _ h₁
    | Or.inr (Or.inl e) =>
      e ▸
        match @trichotomous _ s _ a₂ b₂ with
        | Or.inl h => Or.inl <| Prod.Lex.right _ h
        | Or.inr (Or.inr h) => Or.inr <| Or.inr <| Prod.Lex.right _ h
        | Or.inr (Or.inl e) => e ▸ Or.inr <| Or.inl rfl
  trans a b c h₁ h₂ :=
    by
    cases' h₁ with a₁ a₂ b₁ b₂ ab a₁ b₁ b₂ ab <;> cases' h₂ with _ _ c₁ c₂ bc _ _ c₂ bc
    · exact Prod.Lex.left _ _ (trans ab bc)
    · exact Prod.Lex.left _ _ ab
    · exact Prod.Lex.left _ _ bc
    · exact Prod.Lex.right _ (trans ab bc)
  wf := WellFounded.prod_lex IsWellFounded.wf IsWellFounded.wf
#align prod.lex.is_well_order Prod.Lex.isWellOrder

instance InvImage.isWellFounded (r : α → α → Prop) [IsWellFounded α r] (f : β → α) :
    IsWellFounded _ (InvImage r f) :=
  ⟨InvImage.wf f IsWellFounded.wf⟩
#align inv_image.is_well_founded InvImage.isWellFounded

instance Measure.isWellFounded (f : α → ℕ) : IsWellFounded _ (Measure f) :=
  ⟨measure_wf f⟩
#align measure.is_well_founded Measure.isWellFounded

#print Subrelation.isWellFounded /-
theorem Subrelation.isWellFounded (r : α → α → Prop) [IsWellFounded α r] {s : α → α → Prop}
    (h : Subrelation s r) : IsWellFounded α s :=
  ⟨h.wf IsWellFounded.wf⟩
#align subrelation.is_well_founded Subrelation.isWellFounded
-/

namespace Set

#print Set.Unbounded /-
/-- An unbounded or cofinal set. -/
def Unbounded (r : α → α → Prop) (s : Set α) : Prop :=
  ∀ a, ∃ b ∈ s, ¬r b a
#align set.unbounded Set.Unbounded
-/

#print Set.Bounded /-
/-- A bounded or final set. Not to be confused with `metric.bounded`. -/
def Bounded (r : α → α → Prop) (s : Set α) : Prop :=
  ∃ a, ∀ b ∈ s, r b a
#align set.bounded Set.Bounded
-/

#print Set.not_bounded_iff /-
@[simp]
theorem not_bounded_iff {r : α → α → Prop} (s : Set α) : ¬Bounded r s ↔ Unbounded r s := by
  simp only [bounded, unbounded, not_forall, not_exists, exists_prop, not_and, Classical.not_not]
#align set.not_bounded_iff Set.not_bounded_iff
-/

#print Set.not_unbounded_iff /-
@[simp]
theorem not_unbounded_iff {r : α → α → Prop} (s : Set α) : ¬Unbounded r s ↔ Bounded r s := by
  rw [not_iff_comm, not_bounded_iff]
#align set.not_unbounded_iff Set.not_unbounded_iff
-/

#print Set.unbounded_of_isEmpty /-
theorem unbounded_of_isEmpty [IsEmpty α] {r : α → α → Prop} (s : Set α) : Unbounded r s :=
  isEmptyElim
#align set.unbounded_of_is_empty Set.unbounded_of_isEmpty
-/

end Set

namespace Prod

#print Prod.isRefl_preimage_fst /-
instance isRefl_preimage_fst {r : α → α → Prop} [h : IsRefl α r] :
    IsRefl (α × α) (Prod.fst ⁻¹'o r) :=
  ⟨fun a => refl_of r a.1⟩
#align prod.is_refl_preimage_fst Prod.isRefl_preimage_fst
-/

#print Prod.isRefl_preimage_snd /-
instance isRefl_preimage_snd {r : α → α → Prop} [h : IsRefl α r] :
    IsRefl (α × α) (Prod.snd ⁻¹'o r) :=
  ⟨fun a => refl_of r a.2⟩
#align prod.is_refl_preimage_snd Prod.isRefl_preimage_snd
-/

#print Prod.isTrans_preimage_fst /-
instance isTrans_preimage_fst {r : α → α → Prop} [h : IsTrans α r] :
    IsTrans (α × α) (Prod.fst ⁻¹'o r) :=
  ⟨fun _ _ _ => trans_of r⟩
#align prod.is_trans_preimage_fst Prod.isTrans_preimage_fst
-/

#print Prod.isTrans_preimage_snd /-
instance isTrans_preimage_snd {r : α → α → Prop} [h : IsTrans α r] :
    IsTrans (α × α) (Prod.snd ⁻¹'o r) :=
  ⟨fun _ _ _ => trans_of r⟩
#align prod.is_trans_preimage_snd Prod.isTrans_preimage_snd
-/

end Prod

/-! ### Strict-non strict relations -/

#print IsNonstrictStrictOrder /-
/-- An unbundled relation class stating that `r` is the nonstrict relation corresponding to the
strict relation `s`. Compare `preorder.lt_iff_le_not_le`. This is mostly meant to provide dot
notation on `(⊆)` and `(⊂)`. -/
class IsNonstrictStrictOrder (α : Type _) (r s : α → α → Prop) where
  right_iff_left_not_left (a b : α) : s a b ↔ r a b ∧ ¬r b a
#align is_nonstrict_strict_order IsNonstrictStrictOrder
-/

#print right_iff_left_not_left /-
theorem right_iff_left_not_left {r s : α → α → Prop} [IsNonstrictStrictOrder α r s] {a b : α} :
    s a b ↔ r a b ∧ ¬r b a :=
  IsNonstrictStrictOrder.right_iff_left_not_left _ _
#align right_iff_left_not_left right_iff_left_not_left
-/

#print right_iff_left_not_left_of /-
/-- A version of `right_iff_left_not_left` with explicit `r` and `s`. -/
theorem right_iff_left_not_left_of (r s : α → α → Prop) [IsNonstrictStrictOrder α r s] {a b : α} :
    s a b ↔ r a b ∧ ¬r b a :=
  right_iff_left_not_left
#align right_iff_left_not_left_of right_iff_left_not_left_of
-/

-- The free parameter `r` is strictly speaking not uniquely determined by `s`, but in practice it
-- always has a unique instance, so this is not dangerous.
-- see Note [lower instance priority]
@[nolint dangerous_instance]
instance (priority := 100) IsNonstrictStrictOrder.to_isIrrefl {r : α → α → Prop} {s : α → α → Prop}
    [IsNonstrictStrictOrder α r s] : IsIrrefl α s :=
  ⟨fun a h => ((right_iff_left_not_left_of r s).1 h).2 ((right_iff_left_not_left_of r s).1 h).1⟩
#align is_nonstrict_strict_order.to_is_irrefl IsNonstrictStrictOrder.to_isIrrefl

/-! #### `⊆` and `⊂` -/

section Subset

variable [HasSubset α] {a b c : α}

#print subset_of_eq_of_subset /-
theorem subset_of_eq_of_subset (hab : a = b) (hbc : b ⊆ c) : a ⊆ c := by rwa [hab]
#align subset_of_eq_of_subset subset_of_eq_of_subset
-/

#print subset_of_subset_of_eq /-
theorem subset_of_subset_of_eq (hab : a ⊆ b) (hbc : b = c) : a ⊆ c := by rwa [← hbc]
#align subset_of_subset_of_eq subset_of_subset_of_eq
-/

#print subset_refl /-
@[refl]
theorem subset_refl [IsRefl α (· ⊆ ·)] (a : α) : a ⊆ a :=
  refl _
#align subset_refl subset_refl
-/

#print subset_rfl /-
theorem subset_rfl [IsRefl α (· ⊆ ·)] : a ⊆ a :=
  refl _
#align subset_rfl subset_rfl
-/

#print subset_of_eq /-
theorem subset_of_eq [IsRefl α (· ⊆ ·)] : a = b → a ⊆ b := fun h => h ▸ subset_rfl
#align subset_of_eq subset_of_eq
-/

#print superset_of_eq /-
theorem superset_of_eq [IsRefl α (· ⊆ ·)] : a = b → b ⊆ a := fun h => h ▸ subset_rfl
#align superset_of_eq superset_of_eq
-/

#print ne_of_not_subset /-
theorem ne_of_not_subset [IsRefl α (· ⊆ ·)] : ¬a ⊆ b → a ≠ b :=
  mt subset_of_eq
#align ne_of_not_subset ne_of_not_subset
-/

#print ne_of_not_superset /-
theorem ne_of_not_superset [IsRefl α (· ⊆ ·)] : ¬a ⊆ b → b ≠ a :=
  mt superset_of_eq
#align ne_of_not_superset ne_of_not_superset
-/

#print subset_trans /-
@[trans]
theorem subset_trans [IsTrans α (· ⊆ ·)] {a b c : α} : a ⊆ b → b ⊆ c → a ⊆ c :=
  trans
#align subset_trans subset_trans
-/

#print subset_antisymm /-
theorem subset_antisymm [IsAntisymm α (· ⊆ ·)] (h : a ⊆ b) (h' : b ⊆ a) : a = b :=
  antisymm h h'
#align subset_antisymm subset_antisymm
-/

#print superset_antisymm /-
theorem superset_antisymm [IsAntisymm α (· ⊆ ·)] (h : a ⊆ b) (h' : b ⊆ a) : b = a :=
  antisymm' h h'
#align superset_antisymm superset_antisymm
-/

alias subset_of_eq_of_subset ← Eq.trans_subset
#align eq.trans_subset Eq.trans_subset

alias subset_of_subset_of_eq ← HasSubset.subset.trans_eq
#align has_subset.subset.trans_eq HasSubset.subset.trans_eq

alias subset_of_eq ← Eq.subset'
#align eq.subset' Eq.subset'

--TODO: Fix it and kill `eq.subset`
alias superset_of_eq ← Eq.superset
#align eq.superset Eq.superset

alias subset_trans ← HasSubset.Subset.trans
#align has_subset.subset.trans HasSubset.Subset.trans

alias subset_antisymm ← HasSubset.Subset.antisymm
#align has_subset.subset.antisymm HasSubset.Subset.antisymm

alias superset_antisymm ← HasSubset.Subset.antisymm'
#align has_subset.subset.antisymm' HasSubset.Subset.antisymm'

#print subset_antisymm_iff /-
theorem subset_antisymm_iff [IsRefl α (· ⊆ ·)] [IsAntisymm α (· ⊆ ·)] : a = b ↔ a ⊆ b ∧ b ⊆ a :=
  ⟨fun h => ⟨h.subset', h.Superset⟩, fun h => h.1.antisymm h.2⟩
#align subset_antisymm_iff subset_antisymm_iff
-/

#print superset_antisymm_iff /-
theorem superset_antisymm_iff [IsRefl α (· ⊆ ·)] [IsAntisymm α (· ⊆ ·)] : a = b ↔ b ⊆ a ∧ a ⊆ b :=
  ⟨fun h => ⟨h.Superset, h.subset'⟩, fun h => h.1.antisymm' h.2⟩
#align superset_antisymm_iff superset_antisymm_iff
-/

end Subset

section Ssubset

variable [HasSSubset α] {a b c : α}

#print ssubset_of_eq_of_ssubset /-
theorem ssubset_of_eq_of_ssubset (hab : a = b) (hbc : b ⊂ c) : a ⊂ c := by rwa [hab]
#align ssubset_of_eq_of_ssubset ssubset_of_eq_of_ssubset
-/

#print ssubset_of_ssubset_of_eq /-
theorem ssubset_of_ssubset_of_eq (hab : a ⊂ b) (hbc : b = c) : a ⊂ c := by rwa [← hbc]
#align ssubset_of_ssubset_of_eq ssubset_of_ssubset_of_eq
-/

#print ssubset_irrefl /-
theorem ssubset_irrefl [IsIrrefl α (· ⊂ ·)] (a : α) : ¬a ⊂ a :=
  irrefl _
#align ssubset_irrefl ssubset_irrefl
-/

#print ssubset_irrfl /-
theorem ssubset_irrfl [IsIrrefl α (· ⊂ ·)] {a : α} : ¬a ⊂ a :=
  irrefl _
#align ssubset_irrfl ssubset_irrfl
-/

#print ne_of_ssubset /-
theorem ne_of_ssubset [IsIrrefl α (· ⊂ ·)] {a b : α} : a ⊂ b → a ≠ b :=
  ne_of_irrefl
#align ne_of_ssubset ne_of_ssubset
-/

#print ne_of_ssuperset /-
theorem ne_of_ssuperset [IsIrrefl α (· ⊂ ·)] {a b : α} : a ⊂ b → b ≠ a :=
  ne_of_irrefl'
#align ne_of_ssuperset ne_of_ssuperset
-/

#print ssubset_trans /-
@[trans]
theorem ssubset_trans [IsTrans α (· ⊂ ·)] {a b c : α} : a ⊂ b → b ⊂ c → a ⊂ c :=
  trans
#align ssubset_trans ssubset_trans
-/

#print ssubset_asymm /-
theorem ssubset_asymm [IsAsymm α (· ⊂ ·)] {a b : α} (h : a ⊂ b) : ¬b ⊂ a :=
  asymm h
#align ssubset_asymm ssubset_asymm
-/

alias ssubset_of_eq_of_ssubset ← Eq.trans_ssubset
#align eq.trans_ssubset Eq.trans_ssubset

alias ssubset_of_ssubset_of_eq ← HasSSubset.SSubset.trans_eq
#align has_ssubset.ssubset.trans_eq HasSSubset.SSubset.trans_eq

alias ssubset_irrfl ← HasSSubset.SSubset.false
#align has_ssubset.ssubset.false HasSSubset.SSubset.false

alias ne_of_ssubset ← HasSSubset.SSubset.ne
#align has_ssubset.ssubset.ne HasSSubset.SSubset.ne

alias ne_of_ssuperset ← HasSSubset.SSubset.ne'
#align has_ssubset.ssubset.ne' HasSSubset.SSubset.ne'

alias ssubset_trans ← HasSSubset.SSubset.trans
#align has_ssubset.ssubset.trans HasSSubset.SSubset.trans

alias ssubset_asymm ← HasSSubset.SSubset.asymm
#align has_ssubset.ssubset.asymm HasSSubset.SSubset.asymm

end Ssubset

section SubsetSsubset

variable [HasSubset α] [HasSSubset α] [IsNonstrictStrictOrder α (· ⊆ ·) (· ⊂ ·)] {a b c : α}

#print ssubset_iff_subset_not_subset /-
theorem ssubset_iff_subset_not_subset : a ⊂ b ↔ a ⊆ b ∧ ¬b ⊆ a :=
  right_iff_left_not_left
#align ssubset_iff_subset_not_subset ssubset_iff_subset_not_subset
-/

#print subset_of_ssubset /-
theorem subset_of_ssubset (h : a ⊂ b) : a ⊆ b :=
  (ssubset_iff_subset_not_subset.1 h).1
#align subset_of_ssubset subset_of_ssubset
-/

#print not_subset_of_ssubset /-
theorem not_subset_of_ssubset (h : a ⊂ b) : ¬b ⊆ a :=
  (ssubset_iff_subset_not_subset.1 h).2
#align not_subset_of_ssubset not_subset_of_ssubset
-/

#print not_ssubset_of_subset /-
theorem not_ssubset_of_subset (h : a ⊆ b) : ¬b ⊂ a := fun h' => not_subset_of_ssubset h' h
#align not_ssubset_of_subset not_ssubset_of_subset
-/

#print ssubset_of_subset_not_subset /-
theorem ssubset_of_subset_not_subset (h₁ : a ⊆ b) (h₂ : ¬b ⊆ a) : a ⊂ b :=
  ssubset_iff_subset_not_subset.2 ⟨h₁, h₂⟩
#align ssubset_of_subset_not_subset ssubset_of_subset_not_subset
-/

alias subset_of_ssubset ← HasSSubset.SSubset.subset
#align has_ssubset.ssubset.subset HasSSubset.SSubset.subset

alias not_subset_of_ssubset ← HasSSubset.SSubset.not_subset
#align has_ssubset.ssubset.not_subset HasSSubset.SSubset.not_subset

alias not_ssubset_of_subset ← HasSubset.Subset.not_ssubset
#align has_subset.subset.not_ssubset HasSubset.Subset.not_ssubset

alias ssubset_of_subset_not_subset ← HasSubset.Subset.ssubset_of_not_subset
#align has_subset.subset.ssubset_of_not_subset HasSubset.Subset.ssubset_of_not_subset

#print ssubset_of_subset_of_ssubset /-
theorem ssubset_of_subset_of_ssubset [IsTrans α (· ⊆ ·)] (h₁ : a ⊆ b) (h₂ : b ⊂ c) : a ⊂ c :=
  (h₁.trans h₂.Subset).ssubset_of_not_subset fun h => h₂.not_subset <| h.trans h₁
#align ssubset_of_subset_of_ssubset ssubset_of_subset_of_ssubset
-/

#print ssubset_of_ssubset_of_subset /-
theorem ssubset_of_ssubset_of_subset [IsTrans α (· ⊆ ·)] (h₁ : a ⊂ b) (h₂ : b ⊆ c) : a ⊂ c :=
  (h₁.Subset.trans h₂).ssubset_of_not_subset fun h => h₁.not_subset <| h₂.trans h
#align ssubset_of_ssubset_of_subset ssubset_of_ssubset_of_subset
-/

#print ssubset_of_subset_of_ne /-
theorem ssubset_of_subset_of_ne [IsAntisymm α (· ⊆ ·)] (h₁ : a ⊆ b) (h₂ : a ≠ b) : a ⊂ b :=
  h₁.ssubset_of_not_subset <| mt h₁.antisymm h₂
#align ssubset_of_subset_of_ne ssubset_of_subset_of_ne
-/

#print ssubset_of_ne_of_subset /-
theorem ssubset_of_ne_of_subset [IsAntisymm α (· ⊆ ·)] (h₁ : a ≠ b) (h₂ : a ⊆ b) : a ⊂ b :=
  ssubset_of_subset_of_ne h₂ h₁
#align ssubset_of_ne_of_subset ssubset_of_ne_of_subset
-/

#print eq_or_ssubset_of_subset /-
theorem eq_or_ssubset_of_subset [IsAntisymm α (· ⊆ ·)] (h : a ⊆ b) : a = b ∨ a ⊂ b :=
  (em (b ⊆ a)).imp h.antisymm h.ssubset_of_not_subset
#align eq_or_ssubset_of_subset eq_or_ssubset_of_subset
-/

#print ssubset_or_eq_of_subset /-
theorem ssubset_or_eq_of_subset [IsAntisymm α (· ⊆ ·)] (h : a ⊆ b) : a ⊂ b ∨ a = b :=
  (eq_or_ssubset_of_subset h).symm
#align ssubset_or_eq_of_subset ssubset_or_eq_of_subset
-/

alias ssubset_of_subset_of_ssubset ← HasSubset.Subset.trans_ssubset
#align has_subset.subset.trans_ssubset HasSubset.Subset.trans_ssubset

alias ssubset_of_ssubset_of_subset ← HasSSubset.SSubset.trans_subset
#align has_ssubset.ssubset.trans_subset HasSSubset.SSubset.trans_subset

alias ssubset_of_subset_of_ne ← HasSubset.Subset.ssubset_of_ne
#align has_subset.subset.ssubset_of_ne HasSubset.Subset.ssubset_of_ne

alias ssubset_of_ne_of_subset ← Ne.ssubset_of_subset
#align ne.ssubset_of_subset Ne.ssubset_of_subset

alias eq_or_ssubset_of_subset ← HasSubset.Subset.eq_or_ssubset
#align has_subset.subset.eq_or_ssubset HasSubset.Subset.eq_or_ssubset

alias ssubset_or_eq_of_subset ← HasSubset.Subset.ssubset_or_eq
#align has_subset.subset.ssubset_or_eq HasSubset.Subset.ssubset_or_eq

#print ssubset_iff_subset_ne /-
theorem ssubset_iff_subset_ne [IsAntisymm α (· ⊆ ·)] : a ⊂ b ↔ a ⊆ b ∧ a ≠ b :=
  ⟨fun h => ⟨h.Subset, h.Ne⟩, fun h => h.1.ssubset_of_ne h.2⟩
#align ssubset_iff_subset_ne ssubset_iff_subset_ne
-/

#print subset_iff_ssubset_or_eq /-
theorem subset_iff_ssubset_or_eq [IsRefl α (· ⊆ ·)] [IsAntisymm α (· ⊆ ·)] :
    a ⊆ b ↔ a ⊂ b ∨ a = b :=
  ⟨fun h => h.ssubset_or_eq, fun h => h.elim subset_of_ssubset subset_of_eq⟩
#align subset_iff_ssubset_or_eq subset_iff_ssubset_or_eq
-/

end SubsetSsubset

/-! ### Conversion of bundled order typeclasses to unbundled relation typeclasses -/

instance [Preorder α] : IsRefl α (· ≤ ·) :=
  ⟨le_refl⟩

instance [Preorder α] : IsRefl α (· ≥ ·) :=
  IsRefl.swap _

instance [Preorder α] : IsTrans α (· ≤ ·) :=
  ⟨@le_trans _ _⟩

instance [Preorder α] : IsTrans α (· ≥ ·) :=
  IsTrans.swap _

instance [Preorder α] : IsPreorder α (· ≤ ·) where

instance [Preorder α] : IsPreorder α (· ≥ ·) where

instance [Preorder α] : IsIrrefl α (· < ·) :=
  ⟨lt_irrefl⟩

instance [Preorder α] : IsIrrefl α (· > ·) :=
  IsIrrefl.swap _

instance [Preorder α] : IsTrans α (· < ·) :=
  ⟨@lt_trans _ _⟩

instance [Preorder α] : IsTrans α (· > ·) :=
  IsTrans.swap _

instance [Preorder α] : IsAsymm α (· < ·) :=
  ⟨@lt_asymm _ _⟩

instance [Preorder α] : IsAsymm α (· > ·) :=
  IsAsymm.swap _

instance [Preorder α] : IsAntisymm α (· < ·) :=
  IsAsymm.isAntisymm _

instance [Preorder α] : IsAntisymm α (· > ·) :=
  IsAsymm.isAntisymm _

instance [Preorder α] : IsStrictOrder α (· < ·) where

instance [Preorder α] : IsStrictOrder α (· > ·) where

instance [Preorder α] : IsNonstrictStrictOrder α (· ≤ ·) (· < ·) :=
  ⟨@lt_iff_le_not_le _ _⟩

instance [PartialOrder α] : IsAntisymm α (· ≤ ·) :=
  ⟨@le_antisymm _ _⟩

instance [PartialOrder α] : IsAntisymm α (· ≥ ·) :=
  IsAntisymm.swap _

instance [PartialOrder α] : IsPartialOrder α (· ≤ ·) where

instance [PartialOrder α] : IsPartialOrder α (· ≥ ·) where

instance [LinearOrder α] : IsTotal α (· ≤ ·) :=
  ⟨le_total⟩

instance [LinearOrder α] : IsTotal α (· ≥ ·) :=
  IsTotal.swap _

instance LinearOrder.isTotalPreorder [LinearOrder α] : IsTotalPreorder α (· ≤ ·) := by
  infer_instance
#align linear_order.is_total_preorder LinearOrder.isTotalPreorder

instance [LinearOrder α] : IsTotalPreorder α (· ≥ ·) where

instance [LinearOrder α] : IsLinearOrder α (· ≤ ·) where

instance [LinearOrder α] : IsLinearOrder α (· ≥ ·) where

instance [LinearOrder α] : IsTrichotomous α (· < ·) :=
  ⟨lt_trichotomy⟩

instance [LinearOrder α] : IsTrichotomous α (· > ·) :=
  IsTrichotomous.swap _

instance [LinearOrder α] : IsTrichotomous α (· ≤ ·) :=
  IsTotal.isTrichotomous _

instance [LinearOrder α] : IsTrichotomous α (· ≥ ·) :=
  IsTotal.isTrichotomous _

instance [LinearOrder α] : IsStrictTotalOrder α (· < ·) where

instance [LinearOrder α] : IsOrderConnected α (· < ·) := by infer_instance

instance [LinearOrder α] : IsIncompTrans α (· < ·) := by infer_instance

instance [LinearOrder α] : IsStrictWeakOrder α (· < ·) := by infer_instance

#print transitive_le /-
theorem transitive_le [Preorder α] : Transitive (@LE.le α _) :=
  transitive_of_trans _
#align transitive_le transitive_le
-/

#print transitive_lt /-
theorem transitive_lt [Preorder α] : Transitive (@LT.lt α _) :=
  transitive_of_trans _
#align transitive_lt transitive_lt
-/

#print transitive_ge /-
theorem transitive_ge [Preorder α] : Transitive (@GE.ge α _) :=
  transitive_of_trans _
#align transitive_ge transitive_ge
-/

#print transitive_gt /-
theorem transitive_gt [Preorder α] : Transitive (@GT.gt α _) :=
  transitive_of_trans _
#align transitive_gt transitive_gt
-/

#print OrderDual.isTotal_le /-
instance OrderDual.isTotal_le [LE α] [IsTotal α (· ≤ ·)] : IsTotal αᵒᵈ (· ≤ ·) :=
  @IsTotal.swap α _ _
#align order_dual.is_total_le OrderDual.isTotal_le
-/

instance : WellFoundedLT ℕ :=
  ⟨Nat.lt_wfRel⟩

#print Nat.lt.isWellOrder /-
instance Nat.lt.isWellOrder : IsWellOrder ℕ (· < ·) where
#align nat.lt.is_well_order Nat.lt.isWellOrder
-/

instance [LinearOrder α] [h : IsWellOrder α (· < ·)] : IsWellOrder αᵒᵈ (· > ·) :=
  h

instance [LinearOrder α] [h : IsWellOrder α (· > ·)] : IsWellOrder αᵒᵈ (· < ·) :=
  h


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import init.logic

constant propext {a b : Prop} : (a ↔ b) → a = b

/- Additional congruence lemmas. -/
universes u v

lemma forall_congr_eq {a : Sort u} {p q : a → Prop} (h : ∀ x, p x = q x) : (∀ x, p x) = ∀ x, q x :=
propext (forall_congr (λ a, (h a).to_iff))

lemma imp_congr_eq {a b c d : Prop} (h₁ : a = c) (h₂ : b = d) : (a → b) = (c → d) :=
propext (imp_congr h₁.to_iff h₂.to_iff)

lemma imp_congr_ctx_eq {a b c d : Prop} (h₁ : a = c) (h₂ : c → (b = d)) : (a → b) = (c → d) :=
propext (imp_congr_ctx h₁.to_iff (λ hc, (h₂ hc).to_iff))

lemma eq_true_intro {a : Prop} (h : a) : a = true :=
propext (iff_true_intro h)

lemma eq_false_intro {a : Prop} (h : ¬a) : a = false :=
propext (iff_false_intro h)

theorem iff.to_eq {a b : Prop} (h : a ↔ b) : a = b :=
propext h

theorem iff_eq_eq {a b : Prop} : (a ↔ b) = (a = b) :=
propext (iff.intro
  (assume h, iff.to_eq h)
  (assume h, h.to_iff))

lemma eq_false {a : Prop} : (a = false) = (¬ a) :=
have (a ↔ false) = (¬ a), from propext (iff_false a),
eq.subst (@iff_eq_eq a false) this

lemma eq_true {a : Prop} : (a = true) = a :=
have (a ↔ true) = a, from propext (iff_true a),
eq.subst (@iff_eq_eq a true) this


/-
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 combinatorics.simple_graph.subgraph

/-!
# Triangle counting lemma
-/

open finset fintype
open_locale big_operators

variables {α : Type*} (G : simple_graph α)

namespace simple_graph

/-- A `n`-clique in a graph is a set of `n` vertices which are pairwise connected. -/
def is_n_clique (n : ℕ) (s : finset α) : Prop := s.card = n ∧ (s : set α).pairwise G.adj

instance [decidable_eq α] [decidable_rel G.adj] {n} {s : finset α} :
  decidable (G.is_n_clique n s) :=
decidable_of_iff (s.card = n ∧ ∀ x ∈ s, ∀ y ∈ s, x ≠ y → G.adj x y)
  (by simp [simple_graph.is_n_clique, set.pairwise])

/-- `G` has no triangles. -/
def no_triangles := ∀ t, ¬ G.is_n_clique 3 t

lemma bot_no_triangles : (⊥ : simple_graph α).no_triangles :=
begin
  rintro t ⟨ht₁, ht₂⟩,
  have : 1 < t.card,
  { rw ht₁,
    norm_num },
  rw finset.one_lt_card at this,
  obtain ⟨x, hx, y, hy, hxy⟩ := this,
  apply ht₂ hx hy hxy,
end

section triangle_finset
variables [fintype α] [decidable_eq α] [decidable_rel G.adj]

/-- The triangles in a graph as a finset. -/
def triangle_finset : finset (finset α) :=
(powerset_len 3 univ).filter $ G.is_n_clique 3

lemma mem_triangle_finset (s : finset α) :
  s ∈ G.triangle_finset ↔ s.card = 3 ∧ (s : set α).pairwise G.adj :=
by simp [triangle_finset, mem_powerset_len, is_n_clique]

lemma mem_triangle_finset' (s : finset α) :
  s ∈ G.triangle_finset ↔ G.is_n_clique 3 s :=
G.mem_triangle_finset s

lemma mem_triangle_finset'' (x y z : α) :
  {x, y, z} ∈ G.triangle_finset ↔ G.adj x y ∧ G.adj x z ∧ G.adj y z :=
begin
  rw [mem_triangle_finset],
  simp only [coe_insert, coe_singleton, set.pairwise_insert_of_symmetric G.symm,
    set.pairwise_singleton, true_and, set.mem_insert_iff, set.mem_singleton_iff,
    forall_eq_or_imp, forall_eq, ne.def],
  split,
  { rintro ⟨h, yz, xy, xz⟩,
    have : x ≠ y ∧ x ≠ z ∧ y ≠ z,
    { refine ⟨_, _, _⟩;
      { rintro rfl,
        simp only [insert_idem, insert_singleton_comm, insert_singleton_self_eq] at h,
        apply ne_of_lt _ h,
        rw nat.lt_succ_iff,
        apply card_insert_le _ _ } },
    tauto },
  rintro ⟨xy, xz, yz⟩,
  refine ⟨_, λ _, yz, λ _, xy, λ _, xz⟩,
  rw card_eq_three,
  exact ⟨_, _, _, G.ne_of_adj xy, G.ne_of_adj xz, G.ne_of_adj yz, rfl⟩,
end

lemma mem_triangle_finset''' {s : finset α} :
  s ∈ G.triangle_finset ↔ ∃ x y z, G.adj x y ∧ G.adj x z ∧ G.adj y z ∧ s = {x,y,z} :=
begin
  split,
  { intro h,
    obtain ⟨x, y, z, -, -, -, rfl⟩ := card_eq_three.1 ((G.mem_triangle_finset s).1 h).1,
    refine ⟨x, y, z, _⟩,
    rw mem_triangle_finset'' at h,
    tauto },
  rintro ⟨x, y, z, _, _, _, rfl⟩,
  rw mem_triangle_finset'',
  tauto
end

lemma triangle_finset_empty_iff : G.triangle_finset = ∅ ↔ G.no_triangles :=
by simp only [mem_triangle_finset, eq_empty_iff_forall_not_mem, no_triangles, is_n_clique]

end triangle_finset

open_locale classical

section triangle_free_far
variables [fintype α]

/-- A simple graph is `ε`-triangle-free far if one must remove a density of `ε` edges to make it
triangle-free. -/
def triangle_free_far (G : simple_graph α) (ε : ℝ) : Prop :=
∀ G' ≤ G, G'.no_triangles → ε * (card α)^2 ≤ (G.edge_finset.card - G'.edge_finset.card : ℝ)

lemma has_triangle_of_few_edges_removed {ε : ℝ} {G' : simple_graph α} (hG' : G' ≤ G)
  (hG : G.triangle_free_far ε)
  (hcard : (G.edge_finset.card - G'.edge_finset.card : ℝ) < ε * card α^2) :
  ∃ t, t ∈ G'.triangle_finset :=
begin
  apply nonempty_of_ne_empty,
  rw [ne.def, triangle_finset_empty_iff],
  intro hG'',
  apply not_le_of_lt hcard (hG _ hG' hG''),
end

lemma eps_eq_zero_of_no_triangles [nonempty α] {ε : ℝ} (hε : 0 ≤ ε) (hG : G.triangle_free_far ε)
  (hG' : G.no_triangles) :
  ε = 0 :=
begin
  have := hG G le_rfl hG',
  simp only [sub_self] at this,
  apply (nonpos_of_mul_nonpos_right this (sq_pos_of_ne_zero _ _)).antisymm hε,
  simp only [nat.cast_ne_zero, ←pos_iff_ne_zero, fintype.card_pos],
end

end triangle_free_far

noncomputable def bad_vertices (ε : ℝ) (X Y : finset α) :=
X.filter (λ x, ((Y.filter (G.adj x)).card : ℝ) < (G.edge_density X Y - ε) * Y.card)

lemma of_mem_bad_vertices {ε : ℝ} {X Y : finset α} :
  ∀ x ∈ G.bad_vertices ε X Y, ((Y.filter (G.adj x)).card : ℝ) ≤ (G.edge_density X Y - ε) * Y.card :=
λ x hx, (mem_filter.1 hx).2.le

lemma bad_vertices_eq {ε : ℝ} {X Y : finset α} :
  relation.pairs_finset G.adj (G.bad_vertices ε X Y) Y ⊆
    (G.bad_vertices ε X Y).bUnion (λ x, (Y.filter (G.adj x)).image (λ y, (x,y))) :=
begin
  rintro ⟨x, y⟩,
  simp only [mem_bUnion, mem_image, exists_prop, mem_filter, prod.mk.inj_iff,
    exists_eq_right_right, relation.mem_pairs_finset'],
  rintro ⟨hx, hy, hxy⟩,
  refine ⟨x, hx, ⟨hy, hxy⟩, rfl⟩,
end

lemma pairs_card_bad_le {ε : ℝ} {X Y : finset α} :
  ((relation.pairs_finset G.adj (G.bad_vertices ε X Y) Y).card : ℝ) ≤
    (G.bad_vertices ε X Y).card * Y.card * (G.edge_density X Y - ε) :=
begin
  refine (nat.cast_le.2 (card_le_of_subset G.bad_vertices_eq)).trans _,
  refine (nat.cast_le.2 card_bUnion_le).trans _,
  rw nat.cast_sum,
  simp_rw [card_image_of_injective _ (prod.mk.inj_left _)],
  apply (sum_le_sum G.of_mem_bad_vertices).trans,
  rw [sum_const, nsmul_eq_mul, mul_comm (_ - _), mul_assoc],
end

lemma edge_density_bad_vertices {ε : ℝ} {X Y : finset α} (hε : 0 ≤ ε)
  (dXY : 2 * ε ≤ G.edge_density X Y) :
  G.edge_density (G.bad_vertices ε X Y) Y ≤ G.edge_density X Y - ε :=
begin
  rw [edge_density_eq_edge_count_div_card, edge_count],
  refine div_le_of_nonneg_of_le_mul (mul_nonneg (nat.cast_nonneg _) (nat.cast_nonneg _)) _ _,
  { apply sub_nonneg_of_le,
    linarith },
  rw mul_comm,
  apply G.pairs_card_bad_le,
end

@[simp] lemma edge_density_empty_left (s : finset α) : G.edge_density ∅ s = 0 :=
by simp [edge_density_eq_edge_count_div_card]

@[simp] lemma edge_density_empty_right (s : finset α) : G.edge_density s ∅ = 0 :=
by simp [edge_density_eq_edge_count_div_card]

lemma nonempty_of_edge_density_ne_zero_left {s t : finset α} :
  G.edge_density s t ≠ 0 → s.nonempty :=
begin
  rw nonempty_iff_ne_empty,
  rintro h rfl,
  exact h (edge_density_empty_left _ _),
end

lemma nonempty_of_edge_density_ne_zero_right {s t : finset α} :
  G.edge_density s t ≠ 0 → t.nonempty :=
begin
  rw nonempty_iff_ne_empty,
  rintro h rfl,
  exact h (edge_density_empty_right _ _),
end

lemma few_bad_vertices {X Y : finset α} {ε : ℝ} (hε₀ : 0 ≤ ε) (hε : ε ≤ 1)
  (dXY : 2 * ε ≤ G.edge_density X Y) (uXY : G.is_uniform ε X Y) :
  ((G.bad_vertices ε X Y).card : ℝ) ≤ X.card * ε :=
begin
  by_contra,
  rw not_le at h,
  have := G.edge_density_bad_vertices hε₀ dXY,
  have := uXY (G.bad_vertices ε X Y) (filter_subset _ _) Y set.subset.rfl h.le
    (mul_le_of_le_one_right (nat.cast_nonneg _) hε),
  rw abs_sub_lt_iff at this,
  linarith,
end

-- A subset of the triangles constructed in a weird way to make them easy to count
lemma triangle_split_helper {X Y Z : finset α} {ε : ℝ} :
  (X \ (G.bad_vertices ε X Y ∪ G.bad_vertices ε X Z)).bUnion
    (λ x, (((Y.filter (G.adj x)).product (Z.filter (G.adj x))).filter
      (λ (yz : _ × _), G.adj yz.1 yz.2)).image (prod.mk x)) ⊆
  (X.product (Y.product Z)).filter
    (λ (xyz : α × α × α), G.adj xyz.1 xyz.2.1 ∧ G.adj xyz.1 xyz.2.2 ∧ G.adj xyz.2.1 xyz.2.2) :=
begin
  rintro ⟨x, y, z⟩,
  simp only [mem_filter, mem_product, mem_bUnion, mem_sdiff, exists_prop, mem_union,
    mem_image, prod.exists, and_assoc, exists_imp_distrib, and_imp, prod.mk.inj_iff],
  rintro x hx - y z hy xy hz xz yz rfl rfl rfl,
  exact ⟨hx, hy, hz, xy, xz, yz⟩,
end

lemma good_vertices_triangle_card {X Y Z : finset α} {ε : ℝ} (hε : 0 ≤ ε)
  (dXY : 2 * ε ≤ G.edge_density X Y)
  (dXZ : 2 * ε ≤ G.edge_density X Z)
  (dYZ : 2 * ε ≤ G.edge_density Y Z)
  (uYZ : G.is_uniform ε Y Z) (x : α)
  (hx : x ∈ X \ (G.bad_vertices ε X Y ∪ G.bad_vertices ε X Z))  :
  ε^3 * Y.card * Z.card ≤ ((((Y.filter (G.adj x)).product (Z.filter (G.adj x))).filter
      (λ (yz : _ × _), G.adj yz.1 yz.2)).image (prod.mk x)).card :=
begin
  simp only [mem_sdiff, bad_vertices, mem_union, not_or_distrib, mem_filter, not_and_distrib,
    not_lt] at hx,
  rw [←or_and_distrib_left, and_or_distrib_left] at hx,
  simp only [false_or, and_not_self, mul_comm ((_ : ℝ) - _)] at hx,
  rcases hx with ⟨hx, hxY, hxZ⟩,
  have hY : (Y.card : ℝ) * ε ≤ (filter (G.adj x) Y).card,
  { exact (mul_le_mul_of_nonneg_left (by linarith) (nat.cast_nonneg _)).trans hxY },
  have hZ : (Z.card : ℝ) * ε ≤ (filter (G.adj x) Z).card,
  { exact (mul_le_mul_of_nonneg_left (by linarith) (nat.cast_nonneg _)).trans hxZ },
  rw card_image_of_injective _ (prod.mk.inj_left _),
  have := uYZ _ (filter_subset (G.adj x) _) _ (filter_subset (G.adj x) _) hY hZ,
  have : ε ≤ G.edge_density (filter (G.adj x) Y) (filter (G.adj x) Z),
  { rw abs_sub_lt_iff at this,
    linarith },
  refine le_trans _ (mul_le_of_nonneg_of_le_div (nat.cast_nonneg _)
    (by exact_mod_cast (nat.zero_le _)) this),
  refine eq.trans_le _ (mul_le_mul_of_nonneg_left
    (mul_le_mul hY hZ (mul_nonneg (nat.cast_nonneg _) hε) (nat.cast_nonneg _)) hε),
  ring,
end

-- can probably golf things by relaxing < to ≤
lemma triangle_counting {X Y Z : finset α} {ε : ℝ} (hε₀ : 0 < ε) (hε₁ : ε ≤ 1)
  (dXY : 2 * ε ≤ G.edge_density X Y) (uXY : G.is_uniform ε X Y)
  (dXZ : 2 * ε ≤ G.edge_density X Z) (uXZ : G.is_uniform ε X Z)
  (dYZ : 2 * ε ≤ G.edge_density Y Z) (uYZ : G.is_uniform ε Y Z) :
  (1 - 2 * ε) * ε^3 * X.card * Y.card * Z.card ≤
    ((X.product $ Y.product Z).filter $ λ (xyz : α × α × α),
      G.adj xyz.1 xyz.2.1 ∧ G.adj xyz.1 xyz.2.2 ∧ G.adj xyz.2.1 xyz.2.2).card :=
begin
  have h₁ : ((G.bad_vertices ε X Y).card : ℝ) ≤ X.card * ε := G.few_bad_vertices hε₀.le hε₁ dXY uXY,
  have h₂ : ((G.bad_vertices ε X Z).card : ℝ) ≤ X.card * ε := G.few_bad_vertices hε₀.le hε₁ dXZ uXZ,
  let X' := X \ (G.bad_vertices ε X Y ∪ G.bad_vertices ε X Z),
  have : X'.bUnion _ ⊆ (X.product (Y.product Z)).filter
    (λ (xyz : α × α × α), G.adj xyz.1 xyz.2.1 ∧ G.adj xyz.1 xyz.2.2 ∧ G.adj xyz.2.1 xyz.2.2),
  { apply triangle_split_helper },
  refine le_trans _ (nat.cast_le.2 (card_le_of_subset this)),
  rw [card_bUnion, nat.cast_sum],
  { have := λ x hx, G.good_vertices_triangle_card hε₀.le dXY dXZ dYZ uYZ x hx,
    apply le_trans _ (le_sum_of_forall_le X' _ _ this),
    rw nsmul_eq_mul,
    have hX' : (1 - 2 * ε) * X.card ≤ X'.card,
    { have i : G.bad_vertices ε X Y ∪ G.bad_vertices ε X Z ⊆ X,
      { apply union_subset (filter_subset _ _) (filter_subset _ _) },
      rw [sub_mul, one_mul, card_sdiff i, nat.cast_sub (card_le_of_subset i), sub_le_sub_iff_left,
        mul_assoc, mul_comm ε, two_mul],
      refine (nat.cast_le.2 (card_union_le _ _)).trans _,
      rw nat.cast_add,
      refine add_le_add h₁ h₂ },
    refine le_trans (le_of_eq (by ring)) (mul_le_mul_of_nonneg_right hX' _),
    exact mul_nonneg (mul_nonneg (pow_nonneg hε₀.le _) (nat.cast_nonneg _)) (nat.cast_nonneg _) },
  rintro x hx y hy t,
  rw disjoint_left,
  simp only [prod.forall, mem_image, not_exists, exists_prop, mem_filter, prod.mk.inj_iff,
    exists_imp_distrib, and_imp, not_and, mem_product, or.assoc],
  rintro - - - - - - _ _ _ rfl rfl _ _ _ _ _ _ _ rfl _,
  exact t rfl,
end

variables [fintype α]

lemma triangle_counting2 {X Y Z : finset α} {ε : ℝ}
  (dXY : 2 * ε ≤ G.edge_density X Y) (uXY : G.is_uniform ε X Y) (hXY : disjoint X Y)
  (dXZ : 2 * ε ≤ G.edge_density X Z) (uXZ : G.is_uniform ε X Z) (hXZ : disjoint X Z)
  (dYZ : 2 * ε ≤ G.edge_density Y Z) (uYZ : G.is_uniform ε Y Z) (hYZ : disjoint Y Z) :
  (1 - 2 * ε) * ε^3 * X.card * Y.card * Z.card ≤ G.triangle_finset.card :=
begin
  cases le_or_lt ε 0 with hε₀ hε₀,
  { apply le_trans _ (nat.cast_nonneg _),
    rw [mul_assoc, mul_assoc],
    refine mul_nonpos_of_nonpos_of_nonneg _ (by exact_mod_cast (nat.zero_le _)),
    exact mul_nonpos_of_nonneg_of_nonpos (by linarith) (pow_bit1_nonpos_iff.2 hε₀) },
  cases lt_or_le 1 ε with hε₁ hε₁,
  { apply le_trans _ (nat.cast_nonneg _),
    rw [mul_assoc, mul_assoc, mul_assoc],
    exact mul_nonpos_of_nonpos_of_nonneg (by linarith)
      (mul_nonneg (pow_nonneg hε₀.le _) (by exact_mod_cast (nat.zero_le _))) },
  apply (G.triangle_counting hε₀ hε₁ dXY uXY dXZ uXZ dYZ uYZ).trans _,
  rw nat.cast_le,
  refine card_le_card_of_inj_on (λ xyz, {xyz.1, xyz.2.1, xyz.2.2}) _ _,
  { rintro ⟨x, y, z⟩,
    simp only [and_imp, mem_filter, mem_product],
    intros hx hy hz xy xz yz,
    rw mem_triangle_finset'',
    exact ⟨xy, xz, yz⟩ },
  rintro ⟨x₁, y₁, z₁⟩ h₁ ⟨x₂, y₂, z₂⟩ h₂ t,
  simp only [mem_filter, mem_product] at h₁ h₂,
  apply dumb_thing hXY hXZ hYZ t;
  tauto
end

@[simps]
def reduced_graph (ε : ℝ) (P : finpartition (univ : finset α)) : simple_graph α :=
{ adj := λ x y, G.adj x y ∧
    ∃ U V ∈ P.parts, x ∈ U ∧ y ∈ V ∧ U ≠ V ∧ G.is_uniform (ε/8) U V ∧ ε/4 ≤ G.edge_density U V,
  symm := λ x y,
  begin
    rintro ⟨xy, U, UP, V, VP, xU, yV, UV, GUV, εUV⟩,
    refine ⟨G.symm xy, V, VP, U, UP, yV, xU, UV.symm, GUV.symm, _⟩,
    rwa edge_density_comm,
  end,
  loopless := λ x ⟨h, _⟩, G.loopless x h }

variables {G}

lemma reduced_graph_le {ε : ℝ} {P : finpartition (univ : finset α)} : reduced_graph G ε P ≤ G :=
λ x y ⟨h, _⟩, h

lemma triangle_free_far_of_disjoint_triangles_aux
  (tris : finset (finset α)) (htris : tris ⊆ G.triangle_finset)
  (pd : (tris : set (finset α)).pairwise (λ x y, (x ∩ y).card ≤ 1)) :
  ∀ (G' ≤ G), G'.no_triangles → tris.card ≤ G.edge_finset.card - G'.edge_finset.card :=
begin
  intros G' hG hG',
  rw [←card_sdiff (edge_finset_mono hG), ←card_attach],
  by_contra,
  push_neg at h,
  have : ∀ t ∈ tris, ∃ x y ∈ t, x ≠ y ∧ ⟦(x, y)⟧ ∈ G.edge_finset \ G'.edge_finset,
  { intros t ht,
    by_contra i,
    suffices : t ∈ G'.triangle_finset,
    { rw ←triangle_finset_empty_iff at hG',
      simpa [hG'] using this },
    simp only [not_exists, exists_prop, not_and, mem_sdiff, not_not, mem_edge_finset,
      exists_and_distrib_left, ne.def, mem_edge_set] at i,
    obtain ⟨x, y, z, xy, xz, yz, rfl⟩ := (mem_triangle_finset''' _).1 (htris ht),
    rw mem_triangle_finset'',
    refine ⟨i _ _ _ (G.ne_of_adj xy) xy _, i _ _ _ (G.ne_of_adj xz) xz _,
      i _ _ _ (G.ne_of_adj yz) yz _⟩;
    simp },
  choose fx hfx fy hfy hfne fmem using this,
  let f : {x // x ∈ tris} → sym2 α := λ t, ⟦(fx _ t.2, fy _ t.2)⟧,
  have hf : ∀ x ∈ tris.attach, f x ∈ G.edge_finset \ G'.edge_finset := λ x hx, fmem _ _,
  obtain ⟨⟨t₁, ht₁⟩, -, ⟨t₂, ht₂⟩, -, tne, t : ⟦_⟧ = ⟦_⟧⟩ :=
    exists_ne_map_eq_of_card_lt_of_maps_to h hf,
  have : t₁ ≠ t₂,
  { simpa using tne },
  dsimp at t,
  have i := pd ht₁ ht₂ this,
  simp only [finset.card_le_one_iff, mem_inter, and_imp] at i,
  rw sym2.eq_iff at t,
  cases t,
  { exact hfne _ _ (i (hfx t₁ ht₁) (t.1.symm ▸ hfx t₂ ht₂) (hfy t₁ ht₁) (t.2.symm ▸ hfy t₂ ht₂)) },
  { exact hfne _ _ (i (hfx t₁ ht₁) (t.1.symm ▸ hfy t₂ ht₂) (hfy t₁ ht₁) (t.2.symm ▸ hfx t₂ ht₂)) }
end

lemma triangle_free_far_of_disjoint_triangles {ε : ℝ}
  (tris : finset (finset α)) (htris : tris ⊆ G.triangle_finset)
  (pd : (tris : set (finset α)).pairwise (λ x y, (x ∩ y).card ≤ 1))
  (tris_big : ε * card α ^ 2 ≤ tris.card) :
  G.triangle_free_far ε :=
begin
  intros G' hG hG',
  rw ←nat.cast_sub (card_le_of_subset (edge_finset_mono hG)),
  apply tris_big.trans
    (nat.cast_le.2 (triangle_free_far_of_disjoint_triangles_aux tris htris pd G' hG hG')),
end

lemma reduced_double_edges {ε : ℝ} {P : finpartition (univ : finset α)} :
  univ.filter (λ (xy : α × α), G.adj xy.1 xy.2) \
    univ.filter (λ (xy : α × α), (reduced_graph G ε P).adj xy.1 xy.2) ⊆
      (P.non_uniform_pairs G (ε/8)).bUnion (λ UV, UV.1.product UV.2) ∪
        P.parts.bUnion (λ U, U.off_diag) ∪
          (P.parts.off_diag.filter (λ (UV : _ × _), G.edge_density UV.1 UV.2 < ε/4)).bUnion
            (λ UV, (UV.1.product UV.2).filter (λ xy, G.adj xy.1 xy.2)) :=
begin
  rintro ⟨x, y⟩,
  simp only [mem_sdiff, mem_filter, mem_univ, true_and, reduced_graph_adj, not_and, not_exists,
    not_le, mem_bUnion, mem_union, exists_prop, mem_product, prod.exists, mem_off_diag, and_imp,
    or.assoc, and.assoc, P.mem_non_uniform_pairs],
  intros h h',
  replace h' := h' h,
  obtain ⟨U, hU, hx⟩ := P.exists_mem (mem_univ x),
  obtain ⟨V, hV, hy⟩ := P.exists_mem (mem_univ y),
  rcases eq_or_ne U V with rfl | hUV,
  { exact or.inr (or.inl ⟨U, hU, hx, hy, G.ne_of_adj h⟩) },
  by_cases h₂ : G.is_uniform (ε/8) U V,
  { exact or.inr (or.inr ⟨U, V, hU, hV, hUV, h' _ hU _ hV hx hy hUV h₂, hx, hy, h⟩) },
  { exact or.inl ⟨U, V, hU, hV, hUV, h₂, hx, hy⟩ }
end

-- We will break up the sum more later
lemma non_uniform_killed_card {ε : ℝ} {P : finpartition (univ : finset α)} :
  (((P.non_uniform_pairs G ε).bUnion (λ UV, UV.1.product UV.2)).card : ℝ) ≤
    (∑ i in P.non_uniform_pairs G ε, i.1.card * i.2.card : ℝ) :=
begin
  norm_cast,
  simp_rw ←card_product,
  exact card_bUnion_le,
end

lemma internal_killed_card [nonempty α]
  {P : finpartition (univ : finset α)} (hP : P.is_equipartition) :
  ((P.parts.bUnion (λ U, U.off_diag)).card : ℝ) ≤ card α * (card α + P.parts.card) / P.parts.card :=
begin
  have : (P.parts.bUnion (λ U, U.off_diag)).card ≤
    P.parts.card * (card α / P.parts.card) * (card α / P.parts.card + 1),
  { rw mul_assoc,
    apply card_bUnion_le_card_mul,
    intros U hU,
    suffices : (U.card - 1) * U.card ≤ card α / P.parts.card * (card α / P.parts.card + 1),
    { rwa [nat.mul_sub_right_distrib, one_mul, ←off_diag_card] at this },
    have := hP.card_part_le_average_add_one hU,
    apply nat.mul_le_mul ((nat.sub_le_sub_right this 1).trans _) this,
    simp only [nat.add_succ_sub_one, add_zero] },
  refine (nat.cast_le.2 this).trans _,
  have i : (_ : ℝ) ≠ 0 := nat.cast_ne_zero.2 (P.parts_nonempty $
    univ_nonempty.ne_empty).card_pos.ne',
  rw [mul_div_assoc, div_add_same i, nat.cast_mul, nat.cast_add_one],
  refine mul_le_mul _ _ (nat.cast_add_one_pos _).le (nat.cast_nonneg _),
  { rw [nat.cast_le, mul_comm],
    apply nat.div_mul_le_self },
  apply add_le_add_right,
  apply nat.cast_div_le,
end

-- this is stated with ε but might need to be applied with ε/2 or something
lemma sparse_card {P : finpartition (univ : finset α)} (hP : P.is_equipartition) {ε : ℝ}
  (hε : 0 ≤ ε) :
  (((P.parts.off_diag.filter (λ (UV : _ × _), G.edge_density UV.1 UV.2 < ε)).bUnion
            (λ UV, (UV.1.product UV.2).filter (λ xy, G.adj xy.1 xy.2))).card : ℝ) ≤
  ε * (card α + P.parts.card)^2 :=
begin
  refine (nat.cast_le.2 card_bUnion_le).trans _,
  rw nat.cast_sum,
  change ∑ x in _, G.edge_count _ _ ≤ _,
  have : ∀ UV ∈ P.parts.off_diag.filter (λ (UV : _ × _), G.edge_density UV.1 UV.2 < ε),
    G.edge_count UV.1 UV.2 ≤ ε * (UV.1.card * UV.2.card),
  { rintro ⟨U, V⟩,
    simp only [and_imp, mem_off_diag, mem_filter, ne.def,
      simple_graph.edge_density_eq_edge_count_div_card],
    intros hU hV hUV e,
    apply le_of_lt,
    rwa [←div_lt_iff],
    exact mul_pos (nat.cast_pos.2 (P.nonempty_of_mem_parts hU).card_pos)
      (nat.cast_pos.2 (P.nonempty_of_mem_parts hV).card_pos) },
  apply (sum_le_sum this).trans,
  refine (sum_le_sum_of_subset_of_nonneg (filter_subset _ _) (λ i hi _, _)).trans _,
  { exact mul_nonneg hε (mul_nonneg (nat.cast_nonneg _) (nat.cast_nonneg _)) },
  rw ←mul_sum,
  apply mul_le_mul_of_nonneg_left _ hε,
  refine (sum_le_of_forall_le P.parts.off_diag (λ i, (i.1.card * i.2.card : ℝ))
    ((card α / P.parts.card + 1)^2 : ℕ) _).trans _,
  { simp only [prod.forall, finpartition.mem_non_uniform_pairs, and_imp, mem_off_diag],
    rintro U V hU hV -,
    rw [sq, ←nat.cast_mul, nat.cast_le],
    exact nat.mul_le_mul (hP.card_part_le_average_add_one hU)
      (hP.card_part_le_average_add_one hV) },
  rw [nsmul_eq_mul, ←nat.cast_mul, ←nat.cast_add, ←nat.cast_pow, nat.cast_le, off_diag_card,
    nat.mul_sub_right_distrib],
  apply (nat.sub_le _ _).trans,
  rw [←sq, ←mul_pow],
  apply nat.pow_le_pow_of_le_left,
  rw [mul_add, mul_one],
  apply add_le_add_right,
  apply nat.mul_div_le,
end

lemma triangle_free_far.not_no_triangles [nonempty α] {ε : ℝ} (hG : G.triangle_free_far ε)
  (hε : 0 < ε) : ¬ G.no_triangles :=
λ hG', hε.ne' (eps_eq_zero_of_no_triangles G hε.le hG hG')

lemma triangle_free_far.triangle_finset_card_pos {ε : ℝ} [nonempty α] (hG : G.triangle_free_far ε)
  (hε : 0 < ε) : 0 < G.triangle_finset.card :=
begin
  rw [finset.card_pos, nonempty_iff_ne_empty, ne.def, triangle_finset_empty_iff],
  apply hG.not_no_triangles hε,
end

lemma sum_irreg_pairs_le_of_uniform [nonempty α] {ε : ℝ} (hε : 0 < ε)
  (P : finpartition univ) (hP : P.is_equipartition) (hG : P.is_uniform G ε) :
  (∑ i in P.non_uniform_pairs G ε, i.1.card * i.2.card : ℝ) < ε * (card α + P.parts.card)^2 :=
begin
  refine (sum_le_of_forall_le (P.non_uniform_pairs G ε) (λ i, (i.1.card * i.2.card : ℝ))
    ((card α / P.parts.card + 1)^2 : ℕ) _).trans_lt _,
  { simp only [prod.forall, finpartition.mem_non_uniform_pairs, and_imp],
    rintro U V hU hV hUV -,
    rw [sq, ←nat.cast_mul, nat.cast_le],
    exact nat.mul_le_mul (hP.card_part_le_average_add_one hU)
      (hP.card_part_le_average_add_one hV) },
  rw nsmul_eq_mul,
  refine (mul_le_mul_of_nonneg_right hG (nat.cast_nonneg _)).trans_lt _,
  rw [mul_right_comm _ ε, mul_comm ε],
  apply mul_lt_mul_of_pos_right _ hε,
  norm_cast,
  apply nat.thing2 _ _,
  exact (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos,
end

lemma sum_irreg_pairs_le_of_uniform' [nonempty α] {ε : ℝ} (hε : 0 < ε)
  (P : finpartition univ) (hP : P.is_equipartition) (hG : P.is_uniform G ε) :
  (((P.non_uniform_pairs G ε).bUnion (λ UV, UV.1.product UV.2)).card : ℝ) < 4 * ε * (card α)^2 :=
begin
  apply non_uniform_killed_card.trans_lt,
  apply (sum_irreg_pairs_le_of_uniform hε P hP hG).trans_le,
  suffices : ε * ((card α) + P.parts.card)^2 ≤ ε * (card α + card α)^2,
  { exact this.trans (le_of_eq (by ring)) },
  apply mul_le_mul_of_nonneg_left _ hε.le,
  refine pow_le_pow_of_le_left (by exact_mod_cast (nat.zero_le _)) _ _,
  exact add_le_add_left (nat.cast_le.2 P.card_parts_le_card) _,
end

lemma sum_sparse {ε : ℝ} (hε : 0 ≤ ε)
  (P : finpartition univ) (hP : P.is_equipartition) :
  (((P.parts.off_diag.filter (λ (UV : _ × _), G.edge_density UV.1 UV.2 < ε)).bUnion
            (λ UV, (UV.1.product UV.2).filter (λ xy, G.adj xy.1 xy.2))).card : ℝ) ≤
              4 * ε * (card α)^2 :=
begin
  refine (sparse_card hP hε).trans _,
  suffices : ε * ((card α) + P.parts.card)^2 ≤ ε * (card α + card α)^2,
  { exact this.trans (le_of_eq (by ring)) },
  apply mul_le_mul_of_nonneg_left _ hε,
  refine pow_le_pow_of_le_left (by exact_mod_cast (nat.zero_le _)) _ _,
  exact add_le_add_left (nat.cast_le.2 P.card_parts_le_card) _,
end

lemma internal_killed_card' [nonempty α] {ε : ℝ} (hε : 0 < ε)
  {P : finpartition (univ : finset α)} (hP : P.is_equipartition) (hP' : 4 / ε ≤ P.parts.card) :
  ((P.parts.bUnion (λ U, U.off_diag)).card : ℝ) ≤ ε / 2 * (card α)^2 :=
begin
  apply (internal_killed_card hP).trans,
  rw div_le_iff,
  have : (card α : ℝ) + P.parts.card ≤ 2 * card α,
  { rw two_mul,
    apply add_le_add_left,
    exact nat.cast_le.2 P.card_parts_le_card },
  apply (mul_le_mul_of_nonneg_left this (nat.cast_nonneg _)).trans,
  suffices : 1 ≤ (ε/4) * P.parts.card,
  { rw [mul_left_comm, ←sq],
    convert mul_le_mul_of_nonneg_left this (mul_nonneg zero_le_two (sq_nonneg (card α))) using 1;
    ring },
  rwa [←div_le_iff', one_div_div],
  { linarith },
  rw nat.cast_pos,
  exact (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos
end

/-- An explicit form for the constant in the triangle removal lemma. -/
noncomputable def triangle_removal_bound (ε : ℝ) : ℝ :=
min (1 / (2 * ⌈4/ε⌉₊^3)) ((1 - ε/4) * (ε/(16 * szemeredi_bound (ε/8) ⌈4/ε⌉₊))^3)

lemma triangle_removal_bound_pos {ε : ℝ} (hε : 0 < ε) (hε₁ : ε ≤ 1) :
  0 < triangle_removal_bound ε :=
begin
  apply lt_min,
  { rw one_div_pos,
    refine mul_pos zero_lt_two (pow_pos _ _),
    rw [nat.cast_pos, nat.lt_ceil, nat.cast_zero],
    exact div_pos zero_lt_four hε },
  { refine mul_pos (by linarith) (pow_pos (div_pos hε (mul_pos (by norm_num) _)) _),
    rw nat.cast_pos,
    exact (initial_bound_pos _ _).trans_le (initial_bound_le_szemeredi_bound _ _) }
end

lemma triangle_removal_bound_mul_cube_lt {ε : ℝ} (hε : 0 < ε) :
  (triangle_removal_bound ε) * ⌈4/ε⌉₊^3 < 1 :=
begin
  have : triangle_removal_bound ε ≤ _ := min_le_left _ _,
  apply (mul_le_mul_of_nonneg_right this (pow_nonneg (nat.cast_nonneg _) _)).trans_lt,
  rw [←div_div_eq_div_mul, div_mul_cancel],
  { norm_num },
  apply ne_of_gt (pow_pos _ _),
  rw [nat.cast_pos, nat.lt_ceil, nat.cast_zero],
  exact div_pos zero_lt_four hε
end

lemma annoying_thing {n k : ℕ} (hk : 0 < k) (hn : k ≤ n) : n < 2 * k * (n / k) :=
begin
  rw [mul_assoc, two_mul, ←add_lt_add_iff_right (n % k), add_right_comm, add_assoc,
    nat.mod_add_div n k, add_comm, add_lt_add_iff_right],
  apply (nat.mod_lt n hk).trans_le,
  have : 1 ≤ n / k,
  { rwa [nat.le_div_iff_mul_le _ _ hk, one_mul] },
  simpa using nat.mul_le_mul_left k this,
end

lemma card_bound [nonempty α] {ε : ℝ} {X : finset α} {P : finpartition (univ : finset α)}
  (hP₁ : P.is_equipartition)
  (hP₃ : P.parts.card ≤ szemeredi_bound (ε / 8) ⌈4/ε⌉₊) (hX : X ∈ P.parts) :
  (card α : ℝ) / (2 * szemeredi_bound (ε / 8) ⌈4/ε⌉₊) ≤ X.card :=
begin
  refine le_trans _ (nat.cast_le.2 (hP₁.average_le_card_part hX)),
  rw div_le_iff',
  { norm_cast,
    apply (annoying_thing (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos
      P.card_parts_le_card).le.trans,
    apply nat.mul_le_mul_right,
    exact nat.mul_le_mul_left _ hP₃ },
  refine mul_pos zero_lt_two _,
  rw nat.cast_pos,
  apply (initial_bound_pos _ _).trans_le (initial_bound_le_szemeredi_bound _ _)
end

lemma triangle_removal_aux [nonempty α] {ε : ℝ}
  (hε : 0 < ε) (hε₁ : ε ≤ 1)
  {P : finpartition univ}
  (hP₁ : P.is_equipartition)
  (hP₃ : P.parts.card ≤ szemeredi_bound (ε / 8) ⌈4/ε⌉₊)
  {t : finset α} (ht : t ∈ (G.reduced_graph ε P).triangle_finset) :
  triangle_removal_bound ε * ↑(card α) ^ 3 ≤ ↑(G.triangle_finset.card) :=
begin
  rw [mem_triangle_finset, card_eq_three] at ht,
  obtain ⟨⟨x, y, z, xy, xz, yz, rfl⟩, ht⟩ := ht,
  simp only [coe_insert, coe_singleton] at ht,
  have hx : x ∈ ({x,y,z} : set α) := or.inl rfl,
  have hy : y ∈ ({x,y,z} : set α) := or.inr (or.inl rfl),
  have hz : z ∈ ({x,y,z} : set α) := or.inr (or.inr rfl),
  have hxy : (G.reduced_graph ε P).adj x y := ht hx hy xy,
  have hxz : (G.reduced_graph ε P).adj x z := ht hx hz xz,
  have hyz : (G.reduced_graph ε P).adj y z := ht hy hz yz,
  obtain ⟨xy, X, hX, Y, hY, xX, yY, nXY, uXY, dXY⟩ := hxy,
  obtain ⟨xz, X', hX', Z, hZ, xX', zZ, nXZ, uXZ, dXZ⟩ := hxz,
  cases P.disjoint.elim hX hX' (not_disjoint_iff.2 ⟨x, xX, xX'⟩),
  obtain ⟨yz, Y', hY', Z', hZ', yY', zZ', nYZ, uYZ, dYZ⟩ := hyz,
  cases P.disjoint.elim hY hY' (not_disjoint_iff.2 ⟨y, yY, yY'⟩),
  cases P.disjoint.elim hZ hZ' (not_disjoint_iff.2 ⟨z, zZ, zZ'⟩),
  have dXY := P.disjoint hX hY nXY,
  have dXZ := P.disjoint hX hZ nXZ,
  have dYZ := P.disjoint hY hZ nYZ,
  have : 2 * (ε/8) = ε/4, by ring,
  have i := triangle_counting2 G (by rwa this) uXY dXY (by rwa this) uXZ dXZ (by rwa this) uYZ dYZ,
  apply le_trans _ i,
  rw [this, triangle_removal_bound],
  refine (mul_le_mul_of_nonneg_right (min_le_right (_:ℝ) _) (pow_nonneg _ _)).trans _,
  apply nat.cast_nonneg,
  rw [mul_assoc, ←mul_pow, div_mul_eq_mul_div, (show (16:ℝ) = 8 * 2, by norm_num), mul_assoc (8:ℝ),
    ←div_mul_div, mul_pow, ←mul_assoc],
  suffices : ((card α : ℝ) / (2 * szemeredi_bound (ε / 8) ⌈4 / ε⌉₊)) ^ 3 ≤ X.card * Y.card * Z.card,
  { refine (mul_le_mul_of_nonneg_left this (mul_nonneg _ _)).trans _,
    { linarith },
    { apply pow_nonneg,
      apply div_nonneg hε.le,
      norm_num },
    apply le_of_eq,
    ring },
  rw [pow_succ, sq, mul_assoc],
  refine mul_le_mul (card_bound hP₁ hP₃ hX) _ (mul_nonneg _ _) (nat.cast_nonneg _),
  refine mul_le_mul (card_bound hP₁ hP₃ hY) (card_bound hP₁ hP₃ hZ) _ (nat.cast_nonneg _),
  all_goals
  { exact div_nonneg (nat.cast_nonneg _) (mul_nonneg (by norm_num) $ nat.cast_nonneg _) }
end

end simple_graph