/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark, Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark, Kyle Miller, Alena Gusakov, Hunter Monroe
-/
import data.rel
import data.set.finite
import data.sym.sym2

/-!
# Simple graphs

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

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

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

* `simple_graph.common_neighbors` is the intersection of the neighbor sets of two given vertices

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

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

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

* `simple_graph.dart` is an ordered pair of adjacent vertices, thought of as being an
  orientated edge. These are also known as "half-edges" or "bonds."

* `simple_graph.hom`, `simple_graph.embedding`, and `simple_graph.iso` for graph
  homomorphisms, graph embeddings, and
  graph isomorphisms. Note that a graph embedding is a stronger notion than an
  injective graph homomorphism, since its image is an induced subgraph.

* `complete_boolean_algebra` instance: Under the subgraph relation, `simple_graph` forms a
  `complete_boolean_algebra`. In other words, this is the complete lattice of spanning subgraphs of
  the complete graph.

## Notations

* `→g`, `↪g`, and `≃g` for graph homomorphisms, graph embeddings, and graph isomorphisms,
  respectively.

## 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.

* Morphisms of graphs are abbreviations for `rel_hom`, `rel_embedding`, and `rel_iso`.
  To make use of pre-existing simp lemmas, definitions involving morphisms are
  abbreviations as well.

## 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.
-/

open finset function

universes u v w

/--
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 vertices;
see `simple_graph.edge_set` for the corresponding edge set.
-/
@[ext]
structure simple_graph (V : Type u) :=
(adj : V → V → Prop)
(symm : symmetric adj . obviously)
(loopless : irreflexive adj . obviously)

noncomputable instance {V : Type u} [fintype V] : fintype (simple_graph V) :=
by { classical, exact fintype.of_injective simple_graph.adj simple_graph.ext }

/--
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 :=
{ adj := λ a b, (a ≠ b) ∧ (r a b ∨ r b a),
  symm := λ a b ⟨hn, hr⟩, ⟨hn.symm, hr.symm⟩,
  loopless := λ a ⟨hn, _⟩, hn rfl }

@[simp]
lemma simple_graph.from_rel_adj {V : Type u} (r : V → V → Prop) (v w : V) :
  (simple_graph.from_rel r).adj 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. In `mathlib`, this is usually referred to as `⊤`. -/
def complete_graph (V : Type u) : simple_graph V := { adj := ne }

/-- The graph with no edges on a given vertex type `V`. `mathlib` prefers the notation `⊥`. -/
def empty_graph (V : Type u) : simple_graph V := { adj := λ i j, false }

/--
Two vertices are adjacent in the complete bipartite graph on two vertex types
if and only if they are not from the same side.
Bipartite graphs in general may be regarded as being subgraphs of one of these.

TODO also introduce complete multi-partite graphs, where the vertex type is a sigma type of an
indexed family of vertex types
-/
@[simps]
def complete_bipartite_graph (V W : Type*) : simple_graph (V ⊕ W) :=
{ adj := λ v w, (v.is_left ∧ w.is_right) ∨ (v.is_right ∧ w.is_left),
  symm := begin
    intros v w,
    cases v; cases w; simp,
  end,
  loopless := begin
    intro v,
    cases v; simp,
  end }

namespace simple_graph
variables {ι : Sort*} {𝕜 : Type*} {V : Type u} {W : Type v} {X : Type w} (G : simple_graph V)
  (G' : simple_graph W) {a b c u v w : V} {e : sym2 V}

@[simp] protected lemma irrefl {v : V} : ¬G.adj v v := G.loopless v

lemma adj_comm (u v : V) : G.adj u v ↔ G.adj v u := ⟨λ x, G.symm x, λ x, G.symm x⟩

@[symm] lemma adj_symm (h : G.adj u v) : G.adj v u := G.symm h

lemma adj.symm {G : simple_graph V} {u v : V} (h : G.adj u v) : G.adj v u := G.symm h

lemma ne_of_adj (h : G.adj a b) : a ≠ b := by { rintro rfl, exact G.irrefl h }

protected lemma adj.ne {G : simple_graph V} {a b : V} (h : G.adj a b) : a ≠ b := G.ne_of_adj h

protected lemma adj.ne' {G : simple_graph V} {a b : V} (h : G.adj a b) : b ≠ a := h.ne.symm

lemma ne_of_adj_of_not_adj {v w x : V} (h : G.adj v x) (hn : ¬ G.adj w x) : v ≠ w :=
λ h', hn (h' ▸ h)

lemma adj_injective : injective (adj : simple_graph V → V → V → Prop) :=
λ G H h, by { cases G, cases H, congr' }

@[simp] lemma adj_inj {G H : simple_graph V} : G.adj = H.adj ↔ G = H := adj_injective.eq_iff

section order

/-- The relation that one `simple_graph` is a subgraph of another.
Note that this should be spelled `≤`. -/
def is_subgraph (x y : simple_graph V) : Prop := ∀ ⦃v w : V⦄, x.adj v w → y.adj v w

instance : has_le (simple_graph V) := ⟨is_subgraph⟩

@[simp] lemma is_subgraph_eq_le : (is_subgraph : simple_graph V → simple_graph V → Prop) = (≤) :=
rfl

/-- The supremum of two graphs `x ⊔ y` has edges where either `x` or `y` have edges. -/
instance : has_sup (simple_graph V) := ⟨λ x y,
  { adj := x.adj ⊔ y.adj,
    symm := λ v w h, by rwa [pi.sup_apply, pi.sup_apply, x.adj_comm, y.adj_comm] }⟩

@[simp] lemma sup_adj (x y : simple_graph V) (v w : V) : (x ⊔ y).adj v w ↔ x.adj v w ∨ y.adj v w :=
iff.rfl

/-- The infimum of two graphs `x ⊓ y` has edges where both `x` and `y` have edges. -/
instance : has_inf (simple_graph V) := ⟨λ x y,
  { adj := x.adj ⊓ y.adj,
    symm := λ v w h, by rwa [pi.inf_apply, pi.inf_apply, x.adj_comm, y.adj_comm] }⟩

@[simp] lemma inf_adj (x y : simple_graph V) (v w : V) : (x ⊓ y).adj v w ↔ x.adj v w ∧ y.adj v w :=
iff.rfl

/--
We define `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).
-/
instance : has_compl (simple_graph V) := ⟨λ G,
  { adj := λ v w, v ≠ w ∧ ¬G.adj v w,
    symm := λ v w ⟨hne, _⟩, ⟨hne.symm, by rwa adj_comm⟩,
    loopless := λ v ⟨hne, _⟩, (hne rfl).elim }⟩

@[simp] lemma compl_adj (G : simple_graph V) (v w : V) : Gᶜ.adj v w ↔ v ≠ w ∧ ¬G.adj v w := iff.rfl

/-- The difference of two graphs `x \ y` has the edges of `x` with the edges of `y` removed. -/
instance : has_sdiff (simple_graph V) := ⟨λ x y,
  { adj := x.adj \ y.adj,
    symm := λ v w h, by change x.adj w v ∧ ¬ y.adj w v; rwa [x.adj_comm, y.adj_comm] }⟩

@[simp] lemma sdiff_adj (x y : simple_graph V) (v w : V) :
  (x \ y).adj v w ↔ (x.adj v w ∧ ¬ y.adj v w) := iff.rfl

instance : has_Sup (simple_graph V) :=
⟨λ s, { adj := λ a b, ∃ G ∈ s, adj G a b,
        symm := λ a b, Exists₂.imp $ λ _ _, adj.symm,
        loopless := by { rintro a ⟨G, hG, ha⟩, exact ha.ne rfl } }⟩

instance : has_Inf (simple_graph V) :=
⟨λ s, { adj := λ a b, (∀ ⦃G⦄, G ∈ s → adj G a b) ∧ a ≠ b,
        symm := λ _ _, and.imp (forall₂_imp $ λ _ _, adj.symm) ne.symm,
        loopless := λ a h, h.2 rfl }⟩

@[simp] lemma Sup_adj {s : set (simple_graph V)} {a b : V} : (Sup s).adj a b ↔ ∃ G ∈ s, adj G a b :=
iff.rfl

@[simp] lemma Inf_adj {s : set (simple_graph V)} : (Inf s).adj a b ↔ (∀ G ∈ s, adj G a b) ∧ a ≠ b :=
iff.rfl

@[simp] lemma supr_adj {f : ι → simple_graph V} : (⨆ i, f i).adj a b ↔ ∃ i, (f i).adj a b :=
by simp [supr]

@[simp] lemma infi_adj {f : ι → simple_graph V} :
  (⨅ i, f i).adj a b ↔ (∀ i, (f i).adj a b) ∧ a ≠ b :=
by simp [infi]

lemma Inf_adj_of_nonempty {s : set (simple_graph V)} (hs : s.nonempty) :
  (Inf s).adj a b ↔ ∀ G ∈ s, adj G a b :=
Inf_adj.trans $ and_iff_left_of_imp $ by { obtain ⟨G, hG⟩ := hs, exact λ h, (h _ hG).ne }

lemma infi_adj_of_nonempty [nonempty ι] {f : ι → simple_graph V} :
  (⨅ i, f i).adj a b ↔ ∀ i, (f i).adj a b :=
by simp [infi, Inf_adj_of_nonempty (set.range_nonempty _)]

/-- For graphs `G`, `H`, `G ≤ H` iff `∀ a b, G.adj a b → H.adj a b`. -/
instance : distrib_lattice (simple_graph V) :=
{ le := λ G H, ∀ ⦃a b⦄, G.adj a b → H.adj a b,
  ..show distrib_lattice (simple_graph V),
    from adj_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl) }

instance : complete_boolean_algebra (simple_graph V) :=
{ le := (≤),
  sup := (⊔),
  inf := (⊓),
  compl := has_compl.compl,
  sdiff := (\),
  top := complete_graph V,
  bot := empty_graph V,
  le_top := λ x v w h, x.ne_of_adj h,
  bot_le := λ x v w h, h.elim,
  sdiff_eq := λ x y, by { ext v w, refine ⟨λ h, ⟨h.1, ⟨_, h.2⟩⟩, λ h, ⟨h.1, h.2.2⟩⟩,
                          rintro rfl, exact x.irrefl h.1 },
  inf_compl_le_bot := λ a v w h, false.elim $ h.2.2 h.1,
  top_le_sup_compl := λ a v w ne, by { by_cases a.adj v w, exact or.inl h, exact or.inr ⟨ne, h⟩ },
  Sup := Sup,
  le_Sup := λ s G hG a b hab, ⟨G, hG, hab⟩,
  Sup_le := λ s G hG a b, by { rintro ⟨H, hH, hab⟩, exact hG _ hH hab },
  Inf := Inf,
  Inf_le := λ s G hG a b hab, hab.1 hG,
  le_Inf := λ s G hG a b hab, ⟨λ H hH, hG _ hH hab, hab.ne⟩,
  inf_Sup_le_supr_inf := λ G s a b hab, by simpa only [exists_prop, Sup_adj, and_imp,
    forall_exists_index, Inf_adj, supr_adj, inf_adj, ←exists_and_distrib_right,
    exists_and_distrib_left, and_assoc, and_self_right] using hab,
  infi_sup_le_sup_Inf := λ G s a b hab, begin
    simp only [sup_adj, Inf_adj, infi_adj] at ⊢ hab,
    have : (∀ G' ∈ s, adj G a b ∨ adj G' a b) ∧ a ≠ b :=
      (and_congr_left $ λ h, forall_congr $ λ H, _).1 hab,
    simpa [forall_or_distrib_left, or_and_distrib_right, and_iff_left_of_imp adj.ne] using this,
    exact and_iff_left h,
  end,
  ..simple_graph.distrib_lattice }

@[simp] lemma top_adj (v w : V) : (⊤ : simple_graph V).adj v w ↔ v ≠ w := iff.rfl

@[simp] lemma bot_adj (v w : V) : (⊥ : simple_graph V).adj v w ↔ false := iff.rfl

@[simp] lemma complete_graph_eq_top (V : Type u) : complete_graph V = ⊤ := rfl

@[simp] lemma empty_graph_eq_bot (V : Type u) : empty_graph V = ⊥ := rfl

@[simps] instance (V : Type u) : inhabited (simple_graph V) := ⟨⊥⟩

section decidable

variables (V) (H : simple_graph V) [decidable_rel G.adj] [decidable_rel H.adj]

instance bot.adj_decidable   : decidable_rel (⊥ : simple_graph V).adj := λ v w, decidable.false

instance sup.adj_decidable   : decidable_rel (G ⊔ H).adj := λ v w, or.decidable

instance inf.adj_decidable   : decidable_rel (G ⊓ H).adj := λ v w, and.decidable

instance sdiff.adj_decidable : decidable_rel (G \ H).adj := λ v w, and.decidable

variable [decidable_eq V]

instance top.adj_decidable   : decidable_rel (⊤ : simple_graph V).adj :=  λ v w, not.decidable

instance compl.adj_decidable : decidable_rel Gᶜ.adj := λ v w, and.decidable

end decidable

end order

/-- `G.support` is the set of vertices that form edges in `G`. -/
def support : set V := rel.dom G.adj

lemma mem_support {v : V} : v ∈ G.support ↔ ∃ w, G.adj v w := iff.rfl

lemma support_mono {G G' : simple_graph V} (h : G ≤ G') : G.support ⊆ G'.support :=
rel.dom_mono h

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

instance neighbor_set.mem_decidable (v : V) [decidable_rel G.adj] :
  decidable_pred (∈ G.neighbor_set v) := by { unfold neighbor_set, apply_instance }

section edge_set
variables {G₁ G₂ : simple_graph V}

/--
The edges of G consist of the unordered pairs of vertices related by
`G.adj`.

The way `edge_set` is defined is such that `mem_edge_set` is proved by `refl`.
(That is, `⟦(v, w)⟧ ∈ G.edge_set` is definitionally equal to `G.adj v w`.)
-/
def edge_set : simple_graph V ↪o set (sym2 V) :=
order_embedding.of_map_le_iff (λ G, sym2.from_rel G.symm) $
  λ G G', ⟨λ h a b, @h ⟦(a, b)⟧, λ h e, sym2.ind @h e⟩

@[simp] lemma mem_edge_set : ⟦(v, w)⟧ ∈ G.edge_set ↔ G.adj v w := iff.rfl

lemma not_is_diag_of_mem_edge_set : e ∈ G.edge_set → ¬ e.is_diag := sym2.ind (λ v w, adj.ne) e

@[simp] lemma edge_set_inj : G₁.edge_set = G₂.edge_set ↔ G₁ = G₂ :=
(edge_set : simple_graph V ↪o set (sym2 V)).eq_iff_eq

@[simp] lemma edge_set_subset_edge_set : G₁.edge_set ⊆ G₂.edge_set ↔ G₁ ≤ G₂ :=
(edge_set : simple_graph V ↪o set (sym2 V)).le_iff_le

@[simp] lemma edge_set_ssubset_edge_set : G₁.edge_set ⊂ G₂.edge_set ↔ G₁ < G₂ :=
(edge_set : simple_graph V ↪o set (sym2 V)).lt_iff_lt

lemma edge_set_injective : injective (edge_set : simple_graph V → set (sym2 V)) :=
edge_set.injective

alias edge_set_subset_edge_set ↔ _ edge_set_mono
alias edge_set_ssubset_edge_set ↔ _ edge_set_strict_mono

attribute [mono] edge_set_mono edge_set_strict_mono

variables (G₁ G₂)

@[simp] lemma edge_set_bot : (⊥ : simple_graph V).edge_set = ∅ := sym2.from_rel_bot

@[simp] lemma edge_set_sup : (G₁ ⊔ G₂).edge_set = G₁.edge_set ∪ G₂.edge_set :=
by { ext ⟨x, y⟩, refl }

@[simp] lemma edge_set_inf : (G₁ ⊓ G₂).edge_set = G₁.edge_set ∩ G₂.edge_set :=
by { ext ⟨x, y⟩, refl }

@[simp] lemma edge_set_sdiff : (G₁ \ G₂).edge_set = G₁.edge_set \ G₂.edge_set :=
by { ext ⟨x, y⟩, refl }

/--
This lemma, combined with `edge_set_sdiff` and `edge_set_from_edge_set`,
allows proving `(G \ from_edge_set s).edge_set = G.edge_set \ s` by `simp`.
-/
@[simp] lemma edge_set_sdiff_sdiff_is_diag (G : simple_graph V) (s : set (sym2 V)) :
  G.edge_set \ (s \ {e | e.is_diag}) = G.edge_set \ s :=
begin
  ext e,
  simp only [set.mem_diff, set.mem_set_of_eq, not_and, not_not, and.congr_right_iff],
  intro h,
  simp only [G.not_is_diag_of_mem_edge_set h, imp_false],
end

/--
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`.
-/
lemma adj_iff_exists_edge {v w : V} :
  G.adj v w ↔ v ≠ w ∧ ∃ (e ∈ G.edge_set), v ∈ e ∧ w ∈ e :=
begin
  refine ⟨λ _, ⟨G.ne_of_adj ‹_›, ⟦(v,w)⟧, _⟩, _⟩,
  { simpa },
  { rintro ⟨hne, e, he, hv⟩,
    rw sym2.mem_and_mem_iff hne at hv,
    subst e,
    rwa mem_edge_set at he }
end

lemma adj_iff_exists_edge_coe : G.adj a b ↔ ∃ (e : G.edge_set), ↑e = ⟦(a, b)⟧ :=
by simp only [mem_edge_set, exists_prop, set_coe.exists, exists_eq_right, subtype.coe_mk]

lemma edge_other_ne {e : sym2 V} (he : e ∈ G.edge_set) {v : V} (h : v ∈ e) : h.other ≠ v :=
begin
  erw [← sym2.other_spec h, sym2.eq_swap] at he,
  exact G.ne_of_adj he,
end

instance decidable_mem_edge_set [decidable_rel G.adj] :
  decidable_pred (∈ G.edge_set) := sym2.from_rel.decidable_pred _

instance fintype_edge_set [decidable_eq V] [fintype V] [decidable_rel G.adj] :
  fintype G.edge_set := subtype.fintype _

instance fintype_edge_set_bot : fintype (⊥ : simple_graph V).edge_set :=
by { rw edge_set_bot, apply_instance }

instance fintype_edge_set_sup [decidable_eq V] [fintype G₁.edge_set] [fintype G₂.edge_set] :
  fintype (G₁ ⊔ G₂).edge_set :=
by { rw edge_set_sup, apply_instance }

instance fintype_edge_set_inf [decidable_eq V] [fintype G₁.edge_set] [fintype G₂.edge_set] :
  fintype (G₁ ⊓ G₂).edge_set :=
by { rw edge_set_inf, exact set.fintype_inter _ _ }

instance fintype_edge_set_sdiff [decidable_eq V] [fintype G₁.edge_set] [fintype G₂.edge_set] :
  fintype (G₁ \ G₂).edge_set :=
by { rw edge_set_sdiff, exact set.fintype_diff _ _  }

end edge_set

section from_edge_set

variable (s : set (sym2 V))

/--
`from_edge_set` constructs a `simple_graph` from a set of edges, without loops.
-/
def from_edge_set : simple_graph V :=
{ adj := sym2.to_rel s ⊓ ne,
  symm := λ v w h, ⟨sym2.to_rel_symmetric s h.1, h.2.symm⟩}

@[simp] lemma from_edge_set_adj : (from_edge_set s).adj v w ↔ ⟦(v, w)⟧ ∈ s ∧ v ≠ w := iff.rfl

-- Note: we need to make sure `from_edge_set_adj` and this lemma are confluent.
-- In particular, both yield `⟦(u, v)⟧ ∈ (from_edge_set s).edge_set` ==> `⟦(v, w)⟧ ∈ s ∧ v ≠ w`.
@[simp] lemma edge_set_from_edge_set : (from_edge_set s).edge_set = s \ {e | e.is_diag} :=
by { ext e, exact sym2.ind (by simp) e }

@[simp] lemma from_edge_set_edge_set : from_edge_set G.edge_set = G :=
by { ext v w, exact ⟨λ h, h.1, λ h, ⟨h, G.ne_of_adj h⟩⟩ }

@[simp] lemma from_edge_set_empty : from_edge_set (∅ : set (sym2 V)) = ⊥ :=
by { ext v w, simp only [from_edge_set_adj, set.mem_empty_iff_false, false_and, bot_adj] }

@[simp] lemma from_edge_set_univ : from_edge_set (set.univ : set (sym2 V)) = ⊤ :=
by { ext v w, simp only [from_edge_set_adj, set.mem_univ, true_and, top_adj] }

@[simp] lemma from_edge_set_inf (s t : set (sym2 V)) :
  from_edge_set s ⊓ from_edge_set t = from_edge_set (s ∩ t) :=
by { ext v w, simp only [from_edge_set_adj, set.mem_inter_iff, ne.def, inf_adj], tauto, }

@[simp] lemma from_edge_set_sup (s t : set (sym2 V)) :
  from_edge_set s ⊔ from_edge_set t = from_edge_set (s ∪ t) :=
by { ext v w, simp [set.mem_union, or_and_distrib_right], }

@[simp] lemma from_edge_set_sdiff (s t : set (sym2 V)) :
  from_edge_set s \ from_edge_set t = from_edge_set (s \ t) :=
by { ext v w, split; simp { contextual := tt }, }

@[mono]
lemma from_edge_set_mono {s t : set (sym2 V)} (h : s ⊆ t) : from_edge_set s ≤ from_edge_set t :=
begin
  rintro v w,
  simp only [from_edge_set_adj, ne.def, not_false_iff, and_true, and_imp] {contextual := tt},
  exact λ vws _, h vws,
end

instance [decidable_eq V] [fintype s] : fintype (from_edge_set s).edge_set :=
by { rw edge_set_from_edge_set s, apply_instance }

end from_edge_set

/-! ## Darts -/

/-- A `dart` is an oriented edge, implemented as an ordered pair of adjacent vertices.
This terminology comes from combinatorial maps, and they are also known as "half-edges"
or "bonds." -/
@[ext, derive decidable_eq]
structure dart extends V × V :=
(is_adj : G.adj fst snd)

section darts
variables {G}

/-- The first vertex for the dart. -/
abbreviation dart.fst (d : G.dart) : V := d.fst

/-- The second vertex for the dart. -/
abbreviation dart.snd (d : G.dart) : V := d.snd

lemma dart.to_prod_injective : function.injective (dart.to_prod : G.dart → V × V) := dart.ext

instance dart.fintype [fintype V] [decidable_rel G.adj] : fintype G.dart :=
fintype.of_equiv (Σ v, G.neighbor_set v)
{ to_fun := λ s, ⟨(s.fst, s.snd), s.snd.property⟩,
  inv_fun := λ d, ⟨d.fst, d.snd, d.is_adj⟩,
  left_inv := λ s, by ext; simp,
  right_inv := λ d, by ext; simp }

/-- The edge associated to the dart. -/
def dart.edge (d : G.dart) : sym2 V := ⟦d.to_prod⟧

@[simp] lemma dart.edge_mk {p : V × V} (h : G.adj p.1 p.2) :
  (dart.mk p h).edge = ⟦p⟧ := rfl

@[simp] lemma dart.edge_mem (d : G.dart) : d.edge ∈ G.edge_set :=
d.is_adj

/-- The dart with reversed orientation from a given dart. -/
@[simps] def dart.symm (d : G.dart) : G.dart :=
⟨d.to_prod.swap, G.symm d.is_adj⟩

@[simp] lemma dart.symm_mk {p : V × V} (h : G.adj p.1 p.2) :
  (dart.mk p h).symm = dart.mk p.swap h.symm := rfl

@[simp] lemma dart.edge_symm (d : G.dart) : d.symm.edge = d.edge :=
sym2.mk_prod_swap_eq

@[simp] lemma dart.edge_comp_symm : dart.edge ∘ dart.symm = (dart.edge : G.dart → sym2 V) :=
funext dart.edge_symm

@[simp] lemma dart.symm_symm (d : G.dart) : d.symm.symm = d :=
dart.ext _ _ $ prod.swap_swap _

@[simp] lemma dart.symm_involutive : function.involutive (dart.symm : G.dart → G.dart) :=
dart.symm_symm

lemma dart.symm_ne (d : G.dart) : d.symm ≠ d :=
ne_of_apply_ne (prod.snd ∘ dart.to_prod) d.is_adj.ne

lemma dart_edge_eq_iff : Π (d₁ d₂ : G.dart),
  d₁.edge = d₂.edge ↔ d₁ = d₂ ∨ d₁ = d₂.symm :=
by { rintros ⟨p, hp⟩ ⟨q, hq⟩, simp [sym2.mk_eq_mk_iff] }

lemma dart_edge_eq_mk_iff : Π {d : G.dart} {p : V × V},
  d.edge = ⟦p⟧ ↔ d.to_prod = p ∨ d.to_prod = p.swap :=
by { rintro ⟨p, h⟩, apply sym2.mk_eq_mk_iff }

lemma dart_edge_eq_mk_iff' : Π {d : G.dart} {u v : V},
  d.edge = ⟦(u, v)⟧ ↔ d.fst = u ∧ d.snd = v ∨ d.fst = v ∧ d.snd = u :=
by { rintro ⟨⟨a, b⟩, h⟩ u v, rw dart_edge_eq_mk_iff, simp }

variables (G)

/-- Two darts are said to be adjacent if they could be consecutive
darts in a walk -- that is, the first dart's second vertex is equal to
the second dart's first vertex. -/
def dart_adj (d d' : G.dart) : Prop := d.snd = d'.fst

/-- For a given vertex `v`, this is the bijective map from the neighbor set at `v`
to the darts `d` with `d.fst = v`. -/
@[simps] def dart_of_neighbor_set (v : V) (w : G.neighbor_set v) : G.dart :=
⟨(v, w), w.property⟩

lemma dart_of_neighbor_set_injective (v : V) : function.injective (G.dart_of_neighbor_set v) :=
λ e₁ e₂ h, subtype.ext $ by { injection h with h', convert congr_arg prod.snd h' }

instance nonempty_dart_top [nontrivial V] : nonempty (⊤ : simple_graph V).dart :=
by { obtain ⟨v, w, h⟩ := exists_pair_ne V, exact ⟨⟨(v, w), h⟩⟩ }

end darts

/-! ### Incidence set -/

/-- Set of edges incident to a given vertex, aka incidence set. -/
def incidence_set (v : V) : set (sym2 V) := {e ∈ G.edge_set | v ∈ e}

lemma incidence_set_subset (v : V) : G.incidence_set v ⊆ G.edge_set := λ _ h, h.1

lemma mk_mem_incidence_set_iff : ⟦(b, c)⟧ ∈ G.incidence_set a ↔ G.adj b c ∧ (a = b ∨ a = c) :=
and_congr_right' sym2.mem_iff

lemma mk_mem_incidence_set_left_iff : ⟦(a, b)⟧ ∈ G.incidence_set a ↔ G.adj a b :=
and_iff_left $ sym2.mem_mk_left _ _

lemma mk_mem_incidence_set_right_iff : ⟦(a, b)⟧ ∈ G.incidence_set b ↔ G.adj a b :=
and_iff_left $ sym2.mem_mk_right _ _

lemma edge_mem_incidence_set_iff {e : G.edge_set} : ↑e ∈ G.incidence_set a ↔ a ∈ (e : sym2 V) :=
and_iff_right e.2

lemma incidence_set_inter_incidence_set_subset (h : a ≠ b) :
  G.incidence_set a ∩ G.incidence_set b ⊆ {⟦(a, b)⟧} :=
λ e he, (sym2.mem_and_mem_iff h).1 ⟨he.1.2, he.2.2⟩

lemma incidence_set_inter_incidence_set_of_adj (h : G.adj a b) :
  G.incidence_set a ∩ G.incidence_set b = {⟦(a, b)⟧} :=
begin
  refine (G.incidence_set_inter_incidence_set_subset $ h.ne).antisymm _,
  rintro _ (rfl : _ = ⟦(a, b)⟧),
  exact ⟨G.mk_mem_incidence_set_left_iff.2 h, G.mk_mem_incidence_set_right_iff.2 h⟩,
end

lemma adj_of_mem_incidence_set (h : a ≠ b) (ha : e ∈ G.incidence_set a)
  (hb : e ∈ G.incidence_set b) :
  G.adj a b :=
by rwa [←mk_mem_incidence_set_left_iff,
  ←set.mem_singleton_iff.1 $ G.incidence_set_inter_incidence_set_subset h ⟨ha, hb⟩]

lemma incidence_set_inter_incidence_set_of_not_adj (h : ¬ G.adj a b) (hn : a ≠ b) :
  G.incidence_set a ∩ G.incidence_set b = ∅ :=
begin
  simp_rw [set.eq_empty_iff_forall_not_mem, set.mem_inter_iff, not_and],
  intros u ha hb,
  exact h (G.adj_of_mem_incidence_set hn ha hb),
end

instance decidable_mem_incidence_set [decidable_eq V] [decidable_rel G.adj] (v : V) :
  decidable_pred (∈ G.incidence_set v) := λ e, and.decidable

section edge_finset
variables {G₁ G₂ : simple_graph V} [fintype G.edge_set] [fintype G₁.edge_set] [fintype G₂.edge_set]

/--
The `edge_set` of the graph as a `finset`.
-/
@[reducible] def edge_finset : finset (sym2 V) := set.to_finset G.edge_set

@[simp, norm_cast] lemma coe_edge_finset : (G.edge_finset : set (sym2 V)) = G.edge_set :=
set.coe_to_finset _

variables {G}

@[simp] lemma mem_edge_finset : e ∈ G.edge_finset ↔ e ∈ G.edge_set := set.mem_to_finset

lemma not_is_diag_of_mem_edge_finset : e ∈ G.edge_finset → ¬ e.is_diag :=
not_is_diag_of_mem_edge_set _ ∘ mem_edge_finset.1

@[simp] lemma edge_finset_inj : G₁.edge_finset = G₂.edge_finset ↔ G₁ = G₂ := by simp [edge_finset]

@[simp] lemma edge_finset_subset_edge_finset : G₁.edge_finset ⊆ G₂.edge_finset ↔ G₁ ≤ G₂ :=
by simp [edge_finset]

@[simp] lemma edge_finset_ssubset_edge_finset : G₁.edge_finset ⊂ G₂.edge_finset ↔ G₁ < G₂ :=
by simp [edge_finset]

alias edge_finset_subset_edge_finset ↔ _ edge_finset_mono
alias edge_finset_ssubset_edge_finset ↔ _ edge_finset_strict_mono

attribute [mono] edge_finset_mono edge_finset_strict_mono

@[simp] lemma edge_finset_bot : (⊥ : simple_graph V).edge_finset = ∅ := by simp [edge_finset]

@[simp] lemma edge_finset_sup [decidable_eq V] :
  (G₁ ⊔ G₂).edge_finset = G₁.edge_finset ∪ G₂.edge_finset :=
by simp [edge_finset]

@[simp] lemma edge_finset_inf [decidable_eq V] :
  (G₁ ⊓ G₂).edge_finset = G₁.edge_finset ∩ G₂.edge_finset :=
by simp [edge_finset]

@[simp] lemma edge_finset_sdiff [decidable_eq V] :
  (G₁ \ G₂).edge_finset = G₁.edge_finset \ G₂.edge_finset :=
by simp [edge_finset]

lemma edge_finset_card : G.edge_finset.card = fintype.card G.edge_set := set.to_finset_card _

@[simp] lemma edge_set_univ_card : (univ : finset G.edge_set).card = G.edge_finset.card :=
fintype.card_of_subtype G.edge_finset $ λ _, mem_edge_finset

end edge_finset

@[simp] lemma mem_neighbor_set (v w : V) : w ∈ G.neighbor_set v ↔ G.adj v w :=
iff.rfl

@[simp] lemma mem_incidence_set (v w : V) : ⟦(v, w)⟧ ∈ G.incidence_set v ↔ G.adj v w :=
by simp [incidence_set]

lemma mem_incidence_iff_neighbor {v w : V} : ⟦(v, w)⟧ ∈ G.incidence_set v ↔ w ∈ G.neighbor_set v :=
by simp only [mem_incidence_set, mem_neighbor_set]

lemma adj_incidence_set_inter {v : V} {e : sym2 V} (he : e ∈ G.edge_set) (h : v ∈ e) :
  G.incidence_set v ∩ G.incidence_set h.other = {e} :=
begin
  ext e',
  simp only [incidence_set, set.mem_sep_iff, set.mem_inter_iff, set.mem_singleton_iff],
  refine ⟨λ h', _, _⟩,
  { rw ←sym2.other_spec h,
    exact (sym2.mem_and_mem_iff (edge_other_ne G he h).symm).mp ⟨h'.1.2, h'.2.2⟩ },
  { rintro rfl,
    exact ⟨⟨he, h⟩, he, sym2.other_mem _⟩ }
end

lemma compl_neighbor_set_disjoint (G : simple_graph V) (v : V) :
  disjoint (G.neighbor_set v) (Gᶜ.neighbor_set v) :=
begin
  rw set.disjoint_iff,
  rintro w ⟨h, h'⟩,
  rw [mem_neighbor_set, compl_adj] at h',
  exact h'.2 h,
end

lemma neighbor_set_union_compl_neighbor_set_eq (G : simple_graph V) (v : V) :
  G.neighbor_set v ∪ Gᶜ.neighbor_set v = {v}ᶜ :=
begin
  ext w,
  have h := @ne_of_adj _ G,
  simp_rw [set.mem_union, mem_neighbor_set, compl_adj, set.mem_compl_iff, set.mem_singleton_iff],
  tauto,
end

-- TODO find out why TC inference has `h` failing a defeq check for `to_finset`
lemma card_neighbor_set_union_compl_neighbor_set [fintype V] (G : simple_graph V)
  (v : V) [h : fintype (G.neighbor_set v ∪ Gᶜ.neighbor_set v : set V)] :
  (@set.to_finset _ (G.neighbor_set v ∪ Gᶜ.neighbor_set v) h).card = fintype.card V - 1 :=
begin
  classical,
  simp_rw [neighbor_set_union_compl_neighbor_set_eq, set.to_finset_compl, finset.card_compl,
    set.to_finset_card, set.card_singleton],
end

lemma neighbor_set_compl (G : simple_graph V) (v : V) :
  Gᶜ.neighbor_set v = (G.neighbor_set v)ᶜ \ {v} :=
by { ext w, simp [and_comm, eq_comm] }

/--
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 w : V) : set V := G.neighbor_set v ∩ G.neighbor_set w

lemma common_neighbors_eq (v w : V) :
  G.common_neighbors v w = G.neighbor_set v ∩ G.neighbor_set w := rfl

lemma mem_common_neighbors {u v w : V} : u ∈ G.common_neighbors v w ↔ G.adj v u ∧ G.adj w u :=
iff.rfl

lemma common_neighbors_symm (v w : V) : G.common_neighbors v w = G.common_neighbors w v :=
set.inter_comm _ _

lemma not_mem_common_neighbors_left (v w : V) : v ∉ G.common_neighbors v w :=
λ h, ne_of_adj G h.1 rfl

lemma not_mem_common_neighbors_right (v w : V) : w ∉ G.common_neighbors v w :=
λ h, ne_of_adj G h.2 rfl

lemma common_neighbors_subset_neighbor_set_left (v w : V) :
  G.common_neighbors v w ⊆ G.neighbor_set v :=
set.inter_subset_left _ _

lemma common_neighbors_subset_neighbor_set_right (v w : V) :
  G.common_neighbors v w ⊆ G.neighbor_set w :=
set.inter_subset_right _ _

instance decidable_mem_common_neighbors [decidable_rel G.adj] (v w : V) :
  decidable_pred (∈ G.common_neighbors v w) :=
λ a, and.decidable

lemma common_neighbors_top_eq {v w : V} :
  (⊤ : simple_graph V).common_neighbors v w = set.univ \ {v, w} :=
by { ext u, simp [common_neighbors, eq_comm, not_or_distrib.symm] }

section incidence
variable [decidable_eq V]

/--
Given an edge incident to a particular vertex, get the other vertex on the edge.
-/
def other_vertex_of_incident {v : V} {e : sym2 V} (h : e ∈ G.incidence_set v) : V := h.2.other'

lemma edge_other_incident_set {v : V} {e : sym2 V} (h : e ∈ G.incidence_set v) :
  e ∈ G.incidence_set (G.other_vertex_of_incident h) :=
by { use h.1, simp [other_vertex_of_incident, sym2.other_mem'] }

lemma incidence_other_prop {v : V} {e : sym2 V} (h : e ∈ G.incidence_set v) :
  G.other_vertex_of_incident h ∈ G.neighbor_set v :=
by { cases h with he hv, rwa [←sym2.other_spec' hv, mem_edge_set] at he }

@[simp]
lemma incidence_other_neighbor_edge {v w : V} (h : w ∈ G.neighbor_set v) :
  G.other_vertex_of_incident (G.mem_incidence_iff_neighbor.mpr h) = w :=
sym2.congr_right.mp (sym2.other_spec' (G.mem_incidence_iff_neighbor.mpr h).right)

/--
There is an equivalence between the set of edges incident to a given
vertex and the set of vertices adjacent to the vertex.
-/
@[simps] def incidence_set_equiv_neighbor_set (v : V) : G.incidence_set v ≃ G.neighbor_set v :=
{ to_fun := λ e, ⟨G.other_vertex_of_incident e.2, G.incidence_other_prop e.2⟩,
  inv_fun := λ w, ⟨⟦(v, w.1)⟧, G.mem_incidence_iff_neighbor.mpr w.2⟩,
  left_inv := λ x, by simp [other_vertex_of_incident],
  right_inv := λ ⟨w, hw⟩, by simp }

end incidence

/-! ## Edge deletion -/

/-- Given a set of vertex pairs, remove all of the corresponding edges from the
graph's edge set, if present.

See also: `simple_graph.subgraph.delete_edges`. -/
def delete_edges (s : set (sym2 V)) : simple_graph V :=
{ adj := G.adj \ sym2.to_rel s,
  symm := λ a b, by simp [adj_comm, sym2.eq_swap] }

@[simp] lemma delete_edges_adj (s : set (sym2 V)) (v w : V) :
  (G.delete_edges s).adj v w ↔ G.adj v w ∧ ¬ ⟦(v, w)⟧ ∈ s := iff.rfl

lemma sdiff_eq_delete_edges (G G' : simple_graph V) :
  G \ G' = G.delete_edges G'.edge_set :=
by { ext, simp }

lemma delete_edges_eq_sdiff_from_edge_set (s : set (sym2 V)) :
  G.delete_edges s = G \ from_edge_set s :=
by { ext, exact ⟨λ h, ⟨h.1, not_and_of_not_left _ h.2⟩, λ h, ⟨h.1, not_and'.mp h.2 h.ne⟩⟩ }

lemma compl_eq_delete_edges :
  Gᶜ = (⊤ : simple_graph V).delete_edges G.edge_set :=
by { ext, simp }

@[simp] lemma delete_edges_delete_edges (s s' : set (sym2 V)) :
  (G.delete_edges s).delete_edges s' = G.delete_edges (s ∪ s') :=
by { ext, simp [and_assoc, not_or_distrib] }

@[simp] lemma delete_edges_empty_eq : G.delete_edges ∅ = G :=
by { ext, simp }

@[simp] lemma delete_edges_univ_eq : G.delete_edges set.univ = ⊥ :=
by { ext, simp }

lemma delete_edges_le (s : set (sym2 V)) : G.delete_edges s ≤ G :=
by { intro, simp { contextual := tt } }

lemma delete_edges_le_of_le {s s' : set (sym2 V)} (h : s ⊆ s') :
  G.delete_edges s' ≤ G.delete_edges s :=
λ v w, begin
  simp only [delete_edges_adj, and_imp, true_and] { contextual := tt },
  exact λ ha hn hs, hn (h hs),
end

lemma delete_edges_eq_inter_edge_set (s : set (sym2 V)) :
  G.delete_edges s = G.delete_edges (s ∩ G.edge_set) :=
by { ext, simp [imp_false] { contextual := tt } }

lemma delete_edges_sdiff_eq_of_le {H : simple_graph V} (h : H ≤ G) :
  G.delete_edges (G.edge_set \ H.edge_set) = H :=
by { ext v w, split; simp [@h v w] { contextual := tt } }

lemma edge_set_delete_edges (s : set (sym2 V)) :
  (G.delete_edges s).edge_set = G.edge_set \ s :=
by { ext e, refine sym2.ind _ e, simp }

lemma edge_finset_delete_edges [fintype V] [decidable_eq V] [decidable_rel G.adj]
  (s : finset (sym2 V)) [decidable_rel (G.delete_edges s).adj] :
  (G.delete_edges s).edge_finset = G.edge_finset \ s :=
by { ext e, simp [edge_set_delete_edges] }

section delete_far
variables (G) [ordered_ring 𝕜] [fintype V] [decidable_eq V] [decidable_rel G.adj]
  {p : simple_graph V → Prop} {r r₁ r₂ : 𝕜}

/-- A graph is `r`-*delete-far* from a property `p` if we must delete at least `r` edges from it to
get a graph with the property `p`. -/
def delete_far (p : simple_graph V → Prop) (r : 𝕜) : Prop :=
∀ ⦃s⦄, s ⊆ G.edge_finset → p (G.delete_edges s) → r ≤ s.card

open_locale classical

variables {G}

lemma delete_far_iff :
  G.delete_far p r ↔ ∀ ⦃H⦄, H ≤ G → p H → r ≤ G.edge_finset.card - H.edge_finset.card :=
begin
  refine ⟨λ h H hHG hH, _, λ h s hs hG, _⟩,
  { have := h (sdiff_subset G.edge_finset H.edge_finset),
    simp only [delete_edges_sdiff_eq_of_le _ hHG, edge_finset_mono hHG, card_sdiff,
      card_le_of_subset, coe_sdiff, coe_edge_finset, nat.cast_sub] at this,
    exact this hH },
  { simpa [card_sdiff hs, edge_finset_delete_edges, -set.to_finset_card, nat.cast_sub,
      card_le_of_subset hs] using h (G.delete_edges_le s) hG }
end

alias delete_far_iff ↔ delete_far.le_card_sub_card _

lemma delete_far.mono (h : G.delete_far p r₂) (hr : r₁ ≤ r₂) : G.delete_far p r₁ :=
λ s hs hG, hr.trans $ h hs hG

end delete_far

/-! ## Map and comap -/

/-- Given an injective function, there is an covariant induced map on graphs by pushing forward
the adjacency relation.

This is injective (see `simple_graph.map_injective`). -/
protected def map (f : V ↪ W) (G : simple_graph V) : simple_graph W :=
{ adj := relation.map G.adj f f }

@[simp] lemma map_adj (f : V ↪ W) (G : simple_graph V) (u v : W) :
  (G.map f).adj u v ↔ ∃ (u' v' : V), G.adj u' v' ∧ f u' = u ∧ f v' = v := iff.rfl

lemma map_monotone (f : V ↪ W) : monotone (simple_graph.map f) :=
by { rintros G G' h _ _ ⟨u, v, ha, rfl, rfl⟩, exact ⟨_, _, h ha, rfl, rfl⟩ }

/-- Given a function, there is a contravariant induced map on graphs by pulling back the
adjacency relation.
This is one of the ways of creating induced graphs. See `simple_graph.induce` for a wrapper.

This is surjective when `f` is injective (see `simple_graph.comap_surjective`).-/
@[simps] protected def comap (f : V → W) (G : simple_graph W) : simple_graph V :=
{ adj := λ u v, G.adj (f u) (f v) }

lemma comap_monotone (f : V ↪ W) : monotone (simple_graph.comap f) :=
by { intros G G' h _ _ ha, exact h ha }

@[simp] lemma comap_map_eq (f : V ↪ W) (G : simple_graph V) : (G.map f).comap f = G :=
by { ext, simp }

lemma left_inverse_comap_map (f : V ↪ W) :
  function.left_inverse (simple_graph.comap f) (simple_graph.map f) := comap_map_eq f

lemma map_injective (f : V ↪ W) : function.injective (simple_graph.map f) :=
(left_inverse_comap_map f).injective

lemma comap_surjective (f : V ↪ W) : function.surjective (simple_graph.comap f) :=
(left_inverse_comap_map f).surjective

lemma map_le_iff_le_comap (f : V ↪ W) (G : simple_graph V) (G' : simple_graph W) :
  G.map f ≤ G' ↔ G ≤ G'.comap f :=
⟨λ h u v ha, h ⟨_, _, ha, rfl, rfl⟩, by { rintros h _ _ ⟨u, v, ha, rfl, rfl⟩, exact h ha, }⟩

lemma map_comap_le (f : V ↪ W) (G : simple_graph W) : (G.comap f).map f ≤ G :=
by { rw map_le_iff_le_comap, exact le_refl _ }

/-! ## Induced graphs -/

/- Given a set `s` of vertices, we can restrict a graph to those vertices by restricting its
adjacency relation. This gives a map between `simple_graph V` and `simple_graph s`.

There is also a notion of induced subgraphs (see `simple_graph.subgraph.induce`). -/

/-- Restrict a graph to the vertices in the set `s`, deleting all edges incident to vertices
outside the set. This is a wrapper around `simple_graph.comap`. -/
@[reducible] def induce (s : set V) (G : simple_graph V) : simple_graph s :=
G.comap (function.embedding.subtype _)

/-- Given a graph on a set of vertices, we can make it be a `simple_graph V` by
adding in the remaining vertices without adding in any additional edges.
This is a wrapper around `simple_graph.map`. -/
@[reducible] def spanning_coe {s : set V} (G : simple_graph s) : simple_graph V :=
G.map (function.embedding.subtype _)

lemma induce_spanning_coe {s : set V} {G : simple_graph s} : G.spanning_coe.induce s = G :=
comap_map_eq _ _

lemma spanning_coe_induce_le (s : set V) : (G.induce s).spanning_coe ≤ G :=
map_comap_le _ _

section finite_at

/-!
## 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`.
-/

variables (v) [fintype (G.neighbor_set v)]
/--
`G.neighbors v` is the `finset` version of `G.adj v` in case `G` is
locally finite at `v`.
-/
def neighbor_finset : finset V := (G.neighbor_set v).to_finset

lemma neighbor_finset_def : G.neighbor_finset v = (G.neighbor_set v).to_finset := rfl

@[simp] lemma mem_neighbor_finset (w : V) :
  w ∈ G.neighbor_finset v ↔ G.adj v w :=
set.mem_to_finset

@[simp] lemma not_mem_neighbor_finset_self : v ∉ G.neighbor_finset v :=
(mem_neighbor_finset _ _ _).not.mpr $ G.loopless _

lemma neighbor_finset_disjoint_singleton : disjoint (G.neighbor_finset v) {v} :=
finset.disjoint_singleton_right.mpr $ not_mem_neighbor_finset_self _ _

lemma singleton_disjoint_neighbor_finset : disjoint {v} (G.neighbor_finset v) :=
finset.disjoint_singleton_left.mpr $ not_mem_neighbor_finset_self _ _

/--
`G.degree v` is the number of vertices adjacent to `v`.
-/
def degree : ℕ := (G.neighbor_finset v).card

@[simp]
lemma card_neighbor_set_eq_degree : fintype.card (G.neighbor_set v) = G.degree v :=
(set.to_finset_card _).symm

lemma degree_pos_iff_exists_adj : 0 < G.degree v ↔ ∃ w, G.adj v w :=
by simp only [degree, card_pos, finset.nonempty, mem_neighbor_finset]

lemma degree_compl [fintype (Gᶜ.neighbor_set v)] [fintype V] :
  Gᶜ.degree v = fintype.card V - 1 - G.degree v :=
begin
  classical,
  rw [← card_neighbor_set_union_compl_neighbor_set G v, set.to_finset_union],
  simp [card_disjoint_union (set.disjoint_to_finset.mpr (compl_neighbor_set_disjoint G v))],
end

instance incidence_set_fintype [decidable_eq V] : fintype (G.incidence_set v) :=
fintype.of_equiv (G.neighbor_set v) (G.incidence_set_equiv_neighbor_set v).symm

/--
This is the `finset` version of `incidence_set`.
-/
def incidence_finset [decidable_eq V] : finset (sym2 V) := (G.incidence_set v).to_finset

@[simp]
lemma card_incidence_set_eq_degree [decidable_eq V] :
  fintype.card (G.incidence_set v) = G.degree v :=
by { rw fintype.card_congr (G.incidence_set_equiv_neighbor_set v), simp }

@[simp]
lemma card_incidence_finset_eq_degree [decidable_eq V] :
  (G.incidence_finset v).card = G.degree v :=
by { rw ← G.card_incidence_set_eq_degree, apply set.to_finset_card }

@[simp]
lemma mem_incidence_finset [decidable_eq V] (e : sym2 V) :
  e ∈ G.incidence_finset v ↔ e ∈ G.incidence_set v :=
set.mem_to_finset

lemma incidence_finset_eq_filter [decidable_eq V] [fintype G.edge_set] :
  G.incidence_finset v = G.edge_finset.filter (has_mem.mem v) :=
begin
  ext e,
  refine sym2.ind (λ x y, _) e,
  simp [mk_mem_incidence_set_iff],
end

end finite_at

section locally_finite

/--
A graph is locally finite if every vertex has a finite neighbor set.
-/
@[reducible]
def locally_finite := Π (v : V), fintype (G.neighbor_set v)

variable [locally_finite G]

/--
A locally finite simple graph is regular of degree `d` if every vertex has degree `d`.
-/
def is_regular_of_degree (d : ℕ) : Prop := ∀ (v : V), G.degree v = d

variables {G}

lemma is_regular_of_degree.degree_eq {d : ℕ} (h : G.is_regular_of_degree d) (v : V) :
  G.degree v = d := h v

lemma is_regular_of_degree.compl [fintype V] [decidable_eq V]
  {G : simple_graph V} [decidable_rel G.adj]
  {k : ℕ} (h : G.is_regular_of_degree k) :
  Gᶜ.is_regular_of_degree (fintype.card V - 1 - k) :=
by { intro v, rw [degree_compl, h v] }

end locally_finite

section finite

variable [fintype V]

instance neighbor_set_fintype [decidable_rel G.adj] (v : V) : fintype (G.neighbor_set v) :=
@subtype.fintype _ _ (by { simp_rw mem_neighbor_set, apply_instance }) _

lemma neighbor_finset_eq_filter {v : V} [decidable_rel G.adj] :
  G.neighbor_finset v = finset.univ.filter (G.adj v) :=
by { ext, simp }

lemma neighbor_finset_compl [decidable_eq V] [decidable_rel G.adj] (v : V) :
  Gᶜ.neighbor_finset v = (G.neighbor_finset v)ᶜ \ {v} :=
by simp only [neighbor_finset, neighbor_set_compl, set.to_finset_diff, set.to_finset_compl,
    set.to_finset_singleton]

@[simp]
lemma complete_graph_degree [decidable_eq V] (v : V) :
  (⊤ : simple_graph V).degree v = fintype.card V - 1 :=
by erw [degree, neighbor_finset_eq_filter, filter_ne, card_erase_of_mem (mem_univ v), card_univ]

lemma bot_degree (v : V) : (⊥ : simple_graph V).degree v = 0 :=
begin
  erw [degree, neighbor_finset_eq_filter, filter_false],
  exact finset.card_empty,
end

lemma is_regular_of_degree.top [decidable_eq V] :
  (⊤ : simple_graph V).is_regular_of_degree (fintype.card V - 1) :=
by { intro v, simp }

/--
The minimum degree of all vertices (and `0` if there are no vertices).
The key properties of this are given in `exists_minimal_degree_vertex`, `min_degree_le_degree`
and `le_min_degree_of_forall_le_degree`.
-/
def min_degree [decidable_rel G.adj] : ℕ :=
with_top.untop' 0 (univ.image (λ v, G.degree v)).min

/--
There exists a vertex of minimal degree. Note the assumption of being nonempty is necessary, as
the lemma implies there exists a vertex.
-/
lemma exists_minimal_degree_vertex [decidable_rel G.adj] [nonempty V] :
  ∃ v, G.min_degree = G.degree v :=
begin
  obtain ⟨t, ht : _ = _⟩ := min_of_nonempty (univ_nonempty.image (λ v, G.degree v)),
  obtain ⟨v, _, rfl⟩ := mem_image.mp (mem_of_min ht),
  refine ⟨v, by simp [min_degree, ht]⟩,
end

/-- The minimum degree in the graph is at most the degree of any particular vertex. -/
lemma min_degree_le_degree [decidable_rel G.adj] (v : V) : G.min_degree ≤ G.degree v :=
begin
  obtain ⟨t, ht⟩ := finset.min_of_mem (mem_image_of_mem (λ v, G.degree v) (mem_univ v)),
  have := finset.min_le_of_eq (mem_image_of_mem _ (mem_univ v)) ht,
  rwa [min_degree, ht]
end

/--
In a nonempty graph, if `k` is at most the degree of every vertex, it is at most the minimum
degree. Note the assumption that the graph is nonempty is necessary as long as `G.min_degree` is
defined to be a natural.
-/
lemma le_min_degree_of_forall_le_degree [decidable_rel G.adj] [nonempty V] (k : ℕ)
  (h : ∀ v, k ≤ G.degree v) :
  k ≤ G.min_degree :=
by { rcases G.exists_minimal_degree_vertex with ⟨v, hv⟩, rw hv, apply h }

/--
The maximum degree of all vertices (and `0` if there are no vertices).
The key properties of this are given in `exists_maximal_degree_vertex`, `degree_le_max_degree`
and `max_degree_le_of_forall_degree_le`.
-/
def max_degree [decidable_rel G.adj] : ℕ :=
option.get_or_else (univ.image (λ v, G.degree v)).max 0

/--
There exists a vertex of maximal degree. Note the assumption of being nonempty is necessary, as
the lemma implies there exists a vertex.
-/
lemma exists_maximal_degree_vertex [decidable_rel G.adj] [nonempty V] :
  ∃ v, G.max_degree = G.degree v :=
begin
  obtain ⟨t, ht⟩ := max_of_nonempty (univ_nonempty.image (λ v, G.degree v)),
  have ht₂ := mem_of_max ht,
  simp only [mem_image, mem_univ, exists_prop_of_true] at ht₂,
  rcases ht₂ with ⟨v, rfl⟩,
  refine ⟨v, _⟩,
  rw [max_degree, ht],
  refl
end

/-- The maximum degree in the graph is at least the degree of any particular vertex. -/
lemma degree_le_max_degree [decidable_rel G.adj] (v : V) : G.degree v ≤ G.max_degree :=
begin
  obtain ⟨t, ht : _ = _⟩ := finset.max_of_mem (mem_image_of_mem (λ v, G.degree v) (mem_univ v)),
  have := finset.le_max_of_eq (mem_image_of_mem _ (mem_univ v)) ht,
  rwa [max_degree, ht],
end

/--
In a graph, if `k` is at least the degree of every vertex, then it is at least the maximum
degree.
-/
lemma max_degree_le_of_forall_degree_le [decidable_rel G.adj] (k : ℕ)
  (h : ∀ v, G.degree v ≤ k) :
  G.max_degree ≤ k :=
begin
  by_cases hV : (univ : finset V).nonempty,
  { haveI : nonempty V := univ_nonempty_iff.mp hV,
    obtain ⟨v, hv⟩ := G.exists_maximal_degree_vertex,
    rw hv,
    apply h },
  { rw not_nonempty_iff_eq_empty at hV,
    rw [max_degree, hV, image_empty],
    exact zero_le k },
end

lemma degree_lt_card_verts [decidable_rel G.adj] (v : V) : G.degree v < fintype.card V :=
begin
  classical,
  apply finset.card_lt_card,
  rw finset.ssubset_iff,
  exact ⟨v, by simp, finset.subset_univ _⟩,
end

/--
The maximum degree of a nonempty graph is less than the number of vertices. Note that the assumption
that `V` is nonempty is necessary, as otherwise this would assert the existence of a
natural number less than zero.
-/
lemma max_degree_lt_card_verts [decidable_rel G.adj] [nonempty V] : G.max_degree < fintype.card V :=
begin
  cases G.exists_maximal_degree_vertex with v hv,
  rw hv,
  apply G.degree_lt_card_verts v,
end

lemma card_common_neighbors_le_degree_left [decidable_rel G.adj] (v w : V) :
  fintype.card (G.common_neighbors v w) ≤ G.degree v :=
begin
  rw [←card_neighbor_set_eq_degree],
  exact set.card_le_of_subset (set.inter_subset_left _ _),
end

lemma card_common_neighbors_lt_card_verts [decidable_rel G.adj] (v w : V) :
  fintype.card (G.common_neighbors v w) < fintype.card V :=
nat.lt_of_le_of_lt (G.card_common_neighbors_le_degree_left _ _) (G.degree_lt_card_verts v)

/--
If the condition `G.adj v w` fails, then `card_common_neighbors_le_degree` is
the best we can do in general.
-/
lemma adj.card_common_neighbors_lt_degree {G : simple_graph V} [decidable_rel G.adj]
  {v w : V} (h : G.adj v w) :
  fintype.card (G.common_neighbors v w) < G.degree v :=
begin
  classical,
  erw [←set.to_finset_card],
  apply finset.card_lt_card,
  rw finset.ssubset_iff,
  use w,
  split,
  { rw set.mem_to_finset,
    apply not_mem_common_neighbors_right },
  { rw finset.insert_subset,
    split,
    { simpa, },
    { rw [neighbor_finset, set.to_finset_subset_to_finset],
      exact G.common_neighbors_subset_neighbor_set_left _ _ } }
end

lemma card_common_neighbors_top [decidable_eq V] {v w : V} (h : v ≠ w) :
  fintype.card ((⊤ : simple_graph V).common_neighbors v w) = fintype.card V - 2 :=
begin
  simp only [common_neighbors_top_eq, ← set.to_finset_card, set.to_finset_diff],
  rw finset.card_sdiff,
  { simp [finset.card_univ, h], },
  { simp only [set.to_finset_subset_to_finset, set.subset_univ] },
end

end finite

section maps

/--
A graph homomorphism is a map on vertex sets that respects adjacency relations.

The notation `G →g G'` represents the type of graph homomorphisms.
-/
abbreviation hom := rel_hom G.adj G'.adj

/--
A graph embedding is an embedding `f` such that for vertices `v w : V`,
`G.adj f(v) f(w) ↔ G.adj v w `. Its image is an induced subgraph of G'.

The notation `G ↪g G'` represents the type of graph embeddings.
-/
abbreviation embedding := rel_embedding G.adj G'.adj

/--
A graph isomorphism is an bijective map on vertex sets that respects adjacency relations.

The notation `G ≃g G'` represents the type of graph isomorphisms.
-/
abbreviation iso := rel_iso G.adj G'.adj

infix ` →g ` : 50 := hom
infix ` ↪g ` : 50 := embedding
infix ` ≃g ` : 50 := iso

namespace hom
variables {G G'} (f : G →g G')

/-- The identity homomorphism from a graph to itself. -/
abbreviation id : G →g G := rel_hom.id _

lemma map_adj {v w : V} (h : G.adj v w) : G'.adj (f v) (f w) := f.map_rel' h

lemma map_mem_edge_set {e : sym2 V} (h : e ∈ G.edge_set) : e.map f ∈ G'.edge_set :=
quotient.ind (λ e h, sym2.from_rel_prop.mpr (f.map_rel' h)) e h

lemma apply_mem_neighbor_set {v w : V} (h : w ∈ G.neighbor_set v) : f w ∈ G'.neighbor_set (f v) :=
map_adj f h

/-- The map between edge sets induced by a homomorphism.
The underlying map on edges is given by `sym2.map`. -/
@[simps] def map_edge_set (e : G.edge_set) : G'.edge_set :=
⟨sym2.map f e, f.map_mem_edge_set e.property⟩

/-- The map between neighbor sets induced by a homomorphism. -/
@[simps] def map_neighbor_set (v : V) (w : G.neighbor_set v) : G'.neighbor_set (f v) :=
⟨f w, f.apply_mem_neighbor_set w.property⟩

/-- The map between darts induced by a homomorphism. -/
def map_dart (d : G.dart) : G'.dart := ⟨d.1.map f f, f.map_adj d.2⟩

@[simp] lemma map_dart_apply (d : G.dart) : f.map_dart d = ⟨d.1.map f f, f.map_adj d.2⟩ := rfl

/-- The induced map for spanning subgraphs, which is the identity on vertices. -/
@[simps]
def map_spanning_subgraphs {G G' : simple_graph V} (h : G ≤ G') : G →g G' :=
{ to_fun := λ x, x,
  map_rel' := h }

lemma map_edge_set.injective (hinj : function.injective f) : function.injective f.map_edge_set :=
begin
  rintros ⟨e₁, h₁⟩ ⟨e₂, h₂⟩,
  dsimp [hom.map_edge_set],
  repeat { rw subtype.mk_eq_mk },
  apply sym2.map.injective hinj,
end

/-- Every graph homomomorphism from a complete graph is injective. -/
lemma injective_of_top_hom (f : (⊤ : simple_graph V) →g G') : function.injective f :=
begin
  intros v w h,
  contrapose! h,
  exact G'.ne_of_adj (map_adj _ ((top_adj _ _).mpr h)),
end

/-- There is a homomorphism to a graph from a comapped graph.
When the function is injective, this is an embedding (see `simple_graph.embedding.comap`). -/
@[simps] protected def comap (f : V → W) (G : simple_graph W) : G.comap f →g G :=
{ to_fun := f,
  map_rel' := by simp }

variable {G'' : simple_graph X}

/-- Composition of graph homomorphisms. -/
abbreviation comp (f' : G' →g G'') (f : G →g G') : G →g G'' := f'.comp f

@[simp] lemma coe_comp (f' : G' →g G'') (f : G →g G') : ⇑(f'.comp f) = f' ∘ f := rfl

end hom

namespace embedding
variables {G G'} (f : G ↪g G')

/-- The identity embedding from a graph to itself. -/
abbreviation refl : G ↪g G := rel_embedding.refl _

/-- An embedding of graphs gives rise to a homomorphism of graphs. -/
abbreviation to_hom : G →g G' := f.to_rel_hom

lemma map_adj_iff {v w : V} : G'.adj (f v) (f w) ↔ G.adj v w := f.map_rel_iff

lemma map_mem_edge_set_iff {e : sym2 V} : e.map f ∈ G'.edge_set ↔ e ∈ G.edge_set :=
quotient.ind (λ ⟨v, w⟩, f.map_adj_iff) e

lemma apply_mem_neighbor_set_iff {v w : V} : f w ∈ G'.neighbor_set (f v) ↔ w ∈ G.neighbor_set v :=
map_adj_iff f

/-- A graph embedding induces an embedding of edge sets. -/
@[simps] def map_edge_set : G.edge_set ↪ G'.edge_set :=
{ to_fun := hom.map_edge_set f,
  inj' := hom.map_edge_set.injective f f.inj' }

/-- A graph embedding induces an embedding of neighbor sets. -/
@[simps] def map_neighbor_set (v : V) : G.neighbor_set v ↪ G'.neighbor_set (f v) :=
{ to_fun := λ w, ⟨f w, f.apply_mem_neighbor_set_iff.mpr w.2⟩,
  inj' := begin
    rintros ⟨w₁, h₁⟩ ⟨w₂, h₂⟩ h,
    rw subtype.mk_eq_mk at h ⊢,
    exact f.inj' h,
  end }

/-- Given an injective function, there is an embedding from the comapped graph into the original
graph. -/
@[simps]
protected def comap (f : V ↪ W) (G : simple_graph W) : G.comap f ↪g G :=
{ map_rel_iff' := by simp, ..f }

/-- Given an injective function, there is an embedding from a graph into the mapped graph. -/
@[simps]
protected def map (f : V ↪ W) (G : simple_graph V) : G ↪g G.map f :=
{ map_rel_iff' := by simp, ..f }

/-- Induced graphs embed in the original graph.

Note that if `G.induce s = ⊤` (i.e., if `s` is a clique) then this gives the embedding of a
complete graph. -/
@[reducible] protected def induce (s : set V) : G.induce s ↪g G :=
simple_graph.embedding.comap (function.embedding.subtype _) G

/-- Graphs on a set of vertices embed in their `spanning_coe`. -/
@[reducible] protected def spanning_coe {s : set V} (G : simple_graph s) : G ↪g G.spanning_coe :=
simple_graph.embedding.map (function.embedding.subtype _) G

/-- Embeddings of types induce embeddings of complete graphs on those types. -/
protected def complete_graph {α β : Type*} (f : α ↪ β) :
  (⊤ : simple_graph α) ↪g (⊤ : simple_graph β) :=
{ map_rel_iff' := by simp, ..f }

variables {G'' : simple_graph X}

/-- Composition of graph embeddings. -/
abbreviation comp (f' : G' ↪g G'') (f : G ↪g G') : G ↪g G'' := f.trans f'

@[simp] lemma coe_comp (f' : G' ↪g G'') (f : G ↪g G') : ⇑(f'.comp f) = f' ∘ f := rfl

end embedding

section induce_hom

variables {G G'} {G'' : simple_graph X} {s : set V} {t : set W} {r : set X}
          (φ : G →g G') (φst : set.maps_to φ s t) (ψ : G' →g G'') (ψtr : set.maps_to ψ t r)

/-- The restriction of a morphism of graphs to induced subgraphs. -/
def induce_hom : G.induce s →g G'.induce t :=
{ to_fun := set.maps_to.restrict φ s t φst,
  map_rel' := λ _ _,  φ.map_rel', }

@[simp, norm_cast] lemma coe_induce_hom : ⇑(induce_hom φ φst) = set.maps_to.restrict φ s t φst :=
rfl

@[simp] lemma induce_hom_id (G : simple_graph V) (s) :
  induce_hom (hom.id : G →g G) (set.maps_to_id s) = hom.id :=
by { ext x, refl }

@[simp] lemma induce_hom_comp :
  (induce_hom ψ ψtr).comp (induce_hom φ φst) = induce_hom (ψ.comp φ) (ψtr.comp φst) :=
by { ext x, refl }

end induce_hom

namespace iso
variables {G G'} (f : G ≃g G')

/-- The identity isomorphism of a graph with itself. -/
abbreviation refl : G ≃g G := rel_iso.refl _

/-- An isomorphism of graphs gives rise to an embedding of graphs. -/
abbreviation to_embedding : G ↪g G' := f.to_rel_embedding

/-- An isomorphism of graphs gives rise to a homomorphism of graphs. -/
abbreviation to_hom : G →g G' := f.to_embedding.to_hom

/-- The inverse of a graph isomorphism. -/
abbreviation symm : G' ≃g G := f.symm

lemma map_adj_iff {v w : V} : G'.adj (f v) (f w) ↔ G.adj v w := f.map_rel_iff

lemma map_mem_edge_set_iff {e : sym2 V} : e.map f ∈ G'.edge_set ↔ e ∈ G.edge_set :=
quotient.ind (λ ⟨v, w⟩, f.map_adj_iff) e

lemma apply_mem_neighbor_set_iff {v w : V} : f w ∈ G'.neighbor_set (f v) ↔ w ∈ G.neighbor_set v :=
map_adj_iff f

/-- An isomorphism of graphs induces an equivalence of edge sets. -/
@[simps] def map_edge_set : G.edge_set ≃ G'.edge_set :=
{ to_fun := hom.map_edge_set f,
  inv_fun := hom.map_edge_set f.symm,
  left_inv := begin
    rintro ⟨e, h⟩,
    simp only [hom.map_edge_set, sym2.map_map, rel_iso.coe_coe_fn,
      rel_embedding.coe_coe_fn, subtype.mk_eq_mk, subtype.coe_mk, coe_coe],
    apply congr_fun,
    convert sym2.map_id,
    exact funext (λ _, rel_iso.symm_apply_apply _ _),
  end,
  right_inv := begin
    rintro ⟨e, h⟩,
    simp only [hom.map_edge_set, sym2.map_map, rel_iso.coe_coe_fn,
      rel_embedding.coe_coe_fn, subtype.mk_eq_mk, subtype.coe_mk, coe_coe],
    apply congr_fun,
    convert sym2.map_id,
    exact funext (λ _, rel_iso.apply_symm_apply _ _),
  end }

/-- A graph isomorphism induces an equivalence of neighbor sets. -/
@[simps] def map_neighbor_set (v : V) : G.neighbor_set v ≃ G'.neighbor_set (f v) :=
{ to_fun := λ w, ⟨f w, f.apply_mem_neighbor_set_iff.mpr w.2⟩,
  inv_fun := λ w, ⟨f.symm w, begin
    convert f.symm.apply_mem_neighbor_set_iff.mpr w.2,
    simp only [rel_iso.symm_apply_apply],
  end⟩,
  left_inv := λ w, by simp,
  right_inv := λ w, by simp }

lemma card_eq_of_iso [fintype V] [fintype W] (f : G ≃g G') : fintype.card V = fintype.card W :=
by convert (fintype.of_equiv_card f.to_equiv).symm

/-- Given a bijection, there is an embedding from the comapped graph into the original
graph. -/
@[simps] protected def comap (f : V ≃ W) (G : simple_graph W) : G.comap f.to_embedding ≃g G :=
{ map_rel_iff' := by simp, ..f }

/-- Given an injective function, there is an embedding from a graph into the mapped graph. -/
@[simps] protected def map (f : V ≃ W) (G : simple_graph V) : G ≃g G.map f.to_embedding :=
{ map_rel_iff' := by simp, ..f }

/-- Equivalences of types induce isomorphisms of complete graphs on those types. -/
protected def complete_graph {α β : Type*} (f : α ≃ β) :
  (⊤ : simple_graph α) ≃g (⊤ : simple_graph β) :=
{ map_rel_iff' := by simp, ..f }

lemma to_embedding_complete_graph {α β : Type*} (f : α ≃ β) :
  (iso.complete_graph f).to_embedding = embedding.complete_graph f.to_embedding := rfl

variables {G'' : simple_graph X}

/-- Composition of graph isomorphisms. -/
abbreviation comp (f' : G' ≃g G'') (f : G ≃g G') : G ≃g G'' := f.trans f'

@[simp] lemma coe_comp (f' : G' ≃g G'') (f : G ≃g G') : ⇑(f'.comp f) = f' ∘ f := rfl

end iso

end maps

end simple_graph


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import algebra.order.absolute_value
import algebra.big_operators.order

/-!
# Cauchy sequences

A basic theory of Cauchy sequences, used in the construction of the reals and p-adic numbers. Where
applicable, lemmas that will be reused in other contexts have been stated in extra generality.

There are other "versions" of Cauchyness in the library, in particular Cauchy filters in topology.
This is a concrete implementation that is useful for simplicity and computability reasons.

## Important definitions

* `is_cau_seq`: a predicate that says `f : ℕ → β` is Cauchy.
* `cau_seq`: the type of Cauchy sequences valued in type `β` with respect to an absolute value
  function `abv`.

## Tags

sequence, cauchy, abs val, absolute value
-/

open_locale big_operators

open is_absolute_value

theorem exists_forall_ge_and {α} [linear_order α] {P Q : α → Prop} :
  (∃ i, ∀ j ≥ i, P j) → (∃ i, ∀ j ≥ i, Q j) →
  ∃ i, ∀ j ≥ i, P j ∧ Q j
| ⟨a, h₁⟩ ⟨b, h₂⟩ := let ⟨c, ac, bc⟩ := exists_ge_of_linear a b in
  ⟨c, λ j hj, ⟨h₁ _ (le_trans ac hj), h₂ _ (le_trans bc hj)⟩⟩

section
variables {α : Type*} [linear_ordered_field α]
  {β : Type*} [ring β] (abv : β → α) [is_absolute_value abv]

theorem rat_add_continuous_lemma
  {ε : α} (ε0 : 0 < ε) : ∃ δ > 0, ∀ {a₁ a₂ b₁ b₂ : β},
  abv (a₁ - b₁) < δ → abv (a₂ - b₂) < δ → abv (a₁ + a₂ - (b₁ + b₂)) < ε :=
⟨ε / 2, half_pos ε0, λ a₁ a₂ b₁ b₂ h₁ h₂,
  by simpa [add_halves, sub_eq_add_neg, add_comm, add_left_comm, add_assoc]
    using lt_of_le_of_lt (abv_add abv _ _) (add_lt_add h₁ h₂)⟩

theorem rat_mul_continuous_lemma
  {ε K₁ K₂ : α} (ε0 : 0 < ε) :
  ∃ δ > 0, ∀ {a₁ a₂ b₁ b₂ : β}, abv a₁ < K₁ → abv b₂ < K₂ →
  abv (a₁ - b₁) < δ → abv (a₂ - b₂) < δ → abv (a₁ * a₂ - b₁ * b₂) < ε :=
begin
  have K0 : (0 : α) < max 1 (max K₁ K₂) := lt_of_lt_of_le zero_lt_one (le_max_left _ _),
  have εK := div_pos (half_pos ε0) K0,
  refine ⟨_, εK, λ a₁ a₂ b₁ b₂ ha₁ hb₂ h₁ h₂, _⟩,
  replace ha₁ := lt_of_lt_of_le ha₁ (le_trans (le_max_left _ K₂) (le_max_right 1 _)),
  replace hb₂ := lt_of_lt_of_le hb₂ (le_trans (le_max_right K₁ _) (le_max_right 1 _)),
  have := add_lt_add
    (mul_lt_mul' (le_of_lt h₁) hb₂ (abv_nonneg abv _) εK)
    (mul_lt_mul' (le_of_lt h₂) ha₁ (abv_nonneg abv _) εK),
  rw [← abv_mul abv, mul_comm, div_mul_cancel _ (ne_of_gt K0), ← abv_mul abv, add_halves] at this,
  simpa [mul_add, add_mul, sub_eq_add_neg, add_comm, add_left_comm]
    using lt_of_le_of_lt (abv_add abv _ _) this
end

theorem rat_inv_continuous_lemma
  {β : Type*} [field β] (abv : β → α) [is_absolute_value abv]
  {ε K : α} (ε0 : 0 < ε) (K0 : 0 < K) :
  ∃ δ > 0, ∀ {a b : β}, K ≤ abv a → K ≤ abv b →
  abv (a - b) < δ → abv (a⁻¹ - b⁻¹) < ε :=
begin
  have KK := mul_pos K0 K0,
  have εK := mul_pos ε0 KK,
  refine ⟨_, εK, λ a b ha hb h, _⟩,
  have a0 := lt_of_lt_of_le K0 ha,
  have b0 := lt_of_lt_of_le K0 hb,
  rw [inv_sub_inv ((abv_pos abv).1 a0) ((abv_pos abv).1 b0),
      abv_div abv, abv_mul abv, mul_comm, abv_sub abv,
      ← mul_div_cancel ε (ne_of_gt KK)],
  exact div_lt_div h
    (mul_le_mul hb ha (le_of_lt K0) (abv_nonneg abv _))
    (le_of_lt $ mul_pos ε0 KK) KK
end
end

/-- A sequence is Cauchy if the distance between its entries tends to zero. -/
def is_cau_seq {α : Type*} [linear_ordered_field α]
  {β : Type*} [ring β] (abv : β → α) (f : ℕ → β) : Prop :=
∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j - f i) < ε

namespace is_cau_seq
variables {α : Type*} [linear_ordered_field α]
  {β : Type*} [ring β] {abv : β → α} [is_absolute_value abv] {f : ℕ → β}

@[nolint ge_or_gt] -- see Note [nolint_ge]
theorem cauchy₂ (hf : is_cau_seq abv f) {ε : α} (ε0 : 0 < ε) :
  ∃ i, ∀ j k ≥ i, abv (f j - f k) < ε :=
begin
  refine (hf _ (half_pos ε0)).imp (λ i hi j k ij ik, _),
  rw ← add_halves ε,
  refine lt_of_le_of_lt (abv_sub_le abv _ _ _) (add_lt_add (hi _ ij) _),
  rw abv_sub abv, exact hi _ ik
end

theorem cauchy₃ (hf : is_cau_seq abv f) {ε : α} (ε0 : 0 < ε) :
  ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - f j) < ε :=
let ⟨i, H⟩ := hf.cauchy₂ ε0 in ⟨i, λ j ij k jk, H _ _ (le_trans ij jk) ij⟩

end is_cau_seq

/-- `cau_seq β abv` is the type of `β`-valued Cauchy sequences, with respect to the absolute value
function `abv`. -/
def cau_seq {α : Type*} [linear_ordered_field α]
  (β : Type*) [ring β] (abv : β → α) : Type* :=
{f : ℕ → β // is_cau_seq abv f}

namespace cau_seq
variables {α : Type*} [linear_ordered_field α]

section ring
variables {β : Type*} [ring β] {abv : β → α}

instance : has_coe_to_fun (cau_seq β abv) (λ _, ℕ → β) := ⟨subtype.val⟩

@[simp] theorem mk_to_fun (f) (hf : is_cau_seq abv f) :
  @coe_fn (cau_seq β abv) _ _ ⟨f, hf⟩ = f := rfl

theorem ext {f g : cau_seq β abv} (h : ∀ i, f i = g i) : f = g :=
subtype.eq (funext h)

theorem is_cau (f : cau_seq β abv) : is_cau_seq abv f := f.2

theorem cauchy (f : cau_seq β abv) :
  ∀ {ε}, 0 < ε → ∃ i, ∀ j ≥ i, abv (f j - f i) < ε := f.2

/-- Given a Cauchy sequence `f`, create a Cauchy sequence from a sequence `g` with
the same values as `f`. -/
def of_eq (f : cau_seq β abv) (g : ℕ → β) (e : ∀ i, f i = g i) : cau_seq β abv :=
⟨g, λ ε, by rw [show g = f, from (funext e).symm]; exact f.cauchy⟩

variable [is_absolute_value abv]

@[nolint ge_or_gt] -- see Note [nolint_ge]
theorem cauchy₂ (f : cau_seq β abv) {ε} : 0 < ε →
  ∃ i, ∀ j k ≥ i, abv (f j - f k) < ε := f.2.cauchy₂

theorem cauchy₃ (f : cau_seq β abv) {ε} : 0 < ε →
  ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - f j) < ε := f.2.cauchy₃

theorem bounded (f : cau_seq β abv) : ∃ r, ∀ i, abv (f i) < r :=
begin
  cases f.cauchy zero_lt_one with i h,
  let R := ∑ j in finset.range (i+1), abv (f j),
  have : ∀ j ≤ i, abv (f j) ≤ R,
  { intros j ij, change (λ j, abv (f j)) j ≤ R,
    apply finset.single_le_sum,
    { intros, apply abv_nonneg abv },
    { rwa [finset.mem_range, nat.lt_succ_iff] } },
  refine ⟨R + 1, λ j, _⟩,
  cases lt_or_le j i with ij ij,
  { exact lt_of_le_of_lt (this _ (le_of_lt ij)) (lt_add_one _) },
  { have := lt_of_le_of_lt (abv_add abv _ _)
      (add_lt_add_of_le_of_lt (this _ (le_refl _)) (h _ ij)),
    rw [add_sub, add_comm] at this, simpa }
end

theorem bounded' (f : cau_seq β abv) (x : α) : ∃ r > x, ∀ i, abv (f i) < r :=
let ⟨r, h⟩ := f.bounded in
⟨max r (x+1), lt_of_lt_of_le (lt_add_one _) (le_max_right _ _),
  λ i, lt_of_lt_of_le (h i) (le_max_left _ _)⟩

instance : has_add (cau_seq β abv) :=
⟨λ f g, ⟨λ i, (f i + g i : β), λ ε ε0,
  let ⟨δ, δ0, Hδ⟩ := rat_add_continuous_lemma abv ε0,
      ⟨i, H⟩ := exists_forall_ge_and (f.cauchy₃ δ0) (g.cauchy₃ δ0) in
  ⟨i, λ j ij, let ⟨H₁, H₂⟩ := H _ (le_refl _) in Hδ (H₁ _ ij) (H₂ _ ij)⟩⟩⟩

@[simp] theorem add_apply (f g : cau_seq β abv) (i : ℕ) : (f + g) i = f i + g i := rfl

variable (abv)

/-- The constant Cauchy sequence. -/
def const (x : β) : cau_seq β abv :=
⟨λ i, x, λ ε ε0, ⟨0, λ j ij, by simpa [abv_zero abv] using ε0⟩⟩

variable {abv}

local notation `const` := const abv

@[simp] theorem const_apply (x : β) (i : ℕ) : (const x : ℕ → β) i = x := rfl

theorem const_inj {x y : β} : (const x : cau_seq β abv) = const y ↔ x = y :=
⟨λ h, congr_arg (λ f:cau_seq β abv, (f:ℕ→β) 0) h, congr_arg _⟩

instance : has_zero (cau_seq β abv) := ⟨const 0⟩
instance : has_one (cau_seq β abv) := ⟨const 1⟩
instance : inhabited (cau_seq β abv) := ⟨0⟩

@[simp] theorem zero_apply (i) : (0 : cau_seq β abv) i = 0 := rfl
@[simp] theorem one_apply (i) : (1 : cau_seq β abv) i = 1 := rfl
@[simp] theorem const_zero : const 0 = 0 := rfl

theorem const_add (x y : β) : const (x + y) = const x + const y :=
ext $ λ i, rfl

instance : has_mul (cau_seq β abv) :=
⟨λ f g, ⟨λ i, (f i * g i : β), λ ε ε0,
  let ⟨F, F0, hF⟩ := f.bounded' 0, ⟨G, G0, hG⟩ := g.bounded' 0,
      ⟨δ, δ0, Hδ⟩ := rat_mul_continuous_lemma abv ε0,
      ⟨i, H⟩ := exists_forall_ge_and (f.cauchy₃ δ0) (g.cauchy₃ δ0) in
  ⟨i, λ j ij, let ⟨H₁, H₂⟩ := H _ (le_refl _) in
    Hδ (hF j) (hG i) (H₁ _ ij) (H₂ _ ij)⟩⟩⟩

@[simp] theorem mul_apply (f g : cau_seq β abv) (i : ℕ) : (f * g) i = f i * g i := rfl

theorem const_mul (x y : β) : const (x * y) = const x * const y :=
ext $ λ i, rfl

instance : has_neg (cau_seq β abv) :=
⟨λ f, of_eq (const (-1) * f) (λ x, -f x) (λ i, by simp)⟩

@[simp] theorem neg_apply (f : cau_seq β abv) (i) : (-f) i = -f i := rfl

theorem const_neg (x : β) : const (-x) = -const x :=
ext $ λ i, rfl

instance : has_sub (cau_seq β abv) :=
⟨λ f g, of_eq (f + -g) (λ x, f x - g x) (λ i, by simp [sub_eq_add_neg])⟩

@[simp] theorem sub_apply (f g : cau_seq β abv) (i : ℕ) : (f - g) i = f i - g i := rfl

theorem const_sub (x y : β) : const (x - y) = const x - const y :=
ext $ λ i, rfl

instance : ring (cau_seq β abv) :=
by refine_struct
     { neg := has_neg.neg,
       add := (+),
       zero := (0 : cau_seq β abv),
       mul := (*),
       one := 1,
       sub := has_sub.sub,
       npow := @npow_rec (cau_seq β abv) ⟨1⟩ ⟨(*)⟩,
       nsmul := @nsmul_rec (cau_seq β abv) ⟨0⟩ ⟨(+)⟩,
       zsmul := @zsmul_rec (cau_seq β abv) ⟨0⟩ ⟨(+)⟩ ⟨has_neg.neg⟩ };
intros; try { refl }; apply ext;
simp [mul_add, mul_assoc, add_mul, add_comm, add_left_comm, sub_eq_add_neg]

instance {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv] :
  comm_ring (cau_seq β abv) :=
{ mul_comm := by intros; apply ext; simp [mul_left_comm, mul_comm],
  ..cau_seq.ring }

/-- `lim_zero f` holds when `f` approaches 0. -/
def lim_zero {abv : β → α} (f : cau_seq β abv) : Prop := ∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j) < ε

theorem add_lim_zero {f g : cau_seq β abv}
  (hf : lim_zero f) (hg : lim_zero g) : lim_zero (f + g)
| ε ε0 := (exists_forall_ge_and
    (hf _ $ half_pos ε0) (hg _ $ half_pos ε0)).imp $
  λ i H j ij, let ⟨H₁, H₂⟩ := H _ ij in
    by simpa [add_halves ε] using lt_of_le_of_lt (abv_add abv _ _) (add_lt_add H₁ H₂)

theorem mul_lim_zero_right (f : cau_seq β abv) {g}
  (hg : lim_zero g) : lim_zero (f * g)
| ε ε0 := let ⟨F, F0, hF⟩ := f.bounded' 0 in
  (hg _ $ div_pos ε0 F0).imp $ λ i H j ij,
  by have := mul_lt_mul' (le_of_lt $ hF j) (H _ ij) (abv_nonneg abv _) F0;
     rwa [mul_comm F, div_mul_cancel _ (ne_of_gt F0), ← abv_mul abv] at this

theorem mul_lim_zero_left {f} (g : cau_seq β abv)
  (hg : lim_zero f) : lim_zero (f * g)
| ε ε0 := let ⟨G, G0, hG⟩ := g.bounded' 0 in
  (hg _ $ div_pos ε0 G0).imp $ λ i H j ij,
  by have := mul_lt_mul'' (H _ ij) (hG j) (abv_nonneg abv _) (abv_nonneg abv _);
     rwa [div_mul_cancel _ (ne_of_gt G0), ← abv_mul abv] at this

theorem neg_lim_zero {f : cau_seq β abv} (hf : lim_zero f) : lim_zero (-f) :=
by rw ← neg_one_mul; exact mul_lim_zero_right _ hf

theorem sub_lim_zero {f g : cau_seq β abv}
  (hf : lim_zero f) (hg : lim_zero g) : lim_zero (f - g) :=
by simpa only [sub_eq_add_neg] using add_lim_zero hf (neg_lim_zero hg)

theorem lim_zero_sub_rev {f g : cau_seq β abv} (hfg : lim_zero (f - g)) : lim_zero (g - f) :=
by simpa using neg_lim_zero hfg

theorem zero_lim_zero : lim_zero (0 : cau_seq β abv)
| ε ε0 := ⟨0, λ j ij, by simpa [abv_zero abv] using ε0⟩

theorem const_lim_zero {x : β} : lim_zero (const x) ↔ x = 0 :=
⟨λ H, (abv_eq_zero abv).1 $
  eq_of_le_of_forall_le_of_dense (abv_nonneg abv _) $
  λ ε ε0, let ⟨i, hi⟩ := H _ ε0 in le_of_lt $ hi _ (le_refl _),
λ e, e.symm ▸ zero_lim_zero⟩

instance equiv : setoid (cau_seq β abv) :=
⟨λ f g, lim_zero (f - g),
⟨λ f, by simp [zero_lim_zero],
 λ f g h, by simpa using neg_lim_zero h,
 λ f g h fg gh, by simpa [sub_eq_add_neg, add_assoc] using add_lim_zero fg gh⟩⟩

lemma add_equiv_add {f1 f2 g1 g2 : cau_seq β abv} (hf : f1 ≈ f2) (hg : g1 ≈ g2) :
  f1 + g1 ≈ f2 + g2 :=
begin
  change lim_zero ((f1 + g1) - _),
  convert add_lim_zero hf hg using 1,
  simp only [sub_eq_add_neg, add_assoc],
  rw add_comm (-f2), simp only [add_assoc],
  congr' 2, simp
end

lemma neg_equiv_neg {f g : cau_seq β abv} (hf : f ≈ g) : -f ≈ -g :=
begin
  have hf : lim_zero _ := neg_lim_zero hf,
  show lim_zero (-f - -g),
  convert hf using 1, simp
end

theorem equiv_def₃ {f g : cau_seq β abv} (h : f ≈ g) {ε : α} (ε0 : 0 < ε) :
  ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - g j) < ε :=
(exists_forall_ge_and (h _ $ half_pos ε0) (f.cauchy₃ $ half_pos ε0)).imp $
λ i H j ij k jk, let ⟨h₁, h₂⟩ := H _ ij in
by have := lt_of_le_of_lt (abv_add abv (f j - g j) _) (add_lt_add h₁ (h₂ _ jk));
   rwa [sub_add_sub_cancel', add_halves] at this

theorem lim_zero_congr {f g : cau_seq β abv} (h : f ≈ g) : lim_zero f ↔ lim_zero g :=
⟨λ l, by simpa using add_lim_zero (setoid.symm h) l,
 λ l, by simpa using add_lim_zero h l⟩

theorem abv_pos_of_not_lim_zero {f : cau_seq β abv} (hf : ¬ lim_zero f) :
  ∃ K > 0, ∃ i, ∀ j ≥ i, K ≤ abv (f j) :=
begin
  haveI := classical.prop_decidable,
  by_contra nk,
  refine hf (λ ε ε0, _),
  simp [not_forall] at nk,
  cases f.cauchy₃ (half_pos ε0) with i hi,
  rcases nk _ (half_pos ε0) i with ⟨j, ij, hj⟩,
  refine ⟨j, λ k jk, _⟩,
  have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add (hi j ij k jk) hj),
  rwa [sub_add_cancel, add_halves] at this
end

theorem of_near (f : ℕ → β) (g : cau_seq β abv)
  (h : ∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j - g j) < ε) : is_cau_seq abv f
| ε ε0 :=
  let ⟨i, hi⟩ := exists_forall_ge_and
    (h _ (half_pos $ half_pos ε0)) (g.cauchy₃ $ half_pos ε0) in
  ⟨i, λ j ij, begin
    cases hi _ (le_refl _) with h₁ h₂, rw abv_sub abv at h₁,
    have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add (hi _ ij).1 h₁),
    have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add this (h₂ _ ij)),
    rwa [add_halves, add_halves, add_right_comm,
         sub_add_sub_cancel, sub_add_sub_cancel] at this
  end⟩

lemma not_lim_zero_of_not_congr_zero {f : cau_seq _ abv} (hf : ¬ f ≈ 0) : ¬ lim_zero f :=
assume : lim_zero f,
have lim_zero (f - 0), by simpa,
hf this

lemma mul_equiv_zero  (g : cau_seq _ abv) {f : cau_seq _ abv} (hf : f ≈ 0) : g * f ≈ 0 :=
have lim_zero (f - 0), from hf,
have lim_zero (g*f), from mul_lim_zero_right _ $ by simpa,
show lim_zero (g*f - 0), by simpa

lemma mul_not_equiv_zero {f g : cau_seq _ abv} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) : ¬ (f * g) ≈ 0 :=
assume : lim_zero (f*g - 0),
have hlz : lim_zero (f*g), by simpa,
have hf' : ¬ lim_zero f, by simpa using (show ¬ lim_zero (f - 0), from hf),
have hg' : ¬ lim_zero g, by simpa using (show ¬ lim_zero (g - 0), from hg),
begin
  rcases abv_pos_of_not_lim_zero hf' with ⟨a1, ha1, N1, hN1⟩,
  rcases abv_pos_of_not_lim_zero hg' with ⟨a2, ha2, N2, hN2⟩,
  have : 0 < a1 * a2, from mul_pos ha1 ha2,
  cases hlz _ this with N hN,
  let i := max N (max N1 N2),
  have hN' := hN i (le_max_left _ _),
  have hN1' := hN1 i (le_trans (le_max_left _ _) (le_max_right _ _)),
  have hN1' := hN2 i (le_trans (le_max_right _ _) (le_max_right _ _)),
  apply not_le_of_lt hN',
  change _ ≤ abv (_ * _),
  rw is_absolute_value.abv_mul abv,
  apply mul_le_mul; try { assumption },
  { apply le_of_lt ha2 },
  { apply is_absolute_value.abv_nonneg abv }
end

theorem const_equiv {x y : β} : const x ≈ const y ↔ x = y :=
show lim_zero _ ↔ _, by rw [← const_sub, const_lim_zero, sub_eq_zero]

end ring

section comm_ring
variables {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv]

lemma mul_equiv_zero' (g : cau_seq _ abv) {f : cau_seq _ abv} (hf : f ≈ 0) : f * g ≈ 0 :=
by rw mul_comm; apply mul_equiv_zero _ hf

end comm_ring

section is_domain
variables {β : Type*} [ring β] [is_domain β] (abv : β → α) [is_absolute_value abv]

lemma one_not_equiv_zero : ¬ (const abv 1) ≈ (const abv 0) :=
assume h,
have ∀ ε > 0, ∃ i, ∀ k, i ≤ k → abv (1 - 0) < ε, from h,
have h1 : abv 1 ≤ 0, from le_of_not_gt $
  assume h2 : 0 < abv 1,
  exists.elim (this _ h2) $ λ i hi,
    lt_irrefl (abv 1) $ by simpa using hi _ (le_refl _),
have h2 : 0 ≤ abv 1, from is_absolute_value.abv_nonneg _ _,
have abv 1 = 0, from le_antisymm h1 h2,
have (1 : β) = 0, from (is_absolute_value.abv_eq_zero abv).1 this,
absurd this one_ne_zero

end is_domain

section field
variables {β : Type*} [field β] {abv : β → α} [is_absolute_value abv]

theorem inv_aux {f : cau_seq β abv} (hf : ¬ lim_zero f) :
  ∀ ε > 0, ∃ i, ∀ j ≥ i, abv ((f j)⁻¹ - (f i)⁻¹) < ε | ε ε0 :=
let ⟨K, K0, HK⟩ := abv_pos_of_not_lim_zero hf,
    ⟨δ, δ0, Hδ⟩ := rat_inv_continuous_lemma abv ε0 K0,
    ⟨i, H⟩ := exists_forall_ge_and HK (f.cauchy₃ δ0) in
⟨i, λ j ij, let ⟨iK, H'⟩ := H _ (le_refl _) in Hδ (H _ ij).1 iK (H' _ ij)⟩

/-- Given a Cauchy sequence `f` with nonzero limit, create a Cauchy sequence with values equal to
the inverses of the values of `f`. -/
def inv (f : cau_seq β abv) (hf : ¬ lim_zero f) : cau_seq β abv := ⟨_, inv_aux hf⟩

@[simp] theorem inv_apply {f : cau_seq β abv} (hf i) : inv f hf i = (f i)⁻¹ := rfl

theorem inv_mul_cancel {f : cau_seq β abv} (hf) : inv f hf * f ≈ 1 :=
λ ε ε0, let ⟨K, K0, i, H⟩ := abv_pos_of_not_lim_zero hf in
⟨i, λ j ij,
  by simpa [(abv_pos abv).1 (lt_of_lt_of_le K0 (H _ ij)),
    abv_zero abv] using ε0⟩

theorem const_inv {x : β} (hx : x ≠ 0) :
  const abv (x⁻¹) = inv (const abv x) (by rwa const_lim_zero) :=
ext (assume n, by simp[inv_apply, const_apply])

end field

section abs
local notation `const` := const abs

/-- The entries of a positive Cauchy sequence eventually have a positive lower bound. -/
def pos (f : cau_seq α abs) : Prop := ∃ K > 0, ∃ i, ∀ j ≥ i, K ≤ f j

theorem not_lim_zero_of_pos {f : cau_seq α abs} : pos f → ¬ lim_zero f
| ⟨F, F0, hF⟩ H :=
  let ⟨i, h⟩ := exists_forall_ge_and hF (H _ F0),
      ⟨h₁, h₂⟩ := h _ (le_refl _) in
  not_lt_of_le h₁ (abs_lt.1 h₂).2

theorem const_pos {x : α} : pos (const x) ↔ 0 < x :=
⟨λ ⟨K, K0, i, h⟩, lt_of_lt_of_le K0 (h _ (le_refl _)),
 λ h, ⟨x, h, 0, λ j _, le_refl _⟩⟩

theorem add_pos {f g : cau_seq α abs} : pos f → pos g → pos (f + g)
| ⟨F, F0, hF⟩ ⟨G, G0, hG⟩ :=
  let ⟨i, h⟩ := exists_forall_ge_and hF hG in
  ⟨_, _root_.add_pos F0 G0, i,
    λ j ij, let ⟨h₁, h₂⟩ := h _ ij in add_le_add h₁ h₂⟩

theorem pos_add_lim_zero {f g : cau_seq α abs} : pos f → lim_zero g → pos (f + g)
| ⟨F, F0, hF⟩ H :=
  let ⟨i, h⟩ := exists_forall_ge_and hF (H _ (half_pos F0)) in
  ⟨_, half_pos F0, i, λ j ij, begin
    cases h j ij with h₁ h₂,
    have := add_le_add h₁ (le_of_lt (abs_lt.1 h₂).1),
    rwa [← sub_eq_add_neg, sub_self_div_two] at this
  end⟩

protected theorem mul_pos {f g : cau_seq α abs} : pos f → pos g → pos (f * g)
| ⟨F, F0, hF⟩ ⟨G, G0, hG⟩ :=
  let ⟨i, h⟩ := exists_forall_ge_and hF hG in
  ⟨_, _root_.mul_pos F0 G0, i,
    λ j ij, let ⟨h₁, h₂⟩ := h _ ij in
    mul_le_mul h₁ h₂ (le_of_lt G0) (le_trans (le_of_lt F0) h₁)⟩

theorem trichotomy (f : cau_seq α abs) : pos f ∨ lim_zero f ∨ pos (-f) :=
begin
  cases classical.em (lim_zero f); simp *,
  rcases abv_pos_of_not_lim_zero h with ⟨K, K0, hK⟩,
  rcases exists_forall_ge_and hK (f.cauchy₃ K0) with ⟨i, hi⟩,
  refine (le_total 0 (f i)).imp _ _;
    refine (λ h, ⟨K, K0, i, λ j ij, _⟩);
    have := (hi _ ij).1;
    cases hi _ (le_refl _) with h₁ h₂,
  { rwa abs_of_nonneg at this,
    rw abs_of_nonneg h at h₁,
    exact (le_add_iff_nonneg_right _).1
      (le_trans h₁ $ neg_le_sub_iff_le_add'.1 $
        le_of_lt (abs_lt.1 $ h₂ _ ij).1) },
  { rwa abs_of_nonpos at this,
    rw abs_of_nonpos h at h₁,
    rw [← sub_le_sub_iff_right, zero_sub],
    exact le_trans (le_of_lt (abs_lt.1 $ h₂ _ ij).2) h₁ }
end

instance : has_lt (cau_seq α abs) := ⟨λ f g, pos (g - f)⟩
instance : has_le (cau_seq α abs) := ⟨λ f g, f < g ∨ f ≈ g⟩

theorem lt_of_lt_of_eq {f g h : cau_seq α abs}
  (fg : f < g) (gh : g ≈ h) : f < h :=
show pos (h - f),
by simpa [sub_eq_add_neg, add_comm, add_left_comm] using pos_add_lim_zero fg (neg_lim_zero gh)

theorem lt_of_eq_of_lt {f g h : cau_seq α abs}
  (fg : f ≈ g) (gh : g < h) : f < h :=
by have := pos_add_lim_zero gh (neg_lim_zero fg);
   rwa [← sub_eq_add_neg, sub_sub_sub_cancel_right] at this

theorem lt_trans {f g h : cau_seq α abs} (fg : f < g) (gh : g < h) : f < h :=
show pos (h - f),
by simpa [sub_eq_add_neg, add_comm, add_left_comm] using add_pos fg gh

theorem lt_irrefl {f : cau_seq α abs} : ¬ f < f
| h := not_lim_zero_of_pos h (by simp [zero_lim_zero])

lemma le_of_eq_of_le {f g h : cau_seq α abs}
  (hfg : f ≈ g) (hgh : g ≤ h) : f ≤ h :=
hgh.elim (or.inl ∘ cau_seq.lt_of_eq_of_lt hfg)
  (or.inr ∘ setoid.trans hfg)

lemma le_of_le_of_eq {f g h : cau_seq α abs}
  (hfg : f ≤ g) (hgh : g ≈ h) : f ≤ h :=
hfg.elim (λ h, or.inl (cau_seq.lt_of_lt_of_eq h hgh))
  (λ h, or.inr (setoid.trans h hgh))

instance : preorder (cau_seq α abs) :=
{ lt := (<),
  le := λ f g, f < g ∨ f ≈ g,
  le_refl := λ f, or.inr (setoid.refl _),
  le_trans := λ f g h fg, match fg with
    | or.inl fg, or.inl gh := or.inl $ lt_trans fg gh
    | or.inl fg, or.inr gh := or.inl $ lt_of_lt_of_eq fg gh
    | or.inr fg, or.inl gh := or.inl $ lt_of_eq_of_lt fg gh
    | or.inr fg, or.inr gh := or.inr $ setoid.trans fg gh
    end,
  lt_iff_le_not_le := λ f g,
    ⟨λ h, ⟨or.inl h,
      not_or (mt (lt_trans h) lt_irrefl) (not_lim_zero_of_pos h)⟩,
    λ ⟨h₁, h₂⟩, h₁.resolve_right
      (mt (λ h, or.inr (setoid.symm h)) h₂)⟩ }

theorem le_antisymm {f g : cau_seq α abs} (fg : f ≤ g) (gf : g ≤ f) : f ≈ g :=
fg.resolve_left (not_lt_of_le gf)

theorem lt_total (f g : cau_seq α abs) : f < g ∨ f ≈ g ∨ g < f :=
(trichotomy (g - f)).imp_right
  (λ h, h.imp (λ h, setoid.symm h) (λ h, by rwa neg_sub at h))

theorem le_total (f g : cau_seq α abs) : f ≤ g ∨ g ≤ f :=
(or.assoc.2 (lt_total f g)).imp_right or.inl

theorem const_lt {x y : α} : const x < const y ↔ x < y :=
show pos _ ↔ _, by rw [← const_sub, const_pos, sub_pos]

theorem const_le {x y : α} : const x ≤ const y ↔ x ≤ y :=
by rw le_iff_lt_or_eq; exact or_congr const_lt const_equiv

lemma le_of_exists {f g : cau_seq α abs}
  (h : ∃ i, ∀ j ≥ i, f j ≤ g j) : f ≤ g :=
let ⟨i, hi⟩ := h in
(or.assoc.2 (cau_seq.lt_total f g)).elim
  id
  (λ hgf, false.elim (let ⟨K, hK0, j, hKj⟩ := hgf in
    not_lt_of_ge (hi (max i j) (le_max_left _ _))
      (sub_pos.1 (lt_of_lt_of_le hK0 (hKj _ (le_max_right _ _))))))

theorem exists_gt (f : cau_seq α abs) : ∃ a : α, f < const a :=
let ⟨K, H⟩ := f.bounded in
⟨K + 1, 1, zero_lt_one, 0, λ i _, begin
  rw [sub_apply, const_apply, le_sub_iff_add_le', add_le_add_iff_right],
  exact le_of_lt (abs_lt.1 (H _)).2
end⟩

theorem exists_lt (f : cau_seq α abs) : ∃ a : α, const a < f :=
let ⟨a, h⟩ := (-f).exists_gt in ⟨-a, show pos _,
  by rwa [const_neg, sub_neg_eq_add, add_comm, ← sub_neg_eq_add]⟩

end abs

end cau_seq


import Mathlib.Tactic.InferParam

namespace InferParamTest

theorem zero_le_add (a : Nat) (ha : 0 ≤ a := Nat.zero_le a) : 0 ≤ a + a := calc
  0 ≤ a := ha
  _ ≤ a + a := Nat.le_add_left _ _

theorem zero_le_add' (a : Nat) (ha : 0 ≤ a := by decide) : 0 ≤ a + a := zero_le_add a ha

example : 0 ≤ 2 + 2 := by
  fail_if_success infer_param
  decide

example : 0 ≤ 2 + 2 := by
  apply zero_le_add
  infer_param

example : 0 ≤ 2 + 2 := by
  apply zero_le_add'
  infer_param


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura
-/
prelude
import Init.SimpLemmas
universe u

namespace Nat

@[specialize] def foldAux {α : Type u} (f : Nat → α → α) (s : Nat) : Nat → α → α
  | 0,      a => a
  | succ n, a => foldAux f s n (f (s - (succ n)) a)

@[inline] def fold {α : Type u} (f : Nat → α → α) (n : Nat) (init : α) : α :=
  foldAux f n n init

@[inline] def foldRev {α : Type u} (f : Nat → α → α) (n : Nat) (init : α) : α :=
  let rec @[specialize] loop
    | 0,      a => a
    | succ n, a => loop n (f n a)
  loop n init

@[specialize] def anyAux (f : Nat → Bool) (s : Nat) : Nat → Bool
  | 0      => false
  | succ n => f (s - (succ n)) || anyAux f s n

/- `any f n = true` iff there is `i in [0, n-1]` s.t. `f i = true` -/
@[inline] def any (f : Nat → Bool) (n : Nat) : Bool :=
  anyAux f n n

@[inline] def all (f : Nat → Bool) (n : Nat) : Bool :=
  !any (fun i => !f i) n

@[inline] def repeat {α : Type u} (f : α → α) (n : Nat) (a : α) : α :=
  let rec @[specialize] loop
    | 0,      a => a
    | succ n, a => loop n (f a)
  loop n a

/- Helper "packing" theorems -/

@[simp] theorem zero_eq : Nat.zero = 0 := rfl
@[simp] theorem add_eq : Nat.add x y = x + y := rfl
@[simp] theorem mul_eq : Nat.mul x y = x * y := rfl
@[simp] theorem lt_eq : Nat.lt x y = (x < y) := rfl
@[simp] theorem le_eq : Nat.le x y = (x ≤ y) := rfl

/- Nat.add theorems -/

@[simp] protected theorem zero_add : ∀ (n : Nat), 0 + n = n
  | 0   => rfl
  | n+1 => congrArg succ (Nat.zero_add n)

theorem succ_add : ∀ (n m : Nat), (succ n) + m = succ (n + m)
  | n, 0   => rfl
  | n, m+1 => congrArg succ (succ_add n m)

theorem add_succ (n m : Nat) : n + succ m = succ (n + m) :=
  rfl

theorem add_one (n : Nat) : n + 1 = succ n :=
  rfl

theorem succ_eq_add_one (n : Nat) : succ n = n + 1 :=
  rfl

protected theorem add_comm : ∀ (n m : Nat), n + m = m + n
  | n, 0   => Eq.symm (Nat.zero_add n)
  | n, m+1 => by
    have : succ (n + m) = succ (m + n) := by apply congrArg; apply Nat.add_comm
    rw [succ_add m n]
    apply this

protected theorem add_assoc : ∀ (n m k : Nat), (n + m) + k = n + (m + k)
  | n, m, 0      => rfl
  | n, m, succ k => congrArg succ (Nat.add_assoc n m k)

protected theorem add_left_comm (n m k : Nat) : n + (m + k) = m + (n + k) := by
  rw [← Nat.add_assoc, Nat.add_comm n m, Nat.add_assoc]

protected theorem add_right_comm (n m k : Nat) : (n + m) + k = (n + k) + m := by
  rw [Nat.add_assoc, Nat.add_comm m k, ← Nat.add_assoc]

protected theorem add_left_cancel {n m k : Nat} : n + m = n + k → m = k := by
  induction n with
  | zero => simp; intros; assumption
  | succ n ih => simp [succ_add]; intro h; apply ih h

protected theorem add_right_cancel {n m k : Nat} (h : n + m = k + m) : n = k := by
  rw [Nat.add_comm n m, Nat.add_comm k m] at h
  apply Nat.add_left_cancel h

/- Nat.mul theorems -/

@[simp] protected theorem mul_zero (n : Nat) : n * 0 = 0 :=
  rfl

theorem mul_succ (n m : Nat) : n * succ m = n * m + n :=
  rfl

@[simp] protected theorem zero_mul : ∀ (n : Nat), 0 * n = 0
  | 0      => rfl
  | succ n => mul_succ 0 n ▸ (Nat.zero_mul n).symm ▸ rfl

theorem succ_mul (n m : Nat) : (succ n) * m = (n * m) + m := by
  induction m with
  | zero => rfl
  | succ m ih => rw [mul_succ, add_succ, ih, mul_succ, add_succ, Nat.add_right_comm]

protected theorem mul_comm : ∀ (n m : Nat), n * m = m * n
  | n, 0      => (Nat.zero_mul n).symm ▸ (Nat.mul_zero n).symm ▸ rfl
  | n, succ m => (mul_succ n m).symm ▸ (succ_mul m n).symm ▸ (Nat.mul_comm n m).symm ▸ rfl

@[simp] protected theorem mul_one : ∀ (n : Nat), n * 1 = n :=
  Nat.zero_add

@[simp] protected theorem one_mul (n : Nat) : 1 * n = n :=
  Nat.mul_comm n 1 ▸ Nat.mul_one n

protected theorem left_distrib (n m k : Nat) : n * (m + k) = n * m + n * k := by
  induction n generalizing m k with
  | zero      => repeat rw [Nat.zero_mul]
  | succ n ih => simp [succ_mul, ih]; rw [Nat.add_assoc, Nat.add_assoc (n*m)]; apply congrArg; apply Nat.add_left_comm

protected theorem right_distrib (n m k : Nat) : (n + m) * k = n * k + m * k :=
  have h₁ : (n + m) * k = k * (n + m)     := Nat.mul_comm ..
  have h₂ : k * (n + m) = k * n + k * m   := Nat.left_distrib ..
  have h₃ : k * n + k * m = n * k + k * m := Nat.mul_comm n k ▸ rfl
  have h₄ : n * k + k * m = n * k + m * k := Nat.mul_comm m k ▸ rfl
  ((h₁.trans h₂).trans h₃).trans h₄

protected theorem mul_add (n m k : Nat) : n * (m + k) = n * m + n * k :=
  Nat.left_distrib n m k

protected theorem add_mul (n m k : Nat) : (n + m) * k = n * k + m * k :=
  Nat.right_distrib n m k

protected theorem mul_assoc : ∀ (n m k : Nat), (n * m) * k = n * (m * k)
  | n, m, 0      => rfl
  | n, m, succ k =>
    have h₁ : n * m * succ k = n * m * (k + 1)              := rfl
    have h₂ : n * m * (k + 1) = (n * m * k) + n * m * 1     := Nat.left_distrib ..
    have h₃ : (n * m * k) + n * m * 1 = (n * m * k) + n * m := by rw [Nat.mul_one (n*m)]
    have h₄ : (n * m * k) + n * m = (n * (m * k)) + n * m   := by rw [Nat.mul_assoc n m k]
    have h₅ : (n * (m * k)) + n * m = n * (m * k + m)       := (Nat.left_distrib n (m*k) m).symm
    have h₆ : n * (m * k + m) = n * (m * succ k)            := Nat.mul_succ m k ▸ rfl
    ((((h₁.trans h₂).trans h₃).trans h₄).trans h₅).trans h₆

protected theorem mul_left_comm (n m k : Nat) : n * (m * k) = m * (n * k) := by
  rw [← Nat.mul_assoc, Nat.mul_comm n m, Nat.mul_assoc]

/- Inequalities -/

theorem succ_lt_succ {n m : Nat} : n < m → succ n < succ m :=
  succ_le_succ

theorem lt_succ_of_le {n m : Nat} : n ≤ m → n < succ m :=
  succ_le_succ

@[simp] protected theorem sub_zero (n : Nat) : n - 0 = n :=
  rfl

theorem succ_sub_succ_eq_sub (n m : Nat) : succ n - succ m = n - m := by
  induction m with
  | zero      => exact rfl
  | succ m ih => apply congrArg pred ih

theorem pred_le : ∀ (n : Nat), pred n ≤ n
  | zero   => Nat.le.refl
  | succ n => le_succ _

theorem pred_lt : ∀ {n : Nat}, n ≠ 0 → pred n < n
  | zero,   h => absurd rfl h
  | succ n, h => lt_succ_of_le (Nat.le_refl _)

theorem sub_le (n m : Nat) : n - m ≤ n := by
  induction m with
  | zero      => exact Nat.le_refl (n - 0)
  | succ m ih => apply Nat.le_trans (pred_le (n - m)) ih

theorem sub_lt : ∀ {n m : Nat}, 0 < n → 0 < m → n - m < n
  | 0,   m,   h1, h2 => absurd h1 (Nat.lt_irrefl 0)
  | n+1, 0,   h1, h2 => absurd h2 (Nat.lt_irrefl 0)
  | n+1, m+1, h1, h2 =>
    Eq.symm (succ_sub_succ_eq_sub n m) ▸
      show n - m < succ n from
      lt_succ_of_le (sub_le n m)

theorem sub_succ (n m : Nat) : n - succ m = pred (n - m) :=
  rfl

theorem succ_sub_succ (n m : Nat) : succ n - succ m = n - m :=
  succ_sub_succ_eq_sub n m

protected theorem sub_self : ∀ (n : Nat), n - n = 0
  | 0        => by rw [Nat.sub_zero]
  | (succ n) => by rw [succ_sub_succ, Nat.sub_self n]

protected theorem lt_of_lt_of_le {n m k : Nat} : n < m → m ≤ k → n < k :=
  Nat.le_trans

protected theorem lt_of_lt_of_eq {n m k : Nat} : n < m → m = k → n < k :=
  fun h₁ h₂ => h₂ ▸ h₁

instance : Trans (. < . : Nat → Nat → Prop) (. < . : Nat → Nat → Prop) (. < . : Nat → Nat → Prop) where
  trans := Nat.lt_trans

instance : Trans (. ≤ . : Nat → Nat → Prop) (. ≤ . : Nat → Nat → Prop) (. ≤ . : Nat → Nat → Prop) where
  trans := Nat.le_trans

instance : Trans (. < . : Nat → Nat → Prop) (. ≤ . : Nat → Nat → Prop) (. < . : Nat → Nat → Prop) where
  trans := Nat.lt_of_lt_of_le

instance : Trans (. ≤ . : Nat → Nat → Prop) (. < . : Nat → Nat → Prop) (. < . : Nat → Nat → Prop) where
  trans := Nat.lt_of_le_of_lt

protected theorem le_of_eq {n m : Nat} (p : n = m) : n ≤ m :=
  p ▸ Nat.le_refl n

theorem le_of_succ_le {n m : Nat} (h : succ n ≤ m) : n ≤ m :=
  Nat.le_trans (le_succ n) h

protected theorem le_of_lt {n m : Nat} (h : n < m) : n ≤ m :=
  le_of_succ_le h

def lt.step {n m : Nat} : n < m → n < succ m := le_step

theorem eq_zero_or_pos : ∀ (n : Nat), n = 0 ∨ n > 0
  | 0   => Or.inl rfl
  | n+1 => Or.inr (succ_pos _)

def lt.base (n : Nat) : n < succ n := Nat.le_refl (succ n)

theorem lt_succ_self (n : Nat) : n < succ n := lt.base n

protected theorem le_total (m n : Nat) : m ≤ n ∨ n ≤ m :=
  match Nat.lt_or_ge m n with
  | Or.inl h => Or.inl (Nat.le_of_lt h)
  | Or.inr h => Or.inr h

protected theorem lt_of_le_and_ne {m n : Nat} (h₁ : m ≤ n) (h₂ : m ≠ n) : m < n :=
  match Nat.eq_or_lt_of_le h₁ with
  | Or.inl h => absurd h h₂
  | Or.inr h => h

theorem eq_zero_of_le_zero {n : Nat} (h : n ≤ 0) : n = 0 :=
  Nat.le_antisymm h (zero_le _)

theorem lt_of_succ_lt {n m : Nat} : succ n < m → n < m :=
  le_of_succ_le

theorem lt_of_succ_lt_succ {n m : Nat} : succ n < succ m → n < m :=
  le_of_succ_le_succ

theorem lt_of_succ_le {n m : Nat} (h : succ n ≤ m) : n < m :=
  h

theorem succ_le_of_lt {n m : Nat} (h : n < m) : succ n ≤ m :=
  h

theorem zero_lt_of_lt : {a b : Nat} → a < b → 0 < b
  | 0,   _, h => h
  | a+1, b, h =>
    have : a < b := Nat.lt_trans (Nat.lt_succ_self _) h
    zero_lt_of_lt this

theorem le_or_eq_or_le_succ {m n : Nat} (h : m ≤ succ n) : m ≤ n ∨ m = succ n :=
  Decidable.byCases
    (fun (h' : m = succ n) => Or.inr h')
    (fun (h' : m ≠ succ n) =>
       have : m < succ n := Nat.lt_of_le_and_ne h h'
       have : succ m ≤ succ n := succ_le_of_lt this
       Or.inl (le_of_succ_le_succ this))

theorem le_add_right : ∀ (n k : Nat), n ≤ n + k
  | n, 0   => Nat.le_refl n
  | n, k+1 => le_succ_of_le (le_add_right n k)

theorem le_add_left (n m : Nat): n ≤ m + n :=
  Nat.add_comm n m ▸ le_add_right n m

theorem le.dest : ∀ {n m : Nat}, n ≤ m → Exists (fun k => n + k = m)
  | zero,   zero,   h => ⟨0, rfl⟩
  | zero,   succ n, h => ⟨succ n, Nat.add_comm 0 (succ n) ▸ rfl⟩
  | succ n, zero,   h => absurd h (not_succ_le_zero _)
  | succ n, succ m, h =>
    have : n ≤ m := Nat.le_of_succ_le_succ h
    have : Exists (fun k => n + k = m) := dest this
    match this with
    | ⟨k, h⟩ => ⟨k, show succ n + k = succ m from ((succ_add n k).symm ▸ h ▸ rfl)⟩

theorem le.intro {n m k : Nat} (h : n + k = m) : n ≤ m :=
  h ▸ le_add_right n k

protected theorem not_le_of_gt {n m : Nat} (h : n > m) : ¬ n ≤ m := fun h₁ =>
  match Nat.lt_or_ge n m with
  | Or.inl h₂ => absurd (Nat.lt_trans h h₂) (Nat.lt_irrefl _)
  | Or.inr h₂ =>
    have Heq : n = m := Nat.le_antisymm h₁ h₂
    absurd (@Eq.subst _ _ _ _ Heq h) (Nat.lt_irrefl m)

theorem gt_of_not_le {n m : Nat} (h : ¬ n ≤ m) : n > m :=
  match Nat.lt_or_ge m n with
  | Or.inl h₁ => h₁
  | Or.inr h₁ => absurd h₁ h

protected theorem add_le_add_left {n m : Nat} (h : n ≤ m) (k : Nat) : k + n ≤ k + m :=
  match le.dest h with
  | ⟨w, hw⟩ =>
    have h₁ : k + n + w = k + (n + w) := Nat.add_assoc ..
    have h₂ : k + (n + w) = k + m     := congrArg _ hw
    le.intro <| h₁.trans h₂

protected theorem add_le_add_right {n m : Nat} (h : n ≤ m) (k : Nat) : n + k ≤ m + k := by
  rw [Nat.add_comm n k, Nat.add_comm m k]
  apply Nat.add_le_add_left
  assumption

protected theorem add_lt_add_left {n m : Nat} (h : n < m) (k : Nat) : k + n < k + m :=
  lt_of_succ_le (add_succ k n ▸ Nat.add_le_add_left (succ_le_of_lt h) k)

protected theorem add_lt_add_right {n m : Nat} (h : n < m) (k : Nat) : n + k < m + k :=
  Nat.add_comm k m ▸ Nat.add_comm k n ▸ Nat.add_lt_add_left h k

protected theorem zero_lt_one : 0 < (1:Nat) :=
  zero_lt_succ 0

theorem add_le_add {a b c d : Nat} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d :=
  Nat.le_trans (Nat.add_le_add_right h₁ c) (Nat.add_le_add_left h₂ b)

theorem add_lt_add {a b c d : Nat} (h₁ : a < b) (h₂ : c < d) : a + c < b + d :=
  Nat.lt_trans (Nat.add_lt_add_right h₁ c) (Nat.add_lt_add_left h₂ b)

/- Basic theorems for comparing numerals -/

theorem ctor_eq_zero : Nat.zero = 0 :=
  rfl

protected theorem one_ne_zero : 1 ≠ (0 : Nat) :=
  fun h => Nat.noConfusion h

protected theorem zero_ne_one : 0 ≠ (1 : Nat) :=
  fun h => Nat.noConfusion h

theorem succ_ne_zero (n : Nat) : succ n ≠ 0 :=
  fun h => Nat.noConfusion h

/- mul + order -/

theorem mul_le_mul_left {n m : Nat} (k : Nat) (h : n ≤ m) : k * n ≤ k * m :=
  match le.dest h with
  | ⟨l, hl⟩ =>
    have : k * n + k * l = k * m := Nat.left_distrib k n l ▸ hl.symm ▸ rfl
    le.intro this

theorem mul_le_mul_right {n m : Nat} (k : Nat) (h : n ≤ m) : n * k ≤ m * k :=
  Nat.mul_comm k m ▸ Nat.mul_comm k n ▸ mul_le_mul_left k h

protected theorem mul_le_mul {n₁ m₁ n₂ m₂ : Nat} (h₁ : n₁ ≤ n₂) (h₂ : m₁ ≤ m₂) : n₁ * m₁ ≤ n₂ * m₂ :=
  Nat.le_trans (mul_le_mul_right _ h₁) (mul_le_mul_left _ h₂)

protected theorem mul_lt_mul_of_pos_left {n m k : Nat} (h : n < m) (hk : k > 0) : k * n < k * m :=
  Nat.lt_of_lt_of_le (Nat.add_lt_add_left hk _) (Nat.mul_succ k n ▸ Nat.mul_le_mul_left k (succ_le_of_lt h))

protected theorem mul_lt_mul_of_pos_right {n m k : Nat} (h : n < m) (hk : k > 0) : n * k < m * k :=
  Nat.mul_comm k m ▸ Nat.mul_comm k n ▸ Nat.mul_lt_mul_of_pos_left h hk

protected theorem mul_pos {n m : Nat} (ha : n > 0) (hb : m > 0) : n * m > 0 :=
  have h : 0 * m < n * m := Nat.mul_lt_mul_of_pos_right ha hb
  Nat.zero_mul m ▸ h

/- power -/

theorem pow_succ (n m : Nat) : n^(succ m) = n^m * n :=
  rfl

theorem pow_zero (n : Nat) : n^0 = 1 := rfl

theorem pow_le_pow_of_le_left {n m : Nat} (h : n ≤ m) : ∀ (i : Nat), n^i ≤ m^i
  | 0      => Nat.le_refl _
  | succ i => Nat.mul_le_mul (pow_le_pow_of_le_left h i) h

theorem pow_le_pow_of_le_right {n : Nat} (hx : n > 0) {i : Nat} : ∀ {j}, i ≤ j → n^i ≤ n^j
  | 0,      h =>
    have : i = 0 := eq_zero_of_le_zero h
    this.symm ▸ Nat.le_refl _
  | succ j, h =>
    match le_or_eq_or_le_succ h with
    | Or.inl h => show n^i ≤ n^j * n from
      have : n^i * 1 ≤ n^j * n := Nat.mul_le_mul (pow_le_pow_of_le_right hx h) hx
      Nat.mul_one (n^i) ▸ this
    | Or.inr h =>
      h.symm ▸ Nat.le_refl _

theorem pos_pow_of_pos {n : Nat} (m : Nat) (h : 0 < n) : 0 < n^m :=
  pow_le_pow_of_le_right h (Nat.zero_le _)

/- min/max -/

protected def min (n m : Nat) : Nat :=
  if n ≤ m then n else m

protected def max (n m : Nat) : Nat :=
  if n ≤ m then m else n

/- Auxiliary theorems for well-founded recursion -/
theorem not_eq_zero_of_lt (h : b < a) : a ≠ 0 := by
  cases a
  exact absurd h (Nat.not_lt_zero _)
  apply Nat.noConfusion

theorem pred_lt' {n m : Nat} (h : m < n) : pred n < n :=
  pred_lt (not_eq_zero_of_lt h)

theorem add_sub_self_left (a b : Nat) : (a + b) - a = b := by
  induction a with
  | zero => simp
  | succ a ih =>
    rw [Nat.succ_add, Nat.succ_sub_succ]
    apply ih

theorem add_sub_self_right (a b : Nat) : (a + b) - b = a := by
  rw [Nat.add_comm]; apply add_sub_self_left

theorem sub_le_succ_sub (a i : Nat) : a - i ≤ a.succ - i := by
  cases i with
  | zero => apply Nat.le_of_lt; apply Nat.lt_succ_self
  | succ i => rw [Nat.sub_succ, Nat.succ_sub_succ]; apply Nat.pred_le

theorem zero_lt_sub_of_lt (h : i < a) : 0 < a - i := by
  induction a with
  | zero => contradiction
  | succ a ih =>
    match Nat.eq_or_lt_of_le h with
    | Or.inl h => injection h with h; subst h; rw [←Nat.add_one, Nat.add_sub_self_left]; decide
    | Or.inr h =>
      have : 0 < a - i := ih (Nat.lt_of_succ_lt_succ h)
      exact Nat.lt_of_lt_of_le this (Nat.sub_le_succ_sub _ _)

theorem sub_succ_lt_self (a i : Nat) (h : i < a) : a - (i + 1) < a - i := by
  rw [Nat.add_succ, Nat.sub_succ]
  apply Nat.pred_lt
  apply Nat.not_eq_zero_of_lt
  apply Nat.zero_lt_sub_of_lt
  assumption

end Nat

namespace Prod

@[inline] def foldI {α : Type u} (f : Nat → α → α) (i : Nat × Nat) (a : α) : α :=
  Nat.foldAux f i.2 (i.2 - i.1) a

@[inline] def anyI (f : Nat → Bool) (i : Nat × Nat) : Bool :=
  Nat.anyAux f i.2 (i.2 - i.1)

@[inline] def allI (f : Nat → Bool) (i : Nat × Nat) : Bool :=
  Nat.anyAux (fun a => !f a) i.2 (i.2 - i.1)

end Prod