/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Abhimanyu Pallavi Sudhir
-/
import order.filter.basic
import algebra.module.pi

/-!
# Germ of a function at a filter

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

The germ of a function `f : α → β` at a filter `l : filter α` is the equivalence class of `f`
with respect to the equivalence relation `eventually_eq l`: `f ≈ g` means `∀ᶠ x in l, f x = g x`.

## Main definitions

We define

* `germ l β` to be the space of germs of functions `α → β` at a filter `l : filter α`;
* coercion from `α → β` to `germ l β`: `(f : germ l β)` is the germ of `f : α → β`
  at `l : filter α`; this coercion is declared as `has_coe_t`, so it does not require an explicit
  up arrow `↑`;
* coercion from `β` to `germ l β`: `(↑c : germ l β)` is the germ of the constant function
  `λ x:α, c` at a filter `l`; this coercion is declared as `has_lift_t`, so it requires an explicit
  up arrow `↑`, see [TPiL][TPiL_coe] for details.
* `map (F : β → γ) (f : germ l β)` to be the composition of a function `F` and a germ `f`;
* `map₂ (F : β → γ → δ) (f : germ l β) (g : germ l γ)` to be the germ of `λ x, F (f x) (g x)`
  at `l`;
* `f.tendsto lb`: we say that a germ `f : germ l β` tends to a filter `lb` if its representatives
  tend to `lb` along `l`;
* `f.comp_tendsto g hg` and `f.comp_tendsto' g hg`: given `f : germ l β` and a function
  `g : γ → α` (resp., a germ `g : germ lc α`), if `g` tends to `l` along `lc`, then the composition
  `f ∘ g` is a well-defined germ at `lc`;
* `germ.lift_pred`, `germ.lift_rel`: lift a predicate or a relation to the space of germs:
  `(f : germ l β).lift_pred p` means `∀ᶠ x in l, p (f x)`, and similarly for a relation.
[TPiL_coe]: https://leanprover.github.io/theorem_proving_in_lean/type_classes.html#coercions-using-type-classes

We also define `map (F : β → γ) : germ l β → germ l γ` sending each germ `f` to `F ∘ f`.

For each of the following structures we prove that if `β` has this structure, then so does
`germ l β`:

* one-operation algebraic structures up to `comm_group`;
* `mul_zero_class`, `distrib`, `semiring`, `comm_semiring`, `ring`, `comm_ring`;
* `mul_action`, `distrib_mul_action`, `module`;
* `preorder`, `partial_order`, and `lattice` structures, as well as `bounded_order`;
* `ordered_cancel_comm_monoid` and `ordered_cancel_add_comm_monoid`.

## Tags

filter, germ
-/

namespace filter

variables {α β γ δ : Type*} {l : filter α} {f g h : α → β}

lemma const_eventually_eq' [ne_bot l] {a b : β} : (∀ᶠ x in l, a = b) ↔ a = b :=
eventually_const

lemma const_eventually_eq [ne_bot l] {a b : β} : ((λ _, a) =ᶠ[l] (λ _, b)) ↔ a = b :=
@const_eventually_eq' _ _ _ _ a b

lemma eventually_eq.comp_tendsto {f' : α → β} (H : f =ᶠ[l] f') {g : γ → α} {lc : filter γ}
  (hg : tendsto g lc l) :
  f ∘ g =ᶠ[lc] f' ∘ g :=
hg.eventually H

/-- Setoid used to define the space of germs. -/
def germ_setoid (l : filter α) (β : Type*) : setoid (α → β) :=
{ r := eventually_eq l,
  iseqv := ⟨eventually_eq.refl _, λ _ _, eventually_eq.symm, λ _ _ _, eventually_eq.trans⟩ }

/-- The space of germs of functions `α → β` at a filter `l`. -/
def germ (l : filter α) (β : Type*) : Type* := quotient (germ_setoid l β)

/-- Setoid used to define the filter product. This is a dependent version of
  `filter.germ_setoid`. -/
def product_setoid (l : filter α) (ε : α → Type*) : setoid (Π a, ε a) :=
{ r := λ f g, ∀ᶠ a in l, f a = g a,
  iseqv := ⟨λ _, eventually_of_forall (λ _, rfl),
    λ _ _ h, h.mono (λ _, eq.symm),
    λ x y z h1 h2, h1.congr (h2.mono (λ x hx, hx ▸ iff.rfl))⟩ }

/-- The filter product `Π (a : α), ε a` at a filter `l`. This is a dependent version of
  `filter.germ`. -/
@[protected] def product (l : filter α) (ε : α → Type*) : Type* := quotient (product_setoid l ε)

namespace product

variables {ε : α → Type*}

instance : has_coe_t (Π a, ε a) (l.product ε) := ⟨quotient.mk'⟩

instance [Π a, inhabited (ε a)] : inhabited (l.product ε) :=
⟨(↑(λ a, (default : ε a)) : l.product ε)⟩

end product

namespace germ

instance : has_coe_t (α → β) (germ l β) := ⟨quotient.mk'⟩

instance : has_lift_t β (germ l β) := ⟨λ c, ↑(λ (x : α), c)⟩

@[simp] lemma quot_mk_eq_coe (l : filter α) (f : α → β) : quot.mk _ f = (f : germ l β) := rfl

@[simp] lemma mk'_eq_coe (l : filter α) (f : α → β) : quotient.mk' f = (f : germ l β) := rfl

@[elab_as_eliminator]
lemma induction_on (f : germ l β) {p : germ l β → Prop} (h : ∀ f : α → β, p f) : p f :=
quotient.induction_on' f h

@[elab_as_eliminator]
lemma induction_on₂ (f : germ l β) (g : germ l γ) {p : germ l β → germ l γ → Prop}
  (h : ∀ (f : α → β) (g : α → γ), p f g) : p f g :=
quotient.induction_on₂' f g h

@[elab_as_eliminator]
lemma induction_on₃ (f : germ l β) (g : germ l γ) (h : germ l δ)
  {p : germ l β → germ l γ → germ l δ → Prop}
  (H : ∀ (f : α → β) (g : α → γ) (h : α → δ), p f g h) :
  p f g h :=
quotient.induction_on₃' f g h H

/-- Given a map `F : (α → β) → (γ → δ)` that sends functions eventually equal at `l` to functions
eventually equal at `lc`, returns a map from `germ l β` to `germ lc δ`. -/
def map' {lc : filter γ} (F : (α → β) → (γ → δ)) (hF : (l.eventually_eq ⇒ lc.eventually_eq) F F) :
  germ l β → germ lc δ :=
quotient.map' F hF

/-- Given a germ `f : germ l β` and a function `F : (α → β) → γ` sending eventually equal functions
to the same value, returns the value `F` takes on functions having germ `f` at `l`. -/
def lift_on {γ : Sort*} (f : germ l β) (F : (α → β) → γ) (hF : (l.eventually_eq ⇒ (=)) F F) : γ :=
quotient.lift_on' f F hF

@[simp] lemma map'_coe {lc : filter γ} (F : (α → β) → (γ → δ))
  (hF : (l.eventually_eq ⇒ lc.eventually_eq) F F) (f : α → β) :
  map' F hF f = F f :=
rfl

@[simp, norm_cast] lemma coe_eq : (f : germ l β) = g ↔ (f =ᶠ[l] g) := quotient.eq'

alias coe_eq ↔ _ _root_.filter.eventually_eq.germ_eq

/-- Lift a function `β → γ` to a function `germ l β → germ l γ`. -/
def map (op : β → γ) : germ l β → germ l γ :=
map' ((∘) op) $ λ f g H, H.mono $ λ x H, congr_arg op H

@[simp] lemma map_coe (op : β → γ) (f : α → β) : map op (f : germ l β) = op ∘ f := rfl

@[simp] lemma map_id : map id = (id : germ l β → germ l β) := by { ext ⟨f⟩, refl }

lemma map_map (op₁ : γ → δ) (op₂ : β → γ) (f : germ l β) :
  map op₁ (map op₂ f) = map (op₁ ∘ op₂) f :=
induction_on f $ λ f, rfl

/-- Lift a binary function `β → γ → δ` to a function `germ l β → germ l γ → germ l δ`. -/
def map₂ (op : β → γ → δ) : germ l β → germ l γ → germ l δ :=
quotient.map₂' (λ f g x, op (f x) (g x)) $ λ f f' Hf g g' Hg,
Hg.mp $ Hf.mono $ λ x Hf Hg, by simp only [Hf, Hg]

@[simp] lemma map₂_coe (op : β → γ → δ) (f : α → β) (g : α → γ) :
  map₂ op (f : germ l β) g = λ x, op (f x) (g x) :=
rfl

/-- A germ at `l` of maps from `α` to `β` tends to `lb : filter β` if it is represented by a map
which tends to `lb` along `l`. -/
protected def tendsto (f : germ l β) (lb : filter β) : Prop :=
lift_on f (λ f, tendsto f l lb) $ λ f g H, propext (tendsto_congr' H)

@[simp, norm_cast] lemma coe_tendsto {f : α → β} {lb : filter β} :
  (f : germ l β).tendsto lb ↔ tendsto f l lb :=
iff.rfl

alias coe_tendsto ↔ _ _root_.filter.tendsto.germ_tendsto

/-- Given two germs `f : germ l β`, and `g : germ lc α`, where `l : filter α`, if `g` tends to `l`,
then the composition `f ∘ g` is well-defined as a germ at `lc`. -/
def comp_tendsto' (f : germ l β) {lc : filter γ} (g : germ lc α) (hg : g.tendsto l) :
  germ lc β :=
lift_on f (λ f, g.map f) $ λ f₁ f₂ hF, (induction_on g $ λ g hg, coe_eq.2 $ hg.eventually hF) hg

@[simp] lemma coe_comp_tendsto' (f : α → β) {lc : filter γ} {g : germ lc α} (hg : g.tendsto l) :
  (f : germ l β).comp_tendsto' g hg = g.map f :=
rfl

/-- Given a germ `f : germ l β` and a function `g : γ → α`, where `l : filter α`, if `g` tends
to `l` along `lc : filter γ`, then the composition `f ∘ g` is well-defined as a germ at `lc`. -/
def comp_tendsto (f : germ l β) {lc : filter γ} (g : γ → α) (hg : tendsto g lc l) :
  germ lc β :=
f.comp_tendsto' _ hg.germ_tendsto

@[simp] lemma coe_comp_tendsto (f : α → β) {lc : filter γ} {g : γ → α} (hg : tendsto g lc l) :
  (f : germ l β).comp_tendsto g hg = f ∘ g :=
rfl

@[simp] lemma comp_tendsto'_coe (f : germ l β) {lc : filter γ} {g : γ → α} (hg : tendsto g lc l) :
  f.comp_tendsto' _ hg.germ_tendsto = f.comp_tendsto g hg :=
rfl

@[simp, norm_cast] lemma const_inj [ne_bot l] {a b : β} : (↑a : germ l β) = ↑b ↔ a = b :=
coe_eq.trans $ const_eventually_eq

@[simp] lemma map_const (l : filter α) (a : β) (f : β → γ) :
  (↑a : germ l β).map f = ↑(f a) :=
rfl

@[simp] lemma map₂_const (l : filter α) (b : β) (c : γ) (f : β → γ → δ) :
  map₂ f (↑b : germ l β) ↑c = ↑(f b c) :=
rfl

@[simp] lemma const_comp_tendsto {l : filter α} (b : β) {lc : filter γ} {g : γ → α}
  (hg : tendsto g lc l) :
  (↑b : germ l β).comp_tendsto g hg = ↑b :=
rfl

@[simp] lemma const_comp_tendsto' {l : filter α} (b : β) {lc : filter γ} {g : germ lc α}
  (hg : g.tendsto l) :
  (↑b : germ l β).comp_tendsto' g hg = ↑b :=
induction_on g (λ _ _, rfl) hg

/-- Lift a predicate on `β` to `germ l β`. -/
def lift_pred (p : β → Prop) (f : germ l β) : Prop :=
lift_on f (λ f, ∀ᶠ x in l, p (f x)) $
λ f g H, propext $ eventually_congr $ H.mono $ λ x hx, hx ▸ iff.rfl

@[simp] lemma lift_pred_coe {p : β → Prop} {f : α → β} :
  lift_pred p (f : germ l β) ↔ ∀ᶠ x in l, p (f x) :=
iff.rfl

lemma lift_pred_const {p : β → Prop} {x : β} (hx : p x) :
  lift_pred p (↑x : germ l β) :=
eventually_of_forall $ λ y, hx

@[simp] lemma lift_pred_const_iff [ne_bot l] {p : β → Prop} {x : β} :
  lift_pred p (↑x : germ l β) ↔ p x :=
@eventually_const _ _ _ (p x)

/-- Lift a relation `r : β → γ → Prop` to `germ l β → germ l γ → Prop`. -/
def lift_rel (r : β → γ → Prop) (f : germ l β) (g : germ l γ) : Prop :=
quotient.lift_on₂' f g (λ f g, ∀ᶠ x in l, r (f x) (g x)) $
λ f g f' g' Hf Hg, propext $ eventually_congr $ Hg.mp $ Hf.mono $ λ x hf hg, hf ▸ hg ▸ iff.rfl

@[simp] lemma lift_rel_coe {r : β → γ → Prop} {f : α → β} {g : α → γ} :
  lift_rel r (f : germ l β) g ↔ ∀ᶠ x in l, r (f x) (g x) :=
iff.rfl

lemma lift_rel_const {r : β → γ → Prop} {x : β} {y : γ} (h : r x y) :
  lift_rel r (↑x : germ l β) ↑y :=
eventually_of_forall $ λ _, h

@[simp] lemma lift_rel_const_iff [ne_bot l] {r : β → γ → Prop} {x : β} {y : γ} :
  lift_rel r (↑x : germ l β) ↑y ↔ r x y :=
@eventually_const _ _ _ (r x y)

instance [inhabited β] : inhabited (germ l β) := ⟨↑(default : β)⟩

section monoid

variables {M : Type*} {G : Type*}

@[to_additive]
instance [has_mul M] : has_mul (germ l M) := ⟨map₂ (*)⟩

@[simp, norm_cast, to_additive]
lemma coe_mul [has_mul M] (f g : α → M) : ↑(f * g) = (f * g : germ l M) := rfl

@[to_additive]
instance [has_one M] : has_one (germ l M) := ⟨↑(1:M)⟩

@[simp, norm_cast, to_additive]
lemma coe_one [has_one M] : ↑(1 : α → M) = (1 : germ l M) := rfl

@[to_additive]
instance [semigroup M] : semigroup (germ l M) :=
function.surjective.semigroup coe (surjective_quot_mk _) (λ a b, coe_mul a b)

@[to_additive]
instance [comm_semigroup M] : comm_semigroup (germ l M) :=
function.surjective.comm_semigroup coe (surjective_quot_mk _) (λ a b, coe_mul a b)

@[to_additive add_left_cancel_semigroup]
instance [left_cancel_semigroup M] : left_cancel_semigroup (germ l M) :=
{ mul := (*),
  mul_left_cancel := λ f₁ f₂ f₃, induction_on₃ f₁ f₂ f₃ $ λ f₁ f₂ f₃ H,
    coe_eq.2 ((coe_eq.1 H).mono $ λ x, mul_left_cancel),
  .. germ.semigroup }

@[to_additive add_right_cancel_semigroup]
instance [right_cancel_semigroup M] : right_cancel_semigroup (germ l M) :=
{ mul := (*),
  mul_right_cancel := λ f₁ f₂ f₃, induction_on₃ f₁ f₂ f₃ $ λ f₁ f₂ f₃ H,
    coe_eq.2 $ (coe_eq.1 H).mono $ λ x, mul_right_cancel,
  .. germ.semigroup }

instance [has_vadd M G] : has_vadd M (germ l G) := ⟨λ n, map ((+ᵥ) n)⟩
@[to_additive] instance [has_smul M G] : has_smul M (germ l G) := ⟨λ n, map ((•) n)⟩
@[to_additive has_smul] instance [has_pow G M] : has_pow (germ l G) M := ⟨λ f n, map (^ n) f⟩

@[simp, norm_cast, to_additive]
lemma coe_smul [has_smul M G] (n : M) (f : α → G) : ↑(n • f) = (n • f : germ l G) := rfl

@[simp, norm_cast, to_additive]
lemma const_smul [has_smul M G] (n : M) (a : G) : (↑(n • a) : germ l G) = n • ↑a := rfl

@[simp, norm_cast, to_additive coe_smul]
lemma coe_pow [has_pow G M] (f : α → G) (n : M) : ↑(f ^ n) = (f ^ n : germ l G) := rfl

@[simp, norm_cast, to_additive const_smul]
lemma const_pow [has_pow G M] (a : G) (n : M) : (↑(a ^ n) : germ l G) = ↑a ^ n := rfl

@[to_additive]
instance [monoid M] : monoid (germ l M) :=
function.surjective.monoid coe (surjective_quot_mk _) rfl (λ _ _, rfl) (λ _ _, rfl)

/-- Coercion from functions to germs as a monoid homomorphism. -/
@[to_additive "Coercion from functions to germs as an additive monoid homomorphism."]
def coe_mul_hom [monoid M] (l : filter α) : (α → M) →* germ l M := ⟨coe, rfl, λ f g, rfl⟩

@[simp, to_additive]
lemma coe_coe_mul_hom [monoid M] : (coe_mul_hom l : (α → M) → germ l M) = coe := rfl

@[to_additive]
instance [comm_monoid M] : comm_monoid (germ l M) :=
{ mul := (*),
  one := 1,
  .. germ.comm_semigroup, .. germ.monoid }

instance [add_monoid_with_one M] : add_monoid_with_one (germ l M) :=
{ nat_cast := λ n, ↑(n : M),
  nat_cast_zero := congr_arg coe nat.cast_zero,
  nat_cast_succ := λ n, congr_arg coe (nat.cast_succ _),
  .. germ.has_one, .. germ.add_monoid }

@[to_additive]
instance [has_inv G] : has_inv (germ l G) := ⟨map has_inv.inv⟩

@[simp, norm_cast, to_additive]
lemma coe_inv [has_inv G] (f : α → G) : ↑f⁻¹ = (f⁻¹ : germ l G) := rfl

@[simp, norm_cast, to_additive]
lemma const_inv [has_inv G] (a : G) : (↑a⁻¹ : germ l G) = (↑a)⁻¹ := rfl

@[to_additive]
instance [has_div M] : has_div (germ l M) := ⟨map₂ (/)⟩

@[simp, norm_cast, to_additive]
lemma coe_div [has_div M] (f g : α → M) : ↑(f / g) = (f / g : germ l M) := rfl

@[simp, norm_cast, to_additive]
lemma const_div [has_div M] (a b : M) : (↑(a / b) : germ l M) = ↑a / ↑b := rfl

@[to_additive sub_neg_monoid]
instance [div_inv_monoid G] : div_inv_monoid (germ l G) :=
function.surjective.div_inv_monoid coe (surjective_quot_mk _) rfl (λ _ _, rfl)
  (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

@[to_additive]
instance [group G] : group (germ l G) :=
{ mul := (*),
  one := 1,
  mul_left_inv := by { rintros ⟨f⟩, exact congr_arg (quot.mk _) (mul_left_inv f) },
  .. germ.div_inv_monoid }

@[to_additive]
instance [comm_group G] : comm_group (germ l G) :=
{ mul := (*),
  one := 1,
  inv := has_inv.inv,
  .. germ.group, .. germ.comm_monoid }

end monoid

section ring

variables {R : Type*}

instance nontrivial [nontrivial R] [ne_bot l] : nontrivial (germ l R) :=
let ⟨x, y, h⟩ := exists_pair_ne R in ⟨⟨↑x, ↑y, mt const_inj.1 h⟩⟩

instance [mul_zero_class R] : mul_zero_class (germ l R) :=
{ zero := 0,
  mul := (*),
  mul_zero := λ f, induction_on f $ λ f, by { norm_cast, rw [mul_zero] },
  zero_mul := λ f, induction_on f $ λ f, by { norm_cast, rw [zero_mul] } }

instance [distrib R] : distrib (germ l R) :=
{ mul := (*),
  add := (+),
  left_distrib := λ f g h, induction_on₃ f g h $ λ f g h, by { norm_cast, rw [left_distrib] },
  right_distrib := λ f g h, induction_on₃ f g h $ λ f g h, by { norm_cast, rw [right_distrib] } }

instance [semiring R] : semiring (germ l R) :=
{ .. germ.add_comm_monoid, .. germ.monoid, .. germ.distrib, .. germ.mul_zero_class,
  .. germ.add_monoid_with_one }

/-- Coercion `(α → R) → germ l R` as a `ring_hom`. -/
def coe_ring_hom [semiring R] (l : filter α) : (α → R) →+* germ l R :=
{ to_fun := coe, .. (coe_mul_hom l : _ →* germ l R), .. (coe_add_hom l : _ →+ germ l R) }

@[simp] lemma coe_coe_ring_hom [semiring R] : (coe_ring_hom l : (α → R) → germ l R) = coe := rfl

instance [ring R] : ring (germ l R) :=
{ .. germ.add_comm_group, .. germ.semiring }

instance [comm_semiring R] : comm_semiring (germ l R) :=
{ .. germ.semiring, .. germ.comm_monoid }

instance [comm_ring R] : comm_ring (germ l R) :=
{ .. germ.ring, .. germ.comm_monoid }

end ring

section module

variables {M N R : Type*}

@[to_additive]
instance has_smul' [has_smul M β] : has_smul (germ l M) (germ l β) := ⟨map₂ (•)⟩

@[simp, norm_cast, to_additive] lemma coe_smul' [has_smul M β] (c : α → M) (f : α → β) :
  ↑(c • f) = (c : germ l M) • (f : germ l β) :=
rfl

@[to_additive]
instance [monoid M] [mul_action M β] : mul_action M (germ l β) :=
{ one_smul := λ f, induction_on f $ λ f, by { norm_cast, simp only [one_smul] },
  mul_smul := λ c₁ c₂ f, induction_on f $ λ f, by { norm_cast, simp only [mul_smul] } }

@[to_additive]
instance mul_action' [monoid M] [mul_action M β] : mul_action (germ l M) (germ l β) :=
{ one_smul := λ f, induction_on f $ λ f, by simp only [← coe_one, ← coe_smul', one_smul],
  mul_smul := λ c₁ c₂ f, induction_on₃ c₁ c₂ f $ λ c₁ c₂ f, by { norm_cast, simp only [mul_smul] } }

instance [monoid M] [add_monoid N] [distrib_mul_action M N] :
  distrib_mul_action M (germ l N) :=
{ smul_add := λ c f g, induction_on₂ f g $ λ f g, by { norm_cast, simp only [smul_add] },
  smul_zero := λ c, by simp only [← coe_zero, ← coe_smul, smul_zero] }

instance distrib_mul_action' [monoid M] [add_monoid N] [distrib_mul_action M N] :
  distrib_mul_action (germ l M) (germ l N) :=
{ smul_add := λ c f g, induction_on₃ c f g $ λ c f g, by { norm_cast, simp only [smul_add] },
  smul_zero := λ c, induction_on c $ λ c, by simp only [← coe_zero, ← coe_smul', smul_zero] }

instance [semiring R] [add_comm_monoid M] [module R M] :
  module R (germ l M) :=
{ add_smul := λ c₁ c₂ f, induction_on f $ λ f, by { norm_cast, simp only [add_smul] },
  zero_smul := λ f, induction_on f $ λ f, by { norm_cast, simp only [zero_smul, coe_zero] } }

instance module' [semiring R] [add_comm_monoid M] [module R M] :
  module (germ l R) (germ l M) :=
{ add_smul := λ c₁ c₂ f, induction_on₃ c₁ c₂ f $ λ c₁ c₂ f, by { norm_cast, simp only [add_smul] },
  zero_smul := λ f, induction_on f $ λ f, by simp only [← coe_zero, ← coe_smul', zero_smul] }

end module

instance [has_le β] : has_le (germ l β) := ⟨lift_rel (≤)⟩

lemma le_def [has_le β] : ((≤) : germ l β → germ l β → Prop) = lift_rel (≤) := rfl

@[simp] lemma coe_le [has_le β] : (f : germ l β) ≤ g ↔ f ≤ᶠ[l] g := iff.rfl

lemma coe_nonneg [has_le β] [has_zero β] {f : α → β} : 0 ≤ (f : germ l β) ↔ ∀ᶠ x in l, 0 ≤ f x :=
iff.rfl

lemma const_le [has_le β] {x y : β} : x ≤ y → (↑x : germ l β) ≤ ↑y := lift_rel_const

@[simp, norm_cast]
lemma const_le_iff [has_le β] [ne_bot l] {x y : β} : (↑x : germ l β) ≤ ↑y ↔ x ≤ y :=
lift_rel_const_iff

instance [preorder β] : preorder (germ l β) :=
{ le := (≤),
  le_refl := λ f, induction_on f $ eventually_le.refl l,
  le_trans := λ f₁ f₂ f₃, induction_on₃ f₁ f₂ f₃ $ λ f₁ f₂ f₃, eventually_le.trans }

instance [partial_order β] : partial_order (germ l β) :=
{ le := (≤),
  le_antisymm := λ f g, induction_on₂ f g $ λ f g h₁ h₂, (eventually_le.antisymm h₁ h₂).germ_eq,
  .. germ.preorder }

instance [has_bot β] : has_bot (germ l β) := ⟨↑(⊥ : β)⟩
instance [has_top β] : has_top (germ l β) := ⟨↑(⊤ : β)⟩

@[simp, norm_cast] lemma const_bot [has_bot β] : (↑(⊥ : β) : germ l β) = ⊥ := rfl
@[simp, norm_cast] lemma const_top [has_top β] : (↑(⊤ : β) : germ l β) = ⊤ := rfl

instance [has_le β] [order_bot β] : order_bot (germ l β) :=
{ bot := ⊥,
  bot_le := λ f, induction_on f $ λ f, eventually_of_forall $ λ x, bot_le }

instance [has_le β] [order_top β] : order_top (germ l β) :=
{ top := ⊤,
  le_top := λ f, induction_on f $ λ f, eventually_of_forall $ λ x, le_top }

instance [has_le β] [bounded_order β] : bounded_order (germ l β) :=
{ ..germ.order_bot, ..germ.order_top }

end germ

end filter


import topology.instances.ereal
import topology.instances.ennreal

/- This file contains some lemma regarding the type `ereal` though its mostly
unused in this project. -/

noncomputable theory
open_locale classical big_operators ennreal

namespace ereal

variables {α β : Type*}

def of_real_hom : ℝ →+ ereal :=
{ to_fun := coe,
  map_zero' := rfl,
  map_add' := λ _ _, rfl }

@[simp] lemma coe_of_real_hom : ⇑of_real_hom = coe := rfl

@[simp, norm_cast] lemma coe_finset_sum {s : finset α} {f : α → ℝ} :
  ↑(∑ a in s, f a) = (∑ a in s, f a : ereal) :=
of_real_hom.map_sum f s

lemma finset_sum_eq_top_of_eq_top {f : α → ereal} {a : α} (hf : f a = ⊤)
  {s : finset α} (hs : a ∈ s) : ∑ x in s, f x = ⊤ :=
begin
  apply @finset.case_strong_induction_on _ _
    (λ s : finset α, a ∈ s → ∑ x in s, f x = ⊤),
  { intro h, exact false.elim (finset.not_mem_empty _ h) },
  { intros b s hb h hab,
    rw finset.sum_insert hb,
    cases finset.mem_insert.1 hab with heq hmem,
    { subst heq,
      rw [hf, top_add] },
    { rw h s (finset.subset.refl s) hmem,
      rw add_top } },
  { exact hs }
end

lemma ereal.eq_neg_iff {a b : ereal} (ha : a ≠ ⊤) (h : a + b = 0) : a = -b :=
begin
  revert h,
  rcases b.cases with rfl | ⟨b, rfl⟩ | rfl,
  { rw neg_bot,
    rcases a.cases with rfl | ⟨a, rfl⟩ | rfl; norm_num },
  { rcases a.cases with rfl | ⟨a, rfl⟩ | rfl,
    { norm_num },
    { rw [← coe_add, ← coe_zero, ereal.coe_eq_coe_iff,
          add_eq_zero_iff_eq_neg],
      rintro rfl,
      exact coe_neg _ },
    { norm_num } },
  { norm_num }
end

section tsum

variables {f g : α → ereal} {r : ℝ}

@[norm_cast] lemma has_sum_coe {f : α → ℝ} {r : ℝ} :
  has_sum (λ a, (f a : ereal)) r ↔ has_sum f r :=
begin
  have : (λ s : finset α, ∑ a in s, ↑(f a)) = (coe : ℝ → ereal) ∘ (λ s : finset α, ∑ a in s, f a),
    ext, simp,
  rw [has_sum, has_sum, this, tendsto_coe]
end

lemma tsum_coe_eq {f : α → ℝ} (h : has_sum f r) : ∑'a, (f a : ereal) = r :=
(has_sum_coe.2 h).tsum_eq

lemma coe_tsum {f : α → ℝ} (hf : summable f) :
  ↑(∑' a, f a) = ∑' a, (f a : ereal) :=
begin
  obtain ⟨_, hr⟩ := hf,
  rw [hr.tsum_eq, ereal.tsum_coe_eq hr]
end

lemma has_sum_top_of_eq_top (hf : ∃ a, f a = ⊤) :
  has_sum f ⊤ :=
begin
  obtain ⟨a, ha⟩ := hf,
  apply tendsto_at_top_of_eventually_const,
  swap, exact ({a} : finset α),
  intros s hs,
  change _ ⊆ _ at hs,
  rw finset.singleton_subset_iff at hs,
  exact finset_sum_eq_top_of_eq_top ha hs,
end

lemma tsum_eq_top_of_eq_top (hf : ∃ a, f a = ⊤) : ∑' a, f a = ⊤ :=
(has_sum_top_of_eq_top hf).tsum_eq

@[simp] protected lemma tsum_top [nonempty α] : ∑' a : α, (⊤ : ereal) = ⊤ :=
let ⟨a⟩ := ‹nonempty α› in tsum_eq_top_of_eq_top ⟨a, rfl⟩

lemma tsum_of_neq_top_or_bot (hf : ∀ a, f a ≠ ⊤ ∧ f a ≠ ⊥) :
  (∑' a, (f a).to_real : ereal) = ∑' a, f a :=
tsum_congr $ λ b, (coe_to_real (hf b).1 (hf b).2)

lemma summable_to_real (hf : summable f)
  (hf' : ∀ a, f a ≠ ⊤ ∧ f a ≠ ⊥) :
  summable (to_real ∘ f) :=
begin
  sorry
end

lemma tsum_add (hf : summable f) (hg : summable g)
  (h₁ : ∀ a, f a ≠ ⊤ ∧ f a ≠ ⊥) (h₂ : ∀ a, g a ≠ ⊤ ∧ g a ≠ ⊥) :
  ∑' a, (f a + g a) = (∑' a, f a) + (∑' a, g a) :=
begin
  rw [(tsum_of_neq_top_or_bot h₁).symm, (tsum_of_neq_top_or_bot h₂).symm,
      ← coe_tsum, ← coe_tsum, ← coe_add, ← tsum_add, coe_tsum],
  apply tsum_congr,
  intro, simp [coe_to_real (h₁ b).1 (h₁ b).2, coe_to_real (h₂ b).1 (h₂ b).2],
  exact summable.add (summable_to_real hf h₁) (summable_to_real hg h₂),
  all_goals { exact summable_to_real hf h₁ <|> exact summable_to_real hg h₂ },
end

#exit

protected lemma tsum_le_tsum (h : ∀a, f a ≤ g a) : ∑'a, f a ≤ ∑'a, g a :=
tsum_le_tsum h ennreal.summable ennreal.summable

protected lemma sum_le_tsum {f : α → ℝ≥0∞} (s : finset α) : ∑ x in s, f x ≤ ∑' x, f x :=
sum_le_tsum s (λ x hx, zero_le _) ennreal.summable

protected lemma tsum_eq_supr_nat' {f : ℕ → ℝ≥0∞} {N : ℕ → ℕ} (hN : tendsto N at_top at_top) :
  ∑'i:ℕ, f i = (⨆i:ℕ, ∑ a in finset.range (N i), f a) :=
ennreal.tsum_eq_supr_sum' _ $ λ t,
  let ⟨n, hn⟩    := t.exists_nat_subset_range,
      ⟨k, _, hk⟩ := exists_le_of_tendsto_at_top hN 0 n in
  ⟨k, finset.subset.trans hn (finset.range_mono hk)⟩

protected lemma tsum_eq_supr_nat {f : ℕ → ℝ≥0∞} :
  ∑'i:ℕ, f i = (⨆i:ℕ, ∑ a in finset.range i, f a) :=
ennreal.tsum_eq_supr_sum' _ finset.exists_nat_subset_range

protected lemma tsum_eq_liminf_sum_nat {f : ℕ → ℝ≥0∞} :
  ∑' i, f i = filter.at_top.liminf (λ n, ∑ i in finset.range n, f i) :=
begin
  rw [ennreal.tsum_eq_supr_nat, filter.liminf_eq_supr_infi_of_nat],
  congr,
  refine funext (λ n, le_antisymm _ _),
  { refine le_binfi (λ i hi, finset.sum_le_sum_of_subset_of_nonneg _ (λ _ _ _, zero_le _)),
    simpa only [finset.range_subset, add_le_add_iff_right] using hi, },
  { refine le_trans (infi_le _ n) _,
    simp [le_refl n, le_refl ((finset.range n).sum f)], },
end

protected lemma le_tsum (a : α) : f a ≤ ∑'a, f a :=
le_tsum' ennreal.summable a

protected lemma ne_top_of_tsum_ne_top (h : ∑' a, f a ≠ ∞) (a : α) : f a ≠ ∞ :=
λ ha, h $ ennreal.tsum_eq_top_of_eq_top ⟨a, ha⟩

protected lemma tsum_mul_left : ∑'i, a * f i = a * ∑'i, f i :=
if h : ∀i, f i = 0 then by simp [h] else
let ⟨i, (hi : f i ≠ 0)⟩ := not_forall.mp h in
have sum_ne_0 : ∑'i, f i ≠ 0, from ne_of_gt $
  calc 0 < f i : lt_of_le_of_ne (zero_le _) hi.symm
    ... ≤ ∑'i, f i : ennreal.le_tsum _,
have tendsto (λs:finset α, ∑ j in s, a * f j) at_top (𝓝 (a * ∑'i, f i)),
  by rw [← show (*) a ∘ (λs:finset α, ∑ j in s, f j) = λs, ∑ j in s, a * f j,
         from funext $ λ s, finset.mul_sum];
  exact ennreal.tendsto.const_mul ennreal.summable.has_sum (or.inl sum_ne_0),
has_sum.tsum_eq this

protected lemma tsum_mul_right : (∑'i, f i * a) = (∑'i, f i) * a :=
by simp [mul_comm, ennreal.tsum_mul_left]

@[simp] lemma tsum_supr_eq {α : Type*} (a : α) {f : α → ℝ≥0∞} :
  ∑'b:α, (⨆ (h : a = b), f b) = f a :=
le_antisymm
  (by rw [ennreal.tsum_eq_supr_sum]; exact supr_le (assume s,
    calc (∑ b in s, ⨆ (h : a = b), f b) ≤ ∑ b in {a}, ⨆ (h : a = b), f b :
        finset.sum_le_sum_of_ne_zero $ assume b _ hb,
          suffices a = b, by simpa using this.symm,
          classical.by_contradiction $ assume h,
            by simpa [h] using hb
      ... = f a : by simp))
  (calc f a ≤ (⨆ (h : a = a), f a) : le_supr (λh:a=a, f a) rfl
    ... ≤ (∑'b:α, ⨆ (h : a = b), f b) : ennreal.le_tsum _)

lemma has_sum_iff_tendsto_nat {f : ℕ → ℝ≥0∞} (r : ℝ≥0∞) :
  has_sum f r ↔ tendsto (λn:ℕ, ∑ i in finset.range n, f i) at_top (𝓝 r) :=
begin
  refine ⟨has_sum.tendsto_sum_nat, assume h, _⟩,
  rw [← supr_eq_of_tendsto _ h, ← ennreal.tsum_eq_supr_nat],
  { exact ennreal.summable.has_sum },
  { exact assume s t hst, finset.sum_le_sum_of_subset (finset.range_subset.2 hst) }
end

lemma tendsto_nat_tsum (f : ℕ → ℝ≥0∞) :
  tendsto (λn:ℕ, ∑ i in finset.range n, f i) at_top (𝓝 (∑' n, f n)) :=
by { rw ← has_sum_iff_tendsto_nat, exact ennreal.summable.has_sum }

lemma to_nnreal_apply_of_tsum_ne_top {α : Type*} {f : α → ℝ≥0∞} (hf : ∑' i, f i ≠ ∞) (x : α) :
  (((ennreal.to_nnreal ∘ f) x : ℝ≥0) : ℝ≥0∞) = f x :=
coe_to_nnreal $ ennreal.ne_top_of_tsum_ne_top hf _

lemma summable_to_nnreal_of_tsum_ne_top {α : Type*} {f : α → ℝ≥0∞} (hf : ∑' i, f i ≠ ∞) :
  summable (ennreal.to_nnreal ∘ f) :=
by simpa only [←tsum_coe_ne_top_iff_summable, to_nnreal_apply_of_tsum_ne_top hf] using hf

lemma tendsto_cofinite_zero_of_tsum_lt_top {α} {f : α → ℝ≥0∞} (hf : ∑' x, f x < ∞) :
  tendsto f cofinite (𝓝 0) :=
begin
  have f_ne_top : ∀ n, f n ≠ ∞, from ennreal.ne_top_of_tsum_ne_top hf.ne,
  have h_f_coe : f = λ n, ((f n).to_nnreal : ennreal),
    from funext (λ n, (coe_to_nnreal (f_ne_top n)).symm),
  rw [h_f_coe, ←@coe_zero, tendsto_coe],
  exact nnreal.tendsto_cofinite_zero_of_summable (summable_to_nnreal_of_tsum_ne_top hf.ne),
end

lemma tendsto_at_top_zero_of_tsum_lt_top {f : ℕ → ℝ≥0∞} (hf : ∑' x, f x < ∞) :
  tendsto f at_top (𝓝 0) :=
by { rw ←nat.cofinite_eq_at_top, exact tendsto_cofinite_zero_of_tsum_lt_top hf }

protected lemma tsum_apply {ι α : Type*} {f : ι → α → ℝ≥0∞} {x : α} :
  (∑' i, f i) x = ∑' i, f i x :=
tsum_apply $ pi.summable.mpr $ λ _, ennreal.summable

lemma tsum_sub {f : ℕ → ℝ≥0∞} {g : ℕ → ℝ≥0∞} (h₁ : ∑' i, g i < ∞) (h₂ : g ≤ f) :
  ∑' i, (f i - g i) = (∑' i, f i) - (∑' i, g i) :=
begin
  have h₃: ∑' i, (f i - g i) = ∑' i, (f i - g i + g i) - ∑' i, g i,
  { rw [ennreal.tsum_add, add_sub_self h₁]},
  have h₄:(λ i, (f i - g i) + (g i)) = f,
  { ext n, rw ennreal.sub_add_cancel_of_le (h₂ n)},
  rw h₄ at h₃, apply h₃,
end

end tsum

lemma ereal.coe_tsum_eq_tsum_coe (f : ℕ → ℝ≥0∞) :
  (↑(∑' i, f i) : ereal) = ∑' i, f i :=
begin
  sorry
end

lemma ereal.eq_neg_iff {a b : ereal} (ha : a ≠ ⊤) (h : a + b = 0) : a = -b :=
begin
  revert h,
  rcases b.cases with rfl | ⟨b, rfl⟩ | rfl,
  { rw neg_bot,
    rcases a.cases with rfl | ⟨a, rfl⟩ | rfl; norm_num },
  { rcases a.cases with rfl | ⟨a, rfl⟩ | rfl,
    { norm_num },
    { rw [← coe_add, ← coe_zero, ereal.coe_eq_coe_iff,
          add_eq_zero_iff_eq_neg],
      rintro rfl,
      exact coe_neg _ },
    { norm_num } },
  { norm_num }
end

-- lemma ereal.tsum_neg (f : ℕ → ereal) : - ∑' i, f i = ∑' i, - f i :=
-- begin
--   by_cases summable f,
--   { --have := summable_neg_iff h,
--     by_cases hsum : ∑' (i : ℕ), -f i = ⊤,
--     { sorry

--     },
--     { suffices : ∑' (i : ℕ), -f i + ∑' (i : ℕ), f i = 0,
--         symmetry,
--         apply ereal.eq_neg_iff hsum this,
--       rw ← tsum_add,

--        },
--   },
-- end

end ereal


import data.real.basic

def dollar (x y : ℝ) := x*y - x + y

infix `$` : 50 := dollar

theorem osk2002_7 {x y : ℝ} : (x+y) $ (x-y) = x^2 - y^2 - 2 * y :=
begin
  rw dollar,
  ring,
end


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module logic.relation
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Relator
import Mathlib.Init.Propext
import Mathlib.Tactic.Relation.Rfl
import Mathlib.Tactic.Use
import Mathlib.Init.Data.Quot
import Mathlib.Tactic.MkIffOfInductiveProp

/-!
# Relation closures

This file defines the reflexive, transitive, and reflexive transitive closures of relations.
It also proves some basic results on definitions such as `EqvGen`.

Note that this is about unbundled relations, that is terms of types of the form `α → β → Prop`. For
the bundled version, see `Rel`.

## Definitions

* `Relation.ReflGen`: Reflexive closure. `ReflGen r` relates everything `r` related, plus for all
  `a` it relates `a` with itself. So `ReflGen r a b ↔ r a b ∨ a = b`.
* `Relation.TransGen`: Transitive closure. `TransGen r` relates everything `r` related
  transitively. So `TransGen r a b ↔ ∃ x₀ ... xₙ, r a x₀ ∧ r x₀ x₁ ∧ ... ∧ r xₙ b`.
* `Relation.ReflTransGen`: Reflexive transitive closure. `ReflTransGen r` relates everything
  `r` related transitively, plus for all `a` it relates `a` with itself. So
  `ReflTransGen r a b ↔ (∃ x₀ ... xₙ, r a x₀ ∧ r x₀ x₁ ∧ ... ∧ r xₙ b) ∨ a = b`. It is the same as
  the reflexive closure of the transitive closure, or the transitive closure of the reflexive
  closure. In terms of rewriting systems, this means that `a` can be rewritten to `b` in a number of
  rewrites.
* `Relation.Comp`:  Relation composition. We provide notation `∘r`. For `r : α → β → Prop` and
  `s : β → γ → Prop`, `r ∘r s`relates `a : α` and `c : γ` iff there exists `b : β` that's related to
  both.
* `Relation.Map`: Image of a relation under a pair of maps. For `r : α → β → Prop`, `f : α → γ`,
  `g : β → δ`, `Map r f g` is the relation `γ → δ → Prop` relating `f a` and `g b` for all `a`, `b`
  related by `r`.
* `Relation.Join`: Join of a relation. For `r : α → α → Prop`, `Join r a b ↔ ∃ c, r a c ∧ r b c`. In
  terms of rewriting systems, this means that `a` and `b` can be rewritten to the same term.
-/

open Function

variable {α β γ δ : Type _}

section NeImp

variable {r : α → α → Prop}

theorem IsRefl.reflexive [IsRefl α r] : Reflexive r := fun x ↦ IsRefl.refl x
#align is_refl.reflexive IsRefl.reflexive

/-- To show a reflexive relation `r : α → α → Prop` holds over `x y : α`,
it suffices to show it holds when `x ≠ y`. -/
theorem Reflexive.rel_of_ne_imp (h : Reflexive r) {x y : α} (hr : x ≠ y → r x y) : r x y := by
  by_cases hxy : x = y
  · exact hxy ▸ h x
  · exact hr hxy
#align reflexive.rel_of_ne_imp Reflexive.rel_of_ne_imp

/-- If a reflexive relation `r : α → α → Prop` holds over `x y : α`,
then it holds whether or not `x ≠ y`. -/
theorem Reflexive.ne_imp_iff (h : Reflexive r) {x y : α} : x ≠ y → r x y ↔ r x y :=
  ⟨h.rel_of_ne_imp, fun hr _ ↦ hr⟩
#align reflexive.ne_imp_iff Reflexive.ne_imp_iff

/-- If a reflexive relation `r : α → α → Prop` holds over `x y : α`,
then it holds whether or not `x ≠ y`. Unlike `Reflexive.ne_imp_iff`, this uses `[IsRefl α r]`. -/
theorem reflexive_ne_imp_iff [IsRefl α r] {x y : α} : x ≠ y → r x y ↔ r x y :=
  IsRefl.reflexive.ne_imp_iff
#align reflexive_ne_imp_iff reflexive_ne_imp_iff

protected theorem Symmetric.iff (H : Symmetric r) (x y : α) : r x y ↔ r y x :=
  ⟨fun h ↦ H h, fun h ↦ H h⟩
#align symmetric.iff Symmetric.iff

theorem Symmetric.flip_eq (h : Symmetric r) : flip r = r :=
  funext₂ fun _ _ ↦ propext <| h.iff _ _
#align symmetric.flip_eq Symmetric.flip_eq

theorem Symmetric.swap_eq : Symmetric r → swap r = r :=
  Symmetric.flip_eq
#align symmetric.swap_eq Symmetric.swap_eq

theorem flip_eq_iff : flip r = r ↔ Symmetric r :=
  ⟨fun h _ _ ↦ (congr_fun₂ h _ _).mp, Symmetric.flip_eq⟩
#align flip_eq_iff flip_eq_iff

theorem swap_eq_iff : swap r = r ↔ Symmetric r :=
  flip_eq_iff
#align swap_eq_iff swap_eq_iff

end NeImp

section Comap

variable {r : β → β → Prop}

theorem Reflexive.comap (h : Reflexive r) (f : α → β) : Reflexive (r on f) := fun a ↦ h (f a)
#align reflexive.comap Reflexive.comap

theorem Symmetric.comap (h : Symmetric r) (f : α → β) : Symmetric (r on f) := fun _ _ hab ↦ h hab
#align symmetric.comap Symmetric.comap

theorem Transitive.comap (h : Transitive r) (f : α → β) : Transitive (r on f) :=
  fun _ _ _ hab hbc ↦ h hab hbc
#align transitive.comap Transitive.comap

theorem Equivalence.comap (h : Equivalence r) (f : α → β) : Equivalence (r on f) :=
  ⟨h.reflexive.comap f, @(h.symmetric.comap f), @(h.transitive.comap f)⟩
#align equivalence.comap Equivalence.comap

end Comap

namespace Relation

section Comp

variable {r : α → β → Prop} {p : β → γ → Prop} {q : γ → δ → Prop}

/-- The composition of two relations, yielding a new relation.  The result
relates a term of `α` and a term of `γ` if there is an intermediate
term of `β` related to both.
-/
def Comp (r : α → β → Prop) (p : β → γ → Prop) (a : α) (c : γ) : Prop :=
  ∃ b, r a b ∧ p b c
#align relation.comp Relation.Comp

@[inherit_doc]
local infixr:80 " ∘r " => Relation.Comp

theorem eq_comp : (· = ·) ∘r r = r :=
  funext fun a ↦ funext fun _ ↦ propext <|
  Iff.intro (fun ⟨_, Eq, h⟩ ↦ Eq.symm ▸ h) fun h ↦ ⟨a, rfl, h⟩
#align relation.eq_comp Relation.eq_comp

theorem iff_comp {r : Prop → α → Prop} : (· ↔ ·) ∘r r = r := by
  have : (· ↔ ·) = (· = ·) := by funext a b; exact iff_eq_eq
  rw [this, eq_comp]
#align relation.iff_comp Relation.iff_comp

theorem comp_iff {r : α → Prop → Prop} : r ∘r (· ↔ ·) = r := by
  have : (· ↔ ·) = (· = ·) := by funext a b; exact iff_eq_eq
  rw [this, comp_eq]
#align relation.comp_iff Relation.comp_iff

theorem comp_assoc : (r ∘r p) ∘r q = r ∘r p ∘r q := by
  funext a d
  apply propext
  constructor
  exact fun ⟨c, ⟨b, hab, hbc⟩, hcd⟩ ↦ ⟨b, hab, c, hbc, hcd⟩
  exact fun ⟨b, hab, c, hbc, hcd⟩ ↦ ⟨c, ⟨b, hab, hbc⟩, hcd⟩
#align relation.comp_assoc Relation.comp_assoc

theorem flip_comp : flip (r ∘r p) = flip p ∘r flip r := by
  funext c a
  apply propext
  constructor
  exact fun ⟨b, hab, hbc⟩ ↦ ⟨b, hbc, hab⟩
  exact fun ⟨b, hbc, hab⟩ ↦ ⟨b, hab, hbc⟩
#align relation.flip_comp Relation.flip_comp

end Comp

section Fibration

variable (rα : α → α → Prop) (rβ : β → β → Prop) (f : α → β)

/-- A function `f : α → β` is a fibration between the relation `rα` and `rβ` if for all
  `a : α` and `b : β`, whenever `b : β` and `f a` are related by `rβ`, `b` is the image
  of some `a' : α` under `f`, and `a'` and `a` are related by `rα`. -/
def Fibration :=
  ∀ ⦃a b⦄, rβ b (f a) → ∃ a', rα a' a ∧ f a' = b
#align relation.fibration Relation.Fibration

variable {rα rβ}

/-- If `f : α → β` is a fibration between relations `rα` and `rβ`, and `a : α` is
  accessible under `rα`, then `f a` is accessible under `rβ`. -/
theorem _root_.Acc.of_fibration (fib : Fibration rα rβ f) {a} (ha : Acc rα a) : Acc rβ (f a) := by
  induction' ha with a _ ih
  refine' Acc.intro (f a) fun b hr ↦ _
  obtain ⟨a', hr', rfl⟩ := fib hr
  exact ih a' hr'
#align acc.of_fibration Acc.of_fibration

theorem _root_.Acc.of_downward_closed (dc : ∀ {a b}, rβ b (f a) → ∃ c, f c = b) (a : α)
    (ha : Acc (InvImage rβ f) a) : Acc rβ (f a) :=
  ha.of_fibration f fun a _ h ↦
    let ⟨a', he⟩ := dc h
    -- porting note: Lean 3 did not need the motive
    ⟨a', he.substr (p := λ x => rβ x (f a)) h, he⟩
#align acc.of_downward_closed Acc.of_downward_closed

end Fibration

/-- The map of a relation `r` through a pair of functions pushes the
relation to the codomains of the functions.  The resulting relation is
defined by having pairs of terms related if they have preimages
related by `r`.
-/
protected def Map (r : α → β → Prop) (f : α → γ) (g : β → δ) : γ → δ → Prop := fun c d ↦
  ∃ a b, r a b ∧ f a = c ∧ g b = d
#align relation.map Relation.Map

variable {r : α → α → Prop} {a b c d : α}

/-- `ReflTransGen r`: reflexive transitive closure of `r` -/
@[mk_iff ReflTransGen.cases_tail_iff]
inductive ReflTransGen (r : α → α → Prop) (a : α) : α → Prop
  | refl : ReflTransGen r a a
  | tail {b c} : ReflTransGen r a b → r b c → ReflTransGen r a c
#align relation.refl_trans_gen Relation.ReflTransGen
#align relation.refl_trans_gen.cases_tail_iff Relation.ReflTransGen.cases_tail_iff

attribute [refl] ReflTransGen.refl

/-- `ReflGen r`: reflexive closure of `r` -/
@[mk_iff reflGen_iff]
inductive ReflGen (r : α → α → Prop) (a : α) : α → Prop
  | refl : ReflGen r a a
  | single {b} : r a b → ReflGen r a b
#align relation.refl_gen Relation.ReflGen

#align relation.refl_gen_iff Relation.reflGen_iff

/-- `TransGen r`: transitive closure of `r` -/
@[mk_iff transGen_iff]
inductive TransGen (r : α → α → Prop) (a : α) : α → Prop
  | single {b} : r a b → TransGen r a b
  | tail {b c} : TransGen r a b → r b c → TransGen r a c
#align relation.trans_gen Relation.TransGen

#align relation.trans_gen_iff Relation.transGen_iff

attribute [refl] ReflGen.refl

namespace ReflGen

theorem to_reflTransGen : ∀ {a b}, ReflGen r a b → ReflTransGen r a b
  | a, _, refl => by rfl
  | a, b, single h => ReflTransGen.tail ReflTransGen.refl h
#align relation.refl_gen.to_refl_trans_gen Relation.ReflGen.to_reflTransGen

theorem mono {p : α → α → Prop} (hp : ∀ a b, r a b → p a b) : ∀ {a b}, ReflGen r a b → ReflGen p a b
  | a, _, ReflGen.refl => by rfl
  | a, b, single h => single (hp a b h)
#align relation.refl_gen.mono Relation.ReflGen.mono

instance : IsRefl α (ReflGen r) :=
  ⟨@refl α r⟩

end ReflGen

namespace ReflTransGen

@[trans]
theorem trans (hab : ReflTransGen r a b) (hbc : ReflTransGen r b c) : ReflTransGen r a c := by
  induction hbc
  case refl => assumption
  case tail c d _ hcd hac => exact hac.tail hcd
#align relation.refl_trans_gen.trans Relation.ReflTransGen.trans

theorem single (hab : r a b) : ReflTransGen r a b :=
  refl.tail hab
#align relation.refl_trans_gen.single Relation.ReflTransGen.single

theorem head (hab : r a b) (hbc : ReflTransGen r b c) : ReflTransGen r a c := by
  induction hbc
  case refl => exact refl.tail hab
  case tail c d _ hcd hac => exact hac.tail hcd
#align relation.refl_trans_gen.head Relation.ReflTransGen.head

theorem symmetric (h : Symmetric r) : Symmetric (ReflTransGen r) := by
  intro x y h
  induction' h with z w _ b c
  · rfl
  · apply Relation.ReflTransGen.head (h b) c
#align relation.refl_trans_gen.symmetric Relation.ReflTransGen.symmetric

theorem cases_tail : ReflTransGen r a b → b = a ∨ ∃ c, ReflTransGen r a c ∧ r c b :=
  (cases_tail_iff r a b).1
#align relation.refl_trans_gen.cases_tail Relation.ReflTransGen.cases_tail

@[elab_as_elim]
theorem head_induction_on {P : ∀ a : α, ReflTransGen r a b → Prop} {a : α} (h : ReflTransGen r a b)
    (refl : P b refl)
    (head : ∀ {a c} (h' : r a c) (h : ReflTransGen r c b), P c h → P a (h.head h')) : P a h := by
  induction h
  case refl => exact refl
  case tail b c _ hbc ih =>
  -- Porting note: Lean 3 figured out the motive and `apply ih` worked
  refine @ih (λ {a : α} (hab : ReflTransGen r a b) => P a (ReflTransGen.tail hab hbc)) ?_ ?_
  { exact head hbc _ refl }
  { exact fun h1 h2 ↦ head h1 (h2.tail hbc) }
#align relation.refl_trans_gen.head_induction_on Relation.ReflTransGen.head_induction_on

@[elab_as_elim]
theorem trans_induction_on {P : ∀ {a b : α}, ReflTransGen r a b → Prop} {a b : α}
    (h : ReflTransGen r a b) (ih₁ : ∀ a, @P a a refl) (ih₂ : ∀ {a b} (h : r a b), P (single h))
    (ih₃ : ∀ {a b c} (h₁ : ReflTransGen r a b) (h₂ : ReflTransGen r b c), P h₁ → P h₂ →
     P (h₁.trans h₂)) : P h := by
  induction h
  case refl => exact ih₁ a
  case tail b c hab hbc ih => exact ih₃ hab (single hbc) ih (ih₂ hbc)
#align relation.refl_trans_gen.trans_induction_on Relation.ReflTransGen.trans_induction_on

theorem cases_head (h : ReflTransGen r a b) : a = b ∨ ∃ c, r a c ∧ ReflTransGen r c b := by
  induction h using Relation.ReflTransGen.head_induction_on
  · left
    rfl
  · right
    exact ⟨_, by assumption, by assumption⟩;
#align relation.refl_trans_gen.cases_head Relation.ReflTransGen.cases_head

theorem cases_head_iff : ReflTransGen r a b ↔ a = b ∨ ∃ c, r a c ∧ ReflTransGen r c b := by
  use cases_head
  rintro (rfl | ⟨c, hac, hcb⟩)
  · rfl
  · exact head hac hcb
#align relation.refl_trans_gen.cases_head_iff Relation.ReflTransGen.cases_head_iff

theorem total_of_right_unique (U : Relator.RightUnique r) (ab : ReflTransGen r a b)
    (ac : ReflTransGen r a c) : ReflTransGen r b c ∨ ReflTransGen r c b := by
  induction' ab with b d _ bd IH
  · exact Or.inl ac
  · rcases IH with (IH | IH)
    · rcases cases_head IH with (rfl | ⟨e, be, ec⟩)
      · exact Or.inr (single bd)
      · cases U bd be
        exact Or.inl ec
    · exact Or.inr (IH.tail bd)
#align relation.refl_trans_gen.total_of_right_unique Relation.ReflTransGen.total_of_right_unique

end ReflTransGen

namespace TransGen

theorem to_reflTransGen {a b} (h : TransGen r a b) : ReflTransGen r a b := by
  induction' h with b h b c _ bc ab
  exact ReflTransGen.single h
  exact ReflTransGen.tail ab bc
-- porting note: in Lean 3 this function was called `to_refl` which seems wrong.
#align relation.trans_gen.to_refl Relation.TransGen.to_reflTransGen

theorem trans_left (hab : TransGen r a b) (hbc : ReflTransGen r b c) : TransGen r a c := by
  induction hbc
  case refl => assumption
  case tail c d _ hcd hac => exact hac.tail hcd
#align relation.trans_gen.trans_left Relation.TransGen.trans_left

instance : Trans (TransGen r) (ReflTransGen r) (TransGen r) :=
  ⟨trans_left⟩

@[trans]
theorem trans (hab : TransGen r a b) (hbc : TransGen r b c) : TransGen r a c :=
  trans_left hab hbc.to_reflTransGen
#align relation.trans_gen.trans Relation.TransGen.trans

instance : Trans (TransGen r) (TransGen r) (TransGen r) :=
  ⟨trans⟩

theorem head' (hab : r a b) (hbc : ReflTransGen r b c) : TransGen r a c :=
  trans_left (single hab) hbc
#align relation.trans_gen.head' Relation.TransGen.head'

theorem tail' (hab : ReflTransGen r a b) (hbc : r b c) : TransGen r a c := by
  induction hab generalizing c
  case refl => exact single hbc
  case tail _ _ _ hdb IH => exact tail (IH hdb) hbc
#align relation.trans_gen.tail' Relation.TransGen.tail'

theorem head (hab : r a b) (hbc : TransGen r b c) : TransGen r a c :=
  head' hab hbc.to_reflTransGen
#align relation.trans_gen.head Relation.TransGen.head

@[elab_as_elim]
theorem head_induction_on {P : ∀ a : α, TransGen r a b → Prop} {a : α} (h : TransGen r a b)
    (base : ∀ {a} (h : r a b), P a (single h))
    (ih : ∀ {a c} (h' : r a c) (h : TransGen r c b), P c h → P a (h.head h')) : P a h := by
  induction h
  case single a h => exact base h
  case tail b c _ hbc h_ih =>
  -- Lean 3 could figure out the motive and `apply h_ih` worked
  refine @h_ih (λ {a : α} (hab : @TransGen α r a b) => P a (TransGen.tail hab hbc)) ?_ ?_;
  exact fun h ↦ ih h (single hbc) (base hbc)
  exact fun hab hbc ↦ ih hab _
#align relation.trans_gen.head_induction_on Relation.TransGen.head_induction_on

@[elab_as_elim]
theorem trans_induction_on {P : ∀ {a b : α}, TransGen r a b → Prop} {a b : α} (h : TransGen r a b)
    (base : ∀ {a b} (h : r a b), P (single h))
    (ih : ∀ {a b c} (h₁ : TransGen r a b) (h₂ : TransGen r b c), P h₁ → P h₂ → P (h₁.trans h₂)) :
    P h := by
  induction h with
  | single h => exact base h
  | tail hab hbc h_ih => exact ih hab (single hbc) h_ih (base hbc)
#align relation.trans_gen.trans_induction_on Relation.TransGen.trans_induction_on

theorem trans_right (hab : ReflTransGen r a b) (hbc : TransGen r b c) : TransGen r a c := by
  induction hbc
  case single c hbc => exact tail' hab hbc
  case tail c d _ hcd hac => exact hac.tail hcd
#align relation.trans_gen.trans_right Relation.TransGen.trans_right

instance : Trans (ReflTransGen r) (TransGen r) (TransGen r) :=
  ⟨trans_right⟩

theorem tail'_iff : TransGen r a c ↔ ∃ b, ReflTransGen r a b ∧ r b c := by
  refine' ⟨fun h ↦ _, fun ⟨b, hab, hbc⟩ ↦ tail' hab hbc⟩
  cases' h with _ hac b _ hab hbc
  · exact ⟨_, by rfl, hac⟩
  · exact ⟨_, hab.to_reflTransGen, hbc⟩
#align relation.trans_gen.tail'_iff Relation.TransGen.tail'_iff

theorem head'_iff : TransGen r a c ↔ ∃ b, r a b ∧ ReflTransGen r b c := by
  refine' ⟨fun h ↦ _, fun ⟨b, hab, hbc⟩ ↦ head' hab hbc⟩
  induction h
  case single c hac => exact ⟨_, hac, by rfl⟩
  case tail b c _ hbc IH =>
  rcases IH with ⟨d, had, hdb⟩
  exact ⟨_, had, hdb.tail hbc⟩
#align relation.trans_gen.head'_iff Relation.TransGen.head'_iff

end TransGen

theorem _root_.Acc.TransGen (h : Acc r a) : Acc (TransGen r) a := by
  induction' h with x _ H
  refine' Acc.intro x fun y hy ↦ _
  cases' hy with _ hyx z _ hyz hzx
  exacts[H y hyx, (H z hzx).inv hyz]
#align acc.trans_gen Acc.TransGen

theorem _root_.acc_transGen_iff : Acc (TransGen r) a ↔ Acc r a :=
  ⟨Subrelation.accessible TransGen.single, Acc.TransGen⟩
#align acc_trans_gen_iff acc_transGen_iff

theorem _root_.WellFounded.transGen (h : WellFounded r) : WellFounded (TransGen r) :=
  ⟨fun a ↦ (h.apply a).TransGen⟩

#align well_founded.trans_gen WellFounded.transGen

section TransGen

theorem transGen_eq_self (trans : Transitive r) : TransGen r = r :=
  funext fun a ↦ funext fun b ↦ propext <|
    ⟨fun h ↦ by
      induction h
      case single _ hc => exact hc
      case tail c d _ hcd hac => exact trans hac hcd, TransGen.single⟩
#align relation.trans_gen_eq_self Relation.transGen_eq_self

theorem transitive_transGen : Transitive (TransGen r) := fun _ _ _ ↦ TransGen.trans
#align relation.transitive_trans_gen Relation.transitive_transGen

instance : IsTrans α (TransGen r) :=
  ⟨@TransGen.trans α r⟩

theorem transGen_idem : TransGen (TransGen r) = TransGen r :=
  transGen_eq_self transitive_transGen
#align relation.trans_gen_idem Relation.transGen_idem

theorem TransGen.lift {p : β → β → Prop} {a b : α} (f : α → β) (h : ∀ a b, r a b → p (f a) (f b))
    (hab : TransGen r a b) : TransGen p (f a) (f b) := by
  induction hab
  case single c hac => exact TransGen.single (h a c hac)
  case tail c d _ hcd hac => exact TransGen.tail hac (h c d hcd)
#align relation.trans_gen.lift Relation.TransGen.lift

theorem TransGen.lift' {p : β → β → Prop} {a b : α} (f : α → β)
    (h : ∀ a b, r a b → TransGen p (f a) (f b)) (hab : TransGen r a b) :
    TransGen p (f a) (f b) := by
simpa [transGen_idem] using hab.lift f h
#align relation.trans_gen.lift' Relation.TransGen.lift'

theorem TransGen.closed {p : α → α → Prop} :
    (∀ a b, r a b → TransGen p a b) → TransGen r a b → TransGen p a b :=
  TransGen.lift' id
#align relation.trans_gen.closed Relation.TransGen.closed

theorem TransGen.mono {p : α → α → Prop} :
    (∀ a b, r a b → p a b) → TransGen r a b → TransGen p a b :=
  TransGen.lift id
#align relation.trans_gen.mono Relation.TransGen.mono

theorem TransGen.swap (h : TransGen r b a) : TransGen (swap r) a b := by
  induction' h with b h b c _ hbc ih
  · exact TransGen.single h
  · exact ih.head hbc
#align relation.trans_gen.swap Relation.TransGen.swap

theorem transGen_swap : TransGen (swap r) a b ↔ TransGen r b a :=
  ⟨TransGen.swap, TransGen.swap⟩
#align relation.trans_gen_swap Relation.transGen_swap

end TransGen

section ReflTransGen

open ReflTransGen

theorem reflTransGen_iff_eq (h : ∀ b, ¬r a b) : ReflTransGen r a b ↔ b = a := by
  rw [cases_head_iff]; simp [h, eq_comm]
#align relation.refl_trans_gen_iff_eq Relation.reflTransGen_iff_eq

theorem reflTransGen_iff_eq_or_transGen : ReflTransGen r a b ↔ b = a ∨ TransGen r a b := by
  refine' ⟨fun h ↦ _, fun h ↦ _⟩
  · cases' h with c _ hac hcb
    · exact Or.inl rfl
    · exact Or.inr (TransGen.tail' hac hcb)
  · rcases h with (rfl | h)
    · rfl
    · exact h.to_reflTransGen
#align relation.refl_trans_gen_iff_eq_or_trans_gen Relation.reflTransGen_iff_eq_or_transGen

theorem ReflTransGen.lift {p : β → β → Prop} {a b : α} (f : α → β)
    (h : ∀ a b, r a b → p (f a) (f b)) (hab : ReflTransGen r a b) : ReflTransGen p (f a) (f b) :=
  ReflTransGen.trans_induction_on hab (fun _ ↦ refl) (ReflTransGen.single ∘ h _ _) fun _ _ ↦ trans
#align relation.refl_trans_gen.lift Relation.ReflTransGen.lift

theorem ReflTransGen.mono {p : α → α → Prop} : (∀ a b, r a b → p a b) →
    ReflTransGen r a b → ReflTransGen p a b :=
  ReflTransGen.lift id
#align relation.refl_trans_gen.mono Relation.ReflTransGen.mono

theorem reflTransGen_eq_self (refl : Reflexive r) (trans : Transitive r) : ReflTransGen r = r :=
  funext fun a ↦ funext fun b ↦ propext <|
    ⟨fun h ↦ by
      induction' h with b c _ h₂ IH
      · apply refl
      · exact trans IH h₂, single⟩
#align relation.refl_trans_gen_eq_self Relation.reflTransGen_eq_self

theorem reflexive_reflTransGen : Reflexive (ReflTransGen r) := fun _ ↦ refl
#align relation.reflexive_refl_trans_gen Relation.reflexive_reflTransGen

theorem transitive_reflTransGen : Transitive (ReflTransGen r) := fun _ _ _ ↦ trans
#align relation.transitive_refl_trans_gen Relation.transitive_reflTransGen

instance : IsRefl α (ReflTransGen r) :=
  ⟨@ReflTransGen.refl α r⟩

instance : IsTrans α (ReflTransGen r) :=
  ⟨@ReflTransGen.trans α r⟩

theorem refl_trans_gen_idem : ReflTransGen (ReflTransGen r) = ReflTransGen r :=
  reflTransGen_eq_self reflexive_reflTransGen transitive_reflTransGen
#align relation.refl_trans_gen_idem Relation.refl_trans_gen_idem

theorem ReflTransGen.lift' {p : β → β → Prop} {a b : α} (f : α → β)
    (h : ∀ a b, r a b → ReflTransGen p (f a) (f b))
    (hab : ReflTransGen r a b) : ReflTransGen p (f a) (f b) := by
  simpa [refl_trans_gen_idem] using hab.lift f h
#align relation.refl_trans_gen.lift' Relation.ReflTransGen.lift'

theorem reflTransGen_closed {p : α → α → Prop} :
    (∀ a b, r a b → ReflTransGen p a b) → ReflTransGen r a b → ReflTransGen p a b :=
  ReflTransGen.lift' id
#align relation.refl_trans_gen_closed Relation.reflTransGen_closed

theorem ReflTransGen.swap (h : ReflTransGen r b a) : ReflTransGen (swap r) a b := by
  induction' h with b c _ hbc ih
  · rfl
  · exact ih.head hbc
#align relation.refl_trans_gen.swap Relation.ReflTransGen.swap

theorem reflTransGen_swap : ReflTransGen (swap r) a b ↔ ReflTransGen r b a :=
  ⟨ReflTransGen.swap, ReflTransGen.swap⟩
#align relation.refl_trans_gen_swap Relation.reflTransGen_swap

end ReflTransGen

/-- The join of a relation on a single type is a new relation for which
pairs of terms are related if there is a third term they are both
related to.  For example, if `r` is a relation representing rewrites
in a term rewriting system, then *confluence* is the property that if
`a` rewrites to both `b` and `c`, then `join r` relates `b` and `c`
(see `relation.church_rosser`).
-/
def Join (r : α → α → Prop) : α → α → Prop := fun a b ↦ ∃ c, r a c ∧ r b c
#align relation.join Relation.Join

section Join

open ReflTransGen ReflGen

/-- A sufficient condition for the Church-Rosser property. -/
theorem church_rosser (h : ∀ a b c, r a b → r a c → ∃ d, ReflGen r b d ∧ ReflTransGen r c d)
    (hab : ReflTransGen r a b) (hac : ReflTransGen r a c) : Join (ReflTransGen r) b c := by
  induction hab
  case refl => exact ⟨c, hac, refl⟩
  case tail d e _ hde ih =>
  rcases ih with ⟨b, hdb, hcb⟩
  have : ∃ a, ReflTransGen r e a ∧ ReflGen r b a := by
    clear hcb
    induction hdb
    case refl => exact ⟨e, refl, ReflGen.single hde⟩
    case tail f b _ hfb ih =>
    rcases ih with ⟨a, hea, hfa⟩
    cases' hfa with _ hfa
    · exact ⟨b, hea.tail hfb, ReflGen.refl⟩
    · rcases h _ _ _ hfb hfa with ⟨c, hbc, hac⟩
      exact ⟨c, hea.trans hac, hbc⟩
  rcases this with ⟨a, hea, hba⟩
  cases' hba with _ hba
  · exact ⟨b, hea, hcb⟩
  · exact ⟨a, hea, hcb.tail hba⟩
#align relation.church_rosser Relation.church_rosser

theorem join_of_single (h : Reflexive r) (hab : r a b) : Join r a b :=
  ⟨b, hab, h b⟩
#align relation.join_of_single Relation.join_of_single

theorem symmetric_join : Symmetric (Join r) := fun _ _ ⟨c, hac, hcb⟩ ↦ ⟨c, hcb, hac⟩
#align relation.symmetric_join Relation.symmetric_join

theorem reflexive_join (h : Reflexive r) : Reflexive (Join r) := fun a ↦ ⟨a, h a, h a⟩
#align relation.reflexive_join Relation.reflexive_join

theorem transitive_join (ht : Transitive r) (h : ∀ a b c, r a b → r a c → Join r b c) :
    Transitive (Join r) :=
  fun _ b _ ⟨x, hax, hbx⟩ ⟨y, hby, hcy⟩ ↦
  let ⟨z, hxz, hyz⟩ := h b x y hbx hby
  ⟨z, ht hax hxz, ht hcy hyz⟩
#align relation.transitive_join Relation.transitive_join

theorem equivalence_join (hr : Reflexive r) (ht : Transitive r)
  (h : ∀ a b c, r a b → r a c → Join r b c) : Equivalence (Join r) :=
  ⟨reflexive_join hr, @symmetric_join _ _, @transitive_join _ _ ht h⟩
#align relation.equivalence_join Relation.equivalence_join

theorem equivalence_join_reflTransGen
    (h : ∀ a b c, r a b → r a c → ∃ d, ReflGen r b d ∧ ReflTransGen r c d) :
    Equivalence (Join (ReflTransGen r)) :=
  equivalence_join reflexive_reflTransGen transitive_reflTransGen fun _ _ _ ↦ church_rosser h
#align relation.equivalence_join_refl_trans_gen Relation.equivalence_join_reflTransGen

theorem join_of_equivalence {r' : α → α → Prop} (hr : Equivalence r) (h : ∀ a b, r' a b → r a b) :
    Join r' a b → r a b
  | ⟨_, hac, hbc⟩ => hr.trans (h _ _ hac) (hr.symm <| h _ _ hbc)
#align relation.join_of_equivalence Relation.join_of_equivalence

theorem reflTransGen_of_transitive_reflexive {r' : α → α → Prop} (hr : Reflexive r)
    (ht : Transitive r) (h : ∀ a b, r' a b → r a b) (h' : ReflTransGen r' a b) : r a b := by
  induction' h' with b c _ hbc ih
  · exact hr _
  · exact ht ih (h _ _ hbc)
#align relation.refl_trans_gen_of_transitive_reflexive Relation.reflTransGen_of_transitive_reflexive

theorem reflTransGen_of_equivalence {r' : α → α → Prop} (hr : Equivalence r) :
    (∀ a b, r' a b → r a b) → ReflTransGen r' a b → r a b :=
  reflTransGen_of_transitive_reflexive hr.1 (fun _ _ _ ↦ hr.trans)
#align relation.refl_trans_gen_of_equivalence Relation.reflTransGen_of_equivalence

end Join

end Relation

section EqvGen

variable {r : α → α → Prop} {a b : α}

theorem Equivalence.eqvGen_iff (h : Equivalence r) : EqvGen r a b ↔ r a b :=
  Iff.intro
    (by
      intro h
      induction h with
      | rel => assumption
      | refl => exact h.1 _
      | symm => apply h.symm; assumption
      | trans _ _ _ _ _ hab hbc => exact h.trans hab hbc)
    (EqvGen.rel a b)
#align equivalence.eqv_gen_iff Equivalence.eqvGen_iff

theorem Equivalence.eqvGen_eq (h : Equivalence r) : EqvGen r = r :=
  funext fun _ ↦ funext fun _ ↦ propext <| h.eqvGen_iff
#align equivalence.eqv_gen_eq Equivalence.eqvGen_eq

theorem EqvGen.mono {r p : α → α → Prop} (hrp : ∀ a b, r a b → p a b) (h : EqvGen r a b) :
    EqvGen p a b := by
  induction h with
  | rel a b h => exact EqvGen.rel _ _ (hrp _ _ h)
  | refl => exact EqvGen.refl _
  | symm a b _ ih => exact EqvGen.symm _ _ ih
  | trans a b c _ _ hab hbc => exact EqvGen.trans _ _ _ hab hbc
#align eqv_gen.mono EqvGen.mono

end EqvGen


variables (α : Type*) (r : α → α → Prop)
variable trans_r : ∀ {x y z}, r x y → r y z → r x z

variables (a b c : α)
variables (hab : r a b) (hbc : r b c)

#check trans_r
#check trans_r hab
#check trans_r hab hbc

variable refl_r : ∀ x, r x x
variable symm_r : ∀ {x y}, r x y → r y x

example (a b c d : α ) (hab : r a b) (hcb : r c b) (hcd : r c d) : r a d :=
trans_r (trans_r hab (symm_r hcb)) hcd


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import topology.algebra.infinite_sum
import topology.algebra.group_with_zero

/-!
# Topology on `ℝ≥0`

The natural topology on `ℝ≥0` (the one induced from `ℝ`), and a basic API.

## Main definitions

Instances for the following typeclasses are defined:

* `topological_space ℝ≥0`
* `topological_ring ℝ≥0`
* `second_countable_topology ℝ≥0`
* `order_topology ℝ≥0`
* `has_continuous_sub ℝ≥0`
* `has_continuous_inv' ℝ≥0` (continuity of `x⁻¹` away from `0`)
* `has_continuous_smul ℝ≥0 ℝ`

Everything is inherited from the corresponding structures on the reals.

## Main statements

Various mathematically trivial lemmas are proved about the compatibility
of limits and sums in `ℝ≥0` and `ℝ`. For example

* `tendsto_coe {f : filter α} {m : α → ℝ≥0} {x : ℝ≥0} :
  tendsto (λa, (m a : ℝ)) f (𝓝 (x : ℝ)) ↔ tendsto m f (𝓝 x)`

says that the limit of a filter along a map to `ℝ≥0` is the same in `ℝ` and `ℝ≥0`, and

* `coe_tsum {f : α → ℝ≥0} : ((∑'a, f a) : ℝ) = (∑'a, (f a : ℝ))`

says that says that a sum of elements in `ℝ≥0` is the same in `ℝ` and `ℝ≥0`.

Similarly, some mathematically trivial lemmas about infinite sums are proved,
a few of which rely on the fact that subtraction is continuous.

-/
noncomputable theory
open set topological_space metric filter
open_locale topological_space

namespace nnreal
open_locale nnreal big_operators filter

instance : topological_space ℝ≥0 := infer_instance -- short-circuit type class inference

instance : topological_ring ℝ≥0 :=
{ continuous_mul := continuous_subtype_mk _ $
    (continuous_subtype_val.comp continuous_fst).mul (continuous_subtype_val.comp continuous_snd),
  continuous_add := continuous_subtype_mk _ $
    (continuous_subtype_val.comp continuous_fst).add (continuous_subtype_val.comp continuous_snd) }

instance : second_countable_topology ℝ≥0 :=
topological_space.subtype.second_countable_topology _ _

instance : order_topology ℝ≥0 := @order_topology_of_ord_connected _ _ _ _ (Ici 0) _

section coe
variable {α : Type*}
open filter finset

lemma continuous_of_real : continuous real.to_nnreal :=
continuous_subtype_mk _ $ continuous_id.max continuous_const

lemma continuous_coe : continuous (coe : ℝ≥0 → ℝ) :=
continuous_subtype_val

@[simp, norm_cast] lemma tendsto_coe {f : filter α} {m : α → ℝ≥0} {x : ℝ≥0} :
  tendsto (λa, (m a : ℝ)) f (𝓝 (x : ℝ)) ↔ tendsto m f (𝓝 x) :=
tendsto_subtype_rng.symm

lemma tendsto_coe' {f : filter α} [ne_bot f] {m : α → ℝ≥0} {x : ℝ} :
  tendsto (λ a, m a : α → ℝ) f (𝓝 x) ↔ ∃ hx : 0 ≤ x, tendsto m f (𝓝 ⟨x, hx⟩) :=
⟨λ h, ⟨ge_of_tendsto' h (λ c, (m c).2), tendsto_coe.1 h⟩, λ ⟨hx, hm⟩, tendsto_coe.2 hm⟩

@[simp] lemma map_coe_at_top : map (coe : ℝ≥0 → ℝ) at_top = at_top :=
map_coe_Ici_at_top 0

lemma comap_coe_at_top : comap (coe : ℝ≥0 → ℝ) at_top = at_top :=
(at_top_Ici_eq 0).symm

@[simp, norm_cast] lemma tendsto_coe_at_top {f : filter α} {m : α → ℝ≥0} :
  tendsto (λ a, (m a : ℝ)) f at_top ↔ tendsto m f at_top :=
tendsto_Ici_at_top.symm

lemma tendsto_of_real {f : filter α} {m : α → ℝ} {x : ℝ} (h : tendsto m f (𝓝 x)) :
  tendsto (λa, real.to_nnreal (m a)) f (𝓝 (real.to_nnreal x)) :=
(continuous_of_real.tendsto _).comp h

lemma nhds_zero : 𝓝 (0 : ℝ≥0) = ⨅a ≠ 0, 𝓟 (Iio a) :=
nhds_bot_order.trans $ by simp [bot_lt_iff_ne_bot]

lemma nhds_zero_basis : (𝓝 (0 : ℝ≥0)).has_basis (λ a : ℝ≥0, 0 < a) (λ a, Iio a) :=
nhds_bot_basis

instance : has_continuous_sub ℝ≥0 :=
⟨continuous_subtype_mk _ $
  ((continuous_coe.comp continuous_fst).sub
   (continuous_coe.comp continuous_snd)).max continuous_const⟩

instance : has_continuous_inv₀ ℝ≥0 :=
⟨λ x hx, tendsto_coe.1 $ (real.tendsto_inv $ nnreal.coe_ne_zero.2 hx).comp
  continuous_coe.continuous_at⟩

instance : has_continuous_smul ℝ≥0 ℝ :=
{ continuous_smul := continuous.comp real.continuous_mul $ continuous.prod_mk
    (continuous.comp continuous_subtype_val continuous_fst) continuous_snd }

@[norm_cast] lemma has_sum_coe {f : α → ℝ≥0} {r : ℝ≥0} :
  has_sum (λa, (f a : ℝ)) (r : ℝ) ↔ has_sum f r :=
by simp only [has_sum, coe_sum.symm, tendsto_coe]

lemma has_sum_of_real_of_nonneg {f : α → ℝ} (hf_nonneg : ∀ n, 0 ≤ f n) (hf : summable f) :
  has_sum (λ n, real.to_nnreal (f n)) (real.to_nnreal (∑' n, f n)) :=
begin
  have h_sum : (λ s, ∑ b in s, real.to_nnreal (f b)) = λ s, real.to_nnreal (∑ b in s, f b),
    from funext (λ _, (real.to_nnreal_sum_of_nonneg (λ n _, hf_nonneg n)).symm),
  simp_rw [has_sum, h_sum],
  exact tendsto_of_real hf.has_sum,
end

@[norm_cast] lemma summable_coe {f : α → ℝ≥0} : summable (λa, (f a : ℝ)) ↔ summable f :=
begin
  split,
  exact assume ⟨a, ha⟩, ⟨⟨a, has_sum_le (λa, (f a).2) has_sum_zero ha⟩, has_sum_coe.1 ha⟩,
  exact assume ⟨a, ha⟩, ⟨a.1, has_sum_coe.2 ha⟩
end

lemma summable_coe_of_nonneg {f : α → ℝ} (hf₁ : ∀ n, 0 ≤ f n) :
  @summable (ℝ≥0) _ _ _ (λ n, ⟨f n, hf₁ n⟩) ↔ summable f :=
begin
  lift f to α → ℝ≥0 using hf₁ with f rfl hf₁,
  simp only [summable_coe, subtype.coe_eta]
end

open_locale classical

@[norm_cast] lemma coe_tsum {f : α → ℝ≥0} : ↑∑'a, f a = ∑'a, (f a : ℝ) :=
if hf : summable f
then (eq.symm $ (has_sum_coe.2 $ hf.has_sum).tsum_eq)
else by simp [tsum, hf, mt summable_coe.1 hf]

lemma coe_tsum_of_nonneg {f : α → ℝ} (hf₁ : ∀ n, 0 ≤ f n) :
  (⟨∑' n, f n, tsum_nonneg hf₁⟩ : ℝ≥0) = (∑' n, ⟨f n, hf₁ n⟩ : ℝ≥0) :=
begin
  lift f to α → ℝ≥0 using hf₁ with f rfl hf₁,
  simp_rw [← nnreal.coe_tsum, subtype.coe_eta]
end

lemma tsum_mul_left (a : ℝ≥0) (f : α → ℝ≥0) : ∑' x, a * f x = a * ∑' x, f x :=
nnreal.eq $ by simp only [coe_tsum, nnreal.coe_mul, tsum_mul_left]

lemma tsum_mul_right (f : α → ℝ≥0) (a : ℝ≥0) : (∑' x, f x * a) = (∑' x, f x) * a :=
nnreal.eq $ by simp only [coe_tsum, nnreal.coe_mul, tsum_mul_right]

lemma summable_comp_injective {β : Type*} {f : α → ℝ≥0} (hf : summable f)
  {i : β → α} (hi : function.injective i) :
  summable (f ∘ i) :=
nnreal.summable_coe.1 $
show summable ((coe ∘ f) ∘ i), from (nnreal.summable_coe.2 hf).comp_injective hi

lemma summable_nat_add (f : ℕ → ℝ≥0) (hf : summable f) (k : ℕ) : summable (λ i, f (i + k)) :=
summable_comp_injective hf $ add_left_injective k

lemma summable_nat_add_iff {f : ℕ → ℝ≥0} (k : ℕ) : summable (λ i, f (i + k)) ↔ summable f :=
begin
  rw [← summable_coe, ← summable_coe],
  exact @summable_nat_add_iff ℝ _ _ _ (λ i, (f i : ℝ)) k,
end

lemma has_sum_nat_add_iff {f : ℕ → ℝ≥0} (k : ℕ) {a : ℝ≥0} :
  has_sum (λ n, f (n + k)) a ↔ has_sum f (a + ∑ i in range k, f i) :=
by simp [← has_sum_coe, coe_sum, nnreal.coe_add, ← has_sum_nat_add_iff k]

lemma sum_add_tsum_nat_add {f : ℕ → ℝ≥0} (k : ℕ) (hf : summable f) :
  ∑' i, f i = (∑ i in range k, f i) + ∑' i, f (i + k) :=
by rw [←nnreal.coe_eq, coe_tsum, nnreal.coe_add, coe_sum, coe_tsum,
  sum_add_tsum_nat_add k (nnreal.summable_coe.2 hf)]

lemma infi_real_pos_eq_infi_nnreal_pos [complete_lattice α] {f : ℝ → α} :
  (⨅ (n : ℝ) (h : 0 < n), f n) = (⨅ (n : ℝ≥0) (h : 0 < n), f n) :=
le_antisymm
  (infi_le_infi2 $ assume r, ⟨r, infi_le_infi $ assume hr, le_rfl⟩)
  (le_infi $ assume r, le_infi $ assume hr, infi_le_of_le ⟨r, hr.le⟩ $ infi_le _ hr)

end coe

lemma tendsto_cofinite_zero_of_summable {α} {f : α → ℝ≥0} (hf : summable f) :
  tendsto f cofinite (𝓝 0) :=
begin
  have h_f_coe : f = λ n, real.to_nnreal (f n : ℝ), from funext (λ n, real.to_nnreal_coe.symm),
  rw [h_f_coe, ← @real.to_nnreal_coe 0],
  exact tendsto_of_real ((summable_coe.mpr hf).tendsto_cofinite_zero),
end

lemma tendsto_at_top_zero_of_summable {f : ℕ → ℝ≥0} (hf : summable f) :
  tendsto f at_top (𝓝 0) :=
by { rw ←nat.cofinite_eq_at_top, exact tendsto_cofinite_zero_of_summable hf }

/-- The sum over the complement of a finset tends to `0` when the finset grows to cover the whole
space. This does not need a summability assumption, as otherwise all sums are zero. -/
lemma tendsto_tsum_compl_at_top_zero {α : Type*} (f : α → ℝ≥0) :
  tendsto (λ (s : finset α), ∑' b : {x // x ∉ s}, f b) at_top (𝓝 0) :=
begin
  simp_rw [← tendsto_coe, coe_tsum, nnreal.coe_zero],
  exact tendsto_tsum_compl_at_top_zero (λ (a : α), (f a : ℝ))
end

end nnreal