/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import data.polynomial.degree.lemmas

/-! # `compute_degree_le` a tactic for computing degrees of polynomials

This file defines the tactic `compute_degree_le`.

Using `compute_degree_le` when the goal is of the form `f.nat_degree ≤ d`, tries to solve the goal.
It may leave side-goals, in case it is not entirely successful.

See the doc-string for more details.

##  Future work

* Deal with goals of the form `f.(nat_)degree = d` (PR #14040 does exactly this).
* Add better functionality to deal with exponents that are not necessarily closed natural numbers.
* Add support for proving goals of the from `f.(nat_)degree ≠ 0`.
* Make sure that `degree` and `nat_degree` are equally supported.

##  Implementation details

We start with a goal of the form `f.(nat_)degree ≤ d`.  Recurse into `f` breaking apart sums,
products and powers.  Take care of numerals, `C a, X (^ n), monomial a n` separately. -/

namespace tactic
namespace compute_degree
open expr polynomial

/--  `guess_degree e` assumes that `e` is an expression in a polynomial ring, and makes an attempt
at guessing the `nat_degree` of `e`.  Heuristics for `guess_degree`:
* `0, 1, C a`,      guess `0`,
* `polynomial.X`,   guess `1`,
*  `bit0/1 f, -f`,  guess `guess_degree f`,
* `f + g, f - g`,   guess `max (guess_degree f) (guess_degree g)`,
* `f * g`,          guess `guess_degree f + guess_degree g`,
* `f ^ n`,          guess `guess_degree f * n`,
* `monomial n r`,   guess `n`,
* `f` not as above, guess `f.nat_degree`.

The guessed degree should coincide with the behaviour of `resolve_sum_step`:
`resolve_sum_step` cannot solve a goal `f.nat_degree ≤ d` if `guess_degree f < d`.
 -/
meta def guess_degree : expr → tactic expr
| `(has_zero.zero)           := pure `(0)
| `(has_one.one)             := pure `(0)
| `(- %%f)                   := guess_degree f
| (app `(⇑C) x)              := pure `(0)
| `(X)                       := pure `(1)
| `(bit0 %%a)                := guess_degree a
| `(bit1 %%a)                := guess_degree a
| `(%%a + %%b)               := do [da, db] ← [a, b].mmap guess_degree,
                                pure $ expr.mk_app `(max : ℕ → ℕ → ℕ) [da, db]
| `(%%a - %%b)               := do [da, db] ← [a, b].mmap guess_degree,
                                pure $ expr.mk_app `(max : ℕ → ℕ → ℕ) [da, db]
| `(%%a * %%b)               := do [da, db] ← [a, b].mmap guess_degree,
                                pure $ expr.mk_app `((+) : ℕ → ℕ → ℕ) [da, db]
| `(%%a ^ %%b)               := do da ← guess_degree a,
                                pure $ expr.mk_app `((*) : ℕ → ℕ → ℕ) [da, b]
| (app `(⇑(monomial %%n)) x) := pure n
| e                          := do `(@polynomial %%R %%inst) ← infer_type e,
                                pe ← to_expr ``(@nat_degree %%R %%inst) tt ff,
                                pure $ expr.mk_app pe [e]

/-- `resolve_sum_step` assumes that the current goal is of the form `f.nat_degree ≤ d`, failing
otherwise.  It tries to make progress on the goal by progressing into `f` if `f` is
* a sum, difference, opposite, product, or a power;
* a monomial;
* `C a`;
* `0, 1` or `bit0 a, bit1 a` (to deal with numerals).

The side-goals produced by `resolve_sum_step` are either again of the same shape `f'.nat_degree ≤ d`
or of the form `m ≤ n`, where `m n : ℕ`.

If `d` is less than `guess_degree f`, this tactic will create unsolvable goals.
-/
meta def resolve_sum_step : tactic unit := do
t ← target >>= instantiate_mvars,
`(nat_degree %%tl ≤ %%tr) ← whnf t reducible | fail!("Goal is not of the form `f.nat_degree ≤ d`"),
match tl with
| `(%%tl1 + %%tl2) := refine ``((nat_degree_add_le_iff_left _ _ _).mpr _)
| `(%%tl1 - %%tl2) := refine ``((nat_degree_sub_le_iff_left _).mpr _)
| `(%%tl1 * %%tl2) := do [d1, d2] ← [tl1, tl2].mmap guess_degree,
  refine ``(nat_degree_mul_le.trans $ (add_le_add _ _).trans (_ : %%d1 + %%d2 ≤ %%tr))
| `(- %%f)         := refine ``((nat_degree_neg _).le.trans _)
| `(X ^ %%n)       := refine ``((nat_degree_X_pow_le %%n).trans _)
| (app `(⇑(@monomial %%R %%inst %%n)) x) := refine ``((nat_degree_monomial_le %%x).trans _)
| (app `(⇑C) x)    := refine ``((nat_degree_C %%x).le.trans (nat.zero_le %%tr))
| `(X)             := refine ``(nat_degree_X_le.trans _)
| `(has_zero.zero) := refine ``(nat_degree_zero.le.trans (nat.zero_le _))
| `(has_one.one)   := refine ``(nat_degree_one.le.trans (nat.zero_le _))
| `(bit0 %%a)      := refine ``((nat_degree_bit0 %%a).trans _)
| `(bit1 %%a)      := refine ``((nat_degree_bit1 %%a).trans _)
| `(%%tl1 ^ %%n)   := do
    refine ``(nat_degree_pow_le.trans _),
    refine ``(dite (%%n = 0) (λ (n0 : %%n = 0), (by simp only [n0, zero_mul, zero_le])) _),
    n0 ← get_unused_name "n0" >>= intro,
    refine ``((mul_comm _ _).le.trans ((nat.le_div_iff_mul_le' (nat.pos_of_ne_zero %%n0)).mp _)),
    lem1 ← to_expr ``(nat.mul_div_cancel _ (nat.pos_of_ne_zero %%n0)) tt ff,
    lem2 ← to_expr ``(nat.div_self (nat.pos_of_ne_zero %%n0)) tt ff,
    focus1 (refine ``((%%n0 rfl).elim) <|> rewrite_target lem1 <|> rewrite_target lem2) <|> skip
| e                := fail!"'{e}' is not supported"
end

/--  `norm_assum` simply tries `norm_num` and `assumption`.
It is used to try to discharge as many as possible of the side-goals of `compute_degree_le`.
Several side-goals are of the form `m ≤ n`, for natural numbers `m, n` or of the form `c ≠ 0`,
with `c` a coefficient of the polynomial `f` in question. -/
meta def norm_assum : tactic unit :=
try `[ norm_num ] >> try assumption

/--  `eval_guessing n e` takes a natural number `n` and an expression `e` and gives an
estimate for the evaluation of `eval_expr' ℕ e`.  It is tailor made for estimating degrees of
polynomials.

It decomposes `e` recursively as a sequence of additions, multiplications and `max`.
On the atoms of the process, `eval_guessing` tries to use `eval_expr' ℕ`, resorting to using
`n` if `eval_expr' ℕ` fails.

For use with degree of polynomials, we mostly use `n = 0`. -/
meta def eval_guessing (n : ℕ) : expr → tactic ℕ
| `(%%a + %%b)   := (+) <$> eval_guessing a <*> eval_guessing b
| `(%%a * %%b)   := (*) <$> eval_guessing a <*> eval_guessing b
| `(max %%a %%b) := max <$> eval_guessing a <*> eval_guessing b
| e              := eval_expr' ℕ e <|> pure n

/--  A general description of `compute_degree_le_aux` is in the doc-string of `compute_degree`.
The difference between the two is that `compute_degree_le_aux` makes no effort to close side-goals,
nor fails if the goal does not change. -/
meta def compute_degree_le_aux : tactic unit := do
try $ refine ``(degree_le_nat_degree.trans (with_bot.coe_le_coe.mpr _)),
`(nat_degree %%tl ≤ %%tr) ← target |
  fail "Goal is not of the form\n`f.nat_degree ≤ d` or `f.degree ≤ d`",
expected_deg ← guess_degree tl >>= eval_guessing 0,
deg_bound ← eval_expr' ℕ tr <|> pure expected_deg,
if deg_bound < expected_deg
then fail sformat!"the given polynomial has a term of expected degree\nat least '{expected_deg}'"
else repeat $ resolve_sum_step

end compute_degree

namespace interactive
open compute_degree polynomial

/--  `compute_degree_le` tries to solve a goal of the form `f.nat_degree ≤ d` or `f.degree ≤ d`,
where `f : R[X]` and `d : ℕ` or `d : with_bot ℕ`.

If the given degree `d` is smaller than the one that the tactic computes,
then the tactic suggests the degree that it computed.

Examples:

```lean
open polynomial
open_locale polynomial

variables {R : Type*} [semiring R] {a b c d e : R}

example {F} [ring F] {a : F} {n : ℕ} (h : n ≤ 10) :
  nat_degree (X ^ n + C a * X ^ 10 : F[X]) ≤ 10 :=
by compute_degree_le

example : nat_degree (7 * X : R[X]) ≤ 1 :=
by compute_degree_le

example {p : R[X]} {n : ℕ} {p0 : p.nat_degree = 0} :
 (p ^ n).nat_degree ≤ 0 :=
by compute_degree_le
```
-/
meta def compute_degree_le : tactic unit :=
focus1 $ do check_target_changes compute_degree_le_aux,
  try $ any_goals' norm_assum

add_tactic_doc
{ name := "compute_degree_le",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.compute_degree_le],
  tags := ["arithmetic", "finishing"] }

end interactive

end tactic


import data.real.basic

def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_lb (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, a ≤ f x

variables (f g : ℝ → ℝ) (a b : ℝ)

#check add_le_add

-- BEGIN
example (hfa : fn_ub f a) (hgb : fn_ub g b) :
  fn_ub (λ x, f x + g x) (a + b) :=
begin
  intro x,
  dsimp,
  apply add_le_add,
  apply hfa,
  apply hgb,
end
-- END


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

Nonnegative real numbers.
-/
import data.real.basic order.lattice algebra.field

noncomputable theory
open lattice

local attribute [instance] classical.prop_decidable

def nnreal := {r : ℝ // 0 ≤ r}
local notation ` ℝ≥0 ` := nnreal

namespace nnreal

instance : has_coe ℝ≥0 ℝ := ⟨subtype.val⟩

protected lemma eq {n m : ℝ≥0} : (n : ℝ) = (m : ℝ) → n = m := subtype.eq
protected lemma eq_iff {n m : ℝ≥0} : (n : ℝ) = (m : ℝ) ↔ n = m :=
iff.intro nnreal.eq (congr_arg coe)

protected def of_real (r : ℝ) : ℝ≥0 := ⟨max r 0, le_max_right _ _⟩

lemma coe_of_real (r : ℝ) (hr : 0 ≤ r) : (nnreal.of_real r : ℝ) = r :=
max_eq_left hr

lemma coe_nonneg (r : nnreal) : (0 : ℝ) ≤ r := r.2

instance : has_zero ℝ≥0  := ⟨⟨0, le_refl 0⟩⟩
instance : has_one ℝ≥0   := ⟨⟨1, zero_le_one⟩⟩
instance : has_add ℝ≥0   := ⟨λa b, ⟨a + b, add_nonneg a.2 b.2⟩⟩
instance : has_sub ℝ≥0   := ⟨λa b, nnreal.of_real (a - b)⟩
instance : has_mul ℝ≥0   := ⟨λa b, ⟨a * b, mul_nonneg a.2 b.2⟩⟩
instance : has_inv ℝ≥0   := ⟨λa, ⟨(a.1)⁻¹, inv_nonneg.2 a.2⟩⟩
instance : has_div ℝ≥0   := ⟨λa b, ⟨a.1 / b.1, div_nonneg' a.2 b.2⟩⟩
instance : has_le ℝ≥0    := ⟨λ r s, (r:ℝ) ≤ s⟩
instance : has_bot ℝ≥0   := ⟨0⟩
instance : inhabited ℝ≥0 := ⟨0⟩

@[simp] protected lemma coe_zero : ((0 : ℝ≥0) : ℝ) = 0 := rfl
@[simp] protected lemma coe_one  : ((1 : ℝ≥0) : ℝ) = 1 := rfl
@[simp] protected lemma coe_add (r₁ r₂ : ℝ≥0) : ((r₁ + r₂ : ℝ≥0) : ℝ) = r₁ + r₂ := rfl
@[simp] protected lemma coe_mul (r₁ r₂ : ℝ≥0) : ((r₁ * r₂ : ℝ≥0) : ℝ) = r₁ * r₂ := rfl
@[simp] protected lemma coe_div (r₁ r₂ : ℝ≥0) : ((r₁ / r₂ : ℝ≥0) : ℝ) = r₁ / r₂ := rfl
@[simp] protected lemma coe_inv (r : ℝ≥0) : ((r⁻¹ : ℝ≥0) : ℝ) = r⁻¹ := rfl

@[simp] protected lemma coe_sub (r₁ r₂ : ℝ≥0) (h : r₂ ≤ r₁) : ((r₁ - r₂ : ℝ≥0) : ℝ) = r₁ - r₂ :=
max_eq_left $ le_sub.2 $ by simp [show (r₂ : ℝ) ≤ r₁, from h]

-- TODO: setup semifield!
@[simp] protected lemma zero_div (r : ℝ≥0) : 0 / r = 0 := nnreal.eq (zero_div _)
@[simp] protected lemma coe_eq_zero (r : ℝ≥0) : ↑r = (0 : ℝ) ↔ r = 0 := @nnreal.eq_iff r 0

instance : comm_semiring ℝ≥0 :=
begin
  refine { zero := 0, add := (+), one := 1, mul := (*), ..};
  { intros;
    apply nnreal.eq;
    simp [mul_comm, mul_assoc, add_comm_monoid.add, left_distrib, right_distrib,
          add_comm_monoid.zero] }
end

instance : is_semiring_hom (coe : ℝ≥0 → ℝ) := by refine_struct {..}; intros; refl

lemma sum_coe {α} {s : finset α} {f : α → ℝ≥0} : ↑(s.sum f) = s.sum (λa, (f a : ℝ)) :=
eq.symm $ finset.sum_hom _

lemma prod_coe {α} {s : finset α} {f : α → ℝ≥0} : ↑(s.prod f) = s.prod (λa, (f a : ℝ)) :=
eq.symm $ finset.prod_hom _

lemma smul_coe (r : ℝ≥0) : ∀n, ↑(add_monoid.smul n r) = add_monoid.smul n (r:ℝ)
| 0       := rfl
| (n + 1) := by simp [add_monoid.add_smul, smul_coe n]

@[simp] protected lemma coe_nat_cast : ∀(n : ℕ), (↑(↑n : ℝ≥0) : ℝ) = n
| 0       := rfl
| (n + 1) := by simp [coe_nat_cast n]

instance : decidable_linear_order ℝ≥0 :=
decidable_linear_order.lift (coe : ℝ≥0 → ℝ) subtype.val_injective

protected lemma coe_le {r₁ r₂ : ℝ≥0} : r₁ ≤ r₂ ↔ (r₁ : ℝ) ≤ r₂ := iff.rfl
protected lemma coe_lt {r₁ r₂ : ℝ≥0} : r₁ < r₂ ↔ (r₁ : ℝ) < r₂ := iff.rfl
protected lemma coe_pos {r : ℝ≥0} : 0 < r ↔ (0 : ℝ) < r := iff.rfl

instance : order_bot ℝ≥0 :=
{ bot := ⊥, bot_le := assume ⟨a, h⟩, h, .. nnreal.decidable_linear_order }

instance : canonically_ordered_monoid ℝ≥0 :=
{ add_le_add_left       := assume a b h c, @add_le_add_left ℝ _ a b h c,
  lt_of_add_lt_add_left := assume a b c, @lt_of_add_lt_add_left ℝ _ a b c,
  le_iff_exists_add     := assume ⟨a, ha⟩ ⟨b, hb⟩,
    iff.intro
      (assume h : a ≤ b,
        ⟨⟨b - a, le_sub_iff_add_le.2 $ by simp [h]⟩,
          nnreal.eq $ show b = a + (b - a), by rw [add_sub_cancel'_right]⟩)
      (assume ⟨⟨c, hc⟩, eq⟩, eq.symm ▸ show a ≤ a + c, from (le_add_iff_nonneg_right a).2 hc),
  ..nnreal.comm_semiring,
  ..nnreal.lattice.order_bot,
  ..nnreal.decidable_linear_order }

instance : distrib_lattice ℝ≥0 := by apply_instance

instance : semilattice_inf_bot ℝ≥0 :=
{ .. nnreal.lattice.order_bot, .. nnreal.lattice.distrib_lattice }

instance : semilattice_sup_bot ℝ≥0 :=
{ .. nnreal.lattice.order_bot, .. nnreal.lattice.distrib_lattice }

instance : linear_ordered_semiring ℝ≥0 :=
{ add_left_cancel            := assume a b c h, nnreal.eq $ @add_left_cancel ℝ _ a b c (nnreal.eq_iff.2 h),
  add_right_cancel           := assume a b c h, nnreal.eq $ @add_right_cancel ℝ _ a b c (nnreal.eq_iff.2 h),
  le_of_add_le_add_left      := assume a b c, @le_of_add_le_add_left ℝ _ a b c,
  mul_le_mul_of_nonneg_left  := assume a b c, @mul_le_mul_of_nonneg_left ℝ _ a b c,
  mul_le_mul_of_nonneg_right := assume a b c, @mul_le_mul_of_nonneg_right ℝ _ a b c,
  mul_lt_mul_of_pos_left     := assume a b c, @mul_lt_mul_of_pos_left ℝ _ a b c,
  mul_lt_mul_of_pos_right    := assume a b c, @mul_lt_mul_of_pos_right ℝ _ a b c,
  zero_lt_one                := @zero_lt_one ℝ _,
  .. nnreal.decidable_linear_order,
  .. nnreal.canonically_ordered_monoid,
  .. nnreal.comm_semiring }

instance : canonically_ordered_comm_semiring ℝ≥0 :=
{ zero_ne_one     := assume h, @zero_ne_one ℝ _ $ congr_arg subtype.val $ h,
  mul_eq_zero_iff := assume a b, nnreal.eq_iff.symm.trans $ mul_eq_zero.trans $ by simp,
  .. nnreal.linear_ordered_semiring,
  .. nnreal.canonically_ordered_monoid,
  .. nnreal.comm_semiring }

instance : densely_ordered ℝ≥0 :=
⟨assume a b (h : (a : ℝ) < b), let ⟨c, hac, hcb⟩ := dense h in
  ⟨⟨c, le_trans a.property $ le_of_lt $ hac⟩, hac, hcb⟩⟩

instance : no_top_order ℝ≥0 :=
⟨assume a, let ⟨b, hb⟩ := no_top (a:ℝ) in ⟨⟨b, le_trans a.property $ le_of_lt $ hb⟩, hb⟩⟩

lemma bdd_above_coe {s : set ℝ≥0} : bdd_above ((coe : nnreal → ℝ) '' s) ↔ bdd_above s :=
iff.intro
  (assume ⟨b, hb⟩, ⟨nnreal.of_real b, assume ⟨y, hy⟩ hys, show y ≤ max b 0, from
    le_max_left_of_le $ hb _ $ set.mem_image_of_mem _ hys⟩)
  (assume ⟨b, hb⟩, ⟨b, assume y ⟨x, hx, eq⟩, eq ▸ hb _ $ hx⟩)

lemma bdd_below_coe (s : set ℝ≥0) : bdd_below ((coe : nnreal → ℝ) '' s) :=
⟨0, assume r ⟨q, _, eq⟩, eq ▸ q.2⟩

instance : has_Sup ℝ≥0 :=
⟨λs, ⟨Sup ((coe : nnreal → ℝ) '' s),
  begin
    by_cases h : s = ∅,
    { simp [h, set.image_empty, real.Sup_empty] },
    rcases set.ne_empty_iff_exists_mem.1 h with ⟨⟨b, hb⟩, hbs⟩,
    by_cases h' : bdd_above s,
    { exact le_cSup_of_le (bdd_above_coe.2 h') (set.mem_image_of_mem _ hbs) hb },
    { rw [real.Sup_of_not_bdd_above], rwa [bdd_above_coe] }
  end⟩⟩

instance : has_Inf ℝ≥0 :=
⟨λs, ⟨Inf ((coe : nnreal → ℝ) '' s),
  begin
    by_cases h : s = ∅,
    { simp [h, set.image_empty, real.Inf_empty] },
    exact le_cInf (by simp [h]) (assume r ⟨q, _, eq⟩, eq ▸ q.2)
  end⟩⟩

lemma coe_Sup (s : set nnreal) : (↑(Sup s) : ℝ) = Sup ((coe : nnreal → ℝ) '' s) := rfl
lemma coe_Inf (s : set nnreal) : (↑(Inf s) : ℝ) = Inf ((coe : nnreal → ℝ) '' s) := rfl

instance : conditionally_complete_linear_order_bot ℝ≥0 :=
{ Sup     := Sup,
  Inf     := Inf,
  le_cSup := assume s a hs ha, le_cSup (bdd_above_coe.2 hs) (set.mem_image_of_mem _ ha),
  cSup_le := assume s a hs h,show Sup ((coe : nnreal → ℝ) '' s) ≤ a, from
    cSup_le (by simp [hs]) $ assume r ⟨b, hb, eq⟩, eq ▸ h _ hb,
  cInf_le := assume s a _ has, cInf_le (bdd_below_coe s) (set.mem_image_of_mem _ has),
  le_cInf := assume s a hs h, show (↑a : ℝ) ≤ Inf ((coe : nnreal → ℝ) '' s), from
    le_cInf (by simp [hs]) $ assume r ⟨b, hb, eq⟩, eq ▸ h _ hb,
  cSup_empty := nnreal.eq $ by simp [coe_Sup, real.Sup_empty]; refl,
  decidable_le := begin assume x y, apply classical.dec end,
  .. nnreal.linear_ordered_semiring, .. lattice.lattice_of_decidable_linear_order,
  .. nnreal.lattice.order_bot }

instance : archimedean nnreal :=
⟨ assume x y pos_y,
  let ⟨n, hr⟩ := archimedean.arch (x:ℝ) (pos_y : (0 : ℝ) < y) in
  ⟨n, show (x:ℝ) ≤ (add_monoid.smul n y : nnreal), by simp [*, smul_coe]⟩ ⟩

lemma le_of_forall_epsilon_le {a b : nnreal} (h : ∀ε, ε > 0 → a ≤ b + ε) : a ≤ b :=
le_of_forall_le_of_dense $ assume x hxb,
begin
  rcases le_iff_exists_add.1 (le_of_lt hxb) with ⟨ε, rfl⟩,
  exact h _ ((lt_add_iff_pos_right b).1 hxb)
end

lemma lt_iff_exists_rat_btwn (a b : nnreal) :
  a < b ↔ (∃q:ℚ, 0 ≤ q ∧ a < nnreal.of_real q ∧ nnreal.of_real q < b) :=
iff.intro
  (assume (h : (↑a:ℝ) < (↑b:ℝ)),
    let ⟨q, haq, hqb⟩ := exists_rat_btwn h in
    have 0 ≤ (q : ℝ), from le_trans a.2 $ le_of_lt haq,
    ⟨q, rat.cast_nonneg.1 this, by simp [coe_of_real _ this, nnreal.coe_lt, haq, hqb]⟩)
  (assume ⟨q, _, haq, hqb⟩, lt_trans haq hqb)

lemma bot_eq_zero : (⊥ : nnreal) = 0 := rfl

lemma mul_sup (a b c : ℝ≥0) : a * (b ⊔ c) = (a * b) ⊔ (a * c) :=
begin
  cases le_total b c with h h,
  { simp [sup_eq_max, max_eq_right h, max_eq_right (mul_le_mul_of_nonneg_left h (zero_le a))] },
  { simp [sup_eq_max, max_eq_left h, max_eq_left (mul_le_mul_of_nonneg_left h (zero_le a))] },
end

lemma mul_finset_sup {α} {f : α → ℝ≥0} {s : finset α} (r : ℝ≥0) :
  r * s.sup f = s.sup (λa, r * f a) :=
begin
  refine s.induction_on _ _,
  { simp [bot_eq_zero] },
  { assume a s has ih, simp [has, ih, mul_sup], }
end

section of_real

@[simp] lemma zero_le_coe {q : nnreal} : 0 ≤ (q : ℝ) := q.2

@[simp] lemma of_real_zero : nnreal.of_real 0 = 0 :=
by simp [nnreal.of_real]; refl

@[simp] lemma of_real_one : nnreal.of_real 1 = 1 :=
by simp [nnreal.of_real, max_eq_left (zero_le_one : (0 :ℝ) ≤ 1)]; refl

@[simp] lemma of_real_pos {r : ℝ} : 0 < nnreal.of_real r ↔ 0 < r :=
by simp [nnreal.of_real, nnreal.coe_lt, lt_irrefl]

@[simp] lemma of_real_eq_zero {r : ℝ} : nnreal.of_real r = 0 ↔ r ≤ 0 :=
by simpa [-of_real_pos] using (not_iff_not.2 (@of_real_pos r))

lemma of_real_of_nonpos {r : ℝ} : r ≤ 0 → nnreal.of_real r = 0 :=
of_real_eq_zero.2

@[simp] lemma of_real_coe {r : nnreal} : nnreal.of_real r = r :=
nnreal.eq $ by simp [nnreal.of_real]

@[simp] lemma of_real_le_of_real_iff {r p : ℝ} (hp : 0 ≤ p) :
  nnreal.of_real r ≤ nnreal.of_real p ↔ r ≤ p :=
by simp [nnreal.coe_le, nnreal.of_real, hp]

@[simp] lemma of_real_lt_of_real_iff' {r p : ℝ} :
  nnreal.of_real r < nnreal.of_real p ↔ r < p ∧ 0 < p :=
by simp [nnreal.coe_lt, nnreal.of_real, lt_irrefl]

lemma of_real_lt_of_real_iff {r p : ℝ} (h : 0 < p) :
  nnreal.of_real r < nnreal.of_real p ↔ r < p :=
of_real_lt_of_real_iff'.trans (and_iff_left h)

@[simp] lemma of_real_add {r p : ℝ} (hr : 0 ≤ r) (hp : 0 ≤ p) :
  nnreal.of_real (r + p) = nnreal.of_real r + nnreal.of_real p :=
nnreal.eq $ by simp [nnreal.of_real, hr, hp, add_nonneg]

lemma of_real_add_of_real {r p : ℝ} (hr : 0 ≤ r) (hp : 0 ≤ p) :
  nnreal.of_real r + nnreal.of_real p = nnreal.of_real (r + p) :=
(of_real_add hr hp).symm

lemma of_real_le_of_real {r p : ℝ} (h : r ≤ p) : nnreal.of_real r ≤ nnreal.of_real p :=
nnreal.coe_le.2 $ max_le_max h $ le_refl _

lemma of_real_add_le {r p : ℝ} : nnreal.of_real (r + p) ≤ nnreal.of_real r + nnreal.of_real p :=
nnreal.coe_le.2 $ max_le (add_le_add (le_max_left _ _) (le_max_left _ _)) nnreal.zero_le_coe

end of_real

section mul

lemma mul_eq_mul_left {a b c : nnreal} (h : a ≠ 0) : (a * b = a * c ↔ b = c) :=
begin
  rw [← nnreal.eq_iff, ← nnreal.eq_iff, nnreal.coe_mul, nnreal.coe_mul], split,
  { exact eq_of_mul_eq_mul_left (mt (@nnreal.eq_iff a 0).1 h) },
  { assume h, rw [h] }
end

end mul

section sub

lemma sub_eq_zero {r p : nnreal} (h : r ≤ p) : r - p = 0 :=
nnreal.eq $ max_eq_right $ sub_le_iff_le_add.2 $ by simpa [nnreal.coe_le] using h

@[simp] lemma sub_le_iff_le_add {r p q : nnreal} : r - p ≤ q ↔ r ≤ q + p :=
match le_total p r with
| or.inl h :=
  by rw [nnreal.coe_le, nnreal.coe_le, nnreal.coe_sub _ _ h, nnreal.coe_add, sub_le_iff_le_add]
| or.inr h :=
  have r ≤ p + q, from le_add_right h,
  by simpa [nnreal.coe_le, nnreal.coe_le, sub_eq_zero h]
end

lemma add_sub_cancel {r p : nnreal} : (p + r) - r = p :=
nnreal.eq $ by rw [nnreal.coe_sub, nnreal.coe_add, add_sub_cancel]; exact le_add_left (le_refl _)

lemma add_sub_cancel' {r p : nnreal} : (r + p) - r = p :=
by rw [add_comm, add_sub_cancel]

@[simp] lemma sub_add_cancel_of_le {a b : nnreal} (h : b ≤ a) : (a - b) + b = a :=
nnreal.eq $ by rw [nnreal.coe_add, nnreal.coe_sub _ _ h, sub_add_cancel]

end sub

section inv

lemma div_def {r p : nnreal} : r / p = r * p⁻¹ := rfl

@[simp] lemma inv_zero : (0 : nnreal)⁻¹ = 0 := nnreal.eq inv_zero

@[simp] lemma inv_eq_zero {r : nnreal} : (r : nnreal)⁻¹ = 0 ↔ r = 0 :=
by rw [← nnreal.eq_iff, nnreal.coe_inv, nnreal.coe_zero, inv_eq_zero, ← nnreal.coe_zero, nnreal.eq_iff]

@[simp] lemma inv_pos {r : nnreal} : 0 < r⁻¹ ↔ 0 < r :=
by simp [zero_lt_iff_ne_zero]

@[simp] lemma inv_mul_cancel {r : ℝ≥0} (h : r ≠ 0) : r⁻¹ * r = 1 :=
nnreal.eq $ inv_mul_cancel $ mt (@nnreal.eq_iff r 0).1 h

@[simp] lemma mul_inv_cancel {r : ℝ≥0} (h : r ≠ 0) : r * r⁻¹ = 1 :=
by rw [mul_comm, inv_mul_cancel h]

@[simp] lemma inv_inv {r : ℝ≥0} : r⁻¹⁻¹ = r := nnreal.eq inv_inv'

@[simp] lemma inv_le {r p : ℝ≥0} (h : r ≠ 0) : r⁻¹ ≤ p ↔ 1 ≤ r * p :=
by rw [← mul_le_mul_left (zero_lt_iff_ne_zero.2 h), mul_inv_cancel h]

lemma inv_le_of_le_mul {r p : ℝ≥0} (h : 1 ≤ r * p) : r⁻¹ ≤ p :=
by by_cases r = 0; simp [*, inv_le]

@[simp] lemma le_inv_iff_mul_le {r p : ℝ≥0} (h : p ≠ 0) : (r ≤ p⁻¹ ↔ r * p ≤ 1) :=
by rw [← mul_le_mul_left (zero_lt_iff_ne_zero.2 h), mul_inv_cancel h, mul_comm]

@[simp] lemma lt_inv_iff_mul_lt {r p : ℝ≥0} (h : p ≠ 0) : (r < p⁻¹ ↔ r * p < 1) :=
by rw [← mul_lt_mul_left (zero_lt_iff_ne_zero.2 h), mul_inv_cancel h, mul_comm]

lemma mul_le_if_le_inv {a b r : nnreal} (hr : r ≠ 0) : r * a ≤ b ↔ a ≤ r⁻¹ * b :=
have 0 < r, from lt_of_le_of_ne (zero_le r) hr.symm,
by rw [← @mul_le_mul_left _ _ a _ r this, ← mul_assoc, mul_inv_cancel hr, one_mul]

lemma le_of_forall_lt_one_mul_lt {x y : ℝ≥0} (h : ∀a<1, a * x ≤ y) : x ≤ y :=
le_of_forall_ge_of_dense $ assume a ha,
  have hx : x ≠ 0 := zero_lt_iff_ne_zero.1 (lt_of_le_of_lt (zero_le _) ha),
  have hx' : x⁻¹ ≠ 0, by rwa [(≠), inv_eq_zero],
  have a * x⁻¹ < 1, by rwa [← lt_inv_iff_mul_lt hx', inv_inv],
  have (a * x⁻¹) * x ≤ y, from h _ this,
  by rwa [mul_assoc, inv_mul_cancel hx, mul_one] at this

lemma div_add_div_same (a b c : ℝ≥0) : a / c + b / c = (a + b) / c :=
eq.symm $ right_distrib a b (c⁻¹)

lemma add_halves (a : ℝ≥0) : a / 2 + a / 2 = a := nnreal.eq (add_halves a)

lemma half_lt_self {a : ℝ≥0} (h : a ≠ 0) : a / 2 < a :=
by rw [nnreal.coe_lt, nnreal.coe_div]; exact
half_lt_self (bot_lt_iff_ne_bot.2 h)

end inv

end nnreal


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

import topology.algebra.nonarchimedean.basic
import topology.algebra.filter_basis
import algebra.module.submodule_pointwise

/-!
# Neighborhood bases for non-archimedean rings and modules

This files contains special families of filter bases on rings and modules that give rise to
non-archimedean topologies.

The main definition is `ring_subgroups_basis` which is a predicate on a family of
additive subgroups of a ring. The predicate ensures there is a topology
`ring_subgroups_basis.topology` which is compatible with a ring structure and admits the given
family as a basis of neighborhoods of zero. In particular the given subgroups become open subgroups
(bundled in `ring_subgroups_basis.open_add_subgroup`) and we get a non-archimedean topological ring
(`ring_subgroups_basis.nonarchimedean`).

A special case of this construction is given by `submodules_basis` where the subgroups are
sub-modules in a commutative algebra. This important example gives rises to the adic topology
(studied in its own file).

-/

open set filter function lattice add_group_with_zero_nhd
open_locale topological_space filter pointwise

/-- A family of additive subgroups on a ring `A` is a subgroups basis if it satisfies some
axioms ensuring there is a topology on `A` which is compatible with the ring structure and
admits this family as a basis of neighborhoods of zero. -/
structure ring_subgroups_basis {A ι : Type*} [ring A] (B : ι → add_subgroup A) : Prop :=
(inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j)
(mul : ∀ i, ∃ j, (B j : set A) * B j ⊆ B i)
(left_mul : ∀ x : A, ∀ i, ∃ j, (B j : set A) ⊆ (λ y : A, x*y) ⁻¹' (B i))
(right_mul : ∀ x : A, ∀ i, ∃ j, (B j : set A) ⊆ (λ y : A, y*x) ⁻¹' (B i))

namespace ring_subgroups_basis

variables {A ι : Type*} [ring A]

lemma of_comm {A ι : Type*} [comm_ring A] (B : ι → add_subgroup A)
  (inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j)
  (mul : ∀ i, ∃ j, (B j : set A) * B j ⊆ B i)
  (left_mul : ∀ x : A, ∀ i, ∃ j, (B j : set A) ⊆ (λ y : A, x*y) ⁻¹' (B i)) :
  ring_subgroups_basis B :=
{ inter := inter,
  mul := mul,
  left_mul := left_mul,
  right_mul := begin
    intros x i,
    cases left_mul x i with j hj,
    use j,
    simpa [mul_comm] using hj
  end }

/-- Every subgroups basis on a ring leads to a ring filter basis. -/
def to_ring_filter_basis [nonempty ι] {B : ι → add_subgroup A}
  (hB : ring_subgroups_basis B) : ring_filter_basis A :=
{ sets := {U | ∃ i, U = B i},
  nonempty := by { inhabit ι, exact ⟨B (default ι), default ι, rfl⟩ },
  inter_sets := begin
    rintros _ _ ⟨i, rfl⟩ ⟨j, rfl⟩,
    cases hB.inter i j with k hk,
    use [B k, k, rfl, hk]
  end,
  zero' := by { rintros _ ⟨i, rfl⟩, exact (B i).zero_mem },
  add' := begin
    rintros _ ⟨i, rfl⟩,
    use [B i, i, rfl],
    rintros x ⟨y, z, y_in, z_in, rfl⟩,
    exact (B i).add_mem y_in z_in
  end,
  neg' := begin
    rintros _ ⟨i, rfl⟩,
    use [B i, i, rfl],
    intros x x_in,
    exact (B i).neg_mem x_in
  end,
  conj' := begin
    rintros x₀ _ ⟨i, rfl⟩,
    use [B i, i, rfl],
    simp
  end,
  mul' := begin
    rintros _ ⟨i, rfl⟩,
    cases hB.mul i with k hk,
    use [B k, k, rfl, hk]
  end,
  mul_left' := begin
    rintros x₀ _ ⟨i, rfl⟩,
    cases hB.left_mul x₀ i with k hk,
    use [B k, k, rfl, hk]
  end,
  mul_right' := begin
    rintros x₀ _ ⟨i, rfl⟩,
    cases hB.right_mul x₀ i with k hk,
    use [B k, k, rfl, hk]
  end }

variables [nonempty ι] {B : ι → add_subgroup A} (hB : ring_subgroups_basis B)

lemma mem_add_group_filter_basis_iff {V : set A} :
  V ∈ hB.to_ring_filter_basis.to_add_group_filter_basis ↔ ∃ i, V = B i :=
iff.rfl

lemma mem_add_group_filter_basis (i) :
  (B i : set A) ∈ hB.to_ring_filter_basis.to_add_group_filter_basis :=
⟨i, rfl⟩

/-- The topology defined from a subgroups basis, admitting the given subgroups as a basis
of neighborhoods of zero. -/
def topology : topological_space A :=
hB.to_ring_filter_basis.to_add_group_filter_basis.topology

lemma has_basis_nhds_zero : has_basis (@nhds A hB.topology 0) (λ _, true) (λ i, B i) :=
⟨begin
  intros s,
  rw hB.to_ring_filter_basis.to_add_group_filter_basis.nhds_zero_has_basis.mem_iff,
  split,
  { rintro ⟨-, ⟨i, rfl⟩, hi⟩,
    exact ⟨i, trivial, hi⟩ },
  { rintro ⟨i, -, hi⟩,
    exact ⟨B i, ⟨i, rfl⟩, hi⟩ }
end⟩

lemma has_basis_nhds (a : A) :
  has_basis (@nhds A hB.topology a) (λ _, true) (λ i, {b | b - a ∈ B i}) :=
⟨begin
  intros s,
  rw (hB.to_ring_filter_basis.to_add_group_filter_basis.nhds_has_basis a).mem_iff,
  simp only [exists_prop, exists_true_left],
  split,
  { rintro ⟨-, ⟨i, rfl⟩, hi⟩,
    use i,
    convert hi,
    ext b,
    split,
    { intros h,
      use [b - a, h],
      abel },
    { rintros ⟨c, hc, rfl⟩,
      simpa using hc } },
  { rintros ⟨i, hi⟩,
    use [B i, i, rfl],
    rw image_subset_iff,
    rintro b b_in,
    apply hi,
    simpa using b_in }
end⟩

/-- Given a subgroups basis, the basis elements as open additive subgroups in the associated
topology. -/
def open_add_subgroup (i : ι) : @open_add_subgroup A _ hB.topology:=
{ is_open' := begin
    letI := hB.topology,
    rw is_open_iff_mem_nhds,
    intros a a_in,
    rw (hB.has_basis_nhds a).mem_iff,
    use [i, trivial],
    rintros b b_in,
    simpa using (B i).add_mem a_in b_in
  end,
  ..B i }

-- see Note [nonarchimedean non instances]
lemma nonarchimedean : @nonarchimedean_ring A _ hB.topology :=
begin
  letI := hB.topology,
  constructor,
  intros U hU,
  obtain ⟨i, -, hi : (B i : set A) ⊆ U⟩ := hB.has_basis_nhds_zero.mem_iff.mp hU,
  exact ⟨hB.open_add_subgroup i, hi⟩
end

end ring_subgroups_basis

variables {ι R A : Type*} [comm_ring R] [comm_ring A] [algebra R A]

/-- A family of submodules in a commutative `R`-algebra `A` is a submodules basis if it satisfies
some axioms ensuring there is a topology on `A` which is compatible with the ring structure and
admits this family as a basis of neighborhoods of zero. -/
structure submodules_ring_basis (B : ι → submodule R A) : Prop :=
(inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j)
(left_mul : ∀ (a : A) i, ∃ j, a • B j ≤ B i)
(mul      : ∀ i, ∃ j, (B j : set A) * B j ⊆ B i)

namespace submodules_ring_basis

variables {B : ι → submodule R A} (hB : submodules_ring_basis B)

lemma to_ring_subgroups_basis (hB : submodules_ring_basis B) :
  ring_subgroups_basis (λ i, (B i).to_add_subgroup) :=
begin
  apply ring_subgroups_basis.of_comm (λ i, (B i).to_add_subgroup) hB.inter hB.mul,
  intros a i,
  rcases hB.left_mul a i with ⟨j, hj⟩,
  use j,
  rintros b (b_in : b ∈ B j),
  exact hj ⟨b, b_in, rfl⟩
end

/-- The topology associated to a basis of submodules in an algebra. -/
def topology [nonempty ι] (hB : submodules_ring_basis B) : topological_space A :=
hB.to_ring_subgroups_basis.topology

end submodules_ring_basis

variables {M : Type*} [add_comm_group M] [module R M]

/-- A family of submodules in an `R`-module `M` is a submodules basis if it satisfies
some axioms ensuring there is a topology on `M` which is compatible with the module structure and
admits this family as a basis of neighborhoods of zero. -/
structure submodules_basis [topological_space R]
  (B : ι → submodule R M) : Prop :=
(inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j)
(smul : ∀ (m : M) (i : ι), ∀ᶠ a in 𝓝 (0 : R), a • m ∈ B i)

namespace submodules_basis

variables [topological_space R] [nonempty ι] {B : ι → submodule R M}
          (hB : submodules_basis B)

include hB

/-- The image of a submodules basis is a module filter basis. -/
def to_module_filter_basis : module_filter_basis R M :=
{ sets := {U | ∃ i, U = B i},
  nonempty := by { inhabit ι, exact ⟨B (default ι), default ι, rfl⟩ },
  inter_sets := begin
    rintros _ _ ⟨i, rfl⟩ ⟨j, rfl⟩,
    cases hB.inter i j with k hk,
    use [B k, k, rfl, hk]
  end,
  zero' := by { rintros _ ⟨i, rfl⟩, exact (B i).zero_mem },
  add' := begin
    rintros _ ⟨i, rfl⟩,
    use [B i, i, rfl],
    rintros x ⟨y, z, y_in, z_in, rfl⟩,
    exact (B i).add_mem y_in z_in
  end,
  neg' := begin
    rintros _ ⟨i, rfl⟩,
    use [B i, i, rfl],
    intros x x_in,
    exact (B i).neg_mem x_in
  end,
  conj' := begin
    rintros x₀ _ ⟨i, rfl⟩,
    use [B i, i, rfl],
    simp
  end,
  smul' := begin
    rintros _ ⟨i, rfl⟩,
    use [univ, univ_mem, B i, i, rfl],
    rintros _ ⟨a, m, -, hm, rfl⟩,
    exact (B i).smul_mem _ hm
  end,
  smul_left' := begin
    rintros x₀ _ ⟨i, rfl⟩,
    use [B i, i, rfl],
    intros m,
    exact (B i).smul_mem _
  end,
  smul_right' := begin
    rintros m₀ _ ⟨i, rfl⟩,
    exact hB.smul m₀ i
  end }

/-- The topology associated to a basis of submodules in a module. -/
def topology : topological_space M :=
hB.to_module_filter_basis.to_add_group_filter_basis.topology

/-- Given a submodules basis, the basis elements as open additive subgroups in the associated
topology. -/
def open_add_subgroup (i : ι) : @open_add_subgroup M _ hB.topology :=
{ is_open' := begin
    letI := hB.topology,
    rw is_open_iff_mem_nhds,
    intros a a_in,
    rw (hB.to_module_filter_basis.to_add_group_filter_basis.nhds_has_basis a).mem_iff,
    use [B i, i, rfl],
    rintros - ⟨b, b_in, rfl⟩,
    exact (B i).add_mem a_in b_in
  end,
  ..(B i).to_add_subgroup }

-- see Note [nonarchimedean non instances]
lemma nonarchimedean (hB : submodules_basis B) : @nonarchimedean_add_group M _ hB.topology:=
begin
  letI := hB.topology,
  constructor,
  intros U hU,
  obtain ⟨-, ⟨i, rfl⟩, hi : (B i : set M) ⊆ U⟩ :=
    hB.to_module_filter_basis.to_add_group_filter_basis.nhds_zero_has_basis.mem_iff.mp hU,
  exact ⟨hB.open_add_subgroup i, hi⟩
end

/-- The non archimedean subgroup basis lemmas cannot be instances because some instances
(such as `measure_theory.ae_eq_fun.add_monoid ` or `topological_add_group.to_has_continuous_add`)
cause the search for `@topological_add_group β ?m1 ?m2`, i.e. a search for a topological group where
the topology/group structure are unknown. -/
library_note "nonarchimedean non instances"
end submodules_basis

section
/-
In this section, we check that, in a `R`-algebra `A` over a ring equipped with a topology,
a basis of `R`-submodules which is compatible with the topology on `R` is also a submodule basis
in the sense of `R`-modules (forgetting about the ring structure on `A`) and those two points of
view definitionaly gives the same topology on `A`.
-/
variables [topological_space R] {B : ι → submodule R A} (hB : submodules_ring_basis B)
          (hsmul : ∀ (m : A) (i : ι), ∀ᶠ (a : R) in 𝓝 0, a • m ∈ B i)

lemma submodules_ring_basis.to_submodules_basis : submodules_basis B :=
{ inter := hB.inter,
  smul := hsmul }

example [nonempty ι] : hB.topology = (hB.to_submodules_basis hsmul).topology := rfl
end

/-- Given a ring filter basis on a commutative ring `R`, define a compatibility condition
on a family of submodules of a `R`-module `M`. This compatibility condition allows to get
a topological module structure. -/
structure ring_filter_basis.submodules_basis (BR : ring_filter_basis R)
  (B : ι → submodule R M) : Prop :=
(inter : ∀ i j, ∃ k, B k ≤ B i ⊓ B j)
(smul : ∀ (m : M) (i : ι), ∃ U ∈ BR, U ⊆ (λ a, a • m) ⁻¹' B i)

lemma ring_filter_basis.submodules_basis_is_basis (BR : ring_filter_basis R) {B : ι → submodule R M}
  (hB : BR.submodules_basis B) : @submodules_basis ι R _ M _ _ BR.topology B  :=
{ inter := hB.inter,
  smul := begin
    letI := BR.topology,
    intros m i,
    rcases hB.smul m i with ⟨V, V_in, hV⟩,
    exact mem_of_superset (BR.to_add_group_filter_basis.mem_nhds_zero V_in) hV
  end }

/-- The module filter basis associated to a ring filter basis and a compatible submodule basis.
This allows to build a topological module structure compatible with the given module structure
and the topology associated to the given ring filter basis. -/
def ring_filter_basis.module_filter_basis [nonempty ι] (BR : ring_filter_basis R)
  {B : ι → submodule R M} (hB : BR.submodules_basis B) :
  @module_filter_basis R M _ BR.topology _ _ :=
@submodules_basis.to_module_filter_basis  ι R _ M _ _ BR.topology _ _
  (BR.submodules_basis_is_basis hB)


import SciLean.Core.Functions
import SciLean.Functions.Limit

namespace SciLean

noncomputable
opaque ode_solve {X} [Vec X] (f : X → X) (t : ℝ) (x₀ : X) : X

axiom ode_solve.definition {X} [Vec X] (f : X → X) [IsSmooth f] (t dt : ℝ) (x₀ : X)
  : ∂ (ode_solve f) t dt x₀ = dt * f (ode_solve f t x₀)

variable {X Y Z} [Vec X] [Vec Y] [Vec Z]

def ode_solve_fixed_dt_impl (n : Nat) (stepper : ℝ → (X → X) → (X → X)) (f : X → X) (t : ℝ) (x₀ : X) : X :=
Id.run do
  let Δt := t/n
  let mut x := x₀
  for i in [0:n] do
    x := (stepper Δt f) x
  x

--- This requires some conditions on the function ... or just add the conclusion as an assumption
theorem ode_solve_fixed_dt (stepper : ℝ → (X → X) → (X → X))
  : ode_solve = limit (λ n => ode_solve_fixed_dt_impl n stepper) := sorry

--  ___ _
-- / __| |_ ___ _ __ _ __  ___ _ _ ___
-- \__ \  _/ -_) '_ \ '_ \/ -_) '_(_-<
-- |___/\__\___| .__/ .__/\___|_| /__/
--             |_|  |_|

def forward_euler_step (Δt : ℝ) (f : X → X) (xₙ : X) : X := xₙ + Δt * f xₙ

def midpoint_step (Δt : ℝ) (f : X → X) (xₙ : X) : X :=
  let x' := xₙ + (Δt/2) * f xₙ
  xₙ + Δt * (f x')

def runge_kutta4_step (Δt : ℝ) (f : X → X) (xₙ : X) : X :=
  let k1 := f xₙ
  let k2 := f (xₙ + (Δt/2) * k1)
  let k3 := f (xₙ + (Δt/2) * k2)
  let k4 := f (xₙ + Δt * k3)
  xₙ + (Δt/6) * (k1 + (2:ℝ)*k2 + (2:ℝ)*k3 + k4)


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.int.dvd.basic
import data.nat.pow

/-!
# Basic lemmas about the divisibility relation in `ℤ` involving powers.

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

open nat

namespace int

@[simp]
theorem sign_pow_bit1 (k : ℕ) : ∀ n : ℤ, n.sign ^ (bit1 k) = n.sign
| (n+1:ℕ) := one_pow (bit1 k)
| 0       := zero_pow (nat.zero_lt_bit1 k)
| -[1+ n] := (neg_pow_bit1 1 k).trans (congr_arg (λ x, -x) (one_pow (bit1 k)))

lemma pow_dvd_of_le_of_pow_dvd {p m n : ℕ} {k : ℤ} (hmn : m ≤ n) (hdiv : ↑(p ^ n) ∣ k) :
  ↑(p ^ m) ∣ k :=
begin
  induction k,
  { apply int.coe_nat_dvd.2,
    apply pow_dvd_of_le_of_pow_dvd hmn,
    apply int.coe_nat_dvd.1 hdiv },
  change -[1+k] with -(↑(k+1) : ℤ),
  apply dvd_neg_of_dvd,
  apply int.coe_nat_dvd.2,
  apply pow_dvd_of_le_of_pow_dvd hmn,
  apply int.coe_nat_dvd.1,
  apply dvd_of_dvd_neg,
  exact hdiv,
end

end int