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

! This file was ported from Lean 3 source module algebra.continued_fractions.computation.approximations
! leanprover-community/mathlib commit a7e36e48519ab281320c4d192da6a7b348ce40ad
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.ContinuedFractions.Computation.CorrectnessTerminating
import Mathbin.Data.Nat.Fib
import Mathbin.Tactic.SolveByElim

/-!
# Approximations for Continued Fraction Computations (`generalized_continued_fraction.of`)

## Summary

This file contains useful approximations for the values involved in the continued fractions
computation `generalized_continued_fraction.of`. In particular, we derive the so-called
*determinant formula* for `generalized_continued_fraction.of`:
`Aₙ * Bₙ₊₁ - Bₙ * Aₙ₊₁ = (-1)^(n + 1)`.

Moreover, we derive some upper bounds for the error term when computing a continued fraction up a
given position, i.e. bounds for the term
`|v - (generalized_continued_fraction.of v).convergents n|`. The derived bounds will show us that
the error term indeed gets smaller. As a corollary, we will be able to show that
`(generalized_continued_fraction.of v).convergents` converges to `v` in
`algebra.continued_fractions.computation.approximation_corollaries`.

## Main Theorems

- `generalized_continued_fraction.of_part_num_eq_one`: shows that all partial numerators `aᵢ` are
  equal to one.
- `generalized_continued_fraction.exists_int_eq_of_part_denom`: shows that all partial denominators
  `bᵢ` correspond to an integer.
- `generalized_continued_fraction.one_le_of_nth_part_denom`: shows that `1 ≤ bᵢ`.
- `generalized_continued_fraction.succ_nth_fib_le_of_nth_denom`: shows that the `n`th denominator
  `Bₙ` is greater than or equal to the `n + 1`th fibonacci number `nat.fib (n + 1)`.
- `generalized_continued_fraction.le_of_succ_nth_denom`: shows that `bₙ * Bₙ ≤ Bₙ₊₁`, where `bₙ` is
  the `n`th partial denominator of the continued fraction.
- `generalized_continued_fraction.abs_sub_convergents_le`: shows that
  `|v - Aₙ / Bₙ| ≤ 1 / (Bₙ * Bₙ₊₁)`, where `Aₙ` is the nth partial numerator.

## References

- [*Hardy, GH and Wright, EM and Heath-Brown, Roger and Silverman, Joseph*][hardy2008introduction]
- https://en.wikipedia.org/wiki/Generalized_continued_fraction#The_determinant_formula

-/

namespace GeneralizedContinuedFraction

open GeneralizedContinuedFraction (of)

open Int

variable {K : Type _} {v : K} {n : ℕ} [LinearOrderedField K] [FloorRing K]

namespace IntFractPair

/-!
We begin with some lemmas about the stream of `int_fract_pair`s, which presumably are not
of great interest for the end user.
-/

/-- Shows that the fractional parts of the stream are in `[0,1)`. -/
theorem nth_stream_fr_nonneg_lt_one {ifp_n : IntFractPair K}
    (nth_stream_eq : IntFractPair.stream v n = some ifp_n) : 0 ≤ ifp_n.fr ∧ ifp_n.fr < 1 :=
  by
  cases n
  case zero =>
    have : int_fract_pair.of v = ifp_n := by injection nth_stream_eq
    rw [← this, int_fract_pair.of]
    exact ⟨fract_nonneg _, fract_lt_one _⟩
  case
    succ =>
    rcases succ_nth_stream_eq_some_iff.elim_left nth_stream_eq with ⟨_, _, _, ifp_of_eq_ifp_n⟩
    rw [← ifp_of_eq_ifp_n, int_fract_pair.of]
    exact ⟨fract_nonneg _, fract_lt_one _⟩
#align generalized_continued_fraction.int_fract_pair.nth_stream_fr_nonneg_lt_one GeneralizedContinuedFraction.IntFractPair.nth_stream_fr_nonneg_lt_one

/-- Shows that the fractional parts of the stream are nonnegative. -/
theorem nth_stream_fr_nonneg {ifp_n : IntFractPair K}
    (nth_stream_eq : IntFractPair.stream v n = some ifp_n) : 0 ≤ ifp_n.fr :=
  (nth_stream_fr_nonneg_lt_one nth_stream_eq).left
#align generalized_continued_fraction.int_fract_pair.nth_stream_fr_nonneg GeneralizedContinuedFraction.IntFractPair.nth_stream_fr_nonneg

/-- Shows that the fractional parts of the stream are smaller than one. -/
theorem nth_stream_fr_lt_one {ifp_n : IntFractPair K}
    (nth_stream_eq : IntFractPair.stream v n = some ifp_n) : ifp_n.fr < 1 :=
  (nth_stream_fr_nonneg_lt_one nth_stream_eq).right
#align generalized_continued_fraction.int_fract_pair.nth_stream_fr_lt_one GeneralizedContinuedFraction.IntFractPair.nth_stream_fr_lt_one

/-- Shows that the integer parts of the stream are at least one. -/
theorem one_le_succ_nth_stream_b {ifp_succ_n : IntFractPair K}
    (succ_nth_stream_eq : IntFractPair.stream v (n + 1) = some ifp_succ_n) : 1 ≤ ifp_succ_n.b :=
  by
  obtain ⟨ifp_n, nth_stream_eq, stream_nth_fr_ne_zero, ⟨-⟩⟩ :
    ∃ ifp_n,
      int_fract_pair.stream v n = some ifp_n ∧
        ifp_n.fr ≠ 0 ∧ int_fract_pair.of ifp_n.fr⁻¹ = ifp_succ_n
  exact succ_nth_stream_eq_some_iff.elim_left succ_nth_stream_eq
  suffices 1 ≤ ifp_n.fr⁻¹ by
    rw_mod_cast [le_floor]
    assumption
  suffices ifp_n.fr ≤ 1
    by
    have h : 0 < ifp_n.fr :=
      lt_of_le_of_ne (nth_stream_fr_nonneg nth_stream_eq) stream_nth_fr_ne_zero.symm
    apply one_le_inv h this
  simp only [le_of_lt (nth_stream_fr_lt_one nth_stream_eq)]
#align generalized_continued_fraction.int_fract_pair.one_le_succ_nth_stream_b GeneralizedContinuedFraction.IntFractPair.one_le_succ_nth_stream_b

/--
Shows that the `n + 1`th integer part `bₙ₊₁` of the stream is smaller or equal than the inverse of
the `n`th fractional part `frₙ` of the stream.
This result is straight-forward as `bₙ₊₁` is defined as the floor of `1 / frₙ`
-/
theorem succ_nth_stream_b_le_nth_stream_fr_inv {ifp_n ifp_succ_n : IntFractPair K}
    (nth_stream_eq : IntFractPair.stream v n = some ifp_n)
    (succ_nth_stream_eq : IntFractPair.stream v (n + 1) = some ifp_succ_n) :
    (ifp_succ_n.b : K) ≤ ifp_n.fr⁻¹ :=
  by
  suffices (⌊ifp_n.fr⁻¹⌋ : K) ≤ ifp_n.fr⁻¹
    by
    cases' ifp_n with _ ifp_n_fr
    have : ifp_n_fr ≠ 0 := by
      intro h
      simpa [h, int_fract_pair.stream, nth_stream_eq] using succ_nth_stream_eq
    have : int_fract_pair.of ifp_n_fr⁻¹ = ifp_succ_n := by
      simpa [this, int_fract_pair.stream, nth_stream_eq, Option.coe_def] using succ_nth_stream_eq
    rwa [← this]
  exact floor_le ifp_n.fr⁻¹
#align generalized_continued_fraction.int_fract_pair.succ_nth_stream_b_le_nth_stream_fr_inv GeneralizedContinuedFraction.IntFractPair.succ_nth_stream_b_le_nth_stream_fr_inv

end IntFractPair

/-!
Next we translate above results about the stream of `int_fract_pair`s to the computed continued
fraction `generalized_continued_fraction.of`.
-/

/-- Shows that the integer parts of the continued fraction are at least one. -/
theorem of_one_le_nth_part_denom {b : K}
    (nth_part_denom_eq : (of v).partialDenominators.get? n = some b) : 1 ≤ b :=
  by
  obtain ⟨gp_n, nth_s_eq, ⟨-⟩⟩ : ∃ gp_n, (of v).s.get? n = some gp_n ∧ gp_n.b = b;
  exact exists_s_b_of_part_denom nth_part_denom_eq
  obtain ⟨ifp_n, succ_nth_stream_eq, ifp_n_b_eq_gp_n_b⟩ :
    ∃ ifp, int_fract_pair.stream v (n + 1) = some ifp ∧ (ifp.b : K) = gp_n.b
  exact int_fract_pair.exists_succ_nth_stream_of_gcf_of_nth_eq_some nth_s_eq
  rw [← ifp_n_b_eq_gp_n_b]
  exact_mod_cast int_fract_pair.one_le_succ_nth_stream_b succ_nth_stream_eq
#align generalized_continued_fraction.of_one_le_nth_part_denom GeneralizedContinuedFraction.of_one_le_nth_part_denom

/--
Shows that the partial numerators `aᵢ` of the continued fraction are equal to one and the partial
denominators `bᵢ` correspond to integers.
-/
theorem of_part_num_eq_one_and_exists_int_part_denom_eq {gp : GeneralizedContinuedFraction.Pair K}
    (nth_s_eq : (of v).s.get? n = some gp) : gp.a = 1 ∧ ∃ z : ℤ, gp.b = (z : K) :=
  by
  obtain ⟨ifp, stream_succ_nth_eq, -⟩ : ∃ ifp, int_fract_pair.stream v (n + 1) = some ifp ∧ _
  exact int_fract_pair.exists_succ_nth_stream_of_gcf_of_nth_eq_some nth_s_eq
  have : gp = ⟨1, ifp.b⟩ :=
    by
    have : (of v).s.get? n = some ⟨1, ifp.b⟩ :=
      nth_of_eq_some_of_succ_nth_int_fract_pair_stream stream_succ_nth_eq
    have : some gp = some ⟨1, ifp.b⟩ := by rwa [nth_s_eq] at this
    injection this
  simp [this]
#align generalized_continued_fraction.of_part_num_eq_one_and_exists_int_part_denom_eq GeneralizedContinuedFraction.of_part_num_eq_one_and_exists_int_part_denom_eq

/-- Shows that the partial numerators `aᵢ` are equal to one. -/
theorem of_part_num_eq_one {a : K} (nth_part_num_eq : (of v).partialNumerators.get? n = some a) :
    a = 1 :=
  by
  obtain ⟨gp, nth_s_eq, gp_a_eq_a_n⟩ : ∃ gp, (of v).s.get? n = some gp ∧ gp.a = a
  exact exists_s_a_of_part_num nth_part_num_eq
  have : gp.a = 1 := (of_part_num_eq_one_and_exists_int_part_denom_eq nth_s_eq).left
  rwa [gp_a_eq_a_n] at this
#align generalized_continued_fraction.of_part_num_eq_one GeneralizedContinuedFraction.of_part_num_eq_one

/-- Shows that the partial denominators `bᵢ` correspond to an integer. -/
theorem exists_int_eq_of_part_denom {b : K}
    (nth_part_denom_eq : (of v).partialDenominators.get? n = some b) : ∃ z : ℤ, b = (z : K) :=
  by
  obtain ⟨gp, nth_s_eq, gp_b_eq_b_n⟩ : ∃ gp, (of v).s.get? n = some gp ∧ gp.b = b
  exact exists_s_b_of_part_denom nth_part_denom_eq
  have : ∃ z : ℤ, gp.b = (z : K) := (of_part_num_eq_one_and_exists_int_part_denom_eq nth_s_eq).right
  rwa [gp_b_eq_b_n] at this
#align generalized_continued_fraction.exists_int_eq_of_part_denom GeneralizedContinuedFraction.exists_int_eq_of_part_denom

/-!
One of our next goals is to show that `bₙ * Bₙ ≤ Bₙ₊₁`. For this, we first show that the partial
denominators `Bₙ` are bounded from below by the fibonacci sequence `nat.fib`. This then implies that
`0 ≤ Bₙ` and hence `Bₙ₊₂ = bₙ₊₁ * Bₙ₊₁ + Bₙ ≥ bₙ₊₁ * Bₙ₊₁ + 0 = bₙ₊₁ * Bₙ₊₁`.
-/

-- open `nat` as we will make use of fibonacci numbers.
open Nat

theorem fib_le_of_continuantsAux_b :
    n ≤ 1 ∨ ¬(of v).TerminatedAt (n - 2) → (fib n : K) ≤ ((of v).continuantsAux n).b :=
  Nat.strong_induction_on n
    (by
      clear n
      intro n IH hyp
      rcases n with (_ | _ | n)
      · simp [fib_add_two, continuants_aux]
      -- case n = 0
      · simp [fib_add_two, continuants_aux]
      -- case n = 1
      · let g := of v
        -- case 2 ≤ n
        have : ¬n + 2 ≤ 1 := by linarith
        have not_terminated_at_n : ¬g.terminated_at n := Or.resolve_left hyp this
        obtain ⟨gp, s_ppred_nth_eq⟩ : ∃ gp, g.s.nth n = some gp
        exact option.ne_none_iff_exists'.mp not_terminated_at_n
        set pconts := g.continuants_aux (n + 1) with pconts_eq
        set ppconts := g.continuants_aux n with ppconts_eq
        -- use the recurrence of continuants_aux
        suffices (fib n : K) + fib (n + 1) ≤ gp.a * ppconts.b + gp.b * pconts.b by
          simpa [fib_add_two, add_comm,
            continuants_aux_recurrence s_ppred_nth_eq ppconts_eq pconts_eq]
        -- make use of the fact that gp.a = 1
        suffices (fib n : K) + fib (n + 1) ≤ ppconts.b + gp.b * pconts.b by
          simpa [of_part_num_eq_one <| part_num_eq_s_a s_ppred_nth_eq]
        have not_terminated_at_pred_n : ¬g.terminated_at (n - 1) :=
          mt (terminated_stable <| Nat.sub_le n 1) not_terminated_at_n
        have not_terminated_at_ppred_n : ¬terminated_at g (n - 2) :=
          mt (terminated_stable (n - 1).pred_le) not_terminated_at_pred_n
        -- use the IH to get the inequalities for `pconts` and `ppconts`
        have : (fib (n + 1) : K) ≤ pconts.b :=
          IH _ (Nat.lt.base <| n + 1) (Or.inr not_terminated_at_pred_n)
        have ppred_nth_fib_le_ppconts_B : (fib n : K) ≤ ppconts.b :=
          IH n (lt_trans (Nat.lt.base n) <| Nat.lt.base <| n + 1) (Or.inr not_terminated_at_ppred_n)
        suffices : (fib (n + 1) : K) ≤ gp.b * pconts.b
        solve_by_elim [add_le_add ppred_nth_fib_le_ppconts_B]
        -- finally use the fact that 1 ≤ gp.b to solve the goal
        suffices 1 * (fib (n + 1) : K) ≤ gp.b * pconts.b by rwa [one_mul] at this
        have one_le_gp_b : (1 : K) ≤ gp.b :=
          of_one_le_nth_part_denom (part_denom_eq_s_b s_ppred_nth_eq)
        have : (0 : K) ≤ fib (n + 1) := by exact_mod_cast (fib (n + 1)).zero_le
        have : (0 : K) ≤ gp.b := le_trans zero_le_one one_le_gp_b
        mono)
#align generalized_continued_fraction.fib_le_of_continuants_aux_b GeneralizedContinuedFraction.fib_le_of_continuantsAux_b

/-- Shows that the `n`th denominator is greater than or equal to the `n + 1`th fibonacci number,
that is `nat.fib (n + 1) ≤ Bₙ`. -/
theorem succ_nth_fib_le_of_nth_denom (hyp : n = 0 ∨ ¬(of v).TerminatedAt (n - 1)) :
    (fib (n + 1) : K) ≤ (of v).denominators n :=
  by
  rw [denom_eq_conts_b, nth_cont_eq_succ_nth_cont_aux]
  have : n + 1 ≤ 1 ∨ ¬(of v).TerminatedAt (n - 1) :=
    by
    cases n
    case zero => exact Or.inl <| le_refl 1
    case succ => exact Or.inr (Or.resolve_left hyp n.succ_ne_zero)
  exact fib_le_of_continuants_aux_b this
#align generalized_continued_fraction.succ_nth_fib_le_of_nth_denom GeneralizedContinuedFraction.succ_nth_fib_le_of_nth_denom

/-! As a simple consequence, we can now derive that all denominators are nonnegative. -/

theorem zero_le_of_continuantsAux_b : 0 ≤ ((of v).continuantsAux n).b :=
  by
  let g := of v
  induction' n with n IH
  case zero => rfl
  case succ =>
    cases' Decidable.em <| g.terminated_at (n - 1) with terminated not_terminated
    · cases n
      -- terminating case
      · simp [zero_le_one]
      · have : g.continuants_aux (n + 2) = g.continuants_aux (n + 1) :=
          continuants_aux_stable_step_of_terminated terminated
        simp only [this, IH]
    ·
      calc
        -- non-terminating case
            (0 : K) ≤
            fib (n + 1) :=
          by exact_mod_cast (n + 1).fib.zero_le
        _ ≤ ((of v).continuantsAux (n + 1)).b := fib_le_of_continuants_aux_b (Or.inr not_terminated)

#align generalized_continued_fraction.zero_le_of_continuants_aux_b GeneralizedContinuedFraction.zero_le_of_continuantsAux_b

/-- Shows that all denominators are nonnegative. -/
theorem zero_le_of_denom : 0 ≤ (of v).denominators n :=
  by
  rw [denom_eq_conts_b, nth_cont_eq_succ_nth_cont_aux]
  exact zero_le_of_continuants_aux_b
#align generalized_continued_fraction.zero_le_of_denom GeneralizedContinuedFraction.zero_le_of_denom

theorem le_of_succ_succ_nth_continuantsAux_b {b : K}
    (nth_part_denom_eq : (of v).partialDenominators.get? n = some b) :
    b * ((of v).continuantsAux <| n + 1).b ≤ ((of v).continuantsAux <| n + 2).b :=
  by
  obtain ⟨gp_n, nth_s_eq, rfl⟩ : ∃ gp_n, (of v).s.get? n = some gp_n ∧ gp_n.b = b
  exact exists_s_b_of_part_denom nth_part_denom_eq
  simp [of_part_num_eq_one (part_num_eq_s_a nth_s_eq), zero_le_of_continuants_aux_b,
    GeneralizedContinuedFraction.continuantsAux_recurrence nth_s_eq rfl rfl]
#align generalized_continued_fraction.le_of_succ_succ_nth_continuants_aux_b GeneralizedContinuedFraction.le_of_succ_succ_nth_continuantsAux_b

/-- Shows that `bₙ * Bₙ ≤ Bₙ₊₁`, where `bₙ` is the `n`th partial denominator and `Bₙ₊₁` and `Bₙ` are
the `n + 1`th and `n`th denominator of the continued fraction. -/
theorem le_of_succ_nth_denom {b : K}
    (nth_part_denom_eq : (of v).partialDenominators.get? n = some b) :
    b * (of v).denominators n ≤ (of v).denominators (n + 1) :=
  by
  rw [denom_eq_conts_b, nth_cont_eq_succ_nth_cont_aux]
  exact le_of_succ_succ_nth_continuants_aux_b nth_part_denom_eq
#align generalized_continued_fraction.le_of_succ_nth_denom GeneralizedContinuedFraction.le_of_succ_nth_denom

/-- Shows that the sequence of denominators is monotone, that is `Bₙ ≤ Bₙ₊₁`. -/
theorem of_denom_mono : (of v).denominators n ≤ (of v).denominators (n + 1) :=
  by
  let g := of v
  cases' Decidable.em <| g.partial_denominators.terminated_at n with terminated not_terminated
  · have : g.partial_denominators.nth n = none := by rwa [Stream'.Seq.TerminatedAt] at terminated
    have : g.terminated_at n :=
      terminated_at_iff_part_denom_none.elim_right (by rwa [Stream'.Seq.TerminatedAt] at terminated)
    have : g.denominators (n + 1) = g.denominators n :=
      denominators_stable_of_terminated n.le_succ this
    rw [this]
  · obtain ⟨b, nth_part_denom_eq⟩ : ∃ b, g.partial_denominators.nth n = some b
    exact option.ne_none_iff_exists'.mp not_terminated
    have : 1 ≤ b := of_one_le_nth_part_denom nth_part_denom_eq
    calc
      g.denominators n ≤ b * g.denominators n := by
        simpa using mul_le_mul_of_nonneg_right this zero_le_of_denom
      _ ≤ g.denominators (n + 1) := le_of_succ_nth_denom nth_part_denom_eq

#align generalized_continued_fraction.of_denom_mono GeneralizedContinuedFraction.of_denom_mono

section Determinant

/-!
### Determinant Formula

Next we prove the so-called *determinant formula* for `generalized_continued_fraction.of`:
`Aₙ * Bₙ₊₁ - Bₙ * Aₙ₊₁ = (-1)^(n + 1)`.
-/

theorem determinant_aux (hyp : n = 0 ∨ ¬(of v).TerminatedAt (n - 1)) :
    ((of v).continuantsAux n).a * ((of v).continuantsAux (n + 1)).b -
        ((of v).continuantsAux n).b * ((of v).continuantsAux (n + 1)).a =
      (-1) ^ n :=
  by
  induction' n with n IH
  case zero => simp [continuants_aux]
  case
    succ =>
    -- set up some shorthand notation
    let g := of v
    let conts := continuants_aux g (n + 2)
    set pred_conts := continuants_aux g (n + 1) with pred_conts_eq
    set ppred_conts := continuants_aux g n with ppred_conts_eq
    let pA := pred_conts.a
    let pB := pred_conts.b
    let ppA := ppred_conts.a
    let ppB := ppred_conts.b
    -- let's change the goal to something more readable
    change pA * conts.b - pB * conts.a = (-1) ^ (n + 1)
    have not_terminated_at_n : ¬terminated_at g n := Or.resolve_left hyp n.succ_ne_zero
    obtain ⟨gp, s_nth_eq⟩ : ∃ gp, g.s.nth n = some gp
    exact option.ne_none_iff_exists'.elim_left not_terminated_at_n
    -- unfold the recurrence relation for `conts` once and simplify to derive the following
    suffices pA * (ppB + gp.b * pB) - pB * (ppA + gp.b * pA) = (-1) ^ (n + 1)
      by
      simp only [conts, continuants_aux_recurrence s_nth_eq ppred_conts_eq pred_conts_eq]
      have gp_a_eq_one : gp.a = 1 := of_part_num_eq_one (part_num_eq_s_a s_nth_eq)
      rw [gp_a_eq_one, this.symm]
      ring
    suffices : pA * ppB - pB * ppA = (-1) ^ (n + 1)
    calc
      pA * (ppB + gp.b * pB) - pB * (ppA + gp.b * pA) =
          pA * ppB + pA * gp.b * pB - pB * ppA - pB * gp.b * pA :=
        by ring
      _ = pA * ppB - pB * ppA := by ring
      _ = (-1) ^ (n + 1) := by assumption

    suffices ppA * pB - ppB * pA = (-1) ^ n
      by
      have pow_succ_n : (-1 : K) ^ (n + 1) = -1 * (-1) ^ n := pow_succ (-1) n
      rw [pow_succ_n, ← this]
      ring
    exact IH <| Or.inr <| mt (terminated_stable <| n.sub_le 1) not_terminated_at_n
#align generalized_continued_fraction.determinant_aux GeneralizedContinuedFraction.determinant_aux

/-- The determinant formula `Aₙ * Bₙ₊₁ - Bₙ * Aₙ₊₁ = (-1)^(n + 1)` -/
theorem determinant (not_terminated_at_n : ¬(of v).TerminatedAt n) :
    (of v).numerators n * (of v).denominators (n + 1) -
        (of v).denominators n * (of v).numerators (n + 1) =
      (-1) ^ (n + 1) :=
  determinant_aux <| Or.inr <| not_terminated_at_n
#align generalized_continued_fraction.determinant GeneralizedContinuedFraction.determinant

end Determinant

section ErrorTerm

/-!
### Approximation of Error Term

Next we derive some approximations for the error term when computing a continued fraction up a given
position, i.e. bounds for the term `|v - (generalized_continued_fraction.of v).convergents n|`.
-/

/-- This lemma follows from the finite correctness proof, the determinant equality, and
by simplifying the difference. -/
theorem sub_convergents_eq {ifp : IntFractPair K}
    (stream_nth_eq : IntFractPair.stream v n = some ifp) :
    let g := of v
    let B := (g.continuantsAux (n + 1)).b
    let pB := (g.continuantsAux n).b
    v - g.convergents n = if ifp.fr = 0 then 0 else (-1) ^ n / (B * (ifp.fr⁻¹ * B + pB)) :=
  by
  -- set up some shorthand notation
  let g := of v
  let conts := g.continuants_aux (n + 1)
  let pred_conts := g.continuants_aux n
  have g_finite_correctness :
    v = GeneralizedContinuedFraction.compExactValue pred_conts conts ifp.fr :=
    comp_exact_value_correctness_of_stream_eq_some stream_nth_eq
  cases' Decidable.em (ifp.fr = 0) with ifp_fr_eq_zero ifp_fr_ne_zero
  · suffices v - g.convergents n = 0 by simpa [ifp_fr_eq_zero]
    replace g_finite_correctness : v = g.convergents n
    · simpa [GeneralizedContinuedFraction.compExactValue, ifp_fr_eq_zero] using g_finite_correctness
    exact sub_eq_zero.elim_right g_finite_correctness
  · -- more shorthand notation
    let A := conts.a
    let B := conts.b
    let pA := pred_conts.a
    let pB := pred_conts.b
    -- first, let's simplify the goal as `ifp.fr ≠ 0`
    suffices v - A / B = (-1) ^ n / (B * (ifp.fr⁻¹ * B + pB)) by simpa [ifp_fr_ne_zero]
    -- now we can unfold `g.comp_exact_value` to derive the following equality for `v`
    replace g_finite_correctness : v = (pA + ifp.fr⁻¹ * A) / (pB + ifp.fr⁻¹ * B)
    ·
      simpa [GeneralizedContinuedFraction.compExactValue, ifp_fr_ne_zero, next_continuants,
        next_numerator, next_denominator, add_comm] using g_finite_correctness
    -- let's rewrite this equality for `v` in our goal
    suffices
      (pA + ifp.fr⁻¹ * A) / (pB + ifp.fr⁻¹ * B) - A / B = (-1) ^ n / (B * (ifp.fr⁻¹ * B + pB)) by
      rwa [g_finite_correctness]
    -- To continue, we need use the determinant equality. So let's derive the needed hypothesis.
    have n_eq_zero_or_not_terminated_at_pred_n : n = 0 ∨ ¬g.terminated_at (n - 1) :=
      by
      cases' n with n'
      · simp
      · have : int_fract_pair.stream v (n' + 1) ≠ none := by simp [stream_nth_eq]
        have : ¬g.terminated_at n' :=
          (not_congr of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none).right this
        exact Or.inr this
    have determinant_eq : pA * B - pB * A = (-1) ^ n :=
      determinant_aux n_eq_zero_or_not_terminated_at_pred_n
    -- now all we got to do is to rewrite this equality in our goal and re-arrange terms;
    -- however, for this, we first have to derive quite a few tedious inequalities.
    have pB_ineq : (fib n : K) ≤ pB :=
      haveI : n ≤ 1 ∨ ¬g.terminated_at (n - 2) :=
        by
        cases' n_eq_zero_or_not_terminated_at_pred_n with n_eq_zero not_terminated_at_pred_n
        · simp [n_eq_zero]
        · exact Or.inr <| mt (terminated_stable (n - 1).pred_le) not_terminated_at_pred_n
      fib_le_of_continuants_aux_b this
    have B_ineq : (fib (n + 1) : K) ≤ B :=
      haveI : n + 1 ≤ 1 ∨ ¬g.terminated_at (n + 1 - 2) :=
        by
        cases' n_eq_zero_or_not_terminated_at_pred_n with n_eq_zero not_terminated_at_pred_n
        · simp [n_eq_zero, le_refl]
        · exact Or.inr not_terminated_at_pred_n
      fib_le_of_continuants_aux_b this
    have zero_lt_B : 0 < B :=
      haveI : 1 ≤ B :=
        le_trans (by exact_mod_cast fib_pos (lt_of_le_of_ne n.succ.zero_le n.succ_ne_zero.symm))
          B_ineq
      lt_of_lt_of_le zero_lt_one this
    have zero_ne_B : 0 ≠ B := ne_of_lt zero_lt_B
    have : 0 ≠ pB + ifp.fr⁻¹ * B :=
      by
      have : (0 : K) ≤ fib n := by exact_mod_cast (fib n).zero_le
      -- 0 ≤ fib n ≤ pB
      have zero_le_pB : 0 ≤ pB := le_trans this pB_ineq
      have : 0 < ifp.fr⁻¹ := by
        suffices 0 < ifp.fr by rwa [inv_pos]
        have : 0 ≤ ifp.fr := int_fract_pair.nth_stream_fr_nonneg stream_nth_eq
        change ifp.fr ≠ 0 at ifp_fr_ne_zero
        exact lt_of_le_of_ne this ifp_fr_ne_zero.symm
      have : 0 < ifp.fr⁻¹ * B := mul_pos this zero_lt_B
      have : 0 < pB + ifp.fr⁻¹ * B := add_pos_of_nonneg_of_pos zero_le_pB this
      exact ne_of_lt this
    -- finally, let's do the rewriting
    calc
      (pA + ifp.fr⁻¹ * A) / (pB + ifp.fr⁻¹ * B) - A / B =
          ((pA + ifp.fr⁻¹ * A) * B - (pB + ifp.fr⁻¹ * B) * A) / ((pB + ifp.fr⁻¹ * B) * B) :=
        by rw [div_sub_div _ _ this.symm zero_ne_B.symm]
      _ = (pA * B + ifp.fr⁻¹ * A * B - (pB * A + ifp.fr⁻¹ * B * A)) / _ := by repeat' rw [add_mul]
      _ = (pA * B - pB * A) / ((pB + ifp.fr⁻¹ * B) * B) := by ring
      _ = (-1) ^ n / ((pB + ifp.fr⁻¹ * B) * B) := by rw [determinant_eq]
      _ = (-1) ^ n / (B * (ifp.fr⁻¹ * B + pB)) := by ac_rfl

#align generalized_continued_fraction.sub_convergents_eq GeneralizedContinuedFraction.sub_convergents_eq

/-- Shows that `|v - Aₙ / Bₙ| ≤ 1 / (Bₙ * Bₙ₊₁)` -/
theorem abs_sub_convergents_le (not_terminated_at_n : ¬(of v).TerminatedAt n) :
    |v - (of v).convergents n| ≤ 1 / ((of v).denominators n * ((of v).denominators <| n + 1)) :=
  by
  -- shorthand notation
  let g := of v
  let nextConts := g.continuants_aux (n + 2)
  set conts := continuants_aux g (n + 1) with conts_eq
  set pred_conts := continuants_aux g n with pred_conts_eq
  -- change the goal to something more readable
  change |v - convergents g n| ≤ 1 / (conts.b * nextConts.b)
  obtain ⟨gp, s_nth_eq⟩ : ∃ gp, g.s.nth n = some gp
  exact option.ne_none_iff_exists'.elim_left not_terminated_at_n
  have gp_a_eq_one : gp.a = 1 := of_part_num_eq_one (part_num_eq_s_a s_nth_eq)
  -- unfold the recurrence relation for `nextConts.b`
  have nextConts_b_eq : nextConts.b = pred_conts.b + gp.b * conts.b := by
    simp [nextConts, continuants_aux_recurrence s_nth_eq pred_conts_eq conts_eq, gp_a_eq_one,
      pred_conts_eq.symm, conts_eq.symm, add_comm]
  let denom := conts.b * (pred_conts.b + gp.b * conts.b)
  suffices |v - g.convergents n| ≤ 1 / denom
    by
    rw [nextConts_b_eq]
    congr 1
  obtain ⟨ifp_succ_n, succ_nth_stream_eq, ifp_succ_n_b_eq_gp_b⟩ :
    ∃ ifp_succ_n, int_fract_pair.stream v (n + 1) = some ifp_succ_n ∧ (ifp_succ_n.b : K) = gp.b
  exact int_fract_pair.exists_succ_nth_stream_of_gcf_of_nth_eq_some s_nth_eq
  obtain ⟨ifp_n, stream_nth_eq, stream_nth_fr_ne_zero, if_of_eq_ifp_succ_n⟩ :
    ∃ ifp_n,
      int_fract_pair.stream v n = some ifp_n ∧
        ifp_n.fr ≠ 0 ∧ int_fract_pair.of ifp_n.fr⁻¹ = ifp_succ_n
  exact int_fract_pair.succ_nth_stream_eq_some_iff.elim_left succ_nth_stream_eq
  let denom' := conts.b * (pred_conts.b + ifp_n.fr⁻¹ * conts.b)
  -- now we can use `sub_convergents_eq` to simplify our goal
  suffices |(-1) ^ n / denom'| ≤ 1 / denom
    by
    have : v - g.convergents n = (-1) ^ n / denom' :=
      by
      -- apply `sub_convergens_eq` and simplify the result
      have tmp := sub_convergents_eq stream_nth_eq
      delta at tmp
      simp only [stream_nth_fr_ne_zero, conts_eq.symm, pred_conts_eq.symm] at tmp
      rw [tmp]
      simp only [denom']
      ring_nf
    rwa [this]
  -- derive some tedious inequalities that we need to rewrite our goal
  have nextConts_b_ineq : (fib (n + 2) : K) ≤ pred_conts.b + gp.b * conts.b :=
    by
    have : (fib (n + 2) : K) ≤ nextConts.b :=
      fib_le_of_continuants_aux_b (Or.inr not_terminated_at_n)
    rwa [nextConts_b_eq] at this
  have conts_b_ineq : (fib (n + 1) : K) ≤ conts.b :=
    haveI : ¬g.terminated_at (n - 1) := mt (terminated_stable n.pred_le) not_terminated_at_n
    fib_le_of_continuants_aux_b <| Or.inr this
  have zero_lt_conts_b : 0 < conts.b :=
    haveI : (0 : K) < fib (n + 1) := by
      exact_mod_cast fib_pos (lt_of_le_of_ne n.succ.zero_le n.succ_ne_zero.symm)
    lt_of_lt_of_le this conts_b_ineq
  -- `denom'` is positive, so we can remove `|⬝|` from our goal
  suffices 1 / denom' ≤ 1 / denom
    by
    have : |(-1) ^ n / denom'| = 1 / denom' :=
      by
      suffices 1 / |denom'| = 1 / denom' by rwa [abs_div, abs_neg_one_pow n]
      have : 0 < denom' :=
        by
        have : 0 ≤ pred_conts.b :=
          haveI : (fib n : K) ≤ pred_conts.b :=
            haveI : ¬g.terminated_at (n - 2) :=
              mt (terminated_stable (n.sub_le 2)) not_terminated_at_n
            fib_le_of_continuants_aux_b <| Or.inr this
          le_trans (by exact_mod_cast (fib n).zero_le) this
        have : 0 < ifp_n.fr⁻¹ :=
          haveI zero_le_ifp_n_fract : 0 ≤ ifp_n.fr :=
            int_fract_pair.nth_stream_fr_nonneg stream_nth_eq
          inv_pos.elim_right (lt_of_le_of_ne zero_le_ifp_n_fract stream_nth_fr_ne_zero.symm)
        any_goals repeat' first |apply mul_pos|apply add_pos_of_nonneg_of_pos <;> assumption
      rwa [abs_of_pos this]
    rwa [this]
  suffices : 0 < denom ∧ denom ≤ denom'
  exact div_le_div_of_le_left zero_le_one this.left this.right
  constructor
  · have : 0 < pred_conts.b + gp.b * conts.b :=
      lt_of_lt_of_le
        (by exact_mod_cast fib_pos (lt_of_le_of_ne n.succ.succ.zero_le n.succ.succ_ne_zero.symm))
        nextConts_b_ineq
    solve_by_elim [mul_pos]
  · -- we can cancel multiplication by `conts.b` and addition with `pred_conts.b`
    suffices : gp.b * conts.b ≤ ifp_n.fr⁻¹ * conts.b
    exact (mul_le_mul_left zero_lt_conts_b).right <| (add_le_add_iff_left pred_conts.b).right this
    suffices (ifp_succ_n.b : K) * conts.b ≤ ifp_n.fr⁻¹ * conts.b by rwa [← ifp_succ_n_b_eq_gp_b]
    have : (ifp_succ_n.b : K) ≤ ifp_n.fr⁻¹ :=
      int_fract_pair.succ_nth_stream_b_le_nth_stream_fr_inv stream_nth_eq succ_nth_stream_eq
    have : 0 ≤ conts.b := le_of_lt zero_lt_conts_b
    mono
#align generalized_continued_fraction.abs_sub_convergents_le GeneralizedContinuedFraction.abs_sub_convergents_le

/-- Shows that `|v - Aₙ / Bₙ| ≤ 1 / (bₙ * Bₙ * Bₙ)`. This bound is worse than the one shown in
`gcf.abs_sub_convergents_le`, but sometimes it is easier to apply and sufficient for one's use case.
 -/
theorem abs_sub_convergents_le' {b : K}
    (nth_part_denom_eq : (of v).partialDenominators.get? n = some b) :
    |v - (of v).convergents n| ≤ 1 / (b * (of v).denominators n * (of v).denominators n) :=
  by
  have not_terminated_at_n : ¬(of v).TerminatedAt n := by
    simp [terminated_at_iff_part_denom_none, nth_part_denom_eq]
  refine' (abs_sub_convergents_le not_terminated_at_n).trans _
  -- One can show that `0 < (generalized_continued_fraction.of v).denominators n` but it's easier
  -- to consider the case `(generalized_continued_fraction.of v).denominators n = 0`.
  rcases zero_le_of_denom.eq_or_gt with
    ((hB : (GeneralizedContinuedFraction.of v).denominators n = 0) | hB)
  · simp only [hB, MulZeroClass.mul_zero, MulZeroClass.zero_mul, div_zero]
  · apply one_div_le_one_div_of_le
    · have : 0 < b := zero_lt_one.trans_le (of_one_le_nth_part_denom nth_part_denom_eq)
      apply_rules [mul_pos]
    · conv_rhs => rw [mul_comm]
      exact mul_le_mul_of_nonneg_right (le_of_succ_nth_denom nth_part_denom_eq) hB.le
#align generalized_continued_fraction.abs_sub_convergents_le' GeneralizedContinuedFraction.abs_sub_convergents_le'

end ErrorTerm

end GeneralizedContinuedFraction


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen

! This file was ported from Lean 3 source module linear_algebra.matrix.diagonal
! leanprover-community/mathlib commit 2bbc7e3884ba234309d2a43b19144105a753292e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Matrix.ToLin

/-!
# Diagonal matrices

This file contains some results on the linear map corresponding to a
diagonal matrix (`range`, `ker` and `rank`).

## Tags

matrix, diagonal, linear_map
-/

noncomputable section

open LinearMap Matrix Set Submodule

open BigOperators

open Matrix

universe u v w

namespace Matrix

section CommRing

variable {n : Type _} [Fintype n] [DecidableEq n] {R : Type v} [CommRing R]

theorem proj_diagonal (i : n) (w : n → R) : (proj i).comp (toLin' (diagonal w)) = w i • proj i :=
  LinearMap.ext fun j => mulVec_diagonal _ _ _
#align matrix.proj_diagonal Matrix.proj_diagonal

theorem diagonal_comp_stdBasis (w : n → R) (i : n) :
    (diagonal w).toLin'.comp (LinearMap.stdBasis R (fun _ : n => R) i) =
      w i • LinearMap.stdBasis R (fun _ : n => R) i :=
  LinearMap.ext fun x => (diagonal_mulVec_single w _ _).trans (Pi.single_smul' i (w i) x)
#align matrix.diagonal_comp_std_basis Matrix.diagonal_comp_stdBasis

theorem diagonal_toLin' (w : n → R) :
    (diagonal w).toLin' = LinearMap.pi fun i => w i • LinearMap.proj i :=
  LinearMap.ext fun v => funext fun i => mulVec_diagonal _ _ _
#align matrix.diagonal_to_lin' Matrix.diagonal_toLin'

end CommRing

section Field

variable {m n : Type _} [Fintype m] [Fintype n]

variable {K : Type u} [Field K]

-- maybe try to relax the universe constraint
theorem ker_diagonal_toLin' [DecidableEq m] (w : m → K) :
    ker (diagonal w).toLin' = ⨆ i ∈ { i | w i = 0 }, range (LinearMap.stdBasis K (fun i => K) i) :=
  by
  rw [← comap_bot, ← infi_ker_proj, comap_infi]
  have := fun i : m => ker_comp (to_lin' (diagonal w)) (proj i)
  simp only [comap_infi, ← this, proj_diagonal, ker_smul']
  have : univ ⊆ { i : m | w i = 0 } ∪ { i : m | w i = 0 }ᶜ := by rw [Set.union_compl_self]
  exact
    (supr_range_std_basis_eq_infi_ker_proj K (fun i : m => K) disjoint_compl_right this
        (Set.toFinite _)).symm
#align matrix.ker_diagonal_to_lin' Matrix.ker_diagonal_toLin'

theorem range_diagonal [DecidableEq m] (w : m → K) :
    (diagonal w).toLin'.range =
      ⨆ i ∈ { i | w i ≠ 0 }, (LinearMap.stdBasis K (fun i => K) i).range :=
  by
  dsimp only [mem_set_of_eq]
  rw [← Submodule.map_top, ← supr_range_std_basis, Submodule.map_supᵢ]
  congr ; funext i
  rw [← LinearMap.range_comp, diagonal_comp_std_basis, ← range_smul']
#align matrix.range_diagonal Matrix.range_diagonal

theorem rank_diagonal [DecidableEq m] [DecidableEq K] (w : m → K) :
    rank (diagonal w).toLin' = Fintype.card { i // w i ≠ 0 } :=
  by
  have hu : univ ⊆ { i : m | w i = 0 }ᶜ ∪ { i : m | w i = 0 } := by rw [Set.compl_union_self]
  have hd : Disjoint { i : m | w i ≠ 0 } { i : m | w i = 0 } := disjoint_compl_left
  have B₁ := supr_range_std_basis_eq_infi_ker_proj K (fun i : m => K) hd hu (Set.toFinite _)
  have B₂ := @infi_ker_proj_equiv K _ _ (fun i : m => K) _ _ _ _ (by simp <;> infer_instance) hd hu
  rw [rank, range_diagonal, B₁, ← @dim_fun' K]
  apply LinearEquiv.dim_eq
  apply B₂
#align matrix.rank_diagonal Matrix.rank_diagonal

end Field

end Matrix


import tactic.interactive tactic.find data.list.basic

def my_list_bexists {α : Type} (p : α → bool) : ∀ l : list α, bool
| list.nil := ff
| (list.cons a l) := bor (p a)  (my_list_bexists l)

def my_list_pexists {α : Type} (p : α → Prop) : ∀ l : list α, Prop
| list.nil := false
| (list.cons a l) := (p a) ∨ (my_list_pexists l)

def my_list_pexists' {α : Type} (p : α → Prop) (l : list α) : Prop :=
 ∃ (i : ℕ) (i_is_lt : i < l.length), p (l.nth_le i i_is_lt)

lemma my_list_pexists_nil {α : Type} (p : α → Prop) :
 ¬ my_list_pexists' p list.nil := by {rintro ⟨i,⟨⟨_⟩,_⟩⟩}

lemma my_list_pexists_succ {α : Type} (p : α → Prop) (a : α) (l : list α) :
 my_list_pexists' p (a :: l) ↔ (p a ∨ (my_list_pexists' p l)) := begin
 unfold my_list_pexists',
 split,
 {rintro ⟨_|i,⟨i_is_lt,pi⟩⟩,
  {left,exact pi},
  {let i_is_lt' := nat.lt_of_succ_lt_succ i_is_lt,
  right,use i,use i_is_lt',
  exact pi,}
 },{
  rintro (pa | ⟨i,⟨i_is_lt,pi⟩⟩),
  {use 0,use nat.zero_lt_succ l.length,exact pa},
  {use i.succ,use nat.succ_lt_succ i_is_lt,exact pi}
 }
end

lemma my_list_pexists_iff {α : Type} (p : α → Prop) : ∀ (l : list α),
 my_list_pexists p l ↔ my_list_pexists' p l
| list.nil := ((iff_false _).mpr (my_list_pexists_nil p)).symm
| (a :: l) := by {rw[my_list_pexists_succ,← my_list_pexists_iff l],refl,}

instance my_list_pexists_decidable
 {α : Type} (p : α → Prop) [decidable_pred p] : ∀ (l : list α),
  decidable (my_list_pexists p l)
| list.nil := by { dsimp[my_list_pexists],apply_instance, }
| (a :: l) := by {
    dsimp[my_list_pexists],
    haveI := my_list_pexists_decidable l,
    apply_instance, }

instance my_list_pexists'_decidable
 {α : Type} (p : α → Prop) [decidable_pred p] (l : list α) :
  decidable (my_list_pexists' p l) :=
   decidable_of_iff _ (my_list_pexists_iff p l)


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

/-!
# Grönwall's inequality

The main technical result of this file is the Grönwall-like inequality
`norm_le_gronwall_bound_of_norm_deriv_right_le`. It states that if `f : ℝ → E` satisfies `∥f a∥ ≤ δ`
and `∀ x ∈ [a, b), ∥f' x∥ ≤ K * ∥f x∥ + ε`, then for all `x ∈ [a, b]` we have `∥f x∥ ≤ δ * exp (K *
x) + (ε / K) * (exp (K * x) - 1)`.

Then we use this inequality to prove some estimates on the possible rate of growth of the distance
between two approximate or exact solutions of an ordinary differential equation.

The proofs are based on [Hubbard and West, *Differential Equations: A Dynamical Systems Approach*,
Sec. 4.5][HubbardWest-ode], where `norm_le_gronwall_bound_of_norm_deriv_right_le` is called
“Fundamental Inequality”.

## TODO

- Once we have FTC, prove an inequality for a function satisfying `∥f' x∥ ≤ K x * ∥f x∥ + ε`,
  or more generally `liminf_{y→x+0} (f y - f x)/(y - x) ≤ K x * f x + ε` with any sign
  of `K x` and `f x`.
-/

variables {E : Type*} [normed_group E] [normed_space ℝ E]
          {F : Type*} [normed_group F] [normed_space ℝ F]

open metric set asymptotics filter real
open_locale classical topological_space nnreal

/-! ### Technical lemmas about `gronwall_bound` -/

/-- Upper bound used in several Grönwall-like inequalities. -/
noncomputable def gronwall_bound (δ K ε x : ℝ) : ℝ :=
if K = 0 then δ + ε * x else δ * exp (K * x) + (ε / K) * (exp (K * x) - 1)

lemma gronwall_bound_K0 (δ ε : ℝ) : gronwall_bound δ 0 ε = λ x, δ + ε * x :=
funext $ λ x, if_pos rfl

lemma gronwall_bound_of_K_ne_0 {δ K ε : ℝ} (hK : K ≠ 0) :
  gronwall_bound δ K ε = λ x, δ * exp (K * x) + (ε / K) * (exp (K * x) - 1) :=
funext $ λ x, if_neg hK

lemma has_deriv_at_gronwall_bound (δ K ε x : ℝ) :
  has_deriv_at (gronwall_bound δ K ε) (K * (gronwall_bound δ K ε x) + ε) x :=
begin
  by_cases hK : K = 0,
  { subst K,
    simp only [gronwall_bound_K0, zero_mul, zero_add],
    convert ((has_deriv_at_id x).const_mul ε).const_add δ,
    rw [mul_one] },
  { simp only [gronwall_bound_of_K_ne_0 hK],
    convert (((has_deriv_at_id x).const_mul K).exp.const_mul δ).add
      ((((has_deriv_at_id x).const_mul K).exp.sub_const 1).const_mul (ε / K)) using 1,
    simp only [id, mul_add, (mul_assoc _ _ _).symm, mul_comm _ K, mul_div_cancel' _ hK],
    ring }
end

lemma has_deriv_at_gronwall_bound_shift (δ K ε x a : ℝ) :
  has_deriv_at (λ y, gronwall_bound δ K ε (y - a)) (K * (gronwall_bound δ K ε (x - a)) + ε) x :=
begin
  convert (has_deriv_at_gronwall_bound δ K ε _).comp x ((has_deriv_at_id x).sub_const a),
  rw [id, mul_one]
end

lemma gronwall_bound_x0 (δ K ε : ℝ) : gronwall_bound δ K ε 0 = δ :=
begin
  by_cases hK : K = 0,
  { simp only [gronwall_bound, if_pos hK, mul_zero, add_zero] },
  { simp only [gronwall_bound, if_neg hK, mul_zero, exp_zero, sub_self, mul_one, add_zero] }
end

lemma gronwall_bound_ε0 (δ K x : ℝ) : gronwall_bound δ K 0 x = δ * exp (K * x) :=
begin
  by_cases hK : K = 0,
  { simp only [gronwall_bound_K0, hK, zero_mul, exp_zero, add_zero, mul_one] },
  { simp only [gronwall_bound_of_K_ne_0 hK, zero_div, zero_mul, add_zero] }
end

lemma gronwall_bound_ε0_δ0 (K x : ℝ) : gronwall_bound 0 K 0 x = 0 :=
by simp only [gronwall_bound_ε0, zero_mul]

lemma gronwall_bound_continuous_ε (δ K x : ℝ) : continuous (λ ε, gronwall_bound δ K ε x) :=
begin
  by_cases hK : K = 0,
  { simp only [gronwall_bound_K0, hK],
    exact continuous_const.add (continuous_id.mul continuous_const) },
  { simp only [gronwall_bound_of_K_ne_0 hK],
    exact continuous_const.add ((continuous_id.mul continuous_const).mul continuous_const) }
end

/-! ### Inequality and corollaries -/

/-- A Grönwall-like inequality: if `f : ℝ → ℝ` is continuous on `[a, b]` and satisfies
the inequalities `f a ≤ δ` and
`∀ x ∈ [a, b), liminf_{z→x+0} (f z - f x)/(z - x) ≤ K * (f x) + ε`, then `f x`
is bounded by `gronwall_bound δ K ε (x - a)` on `[a, b]`.

See also `norm_le_gronwall_bound_of_norm_deriv_right_le` for a version bounding `∥f x∥`,
`f : ℝ → E`. -/
theorem le_gronwall_bound_of_liminf_deriv_right_le {f f' : ℝ → ℝ} {δ K ε : ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, ∀ r, f' x < r →
    ∃ᶠ z in 𝓝[Ioi x] x, (z - x)⁻¹ * (f z - f x) < r)
  (ha : f a ≤ δ) (bound : ∀ x ∈ Ico a b, f' x ≤ K * f x + ε) :
  ∀ x ∈ Icc a b, f x ≤ gronwall_bound δ K ε (x - a) :=
begin
  have H : ∀ x ∈ Icc a b, ∀ ε' ∈ Ioi ε, f x ≤ gronwall_bound δ K ε' (x - a),
  { assume x hx ε' hε',
    apply image_le_of_liminf_slope_right_lt_deriv_boundary hf hf',
    { rwa [sub_self, gronwall_bound_x0] },
    { exact λ x, has_deriv_at_gronwall_bound_shift δ K ε' x a },
    { assume x hx hfB,
      rw [← hfB],
      apply lt_of_le_of_lt (bound x hx),
      exact add_lt_add_left hε' _ },
    { exact hx } },
  assume x hx,
  change f x ≤ (λ ε', gronwall_bound δ K ε' (x - a)) ε,
  convert continuous_within_at_const.closure_le _ _ (H x hx),
  { simp only [closure_Ioi, left_mem_Ici] },
  exact (gronwall_bound_continuous_ε δ K (x - a)).continuous_within_at
end

/-- A Grönwall-like inequality: if `f : ℝ → E` is continuous on `[a, b]`, has right derivative
`f' x` at every point `x ∈ [a, b)`, and satisfies the inequalities `∥f a∥ ≤ δ`,
`∀ x ∈ [a, b), ∥f' x∥ ≤ K * ∥f x∥ + ε`, then `∥f x∥` is bounded by `gronwall_bound δ K ε (x - a)`
on `[a, b]`. -/
theorem norm_le_gronwall_bound_of_norm_deriv_right_le {f f' : ℝ → E} {δ K ε : ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b)) (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  (ha : ∥f a∥ ≤ δ) (bound : ∀ x ∈ Ico a b, ∥f' x∥ ≤ K * ∥f x∥ + ε) :
  ∀ x ∈ Icc a b, ∥f x∥ ≤ gronwall_bound δ K ε (x - a) :=
le_gronwall_bound_of_liminf_deriv_right_le (continuous_norm.comp_continuous_on hf)
  (λ x hx r hr, (hf' x hx).liminf_right_slope_norm_le hr) ha bound

/-- If `f` and `g` are two approximate solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in some time-dependent set `s t`,
and assumes that the solutions never leave this set. -/
theorem dist_le_of_approx_trajectories_ODE_of_mem_set {v : ℝ → E → E} {s : ℝ → set E}
  {K : ℝ} (hv : ∀ t, ∀ x y ∈ s t, dist (v t x) (v t y) ≤ K * dist x y)
  {f g f' g' : ℝ → E} {a b : ℝ} {εf εg δ : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (f' t) (Ici t) t)
  (f_bound : ∀ t ∈ Ico a b, dist (f' t) (v t (f t)) ≤ εf)
  (hfs : ∀ t ∈ Ico a b, f t ∈ s t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (g' t) (Ici t) t)
  (g_bound : ∀ t ∈ Ico a b, dist (g' t) (v t (g t)) ≤ εg)
  (hgs : ∀ t ∈ Ico a b, g t ∈ s t)
  (ha : dist (f a) (g a) ≤ δ) :
  ∀ t ∈ Icc a b, dist (f t) (g t) ≤ gronwall_bound δ K (εf + εg) (t - a) :=
begin
  simp only [dist_eq_norm] at ha ⊢,
  have h_deriv : ∀ t ∈ Ico a b, has_deriv_within_at (λ t, f t - g t) (f' t - g' t) (Ici t) t,
    from λ t ht, (hf' t ht).sub (hg' t ht),
  apply norm_le_gronwall_bound_of_norm_deriv_right_le (hf.sub hg) h_deriv ha,
  assume t ht,
  have := dist_triangle4_right (f' t) (g' t) (v t (f t)) (v t (g t)),
  rw [dist_eq_norm] at this,
  apply le_trans this,
  apply le_trans (add_le_add (add_le_add (f_bound t ht) (g_bound t ht))
    (hv t (f t) (g t) (hfs t ht) (hgs t ht))),
  rw [dist_eq_norm, add_comm]
end

/-- If `f` and `g` are two approximate solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in the whole space. -/
theorem dist_le_of_approx_trajectories_ODE {v : ℝ → E → E}
  {K : ℝ≥0} (hv : ∀ t, lipschitz_with K (v t))
  {f g f' g' : ℝ → E} {a b : ℝ} {εf εg δ : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (f' t) (Ici t) t)
  (f_bound : ∀ t ∈ Ico a b, dist (f' t) (v t (f t)) ≤ εf)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (g' t) (Ici t) t)
  (g_bound : ∀ t ∈ Ico a b, dist (g' t) (v t (g t)) ≤ εg)
  (ha : dist (f a) (g a) ≤ δ) :
  ∀ t ∈ Icc a b, dist (f t) (g t) ≤ gronwall_bound δ K (εf + εg) (t - a) :=
have hfs : ∀ t ∈ Ico a b, f t ∈ (@univ E), from λ t ht, trivial,
dist_le_of_approx_trajectories_ODE_of_mem_set (λ t x y hx hy, (hv t).dist_le_mul x y)
  hf hf' f_bound hfs hg hg' g_bound (λ t ht, trivial) ha

/-- If `f` and `g` are two exact solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in some time-dependent set `s t`,
and assumes that the solutions never leave this set. -/
theorem dist_le_of_trajectories_ODE_of_mem_set {v : ℝ → E → E} {s : ℝ → set E}
  {K : ℝ} (hv : ∀ t, ∀ x y ∈ s t, dist (v t x) (v t y) ≤ K * dist x y)
  {f g : ℝ → E} {a b : ℝ} {δ : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (v t (f t)) (Ici t) t)
  (hfs : ∀ t ∈ Ico a b, f t ∈ s t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (v t (g t)) (Ici t) t)
  (hgs : ∀ t ∈ Ico a b, g t ∈ s t)
  (ha : dist (f a) (g a) ≤ δ) :
  ∀ t ∈ Icc a b, dist (f t) (g t) ≤ δ * exp (K * (t - a)) :=
begin
  have f_bound : ∀ t ∈ Ico a b, dist (v t (f t)) (v t (f t)) ≤ 0,
    by { intros, rw [dist_self] },
  have g_bound : ∀ t ∈ Ico a b, dist (v t (g t)) (v t (g t)) ≤ 0,
    by { intros, rw [dist_self] },
  assume t ht,
  have := dist_le_of_approx_trajectories_ODE_of_mem_set hv hf hf' f_bound hfs hg hg' g_bound
    hgs ha t ht,
  rwa [zero_add, gronwall_bound_ε0] at this,
end

/-- If `f` and `g` are two exact solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in the whole space. -/
theorem dist_le_of_trajectories_ODE {v : ℝ → E → E}
  {K : ℝ≥0} (hv : ∀ t, lipschitz_with K (v t))
  {f g : ℝ → E} {a b : ℝ} {δ : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (v t (f t)) (Ici t) t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (v t (g t)) (Ici t) t)
  (ha : dist (f a) (g a) ≤ δ) :
  ∀ t ∈ Icc a b, dist (f t) (g t) ≤ δ * exp (K * (t - a)) :=
have hfs : ∀ t ∈ Ico a b, f t ∈ (@univ E), from λ t ht, trivial,
dist_le_of_trajectories_ODE_of_mem_set (λ t x y hx hy, (hv t).dist_le_mul x y)
  hf hf' hfs hg hg' (λ t ht, trivial) ha

/-- There exists only one solution of an ODE \(\dot x=v(t, x)\) in a set `s ⊆ ℝ × E` with
a given initial value provided that RHS is Lipschitz continuous in `x` within `s`,
and we consider only solutions included in `s`. -/
theorem ODE_solution_unique_of_mem_set {v : ℝ → E → E} {s : ℝ → set E}
  {K : ℝ} (hv : ∀ t, ∀ x y ∈ s t, dist (v t x) (v t y) ≤ K * dist x y)
  {f g : ℝ → E} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (v t (f t)) (Ici t) t)
  (hfs : ∀ t ∈ Ico a b, f t ∈ s t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (v t (g t)) (Ici t) t)
  (hgs : ∀ t ∈ Ico a b, g t ∈ s t)
  (ha : f a = g a) :
  ∀ t ∈ Icc a b, f t = g t :=
begin
  assume t ht,
  have := dist_le_of_trajectories_ODE_of_mem_set hv hf hf' hfs hg hg' hgs
    (dist_le_zero.2 ha) t ht,
  rwa [zero_mul, dist_le_zero] at this
end

/-- There exists only one solution of an ODE \(\dot x=v(t, x)\) with
a given initial value provided that RHS is Lipschitz continuous in `x`. -/
theorem ODE_solution_unique {v : ℝ → E → E}
  {K : ℝ≥0} (hv : ∀ t, lipschitz_with K (v t))
  {f g : ℝ → E} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (v t (f t)) (Ici t) t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (v t (g t)) (Ici t) t)
  (ha : f a = g a) :
  ∀ t ∈ Icc a b, f t = g t :=
have hfs : ∀ t ∈ Ico a b, f t ∈ (@univ E), from λ t ht, trivial,
ODE_solution_unique_of_mem_set (λ t x y hx hy, (hv t).dist_le_mul x y)
  hf hf' hfs hg hg' (λ t ht, trivial) ha


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.multiset.nodup
import Mathlib.data.list.nat_antidiagonal
import Mathlib.PostPort

namespace Mathlib

/-!
# The "antidiagonal" {(0,n), (1,n-1), ..., (n,0)} as a multiset.
-/

namespace multiset

namespace nat

/-- The antidiagonal of a natural number `n` is
    the multiset of pairs `(i,j)` such that `i+j = n`. -/
def antidiagonal (n : ℕ) : multiset (ℕ × ℕ) := ↑(list.nat.antidiagonal n)

/-- A pair (i,j) is contained in the antidiagonal of `n` if and only if `i+j=n`. -/
@[simp] theorem mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} :
    x ∈ antidiagonal n ↔ prod.fst x + prod.snd x = n :=
  sorry

/-- The cardinality of the antidiagonal of `n` is `n+1`. -/
@[simp] theorem card_antidiagonal (n : ℕ) : coe_fn card (antidiagonal n) = n + 1 := sorry

/-- The antidiagonal of `0` is the list `[(0,0)]` -/
@[simp] theorem antidiagonal_zero : antidiagonal 0 = singleton (0, 0) := rfl

/-- The antidiagonal of `n` does not contain duplicate entries. -/
@[simp] theorem nodup_antidiagonal (n : ℕ) : nodup (antidiagonal n) :=
  iff.mpr coe_nodup (list.nat.nodup_antidiagonal n)

@[simp] theorem antidiagonal_succ {n : ℕ} :
    antidiagonal (n + 1) = (0, n + 1) ::ₘ map (prod.map Nat.succ id) (antidiagonal n) :=
  sorry

end Mathlib


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Sébastien Gouëzel
Characterize completeness of metric spaces in terms of Cauchy sequences.
In particular, reconcile the filter notion of Cauchy-ness with the cau_seq notion on normed spaces.
-/

import topology.uniform_space.basic analysis.normed_space.basic data.real.cau_seq analysis.specific_limits
import tactic.linarith

universes u v
open set filter classical emetric

variable {β : Type v}

/- We show that a metric space in which all Cauchy sequences converge is complete, i.e., all
Cauchy filters converge. For this, we approximate any Cauchy filter by a Cauchy sequence,
taking advantage of the fact that there is a sequence tending to `0` in ℝ. The proof also gives
a more precise result, that to get completeness it is enough to have the convergence
of all sequence that are Cauchy in a fixed quantitative sense, for instance satisfying
`dist (u n) (u m) < 2^{- min m n}`. The classical argument to obtain this criterion is to start
from a Cauchy sequence, extract a subsequence that satisfies this property, deduce the convergence
of the subsequence, and then the convergence of the original sequence. All this argument is
completely bypassed by the following proof, which avoids any use of subsequences and is written
partly in terms of filters. -/

namespace ennreal

/-In this paragraph, we prove useful properties of the sequence `half_pow n := 2^{-n}` in ennreal.
Some of them are instrumental in this file to get Cauchy sequences, but others are proved
here only for use in further applications of the completeness criterion
`emetric.complete_of_convergent_controlled_sequences` below. -/

/-- An auxiliary positive sequence that tends to `0` in `ennreal`, with good behavior. -/
noncomputable def half_pow (n : ℕ) : ennreal := ennreal.of_real ((1 / 2) ^ n)

lemma half_pow_pos (n : ℕ) : 0 < half_pow n :=
begin
  have : (0 : real) < (1/2)^n := pow_pos (by norm_num) _,
  simpa [half_pow] using this
end

lemma half_pow_tendsto_zero : tendsto (λn, half_pow n) at_top (nhds 0) :=
begin
  unfold half_pow,
  rw ← ennreal.of_real_zero,
  apply ennreal.tendsto_of_real,
  exact tendsto_pow_at_top_nhds_0_of_lt_1 (by norm_num) (by norm_num)
end

lemma half_pow_add_succ (n : ℕ) : half_pow (n+1) + half_pow (n+1) = half_pow n :=
begin
  have : (0 : real) ≤ (1/2)^(n+1) := (le_of_lt (pow_pos (by norm_num) _)),
  simp only [half_pow, eq.symm (ennreal.of_real_add this this)],
  apply congr_arg,
  simp only [pow_add, one_div_eq_inv, pow_one],
  ring,
end

lemma half_pow_mono (m k : ℕ) (h : m ≤ k) : half_pow k ≤ half_pow m :=
ennreal.of_real_le_of_real (pow_le_pow_of_le_one (by norm_num) (by norm_num) h)

lemma edist_le_two_mul_half_pow [emetric_space β] {k l N : ℕ} (hk : N ≤ k) (hl : N ≤ l)
  {u : ℕ → β} (h : ∀n, edist (u n) (u (n+1)) ≤ half_pow n) :
  edist (u k) (u l) ≤ 2 * half_pow N :=
begin
  have ineq_rec : ∀m, ∀k≥m, half_pow k + edist (u m) (u (k+1)) ≤ 2 * half_pow m,
  { assume m,
    refine nat.le_induction _ (λk km hk, _),
    { calc half_pow m + edist (u m) (u (m+1)) ≤ half_pow m + half_pow m : add_le_add_left' (h m)
      ... = 2 * half_pow m : by simp [(mul_two _).symm, mul_comm] },
    { calc half_pow (k + 1) + edist (u m) (u (k + 1 + 1))
      ≤ half_pow (k+1) + (edist (u m) (u (k+1)) + edist (u (k+1)) (u (k+2))) :
        add_le_add_left' (edist_triangle _ _ _)
      ... ≤ half_pow (k+1) + (edist (u m) (u (k+1)) + half_pow (k+1)) :
        add_le_add_left' (add_le_add_left' (h (k+1)))
      ... = (half_pow(k+1) + half_pow(k+1)) + edist (u m) (u (k+1)) : by simp [add_comm]
      ... = half_pow k + edist (u m) (u (k+1)) : by rw half_pow_add_succ
      ... ≤ 2 * half_pow m : hk }},
  have Imk : ∀m, ∀k≥m, edist (u m) (u k) ≤ 2 * half_pow m,
  { assume m k hk,
    by_cases h : m = k,
    { simp [h, le_of_lt (half_pow_pos k)] },
    { have I : m < k := lt_of_le_of_ne hk h,
      have : 0 < k := lt_of_le_of_lt (nat.zero_le _) ‹m < k›,
      let l := nat.pred k,
      have : k = l+1 := (nat.succ_pred_eq_of_pos ‹0 < k›).symm,
      rw this,
      have : m ≤ l := begin rw this at I, apply nat.le_of_lt_succ I end,
      calc edist (u m) (u (l+1)) ≤ half_pow l + edist (u m) (u (l+1)) : le_add_left (le_refl _)
        ... ≤ 2 * half_pow m : ineq_rec m l ‹m ≤ l› }},
  by_cases h : k ≤ l,
  { calc edist (u k) (u l) ≤ 2 * half_pow k : Imk k l h
      ... ≤ 2 * half_pow N :
        canonically_ordered_semiring.mul_le_mul (le_refl _) (half_pow_mono N k hk) },
  { simp at h,
    calc edist (u k) (u l) = edist (u l) (u k) : edist_comm _ _
      ... ≤ 2 * half_pow l : Imk l k (le_of_lt h)
      ... ≤ 2 * half_pow N :
        canonically_ordered_semiring.mul_le_mul (le_refl _) (half_pow_mono N l hl) }
end

lemma cauchy_seq_of_edist_le_half_pow [emetric_space β]
  {u : ℕ → β} (h : ∀n, edist (u n) (u (n+1)) ≤ half_pow n) : cauchy_seq u :=
begin
  refine emetric.cauchy_seq_iff_le_tendsto_0.2 ⟨λn:ℕ, 2 * half_pow n, ⟨_, _⟩⟩,
  { exact λk l N hk hl, edist_le_two_mul_half_pow hk hl h },
  { have : tendsto (λn, 2 * half_pow n) at_top (nhds (2 * 0)) :=
      ennreal.tendsto_mul_right half_pow_tendsto_zero (by simp),
    simpa using this }
end

end ennreal

namespace sequentially_complete

section
/- We fix a cauchy filter `f`, and a bounding sequence `B` made of positive numbers. We will
prove that, if all sequences satisfying `dist (u n) (u m) < B (min n m)` converge, then
the cauchy filter `f` is converging. The idea is to construct from `f` a Cauchy sequence
that satisfies this property, therefore converges, and then to deduce the convergence of
`f` from this.
We give the argument in the more general setting of emetric spaces, and specialize it to
metric spaces at the end.
-/
variables [emetric_space β] {f : filter β} (hf : cauchy f) (B : ℕ → ennreal) (hB : ∀n, 0 < B n)
open ennreal

/--Auxiliary sequence, which is bounded by `B`, positive, and tends to `0`.-/
noncomputable def B2 (B : ℕ → ennreal) (hB : ∀n, 0 < B n) (n : ℕ) :=
  (half_pow n) ⊓ (B n)

lemma B2_pos (n : ℕ) : 0 < B2 B hB n :=
by unfold B2; simp [half_pow_pos n, hB n]

lemma B2_lim : tendsto (λn, B2 B hB n) at_top (nhds 0) :=
begin
  have : ∀n, B2 B hB n ≤ half_pow n := λn, lattice.inf_le_left,
  exact tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds half_pow_tendsto_zero
    (by simp) (by simp [this])
end

/-- Define a decreasing sequence of sets in the filter `f`, of diameter bounded by `B2 n`. -/
def set_seq_of_cau_filter : ℕ → set β
| 0 := some ((emetric.cauchy_iff.1 hf).2 _ (B2_pos B hB 0))
| (n+1) := (set_seq_of_cau_filter n) ∩ some ((emetric.cauchy_iff.1 hf).2 _ (B2_pos B hB (n + 1)))

/-- These sets are in the filter. -/
lemma set_seq_of_cau_filter_mem_sets : ∀ n, set_seq_of_cau_filter hf B hB n ∈ f
| 0 := some (some_spec ((emetric.cauchy_iff.1 hf).2 _ (B2_pos B hB 0)))
| (n+1) := inter_mem_sets (set_seq_of_cau_filter_mem_sets n)
             (some (some_spec ((emetric.cauchy_iff.1 hf).2 _ (B2_pos B hB (n + 1)))))

/-- These sets are nonempty. -/
lemma set_seq_of_cau_filter_inhabited (n : ℕ) : ∃ x, x ∈ set_seq_of_cau_filter hf B hB n :=
inhabited_of_mem_sets (emetric.cauchy_iff.1 hf).1 (set_seq_of_cau_filter_mem_sets hf B hB n)

/-- By construction, their diameter is controlled by `B2 n`. -/
lemma set_seq_of_cau_filter_spec : ∀ n, ∀ {x y},
  x ∈ set_seq_of_cau_filter hf B hB n → y ∈ set_seq_of_cau_filter hf B hB n → edist x y < B2 B hB n
| 0 := some_spec (some_spec ((emetric.cauchy_iff.1 hf).2 _ (B2_pos B hB 0)))
| (n+1) := λ x y hx hy,
  some_spec (some_spec ((emetric.cauchy_iff.1 hf).2 _ (B2_pos B hB (n+1)))) x y
    (mem_of_mem_inter_right hx) (mem_of_mem_inter_right hy)

-- this must exist somewhere, no?
private lemma mono_of_mono_succ_aux {α} [partial_order α] (f : ℕ → α) (h : ∀ n, f (n+1) ≤ f n) (m : ℕ) :
  ∀ n, f (m + n) ≤ f m
| 0 := le_refl _
| (k+1) := le_trans (h _) (mono_of_mono_succ_aux _)

lemma mono_of_mono_succ {α} [partial_order α] (f : ℕ → α) (h : ∀ n, f (n+1) ≤ f n) {m n : ℕ}
  (hmn : m ≤ n) : f n ≤ f m :=
let ⟨k, hk⟩ := nat.exists_eq_add_of_le hmn in
by simpa [hk] using mono_of_mono_succ_aux f h m k

lemma set_seq_of_cau_filter_monotone' (n : ℕ) :
  set_seq_of_cau_filter hf B hB (n+1) ⊆ set_seq_of_cau_filter hf B hB n :=
inter_subset_left _ _

/-- These sets are nested. -/
lemma set_seq_of_cau_filter_monotone {n k : ℕ} (hle : n ≤ k) :
  set_seq_of_cau_filter hf B hB k ⊆ set_seq_of_cau_filter hf B hB n :=
mono_of_mono_succ (set_seq_of_cau_filter hf B hB) (set_seq_of_cau_filter_monotone' hf B hB) hle

/-- Define the approximating Cauchy sequence for the Cauchy filter `f`,
obtained by taking a point in each set. -/
noncomputable def seq_of_cau_filter (n : ℕ) : β :=
some (set_seq_of_cau_filter_inhabited hf B hB n)

/-- The approximating sequence indeed belong to our good sets. -/
lemma seq_of_cau_filter_mem_set_seq (n : ℕ) : seq_of_cau_filter hf B hB n ∈ set_seq_of_cau_filter hf B hB n :=
some_spec (set_seq_of_cau_filter_inhabited hf B hB n)

/-- The distance between points in the sequence is bounded by `B2 N`. -/
lemma seq_of_cau_filter_bound {N n k : ℕ} (hn : N ≤ n) (hk : N ≤ k) :
  edist (seq_of_cau_filter hf B hB n) (seq_of_cau_filter hf B hB k) < B2 B hB N :=
set_seq_of_cau_filter_spec hf B hB N
  (set_seq_of_cau_filter_monotone hf B hB hn (seq_of_cau_filter_mem_set_seq hf B hB n))
  (set_seq_of_cau_filter_monotone hf B hB hk (seq_of_cau_filter_mem_set_seq hf B hB k))

/-- The approximating sequence is indeed Cauchy as `B2 n` tends to `0` with `n`. -/
lemma seq_of_cau_filter_is_cauchy :
  cauchy_seq (seq_of_cau_filter hf B hB) :=
emetric.cauchy_seq_iff_le_tendsto_0.2 ⟨B2 B hB,
  λ n m N hn hm, le_of_lt (seq_of_cau_filter_bound hf B hB hn hm), B2_lim B hB⟩

/-- If the approximating Cauchy sequence is converging, to a limit `y`, then the
original Cauchy filter `f` is also converging, to the same limit.
Given `t1` in the filter `f` and `t2` a neighborhood of `y`, it suffices to show that `t1 ∩ t2` is
nonempty.
Pick `ε` so that the ε-eball around `y` is contained in `t2`.
Pick `n` with `B2 n < ε/2`, and `n2` such that `dist(seq n2, y) < ε/2`. Let `N = max(n, n2)`.
We defined `seq` by looking at a decreasing sequence of sets of `f` with shrinking radius.
The Nth one has radius `< B2 N < ε/2`. This set is in `f`, so we can find an element `x` that's
also in `t1`.
`dist(x, seq N) < ε/2` since `seq N` is in this set, and `dist (seq N, y) < ε/2`,
so `x` is in the ε-ball around `y`, and thus in `t2`. -/
lemma le_nhds_cau_filter_lim {y : β} (H : tendsto (seq_of_cau_filter hf B hB) at_top (nhds y)) :
  f ≤ nhds y :=
begin
  refine (le_nhds_iff_adhp_of_cauchy hf).2 _,
  refine forall_sets_neq_empty_iff_neq_bot.1 (λs hs, _),
  rcases filter.mem_inf_sets.2 hs with ⟨t1, ht1, t2, ht2, ht1t2⟩,
  rcases emetric.mem_nhds_iff.1 ht2 with ⟨ε, hε, ht2'⟩,
  cases emetric.cauchy_iff.1 hf with hfb _,
  have : ε / 2 > 0 := ennreal.half_pos hε,
  rcases inhabited_of_mem_sets (by simp) ((tendsto_orderable.1 (B2_lim B hB)).2 _ this)
    with ⟨n, hnε⟩,
  simp only [set.mem_set_of_eq] at hnε, -- hnε : ε / 2 > B2 B hB n
  cases (emetric.tendsto_at_top _).1 H _ this with n2 hn2,
  let N := max n n2,
  have ht1sn : t1 ∩ set_seq_of_cau_filter hf B hB N ∈ f,
    from inter_mem_sets ht1 (set_seq_of_cau_filter_mem_sets hf B hB _),
  have hts1n_ne : t1 ∩ set_seq_of_cau_filter hf B hB N ≠ ∅,
    from forall_sets_neq_empty_iff_neq_bot.2 hfb _ ht1sn,
  cases exists_mem_of_ne_empty hts1n_ne with x hx,
  -- x : β,  hx : x ∈ t1 ∩ set_seq_of_cau_filter hf B hB N
  -- we still have to show that x ∈ t2, i.e., edist x y < ε
  have I1 : seq_of_cau_filter hf B hB N ∈ set_seq_of_cau_filter hf B hB n :=
    (set_seq_of_cau_filter_monotone hf B hB (le_max_left n n2)) (seq_of_cau_filter_mem_set_seq hf B hB N),
  have I2 : x ∈ set_seq_of_cau_filter hf B hB n :=
    (set_seq_of_cau_filter_monotone hf B hB (le_max_left n n2)) hx.2,
  have hdist1 : edist x (seq_of_cau_filter hf B hB N) < B2 B hB n :=
    set_seq_of_cau_filter_spec hf B hB _ I2 I1,
  have hdist2 : edist (seq_of_cau_filter hf B hB N) y < ε / 2 :=
    hn2 N (le_max_right _ _),
  have hdist : edist x y < ε := calc
    edist x y ≤ edist x (seq_of_cau_filter hf B hB N) + edist (seq_of_cau_filter hf B hB N) y : edist_triangle _ _ _
          ... < B2 B hB n + ε/2 : ennreal.add_lt_add hdist1 hdist2
          ... ≤ ε/2 + ε/2 : add_le_add_right' (le_of_lt hnε)
          ... = ε : ennreal.add_halves _,
  have hxt2 : x ∈ t2, from ht2' hdist,
  exact ne_empty_iff_exists_mem.2 ⟨x, ht1t2 (mem_inter hx.left hxt2)⟩
end

end
end sequentially_complete

/-- An emetric space in which every Cauchy sequence converges is complete. -/
theorem complete_of_cauchy_seq_tendsto {α : Type u} [emetric_space α]
  (H : ∀u : ℕ → α, cauchy_seq u → ∃x, tendsto u at_top (nhds x)) :
  complete_space α :=
⟨begin
  -- Consider a Cauchy filter `f`
  intros f hf,
  -- Introduce a sequence `u` approximating the filter `f`. We don't need the bound `B`,
  -- so take for instance `B n = 1` for all `n`.
  let u := sequentially_complete.seq_of_cau_filter hf (λn, 1) (λn, ennreal.zero_lt_one),
  -- It is Cauchy.
  have : cauchy_seq u := sequentially_complete.seq_of_cau_filter_is_cauchy hf (λn, 1) (λn, ennreal.zero_lt_one),
  -- Therefore, it converges by assumption. Let `x` be its limit.
  rcases H u this with ⟨x, hx⟩,
  -- The original filter also converges to `x`.
  exact ⟨x, sequentially_complete.le_nhds_cau_filter_lim hf (λn, 1) (λn, ennreal.zero_lt_one) hx⟩
end⟩

/-- A very useful criterion to show that a space is complete is to show that all sequences
which satisfy a bound of the form `edist (u n) (u m) < B N` for all `n m ≥ N` are
converging. This is often applied for `B N = 2^{-N}`, i.e., with a very fast convergence to
`0`, which makes it possible to use arguments of converging series, while this is impossible
to do in general for arbitrary Cauchy sequences. -/
theorem emetric.complete_of_convergent_controlled_sequences {α : Type u} [emetric_space α]
  (B : ℕ → ennreal) (hB : ∀n, 0 < B n)
  (H : ∀u : ℕ → α, (∀N n m : ℕ, N ≤ n → N ≤ m → edist (u n) (u m) < B N) → ∃x, tendsto u at_top (nhds x)) :
  complete_space α :=
⟨begin
  -- Consider a Cauchy filter `f`.
  intros f hf,
  -- Introduce a sequence `u` approximating the filter `f`.
  let u := sequentially_complete.seq_of_cau_filter hf B hB,
  -- It satisfies the required bound.
  have : ∀N n m : ℕ, N ≤ n → N ≤ m → edist (u n) (u m) < B N := λN n m hn hm, calc
    edist (u n) (u m) < sequentially_complete.B2 B hB N :
      sequentially_complete.seq_of_cau_filter_bound hf B hB hn hm
    ... ≤ B N : lattice.inf_le_right,
  -- Therefore, it converges by assumption. Let `x` be its limit.
  rcases H u this with ⟨x, hx⟩,
  -- The original filter also converges to `x`.
  exact ⟨x, sequentially_complete.le_nhds_cau_filter_lim hf B hB hx⟩
end⟩

/-- A very useful criterion to show that a space is complete is to show that all sequences
which satisfy a bound of the form `dist (u n) (u m) < B N` for all `n m ≥ N` are
converging. This is often applied for `B N = 2^{-N}`, i.e., with a very fast convergence to
`0`, which makes it possible to use arguments of converging series, while this is impossible
to do in general for arbitrary Cauchy sequences. -/
theorem metric.complete_of_convergent_controlled_sequences {α : Type u} [metric_space α]
  (B : ℕ → real) (hB : ∀n, 0 < B n)
  (H : ∀u : ℕ → α, (∀N n m : ℕ, N ≤ n → N ≤ m → dist (u n) (u m) < B N) → ∃x, tendsto u at_top (nhds x)) :
  complete_space α :=
begin
  -- this follows from the same criterion in emetric spaces. We just need to translate
  -- the convergence assumption from `dist` to `edist`
  apply emetric.complete_of_convergent_controlled_sequences (λn, ennreal.of_real (B n)),
  { simp [hB] },
  { assume u Hu,
    apply H,
    assume N n m hn hm,
    have Z := Hu N n m hn hm,
    rw [edist_dist, ennreal.of_real_lt_of_real_iff] at Z,
    exact Z,
    exact hB N }
end

section

/- Now, we will apply these results to `cau_seq`, i.e., "Cauchy sequences" defined by a
multiplicative absolute value on normed fields. -/

lemma tendsto_limit [normed_ring β] [hn : is_absolute_value (norm : β → ℝ)]
  (f : cau_seq β norm) [cau_seq.is_complete β norm] :
  tendsto f at_top (nhds f.lim) :=
_root_.tendsto_nhds.mpr
begin
  intros s os lfs,
  suffices : ∃ (a : ℕ), ∀ (b : ℕ), b ≥ a → f b ∈ s, by simpa using this,
  rcases metric.is_open_iff.1 os _ lfs with ⟨ε, ⟨hε, hεs⟩⟩,
  cases setoid.symm (cau_seq.equiv_lim f) _ hε with N hN,
  existsi N,
  intros b hb,
  apply hεs,
  dsimp [metric.ball], rw [dist_comm, dist_eq_norm],
  solve_by_elim
end

variables [normed_field β]

/-
 This section shows that if we have a uniform space generated by an absolute value, topological
 completeness and Cauchy sequence completeness coincide. The problem is that there isn't
 a good notion of "uniform space generated by an absolute value", so right now this is
 specific to norm. Furthermore, norm only instantiates is_absolute_value on normed_field.
 This needs to be fixed, since it prevents showing that ℤ_[hp] is complete
-/

instance normed_field.is_absolute_value : is_absolute_value (norm : β → ℝ) :=
{ abv_nonneg := norm_nonneg,
  abv_eq_zero := norm_eq_zero,
  abv_add := norm_triangle,
  abv_mul := normed_field.norm_mul }

open metric

lemma cauchy_of_filter_cauchy (f : ℕ → β) (hf : cauchy_seq f) :
  is_cau_seq norm f :=
begin
  cases cauchy_iff.1 hf with hf1 hf2,
  intros ε hε,
  rcases hf2 {x | dist x.1 x.2 < ε} (dist_mem_uniformity hε) with ⟨t, ⟨ht, htsub⟩⟩,
  simp at ht, cases ht with N hN,
  existsi N,
  intros j hj,
  rw ←dist_eq_norm,
  apply @htsub (f j, f N),
  apply set.mk_mem_prod; solve_by_elim [le_refl]
end

lemma filter_cauchy_of_cauchy (f : cau_seq β norm) : cauchy_seq f :=
begin
  apply cauchy_iff.2,
  split,
  { exact map_ne_bot at_top_ne_bot },
  { intros s hs,
    rcases mem_uniformity_dist.1 hs with ⟨ε, ⟨hε, hεs⟩⟩,
    cases cau_seq.cauchy₂ f hε with N hN,
    existsi {n | n ≥ N}.image f,
    simp, split,
    { existsi N, intros b hb, existsi b, simp [hb] },
    { rintros ⟨a, b⟩ ⟨⟨a', ⟨ha'1, ha'2⟩⟩, ⟨b', ⟨hb'1, hb'2⟩⟩⟩,
      dsimp at ha'1 ha'2 hb'1 hb'2,
      rw [←ha'2, ←hb'2],
      apply hεs,
      rw dist_eq_norm,
      apply hN; assumption }},
end

/-- In a normed field, `cau_seq` coincides with the usual notion of Cauchy sequences. -/
lemma cau_seq_iff_cauchy_seq {α : Type u} [normed_field α] {u : ℕ → α} :
  is_cau_seq norm u ↔ cauchy_seq u :=
⟨λh, filter_cauchy_of_cauchy ⟨u, h⟩,
 λh, cauchy_of_filter_cauchy u h⟩

/-- A complete normed field is complete as a metric space, as Cauchy sequences converge by
assumption and this suffices to characterize completeness. -/
instance complete_space_of_cau_seq_complete [cau_seq.is_complete β norm] : complete_space β :=
begin
  apply complete_of_cauchy_seq_tendsto,
  assume u hu,
  have C : is_cau_seq norm u := cau_seq_iff_cauchy_seq.2 hu,
  existsi cau_seq.lim ⟨u, C⟩,
  rw metric.tendsto_at_top,
  assume ε εpos,
  cases (cau_seq.equiv_lim ⟨u, C⟩) _ εpos with N hN,
  existsi N,
  simpa [dist_eq_norm] using hN
end

end


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.algebra.subalgebra
import topology.algebra.module

/-!
# Topological (sub)algebras

A topological algebra over a topological semiring `R` is a topological ring with a compatible
continuous scalar multiplication by elements of `R`. We reuse typeclass `has_continuous_smul` for
topological algebras.

## Results

This is just a minimal stub for now!

The topological closure of a subalgebra is still a subalgebra,
which as an algebra is a topological algebra.
-/

open classical set topological_space algebra
open_locale classical

universes u v w

section topological_algebra
variables (R : Type*) [topological_space R] [comm_semiring R]
variables (A : Type u) [topological_space A]
variables [semiring A]

lemma continuous_algebra_map_iff_smul [algebra R A] [topological_ring A] :
  continuous (algebra_map R A) ↔ continuous (λ p : R × A, p.1 • p.2) :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { simp only [algebra.smul_def], exact (h.comp continuous_fst).mul continuous_snd },
  { rw algebra_map_eq_smul_one', exact h.comp (continuous_id.prod_mk continuous_const) }
end

@[continuity]
lemma continuous_algebra_map [algebra R A] [topological_ring A] [has_continuous_smul R A] :
  continuous (algebra_map R A) :=
(continuous_algebra_map_iff_smul R A).2 continuous_smul

lemma has_continuous_smul_of_algebra_map [algebra R A] [topological_ring A]
  (h : continuous (algebra_map R A)) :
  has_continuous_smul R A :=
⟨(continuous_algebra_map_iff_smul R A).1 h⟩

end topological_algebra

section topological_algebra
variables {R : Type*} [comm_semiring R]
variables {A : Type u} [topological_space A]
variables [semiring A]
variables [algebra R A] [topological_ring A]

/-- The closure of a subalgebra in a topological algebra as a subalgebra. -/
def subalgebra.topological_closure (s : subalgebra R A) : subalgebra R A :=
{ carrier := closure (s : set A),
  algebra_map_mem' := λ r, s.to_subsemiring.subring_topological_closure (s.algebra_map_mem r),
  .. s.to_subsemiring.topological_closure }

@[simp] lemma subalgebra.topological_closure_coe (s : subalgebra R A) :
  (s.topological_closure : set A) = closure (s : set A) :=
rfl

instance subalgebra.topological_closure_topological_ring (s : subalgebra R A) :
  topological_ring (s.topological_closure) :=
s.to_subsemiring.topological_closure_topological_ring

instance subalgebra.topological_closure_topological_algebra
  [topological_space R] [has_continuous_smul R A] (s : subalgebra R A) :
  has_continuous_smul R (s.topological_closure) :=
s.to_submodule.topological_closure_has_continuous_smul

lemma subalgebra.subalgebra_topological_closure (s : subalgebra R A) :
  s ≤ s.topological_closure :=
subset_closure

lemma subalgebra.is_closed_topological_closure (s : subalgebra R A) :
  is_closed (s.topological_closure : set A) :=
by convert is_closed_closure

lemma subalgebra.topological_closure_minimal
  (s : subalgebra R A) {t : subalgebra R A} (h : s ≤ t) (ht : is_closed (t : set A)) :
  s.topological_closure ≤ t :=
closure_minimal h ht

/--
This is really a statement about topological algebra isomorphisms,
but we don't have those, so we use the clunky approach of talking about
an algebra homomorphism, and a separate homeomorphism,
along with a witness that as functions they are the same.
-/
lemma subalgebra.topological_closure_comap'_homeomorph
  (s : subalgebra R A)
  {B : Type*} [topological_space B] [ring B] [topological_ring B] [algebra R B]
  (f : B →ₐ[R] A) (f' : B ≃ₜ A) (w : (f : B → A) = f') :
  s.topological_closure.comap' f = (s.comap' f).topological_closure :=
begin
  apply set_like.ext',
  simp only [subalgebra.topological_closure_coe],
  simp only [subalgebra.coe_comap, subsemiring.coe_comap, alg_hom.coe_to_ring_hom],
  rw [w],
  exact f'.preimage_closure _,
end

end topological_algebra


/-
Copyright (c) 2018 Mario Carneiro and Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kevin Buzzard
-/

import data.equiv.algebra
import linear_algebra.linear_combination
import ring_theory.ideal_operations
import ring_theory.subring

open set lattice

namespace submodule
variables {α : Type*} {β : Type*} [ring α] [add_comm_group β] [module α β]

def fg (s : submodule α β) : Prop := ∃ t : finset β, submodule.span α ↑t = s

theorem fg_def {s : submodule α β} :
  s.fg ↔ ∃ t : set β, finite t ∧ span α t = s :=
⟨λ ⟨t, h⟩, ⟨_, finset.finite_to_set t, h⟩, begin
  rintro ⟨t', h, rfl⟩,
  rcases finite.exists_finset_coe h with ⟨t, rfl⟩,
  exact ⟨t, rfl⟩
end⟩

/-- Nakayama's Lemma. Atiyah-Macdonald 2.5, Eisenbud 4.7, Matsumura 2.2, Stacks 00DV -/
theorem exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul {R : Type*} [comm_ring R]
  {M : Type*} [add_comm_group M] [module R M]
  (I : ideal R) (N : submodule R M) (hn : N.fg) (hin : N ≤ I • N) :
  ∃ r : R, r - 1 ∈ I ∧ ∀ n ∈ N, r • n = (0 : M) :=
begin
  rw fg_def at hn, rcases hn with ⟨s, hfs, hs⟩,
  have : ∃ r : R, r - 1 ∈ I ∧ N ≤ (I • span R s).comap (linear_map.lsmul R M r) ∧ s ⊆ N,
  { refine ⟨1, _, _, _⟩,
    { rw sub_self, exact I.zero_mem },
    { rw [hs], intros n hn, rw [mem_coe, mem_comap], change (1:R) • n ∈ I • N, rw one_smul, exact hin hn },
    { rw [← span_le, hs], exact le_refl N } },
  clear hin hs, revert this,
  refine set.finite.dinduction_on hfs (λ H, _) (λ i s his hfs ih H, _),
  { rcases H with ⟨r, hr1, hrn, hs⟩, refine ⟨r, hr1, λ n hn, _⟩, specialize hrn hn,
    rwa [mem_coe, mem_comap, span_empty, smul_bot, mem_bot] at hrn },
  apply ih, rcases H with ⟨r, hr1, hrn, hs⟩,
  rw [← set.singleton_union, span_union, smul_sup] at hrn,
  rw [set.insert_subset] at hs,
  have : ∃ c : R, c - 1 ∈ I ∧ c • i ∈ I • span R s,
  { specialize hrn hs.1, rw [mem_coe, mem_comap, mem_sup] at hrn,
    rcases hrn with ⟨y, hy, z, hz, hyz⟩, change y + z = r • i at hyz,
    rw mem_smul_span_singleton at hy, rcases hy with ⟨c, hci, rfl⟩,
    use r-c, split,
    { rw [sub_right_comm], exact I.sub_mem hr1 hci },
    { rw [sub_smul, ← hyz, add_sub_cancel'], exact hz } },
  rcases this with ⟨c, hc1, hci⟩, refine ⟨c * r, _, _, hs.2⟩,
  { rw [← ideal.quotient.eq, ideal.quotient.mk_one] at hr1 hc1 ⊢,
    rw [ideal.quotient.mk_mul, hc1, hr1, mul_one] },
  { intros n hn, specialize hrn hn, rw [mem_coe, mem_comap, mem_sup] at hrn,
    rcases hrn with ⟨y, hy, z, hz, hyz⟩, change y + z = r • n at hyz,
    rw mem_smul_span_singleton at hy, rcases hy with ⟨d, hdi, rfl⟩,
    change _ • _ ∈ I • span R s,
    rw [mul_smul, ← hyz, smul_add, smul_smul, mul_comm, mul_smul],
    exact add_mem _ (smul_mem _ _ hci) (smul_mem _ _ hz) }
end

theorem fg_bot : (⊥ : submodule α β).fg :=
⟨∅, by rw [finset.coe_empty, span_empty]⟩

theorem fg_sup {s₁ s₂ : submodule α β}
  (hs₁ : s₁.fg) (hs₂ : s₂.fg) : (s₁ ⊔ s₂).fg :=
let ⟨t₁, ht₁⟩ := fg_def.1 hs₁, ⟨t₂, ht₂⟩ := fg_def.1 hs₂ in
fg_def.2 ⟨t₁ ∪ t₂, finite_union ht₁.1 ht₂.1, by rw [span_union, ht₁.2, ht₂.2]⟩

variables {γ : Type*} [add_comm_group γ] [module α γ]
variables {f : β →ₗ[α] γ}

theorem fg_map {s : submodule α β} (hs : s.fg) : (s.map f).fg :=
let ⟨t, ht⟩ := fg_def.1 hs in fg_def.2 ⟨f '' t, finite_image _ ht.1, by rw [span_image, ht.2]⟩

theorem fg_prod {sb : submodule α β} {sc : submodule α γ}
  (hsb : sb.fg) (hsc : sc.fg) : (sb.prod sc).fg :=
let ⟨tb, htb⟩ := fg_def.1 hsb, ⟨tc, htc⟩ := fg_def.1 hsc in
fg_def.2 ⟨prod.inl '' tb ∪ prod.inr '' tc,
  finite_union (finite_image _ htb.1) (finite_image _ htc.1),
  by rw [linear_map.span_inl_union_inr, htb.2, htc.2]⟩

variable (f)
/-- If 0 → M' → M → M'' → 0 is exact and M' and M'' are
finitely generated then so is M. -/
theorem fg_of_fg_map_of_fg_inf_ker {s : submodule α β}
  (hs1 : (s.map f).fg) (hs2 : (s ⊓ f.ker).fg) : s.fg :=
begin
  haveI := classical.dec_eq β, haveI := classical.dec_eq γ,
  cases hs1 with t1 ht1, cases hs2 with t2 ht2,
  have : ∀ y ∈ t1, ∃ x ∈ s, f x = y,
  { intros y hy,
    have : y ∈ map f s, { rw ← ht1, exact subset_span hy },
    rcases mem_map.1 this with ⟨x, hx1, hx2⟩,
    exact ⟨x, hx1, hx2⟩ },
  have : ∃ g : γ → β, ∀ y ∈ t1, g y ∈ s ∧ f (g y) = y,
  { choose g hg1 hg2,
    existsi λ y, if H : y ∈ t1 then g y H else 0,
    intros y H, split,
    { simp only [dif_pos H], apply hg1 },
    { simp only [dif_pos H], apply hg2 } },
  cases this with g hg, clear this,
  existsi t1.image g ∪ t2,
  rw [finset.coe_union, span_union, finset.coe_image],
  apply le_antisymm,
  { refine sup_le (span_le.2 $ image_subset_iff.2 _) (span_le.2 _),
    { intros y hy, exact (hg y hy).1 },
    { intros x hx, have := subset_span hx,
      rw ht2 at this,
      exact this.1 } },
  intros x hx,
  have : f x ∈ map f s, { rw mem_map, exact ⟨x, hx, rfl⟩ },
  rw [← ht1, mem_span_iff_lc] at this,
  rcases this with ⟨l, hl1, hl2⟩,
  refine mem_sup.2 ⟨lc.total α β ((lc.map α g : lc α γ → lc α β) l), _,
    x - lc.total α β ((lc.map α g : lc α γ → lc α β) l), _, add_sub_cancel'_right _ _⟩,
  { rw mem_span_iff_lc, refine ⟨_, _, rfl⟩,
    rw [← lc.map_supported g, mem_map],
    exact ⟨_, hl1, rfl⟩ },
  rw [ht2, mem_inf], split,
  { apply s.sub_mem hx,
    rw [lc.total_apply, lc.map_apply, finsupp.sum_map_domain_index],
    refine s.sum_mem _,
    { intros y hy, exact s.smul_mem _ (hg y (hl1 hy)).1 },
    { exact zero_smul _ }, { exact λ _ _ _, add_smul _ _ _ } },
  { rw [linear_map.mem_ker, f.map_sub, ← hl2],
    rw [lc.total_apply, lc.total_apply, lc.map_apply],
    rw [finsupp.sum_map_domain_index, finsupp.sum, finsupp.sum, f.map_sum],
    rw sub_eq_zero,
    refine finset.sum_congr rfl (λ y hy, _),
    rw [f.map_smul, (hg y (hl1 hy)).2],
    { exact zero_smul _ }, { exact λ _ _ _, add_smul _ _ _ } }
end

end submodule

class is_noetherian (α β) [ring α] [add_comm_group β] [module α β] : Prop :=
(noetherian : ∀ (s : submodule α β), s.fg)

section
variables {α : Type*} {β : Type*} {γ : Type*}
variables [ring α] [add_comm_group β] [add_comm_group γ]
variables [module α β] [module α γ]
open is_noetherian
include α

theorem is_noetherian_submodule {N : submodule α β} :
  is_noetherian α N ↔ ∀ s : submodule α β, s ≤ N → s.fg :=
⟨λ ⟨hn⟩, λ s hs, have s ≤ N.subtype.range, from (N.range_subtype).symm ▸ hs,
  linear_map.map_comap_eq_self this ▸ submodule.fg_map (hn _),
λ h, ⟨λ s, submodule.fg_of_fg_map_of_fg_inf_ker N.subtype (h _ $ submodule.map_subtype_le _ _) $
  by rw [submodule.ker_subtype, inf_bot_eq]; exact submodule.fg_bot⟩⟩

theorem is_noetherian_submodule_left {N : submodule α β} :
  is_noetherian α N ↔ ∀ s : submodule α β, (N ⊓ s).fg :=
is_noetherian_submodule.trans
⟨λ H s, H _ inf_le_left, λ H s hs, (inf_of_le_right hs) ▸ H _⟩

theorem is_noetherian_submodule_right {N : submodule α β} :
  is_noetherian α N ↔ ∀ s : submodule α β, (s ⊓ N).fg :=
is_noetherian_submodule.trans
⟨λ H s, H _ inf_le_right, λ H s hs, (inf_of_le_left hs) ▸ H _⟩

variable (β)
theorem is_noetherian_of_surjective (f : β →ₗ[α] γ) (hf : f.range = ⊤)
  [is_noetherian α β] : is_noetherian α γ :=
⟨λ s, have (s.comap f).map f = s, from linear_map.map_comap_eq_self $ hf.symm ▸ le_top,
this ▸ submodule.fg_map $ noetherian _⟩
variable {β}

theorem is_noetherian_of_linear_equiv (f : β ≃ₗ[α] γ)
  [is_noetherian α β] : is_noetherian α γ :=
is_noetherian_of_surjective _ f.to_linear_map f.range

instance is_noetherian_prod [is_noetherian α β]
  [is_noetherian α γ] : is_noetherian α (β × γ) :=
⟨λ s, submodule.fg_of_fg_map_of_fg_inf_ker (linear_map.snd α β γ) (noetherian _) $
have s ⊓ linear_map.ker (linear_map.snd α β γ) ≤ linear_map.range (linear_map.inl α β γ),
from λ x ⟨hx1, hx2⟩, ⟨x.1, trivial, prod.ext rfl $ eq.symm $ linear_map.mem_ker.1 hx2⟩,
linear_map.map_comap_eq_self this ▸ submodule.fg_map (noetherian _)⟩

instance is_noetherian_pi {α ι : Type*} {β : ι → Type*} [ring α]
  [Π i, add_comm_group (β i)] [Π i, module α (β i)] [fintype ι]
  [∀ i, is_noetherian α (β i)] : is_noetherian α (Π i, β i) :=
begin
  haveI := classical.dec_eq ι,
  suffices : ∀ s : finset ι, is_noetherian α (Π i : (↑s : set ι), β i),
  { letI := this finset.univ,
    refine @is_noetherian_of_linear_equiv _ _ _ _ _ _ _ _
      ⟨_, _, _, _, _, _⟩ (this finset.univ),
    { exact λ f i, f ⟨i, finset.mem_univ _⟩ },
    { intros, ext, refl },
    { intros, ext, refl },
    { exact λ f i, f i.1 },
    { intro, ext i, cases i, refl },
    { intro, ext i, refl } },
  intro s,
  induction s using finset.induction with a s has ih,
  { split, intro s, convert submodule.fg_bot, apply eq_bot_iff.2,
    intros x hx, refine (submodule.mem_bot α).2 _, ext i, cases i.2 },
  refine @is_noetherian_of_linear_equiv _ _ _ _ _ _ _ _
    ⟨_, _, _, _, _, _⟩ (@is_noetherian_prod _ (β a) _ _ _ _ _ _ _ ih),
  { exact λ f i, or.by_cases (finset.mem_insert.1 i.2)
      (λ h : i.1 = a, show β i.1, from (eq.rec_on h.symm f.1))
      (λ h : i.1 ∈ s, show β i.1, from f.2 ⟨i.1, h⟩) },
  { intros f g, ext i, unfold or.by_cases, cases i with i hi,
    rcases finset.mem_insert.1 hi with rfl | h,
    { change _ = _ + _, simp only [dif_pos], refl },
    { change _ = _ + _, have : ¬i = a, { rintro rfl, exact has h },
      simp only [dif_neg this, dif_pos h], refl } },
  { intros c f, ext i, unfold or.by_cases, cases i with i hi,
    rcases finset.mem_insert.1 hi with rfl | h,
    { change _ = c • _, simp only [dif_pos], refl },
    { change _ = c • _, have : ¬i = a, { rintro rfl, exact has h },
      simp only [dif_neg this, dif_pos h], refl } },
  { exact λ f, (f ⟨a, finset.mem_insert_self _ _⟩, λ i, f ⟨i.1, finset.mem_insert_of_mem i.2⟩) },
  { intro f, apply prod.ext,
    { simp only [or.by_cases, dif_pos] },
    { ext i, cases i with i his,
      have : ¬i = a, { rintro rfl, exact has his },
      dsimp only [or.by_cases], change i ∈ s at his,
      rw [dif_neg this, dif_pos his] } },
  { intro f, ext i, cases i with i hi,
    rcases finset.mem_insert.1 hi with rfl | h,
    { simp only [or.by_cases, dif_pos], refl },
    { have : ¬i = a, { rintro rfl, exact has h },
      simp only [or.by_cases, dif_neg this, dif_pos h], refl } }
end

end

open is_noetherian

theorem is_noetherian_iff_well_founded
  {α β} [ring α] [add_comm_group β] [module α β] :
  is_noetherian α β ↔ well_founded ((>) : submodule α β → submodule α β → Prop) :=
⟨λ h, begin
  apply order_embedding.well_founded_iff_no_descending_seq.2,
  swap, { apply is_strict_order.swap },
  rintro ⟨⟨N, hN⟩⟩,
  let M := ⨆ n, N n,
  resetI,
  rcases submodule.fg_def.1 (noetherian M) with ⟨t, h₁, h₂⟩,
  have hN' : ∀ {a b}, a ≤ b → N a ≤ N b :=
    λ a b, (le_iff_le_of_strict_mono N (λ _ _, hN.1)).2,
  have : t ⊆ ⋃ i, (N i : set β),
  { rw [← submodule.Union_coe_of_directed _ N _],
    { show t ⊆ M, rw ← h₂,
      apply submodule.subset_span },
    { apply_instance },
    { exact λ i j, ⟨max i j,
        hN' (le_max_left _ _),
        hN' (le_max_right _ _)⟩ } },
  simp [subset_def] at this,
  choose f hf using show ∀ x : t, ∃ (i : ℕ), x.1 ∈ N i, { simpa },
  cases h₁ with h₁,
  let A := finset.sup (@finset.univ t h₁) f,
  have : M ≤ N A,
  { rw ← h₂, apply submodule.span_le.2,
    exact λ x h, hN' (finset.le_sup (@finset.mem_univ t h₁ _))
      (hf ⟨x, h⟩) },
  exact not_le_of_lt (hN.1 (nat.lt_succ_self A))
    (le_trans (le_supr _ _) this)
  end,
  begin
    assume h, split, assume N,
    suffices : ∀ M ≤ N, ∃ s, finite s ∧ M ⊔ submodule.span α s = N,
    { rcases this ⊥ bot_le with ⟨s, hs, e⟩,
      exact submodule.fg_def.2 ⟨s, hs, by simpa using e⟩ },
    refine λ M, h.induction M _, intros M IH MN,
    letI := classical.dec,
    by_cases h : ∀ x, x ∈ N → x ∈ M,
    { cases le_antisymm MN h, exact ⟨∅, by simp⟩ },
    { simp [not_forall] at h,
      rcases h with ⟨x, h, h₂⟩,
      have : ¬M ⊔ submodule.span α {x} ≤ M,
      { intro hn, apply h₂,
        have := le_trans le_sup_right hn,
        exact submodule.span_le.1 this (mem_singleton x) },
      rcases IH (M ⊔ submodule.span α {x})
        ⟨@le_sup_left _ _ M _, this⟩
        (sup_le MN (submodule.span_le.2 (by simpa))) with ⟨s, hs, hs₂⟩,
      refine ⟨insert x s, finite_insert _ hs, _⟩,
      rw [← hs₂, sup_assoc, ← submodule.span_union], simp }
  end⟩

lemma well_founded_submodule_gt {α β} [ring α] [add_comm_group β] [module α β] :
  ∀ [is_noetherian α β], well_founded ((>) : submodule α β → submodule α β → Prop) :=
is_noetherian_iff_well_founded.mp

@[class] def is_noetherian_ring (α) [ring α] : Prop := is_noetherian α α

instance is_noetherian_ring.to_is_noetherian {α : Type*} [ring α] :
  ∀ [is_noetherian_ring α], is_noetherian α α := id

instance ring.is_noetherian_of_fintype (R M) [ring R] [add_comm_group M] [module R M] [fintype M] : is_noetherian R M :=
by letI := classical.dec; exact
⟨assume s, ⟨to_finset s, by rw [finset.coe_to_finset', submodule.span_eq]⟩⟩

theorem ring.is_noetherian_of_zero_eq_one {R} [ring R] (h01 : (0 : R) = 1) : is_noetherian_ring R :=
by haveI := subsingleton_of_zero_eq_one R h01;
   haveI := fintype.of_subsingleton (0:R);
   exact ring.is_noetherian_of_fintype _ _

theorem is_noetherian_of_submodule_of_noetherian (R M) [ring R] [add_comm_group M] [module R M] (N : submodule R M)
  (h : is_noetherian R M) : is_noetherian R N :=
begin
  rw is_noetherian_iff_well_founded at h ⊢,
  convert order_embedding.well_founded (order_embedding.rsymm (submodule.map_subtype.lt_order_embedding N)) h
end

theorem is_noetherian_of_quotient_of_noetherian (R) [ring R] (M) [add_comm_group M] [module R M] (N : submodule R M)
  (h : is_noetherian R M) : is_noetherian R N.quotient :=
begin
  rw is_noetherian_iff_well_founded at h ⊢,
  convert order_embedding.well_founded (order_embedding.rsymm (submodule.comap_mkq.lt_order_embedding N)) h
end

theorem is_noetherian_of_fg_of_noetherian {R M} [ring R] [add_comm_group M] [module R M] (N : submodule R M)
  [is_noetherian_ring R] (hN : N.fg) : is_noetherian R N :=
let ⟨s, hs⟩ := hN in
begin
  haveI := classical.dec_eq M,
  letI : is_noetherian R R := by apply_instance,
  have : ∀ x ∈ s, x ∈ N, from λ x hx, hs ▸ submodule.subset_span hx,
  refine @@is_noetherian_of_surjective ((↑s : set M) → R) _ _ _ (pi.module _)
    _ _ _ is_noetherian_pi,
  { fapply linear_map.mk,
    { exact λ f, ⟨s.attach.sum (λ i, f i • i.1), N.sum_mem (λ c _, N.smul_mem _ $ this _ c.2)⟩ },
    { intros f g, apply subtype.eq,
      change s.attach.sum (λ i, (f i + g i) • _) = _,
      simp only [add_smul, finset.sum_add_distrib], refl },
    { intros c f, apply subtype.eq,
      change s.attach.sum (λ i, (c • f i) • _) = _,
      simp only [smul_eq_mul, mul_smul],
      exact finset.sum_hom _ } },
  rw linear_map.range_eq_top,
  rintro ⟨n, hn⟩, change n ∈ N at hn,
  rw [← hs, mem_span_iff_lc] at hn,
  rcases hn with ⟨l, hl1, hl2⟩,
  refine ⟨λ x, l x.1, subtype.eq _⟩,
  change s.attach.sum (λ i, l i.1 • i.1) = n,
  rw [@finset.sum_attach M M s _ (λ i, l i • i), ← hl2,
      lc.total_apply, finsupp.sum, eq_comm],
  refine finset.sum_subset hl1 (λ x _ hx, _),
  rw [finsupp.not_mem_support_iff.1 hx, zero_smul]
end

theorem is_noetherian_ring_of_surjective (R) [comm_ring R] (S) [comm_ring S]
  (f : R → S) [is_ring_hom f] (hf : function.surjective f)
  [H : is_noetherian_ring R] : is_noetherian_ring S :=
begin
  unfold is_noetherian_ring at H ⊢,
  rw is_noetherian_iff_well_founded at H ⊢,
  convert order_embedding.well_founded (order_embedding.rsymm (ideal.lt_order_embedding_of_surjective f hf)) H
end

instance is_noetherian_ring_range {R} [comm_ring R] {S} [comm_ring S] (f : R → S) [is_ring_hom f]
  [is_noetherian_ring R] : is_noetherian_ring (set.range f) :=
@is_noetherian_ring_of_surjective R _ (set.range f) _ (λ x, ⟨f x, x, rfl⟩)
  (⟨subtype.eq (is_ring_hom.map_one f),
    λ _ _, subtype.eq (is_ring_hom.map_mul f),
    λ _ _, subtype.eq (is_ring_hom.map_add f)⟩)
  (λ ⟨x, y, hy⟩, ⟨y, subtype.eq hy⟩) _

theorem is_noetherian_ring_of_ring_equiv (R) [comm_ring R] {S} [comm_ring S]
  (f : R ≃r S) [is_noetherian_ring R] : is_noetherian_ring S :=
is_noetherian_ring_of_surjective R S f.1 f.1.surjective

namespace is_noetherian_ring

variables {α : Type*} [integral_domain α] [is_noetherian_ring α]
open associates nat

local attribute [elab_as_eliminator] well_founded.fix

lemma well_founded_dvd_not_unit : well_founded (λ a b : α, a ≠ 0 ∧ ∃ x, ¬is_unit x ∧ b = a * x ) :=
by simp only [ideal.span_singleton_lt_span_singleton.symm];
   exact inv_image.wf (λ a, ideal.span ({a} : set α)) well_founded_submodule_gt

lemma exists_irreducible_factor {a : α} (ha : ¬ is_unit a) (ha0 : a ≠ 0) :
  ∃ i, irreducible i ∧ i ∣ a :=
(irreducible_or_factor a ha).elim (λ hai, ⟨a, hai, dvd_refl _⟩)
  (well_founded.fix
    well_founded_dvd_not_unit
    (λ a ih ha ha0 ⟨x, y, hx, hy, hxy⟩,
      have hx0 : x ≠ 0, from λ hx0, ha0 (by rw [← hxy, hx0, zero_mul]),
      (irreducible_or_factor x hx).elim
        (λ hxi, ⟨x, hxi, hxy ▸ by simp⟩)
        (λ hxf, let ⟨i, hi⟩ := ih x ⟨hx0, y, hy, hxy.symm⟩ hx hx0 hxf in
          ⟨i, hi.1, dvd.trans hi.2 (hxy ▸ by simp)⟩)) a ha ha0)

@[elab_as_eliminator] lemma irreducible_induction_on {P : α → Prop} (a : α)
  (h0 : P 0) (hu : ∀ u : α, is_unit u → P u)
  (hi : ∀ a i : α, a ≠ 0 → irreducible i → P a → P (i * a)) :
  P a :=
by haveI := classical.dec; exact
well_founded.fix well_founded_dvd_not_unit
  (λ a ih, if ha0 : a = 0 then ha0.symm ▸ h0
    else if hau : is_unit a then hu a hau
    else let ⟨i, hii, ⟨b, hb⟩⟩ := exists_irreducible_factor hau ha0 in
      have hb0 : b ≠ 0, from λ hb0, by simp * at *,
      hb.symm ▸ hi _ _ hb0 hii (ih _ ⟨hb0, i,
        hii.1, by rw [hb, mul_comm]⟩))
  a

lemma exists_factors (a : α) : a ≠ 0 →
  ∃f:multiset α, (∀b∈f, irreducible b) ∧ associated a f.prod :=
is_noetherian_ring.irreducible_induction_on a
  (λ h, (h rfl).elim)
  (λ u hu _, ⟨0, by simp [associated_one_iff_is_unit, hu]⟩)
  (λ a i ha0 hii ih hia0,
    let ⟨s, hs⟩ := ih ha0 in
    ⟨i::s, ⟨by clear _let_match; finish,
      by rw multiset.prod_cons;
        exact associated_mul_mul (by refl) hs.2⟩⟩)

end is_noetherian_ring


/-
  The lemmas in this file may be soon be in mathlib, if not already
-/

import data.list.basic
import data.int.basic
import tactic.ring
import tactic.linarith

open list nat int

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

lemma reverse_range'_map_range' (a b : ℕ) : reverse (range' a (b+1-a)) = map (λ i, a+b-i) (range' a (b+1-a)) :=
begin
  rw [reverse_range', range'_eq_map_range, list.map_map],
  apply map_congr, intros i H,
  simp at *,
  rw [nat.add_sub_add_left, nat.add_sub_cancel'], {refl},
  apply le_of_not_le (λ h, _),
  rw sub_eq_zero_of_le h at H,
  exact not_lt_zero _ H
end

lemma filter_ext {α : Type*} {r: list α} (P P') [decidable_pred P] [decidable_pred P']
  (HP : ∀ i ∈ r, P i = P' i) : filter P r = filter P' r :=
begin
  induction r with h t IH,
  { simp },
  { have HPh : P h = P' h := HP h (by simp),
    have : ∀ (i : α), i ∈ t → P i = P' i,
    { intros i i_t,
      exact (HP i $ by simp [i_t]) },
    by_cases H : P h,
    { have H' : P' h := HPh ▸ H,
      simp [H, H', IH this] },
    { have H' : ¬ P' h := HPh ▸ H,
      simp [H, H', IH this] } }
end

lemma foldr_congr' {α : Type*} {β : Type*} {l : list α} (f f' : α → β → β) (s : β)
  (H : ∀ a ∈ l, ∀ b : β, f a b = f' a b) : foldr f s l = foldr f' s l :=
by induction l; simp * {contextual := tt}

lemma range'_add_map (a b k : ℕ) : range' (a+k) b = map (λ x, x + k) (range' a b) :=
begin
  revert a,
  induction b with b IH; intro a,
  { refl },
  { simpa using (IH $ a + 1) }
end

lemma range'_sub_map (a b k : ℕ) : range' a b = map (λ x, x - k) (range' (a+k) b) :=
begin
  suffices : (λ (x : ℕ), x - k) ∘ (λ (x : ℕ), x + k) = id,
  { rw [range'_add_map, list.map_map, this, map_id] },
  { funext, simp [nat.add_sub_cancel_left] }
end

lemma filter_map_comm {I : Type*} {J : Type*} (f : I → J) (P : J → Prop) (r: list I) [decidable_pred P] :
  filter P (map f r) = map f (filter (P ∘ f) r) :=
begin
  induction r with h _ IH,
  { simp },
  { by_cases H : P (f h) ; simp [filter_cons_of_pos, filter_cons_of_neg, H, IH] }
end

lemma list.eq_nil_iff_not_mem {α : Type*} (l : list α) : l = [] ↔ ∀ x, x ∉ l :=
⟨λ h, by simp[h],
  begin
    intro H,
    cases l with h t,
    refl,
    exfalso,
    specialize H h,
    have : h ∈ list.cons h t, by simp,
    exact H this
  end⟩

lemma list.range_eq_nil (n : ℕ) : list.range n = [] ↔ n = 0 :=
begin
  rw list.eq_nil_iff_not_mem,
  simp [mem_range],
  split ; intro h,
  { exact eq_zero_of_le_zero (h 0) },
  { rw h,
    exact nat.zero_le }
end

@[simp]
lemma to_nat_zero : to_nat 0 = 0 := rfl

lemma to_nat_eq_zero (a) : to_nat a = 0 ↔ a ≤ 0 :=
begin
  induction a with n,
  { change n = 0 ↔ of_nat n ≤ 0,
    split ; intro h,
    { rw h,
      refl },
    { apply eq_zero_of_le_zero,
      rwa ←coe_nat_le_coe_nat_iff n 0 } },
  { simp[to_nat] },
end

lemma to_nat_sub_eq_zero (a b : ℤ) : to_nat (b - a) = 0 ↔ b ≤ a :=
by rw [←sub_nonpos, to_nat_eq_zero]

lemma int.range_eq_nil (a b) : int.range a b = [] ↔ b ≤ a :=
by unfold int.range ; rw [list.map_eq_nil, list.range_eq_nil, to_nat_sub_eq_zero]

lemma int.range_shift (a b k) : int.range (a+k) (b+k) = map (λ x, x+k) (int.range a b) :=
begin
  unfold int.range,
  rw [list.map_map, show b + k - (a + k) = b - a , by ring],
  congr,
  ext n,
  simp
end

lemma reverse_int_range_map_int_range (a b) : reverse (int.range a b) = map (λ i, a+b-i-(1 : ℤ)) (int.range a b) :=
begin
  by_cases h : a ≤ b,
  { unfold int.range,
    rw [←list.map_reverse, range_eq_range', reverse_range'],
    repeat { rw list.map_map },
    change map (λ (x : ℕ), a + ↑(0 + to_nat (b - a) - 1 - x)) (range (to_nat (b - a))) =
      map (λ (x : ℕ), a + b - (a + x) - 1) (range' 0 (to_nat (b - a))),
    rw [zero_add, range_eq_range'],
    apply map_congr,
    intros n n_in,
    have n_lt := (list.mem_range'.1 n_in).right,
    rw zero_add at n_lt,
    have key : ↑(to_nat (b - a) - 1 - n) = b - a - 1 - n,
    { rw [nat.sub_sub, int.coe_nat_sub, to_nat_of_nonneg (sub_nonneg_of_le h), int.coe_nat_add],
      simp,
      linarith },
    rw key,
    ring },
   { rw (int.range_eq_nil a b).2 (le_of_not_le h),
     simp }
end

lemma to_nat_succ {a : ℤ} (h : 0 ≤ a) : to_nat a + 1 = to_nat (a+1) :=
begin
  cases a,
  { refl },
  { exfalso,
    exact h }
end

lemma int_range_eq_concat {a b} (h : a < b) : int.range a b = concat (int.range a (b-1)) (b-1) :=
begin
  unfold int.range,
  have h' : 0 ≤ b - a - 1, by have := add_one_le_of_lt h ; linarith,
  have : b - 1 = (λ (r : ℕ), a + ↑r) (to_nat (b - a-1)),
  { change b - 1 = a + ↑(to_nat (b - a - 1)),
    rw to_nat_of_nonneg h',
    ring },
  rw [this, ←map_concat],
  congr,
  simp only [function.comp_app],
  rw [to_nat_of_nonneg h', concat_eq_append, show a + (b - a - 1) - a = b - a - 1, by simp],
  convert list.range_concat _,
  rw to_nat_succ h',
  congr,
  ring
end

@[simp]
protected lemma int.length_range (a b) : length (int.range a b) = to_nat (b-a) :=
by unfold int.range ; rw [length_map, length_range]

@[simp]
lemma nth_le_int_range (a b n h) : nth_le (int.range a b) n h = a + n :=
begin
  unfold int.range,
  rw nth_le_map,
  { simp },
  { simpa using h }
end

@[simp]
lemma filter_mem {α : Type*} (l : list α) [decidable_pred (λ i, i ∈ l)] :
  filter (λ i, i ∈ l) l = l :=
by simp [filter_eq_self.2]

@[simp]
lemma filter_true {α : Type*} (l : list α) : filter (λ i, true) l = l :=
by simp [filter_eq_self.2]

lemma nth_le_cons {α : Type*} (a : α) (t n h) :
  nth_le (a :: t) (n+1) h = nth_le t n (lt_of_succ_lt_succ h) := rfl


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.sqrt
import Mathlib.PostPort

namespace Mathlib

namespace int

/-- `sqrt n` is the square root of an integer `n`. If `n` is not a
  perfect square, and is positive, it returns the largest `k:ℤ` such
  that `k*k ≤ n`. If it is negative, it returns 0. For example,
  `sqrt 2 = 1` and `sqrt 1 = 1` and `sqrt (-1) = 0` -/
def sqrt (n : ℤ) : ℤ := ↑(nat.sqrt (to_nat n))

theorem sqrt_eq (n : ℤ) : sqrt (n * n) = ↑(nat_abs n) := sorry

theorem exists_mul_self (x : ℤ) : (∃ (n : ℤ), n * n = x) ↔ sqrt x * sqrt x = x := sorry

theorem sqrt_nonneg (n : ℤ) : 0 ≤ sqrt n := coe_nat_nonneg (nat.sqrt (to_nat n))

end Mathlib