/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth, Sébastien Gouëzel

! This file was ported from Lean 3 source module analysis.calculus.inverse
! leanprover-community/mathlib commit b2ff9a3d7a15fd5b0f060b135421d6a89a999c2f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.ContDiff
import Mathbin.Tactic.RingExp
import Mathbin.Analysis.NormedSpace.Banach
import Mathbin.Topology.LocalHomeomorph

/-!
# Inverse function theorem

In this file we prove the inverse function theorem. It says that if a map `f : E → F`
has an invertible strict derivative `f'` at `a`, then it is locally invertible,
and the inverse function has derivative `f' ⁻¹`.

We define `has_strict_deriv_at.to_local_homeomorph` that repacks a function `f`
with a `hf : has_strict_fderiv_at f f' a`, `f' : E ≃L[𝕜] F`, into a `local_homeomorph`.
The `to_fun` of this `local_homeomorph` is `defeq` to `f`, so one can apply theorems
about `local_homeomorph` to `hf.to_local_homeomorph f`, and get statements about `f`.

Then we define `has_strict_fderiv_at.local_inverse` to be the `inv_fun` of this `local_homeomorph`,
and prove two versions of the inverse function theorem:

* `has_strict_fderiv_at.to_local_inverse`: if `f` has an invertible derivative `f'` at `a` in the
  strict sense (`hf`), then `hf.local_inverse f f' a` has derivative `f'.symm` at `f a` in the
  strict sense;

* `has_strict_fderiv_at.to_local_left_inverse`: if `f` has an invertible derivative `f'` at `a` in
  the strict sense and `g` is locally left inverse to `f` near `a`, then `g` has derivative
  `f'.symm` at `f a` in the strict sense.

In the one-dimensional case we reformulate these theorems in terms of `has_strict_deriv_at` and
`f'⁻¹`.

We also reformulate the theorems in terms of `cont_diff`, to give that `C^k` (respectively,
smooth) inputs give `C^k` (smooth) inverses.  These versions require that continuous
differentiability implies strict differentiability; this is false over a general field, true over
`ℝ` or `ℂ` and implemented here assuming `is_R_or_C 𝕂`.

Some related theorems, providing the derivative and higher regularity assuming that we already know
the inverse function, are formulated in `fderiv.lean`, `deriv.lean`, and `cont_diff.lean`.

## Notations

In the section about `approximates_linear_on` we introduce some `local notation` to make formulas
shorter:

* by `N` we denote `‖f'⁻¹‖`;
* by `g` we denote the auxiliary contracting map `x ↦ x + f'.symm (y - f x)` used to prove that
  `{x | f x = y}` is nonempty.

## Tags

derivative, strictly differentiable, continuously differentiable, smooth, inverse function
-/

open Function Set Filter Metric

open Topology Classical NNReal

noncomputable section

variable {𝕜 : Type _} [NontriviallyNormedField 𝕜]

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace 𝕜 E]

variable {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F]

variable {G : Type _} [NormedAddCommGroup G] [NormedSpace 𝕜 G]

variable {G' : Type _} [NormedAddCommGroup G'] [NormedSpace 𝕜 G']

variable {ε : ℝ}

open Asymptotics Filter Metric Set

open ContinuousLinearMap (id)

/-!
### Non-linear maps close to affine maps

In this section we study a map `f` such that `‖f x - f y - f' (x - y)‖ ≤ c * ‖x - y‖` on an open set
`s`, where `f' : E →L[𝕜] F` is a continuous linear map and `c` is suitably small. Maps of this type
behave like `f a + f' (x - a)` near each `a ∈ s`.

When `f'` is onto, we show that `f` is locally onto.

When `f'` is a continuous linear equiv, we show that `f` is a homeomorphism
between `s` and `f '' s`. More precisely, we define `approximates_linear_on.to_local_homeomorph` to
be a `local_homeomorph` with `to_fun = f`, `source = s`, and `target = f '' s`.

Maps of this type naturally appear in the proof of the inverse function theorem (see next section),
and `approximates_linear_on.to_local_homeomorph` will imply that the locally inverse function
exists.

We define this auxiliary notion to split the proof of the inverse function theorem into small
lemmas. This approach makes it possible

- to prove a lower estimate on the size of the domain of the inverse function;

- to reuse parts of the proofs in the case if a function is not strictly differentiable. E.g., for a
  function `f : E × F → G` with estimates on `f x y₁ - f x y₂` but not on `f x₁ y - f x₂ y`.
-/

/-- We say that `f` approximates a continuous linear map `f'` on `s` with constant `c`,
if `‖f x - f y - f' (x - y)‖ ≤ c * ‖x - y‖` whenever `x, y ∈ s`.

This predicate is defined to facilitate the splitting of the inverse function theorem into small
lemmas. Some of these lemmas can be useful, e.g., to prove that the inverse function is defined
on a specific set. -/
def ApproximatesLinearOn (f : E → F) (f' : E →L[𝕜] F) (s : Set E) (c : ℝ≥0) : Prop :=
  ∀ x ∈ s, ∀ y ∈ s, ‖f x - f y - f' (x - y)‖ ≤ c * ‖x - y‖
#align approximates_linear_on ApproximatesLinearOn

@[simp]
theorem approximatesLinearOn_empty (f : E → F) (f' : E →L[𝕜] F) (c : ℝ≥0) :
    ApproximatesLinearOn f f' ∅ c := by simp [ApproximatesLinearOn]
#align approximates_linear_on_empty approximatesLinearOn_empty

namespace ApproximatesLinearOn

variable [cs : CompleteSpace E] {f : E → F}

/-! First we prove some properties of a function that `approximates_linear_on` a (not necessarily
invertible) continuous linear map. -/

section

variable {f' : E →L[𝕜] F} {s t : Set E} {c c' : ℝ≥0}

theorem mono_num (hc : c ≤ c') (hf : ApproximatesLinearOn f f' s c) :
    ApproximatesLinearOn f f' s c' := fun x hx y hy =>
  le_trans (hf x hx y hy) (mul_le_mul_of_nonneg_right hc <| norm_nonneg _)
#align approximates_linear_on.mono_num ApproximatesLinearOn.mono_num

theorem mono_set (hst : s ⊆ t) (hf : ApproximatesLinearOn f f' t c) :
    ApproximatesLinearOn f f' s c := fun x hx y hy => hf x (hst hx) y (hst hy)
#align approximates_linear_on.mono_set ApproximatesLinearOn.mono_set

theorem approximatesLinearOn_iff_lipschitzOnWith {f : E → F} {f' : E →L[𝕜] F} {s : Set E}
    {c : ℝ≥0} : ApproximatesLinearOn f f' s c ↔ LipschitzOnWith c (f - f') s :=
  by
  have : ∀ x y, f x - f y - f' (x - y) = (f - f') x - (f - f') y :=
    by
    intro x y
    simp only [map_sub, Pi.sub_apply]
    abel
  simp only [this, lipschitzOnWith_iff_norm_sub_le, ApproximatesLinearOn]
#align approximates_linear_on.approximates_linear_on_iff_lipschitz_on_with ApproximatesLinearOn.approximatesLinearOn_iff_lipschitzOnWith

alias approximates_linear_on_iff_lipschitz_on_with ↔
  LipschitzOnWith _root_.lipschitz_on_with.approximates_linear_on
#align approximates_linear_on.lipschitz_on_with ApproximatesLinearOn.lipschitzOnWith
#align lipschitz_on_with.approximates_linear_on LipschitzOnWith.approximatesLinearOn

theorem lipschitz_sub (hf : ApproximatesLinearOn f f' s c) :
    LipschitzWith c fun x : s => f x - f' x :=
  by
  refine' LipschitzWith.of_dist_le_mul fun x y => _
  rw [dist_eq_norm, Subtype.dist_eq, dist_eq_norm]
  convert hf x x.2 y y.2 using 2
  rw [f'.map_sub]; abel
#align approximates_linear_on.lipschitz_sub ApproximatesLinearOn.lipschitz_sub

protected theorem lipschitz (hf : ApproximatesLinearOn f f' s c) :
    LipschitzWith (‖f'‖₊ + c) (s.restrict f) := by
  simpa only [restrict_apply, add_sub_cancel'_right] using
    (f'.lipschitz.restrict s).add hf.lipschitz_sub
#align approximates_linear_on.lipschitz ApproximatesLinearOn.lipschitz

protected theorem continuous (hf : ApproximatesLinearOn f f' s c) : Continuous (s.restrict f) :=
  hf.lipschitz.Continuous
#align approximates_linear_on.continuous ApproximatesLinearOn.continuous

protected theorem continuousOn (hf : ApproximatesLinearOn f f' s c) : ContinuousOn f s :=
  continuousOn_iff_continuous_restrict.2 hf.Continuous
#align approximates_linear_on.continuous_on ApproximatesLinearOn.continuousOn

end

section LocallyOnto

/-!
We prove that a function which is linearly approximated by a continuous linear map with a nonlinear
right inverse is locally onto. This will apply to the case where the approximating map is a linear
equivalence, for the local inverse theorem, but also whenever the approximating map is onto,
by Banach's open mapping theorem. -/

include cs

variable {s : Set E} {c : ℝ≥0} {f' : E →L[𝕜] F}

/-- If a function is linearly approximated by a continuous linear map with a (possibly nonlinear)
right inverse, then it is locally onto: a ball of an explicit radius is included in the image
of the map. -/
theorem surjOn_closedBall_of_nonlinearRightInverse (hf : ApproximatesLinearOn f f' s c)
    (f'symm : f'.NonlinearRightInverse) {ε : ℝ} {b : E} (ε0 : 0 ≤ ε) (hε : closedBall b ε ⊆ s) :
    SurjOn f (closedBall b ε) (closedBall (f b) (((f'symm.nnnorm : ℝ)⁻¹ - c) * ε)) :=
  by
  intro y hy
  cases' le_or_lt (f'symm.nnnorm : ℝ)⁻¹ c with hc hc
  · refine' ⟨b, by simp [ε0], _⟩
    have : dist y (f b) ≤ 0 :=
      (mem_closed_ball.1 hy).trans (mul_nonpos_of_nonpos_of_nonneg (by linarith) ε0)
    simp only [dist_le_zero] at this
    rw [this]
  have If' : (0 : ℝ) < f'symm.nnnorm := by
    rw [← inv_pos]
    exact (NNReal.coe_nonneg _).trans_lt hc
  have Icf' : (c : ℝ) * f'symm.nnnorm < 1 := by rwa [inv_eq_one_div, lt_div_iff If'] at hc
  have Jf' : (f'symm.nnnorm : ℝ) ≠ 0 := ne_of_gt If'
  have Jcf' : (1 : ℝ) - c * f'symm.nnnorm ≠ 0 :=
    by
    apply ne_of_gt
    linarith
  /- We have to show that `y` can be written as `f x` for some `x ∈ closed_ball b ε`.
    The idea of the proof is to apply the Banach contraction principle to the map
    `g : x ↦ x + f'symm (y - f x)`, as a fixed point of this map satisfies `f x = y`.
    When `f'symm` is a genuine linear inverse, `g` is a contracting map. In our case, since `f'symm`
    is nonlinear, this map is not contracting (it is not even continuous), but still the proof of
    the contraction theorem holds: `uₙ = gⁿ b` is a Cauchy sequence, converging exponentially fast
    to the desired point `x`. Instead of appealing to general results, we check this by hand.

    The main point is that `f (u n)` becomes exponentially close to `y`, and therefore
    `dist (u (n+1)) (u n)` becomes exponentally small, making it possible to get an inductive
    bound on `dist (u n) b`, from which one checks that `u n` stays in the ball on which one has a
    control. Therefore, the bound can be checked at the next step, and so on inductively.
    -/
  set g := fun x => x + f'symm (y - f x) with hg
  set u := fun n : ℕ => (g^[n]) b with hu
  have usucc : ∀ n, u (n + 1) = g (u n) := by simp [hu, ← iterate_succ_apply' g _ b]
  -- First bound: if `f z` is close to `y`, then `g z` is close to `z` (i.e., almost a fixed point).
  have A : ∀ z, dist (g z) z ≤ f'symm.nnnorm * dist (f z) y :=
    by
    intro z
    rw [dist_eq_norm, hg, add_sub_cancel', dist_eq_norm']
    exact f'symm.bound _
  -- Second bound: if `z` and `g z` are in the set with good control, then `f (g z)` becomes closer
  -- to `y` than `f z` was (this uses the linear approximation property, and is the reason for the
  -- choice of the formula for `g`).
  have B :
    ∀ z ∈ closed_ball b ε,
      g z ∈ closed_ball b ε → dist (f (g z)) y ≤ c * f'symm.nnnorm * dist (f z) y :=
    by
    intro z hz hgz
    set v := f'symm (y - f z) with hv
    calc
      dist (f (g z)) y = ‖f (z + v) - y‖ := by rw [dist_eq_norm]
      _ = ‖f (z + v) - f z - f' v + f' v - (y - f z)‖ :=
        by
        congr 1
        abel
      _ = ‖f (z + v) - f z - f' (z + v - z)‖ := by
        simp only [ContinuousLinearMap.NonlinearRightInverse.right_inv, add_sub_cancel',
          sub_add_cancel]
      _ ≤ c * ‖z + v - z‖ := (hf _ (hε hgz) _ (hε hz))
      _ ≤ c * (f'symm.nnnorm * dist (f z) y) :=
        by
        apply mul_le_mul_of_nonneg_left _ (NNReal.coe_nonneg c)
        simpa [hv, dist_eq_norm'] using f'symm.bound (y - f z)
      _ = c * f'symm.nnnorm * dist (f z) y := by ring

  -- Third bound: a complicated bound on `dist w b` (that will show up in the induction) is enough
  -- to check that `w` is in the ball on which one has controls. Will be used to check that `u n`
  -- belongs to this ball for all `n`.
  have C :
    ∀ (n : ℕ) (w : E),
      dist w b ≤
          f'symm.nnnorm * (1 - (c * f'symm.nnnorm) ^ n) / (1 - c * f'symm.nnnorm) * dist (f b) y →
        w ∈ closed_ball b ε :=
    by
    intro n w hw
    apply hw.trans
    rw [div_mul_eq_mul_div, div_le_iff]
    swap
    · linarith
    calc
      (f'symm.nnnorm : ℝ) * (1 - (c * f'symm.nnnorm) ^ n) * dist (f b) y =
          f'symm.nnnorm * dist (f b) y * (1 - (c * f'symm.nnnorm) ^ n) :=
        by ring
      _ ≤ f'symm.nnnorm * dist (f b) y * 1 :=
        by
        apply mul_le_mul_of_nonneg_left _ (mul_nonneg (NNReal.coe_nonneg _) dist_nonneg)
        rw [sub_le_self_iff]
        exact pow_nonneg (mul_nonneg (NNReal.coe_nonneg _) (NNReal.coe_nonneg _)) _
      _ ≤ f'symm.nnnorm * (((f'symm.nnnorm : ℝ)⁻¹ - c) * ε) :=
        by
        rw [mul_one]
        exact mul_le_mul_of_nonneg_left (mem_closed_ball'.1 hy) (NNReal.coe_nonneg _)
      _ = ε * (1 - c * f'symm.nnnorm) := by
        field_simp
        ring

  /- Main inductive control: `f (u n)` becomes exponentially close to `y`, and therefore
    `dist (u (n+1)) (u n)` becomes exponentally small, making it possible to get an inductive
    bound on `dist (u n) b`, from which one checks that `u n` remains in the ball on which we
    have estimates. -/
  have D :
    ∀ n : ℕ,
      dist (f (u n)) y ≤ (c * f'symm.nnnorm) ^ n * dist (f b) y ∧
        dist (u n) b ≤
          f'symm.nnnorm * (1 - (c * f'symm.nnnorm) ^ n) / (1 - c * f'symm.nnnorm) * dist (f b) y :=
    by
    intro n
    induction' n with n IH
    · simp [hu, le_refl]
    rw [usucc]
    have Ign :
      dist (g (u n)) b ≤
        f'symm.nnnorm * (1 - (c * f'symm.nnnorm) ^ n.succ) / (1 - c * f'symm.nnnorm) *
          dist (f b) y :=
      calc
        dist (g (u n)) b ≤ dist (g (u n)) (u n) + dist (u n) b := dist_triangle _ _ _
        _ ≤ f'symm.nnnorm * dist (f (u n)) y + dist (u n) b := (add_le_add (A _) le_rfl)
        _ ≤
            f'symm.nnnorm * ((c * f'symm.nnnorm) ^ n * dist (f b) y) +
              f'symm.nnnorm * (1 - (c * f'symm.nnnorm) ^ n) / (1 - c * f'symm.nnnorm) *
                dist (f b) y :=
          (add_le_add (mul_le_mul_of_nonneg_left IH.1 (NNReal.coe_nonneg _)) IH.2)
        _ =
            f'symm.nnnorm * (1 - (c * f'symm.nnnorm) ^ n.succ) / (1 - c * f'symm.nnnorm) *
              dist (f b) y :=
          by
          field_simp [Jcf']
          ring

    refine' ⟨_, Ign⟩
    calc
      dist (f (g (u n))) y ≤ c * f'symm.nnnorm * dist (f (u n)) y :=
        B _ (C n _ IH.2) (C n.succ _ Ign)
      _ ≤ c * f'symm.nnnorm * ((c * f'symm.nnnorm) ^ n * dist (f b) y) :=
        (mul_le_mul_of_nonneg_left IH.1 (mul_nonneg (NNReal.coe_nonneg _) (NNReal.coe_nonneg _)))
      _ = (c * f'symm.nnnorm) ^ n.succ * dist (f b) y := by ring

  -- Deduce from the inductive bound that `uₙ` is a Cauchy sequence, therefore converging.
  have : CauchySeq u :=
    haveI :
      ∀ n : ℕ, dist (u n) (u (n + 1)) ≤ f'symm.nnnorm * dist (f b) y * (c * f'symm.nnnorm) ^ n :=
      by
      intro n
      calc
        dist (u n) (u (n + 1)) = dist (g (u n)) (u n) := by rw [usucc, dist_comm]
        _ ≤ f'symm.nnnorm * dist (f (u n)) y := (A _)
        _ ≤ f'symm.nnnorm * ((c * f'symm.nnnorm) ^ n * dist (f b) y) :=
          (mul_le_mul_of_nonneg_left (D n).1 (NNReal.coe_nonneg _))
        _ = f'symm.nnnorm * dist (f b) y * (c * f'symm.nnnorm) ^ n := by ring

    cauchySeq_of_le_geometric _ _ Icf' this
  obtain ⟨x, hx⟩ : ∃ x, tendsto u at_top (𝓝 x) := cauchySeq_tendsto_of_complete this
  -- As all the `uₙ` belong to the ball `closed_ball b ε`, so does their limit `x`.
  have xmem : x ∈ closed_ball b ε :=
    is_closed_ball.mem_of_tendsto hx (eventually_of_forall fun n => C n _ (D n).2)
  refine' ⟨x, xmem, _⟩
  -- It remains to check that `f x = y`. This follows from continuity of `f` on `closed_ball b ε`
  -- and from the fact that `f uₙ` is converging to `y` by construction.
  have hx' : tendsto u at_top (𝓝[closed_ball b ε] x) :=
    by
    simp only [nhdsWithin, tendsto_inf, hx, true_and_iff, ge_iff_le, tendsto_principal]
    exact eventually_of_forall fun n => C n _ (D n).2
  have T1 : tendsto (fun n => f (u n)) at_top (𝓝 (f x)) :=
    (hf.continuous_on.mono hε x xmem).Tendsto.comp hx'
  have T2 : tendsto (fun n => f (u n)) at_top (𝓝 y) :=
    by
    rw [tendsto_iff_dist_tendsto_zero]
    refine' squeeze_zero (fun n => dist_nonneg) (fun n => (D n).1) _
    simpa using
      (tendsto_pow_atTop_nhds_0_of_lt_1 (mul_nonneg (NNReal.coe_nonneg _) (NNReal.coe_nonneg _))
            Icf').mul
        tendsto_const_nhds
  exact tendsto_nhds_unique T1 T2
#align approximates_linear_on.surj_on_closed_ball_of_nonlinear_right_inverse ApproximatesLinearOn.surjOn_closedBall_of_nonlinearRightInverse

theorem open_image (hf : ApproximatesLinearOn f f' s c) (f'symm : f'.NonlinearRightInverse)
    (hs : IsOpen s) (hc : Subsingleton F ∨ c < f'symm.nnnorm⁻¹) : IsOpen (f '' s) :=
  by
  cases' hc with hE hc;
  · skip
    apply isOpen_discrete
  simp only [isOpen_iff_mem_nhds, nhds_basis_closed_ball.mem_iff, ball_image_iff] at hs⊢
  intro x hx
  rcases hs x hx with ⟨ε, ε0, hε⟩
  refine' ⟨(f'symm.nnnorm⁻¹ - c) * ε, mul_pos (sub_pos.2 hc) ε0, _⟩
  exact
    (hf.surj_on_closed_ball_of_nonlinear_right_inverse f'symm (le_of_lt ε0) hε).mono hε
      (subset.refl _)
#align approximates_linear_on.open_image ApproximatesLinearOn.open_image

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (t «expr ⊆ » s) -/
theorem image_mem_nhds (hf : ApproximatesLinearOn f f' s c) (f'symm : f'.NonlinearRightInverse)
    {x : E} (hs : s ∈ 𝓝 x) (hc : Subsingleton F ∨ c < f'symm.nnnorm⁻¹) : f '' s ∈ 𝓝 (f x) :=
  by
  obtain ⟨t, hts, ht, xt⟩ : ∃ (t : _)(_ : t ⊆ s), IsOpen t ∧ x ∈ t := _root_.mem_nhds_iff.1 hs
  have := IsOpen.mem_nhds ((hf.mono_set hts).open_image f'symm ht hc) (mem_image_of_mem _ xt)
  exact mem_of_superset this (image_subset _ hts)
#align approximates_linear_on.image_mem_nhds ApproximatesLinearOn.image_mem_nhds

theorem map_nhds_eq (hf : ApproximatesLinearOn f f' s c) (f'symm : f'.NonlinearRightInverse) {x : E}
    (hs : s ∈ 𝓝 x) (hc : Subsingleton F ∨ c < f'symm.nnnorm⁻¹) : map f (𝓝 x) = 𝓝 (f x) :=
  by
  refine'
    le_antisymm ((hf.continuous_on x (mem_of_mem_nhds hs)).ContinuousAt hs) (le_map fun t ht => _)
  have : f '' (s ∩ t) ∈ 𝓝 (f x) :=
    (hf.mono_set (inter_subset_left s t)).image_mem_nhds f'symm (inter_mem hs ht) hc
  exact mem_of_superset this (image_subset _ (inter_subset_right _ _))
#align approximates_linear_on.map_nhds_eq ApproximatesLinearOn.map_nhds_eq

end LocallyOnto

/-!
From now on we assume that `f` approximates an invertible continuous linear map `f : E ≃L[𝕜] F`.

We also assume that either `E = {0}`, or `c < ‖f'⁻¹‖⁻¹`. We use `N` as an abbreviation for `‖f'⁻¹‖`.
-/

variable {f' : E ≃L[𝕜] F} {s : Set E} {c : ℝ≥0}

-- mathport name: exprN
local notation "N" => ‖(f'.symm : F →L[𝕜] E)‖₊

protected theorem antilipschitz (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) : AntilipschitzWith (N⁻¹ - c)⁻¹ (s.restrict f) :=
  by
  cases' hc with hE hc
  · haveI : Subsingleton s := ⟨fun x y => Subtype.eq <| @Subsingleton.elim _ hE _ _⟩
    exact AntilipschitzWith.of_subsingleton
  convert(f'.antilipschitz.restrict s).add_lipschitzWith hf.lipschitz_sub hc
  simp [restrict]
#align approximates_linear_on.antilipschitz ApproximatesLinearOn.antilipschitz

protected theorem injective (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) : Injective (s.restrict f) :=
  (hf.antilipschitz hc).Injective
#align approximates_linear_on.injective ApproximatesLinearOn.injective

protected theorem injOn (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) : InjOn f s :=
  injOn_iff_injective.2 <| hf.Injective hc
#align approximates_linear_on.inj_on ApproximatesLinearOn.injOn

protected theorem surjective [CompleteSpace E] (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) univ c)
    (hc : Subsingleton E ∨ c < N⁻¹) : Surjective f :=
  by
  cases' hc with hE hc
  · haveI : Subsingleton F := (Equiv.subsingleton_congr f'.to_linear_equiv.to_equiv).1 hE
    exact surjective_to_subsingleton _
  · apply forall_of_forall_mem_closed_ball (fun y : F => ∃ a, f a = y) (f 0) _
    have hc' : (0 : ℝ) < N⁻¹ - c := by
      rw [sub_pos]
      exact hc
    let p : ℝ → Prop := fun R => closed_ball (f 0) R ⊆ Set.range f
    have hp : ∀ᶠ r : ℝ in at_top, p ((N⁻¹ - c) * r) :=
      by
      have hr : ∀ᶠ r : ℝ in at_top, 0 ≤ r := eventually_ge_at_top 0
      refine' hr.mono fun r hr => subset.trans _ (image_subset_range f (closed_ball 0 r))
      refine' hf.surj_on_closed_ball_of_nonlinear_right_inverse f'.to_nonlinear_right_inverse hr _
      exact subset_univ _
    refine' ((tendsto_id.const_mul_at_top hc').Frequently hp.frequently).mono _
    exact fun R h y hy => h hy
#align approximates_linear_on.surjective ApproximatesLinearOn.surjective

/-- A map approximating a linear equivalence on a set defines a local equivalence on this set.
Should not be used outside of this file, because it is superseded by `to_local_homeomorph` below.

This is a first step towards the inverse function. -/
def toLocalEquiv (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) : LocalEquiv E F :=
  (hf.InjOn hc).toLocalEquiv _ _
#align approximates_linear_on.to_local_equiv ApproximatesLinearOn.toLocalEquiv

/-- The inverse function is continuous on `f '' s`. Use properties of `local_homeomorph` instead. -/
theorem inverse_continuousOn (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) : ContinuousOn (hf.toLocalEquiv hc).symm (f '' s) :=
  by
  apply continuousOn_iff_continuous_restrict.2
  refine' ((hf.antilipschitz hc).to_right_inv_on' _ (hf.to_local_equiv hc).right_inv').Continuous
  exact fun x hx => (hf.to_local_equiv hc).map_target hx
#align approximates_linear_on.inverse_continuous_on ApproximatesLinearOn.inverse_continuousOn

/-- The inverse function is approximated linearly on `f '' s` by `f'.symm`. -/
theorem to_inv (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c) (hc : Subsingleton E ∨ c < N⁻¹) :
    ApproximatesLinearOn (hf.toLocalEquiv hc).symm (f'.symm : F →L[𝕜] E) (f '' s)
      (N * (N⁻¹ - c)⁻¹ * c) :=
  by
  intro x hx y hy
  set A := hf.to_local_equiv hc with hA
  have Af : ∀ z, A z = f z := fun z => rfl
  rcases(mem_image _ _ _).1 hx with ⟨x', x's, rfl⟩
  rcases(mem_image _ _ _).1 hy with ⟨y', y's, rfl⟩
  rw [← Af x', ← Af y', A.left_inv x's, A.left_inv y's]
  calc
    ‖x' - y' - f'.symm (A x' - A y')‖ ≤ N * ‖f' (x' - y' - f'.symm (A x' - A y'))‖ :=
      (f' : E →L[𝕜] F).bound_of_antilipschitz f'.antilipschitz _
    _ = N * ‖A y' - A x' - f' (y' - x')‖ := by
      congr 2
      simp only [ContinuousLinearEquiv.apply_symm_apply, ContinuousLinearEquiv.map_sub]
      abel
    _ ≤ N * (c * ‖y' - x'‖) := (mul_le_mul_of_nonneg_left (hf _ y's _ x's) (NNReal.coe_nonneg _))
    _ ≤ N * (c * (((N⁻¹ - c)⁻¹ : ℝ≥0) * ‖A y' - A x'‖)) :=
      by
      apply_rules [mul_le_mul_of_nonneg_left, NNReal.coe_nonneg]
      rw [← dist_eq_norm, ← dist_eq_norm]
      exact (hf.antilipschitz hc).le_mul_dist ⟨y', y's⟩ ⟨x', x's⟩
    _ = (N * (N⁻¹ - c)⁻¹ * c : ℝ≥0) * ‖A x' - A y'‖ :=
      by
      simp only [norm_sub_rev, Nonneg.coe_mul]
      ring

#align approximates_linear_on.to_inv ApproximatesLinearOn.to_inv

include cs

section

variable (f s)

/-- Given a function `f` that approximates a linear equivalence on an open set `s`,
returns a local homeomorph with `to_fun = f` and `source = s`. -/
def toLocalHomeomorph (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) (hs : IsOpen s) : LocalHomeomorph E F
    where
  toLocalEquiv := hf.toLocalEquiv hc
  open_source := hs
  open_target :=
    hf.open_image f'.toNonlinearRightInverse hs
      (by rwa [f'.to_linear_equiv.to_equiv.subsingleton_congr] at hc)
  continuous_toFun := hf.ContinuousOn
  continuous_invFun := hf.inverse_continuousOn hc
#align approximates_linear_on.to_local_homeomorph ApproximatesLinearOn.toLocalHomeomorph

/-- A function `f` that approximates a linear equivalence on the whole space is a homeomorphism. -/
def toHomeomorph (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) univ c)
    (hc : Subsingleton E ∨ c < N⁻¹) : E ≃ₜ F :=
  by
  refine' (hf.to_local_homeomorph _ _ hc isOpen_univ).toHomeomorphOfSourceEqUnivTargetEqUniv rfl _
  change f '' univ = univ
  rw [image_univ, range_iff_surjective]
  exact hf.surjective hc
#align approximates_linear_on.to_homeomorph ApproximatesLinearOn.toHomeomorph

omit cs

/-- In a real vector space, a function `f` that approximates a linear equivalence on a subset `s`
can be extended to a homeomorphism of the whole space. -/
theorem exists_homeomorph_extension {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E]
    {F : Type _} [NormedAddCommGroup F] [NormedSpace ℝ F] [FiniteDimensional ℝ F] {s : Set E}
    {f : E → F} {f' : E ≃L[ℝ] F} {c : ℝ≥0} (hf : ApproximatesLinearOn f (f' : E →L[ℝ] F) s c)
    (hc : Subsingleton E ∨ lipschitzExtensionConstant F * c < ‖(f'.symm : F →L[ℝ] E)‖₊⁻¹) :
    ∃ g : E ≃ₜ F, EqOn f g s :=
  by
  -- the difference `f - f'` is Lipschitz on `s`. It can be extended to a Lipschitz function `u`
  -- on the whole space, with a slightly worse Lipschitz constant. Then `f' + u` will be the
  -- desired homeomorphism.
  obtain ⟨u, hu, uf⟩ :
    ∃ u : E → F, LipschitzWith (lipschitzExtensionConstant F * c) u ∧ eq_on (f - f') u s :=
    hf.lipschitz_on_with.extend_finite_dimension
  let g : E → F := fun x => f' x + u x
  have fg : eq_on f g s := fun x hx => by simp_rw [g, ← uf hx, Pi.sub_apply, add_sub_cancel'_right]
  have hg : ApproximatesLinearOn g (f' : E →L[ℝ] F) univ (lipschitzExtensionConstant F * c) :=
    by
    apply LipschitzOnWith.approximatesLinearOn
    rw [lipschitz_on_univ]
    convert hu
    ext x
    simp only [add_sub_cancel', ContinuousLinearEquiv.coe_coe, Pi.sub_apply]
  haveI : FiniteDimensional ℝ E := f'.symm.to_linear_equiv.finite_dimensional
  exact ⟨hg.to_homeomorph g hc, fg⟩
#align approximates_linear_on.exists_homeomorph_extension ApproximatesLinearOn.exists_homeomorph_extension

end

@[simp]
theorem toLocalHomeomorph_coe (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) (hs : IsOpen s) :
    (hf.toLocalHomeomorph f s hc hs : E → F) = f :=
  rfl
#align approximates_linear_on.to_local_homeomorph_coe ApproximatesLinearOn.toLocalHomeomorph_coe

@[simp]
theorem toLocalHomeomorph_source (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) (hs : IsOpen s) : (hf.toLocalHomeomorph f s hc hs).source = s :=
  rfl
#align approximates_linear_on.to_local_homeomorph_source ApproximatesLinearOn.toLocalHomeomorph_source

@[simp]
theorem toLocalHomeomorph_target (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) (hs : IsOpen s) :
    (hf.toLocalHomeomorph f s hc hs).target = f '' s :=
  rfl
#align approximates_linear_on.to_local_homeomorph_target ApproximatesLinearOn.toLocalHomeomorph_target

theorem closedBall_subset_target (hf : ApproximatesLinearOn f (f' : E →L[𝕜] F) s c)
    (hc : Subsingleton E ∨ c < N⁻¹) (hs : IsOpen s) {b : E} (ε0 : 0 ≤ ε) (hε : closedBall b ε ⊆ s) :
    closedBall (f b) ((N⁻¹ - c) * ε) ⊆ (hf.toLocalHomeomorph f s hc hs).target :=
  (hf.surjOn_closedBall_of_nonlinearRightInverse f'.toNonlinearRightInverse ε0 hε).mono hε
    (Subset.refl _)
#align approximates_linear_on.closed_ball_subset_target ApproximatesLinearOn.closedBall_subset_target

end ApproximatesLinearOn

/-!
### Inverse function theorem

Now we prove the inverse function theorem. Let `f : E → F` be a map defined on a complete vector
space `E`. Assume that `f` has an invertible derivative `f' : E ≃L[𝕜] F` at `a : E` in the strict
sense. Then `f` approximates `f'` in the sense of `approximates_linear_on` on an open neighborhood
of `a`, and we can apply `approximates_linear_on.to_local_homeomorph` to construct the inverse
function. -/

namespace HasStrictFderivAt

/-- If `f` has derivative `f'` at `a` in the strict sense and `c > 0`, then `f` approximates `f'`
with constant `c` on some neighborhood of `a`. -/
theorem approximates_deriv_on_nhds {f : E → F} {f' : E →L[𝕜] F} {a : E}
    (hf : HasStrictFderivAt f f' a) {c : ℝ≥0} (hc : Subsingleton E ∨ 0 < c) :
    ∃ s ∈ 𝓝 a, ApproximatesLinearOn f f' s c :=
  by
  cases' hc with hE hc
  · refine' ⟨univ, IsOpen.mem_nhds isOpen_univ trivial, fun x hx y hy => _⟩
    simp [@Subsingleton.elim E hE x y]
  have := hf.def hc
  rw [nhds_prod_eq, Filter.Eventually, mem_prod_same_iff] at this
  rcases this with ⟨s, has, hs⟩
  exact ⟨s, has, fun x hx y hy => hs (mk_mem_prod hx hy)⟩
#align has_strict_fderiv_at.approximates_deriv_on_nhds HasStrictFderivAt.approximates_deriv_on_nhds

theorem map_nhds_eq_of_surj [CompleteSpace E] [CompleteSpace F] {f : E → F} {f' : E →L[𝕜] F} {a : E}
    (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) (h : LinearMap.range f' = ⊤) :
    map f (𝓝 a) = 𝓝 (f a) :=
  by
  let f'symm := f'.nonlinear_right_inverse_of_surjective h
  set c : ℝ≥0 := f'symm.nnnorm⁻¹ / 2 with hc
  have f'symm_pos : 0 < f'symm.nnnorm := f'.nonlinear_right_inverse_of_surjective_nnnorm_pos h
  have cpos : 0 < c := by simp [hc, half_pos, inv_pos, f'symm_pos]
  obtain ⟨s, s_nhds, hs⟩ : ∃ s ∈ 𝓝 a, ApproximatesLinearOn f f' s c :=
    hf.approximates_deriv_on_nhds (Or.inr cpos)
  apply hs.map_nhds_eq f'symm s_nhds (Or.inr (NNReal.half_lt_self _))
  simp [ne_of_gt f'symm_pos]
#align has_strict_fderiv_at.map_nhds_eq_of_surj HasStrictFderivAt.map_nhds_eq_of_surj

variable [cs : CompleteSpace E] {f : E → F} {f' : E ≃L[𝕜] F} {a : E}

theorem approximates_deriv_on_open_nhds (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    ∃ (s : Set E)(hs : a ∈ s ∧ IsOpen s),
      ApproximatesLinearOn f (f' : E →L[𝕜] F) s (‖(f'.symm : F →L[𝕜] E)‖₊⁻¹ / 2) :=
  by
  refine' ((nhds_basis_opens a).exists_iff _).1 _
  exact fun s t => ApproximatesLinearOn.mono_set
  exact
    hf.approximates_deriv_on_nhds <|
      f'.subsingleton_or_nnnorm_symm_pos.imp id fun hf' => half_pos <| inv_pos.2 hf'
#align has_strict_fderiv_at.approximates_deriv_on_open_nhds HasStrictFderivAt.approximates_deriv_on_open_nhds

include cs

variable (f)

/-- Given a function with an invertible strict derivative at `a`, returns a `local_homeomorph`
with `to_fun = f` and `a ∈ source`. This is a part of the inverse function theorem.
The other part `has_strict_fderiv_at.to_local_inverse` states that the inverse function
of this `local_homeomorph` has derivative `f'.symm`. -/
def toLocalHomeomorph (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) : LocalHomeomorph E F :=
  ApproximatesLinearOn.toLocalHomeomorph f (Classical.choose hf.approximates_deriv_on_open_nhds)
    (Classical.choose_spec hf.approximates_deriv_on_open_nhds).snd
    (f'.subsingleton_or_nnnorm_symm_pos.imp id fun hf' =>
      NNReal.half_lt_self <| ne_of_gt <| inv_pos.2 hf')
    (Classical.choose_spec hf.approximates_deriv_on_open_nhds).fst.2
#align has_strict_fderiv_at.to_local_homeomorph HasStrictFderivAt.toLocalHomeomorph

variable {f}

@[simp]
theorem toLocalHomeomorph_coe (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    (hf.toLocalHomeomorph f : E → F) = f :=
  rfl
#align has_strict_fderiv_at.to_local_homeomorph_coe HasStrictFderivAt.toLocalHomeomorph_coe

theorem mem_toLocalHomeomorph_source (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    a ∈ (hf.toLocalHomeomorph f).source :=
  (Classical.choose_spec hf.approximates_deriv_on_open_nhds).fst.1
#align has_strict_fderiv_at.mem_to_local_homeomorph_source HasStrictFderivAt.mem_toLocalHomeomorph_source

theorem image_mem_toLocalHomeomorph_target (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    f a ∈ (hf.toLocalHomeomorph f).target :=
  (hf.toLocalHomeomorph f).map_source hf.mem_toLocalHomeomorph_source
#align has_strict_fderiv_at.image_mem_to_local_homeomorph_target HasStrictFderivAt.image_mem_toLocalHomeomorph_target

theorem map_nhds_eq_of_equiv (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    map f (𝓝 a) = 𝓝 (f a) :=
  (hf.toLocalHomeomorph f).map_nhds_eq hf.mem_toLocalHomeomorph_source
#align has_strict_fderiv_at.map_nhds_eq_of_equiv HasStrictFderivAt.map_nhds_eq_of_equiv

variable (f f' a)

/-- Given a function `f` with an invertible derivative, returns a function that is locally inverse
to `f`. -/
def localInverse (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) : F → E :=
  (hf.toLocalHomeomorph f).symm
#align has_strict_fderiv_at.local_inverse HasStrictFderivAt.localInverse

variable {f f' a}

theorem localInverse_def (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    hf.localInverse f _ _ = (hf.toLocalHomeomorph f).symm :=
  rfl
#align has_strict_fderiv_at.local_inverse_def HasStrictFderivAt.localInverse_def

theorem eventually_left_inverse (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    ∀ᶠ x in 𝓝 a, hf.localInverse f f' a (f x) = x :=
  (hf.toLocalHomeomorph f).eventually_left_inverse hf.mem_toLocalHomeomorph_source
#align has_strict_fderiv_at.eventually_left_inverse HasStrictFderivAt.eventually_left_inverse

@[simp]
theorem localInverse_apply_image (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    hf.localInverse f f' a (f a) = a :=
  hf.eventually_left_inverse.self_of_nhds
#align has_strict_fderiv_at.local_inverse_apply_image HasStrictFderivAt.localInverse_apply_image

theorem eventually_right_inverse (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    ∀ᶠ y in 𝓝 (f a), f (hf.localInverse f f' a y) = y :=
  (hf.toLocalHomeomorph f).eventually_right_inverse' hf.mem_toLocalHomeomorph_source
#align has_strict_fderiv_at.eventually_right_inverse HasStrictFderivAt.eventually_right_inverse

theorem localInverse_continuousAt (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    ContinuousAt (hf.localInverse f f' a) (f a) :=
  (hf.toLocalHomeomorph f).continuousAt_symm hf.image_mem_toLocalHomeomorph_target
#align has_strict_fderiv_at.local_inverse_continuous_at HasStrictFderivAt.localInverse_continuousAt

theorem localInverse_tendsto (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    Tendsto (hf.localInverse f f' a) (𝓝 <| f a) (𝓝 a) :=
  (hf.toLocalHomeomorph f).tendsto_symm hf.mem_toLocalHomeomorph_source
#align has_strict_fderiv_at.local_inverse_tendsto HasStrictFderivAt.localInverse_tendsto

theorem localInverse_unique (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) {g : F → E}
    (hg : ∀ᶠ x in 𝓝 a, g (f x) = x) : ∀ᶠ y in 𝓝 (f a), g y = localInverse f f' a hf y :=
  eventuallyEq_of_left_inv_of_right_inv hg hf.eventually_right_inverse <|
    (hf.toLocalHomeomorph f).tendsto_symm hf.mem_toLocalHomeomorph_source
#align has_strict_fderiv_at.local_inverse_unique HasStrictFderivAt.localInverse_unique

/-- If `f` has an invertible derivative `f'` at `a` in the sense of strict differentiability `(hf)`,
then the inverse function `hf.local_inverse f` has derivative `f'.symm` at `f a`. -/
theorem to_localInverse (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) :
    HasStrictFderivAt (hf.localInverse f f' a) (f'.symm : F →L[𝕜] E) (f a) :=
  (hf.toLocalHomeomorph f).hasStrictFderivAt_symm hf.image_mem_toLocalHomeomorph_target <| by
    simpa [← local_inverse_def] using hf
#align has_strict_fderiv_at.to_local_inverse HasStrictFderivAt.to_localInverse

/-- If `f : E → F` has an invertible derivative `f'` at `a` in the sense of strict differentiability
and `g (f x) = x` in a neighborhood of `a`, then `g` has derivative `f'.symm` at `f a`.

For a version assuming `f (g y) = y` and continuity of `g` at `f a` but not `[complete_space E]`
see `of_local_left_inverse`.  -/
theorem to_local_left_inverse (hf : HasStrictFderivAt f (f' : E →L[𝕜] F) a) {g : F → E}
    (hg : ∀ᶠ x in 𝓝 a, g (f x) = x) : HasStrictFderivAt g (f'.symm : F →L[𝕜] E) (f a) :=
  hf.to_localInverse.congr_of_eventuallyEq <| (hf.localInverse_unique hg).mono fun _ => Eq.symm
#align has_strict_fderiv_at.to_local_left_inverse HasStrictFderivAt.to_local_left_inverse

end HasStrictFderivAt

/-- If a function has an invertible strict derivative at all points, then it is an open map. -/
theorem open_map_of_strict_fderiv_equiv [CompleteSpace E] {f : E → F} {f' : E → E ≃L[𝕜] F}
    (hf : ∀ x, HasStrictFderivAt f (f' x : E →L[𝕜] F) x) : IsOpenMap f :=
  isOpenMap_iff_nhds_le.2 fun x => (hf x).map_nhds_eq_of_equiv.ge
#align open_map_of_strict_fderiv_equiv open_map_of_strict_fderiv_equiv

/-!
### Inverse function theorem, 1D case

In this case we prove a version of the inverse function theorem for maps `f : 𝕜 → 𝕜`.
We use `continuous_linear_equiv.units_equiv_aut` to translate `has_strict_deriv_at f f' a` and
`f' ≠ 0` into `has_strict_fderiv_at f (_ : 𝕜 ≃L[𝕜] 𝕜) a`.
-/

namespace HasStrictDerivAt

variable [cs : CompleteSpace 𝕜] {f : 𝕜 → 𝕜} {f' a : 𝕜} (hf : HasStrictDerivAt f f' a) (hf' : f' ≠ 0)

include cs

variable (f f' a)

/-- A function that is inverse to `f` near `a`. -/
@[reducible]
def localInverse : 𝕜 → 𝕜 :=
  (hf.hasStrictFderivAt_equiv hf').localInverse _ _ _
#align has_strict_deriv_at.local_inverse HasStrictDerivAt.localInverse

variable {f f' a}

theorem map_nhds_eq : map f (𝓝 a) = 𝓝 (f a) :=
  (hf.hasStrictFderivAt_equiv hf').map_nhds_eq_of_equiv
#align has_strict_deriv_at.map_nhds_eq HasStrictDerivAt.map_nhds_eq

theorem to_localInverse : HasStrictDerivAt (hf.localInverse f f' a hf') f'⁻¹ (f a) :=
  (hf.hasStrictFderivAt_equiv hf').to_localInverse
#align has_strict_deriv_at.to_local_inverse HasStrictDerivAt.to_localInverse

theorem to_local_left_inverse {g : 𝕜 → 𝕜} (hg : ∀ᶠ x in 𝓝 a, g (f x) = x) :
    HasStrictDerivAt g f'⁻¹ (f a) :=
  (hf.hasStrictFderivAt_equiv hf').to_local_left_inverse hg
#align has_strict_deriv_at.to_local_left_inverse HasStrictDerivAt.to_local_left_inverse

end HasStrictDerivAt

/-- If a function has a non-zero strict derivative at all points, then it is an open map. -/
theorem open_map_of_strict_deriv [CompleteSpace 𝕜] {f f' : 𝕜 → 𝕜}
    (hf : ∀ x, HasStrictDerivAt f (f' x) x) (h0 : ∀ x, f' x ≠ 0) : IsOpenMap f :=
  isOpenMap_iff_nhds_le.2 fun x => ((hf x).map_nhds_eq (h0 x)).ge
#align open_map_of_strict_deriv open_map_of_strict_deriv

/-!
### Inverse function theorem, smooth case

-/

namespace ContDiffAt

variable {𝕂 : Type _} [IsROrC 𝕂]

variable {E' : Type _} [NormedAddCommGroup E'] [NormedSpace 𝕂 E']

variable {F' : Type _} [NormedAddCommGroup F'] [NormedSpace 𝕂 F']

variable [CompleteSpace E'] (f : E' → F') {f' : E' ≃L[𝕂] F'} {a : E'}

/-- Given a `cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible
derivative at `a`, returns a `local_homeomorph` with `to_fun = f` and `a ∈ source`. -/
def toLocalHomeomorph {n : ℕ∞} (hf : ContDiffAt 𝕂 n f a) (hf' : HasFderivAt f (f' : E' →L[𝕂] F') a)
    (hn : 1 ≤ n) : LocalHomeomorph E' F' :=
  (hf.has_strict_fderiv_at' hf' hn).toLocalHomeomorph f
#align cont_diff_at.to_local_homeomorph ContDiffAt.toLocalHomeomorph

variable {f}

@[simp]
theorem toLocalHomeomorph_coe {n : ℕ∞} (hf : ContDiffAt 𝕂 n f a)
    (hf' : HasFderivAt f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) :
    (hf.toLocalHomeomorph f hf' hn : E' → F') = f :=
  rfl
#align cont_diff_at.to_local_homeomorph_coe ContDiffAt.toLocalHomeomorph_coe

theorem mem_toLocalHomeomorph_source {n : ℕ∞} (hf : ContDiffAt 𝕂 n f a)
    (hf' : HasFderivAt f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) :
    a ∈ (hf.toLocalHomeomorph f hf' hn).source :=
  (hf.has_strict_fderiv_at' hf' hn).mem_toLocalHomeomorph_source
#align cont_diff_at.mem_to_local_homeomorph_source ContDiffAt.mem_toLocalHomeomorph_source

theorem image_mem_toLocalHomeomorph_target {n : ℕ∞} (hf : ContDiffAt 𝕂 n f a)
    (hf' : HasFderivAt f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) :
    f a ∈ (hf.toLocalHomeomorph f hf' hn).target :=
  (hf.has_strict_fderiv_at' hf' hn).image_mem_toLocalHomeomorph_target
#align cont_diff_at.image_mem_to_local_homeomorph_target ContDiffAt.image_mem_toLocalHomeomorph_target

/-- Given a `cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible derivative
at `a`, returns a function that is locally inverse to `f`. -/
def localInverse {n : ℕ∞} (hf : ContDiffAt 𝕂 n f a) (hf' : HasFderivAt f (f' : E' →L[𝕂] F') a)
    (hn : 1 ≤ n) : F' → E' :=
  (hf.has_strict_fderiv_at' hf' hn).localInverse f f' a
#align cont_diff_at.local_inverse ContDiffAt.localInverse

theorem localInverse_apply_image {n : ℕ∞} (hf : ContDiffAt 𝕂 n f a)
    (hf' : HasFderivAt f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) : hf.localInverse hf' hn (f a) = a :=
  (hf.has_strict_fderiv_at' hf' hn).localInverse_apply_image
#align cont_diff_at.local_inverse_apply_image ContDiffAt.localInverse_apply_image

/-- Given a `cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible derivative
at `a`, the inverse function (produced by `cont_diff.to_local_homeomorph`) is
also `cont_diff`. -/
theorem to_localInverse {n : ℕ∞} (hf : ContDiffAt 𝕂 n f a)
    (hf' : HasFderivAt f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) :
    ContDiffAt 𝕂 n (hf.localInverse hf' hn) (f a) :=
  by
  have := hf.local_inverse_apply_image hf' hn
  apply
    (hf.to_local_homeomorph f hf' hn).contDiffAt_symm
      (image_mem_to_local_homeomorph_target hf hf' hn)
  · convert hf'
  · convert hf
#align cont_diff_at.to_local_inverse ContDiffAt.to_localInverse

end ContDiffAt


import boolring_tactic
----------------------------- Examples ------------------------------------

variables {α : Type}

lemma foo_alg (A: boolean_algebra α) (X Y Z P Q W: α):
  (X ⊔ (Y ⊔ Z)) ⊔ ((W ⊓ P ⊓ Q)ᶜ ⊔ (P ⊔ W ⊔ Q)) = ⊤ :=
begin
  timed_simplify_sets,
end

lemma foo_set (X Y Z : set α):
  X ∩ Y ∩ Z = Z ∩ Y ∩ (X ∩ set.univ) :=
  begin
    timed_simplify_sets,
  end

lemma foo_finset [fintype α][decidable_eq α](X Y Z: finset α):
  X ∩ Y ∩ Z = Z ∩ Y ∩ (X ∪ ∅) :=
  begin
    timed_simplify_sets,
  end

lemma bar_finset [fintype α][decidable_eq α](X Y Z: finset α):
  X ∩ Y ∩ Z ⊆ (X ∪ Y) ∩ Z :=
  begin
    timed_simplify_sets,

  end

lemma foo_big (X₀ X₁ X₂ X₃ X₄ X₅ X₆ X₇ X₈ X₉ : set α) :
  (X₀ ∪ X₁ ∪ (X₂ ∩ X₃) ∪ X₄ ∪ X₅ ∪ (X₆ ∩ X₇ ∩ X₈) ∪ X₉)ᶜ
    ⊆ (X₉ᶜ ∩ ((X₆ᶜ ∪ ∅) ∪ X₈ᶜ ∪ X₇ᶜᶜᶜ) ∩ X₅ᶜ ∩ (X₀ᶜ \ X₁) ∩ (X₃ᶜ ∪ X₂ᶜ) ∩ X₄ᶜ) :=
  begin
    timed_simplify_sets,
  end

lemma foo_big_prop (X₀ X₁ X₂ X₃ X₄ X₅ X₆ X₇ X₈ X₉ : Prop) :
  (X₀ ∨ X₁ ∨ (X₂ ∧ X₃) ∨ X₄ ∨ X₅ ∨ (X₆ ∧ X₇ ∧  X₈) ∨ X₉)ᶜ
    → (X₉ᶜ ∧ ((X₆ᶜ ∨ false) ∨ X₈ᶜ ∨ X₇ᶜᶜᶜ) ∧ X₅ᶜ ∧ (X₀ᶜ \ X₁)
    ∧ (X₃ᶜ ∨ X₂ᶜ) ∧ X₄ᶜ) :=
  begin
    unfold_projs,
    tauto!,
  end


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

import analysis.special_functions.pow
import ring_theory.class_group
import ring_theory.norm
import linear_algebra.free_module.pid
import linear_algebra.matrix.absolute_value
import number_theory.class_number.admissible_absolute_value

/-!
# Class numbers of global fields
In this file, we use the notion of "admissible absolute value" to prove
finiteness of the class group for number fields and function fields,
and define `class_number` as the order of this group.
## Main definitions
 - `class_group.fintype_of_admissible`: if `R` has an admissible absolute value,
   its integral closure has a finite class group
-/

open_locale big_operators
open_locale non_zero_divisors

namespace class_group

open ring

open_locale big_operators

section euclidean_domain

variables (R S K L : Type*) [euclidean_domain R] [comm_ring S] [is_domain S]
variables [field K] [field L]
variables [algebra R K] [is_fraction_ring R K]
variables [algebra K L] [finite_dimensional K L] [is_separable K L]
variables [algRL : algebra R L] [is_scalar_tower R K L]
variables [algebra R S] [algebra S L]
variables [ist : is_scalar_tower R S L] [iic : is_integral_closure S R L]

variables {R S} (abv : absolute_value R ℤ)
variables {ι : Type*} [decidable_eq ι] [fintype ι] (bS : basis ι R S)

/-- If `b` is an `R`-basis of `S` of cardinality `n`, then `norm_bound abv b` is an integer
such that for every `R`-integral element `a : S` with coordinates `≤ y`,
we have algebra.norm a ≤ norm_bound abv b * y ^ n`. (See also `norm_le` and `norm_lt`). -/
noncomputable def norm_bound : ℤ :=
let n := fintype.card ι,
    i : ι := nonempty.some bS.index_nonempty,
    m : ℤ := finset.max' (finset.univ.image (λ (ijk : ι × ι × ι),
        abv (algebra.left_mul_matrix bS (bS ijk.1) ijk.2.1 ijk.2.2)))
        ⟨_, finset.mem_image.mpr ⟨⟨i, i, i⟩, finset.mem_univ _, rfl⟩⟩
in nat.factorial n • (n • m) ^ n

lemma norm_bound_pos : 0 < norm_bound abv bS :=
begin
  obtain ⟨i, j, k, hijk⟩ : ∃ i j k,
    algebra.left_mul_matrix bS (bS i) j k ≠ 0,
  { by_contra h,
    push_neg at h,
    obtain ⟨i⟩ := bS.index_nonempty,
    apply bS.ne_zero i,
    apply (algebra.left_mul_matrix bS).injective_iff.mp (algebra.left_mul_matrix_injective bS),
    ext j k,
    simp [h, dmatrix.zero_apply] },
  simp only [norm_bound, algebra.smul_def, ring_hom.eq_nat_cast, int.nat_cast_eq_coe_nat],
  refine mul_pos (int.coe_nat_pos.mpr (nat.factorial_pos _)) _,
  refine pow_pos (mul_pos (int.coe_nat_pos.mpr (fintype.card_pos_iff.mpr ⟨i⟩)) _) _,
  refine lt_of_lt_of_le (abv.pos hijk) (finset.le_max' _ _ _),
  exact finset.mem_image.mpr ⟨⟨i, j, k⟩, finset.mem_univ _, rfl⟩
end

/-- If the `R`-integral element `a : S` has coordinates `≤ y` with respect to some basis `b`,
its norm is less than `norm_bound abv b * y ^ dim S`. -/
lemma norm_le (a : S) {y : ℤ} (hy : ∀ k, abv (bS.repr a k) ≤ y) :
  abv (algebra.norm R a) ≤ norm_bound abv bS * y ^ fintype.card ι :=
begin
  conv_lhs { rw ← bS.sum_repr a },
  rw [algebra.norm_apply, ← linear_map.det_to_matrix bS],
  simp only [algebra.norm_apply, alg_hom.map_sum, alg_hom.map_smul, linear_equiv.map_sum,
      linear_equiv.map_smul, algebra.to_matrix_lmul_eq, norm_bound, smul_mul_assoc, ← mul_pow],
  convert matrix.det_sum_smul_le finset.univ _ hy using 3,
  { rw [finset.card_univ, smul_mul_assoc, mul_comm] },
  { intros i j k,
    apply finset.le_max',
    exact finset.mem_image.mpr ⟨⟨i, j, k⟩, finset.mem_univ _, rfl⟩ },
end

/-- If the `R`-integral element `a : S` has coordinates `< y` with respect to some basis `b`,
its norm is strictly less than `norm_bound abv b * y ^ dim S`. -/
lemma norm_lt {T : Type*} [linear_ordered_comm_ring T]
  (a : S) {y : T} (hy : ∀ k, (abv (bS.repr a k) : T) < y) :
  (abv (algebra.norm R a) : T) < norm_bound abv bS * y ^ fintype.card ι :=
begin
  obtain ⟨i⟩ := bS.index_nonempty,
  have him : (finset.univ.image (λ k, abv (bS.repr a k))).nonempty :=
    ⟨_, finset.mem_image.mpr ⟨i, finset.mem_univ _, rfl⟩⟩,
  set y' : ℤ := finset.max' _ him with y'_def,
  have hy' : ∀ k, abv (bS.repr a k) ≤ y',
  { intro k,
    exact finset.le_max' _ _ (finset.mem_image.mpr ⟨k, finset.mem_univ _, rfl⟩) },
  have : (y' : T) < y,
  { rw [y'_def, ← finset.max'_image (show monotone (coe : ℤ → T), from λ x y h, int.cast_le.mpr h)],
    apply (finset.max'_lt_iff _ (him.image _)).mpr,
    simp only [finset.mem_image, exists_prop],
    rintros _ ⟨x, ⟨k, -, rfl⟩, rfl⟩,
    exact hy k },
  have y'_nonneg : 0 ≤ y' := le_trans (abv.nonneg _) (hy' i),
  apply (int.cast_le.mpr (norm_le abv bS a hy')).trans_lt,
  simp only [int.cast_mul, int.cast_pow],
  apply mul_lt_mul' (le_refl _),
  { exact pow_lt_pow_of_lt_left this
      (int.cast_nonneg.mpr y'_nonneg)
      (fintype.card_pos_iff.mpr ⟨i⟩) },
  { exact pow_nonneg (int.cast_nonneg.mpr y'_nonneg) _ },
  { exact int.cast_pos.mpr (norm_bound_pos abv bS) },
  { apply_instance }
end

/-- A nonzero ideal has an element of minimal norm. -/
lemma exists_min (I : (ideal S)⁰) :
  ∃ b ∈ (I : ideal S), b ≠ 0 ∧
  ∀ c ∈ (I : ideal S), abv (algebra.norm R c) < abv (algebra.norm R b) → c = (0 : S) :=
begin
  obtain ⟨_, ⟨b, b_mem, b_ne_zero, rfl⟩, min⟩ := @int.exists_least_of_bdd
    (λ a, ∃ b ∈ (I : ideal S), b ≠ (0 : S) ∧ abv (algebra.norm R b) = a) _ _,
  { refine ⟨b, b_mem, b_ne_zero, _⟩,
    intros c hc lt,
    contrapose! lt with c_ne_zero,
    exact min _ ⟨c, hc, c_ne_zero, rfl⟩ },
  { use 0,
    rintros _ ⟨b, b_mem, b_ne_zero, rfl⟩,
    apply abv.nonneg },
  { obtain ⟨b, b_mem, b_ne_zero⟩ := (I : ideal S).ne_bot_iff.mp (non_zero_divisors.coe_ne_zero I),
    exact ⟨_, ⟨b, b_mem, b_ne_zero, rfl⟩⟩ }
end

section is_admissible

variables (L) {abv} (adm : abv.is_admissible)

include adm

/-- If we have a large enough set of elements in `R^ι`, then there will be a pair
whose remainders are close together. We'll show that all sets of cardinality
at least `cardM bS adm` elements satisfy this condition.

The value of `cardM` is not at all optimal: for specific choices of `R`,
the minimum cardinality can be exponentially smaller.
-/
noncomputable def cardM : ℕ :=
adm.card (norm_bound abv bS ^ (-1 / (fintype.card ι) : ℝ)) ^ fintype.card ι

variables [infinite R]

/-- In the following results, we need a large set of distinct elements of `R`. -/
noncomputable def distinct_elems : fin (cardM bS adm).succ ↪ R :=
function.embedding.trans (fin.coe_embedding _).to_embedding (infinite.nat_embedding R)

variables [decidable_eq R]

/-- `finset_approx` is a finite set such that each fractional ideal in the integral closure
contains an element close to `finset_approx`. -/
noncomputable def finset_approx : finset R :=
((finset.univ.product finset.univ)
  .image (λ (xy : _ × _), distinct_elems bS adm xy.1 - distinct_elems bS adm xy.2))
  .erase 0

lemma finset_approx.zero_not_mem : (0 : R) ∉ finset_approx bS adm :=
finset.not_mem_erase _ _

@[simp] lemma mem_finset_approx {x : R} :
  x ∈ finset_approx bS adm ↔
  ∃ i j, i ≠ j ∧ distinct_elems bS adm i - distinct_elems bS adm j = x :=
begin
  simp only [finset_approx, finset.mem_erase, finset.mem_image],
  split,
  { rintros ⟨hx, ⟨i, j⟩, _, rfl⟩,
    refine ⟨i, j, _, rfl⟩,
    rintro rfl,
    simpa using hx },
  { rintros ⟨i, j, hij, rfl⟩,
    refine ⟨_, ⟨i, j⟩, finset.mem_product.mpr ⟨finset.mem_univ _, finset.mem_univ _⟩, rfl⟩,
    rw [ne.def, sub_eq_zero],
    exact λ h, hij ((distinct_elems bS adm).injective h) }
end

section real

open real

local attribute [-instance] real.decidable_eq

/-- We can approximate `a / b : L` with `q / r`, where `r` has finitely many options for `L`. -/
theorem exists_mem_finset_approx (a : S) {b} (hb : b ≠ (0 : R)) :
  ∃ (q : S) (r ∈ finset_approx bS adm),
    abv (algebra.norm R (r • a - b • q)) < abv (algebra.norm R (algebra_map R S b)) :=
begin
  have dim_pos := fintype.card_pos_iff.mpr bS.index_nonempty,
  set ε : ℝ := norm_bound abv bS ^ (-1 / (fintype.card ι) : ℝ) with ε_eq,
  have hε : 0 < ε := real.rpow_pos_of_pos (int.cast_pos.mpr (norm_bound_pos abv bS)) _,
  have ε_le : (norm_bound abv bS : ℝ) * (abv b • ε) ^ fintype.card ι ≤
                (abv b ^ fintype.card ι),
  { have := norm_bound_pos abv bS,
    have := abv.nonneg b,
    rw [ε_eq, algebra.smul_def, ring_hom.eq_int_cast, ← rpow_nat_cast, mul_rpow, ← rpow_mul,
        div_mul_cancel, rpow_neg_one, mul_left_comm, mul_inv_cancel, mul_one, rpow_nat_cast];
      try { norm_cast, linarith },
    { apply rpow_nonneg_of_nonneg,
      norm_cast,
      linarith } },
  let μ : fin (cardM bS adm).succ ↪ R := distinct_elems bS adm,
  set s := bS.repr a,
  have s_eq : ∀ i, s i = bS.repr a i := λ i, rfl,
  set qs := λ j i, (μ j * s i) / b,
  have q_eq : ∀ j i, qs j i = (μ j * s i) / b := λ i j, rfl,
  set rs := λ j i, (μ j * s i) % b with r_eq,
  have r_eq : ∀ j i, rs j i = (μ j * s i) % b := λ i j, rfl,
  have μ_eq : ∀ i j, μ j * s i = b * qs j i + rs j i,
  { intros i j,
    rw [q_eq, r_eq, euclidean_domain.div_add_mod], },
  have μ_mul_a_eq : ∀ j, μ j • a = b • ∑ i, qs j i • bS i + ∑ i, rs j i • bS i,
  { intro j,
    rw ← bS.sum_repr a,
    simp only [finset.smul_sum, ← finset.sum_add_distrib],
    refine finset.sum_congr rfl (λ i _, _),
    rw [← s_eq, ← mul_smul, μ_eq, add_smul, mul_smul] },

  obtain ⟨j, k, j_ne_k, hjk⟩ := adm.exists_approx hε hb (λ j i, μ j * s i),
  have hjk' : ∀ i, (abv (rs k i - rs j i) : ℝ) < abv b • ε,
  { simpa only [r_eq] using hjk },
  set q := ∑ i, (qs k i - qs j i) • bS i with q_eq,
  set r := μ k - μ j with r_eq,
  refine ⟨q, r, (mem_finset_approx bS adm).mpr _, _⟩,
  { exact ⟨k, j, j_ne_k.symm, rfl⟩ },
  have : r • a - b • q = (∑ (x : ι), (rs k x • bS x - rs j x • bS x)),
  { simp only [r_eq, sub_smul, μ_mul_a_eq, q_eq, finset.smul_sum, ← finset.sum_add_distrib,
               ← finset.sum_sub_distrib, smul_sub],
    refine finset.sum_congr rfl (λ x _, _),
    ring },
  rw [this, algebra.norm_algebra_map_of_basis bS, abv.map_pow],

  refine int.cast_lt.mp ((norm_lt abv bS _ (λ i, lt_of_le_of_lt _ (hjk' i))).trans_le _),
  { apply le_of_eq,
    congr,
    simp_rw [linear_equiv.map_sum, linear_equiv.map_sub, linear_equiv.map_smul,
             finset.sum_apply', finsupp.sub_apply, finsupp.smul_apply,
             finset.sum_sub_distrib, basis.repr_self_apply, smul_eq_mul, mul_boole,
             finset.sum_ite_eq', finset.mem_univ, if_true] },
  { exact_mod_cast ε_le },
end

include ist iic

/-- We can approximate `a / b : L` with `q / r`, where `r` has finitely many options for `L`. -/
theorem exists_mem_finset_approx' (h : algebra.is_algebraic R L) (a : S) {b : S} (hb : b ≠ 0) :
  ∃ (q : S) (r ∈ finset_approx bS adm),
  abv (algebra.norm R (r • a - q * b)) < abv (algebra.norm R b) :=
begin
  have inj : function.injective (algebra_map R L),
  { rw is_scalar_tower.algebra_map_eq R S L,
    exact (is_integral_closure.algebra_map_injective S R L).comp bS.algebra_map_injective },
  obtain ⟨a', b', hb', h⟩ := is_integral_closure.exists_smul_eq_mul h inj a hb,
  obtain ⟨q, r, hr, hqr⟩ := exists_mem_finset_approx bS adm a' hb',
  refine ⟨q, r, hr, _⟩,
  refine lt_of_mul_lt_mul_left _
    (show 0 ≤ abv (algebra.norm R (algebra_map R S b')), from abv.nonneg _),
  refine lt_of_le_of_lt (le_of_eq _) (mul_lt_mul hqr (le_refl _)
    (abv.pos ((algebra.norm_ne_zero_iff_of_basis bS).mpr hb)) (abv.nonneg _)),
  rw [← abv.map_mul, ← monoid_hom.map_mul, ← abv.map_mul, ← monoid_hom.map_mul, ← algebra.smul_def,
      smul_sub b', sub_mul, smul_comm, h, mul_comm b a', algebra.smul_mul_assoc r a' b,
      algebra.smul_mul_assoc b' q b]
end

end real

lemma prod_finset_approx_ne_zero : algebra_map R S (∏ m in finset_approx bS adm, m) ≠ 0 :=
begin
  refine mt ((ring_hom.injective_iff _).mp bS.algebra_map_injective _) _,
  simp only [finset.prod_eq_zero_iff, not_exists],
  rintros x hx rfl,
  exact finset_approx.zero_not_mem bS adm hx
end

lemma ne_bot_of_prod_finset_approx_mem
  (J : ideal S) (h : algebra_map _ _ (∏ m in finset_approx bS adm, m) ∈ J) :
  J ≠ ⊥ :=
(submodule.ne_bot_iff _).mpr ⟨_, h, prod_finset_approx_ne_zero _ _⟩

include ist iic

/-- Each class in the class group contains an ideal `J`
such that `M := Π m ∈ finset_approx` is in `J`. -/
theorem exists_mk0_eq_mk0 [is_dedekind_domain S] [is_fraction_ring S L]
  (h : algebra.is_algebraic R L) (I : (ideal S)⁰) :
  ∃ (J : (ideal S)⁰), class_group.mk0 L I = class_group.mk0 L J ∧
    algebra_map _ _ (∏ m in finset_approx bS adm, m) ∈ (J : ideal S) :=
begin
  set M := ∏ m in finset_approx bS adm, m with M_eq,
  have hM : algebra_map R S M ≠ 0 := prod_finset_approx_ne_zero bS adm,
  obtain ⟨b, b_mem, b_ne_zero, b_min⟩ := exists_min abv I,
  suffices : ideal.span {b} ∣ ideal.span {algebra_map _ _ M} * I.1,
  { obtain ⟨J, hJ⟩ := this,
    refine ⟨⟨J, _⟩, _, _⟩,
    { rw mem_non_zero_divisors_iff_ne_zero,
      rintro rfl,
      rw [ideal.zero_eq_bot, ideal.mul_bot] at hJ,
      exact hM (ideal.span_singleton_eq_bot.mp (I.2 _ hJ)) },
    { rw class_group.mk0_eq_mk0_iff,
      exact ⟨algebra_map _ _ M, b, hM, b_ne_zero, hJ⟩ },
    rw [← set_like.mem_coe, ← set.singleton_subset_iff, ← ideal.span_le, ← ideal.dvd_iff_le],
    refine (mul_dvd_mul_iff_left _).mp _,
    swap, { exact mt ideal.span_singleton_eq_bot.mp b_ne_zero },
    rw [subtype.coe_mk, ideal.dvd_iff_le, ← hJ, mul_comm],
    apply ideal.mul_mono le_rfl,
    rw [ideal.span_le, set.singleton_subset_iff],
    exact b_mem },
  rw [ideal.dvd_iff_le, ideal.mul_le],
  intros r' hr' a ha,
  rw ideal.mem_span_singleton at ⊢ hr',
  obtain ⟨q, r, r_mem, lt⟩ := exists_mem_finset_approx' L bS adm h a b_ne_zero,
  apply @dvd_of_mul_left_dvd _ _ q,
  simp only [algebra.smul_def] at lt,
  rw ← sub_eq_zero.mp (b_min _ (I.1.sub_mem (I.1.mul_mem_left _ ha) (I.1.mul_mem_left _ b_mem)) lt),
  refine mul_dvd_mul_right (dvd_trans (ring_hom.map_dvd _ _) hr') _,
  exact multiset.dvd_prod (multiset.mem_map.mpr ⟨_, r_mem, rfl⟩)
end

omit iic ist

/-- `class_group.mk_M_mem` is a specialization of `class_group.mk0` to (the finite set of)
ideals that contain `M := ∏ m in finset_approx L f abs, m`.
By showing this function is surjective, we prove that the class group is finite. -/
noncomputable def mk_M_mem [is_fraction_ring S L] [is_dedekind_domain S]
  (J : {J : ideal S // algebra_map _ _ (∏ m in finset_approx bS adm, m) ∈ J}) :
  class_group S L :=
class_group.mk0 _ ⟨J.1, mem_non_zero_divisors_iff_ne_zero.mpr
  (ne_bot_of_prod_finset_approx_mem bS adm J.1 J.2)⟩

include iic ist

lemma mk_M_mem_surjective [is_fraction_ring S L] [is_dedekind_domain S]
  (h : algebra.is_algebraic R L) :
  function.surjective (class_group.mk_M_mem L bS adm) :=
begin
  intro I',
  obtain ⟨⟨I, hI⟩, rfl⟩ := class_group.mk0_surjective I',
  obtain ⟨J, mk0_eq_mk0, J_dvd⟩ := exists_mk0_eq_mk0 L bS adm h ⟨I, hI⟩,
  exact ⟨⟨J, J_dvd⟩, mk0_eq_mk0.symm⟩
end

open_locale classical

/-- The main theorem: the class group of an integral closure `S` of `R` in an
algebraic extension `L` is finite if there is an admissible absolute value.

See also `class_group.fintype_of_admissible_of_finite` where `L` is a finite
extension of `K = Frac(R)`, supplying most of the required assumptions automatically.
-/
noncomputable def fintype_of_admissible_of_algebraic [is_fraction_ring S L] [is_dedekind_domain S]
  (h : algebra.is_algebraic R L) : fintype (class_group S L) :=
@fintype.of_surjective _ _ _
  (@fintype.of_equiv _
    {J // J ∣ ideal.span ({algebra_map R S (∏ (m : R) in finset_approx bS adm, m)} : set S)}
    (unique_factorization_monoid.fintype_subtype_dvd _
      (by { rw [ne.def, ideal.zero_eq_bot, ideal.span_singleton_eq_bot],
            exact prod_finset_approx_ne_zero bS adm }))
    ((equiv.refl _).subtype_equiv (λ I, ideal.dvd_iff_le.trans
      (by rw [equiv.refl_apply, ideal.span_le, set.singleton_subset_iff]))))
  (class_group.mk_M_mem L bS adm)
  (class_group.mk_M_mem_surjective L bS adm h)

/-- The main theorem: the class group of an integral closure `S` of `R` in a
finite extension `L` of `K = Frac(R)` is finite if there is an admissible
absolute value.

See also `class_group.fintype_of_admissible_of_algebraic` where `L` is an
algebraic extension of `R`, that includes some extra assumptions.
-/
noncomputable def fintype_of_admissible_of_finite [is_dedekind_domain R] :
  fintype (@class_group S L _ _ _
    (is_integral_closure.is_fraction_ring_of_finite_extension R K L S)) :=
begin
  letI := classical.dec_eq L,
  letI := is_integral_closure.is_fraction_ring_of_finite_extension R K L S,
  letI := is_integral_closure.is_dedekind_domain R K L S,
  choose s b hb_int using finite_dimensional.exists_is_basis_integral R K L,
  obtain ⟨n, b⟩ := submodule.basis_of_pid_of_le_span _
    (is_integral_closure.range_le_span_dual_basis S b hb_int),
  let bS := b.map ((linear_map.quot_ker_equiv_range _).symm ≪≫ₗ _),
  refine fintype_of_admissible_of_algebraic L bS adm
    (λ x, (is_fraction_ring.is_algebraic_iff R K).mpr (algebra.is_algebraic_of_finite x)),
  { rw linear_map.ker_eq_bot.mpr,
    { exact submodule.quot_equiv_of_eq_bot _ rfl },
    { exact is_integral_closure.algebra_map_injective _ R _ } },
  { refine (basis.linear_independent _).restrict_scalars _,
    simp only [algebra.smul_def, mul_one],
    apply is_fraction_ring.injective }
end

end is_admissible

end euclidean_domain

end class_group


import .SL2Z_generators
import .modular_forms

local notation `ℍ` := upper_half_space
local notation `Mat` := integral_matrices_with_determinant

lemma pos_det' {m : ℤ}  (h : m > 0) {A : Mat m} : ↑(A.a) * ↑(A.d) - ↑(A.b) * ↑(A.c) > (0 : ℝ) :=
begin
  cases A with a b c d det,
  rw ←det at h,
  rw [←int.cast_mul, ←int.cast_mul, ←int.cast_sub],
  suffices : (0 : ℝ) < ↑(a * d - b * c), exact this,
  rwa int.cast_pos
end

lemma aux_10 {m : ℤ} (h : m > 0) (A : Mat m) (z : ℍ) : (↑(A.c) * ↑z + ↑(A.d)) ≠ (0 : ℂ) :=
have H1 : (↑(A.a) : ℝ) * ↑(A.d) - ↑(A.b) * ↑(A.c) > 0,
  by rw [← int.cast_mul, ← int.cast_mul, ← int.cast_sub];
  from int.cast_pos.2 (trans_rel_left _ h A.det.symm),
have _ := preserve_ℍ.aux H1 z.2,
by simpa only [complex.of_real_int_cast]

theorem M_trans_SL2Z_M {m : ℤ} {h : m > 0} {M : SL2Z} {A : Mat m} :
M_trans h (SL2Z_M m M A) = SL2Z_H M ∘ (M_trans h A) :=
begin
  funext z, apply subtype.eq,
  change _/_=_/_,
  have H3 := aux_10 h A z,
  have H4 := aux_10 zero_lt_one M (M_trans h A z),
  unfold M_trans «Möbius_transform» at H4 ⊢,
  simp only [subtype.coe_mk, complex.of_real_int_cast] with SL2Z at H3 H4 ⊢,
  rw ← mul_div_mul_right _ H4 H3,
    conv { to_rhs,
      rw [add_mul, add_mul, mul_assoc, mul_assoc],
      rw [div_mul_cancel _ H3] },
  simp only [int.cast_add, int.cast_mul],
  congr' 1; simp only [add_mul, mul_add, mul_assoc, add_left_comm, add_assoc]
end

set_option eqn_compiler.zeta true
noncomputable def Hecke_operator {k : ℕ} (m : ℤ) (h : m > 0) (f : is_Petersson_weight_ k) :
  is_Petersson_weight_ k :=
begin
  let orbits := quotient (action_rel (SL2Z_M m)),
  letI h_orbits : fintype orbits := SL2Z_M.finiteness m (ne_of_gt h),
  refine ⟨λz:ℍ,
    (m^k : ℂ) * (finset.univ : finset orbits).sum (λo, quotient.lift_on' o _ _), _⟩,
  refine λA, 1 / (A.c * z + A.d)^k * f.1 (M_trans h A z),
  { rcases f with ⟨f, weight_f⟩,
    rintros A B ⟨M, H⟩,

    change 1 / (↑(A.c) * ↑z + ↑(A.d)) ^ k * f (M_trans h A z) = 1 / (↑(B.c) * ↑z + ↑(B.d)) ^ k * f (M_trans h B z),

    rw ← H,
    rw M_trans_SL2Z_M,
    simp [-one_div_eq_inv],
    rw (weight_f M _),
    rw ← mul_assoc,
    congr' 1,
    dsimp[M_trans, «Möbius_transform»],
    ring,
    rw pow_inv,
    rw pow_inv,
    rw ← mul_pow,
    congr' 1,
    -- Patrick claims this goal is true -- and so does Johan
    repeat {sorry} },
  { dsimp [is_Petersson_weight_],
    intros M z,
    conv { to_rhs, rw ← mul_assoc, congr, rw mul_comm },
    conv { to_rhs, rw mul_assoc, rw finset.mul_sum, },
    congr' 1,
    refine finset.sum_bij _ _ _ _ _,
    -- Define the function given by right multiplication with M
    -- The other goals should be straightforward

    -- funext o,
    -- rcases o with ⟨A⟩,
    -- dsimp [quotient.lift_on',quotient.lift_on,quot.lift_on],
    -- rcases f with ⟨f, weight_f⟩,
    -- dsimp [is_Petersson_weight_] at weight_f,
    -- simp,
    -- dsimp [SL2Z_H,M_trans,«Möbius_transform»],
    -- simp,
    sorry }
end


import generalisation_linter
import algebra.associated
import topology.metric_space.basic
import algebra.ring
import algebra.category.Group
import algebra.group_power
import algebra.algebra.basic
import analysis.convex.integral
import measure_theory.integral.set_integral
import measure_theory.measure.finite_measure_weak_convergence
import tactic.group

/-! Tests for generalisation linter, should produce test.expected.out -/
namespace lint_tests
section

  variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

  lemma is_unit.pow [monoid α] {a : α} (n : ℕ) : is_unit a → is_unit (a ^ n) :=
  λ ⟨u, hu⟩, ⟨u ^ n, by simp *⟩

  theorem is_unit_iff_dvd_one [comm_monoid α] {x : α} : is_unit x ↔ x ∣ 1 :=
  ⟨by rintro ⟨u, rfl⟩; exact ⟨_, u.mul_inv.symm⟩,
  λ ⟨y, h⟩, ⟨⟨x, y, h.symm, by rw [h, mul_comm]⟩, rfl⟩⟩

end
section
theorem one_lt_bit1 {α : Type*} [linear_ordered_semiring α] {a : α} [nontrivial α] :
(1 : α) < bit1 a ↔ 0 < a :=
by rw [bit1, lt_add_iff_pos_left, bit0, ← two_mul, zero_lt_mul_left (zero_lt_two : 0 < (2:α))]
-- set_option pp.all true
-- #print  one_lt_bit1

end

section

  lemma atest (α : Type*) [comm_monoid α] : (1 : α) * 1 = 1 ∧ ∀ a b : α, a * b = b * a := ⟨mul_one _, mul_comm⟩
  lemma btest (α : Type*) [ordered_ring α] (a b : α) : (0 : α) ≤ 0 ∧ a * b + b = a * b + b := ⟨eq.le rfl, rfl⟩
  lemma btest' (α : Type*) [has_add α] [has_mul α] [has_zero α] [preorder α] (a b : α) : (0 : α) ≤ 0 ∧ a * b + b = a * b + b := ⟨eq.le rfl, rfl⟩

end
section

  universe u
  variables (α : Type u) [comm_ring α] [is_domain α]

  open char_p nat
  theorem char_ne_one (p : ℕ) [hc : char_p α p] : p ≠ 1 :=
  assume hp : p = 1,
  have (1 : α) = 0, by simpa using (cast_eq_zero_iff α p 1).mpr (hp ▸ dvd_refl p),
  absurd this one_ne_zero

  theorem char_is_prime_of_two_le (p : ℕ) [hc : char_p α p] (hp : 2 ≤ p) : nat.prime p :=
  suffices ∀d ∣ p, d = 1 ∨ d = p, from nat.prime_def_lt''.mpr ⟨hp, this⟩,
  assume (d : ℕ) (hdvd : ∃ e, p = d * e),
  let ⟨e, hmul⟩ := hdvd in
  have (p : α) = 0, from (cast_eq_zero_iff α p p).mpr (dvd_refl p),
  have (d : α) * e = 0, from (@cast_mul α _ d e) ▸ (hmul ▸ this),
  or.elim (eq_zero_or_eq_zero_of_mul_eq_zero this)
    (assume hd : (d : α) = 0,
    have p ∣ d, from (cast_eq_zero_iff α p d).mp hd,
    show d = 1 ∨ d = p, from or.inr (dvd_antisymm ⟨e, hmul⟩ this))
    (assume he : (e : α) = 0,
    have p ∣ e, from (cast_eq_zero_iff α p e).mp he,
    have e ∣ p, from dvd_of_mul_left_eq d (eq.symm hmul),
    have e = p, from dvd_antisymm ‹e ∣ p› ‹p ∣ e›,
    have h₀ : p > 0, from gt_of_ge_of_gt hp (nat.zero_lt_succ 1),
    have d * p = 1 * p, by rw ‹e = p› at hmul; rw [one_mul]; exact eq.symm hmul,
    show d = 1 ∨ d = p, from or.inl (eq_of_mul_eq_mul_right h₀ this))

end
section

open measure_theory set filter
open_locale topological_space big_operators

variables {α E : Type*} [measurable_space α] {μ : measure α}
  [normed_group E] [normed_space ℝ E] [complete_space E]
  [topological_space.second_countable_topology E] [measurable_space E] [borel_space E]

private lemma convex.smul_integral_mem_of_measurable
  [is_finite_measure μ] {s : set E} (hs : convex ℝ s) (hsc : is_closed s)
  (hμ : μ ≠ 0) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hfm : measurable f) :
  (μ univ).to_real⁻¹ • ∫ x, f x ∂μ ∈ s :=
begin
  unfreezingI { rcases eq_empty_or_nonempty s with rfl|⟨y₀, h₀⟩ },
  { refine (hμ _).elim, simpa using hfs },
  rw ← hsc.closure_eq at hfs,
  have hc : integrable (λ _, y₀) μ := integrable_const _,
  set F : ℕ → simple_func α E := simple_func.approx_on f hfm s y₀ h₀,
  have : tendsto (λ n, (F n).integral μ) at_top (𝓝 $ ∫ x, f x ∂μ),
  { simp only [simple_func.integral_eq_integral _
      (simple_func.integrable_approx_on hfm hfi h₀ hc _)],
    exact tendsto_integral_of_L1 _ hfi
      (eventually_of_forall $ simple_func.integrable_approx_on hfm hfi h₀ hc)
      (simple_func.tendsto_approx_on_L1_nnnorm hfm h₀ hfs (hfi.sub hc).2) },
  refine hsc.mem_of_tendsto (tendsto_const_nhds.smul this) (eventually_of_forall $ λ n, _),
  have : ∑ y in (F n).range, (μ ((F n) ⁻¹' {y})).to_real = (μ univ).to_real,
    by rw [← (F n).sum_range_measure_preimage_singleton, @ennreal.to_real_sum _ _
      (λ y, μ ((F n) ⁻¹' {y})) (λ _ _, (measure_ne_top _ _))],
  rw [← this, simple_func.integral],
  refine hs.center_mass_mem (λ _ _, ennreal.to_real_nonneg) _ _,
  { rw this,
    exact ennreal.to_real_pos (mt measure.measure_univ_eq_zero.mp hμ) (measure_ne_top _ _) },
  { simp only [simple_func.mem_range],
    rintros _ ⟨x, rfl⟩,
    exact simple_func.approx_on_mem hfm h₀ n x }
end

/-- If `μ` is a non-zero finite measure on `α`, `s` is a convex closed set in `E`, and `f` is an
integrable function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `s`:
`(μ univ).to_real⁻¹ • ∫ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version
of this lemma. -/
lemma convex.smul_integral_mem
  [is_finite_measure μ] {s : set E} (hs : convex ℝ s) (hsc : is_closed s)
  (hμ : μ ≠ 0) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) :
  (μ univ).to_real⁻¹ • ∫ x, f x ∂μ ∈ s :=
begin
  have : ∀ᵐ (x : α) ∂μ, hfi.ae_measurable.mk f x ∈ s,
  { filter_upwards [hfs, hfi.ae_measurable.ae_eq_mk],
    assume a ha h,
    rwa ← h },
  convert convex.smul_integral_mem_of_measurable hs hsc hμ this
    (hfi.congr hfi.ae_measurable.ae_eq_mk) (hfi.ae_measurable.measurable_mk) using 2,
  apply integral_congr_ae,
  exact hfi.ae_measurable.ae_eq_mk
end

end

section

  variables {α : Type*} [linear_ordered_ring α] [archimedean α]

  lemma pow_unbounded_of_one_lt (x : α) {y : α} (hy1 : 1 < y) :
    ∃ n : ℕ, x < y ^ n :=
  sub_add_cancel y 1 ▸ add_one_pow_unbounded_of_pos _ (sub_pos.2 hy1)

  /-- Every x greater than or equal to 1 is between two successive
  natural-number powers of every y greater than one. -/
  lemma exists_nat_pow_near {x : α} {y : α} (hx : 1 ≤ x) (hy : 1 < y) :
    ∃ n : ℕ, y ^ n ≤ x ∧ x < y ^ (n + 1) :=
  have h : ∃ n : ℕ, x < y ^ n, from pow_unbounded_of_one_lt _ hy,
  by classical; exact let n := nat.find h in
    have hn  : x < y ^ n, from nat.find_spec h,
    have hnp : 0 < n,     from pos_iff_ne_zero.2 (λ hn0,
      by rw [hn0, pow_zero] at hn; exact (not_le_of_gt hn hx)),
    have hnsp : nat.pred n + 1 = n,     from nat.succ_pred_eq_of_pos hnp,
    have hltn : nat.pred n < n,         from nat.pred_lt (ne_of_gt hnp),
    ⟨nat.pred n, le_of_not_lt (nat.find_min h hltn), by rwa hnsp⟩

  theorem exists_int_gt (x : α) : ∃ n : ℤ, x < n :=
  let ⟨n, h⟩ := exists_nat_gt x in ⟨n, by rwa int.cast_coe_nat⟩
  --- only needs semiring and has neg doesn't matter what negative ints do.

end

section
  variables {α : Type*} [linear_ordered_ring α] {a b c : α}

  @[simp] lemma mul_le_mul_right_of_neg {a b c : α} (h : c < 0) : a * c ≤ b * c ↔ b ≤ a :=
  ⟨le_imp_le_of_lt_imp_lt $ λ h', mul_lt_mul_of_neg_right h' h,
    λ h', mul_le_mul_of_nonpos_right h' h.le⟩

end

section

  lemma good (G : Type*) [division_monoid G] (n : ℤ) (g : G) (h : g^(-n) = 1) : g^n = 1 :=
  begin
    rw [zpow_neg, inv_eq_one] at h,
    exact h,
  end

  lemma good2 (G : Type*) [add_monoid G] (n : ℕ) (g : G) (h : n •  g = 0) : (2*n)•  g = 0 :=
  by rw [mul_nsmul, h, nsmul_zero]

--   -- monoid?
  lemma bad (G : Type*) [group G] (n : ℕ) (g : G) (h : g^n = 1) : g^(2*n) = 1 :=
  by rw [pow_mul', h, one_pow]

  -- add_monoid
  lemma bad2diamond (G : Type*) [ring G] (n : ℕ) (g : G) (h : n •  g = 0) : (2*n)•  g = 0 :=
  by rw [mul_nsmul, h, nsmul_zero]

  -- statement generalises but proof does not!! this one is hard then, beyond current scope to complete
  -- add_monoid linter only finds semiring
  lemma bad3pfbad (G : Type*) [ring G] (n : ℕ) (g : G) (h : n •  g = 0) : (2*n)•  g = 0 :=
  by simp only [nsmul_eq_mul] at h; simp only [nat.cast_bit0, nsmul_eq_mul, nat.cast_one, nat.cast_mul]; assoc_rewrite h; exact mul_zero 2

  lemma bad3 (G : Type*) [ring G] (n : ℕ) (g : G) (h : n •  g = 0) : (2*n)•  g = 0 :=
  by {rw [mul_nsmul, h], exact nsmul_zero _}

  -- add_monoid
  lemma bad4 (G : Type*) [add_comm_group G] (n : ℕ) (g : G) (h : n •  g = 0) : (2*n)•  g = 0 :=
  by rw [mul_nsmul, h, nsmul_zero]

  -- add_monoid
  lemma bad5 (G : Type*) [add_group G] (n : ℕ) (g : G) (h : n •  g = 0) : (2*n)•  g = 0 :=
  by rw [mul_nsmul, h, nsmul_zero]

  -- add_comm_semigroup
  lemma bad6 (G : Type*) [add_comm_group G] (g h : G) : g + h = h + g := add_comm _ _

  -- add_comm_semigroup
  lemma bad8 (G H : Type*) [add_comm_group G] (g h : G) : g + h = h + g := add_comm _ _

  -- add_comm_semigroup
  lemma bad7pibinder (G : Type*) [add_comm_group G] (g h : G) : g + h = h + g ∧ ∀ g2, g2 + g = g + g2 :=
  ⟨add_comm _ _,assume g2, add_comm _ _ ⟩

  -- this example this is not an instance or even a tc
  lemma bad10 (G H : Type*) [has_mul G] [has_mul H] [fintype G] [fintype H] (h : G ≃* H) :
  fintype.card G = fintype.card H := fintype.card_congr h.to_equiv

  -- multiple tings
  -- monoid H, fintypes not needed
  lemma bad9 (G H : Type*) [monoid G] [group H] [fintype G] [fintype H] : (1^2 : G) = 1 ∧ (1^2 : H) = 1 :=
  ⟨one_pow 2, one_pow 2⟩

  -- group
  lemma bad11 (G : Type*) [group G] (n : ℤ) (g : G) (h : g^(-n) = 1) : g^n = 1 :=
  begin
    rw [zpow_neg, inv_eq_one] at h,
    exact h,
  end

  -- bundled examples do nothing
  lemma bun (G : Group) (g : G) : g^2*g^2 = g^4 :=
  begin
    group,
  end

  lemma bad_now (G : Type*) [division_monoid G] (n : ℤ) (g : G) (h : g^(-n) = 1) : g^n = 1 :=
  begin
    rw [zpow_neg, inv_eq_one] at h,
    exact h,
  end

end

section
  def eval {M N : Type*} [monoid M] [comm_monoid N] : M →* (M →* N) →* N := (monoid_hom.id (M →* N)).flip
end

section

lemma one_lt_fpow {K} [linear_ordered_field K] {p : K} (hp : 1 < p) :
  ∀ z : ℤ, 0 < z → 1 < p ^ z
| (n : ℕ) h := (zpow_coe_nat p n).symm.subst (one_lt_pow hp $ int.coe_nat_ne_zero.mp h.ne')
| -[1+ n] h := ((int.neg_succ_not_pos _).mp h).elim
end

section

  open equiv.set equiv sum nat function set subtype

  @[simp] lemma sum_diff_subset_apply_inr
    {α} {s t : set α} (h : s ⊆ t) [decidable_pred (∈ s)] (x : t \ s) :
    equiv.set.sum_diff_subset h (sum.inr x) = inclusion (diff_subset t s) x := rfl

  lemma supr_apply {α : Type*} {β : α → Type*} {ι : Sort*} [Π i, has_Sup (β i)] {f : ι → Πa, β a}
    {a : α} :
    (⨆i, f i) a = (⨆i, f i a) :=
  @infi_apply α (λ i, order_dual (β i)) _ _ f a

end

section

  variables {α β γ :Type} {ι : Sort*} {s : set α}
  --none
  theorem exists_nat_ge [linear_ordered_semiring α] [archimedean α] (x : α) :
    ∃ n : ℕ, x ≤ n :=
  (exists_nat_gt x).imp $ λ n, le_of_lt

  theorem finset_le {r : α → α → Prop} [is_trans α r]
    {ι} [hι : nonempty ι] {f : ι → α} (D : directed r f) (s : finset ι) :
    ∃ z, ∀ i ∈ s, r (f i) (f z) :=
  show ∃ z, ∀ i ∈ s.1, r (f i) (f z), from
  multiset.induction_on s.1 (let ⟨z⟩ := hι in ⟨z, λ _, false.elim⟩) $
  λ i s ⟨j, H⟩, let ⟨k, h₁, h₂⟩ := D i j in
  ⟨k, λ a h, or.cases_on (multiset.mem_cons.1 h)
    (λ h, h.symm ▸ h₁)
    (λ h, trans (H _ h) h₂)⟩
end

section
  variables {α β :Type}
  open set
  lemma finite.bdd_below_bUnion [semilattice_inf α] [nonempty α] {I : set β} {S : β → set α} (H : set.finite I) :
  bdd_below (⋃ i ∈ I, S i) ↔ ∀ i ∈ I, bdd_below (S i) :=
  @finite.bdd_above_bUnion αᵒᵈ _ _ _ _ _ H
end

section

  open filter set
  variables {α β :Type}
  variables  {ι' : Type}
  lemma unbounded_of_tendsto_at_top [nonempty α] [semilattice_sup α] [preorder β] [no_max_order β]
    {f : α → β} (h : tendsto f at_top at_top) :
    ¬ bdd_above (range f) :=
  begin
    rintros ⟨M, hM⟩,
    cases mem_at_top_sets.mp (h $ Ioi_mem_at_top M) with a ha,
    apply lt_irrefl M,
    calc
    M < f a : ha a le_rfl
    ... ≤ M : hM (set.mem_range_self a)
  end

end

section
  -- it looks like we only need has_pow here as has_pow is all that appears in the proof
  -- however to_monoid and to_inv also appear in the statement, so should not show up
  -- theorem gpow_neg_succ_of_nat {G : Type } [group G] (a : G) (n : ℕ) : a ^ -[1+n] = (a ^ n.succ)⁻¹ := rfl
  -- set_option pp.all true
  -- #print gpow_neg_succ_of_nat
end

section
lemma char_p_iff_char_p {K L : Type*} [field K] [field L] (f : K →+* L) (p : ℕ) :
  char_p K p ↔ char_p L p :=
by simp only [char_p_iff, ← f.injective.eq_iff, map_nat_cast f, f.map_zero]

section
  open nat subtype multiset
  variables {α β :Type}

  lemma piecewise_piecewise_of_subset_left {δ : α → Sort*} (s : finset α) (g f : Π (i : α), δ i) [Π (j : α), decidable (j ∈ s)] {s t : finset α} [Π i, decidable (i ∈ s)]
    [Π i, decidable (i ∈ t)] (h : s ⊆ t) (f₁ f₂ g : Π a, δ a) :
    s.piecewise (t.piecewise f₁ f₂) g = s.piecewise f₁ g :=
  s.piecewise_congr (λ i hi, finset.piecewise_eq_of_mem _ _ _ (h hi)) (λ _ _, rfl)

end

section
  variables {α β :Type}

  lemma sub_le_of_abs_sub_le_left {c b a : α} [linear_ordered_ring α] (h : abs (a - b) ≤ c) : b - c ≤ a :=
  if hz : 0 ≤ a - b then
    (calc
        a ≥ b     : le_of_sub_nonneg hz
      ... ≥ b - c : sub_le_self _ $ (abs_nonneg _).trans h)
  else
    have habs : b - a ≤ c, by rwa [abs_of_neg (lt_of_not_ge hz), neg_sub] at h,
    have habs' : b ≤ c + a, from sub_le_iff_le_add.mp habs,
    sub_le.mp habs

end

section
  variables {α β :Type}
  lemma inf_ind [linear_order α] (a b : α) {p : α → Prop} (ha : p a) (hb : p b) : p (a ⊓ b) :=
  @sup_ind αᵒᵈ _ _ _ _ ha hb
end

section
  variables {α β :Type}

  open filter
  open_locale filter
  lemma map_at_bot_eq [nonempty α] [semilattice_inf α] {f : α → β} :
    at_bot.map f = (⨅a, 𝓟 $ f '' {a' | a' ≤ a}) :=
  @map_at_top_eq (order_dual α) _ _ _ _

end

section
  variables {α β : Type}
  open_locale big_operators
  lemma abs_sum_le_sum_abs [linear_ordered_field α] {f : β → α} {s : finset β} :
    abs (∑ x in s, f x) ≤ ∑ x in s, abs (f x) :=
  finset.le_sum_of_subadditive _ abs_zero abs_add s f
end

section
  universes u v w

  lemma mem_orbit_self
  {α : Type u} {β : Type v} [monoid α] [mul_action α β]
  (b : β) : b ∈ mul_action.orbit α b :=
  ⟨1, mul_action.one_smul _⟩
end

section
  variable {R : Type}
  variables [euclidean_domain R]
  variable [decidable_eq R]
  open euclidean_domain

  /-- `gcd a b` is a (non-unique) element such that `gcd a b ∣ a` `gcd a b ∣ b`, and for
    any element `c` such that `c ∣ a` and `c ∣ b`, then `c ∣ gcd a b` -/
  def gcd : R → R → R
  | a := λ b, if a0 : a = 0 then b else
    have h:_ := mod_lt b a0,
    gcd (b%a) a
  using_well_founded {dec_tac := tactic.assumption,
    rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]}

end

section
  universes u v w
  open algebra
  variables {R : Type u} {S : Type v} {A : Type w} {B : Type*}

/-- Let `R` be a commutative semiring, let `A` be a semiring with a `module R` structure.
If `(r • 1) * x = x * (r • 1) = r • x` for all `r : R` and `x : A`, then `A` is an `algebra`
over `R`. -/
def of_module' [comm_semiring R] [semiring A] [module R A]
  (h₁ : ∀ (r : R) (x : A), (r • 1) * x = r • x)
  (h₂ : ∀ (r : R) (x : A), x * (r • 1) = r • x) : algebra R A :=
{ to_fun := λ r, r • 1,
  map_one' := one_smul _ _,
  map_mul' := λ r₁ r₂, by rw [h₁, mul_smul],
  map_zero' := zero_smul _ _,
  map_add' := λ r₁ r₂, add_smul r₁ r₂ 1,
  commutes' := λ r x, by simp only [h₁, h₂],
  smul_def' := λ r x, by simp only [h₁] }

/-- Let `R` be a commutative semiring, let `A` be a semiring with a `module R` structure.
If `(r • x) * y = x * (r • y) = r • (x * y)` for all `r : R` and `x y : A`, then `A`
is an `algebra` over `R`. -/
def of_module [comm_semiring R] [semiring A] [module R A]
  (h₁ : ∀ (r : R) (x y : A), (r • x) * y = r • (x * y))
  (h₂ : ∀ (r : R) (x y : A), x * (r • y) = r • (x * y)) : algebra R A :=
of_module' (λ r x, by rw [h₁, one_mul]) (λ r x, by rw [h₂, mul_one])

end

section
  /- _inst_2: decidable_eq ↝ -/

  open_locale big_operators
  open finset
  variables {α β γ : Type}
  variables [comm_monoid β]
  @[simp, to_additive]
  lemma prod_sum_elim [decidable_eq (α ⊕ γ)]
    (s : finset α) (t : finset γ) (f : α → β) (g : γ → β) :
    ∏ x in s.image sum.inl ∪ t.image sum.inr, sum.elim f g x = (∏ x in s, f x) * (∏ x in t, g x) :=
  begin
    rw [prod_union, prod_image, prod_image],
    { simp only [sum.elim_inl, sum.elim_inr] },
    { exact λ _ _ _ _, sum.inr.inj },
    { exact λ _ _ _ _, sum.inl.inj },
    { rintros i hi,
      erw [finset.mem_inter, finset.mem_image, finset.mem_image] at hi,
      rcases hi with ⟨⟨i, hi, rfl⟩, ⟨j, hj, H⟩⟩,
      cases H }
  end
end
section

  variables {α β : Type} {s s₁ s₂ : finset α} {a : α} {b : β} {f g : α → β} [semiring β]
  open_locale big_operators
  open function

  -- odd one the linter wants to assume add_comm_monoid has_mul and is_add_monoid_hom mul
  -- this is weaker than semiring indeed as no mul identity needed
  -- Update: mathlib now has non-unital non-assoc semi so does that
lemma sum_mul : (∑ x in s, f x) * b = ∑ x in s, f x * b :=
add_monoid_hom.map_sum (add_monoid_hom.mul_right b) _ s
--   lemma sum_mul : (∑ x in s, f x) * b = ∑ x in s, f x * b :=
-- add_monoid_hom.map_sum (add_monoid_hom.mul_right b) _ s
  -- (s.sum_hom (λ x, x * b)).symm
  open tactic
  set_option trace.generalising true
  set_option pp.all true
run_cmd do e ← get_env, cd ← class_dag e, l← e.get `lint_tests.sum_mul, trace $ find_gens' l cd cd.topological_sort cd.reachable_table e l.type l.value 0 ""
end

section
  universes u v
  variables {α : Type u} {β : Type v} [topological_space α]
  lemma is_closed_singleton [t2_space α] {x : α} : is_closed ({x} : set α) :=
  t1_space.t1 x

end

section

class foo (X : Type) :=
(f : X → X)
class bar (X : Type) extends foo X :=
(h : f ∘ f = f)
end

section

lemma aa (X : Type) [bar X] : (foo.f : X → X) = foo.f := rfl

lemma mn_tors_of_n_tors {X : Type*} [semiring X] (m n : ℕ) (x : X) (h : n •  x = 0) :
  (m * n) •  x = 0 := by rw [mul_nsmul, h, nsmul_zero]
end
end

-- set_option profiler true

#lint only generalisation_linter
end lint_tests


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

Enumerate elements of a set with a select function.
-/
import data.set.lattice
import tactic.wlog
noncomputable theory

open function set

namespace set

section enumerate
parameters {α : Type*} (sel : set α → option α)

def enumerate : set α → ℕ → option α
| s 0       := sel s
| s (n + 1) := do a ← sel s, enumerate (s \ {a}) n

lemma enumerate_eq_none_of_sel {s : set α} (h : sel s = none) : ∀{n}, enumerate s n = none
| 0       := by simp [h, enumerate]; refl
| (n + 1) := by simp [h, enumerate]; refl

lemma enumerate_eq_none : ∀{s n₁ n₂}, enumerate s n₁ = none → n₁ ≤ n₂ → enumerate s n₂ = none
| s 0       m := assume : sel s = none, by simp [enumerate_eq_none_of_sel, this]
| s (n + 1) m := assume h hm,
  begin
    cases hs : sel s,
    { by simp [enumerate_eq_none_of_sel, hs] },
    { cases m,
      case nat.zero {
        have : n + 1 = 0, from nat.eq_zero_of_le_zero hm,
        contradiction },
      case nat.succ : m' {
        simp [hs, enumerate] at h ⊢,
        have hm : n ≤ m', from nat.le_of_succ_le_succ hm,
        exact enumerate_eq_none h hm } }
  end

lemma enumerate_mem (h_sel : ∀s a, sel s = some a → a ∈ s) :
  ∀{s n a}, enumerate s n = some a → a ∈ s
| s 0 a     := h_sel s a
| s (n+1) a :=
  begin
    cases h : sel s,
    case none { simp [enumerate_eq_none_of_sel, h] },
    case some : a' {
      simp [enumerate, h],
      exact assume h' : enumerate _ (s \ {a'}) n = some a,
        have a ∈ s \ {a'}, from enumerate_mem h',
        this.left }
  end

lemma enumerate_inj {n₁ n₂ : ℕ} {a : α} {s : set α} (h_sel : ∀s a, sel s = some a → a ∈ s)
  (h₁ : enumerate s n₁ = some a) (h₂ : enumerate s n₂ = some a) : n₁ = n₂ :=
begin
  wlog hn : n₁ ≤ n₂,
  { rcases nat.le.dest hn with ⟨m, rfl⟩, clear hn,
    induction n₁ generalizing s,
    case nat.zero {
      cases m,
      case nat.zero { refl },
      case nat.succ : m {
        have : enumerate sel (s \ {a}) m = some a, { simp [enumerate, *] at * },
        have : a ∈ s \ {a}, from enumerate_mem _ h_sel this,
        by simpa } },
    case nat.succ { cases h : sel s; simp [enumerate, nat.add_succ, add_comm, *] at *; tauto } }
end

end enumerate

end set