/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.complex.abs_max
import analysis.asymptotics.superpolynomial_decay

/-!
# Phragmen-Lindelöf principle

In this file we prove several versions of the Phragmen-Lindelöf principle, a version of the maximum
modulus principle for an unbounded domain.

## Main statements

* `phragmen_lindelof.horizontal_strip`: the Phragmen-Lindelöf principle in a horizontal strip
  `{z : ℂ | a < complex.im z < b}`;

* `phragmen_lindelof.eq_zero_on_horizontal_strip`, `phragmen_lindelof.eq_on_horizontal_strip`:
  extensionality lemmas based on the Phragmen-Lindelöf principle in a horizontal strip;

* `phragmen_lindelof.vertical_strip`: the Phragmen-Lindelöf principle in a vertical strip
  `{z : ℂ | a < complex.re z < b}`;

* `phragmen_lindelof.eq_zero_on_vertical_strip`, `phragmen_lindelof.eq_on_vertical_strip`:
  extensionality lemmas based on the Phragmen-Lindelöf principle in a vertical strip;

* `phragmen_lindelof.quadrant_I`, `phragmen_lindelof.quadrant_II`, `phragmen_lindelof.quadrant_III`,
  `phragmen_lindelof.quadrant_IV`: the Phragmen-Lindelöf principle in the coordinate quadrants;

* `phragmen_lindelof.right_half_plane_of_tendsto_zero_on_real`,
  `phragmen_lindelof.right_half_plane_of_bounded_on_real`: two versions of the Phragmen-Lindelöf
  principle in the right half-plane;

* `phragmen_lindelof.eq_zero_on_right_half_plane_of_superexponential_decay`,
  `phragmen_lindelof.eq_on_right_half_plane_of_superexponential_decay`: extensionality lemmas based
  on the Phragmen-Lindelöf principle in the right half-plane.

In the case of the right half-plane, we prove a version of the Phragmen-Lindelöf principle that is
useful for Ilyashenko's proof of the individual finiteness theorem (a polynomial vector field on the
real plane has only finitely many limit cycles).
-/

open set function filter asymptotics metric complex
open_locale topological_space filter real

local notation `expR` := real.exp

namespace phragmen_lindelof

/-!
### Auxiliary lemmas
-/

variables {E : Type*} [normed_group E]

/-- An auxiliary lemma that combines two double exponential estimates into a similar estimate
on the difference of the functions. -/
lemma is_O_sub_exp_exp {a : ℝ} {f g : ℂ → E} {l : filter ℂ} {u : ℂ → ℝ}
  (hBf : ∃ (c < a) B, f =O[l] (λ z, expR (B * expR (c * |u z|))))
  (hBg : ∃ (c < a) B, g =O[l] (λ z, expR (B * expR (c * |u z|)))) :
  ∃ (c < a) B, (f - g) =O[l] (λ z, expR (B * expR (c * |u z|))) :=
begin
  have : ∀ {c₁ c₂ B₁ B₂}, c₁ ≤ c₂ → 0 ≤ B₂ → B₁ ≤ B₂ → ∀ z,
    ∥expR (B₁ * expR (c₁ * |u z|))∥ ≤ ∥expR (B₂ * expR (c₂ * |u z|))∥,
  { intros c₁ c₂ B₁ B₂ hc hB₀ hB z,
    rw [real.norm_eq_abs, real.norm_eq_abs, real.abs_exp, real.abs_exp, real.exp_le_exp],
    exact mul_le_mul hB (real.exp_le_exp.2 $ mul_le_mul_of_nonneg_right hc $ abs_nonneg _)
      (real.exp_pos _).le hB₀ },
  rcases hBf with ⟨cf, hcf, Bf, hOf⟩, rcases hBg with ⟨cg, hcg, Bg, hOg⟩,
  refine ⟨max cf cg, max_lt hcf hcg, max 0 (max Bf Bg), _⟩,
  refine (hOf.trans_le $ this _ _ _).sub (hOg.trans_le $ this _ _ _),
  exacts [le_max_left _ _, le_max_left _ _, (le_max_left _ _).trans (le_max_right _ _),
    le_max_right _ _, le_max_left _ _, (le_max_right _ _).trans (le_max_right _ _)]
end

/-- An auxiliary lemma that combines two “exponential of a power” estimates into a similar estimate
on the difference of the functions. -/
lemma is_O_sub_exp_rpow {a : ℝ} {f g : ℂ → E} {l : filter ℂ}
  (hBf : ∃ (c < a) B, f =O[comap complex.abs at_top ⊓ l] (λ z, expR (B * (abs z) ^ c)))
  (hBg : ∃ (c < a) B, g =O[comap complex.abs at_top ⊓ l] (λ z, expR (B * (abs z) ^ c))) :
  ∃ (c < a) B, (f - g) =O[comap complex.abs at_top ⊓ l] (λ z, expR (B * (abs z) ^ c)) :=
begin
  have : ∀ {c₁ c₂ B₁ B₂ : ℝ}, c₁ ≤ c₂ → 0 ≤ B₂ → B₁ ≤ B₂ →
    (λ z : ℂ, expR (B₁ * (abs z) ^ c₁)) =O[comap complex.abs at_top ⊓ l]
      (λ z, expR (B₂ * (abs z) ^ c₂)),
  { have : ∀ᶠ z : ℂ in comap abs at_top ⊓ l, 1 ≤ abs z,
      from ((eventually_ge_at_top 1).comap _).filter_mono inf_le_left,
    refine λ c₁ c₂ B₁ B₂ hc hB₀ hB, is_O.of_bound 1 (this.mono $ λ z hz, _),
    rw [one_mul, real.norm_eq_abs, real.norm_eq_abs, real.abs_exp, real.abs_exp, real.exp_le_exp],
    exact mul_le_mul hB (real.rpow_le_rpow_of_exponent_le hz hc)
      (real.rpow_nonneg_of_nonneg (abs_nonneg _) _) hB₀ },
  rcases hBf with ⟨cf, hcf, Bf, hOf⟩, rcases hBg with ⟨cg, hcg, Bg, hOg⟩,
  refine ⟨max cf cg, max_lt hcf hcg, max 0 (max Bf Bg), _⟩,
  refine (hOf.trans $ this _ _ _).sub (hOg.trans $ this _ _ _),
  exacts [le_max_left _ _, le_max_left _ _, (le_max_left _ _).trans (le_max_right _ _),
    le_max_right _ _, le_max_left _ _, (le_max_right _ _).trans (le_max_right _ _)]
end

variables [normed_space ℂ E] {a b C : ℝ} {f g : ℂ → E} {z : ℂ}

/-!
### Phragmen-Lindelöf principle in a horizontal strip
-/

/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < im z < b}`.
Let `f : ℂ → E` be a function such that

* `f` is differentiable on `U` and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * exp(c * |re z|))` on `U` for some `c < π / (b - a)`;
* `∥f z∥` is bounded from above by a constant `C` on the boundary of `U`.

Then `∥f z∥` is bounded by the same constant on the closed strip
`{z : ℂ | a ≤ im z ≤ b}`. Moreover, it suffices to verify the second assumption
only for sufficiently large values of `|re z|`.
-/
lemma horizontal_strip (hfd : diff_cont_on_cl ℂ f (im ⁻¹' Ioo a b))
  (hB : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b)]
    (λ z, expR (B * expR (c * |z.re|))))
  (hle_a : ∀ z : ℂ, im z = a → ∥f z∥ ≤ C) (hle_b : ∀ z, im z = b → ∥f z∥ ≤ C)
  (hza : a ≤ im z) (hzb : im z ≤ b) :
  ∥f z∥ ≤ C :=
begin
  -- If `im z = a` or `im z = b`, then we apply `hle_a` or `hle_b`, otherwise `im z ∈ Ioo a b`.
  rw le_iff_eq_or_lt at hza hzb,
  cases hza with hza hza, { exact hle_a _ hza.symm },
  cases hzb with hzb hzb, { exact hle_b _ hzb },
  -- WLOG, `0 < C`.
  suffices : ∀ C' : ℝ, 0 < C' → (∀ w : ℂ, im w = a → ∥f w∥ ≤ C') →
    (∀ w : ℂ, im w = b → ∥f w∥ ≤ C') → ∥f z∥ ≤ C',
  { refine le_of_forall_le_of_dense (λ C' hC', this C' _ (λ w hw, _) (λ w hw, _)),
    { refine ((norm_nonneg (f (a * I))).trans (hle_a _ _)).trans_lt hC',
      rw [mul_I_im, of_real_re] },
    exacts [(hle_a _ hw).trans hC'.le, (hle_b _ hw).trans hC'.le] },
  clear_dependent C, intros C hC₀ hle_a hle_b,
  -- After a change of variables, we deal with the strip `a - b < im z < a + b` instead
  -- of `a < im z < b`
  obtain ⟨a, b, rfl, rfl⟩ : ∃ a' b', a = a' - b' ∧ b = a' + b' :=
    ⟨(a + b) / 2, (b - a) / 2, by ring, by ring⟩,
  have hab : a - b < a + b, from hza.trans hzb,
  have hb : 0 < b,
    by simpa only [sub_eq_add_neg, add_lt_add_iff_left, neg_lt_self_iff] using hab,
  rw [add_sub_sub_cancel, ← two_mul, div_mul_eq_div_div] at hB,
  have hπb : 0 < π / 2 / b, from div_pos real.pi_div_two_pos hb,
  -- Choose some `c B : ℝ` satisfying `hB`, then choose `max c 0 < d < π / 2 / b`.
  rcases hB with ⟨c, hc, B, hO⟩,
  obtain ⟨d, ⟨hcd, hd₀⟩, hd⟩ : ∃ d, (c < d ∧ 0 < d) ∧ d < π / 2 / b,
    by simpa only [max_lt_iff] using exists_between (max_lt hc hπb),
  have hb' : d * b < π / 2, from (lt_div_iff hb).1 hd,
  set aff : ℂ → ℂ := λ w, d * (w - a * I),
  set g : ℝ → ℂ → ℂ := λ ε w, exp (ε * (exp (aff w) + exp (-aff w))),
  /- Since `g ε z → 1` as `ε → 0⁻`, it suffices to prove that `∥g ε z • f z∥ ≤ C`
  for all negative `ε`. -/
  suffices : ∀ᶠ ε : ℝ in 𝓝[<] 0, ∥g ε z • f z∥ ≤ C,
  { refine le_of_tendsto (tendsto.mono_left _ nhds_within_le_nhds) this,
    apply ((continuous_of_real.mul continuous_const).cexp.smul continuous_const).norm.tendsto',
    simp, apply_instance },
  filter_upwards [self_mem_nhds_within] with ε ε₀, change ε < 0 at ε₀,
  -- An upper estimate on `∥g ε w∥` that will be used in two branches of the proof.
  obtain ⟨δ, δ₀, hδ⟩ : ∃ δ : ℝ, δ < 0 ∧ ∀ ⦃w⦄, im w ∈ Icc (a - b) (a + b) →
    abs (g ε w) ≤ expR (δ * expR (d * |re w|)),
  { refine ⟨ε * real.cos (d * b), mul_neg_of_neg_of_pos ε₀ (real.cos_pos_of_mem_Ioo $ abs_lt.1 $
      (abs_of_pos (mul_pos hd₀ hb)).symm ▸ hb'), λ w hw, _⟩,
    replace hw : |im (aff w)| ≤ d * b,
    { rw [← real.closed_ball_eq_Icc] at hw,
      rwa [of_real_mul_im, sub_im, mul_I_im, of_real_re, _root_.abs_mul, abs_of_pos hd₀,
        mul_le_mul_left hd₀] },
    simpa only [of_real_mul_re, _root_.abs_mul, abs_of_pos hd₀, sub_re, mul_I_re, of_real_im,
      zero_mul, neg_zero, sub_zero]
      using abs_exp_mul_exp_add_exp_neg_le_of_abs_im_le ε₀.le hw hb'.le },
  -- `abs (g ε w) ≤ 1` on the lines `w.im = a ± b` (actually, it holds everywhere in the strip)
  have hg₁ : ∀ w, (im w = a - b ∨ im w = a + b) → abs (g ε w) ≤ 1,
  { refine λ w hw, (hδ $ hw.by_cases _ _).trans (real.exp_le_one_iff.2 _),
    exacts [λ h, h.symm ▸ left_mem_Icc.2 hab.le, λ h, h.symm ▸ right_mem_Icc.2 hab.le,
      mul_nonpos_of_nonpos_of_nonneg δ₀.le (real.exp_pos _).le] },
  /- Our apriori estimate on `f` implies that `g ε w • f w → 0` as `|w.re| → ∞` along the strip. In
  particular, its norm is less than or equal to `C` for sufficiently large `|w.re|`. -/
  obtain ⟨R, hzR, hR⟩ : ∃ R : ℝ, |z.re| < R ∧ ∀ w, |re w| = R → im w ∈ Ioo (a - b) (a + b) →
    ∥g ε w • f w∥ ≤ C,
  { refine ((eventually_gt_at_top _).and _).exists,
    rcases hO.exists_pos with ⟨A, hA₀, hA⟩,
    simp only [is_O_with_iff, eventually_inf_principal, eventually_comap, mem_Ioo, ← abs_lt,
      mem_preimage, (∘), real.norm_eq_abs, abs_of_pos (real.exp_pos _)] at hA,
    suffices : tendsto (λ R, expR (δ * expR (d * R) + B * expR (c * R) + real.log A)) at_top (𝓝 0),
    { filter_upwards [this.eventually (ge_mem_nhds hC₀), hA] with R hR Hle w hre him,
      calc ∥g ε w • f w∥ ≤ expR (δ * expR (d * R) + B * expR (c * R) + real.log A) : _
      ... ≤ C : hR,
      rw [norm_smul, real.exp_add, ← hre, real.exp_add, real.exp_log hA₀, mul_assoc, mul_comm _ A],
      exact mul_le_mul (hδ $ Ioo_subset_Icc_self him) (Hle _ hre him) (norm_nonneg _)
        (real.exp_pos _).le },
    refine real.tendsto_exp_at_bot.comp _,
    suffices H : tendsto (λ R, δ + B * (expR ((d - c) * R))⁻¹) at_top (𝓝 (δ + B * 0)),
    { rw [mul_zero, add_zero] at H,
      refine tendsto.at_bot_add _ tendsto_const_nhds,
      simpa only [id, (∘), add_mul, mul_assoc, ← div_eq_inv_mul, ← real.exp_sub,
        ← sub_mul, sub_sub_cancel]
        using H.neg_mul_at_top δ₀ (real.tendsto_exp_at_top.comp $
          tendsto_const_nhds.mul_at_top hd₀ tendsto_id) },
    refine tendsto_const_nhds.add (tendsto_const_nhds.mul _),
    exact tendsto_inv_at_top_zero.comp (real.tendsto_exp_at_top.comp $
      tendsto_const_nhds.mul_at_top (sub_pos.2 hcd) tendsto_id) },
  have hR₀ : 0 < R, from (_root_.abs_nonneg _).trans_lt hzR,
  /- Finally, we apply the bounded version of the maximum modulus principle to the rectangle
  `(-R, R) × (a - b, a + b)`. The function is bounded by `C` on the horizontal sides by assumption
  (and because `∥g ε w∥ ≤ 1`) and on the vertical sides by the choice of `R`. -/
  have hgd : differentiable ℂ (g ε),
    from ((((differentiable_id.sub_const _).const_mul _).cexp.add
      ((differentiable_id.sub_const _).const_mul _).neg.cexp).const_mul _).cexp,
  replace hd : diff_cont_on_cl ℂ (λ w, g ε w • f w) (Ioo (-R) R ×ℂ Ioo (a - b) (a + b)),
    from (hgd.diff_cont_on_cl.smul hfd).mono (inter_subset_right _ _),
  convert norm_le_of_forall_mem_frontier_norm_le ((bounded_Ioo _ _).re_prod_im (bounded_Ioo _ _))
    hd (λ w hw, _) _,
  { have hwc := frontier_subset_closure hw,
    rw [frontier_re_prod_im, closure_Ioo (neg_lt_self hR₀).ne, frontier_Ioo hab,
      closure_Ioo hab.ne, frontier_Ioo (neg_lt_self hR₀)] at hw,
    by_cases him : w.im = a - b ∨ w.im = a + b,
    { rw [closure_re_prod_im, closure_Ioo (neg_lt_self hR₀).ne] at hwc,
      rw [norm_smul, ← one_mul C],
      exact mul_le_mul (hg₁ _ him) (him.by_cases (hle_a _) (hle_b _)) (norm_nonneg _) zero_le_one },
    { replace hw : w ∈ {-R, R} ×ℂ Icc (a - b) (a + b), from hw.resolve_left (λ h, him h.2),
      have hw' := eq_endpoints_or_mem_Ioo_of_mem_Icc hw.2, rw ← or.assoc at hw',
      exact hR _ ((abs_eq hR₀.le).2 hw.1.symm) (hw'.resolve_left him) } },
  { rw [closure_re_prod_im, closure_Ioo hab.ne, closure_Ioo (neg_lt_self hR₀).ne],
    exact ⟨abs_le.1 hzR.le, ⟨hza.le, hzb.le⟩⟩ }
end

/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < im z < b}`.
Let `f : ℂ → E` be a function such that

* `f` is differentiable on `U` and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * exp(c * |re z|))` on `U` for some `c < π / (b - a)`;
* `f z = 0` on the boundary of `U`.

Then `f` is equal to zero on the closed strip `{z : ℂ | a ≤ im z ≤ b}`.
-/
lemma eq_zero_on_horizontal_strip (hd : diff_cont_on_cl ℂ f (im ⁻¹' Ioo a b))
  (hB : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b)]
    (λ z, expR (B * expR (c * |z.re|))))
  (ha : ∀ z : ℂ, z.im = a → f z = 0) (hb : ∀ z : ℂ, z.im = b → f z = 0) :
  eq_on f 0 (im ⁻¹' Icc a b) :=
λ z hz, norm_le_zero_iff.1 $ horizontal_strip hd hB
  (λ z hz, (ha z hz).symm ▸ norm_zero.le) (λ z hz, (hb z hz).symm ▸ norm_zero.le) hz.1 hz.2

/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < im z < b}`.
Let `f g : ℂ → E` be functions such that

* `f` and `g` are differentiable on `U` and are continuous on its closure;
* `∥f z∥` and `∥g z∥` are bounded from above by `A * exp(B * exp(c * |re z|))` on `U` for some
  `c < π / (b - a)`;
* `f z = g z` on the boundary of `U`.

Then `f` is equal to `g` on the closed strip `{z : ℂ | a ≤ im z ≤ b}`.
-/
lemma eq_on_horizontal_strip {g : ℂ → E} (hdf : diff_cont_on_cl ℂ f (im ⁻¹' Ioo a b))
  (hBf : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b)]
    (λ z, expR (B * expR (c * |z.re|))))
  (hdg : diff_cont_on_cl ℂ g (im ⁻¹' Ioo a b))
  (hBg : ∃ (c < π / (b - a)) B, g =O[comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b)]
    (λ z, expR (B * expR (c * |z.re|))))
  (ha : ∀ z : ℂ, z.im = a → f z = g z) (hb : ∀ z : ℂ, z.im = b → f z = g z) :
  eq_on f g (im ⁻¹' Icc a b) :=
λ z hz, sub_eq_zero.1 (eq_zero_on_horizontal_strip (hdf.sub hdg) (is_O_sub_exp_exp hBf hBg)
  (λ w hw, sub_eq_zero.2 (ha w hw)) (λ w hw, sub_eq_zero.2 (hb w hw)) hz)

/-!
### Phragmen-Lindelöf principle in a vertical strip
-/

/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < re z < b}`.
Let `f : ℂ → E` be a function such that

* `f` is differentiable on `U` and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * exp(c * |im z|))` on `U` for some `c < π / (b - a)`;
* `∥f z∥` is bounded from above by a constant `C` on the boundary of `U`.

Then `∥f z∥` is bounded by the same constant on the closed strip
`{z : ℂ | a ≤ re z ≤ b}`. Moreover, it suffices to verify the second assumption
only for sufficiently large values of `|im z|`.
-/
lemma vertical_strip (hfd : diff_cont_on_cl ℂ f (re ⁻¹' Ioo a b))
  (hB : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)]
    (λ z, expR (B * expR (c * |z.im|))))
  (hle_a : ∀ z : ℂ, re z = a → ∥f z∥ ≤ C) (hle_b : ∀ z, re z = b → ∥f z∥ ≤ C)
  (hza : a ≤ re z) (hzb : re z ≤ b) :
  ∥f z∥ ≤ C :=
begin
  suffices : ∥(λ z, f (z * (-I))) (z * I)∥ ≤ C, by simpa [mul_assoc] using this,
  have H : maps_to (λ z, z * (-I)) (im ⁻¹' Ioo a b) (re ⁻¹' Ioo a b),
  { intros z hz, simpa using hz },
  refine horizontal_strip (hfd.comp (differentiable_id.mul_const _).diff_cont_on_cl H)
    _ (λ z hz, hle_a _ _) (λ z hz, hle_b _ _) _ _,
  { refine Exists₃.imp (λ c hc B hO, _) hB,
    have : tendsto (λ z, z * (-I)) (comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b))
      (comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)),
    { refine (tendsto_comap_iff.2 _).inf H.tendsto,
      simpa [(∘)] using tendsto_comap },
    simpa [(∘)] using hO.comp_tendsto this },
  all_goals { simpa }
end

/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < re z < b}`.
Let `f : ℂ → E` be a function such that

* `f` is differentiable on `U` and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * exp(c * |im z|))` on `U` for some `c < π / (b - a)`;
* `f z = 0` on the boundary of `U`.

Then `f` is equal to zero on the closed strip `{z : ℂ | a ≤ re z ≤ b}`.
-/
lemma eq_zero_on_vertical_strip (hd : diff_cont_on_cl ℂ f (re ⁻¹' Ioo a b))
  (hB : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)]
    (λ z, expR (B * expR (c * |z.im|))))
  (ha : ∀ z : ℂ, re z = a → f z = 0) (hb : ∀ z : ℂ, re z = b → f z = 0) :
  eq_on f 0 (re ⁻¹' Icc a b) :=
λ z hz, norm_le_zero_iff.1 $ vertical_strip hd hB
  (λ z hz, (ha z hz).symm ▸ norm_zero.le) (λ z hz, (hb z hz).symm ▸ norm_zero.le) hz.1 hz.2

/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < re z < b}`.
Let `f g : ℂ → E` be functions such that

* `f` and `g` are differentiable on `U` and are continuous on its closure;
* `∥f z∥` and `∥g z∥` are bounded from above by `A * exp(B * exp(c * |im z|))` on `U` for some
  `c < π / (b - a)`;
* `f z = g z` on the boundary of `U`.

Then `f` is equal to `g` on the closed strip `{z : ℂ | a ≤ re z ≤ b}`.
-/
lemma eq_on_vertical_strip {g : ℂ → E} (hdf : diff_cont_on_cl ℂ f (re ⁻¹' Ioo a b))
  (hBf : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)]
    (λ z, expR (B * expR (c * |z.im|))))
  (hdg : diff_cont_on_cl ℂ g (re ⁻¹' Ioo a b))
  (hBg : ∃ (c < π / (b - a)) B, g =O[comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)]
    (λ z, expR (B * expR (c * |z.im|))))
  (ha : ∀ z : ℂ, re z = a → f z = g z) (hb : ∀ z : ℂ, re z = b → f z = g z) :
  eq_on f g (re ⁻¹' Icc a b) :=
λ z hz, sub_eq_zero.1 (eq_zero_on_vertical_strip (hdf.sub hdg) (is_O_sub_exp_exp hBf hBg)
  (λ w hw, sub_eq_zero.2 (ha w hw)) (λ w hw, sub_eq_zero.2 (hb w hw)) hz)

/-!
### Phragmen-Lindelöf principle in coordinate quadrants
-/

/-- **Phragmen-Lindelöf principle** in the first quadrant. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open first quadrant and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open first quadrant
  for some `c < 2`;
* `∥f z∥` is bounded from above by a constant `C` on the boundary of the first quadrant.

Then `∥f z∥` is bounded from above by the same constant on the closed first quadrant. -/
lemma quadrant_I (hd : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Ioi 0))
  (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Ioi 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, 0 ≤ x → ∥f x∥ ≤ C) (him : ∀ x : ℝ, 0 ≤ x → ∥f (x * I)∥ ≤ C)
  (hz_re : 0 ≤ z.re) (hz_im : 0 ≤ z.im) :
  ∥f z∥ ≤ C :=
begin
  -- The case `z = 0` is trivial.
  rcases eq_or_ne z 0 with rfl|hzne, { exact hre 0 le_rfl },
  -- Otherwise, `z = e ^ ζ` for some `ζ : ℂ`, `0 < Im ζ < π / 2`.
  obtain ⟨ζ, hζ, rfl⟩ : ∃ ζ : ℂ, ζ.im ∈ Icc 0 (π / 2) ∧ exp ζ = z,
  { refine ⟨log z, _, exp_log hzne⟩,
    rw log_im,
    exact ⟨arg_nonneg_iff.2 hz_im, arg_le_pi_div_two_iff.2 (or.inl hz_re)⟩ },
  clear hz_re hz_im hzne,
  -- We are going to apply `phragmen_lindelof.horizontal_strip` to `f ∘ complex.exp` and `ζ`.
  change ∥(f ∘ exp) ζ∥ ≤ C,
  have H : maps_to exp (im ⁻¹' Ioo 0 (π / 2)) (Ioi 0 ×ℂ Ioi 0),
  { intros z hz,
    rw [mem_re_prod_im, exp_re, exp_im, mem_Ioi, mem_Ioi],
    refine ⟨mul_pos (real.exp_pos _)
      (real.cos_pos_of_mem_Ioo ⟨(neg_lt_zero.2 $ div_pos real.pi_pos two_pos).trans hz.1, hz.2⟩),
      mul_pos (real.exp_pos _)
        (real.sin_pos_of_mem_Ioo ⟨hz.1, hz.2.trans (half_lt_self real.pi_pos)⟩)⟩ },
  refine horizontal_strip (hd.comp differentiable_exp.diff_cont_on_cl H) _ _ _ hζ.1 hζ.2;
    clear hζ ζ,
  { -- The estimate `hB` on `f` implies the required estimate on
    -- `f ∘ exp` with the same `c` and `B' = max B 0`.
    rw [sub_zero, div_div_cancel' real.pi_pos.ne'],
    rcases hB with ⟨c, hc, B, hO⟩,
    refine ⟨c, hc, max B 0, _⟩,
    rw [← comap_comap, comap_abs_at_top, comap_sup, inf_sup_right],
    -- We prove separately the estimates as `ζ.re → ∞` and as `ζ.re → -∞`
    refine is_O.sup _ ((hO.comp_tendsto $ tendsto_exp_comap_re_at_top.inf H.tendsto).trans $
      is_O.of_bound 1 _),
    { -- For the estimate as `ζ.re → -∞`, note that `f` is continuous within the first quadrant at
      -- zero, hence `f (exp ζ)` has a limit as `ζ.re → -∞`, `0 < ζ.im < π / 2`.
      have hc : continuous_within_at f (Ioi 0 ×ℂ Ioi 0) 0,
      { refine (hd.continuous_on _ _).mono subset_closure,
        simp [closure_re_prod_im, mem_re_prod_im] },
      refine (is_O_one_of_tendsto ℝ (hc.tendsto.comp $ tendsto_exp_comap_re_at_bot.inf
        H.tendsto)).trans (is_O_of_le _ (λ w, _)),
      rw [norm_one, real.norm_of_nonneg (real.exp_pos _).le, real.one_le_exp_iff],
      exact mul_nonneg (le_max_right _ _) (real.exp_pos _).le },
    { -- For the estimate as `ζ.re → ∞`, we reuse the uppoer estimate on `f`
      simp only [eventually_inf_principal, eventually_comap, comp_app, one_mul,
        real.norm_of_nonneg (real.exp_pos _).le, abs_exp, ← real.exp_mul, real.exp_le_exp],
      refine (eventually_ge_at_top 0).mono (λ x hx z hz hz', _),
      rw [hz, _root_.abs_of_nonneg hx, mul_comm _ c],
      exact mul_le_mul_of_nonneg_right (le_max_left _ _) (real.exp_pos _).le } },
  { -- If `ζ.im = 0`, then `complex.exp ζ` is a positive real number
    intros ζ hζ, lift ζ to ℝ using hζ,
    rw [comp_app, ← of_real_exp],
    exact hre _ (real.exp_pos _).le },
  { -- If `ζ.im = π / 2`, then `complex.exp ζ` is a purely imaginary number with positive `im`
    intros ζ hζ,
    rw [← re_add_im ζ, hζ, comp_app, exp_add_mul_I, ← of_real_cos, ← of_real_sin,
      real.cos_pi_div_two, real.sin_pi_div_two, of_real_zero, of_real_one, one_mul, zero_add,
      ← of_real_exp],
    exact him _ (real.exp_pos _).le }
end

/-- **Phragmen-Lindelöf principle** in the first quadrant. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open first quadrant and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open first quadrant
  for some `A`, `B`, and `c < 2`;
* `f` is equal to zero on the boundary of the first quadrant.

Then `f` is equal to zero on the closed first quadrant. -/
lemma eq_zero_on_quadrant_I (hd : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Ioi 0))
  (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Ioi 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, 0 ≤ x → f x = 0) (him : ∀ x : ℝ, 0 ≤ x → f (x * I) = 0) :
  eq_on f 0 {z | 0 ≤ z.re ∧ 0 ≤ z.im} :=
λ z hz, norm_le_zero_iff.1 $ quadrant_I hd hB (λ x hx, norm_le_zero_iff.2 $ hre x hx)
  (λ x hx, norm_le_zero_iff.2 $ him x hx) hz.1 hz.2

/-- **Phragmen-Lindelöf principle** in the first quadrant. Let `f g : ℂ → E` be functions such that

* `f` and `g` are differentiable in the open first quadrant and are continuous on its closure;
* `∥f z∥` and `∥g z∥` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open first
  quadrant for some `A`, `B`, and `c < 2`;
* `f` is equal to `g` on the boundary of the first quadrant.

Then `f` is equal to `g` on the closed first quadrant. -/
lemma eq_on_quadrant_I (hdf : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Ioi 0))
  (hBf : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Ioi 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hdg : diff_cont_on_cl ℂ g (Ioi 0 ×ℂ Ioi 0))
  (hBg : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Ioi 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, 0 ≤ x → f x = g x) (him : ∀ x : ℝ, 0 ≤ x → f (x * I) = g (x * I)) :
  eq_on f g {z | 0 ≤ z.re ∧ 0 ≤ z.im} :=
λ z hz, sub_eq_zero.1 $ eq_zero_on_quadrant_I (hdf.sub hdg) (is_O_sub_exp_rpow hBf hBg)
  (λ x hx, sub_eq_zero.2 $ hre x hx) (λ x hx, sub_eq_zero.2 $ him x hx) hz

/-- **Phragmen-Lindelöf principle** in the second quadrant. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open second quadrant and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open second quadrant
  for some `c < 2`;
* `∥f z∥` is bounded from above by a constant `C` on the boundary of the second quadrant.

Then `∥f z∥` is bounded from above by the same constant on the closed second quadrant. -/
lemma quadrant_II (hd : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Ioi 0))
  (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Ioi 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, x ≤ 0 → ∥f x∥ ≤ C) (him : ∀ x : ℝ, 0 ≤ x → ∥f (x * I)∥ ≤ C)
  (hz_re : z.re ≤ 0) (hz_im : 0 ≤ z.im) :
  ∥f z∥ ≤ C :=
begin
  obtain ⟨z, rfl⟩ : ∃ z', z' * I = z, from ⟨z / I, div_mul_cancel _ I_ne_zero⟩,
  simp only [mul_I_re, mul_I_im, neg_nonpos] at hz_re hz_im,
  change ∥(f ∘ (* I)) z∥ ≤ C,
  have H : maps_to (* I) (Ioi 0 ×ℂ Ioi 0) (Iio 0 ×ℂ Ioi 0),
  { intros w hw,
    simpa only [mem_re_prod_im, mul_I_re, mul_I_im, neg_lt_zero, mem_Iio] using hw.symm },
  refine quadrant_I (hd.comp (differentiable_id.mul_const _).diff_cont_on_cl H)
    (Exists₃.imp (λ c hc B hO, _) hB) him (λ x hx, _) hz_im hz_re,
  { simpa only [(∘), complex.abs_mul, abs_I, mul_one]
      using hO.comp_tendsto ((tendsto_mul_right_cobounded I_ne_zero).inf H.tendsto) },
  { rw [comp_app, mul_assoc, I_mul_I, mul_neg_one, ← of_real_neg],
    exact hre _ (neg_nonpos.2 hx) }
end

/-- **Phragmen-Lindelöf principle** in the second quadrant. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open second quadrant and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open second quadrant
  for some `A`, `B`, and `c < 2`;
* `f` is equal to zero on the boundary of the second quadrant.

Then `f` is equal to zero on the closed second quadrant. -/
lemma eq_zero_on_quadrant_II (hd : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Ioi 0))
  (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Ioi 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, x ≤ 0 → f x = 0) (him : ∀ x : ℝ, 0 ≤ x → f (x * I) = 0) :
  eq_on f 0 {z | z.re ≤ 0 ∧ 0 ≤ z.im} :=
λ z hz, norm_le_zero_iff.1 $ quadrant_II hd hB (λ x hx, norm_le_zero_iff.2 $ hre x hx)
  (λ x hx, norm_le_zero_iff.2 $ him x hx) hz.1 hz.2

/-- **Phragmen-Lindelöf principle** in the second quadrant. Let `f g : ℂ → E` be functions such that

* `f` and `g` are differentiable in the open second quadrant and are continuous on its closure;
* `∥f z∥` and `∥g z∥` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open second
  quadrant for some `A`, `B`, and `c < 2`;
* `f` is equal to `g` on the boundary of the second quadrant.

Then `f` is equal to `g` on the closed second quadrant. -/
lemma eq_on_quadrant_II (hdf : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Ioi 0))
  (hBf : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Ioi 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hdg : diff_cont_on_cl ℂ g (Iio 0 ×ℂ Ioi 0))
  (hBg : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Ioi 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, x ≤ 0 → f x = g x) (him : ∀ x : ℝ, 0 ≤ x → f (x * I) = g (x * I)) :
  eq_on f g {z | z.re ≤ 0 ∧ 0 ≤ z.im} :=
λ z hz, sub_eq_zero.1 $ eq_zero_on_quadrant_II (hdf.sub hdg) (is_O_sub_exp_rpow hBf hBg)
  (λ x hx, sub_eq_zero.2 $ hre x hx) (λ x hx, sub_eq_zero.2 $ him x hx) hz

/-- **Phragmen-Lindelöf principle** in the third quadrant. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open third quadrant and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp (B * (abs z) ^ c)` on the open third quadrant
  for some `c < 2`;
* `∥f z∥` is bounded from above by a constant `C` on the boundary of the third quadrant.

Then `∥f z∥` is bounded from above by the same constant on the closed third quadrant. -/
lemma quadrant_III (hd : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Iio 0))
  (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Iio 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, x ≤ 0 → ∥f x∥ ≤ C) (him : ∀ x : ℝ, x ≤ 0 → ∥f (x * I)∥ ≤ C)
  (hz_re : z.re ≤ 0) (hz_im : z.im ≤ 0) :
  ∥f z∥ ≤ C :=
begin
  obtain ⟨z, rfl⟩ : ∃ z', -z' = z, from ⟨-z, neg_neg z⟩,
  simp only [neg_re, neg_im, neg_nonpos] at hz_re hz_im,
  change ∥(f ∘ has_neg.neg) z∥ ≤ C,
  have H : maps_to has_neg.neg (Ioi 0 ×ℂ Ioi 0) (Iio 0 ×ℂ Iio 0),
  { intros w hw,
    simpa only [mem_re_prod_im, neg_re, neg_im, neg_lt_zero, mem_Iio] using hw },
  refine quadrant_I (hd.comp differentiable_neg.diff_cont_on_cl H) _ (λ x hx, _) (λ x hx, _)
    hz_re hz_im,
  { refine Exists₃.imp (λ c hc B hO, _) hB,
    simpa only [(∘), complex.abs_neg]
      using hO.comp_tendsto (tendsto_neg_cobounded.inf H.tendsto) },
  { rw [comp_app, ← of_real_neg],
    exact hre (-x) (neg_nonpos.2 hx) },
  { rw [comp_app, ← neg_mul, ← of_real_neg],
    exact him (-x) (neg_nonpos.2 hx) }
end

/-- **Phragmen-Lindelöf principle** in the third quadrant. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open third quadrant and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open third quadrant
  for some `A`, `B`, and `c < 2`;
* `f` is equal to zero on the boundary of the third quadrant.

Then `f` is equal to zero on the closed third quadrant. -/
lemma eq_zero_on_quadrant_III (hd : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Iio 0))
  (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Iio 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, x ≤ 0 → f x = 0) (him : ∀ x : ℝ, x ≤ 0 → f (x * I) = 0) :
  eq_on f 0 {z | z.re ≤ 0 ∧ z.im ≤ 0} :=
λ z hz, norm_le_zero_iff.1 $ quadrant_III hd hB (λ x hx, norm_le_zero_iff.2 $ hre x hx)
  (λ x hx, norm_le_zero_iff.2 $ him x hx) hz.1 hz.2

/-- **Phragmen-Lindelöf principle** in the third quadrant. Let `f g : ℂ → E` be functions such that

* `f` and `g` are differentiable in the open third quadrant and are continuous on its closure;
* `∥f z∥` and `∥g z∥` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open third
  quadrant for some `A`, `B`, and `c < 2`;
* `f` is equal to `g` on the boundary of the third quadrant.

Then `f` is equal to `g` on the closed third quadrant. -/
lemma eq_on_quadrant_III (hdf : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Iio 0))
  (hBf : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Iio 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hdg : diff_cont_on_cl ℂ g (Iio 0 ×ℂ Iio 0))
  (hBg : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Iio 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, x ≤ 0 → f x = g x) (him : ∀ x : ℝ, x ≤ 0 → f (x * I) = g (x * I)) :
  eq_on f g {z | z.re ≤ 0 ∧ z.im ≤ 0} :=
λ z hz, sub_eq_zero.1 $ eq_zero_on_quadrant_III (hdf.sub hdg) (is_O_sub_exp_rpow hBf hBg)
  (λ x hx, sub_eq_zero.2 $ hre x hx) (λ x hx, sub_eq_zero.2 $ him x hx) hz

/-- **Phragmen-Lindelöf principle** in the fourth quadrant. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open fourth quadrant and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open fourth quadrant
  for some `c < 2`;
* `∥f z∥` is bounded from above by a constant `C` on the boundary of the fourth quadrant.

Then `∥f z∥` is bounded from above by the same constant on the closed fourth quadrant. -/
lemma quadrant_IV (hd : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Iio 0))
  (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Iio 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, 0 ≤ x → ∥f x∥ ≤ C) (him : ∀ x : ℝ, x ≤ 0 → ∥f (x * I)∥ ≤ C)
  (hz_re : 0 ≤ z.re) (hz_im : z.im ≤ 0) :
  ∥f z∥ ≤ C :=
begin
  obtain ⟨z, rfl⟩ : ∃ z', -z' = z, from ⟨-z, neg_neg z⟩,
  simp only [neg_re, neg_im, neg_nonpos, neg_nonneg] at hz_re hz_im,
  change ∥(f ∘ has_neg.neg) z∥ ≤ C,
  have H : maps_to has_neg.neg (Iio 0 ×ℂ Ioi 0) (Ioi 0 ×ℂ Iio 0),
  { intros w hw,
    simpa only [mem_re_prod_im, neg_re, neg_im, neg_lt_zero, neg_pos, mem_Ioi, mem_Iio] using hw },
  refine quadrant_II (hd.comp differentiable_neg.diff_cont_on_cl H) _ (λ x hx, _) (λ x hx, _)
    hz_re hz_im,
  { refine Exists₃.imp (λ c hc B hO, _) hB,
    simpa only [(∘), complex.abs_neg]
      using hO.comp_tendsto (tendsto_neg_cobounded.inf H.tendsto) },
  { rw [comp_app, ← of_real_neg],
    exact hre (-x) (neg_nonneg.2 hx) },
  { rw [comp_app, ← neg_mul, ← of_real_neg],
    exact him (-x) (neg_nonpos.2 hx) }
end

/-- **Phragmen-Lindelöf principle** in the fourth quadrant. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open fourth quadrant and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open fourth quadrant
  for some `A`, `B`, and `c < 2`;
* `f` is equal to zero on the boundary of the fourth quadrant.

Then `f` is equal to zero on the closed fourth quadrant. -/

/-- **Phragmen-Lindelöf principle** in the fourth quadrant. Let `f g : ℂ → E` be functions such that

* `f` and `g` are differentiable in the open fourth quadrant and are continuous on its closure;
* `∥f z∥` and `∥g z∥` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open fourth
  quadrant for some `A`, `B`, and `c < 2`;
* `f` is equal to `g` on the boundary of the fourth quadrant.

Then `f` is equal to `g` on the closed fourth quadrant. -/
lemma eq_on_quadrant_IV (hdf : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Iio 0))
  (hBf : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Iio 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hdg : diff_cont_on_cl ℂ g (Ioi 0 ×ℂ Iio 0))
  (hBg : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Iio 0)]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : ∀ x : ℝ, 0 ≤ x → f x = g x) (him : ∀ x : ℝ, x ≤ 0 → f (x * I) = g (x * I)) :
  eq_on f g {z | 0 ≤ z.re ∧ z.im ≤ 0} :=
λ z hz, sub_eq_zero.1 $ eq_zero_on_quadrant_IV (hdf.sub hdg) (is_O_sub_exp_rpow hBf hBg)
  (λ x hx, sub_eq_zero.2 $ hre x hx) (λ x hx, sub_eq_zero.2 $ him x hx) hz

/-!
### Phragmen-Lindelöf principle in the right half-plane
-/

/-- **Phragmen-Lindelöf principle** in the right half-plane. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open right half-plane and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open right half-plane
  for some `c < 2`;
* `∥f z∥` is bounded from above by a constant `C` on the imaginary axis;
* `f x → 0` as `x : ℝ` tends to infinity.

Then `∥f z∥` is bounded from above by the same constant on the closed right half-plane.
See also `phragmen_lindelof.right_half_plane_of_bounded_on_real` for a stronger version. -/
lemma right_half_plane_of_tendsto_zero_on_real (hd : diff_cont_on_cl ℂ f {z | 0 < z.re})
  (hexp : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : tendsto (λ x : ℝ, f x) at_top (𝓝 0)) (him : ∀ x : ℝ, ∥f (x * I)∥ ≤ C) (hz : 0 ≤ z.re) :
  ∥f z∥ ≤ C :=
begin
  /- We are going to apply the Phragmen-Lindelöf principle in the first and fourth quadrants.
  The lemmas immediately imply that for any upper estimate `C'` on `∥f x∥`, `x : ℝ`, `0 ≤ x`,
  the number `max C C'` is an upper estimate on `f` in the whole right half-plane. -/
  revert z,
  have hle : ∀ C', (∀ x : ℝ, 0 ≤ x → ∥f x∥ ≤ C') → ∀ z : ℂ, 0 ≤ z.re → ∥f z∥ ≤ max C C',
  { intros C' hC' z hz,
    cases le_total z.im 0,
    { refine quadrant_IV (hd.mono $ λ _, and.left) (Exists₃.imp (λ c hc B hO, _) hexp)
        (λ x hx, (hC' x hx).trans $ le_max_right _ _) (λ x hx, (him x).trans (le_max_left _ _))
        hz h,
      exact hO.mono (inf_le_inf_left _ $ principal_mono.2 $ λ _, and.left) },
    { refine quadrant_I (hd.mono $ λ _, and.left) (Exists₃.imp (λ c hc B hO, _) hexp)
        (λ x hx, (hC' x hx).trans $ le_max_right _ _) (λ x hx, (him x).trans (le_max_left _ _))
        hz h,
      exact hO.mono (inf_le_inf_left _ $ principal_mono.2 $ λ _, and.left) } },
  -- Since `f` is continuous on `Ici 0` and `∥f x∥` tends to zero as `x → ∞`,
  -- the norm `∥f x∥` takes its maximum value at some `x₀ : ℝ`.
  obtain ⟨x₀, hx₀, hmax⟩ : ∃ x : ℝ, 0 ≤ x ∧ ∀ y : ℝ, 0 ≤ y → ∥f y∥ ≤ ∥f x∥,
  { have hfc : continuous_on (λ x : ℝ, f x) (Ici 0),
    { refine hd.continuous_on.comp continuous_of_real.continuous_on (λ x hx, _),
      rwa closure_set_of_lt_re },
    by_cases h₀ : ∀ x : ℝ, 0 ≤ x → f x = 0,
    { refine ⟨0, le_rfl, λ y hy, _⟩, rw [h₀ y hy, h₀ 0 le_rfl] },
    push_neg at h₀,
    rcases h₀ with ⟨x₀, hx₀, hne⟩,
    have hlt : ∥(0 : E)∥ < ∥f x₀∥, by rwa [norm_zero, norm_pos_iff],
    suffices : ∀ᶠ x : ℝ in cocompact ℝ ⊓ 𝓟 (Ici 0), ∥f x∥ ≤ ∥f x₀∥,
      by simpa only [exists_prop] using hfc.norm.exists_forall_ge' is_closed_Ici hx₀ this,
    rw [real.cocompact_eq, inf_sup_right, (disjoint_at_bot_principal_Ici (0 : ℝ)).eq_bot,
      bot_sup_eq],
    exact (hre.norm.eventually $ ge_mem_nhds hlt).filter_mono inf_le_left },
  cases le_or_lt (∥f x₀∥) C,
  { -- If `∥f x₀∥ ≤ C`, then `hle` implies the required estimate
    simpa only [max_eq_left h] using hle _ hmax },
  { -- Otherwise, `∥f z∥ ≤ ∥f x₀∥` for all `z` in the right half-plane due to `hle`.
    replace hmax : is_max_on (norm ∘ f) {z | 0 < z.re} x₀,
    { rintros z (hz : 0 < z.re),
      simpa [max_eq_right h.le] using hle _ hmax _ hz.le },
    -- Due to the maximum modulus principle applied to the closed ball of radius `x₀.re`,
    -- `∥f 0∥ = ∥f x₀∥`.
    have : ∥f 0∥ = ∥f x₀∥,
    { apply norm_eq_norm_of_is_max_on_of_ball_subset hd hmax,
      -- move to a lemma?
      intros z hz,
      rw [mem_ball, dist_zero_left, dist_eq, norm_eq_abs, complex.abs_of_nonneg hx₀] at hz,
      rw mem_set_of_eq,
      contrapose! hz,
      calc x₀ ≤ x₀ - z.re : (le_sub_self_iff _).2 hz
      ... ≤ |x₀ - z.re| : le_abs_self _
      ... = |(z - x₀).re| : by rw [sub_re, of_real_re, _root_.abs_sub_comm]
      ... ≤ abs (z - x₀) : abs_re_le_abs _ },
    -- Thus we have `C < ∥f x₀∥ = ∥f 0∥ ≤ C`. Contradiction completes the proof.
    refine (h.not_le $ this ▸ _).elim,
    simpa using him 0 }
end

/-- **Phragmen-Lindelöf principle** in the right half-plane. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open right half-plane and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open right half-plane
  for some `c < 2`;
* `∥f z∥` is bounded from above by a constant `C` on the imaginary axis;
* `∥f x∥` is bounded from above by a constant for large real values of `x`.

Then `∥f z∥` is bounded from above by `C` on the closed right half-plane.
See also `phragmen_lindelof.right_half_plane_of_tendsto_zero_on_real` for a weaker version. -/
lemma right_half_plane_of_bounded_on_real (hd : diff_cont_on_cl ℂ f {z | 0 < z.re})
  (hexp : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : is_bounded_under (≤) at_top (λ x : ℝ, ∥f x∥))
  (him : ∀ x : ℝ, ∥f (x * I)∥ ≤ C) (hz : 0 ≤ z.re) :
  ∥f z∥ ≤ C :=
begin
  -- For each `ε < 0`, the function `λ z, exp (ε * z) • f z` satisfies assumptions of
  -- `right_half_plane_of_tendsto_zero_on_real`, hence `∥exp (ε * z) • f z∥ ≤ C` for all `ε < 0`.
  -- Taking the limit as `ε → 0`, we obtain the required inequality.
  suffices : ∀ᶠ ε : ℝ in 𝓝[<] 0, ∥exp (ε * z) • f z∥ ≤ C,
  { refine le_of_tendsto (tendsto.mono_left _ nhds_within_le_nhds) this,
    apply ((continuous_of_real.mul continuous_const).cexp.smul continuous_const).norm.tendsto',
    simp, apply_instance },
  filter_upwards [self_mem_nhds_within] with ε ε₀, change ε < 0 at ε₀,
  set g : ℂ → E := λ z, exp (ε * z) • f z, change ∥g z∥ ≤ C,
  replace hd : diff_cont_on_cl ℂ g {z : ℂ | 0 < z.re},
    from (differentiable_id.const_mul _).cexp.diff_cont_on_cl.smul hd,
  have hgn : ∀ z, ∥g z∥ = expR (ε * z.re) * ∥f z∥,
  { intro z, rw [norm_smul, norm_eq_abs, abs_exp, of_real_mul_re] },
  refine right_half_plane_of_tendsto_zero_on_real hd _ _ (λ y, _) hz,
  { refine Exists₃.imp (λ c hc B hO, (is_O.of_bound 1  _).trans hO) hexp,
    refine (eventually_inf_principal.2 $ eventually_of_forall $ λ z hz, _),
    rw [hgn, one_mul],
    refine mul_le_of_le_one_left (norm_nonneg _) (real.exp_le_one_iff.2 _),
    exact mul_nonpos_of_nonpos_of_nonneg ε₀.le (le_of_lt hz) },
  { simp_rw [g, ← of_real_mul, ← of_real_exp, coe_smul],
    have h₀ : tendsto (λ x : ℝ, expR (ε * x)) at_top (𝓝 0),
      from real.tendsto_exp_at_bot.comp (tendsto_const_nhds.neg_mul_at_top ε₀ tendsto_id),
    exact h₀.zero_smul_is_bounded_under_le hre },
  { rw [hgn, of_real_mul_re, I_re, mul_zero, mul_zero, real.exp_zero, one_mul],
    exact him y }
end

/-- **Phragmen-Lindelöf principle** in the right half-plane. Let `f : ℂ → E` be a function such that

* `f` is differentiable in the open right half-plane and is continuous on its closure;
* `∥f z∥` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open right half-plane
  for some `c < 2`;
* `∥f z∥` is bounded from above by a constant on the imaginary axis;
* `f x`, `x : ℝ`, tends to zero superexponentially fast as `x → ∞`:
  for any natural `n`, `exp (n * x) * ∥f x∥` tends to zero as `x → ∞`.

Then `f` is equal to zero on the closed right half-plane. -/
lemma eq_zero_on_right_half_plane_of_superexponential_decay
  (hd : diff_cont_on_cl ℂ f {z | 0 < z.re})
  (hexp : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : superpolynomial_decay at_top expR (λ x, ∥f x∥))
  (him : ∃ C, ∀ x : ℝ, ∥f (x * I)∥ ≤ C) :
  eq_on f 0 {z : ℂ | 0 ≤ z.re} :=
begin
  rcases him with ⟨C, hC⟩,
  -- Due to continuity, it suffices to prove the equality on the open right half-plane.
  suffices : ∀ z : ℂ, 0 < z.re → f z = 0,
  { simpa only [closure_set_of_lt_re] using eq_on.of_subset_closure this hd.continuous_on
      continuous_on_const subset_closure subset.rfl },
  -- Consider $g_n(z)=e^{nz}f(z)$.
  set g : ℕ → ℂ → E := λ n z, (exp z) ^ n • f z,
  have hg : ∀ n z, ∥g n z∥ = (expR z.re) ^ n * ∥f z∥,
  { intros n z, simp only [norm_smul, norm_eq_abs, complex.abs_pow, abs_exp] },
  intros z hz,
  -- Since `e^{nz} → ∞` as `n → ∞`, it suffices to show that each `g_n` is bounded from above by `C`
  suffices H : ∀ n : ℕ, ∥g n z∥ ≤ C,
  { contrapose! H,
    simp only [hg],
    exact (((tendsto_pow_at_top_at_top_of_one_lt (real.one_lt_exp_iff.2 hz)).at_top_mul
      (norm_pos_iff.2 H) tendsto_const_nhds).eventually (eventually_gt_at_top C)).exists },
  intro n,
  -- This estimate follows from the Phragmen-Lindelöf principle in the right half-plane.
  refine right_half_plane_of_tendsto_zero_on_real (differentiable_exp.pow.diff_cont_on_cl.smul hd)
    _ _ (λ y, _) hz.le,
  { rcases hexp with ⟨c, hc, B, hO⟩,
    refine ⟨max c 1, max_lt hc one_lt_two, n + max B 0, is_O.of_norm_left _⟩,
    simp only [hg],
    refine ((is_O_refl (λ z : ℂ, expR z.re ^ n) _).mul hO.norm_left).trans (is_O.of_bound 1 _),
    simp only [← real.exp_nat_mul, ← real.exp_add, real.norm_of_nonneg (real.exp_pos _).le,
      real.exp_le_exp, add_mul, eventually_inf_principal, eventually_comap, one_mul],
    filter_upwards [eventually_ge_at_top (1 : ℝ)] with r hr z hzr hre, subst r,
    refine add_le_add (mul_le_mul_of_nonneg_left _ n.cast_nonneg) _,
    { calc z.re ≤ abs z : re_le_abs _
      ... = abs z ^ (1 : ℝ) : (real.rpow_one _).symm
      ... ≤ abs z ^ (max c 1) : real.rpow_le_rpow_of_exponent_le hr (le_max_right _ _) },
    { exact mul_le_mul (le_max_left _ _) (real.rpow_le_rpow_of_exponent_le hr (le_max_left _ _))
        (real.rpow_nonneg_of_nonneg (abs_nonneg _) _) (le_max_right _ _) } },
  { rw tendsto_zero_iff_norm_tendsto_zero, simp only [hg],
    exact hre n },
  { rw [hg, of_real_mul_re, I_re, mul_zero, real.exp_zero, one_pow, one_mul],
    exact hC y }
end

/-- **Phragmen-Lindelöf principle** in the right half-plane. Let `f g : ℂ → E` be functions such
that

* `f` and `g` are differentiable in the open right half-plane and are continuous on its closure;
* `∥f z∥` and `∥g z∥` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open right
  half-plane for some `c < 2`;
* `∥f z∥` and `∥g z∥` are bounded from above by constants on the imaginary axis;
* `f x - g x`, `x : ℝ`, tends to zero superexponentially fast as `x → ∞`:
  for any natural `n`, `exp (n * x) * ∥f x - g x∥` tends to zero as `x → ∞`.

Then `f` is equal to `g` on the closed right half-plane. -/
lemma eq_on_right_half_plane_of_superexponential_decay {g : ℂ → E}
  (hfd : diff_cont_on_cl ℂ f {z | 0 < z.re}) (hgd : diff_cont_on_cl ℂ g {z | 0 < z.re})
  (hfexp : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}]
    (λ z, expR (B * (abs z) ^ c)))
  (hgexp : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}]
    (λ z, expR (B * (abs z) ^ c)))
  (hre : superpolynomial_decay at_top expR (λ x, ∥f x - g x∥))
  (hfim : ∃ C, ∀ x : ℝ, ∥f (x * I)∥ ≤ C) (hgim : ∃ C, ∀ x : ℝ, ∥g (x * I)∥ ≤ C) :
  eq_on f g {z : ℂ | 0 ≤ z.re} :=
begin
  suffices : eq_on (f - g) 0 {z : ℂ | 0 ≤ z.re},
    by simpa only [eq_on, pi.sub_apply, pi.zero_apply, sub_eq_zero] using this,
  refine eq_zero_on_right_half_plane_of_superexponential_decay (hfd.sub hgd) _ hre _,
  { set l : filter ℂ := comap abs at_top ⊓ 𝓟 {z : ℂ | 0 < z.re},
    suffices : ∀ {c₁ c₂ B₁ B₂ : ℝ}, c₁ ≤ c₂ → B₁ ≤ B₂ → 0 ≤ B₂ →
      (λ z, expR (B₁ * abs z ^ c₁)) =O[l] (λ z, expR (B₂ * abs z ^ c₂)),
    { rcases hfexp with ⟨cf, hcf, Bf, hOf⟩, rcases hgexp with ⟨cg, hcg, Bg, hOg⟩,
      refine ⟨max cf cg, max_lt hcf hcg, max 0 (max Bf Bg), _⟩,
      refine is_O.sub (hOf.trans $ this _ _ _) (hOg.trans $ this _ _ _); simp },
    intros c₁ c₂ B₁ B₂ hc hB hB₂,
    have : ∀ᶠ z : ℂ in l, 1 ≤ abs z,
      from ((eventually_ge_at_top 1).comap _).filter_mono inf_le_left,
    refine is_O.of_bound 1 (this.mono $ λ z hz, _),
    simp only [real.norm_of_nonneg (real.exp_pos _).le, real.exp_le_exp, one_mul],
    exact mul_le_mul hB (real.rpow_le_rpow_of_exponent_le hz hc)
      (real.rpow_nonneg_of_nonneg (abs_nonneg _) _) hB₂ },
  { rcases hfim with ⟨Cf, hCf⟩, rcases hgim with ⟨Cg, hCg⟩,
    exact ⟨Cf + Cg, λ x, norm_sub_le_of_le (hCf x) (hCg x)⟩ }
end

end phragmen_lindelof


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Johan Commelin, Patrick Massot
-/

import algebra.order.group
import tactic.abel

/-!
# Linearly ordered commutative groups and monoids with a zero element adjoined

This file sets up a special class of linearly ordered commutative monoids
that show up as the target of so-called “valuations” in algebraic number theory.

Usually, in the informal literature, these objects are constructed
by taking a linearly ordered commutative group Γ and formally adjoining a zero element: Γ ∪ {0}.

The disadvantage is that a type such as `nnreal` is not of that form,
whereas it is a very common target for valuations.
The solutions is to use a typeclass, and that is exactly what we do in this file.

Note that to avoid issues with import cycles, `linear_ordered_comm_monoid_with_zero` is defined
in another file. However, the lemmas about it are stated here.
-/

set_option old_structure_cmd true

/-- A linearly ordered commutative group with a zero element. -/
class linear_ordered_comm_group_with_zero (α : Type*)
  extends linear_ordered_comm_monoid_with_zero α, comm_group_with_zero α

variables {α : Type*}
variables {a b c d x y z : α}

instance [linear_ordered_add_comm_monoid_with_top α] :
  linear_ordered_comm_monoid_with_zero (multiplicative (order_dual α)) :=
{ zero := multiplicative.of_add (⊤ : α),
  zero_mul := top_add,
  mul_zero := add_top,
  zero_le_one := (le_top : (0 : α) ≤ ⊤),
  ..multiplicative.ordered_comm_monoid,
  ..multiplicative.linear_order }

instance [linear_ordered_add_comm_group_with_top α] :
  linear_ordered_comm_group_with_zero (multiplicative (order_dual α)) :=
{ inv_zero := linear_ordered_add_comm_group_with_top.neg_top,
  mul_inv_cancel := linear_ordered_add_comm_group_with_top.add_neg_cancel,
  ..multiplicative.div_inv_monoid,
  ..multiplicative.linear_ordered_comm_monoid_with_zero,
  ..multiplicative.nontrivial }

instance [linear_ordered_comm_monoid α] :
  linear_ordered_comm_monoid_with_zero (with_zero α) :=
{ mul_le_mul_left := λ x y, mul_le_mul_left',
  zero_le_one     := with_zero.zero_le _,
  ..with_zero.linear_order,
  ..with_zero.comm_monoid_with_zero }

instance [linear_ordered_comm_group α] :
  linear_ordered_comm_group_with_zero (with_zero α) :=
{ ..with_zero.linear_ordered_comm_monoid_with_zero,
  ..with_zero.comm_group_with_zero }

section linear_ordered_comm_monoid

variables [linear_ordered_comm_monoid_with_zero α]
/-
The following facts are true more generally in a (linearly) ordered commutative monoid.
-/

/-- Pullback a `linear_ordered_comm_monoid_with_zero` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.linear_ordered_comm_monoid_with_zero {β : Type*}
  [has_zero β] [has_one β] [has_mul β]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) :
  linear_ordered_comm_monoid_with_zero β :=
{ zero_le_one := show f 0 ≤ f 1, by simp only [zero, one,
    linear_ordered_comm_monoid_with_zero.zero_le_one],
  ..linear_order.lift f hf,
  ..hf.ordered_comm_monoid f one mul,
  ..hf.comm_monoid_with_zero f zero one mul }

lemma zero_le_one' : (0 : α) ≤ 1 :=
linear_ordered_comm_monoid_with_zero.zero_le_one

@[simp] lemma zero_le' : 0 ≤ a :=
by simpa only [mul_zero, mul_one] using mul_le_mul_left' (@zero_le_one' α _) a

@[simp] lemma not_lt_zero' : ¬a < 0 :=
not_lt_of_le zero_le'

@[simp] lemma le_zero_iff : a ≤ 0 ↔ a = 0 :=
⟨λ h, le_antisymm h zero_le', λ h, h ▸ le_refl _⟩

lemma zero_lt_iff : 0 < a ↔ a ≠ 0 :=
⟨ne_of_gt, λ h, lt_of_le_of_ne zero_le' h.symm⟩

lemma ne_zero_of_lt (h : b < a) : a ≠ 0 :=
λ h1, not_lt_zero' $ show b < 0, from h1 ▸ h

lemma pow_pos_iff [no_zero_divisors α] {n : ℕ} (hn : 0 < n) : 0 < a ^ n ↔ 0 < a :=
by simp_rw [zero_lt_iff, pow_ne_zero_iff hn]

instance : linear_ordered_add_comm_monoid_with_top (additive (order_dual α)) :=
{ top := (0 : α),
  top_add' := λ a, (zero_mul a : (0 : α) * a = 0),
  le_top := λ _, zero_le',
  ..additive.ordered_add_comm_monoid,
  ..additive.linear_order }

end linear_ordered_comm_monoid

variables [linear_ordered_comm_group_with_zero α]

lemma zero_lt_one₀ : (0 : α) < 1 :=
lt_of_le_of_ne zero_le_one' zero_ne_one

lemma le_of_le_mul_right (h : c ≠ 0) (hab : a * c ≤ b * c) : a ≤ b :=
by simpa only [mul_inv_cancel_right₀ h] using (mul_le_mul_right' hab c⁻¹)

lemma le_mul_inv_of_mul_le (h : c ≠ 0) (hab : a * c ≤ b) : a ≤ b * c⁻¹ :=
le_of_le_mul_right h (by simpa [h] using hab)

lemma mul_inv_le_of_le_mul (h : c ≠ 0) (hab : a ≤ b * c) : a * c⁻¹ ≤ b :=
le_of_le_mul_right h (by simpa [h] using hab)

lemma le_mul_inv_iff₀ (hc : c ≠ 0) : a ≤ b * c⁻¹ ↔ a * c ≤ b :=
⟨λ h, inv_inv₀ c ▸ mul_inv_le_of_le_mul (inv_ne_zero hc) h, le_mul_inv_of_mul_le hc⟩

lemma mul_inv_le_iff₀ (hc : c ≠ 0) : a * c⁻¹ ≤ b ↔ a ≤ b * c :=
⟨λ h, inv_inv₀ c ▸ le_mul_inv_of_mul_le (inv_ne_zero hc) h, mul_inv_le_of_le_mul hc⟩

lemma div_le_div₀ (a b c d : α) (hb : b ≠ 0) (hd : d ≠ 0) :
  a * b⁻¹ ≤ c * d⁻¹ ↔ a * d ≤ c * b :=
if ha : a = 0 then by simp [ha] else
if hc : c = 0 then by simp [inv_ne_zero hb, hc, hd] else
show (units.mk0 a ha) * (units.mk0 b hb)⁻¹ ≤ (units.mk0 c hc) * (units.mk0 d hd)⁻¹ ↔
  (units.mk0 a ha) * (units.mk0 d hd) ≤ (units.mk0 c hc) * (units.mk0 b hb),
from mul_inv_le_mul_inv_iff'

@[simp] lemma units.zero_lt (u : units α) : (0 : α) < u :=
zero_lt_iff.2 $ u.ne_zero

lemma mul_lt_mul_of_lt_of_le₀ (hab : a ≤ b) (hb : b ≠ 0) (hcd : c < d) : a * c < b * d :=
have hd : d ≠ 0 := ne_zero_of_lt hcd,
if ha : a = 0 then by { rw [ha, zero_mul, zero_lt_iff], exact mul_ne_zero hb hd } else
if hc : c = 0 then by { rw [hc, mul_zero, zero_lt_iff], exact mul_ne_zero hb hd } else
show (units.mk0 a ha) * (units.mk0 c hc) < (units.mk0 b hb) * (units.mk0 d hd),
from mul_lt_mul_of_le_of_lt hab hcd

lemma mul_lt_mul₀ (hab : a < b) (hcd : c < d) : a * c < b * d :=
mul_lt_mul_of_lt_of_le₀ hab.le (ne_zero_of_lt hab) hcd

lemma mul_inv_lt_of_lt_mul₀ (h : x < y * z) : x * z⁻¹ < y :=
have hz : z ≠ 0 := (mul_ne_zero_iff.1 $ ne_zero_of_lt h).2,
by { contrapose! h, simpa only [inv_inv₀] using mul_inv_le_of_le_mul (inv_ne_zero hz) h }

lemma inv_mul_lt_of_lt_mul₀ (h : x < y * z) : y⁻¹ * x < z :=
by { rw mul_comm at *, exact mul_inv_lt_of_lt_mul₀ h }

lemma mul_lt_right₀ (c : α) (h : a < b) (hc : c ≠ 0) : a * c < b * c :=
by { contrapose! h, exact le_of_le_mul_right hc h }

lemma pow_lt_pow_succ {x : α} {n : ℕ} (hx : 1 < x) : x ^ n < x ^ n.succ :=
by { rw [← one_mul (x ^ n), pow_succ],
exact mul_lt_right₀ _ hx (pow_ne_zero _ $ ne_of_gt (lt_trans zero_lt_one₀ hx)) }

lemma pow_lt_pow₀ {x : α} {m n : ℕ} (hx : 1 < x) (hmn : m < n) : x ^ m < x ^ n :=
by { induction hmn with n hmn ih, exacts [pow_lt_pow_succ hx, lt_trans ih (pow_lt_pow_succ hx)] }

lemma inv_lt_inv₀ (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ < b⁻¹ ↔ b < a :=
show (units.mk0 a ha)⁻¹ < (units.mk0 b hb)⁻¹ ↔ (units.mk0 b hb) < (units.mk0 a ha),
from inv_lt_inv_iff

lemma inv_le_inv₀ (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
show (units.mk0 a ha)⁻¹ ≤ (units.mk0 b hb)⁻¹ ↔ (units.mk0 b hb) ≤ (units.mk0 a ha),
from inv_le_inv_iff

lemma lt_of_mul_lt_mul_of_le₀ (h : a * b < c * d) (hc : 0 < c) (hh : c ≤ a) : b < d :=
begin
  have ha : a ≠ 0 := ne_of_gt (lt_of_lt_of_le hc hh),
  simp_rw ← inv_le_inv₀ ha (ne_of_gt hc) at hh,
  have := mul_lt_mul_of_lt_of_le₀ hh (inv_ne_zero (ne_of_gt hc)) h,
  simpa [inv_mul_cancel_left₀ ha, inv_mul_cancel_left₀ (ne_of_gt hc)] using this,
end

lemma mul_le_mul_right₀ (hc : c ≠ 0) : a * c ≤ b * c ↔ a ≤ b :=
⟨le_of_le_mul_right hc, λ hab, mul_le_mul_right' hab _⟩

lemma div_le_div_right₀ (hc : c ≠ 0) : a/c ≤ b/c ↔ a ≤ b :=
by rw [div_eq_mul_inv, div_eq_mul_inv, mul_le_mul_right₀ (inv_ne_zero hc)]

lemma le_div_iff₀ (hc : c ≠ 0) : a ≤ b/c ↔ a*c ≤ b :=
by rw [div_eq_mul_inv, le_mul_inv_iff₀ hc]

lemma div_le_iff₀ (hc : c ≠ 0) : a/c ≤ b ↔ a ≤ b*c :=
by rw [div_eq_mul_inv, mul_inv_le_iff₀ hc]

instance : linear_ordered_add_comm_group_with_top (additive (order_dual α)) :=
{ neg_top := inv_zero,
  add_neg_cancel := λ a ha, mul_inv_cancel ha,
  ..additive.sub_neg_monoid,
  ..additive.linear_ordered_add_comm_monoid_with_top,
  ..additive.nontrivial }

namespace monoid_hom

variables {R : Type*} [ring R] (f : R →* α)

theorem map_neg_one : f (-1) = 1 :=
(pow_eq_one_iff (nat.succ_ne_zero 1)).1 $
  calc f (-1) ^ 2 = f (-1) * f(-1) : sq _
              ... = f ((-1) * - 1) : (f.map_mul _ _).symm
              ... = f ( - - 1)     : congr_arg _ (neg_one_mul _)
              ... = f 1            : congr_arg _ (neg_neg _)
              ... = 1              : map_one f

@[simp] lemma map_neg (x : R) : f (-x) = f x :=
calc f (-x) = f (-1 * x)   : congr_arg _ (neg_one_mul _).symm
        ... = f (-1) * f x : map_mul _ _ _
        ... = 1 * f x      : _root_.congr_arg (λ g, g * (f x)) (map_neg_one f)
        ... = f x          : one_mul _

lemma map_sub_swap (x y : R) : f (x - y) = f (y - x) :=
calc f (x - y) = f (-(y - x)) : congr_arg _ (neg_sub _ _).symm
           ... = _            : map_neg _ _

end monoid_hom


/-
Copyright (c) 2020 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg
-/

import tactic.generalizes

universes u

lemma example_from_docs₁ (P : ∀ n, fin n → Prop) (n : ℕ) (f : fin n)
  (p : ∀ n xs, P n xs) : P (nat.succ n) (fin.succ f) :=
begin
  generalizes [n'_eq : nat.succ n = n', f'_eq : fin.succ f == f'],
  guard_hyp n' : ℕ,
  guard_hyp n'_eq : n' = nat.succ n,
  guard_hyp f' : fin n',
  guard_hyp f'_eq : f' == fin.succ f,
  exact p n' f'
  -- Note: `generalizes` fails if we write `n + 1` instead of `nat.succ n` in
  -- the target because `kabstract` works with a notion of equality that is
  -- weaker than definitional equality. This is annoying, but we can't do much
  -- about it short of reimplementing `kabstract`.
end

lemma example_from_docs₂ (P : ∀ n, fin n → Prop) (n : ℕ) (f : fin n)
  (p : ∀ n xs, P n xs) : P (nat.succ n) (fin.succ f) :=
begin
  generalizes [(nat.succ n = n'), (fin.succ f == f')],
  guard_hyp n' : ℕ,
  success_if_fail { guard_hyp n'_eq : n' = nat.succ n },
  guard_hyp f' : fin n',
  success_if_fail { guard_hyp f'_eq : f' == fin.succ f },
  exact p n' f'
end

inductive Vec (α : Sort u) : ℕ → Sort (max 1 u)
| nil : Vec 0
| cons {n} (x : α) (xs : Vec n) : Vec (n + 1)

namespace Vec

inductive eq {α} : ∀ (n m : ℕ), Vec α n → Vec α m → Prop
| nil : eq 0 0 nil nil
| cons {n m x y xs ys}
  : x = y
  → eq n m xs ys
  → eq (n + 1) (m + 1) (cons x xs) (cons y ys)

inductive fancy_unit {α} : ∀ n, Vec α n → Prop
| intro (n xs) : fancy_unit n xs

-- An example of the difference between multiple calls to `generalize` and
-- one call to `generalizes`.
lemma test₁ {α n} {x : α} {xs} : fancy_unit (n + 1) (cons x xs) :=
begin
  -- Successive `generalize` invocations don't give us the right goal:
  -- The second generalisation fails due to the dependency between
  -- `xs' : Vec α (n + 1)` and `n + 1`.
  success_if_fail {
    generalize eq_xs' : cons x xs = xs',
    generalize eq_n' : n + 1 = n',
    exact fancy_unit.intro n' xs' },
  -- `generalizes` gives us the expected result with everything generalised.
  generalizes [eq_n' : n + 1 = n', eq_xs' : cons x xs = xs'],
  guard_hyp n' : ℕ,
  guard_hyp eq_n' : n' = n + 1,
  guard_hyp xs' : Vec α n',
  guard_hyp eq_xs' : xs' == cons x xs,
  exact fancy_unit.intro n' xs'
end

-- We can also choose to introduce equations for only some of the generalised
-- expressions.
lemma test₂ {α n} {x : α} {xs} : fancy_unit (n + 1) (cons x xs) :=
begin
  generalizes [n + 1 = n', eq_xs' : cons x xs = xs'],
  guard_hyp n' : ℕ,
  success_if_fail { guard_hyp eq_n' : n' = n + 1 },
  guard_hyp xs' : Vec α n',
  guard_hyp eq_xs' : xs' == cons x xs,
  exact fancy_unit.intro n' xs'
end

-- An example where `generalizes` enables a successful `induction` (though in
-- this case, `cases` would suffice and already performs the generalisation).
lemma eq_cons_inversion {α} {n m x y} {xs : Vec α n} {ys : Vec α m}
  : eq (n + 1) (m + 1) (cons x xs) (cons y ys)
  → eq n m xs ys :=
begin
  generalizes
    [ n'_eq : n + 1 = n'
    , m'_eq : m + 1 = m'
    , xs'_eq : cons x xs = xs'
    , ys'_eq : cons y ys = ys'
    ],
  intro h,
  induction h,
  case nil {
    cases n'_eq, },
  case cons : n'' m'' x y xs'' ys'' eq_xy eq_xsys'' ih {
    cases n'_eq, clear n'_eq,
    cases m'_eq, clear m'_eq,
    cases xs'_eq, clear xs'_eq,
    cases ys'_eq, clear ys'_eq,
    exact eq_xsys'', }
end

end Vec


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Oliver Nash

! This file was ported from Lean 3 source module data.finset.prod
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Card

/-!
# Finsets in product types

This file defines finset constructions on the product type `α × β`. Beware not to confuse with the
`Finset.prod` operation which computes the multiplicative product.

## Main declarations

* `Finset.product`: Turns `s : Finset α`, `t : Finset β` into their product in `Finset (α × β)`.
* `Finset.diag`: For `s : Finset α`, `s.diag` is the `Finset (α × α)` of pairs `(a, a)` with
  `a ∈ s`.
* `Finset.offDiag`: For `s : Finset α`, `s.offDiag` is the `Finset (α × α)` of pairs `(a, b)` with
  `a, b ∈ s` and `a ≠ b`.
-/

open Multiset

variable {α β γ : Type _}

namespace Finset

/-! ### prod -/

section Prod

variable {s s' : Finset α} {t t' : Finset β} {a : α} {b : β}

/-- `product s t` is the set of pairs `(a, b)` such that `a ∈ s` and `b ∈ t`. -/
protected def product (s : Finset α) (t : Finset β) : Finset (α × β) :=
  ⟨_, s.nodup.product t.nodup⟩
#align finset.product Finset.product

--Porting note: Change notation from  "×ˢ" to "×ᶠ" to avoid ambiguity
@[inherit_doc]
infixr:82
  " ×ᶠ " =>-- This notation binds more strongly than (pre)images, unions and intersections.
  Finset.product

@[simp]
theorem product_val : (s ×ᶠ t).1 = s.1 ×ˢ t.1 :=
  rfl
#align finset.product_val Finset.product_val

@[simp]
theorem mem_product {p : α × β} : p ∈ s ×ᶠ t ↔ p.1 ∈ s ∧ p.2 ∈ t :=
  Multiset.mem_product
#align finset.mem_product Finset.mem_product

theorem mk_mem_product (ha : a ∈ s) (hb : b ∈ t) : (a, b) ∈ s ×ᶠ t :=
  mem_product.2 ⟨ha, hb⟩
#align finset.mk_mem_product Finset.mk_mem_product

@[simp, norm_cast]
theorem coe_product (s : Finset α) (t : Finset β) :
    (↑(s ×ᶠ t) : Set (α × β)) = (s : Set α) ×ˢ t :=
  Set.ext fun _ => Finset.mem_product
#align finset.coe_product Finset.coe_product

theorem subset_product_image_fst [DecidableEq α] : (s ×ᶠ t).image Prod.fst ⊆ s := fun i => by
  simp (config := { contextual := true }) [mem_image]
#align finset.subset_product_image_fst Finset.subset_product_image_fst

theorem subset_product_image_snd [DecidableEq β] : (s ×ᶠ t).image Prod.snd ⊆ t := fun i => by
  simp (config := { contextual := true }) [mem_image]
#align finset.subset_product_image_snd Finset.subset_product_image_snd

theorem product_image_fst [DecidableEq α] (ht : t.Nonempty) : (s ×ᶠ t).image Prod.fst = s :=
  by
  ext i
  simp [mem_image, ht.bex]
#align finset.product_image_fst Finset.product_image_fst

theorem product_image_snd [DecidableEq β] (ht : s.Nonempty) : (s ×ᶠ t).image Prod.snd = t :=
  by
  ext i
  simp [mem_image, ht.bex]
#align finset.product_image_snd Finset.product_image_snd

theorem subset_product [DecidableEq α] [DecidableEq β] {s : Finset (α × β)} :
    s ⊆ s.image Prod.fst ×ᶠ s.image Prod.snd := fun _ hp =>
  mem_product.2 ⟨mem_image_of_mem _ hp, mem_image_of_mem _ hp⟩
#align finset.subset_product Finset.subset_product

theorem product_subset_product (hs : s ⊆ s') (ht : t ⊆ t') : s ×ᶠ t ⊆ s' ×ᶠ t' := fun ⟨_, _⟩ h =>
  mem_product.2 ⟨hs (mem_product.1 h).1, ht (mem_product.1 h).2⟩
#align finset.product_subset_product Finset.product_subset_product

theorem product_subset_product_left (hs : s ⊆ s') : s ×ᶠ t ⊆ s' ×ᶠ t :=
  product_subset_product hs (Subset.refl _)
#align finset.product_subset_product_left Finset.product_subset_product_left

theorem product_subset_product_right (ht : t ⊆ t') : s ×ᶠ t ⊆ s ×ᶠ t' :=
  product_subset_product (Subset.refl _) ht
#align finset.product_subset_product_right Finset.product_subset_product_right

theorem map_swap_product (s : Finset α) (t : Finset β) :
    (t ×ᶠ s).map ⟨Prod.swap, Prod.swap_injective⟩ = s ×ᶠ t :=
  coe_injective <| by
    push_cast
    exact Set.image_swap_prod _ _
#align finset.map_swap_product Finset.map_swap_product

@[simp]
theorem image_swap_product [DecidableEq (α × β)] (s : Finset α) (t : Finset β) :
    (t ×ᶠ s).image Prod.swap = s ×ᶠ t :=
  coe_injective <| by
    push_cast
    exact Set.image_swap_prod _ _
#align finset.image_swap_product Finset.image_swap_product

theorem product_eq_bunionᵢ [DecidableEq (α × β)] (s : Finset α) (t : Finset β) :
    s ×ᶠ t = s.bunionᵢ fun a => t.image fun b => (a, b) :=
  ext fun ⟨x, y⟩ => by
    simp only [mem_product, mem_bunionᵢ, mem_image, exists_prop, Prod.mk.inj_iff, and_left_comm,
      exists_and_left, exists_eq_right, exists_eq_left]
#align finset.product_eq_bUnion Finset.product_eq_bunionᵢ

theorem product_eq_bunionᵢ_right [DecidableEq (α × β)] (s : Finset α) (t : Finset β) :
    s ×ᶠ t = t.bunionᵢ fun b => s.image fun a => (a, b) :=
  ext fun ⟨x, y⟩ => by
    simp only [mem_product, mem_bunionᵢ, mem_image, exists_prop, Prod.mk.inj_iff, and_left_comm,
      exists_and_left, exists_eq_right, exists_eq_left]
#align finset.product_eq_bUnion_right Finset.product_eq_bunionᵢ_right

/-- See also `Finset.sup_product_left`. -/
@[simp]
theorem product_bunionᵢ [DecidableEq γ] (s : Finset α) (t : Finset β) (f : α × β → Finset γ) :
    (s ×ᶠ t).bunionᵢ f = s.bunionᵢ fun a => t.bunionᵢ fun b => f (a, b) := by
  classical simp_rw [product_eq_bunionᵢ, bunionᵢ_bunionᵢ, image_bunionᵢ]
#align finset.product_bUnion Finset.product_bunionᵢ

@[simp]
theorem card_product (s : Finset α) (t : Finset β) : card (s ×ᶠ t) = card s * card t :=
  Multiset.card_product _ _
#align finset.card_product Finset.card_product

theorem filter_product (p : α → Prop) (q : β → Prop) [DecidablePred p] [DecidablePred q] :
    ((s ×ᶠ t).filter fun x : α × β => p x.1 ∧ q x.2) = s.filter p ×ᶠ t.filter q := by
  ext ⟨a, b⟩
  simp [mem_filter, mem_product, decide_eq_true_eq, and_comm, and_left_comm, and_assoc]
#align finset.filter_product Finset.filter_product

theorem filter_product_left (p : α → Prop) [DecidablePred p] :
    ((s ×ᶠ t).filter fun x : α × β => p x.1) = s.filter p ×ᶠ t := by
  simpa using filter_product p fun _ => true
#align finset.filter_product_left Finset.filter_product_left

theorem filter_product_right (q : β → Prop) [DecidablePred q] :
    ((s ×ᶠ t).filter fun x : α × β => q x.2) = s ×ᶠ t.filter q := by
  simpa using filter_product (fun _ : α => true) q
#align finset.filter_product_right Finset.filter_product_right

theorem filter_product_card (s : Finset α) (t : Finset β) (p : α → Prop) (q : β → Prop)
    [DecidablePred p] [DecidablePred q] :
    ((s ×ᶠ t).filter fun x : α × β => (p x.1) = (q x.2)).card =
      (s.filter p).card * (t.filter q).card +
        (s.filter (¬ p ·)).card * (t.filter (¬ q ·)).card := by
  classical
    rw [← card_product, ← card_product, ← filter_product, ← filter_product, ← card_union_eq]
    · apply congr_arg
      ext ⟨a, b⟩
      simp only [filter_union_right, mem_filter, mem_product]
      constructor <;> intro h <;> use h.1
      . simp only [h.2, Function.comp_apply, Decidable.em, and_self]
      . revert h
        simp only [Function.comp_apply, and_imp]
        rintro _ _ (_|_) <;> simp [*]
    · apply Finset.disjoint_filter_filter'
      exact (disjoint_compl_right.inf_left _).inf_right _
#align finset.filter_product_card Finset.filter_product_card

theorem empty_product (t : Finset β) : (∅ : Finset α) ×ᶠ t = ∅ :=
  rfl
#align finset.empty_product Finset.empty_product

theorem product_empty (s : Finset α) : s ×ᶠ (∅ : Finset β) = ∅ :=
  eq_empty_of_forall_not_mem fun _ h => not_mem_empty _ (Finset.mem_product.1 h).2
#align finset.product_empty Finset.product_empty

theorem Nonempty.product (hs : s.Nonempty) (ht : t.Nonempty) : (s ×ᶠ t).Nonempty :=
  let ⟨x, hx⟩ := hs
  let ⟨y, hy⟩ := ht
  ⟨(x, y), mem_product.2 ⟨hx, hy⟩⟩
#align finset.nonempty.product Finset.Nonempty.product

theorem Nonempty.fst (h : (s ×ᶠ t).Nonempty) : s.Nonempty :=
  let ⟨xy, hxy⟩ := h
  ⟨xy.1, (mem_product.1 hxy).1⟩
#align finset.nonempty.fst Finset.Nonempty.fst

theorem Nonempty.snd (h : (s ×ᶠ t).Nonempty) : t.Nonempty :=
  let ⟨xy, hxy⟩ := h
  ⟨xy.2, (mem_product.1 hxy).2⟩
#align finset.nonempty.snd Finset.Nonempty.snd

@[simp]
theorem nonempty_product : (s ×ᶠ t).Nonempty ↔ s.Nonempty ∧ t.Nonempty :=
  ⟨fun h => ⟨h.fst, h.snd⟩, fun h => h.1.product h.2⟩
#align finset.nonempty_product Finset.nonempty_product

@[simp]
theorem product_eq_empty {s : Finset α} {t : Finset β} : s ×ᶠ t = ∅ ↔ s = ∅ ∨ t = ∅ := by
  rw [← not_nonempty_iff_eq_empty, nonempty_product, not_and_or, not_nonempty_iff_eq_empty,
    not_nonempty_iff_eq_empty]
#align finset.product_eq_empty Finset.product_eq_empty

@[simp]
theorem singleton_product {a : α} : ({a} : Finset α) ×ᶠ t = t.map ⟨Prod.mk a, Prod.mk.inj_left _⟩ :=
  by
  ext ⟨x, y⟩
  simp [and_left_comm, eq_comm]
#align finset.singleton_product Finset.singleton_product

@[simp]
theorem product_singleton {b : β} : s ×ᶠ {b} = s.map ⟨fun i => (i, b), Prod.mk.inj_right _⟩ :=
  by
  ext ⟨x, y⟩
  simp [and_left_comm, eq_comm]
#align finset.product_singleton Finset.product_singleton

theorem singleton_product_singleton {a : α} {b : β} :
    ({a} : Finset α) ×ᶠ ({b} : Finset β) = {(a, b)} := by
  simp only [product_singleton, Function.Embedding.coeFn_mk, map_singleton]
#align finset.singleton_product_singleton Finset.singleton_product_singleton

@[simp]
theorem union_product [DecidableEq α] [DecidableEq β] : (s ∪ s') ×ᶠ t = s ×ᶠ t ∪ s' ×ᶠ t :=
  by
  ext ⟨x, y⟩
  simp only [or_and_right, mem_union, mem_product]
#align finset.union_product Finset.union_product

@[simp]
theorem product_union [DecidableEq α] [DecidableEq β] : s ×ᶠ (t ∪ t') = s ×ᶠ t ∪ s ×ᶠ t' :=
  by
  ext ⟨x, y⟩
  simp only [and_or_left, mem_union, mem_product]
#align finset.product_union Finset.product_union

theorem inter_product [DecidableEq α] [DecidableEq β] : (s ∩ s') ×ᶠ t = s ×ᶠ t ∩ s' ×ᶠ t :=
  by
  ext ⟨x, y⟩
  simp only [← and_and_right, mem_inter, mem_product]
#align finset.inter_product Finset.inter_product

theorem product_inter [DecidableEq α] [DecidableEq β] : s ×ᶠ (t ∩ t') = s ×ᶠ t ∩ s ×ᶠ t' :=
  by
  ext ⟨x, y⟩
  simp only [← and_and_left, mem_inter, mem_product]
#align finset.product_inter Finset.product_inter

theorem product_inter_product [DecidableEq α] [DecidableEq β] :
    s ×ᶠ t ∩ s' ×ᶠ t' = (s ∩ s') ×ᶠ (t ∩ t') :=
  by
  ext ⟨x, y⟩
  simp only [and_assoc, and_left_comm, mem_inter, mem_product]
#align finset.product_inter_product Finset.product_inter_product

theorem disjoint_product : Disjoint (s ×ᶠ t) (s' ×ᶠ t') ↔ Disjoint s s' ∨ Disjoint t t' := by
  simp_rw [← disjoint_coe, coe_product, Set.disjoint_prod]
#align finset.disjoint_product Finset.disjoint_product

@[simp]
theorem disjUnion_product (hs : Disjoint s s') :
    s.disjUnion s' hs ×ᶠ t = (s ×ᶠ t).disjUnion (s' ×ᶠ t) (disjoint_product.mpr <| Or.inl hs) :=
  eq_of_veq <| Multiset.add_product _ _ _
#align finset.disj_union_product Finset.disjUnion_product

@[simp]
theorem product_disjUnion (ht : Disjoint t t') :
    s ×ᶠ t.disjUnion t' ht = (s ×ᶠ t).disjUnion (s ×ᶠ t') (disjoint_product.mpr <| Or.inr ht) :=
  eq_of_veq <| Multiset.product_add _ _ _
#align finset.product_disj_union Finset.product_disjUnion

end Prod

section Diag

variable [DecidableEq α] (s t : Finset α)

/-- Given a finite set `s`, the diagonal, `s.diag` is the set of pairs of the form `(a, a)` for
`a ∈ s`. -/
def diag :=
  (s ×ᶠ s).filter fun a : α × α => a.fst = a.snd
#align finset.diag Finset.diag

/-- Given a finite set `s`, the off-diagonal, `s.offDiag` is the set of pairs `(a, b)` with `a ≠ b`
for `a, b ∈ s`. -/
def offDiag :=
  (s ×ᶠ s).filter fun a : α × α => a.fst ≠ a.snd
#align finset.off_diag Finset.offDiag

variable {s} {x : α × α}

@[simp]
theorem mem_diag : x ∈ s.diag ↔ x.1 ∈ s ∧ x.1 = x.2 := by
  simp (config := { contextual := true }) [diag]
#align finset.mem_diag Finset.mem_diag

@[simp]
theorem mem_offDiag : x ∈ s.offDiag ↔ x.1 ∈ s ∧ x.2 ∈ s ∧ x.1 ≠ x.2 := by
  simp [offDiag, and_assoc]
#align finset.mem_off_diag Finset.mem_offDiag

variable (s)

@[simp, norm_cast]
theorem coe_offDiag : (s.offDiag : Set (α × α)) = (s : Set α).offDiag :=
  Set.ext fun _ => mem_offDiag
#align finset.coe_off_diag Finset.coe_offDiag

@[simp]
theorem diag_card : (diag s).card = s.card :=
  by
  suffices diag s = s.image fun a => (a, a) by
    rw [this]
    apply card_image_of_injOn
    exact fun x1 _ x2 _ h3 => (Prod.mk.inj h3).1
  ext ⟨a₁, a₂⟩
  rw [mem_diag]
  constructor <;> intro h <;> rw [Finset.mem_image] at *
  · use a₁
    simpa using h
  · rcases h with ⟨a, h1, h2⟩
    have h := Prod.mk.inj h2
    rw [← h.1, ← h.2]
    use h1
#align finset.diag_card Finset.diag_card

@[simp]
theorem offDiag_card : (offDiag s).card = s.card * s.card - s.card :=
  suffices (diag s).card + (offDiag s).card = s.card * s.card by
    conv_rhs => { rw [← s.diag_card] }
    simp only [diag_card] at *
    rw [tsub_eq_of_eq_add_rev]
    rw [this]
  by rw [← card_product, diag, offDiag]
     conv_rhs => rw [← filter_card_add_filter_neg_card_eq_card (fun a => a.1 = a.2)]
#align finset.off_diag_card Finset.offDiag_card

@[mono]
theorem diag_mono : Monotone (diag : Finset α → Finset (α × α)) := fun _ _ h _ hx =>
  mem_diag.2 <| And.imp_left (@h _) <| mem_diag.1 hx
#align finset.diag_mono Finset.diag_mono

@[mono]
theorem offDiag_mono : Monotone (offDiag : Finset α → Finset (α × α)) := fun _ _ h _ hx =>
  mem_offDiag.2 <| And.imp (@h _) (And.imp_left <| @h _) <| mem_offDiag.1 hx
#align finset.off_diag_mono Finset.offDiag_mono

@[simp]
theorem diag_empty : (∅ : Finset α).diag = ∅ :=
  rfl
#align finset.diag_empty Finset.diag_empty

@[simp]
theorem offDiag_empty : (∅ : Finset α).offDiag = ∅ :=
  rfl
#align finset.off_diag_empty Finset.offDiag_empty

@[simp]
theorem diag_union_offDiag : s.diag ∪ s.offDiag = s ×ᶠ s := by
  conv_rhs => rw [← filter_union_filter_neg_eq (fun a => a.1 = a.2) (s ×ᶠ s)]
#align finset.diag_union_off_diag Finset.diag_union_offDiag

@[simp]
theorem disjoint_diag_offDiag : Disjoint s.diag s.offDiag :=
  disjoint_filter_filter_neg (s ×ᶠ s) (s ×ᶠ s) (fun a => a.1 = a.2)
#align finset.disjoint_diag_off_diag Finset.disjoint_diag_offDiag

theorem product_sdiff_diag : s ×ᶠ s \ s.diag = s.offDiag := by
  rw [← diag_union_offDiag, union_comm, union_sdiff_self,
    sdiff_eq_self_of_disjoint (disjoint_diag_offDiag _).symm]
#align finset.product_sdiff_diag Finset.product_sdiff_diag

theorem product_sdiff_offDiag : s ×ᶠ s \ s.offDiag = s.diag := by
  rw [← diag_union_offDiag, union_sdiff_self, sdiff_eq_self_of_disjoint (disjoint_diag_offDiag _)]
#align finset.product_sdiff_off_diag Finset.product_sdiff_offDiag

theorem diag_inter : (s ∩ t).diag = s.diag ∩ t.diag :=
  ext fun x => by simpa only [mem_diag, mem_inter] using and_and_right
#align finset.diag_inter Finset.diag_inter

theorem offDiag_inter : (s ∩ t).offDiag = s.offDiag ∩ t.offDiag :=
  coe_injective <| by
    push_cast
    exact Set.offDiag_inter _ _
#align finset.off_diag_inter Finset.offDiag_inter

variable {s t}

theorem offDiag_union (h : Disjoint s t) :
    (s ∪ t).offDiag = s.offDiag ∪ t.offDiag ∪ s ×ᶠ t ∪ t ×ᶠ s :=
  coe_injective <| by
    push_cast
    exact Set.offDiag_union (disjoint_coe.2 h)
#align finset.off_diag_union Finset.offDiag_union

variable (a : α)

@[simp]
theorem offDiag_singleton : ({a} : Finset α).offDiag = ∅ := by simp [← Finset.card_eq_zero]
#align finset.off_diag_singleton Finset.offDiag_singleton

theorem diag_singleton : ({a} : Finset α).diag = {(a, a)} := by
  rw [← product_sdiff_offDiag, offDiag_singleton, sdiff_empty, singleton_product_singleton]
#align finset.diag_singleton Finset.diag_singleton

theorem diag_insert : (insert a s).diag = insert (a, a) s.diag := by
  rw [insert_eq, insert_eq, diag_union, diag_singleton]
#align finset.diag_insert Finset.diag_insert

theorem offDiag_insert (has : a ∉ s) : (insert a s).offDiag = s.offDiag ∪ {a} ×ᶠ s ∪ s ×ᶠ {a} := by
  rw [insert_eq, union_comm, offDiag_union (disjoint_singleton_right.2 has), offDiag_singleton,
    union_empty, union_right_comm]
#align finset.off_diag_insert Finset.offDiag_insert

end Diag

end Finset


/-
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, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov, Yakov Pechersky

! This file was ported from Lean 3 source module group_theory.subsemigroup.basic
! leanprover-community/mathlib commit feb99064803fd3108e37c18b0f77d0a8344677a3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Group
import Mathlib.Data.Set.Lattice
import Mathlib.Data.SetLike.Basic

/-!
# Subsemigroups: definition and `complete_lattice` structure

This file defines bundled multiplicative and additive subsemigroups. We also define
a `CompleteLattice` structure on `Subsemigroup`s,
and define the closure of a set as the minimal subsemigroup that includes this set.

## Main definitions

* `Subsemigroup M`: the type of bundled subsemigroup of a magma `M`; the underlying set is given in
  the `carrier` field of the structure, and should be accessed through coercion as in `(S : Set M)`.
* `AddSubsemigroup M` : the type of bundled subsemigroups of an additive magma `M`.

For each of the following definitions in the `Subsemigroup` namespace, there is a corresponding
definition in the `AddSubsemigroup` namespace.

* `Subsemigroup.copy` : copy of a subsemigroup with `carrier` replaced by a set that is equal but
  possibly not definitionally equal to the carrier of the original `Subsemigroup`.
* `Subsemigroup.closure` :  semigroup closure of a set, i.e.,
  the least subsemigroup that includes the set.
* `Subsemigroup.gi` : `closure : Set M → Subsemigroup M` and coercion `coe : Subsemigroup M → Set M`
  form a `GaloisInsertion`;

## Implementation notes

Subsemigroup inclusion is denoted `≤` rather than `⊆`, although `∈` is defined as
membership of a subsemigroup's underlying set.

Note that `Subsemigroup M` does not actually require `Semigroup M`,
instead requiring only the weaker `Mul M`.

This file is designed to have very few dependencies. In particular, it should not use natural
numbers.

## Tags
subsemigroup, subsemigroups
-/

-- Only needed for notation
variable {M : Type _} {N : Type _} {A : Type _}

section NonAssoc

variable [Mul M] {s : Set M}

variable [Add A] {t : Set A}

/-- `MulMemClass S M` says `S` is a type of sets `s : Set M` that are closed under `(*)` -/
class MulMemClass (S : Type _) (M : Type _) [Mul M] [SetLike S M] : Prop where
  /-- A substructure satisfying `MulMemClass` is closed under multiplication. -/
  mul_mem : ∀ {s : S} {a b : M}, a ∈ s → b ∈ s → a * b ∈ s
#align mul_mem_class MulMemClass

export MulMemClass (mul_mem)

/-- `AddMemClass S M` says `S` is a type of sets `s : Set M` that are closed under `(+)` -/
class AddMemClass (S : Type _) (M : Type _) [Add M] [SetLike S M] : Prop where
  /-- A substructure satisfying `AddMemClass` is closed under addition. -/
  add_mem : ∀ {s : S} {a b : M}, a ∈ s → b ∈ s → a + b ∈ s
#align add_mem_class AddMemClass

export AddMemClass (add_mem)

attribute [to_additive] MulMemClass

/-- A subsemigroup of a magma `M` is a subset closed under multiplication. -/
structure Subsemigroup (M : Type _) [Mul M] where
  /-- The carrier of a subsemigroup. -/
  carrier : Set M
  /-- The product of two elements of a subsemigroup belongs to the subsemigroup. -/
  mul_mem' {a b} : a ∈ carrier → b ∈ carrier → a * b ∈ carrier
#align subsemigroup Subsemigroup

/-- An additive subsemigroup of an additive magma `M` is a subset closed under addition. -/
structure AddSubsemigroup (M : Type _) [Add M] where
  /-- The carrier of an additive subsemigroup. -/
  carrier : Set M
  /-- The sum of two elements of an additive subsemigroup belongs to the subsemigroup. -/
  add_mem' {a b} : a ∈ carrier → b ∈ carrier → a + b ∈ carrier
#align add_subsemigroup AddSubsemigroup

attribute [to_additive AddSubsemigroup] Subsemigroup

namespace Subsemigroup

@[to_additive]
instance : SetLike (Subsemigroup M) M :=
  ⟨Subsemigroup.carrier, fun p q h => by cases p; cases q; congr⟩

@[to_additive]
instance : MulMemClass (Subsemigroup M) M where mul_mem := fun {_ _ _} => Subsemigroup.mul_mem' _

initialize_simps_projections Subsemigroup (carrier → coe)
initialize_simps_projections AddSubsemigroup (carrier → coe)

@[to_additive (attr := simp)]
theorem mem_carrier {s : Subsemigroup M} {x : M} : x ∈ s.carrier ↔ x ∈ s :=
  Iff.rfl
#align subsemigroup.mem_carrier Subsemigroup.mem_carrier
#align add_subsemigroup.mem_carrier AddSubsemigroup.mem_carrier

@[to_additive (attr := simp)]
theorem mem_mk {s : Set M} {x : M} (h_mul) : x ∈ mk s h_mul ↔ x ∈ s :=
  Iff.rfl
#align subsemigroup.mem_mk Subsemigroup.mem_mk
#align add_subsemigroup.mem_mk AddSubsemigroup.mem_mk

@[to_additive (attr := simp)]
theorem coe_set_mk {s : Set M} (h_mul) : (mk s h_mul : Set M) = s :=
  rfl
#align subsemigroup.coe_set_mk Subsemigroup.coe_set_mk
#align add_subsemigroup.coe_set_mk AddSubsemigroup.coe_set_mk

@[to_additive (attr := simp)]
theorem mk_le_mk {s t : Set M} (h_mul) (h_mul') : mk s h_mul ≤ mk t h_mul' ↔ s ⊆ t :=
  Iff.rfl
#align subsemigroup.mk_le_mk Subsemigroup.mk_le_mk
#align add_subsemigroup.mk_le_mk AddSubsemigroup.mk_le_mk

/-- Two subsemigroups are equal if they have the same elements. -/
@[to_additive (attr := ext) "Two `AddSubsemigroup`s are equal if they have the same elements."]
theorem ext {S T : Subsemigroup M} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T :=
  SetLike.ext h
#align subsemigroup.ext Subsemigroup.ext
#align add_subsemigroup.ext AddSubsemigroup.ext

/-- Copy a subsemigroup replacing `carrier` with a set that is equal to it. -/
@[to_additive "Copy an additive subsemigroup replacing `carrier` with a set that is equal to it."]
protected def copy (S : Subsemigroup M) (s : Set M) (hs : s = S) :
    Subsemigroup M where
  carrier := s
  mul_mem' := hs.symm ▸ S.mul_mem'
#align subsemigroup.copy Subsemigroup.copy
#align add_subsemigroup.copy AddSubsemigroup.copy

variable {S : Subsemigroup M}

@[to_additive (attr := simp)]
theorem coe_copy {s : Set M} (hs : s = S) : (S.copy s hs : Set M) = s :=
  rfl
#align subsemigroup.coe_copy Subsemigroup.coe_copy
#align add_subsemigroup.coe_copy AddSubsemigroup.coe_copy

@[to_additive]
theorem copy_eq {s : Set M} (hs : s = S) : S.copy s hs = S :=
  SetLike.coe_injective hs
#align subsemigroup.copy_eq Subsemigroup.copy_eq
#align add_subsemigroup.copy_eq AddSubsemigroup.copy_eq

variable (S)

/-- A subsemigroup is closed under multiplication. -/
@[to_additive "An `AddSubsemigroup` is closed under addition."]
protected theorem mul_mem {x y : M} : x ∈ S → y ∈ S → x * y ∈ S :=
  Subsemigroup.mul_mem' S
#align subsemigroup.mul_mem Subsemigroup.mul_mem
#align add_subsemigroup.add_mem AddSubsemigroup.add_mem

/-- The subsemigroup `M` of the magma `M`. -/
@[to_additive "The additive subsemigroup `M` of the magma `M`."]
instance : Top (Subsemigroup M) :=
  ⟨{  carrier := Set.univ
      mul_mem' := fun _ _ => Set.mem_univ _ }⟩

/-- The trivial subsemigroup `∅` of a magma `M`. -/
@[to_additive "The trivial `AddSubsemigroup` `∅` of an additive magma `M`."]
instance : Bot (Subsemigroup M) :=
  ⟨{  carrier := ∅
      mul_mem' := False.elim }⟩

@[to_additive]
instance : Inhabited (Subsemigroup M) :=
  ⟨⊥⟩

@[to_additive]
theorem not_mem_bot {x : M} : x ∉ (⊥ : Subsemigroup M) :=
  Set.not_mem_empty x
#align subsemigroup.not_mem_bot Subsemigroup.not_mem_bot
#align add_subsemigroup.not_mem_bot AddSubsemigroup.not_mem_bot

@[to_additive (attr := simp)]
theorem mem_top (x : M) : x ∈ (⊤ : Subsemigroup M) :=
  Set.mem_univ x
#align subsemigroup.mem_top Subsemigroup.mem_top
#align add_subsemigroup.mem_top AddSubsemigroup.mem_top

@[to_additive (attr := simp)]

@[to_additive (attr := simp)]
theorem coe_bot : ((⊥ : Subsemigroup M) : Set M) = ∅ :=
  rfl
#align subsemigroup.coe_bot Subsemigroup.coe_bot
#align add_subsemigroup.coe_bot AddSubsemigroup.coe_bot

/-- The inf of two subsemigroups is their intersection. -/
@[to_additive "The inf of two `AddSubsemigroup`s is their intersection."]
instance : Inf (Subsemigroup M) :=
  ⟨fun S₁ S₂ =>
    { carrier := S₁ ∩ S₂
      mul_mem' := fun ⟨hx, hx'⟩ ⟨hy, hy'⟩ => ⟨S₁.mul_mem hx hy, S₂.mul_mem hx' hy'⟩ }⟩

@[to_additive (attr := simp)]
theorem coe_inf (p p' : Subsemigroup M) : ((p ⊓ p' : Subsemigroup M) : Set M) = (p : Set M) ∩ p' :=
  rfl
#align subsemigroup.coe_inf Subsemigroup.coe_inf
#align add_subsemigroup.coe_inf AddSubsemigroup.coe_inf

@[to_additive (attr := simp)]
theorem mem_inf {p p' : Subsemigroup M} {x : M} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' :=
  Iff.rfl
#align subsemigroup.mem_inf Subsemigroup.mem_inf
#align add_subsemigroup.mem_inf AddSubsemigroup.mem_inf

@[to_additive]
instance : InfSet (Subsemigroup M) :=
  ⟨fun s =>
    { carrier := ⋂ t ∈ s, ↑t
      mul_mem' := fun hx hy =>
        Set.mem_binterᵢ fun i h =>
          i.mul_mem (by apply Set.mem_interᵢ₂.1 hx i h) (by apply Set.mem_interᵢ₂.1 hy i h) }⟩

@[to_additive (attr := simp, norm_cast)]
theorem coe_infₛ (S : Set (Subsemigroup M)) : ((infₛ S : Subsemigroup M) : Set M) = ⋂ s ∈ S, ↑s :=
  rfl
#align subsemigroup.coe_Inf Subsemigroup.coe_infₛ
#align add_subsemigroup.coe_Inf AddSubsemigroup.coe_infₛ

@[to_additive]
theorem mem_infₛ {S : Set (Subsemigroup M)} {x : M} : x ∈ infₛ S ↔ ∀ p ∈ S, x ∈ p :=
  Set.mem_interᵢ₂
#align subsemigroup.mem_Inf Subsemigroup.mem_infₛ
#align add_subsemigroup.mem_Inf AddSubsemigroup.mem_infₛ

@[to_additive]
theorem mem_infᵢ {ι : Sort _} {S : ι → Subsemigroup M} {x : M} : (x ∈ ⨅ i, S i) ↔ ∀ i, x ∈ S i := by
  simp only [infᵢ, mem_infₛ, Set.forall_range_iff]
#align subsemigroup.mem_infi Subsemigroup.mem_infᵢ
#align add_subsemigroup.mem_infi AddSubsemigroup.mem_infᵢ

@[to_additive (attr := simp, norm_cast)]
theorem coe_infᵢ {ι : Sort _} {S : ι → Subsemigroup M} : (↑(⨅ i, S i) : Set M) = ⋂ i, S i := by
  simp only [infᵢ, coe_infₛ, Set.binterᵢ_range]
#align subsemigroup.coe_infi Subsemigroup.coe_infᵢ
#align add_subsemigroup.coe_infi AddSubsemigroup.coe_infᵢ

/-- subsemigroups of a monoid form a complete lattice. -/
@[to_additive "The `AddSubsemigroup`s of an `AddMonoid` form a complete lattice."]
instance : CompleteLattice (Subsemigroup M) :=
  { completeLatticeOfInf (Subsemigroup M) fun _ =>
      IsGLB.of_image SetLike.coe_subset_coe isGLB_binfᵢ with
    le := (· ≤ ·)
    lt := (· < ·)
    bot := ⊥
    bot_le := fun _ _ hx => (not_mem_bot hx).elim
    top := ⊤
    le_top := fun _ x _ => mem_top x
    inf := (· ⊓ ·)
    infₛ := InfSet.infₛ
    le_inf := fun _ _ _ ha hb _ hx => ⟨ha hx, hb hx⟩
    inf_le_left := fun _ _ _ => And.left
    inf_le_right := fun _ _ _ => And.right }

@[to_additive (attr := simp)]
theorem subsingleton_of_subsingleton [Subsingleton (Subsemigroup M)] : Subsingleton M := by
  constructor; intro x y
  have : ∀ a : M, a ∈ (⊥ : Subsemigroup M) := by simp [Subsingleton.elim (⊥ : Subsemigroup M) ⊤]
  exact absurd (this x) not_mem_bot
#align subsemigroup.subsingleton_of_subsingleton Subsemigroup.subsingleton_of_subsingleton
#align add_subsemigroup.subsingleton_of_subsingleton AddSubsemigroup.subsingleton_of_subsingleton

@[to_additive]
instance [hn : Nonempty M] : Nontrivial (Subsemigroup M) :=
  ⟨⟨⊥, ⊤, fun h => by
      obtain ⟨x⟩ := id hn
      refine' absurd (_ : x ∈ ⊥) not_mem_bot
      simp [h]⟩⟩

/-- The `Subsemigroup` generated by a set. -/
@[to_additive "The `AddSubsemigroup` generated by a set"]
def closure (s : Set M) : Subsemigroup M :=
  infₛ { S | s ⊆ S }
#align subsemigroup.closure Subsemigroup.closure
#align add_subsemigroup.closure AddSubsemigroup.closure

@[to_additive]
theorem mem_closure {x : M} : x ∈ closure s ↔ ∀ S : Subsemigroup M, s ⊆ S → x ∈ S :=
  mem_infₛ
#align subsemigroup.mem_closure Subsemigroup.mem_closure
#align add_subsemigroup.mem_closure AddSubsemigroup.mem_closure

/-- The subsemigroup generated by a set includes the set. -/
@[to_additive (attr := simp) "The `AddSubsemigroup` generated by a set includes the set."]
theorem subset_closure : s ⊆ closure s := fun _ hx => mem_closure.2 fun _ hS => hS hx
#align subsemigroup.subset_closure Subsemigroup.subset_closure
#align add_subsemigroup.subset_closure AddSubsemigroup.subset_closure

@[to_additive]
theorem not_mem_of_not_mem_closure {P : M} (hP : P ∉ closure s) : P ∉ s := fun h =>
  hP (subset_closure h)
#align subsemigroup.not_mem_of_not_mem_closure Subsemigroup.not_mem_of_not_mem_closure
#align add_subsemigroup.not_mem_of_not_mem_closure AddSubsemigroup.not_mem_of_not_mem_closure

variable {S}

open Set

/-- A subsemigroup `S` includes `closure s` if and only if it includes `s`. -/
@[to_additive (attr := simp)
  "An additive subsemigroup `S` includes `closure s` if and only if it includes `s`"]
theorem closure_le : closure s ≤ S ↔ s ⊆ S :=
  ⟨Subset.trans subset_closure, fun h => infₛ_le h⟩
#align subsemigroup.closure_le Subsemigroup.closure_le
#align add_subsemigroup.closure_le AddSubsemigroup.closure_le

/-- subsemigroup closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
@[to_additive "Additive subsemigroup closure of a set is monotone in its argument: if `s ⊆ t`,
  then `closure s ≤ closure t`"]
theorem closure_mono ⦃s t : Set M⦄ (h : s ⊆ t) : closure s ≤ closure t :=
  closure_le.2 <| Subset.trans h subset_closure
#align subsemigroup.closure_mono Subsemigroup.closure_mono
#align add_subsemigroup.closure_mono AddSubsemigroup.closure_mono

@[to_additive]
theorem closure_eq_of_le (h₁ : s ⊆ S) (h₂ : S ≤ closure s) : closure s = S :=
  le_antisymm (closure_le.2 h₁) h₂
#align subsemigroup.closure_eq_of_le Subsemigroup.closure_eq_of_le
#align add_subsemigroup.closure_eq_of_le AddSubsemigroup.closure_eq_of_le

variable (S)

/-- An induction principle for closure membership. If `p` holds for all elements of `s`, and
is preserved under multiplication, then `p` holds for all elements of the closure of `s`. -/
@[to_additive (attr := elab_as_elim) "An induction principle for additive closure membership. If `p`
  holds for all elements of `s`, and is preserved under addition, then `p` holds for all
  elements of the additive closure of `s`."]
theorem closure_induction {p : M → Prop} {x} (h : x ∈ closure s) (Hs : ∀ x ∈ s, p x)
    (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
  (@closure_le _ _ _ ⟨p, Hmul _ _⟩).2 Hs h
#align subsemigroup.closure_induction Subsemigroup.closure_induction
#align add_subsemigroup.closure_induction AddSubsemigroup.closure_induction

/-- A dependent version of `Subsemigroup.closure_induction`.  -/
@[to_additive (attr := elab_as_elim) "A dependent version of `AddSubsemigroup.closure_induction`. "]
theorem closure_induction' (s : Set M) {p : ∀ x, x ∈ closure s → Prop}
    (Hs : ∀ (x) (h : x ∈ s), p x (subset_closure h))
    (Hmul : ∀ x hx y hy, p x hx → p y hy → p (x * y) (mul_mem hx hy)) {x} (hx : x ∈ closure s) :
    p x hx := by
  refine' Exists.elim _ fun (hx : x ∈ closure s) (hc : p x hx) => hc
  exact
    closure_induction hx (fun x hx => ⟨_, Hs x hx⟩) fun x y ⟨hx', hx⟩ ⟨hy', hy⟩ =>
      ⟨_, Hmul _ _ _ _ hx hy⟩
#align subsemigroup.closure_induction' Subsemigroup.closure_induction'
#align add_subsemigroup.closure_induction' AddSubsemigroup.closure_induction'

/-- An induction principle for closure membership for predicates with two arguments.  -/
@[to_additive (attr := elab_as_elim) "An induction principle for additive closure membership for
  predicates with two arguments."]
theorem closure_induction₂ {p : M → M → Prop} {x} {y : M} (hx : x ∈ closure s) (hy : y ∈ closure s)
    (Hs : ∀ x ∈ s, ∀ y ∈ s, p x y) (Hmul_left : ∀ x y z, p x z → p y z → p (x * y) z)
    (Hmul_right : ∀ x y z, p z x → p z y → p z (x * y)) : p x y :=
  closure_induction hx
    (fun x xs => closure_induction hy (Hs x xs) fun z _ h₁ h₂ => Hmul_right z _ _ h₁ h₂)
    fun _ _ h₁ h₂ => Hmul_left _ _ _ h₁ h₂
#align subsemigroup.closure_induction₂ Subsemigroup.closure_induction₂
#align add_subsemigroup.closure_induction₂ AddSubsemigroup.closure_induction₂

/-- If `s` is a dense set in a magma `M`, `Subsemigroup.closure s = ⊤`, then in order to prove that
some predicate `p` holds for all `x : M` it suffices to verify `p x` for `x ∈ s`,
and verify that `p x` and `p y` imply `p (x * y)`. -/
@[to_additive (attr := elab_as_elim) "If `s` is a dense set in an additive monoid `M`,
  `AddSubsemigroup.closure s = ⊤`, then in order to prove that some predicate `p` holds
  for all `x : M` it suffices to verify `p x` for `x ∈ s`, and verify that `p x` and `p y` imply
  `p (x + y)`."]
theorem dense_induction {p : M → Prop} (x : M) {s : Set M} (hs : closure s = ⊤) (Hs : ∀ x ∈ s, p x)
    (Hmul : ∀ x y, p x → p y → p (x * y)) : p x := by
  have : ∀ x ∈ closure s, p x := fun x hx => closure_induction hx Hs Hmul
  simpa [hs] using this x
#align subsemigroup.dense_induction Subsemigroup.dense_induction
#align add_subsemigroup.dense_induction AddSubsemigroup.dense_induction

variable (M)

/-- `closure` forms a Galois insertion with the coercion to set. -/
@[to_additive "`closure` forms a Galois insertion with the coercion to set."]
protected def gi : GaloisInsertion (@closure M _) SetLike.coe :=
  GaloisConnection.toGaloisInsertion (fun _ _ => closure_le) fun _ => subset_closure
#align subsemigroup.gi Subsemigroup.gi
#align add_subsemigroup.gi AddSubsemigroup.gi

variable {M}

/-- Closure of a subsemigroup `S` equals `S`. -/
@[to_additive (attr := simp) "Additive closure of an additive subsemigroup `S` equals `S`"]
theorem closure_eq : closure (S : Set M) = S :=
  (Subsemigroup.gi M).l_u_eq S
#align subsemigroup.closure_eq Subsemigroup.closure_eq
#align add_subsemigroup.closure_eq AddSubsemigroup.closure_eq

@[to_additive (attr := simp)]
theorem closure_empty : closure (∅ : Set M) = ⊥ :=
  (Subsemigroup.gi M).gc.l_bot
#align subsemigroup.closure_empty Subsemigroup.closure_empty
#align add_subsemigroup.closure_empty AddSubsemigroup.closure_empty

@[to_additive (attr := simp)]
theorem closure_univ : closure (univ : Set M) = ⊤ :=
  @coe_top M _ ▸ closure_eq ⊤
#align subsemigroup.closure_univ Subsemigroup.closure_univ
#align add_subsemigroup.closure_univ AddSubsemigroup.closure_univ

@[to_additive]
theorem closure_union (s t : Set M) : closure (s ∪ t) = closure s ⊔ closure t :=
  (Subsemigroup.gi M).gc.l_sup
#align subsemigroup.closure_union Subsemigroup.closure_union
#align add_subsemigroup.closure_union AddSubsemigroup.closure_union

@[to_additive]
theorem closure_unionᵢ {ι} (s : ι → Set M) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
  (Subsemigroup.gi M).gc.l_supᵢ
#align subsemigroup.closure_Union Subsemigroup.closure_unionᵢ
#align add_subsemigroup.closure_Union AddSubsemigroup.closure_unionᵢ

@[to_additive]
theorem closure_singleton_le_iff_mem (m : M) (p : Subsemigroup M) : closure {m} ≤ p ↔ m ∈ p := by
  rw [closure_le, singleton_subset_iff, SetLike.mem_coe]
#align subsemigroup.closure_singleton_le_iff_mem Subsemigroup.closure_singleton_le_iff_mem
#align add_subsemigroup.closure_singleton_le_iff_mem AddSubsemigroup.closure_singleton_le_iff_mem

@[to_additive]
theorem mem_supᵢ {ι : Sort _} (p : ι → Subsemigroup M) {m : M} :
    (m ∈ ⨆ i, p i) ↔ ∀ N, (∀ i, p i ≤ N) → m ∈ N := by
  rw [← closure_singleton_le_iff_mem, le_supᵢ_iff]
  simp only [closure_singleton_le_iff_mem]
#align subsemigroup.mem_supr Subsemigroup.mem_supᵢ
#align add_subsemigroup.mem_supr AddSubsemigroup.mem_supᵢ

@[to_additive]
theorem supᵢ_eq_closure {ι : Sort _} (p : ι → Subsemigroup M) :
    (⨆ i, p i) = Subsemigroup.closure (⋃ i, (p i : Set M)) := by
  simp_rw [Subsemigroup.closure_unionᵢ, Subsemigroup.closure_eq]
#align subsemigroup.supr_eq_closure Subsemigroup.supᵢ_eq_closure
#align add_subsemigroup.supr_eq_closure AddSubsemigroup.supᵢ_eq_closure

end Subsemigroup

namespace MulHom

variable [Mul N]

open Subsemigroup

/-- The subsemigroup of elements `x : M` such that `f x = g x` -/
@[to_additive "The additive subsemigroup of elements `x : M` such that `f x = g x`"]
def eqLocus (f g : M →ₙ* N) : Subsemigroup M where
  carrier := { x | f x = g x }
  mul_mem' (hx : _ = _) (hy : _ = _) := by simp [*]
#align mul_hom.eq_mlocus MulHom.eqLocus
#align add_hom.eq_mlocus AddHom.eqLocus

/-- If two mul homomorphisms are equal on a set, then they are equal on its subsemigroup closure. -/
@[to_additive "If two add homomorphisms are equal on a set,
  then they are equal on its additive subsemigroup closure."]
theorem eqOn_closure {f g : M →ₙ* N} {s : Set M} (h : Set.EqOn f g s) :
    Set.EqOn f g (closure s) :=
  show closure s ≤ f.eqLocus g from closure_le.2 h
#align mul_hom.eq_on_mclosure MulHom.eqOn_closure
#align add_hom.eq_on_mclosure AddHom.eqOn_closure

@[to_additive]
theorem eq_of_eqOn_top {f g : M →ₙ* N} (h : Set.EqOn f g (⊤ : Subsemigroup M)) : f = g :=
  ext fun _ => h trivial
#align mul_hom.eq_of_eq_on_mtop MulHom.eq_of_eqOn_top
#align add_hom.eq_of_eq_on_mtop AddHom.eq_of_eqOn_top

@[to_additive]
theorem eq_of_eqOn_dense {s : Set M} (hs : closure s = ⊤) {f g : M →ₙ* N} (h : s.EqOn f g) :
    f = g :=
  eq_of_eqOn_top <| hs ▸ eqOn_closure h
#align mul_hom.eq_of_eq_on_mdense MulHom.eq_of_eqOn_dense
#align add_hom.eq_of_eq_on_mdense AddHom.eq_of_eqOn_dense

end MulHom

end NonAssoc

section Assoc

namespace MulHom

open Subsemigroup

/-- Let `s` be a subset of a semigroup `M` such that the closure of `s` is the whole semigroup.
Then `MulHom.ofDense` defines a mul homomorphism from `M` asking for a proof
of `f (x * y) = f x * f y` only for `y ∈ s`. -/
@[to_additive]
def ofDense {M N} [Semigroup M] [Semigroup N] {s : Set M} (f : M → N) (hs : closure s = ⊤)
    (hmul : ∀ (x), ∀ y ∈ s, f (x * y) = f x * f y) :
    M →ₙ* N where
  toFun := f
  map_mul' x y :=
    dense_induction y hs (fun y hy x => hmul x y hy)
      (fun y₁ y₂ h₁ h₂ x => by simp only [← mul_assoc, h₁, h₂]) x
#align mul_hom.of_mdense MulHom.ofDense
#align add_hom.of_mdense AddHom.ofDense

/-- Let `s` be a subset of an additive semigroup `M` such that the closure of `s` is the whole
semigroup.  Then `AddHom.ofDense` defines an additive homomorphism from `M` asking for a proof
of `f (x + y) = f x + f y` only for `y ∈ s`. -/
add_decl_doc AddHom.ofDense

@[to_additive (attr := simp, norm_cast)]
theorem coe_ofDense [Semigroup M] [Semigroup N] {s : Set M} (f : M → N) (hs : closure s = ⊤)
    (hmul) : (ofDense f hs hmul : M → N) = f :=
  rfl
#align mul_hom.coe_of_mdense MulHom.coe_ofDense
#align add_hom.coe_of_mdense AddHom.coe_ofDense

end MulHom

end Assoc


import topology.algebra.ring
import ring_theory.subring
import tactic.linarith
import power_bounded
import Huber_ring.basic

import for_mathlib.topological_rings

/-!
# Tate rings

A Tate ring is a Huber ring that has a topologically nilpotent unit.
Topologically nilpotent units are also called pseudo-uniformizers.
-/

universe u

variables {R : Type u} [comm_ring R] [topological_space R]

open filter function

/--A unit of a topological ring is called a pseudo-uniformizer if it is topologically nilpotent.-/
def is_pseudo_uniformizer (ϖ : units R) : Prop := is_topologically_nilpotent (ϖ : R)

variable (R)
/--A pseudo-uniformizer of a topological ring is a topologially nilpotent unit.-/
def pseudo_uniformizer := {ϖ : units R // is_topologically_nilpotent (ϖ : R)}
variable {R}

namespace pseudo_uniformizer

/-- The coercion from pseudo-uniformizers to the unit group. -/
instance : has_coe (pseudo_uniformizer R) (units R) := ⟨subtype.val⟩

/--The unit underlying a pseudo-uniformizer.-/
abbreviation unit (ϖ : pseudo_uniformizer R) : units R := ϖ

/--A pseudo-uniformizer is topologically nilpotent (by definition).-/
lemma is_topologically_nilpotent (ϖ : pseudo_uniformizer R) :
  is_topologically_nilpotent (ϖ : R) := ϖ.property

variables [topological_ring R]

/--A pseudo-uniformizer is power bounded.-/
lemma power_bounded (ϖ : pseudo_uniformizer R) :
  is_power_bounded (ϖ : R) :=
begin
  intros U U_nhds,
  rcases half_nhds U_nhds with ⟨U', ⟨U'_nhds, U'_prod⟩⟩,
  rcases ϖ.is_topologically_nilpotent U' U'_nhds with ⟨N, H⟩,
  let V : set R := (λ u, u*ϖ^(N+1)) '' U',
  have V_nhds : V ∈ (nhds (0 : R)),
  { dsimp [V],
    have inv : left_inverse (λ (u : R), u * (↑ϖ.unit⁻¹)^((N + 1))) (λ (u : R), u * ϖ^(N + 1)) ∧
        right_inverse (λ (u : R), u * (↑ϖ.unit⁻¹)^(N + 1)) (λ (u : R), u * ϖ^(N + 1)),
    by split ; intro ; simp [mul_assoc, (mul_pow _ _ _).symm],
    erw set.image_eq_preimage_of_inverse inv.1 inv.2,
    have : tendsto (λ (u : R), u * ↑ϖ.1⁻¹ ^ (N + 1)) (nhds 0) (nhds 0),
    { conv {congr, skip, skip, rw ←(zero_mul (↑ϖ.1⁻¹ ^ (N + 1) : R))},
        exact tendsto_id.mul tendsto_const_nhds },
    exact this U'_nhds },
  use [V, V_nhds],
  rintros _ ⟨u, u_in, rfl⟩ b ⟨n, rfl⟩,
  rw [mul_assoc, ← pow_add],
  apply U'_prod _ _ u_in (H _ _),
  linarith
end

/-- The coercion from pseudo-uniformizers to the power bounded subring. -/
instance coe_to_power_bounded_subring : has_coe (pseudo_uniformizer R) (power_bounded_subring R) :=
⟨λ ϖ, ⟨_, ϖ.power_bounded⟩⟩

end pseudo_uniformizer

/--A Tate ring is a Huber ring that has a pseudo uniformizer.-/
class Tate_ring (R : Type u) [Huber_ring R] : Prop :=
(has_pseudo_uniformizer : nonempty (pseudo_uniformizer R))