/-
Copyright (c) 2019 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard
-/
import data.real.basic
import data.real.ennreal

/-!
# The extended reals [-∞, ∞].

This file defines `ereal`, the real numbers together with a top and bottom element,
referred to as ⊤ and ⊥. It is implemented as `with_top (with_bot ℝ)`

Addition and multiplication are problematic in the presence of ±∞, but
negation has a natural definition and satisfies the usual properties.

An ad hoc addition is defined, for which `ereal` is an `add_comm_monoid`, and even an ordered one
(if `a ≤ a'` and `b ≤ b'` then `a + b ≤ a' + b'`).
Note however that addition is badly behaved at `(⊥, ⊤)` and `(⊤, ⊥)` so this can not be upgraded
to a group structure. Our choice is that `⊥ + ⊤ = ⊤ + ⊥ = ⊤`.

An ad hoc subtraction is then defined by `x - y = x + (-y)`. It does not have nice properties,
but it is sometimes convenient to have.

An ad hoc multiplication is defined, for which `ereal` is a `comm_monoid_with_zero`.
This does not distribute with addition, as `⊤ = ⊤ - ⊥ = 1*⊤ - 1*⊤ ≠ (1 - 1) * ⊤ = 0 * ⊤ = 0`.

`ereal` is a `complete_linear_order`; this is deduced by type class inference from
the fact that `with_top (with_bot L)` is a complete linear order if `L` is
a conditionally complete linear order.

Coercions from `ℝ` and from `ℝ≥0∞` are registered, and their basic properties are proved. The main
one is the real coercion, and is usually referred to just as `coe` (lemmas such as
`ereal.coe_add` deal with this coercion). The one from `ennreal` is usually called `coe_ennreal`
in the `ereal` namespace.

## Tags

real, ereal, complete lattice

## TODO

abs : ereal → ℝ≥0∞

In Isabelle they define + - * and / (making junk choices for things like -∞ + ∞)
and then prove whatever bits of the ordered ring/field axioms still hold. They
also do some limits stuff (liminf/limsup etc).
See https://isabelle.in.tum.de/dist/library/HOL/HOL-Library/Extended_Real.html
-/

open_locale ennreal nnreal

/-- ereal : The type `[-∞, ∞]` -/
@[derive [has_top, comm_monoid_with_zero,
  has_Sup, has_Inf, complete_linear_order, linear_ordered_add_comm_monoid_with_top]]
def ereal := with_top (with_bot ℝ)

/-- The canonical inclusion froms reals to ereals. Do not use directly: as this is registered as
a coercion, use the coercion instead. -/
def real.to_ereal : ℝ → ereal := some ∘ some

namespace ereal

-- TODO: Provide explicitly, otherwise it is inferred noncomputably from `complete_linear_order`
instance : has_bot ereal := ⟨some ⊥⟩

@[simp] lemma bot_lt_top : (⊥ : ereal) < ⊤ := with_top.coe_lt_top _
@[simp] lemma bot_ne_top : (⊥ : ereal) ≠ ⊤ := bot_lt_top.ne

instance : has_coe ℝ ereal := ⟨real.to_ereal⟩
@[simp, norm_cast] protected lemma coe_le_coe_iff {x y : ℝ} : (x : ereal) ≤ (y : ereal) ↔ x ≤ y :=
by { unfold_coes, simp [real.to_ereal] }
@[simp, norm_cast] protected lemma coe_lt_coe_iff {x y : ℝ} : (x : ereal) < (y : ereal) ↔ x < y :=
by { unfold_coes, simp [real.to_ereal] }
@[simp, norm_cast] protected lemma coe_eq_coe_iff {x y : ℝ} : (x : ereal) = (y : ereal) ↔ x = y :=
by { unfold_coes, simp [real.to_ereal, option.some_inj] }

/-- The canonical map from nonnegative extended reals to extended reals -/
def _root_.ennreal.to_ereal : ℝ≥0∞ → ereal
| ⊤ := ⊤
| (some x) := x.1

instance has_coe_ennreal : has_coe ℝ≥0∞ ereal := ⟨ennreal.to_ereal⟩

instance : has_zero ereal := ⟨(0 : ℝ)⟩
instance : inhabited ereal := ⟨0⟩

/-- A recursor for `ereal` in terms of the coercion.

A typical invocation looks like `induction x using ereal.rec`. Note that using `induction`
directly will unfold `ereal` to `option` which is undesirable.

When working in term mode, note that pattern matching can be used directly. -/
@[elab_as_eliminator]
protected def rec {C : ereal → Sort*} (h_bot : C ⊥) (h_real : Π a : ℝ, C a) (h_top : C ⊤) :
  ∀ a : ereal, C a
| ⊥ := h_bot
| (a : ℝ) := h_real a
| ⊤ := h_top

/-! ### Real coercion -/

instance : can_lift ereal ℝ :=
{ coe := coe,
  cond := λ r, r ≠ ⊤ ∧ r ≠ ⊥,
  prf := λ x hx,
  begin
    induction x using ereal.rec,
    { simpa using hx },
    { simp },
    { simpa using hx }
  end }

/-- The map from extended reals to reals sending infinities to zero. -/
def to_real : ereal → ℝ
| ⊥       := 0
| ⊤       := 0
| (x : ℝ) := x

@[simp] lemma to_real_top : to_real ⊤ = 0 := rfl

@[simp] lemma to_real_bot : to_real ⊥ = 0 := rfl

@[simp] lemma to_real_zero : to_real 0 = 0 := rfl

@[simp] lemma to_real_coe (x : ℝ) : to_real (x : ereal) = x := rfl

@[simp] lemma bot_lt_coe (x : ℝ) : (⊥ : ereal) < x :=
by { apply with_top.coe_lt_coe.2, exact with_bot.bot_lt_coe _ }

@[simp] lemma coe_ne_bot (x : ℝ) : (x : ereal) ≠ ⊥  := (bot_lt_coe x).ne'

@[simp] lemma bot_ne_coe (x : ℝ) : (⊥ : ereal) ≠ x := (bot_lt_coe x).ne

@[simp] lemma coe_lt_top (x : ℝ) : (x : ereal) < ⊤ := with_top.coe_lt_top _

@[simp] lemma coe_ne_top (x : ℝ) : (x : ereal) ≠ ⊤ := (coe_lt_top x).ne

@[simp] lemma top_ne_coe (x : ℝ) : (⊤ : ereal) ≠ x := (coe_lt_top x).ne'

@[simp] lemma bot_lt_zero : (⊥ : ereal) < 0 := bot_lt_coe 0

@[simp] lemma bot_ne_zero : (⊥ : ereal) ≠ 0 := (coe_ne_bot 0).symm

@[simp] lemma zero_ne_bot : (0 : ereal) ≠ ⊥ := coe_ne_bot 0

@[simp] lemma zero_lt_top : (0 : ereal) < ⊤ := coe_lt_top 0

@[simp] lemma zero_ne_top : (0 : ereal) ≠ ⊤ := coe_ne_top 0

@[simp] lemma top_ne_zero : (⊤ : ereal) ≠ 0 := (coe_ne_top 0).symm

@[simp, norm_cast] lemma coe_add (x y : ℝ) : ((x + y : ℝ) : ereal) = (x : ereal) + (y : ereal) :=
rfl

@[simp] lemma coe_zero : ((0 : ℝ) : ereal) = 0 := rfl

lemma to_real_le_to_real {x y : ereal} (h : x ≤ y) (hx : x ≠ ⊥) (hy : y ≠ ⊤) :
  x.to_real ≤ y.to_real :=
begin
  lift x to ℝ,
  lift y to ℝ,
  { simpa using h },
  { simp [hy, ((bot_lt_iff_ne_bot.2 hx).trans_le h).ne'] },
  { simp [hx, (h.trans_lt (lt_top_iff_ne_top.2 hy)).ne], },
end

lemma coe_to_real {x : ereal} (hx : x ≠ ⊤) (h'x : x ≠ ⊥) : (x.to_real : ereal) = x :=
begin
  induction x using ereal.rec,
  { simpa using h'x },
  { refl },
  { simpa using hx },
end

lemma le_coe_to_real {x : ereal} (h : x ≠ ⊤) : x ≤ x.to_real :=
begin
  by_cases h' : x = ⊥,
  { simp only [h', bot_le] },
  { simp only [le_refl, coe_to_real h h'] },
end

lemma coe_to_real_le {x : ereal} (h : x ≠ ⊥) : ↑x.to_real ≤ x :=
begin
  by_cases h' : x = ⊤,
  { simp only [h', le_top] },
  { simp only [le_refl, coe_to_real h' h] },
end

lemma eq_top_iff_forall_lt (x : ereal) : x = ⊤ ↔ ∀ (y : ℝ), (y : ereal) < x :=
begin
  split,
  { rintro rfl, exact ereal.coe_lt_top },
  { contrapose!,
    intro h,
    exact ⟨x.to_real, le_coe_to_real h⟩, },
end

lemma eq_bot_iff_forall_lt (x : ereal) : x = ⊥ ↔ ∀ (y : ℝ), x < (y : ereal) :=
begin
  split,
  { rintro rfl, exact bot_lt_coe },
  { contrapose!,
    intro h,
    exact ⟨x.to_real, coe_to_real_le h⟩, },
end

/-! ### ennreal coercion -/

@[simp] lemma to_real_coe_ennreal : ∀ {x : ℝ≥0∞}, to_real (x : ereal) = ennreal.to_real x
| ⊤ := rfl
| (some x) := rfl

lemma coe_nnreal_eq_coe_real (x : ℝ≥0) : ((x : ℝ≥0∞) : ereal) = (x : ℝ) := rfl

@[simp] lemma coe_ennreal_top : ((⊤ : ℝ≥0∞) : ereal) = ⊤ := rfl

@[simp] lemma coe_ennreal_eq_top_iff : ∀ {x : ℝ≥0∞}, (x : ereal) = ⊤ ↔ x = ⊤
| ⊤ := by simp
| (some x) := by { simp only [ennreal.coe_ne_top, iff_false, ennreal.some_eq_coe], dec_trivial }

lemma coe_nnreal_ne_top (x : ℝ≥0) : ((x : ℝ≥0∞) : ereal) ≠ ⊤ := dec_trivial

@[simp] lemma coe_nnreal_lt_top (x : ℝ≥0) : ((x : ℝ≥0∞) : ereal) < ⊤ := dec_trivial

@[simp, norm_cast] lemma coe_ennreal_le_coe_ennreal_iff : ∀ {x y : ℝ≥0∞},
  (x : ereal) ≤ (y : ereal) ↔ x ≤ y
| x ⊤ := by simp
| ⊤ (some y) := by simp
| (some x) (some y) := by simp [coe_nnreal_eq_coe_real]

@[simp, norm_cast] lemma coe_ennreal_lt_coe_ennreal_iff : ∀ {x y : ℝ≥0∞},
  (x : ereal) < (y : ereal) ↔ x < y
| ⊤ ⊤ := by simp
| (some x) ⊤ := by simp
| ⊤ (some y) := by simp
| (some x) (some y) := by simp [coe_nnreal_eq_coe_real]

@[simp, norm_cast] lemma coe_ennreal_eq_coe_ennreal_iff : ∀ {x y : ℝ≥0∞},
  (x : ereal) = (y : ereal) ↔ x = y
| ⊤ ⊤ := by simp
| (some x) ⊤ := by simp
| ⊤ (some y) := by simp [(coe_nnreal_lt_top y).ne']
| (some x) (some y) := by simp [coe_nnreal_eq_coe_real]

lemma coe_ennreal_nonneg (x : ℝ≥0∞) : (0 : ereal) ≤ x :=
coe_ennreal_le_coe_ennreal_iff.2 (zero_le x)

@[simp] lemma bot_lt_coe_ennreal (x : ℝ≥0∞) : (⊥ : ereal) < x :=
(bot_lt_coe 0).trans_le (coe_ennreal_nonneg _)

@[simp] lemma coe_ennreal_ne_bot (x : ℝ≥0∞) : (x : ereal) ≠ ⊥ := (bot_lt_coe_ennreal x).ne'

@[simp, norm_cast] lemma coe_ennreal_add : ∀ (x y : ennreal), ((x + y : ℝ≥0∞) : ereal) = x + y
| ⊤ y := rfl
| x ⊤ := by simp
| (some x) (some y) := rfl

@[simp] lemma coe_ennreal_zero : ((0 : ℝ≥0∞) : ereal) = 0 := rfl

/-! ### Order -/

lemma exists_rat_btwn_of_lt : Π {a b : ereal} (hab : a < b),
  ∃ (x : ℚ), a < (x : ℝ) ∧ ((x : ℝ) : ereal) < b
| ⊤ b h := (not_top_lt h).elim
| (a : ℝ) ⊥ h := (lt_irrefl _ ((bot_lt_coe a).trans h)).elim
| (a : ℝ) (b : ℝ) h := by simp [exists_rat_btwn (ereal.coe_lt_coe_iff.1 h)]
| (a : ℝ) ⊤ h := let ⟨b, hab⟩ := exists_rat_gt a in ⟨b, by simpa using hab, coe_lt_top _⟩
| ⊥ ⊥ h := (lt_irrefl _ h).elim
| ⊥ (a : ℝ) h := let ⟨b, hab⟩ := exists_rat_lt a in ⟨b, bot_lt_coe _, by simpa using hab⟩
| ⊥ ⊤ h := ⟨0, bot_lt_coe _, coe_lt_top _⟩

lemma lt_iff_exists_rat_btwn {a b : ereal} :
  a < b ↔ ∃ (x : ℚ), a < (x : ℝ) ∧ ((x : ℝ) : ereal) < b :=
⟨λ hab, exists_rat_btwn_of_lt hab, λ ⟨x, ax, xb⟩, ax.trans xb⟩

lemma lt_iff_exists_real_btwn {a b : ereal} :
  a < b ↔ ∃ (x : ℝ), a < x ∧ (x : ereal) < b :=
⟨λ hab, let ⟨x, ax, xb⟩ := exists_rat_btwn_of_lt hab in ⟨(x : ℝ), ax, xb⟩,
 λ ⟨x, ax, xb⟩, ax.trans xb⟩

/-- The set of numbers in `ereal` that are not equal to `±∞` is equivalent to `ℝ`. -/
def ne_top_bot_equiv_real : ({⊥, ⊤} : set ereal).compl ≃ ℝ :=
{ to_fun := λ x, ereal.to_real x,
  inv_fun := λ x, ⟨x, by simp⟩,
  left_inv := λ ⟨x, hx⟩, subtype.eq $ begin
    lift x to ℝ,
    { simp },
    { simpa [not_or_distrib, and_comm] using hx }
  end,
  right_inv := λ x, by simp }

/-! ### Addition -/

@[simp] lemma add_top (x : ereal) : x + ⊤ = ⊤ := add_top _
@[simp] lemma top_add (x : ereal) : ⊤ + x = ⊤ := top_add _

@[simp] lemma bot_add_bot : (⊥ : ereal) + ⊥ = ⊥ := rfl
@[simp] lemma bot_add_coe (x : ℝ) : (⊥ : ereal) + x = ⊥ := rfl
@[simp] lemma coe_add_bot (x : ℝ) : (x : ereal) + ⊥ = ⊥ := rfl

lemma to_real_add : ∀ {x y : ereal} (hx : x ≠ ⊤) (h'x : x ≠ ⊥) (hy : y ≠ ⊤) (h'y : y ≠ ⊥),
  to_real (x + y) = to_real x + to_real y
| ⊥ y hx h'x hy h'y := (h'x rfl).elim
| ⊤ y hx h'x hy h'y := (hx rfl).elim
| x ⊤ hx h'x hy h'y := (hy rfl).elim
| x ⊥ hx h'x hy h'y := (h'y rfl).elim
| (x : ℝ) (y : ℝ) hx h'x hy h'y := by simp [← ereal.coe_add]

lemma add_lt_add_right_coe {x y : ereal} (h : x < y) (z : ℝ) : x + z < y + z :=
begin
  induction x using ereal.rec; induction y using ereal.rec,
  { exact (lt_irrefl _ h).elim },
  { simp only [bot_lt_coe, bot_add_coe, ← coe_add] },
  { simp },
  { exact (lt_irrefl _ (h.trans (bot_lt_coe x))).elim },
  { norm_cast at h ⊢, exact add_lt_add_right h _ },
  { simp only [← coe_add, top_add, coe_lt_top] },
  { exact (lt_irrefl _ (h.trans_le le_top)).elim },
  { exact (lt_irrefl _ (h.trans_le le_top)).elim },
  { exact (lt_irrefl _ (h.trans_le le_top)).elim },
end

lemma add_lt_add_of_lt_of_le {x y z t : ereal} (h : x < y) (h' : z ≤ t) (hz : z ≠ ⊥) (ht : t ≠ ⊤) :
  x + z < y + t :=
begin
  induction z using ereal.rec,
  { simpa only using hz },
  { calc x + z < y + z : add_lt_add_right_coe h _
           ... ≤ y + t : add_le_add (le_refl _) h' },
  { exact (ht (top_le_iff.1 h')).elim }
end

lemma add_lt_add_left_coe {x y : ereal} (h : x < y) (z : ℝ) : (z : ereal) + x < z + y :=
by simpa [add_comm] using add_lt_add_right_coe h z

lemma add_lt_add {x y z t : ereal} (h1 : x < y) (h2 : z < t) : x + z < y + t :=
begin
  induction y using ereal.rec,
  { exact (lt_irrefl _ (bot_le.trans_lt h1)).elim },
  { calc x + z ≤ y + z : add_le_add h1.le (le_refl _)
    ... < y + t : add_lt_add_left_coe h2 _ },
  { simp [lt_top_iff_ne_top, with_top.add_eq_top, h1.ne, (h2.trans_le le_top).ne] }
end

@[simp] lemma add_eq_top_iff {x y : ereal} : x + y = ⊤ ↔ x = ⊤ ∨ y = ⊤ :=
begin
  induction x using ereal.rec; induction y using ereal.rec;
  simp [← ereal.coe_add],
end

@[simp] lemma add_lt_top_iff {x y : ereal} : x + y < ⊤ ↔ x < ⊤ ∧ y < ⊤ :=
by simp [lt_top_iff_ne_top, not_or_distrib]

/-! ### Negation -/

/-- negation on `ereal` -/
protected def neg : ereal → ereal
| ⊥       := ⊤
| ⊤       := ⊥
| (x : ℝ) := (-x : ℝ)

instance : has_neg ereal := ⟨ereal.neg⟩

@[norm_cast] protected lemma neg_def (x : ℝ) : ((-x : ℝ) : ereal) = -x := rfl

@[simp] lemma neg_top : - (⊤ : ereal) = ⊥ := rfl
@[simp] lemma neg_bot : - (⊥ : ereal) = ⊤ := rfl
@[simp] lemma neg_zero : - (0 : ereal) = 0 := by { change ((-0 : ℝ) : ereal) = 0, simp }

/-- `- -a = a` on `ereal`. -/
@[simp] protected theorem neg_neg : ∀ (a : ereal), - (- a) = a
| ⊥ := rfl
| ⊤ := rfl
| (a : ℝ) := by { norm_cast, simp [neg_neg a] }

theorem neg_inj {a b : ereal} (h : -a = -b) : a = b := by rw [←ereal.neg_neg a, h, ereal.neg_neg b]

@[simp] theorem neg_eq_neg_iff (a b : ereal) : - a = - b ↔ a = b :=
⟨λ h, neg_inj h, λ h, by rw [h]⟩

@[simp] lemma to_real_neg : ∀ {a : ereal}, to_real (-a) = - to_real a
| ⊤ := by simp
| ⊥ := by simp
| (x : ℝ) := rfl

/-- Even though `ereal` is not an additive group, `-a = b ↔ -b = a` still holds -/
theorem neg_eq_iff_neg_eq {a b : ereal} : -a = b ↔ -b = a :=
⟨by {intro h, rw ←h, exact ereal.neg_neg a},
 by {intro h, rw ←h, exact ereal.neg_neg b}⟩

@[simp] lemma neg_eg_top_iff {x : ereal} : - x = ⊤ ↔ x = ⊥ :=
by { rw neg_eq_iff_neg_eq, simp [eq_comm] }

@[simp] lemma neg_eg_bot_iff {x : ereal} : - x = ⊥ ↔ x = ⊤ :=
by { rw neg_eq_iff_neg_eq, simp [eq_comm] }

@[simp] lemma neg_eg_zero_iff {x : ereal} : - x = 0 ↔ x = 0 :=
by { rw neg_eq_iff_neg_eq, simp [eq_comm] }

/-- if `-a ≤ b` then `-b ≤ a` on `ereal`. -/
protected theorem neg_le_of_neg_le : ∀ {a b : ereal} (h : -a ≤ b), -b ≤ a
| ⊥ ⊥ h := h
| ⊥ (some b) h := by cases (top_le_iff.1 h)
| ⊤ l h := le_top
| (a : ℝ) ⊥ h := by cases (le_bot_iff.1 h)
| l ⊤ h := bot_le
| (a : ℝ) (b : ℝ) h := by { norm_cast at h ⊢, exact _root_.neg_le_of_neg_le h }

/-- `-a ≤ b ↔ -b ≤ a` on `ereal`. -/
protected theorem neg_le {a b : ereal} : -a ≤ b ↔ -b ≤ a :=
⟨ereal.neg_le_of_neg_le, ereal.neg_le_of_neg_le⟩

/-- `a ≤ -b → b ≤ -a` on ereal -/
theorem le_neg_of_le_neg {a b : ereal} (h : a ≤ -b) : b ≤ -a :=
by rwa [←ereal.neg_neg b, ereal.neg_le, ereal.neg_neg]

@[simp] lemma neg_le_neg_iff {a b : ereal} : - a ≤ - b ↔ b ≤ a :=
by conv_lhs { rw [ereal.neg_le, ereal.neg_neg] }

@[simp, norm_cast] lemma coe_neg (x : ℝ) : ((- x : ℝ) : ereal) = - (x : ereal) := rfl

/-- Negation as an order reversing isomorphism on `ereal`. -/
def neg_order_iso : ereal ≃o (order_dual ereal) :=
{ to_fun := ereal.neg,
  inv_fun := ereal.neg,
  left_inv := ereal.neg_neg,
  right_inv := ereal.neg_neg,
  map_rel_iff' := λ x y, neg_le_neg_iff }

lemma neg_lt_of_neg_lt {a b : ereal} (h : -a < b) : -b < a :=
begin
  apply lt_of_le_of_ne (ereal.neg_le_of_neg_le h.le),
  assume H,
  rw [← H, ereal.neg_neg] at h,
  exact lt_irrefl _ h
end

lemma neg_lt_iff_neg_lt {a b : ereal} : -a < b ↔ -b < a :=
⟨λ h, ereal.neg_lt_of_neg_lt h, λ h, ereal.neg_lt_of_neg_lt h⟩

/-! ### Subtraction -/

/-- Subtraction on `ereal`, defined by `x - y = x + (-y)`. Since addition is badly behaved at some
points, so is subtraction. There is no standard algebraic typeclass involving subtraction that is
registered on `ereal` because of this bad behavior. -/
protected noncomputable def sub (x y : ereal) : ereal := x + (-y)

noncomputable instance : has_sub ereal := ⟨ereal.sub⟩

@[simp] lemma top_sub (x : ereal) : ⊤ - x = ⊤ := top_add x
@[simp] lemma sub_bot (x : ereal) : x - ⊥ = ⊤ := add_top x

@[simp] lemma bot_sub_top : (⊥ : ereal) - ⊤ = ⊥ := rfl
@[simp] lemma bot_sub_coe (x : ℝ) : (⊥ : ereal) - x = ⊥ := rfl
@[simp] lemma coe_sub_bot (x : ℝ) : (x : ereal) - ⊤ = ⊥ := rfl

@[simp] lemma sub_zero (x : ereal) : x - 0 = x := by { change x + (-0) = x, simp }
@[simp] lemma zero_sub (x : ereal) : 0 - x = - x := by { change 0 + (-x) = - x, simp }

lemma sub_eq_add_neg (x y : ereal) : x - y = x + -y := rfl

lemma sub_le_sub {x y z t : ereal} (h : x ≤ y) (h' : t ≤ z) : x - z ≤ y - t :=
add_le_add h (neg_le_neg_iff.2 h')

lemma sub_lt_sub_of_lt_of_le {x y z t : ereal} (h : x < y) (h' : z ≤ t) (hz : z ≠ ⊥) (ht : t ≠ ⊤) :
  x - t < y - z :=
add_lt_add_of_lt_of_le h (neg_le_neg_iff.2 h') (by simp [ht]) (by simp [hz])

lemma coe_real_ereal_eq_coe_to_nnreal_sub_coe_to_nnreal (x : ℝ) :
  (x : ereal) = real.to_nnreal x - real.to_nnreal (-x) :=
begin
  rcases le_or_lt 0 x with h|h,
  { have : real.to_nnreal x = ⟨x, h⟩, by { ext, simp [h] },
    simp only [real.to_nnreal_of_nonpos (neg_nonpos.mpr h), this, sub_zero, ennreal.coe_zero,
      coe_ennreal_zero, coe_coe],
    refl },
  { have : (x : ereal) = - (- x : ℝ), by simp,
    conv_lhs { rw this },
    have : real.to_nnreal (-x) = ⟨-x, neg_nonneg.mpr h.le⟩, by { ext, simp [neg_nonneg.mpr h.le], },
    simp only [real.to_nnreal_of_nonpos h.le, this, zero_sub, neg_eq_neg_iff, coe_neg,
      ennreal.coe_zero, coe_ennreal_zero, coe_coe],
    refl }
end

lemma to_real_sub {x y : ereal} (hx : x ≠ ⊤) (h'x : x ≠ ⊥) (hy : y ≠ ⊤) (h'y : y ≠ ⊥) :
  to_real (x - y) = to_real x - to_real y :=
begin
  rw [ereal.sub_eq_add_neg, to_real_add hx h'x, to_real_neg],
  { refl },
  { simpa using hy },
  { simpa using h'y }
end

/-! ### Multiplication -/

@[simp] lemma coe_one : ((1 : ℝ) : ereal) = 1 := rfl

@[simp, norm_cast] lemma coe_mul (x y : ℝ) : ((x * y : ℝ) : ereal) = (x : ereal) * (y : ereal) :=
eq.trans (with_bot.coe_eq_coe.mpr with_bot.coe_mul) with_top.coe_mul

@[simp] lemma mul_top (x : ereal) (h : x ≠ 0) : x * ⊤ = ⊤ := with_top.mul_top h
@[simp] lemma top_mul (x : ereal) (h : x ≠ 0) : ⊤ * x = ⊤ := with_top.top_mul h

@[simp] lemma bot_mul_bot : (⊥ : ereal) * ⊥ = ⊥ := rfl
@[simp] lemma bot_mul_coe (x : ℝ) (h : x ≠ 0) : (⊥ : ereal) * x = ⊥ :=
with_top.coe_mul.symm.trans $
  with_bot.coe_eq_coe.mpr $ with_bot.bot_mul $ function.injective.ne (@option.some.inj _) h
@[simp] lemma coe_mul_bot (x : ℝ) (h : x ≠ 0) : (x : ereal) * ⊥ = ⊥ :=
with_top.coe_mul.symm.trans $
  with_bot.coe_eq_coe.mpr $ with_bot.mul_bot $ function.injective.ne (@option.some.inj _) h

@[simp] lemma to_real_one : to_real 1 = 1 := rfl

lemma to_real_mul : ∀ {x y : ereal}, to_real (x * y) = to_real x * to_real y
| ⊤ y := by by_cases hy : y = 0; simp [hy]
| x ⊤ := by by_cases hx : x = 0; simp [hx]
| (x : ℝ) (y : ℝ) := by simp [← ereal.coe_mul]
| ⊥ (y : ℝ) := by by_cases hy : y = 0; simp [hy]
| (x : ℝ) ⊥ := by by_cases hx : x = 0; simp [hx]
| ⊥ ⊥ := by simp

end ereal


import group_theory.subgroup.basic
import tactic.field_simp

variables (K : Type*) [field K]

--lemma is_unit.inv {G : Type*} [group_with_zero G] {x : G} (hx : is_unit x) : is_unit x⁻¹ :=
--⟨⟨x⁻¹,x, by field_simp [hx.ne_zero], by field_simp [hx.ne_zero]⟩, rfl⟩

structure mul_subgroup :=
(carrier : set K)
(mul_mem' : ∀ {x y : K}, x ∈ carrier → y ∈ carrier → x * y ∈ carrier)
(inv_mem' : ∀ {x : K}, x ∈ carrier → x⁻¹ ∈ carrier)
(one_mem' : (1 : K) ∈ carrier)
(is_unit' : ∀ {x : K}, x ∈ carrier → is_unit x)

namespace mul_subgroup
variable {K}

instance : set_like (mul_subgroup K) K :=
{ coe := carrier,
  coe_injective' := begin
    intros S T h,
    cases S, cases T, congr, assumption,
  end }

@[ext]
lemma ext (S T : mul_subgroup K) (h : ∀ x, x ∈ S ↔ x ∈ T) :
  S = T := set_like.ext h

lemma is_unit_of_mem {x : K} (T : mul_subgroup K) : x ∈ T → is_unit x :=
begin
  intros hx, apply T.is_unit' hx,
end

lemma ne_zero_of_mem [nontrivial K]
  {x : K} (T : mul_subgroup K) : x ∈ T → x ≠ 0 :=
λ hx, is_unit.ne_zero (T.is_unit_of_mem hx)

lemma zero_nmem [nontrivial K] (T : mul_subgroup K) : (0 : K) ∉ T :=
λ c, T.ne_zero_of_mem c rfl

lemma mul_mem (T : mul_subgroup K) {a b : K} (ha : a ∈ T) (hb : b ∈ T) :
  a * b ∈ T := T.mul_mem' ha hb

lemma one_mem (T : mul_subgroup K) : (1 : K) ∈ T :=
T.one_mem'

lemma inv_mem (T : mul_subgroup K) {a : K}
  (ha : a ∈ T) : a⁻¹ ∈ T :=
T.inv_mem' ha

def mk' (T : subgroup Kˣ) : mul_subgroup K :=
{ carrier := { u | ∃ (h : is_unit u), h.unit ∈ T },
  mul_mem' := begin
    rintros x y ⟨hx,hx'⟩ ⟨hy,hy'⟩, refine ⟨hx.mul hy, _⟩,
    convert T.mul_mem hx' hy',
    ext, refl,
  end,
  inv_mem' := begin
    rintros x ⟨hx,hx'⟩, refine ⟨hx.inv, _⟩,
    convert T.inv_mem hx', ext, simpa only [units.coe_inv],
  end,
  one_mem' := ⟨is_unit_one, by { convert T.one_mem, ext, refl }⟩,
  is_unit' := λ x hx, hx.some }

def subgroup (T : mul_subgroup K) : subgroup Kˣ :=
{ carrier := { u | (u : K) ∈ T },
  mul_mem' := λ a b ha hb, T.mul_mem ha hb,
  one_mem' := T.one_mem,
  inv_mem' := λ a ha, begin
    dsimp, convert T.inv_mem ha using 1, simp only [units.coe_inv],
  end }

end mul_subgroup


/-
Copyright (c) 2021 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import tactic

universe u

variables {α : Type u}

section
variables (α)

@[derive decidable_eq]
inductive literal : Type u
| pos (x : α) : literal
| neg (x : α) : literal

abbreviation clause : Type u := list (literal α)
abbreviation cnf : Type u := list (clause α)
abbreviation interpretation : Type u := α → bool

end

namespace literal

@[simp]
def inverse : literal α → literal α
| (pos x) := neg x
| (neg x) := pos x

@[simp]
def var : literal α → α
| (pos x) := x
| (neg x) := x

@[simp]
def satisfied (ι : interpretation α) : literal α → Prop
| (pos x) := ι x
| (neg x) := ¬ι x

instance decidable_satisfied (ι : interpretation α) : decidable_pred (satisfied ι) :=
λ l, by cases l; dsimp only [satisfied]; apply_instance

@[simp]
lemma satisfied_inverse (ι : interpretation α) (l : literal α) : satisfied ι l.inverse ↔ ¬satisfied ι l :=
by cases l; simp

@[simp]
lemma inverse_inverse (l : literal α) : l.inverse.inverse = l :=
by cases l; refl

lemma not_satisfied_and_satisfied_inverse (ι : interpretation α) (l m : literal α)
  (hl : satisfied ι l) (hm : satisfied ι m) : l ≠ m.inverse :=
λ h, absurd hl $ by { convert hm, rw [←satisfied_inverse, h, inverse_inverse] }

end literal

namespace interpretation
variable [decidable_eq α]

def flip (ι : interpretation α) : literal α → interpretation α
| (literal.pos x) := function.update ι x ¬ι x
| (literal.neg x) := function.update ι x ¬ι x

@[simp]
lemma satisfied_flip_eq (ι : interpretation α) (l : literal α) :
  literal.satisfied (ι.flip l) l ↔ ¬literal.satisfied ι l :=
by cases l; simp only [flip, function.update_same, literal.satisfied, bool.of_to_bool_iff]

lemma satisfied_flip_neq (ι : interpretation α) (l m : literal α) (h₁ : m ≠ l) (h₂ : m ≠ l.inverse) :
  literal.satisfied (ι.flip l) m ↔ literal.satisfied ι m :=
begin
  cases l; cases m;
  simp only [flip, literal.satisfied, ne.def, not_false_iff, literal.inverse] at ⊢ h₁ h₂;
  rw function.update_noteq h₁ <|> rw function.update_noteq h₂
end

end interpretation

namespace clause

def satisfied (ι : interpretation α) (γ : clause α) : Prop :=
∃ l ∈ γ, literal.satisfied ι l

@[simp]
lemma not_satisfied_nil (ι : interpretation α) : ¬satisfied ι [] :=
λ ⟨_, ⟨hl, _⟩⟩, list.not_mem_nil _ hl

@[simp]
lemma satisfied_cons (ι : interpretation α) (γ : clause α) (l : literal α) :
  satisfied ι (l::γ) ↔ literal.satisfied ι l ∨ satisfied ι γ :=
by simp only [satisfied, list.exists_mem_cons_iff]

lemma satisfied_eq {ι κ : interpretation α} {γ : clause α} (h : ∀ l ∈ γ, literal.satisfied ι l ↔ literal.satisfied κ l) :
  γ.satisfied ι ↔ γ.satisfied κ :=
begin
  induction γ with l γ ih,
  { simp only [not_satisfied_nil] },
  { simp only [satisfied_cons, h _ (list.mem_cons_self _ _), ih (λ m hm, h _ (list.mem_cons_of_mem _ hm))] }
end

end clause

namespace cnf

def satisfied (ι : interpretation α) (c : cnf α) : Prop :=
∀ γ ∈ c, clause.satisfied ι γ

@[simp]
lemma satisfied_nil (ι : interpretation α) : satisfied ι [] :=
λ γ hγ, absurd hγ $ list.not_mem_nil _

@[simp]
lemma satisfied_cons (ι : interpretation α) (c : cnf  α) (γ : clause α) :
  satisfied ι (γ::c) ↔ clause.satisfied ι γ ∧ satisfied ι c :=
by simp only [satisfied, list.forall_mem_cons]

lemma satisfied_iff (ι κ : interpretation α) {c : cnf α} (h : ∀ γ ∈ c, ∀ l ∈ γ, literal.satisfied ι l ↔ literal.satisfied κ l) :
  c.satisfied ι ↔ c.satisfied κ :=
begin
  induction c with γ c ih,
  { simp only [satisfied_nil] },
  { simp only [satisfied_cons, clause.satisfied_eq (λ l hl, h _ (list.mem_cons_self _ _) _ hl),
      ih (λ δ hδ l hl, h _ (list.mem_cons_of_mem _ hδ) _ hl)] }
end

def satisfiable (c : cnf α) : Prop :=
∃ ι, satisfied ι c

@[simp]
lemma satisfiable_empty : satisfiable ([] : cnf α) :=
⟨λ x, false, satisfied_nil _⟩

lemma not_satisfiable_of_empty_mem {c : cnf α} (hc : [] ∈ c) : ¬satisfiable c :=
λ ⟨ι, hι⟩, clause.not_satisfied_nil _ (hι _ hc)

def size (c : cnf α) : ℕ :=
(c.map list.length).sum

instance : has_sizeof (cnf α) :=
{ sizeof := size }

lemma sizeof_eq_size (c : cnf α) : sizeof c = size c :=
rfl

end cnf


import field_theory.ratfunc
import data.complex.basic

-- ring of integers ℤ
example : comm_ring ℤ := by apply_instance

-- field of fractions ℚ
noncomputable example : ℚ ≃ₐ[ℤ] fraction_ring ℤ := (fraction_ring.alg_equiv ℤ ℚ).symm

-- ring of polynomials over the complexes
noncomputable example : comm_ring (polynomial ℂ) := by apply_instance

-- field of fractions ℂ(X)
noncomputable example : ratfunc ℂ ≃ₐ[ℂ] fraction_ring (polynomial ℂ) :=
(fraction_ring.alg_equiv (polynomial ℂ) (ratfunc ℂ)).symm.restrict_scalars ℂ

-- An element of f(X) : ℂ(X) is a “rational function,” i.e., a quotient
-- of two polynomials, P(X), Q(X) : ℂ[X], Q(X) ≠ 0;
-- we can always require that Q(X) is monic, i.e., its leading coefficient is 1.
example (f : ratfunc ℂ) : ∃ (p q : polynomial ℂ) (hq : q ≠ 0) (hm : q.monic),
  f = ratfunc.mk p q :=
⟨f.num, f.denom, f.denom_ne_zero, f.monic_denom,
  by simp only [ratfunc.mk_eq_div, ratfunc.num_div_denom]⟩

-- Any rational number x : ℚ is a quotient of two integers
-- with a, b : ℤ, b ≠ 0, we can always require b > 0
example (x : ℚ) : ∃ (a b : ℤ) (hb : 0 < b),
  x = a / b :=
⟨x.num, x.denom, int.coe_nat_pos.mpr x.pos, x.num_div_denom.symm⟩


import algebra.field algebra.ring
import analysis.normed_space analysis.ennreal
import analysis.topology.infinite_sum
import analysis.complex

/--
 - A formal power series over a ring R is a formal expression of the form
 -
 - ∑ᵢ aᵢ zⁱ
 -
 - where i ∈ ℕ and aᵢ ∈ R. Thus, the data necessary to specify a formal power
 - series is a sequence in R. The point of writing them as series is that this
 - specifies natural operations on them.
 -/
def formal_power_series (R : Type*) : Type* := ℕ → R

namespace formal_power_series

-- TODO: introduce some notation, figure out how to avoid conflicts with notation for
-- infinite sums and convergent power series.

/--
 - Just like for polynomials, it is easy to define a 'formal derivative' for
 - formal power series.
 -/
def formal_derivative {R : Type*} [ring R] : formal_power_series R → formal_power_series R := sorry

variable {R : Type*}
variables [normed_ring R]
open lattice topological_space

/--
 - A predicate that indicates if the formal power series s converges at a point x ∈ R.
 -/
def converges_at_to (s : formal_power_series R) (x : R) (y : R) : Prop :=
is_sum (λ n : ℕ , s n * x ^ n) y -- is_sum means absolute convergence of the series at x

def converges_to_at (s : formal_power_series R) (y : R) (x : R) : Prop :=
is_sum (λ n : ℕ , s n * x ^ n) y -- is_sum means absolute convergence of the series at x

def converges_at (s : formal_power_series R) (x : R) : Prop :=
has_sum (λ n : ℕ , s n * x ^ n) -- has_sum means absolute convergence of the series at x

/--
 - The supremum of {r : ℝ | ∀ x, ∥x∥ < r → converges s x}.
 -/
noncomputable def convergence_radius (s : formal_power_series R) (x₀ : R) : ennreal :=
Sup {r : ennreal | ∀ x : R, ↑(nnnorm (x - x₀)) < r → converges_at (x - x₀) s}

/--
 - A power series is the function associated with a formal power series by taking infinite sums. I may or may not converge.
 -/
noncomputable def at_point (s : formal_power_series R) (x : R) :=
∑ n : ℕ , s n * x ^ n

-- noncomputable instance : has_coe_to_fun (formal_power_series R) :=
-- ⟨λ _, R → R,
--   λ s x, s.at_point x⟩

end formal_power_series

variable {R : Type*}
variables [normed_ring R]
open lattice topological_space

/--
 - A function f defined on an open subset of R is analytic if it can
 - locally be written as a convergent power series.
 -
 - This definition is not done yet.
 -/
def is_analytic_at (x₀ : R) (f : R → R) : Prop :=
∃ (s : formal_power_series R) (r > 0), ∀ x : R, norm(x - x₀) < r → s.converges_at_to (x - x₀) (f x)

#print is_analytic_at.

def is_analytic_on (U : set R) (f : R → R) : Prop :=
∀ x ∈ U, is_analytic_at x f

-- class is_analytic (U : opens R) (f : U → R) : Prop :=
-- (prop : ∀ x ∈ U,  ∃ (s : formal_power_series R) (x₀ : R), convergence_radius s x₀ > 0 ∧ ↑(nnnorm (x - x₀)) < convergence_radius s x₀ ∧  some (f ⟨x, ‹x ∈ U›⟩) = power_series s (x - x₀) )

structure analytic_function (U : opens R) :=
(to_fun : U → R)
(is_analytic := is_analytic U to_fun)

/--
 - An analytic function on U can be coerced to a function U → R.
 -/
instance (U : opens R) : has_coe_to_fun $ analytic_function U := ⟨λ _, U → R, λ f, f.to_fun⟩

/--
 - The formal derivative on formal power series restricts and corestricts
 - to convergent power series, hence it is defined for analytic functions.
 -/
def derivative (U : opens ℝ) : analytic_function U → analytic_function U := sorry

instance : normed_field ℂ := sorry

theorem one_div_z_analytic : is_analytic ⟨{z : ℂ | z ≠ 0}, sorry⟩ (λ z, (1:ℂ)/z) := sorry


/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.quotient_group

/-!
# Lemmas about quotients in characteristic zero

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

variables {R : Type*} [division_ring R] [char_zero R] {p : R}

namespace add_subgroup

/-- `z • r` is a multiple of `p` iff `r` is `pk/z` above a multiple of `p`, where `0 ≤ k < |z|`. -/
lemma zsmul_mem_zmultiples_iff_exists_sub_div {r : R} {z : ℤ} (hz : z ≠ 0) :
  z • r ∈ add_subgroup.zmultiples p ↔
    ∃ k : fin z.nat_abs, r - (k : ℕ) • (p / z : R) ∈ add_subgroup.zmultiples p:=
begin
  rw [add_subgroup.mem_zmultiples_iff],
  simp_rw [add_subgroup.mem_zmultiples_iff, div_eq_mul_inv, ←smul_mul_assoc, eq_sub_iff_add_eq],
  have hz' : (z : R) ≠ 0 := int.cast_ne_zero.mpr hz,
  conv_rhs { simp only [←(mul_right_injective₀ hz').eq_iff] { single_pass := tt}, },
  simp_rw [←zsmul_eq_mul, smul_add, ←mul_smul_comm, zsmul_eq_mul (z : R)⁻¹, mul_inv_cancel hz',
    mul_one, ←coe_nat_zsmul, smul_smul, ←add_smul],
  split,
  { rintro ⟨k, h⟩,
    simp_rw ← h,
    refine ⟨⟨(k % z).to_nat, _⟩, k / z, _⟩,
    { rw [←int.coe_nat_lt, int.to_nat_of_nonneg (int.mod_nonneg _ hz)],
      exact (int.mod_lt _ hz).trans_eq (int.abs_eq_nat_abs _) },
    rw [fin.coe_mk, int.to_nat_of_nonneg (int.mod_nonneg _ hz), int.div_add_mod] },
  { rintro ⟨k, n, h⟩,
    exact ⟨_, h⟩, },
end

lemma nsmul_mem_zmultiples_iff_exists_sub_div {r : R} {n : ℕ} (hn : n ≠ 0) :
  n • r ∈ add_subgroup.zmultiples p ↔
    ∃ k : fin n, r - (k : ℕ) • (p / n : R) ∈ add_subgroup.zmultiples p:=
begin
  simp_rw [←coe_nat_zsmul r, zsmul_mem_zmultiples_iff_exists_sub_div (int.coe_nat_ne_zero.mpr hn),
    int.cast_coe_nat],
  refl,
end

end add_subgroup

namespace quotient_add_group

lemma zmultiples_zsmul_eq_zsmul_iff {ψ θ : R ⧸ add_subgroup.zmultiples p} {z : ℤ} (hz : z ≠ 0) :
  z • ψ = z • θ ↔ (∃ k : fin z.nat_abs, ψ = θ + (k : ℕ) • (p / z : R)) :=
begin
  induction ψ using quotient.induction_on',
  induction θ using quotient.induction_on',
  have : (quotient.mk' : R → R ⧸ add_subgroup.zmultiples p) = coe := rfl,
  simp only [this],
  simp_rw [←coe_zsmul, ←coe_nsmul, ←coe_add, quotient_add_group.eq_iff_sub_mem, ←smul_sub,
    ←sub_sub, add_subgroup.zsmul_mem_zmultiples_iff_exists_sub_div hz],
end

lemma zmultiples_nsmul_eq_nsmul_iff {ψ θ : R ⧸ add_subgroup.zmultiples p} {n : ℕ} (hz : n ≠ 0) :
  n • ψ = n • θ ↔ (∃ k : fin n, ψ = θ + (k : ℕ) • (p / n : R)) :=
begin
  simp_rw [←coe_nat_zsmul ψ, ←coe_nat_zsmul θ,
    zmultiples_zsmul_eq_zsmul_iff (int.coe_nat_ne_zero.mpr hz),  int.cast_coe_nat],
  refl,
end

end quotient_add_group


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

! This file was ported from Lean 3 source module combinatorics.set_family.kleitman
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.SetFamily.HarrisKleitman
import Mathlib.Combinatorics.SetFamily.Intersecting

/-!
# Kleitman's bound on the size of intersecting families

An intersecting family on `n` elements has size at most `2ⁿ⁻¹`, so we could naïvely think that two
intersecting families could cover all `2ⁿ` sets. But actually that's not case because for example
none of them can contain the empty set. Intersecting families are in some sense correlated.
Kleitman's bound stipulates that `k` intersecting families cover at most `2ⁿ - 2ⁿ⁻ᵏ` sets.

## Main declarations

* `Finset.card_bunionᵢ_le_of_intersecting`: Kleitman's theorem.

## References

* [D. J. Kleitman, *Families of non-disjoint subsets*][kleitman1966]
-/

open Finset

open Fintype (card)

variable {ι α : Type _} [Fintype α] [DecidableEq α] [Nonempty α]

/-- **Kleitman's theorem**. An intersecting family on `n` elements contains at most `2ⁿ⁻¹` sets, and
each further intersecting family takes at most half of the sets that are in no previous family. -/
theorem Finset.card_bunionᵢ_le_of_intersecting (s : Finset ι) (f : ι → Finset (Finset α))
    (hf : ∀ i ∈ s, (f i : Set (Finset α)).Intersecting) :
    (s.bunionᵢ f).card ≤ 2 ^ Fintype.card α - 2 ^ (Fintype.card α - s.card) := by
  have : DecidableEq ι := by
    classical
    infer_instance
  obtain hs | hs := le_total (Fintype.card α) s.card
  · rw [tsub_eq_zero_of_le hs, pow_zero]
    refine' (card_le_of_subset <| bunionᵢ_subset.2 fun i hi a ha ↦
      mem_compl.2 <| not_mem_singleton.2 <| (hf _ hi).ne_bot ha).trans_eq _
    rw [card_compl, Fintype.card_finset, card_singleton]
  induction' s using Finset.cons_induction with i s hi ih generalizing f
  · simp
  set f' : ι → Finset (Finset α) :=
    fun j ↦ if hj : j ∈ cons i s hi then (hf j hj).exists_card_eq.choose else ∅
  have hf₁ : ∀ j, j ∈ cons i s hi → f j ⊆ f' j ∧ 2 * (f' j).card =
      2 ^ Fintype.card α ∧ (f' j : Set (Finset α)).Intersecting := by
    rintro j hj
    simp_rw [dif_pos hj, ← Fintype.card_finset]
    exact Classical.choose_spec (hf j hj).exists_card_eq
  have hf₂ : ∀ j, j ∈ cons i s hi → IsUpperSet (f' j : Set (Finset α)) := by
    refine' fun j hj ↦ (hf₁ _ hj).2.2.isUpperSet' ((hf₁ _ hj).2.2.is_max_iff_card_eq.2 _)
    rw [Fintype.card_finset]
    exact (hf₁ _ hj).2.1
  refine' (card_le_of_subset <| bunionᵢ_mono fun j hj ↦ (hf₁ _ hj).1).trans _
  nth_rw 1 [cons_eq_insert i]
  rw [bunionᵢ_insert]
  refine' (card_mono <| @le_sup_sdiff _ _ _ <| f' i).trans ((card_union_le _ _).trans _)
  rw [union_sdiff_left, sdiff_eq_inter_compl]
  refine' le_of_mul_le_mul_left _ (pow_pos (zero_lt_two' ℕ) <| Fintype.card α + 1)
  rw [pow_succ', mul_add, mul_assoc, mul_comm _ 2, mul_assoc]
  refine' (add_le_add
      ((mul_le_mul_left <| pow_pos (zero_lt_two' ℕ) _).2
      (hf₁ _ <| mem_cons_self _ _).2.2.card_le) <|
      (mul_le_mul_left <| zero_lt_two' ℕ).2 <| IsUpperSet.card_inter_le_finset _ _).trans _
  · rw [coe_bunionᵢ]
    exact isUpperSet_unionᵢ₂ fun i hi ↦ hf₂ _ <| subset_cons _ hi
  · rw [coe_compl]
    exact (hf₂ _ <| mem_cons_self _ _).compl
  rw [mul_tsub, card_compl, Fintype.card_finset, mul_left_comm, mul_tsub,
    (hf₁ _ <| mem_cons_self _ _).2.1, two_mul, add_tsub_cancel_left, ← mul_tsub, ← mul_two,
    mul_assoc, ← add_mul, mul_comm]
  refine' mul_le_mul_left' _ _
  refine' (add_le_add_left
    (ih _ (fun i hi ↦ (hf₁ _ <| subset_cons _ hi).2.2)
    ((card_le_of_subset <| subset_cons _).trans hs)) _).trans _
  rw [mul_tsub, two_mul, ← pow_succ,
    ← add_tsub_assoc_of_le (pow_le_pow' (one_le_two : (1 : ℕ) ≤ 2) tsub_le_self),
    tsub_add_eq_add_tsub hs, card_cons, add_tsub_add_eq_tsub_right]
#align finset.card_bUnion_le_of_intersecting Finset.card_bunionᵢ_le_of_intersecting


/-
Copyright (c) 2023 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import algebra.big_operators.basic
import mathlib.combinatorics.simple_graph.subgraph
import mathlib.data.sym.sym2

/-!
# Containment of graphs

This file defines graph containment.

A graph is said to contain another if one of its subgraphs is isomorphic to it.
-/

open function
open_locale big_operators classical

namespace simple_graph
variables {α β γ : Type*} {G G₁ G₂ G₃ : simple_graph α} {H : simple_graph β} {I : simple_graph γ}

/-- A simple graph `G` is contained in a simple graph `H` if there exists a subgraph of `H`
isomorphic to `G`. This is denoted by `G ⊑ H`. -/
def is_contained (G : simple_graph α) (H : simple_graph β) : Prop := ∃ f : G →g H, injective f

infix ` ⊑ `:50 := simple_graph.is_contained

lemma is_contained_of_le (h : G₁ ≤ G₂) : G₁ ⊑ G₂ := ⟨hom_of_le h, injective_id⟩
protected lemma iso.is_contained (e : G ≃g H) : G ⊑ H := ⟨e, e.injective⟩
protected lemma iso.is_contained' (e : G ≃g H) : H ⊑ G := e.symm.is_contained
lemma subgraph.coe_is_contained (G' : G.subgraph) : G'.coe ⊑ G := ⟨G'.hom, subtype.val_injective⟩

@[refl] lemma is_contained_refl (G : simple_graph α) : G ⊑ G := is_contained_of_le le_rfl
lemma is_contained_rfl : G ⊑ G := is_contained_refl _

lemma is_contained.trans : G ⊑ H → H ⊑ I → G ⊑ I :=
by { rintro ⟨f, hf⟩ ⟨g, hg⟩, exact ⟨g.comp f, hg.comp hf⟩ }

lemma is_contained.mono_left (h₁₂ : G₁ ≤ G₂) (h₂₃ : G₂ ⊑ G₃) : G₁ ⊑ G₃ :=
(is_contained_of_le h₁₂).trans h₂₃

lemma is_contained.mono_right (h₁₂ : G₁ ⊑ G₂) (h₂₃ : G₂ ≤ G₃) : G₁ ⊑ G₃ :=
h₁₂.trans $ is_contained_of_le h₂₃

alias is_contained.mono_right ← is_contained.trans_le

lemma is_contained_of_is_empty [is_empty α] : G ⊑ H :=
⟨{ to_fun := is_empty_elim, map_rel' := is_empty_elim }, is_empty_elim⟩

lemma bot_is_contained (f : α ↪ β) : (⊥ : simple_graph α) ⊑ H :=
⟨{ to_fun := f, map_rel' := λ _ _, false.elim }, f.injective⟩

lemma is_contained_iff_exists_subgraph : G ⊑ H ↔ ∃ H' : H.subgraph, nonempty $ G ≃g H'.coe :=
begin
  split,
  { rintro ⟨f, hf⟩,
    exact ⟨subgraph.map f ⊤, ⟨(subgraph.iso_map _ hf _).comp subgraph.top_iso.symm⟩⟩ },
  { rintro ⟨H', ⟨e⟩⟩,
    exact e.is_contained.trans H'.coe_is_contained }
end

private lemma aux (hG : G ≠ ⊥) {H' : H.subgraph} (f : G ≃g H'.coe) : H'.edge_set.nonempty :=
begin
  obtain ⟨e, he⟩ := nonempty_edge_set.2 hG,
  rw ←subgraph.image_coe_edge_set_coe,
  exact set.nonempty.image _ ⟨sym2.map f e, f.map_mem_edge_set_iff.2 he⟩,
end

/-- `G.kill H` is a subgraph of `H` where an edge from every subgraph isomorphic to `G` was removed.
As such, it is a big subgraph of `H` that does not contain any subgraph isomorphic to `G`.
-/
noncomputable def kill (G : simple_graph α) (H : simple_graph β) : simple_graph β :=
if hG : G = ⊥ then H else H.delete_edges $ ⋃ (H' : H.subgraph) (f : G ≃g H'.coe), {(aux hG f).some}

lemma kill_le : G.kill H ≤ H := by { rw kill, split_ifs, exacts [le_rfl, delete_edges_le _ _] }

@[simp] lemma bot_kill (H : simple_graph β) : (⊥ : simple_graph α).kill H = H := dif_pos rfl

lemma kill_eq_right (hG : G ≠ ⊥) : G.kill H = H ↔ ¬ G ⊑ H :=
begin
  rw [kill, dif_neg hG],
  simp only [set.disjoint_left, is_contained_iff_exists_subgraph, @forall_swap _ H.subgraph,
    set.Union_singleton_eq_range, delete_edges_eq, set.mem_Union, set.mem_range, not_exists,
    not_nonempty_iff],
  exact forall_congr (λ H', ⟨λ h,
    ⟨λ f, h _ (subgraph.edge_set_subset _ $ (aux hG f).some_spec) f rfl⟩, λ h _ _, h.elim⟩),
end

lemma kill_of_not_is_contained (hGH : ¬ G ⊑ H) : G.kill H = H :=
begin
  obtain rfl | hG := eq_or_ne G ⊥,
  { exact bot_kill _ },
  { exact (kill_eq_right hG).2 hGH }
end

lemma not_is_contained_kill (hG : G ≠ ⊥) : ¬ G ⊑ G.kill H :=
begin
  rw [kill, dif_neg hG, delete_edges_eq_sdiff_from_edge_set, is_contained_iff_exists_subgraph],
  rintro ⟨H', ⟨f⟩⟩,
  have hH' : (H'.map $ hom_of_le (sdiff_le : H \ _ ≤ H)).edge_set.nonempty,
  { rw subgraph.edge_set_map,
    exact (aux hG f).image _ },
  set e := hH'.some with he,
  have : e ∈ _ := hH'.some_spec,
  clear_value e,
  rw ←subgraph.image_coe_edge_set_coe at this,
  subst he,
  obtain ⟨e, he₀, he₁⟩ := this,
  let e' : sym2 H'.verts := sym2.map (subgraph.iso_map (hom_of_le _) injective_id _).symm e,
  have he' : e' ∈ H'.coe.edge_set := (iso.map_mem_edge_set_iff _).2 he₀,
  rw subgraph.edge_set_coe at he',
  have := subgraph.edge_set_subset _ he',
  simp only [edge_set_sdiff, edge_set_from_edge_set, edge_set_sdiff_sdiff_is_diag, set.mem_diff,
    set.mem_Union, not_exists] at this,
  refine this.2 (H'.map $ hom_of_le sdiff_le)
    ((subgraph.iso_map (hom_of_le _) injective_id _).comp f) _,
  rw [sym2.map_map, set.mem_singleton_iff, ←he₁],
  congr' 1 with x,
  refine congr_arg coe (equiv.set.image_symm_apply _ _ injective_id _ _),
  simpa using x.2,
end

variables [fintype H.edge_set]

noncomputable instance kill.edge_set.fintype : fintype (G.kill H).edge_set :=
fintype.of_injective (set.inclusion $ edge_set_mono kill_le) $ set.inclusion_injective _

end simple_graph


import tactic
import group_theory.subgroup.basic

namespace my_kernel_norm_sub

variables {G H : Type} [group G] [group H]

lemma map_mul_2 {x y : G}{φ : G →* H} : φ(x * y * x⁻¹) = φ(x) * φ(y) * φ(x)⁻¹ :=
begin
    -- rewrite twice to get an obvious identiy
  rw map_mul,
  rw map_mul,
end

lemma x_in_kernel_is_identity {k : G}{φ : G →* H}(hk : k ∈ φ.ker) : φ(k) = 1 :=
begin
  exact hk,
end

lemma conjugating_k_in_kernel_by_x_is_identity
  {k : G}{φ : G →* H}(hk : k ∈ φ.ker){x : G} : φ(x * k * x⁻¹) = 1 :=
begin
  -- rewrite our hypothesis to expand to multiplication by function
  rw map_mul_2,
  -- kernel element goes to the identity
  rw x_in_kernel_is_identity hk,
  -- Remove the multiplication by 1
  rw mul_one,
  -- bring back the multiplication by maps to multiplication within a map
  rw ← map_mul,
  -- cancel x * x⁻¹
  rw mul_right_inv,
  -- identity maps to identity
  rw map_one,
end

variable {φ : G →* H}
lemma conjugating_kernel_by_x_is_in_kernel
  {k : G}(hk : k ∈ φ.ker){x : G} : x * k * x⁻¹ ∈ φ.ker :=
begin
    apply conjugating_k_in_kernel_by_x_is_identity,
    exact hk,
end

theorem kernel_is_normal_subgroup_of_domain {φ : G →* H} : subgroup.normal (φ.ker) :=
begin
  -- Change the goal to be the hypothesis of what a normal group is
  apply subgroup.normal.mk,
  apply conjugating_kernel_by_x_is_in_kernel,
end

theorem preimage_of_normal_subgroup_is_normal
  {φ : G →* H} {I : subgroup H}(hn : subgroup.normal(I)) :
    subgroup.normal (I.comap φ) :=
begin
  -- Change the goal to be the hypothesis of what a normal group is
  apply subgroup.normal.mk,
  -- y an element of G
  intro y,
  -- hypothesis that y is in the preimage of φ
  intro hyInPreim,
  -- x any element of G
  intro x,
  --Simplifies the goal from x * y * x⁻¹ ∈ subgroup.comap φ I
  -- to φ(x) * φ(y) * φ(x)⁻¹ ∈ I,
  simp,
  -- Apply the conjecture that the image I is a normal subgroup
  apply hn.conj_mem,
  -- φ(y) is in the image, thus proving the claim
  exact hyInPreim,
end

end my_kernel_norm_sub


/-
Copyright (c) 2019 Neil Strickland.  All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

This file sets up a version of the Euclidean algorithm that works
only with natural numbers.  Given a, b > 0, it computes the unique
system (w, x, y, z, d) such that the following identities hold:

 w * z = x * y + 1
 a = (w + x) d
 b = (y + z) d

These equations force w, z, d > 0.  They also imply that
the integers a' = w + x = a / d and b' = y + z = b / d are coprime,
and that d is the gcd of a and b.

This story is closely related to the structure of SL₂(ℕ) (as a
free monoid on two generators) and the theory of continued fractions.
-/
import tactic.ring
import tactic.abel
import data.pnat.prime

namespace pnat
open nat pnat

/-- A term of xgcd_type is a system of six naturals.  They should
 be thought of as representing the matrix
 [[w, x], [y, z]] = [[wp + 1, x], [y, zp + 1]]
 together with the vector [a, b] = [ap + 1, bp + 1].
-/
@[derive inhabited]
structure xgcd_type :=
(wp x y zp ap bp : ℕ)

namespace xgcd_type

variable (u : xgcd_type)

instance : has_sizeof xgcd_type := ⟨λ u, u.bp⟩

/-- The has_repr instance converts terms to strings in a way that
 reflects the matrix/vector interpretation as above. -/
instance : has_repr xgcd_type :=
⟨λ u, "[[[" ++ (repr (u.wp + 1)) ++ ", " ++ (repr u.x) ++
      "], [" ++ (repr u.y) ++ ", " ++ (repr (u.zp + 1)) ++ "]], [" ++
      (repr (u.ap + 1)) ++ ", " ++ (repr (u.bp + 1)) ++ "]]"⟩

def mk' (w : ℕ+) (x : ℕ) (y : ℕ) (z : ℕ+) (a : ℕ+) (b : ℕ+) : xgcd_type :=
mk w.val.pred x y z.val.pred a.val.pred b.val.pred

def w : ℕ+ := succ_pnat u.wp
def z : ℕ+ := succ_pnat u.zp
def a : ℕ+ := succ_pnat u.ap
def b : ℕ+ := succ_pnat u.bp
def r : ℕ := (u.ap + 1) % (u.bp + 1)
def q : ℕ := (u.ap + 1) / (u.bp + 1)
def qp : ℕ := u.q - 1

/-- The map v gives the product of the matrix
 [[w, x], [y, z]] = [[wp + 1, x], [y, zp + 1]]
 and the vector [a, b] = [ap + 1, bp + 1].  The map
 vp gives [sp, tp] such that v = [sp + 1, tp + 1].
-/
def vp : ℕ × ℕ :=
⟨ u.wp + u.x + u.ap + u.wp * u.ap + u.x * u.bp,
  u.y + u.zp + u.bp + u.y * u.ap + u.zp * u.bp ⟩

def v : ℕ × ℕ := ⟨u.w * u.a + u.x * u.b, u.y * u.a + u.z * u.b⟩
def succ₂ (t : ℕ × ℕ) : ℕ × ℕ := ⟨t.1.succ, t.2.succ⟩

theorem v_eq_succ_vp : u.v = succ₂ u.vp :=
by { ext; dsimp [v, vp, w, z, a, b, succ₂];
     repeat { rw [nat.succ_eq_add_one] }; ring }

/-- is_special holds if the matrix has determinant one. -/
def is_special : Prop := u.wp + u.zp + u.wp * u.zp = u.x * u.y
def is_special' : Prop := u.w * u.z = succ_pnat (u.x * u.y)

theorem is_special_iff : u.is_special ↔ u.is_special' :=
begin
  dsimp [is_special, is_special'],
  split; intro h,
  { apply eq, dsimp [w, z, succ_pnat], rw [← h],
    repeat { rw [nat.succ_eq_add_one] }, ring },
  { apply nat.succ.inj,
    replace h := congr_arg (coe : ℕ+ → ℕ) h,
    rw [mul_coe, w, z] at h,
    repeat { rw [succ_pnat_coe, nat.succ_eq_add_one] at h },
    repeat { rw [nat.succ_eq_add_one] }, rw [← h], ring }
end

/-- is_reduced holds if the two entries in the vector are the
 same.  The reduction algorithm will produce a system with this
 property, whose product vector is the same as for the original
 system. -/
def is_reduced : Prop := u.ap = u.bp
def is_reduced' : Prop := u.a = u.b

theorem is_reduced_iff : u.is_reduced ↔ u.is_reduced' :=
⟨ congr_arg succ_pnat, succ_pnat_inj ⟩

def flip : xgcd_type :=
{ wp := u.zp, x := u.y, y := u.x, zp := u.wp, ap := u.bp, bp := u.ap }

@[simp] theorem flip_w : (flip u).w = u.z := rfl
@[simp] theorem flip_x : (flip u).x = u.y := rfl
@[simp] theorem flip_y : (flip u).y = u.x := rfl
@[simp] theorem flip_z : (flip u).z = u.w := rfl
@[simp] theorem flip_a : (flip u).a = u.b := rfl
@[simp] theorem flip_b : (flip u).b = u.a := rfl

theorem flip_is_reduced : (flip u).is_reduced ↔ u.is_reduced :=
by { dsimp [is_reduced, flip], split; intro h; exact h.symm }

theorem flip_is_special : (flip u).is_special ↔ u.is_special :=
by { dsimp [is_special, flip], rw[mul_comm u.x, mul_comm u.zp, add_comm u.zp] }

theorem flip_v : (flip u).v = (u.v).swap :=
by { dsimp [v], ext, { simp only, ring }, { simp only, ring } }

/-- Properties of division with remainder for a / b.  -/
theorem rq_eq : u.r + (u.bp + 1) * u.q = u.ap + 1 :=
nat.mod_add_div (u.ap + 1) (u.bp + 1)

theorem qp_eq (hr : u.r = 0) : u.q = u.qp + 1 :=
begin
  by_cases hq : u.q = 0,
  { let h := u.rq_eq, rw [hr, hq, mul_zero, add_zero] at h, cases h },
  { exact (nat.succ_pred_eq_of_pos (nat.pos_of_ne_zero hq)).symm }
end

/-- The following function provides the starting point for
 our algorithm.  We will apply an iterative reduction process
 to it, which will produce a system satisfying is_reduced.
 The gcd can be read off from this final system.
-/
def start (a b : ℕ+) : xgcd_type := ⟨0, 0, 0, 0, a - 1, b - 1⟩

theorem start_is_special (a b : ℕ+) : (start a b).is_special :=
by { dsimp [start, is_special], refl }

theorem start_v (a b : ℕ+) : (start a b).v = ⟨a, b⟩ :=
begin
  dsimp [start, v, xgcd_type.a, xgcd_type.b, w, z],
  rw [one_mul, one_mul, zero_mul, zero_mul, zero_add, add_zero],
  rw [← nat.pred_eq_sub_one, ← nat.pred_eq_sub_one],
  rw [nat.succ_pred_eq_of_pos a.pos, nat.succ_pred_eq_of_pos b.pos]
end

def finish : xgcd_type :=
xgcd_type.mk u.wp ((u.wp + 1) * u.qp + u.x) u.y (u.y * u.qp + u.zp) u.bp u.bp

theorem finish_is_reduced : u.finish.is_reduced :=
by { dsimp [is_reduced], refl }

theorem finish_is_special (hs : u.is_special) : u.finish.is_special :=
begin
  dsimp [is_special, finish] at hs ⊢,
  rw [add_mul _ _ u.y, add_comm _ (u.x * u.y), ← hs],
  ring
end

theorem finish_v (hr : u.r = 0) : u.finish.v = u.v :=
begin
  let ha : u.r + u.b * u.q = u.a := u.rq_eq,
  rw [hr, zero_add] at ha,
  ext,
  { change (u.wp + 1) * u.b + ((u.wp + 1) * u.qp + u.x) * u.b = u.w * u.a + u.x * u.b,
    have : u.wp + 1 = u.w := rfl, rw [this, ← ha, u.qp_eq hr], ring },
  { change u.y * u.b + (u.y * u.qp + u.z) * u.b = u.y * u.a + u.z * u.b,
    rw [← ha, u.qp_eq hr], ring }
end

/-- This is the main reduction step, which is used when u.r ≠ 0, or
 equivalently b does not divide a. -/
def step : xgcd_type :=
xgcd_type.mk (u.y * u.q + u.zp) u.y ((u.wp + 1) * u.q + u.x) u.wp u.bp (u.r - 1)

/-- We will apply the above step recursively.  The following result
 is used to ensure that the process terminates. -/
theorem step_wf (hr : u.r ≠ 0) : sizeof u.step < sizeof u :=
begin
  change u.r - 1 < u.bp,
  have h₀ : (u.r - 1) + 1 = u.r := nat.succ_pred_eq_of_pos (nat.pos_of_ne_zero hr),
  have h₁ : u.r < u.bp + 1 := nat.mod_lt (u.ap + 1) u.bp.succ_pos,
  rw[← h₀] at h₁,
  exact lt_of_succ_lt_succ h₁,
end

theorem step_is_special (hs : u.is_special) : u.step.is_special :=
begin
  dsimp [is_special, step] at hs ⊢,
  rw [mul_add, mul_comm u.y u.x, ← hs],
  ring
end

/-- The reduction step does not change the product vector. -/
theorem step_v (hr : u.r ≠ 0) : u.step.v = (u.v).swap :=
begin
  let ha : u.r + u.b * u.q = u.a := u.rq_eq,
  let hr : (u.r - 1) + 1 = u.r :=
    (add_comm _ 1).trans (nat.add_sub_of_le (nat.pos_of_ne_zero hr)),
  ext,
  { change ((u.y * u.q + u.z) * u.b + u.y * (u.r - 1 + 1) : ℕ) = u.y * u.a + u.z * u.b,
    rw [← ha, hr], ring },
  { change ((u.w * u.q + u.x) * u.b + u.w * (u.r - 1 + 1) : ℕ) = u.w * u.a + u.x * u.b,
    rw [← ha, hr], ring }
end

/-- We can now define the full reduction function, which applies
 step as long as possible, and then applies finish. Note that the
 "have" statement puts a fact in the local context, and the
 equation compiler uses this fact to help construct the full
 definition in terms of well-founded recursion.  The same fact
 needs to be introduced in all the inductive proofs of properties
 given below. -/
def reduce : xgcd_type → xgcd_type
| u := dite (u.r = 0)
    (λ h, u.finish)
    (λ h, have sizeof u.step < sizeof u, from u.step_wf h,
     flip (reduce u.step))

theorem reduce_a {u : xgcd_type} (h : u.r = 0) :
u.reduce = u.finish := by { rw [reduce], simp only, rw [if_pos h] }

theorem reduce_b {u : xgcd_type} (h : u.r ≠ 0) :
u.reduce = u.step.reduce.flip := by { rw [reduce], simp only, rw [if_neg h, step] }

theorem reduce_reduced : ∀ (u : xgcd_type), u.reduce.is_reduced
| u := dite (u.r = 0) (λ h, by { rw [reduce_a h], exact u.finish_is_reduced })
    (λ h,  have sizeof u.step < sizeof u, from u.step_wf h,
     by { rw [reduce_b h, flip_is_reduced], apply reduce_reduced })

theorem reduce_reduced' (u : xgcd_type) : u.reduce.is_reduced' :=
(is_reduced_iff _).mp u.reduce_reduced

theorem reduce_special : ∀ (u : xgcd_type), u.is_special → u.reduce.is_special
| u := dite (u.r = 0)
    (λ h hs, by { rw [reduce_a h], exact u.finish_is_special hs })
    (λ h hs, have sizeof u.step < sizeof u, from u.step_wf h,
     by { rw [reduce_b h],
          exact (flip_is_special _).mpr (reduce_special _ (u.step_is_special hs)) })

theorem reduce_special' (u : xgcd_type) (hs : u.is_special) : u.reduce.is_special' :=
(is_special_iff _).mp (u.reduce_special hs)

theorem reduce_v : ∀ (u : xgcd_type), u.reduce.v = u.v
| u := dite (u.r = 0)
 (λ h, by {rw[reduce_a h, finish_v u h]})
 (λ h, have sizeof u.step < sizeof u, from u.step_wf h,
       by { rw[reduce_b h, flip_v, reduce_v (step u), step_v u h, prod.swap_swap] })

end xgcd_type

section gcd

variables (a b : ℕ+)

def xgcd: xgcd_type := (xgcd_type.start a b).reduce

def gcd_d : ℕ+ := (xgcd a b).a
def gcd_w : ℕ+ := (xgcd a b).w
def gcd_x : ℕ  := (xgcd a b).x
def gcd_y : ℕ  := (xgcd a b).y
def gcd_z : ℕ+ := (xgcd a b).z

def gcd_a' : ℕ+ := succ_pnat ((xgcd a b).wp + (xgcd a b).x)
def gcd_b' : ℕ+ := succ_pnat ((xgcd a b).y + (xgcd a b).zp)

theorem gcd_a'_coe : ((gcd_a' a b) : ℕ) = (gcd_w a b) + (gcd_x a b) :=
by { dsimp [gcd_a', gcd_x, gcd_w, xgcd_type.w],
     rw [nat.succ_eq_add_one, nat.succ_eq_add_one, add_right_comm] }

theorem gcd_b'_coe : ((gcd_b' a b) : ℕ) = (gcd_y a b) + (gcd_z a b) :=
by { dsimp [gcd_b', gcd_y, gcd_z, xgcd_type.z],
     rw [nat.succ_eq_add_one, nat.succ_eq_add_one, add_assoc] }

theorem gcd_props :
 let d := gcd_d a b,
  w := gcd_w a b, x := gcd_x a b, y := gcd_y a b, z := gcd_z a b,
  a' := gcd_a' a b, b' := gcd_b' a b in
 (w * z = succ_pnat (x * y) ∧
  (a = a' * d) ∧ (b = b' * d) ∧
  z * a' = succ_pnat (x * b') ∧ w * b' = succ_pnat (y * a') ∧
  (z * a : ℕ) = x * b + d ∧ (w * b : ℕ) = y * a + d
 ) :=
begin
  intros,
  let u := (xgcd_type.start a b),
  let ur := u.reduce,
  have ha : d = ur.a := rfl,
  have hb : d = ur.b := u.reduce_reduced',
  have ha' : (a' : ℕ) = w + x := gcd_a'_coe a b,
  have hb' : (b' : ℕ) = y + z := gcd_b'_coe a b,
  have hdet : w * z = succ_pnat (x * y) := u.reduce_special' rfl,
  split, exact hdet,
  have hdet' : ((w * z) : ℕ) = x * y + 1 :=
    by { rw [← mul_coe, hdet, succ_pnat_coe] },
  have huv : u.v = ⟨a, b⟩ := (xgcd_type.start_v a b),
  let hv : prod.mk (w * d + x * ur.b : ℕ) (y * d + z * ur.b : ℕ) = ⟨a, b⟩ :=
   u.reduce_v.trans (xgcd_type.start_v a b),
  rw [← hb, ← add_mul, ← add_mul, ← ha', ← hb'] at hv,
  have ha'' : (a : ℕ) = a' * d := (congr_arg prod.fst hv).symm,
  have hb'' : (b : ℕ) = b' * d := (congr_arg prod.snd hv).symm,
  split, exact eq ha'', split, exact eq hb'',
  have hza' : (z * a' : ℕ) = x * b' + 1,
  by { rw [ha', hb', mul_add, mul_add, mul_comm (z : ℕ), hdet'], ring },
  have hwb' : (w * b' : ℕ) = y * a' + 1,
  by { rw [ha', hb', mul_add, mul_add, hdet'], ring },
  split,
  { apply eq, rw [succ_pnat_coe, nat.succ_eq_add_one, mul_coe, hza'] },
  split,
  { apply eq, rw [succ_pnat_coe, nat.succ_eq_add_one, mul_coe, hwb'] },
  rw [ha'', hb''], repeat { rw [← mul_assoc] }, rw [hza', hwb'],
  split; ring,
end

theorem gcd_eq : gcd_d a b = gcd a b :=
begin
  rcases gcd_props a b with ⟨h₀, h₁, h₂, h₃, h₄, h₅, h₆⟩,
  apply dvd_antisymm,
  { apply dvd_gcd,
    exact dvd.intro (gcd_a' a b) (h₁.trans (mul_comm _ _)).symm,
    exact dvd.intro (gcd_b' a b) (h₂.trans (mul_comm _ _)).symm},
  { have h₇ : (gcd a b : ℕ) ∣ (gcd_z a b) * a :=
      dvd_trans (nat.gcd_dvd_left a b) (dvd_mul_left _ _),
    have h₈ : (gcd a b : ℕ) ∣ (gcd_x a b) * b :=
      dvd_trans (nat.gcd_dvd_right a b) (dvd_mul_left _ _),
    rw[h₅] at h₇, rw dvd_iff,
    exact (nat.dvd_add_iff_right h₈).mpr h₇,}
end

theorem gcd_det_eq :
  (gcd_w a b) * (gcd_z a b) = succ_pnat ((gcd_x a b) * (gcd_y a b)) :=
(gcd_props a b).1

theorem gcd_b_eq : b = (gcd_b' a b) * (gcd a b) :=
(gcd_eq a b) ▸ (gcd_props a b).2.2.1

theorem gcd_rel_left' :
  (gcd_z a b) * (gcd_a' a b) = succ_pnat ((gcd_x a b) * (gcd_b' a b)) :=
(gcd_props a b).2.2.2.1

theorem gcd_rel_right' :
  (gcd_w a b) * (gcd_b' a b) = succ_pnat ((gcd_y a b) * (gcd_a' a b)) :=
(gcd_props a b).2.2.2.2.1

theorem gcd_rel_left :
  ((gcd_z a b) * a : ℕ) = (gcd_x a b) * b + (gcd a b) :=
(gcd_eq a b) ▸ (gcd_props a b).2.2.2.2.2.1

theorem gcd_rel_right :
  ((gcd_w a b) * b : ℕ) = (gcd_y a b) * a + (gcd a b) :=
(gcd_eq a b) ▸ (gcd_props a b).2.2.2.2.2.2

end gcd
end pnat


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.inner_product_space.basic
import analysis.special_functions.sqrt

/-!
# Derivative of the inner product

In this file we prove that the inner product and square of the norm in an inner space are
infinitely `ℝ`-smooth. In order to state these results, we need a `normed_space ℝ E`
instance. Though we can deduce this structure from `inner_product_space 𝕜 E`, this instance may be
not definitionally equal to some other “natural” instance. So, we assume `[normed_space ℝ E]` and
`[is_scalar_tower ℝ 𝕜 E]`. In both interesting cases `𝕜 = ℝ` and `𝕜 = ℂ` we have these instances.

-/

noncomputable theory

open is_R_or_C real filter
open_locale big_operators classical topological_space

variables {𝕜 E F : Type*} [is_R_or_C 𝕜]
variables [inner_product_space 𝕜 E] [inner_product_space ℝ F]
local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y

variables [normed_space ℝ E] [is_scalar_tower ℝ 𝕜 E]

/-- Derivative of the inner product. -/
def fderiv_inner_clm (p : E × E) : E × E →L[ℝ] 𝕜 := is_bounded_bilinear_map_inner.deriv p

@[simp] lemma fderiv_inner_clm_apply (p x : E × E) :
  fderiv_inner_clm  p x = ⟪p.1, x.2⟫ + ⟪x.1, p.2⟫ := rfl

lemma times_cont_diff_inner {n} : times_cont_diff ℝ n (λ p : E × E, ⟪p.1, p.2⟫) :=
is_bounded_bilinear_map_inner.times_cont_diff

lemma times_cont_diff_at_inner {p : E × E} {n} :
  times_cont_diff_at ℝ n (λ p : E × E, ⟪p.1, p.2⟫) p :=
times_cont_diff_inner.times_cont_diff_at

lemma differentiable_inner : differentiable ℝ (λ p : E × E, ⟪p.1, p.2⟫) :=
is_bounded_bilinear_map_inner.differentiable_at

variables {G : Type*} [normed_group G] [normed_space ℝ G]
  {f g : G → E} {f' g' : G →L[ℝ] E} {s : set G} {x : G} {n : with_top ℕ}

include 𝕜

lemma times_cont_diff_within_at.inner (hf : times_cont_diff_within_at ℝ n f s x)
  (hg : times_cont_diff_within_at ℝ n g s x) :
  times_cont_diff_within_at ℝ n (λ x, ⟪f x, g x⟫) s x :=
times_cont_diff_at_inner.comp_times_cont_diff_within_at x (hf.prod hg)

lemma times_cont_diff_at.inner (hf : times_cont_diff_at ℝ n f x)
  (hg : times_cont_diff_at ℝ n g x) :
  times_cont_diff_at ℝ n (λ x, ⟪f x, g x⟫) x :=
hf.inner hg

lemma times_cont_diff_on.inner (hf : times_cont_diff_on ℝ n f s) (hg : times_cont_diff_on ℝ n g s) :
  times_cont_diff_on ℝ n (λ x, ⟪f x, g x⟫) s :=
λ x hx, (hf x hx).inner (hg x hx)

lemma times_cont_diff.inner (hf : times_cont_diff ℝ n f) (hg : times_cont_diff ℝ n g) :
  times_cont_diff ℝ n (λ x, ⟪f x, g x⟫) :=
times_cont_diff_inner.comp (hf.prod hg)

lemma has_fderiv_within_at.inner (hf : has_fderiv_within_at f f' s x)
  (hg : has_fderiv_within_at g g' s x) :
  has_fderiv_within_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm (f x, g x)).comp $ f'.prod g') s x :=
(is_bounded_bilinear_map_inner.has_fderiv_at (f x, g x)).comp_has_fderiv_within_at x (hf.prod hg)

lemma has_strict_fderiv_at.inner (hf : has_strict_fderiv_at f f' x)
  (hg : has_strict_fderiv_at g g' x) :
  has_strict_fderiv_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm (f x, g x)).comp $ f'.prod g') x :=
(is_bounded_bilinear_map_inner.has_strict_fderiv_at (f x, g x)).comp x (hf.prod hg)

lemma has_fderiv_at.inner (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) :
  has_fderiv_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm (f x, g x)).comp $ f'.prod g') x :=
(is_bounded_bilinear_map_inner.has_fderiv_at (f x, g x)).comp x (hf.prod hg)

lemma has_deriv_within_at.inner {f g : ℝ → E} {f' g' : E} {s : set ℝ} {x : ℝ}
  (hf : has_deriv_within_at f f' s x) (hg : has_deriv_within_at g g' s x) :
  has_deriv_within_at (λ t, ⟪f t, g t⟫) (⟪f x, g'⟫ + ⟪f', g x⟫) s x :=
by simpa using (hf.has_fderiv_within_at.inner hg.has_fderiv_within_at).has_deriv_within_at

lemma has_deriv_at.inner {f g : ℝ → E} {f' g' : E} {x : ℝ} :
  has_deriv_at f f' x →  has_deriv_at g g' x →
  has_deriv_at (λ t, ⟪f t, g t⟫) (⟪f x, g'⟫ + ⟪f', g x⟫) x :=
by simpa only [← has_deriv_within_at_univ] using has_deriv_within_at.inner

lemma differentiable_within_at.inner (hf : differentiable_within_at ℝ f s x)
  (hg : differentiable_within_at ℝ g s x) :
  differentiable_within_at ℝ (λ x, ⟪f x, g x⟫) s x :=
((differentiable_inner _).has_fderiv_at.comp_has_fderiv_within_at x
  (hf.prod hg).has_fderiv_within_at).differentiable_within_at

lemma differentiable_at.inner (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) :
  differentiable_at ℝ (λ x, ⟪f x, g x⟫) x :=
(differentiable_inner _).comp x (hf.prod hg)

lemma differentiable_on.inner (hf : differentiable_on ℝ f s) (hg : differentiable_on ℝ g s) :
  differentiable_on ℝ (λ x, ⟪f x, g x⟫) s :=
λ x hx, (hf x hx).inner (hg x hx)

lemma differentiable.inner (hf : differentiable ℝ f) (hg : differentiable ℝ g) :
  differentiable ℝ (λ x, ⟪f x, g x⟫) :=
λ x, (hf x).inner (hg x)

lemma fderiv_inner_apply (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) (y : G) :
  fderiv ℝ (λ t, ⟪f t, g t⟫) x y = ⟪f x, fderiv ℝ g x y⟫ + ⟪fderiv ℝ f x y, g x⟫ :=
by { rw [(hf.has_fderiv_at.inner hg.has_fderiv_at).fderiv], refl }

lemma deriv_inner_apply {f g : ℝ → E} {x : ℝ} (hf : differentiable_at ℝ f x)
  (hg : differentiable_at ℝ g x) :
  deriv (λ t, ⟪f t, g t⟫) x = ⟪f x, deriv g x⟫ + ⟪deriv f x, g x⟫ :=
(hf.has_deriv_at.inner hg.has_deriv_at).deriv

lemma times_cont_diff_norm_sq : times_cont_diff ℝ n (λ x : E, ∥x∥ ^ 2) :=
begin
  simp only [sq, ← inner_self_eq_norm_mul_norm],
  exact (re_clm : 𝕜 →L[ℝ] ℝ).times_cont_diff.comp (times_cont_diff_id.inner times_cont_diff_id)
end

lemma times_cont_diff.norm_sq (hf : times_cont_diff ℝ n f) :
  times_cont_diff ℝ n (λ x, ∥f x∥ ^ 2) :=
times_cont_diff_norm_sq.comp hf

lemma times_cont_diff_within_at.norm_sq (hf : times_cont_diff_within_at ℝ n f s x) :
  times_cont_diff_within_at ℝ n (λ y, ∥f y∥ ^ 2) s x :=
times_cont_diff_norm_sq.times_cont_diff_at.comp_times_cont_diff_within_at x hf

lemma times_cont_diff_at.norm_sq (hf : times_cont_diff_at ℝ n f x) :
  times_cont_diff_at ℝ n (λ y, ∥f y∥ ^ 2) x :=
hf.norm_sq

lemma times_cont_diff_at_norm {x : E} (hx : x ≠ 0) : times_cont_diff_at ℝ n norm x :=
have ∥id x∥ ^ 2 ≠ 0, from pow_ne_zero _ (norm_pos_iff.2 hx).ne',
by simpa only [id, sqrt_sq, norm_nonneg] using times_cont_diff_at_id.norm_sq.sqrt this

lemma times_cont_diff_at.norm (hf : times_cont_diff_at ℝ n f x) (h0 : f x ≠ 0) :
  times_cont_diff_at ℝ n (λ y, ∥f y∥) x :=
(times_cont_diff_at_norm h0).comp x hf

lemma times_cont_diff_at.dist (hf : times_cont_diff_at ℝ n f x) (hg : times_cont_diff_at ℝ n g x)
  (hne : f x ≠ g x) :
  times_cont_diff_at ℝ n (λ y, dist (f y) (g y)) x :=
by { simp only [dist_eq_norm], exact (hf.sub hg).norm (sub_ne_zero.2 hne) }

lemma times_cont_diff_within_at.norm (hf : times_cont_diff_within_at ℝ n f s x) (h0 : f x ≠ 0) :
  times_cont_diff_within_at ℝ n (λ y, ∥f y∥) s x :=
(times_cont_diff_at_norm h0).comp_times_cont_diff_within_at x hf

lemma times_cont_diff_within_at.dist (hf : times_cont_diff_within_at ℝ n f s x)
  (hg : times_cont_diff_within_at ℝ n g s x) (hne : f x ≠ g x) :
  times_cont_diff_within_at ℝ n (λ y, dist (f y) (g y)) s x :=
by { simp only [dist_eq_norm], exact (hf.sub hg).norm (sub_ne_zero.2 hne) }

lemma times_cont_diff_on.norm_sq (hf : times_cont_diff_on ℝ n f s) :
  times_cont_diff_on ℝ n (λ y, ∥f y∥ ^ 2) s :=
(λ x hx, (hf x hx).norm_sq)

lemma times_cont_diff_on.norm (hf : times_cont_diff_on ℝ n f s) (h0 : ∀ x ∈ s, f x ≠ 0) :
  times_cont_diff_on ℝ n (λ y, ∥f y∥) s :=
λ x hx, (hf x hx).norm (h0 x hx)

lemma times_cont_diff_on.dist (hf : times_cont_diff_on ℝ n f s)
  (hg : times_cont_diff_on ℝ n g s) (hne : ∀ x ∈ s, f x ≠ g x) :
  times_cont_diff_on ℝ n (λ y, dist (f y) (g y)) s :=
λ x hx, (hf x hx).dist (hg x hx) (hne x hx)

lemma times_cont_diff.norm (hf : times_cont_diff ℝ n f) (h0 : ∀ x, f x ≠ 0) :
  times_cont_diff ℝ n (λ y, ∥f y∥) :=
times_cont_diff_iff_times_cont_diff_at.2 $ λ x, hf.times_cont_diff_at.norm (h0 x)

lemma times_cont_diff.dist (hf : times_cont_diff ℝ n f) (hg : times_cont_diff ℝ n g)
  (hne : ∀ x, f x ≠ g x) :
  times_cont_diff ℝ n (λ y, dist (f y) (g y)) :=
times_cont_diff_iff_times_cont_diff_at.2 $
  λ x, hf.times_cont_diff_at.dist hg.times_cont_diff_at (hne x)

omit 𝕜
lemma has_strict_fderiv_at_norm_sq (x : F) :
  has_strict_fderiv_at (λ x, ∥x∥ ^ 2) (bit0 (inner_right x)) x :=
begin
  simp only [sq, ← inner_self_eq_norm_mul_norm],
  convert (has_strict_fderiv_at_id x).inner (has_strict_fderiv_at_id x),
  ext y,
  simp [bit0, real_inner_comm],
end
include 𝕜

lemma differentiable_at.norm_sq (hf : differentiable_at ℝ f x) :
  differentiable_at ℝ (λ y, ∥f y∥ ^ 2) x :=
(times_cont_diff_at_id.norm_sq.differentiable_at le_rfl).comp x hf

lemma differentiable_at.norm (hf : differentiable_at ℝ f x) (h0 : f x ≠ 0) :
  differentiable_at ℝ (λ y, ∥f y∥) x :=
((times_cont_diff_at_norm h0).differentiable_at le_rfl).comp x hf

lemma differentiable_at.dist (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x)
  (hne : f x ≠ g x) :
  differentiable_at ℝ (λ y, dist (f y) (g y)) x :=
by { simp only [dist_eq_norm], exact (hf.sub hg).norm (sub_ne_zero.2 hne) }

lemma differentiable.norm_sq (hf : differentiable ℝ f) : differentiable ℝ (λ y, ∥f y∥ ^ 2) :=
λ x, (hf x).norm_sq

lemma differentiable.norm (hf : differentiable ℝ f) (h0 : ∀ x, f x ≠ 0) :
  differentiable ℝ (λ y, ∥f y∥) :=
λ x, (hf x).norm (h0 x)

lemma differentiable.dist (hf : differentiable ℝ f) (hg : differentiable ℝ g)
  (hne : ∀ x, f x ≠ g x) :
  differentiable ℝ (λ y, dist (f y) (g y)) :=
λ x, (hf x).dist (hg x) (hne x)

lemma differentiable_within_at.norm_sq (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ y, ∥f y∥ ^ 2) s x :=
(times_cont_diff_at_id.norm_sq.differentiable_at le_rfl).comp_differentiable_within_at x hf

lemma differentiable_within_at.norm (hf : differentiable_within_at ℝ f s x) (h0 : f x ≠ 0) :
  differentiable_within_at ℝ (λ y, ∥f y∥) s x :=
((times_cont_diff_at_id.norm h0).differentiable_at le_rfl).comp_differentiable_within_at x hf

lemma differentiable_within_at.dist (hf : differentiable_within_at ℝ f s x)
  (hg : differentiable_within_at ℝ g s x) (hne : f x ≠ g x) :
  differentiable_within_at ℝ (λ y, dist (f y) (g y)) s x :=
by { simp only [dist_eq_norm], exact (hf.sub hg).norm (sub_ne_zero.2 hne) }

lemma differentiable_on.norm_sq (hf : differentiable_on ℝ f s) :
  differentiable_on ℝ (λ y, ∥f y∥ ^ 2) s :=
λ x hx, (hf x hx).norm_sq

lemma differentiable_on.norm (hf : differentiable_on ℝ f s) (h0 : ∀ x ∈ s, f x ≠ 0) :
  differentiable_on ℝ (λ y, ∥f y∥) s :=
λ x hx, (hf x hx).norm (h0 x hx)

lemma differentiable_on.dist (hf : differentiable_on ℝ f s) (hg : differentiable_on ℝ g s)
  (hne : ∀ x ∈ s, f x ≠ g x) :
  differentiable_on ℝ (λ y, dist (f y) (g y)) s :=
λ x hx, (hf x hx).dist (hg x hx) (hne x hx)