/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark, Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Aaron Anderson, Jalex Stark, Kyle Miller, Alena Gusakov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.data.sym2
import Mathlib.data.set.finite
import Mathlib.PostPort

universes u l

namespace Mathlib

/-!
# Simple graphs

This module defines simple graphs on a vertex type `V` as an
irreflexive symmetric relation.

There is a basic API for locally finite graphs and for graphs with
finitely many vertices.

## Main definitions

* `simple_graph` is a structure for symmetric, irreflexive relations

* `neighbor_set` is the `set` of vertices adjacent to a given vertex

* `neighbor_finset` is the `finset` of vertices adjacent to a given vertex,
   if `neighbor_set` is finite

* `incidence_set` is the `set` of edges containing a given vertex

* `incidence_finset` is the `finset` of edges containing a given vertex,
   if `incidence_set` is finite

## Implementation notes

* A locally finite graph is one with instances `∀ v, fintype (G.neighbor_set v)`.

* Given instances `decidable_rel G.adj` and `fintype V`, then the graph
  is locally finite, too.

## Naming Conventions

* If the vertex type of a graph is finite, we refer to its cardinality as `card_verts`.

TODO: This is the simplest notion of an unoriented graph.  This should
eventually fit into a more complete combinatorics hierarchy which
includes multigraphs and directed graphs.  We begin with simple graphs
in order to start learning what the combinatorics hierarchy should
look like.

TODO: Part of this would include defining, for example, subgraphs of a
simple graph.

-/

/--
A simple graph is an irreflexive symmetric relation `adj` on a vertex type `V`.
The relation describes which pairs of vertices are adjacent.
There is exactly one edge for every pair of adjacent edges;
see `simple_graph.edge_set` for the corresponding edge set.
-/
structure simple_graph (V : Type u) where
  adj : V → V → Prop
  sym :
    autoParam (symmetric adj)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  loopless :
    autoParam (irreflexive adj)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

/--
Construct the simple graph induced by the given relation.  It
symmetrizes the relation and makes it irreflexive.
-/
def simple_graph.from_rel {V : Type u} (r : V → V → Prop) : simple_graph V :=
  simple_graph.mk fun (a b : V) => a ≠ b ∧ (r a b ∨ r b a)

protected instance simple_graph.fintype {V : Type u} [fintype V] : fintype (simple_graph V) :=
  fintype.of_injective simple_graph.adj simple_graph.ext

@[simp] theorem simple_graph.from_rel_adj {V : Type u} (r : V → V → Prop) (v : V) (w : V) :
    simple_graph.adj (simple_graph.from_rel r) v w ↔ v ≠ w ∧ (r v w ∨ r w v) :=
  iff.rfl

/--
The complete graph on a type `V` is the simple graph with all pairs of distinct vertices adjacent.
-/
def complete_graph (V : Type u) : simple_graph V := simple_graph.mk ne

protected instance simple_graph.inhabited (V : Type u) : Inhabited (simple_graph V) :=
  { default := complete_graph V }

protected instance complete_graph_adj_decidable (V : Type u) [DecidableEq V] :
    DecidableRel (simple_graph.adj (complete_graph V)) :=
  fun (v w : V) => not.decidable

namespace simple_graph

/-- `G.neighbor_set v` is the set of vertices adjacent to `v` in `G`. -/
def neighbor_set {V : Type u} (G : simple_graph V) (v : V) : set V := set_of (adj G v)

protected instance neighbor_set.mem_decidable {V : Type u} (G : simple_graph V) (v : V)
    [DecidableRel (adj G)] : decidable_pred fun (_x : V) => _x ∈ neighbor_set G v :=
  eq.mpr sorry fun (a : V) => set.decidable_mem (set_of (adj G v)) a

theorem ne_of_adj {V : Type u} (G : simple_graph V) {a : V} {b : V} (hab : adj G a b) : a ≠ b :=
  id fun (ᾰ : a = b) => Eq._oldrec (fun (hab : adj G a a) => loopless G a hab) ᾰ hab

/--
The edges of G consist of the unordered pairs of vertices related by
`G.adj`.
-/
def edge_set {V : Type u} (G : simple_graph V) : set (sym2 V) := sym2.from_rel (sym G)

/--
The `incidence_set` is the set of edges incident to a given vertex.
-/
def incidence_set {V : Type u} (G : simple_graph V) (v : V) : set (sym2 V) :=
  has_sep.sep (fun (e : sym2 V) => v ∈ e) (edge_set G)

theorem incidence_set_subset {V : Type u} (G : simple_graph V) (v : V) :
    incidence_set G v ⊆ edge_set G :=
  fun (_x : sym2 V) (h : _x ∈ incidence_set G v) => and.left h

@[simp] theorem mem_edge_set {V : Type u} (G : simple_graph V) {v : V} {w : V} :
    quotient.mk (v, w) ∈ edge_set G ↔ adj G v w :=
  iff.refl (quotient.mk (v, w) ∈ edge_set G)

/--
Two vertices are adjacent iff there is an edge between them.  The
condition `v ≠ w` ensures they are different endpoints of the edge,
which is necessary since when `v = w` the existential
`∃ (e ∈ G.edge_set), v ∈ e ∧ w ∈ e` is satisfied by every edge
incident to `v`.
-/
theorem adj_iff_exists_edge {V : Type u} (G : simple_graph V) {v : V} {w : V} :
    adj G v w ↔ v ≠ w ∧ ∃ (e : sym2 V), ∃ (H : e ∈ edge_set G), v ∈ e ∧ w ∈ e :=
  sorry

theorem edge_other_ne {V : Type u} (G : simple_graph V) {e : sym2 V} (he : e ∈ edge_set G) {v : V}
    (h : v ∈ e) : sym2.mem.other h ≠ v :=
  ne_of_adj G
    (eq.mp (Eq._oldrec (Eq.refl (quotient.mk (v, sym2.mem.other h) ∈ edge_set G)) sym2.eq_swap)
      (eq.mp (Eq._oldrec (Eq.refl (e ∈ edge_set G)) (Eq.symm (sym2.mem_other_spec h))) he))

protected instance edge_set_decidable_pred {V : Type u} (G : simple_graph V)
    [DecidableRel (adj G)] : decidable_pred (edge_set G) :=
  sym2.from_rel.decidable_pred (sym G)

protected instance edges_fintype {V : Type u} (G : simple_graph V) [DecidableEq V] [fintype V]
    [DecidableRel (adj G)] : fintype ↥(edge_set G) :=
  subtype.fintype fun (x : sym2 V) => x ∈ edge_set G

protected instance incidence_set_decidable_pred {V : Type u} (G : simple_graph V) [DecidableEq V]
    [DecidableRel (adj G)] (v : V) : decidable_pred (incidence_set G v) :=
  fun (e : sym2 V) => and.decidable

/--
The `edge_set` of the graph as a `finset`.
-/
def edge_finset {V : Type u} (G : simple_graph V) [DecidableEq V] [fintype V]
    [DecidableRel (adj G)] : finset (sym2 V) :=
  set.to_finset (edge_set G)

@[simp] theorem mem_edge_finset {V : Type u} (G : simple_graph V) [DecidableEq V] [fintype V]
    [DecidableRel (adj G)] (e : sym2 V) : e ∈ edge_finset G ↔ e ∈ edge_set G :=
  set.mem_to_finset

@[simp] theorem edge_set_univ_card {V : Type u} (G : simple_graph V) [DecidableEq V] [fintype V]
    [DecidableRel (adj G)] : finset.card finset.univ = finset.card (edge_finset G) :=
  fintype.card_of_subtype (edge_finset G) (mem_edge_finset G)

@[simp] theorem irrefl {V : Type u} (G : simple_graph V) {v : V} : ¬adj G v v := loopless G v

theorem edge_symm {V : Type u} (G : simple_graph V) (u : V) (v : V) : adj G u v ↔ adj G v u :=
  { mp := fun (x : adj G u v) => sym G x, mpr := fun (x : adj G v u) => sym G x }

@[simp] theorem mem_neighbor_set {V : Type u} (G : simple_graph V) (v : V) (w : V) :
    w ∈ neighbor_set G v ↔ adj G v w :=
  iff.rfl

@[simp] theorem mem_incidence_set {V : Type u} (G : simple_graph V) (v : V) (w : V) :
    quotient.mk (v, w) ∈ incidence_set G v ↔ adj G v w :=
  sorry

theorem mem_incidence_iff_neighbor {V : Type u} (G : simple_graph V) {v : V} {w : V} :
    quotient.mk (v, w) ∈ incidence_set G v ↔ w ∈ neighbor_set G v :=
  sorry

theorem adj_incidence_set_inter {V : Type u} (G : simple_graph V) {v : V} {e : sym2 V}
    (he : e ∈ edge_set G) (h : v ∈ e) :
    incidence_set G v ∩ incidence_set G (sym2.mem.other h) = singleton e :=
  sorry

/--
The set of common neighbors between two vertices `v` and `w` in a graph `G` is the
intersection of the neighbor sets of `v` and `w`.
-/
def common_neighbors {V : Type u} (G : simple_graph V) (v : V) (w : V) : set V :=
  neighbor_set G v ∩ neighbor_set G w

theorem common_neighbors_eq {V : Type u} (G : simple_graph V) (v : V) (w : V) :
    common_neighbors G v w = neighbor_set G v ∩ neighbor_set G w :=
  rfl

theorem mem_common_neighbors {V : Type u} (G : simple_graph V) {u : V} {v : V} {w : V} :
    u ∈ common_neighbors G v w ↔ adj G v u ∧ adj G w u :=
  sorry

theorem common_neighbors_symm {V : Type u} (G : simple_graph V) (v : V) (w : V) :
    common_neighbors G v w = common_neighbors G w v :=
  sorry

theorem not_mem_common_neighbors_left {V : Type u} (G : simple_graph V) (v : V) (w : V) :
    ¬v ∈ common_neighbors G v w :=
  sorry

theorem not_mem_common_neighbors_right {V : Type u} (G : simple_graph V) (v : V) (w : V) :
    ¬w ∈ common_neighbors G v w :=
  sorry

theorem common_neighbors_subset_neighbor_set {V : Type u} (G : simple_graph V) (v : V) (w : V) :
    common_neighbors G v w ⊆ neighbor_set G v :=
  sorry

/--
Given an edge incident to a particular vertex, get the other vertex on the edge.
-/
def other_vertex_of_incident {V : Type u} (G : simple_graph V) [DecidableEq V] {v : V} {e : sym2 V}
    (h : e ∈ incidence_set G v) : V :=
  sym2.mem.other' sorry

theorem edge_mem_other_incident_set {V : Type u} (G : simple_graph V) [DecidableEq V] {v : V}
    {e : sym2 V} (h : e ∈ incidence_set G v) : e ∈ incidence_set G (other_vertex_of_incident G h) :=
  sorry

theorem incidence_other_prop {V : Type u} (G : simple_graph V) [DecidableEq V] {v : V} {e : sym2 V}
    (h : e ∈ incidence_set G v) : other_vertex_of_incident G h ∈ neighbor_set G v :=
  sorry

@[simp] theorem incidence_other_neighbor_edge {V : Type u} (G : simple_graph V) [DecidableEq V]
    {v : V} {w : V} (h : w ∈ neighbor_set G v) :
    other_vertex_of_incident G (iff.mpr (mem_incidence_iff_neighbor G) h) = w :=
  iff.mp sym2.congr_right
    (sym2.mem_other_spec' (and.right (iff.mpr (mem_incidence_iff_neighbor G) h)))

/--
There is an equivalence between the set of edges incident to a given
vertex and the set of vertices adjacent to the vertex.
-/
def incidence_set_equiv_neighbor_set {V : Type u} (G : simple_graph V) [DecidableEq V] (v : V) :
    ↥(incidence_set G v) ≃ ↥(neighbor_set G v) :=
  equiv.mk
    (fun (e : ↥(incidence_set G v)) =>
      { val := other_vertex_of_incident G sorry, property := sorry })
    (fun (w : ↥(neighbor_set G v)) => { val := quotient.mk (v, subtype.val w), property := sorry })
    sorry sorry

/-!
## Finiteness at a vertex

This section contains definitions and lemmas concerning vertices that
have finitely many adjacent vertices.  We denote this condition by
`fintype (G.neighbor_set v)`.

We define `G.neighbor_finset v` to be the `finset` version of `G.neighbor_set v`.
Use `neighbor_finset_eq_filter` to rewrite this definition as a `filter`.
-/

/--
`G.neighbors v` is the `finset` version of `G.adj v` in case `G` is
locally finite at `v`.
-/
def neighbor_finset {V : Type u} (G : simple_graph V) (v : V) [fintype ↥(neighbor_set G v)] :
    finset V :=
  set.to_finset (neighbor_set G v)

@[simp] theorem mem_neighbor_finset {V : Type u} (G : simple_graph V) (v : V)
    [fintype ↥(neighbor_set G v)] (w : V) : w ∈ neighbor_finset G v ↔ adj G v w :=
  set.mem_to_finset

/--
`G.degree v` is the number of vertices adjacent to `v`.
-/
def degree {V : Type u} (G : simple_graph V) (v : V) [fintype ↥(neighbor_set G v)] : ℕ :=
  finset.card (neighbor_finset G v)

@[simp] theorem card_neighbor_set_eq_degree {V : Type u} (G : simple_graph V) (v : V)
    [fintype ↥(neighbor_set G v)] : fintype.card ↥(neighbor_set G v) = degree G v :=
  Eq.symm (set.to_finset_card (neighbor_set G v))

theorem degree_pos_iff_exists_adj {V : Type u} (G : simple_graph V) (v : V)
    [fintype ↥(neighbor_set G v)] : 0 < degree G v ↔ ∃ (w : V), adj G v w :=
  sorry

protected instance incidence_set_fintype {V : Type u} (G : simple_graph V) (v : V)
    [fintype ↥(neighbor_set G v)] [DecidableEq V] : fintype ↥(incidence_set G v) :=
  fintype.of_equiv (↥(neighbor_set G v)) (equiv.symm (incidence_set_equiv_neighbor_set G v))

/--
This is the `finset` version of `incidence_set`.
-/
def incidence_finset {V : Type u} (G : simple_graph V) (v : V) [fintype ↥(neighbor_set G v)]
    [DecidableEq V] : finset (sym2 V) :=
  set.to_finset (incidence_set G v)

@[simp] theorem card_incidence_set_eq_degree {V : Type u} (G : simple_graph V) (v : V)
    [fintype ↥(neighbor_set G v)] [DecidableEq V] :
    fintype.card ↥(incidence_set G v) = degree G v :=
  sorry

@[simp] theorem mem_incidence_finset {V : Type u} (G : simple_graph V) (v : V)
    [fintype ↥(neighbor_set G v)] [DecidableEq V] (e : sym2 V) :
    e ∈ incidence_finset G v ↔ e ∈ incidence_set G v :=
  set.mem_to_finset

/--
A graph is locally finite if every vertex has a finite neighbor set.
-/
def locally_finite {V : Type u} (G : simple_graph V) := (v : V) → fintype ↥(neighbor_set G v)

/--
A locally finite simple graph is regular of degree `d` if every vertex has degree `d`.
-/
def is_regular_of_degree {V : Type u} (G : simple_graph V) [locally_finite G] (d : ℕ) :=
  ∀ (v : V), degree G v = d

theorem is_regular_of_degree_eq {V : Type u} (G : simple_graph V) [locally_finite G] {d : ℕ}
    (h : is_regular_of_degree G d) (v : V) : degree G v = d :=
  h v

protected instance neighbor_set_fintype {V : Type u} (G : simple_graph V) [fintype V]
    [DecidableRel (adj G)] (v : V) : fintype ↥(neighbor_set G v) :=
  subtype.fintype fun (x : V) => x ∈ neighbor_set G v

theorem neighbor_finset_eq_filter {V : Type u} (G : simple_graph V) [fintype V] {v : V}
    [DecidableRel (adj G)] : neighbor_finset G v = finset.filter (adj G v) finset.univ :=
  sorry

@[simp] theorem complete_graph_degree {V : Type u} [fintype V] [DecidableEq V] (v : V) :
    degree (complete_graph V) v = fintype.card V - 1 :=
  sorry

theorem complete_graph_is_regular {V : Type u} [fintype V] [DecidableEq V] :
    is_regular_of_degree (complete_graph V) (fintype.card V - 1) :=
  sorry

/--
The minimum degree of all vertices
-/
def min_degree {V : Type u} [fintype V] (G : simple_graph V) [Nonempty V] [DecidableRel (adj G)] :
    ℕ :=
  finset.min' (finset.image (fun (v : V) => degree G v) finset.univ) sorry

/--
The maximum degree of all vertices
-/
def max_degree {V : Type u} [fintype V] (G : simple_graph V) [Nonempty V] [DecidableRel (adj G)] :
    ℕ :=
  finset.max' (finset.image (fun (v : V) => degree G v) finset.univ) sorry

/-! The following lemmas about `fintype.card` use noncomputable decidable instances to get fintype
assumptions. -/

theorem degree_lt_card_verts {V : Type u} [fintype V] (G : simple_graph V) (v : V) :
    degree G v < fintype.card V :=
  sorry

theorem card_common_neighbors_le_degree_left {V : Type u} (G : simple_graph V) [fintype V] (v : V)
    (w : V) : fintype.card ↥(common_neighbors G v w) ≤ degree G v :=
  sorry

theorem card_common_neighbors_le_degree_right {V : Type u} (G : simple_graph V) [fintype V] (v : V)
    (w : V) : fintype.card ↥(common_neighbors G v w) ≤ degree G w :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (fintype.card ↥(common_neighbors G v w) ≤ degree G w))
        (common_neighbors_symm G v w)))
    (card_common_neighbors_le_degree_left G w v)

theorem card_common_neighbors_lt_card_verts {V : Type u} (G : simple_graph V) [fintype V] (v : V)
    (w : V) : fintype.card ↥(common_neighbors G v w) < fintype.card V :=
  nat.lt_of_le_of_lt (card_common_neighbors_le_degree_left G v w) (degree_lt_card_verts G v)

/--
If the condition `G.adj v w` fails, then `card_common_neighbors_le_degree` is
the best we can do in general.
-/
theorem adj.card_common_neighbors_lt_degree {V : Type u} [fintype V] {G : simple_graph V} {v : V}
    {w : V} (h : adj G v w) : fintype.card ↥(common_neighbors G v w) < degree G v :=
  sorry

/-!
## Complement of a simple graph

This section contains definitions and lemmas concerning the complement of a simple graph.
-/

/--
We define `compl G` to be the `simple_graph V` such that no two adjacent vertices in `G`
are adjacent in the complement, and every nonadjacent pair of vertices is adjacent
(still ensuring that vertices are not adjacent to themselves.)
-/
def compl {V : Type u} (G : simple_graph V) : simple_graph V :=
  mk fun (v w : V) => v ≠ w ∧ ¬adj G v w

protected instance has_compl {V : Type u} : has_compl (simple_graph V) := has_compl.mk compl

@[simp] theorem compl_adj {V : Type u} (G : simple_graph V) (v : V) (w : V) :
    adj (Gᶜ) v w ↔ v ≠ w ∧ ¬adj G v w :=
  iff.rfl

@[simp] theorem compl_compl {V : Type u} (G : simple_graph V) : Gᶜᶜ = G := sorry

@[simp] theorem compl_involutive {V : Type u} : function.involutive compl := compl_compl

theorem compl_neighbor_set_disjoint {V : Type u} (G : simple_graph V) (v : V) :
    disjoint (neighbor_set G v) (neighbor_set (Gᶜ) v) :=
  sorry

theorem neighbor_set_union_compl_neighbor_set_eq {V : Type u} (G : simple_graph V) (v : V) :
    neighbor_set G v ∪ neighbor_set (Gᶜ) v = (singleton vᶜ) :=
  sorry

end Mathlib


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

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

/-!
# Comparison

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

This file provides basic results about orderings and comparison in linear orders.

## Definitions

* `cmp_le`: An `ordering` from `≤`.
* `ordering.compares`: Turns an `ordering` into `<` and `=` propositions.
* `linear_order_of_compares`: Constructs a `linear_order` instance from the fact that any two
  elements that are not one strictly less than the other either way are equal.
-/

variable {α : Type _}

#print cmpLE /-
/-- Like `cmp`, but uses a `≤` on the type instead of `<`. Given two elements `x` and `y`, returns a
three-way comparison result `ordering`. -/
def cmpLE {α} [LE α] [@DecidableRel α (· ≤ ·)] (x y : α) : Ordering :=
  if x ≤ y then if y ≤ x then Ordering.eq else Ordering.lt else Ordering.gt
#align cmp_le cmpLE
-/

#print cmpLE_swap /-
theorem cmpLE_swap {α} [LE α] [IsTotal α (· ≤ ·)] [@DecidableRel α (· ≤ ·)] (x y : α) :
    (cmpLE x y).symm = cmpLE y x :=
  by
  by_cases xy : x ≤ y <;> by_cases yx : y ≤ x <;> simp [cmpLE, *, Ordering.swap]
  cases not_or_of_not xy yx (total_of _ _ _)
#align cmp_le_swap cmpLE_swap
-/

#print cmpLE_eq_cmp /-
theorem cmpLE_eq_cmp {α} [Preorder α] [IsTotal α (· ≤ ·)] [@DecidableRel α (· ≤ ·)]
    [@DecidableRel α (· < ·)] (x y : α) : cmpLE x y = cmp x y :=
  by
  by_cases xy : x ≤ y <;> by_cases yx : y ≤ x <;> simp [cmpLE, lt_iff_le_not_le, *, cmp, cmpUsing]
  cases not_or_of_not xy yx (total_of _ _ _)
#align cmp_le_eq_cmp cmpLE_eq_cmp
-/

namespace Ordering

#print Ordering.Compares /-
/-- `compares o a b` means that `a` and `b` have the ordering relation `o` between them, assuming
that the relation `a < b` is defined. -/
@[simp]
def Compares [LT α] : Ordering → α → α → Prop
  | lt, a, b => a < b
  | Eq, a, b => a = b
  | GT.gt, a, b => a > b
#align ordering.compares Ordering.Compares
-/

#print Ordering.compares_swap /-
theorem compares_swap [LT α] {a b : α} {o : Ordering} : o.symm.Compares a b ↔ o.Compares b a :=
  by
  cases o
  exacts[Iff.rfl, eq_comm, Iff.rfl]
#align ordering.compares_swap Ordering.compares_swap
-/

alias compares_swap ↔ compares.of_swap compares.swap
#align ordering.compares.of_swap Ordering.Compares.of_swap
#align ordering.compares.swap Ordering.Compares.swap

#print Ordering.swap_inj /-
@[simp]
theorem swap_inj (o₁ o₂ : Ordering) : o₁.symm = o₂.symm ↔ o₁ = o₂ := by
  cases o₁ <;> cases o₂ <;> decide
#align ordering.swap_inj Ordering.swap_inj
-/

#print Ordering.swap_eq_iff_eq_swap /-
theorem swap_eq_iff_eq_swap {o o' : Ordering} : o.symm = o' ↔ o = o'.symm := by
  rw [← swap_inj, swap_swap]
#align ordering.swap_eq_iff_eq_swap Ordering.swap_eq_iff_eq_swap
-/

#print Ordering.Compares.eq_lt /-
theorem Compares.eq_lt [Preorder α] : ∀ {o} {a b : α}, Compares o a b → (o = lt ↔ a < b)
  | lt, a, b, h => ⟨fun _ => h, fun _ => rfl⟩
  | Eq, a, b, h => ⟨fun h => by injection h, fun h' => (ne_of_lt h' h).elim⟩
  | GT.gt, a, b, h => ⟨fun h => by injection h, fun h' => (lt_asymm h h').elim⟩
#align ordering.compares.eq_lt Ordering.Compares.eq_lt
-/

#print Ordering.Compares.ne_lt /-
theorem Compares.ne_lt [Preorder α] : ∀ {o} {a b : α}, Compares o a b → (o ≠ lt ↔ b ≤ a)
  | lt, a, b, h => ⟨absurd rfl, fun h' => (not_le_of_lt h h').elim⟩
  | Eq, a, b, h => ⟨fun _ => ge_of_eq h, fun _ h => by injection h⟩
  | GT.gt, a, b, h => ⟨fun _ => le_of_lt h, fun _ h => by injection h⟩
#align ordering.compares.ne_lt Ordering.Compares.ne_lt
-/

#print Ordering.Compares.eq_eq /-
theorem Compares.eq_eq [Preorder α] : ∀ {o} {a b : α}, Compares o a b → (o = eq ↔ a = b)
  | lt, a, b, h => ⟨fun h => by injection h, fun h' => (ne_of_lt h h').elim⟩
  | Eq, a, b, h => ⟨fun _ => h, fun _ => rfl⟩
  | GT.gt, a, b, h => ⟨fun h => by injection h, fun h' => (ne_of_gt h h').elim⟩
#align ordering.compares.eq_eq Ordering.Compares.eq_eq
-/

#print Ordering.Compares.eq_gt /-
theorem Compares.eq_gt [Preorder α] {o} {a b : α} (h : Compares o a b) : o = gt ↔ b < a :=
  swap_eq_iff_eq_swap.symm.trans h.symm.eq_lt
#align ordering.compares.eq_gt Ordering.Compares.eq_gt
-/

#print Ordering.Compares.ne_gt /-
theorem Compares.ne_gt [Preorder α] {o} {a b : α} (h : Compares o a b) : o ≠ gt ↔ a ≤ b :=
  (not_congr swap_eq_iff_eq_swap.symm).trans h.symm.ne_lt
#align ordering.compares.ne_gt Ordering.Compares.ne_gt
-/

#print Ordering.Compares.le_total /-
theorem Compares.le_total [Preorder α] {a b : α} : ∀ {o}, Compares o a b → a ≤ b ∨ b ≤ a
  | lt, h => Or.inl (le_of_lt h)
  | Eq, h => Or.inl (le_of_eq h)
  | GT.gt, h => Or.inr (le_of_lt h)
#align ordering.compares.le_total Ordering.Compares.le_total
-/

#print Ordering.Compares.le_antisymm /-
theorem Compares.le_antisymm [Preorder α] {a b : α} : ∀ {o}, Compares o a b → a ≤ b → b ≤ a → a = b
  | lt, h, _, hba => (not_le_of_lt h hba).elim
  | Eq, h, _, _ => h
  | GT.gt, h, hab, _ => (not_le_of_lt h hab).elim
#align ordering.compares.le_antisymm Ordering.Compares.le_antisymm
-/

#print Ordering.Compares.inj /-
theorem Compares.inj [Preorder α] {o₁} :
    ∀ {o₂} {a b : α}, Compares o₁ a b → Compares o₂ a b → o₁ = o₂
  | lt, a, b, h₁, h₂ => h₁.eq_lt.2 h₂
  | Eq, a, b, h₁, h₂ => h₁.eq_eq.2 h₂
  | GT.gt, a, b, h₁, h₂ => h₁.eq_gt.2 h₂
#align ordering.compares.inj Ordering.Compares.inj
-/

/- warning: ordering.compares_iff_of_compares_impl -> Ordering.compares_iff_of_compares_impl is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : Preorder.{u2} β] {a : α} {b : α} {a' : β} {b' : β}, (forall {o : Ordering}, (Ordering.Compares.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α _inst_1))) o a b) -> (Ordering.Compares.{u2} β (Preorder.toLT.{u2} β _inst_2) o a' b')) -> (forall (o : Ordering), Iff (Ordering.Compares.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α _inst_1))) o a b) (Ordering.Compares.{u2} β (Preorder.toLT.{u2} β _inst_2) o a' b'))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : Preorder.{u1} β] {a : α} {b : α} {a' : β} {b' : β}, (forall {o : Ordering}, (Ordering.Compares.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (LinearOrder.toPartialOrder.{u2} α _inst_1))) o a b) -> (Ordering.Compares.{u1} β (Preorder.toLT.{u1} β _inst_2) o a' b')) -> (forall (o : Ordering), Iff (Ordering.Compares.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (LinearOrder.toPartialOrder.{u2} α _inst_1))) o a b) (Ordering.Compares.{u1} β (Preorder.toLT.{u1} β _inst_2) o a' b'))
Case conversion may be inaccurate. Consider using '#align ordering.compares_iff_of_compares_impl Ordering.compares_iff_of_compares_implₓ'. -/
theorem compares_iff_of_compares_impl {β : Type _} [LinearOrder α] [Preorder β] {a b : α}
    {a' b' : β} (h : ∀ {o}, Compares o a b → Compares o a' b') (o) :
    Compares o a b ↔ Compares o a' b' :=
  by
  refine' ⟨h, fun ho => _⟩
  cases' lt_trichotomy a b with hab hab
  · change compares Ordering.lt a b at hab
    rwa [ho.inj (h hab)]
  · cases' hab with hab hab
    · change compares Ordering.eq a b at hab
      rwa [ho.inj (h hab)]
    · change compares Ordering.gt a b at hab
      rwa [ho.inj (h hab)]
#align ordering.compares_iff_of_compares_impl Ordering.compares_iff_of_compares_impl

#print Ordering.swap_orElse /-
theorem swap_orElse (o₁ o₂) : (orElse o₁ o₂).symm = orElse o₁.symm o₂.symm := by
  cases o₁ <;> try rfl <;> cases o₂ <;> rfl
#align ordering.swap_or_else Ordering.swap_orElse
-/

#print Ordering.orElse_eq_lt /-
theorem orElse_eq_lt (o₁ o₂) : orElse o₁ o₂ = lt ↔ o₁ = lt ∨ o₁ = eq ∧ o₂ = lt := by
  cases o₁ <;> cases o₂ <;> exact by decide
#align ordering.or_else_eq_lt Ordering.orElse_eq_lt
-/

end Ordering

open Ordering OrderDual

#print toDual_compares_toDual /-
@[simp]
theorem toDual_compares_toDual [LT α] {a b : α} {o : Ordering} :
    Compares o (toDual a) (toDual b) ↔ Compares o b a :=
  by
  cases o
  exacts[Iff.rfl, eq_comm, Iff.rfl]
#align to_dual_compares_to_dual toDual_compares_toDual
-/

#print ofDual_compares_ofDual /-
@[simp]
theorem ofDual_compares_ofDual [LT α] {a b : αᵒᵈ} {o : Ordering} :
    Compares o (ofDual a) (ofDual b) ↔ Compares o b a :=
  by
  cases o
  exacts[Iff.rfl, eq_comm, Iff.rfl]
#align of_dual_compares_of_dual ofDual_compares_ofDual
-/

#print cmp_compares /-
theorem cmp_compares [LinearOrder α] (a b : α) : (cmp a b).Compares a b := by
  obtain h | h | h := lt_trichotomy a b <;> simp [cmp, cmpUsing, h, h.not_lt]
#align cmp_compares cmp_compares
-/

#print Ordering.Compares.cmp_eq /-
theorem Ordering.Compares.cmp_eq [LinearOrder α] {a b : α} {o : Ordering} (h : o.Compares a b) :
    cmp a b = o :=
  (cmp_compares a b).inj h
#align ordering.compares.cmp_eq Ordering.Compares.cmp_eq
-/

#print cmp_swap /-
@[simp]
theorem cmp_swap [Preorder α] [@DecidableRel α (· < ·)] (a b : α) : (cmp a b).symm = cmp b a :=
  by
  unfold cmp cmpUsing
  by_cases a < b <;> by_cases h₂ : b < a <;> simp [h, h₂, Ordering.swap]
  exact lt_asymm h h₂
#align cmp_swap cmp_swap
-/

#print cmpLE_toDual /-
@[simp]
theorem cmpLE_toDual [LE α] [@DecidableRel α (· ≤ ·)] (x y : α) :
    cmpLE (toDual x) (toDual y) = cmpLE y x :=
  rfl
#align cmp_le_to_dual cmpLE_toDual
-/

#print cmpLE_ofDual /-
@[simp]
theorem cmpLE_ofDual [LE α] [@DecidableRel α (· ≤ ·)] (x y : αᵒᵈ) :
    cmpLE (ofDual x) (ofDual y) = cmpLE y x :=
  rfl
#align cmp_le_of_dual cmpLE_ofDual
-/

/- warning: cmp_to_dual clashes with cmp_le_to_dual -> cmpLE_toDual
warning: cmp_to_dual -> cmpLE_toDual is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LT.{u1} α] [_inst_2 : DecidableRel.{succ u1} α (LT.lt.{u1} α _inst_1)] (x : α) (y : α), Eq.{1} Ordering (cmp.{u1} (OrderDual.{u1} α) (OrderDual.hasLt.{u1} α _inst_1) (fun (a : OrderDual.{u1} α) (b : OrderDual.{u1} α) => _inst_2 b a) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} α (OrderDual.{u1} α)) (fun (_x : Equiv.{succ u1, succ u1} α (OrderDual.{u1} α)) => α -> (OrderDual.{u1} α)) (Equiv.hasCoeToFun.{succ u1, succ u1} α (OrderDual.{u1} α)) (OrderDual.toDual.{u1} α) x) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} α (OrderDual.{u1} α)) (fun (_x : Equiv.{succ u1, succ u1} α (OrderDual.{u1} α)) => α -> (OrderDual.{u1} α)) (Equiv.hasCoeToFun.{succ u1, succ u1} α (OrderDual.{u1} α)) (OrderDual.toDual.{u1} α) y)) (cmp.{u1} α _inst_1 (fun (a : α) (b : α) => _inst_2 a b) y x)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : LE.{u1} α] [_inst_2 : DecidableRel.{succ u1} α (fun (x._@.Mathlib.Order.Compare._hyg.2480 : α) (x._@.Mathlib.Order.Compare._hyg.2482 : α) => LE.le.{u1} α _inst_1 x._@.Mathlib.Order.Compare._hyg.2480 x._@.Mathlib.Order.Compare._hyg.2482)] (x : α) (y : α), Eq.{1} Ordering (cmpLE.{u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α) => OrderDual.{u1} α) x) (OrderDual.instLEOrderDual.{u1} α _inst_1) (fun (a : OrderDual.{u1} α) (b : OrderDual.{u1} α) => _inst_2 b a) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} α (OrderDual.{u1} α)) α (fun (_x : α) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α) => OrderDual.{u1} α) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} α (OrderDual.{u1} α)) (OrderDual.toDual.{u1} α) x) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} α (OrderDual.{u1} α)) α (fun (_x : α) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α) => OrderDual.{u1} α) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} α (OrderDual.{u1} α)) (OrderDual.toDual.{u1} α) y)) (cmpLE.{u1} α _inst_1 (fun (a : α) (b : α) => _inst_2 a b) y x)
Case conversion may be inaccurate. Consider using '#align cmp_to_dual cmpLE_toDualₓ'. -/
@[simp]
theorem cmpLE_toDual [LT α] [@DecidableRel α (· < ·)] (x y : α) :
    cmp (toDual x) (toDual y) = cmp y x :=
  rfl
#align cmp_to_dual cmpLE_toDual

/- warning: cmp_of_dual clashes with cmp_le_of_dual -> cmpLE_ofDual
warning: cmp_of_dual -> cmpLE_ofDual is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LT.{u1} α] [_inst_2 : DecidableRel.{succ u1} α (LT.lt.{u1} α _inst_1)] (x : OrderDual.{u1} α) (y : OrderDual.{u1} α), Eq.{1} Ordering (cmp.{u1} α _inst_1 (fun (a : α) (b : α) => _inst_2 a b) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (OrderDual.{u1} α) α) (fun (_x : Equiv.{succ u1, succ u1} (OrderDual.{u1} α) α) => (OrderDual.{u1} α) -> α) (Equiv.hasCoeToFun.{succ u1, succ u1} (OrderDual.{u1} α) α) (OrderDual.ofDual.{u1} α) x) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (OrderDual.{u1} α) α) (fun (_x : Equiv.{succ u1, succ u1} (OrderDual.{u1} α) α) => (OrderDual.{u1} α) -> α) (Equiv.hasCoeToFun.{succ u1, succ u1} (OrderDual.{u1} α) α) (OrderDual.ofDual.{u1} α) y)) (cmp.{u1} (OrderDual.{u1} α) (OrderDual.hasLt.{u1} α _inst_1) (fun (a : OrderDual.{u1} α) (b : OrderDual.{u1} α) => _inst_2 b a) y x)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : LE.{u1} α] [_inst_2 : DecidableRel.{succ u1} α (fun (x._@.Mathlib.Order.Compare._hyg.2525 : α) (x._@.Mathlib.Order.Compare._hyg.2527 : α) => LE.le.{u1} α _inst_1 x._@.Mathlib.Order.Compare._hyg.2525 x._@.Mathlib.Order.Compare._hyg.2527)] (x : OrderDual.{u1} α) (y : OrderDual.{u1} α), Eq.{1} Ordering (cmpLE.{u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : OrderDual.{u1} α) => α) x) _inst_1 (fun (a : α) (b : α) => _inst_2 a b) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (OrderDual.{u1} α) α) (OrderDual.{u1} α) (fun (_x : OrderDual.{u1} α) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : OrderDual.{u1} α) => α) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (OrderDual.{u1} α) α) (OrderDual.ofDual.{u1} α) x) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (OrderDual.{u1} α) α) (OrderDual.{u1} α) (fun (_x : OrderDual.{u1} α) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : OrderDual.{u1} α) => α) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (OrderDual.{u1} α) α) (OrderDual.ofDual.{u1} α) y)) (cmpLE.{u1} (OrderDual.{u1} α) (OrderDual.instLEOrderDual.{u1} α _inst_1) (fun (a : OrderDual.{u1} α) (b : OrderDual.{u1} α) => _inst_2 b a) y x)
Case conversion may be inaccurate. Consider using '#align cmp_of_dual cmpLE_ofDualₓ'. -/
@[simp]
theorem cmpLE_ofDual [LT α] [@DecidableRel α (· < ·)] (x y : αᵒᵈ) :
    cmp (ofDual x) (ofDual y) = cmp y x :=
  rfl
#align cmp_of_dual cmpLE_ofDual

#print linearOrderOfCompares /-
/-- Generate a linear order structure from a preorder and `cmp` function. -/
def linearOrderOfCompares [Preorder α] (cmp : α → α → Ordering)
    (h : ∀ a b, (cmp a b).Compares a b) : LinearOrder α :=
  { ‹Preorder α› with
    le_antisymm := fun a b => (h a b).le_antisymm
    le_total := fun a b => (h a b).le_total
    decidableLe := fun a b => decidable_of_iff _ (h a b).ne_gt
    decidableLt := fun a b => decidable_of_iff _ (h a b).eq_lt
    DecidableEq := fun a b => decidable_of_iff _ (h a b).eq_eq }
#align linear_order_of_compares linearOrderOfCompares
-/

variable [LinearOrder α] (x y : α)

#print cmp_eq_lt_iff /-
@[simp]
theorem cmp_eq_lt_iff : cmp x y = Ordering.lt ↔ x < y :=
  Ordering.Compares.eq_lt (cmp_compares x y)
#align cmp_eq_lt_iff cmp_eq_lt_iff
-/

#print cmp_eq_eq_iff /-
@[simp]
theorem cmp_eq_eq_iff : cmp x y = Ordering.eq ↔ x = y :=
  Ordering.Compares.eq_eq (cmp_compares x y)
#align cmp_eq_eq_iff cmp_eq_eq_iff
-/

#print cmp_eq_gt_iff /-
@[simp]
theorem cmp_eq_gt_iff : cmp x y = Ordering.gt ↔ y < x :=
  Ordering.Compares.eq_gt (cmp_compares x y)
#align cmp_eq_gt_iff cmp_eq_gt_iff
-/

#print cmp_self_eq_eq /-
@[simp]
theorem cmp_self_eq_eq : cmp x x = Ordering.eq := by rw [cmp_eq_eq_iff]
#align cmp_self_eq_eq cmp_self_eq_eq
-/

variable {x y} {β : Type _} [LinearOrder β] {x' y' : β}

/- warning: cmp_eq_cmp_symm -> cmp_eq_cmp_symm is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] {x : α} {y : α} {β : Type.{u2}} [_inst_2 : LinearOrder.{u2} β] {x' : β} {y' : β}, Iff (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α _inst_1))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) x y) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (LinearOrder.toPartialOrder.{u2} β _inst_2))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) x' y')) (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α _inst_1))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) y x) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (LinearOrder.toPartialOrder.{u2} β _inst_2))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) y' x'))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : LinearOrder.{u2} α] {x : α} {y : α} {β : Type.{u1}} [_inst_2 : LinearOrder.{u1} β] {x' : β} {y' : β}, Iff (Eq.{1} Ordering (cmp.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (LinearOrder.toPartialOrder.{u2} α _inst_1))) (fun (a : α) (b : α) => instDecidableLtToLTToPreorderToPartialOrder.{u2} α _inst_1 a b) x y) (cmp.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (LinearOrder.toPartialOrder.{u1} β _inst_2))) (fun (a : β) (b : β) => instDecidableLtToLTToPreorderToPartialOrder.{u1} β _inst_2 a b) x' y')) (Eq.{1} Ordering (cmp.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (LinearOrder.toPartialOrder.{u2} α _inst_1))) (fun (a : α) (b : α) => instDecidableLtToLTToPreorderToPartialOrder.{u2} α _inst_1 a b) y x) (cmp.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (LinearOrder.toPartialOrder.{u1} β _inst_2))) (fun (a : β) (b : β) => instDecidableLtToLTToPreorderToPartialOrder.{u1} β _inst_2 a b) y' x'))
Case conversion may be inaccurate. Consider using '#align cmp_eq_cmp_symm cmp_eq_cmp_symmₓ'. -/
theorem cmp_eq_cmp_symm : cmp x y = cmp x' y' ↔ cmp y x = cmp y' x' := by
  rw [← cmp_swap x', ← cmp_swap x, swap_inj]
#align cmp_eq_cmp_symm cmp_eq_cmp_symm

/- warning: lt_iff_lt_of_cmp_eq_cmp -> lt_iff_lt_of_cmp_eq_cmp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] {x : α} {y : α} {β : Type.{u2}} [_inst_2 : LinearOrder.{u2} β] {x' : β} {y' : β}, (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α _inst_1))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) x y) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (LinearOrder.toPartialOrder.{u2} β _inst_2))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) x' y')) -> (Iff (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α _inst_1))) x y) (LT.lt.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (LinearOrder.toPartialOrder.{u2} β _inst_2))) x' y'))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : LinearOrder.{u2} α] {x : α} {y : α} {β : Type.{u1}} [_inst_2 : LinearOrder.{u1} β] {x' : β} {y' : β}, (Eq.{1} Ordering (cmp.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (LinearOrder.toPartialOrder.{u2} α _inst_1))) (fun (a : α) (b : α) => instDecidableLtToLTToPreorderToPartialOrder.{u2} α _inst_1 a b) x y) (cmp.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (LinearOrder.toPartialOrder.{u1} β _inst_2))) (fun (a : β) (b : β) => instDecidableLtToLTToPreorderToPartialOrder.{u1} β _inst_2 a b) x' y')) -> (Iff (LT.lt.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (LinearOrder.toPartialOrder.{u2} α _inst_1))) x y) (LT.lt.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (LinearOrder.toPartialOrder.{u1} β _inst_2))) x' y'))
Case conversion may be inaccurate. Consider using '#align lt_iff_lt_of_cmp_eq_cmp lt_iff_lt_of_cmp_eq_cmpₓ'. -/
theorem lt_iff_lt_of_cmp_eq_cmp (h : cmp x y = cmp x' y') : x < y ↔ x' < y' := by
  rw [← cmp_eq_lt_iff, ← cmp_eq_lt_iff, h]
#align lt_iff_lt_of_cmp_eq_cmp lt_iff_lt_of_cmp_eq_cmp

/- warning: le_iff_le_of_cmp_eq_cmp -> le_iff_le_of_cmp_eq_cmp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] {x : α} {y : α} {β : Type.{u2}} [_inst_2 : LinearOrder.{u2} β] {x' : β} {y' : β}, (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α _inst_1))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) x y) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (LinearOrder.toPartialOrder.{u2} β _inst_2))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) x' y')) -> (Iff (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α _inst_1))) x y) (LE.le.{u2} β (Preorder.toLE.{u2} β (PartialOrder.toPreorder.{u2} β (LinearOrder.toPartialOrder.{u2} β _inst_2))) x' y'))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : LinearOrder.{u2} α] {x : α} {y : α} {β : Type.{u1}} [_inst_2 : LinearOrder.{u1} β] {x' : β} {y' : β}, (Eq.{1} Ordering (cmp.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (LinearOrder.toPartialOrder.{u2} α _inst_1))) (fun (a : α) (b : α) => instDecidableLtToLTToPreorderToPartialOrder.{u2} α _inst_1 a b) x y) (cmp.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (LinearOrder.toPartialOrder.{u1} β _inst_2))) (fun (a : β) (b : β) => instDecidableLtToLTToPreorderToPartialOrder.{u1} β _inst_2 a b) x' y')) -> (Iff (LE.le.{u2} α (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (LinearOrder.toPartialOrder.{u2} α _inst_1))) x y) (LE.le.{u1} β (Preorder.toLE.{u1} β (PartialOrder.toPreorder.{u1} β (LinearOrder.toPartialOrder.{u1} β _inst_2))) x' y'))
Case conversion may be inaccurate. Consider using '#align le_iff_le_of_cmp_eq_cmp le_iff_le_of_cmp_eq_cmpₓ'. -/
theorem le_iff_le_of_cmp_eq_cmp (h : cmp x y = cmp x' y') : x ≤ y ↔ x' ≤ y' :=
  by
  rw [← not_lt, ← not_lt]
  apply not_congr
  apply lt_iff_lt_of_cmp_eq_cmp
  rwa [cmp_eq_cmp_symm]
#align le_iff_le_of_cmp_eq_cmp le_iff_le_of_cmp_eq_cmp

/- warning: eq_iff_eq_of_cmp_eq_cmp -> eq_iff_eq_of_cmp_eq_cmp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] {x : α} {y : α} {β : Type.{u2}} [_inst_2 : LinearOrder.{u2} β] {x' : β} {y' : β}, (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α _inst_1))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) x y) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (LinearOrder.toPartialOrder.{u2} β _inst_2))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) x' y')) -> (Iff (Eq.{succ u1} α x y) (Eq.{succ u2} β x' y'))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : LinearOrder.{u2} α] {x : α} {y : α} {β : Type.{u1}} [_inst_2 : LinearOrder.{u1} β] {x' : β} {y' : β}, (Eq.{1} Ordering (cmp.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (LinearOrder.toPartialOrder.{u2} α _inst_1))) (fun (a : α) (b : α) => instDecidableLtToLTToPreorderToPartialOrder.{u2} α _inst_1 a b) x y) (cmp.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (LinearOrder.toPartialOrder.{u1} β _inst_2))) (fun (a : β) (b : β) => instDecidableLtToLTToPreorderToPartialOrder.{u1} β _inst_2 a b) x' y')) -> (Iff (Eq.{succ u2} α x y) (Eq.{succ u1} β x' y'))
Case conversion may be inaccurate. Consider using '#align eq_iff_eq_of_cmp_eq_cmp eq_iff_eq_of_cmp_eq_cmpₓ'. -/
theorem eq_iff_eq_of_cmp_eq_cmp (h : cmp x y = cmp x' y') : x = y ↔ x' = y' := by
  rw [le_antisymm_iff, le_antisymm_iff, le_iff_le_of_cmp_eq_cmp h,
    le_iff_le_of_cmp_eq_cmp (cmp_eq_cmp_symm.1 h)]
#align eq_iff_eq_of_cmp_eq_cmp eq_iff_eq_of_cmp_eq_cmp

#print LT.lt.cmp_eq_lt /-
theorem LT.lt.cmp_eq_lt (h : x < y) : cmp x y = Ordering.lt :=
  (cmp_eq_lt_iff _ _).2 h
#align has_lt.lt.cmp_eq_lt LT.lt.cmp_eq_lt
-/

#print LT.lt.cmp_eq_gt /-
theorem LT.lt.cmp_eq_gt (h : x < y) : cmp y x = Ordering.gt :=
  (cmp_eq_gt_iff _ _).2 h
#align has_lt.lt.cmp_eq_gt LT.lt.cmp_eq_gt
-/

#print Eq.cmp_eq_eq /-
theorem Eq.cmp_eq_eq (h : x = y) : cmp x y = Ordering.eq :=
  (cmp_eq_eq_iff _ _).2 h
#align eq.cmp_eq_eq Eq.cmp_eq_eq
-/

#print Eq.cmp_eq_eq' /-
theorem Eq.cmp_eq_eq' (h : x = y) : cmp y x = Ordering.eq :=
  h.symm.cmp_eq_eq
#align eq.cmp_eq_eq' Eq.cmp_eq_eq'
-/


import tactic.equiv_rw tactic group_theory.subgroup group_theory.semidirect_product

universes u v w x y z

def mul_left {G : Type*} [group G] : G →* equiv.perm G :=
{ to_fun := λ g,
  { to_fun := λ h, g * h,
    inv_fun := λ h, g⁻¹ * h,
    left_inv := λ _, by simp [mul_assoc],
    right_inv := λ _, by simp [mul_assoc] },
  map_one' := by ext; simp,
  map_mul' := λ _ _, by ext; simp [mul_assoc] }

@[simp] lemma coe_fn_mul_left {G : Type*} [group G] (g : G) : (⇑(mul_left g) : G → G) = (*) g := rfl
@[simp] lemma coe_fn_mul_left_symm {G : Type*} [group G] (g : G) : (⇑(mul_left g).symm : G → G) = (*) g⁻¹ := rfl

noncomputable theory

def reduced  {ι : Type u} {G : ι → Type v} [Π i, group (G i)] (l : list (Σ i : ι, G i)) : Prop :=
l.chain' (λ a b, a.1 ≠ b.1) ∧ ∀ a : Σ i, G i, a ∈ l → a.2 ≠ 1

def coprod {ι : Type u} (G : ι → Type v) [Π i, group (G i)] : Type (max u v) :=
{ l : list (Σ i, G i) // reduced l }

--protected constant coprod.monoid [Π i, monoid (G i)] : monoid (coprod G)
protected constant coprod.group {ι : Type u} {G : ι → Type v} [Π i, group (G i)] : group (coprod G)
attribute [instance] coprod.group

namespace coprod

variables {ι : Type u} [decidable_eq ι] {G : ι → Type v} [Π i, group (G i)] {M : Type w}
variables {α : Type*} {β : Type*} {γ : Type*} [decidable_eq α] [decidable_eq β] [decidable_eq γ]

constant of : Π i : ι, G i →* coprod G

@[simp] lemma cons_eq_of_mul {l : list (Σ i, G i)}
  (g : Σ i , G i) (h) :
  @eq (coprod G) (⟨g :: l, h⟩ : coprod G) (of g.1 g.2 * ⟨l, sorry⟩) := sorry

@[simp] lemma append_eq_mul (l₁ l₂ : list (Σ i, G i)) (hl):
  @eq (coprod G) ⟨l₁ ++ l₂, hl⟩ (⟨l₁, sorry⟩ * ⟨l₂, sorry⟩) := sorry

@[simp] lemma eta (w : coprod G) : (⟨w.1, w.2⟩ : coprod G) = w := by cases w; refl

constant lift [monoid M] (f : Π i, G i →* M) : coprod G →* M

protected constant decidable_eq : decidable_eq (coprod G)

attribute [instance] coprod.decidable_eq

@[simp] lemma lift_of [monoid M] (f : Π i, G i →* M) {i : ι} (g : G i) :
  lift f (of i g) = f i g := sorry

@[simp] lemma lift_comp_of [monoid M] (f : Π i, G i →* M) (i : ι) :
  (lift f).comp (of i) = f i :=
by ext; simp

@[elab_as_eliminator]
constant rec_on {C : coprod G → Sort*} (g : coprod G) (h1 : C 1)
  (f : Π (g : Σ i, G i) (h : coprod G), C h → C (of g.1 g.2 * h)) : C g

@[simp] lemma rec_on_one {C : coprod G → Sort*} (h1 : C 1)
  (f : Π (g : Σ i, G i) (h : coprod G), C h → C (of g.1 g.2 * h)) :
  (rec_on (1 : coprod G) h1 f : C 1) = h1 := sorry

lemma rec_on_mul {C : coprod G → Sort*} {i j : ι} (hij : i ≠ j)
  (g : G i) (h : G j) (x : coprod G) (hg1 : g ≠ 1) (hh1 : h ≠ 1)
  (h1 : C 1) (f : Π (g : Σ i, G i) (h : coprod G), C h → C (of g.1 g.2 * h)) :
  (rec_on (of i g * (of j h * x)) h1 f : C (of i g * (of j h * x))) =
  f ⟨i, g⟩ (of j h * x) (rec_on (of j h * x) h1 f) := sorry

lemma hom_ext [monoid M] {f g : coprod G →* M}
  (h : ∀ i : ι, f.comp (of i) = g.comp (of i)) : f = g :=
begin
  ext,
  refine coprod.rec_on x _ _,
  { simp },
  { rintros ⟨i, k⟩ x hfg,
    have := monoid_hom.ext_iff.1 (h i) k,
    erw [monoid_hom.map_mul, monoid_hom.map_mul, this, hfg], dsimp, refl, }
end

lemma mul_equiv_ext [monoid M] {f g : coprod G ≃* M}
  (h : ∀ i : ι, f.to_monoid_hom.comp (of i) = g.to_monoid_hom.comp (of i)) :
  f = g :=
sorry

end coprod

notation `C∞` := multiplicative ℤ

def ii : C∞ := show ℤ, from 1

def free_group (ι : Type*) := coprod (λ i : ι, multiplicative ℤ)

namespace free_group
variables {ι : Type u} [decidable_eq ι] {M : Type w}
variables {α : Type*} {β : Type*} {γ : Type*} [decidable_eq α] [decidable_eq β] [decidable_eq γ]

open function

instance : group (free_group ι) := coprod.group
instance : decidable_eq (free_group ι) := coprod.decidable_eq

def of (i : ι) : free_group ι := coprod.of i ii

def of' (i : ι) : multiplicative ℤ →* free_group ι := coprod.of i

@[simp] lemma cons_eq_of'_mul (l : list (Σ i : ι, multiplicative ℤ))
  (g : Σ i : ι, multiplicative ℤ) (h) :
  @eq (free_group ι) ⟨g :: l, h⟩ (of' g.1 g.2 * ⟨l, sorry⟩) :=
sorry

lemma of'_eq_pow (i : ι) (n : C∞) : of' i n = (of i) ^ n.to_add := sorry

@[simp] lemma append_eq_mul (l₁ l₂ : list (Σ i : ι, multiplicative ℤ)) (hl):
  @eq (free_group ι) ⟨l₁ ++ l₂, hl⟩ (⟨l₁, sorry⟩ * ⟨l₂, sorry⟩) := sorry

@[simp] lemma nil_eq_one : @eq (free_group ι) ⟨[], sorry⟩ 1 := sorry

-- @[simp] lemma cons_eq_of'_mul' (l : list (Σ i : ι, multiplicative ℤ))
--   (hl : reduced l) (g : multiplicative ℤ) (h) :
-- (⟨⟨i, g⟩ :: l, h⟩ : free_group ι) = @has_mul.mul (free_group ι) _ (of' i g) ⟨l, hl⟩ := sorry

@[simp] lemma eta (w : free_group ι) : (⟨w.1, w.2⟩ : free_group ι) = w := by cases w; refl

lemma of_eq_of' (i : ι) : of i = of' i ii := rfl

def lift' [monoid M] (f : Π i : ι, multiplicative ℤ →* M) : free_group ι →* M :=
coprod.lift f

def lift [group M] (f : ι → M) : free_group ι →* M :=
lift' (λ i, gpowers_hom _ (f i))

@[simp] lemma lift'_of' [monoid M] (f : Π i : ι, multiplicative ℤ →* M) (i : ι) (n : multiplicative ℤ) :
  lift' f (of' i n) = f i n := by simp [lift', of']

@[simp] lemma lift_of [group M] (f : Π i : ι, M) (i : ι) :
  lift f (of i) = f i := by simp [lift, of_eq_of', gpowers_hom, ii,
    multiplicative.to_add]

@[simp] lemma lift'_comp_of' [monoid M] (f : Π i : ι, multiplicative ℤ →* M) (i : ι) :
  (lift' f).comp (of' i) = f i := by ext; simp

@[elab_as_eliminator]
def rec_on' {C : free_group ι → Sort*} (g : free_group ι) (h1 : C 1)
  (f : Π (g : Σ i, multiplicative ℤ) (h : free_group ι), C h → C (of' g.1 g.2 * h)) : C g :=
by exact coprod.rec_on g h1 f

@[simp] lemma rec_on'_one {C : free_group ι → Sort*} (h1 : C 1)
  (f : Π (g : Σ i : ι, multiplicative ℤ) (h : free_group ι), C h → C (of' g.1 g.2 * h)) :
  (rec_on' (1 : free_group ι) h1 f : C 1) = h1 := coprod.rec_on_one h1 f

lemma rec_on'_mul {C : free_group ι → Sort*} {i j : ι} (hij : i ≠ j)
  (g h : ℤ) (x : free_group ι) (hg0 : g ≠ 0) (hh0 : h ≠ 0) (h1 : C 1)
  (f : Π (g : Σ i : ι, multiplicative ℤ) (h : free_group ι), C h → C (of' g.1 g.2 * h)) :
  (rec_on' (of' i g * (of' j h * x)) h1 f : C (of' i g * (of' j h * x))) =
  f ⟨i, g⟩ (of' j h * x) (rec_on' (of' j h * x) h1 f) :=
coprod.rec_on_mul hij g h x hg0 hh0 h1 f

@[elab_as_eliminator]
def rec_on {C : free_group ι → Sort*} (g : free_group ι) (h1 : C 1)
  (f : Π (i : ι) (h : free_group ι), C h → C (of i * h)) : C g :=
sorry

protected constant embedding (e : α ↪ β) : free_group α →* free_group β

@[simp] lemma embedding_id : free_group.embedding (embedding.refl α) = monoid_hom.id _ := sorry

@[simp] lemma embedding_trans (e₁ : α ↪ β) (e₂ : β ↪ γ) :
  free_group.embedding (e₁.trans e₂) = (free_group.embedding e₂).comp (free_group.embedding e₁) := sorry

@[simp] lemma embedding_of' (e : α ↪ β) (a : α) (n : multiplicative ℤ) :
  free_group.embedding e (of' a n) = of' (e a) n := sorry

protected constant equiv (e : α ≃ β) : free_group α ≃* free_group β

@[simp] lemma equiv_refl : free_group.equiv (equiv.refl α) = mul_equiv.refl _ := sorry

@[simp] lemma equiv_trans (e₁ : α ≃ β) (e₂ : β ≃ γ) :
  free_group.equiv (e₁.trans e₂) = (free_group.equiv e₁).trans (free_group.equiv e₂) := sorry

@[simp] lemma equiv_of' (e : α ≃ β) (a : α) (n : multiplicative ℤ) :
  free_group.equiv e (of' a n) = of' (e a) n := sorry

lemma hom_ext [monoid M] {f g : free_group ι →* M}
  (h : ∀ i, f (of i) = g (of i)) : f = g :=
coprod.hom_ext (λ i, monoid_hom.ext (λ x, sorry))

lemma mul_equiv_ext [monoid M] {f g : free_group ι ≃* M}
  (h : ∀ i, f (of i) = g (of i)) : f = g :=
sorry

def exp_sum (i : ι) : free_group ι →* multiplicative ℤ :=
free_group.lift' (λ j, if i = j then monoid_hom.id _ else 1)

/-- `closure_var` is the group closure of a set of variables -/
def closure_var (T : set ι) : subgroup (free_group ι) :=
subgroup.closure (of '' T)

instance (T : set ι) [decidable_pred T] (g : free_group ι) : decidable (g ∈ closure_var T) := sorry

constant vars (w : free_group ι) : finset ι

end free_group

variables (G H : Type u) [group G] [group H] {M : Type*} [monoid M]

def bicoprod_group_aux (b : bool) :
  group (cond b G H) := by cases b; dunfold cond; apply_instance

local attribute [instance] bicoprod_group_aux

def bicoprod := coprod (λ b : bool, cond b G H)

namespace bicoprod

infixr ` ⋆ `: 30 := bicoprod

instance : group (G ⋆ H) := coprod.group

variables {G H}

def inl : G →* G ⋆ H :=
@coprod.of bool _ (λ b, cond b G H) _ tt

def inr : H →* G ⋆ H :=
@coprod.of bool _ (λ b, cond b G H) _ ff

def lift (f : G →* M) (g : H →* M) : G ⋆ H →* M :=
coprod.lift (λ b, bool.rec_on b g f)

@[simp] lemma lift_comp_inl (f₁ : G →* M) (f₂ : H →* M) :
  (lift f₁ f₂).comp inl = f₁ := coprod.lift_comp_of _ _

@[simp] lemma lift_comp_inr (f₁ : G →* M) (f₂ : H →* M) :
  (lift f₁ f₂).comp inr = f₂ := coprod.lift_comp_of _ _

@[simp] lemma lift_inl (f₁ : G →* M) (f₂ : H →* M) (g : G) :
  (lift f₁ f₂) (inl g) = f₁ g := coprod.lift_of _ _

@[simp] lemma lift_inr (f₁ : G →* M) (f₂ : H →* M) (h : H) :
  (lift f₁ f₂) (inr h) = f₂ h := coprod.lift_of _ _

end bicoprod


import data.nat.choose
import data.finset

import config
import etv

import main.defs
import main.lemmas

open_locale classical
noncomputable theory

variables {α : Type*} [linear_order α] (C : config α)

namespace config

def delta (n : ℕ) (S : finset α) : finset α :=
  S.filter (λ p, C.beta S p < n ∧
    ↑p = (S.filter (λ q, C.beta S q = C.beta S p)).min)

lemma delta_card (n : ℕ) (S : finset α) : (C.delta n S).card ≤ n :=
begin
  rw ←finset.card_range n,
  apply finset.card_le_card_of_inj_on (C.beta S),
  { rw delta, intro a, rw finset.mem_filter,
    intros h, rcases h with ⟨_, h', _⟩, simp at ⊢ h', exact h', },
  { intros x hx y hy hxy,
    rw delta at hx hy, simp only [finset.mem_filter] at hx hy,
    rcases hx with ⟨x_in_S, bx_lt_n, x_min⟩,
    rcases hy with ⟨y_in_S, by_lt_n, y_min⟩,
    rw [←with_bot.coe_eq_coe, x_min, y_min, hxy], },
end

lemma not_mem_delta {n : ℕ} {S : finset α} {p' : α}
  (h : p' ∈ S \ (C.delta n S)) :
  (n ≤ C.beta S p') ∨ (∃ p,
    p ∈ C.delta n S ∧ C.beta S p = C.beta S p' ∧ p < p') :=
begin
  rw [delta, finset.mem_sdiff, finset.mem_filter,
    not_and, not_and_distrib] at h,
  cases h with p'_in_S aux, have h := aux p'_in_S, clear aux,
  by_cases bp_n : C.beta S p' < n, swap,
  { left, exact not_lt.mp bp_n },
  cases h, exact absurd bp_n h,
  right,
  set row := S.filter (λ q, C.beta S q = C.beta S p') with def_row,
  have row_nonempty : row.nonempty := begin
    use p', rw def_row, rw finset.mem_filter,
    split, assumption, exact rfl, end,
  have row_in_S : row ⊆ S := finset.filter_subset _ _,
  set p := row.min' row_nonempty with def_p,
  have p_in_row : p ∈ row := finset.min'_mem _ row_nonempty,
  have bp_eq_bp' : C.beta S p = C.beta S p' := begin
    rw def_row at p_in_row, rw finset.mem_filter at p_in_row,
    exact p_in_row.right, end,
  have p'_in_row : p' ∈ row := begin
    rw def_row, rw finset.mem_filter, split, assumption,
    exact rfl, end,
  existsi p, refine ⟨_, bp_eq_bp', _⟩,
  { rw delta, simp only [finset.mem_filter],
    rw bp_eq_bp', rw ←def_row,
    refine ⟨row_in_S p_in_row, bp_n, _⟩,
    rw def_p, exact finset.coe_min' _, },
  { rw ←finset.coe_min' row_nonempty at h,
    suffices p_le_p' : p ≤ p',
    { rw le_iff_lt_or_eq at p_le_p',
      cases p_le_p',
      assumption, exfalso, apply h, rw [←def_p, p_le_p'], },
    rw def_p, exact finset.min'_le _ _ p'_in_row, },
end

lemma find_join {n : ℕ} {S : finset α}
  (l : C.label S) (cup_free : ¬C.has_ncup (n + 4) S)
  (no_join: ¬C.has_join (n + 3) (n + 2) S)
  (o p : α) (c : list α) (m : ℕ)
  (o_in_S : o ∈ S) (p_in_S : p ∈ S) (o_le_p : o ≤ p)
  (c_in_S : c.in S) (c_ncup : C.ncup m c) (c_head : p ∈ c.head')
  (le_m : n + 2 ≤ m) (ho : n + 2 ≤ C.beta S o) : false :=
begin
  rw le_iff_lt_or_eq at o_le_p, cases o_le_p with o_lt_p o_eq_p,
  { rcases C.beta_cup S o_in_S with ⟨d, d_in_S, d_ncup, d_last⟩,
    by_cases sop : l.slope o p,
    { apply cup_free,
      have dp_ncup := d_ncup.extend_right sop o_lt_p p_in_S d_in_S d_last,
      have ineq : n + 4 ≤ C.beta S o + 1 + 1 := by linarith,
      apply has_ncup_le ineq, use (d ++ [p]),
      split, exact dp_ncup, simp, tauto, },
    { apply no_join,
      rcases d_ncup.take_right_with_last (n + 3) o
        (by dec_trivial) (by linarith) d_last
        with ⟨d', d'_in_d, d'_ncup, d'_last⟩,
      have oc_ncup := c_ncup.extend_left sop o_in_S o_lt_p c_in_S c_head,
      rcases oc_ncup.take_left_with_head (n + 2) o
        (by dec_trivial) (by linarith) (by simp)
        with ⟨c', c'_in_oc, c'_ncup, c'_head⟩,
      use [o, d', c'],
      have d'_in_S := list.subset_in d'_in_d d_in_S,
      have c'_in_S := list.subset_in c'_in_oc (by simp; tauto),
      tauto, }, },
  { subst o_eq_p, apply no_join,
    rcases C.beta_cup S o_in_S with ⟨d, d_in_S, d_ncup, d_last⟩,
    rcases d_ncup.take_right_with_last (n + 3) o
      (by dec_trivial) (by linarith) d_last
      with ⟨d', d'_in_d, d'_ncup, d'_last⟩,
    rcases c_ncup.take_left_with_head (n + 2) o
      (by dec_trivial) (by linarith) c_head
      with ⟨c', c'_in_c, c'_ncup, c'_head⟩,
    use [o, d', c'],
    have d'_in_S := list.subset_in d'_in_d d_in_S,
    have c'_in_S := list.subset_in c'_in_c c_in_S,
    tauto, },
end

lemma laced_extension {n : ℕ} {S D : finset α} (l : C.label S)
  (cup_free : ¬C.has_ncup (n + 4) S) (def_D : D = C.delta (n + 2) S)
  (no_join: ¬C.has_join (n + 3) (n + 2) S)
  {p' r : α} (p'r_laced : C.has_laced (n + 2) (S \ D) p' r) :
  l.alpha p' = 1 ∧ ∃ p : α, C.has_laced (n + 3) S p r ∧
    p < p' ∧ l.alpha p = 0 ∧ C.beta S p = C.beta S p' :=
begin
  rcases p'r_laced with ⟨a, b, cp', c, cr, cp'_cup, c_cup, cr_cup,
    ⟨cp'_in_SD, c_in_SD, cr_in_SD⟩, eq_ab, cp'_last, c_head, c_last, cr_head⟩,
  have p'_in_SD := c_in_SD _ (list.mem_of_mem_head' c_head),
  have p'_in_S := (finset.sdiff_subset S D) p'_in_SD,
  have c_in_S := list.in_superset (finset.sdiff_subset S D) c_in_SD,
  have cr_in_S := list.in_superset (finset.sdiff_subset S D) cr_in_SD,
  rw def_D at p'_in_SD,
  rcases (C.not_mem_delta p'_in_SD) with
    p'_beta | ⟨p, p_in_delta, eq_p, p_lt_p'⟩,
  { exfalso, apply C.find_join l cup_free no_join p' p' c;
      try { assumption }; try { simp }, },
  have p_in_S : p ∈ S := begin
    rw [delta, finset.mem_filter] at p_in_delta, exact p_in_delta.left end,
  have ap_lt_ap' := (l.beta_eq_alpha_inc p_in_S p'_in_S eq_p).mp p_lt_p',
  have ap' : l.alpha p' = 1 := begin
    cases nat.lt_or_ge (l.alpha p') 2 with ap' ap', linarith,
    exfalso, apply cup_free,
    have has_cup := l.add_alpha p'_in_S c_in_S c_cup c_head,
    apply has_ncup_le _ has_cup, linarith, end,
  have ap : l.alpha p = 0 := by linarith,
  refine ⟨ap', ⟨p, _,p_lt_p', ap, eq_p⟩⟩,
  { have a_le_bp : a ≤ C.beta S p := begin
      rw eq_p,
      -- Take the head o' of cp'
      have cp'_nnil : cp' ≠ [] := begin
        intro h, subst h, simp at cp'_last, exact cp'_last end,
      rcases list.take_head cp'_nnil with ⟨o', cp'', eq_cp'⟩,
      have o'_le_p' : o' ≤ p' := cp'_cup.head'_le_last' o' p'
        (by rw eq_cp'; simp) (by assumption),
      have o'_in_SD : o' ∈ S \ D := by apply cp'_in_SD; rw eq_cp'; simp,
      have o'_in_S : o' ∈ S := (finset.sdiff_subset S D) o'_in_SD,
      rw def_D at o'_in_SD,
      -- Locate o in delta having the same row as o'
      rcases C.not_mem_delta o'_in_SD with le_beta |
        ⟨o, o_in_delta, eq_o, o_lt_o'⟩,
      { exfalso, apply C.find_join l cup_free no_join o' p' c;
        try { assumption }; try { simp }, },
      have o_in_S : o ∈ S :=
        by rw [config.delta] at o_in_delta;
        exact finset.mem_of_mem_filter _ o_in_delta,
      -- Show that the slope of o and o' is ff
      by_cases soo' : l.slope o o',
      { have inc := slope_tt_inc_beta soo' o_in_S o'_in_S o_lt_o',
        rw eq_o at inc, simp at inc, exfalso, assumption, },
      -- extend cp' to left with o
      have cp'_in_S := list.in_superset (finset.sdiff_subset S D) cp'_in_SD,
      have ocp'_cup : C.ncup (a + 1) (o :: cp') := begin
        apply cp'_cup.extend_left soo'; try {assumption},
        rw eq_cp', simp, end,
      apply @nat.le_of_add_le_add_right 1, rw ←ocp'_cup.right,
      apply C.cup_length_le_beta,
      simp, split; assumption, exact ocp'_cup.left,
      apply list.mem_last'_cons, assumption, end,

    rw config.has_laced,
    rcases C.beta_cup S p_in_S with ⟨cp, cp_in_S, cp_cup, cp_last⟩,
    rcases cp_cup.take_right_with_last (a + 1) p
      (by dec_trivial) (by linarith) cp_last
      with ⟨dp, dp_in_cp, dp_cup, dp_last⟩,
    have dp_in_S : dp.in S := list.subset_in dp_in_cp cp_in_S,
    have spp' : ¬l.slope p p' := begin
      intro spp',
      have ineq := slope_tt_inc_beta spp' p_in_S p'_in_S p_lt_p', linarith,
    end,
    have pc_cup := c_cup.extend_left spp' p_in_S p_lt_p' c_in_S c_head,
    use [a + 1, b, dp, p :: c, cr, dp_cup, pc_cup, cr_cup],
    refine ⟨⟨_, by simp; tauto, _⟩,
      by linarith, _, by simp, list.mem_last'_cons c_last, _⟩; assumption, },
end

theorem main_induction_wlog (n : ℕ) :
  C.main_goal n → C.main_goal_wlog (n+1) :=
begin
  intros ih S no_join S_card cap4_free cup_free,
  have l : C.label S := cap4_free_label cap4_free,
  set D := C.delta (n+2) S with def_D,
  have D_card := C.delta_card (n+2) S, rw ←def_D at D_card,
  have SD_card : (n + 2).choose 2 + 2 ≤ (S \ D).card := begin
    apply @nat.le_of_add_le_add_right D.card,
    rw finset.card_sdiff_add_card,
    apply le_trans _
      (finset.card_le_of_subset (finset.subset_union_left S D)),
    apply le_trans _ S_card,
    apply le_trans (nat.add_le_add_left D_card _) _,
    rw nat.add_right_comm, apply le_of_eq,
    rw nat.add_right_comm n 1 2, simp, apply symm, rw nat.choose, simp,
    rw nat.add_comm,
  end,
  have t := ih (S \ D) SD_card _ _,
  swap, { intro h, rcases h with ⟨c, ⟨_, c_in⟩⟩,
    apply cap4_free, use c, split, assumption,
    apply list.in_superset _ c_in, exact finset.sdiff_subset S D, },
  swap, { intro h, rcases h with ⟨c, ⟨c_cup, c_in⟩⟩,
    rcases c_cup.cons_head_tail with ⟨p, c', eq_c, -⟩,
    have p_in_c : p ∈ c := by rw eq_c; left; exact rfl,
    have p_in_SD : p ∈ S \ D := c_in _ p_in_c,
    rw def_D at p_in_SD,
    have p_in_S : p ∈ S := (finset.sdiff_subset S D) p_in_SD,
    have c_in_S : c.in S := (λ a ha, (finset.sdiff_subset S D) (c_in a ha)),
    rcases (C.not_mem_delta p_in_SD) with
      le_bp | ⟨o, o_in_delta, bo_eq_bp, o_lt_p⟩,
    { apply C.find_join l cup_free no_join p p c;
        try {assumption}; try {simp},
      rw eq_c, simp, },
    { have o_in_S : o ∈ S := begin
        rw [delta, finset.mem_filter] at o_in_delta,
        exact o_in_delta.left end,
      have ao_lt_ap := (l.beta_eq_alpha_inc o_in_S p_in_S bo_eq_bp).mp o_lt_p,
      have has_cup := l.add_alpha p_in_S c_in_S c_cup (by rw eq_c; simp),
      apply cup_free, ring_nf at ⊢ has_cup,
      apply has_ncup_le _ has_cup, linarith, }, },
  { rcases t with ⟨p', q', r, s,
      ⟨⟨p'_lt_q', q'_le_r, r_lt_s⟩, ⟨p'r_laced, q's_laced⟩⟩⟩,
    rcases C.laced_extension l cup_free def_D no_join p'r_laced with
      ⟨ap', ⟨p, pr_laced, p_lt_p', ap, bp⟩⟩,
    rcases C.laced_extension l cup_free def_D no_join q's_laced with
      ⟨aq', ⟨q, qs_laced, q_lt_q', aq, bq⟩⟩,
    rcases pr_laced.mem_ends with ⟨p_in_S, r_in_S⟩,
    rcases qs_laced.mem_ends with ⟨q_in_S, s_in_S⟩,
    have p'_in_S := (finset.sdiff_subset S D) p'r_laced.mem_ends.left,
    have q'_in_S := (finset.sdiff_subset S D) q's_laced.mem_ends.left,
    refine ⟨p, q, r, s, ⟨⟨_, _, r_lt_s⟩, pr_laced, qs_laced⟩⟩,
    { have ap_eq_aq := eq.trans ap aq.symm,
      rw C.alpha_eq_beta_inc p_in_S q_in_S ap_eq_aq,
      rw [bp, bq],
      have ap'_eq_aq' := eq.trans ap' aq'.symm,
      rw ←(C.alpha_eq_beta_inc p'_in_S q'_in_S ap'_eq_aq'),
      exact p'_lt_q', },
    { apply le_of_lt,
      exact lt_of_lt_of_le q_lt_q' q'_le_r, }, },
end

end config


namespace tree

inductive tree (α : Type ) : Type
| node : α → list tree → tree

def at_index {a :Type} : list ℕ -> tree a -> option a
| [] (tree.node i t) := some i
| (h::t) (tree.node i cs) := do
                                nc <- list.nth cs h ,
                                at_index t nc

lemma helpme : forall {a} (c :a) h t tr,
some c = at_index (h::t) tr ->
false :=
begin
intros _ _ _ _ _ sc, cases tr,
simp [at_index] at sc,
admit
end

end tree


/-
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 .bounds
import .finpartitions
import .prereqs
import .witness

/-!
# Chunk of `increment`
-/

open finpartition finset fintype relation
open_locale big_operators classical

variables {α : Type*} [fintype α] {P : finpartition (univ : finset α)} (hP : P.is_equipartition)
  (G : simple_graph α) (ε : ℝ) {U : finset α} (hU : U ∈ P.parts) (V : finset α)

local notation `m` := (card α/exp_bound P.parts.card : ℕ)

/-- The witnesses of non uniformity among the parts of a finpartition. -/
noncomputable def finpartition.witnesses
  (P : finpartition (univ : finset α)) (G : simple_graph α) (ε : ℝ) (U : finset α) :=
(P.parts.filter (λ V, U ≠ V ∧ ¬G.is_uniform ε U V)).image (G.witness ε U)

/-- The portion of `increment` that partitions `U`. -/
noncomputable def finpartition.is_equipartition.chunk_increment :
  finpartition U :=
dite (U.card = m * 4^P.parts.card + (card α/P.parts.card - m * 4^P.parts.card))
  (λ hUcard, (atomise U (P.witnesses G ε U)).equitabilise $ card_aux₂ hUcard)
  (λ hUcard, (atomise U (P.witnesses G ε U)).equitabilise $ card_aux₃ hP hU hUcard)
  -- hP and hU are used to get that U has size m * 4^P.parts.card + a or m * 4^P.parts.card + a + 1

/-- The portion of `chunk_increment` that's contained in the witness of non uniformity of `U` and
`V`. -/
noncomputable def finpartition.is_equipartition.star (V : finset α) : finset (finset α) :=
(hP.chunk_increment G ε hU).parts.filter (λ x, x ⊆ G.witness ε U V)

/-! # star -/

/-- Each thing in star is a subset of the witness. -/
lemma subset_witness_of_mem_star : ∀ A ∈ hP.star G ε hU V, A ⊆ G.witness ε U V :=
λ A hA, (mem_filter.1 hA).2

lemma bUnion_star_subset_witness : (hP.star G ε hU V).bUnion id ⊆ G.witness ε U V :=
bUnion_subset_iff_forall_subset.2 (subset_witness_of_mem_star hP G ε hU V)

variables {hP G ε hU V}

lemma star_subset_chunk_increment : hP.star G ε hU V ⊆ (hP.chunk_increment G ε hU).parts :=
filter_subset _ _

lemma star_pairwise_disjoint : (hP.star G ε hU V : set (finset α)).pairwise_disjoint id :=
(hP.chunk_increment G ε hU).disjoint.subset star_subset_chunk_increment

lemma witness_sdiff_bUnion_star_small (hV : V ∈ P.parts) (hUV : U ≠ V) (h₂ : ¬G.is_uniform ε U V) :
  (G.witness ε U V \ (hP.star G ε hU V).bUnion id).card ≤ 2^(P.parts.card - 1) * m :=
begin
  have hX : G.witness ε U V ∈ P.witnesses G ε U := mem_image_of_mem _ (by simp [hUV, hV, h₂]),
  have q : G.witness ε U V \ (hP.star G ε hU V).bUnion id ⊆
    ((atomise U (P.witnesses G ε U)).parts.filter
      (λ B, B ⊆ G.witness ε U V ∧ B.nonempty)).bUnion
      (λ B, B \ ((hP.chunk_increment G ε hU).parts.filter (λ x, x ⊆ B)).bUnion id),
  { intros x hx,
    rw [←union_of_atoms' (G.witness ε U V) hX (G.witness_subset h₂),
      finpartition.is_equipartition.star, mem_sdiff, mem_bUnion] at hx,
    simp only [not_exists, mem_bUnion, and_imp, filter_congr_decidable, exists_prop, mem_filter,
      not_and, mem_sdiff, id.def, mem_sdiff] at hx ⊢,
    obtain ⟨⟨B, hB₁, hB₂⟩, hx⟩ := hx,
    exact ⟨B, hB₁, hB₂, λ A hA AB, hx A hA $ AB.trans hB₁.2.1⟩ },
  apply (card_le_of_subset q).trans (card_bUnion_le.trans _),
  have :
    ∑ i in (atomise U (P.witnesses G ε U)).parts.filter (λ B, B ⊆ G.witness ε U V ∧ B.nonempty), m
      ≤ 2 ^ (P.parts.card - 1) * m,
  { rw sum_const_nat,
    { apply nat.mul_le_mul_right,
      have t := partial_atomise (G.witness ε U V) hX,
      rw filter_congr_decidable at t,
      apply t.trans (pow_le_pow (by norm_num) (nat.sub_le_sub_right _ _)),
      apply card_image_le.trans (card_le_of_subset (filter_subset _ _)) },
    { intros,
      refl } },
  apply le_trans _ this,
  have : ∀ B ∈ (atomise U (P.witnesses G ε U)).parts,
          (B \ ((hP.chunk_increment G ε hU).parts.filter (λ x, x ⊆ B)).bUnion id).card ≤ m,
  { intros B hB,
    rw [finpartition.is_equipartition.chunk_increment],
    split_ifs with h₁,
    { convert almost_in_atoms_of_mem_parts_equitabilise (card_aux₂ h₁) hB },
    convert almost_in_atoms_of_mem_parts_equitabilise (card_aux₃ hP hU h₁) hB },
  apply sum_le_sum (λ B hB, this B (filter_subset _ _ hB)),
end

lemma one_sub_eps_mul_card_witness_le_card_star (hV : V ∈ P.parts) (hUV : U ≠ V)
  (hunif : ¬G.is_uniform ε U V) (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε₁ : ε ≤ 1) :
  (1 - ε/10) * (G.witness ε U V).card ≤ ((hP.star G ε hU V).bUnion id).card :=
begin
  have hP₁ : 0 < P.parts.card := finset.card_pos.2 ⟨_, hU⟩,
  have : (2^P.parts.card : ℝ) * m/(U.card * ε) ≤ ε/10,
  { rw [←div_div_eq_div_mul, div_le_iff' (eps_pos hPε)],
    refine le_of_mul_le_mul_left _ (pow_pos zero_lt_two P.parts.card),
    calc
      2^P.parts.card * ((2^P.parts.card * m : ℝ)/U.card)
          = (2 * 2)^P.parts.card * m/U.card : by rw [mul_pow, ←mul_div_assoc, mul_assoc]
      ... = 4^P.parts.card * m/U.card : by norm_num
      ... ≤ 1 : div_le_one_of_le (pow_mul_m_le_card_part hP hU) (nat.cast_nonneg _)
      ... ≤ 2^P.parts.card * ε^2 / 10 : begin
              refine (one_le_sq_iff (div_nonneg (mul_nonneg (pow_nonneg (@zero_le_two ℝ _) _) $
                sq_nonneg _) $ by norm_num)).1 _,
              rw [div_pow, mul_pow, pow_right_comm, ←pow_mul ε,
                one_le_div (sq_pos_of_ne_zero (10 : ℝ) $ by norm_num)],
              calc
                (10 ^ 2 : ℝ)
                = 100 : by norm_num
                ... ≤ 4^P.parts.card * ε^5 : hPε
                ... ≤ 4^P.parts.card * ε^4
                    : mul_le_mul_of_nonneg_left (pow_le_pow_of_le_one (eps_pos hPε).le hε₁
                        (nat.le_succ _)) (pow_nonneg zero_lt_four.le _)
                ... = (2^2)^P.parts.card * ε ^ (2 * 2) : by norm_num,
            end
      ... = 2^P.parts.card * (ε * (ε / 10)) : by rw [mul_div_assoc, sq, mul_div_assoc] },
  calc
    (1 - ε/10) * (G.witness ε U V).card
        ≤ (1 - 2^P.parts.card * m/(U.card * ε)) * (G.witness ε U V).card
        : mul_le_mul_of_nonneg_right (sub_le_sub_left this _) (nat.cast_nonneg _)
    ... = (G.witness ε U V).card - 2^P.parts.card * m/(U.card * ε) * (G.witness ε U V).card
        : by rw [sub_mul, one_mul]
    ... ≤ (G.witness ε U V).card - 2^(P.parts.card - 1) * m : begin
          refine sub_le_sub_left _ _,
          have : (2 : ℝ)^P.parts.card = 2^(P.parts.card - 1) * 2,
          { rw [←pow_succ', nat.sub_add_cancel hP₁] },
          rw [←mul_div_right_comm, this, mul_right_comm _ (2 : ℝ), mul_assoc, le_div_iff
            (mul_pos (nat.cast_pos.2 (P.nonempty_of_mem_parts hU).card_pos) (eps_pos hPε))],
          refine mul_le_mul_of_nonneg_left _ _,
          exact (G.witness_card hunif).trans
            (le_mul_of_one_le_left (nat.cast_nonneg _) one_le_two),
          exact mul_nonneg (pow_nonneg zero_le_two _) (nat.cast_nonneg _),
        end
    ... ≤ ((hP.star G ε hU V).bUnion id).card
        : begin
          norm_cast,
          rw [sub_le, ←nat.cast_sub (finset.card_le_of_subset $ bUnion_star_subset_witness
            hP G ε hU V), ←card_sdiff (bUnion_star_subset_witness hP G ε hU V), nat.cast_le],
          exact witness_sdiff_bUnion_star_small hV hUV hunif,
        end
end

variables {hP G ε U hU V}

/-! # chunk_increment -/

lemma card_chunk_increment (m_pos : 0 < m) :
  (hP.chunk_increment G ε hU).parts.card = 4^P.parts.card :=
begin
  rw finpartition.is_equipartition.chunk_increment,
  split_ifs,
  { rw [equitabilise.parts_card m_pos, nat.sub_add_cancel],
    exact le_of_lt a_add_one_le_four_pow_parts_card },
  { rw [equitabilise.parts_card m_pos, nat.sub_add_cancel a_add_one_le_four_pow_parts_card] }
end

lemma card_eq_of_mem_parts_chunk_increment {A : finset α}
  (hA : A ∈ (hP.chunk_increment G ε hU).parts) :
  A.card = m ∨ A.card = m + 1 :=
begin
  rw [finpartition.is_equipartition.chunk_increment] at hA,
  split_ifs at hA;
  apply card_eq_of_mem_parts_equitabilise _ hA,
end

lemma m_le_card_of_mem_chunk_increment_parts {A : finset α}
  (hA : A ∈ (hP.chunk_increment G ε hU).parts) : m ≤ A.card :=
(card_eq_of_mem_parts_chunk_increment hA).elim ge_of_eq (λ i, by simp [i])

lemma card_le_m_add_one_of_mem_chunk_increment_parts {A : finset α}
  (hA : A ∈ (hP.chunk_increment G ε hU).parts) : A.card ≤ m + 1 :=
(card_eq_of_mem_parts_chunk_increment hA).elim (λ i, by simp [i]) (λ i, i.le)

lemma card_bUnion_star_le_m_add_one_card_star_mul :
  (((hP.star G ε hU V).bUnion id).card : ℝ) ≤ (hP.star G ε hU V).card * (m + 1) :=
by exact_mod_cast (card_bUnion_le_card_mul _ _ _ $ λ s hs,
  card_le_m_add_one_of_mem_chunk_increment_parts $ star_subset_chunk_increment hs)

lemma le_sum_card_subset_chunk_increment_parts {A : finset (finset α)}
  (hA : A ⊆ (hP.chunk_increment G ε hU).parts) {u : finset α} (hu : u ∈ A) :
  (A.card : ℝ) * u.card * (m/(m+1)) ≤ (A.sup id).card :=
begin
  rw [mul_div_assoc', div_le_iff coe_m_add_one_pos, mul_right_comm],
  refine mul_le_mul _ _ (nat.cast_nonneg _) (nat.cast_nonneg _),
  { rw [←(of_subset _ hA rfl).sum_card_parts, of_subset_parts, ←nat.cast_mul, nat.cast_le],
    exact le_sum_of_forall_le _ _ _ (λ x hx, m_le_card_of_mem_chunk_increment_parts (hA hx)) },
  { exact_mod_cast card_le_m_add_one_of_mem_chunk_increment_parts (hA hu) },
end

lemma sum_card_subset_chunk_increment_parts_le (m_pos : (0 : ℝ) < m) {A : finset (finset α)}
  (hA : A ⊆ (hP.chunk_increment G ε hU).parts) {u : finset α} (hu : u ∈ A) :
  ((A.sup id).card : ℝ) ≤ (A.card * u.card) * ((m+1)/m) :=
begin
  rw [sup_eq_bUnion, mul_div_assoc', le_div_iff m_pos, mul_right_comm],
  refine mul_le_mul _ _ (nat.cast_nonneg _) (by exact_mod_cast nat.zero_le _),
  { norm_cast,
    refine card_bUnion_le_card_mul _ _ _ (λ x hx, _),
    apply card_le_m_add_one_of_mem_chunk_increment_parts (hA hx) },
  { exact_mod_cast m_le_card_of_mem_chunk_increment_parts (hA hu) },
end

lemma one_sub_le_m_div_m_add_one_sq [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α)
  (hPε : 100 ≤ 4^P.parts.card * ε^5) :
  1 - ε^5/50 ≤ (m/(m + 1))^2 :=
begin
  have : ((m:ℝ) / (m+1)) = 1 - 1/(m+1),
  { rw [one_sub_div coe_m_add_one_pos.ne', add_sub_cancel] },
  rw [this, sub_sq, one_pow, mul_one],
  refine le_trans _ (le_add_of_nonneg_right (sq_nonneg _)),
  rw [sub_le_sub_iff_left, ←le_div_iff' (show (0:ℝ) < 2, by norm_num), div_div_eq_div_mul,
    one_div_le coe_m_add_one_pos (div_pos (eps_pow_five_pos hPε) (show (0:ℝ) < 50*2, by norm_num)),
    one_div_div],
  refine le_trans _ (le_add_of_nonneg_right zero_le_one),
  norm_num,
  apply hundred_div_ε_pow_five_le_m hPα hPε,
end

lemma m_add_one_div_m_le_one_add [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α)
  (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε₁ : ε ≤ 1) :
  ((m + 1 : ℝ)/m)^2 ≤ 1 + ε^5/49 :=
begin
  rw same_add_div (m_coe_pos hPα).ne',
  have : 1 + 1/(m:ℝ) ≤ 1 + ε^5/100,
  { rw [add_le_add_iff_left, ←one_div_div (100:ℝ)],
    refine one_div_le_one_div_of_le (div_pos (by norm_num) (eps_pow_five_pos hPε)) _,
    apply hundred_div_ε_pow_five_le_m hPα hPε },
  refine (pow_le_pow_of_le_left _ this 2).trans _,
  { exact add_nonneg zero_le_one (one_div_nonneg.2 (nat.cast_nonneg _)) },
  rw [add_sq, one_pow, add_assoc, add_le_add_iff_left, mul_one, ←le_sub_iff_add_le',
    div_eq_mul_one_div _ (49:ℝ), mul_div_comm (2:ℝ), ←mul_sub_left_distrib, div_pow,
    div_le_iff (show (0:ℝ) < 100^2, by norm_num), mul_assoc, sq],
  refine mul_le_mul_of_nonneg_left _ (eps_pow_five_pos hPε).le,
  refine (pow_le_one 5 (eps_pos hPε).le hε₁).trans (by norm_num),
end

lemma density_sub_eps_le_sum_density_div_card [nonempty α]
  (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5)
  {U V : finset α} {hU : U ∈ P.parts} {hV : V ∈ P.parts} {A B : finset (finset α)}
  (hA : A ⊆ (hP.chunk_increment G ε hU).parts) (hB : B ⊆ (hP.chunk_increment G ε hV).parts) :
  G.edge_density (A.bUnion id) (B.bUnion id) - ε^5/50 ≤
    (∑ ab in A.product B, G.edge_density ab.1 ab.2)/(A.card * B.card) :=
begin
  have : G.edge_density (A.bUnion id) (B.bUnion id) - ε^5/50
                                      ≤ (1 - ε^5/50) * G.edge_density (A.bUnion id) (B.bUnion id),
  { rw [sub_mul, one_mul, sub_le_sub_iff_left],
    refine mul_le_of_le_one_right (div_nonneg (eps_pow_five_pos hPε).le (by norm_num)) _,
    apply G.edge_density_le_one _ _ },
  refine this.trans _,
  simp only [simple_graph.edge_density, pairs_density, ←sup_eq_bUnion, nat.cast_sum,
    relation.pairs_count_finpartition (of_subset _ hA rfl) (of_subset _ hB rfl), of_subset_parts,
    sum_div, mul_sum, div_div_eq_div_mul, mul_div_comm ((1:ℝ) - _)],
  apply sum_le_sum,
  simp only [and_imp, prod.forall, mem_product],
  rintro x y hx hy,
  rw [mul_mul_mul_comm, mul_comm (x.card : ℝ), mul_comm (y.card : ℝ), le_div_iff, mul_assoc],
  { apply mul_le_of_le_one_right (nat.cast_nonneg _),
    rw [div_mul_eq_mul_div, ←mul_assoc, mul_assoc],
    refine div_le_one_of_le _ (mul_nonneg (nat.cast_nonneg _) (nat.cast_nonneg _)),
    refine (mul_le_mul_of_nonneg_right (one_sub_le_m_div_m_add_one_sq hPα hPε) _).trans _,
    { exact_mod_cast (nat.zero_le _) },
    rw [sq, mul_mul_mul_comm, mul_comm ((m:ℝ)/_), mul_comm ((m:ℝ)/_)],
    refine mul_le_mul _ _ _ (nat.cast_nonneg _),
    apply le_sum_card_subset_chunk_increment_parts hA hx,
    apply le_sum_card_subset_chunk_increment_parts hB hy,
    apply mul_nonneg (mul_nonneg (nat.cast_nonneg _) (nat.cast_nonneg _)) _,
    refine div_nonneg (nat.cast_nonneg m) coe_m_add_one_pos.le },
  refine mul_pos (mul_pos _ _) (mul_pos _ _); rw [nat.cast_pos, finset.card_pos],
  exacts [⟨_, hx⟩, nonempty_of_mem_parts _ (hA hx), ⟨_, hy⟩, nonempty_of_mem_parts _ (hB hy)]
end

lemma sum_density_div_card_le_density_add_eps [nonempty α]
  (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε₁ : ε ≤ 1)
  {U V : finset α} {hU : U ∈ P.parts} {hV : V ∈ P.parts} {A B : finset (finset α)}
  (hA : A ⊆ (hP.chunk_increment G ε hU).parts) (hB : B ⊆ (hP.chunk_increment G ε hV).parts) :
  (∑ ab in A.product B, G.edge_density ab.1 ab.2)/(A.card * B.card) ≤
  G.edge_density (A.bUnion id) (B.bUnion id) + ε^5/49 :=
begin
  have : (1 + ε^5/49) * G.edge_density (A.bUnion id) (B.bUnion id) ≤
            G.edge_density (A.bUnion id) (B.bUnion id) + ε^5/49,
  { rw [add_mul, one_mul, add_le_add_iff_left],
    refine mul_le_of_le_one_right (div_nonneg (eps_pow_five_pos hPε).le (by norm_num)) _,
    apply G.edge_density_le_one },
  refine le_trans _ this,
  simp only [simple_graph.edge_density, pairs_density, ←sup_eq_bUnion, nat.cast_sum, mul_sum,
    sum_div, relation.pairs_count_finpartition (of_subset _ hA rfl) (of_subset _ hB rfl),
    of_subset_parts, mul_div_comm ((1:ℝ) + _), div_div_eq_div_mul],
  apply sum_le_sum,
  simp only [and_imp, prod.forall, mem_product],
  intros x y hx hy,
  rw [mul_mul_mul_comm, mul_comm (x.card : ℝ), mul_comm (y.card : ℝ), div_le_iff, mul_assoc],
  { refine le_mul_of_one_le_right (nat.cast_nonneg _) _,
    rw [div_mul_eq_mul_div, one_le_div],
    refine le_trans _ (mul_le_mul_of_nonneg_right (m_add_one_div_m_le_one_add hPα hPε hε₁) _),
    { rw [sq, mul_mul_mul_comm, mul_comm (_/(m:ℝ)), mul_comm (_/(m:ℝ))],
      refine mul_le_mul _ _ (nat.cast_nonneg _) _,
      apply sum_card_subset_chunk_increment_parts_le (m_coe_pos hPα) hA hx,
      apply sum_card_subset_chunk_increment_parts_le (m_coe_pos hPα) hB hy,
      apply mul_nonneg (mul_nonneg (nat.cast_nonneg _) (nat.cast_nonneg _)) _,
      refine div_nonneg coe_m_add_one_pos.le (nat.cast_nonneg m) },
    { exact_mod_cast (nat.zero_le _) },
    rw [←nat.cast_mul, nat.cast_pos],
    apply nat.mul_pos;
    rw [finset.card_pos, sup_eq_bUnion, bUnion_nonempty],
    { exact ⟨_, hx, nonempty_of_mem_parts _ (hA hx)⟩ },
    { exact ⟨_, hy, nonempty_of_mem_parts _ (hB hy)⟩ } },
  refine mul_pos (mul_pos _ _) (mul_pos _ _); rw [nat.cast_pos, finset.card_pos],
  exacts [⟨_, hx⟩, nonempty_of_mem_parts _ (hA hx), ⟨_, hy⟩, nonempty_of_mem_parts _ (hB hy)]
end

lemma average_density_near_total_density [nonempty α]
  (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε₁ : ε ≤ 1)
  {U V : finset α} {hU : U ∈ P.parts} {hV : V ∈ P.parts} {A B : finset (finset α)}
  (hA : A ⊆ (hP.chunk_increment G ε hU).parts) (hB : B ⊆ (hP.chunk_increment G ε hV).parts) :
|(∑ ab in A.product B, G.edge_density ab.1 ab.2)/(A.card * B.card) -
  G.edge_density (A.bUnion id) (B.bUnion id)| ≤ ε^5/49 :=
begin
  rw abs_sub_le_iff,
  split,
  { rw sub_le_iff_le_add',
    apply sum_density_div_card_le_density_add_eps hPα hPε hε₁ hA hB },
  suffices : G.edge_density (A.bUnion id) (B.bUnion id) -
    (∑ ab in A.product B, G.edge_density ab.1 ab.2)/(A.card * B.card) ≤ ε^5/50,
  { apply this.trans,
    exact div_le_div_of_le_left (eps_pow_five_pos hPε).le (by norm_num) (by norm_num) },
  rw [sub_le_iff_le_add, ←sub_le_iff_le_add'],
  apply density_sub_eps_le_sum_density_div_card hPα hPε hA hB,
end

-- predagger inequality
lemma sq_density_sub_eps_le_sum_sq_density_div_card_aux [nonempty α]
  (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5)
  {U V : finset α} (hU : U ∈ P.parts) (hV : V ∈ P.parts) :
  G.edge_density U V^2 - ε^5/25 ≤
  ((∑ ab in (hP.chunk_increment G ε hU).parts.product (hP.chunk_increment G ε hV).parts,
    G.edge_density ab.1 ab.2)/16^P.parts.card)^2 :=
begin
  obtain hGε | hGε := le_total (G.edge_density U V) (ε^5/50),
  { refine (sub_nonpos_of_le _).trans (sq_nonneg _),
    refine (sq_le (G.edge_density_nonneg _ _) (G.edge_density_le_one _ _)).trans (hGε.trans _),
    exact div_le_div_of_le_left (eps_pow_five_pos hPε).le (by norm_num) (by norm_num) },
  rw ←sub_nonneg at hGε,
  have : G.edge_density U V - ε ^ 5 / 50 ≤
    (∑ ab in (hP.chunk_increment G ε hU).parts.product (hP.chunk_increment G ε hV).parts,
      G.edge_density ab.1 ab.2) / (16 ^ P.parts.card),
  { apply (le_trans _ (density_sub_eps_le_sum_density_div_card hPα hPε
      (set.subset.refl (hP.chunk_increment G ε hU).parts)
      (set.subset.refl (hP.chunk_increment G ε hV).parts))).trans _,
    { rw [bUnion_parts, bUnion_parts] },
    { rw [card_chunk_increment (m_pos hPα), card_chunk_increment (m_pos hPα), ←nat.cast_mul,
        ←mul_pow, nat.cast_pow],
      norm_cast } },
  apply le_trans _ (pow_le_pow_of_le_left hGε this 2),
  rw [sub_sq, sub_add, sub_le_sub_iff_left],
  apply (sub_le_self _ (sq_nonneg (ε^5/50))).trans,
  rw [mul_right_comm, mul_div_comm, div_eq_mul_one_div (ε^5), (show (2:ℝ)/50 = 1/25, by norm_num)],
  refine mul_le_of_le_one_right (mul_nonneg _ (by norm_num)) (G.edge_density_le_one _ _),
  apply (eps_pow_five_pos hPε).le,
end

-- dagger inequality
lemma sq_density_sub_eps_le_sum_sq_density_div_card [nonempty α]
  (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5)
  {U V : finset α} (hU : U ∈ P.parts) (hV : V ∈ P.parts) :
  G.edge_density U V^2 - ε^5/25 ≤
  (∑ ab in (hP.chunk_increment G ε hU).parts.product (hP.chunk_increment G ε hV).parts,
    G.edge_density ab.1 ab.2^2)/16^P.parts.card :=
begin
  apply (sq_density_sub_eps_le_sum_sq_density_div_card_aux hPα hPε hU hV).trans,
  convert chebyshev _ _;
  rw [card_product, nat.cast_mul, card_chunk_increment (m_pos hPα),
    card_chunk_increment (m_pos hPα), ←nat.cast_mul, ←mul_pow];
  norm_cast,
end

lemma abs_density_star_sub_density_le_eps (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε₁ : ε ≤ 1)
  {U V : finset α} {hU : U ∈ P.parts} {hV : V ∈ P.parts} (hUV' : U ≠ V)
  (hUV : ¬ G.is_uniform ε U V) :
  |G.edge_density ((hP.star G ε hU V).bUnion id) ((hP.star G ε hV U).bUnion id) -
    G.edge_density (G.witness ε U V) (G.witness ε V U)| ≤ ε/5 :=
begin
  convert lemma_A G.adj
    (bUnion_star_subset_witness hP G ε hU V)
    (bUnion_star_subset_witness hP G ε hV U)
    (div_nonneg (eps_pos hPε).le $ by norm_num)
    (one_sub_eps_mul_card_witness_le_card_star hV hUV' hUV hPε hε₁)
    (one_sub_eps_mul_card_witness_le_card_star hU hUV'.symm (λ hVU, hUV hVU.symm) hPε hε₁),
  linarith,
end

lemma m_bound {x : ℝ} (hx : 0 < x) : (x + 1) * (1 - 1/x) / x ≤ 1 :=
begin
  rw [div_le_one hx, one_sub_div hx.ne', mul_div_assoc', div_le_iff hx],
  linarith,
end

lemma eps_le_card_star_div [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α)
  (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε₁ : ε ≤ 1) {U V : finset α} (hU : U ∈ P.parts)
  (hV : V ∈ P.parts) (hUV : U ≠ V) (hunif : ¬ G.is_uniform ε U V) :
  4/5 * ε ≤ (hP.star G ε hU V).card / 4^P.parts.card :=
begin
  have hm : (0 : ℝ) ≤ 1 - 1/m :=
    sub_nonneg_of_le (one_div_le_one_of_one_le $ one_le_m_coe hPα),
  have hε : 0 ≤ 1 - ε / 10 :=
    sub_nonneg_of_le (div_le_one_of_le (hε₁.trans $ by norm_num) $ by norm_num),
  calc
    4/5 * ε
        = (1 - 1/10) * (1 - 1/9) * ε : by norm_num
    ... ≤ (1 - ε/10) * (1 - 1/m) * ((G.witness ε U V).card / U.card)
        : mul_le_mul
            (mul_le_mul (sub_le_sub_left (div_le_div_of_le_of_nonneg hε₁ $ by norm_num) _)
              (sub_le_sub_left (div_le_div_of_le_left zero_le_one (by norm_num)
                (by exact_mod_cast ((show 9 ≤ 100, by norm_num).trans
                $ hundred_le_m hPα hPε hε₁))) _)
              (by norm_num) hε)
            ((le_div_iff' $ (@nat.cast_pos ℝ _ _ _).2 (P.nonempty_of_mem_parts hU).card_pos).2
              (G.witness_card hunif))
            (eps_pos hPε).le
            (mul_nonneg hε hm)
    ... = (1 - ε/10) * (G.witness ε U V).card * ((1 - 1/m) / U.card)
        : by rw [mul_assoc, mul_assoc, mul_div_comm]
    ... ≤ ((hP.star G ε hU V).bUnion id).card * ((1 - 1/m) / U.card)
        : (mul_le_mul_of_nonneg_right
            (one_sub_eps_mul_card_witness_le_card_star hV hUV hunif hPε hε₁)
            (div_nonneg hm $ nat.cast_nonneg _))
    ... ≤ (hP.star G ε hU V).card * (m + 1) * ((1 - 1/m) / U.card) :
            mul_le_mul_of_nonneg_right card_bUnion_star_le_m_add_one_card_star_mul
              (div_nonneg hm $ nat.cast_nonneg _)
    ... ≤ (hP.star G ε hU V).card * (m + 1) * ((1 - 1/m) / (4^P.parts.card * m))
        : mul_le_mul_of_nonneg_left (div_le_div_of_le_left hm
            (mul_pos four_pow_pos $ m_coe_pos hPα) $ pow_mul_m_le_card_part hP hU)
            (mul_nonneg (nat.cast_nonneg _) $ add_nonneg (nat.cast_nonneg _) zero_le_one)
    ... ≤ (hP.star G ε hU V).card / 4^P.parts.card :
    begin
      rw [mul_assoc, mul_comm ((4:ℝ)^P.parts.card), ←div_div_eq_div_mul, ←mul_div_assoc,
        ←div_mul_eq_mul_div_comm],
      refine mul_le_of_le_one_right (div_nonneg (nat.cast_nonneg _) four_pow_pos.le) _,
      rw mul_div_assoc',
      apply m_bound (m_coe_pos hPα),
    end
end

lemma stuff [nonempty α]
  (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε₁ : ε ≤ 1)
  {U V : finset α} {hU : U ∈ P.parts} {hV : V ∈ P.parts} (h_diff : U ≠ V)
  (hUV : ¬ G.is_uniform ε U V) :
  3/4 * ε ≤
    |(∑ ab in (hP.star G ε hU V).product (hP.star G ε hV U), G.edge_density ab.1 ab.2)
      / ((hP.star G ε hU V).card * (hP.star G ε hV U).card) -
        (∑ ab in (hP.chunk_increment G ε hU).parts.product (hP.chunk_increment G ε hV).parts,
          G.edge_density ab.1 ab.2)/16^P.parts.card| :=
begin
  rw [(show (16:ℝ) = 4^2, by norm_num), pow_right_comm, sq ((4:ℝ)^_)],
  set p := (∑ ab in (hP.star G ε hU V).product (hP.star G ε hV U), G.edge_density ab.1 ab.2)
      / ((hP.star G ε hU V).card * (hP.star G ε hV U).card),
  set q := (∑ ab in (hP.chunk_increment G ε hU).parts.product (hP.chunk_increment G ε hV).parts,
          G.edge_density ab.1 ab.2)/(4 ^ P.parts.card * 4 ^ P.parts.card),
  change _ ≤ |p - q|,
  set r := G.edge_density ((hP.star G ε hU V).bUnion id) ((hP.star G ε hV U).bUnion id),
  set s := G.edge_density (G.witness ε U V) (G.witness ε V U),
  set t := G.edge_density U V,
  have hrs : |r - s| ≤ ε/5 := abs_density_star_sub_density_le_eps hPε hε₁ h_diff hUV,
  have hst : ε ≤ |s - t| := G.witness_pair_spec h_diff hUV,
  have hpr : |p - r| ≤ ε^5/49 := average_density_near_total_density hPα hPε hε₁
    star_subset_chunk_increment star_subset_chunk_increment,
  have hqt : |q - t| ≤ ε^5/49,
  { have := average_density_near_total_density hPα hPε hε₁
      (subset.refl (hP.chunk_increment G ε hU).parts)
      (subset.refl (hP.chunk_increment G ε hV).parts),
    simp_rw [←sup_eq_bUnion, sup_parts, card_chunk_increment (m_pos hPα), nat.cast_pow] at this,
    norm_num at this,
    exact this },
  have hε : 0 < ε := eps_pos hPε,
  have hpr' : |p - r| ≤ ε/49,
  { refine hpr.trans (div_le_div_of_le_of_nonneg _ (by norm_num)),
    simpa using pow_le_pow_of_le_one hε.le hε₁ (show 1 ≤ 5, by norm_num) },
  have hqt' : |q - t| ≤ ε/49,
  { apply hqt.trans (div_le_div_of_le_of_nonneg _ (by norm_num)),
    simpa using pow_le_pow_of_le_one hε.le hε₁ (show 1 ≤ 5, by norm_num) },
  rw abs_sub_le_iff at hrs hpr' hqt',
  rw le_abs at hst ⊢,
  cases hst,
  left, linarith,
  right, linarith,
end

-- double dagger inequality
lemma sq_density_sub_eps_le_sum_sq_density_div_card_of_nonuniform [nonempty α]
  (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε₁ : ε ≤ 1)
  {U V : finset α} {hU : U ∈ P.parts} {hV : V ∈ P.parts} (h_diff : U ≠ V)
  (hUV : ¬ G.is_uniform ε U V) :
  G.edge_density U V^2 - ε^5/25 + ε^4/3 ≤
  (∑ ab in (hP.chunk_increment G ε hU).parts.product (hP.chunk_increment G ε hV).parts,
    G.edge_density ab.1 ab.2^2)/16^P.parts.card :=
calc
  G.edge_density U V^2 - ε^5/25 + ε^4/3
      ≤ G.edge_density U V^2 - ε^5/25 +
          (hP.star G ε hU V).card * (hP.star G ε hV U).card/16^P.parts.card * (9/16) * ε^2 :
        begin
          apply add_le_add_left,
          have Ul : 4/5 * ε ≤ (hP.star G ε hU V).card / _ :=
            eps_le_card_star_div hPα hPε hε₁ hU hV h_diff hUV,
          have Vl : 4/5 * ε ≤ (hP.star G ε hV U).card / _ :=
            eps_le_card_star_div hPα hPε hε₁ hV hU h_diff.symm (λ h, hUV h.symm),
          rw [(show (16:ℝ) = 4^2, by norm_num), pow_right_comm, sq ((4:ℝ)^_), ←div_mul_div,
            mul_assoc],
          have UVl :=
            mul_le_mul Ul Vl
              (mul_nonneg (by norm_num) (eps_pos hPε).le)
              (div_nonneg (nat.cast_nonneg _) four_pow_pos.le),
          apply le_trans _ (mul_le_mul_of_nonneg_right UVl _),
          { field_simp,
            ring_nf,
            apply mul_le_mul_of_nonneg_right,
            norm_num,
            exact pow_nonneg (eps_pos hPε).le _ },
          { norm_num,
            exact pow_nonneg (eps_pos hPε).le _ },
        end
  ... ≤ (∑ ab in (hP.chunk_increment G ε hU).parts.product (hP.chunk_increment G ε hV).parts,
          G.edge_density ab.1 ab.2^2)/16^P.parts.card :
    begin
      have t : (hP.star G ε hU V).product (hP.star G ε hV U) ⊆
        (hP.chunk_increment G ε hU).parts.product (hP.chunk_increment G ε hV).parts :=
          product_subset_product star_subset_chunk_increment star_subset_chunk_increment,
      have hε : 0 ≤ ε := (eps_pos hPε).le,
      have h₁ : 0 ≤ 3/4 * ε := by linarith,
      have := lemma_B_ineq t (λ x, G.edge_density x.1 x.2) (G.edge_density U V^2 - ε^5/25) h₁ _ _,
      { simp_rw [card_product, card_chunk_increment (m_pos hPα), ←mul_pow, nat.cast_pow, mul_pow,
          div_pow, ←mul_assoc] at this,
        norm_num at this,
        exact this },
      { simp_rw [card_product, card_chunk_increment (m_pos hPα), ←mul_pow],
        norm_num,
        exact stuff hPα hPε hε₁ h_diff hUV },
      { rw card_product,
        apply (sq_density_sub_eps_le_sum_sq_density_div_card_aux hPα hPε hU hV).trans,
        rw [card_chunk_increment (m_pos hPα), card_chunk_increment (m_pos hPα), ←mul_pow],
        norm_num,
        exact hP }
    end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.tensor_product
import Mathlib.PostPort

universes u v w

namespace Mathlib

/-!
We provide the `R`-algebra structure on `matrix n n A` when `A` is an `R`-algebra,
and show `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)`.
-/

protected instance matrix.algebra {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {n : Type w} [fintype n] [DecidableEq n] : algebra R (matrix n n A) :=
  algebra.mk (ring_hom.mk (ring_hom.to_fun (ring_hom.comp (matrix.scalar n) (algebra_map R A))) sorry sorry sorry sorry)
    sorry sorry

theorem algebra_map_matrix_apply {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] {n : Type w} [fintype n] [DecidableEq n] {r : R} {i : n} {j : n} : coe_fn (algebra_map R (matrix n n A)) r i j = ite (i = j) (coe_fn (algebra_map R A) r) 0 := sorry

namespace matrix_equiv_tensor

/--
(Implementation detail).
The bare function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`, on pure tensors.
-/
def to_fun (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] (a : A) (m : matrix n n R) : matrix n n A :=
  fun (i j : n) => a * coe_fn (algebra_map R A) (m i j)

/--
(Implementation detail).
The function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`,
as an `R`-linear map in the second tensor factor.
-/
def to_fun_right_linear (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] (a : A) : linear_map R (matrix n n R) (matrix n n A) :=
  linear_map.mk (to_fun R A n a) sorry sorry

/--
(Implementation detail).
The function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`,
as an `R`-bilinear map.
-/
def to_fun_bilinear (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] : linear_map R A (linear_map R (matrix n n R) (matrix n n A)) :=
  linear_map.mk (to_fun_right_linear R A n) sorry sorry

/--
(Implementation detail).
The function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`,
as an `R`-linear map.
-/
def to_fun_linear (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] : linear_map R (tensor_product R A (matrix n n R)) (matrix n n A) :=
  tensor_product.lift (to_fun_bilinear R A n)

/--
The function `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`, as an algebra homomorphism.
-/
def to_fun_alg_hom (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] : alg_hom R (tensor_product R A (matrix n n R)) (matrix n n A) :=
  algebra.tensor_product.alg_hom_of_linear_map_tensor_product (to_fun_linear R A n) sorry sorry

@[simp] theorem to_fun_alg_hom_apply (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (a : A) (m : matrix n n R) : coe_fn (to_fun_alg_hom R A n) (tensor_product.tmul R a m) = fun (i j : n) => a * coe_fn (algebra_map R A) (m i j) := sorry

/--
(Implementation detail.)

The bare function `matrix n n A → A ⊗[R] matrix n n R`.
(We don't need to show that it's an algebra map, thankfully --- just that it's an inverse.)
-/
def inv_fun (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (M : matrix n n A) : tensor_product R A (matrix n n R) :=
  finset.sum finset.univ
    fun (p : n × n) =>
      tensor_product.tmul R (M (prod.fst p) (prod.snd p)) (matrix.std_basis_matrix (prod.fst p) (prod.snd p) 1)

@[simp] theorem inv_fun_zero (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] : inv_fun R A n 0 = 0 := sorry

@[simp] theorem inv_fun_add (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (M : matrix n n A) (N : matrix n n A) : inv_fun R A n (M + N) = inv_fun R A n M + inv_fun R A n N := sorry

@[simp] theorem inv_fun_smul (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (a : A) (M : matrix n n A) : (inv_fun R A n fun (i j : n) => a * M i j) = tensor_product.tmul R a 1 * inv_fun R A n M := sorry

@[simp] theorem inv_fun_algebra_map (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (M : matrix n n R) : (inv_fun R A n fun (i j : n) => coe_fn (algebra_map R A) (M i j)) = tensor_product.tmul R 1 M := sorry

theorem right_inv (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (M : matrix n n A) : coe_fn (to_fun_alg_hom R A n) (inv_fun R A n M) = M := sorry

theorem left_inv (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (M : tensor_product R A (matrix n n R)) : inv_fun R A n (coe_fn (to_fun_alg_hom R A n) M) = M := sorry

/--
(Implementation detail)

The equivalence, ignoring the algebra structure, `(A ⊗[R] matrix n n R) ≃ matrix n n A`.
-/
def equiv (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] : tensor_product R A (matrix n n R) ≃ matrix n n A :=
  equiv.mk (⇑(to_fun_alg_hom R A n)) (inv_fun R A n) sorry sorry

end matrix_equiv_tensor

/--
The `R`-algebra isomorphism `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)`.
-/
def matrix_equiv_tensor (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] : alg_equiv R (matrix n n A) (tensor_product R A (matrix n n R)) :=
  alg_equiv.symm (alg_equiv.mk (alg_hom.to_fun sorry) (equiv.inv_fun sorry) sorry sorry sorry sorry sorry)

@[simp] theorem matrix_equiv_tensor_apply (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (M : matrix n n A) : coe_fn (matrix_equiv_tensor R A n) M =
  finset.sum finset.univ
    fun (p : n × n) =>
      tensor_product.tmul R (M (prod.fst p) (prod.snd p)) (matrix.std_basis_matrix (prod.fst p) (prod.snd p) 1) :=
  rfl

@[simp] theorem matrix_equiv_tensor_apply_std_basis (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (i : n) (j : n) (x : A) : coe_fn (matrix_equiv_tensor R A n) (matrix.std_basis_matrix i j x) =
  tensor_product.tmul R x (matrix.std_basis_matrix i j 1) := sorry

@[simp] theorem matrix_equiv_tensor_apply_symm (R : Type u) [comm_semiring R] (A : Type v) [semiring A] [algebra R A] (n : Type w) [fintype n] [DecidableEq n] (a : A) (M : matrix n n R) : coe_fn (alg_equiv.symm (matrix_equiv_tensor R A n)) (tensor_product.tmul R a M) =
  fun (i j : n) => a * coe_fn (algebra_map R A) (M i j) := sorry