import .basic
import ..myset.basic

namespace hidden

namespace myring

structure is_ideal {α : Type} [myring α] (I : myset α) : Prop :=
intro ::
(contains_zero: (0: α) ∈ I)
(add_closure (a b : α) : a ∈ I → b ∈ I → a + b ∈ I)
(mul_closure (r x : α) : x ∈ I → r * x ∈ I)

variables {α : Type} [myring α] (I J : myset α)

namespace is_ideal

theorem neg_closure {I: myset α} (hI: is_ideal I) (a: α) (ha: a ∈ I):
-a ∈ I :=
begin
  have := hI.mul_closure (-1: α) a ha,
  rw ←neg_eq_mul_neg_one at this,
  from this,
end

end is_ideal

theorem ideal_intersection (hI : is_ideal I) (hJ : is_ideal J) : is_ideal (I ∩ J) :=
begin
  split, {
    split, {
      from hI.contains_zero,
    }, {
      from hJ.contains_zero,
    },
  }, {
    intros a b,
    assume haIJ hbIJ,
    split,
      apply hI.add_closure _ _ haIJ.left hbIJ.left,
    apply hJ.add_closure _ _ haIJ.right hbIJ.right,
  }, {
    intros r x,
    assume h,
    split,
      apply hI.mul_closure _ _ h.left,
    apply hJ.mul_closure _ _ h.right,
  },
end

variables {β : Type} [myring β]

def ker (f : α → β) : myset α := { a | f a = 0 }
def im (f : α → β) : myset β := { b | ∃ a, f a = b }

structure is_homomorphism (f : α → β) : Prop :=
intro :: -- necessary ?
(respects_add (a b : α) : f (a + b) = f a + f b)
(respects_mul (a b : α) : f (a * b) = f a * f b)
(respects_one (a b : α) : f 1 = 1)

namespace is_homomorphism

variables {f : α → β} (hf : is_homomorphism f)

include hf

theorem respects_zero : f 0 = 0 :=
begin
  apply add_cancel_left (f 0),
  rw [←hf.respects_add, add_zero, add_zero],
end

theorem respects_neg (a : α) : f (-a) = -f a :=
begin
  rw [←neg_unique, ←respects_add hf, neg_add, respects_zero hf],
end

theorem kernel_ideal : is_ideal (ker f) :=
begin
  split, {
    from hf.respects_zero,
  }, {
    intros a b,
    assume ha hb,
    change f (a + b) = 0,
    change f a = 0 at ha,
    change f b = 0 at hb,
    rw [hf.respects_add, ha, hb, add_zero],
  }, {
    intros r x,
    assume hx,
    change f (r * x) = 0,
    change f x = 0 at hx,
    rw [hf.respects_mul, hx, mul_zero],
  },
end

end is_homomorphism

end myring

end hidden


/-
Copyright (c) 2019 Rohan Mitta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rohan Mitta, Kevin Buzzard, Alistair Tucker, Johannes Hölzl, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.specific_limits
import Mathlib.data.setoid.basic
import Mathlib.dynamics.fixed_points.topology
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Contracting maps

A Lipschitz continuous self-map with Lipschitz constant `K < 1` is called a *contracting map*.
In this file we prove the Banach fixed point theorem, some explicit estimates on the rate
of convergence, and some properties of the map sending a contracting map to its fixed point.

## Main definitions

* `contracting_with K f` : a Lipschitz continuous self-map with `K < 1`;
* `efixed_point` : given a contracting map `f` on a complete emetric space and a point `x`
  such that `edist x (f x) < ∞`, `efixed_point f hf x hx` is the unique fixed point of `f`
  in `emetric.ball x ∞`;
* `fixed_point` : the unique fixed point of a contracting map on a complete nonempty metric space.

## Tags

contracting map, fixed point, Banach fixed point theorem
-/

/-- A map is said to be `contracting_with K`, if `K < 1` and `f` is `lipschitz_with K`. -/
def contracting_with {α : Type u_1} [emetric_space α] (K : nnreal) (f : α → α) :=
  K < 1 ∧ lipschitz_with K f

namespace contracting_with

theorem to_lipschitz_with {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) : lipschitz_with K f :=
  and.right hf

theorem one_sub_K_pos' {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) : 0 < 1 - ↑K := sorry

theorem one_sub_K_ne_zero {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) : 1 - ↑K ≠ 0 :=
  ne_of_gt (one_sub_K_pos' hf)

theorem one_sub_K_ne_top {K : nnreal} : 1 - ↑K ≠ ⊤ := sorry

theorem edist_inequality {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} {y : α} (h : edist x y < ⊤) : edist x y ≤ (edist x (f x) + edist y (f y)) / (1 - ↑K) := sorry

theorem edist_le_of_fixed_point {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} {y : α} (h : edist x y < ⊤) (hy : function.is_fixed_pt f y) : edist x y ≤ edist x (f x) / (1 - ↑K) := sorry

theorem eq_or_edist_eq_top_of_fixed_points {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} {y : α} (hx : function.is_fixed_pt f x) (hy : function.is_fixed_pt f y) : x = y ∨ edist x y = ⊤ := sorry

/-- If a map `f` is `contracting_with K`, and `s` is a forward-invariant set, then
restriction of `f` to `s` is `contracting_with K` as well. -/
theorem restrict {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {s : set α} (hs : set.maps_to f s s) : contracting_with K (set.maps_to.restrict f s s hs) :=
  { left := and.left hf, right := fun (x y : ↥s) => and.right hf ↑x ↑y }

/-- Banach fixed-point theorem, contraction mapping theorem, `emetric_space` version.
A contracting map on a complete metric space has a fixed point.
We include more conclusions in this theorem to avoid proving them again later.

The main API for this theorem are the functions `efixed_point` and `fixed_point`,
and lemmas about these functions. -/
theorem exists_fixed_point {α : Type u_1} [emetric_space α] [cs : complete_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) (x : α) (hx : edist x (f x) < ⊤) : ∃ (y : α),
  function.is_fixed_pt f y ∧
    filter.tendsto (fun (n : ℕ) => nat.iterate f n x) filter.at_top (nhds y) ∧
      ∀ (n : ℕ), edist (nat.iterate f n x) y ≤ edist x (f x) * ↑K ^ n / (1 - ↑K) := sorry

/-- Let `x` be a point of a complete emetric space. Suppose that `f` is a contracting map,
and `edist x (f x) < ∞`. Then `efixed_point` is the unique fixed point of `f`
in `emetric.ball x ∞`. -/
def efixed_point {α : Type u_1} [emetric_space α] [cs : complete_space α] {K : nnreal} (f : α → α) (hf : contracting_with K f) (x : α) (hx : edist x (f x) < ⊤) : α :=
  classical.some (exists_fixed_point hf x hx)

theorem efixed_point_is_fixed_pt {α : Type u_1} [emetric_space α] [cs : complete_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) : function.is_fixed_pt f (efixed_point f hf x hx) :=
  and.left (classical.some_spec (exists_fixed_point hf x hx))

theorem tendsto_iterate_efixed_point {α : Type u_1} [emetric_space α] [cs : complete_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) : filter.tendsto (fun (n : ℕ) => nat.iterate f n x) filter.at_top (nhds (efixed_point f hf x hx)) :=
  and.left (and.right (classical.some_spec (exists_fixed_point hf x hx)))

theorem apriori_edist_iterate_efixed_point_le {α : Type u_1} [emetric_space α] [cs : complete_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) (n : ℕ) : edist (nat.iterate f n x) (efixed_point f hf x hx) ≤ edist x (f x) * ↑K ^ n / (1 - ↑K) :=
  and.right (and.right (classical.some_spec (exists_fixed_point hf x hx))) n

theorem edist_efixed_point_le {α : Type u_1} [emetric_space α] [cs : complete_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) : edist x (efixed_point f hf x hx) ≤ edist x (f x) / (1 - ↑K) := sorry

theorem edist_efixed_point_lt_top {α : Type u_1} [emetric_space α] [cs : complete_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) : edist x (efixed_point f hf x hx) < ⊤ :=
  lt_of_le_of_lt (edist_efixed_point_le hf hx)
    (ennreal.mul_lt_top hx (iff.mpr ennreal.lt_top_iff_ne_top (iff.mpr ennreal.inv_ne_top (one_sub_K_ne_zero hf))))

theorem efixed_point_eq_of_edist_lt_top {α : Type u_1} [emetric_space α] [cs : complete_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) {y : α} (hy : edist y (f y) < ⊤) (h : edist x y < ⊤) : efixed_point f hf x hx = efixed_point f hf y hy := sorry

/-- Banach fixed-point theorem for maps contracting on a complete subset. -/
theorem exists_fixed_point' {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} {s : set α} (hsc : is_complete s) (hsf : set.maps_to f s s) (hf : contracting_with K (set.maps_to.restrict f s s hsf)) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) : ∃ (y : α),
  ∃ (H : y ∈ s),
    function.is_fixed_pt f y ∧
      filter.tendsto (fun (n : ℕ) => nat.iterate f n x) filter.at_top (nhds y) ∧
        ∀ (n : ℕ), edist (nat.iterate f n x) y ≤ edist x (f x) * ↑K ^ n / (1 - ↑K) := sorry

/-- Let `s` be a complete forward-invariant set of a self-map `f`. If `f` contracts on `s`
and `x ∈ s` satisfies `edist x (f x) < ⊤`, then `efixed_point'` is the unique fixed point
of the restriction of `f` to `s ∩ emetric.ball x ⊤`. -/
def efixed_point' {α : Type u_1} [emetric_space α] {K : nnreal} (f : α → α) {s : set α} (hsc : is_complete s) (hsf : set.maps_to f s s) (hf : contracting_with K (set.maps_to.restrict f s s hsf)) (x : α) (hxs : x ∈ s) (hx : edist x (f x) < ⊤) : α :=
  classical.some (exists_fixed_point' hsc hsf hf hxs hx)

theorem efixed_point_mem' {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} {s : set α} (hsc : is_complete s) (hsf : set.maps_to f s s) (hf : contracting_with K (set.maps_to.restrict f s s hsf)) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) : efixed_point' f hsc hsf hf x hxs hx ∈ s :=
  Exists.fst (classical.some_spec (exists_fixed_point' hsc hsf hf hxs hx))

theorem efixed_point_is_fixed_pt' {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} {s : set α} (hsc : is_complete s) (hsf : set.maps_to f s s) (hf : contracting_with K (set.maps_to.restrict f s s hsf)) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) : function.is_fixed_pt f (efixed_point' f hsc hsf hf x hxs hx) :=
  and.left (Exists.snd (classical.some_spec (exists_fixed_point' hsc hsf hf hxs hx)))

theorem tendsto_iterate_efixed_point' {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} {s : set α} (hsc : is_complete s) (hsf : set.maps_to f s s) (hf : contracting_with K (set.maps_to.restrict f s s hsf)) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) : filter.tendsto (fun (n : ℕ) => nat.iterate f n x) filter.at_top (nhds (efixed_point' f hsc hsf hf x hxs hx)) :=
  and.left (and.right (Exists.snd (classical.some_spec (exists_fixed_point' hsc hsf hf hxs hx))))

theorem apriori_edist_iterate_efixed_point_le' {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} {s : set α} (hsc : is_complete s) (hsf : set.maps_to f s s) (hf : contracting_with K (set.maps_to.restrict f s s hsf)) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) (n : ℕ) : edist (nat.iterate f n x) (efixed_point' f hsc hsf hf x hxs hx) ≤ edist x (f x) * ↑K ^ n / (1 - ↑K) :=
  and.right (and.right (Exists.snd (classical.some_spec (exists_fixed_point' hsc hsf hf hxs hx)))) n

theorem edist_efixed_point_le' {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} {s : set α} (hsc : is_complete s) (hsf : set.maps_to f s s) (hf : contracting_with K (set.maps_to.restrict f s s hsf)) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) : edist x (efixed_point' f hsc hsf hf x hxs hx) ≤ edist x (f x) / (1 - ↑K) := sorry

theorem edist_efixed_point_lt_top' {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} {s : set α} (hsc : is_complete s) (hsf : set.maps_to f s s) (hf : contracting_with K (set.maps_to.restrict f s s hsf)) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) : edist x (efixed_point' f hsc hsf hf x hxs hx) < ⊤ :=
  lt_of_le_of_lt (edist_efixed_point_le' hsc hsf hf hxs hx)
    (ennreal.mul_lt_top hx (iff.mpr ennreal.lt_top_iff_ne_top (iff.mpr ennreal.inv_ne_top (one_sub_K_ne_zero hf))))

/-- If a globally contracting map `f` has two complete forward-invariant sets `s`, `t`,
and `x ∈ s` is at a finite distance from `y ∈ t`, then the `efixed_point'` constructed by `x`
is the same as the `efixed_point'` constructed by `y`.

This lemma takes additional arguments stating that `f` contracts on `s` and `t` because this way
it can be used to prove the desired equality with non-trivial proofs of these facts. -/
theorem efixed_point_eq_of_edist_lt_top' {α : Type u_1} [emetric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {s : set α} (hsc : is_complete s) (hsf : set.maps_to f s s) (hfs : contracting_with K (set.maps_to.restrict f s s hsf)) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) {t : set α} (htc : is_complete t) (htf : set.maps_to f t t) (hft : contracting_with K (set.maps_to.restrict f t t htf)) {y : α} (hyt : y ∈ t) (hy : edist y (f y) < ⊤) (hxy : edist x y < ⊤) : efixed_point' f hsc hsf hfs x hxs hx = efixed_point' f htc htf hft y hyt hy := sorry

end contracting_with

namespace contracting_with

theorem one_sub_K_pos {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) : 0 < 1 - ↑K :=
  iff.mpr sub_pos (and.left hf)

theorem dist_le_mul {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) (x : α) (y : α) : dist (f x) (f y) ≤ ↑K * dist x y :=
  lipschitz_with.dist_le_mul (to_lipschitz_with hf) x y

theorem dist_inequality {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) (x : α) (y : α) : dist x y ≤ (dist x (f x) + dist y (f y)) / (1 - ↑K) := sorry

theorem dist_le_of_fixed_point {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) (x : α) {y : α} (hy : function.is_fixed_pt f y) : dist x y ≤ dist x (f x) / (1 - ↑K) := sorry

theorem fixed_point_unique' {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) {x : α} {y : α} (hx : function.is_fixed_pt f x) (hy : function.is_fixed_pt f y) : x = y :=
  or.resolve_right (eq_or_edist_eq_top_of_fixed_points hf hx hy) (edist_ne_top x y)

/-- Let `f` be a contracting map with constant `K`; let `g` be another map uniformly
`C`-close to `f`. If `x` and `y` are their fixed points, then `dist x y ≤ C / (1 - K)`. -/
theorem dist_fixed_point_fixed_point_of_dist_le' {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) (g : α → α) {x : α} {y : α} (hx : function.is_fixed_pt f x) (hy : function.is_fixed_pt g y) {C : ℝ} (hfg : ∀ (z : α), dist (f z) (g z) ≤ C) : dist x y ≤ C / (1 - ↑K) := sorry

/-- The unique fixed point of a contracting map in a nonempty complete metric space. -/
def fixed_point {α : Type u_1} [metric_space α] {K : nnreal} (f : α → α) (hf : contracting_with K f) [Nonempty α] [complete_space α] : α :=
  efixed_point f hf (Classical.choice _inst_2) sorry

/-- The point provided by `contracting_with.fixed_point` is actually a fixed point. -/
theorem fixed_point_is_fixed_pt {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) [Nonempty α] [complete_space α] : function.is_fixed_pt f (fixed_point f hf) :=
  efixed_point_is_fixed_pt hf (fixed_point._proof_1 f)

theorem fixed_point_unique {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) [Nonempty α] [complete_space α] {x : α} (hx : function.is_fixed_pt f x) : x = fixed_point f hf :=
  fixed_point_unique' hf hx (fixed_point_is_fixed_pt hf)

theorem dist_fixed_point_le {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) [Nonempty α] [complete_space α] (x : α) : dist x (fixed_point f hf) ≤ dist x (f x) / (1 - ↑K) :=
  dist_le_of_fixed_point hf x (fixed_point_is_fixed_pt hf)

/-- Aposteriori estimates on the convergence of iterates to the fixed point. -/
theorem aposteriori_dist_iterate_fixed_point_le {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) [Nonempty α] [complete_space α] (x : α) (n : ℕ) : dist (nat.iterate f n x) (fixed_point f hf) ≤ dist (nat.iterate f n x) (nat.iterate f (n + 1) x) / (1 - ↑K) := sorry

theorem apriori_dist_iterate_fixed_point_le {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) [Nonempty α] [complete_space α] (x : α) (n : ℕ) : dist (nat.iterate f n x) (fixed_point f hf) ≤ dist x (f x) * ↑K ^ n / (1 - ↑K) :=
  le_trans (aposteriori_dist_iterate_fixed_point_le hf x n)
    (iff.mpr (div_le_div_right (one_sub_K_pos hf))
      (lipschitz_with.dist_iterate_succ_le_geometric (to_lipschitz_with hf) x n))

theorem tendsto_iterate_fixed_point {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) [Nonempty α] [complete_space α] (x : α) : filter.tendsto (fun (n : ℕ) => nat.iterate f n x) filter.at_top (nhds (fixed_point f hf)) := sorry

theorem fixed_point_lipschitz_in_map {α : Type u_1} [metric_space α] {K : nnreal} {f : α → α} (hf : contracting_with K f) [Nonempty α] [complete_space α] {g : α → α} (hg : contracting_with K g) {C : ℝ} (hfg : ∀ (z : α), dist (f z) (g z) ≤ C) : dist (fixed_point f hf) (fixed_point g hg) ≤ C / (1 - ↑K) :=
  dist_fixed_point_fixed_point_of_dist_le' hf g (fixed_point_is_fixed_pt hf) (fixed_point_is_fixed_pt hg) hfg


import definitions
import point3
import data.nat.prime

open nat

/-- point 4, first part-/
lemma luc_fib (m : ℕ) : luc (m + 3) = 2 * fib (m + 3) + fib m :=
int.coe_nat_inj $ by rw [int.coe_nat_add, int.coe_nat_mul];
  rw [← fib_down, ← fib_down, ← luc_down, Luc, Fib, Fib];
  rw [α_Fib, α_Fib, β_Fib]; dsimp;
  rw [add_neg_cancel_right];
  repeat { rw Fib_add_one_add_one }; simp [add_mul]

lemma fib_succ_coprime (m : ℕ) : coprime (fib (m + 1)) (fib m) :=
nat.rec_on m dec_trivial $ λ n ih,
show gcd (fib n + fib (n+1)) (fib (n+1)) = 1,
by rw [nat.gcd_add, nat.gcd_comm, coprime.gcd_eq_one ih]

lemma gcd_fib_luc_dvd_two (m : ℕ) : gcd (fib m) (luc m) ∣ 2 :=
nat.cases_on m dec_trivial $ λ n, nat.cases_on n dec_trivial $
λ n, nat.cases_on n dec_trivial $ λ n,
show gcd (fib (n+3)) (luc (n+3)) ∣ 2,
by rw [luc_fib, nat.gcd_comm, add_comm, nat.gcd_add_mul_right];
change gcd (fib n) (fib (n+1) + (fib n + fib (n+1))) ∣ 2;
rw [nat.gcd_comm, add_left_comm, add_comm, nat.gcd_add, ← mul_two];
rw [coprime.gcd_mul_left_cancel 2 (fib_succ_coprime n)];
apply nat.gcd_dvd_left

-- Prime trick thanks to Chris and Mario.
/-- point 4, last part-/
lemma gcd_fib_luc_one_or_two (m : ℕ) : gcd (fib m) (luc m) = 1 ∨ gcd (fib m) (luc m) = 2 :=
(dvd_prime prime_two).1 $ gcd_fib_luc_dvd_two m


import algebra.big_operators

open nat finset

lemma  {α : Type*} [add_comm_monoid α] (f : ℕ → ℕ → α) (n : ℕ) :
    (range n).sum (λ m, (range (m + 1)).sum (λ k, f k (m - k))) =
    (range n).sum (λ m, (range (n - m)).sum (f m)) :=
have h₁ : ((range n).sigma (range ∘ succ)).sum
    (λ (a : Σ m, ℕ), f (a.2) (a.1 - a.2)) =
    (range n).sum (λ m, (range (m + 1)).sum
    (λ k, f k (m - k))) := sum_sigma,
have h₂ : ((range n).sigma (λ m, range (n - m))).sum (λ a : Σ (m : ℕ), ℕ, f (a.1) (a.2)) =
    (range n).sum (λ m, (range (n - m)).sum (f m)) := sum_sigma,
h₁ ▸ h₂ ▸ sum_bij
(λ a _, ⟨a.2, a.1 - a.2⟩)
(λ a ha, have h₁ : a.1 < n := mem_range.1 (mem_sigma.1 ha).1,
  have h₂ : a.2 < succ a.1 := mem_range.1 (mem_sigma.1 ha).2,
    mem_sigma.2 ⟨mem_range.2 (lt_of_lt_of_le h₂ h₁),
    mem_range.2 ((nat.sub_lt_sub_right_iff (le_of_lt_succ h₂)).2 h₁)⟩)
(λ _ _, rfl)
(λ ⟨a₁, a₂⟩ ⟨b₁, b₂⟩ ha hb h,
  have ha : a₁ < n ∧ a₂ ≤ a₁ :=
      ⟨mem_range.1 (mem_sigma.1 ha).1, le_of_lt_succ (mem_range.1 (mem_sigma.1 ha).2)⟩,
  have hb : b₁ < n ∧ b₂ ≤ b₁ :=
      ⟨mem_range.1 (mem_sigma.1 hb).1, le_of_lt_succ (mem_range.1 (mem_sigma.1 hb).2)⟩,
  have h : a₂ = b₂ ∧ _ := sigma.mk.inj h,
  have h' : a₁ = b₁ - b₂ + a₂ := (nat.sub_eq_iff_eq_add ha.2).1 (eq_of_heq h.2),
  sigma.mk.inj_iff.2
    ⟨nat.sub_add_cancel hb.2 ▸ h'.symm ▸ h.1 ▸ rfl,
    (heq_of_eq h.1)⟩)
(λ ⟨a₁, a₂⟩ ha,
  have ha : a₁ < n ∧ a₂ < n - a₁ :=
      ⟨mem_range.1 (mem_sigma.1 ha).1, (mem_range.1 (mem_sigma.1 ha).2)⟩,
  ⟨⟨a₂ + a₁, a₁⟩, ⟨mem_sigma.2 ⟨mem_range.2 (by omega),
    mem_range.2 (lt_succ_of_le (le_add_left _ _))⟩,
  sigma.mk.inj_iff.2 ⟨rfl, heq_of_eq (nat.add_sub_cancel _ _).symm⟩⟩⟩)

local notation f `∑`: 90 n :90 := (range n).sum f
lemma sum_range_diag_flip (f : ℕ → ℕ → α) :
    (λ m, (λ k, f k (m - k)) ∑ (succ m)) ∑ n = (λ m, (λ k, f m k) ∑ (n - m)) ∑ n :=
begin
  suffices : ∀ j < n, (λ m, (λ k, f k (m - k)) ∑ succ (min j m)) ∑ n = (λ m, (λ k, f m k) ∑ (n - m)) ∑ succ j,
  { cases n with n,
    { simp },
    { rw ← this n (lt_succ_self _),
      apply finset.sum_congr rfl,
      assume m hm,
      rw finset.mem_range at hm,
      rw min_eq_right (le_of_lt_succ hm) } },
  assume j hj,
  induction j with j hi,
  { clear hj,
    induction n; simp * at * },
  { specialize hi (le_of_succ_le hj),
    rw [sum_range_succ _ (succ j), ← hi],
    clear hi,
    induction n with n hi,
    { exact absurd hj dec_trivial },
    { cases lt_or_eq_of_le (le_of_lt_succ hj) with hj' hj',
      { specialize hi hj',
        rw [sum_range_succ, sum_range_succ _ n, hi, min_eq_left (le_of_lt hj'), succ_sub (le_of_lt hj'),
            min_eq_left (le_of_lt (lt_of_succ_lt_succ hj)), sum_range_succ _ (_ - _), sum_range_succ _ (succ j)],
        simp },
      { rw [sum_range_succ, sum_range_succ _ n, ← hj', min_eq_left (le_refl _), min_eq_left (le_succ _), sum_range_succ _ (succ _),
          succ_sub (le_refl _), nat.sub_self, sum_range_succ _ 0, finset.range_zero, finset.sum_empty, add_zero, ← add_assoc],
        refine congr_arg _ (finset.sum_congr rfl _),
        assume m hm,
        rw finset.mem_range at hm,
        rw [min_eq_right (le_of_lt hm), min_eq_right (le_of_lt_succ hm)] } } }
end
#print sum_range_diag_flip
end sum_range

theorem binomial [comm_semiring α] (x y : α) : ∀ n : ℕ,
    (x + y)^n = (λ m, x^m * y^(n - m) * choose n m) ∑ succ n
| 0        := by simp
| (succ n) :=
begin
  rw [_root_.pow_succ, binomial, add_mul, finset.mul_sum, finset.mul_sum, sum_range_succ, sum_range_succ',
      sum_range_succ, sum_range_succ', add_assoc, ← add_assoc (_ ∑ n), ← finset.sum_add_distrib],
  have h₁ : x * (x^n * y^(n - n) * choose n n) = x^succ n * y^(succ n - succ n)
      * choose (succ n) (succ n) :=
    by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
  have  h₂ : y * (x^0 * y^(n - 0) * choose n 0) = x^0 * y^(succ n - 0) * choose (succ n) 0 :=
    by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
  have h₃ : (λ m, x * (x^m * y^(n - m) * choose n m) + y * (x^succ m * y^(n - succ m)
      * choose n (succ m))) ∑ n
      = (λ m, x^succ m * y^(succ n - succ m) * ↑(choose (succ n) (succ m))) ∑ n :=
    finset.sum_congr rfl
      begin
        assume m hm,
        rw finset.mem_range at hm,
        rw [← mul_assoc y, ← mul_assoc y, mul_right_comm y, ← _root_.pow_succ, add_one, ← succ_sub hm],
        simp [succ_sub_succ, _root_.pow_succ, choose_succ_succ, mul_add, mul_comm,
            mul_assoc, mul_left_comm]
      end,
  rw [h₁, h₂, h₃]
end

lemma zero_pow [semiring α] {n : ℕ} (hn : 0 < n) : (0 : α)^n = 0 :=
begin
  induction n with n hi,
  { exact absurd hn dec_trivial },
  { cases n with n,
    { simp },
    { simp [hi dec_trivial, _root_.pow_succ _ (succ _), zero_mul] } }
end

lemma pow_abv (x : β) {n : ℕ} (hn : 1 ≤ n) (abv: β → α) [is_absolute_value abv] : abv (x^n) = (abv x)^n :=
begin
  induction n with n hi,
  { exact absurd hn dec_trivial },
  { cases n with n,
    { simp },
    { simp [hi dec_trivial, _root_.pow_succ _ (succ _), abv_mul abv] } }
end

section geo_series
open cau_seq
variables [discrete_linear_ordered_field α] [ring β] {abv : β → α} [is_absolute_value abv]

private lemma lim_zero_pow_lt_one_aux [archimedean α] {x : β} (hx : abv x < 1) : ∀ ε > 0, ∃ i : ℕ, ∀ j ≥ i, abv (x^j) < ε :=
begin
  assume ε ε0,
  cases classical.em (x = 0),
  { existsi 1,
    assume j hj,
    simpa [h, _root_.zero_pow hj, abv_zero abv] },
  { have hx : (abv x)⁻¹ > 1 := one_lt_inv ((abv_pos abv).mpr h) hx,
    cases pow_unbounded_of_gt_one ε⁻¹ hx with i hi,
    have hax : 0 < abv x  := by rwa abv_pos abv,
    existsi max i 1,
    assume j hj,
    rw [pow_abv _ (le_trans (le_max_right _ _) hj), ← inv_lt_inv ε0 (pow_pos hax _),
        pow_inv _ _ (ne_of_lt hax).symm],
    exact lt_of_lt_of_le hi (pow_le_pow (le_of_lt hx) (le_trans (le_max_left _ _) hj)) }
end

lemma is_cau_pow_lt_one [archimedean α] {x : β} (hx : abv x < 1) : is_cau_seq abv (λ n, x^n) :=
of_near _ (const abv 0) $ by simp only [const_apply, sub_zero]; exact lim_zero_pow_lt_one_aux hx

lemma lim_zero_pow_lt_one [archimedean α] (x : β) (hx : abv x < 1) : lim_zero ⟨λ n, x^n, is_cau_pow_lt_one _ hx⟩ :=
lim_zero_pow_lt_one_aux abv hx

lemma sum_geo {x : β} (hx : x ≠ 1) : ∀ n, (λ m, x^m) ∑ n * (1 - x) = 1 - x^n
| 0       := by simp
| (n + 1) := by rw [sum_range_succ, add_mul, sum_geo]; simp [mul_add, _root_.pow_succ']

lemma is_cau_abv_geo_series [archimedean α] {x : β} (hx : abv x < 1) : is_cau_seq abs (λ n, (λ m, (abv x)^m) ∑ n) :=
begin
  have haa : abs (abv x) < 1 := by rwa abs_of_nonneg (abv_nonneg abv _),
  have hax1 : ¬ 1 - abv x = 0 := by rw [sub_eq_zero_iff_eq]; exact (ne_of_lt hx).symm,
  have hax1' : ¬ abv x = 1 := by rwa [eq_comm, ← sub_eq_zero_iff_eq],
  let s : cau_seq α abs := (cau_seq.const abs 1 - ⟨_, is_cau_pow_lt_one abs haa⟩) *
      cau_seq.inv (cau_seq.const abs (1 - abv x)) (by rwa const_lim_zero),
  refine (cau_seq.of_eq s _ _).2,
  assume n,
  simp [s],
  rw [← div_eq_mul_inv, div_eq_iff_mul_eq],
  exact sum_geo hax1' _, assumption,
end

end geo_series
-- -- proof that two different ways of representing a sum across a 2D plane are equal, used
-- -- in proof of exp (x + y) = exp x * exp y
-- lemma series_series_diag_flip [add_comm_monoid α] (f : ℕ → ℕ → α) (n : ℕ) : series (λ i,
-- series (λ k, f k (i - k)) i) n = series (λ i, series (λ k, f i k) (n - i)) n := begin
--   have : ∀ m : ℕ, m ≤ n → series (λ (i : ℕ), series (λ k, f k (i - k)) (min m i)) n =
--   series (λ i, series (λ k, f i k) (n - i)) m := by
--   { assume m mn, induction m with m' hi,
--     simp[series_succ,series_zero,mul_add,max_eq_left (zero_le n)],
--     simp only [series_succ _ m'],rw ←hi (le_of_succ_le mn),clear hi,
--     induction n with n' hi,
--     simp[series_succ],exact absurd mn dec_trivial,cases n' with n₂,
--     simp [series_succ],rw [min_eq_left mn,series_succ,min_eq_left (le_of_succ_le mn)],
--     rw eq_zero_of_le_zero (le_of_succ_le_succ mn),simp,
--     cases lt_or_eq_of_le mn,
--     simp [series_succ _ (succ n₂),min_eq_left mn,hi (le_of_lt_succ h)],rw [←add_assoc,←add_assoc],
--     suffices : series (f (succ m')) (n₂ - m') + series (λ (k : ℕ), f k (succ (succ n₂) - k)) (succ m')
--     = series (f (succ m')) (succ n₂ - m') +
--         series (λ (k : ℕ), f k (succ (succ n₂) - k)) (min m' (succ (succ n₂))),
--       rw this,rw[min_eq_left (le_of_succ_le mn),series_succ,succ_sub_succ,succ_sub (le_of_succ_le_succ (le_of_lt_succ h)),series_succ],
--       rw [add_comm (series (λ (k : ℕ), f k (succ (succ n₂) - k)) m'),add_assoc],
--     rw ←h,simp[nat.sub_self],clear hi mn h,simp[series_succ,nat.sub_self],
--     suffices : series (λ (i : ℕ), series (λ (k : ℕ), f k (i - k)) (min (succ m') i)) m' = series (λ (i : ℕ), series (λ (k : ℕ), f k (i - k)) (min m' i)) m',
--       rw [this,min_eq_left (le_succ _)],clear n₂,
--     have h₁ : ∀ i ≤ m', (λ (i : ℕ), series (λ (k : ℕ), f k (i - k)) (min (succ m') i)) i = (λ (i : ℕ), series (λ (k : ℕ), f k (i - k)) (min m' i)) i,
--       assume i im,simp, rw [min_eq_right im,min_eq_right (le_succ_of_le im)],
--     rw series_congr h₁},
--   specialize this n (le_refl _),
--   rw ←this,refine series_congr _,assume i ni,rw min_eq_right ni,
-- end

-- open monoid

-- theorem series_binomial {α : Type*} [comm_semiring α] (x y : α) (i : ℕ) : pow (x + y) i =
-- series (λ j, choose i j * pow x j * pow y (i - j)) i := begin
--   induction i with i' hi,
--   simp!,unfold monoid.pow,rw hi,
--   rw [←series_mul_left],
--   have : ∀ j : ℕ, j ≤ i' → (λ (i : ℕ), (x + y) * (↑(choose i' i) * pow x i * pow y (i' - i))) j
--   = choose i' j * pow x (succ j) * pow y (i' - j) + choose i' j * pow x j * pow y (succ i' - j) := by
--   { assume j ji,dsimp only,rw add_mul,
--     have :  x * (↑(choose i' j) * pow x j * pow y (i' - j)) + y * (↑(choose i' j) * pow x j * pow y (i' - j))
--     = ↑(choose i' j) * (x * pow x j) * pow y (i' - j) + ↑(choose i' j) * pow x j * (y * pow y (i' - j)),
--       simp[mul_comm,_root_.mul_assoc,mul_left_comm],
--     rw [this,←_root_.pow_succ,←_root_.pow_succ,succ_sub ji]},
--   rw [series_congr this],clear this,
--   clear hi,rw series_add,
--   have : series (λ (i : ℕ), ↑(choose i' i) * pow x i * pow y (succ i' - i)) i' =
--       series (λ (i : ℕ), ↑(choose i' i) * pow x i * pow y (succ i' - i)) (succ i') := by
--   { simp[series_succ],},
--   rw [this,series_succ₁,series_succ₁],
--   simp[nat.sub_self],rw ←series_add,
--   refine congr_arg _ (series_congr _),
--   assume j ji,unfold choose,rw [nat.cast_add,add_mul,add_mul],
-- end

-- lemma geo_series_eq {α : Type*} [field α] (x : α) (n : ℕ) : x ≠ 1 → series (pow x) n = (1 - pow x (succ n)) / (1 - x) := begin
--   assume x1,have x1' : 1 + -x ≠ 0,assume h,rw [eq_comm, ←sub_eq_iff_eq_add] at h,simp at h,trivial,
--   induction n with n' hi,
--   {simp![div_self x1']},
--   {rw eq_div_iff_mul_eq,simpa,
--   rw [_root_.series_succ,_root_.pow_succ _ (succ n')],
--   rw hi,simp,rw [add_mul,div_mul_cancel _ x1',mul_add],ring,exact x1'},
-- end

-- lemma is_cau_geo_series {α : Type*} [discrete_linear_ordered_field α] [archimedean α] (x : α) :
-- abs x < 1 → is_cau_seq abs (series (pow x)) := begin
--   assume x1, have : series (pow x) = λ n,(1 - pow x (succ n)) / (1 - x),
--     apply funext,assume n,refine geo_series_eq x n _ ,assume h, rw h at x1,exact absurd x1 (by norm_num),rw this,
--   have absx : 0 < abs (1 - x),refine abs_pos_of_ne_zero _,assume h,rw sub_eq_zero_iff_eq at h,rw ←h at x1,
--   have : ¬abs (1 : α) < 1,norm_num,trivial,simp at absx,
--   cases classical.em (x = 0),rw h,simp[monoid.pow],assume ε ε0,existsi 1,assume j j1,simpa!,
--   have x2: 1 < (abs x)⁻¹,rw lt_inv,simpa,{norm_num},exact abs_pos_of_ne_zero h,
--   have pos_x : 0 < abs x := abs_pos_of_ne_zero h,
--   assume ε ε0,
--   cases pow_unbounded_of_gt_one (2 / (ε * abs (1 - x))) x2 with i hi,
--   have ε2 : 0 < 2 / (ε * abs (1 - x)) := div_pos (by norm_num) (mul_pos ε0 absx),
--   rw [pow_inv,lt_inv ε2 (pow_pos pos_x _)] at hi,
--   existsi i,assume j ji,rw [inv_eq_one_div,div_div_eq_mul_div,_root_.one_mul,lt_div_iff (by norm_num : (0 : α) < 2)] at hi,
--   rw [div_sub_div_same,abs_div,div_lt_iff absx],
--   refine lt_of_le_of_lt _ hi,
--   simp,
--   refine le_trans (abs_add _ _) _,
--   have : pow (abs x) i * 2 = pow (abs x) i + pow (abs x) i,ring,
--   rw this,
--   refine add_le_add _ _,
--   {rw [←_root_.one_mul (pow (abs x) i),pow_abs,_root_.pow_succ,abs_mul],
--   exact mul_le_mul_of_nonneg_right (le_of_lt x1) (abs_nonneg _)},
--   {rw [abs_neg,←pow_abs],
--   rw [←inv_le_inv (pow_pos pos_x _) (pow_pos pos_x _),←pow_inv,←pow_inv],
--   refine pow_le_pow (le_of_lt x2) (le_succ_of_le ji),}
-- end

-- lemma is_cau_geo_series_const {α : Type*} [discrete_linear_ordered_field α] [archimedean α] (a x : α) :
-- abs x < 1 → is_cau_seq abs (series (λ n, a * pow x n)) := begin
--   assume x1 ε ε0,
--   cases classical.em (a = 0),
--   existsi 0,intros,rw [series_mul_left],induction j,simp!,assumption,rw h,simpa!,
--   cases is_cau_geo_series x x1 (ε / abs a) (div_pos ε0 (abs_pos_of_ne_zero h)) with i hi,
--   existsi i,assume j ji,rw [series_mul_left,series_mul_left,←mul_sub,abs_mul,mul_comm,←lt_div_iff],
--   exact hi j ji,exact abs_pos_of_ne_zero h,
-- end

-- lemma is_cau_series_of_abv_le_cau {α : Type*} {β : Type*} [discrete_linear_ordered_field α] [ring β] {f : ℕ → β}
-- {g : ℕ → α} {abv : β → α} [is_absolute_value abv] (n : ℕ) : (∀ m, n ≤ m → abv (f m) ≤ g m) →
-- is_cau_seq abs (series g) → is_cau_seq abv (series f) := begin
--   assume hm hg ε ε0,cases hg (ε / 2) (div_pos ε0 (by norm_num)) with i hi,
--   existsi max n i,
--   assume j ji,
--   have hi₁ := hi j (le_trans (le_max_right n i) ji),
--   have hi₂ := hi (max n i) (le_max_right n i),
--   have sub_le := abs_sub_le (series g j) (series g i) (series g (max n i)),
--   have := add_lt_add hi₁ hi₂,rw abs_sub (series g (max n i)) at this,
--   have ε2 : ε / 2 + ε / 2 = ε,ring,
--   rw ε2 at this,
--   refine lt_of_le_of_lt _ this,
--   refine le_trans _ sub_le,
--   refine le_trans _ (le_abs_self _),
--   generalize hk : j - max n i = k,clear this ε2 hi₂ hi₁ hi ε0 ε hg sub_le,
--   rw nat.sub_eq_iff_eq_add ji at hk,rw hk, clear hk ji j,
--   induction k with k' hi,simp,rw abv_zero abv,
--   rw succ_add,unfold series,
--   rw [add_comm,add_sub_assoc],
--   refine le_trans (abv_add _ _ _) _,
--   rw [add_comm (series g (k' + max n i)),add_sub_assoc],
--   refine add_le_add _ _,
--   refine hm _ _,rw [←zero_add n,←succ_add],refine add_le_add _ _,exact zero_le _,
--   simp, exact le_max_left _ _,assumption,
-- end

-- -- The form of ratio test with  0 ≤ r < 1, and abv (f (succ m)) ≤ r * abv (f m) handled zero terms of series the best
-- lemma series_ratio_test {α : Type*} {β : Type*} [discrete_linear_ordered_field α] [ring β]
-- [archimedean α] {abv : β → α} [is_absolute_value abv] {f : ℕ → β} (n : ℕ) (r : α) :
-- 0 ≤ r → r < 1 → (∀ m, n ≤ m → abv (f (succ m)) ≤ r * abv (f m)) → is_cau_seq abv (series f)
--   := begin
--   assume r0 r1 h,
--   refine is_cau_series_of_abv_le_cau (succ n) _ (is_cau_geo_series_const (abv (f (succ n)) * pow r⁻¹ (succ n)) r _),
--   assume m mn,
--   generalize hk : m - (succ n) = k,rw nat.sub_eq_iff_eq_add mn at hk,
--   cases classical.em (r = 0) with r_zero r_pos,have m_pos := lt_of_lt_of_le (succ_pos n) mn,
--   have := pred_le_pred mn,simp at this,
--   have := h (pred m) this,simp[r_zero,succ_pred_eq_of_pos m_pos] at this,
--   refine le_trans this _,refine mul_nonneg _ _,refine mul_nonneg (abv_nonneg _ _) (pow_nonneg (inv_nonneg.mpr r0) _),exact pow_nonneg r0 _,
--   replace r_pos : 0 < r,cases lt_or_eq_of_le r0 with h h,exact h,exact absurd h.symm r_pos,
--   revert m n,
--   induction k with k' hi,assume m n h mn hk,
--   rw [hk,zero_add,mul_right_comm,←pow_inv _ _ (ne_of_lt r_pos).symm,←div_eq_mul_inv,mul_div_cancel],
--   exact (ne_of_lt (pow_pos r_pos _)).symm,
--   assume m n h mn hk,rw [hk,succ_add],
--   have kn : k' + (succ n) ≥ (succ n), rw ←zero_add (succ n),refine add_le_add _ _,exact zero_le _,simp,
--   replace hi := hi (k' + (succ n)) n h kn rfl,
--   rw [(by simp!;ring : pow r (succ (k' + succ n)) = pow r (k' + succ n) * r),←_root_.mul_assoc],
--   replace h := h (k' + succ n) (le_of_succ_le kn),rw mul_comm at h,
--   exact le_trans h (mul_le_mul_of_nonneg_right hi r0),
--   rwa abs_of_nonneg r0,
-- end

-- lemma series_cau_of_abv_cau {α : Type*} {β : Type*} [discrete_linear_ordered_field α] [ring β] {abv : β → α} {f : ℕ → β}
-- [is_absolute_value abv] : is_cau_seq abs (series (λ n, abv (f n))) → is_cau_seq abv (series f) :=
--    λ h, is_cau_series_of_abv_le_cau 0 (λ n h, le_refl _) h

-- -- I did not use the equivalent function on cauchy sequences as I do not have a proof
-- -- series (λ n, series (λ m, a m * b (n - m)) n) j) is a cauchy sequence. Using this lemma
-- -- and of_near, this can be proven to be a cauchy sequence
-- lemma series_cauchy_prod {α β : Type*} [discrete_linear_ordered_field α] [ring β] {a b : ℕ → β}
-- {abv : β → α} [is_absolute_value abv] : is_cau_seq abs (series (λ n, abv (a n))) → is_cau_seq abv (series b) →
-- ∀ ε : α, 0 < ε → ∃ i : ℕ, ∀ j ≥ i, abv (series a j * series b j - series (λ n,
-- series (λ m, a m * b (n - m)) n) j) < ε := begin
-- -- slightly adapted version of theorem 9.4.7 from "The Real Numbers and Real Analysis", Ethan D. Bloch
--   assume ha hb ε ε0,
--   cases cau_seq.bounded ⟨_, hb⟩ with Q hQ,simp at hQ,
--   cases cau_seq.bounded ⟨_, ha⟩ with P hP,simp at hP,
--   have P0 : 0 < P,exact lt_of_le_of_lt (abs_nonneg _) (hP 0),
--   have Pε0 := div_pos ε0 (mul_pos (show (2 : α) > 0, from by norm_num) P0),
--   cases cau_seq.cauchy₂ ⟨_, hb⟩ Pε0 with N hN,simp at hN,
--   have Qε0 := div_pos ε0 (mul_pos (show (4 : α) > 0, from by norm_num) (lt_of_le_of_lt (abv_nonneg _ _) (hQ 0))),
--   cases cau_seq.cauchy₂ ⟨_, ha⟩ Qε0 with M hM,simp at hM,
--   existsi 2 * (max N M + 1),
--   assume K hK,have := series_series_diag_flip (λ m n, a m * b n) K,simp at this,rw this,clear this,
--   have : (λ (i : ℕ), series (λ (k : ℕ), a i * b k) (K - i)) = (λ (i : ℕ), a i * series (λ (k : ℕ), b k) (K - i)) := by
--     {apply funext,assume i,rw series_mul_left},
--   rw this,clear this,simp,
--   have : series (λ (i : ℕ), a i * series b (K - i)) K = series (λ (i : ℕ), a i * (series b (K - i) - series b K))
--   K + series (λ i, a i * series b K) K,
--     {rw ←series_add,simp[(mul_add _ _ _).symm]},
--   rw this, clear this,
--   rw series_mul_series,simp,
--   rw abv_neg abv,
--   refine lt_of_le_of_lt (abv_series_le_series_abv _) _,
--   simp [abv_mul abv],
--   suffices : series (λ (i : ℕ), abv (a i) * abv (series b (K - i) + -series b K)) (max N M + 1) +
--   (series (λ (i : ℕ), abv (a i) * abv (series b (K - i) + -series b K)) K -series (λ (i : ℕ),
--   abv (a i) * abv (series b (K - i) + -series b K)) (max N M + 1)) < ε / (2 * P) * P + ε / (4 * Q) * (2 * Q),
--   { simp [(div_div_eq_div_mul _ _ _).symm] at this,
--     rwa[div_mul_cancel _ (ne_of_lt P0).symm,(by norm_num : (4 : α) = 2 * 2),←div_div_eq_div_mul,mul_comm (2 : α),←_root_.mul_assoc,
--     div_mul_cancel _ (ne_of_lt (lt_of_le_of_lt (abv_nonneg _ _) (hQ 0))).symm,div_mul_cancel,add_halves] at this,
--     norm_num},
--   refine add_lt_add _ _,
--   {have : series (λ (i : ℕ), abv (a i) * abv (series b (K - i) + -series b K)) (max N M + 1) ≤ series
--   (λ (i : ℕ), abv (a i) * (ε / (2 * P))) (max N M + 1) := by
--     {refine series_le_series _,assume m mJ,refine mul_le_mul_of_nonneg_left _ _,
--       {refine le_of_lt (hN (K - m) K _ _),{
--       refine nat.le_sub_left_of_add_le (le_trans _ hK),
--       rw[succ_mul,_root_.one_mul],
--       exact add_le_add mJ (le_trans (le_max_left _ _) (le_of_lt (lt_add_one _)))},
--       {refine le_trans _ hK,rw ←_root_.one_mul N,
--       refine mul_le_mul (by norm_num) (by rw _root_.one_mul;exact le_trans (le_max_left _ _)
--       (le_of_lt (lt_add_one _))) (zero_le _) (zero_le _)}},
--       exact abv_nonneg abv _},
--   refine lt_of_le_of_lt this _,
--   rw [series_mul_right,mul_comm],
--   specialize hP (max N M + 1),rwa abs_of_nonneg at hP,
--   exact (mul_lt_mul_left Pε0).mpr hP,
--   exact series_nonneg (λ x h, abv_nonneg abv _)},
--   {have hNMK : max N M + 1 < K := by
--     {refine lt_of_lt_of_le _ hK,
--     rw [succ_mul,_root_.one_mul,←add_zero (max N M + 1)],
--     refine add_lt_add_of_le_of_lt (le_refl _) _,rw add_zero,
--     refine add_pos_of_nonneg_of_pos (zero_le _) (by norm_num)},
--   rw series_sub_series _ hNMK,
--   have : series (λ (k : ℕ), abv (a (k + (max N M + 1 + 1))) * abv
--   (series b (K - (k + (max N M + 1 + 1))) + -series b K)) (K - (max N M + 1 + 1)) ≤
--   series (λ (k : ℕ), abv (a (k + (max N M + 1 + 1))) * (2 * Q)) (K - (max N M + 1 + 1)) := by
--     {refine series_le_series _,
--     assume m hm,
--     refine mul_le_mul_of_nonneg_left _ _,
--     {refine le_trans (abv_add abv _ _) _,
--     rw (by ring : 2 * Q = Q + Q),
--     refine add_le_add (le_of_lt (hQ _)) _,
--     rw abv_neg abv, exact le_of_lt (hQ _)},
--     exact abv_nonneg abv _},
--   refine lt_of_le_of_lt this _,
--   rw [series_mul_right],
--   refine (mul_lt_mul_right (mul_pos (by norm_num) (lt_of_le_of_lt (abv_nonneg abv _) (hQ 0)))).mpr _,
--   refine lt_of_le_of_lt (le_abs_self _) _,
--   rw[←@series_sub_series _ _ (λ k, abv (a k)) (max N M + 1) K hNMK],
--   refine hM _ _ _ (le_trans (le_max_right _ _) (le_of_lt (lt_add_one _))),
--   refine le_trans _ hK,
--   rw [succ_mul,_root_.one_mul,←add_zero M],
--   exact add_le_add (le_trans (le_max_right _ _) (le_of_lt (lt_add_one _))) (zero_le _)},
-- end


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

import LeanColls.AuxLemmas

namespace LeanColls

/-! # Bit vectors

Bit 0 is the least significant bit.
-/
def BitVec (size) :=  Fin (2^size)

namespace BitVec

def get (bv : BitVec n) (i : Fin n) : Bool :=
  (bv.val >>> i.val) % 2 == 1

def set (bv : BitVec n) (i : Fin n) (x : Bool) : BitVec n :=
  match bv, i with
  | ⟨data, h_data⟩, ⟨i, h_i⟩ =>
    if x then
      -- Set bit i to 1
      ⟨data ||| (1 <<< i), sorry⟩
    else
      -- Set bit i to 0
      ⟨data &&& ((1 <<< n) - 1 - (1 <<< i)), sorry⟩

def flip (bv : BitVec n) (i : Fin n) : BitVec n :=
  bv.set i (not <| bv.get i)

def empty (n : Nat) : BitVec n := ⟨0, Nat.pos_pow_of_pos _ (by decide)⟩

instance : OfNat (BitVec n) 0 := ⟨empty n⟩

@[simp]
theorem shiftLeft_bitwiseOr (a b i : Nat)
  : (a ||| b) >>> i = (a >>> i) ||| (b >>> i)
  := by sorry

@[simp]
theorem shiftRight_shiftLeft (i j)
  : 2^i >>> j = if j > i then 0 else 2^(i-j)
  := by sorry

theorem get_set (bv : BitVec n) (i x) (j : Fin n)
  : get (set bv i x) j = if i = j then x else get bv j
  := by
  simp [get, set]
  split <;> split <;> (subst_vars; simp)
  repeat sorry

theorem shiftRight_zero (n i : Nat)
  : n >>> (i+1) = n >>> i / 2
  := by simp [HShiftRight.hShiftRight, ShiftRight.shiftRight, Nat.shiftRight]

theorem shiftRight_succ (n i : Nat)
  : n >>> (i+1) = n >>> i / 2
  := by simp [HShiftRight.hShiftRight, ShiftRight.shiftRight, Nat.shiftRight]

theorem zero_shiftRight (i : Nat) : 0 >>> i = 0
  := by
  induction i <;> simp [shiftRight_zero, shiftRight_succ]
  rw [(by assumption : _ >>> _ = 0)]
  simp

theorem get_empty (n i)
  : get (empty n) i = false
  := by
  match i with
  | ⟨i,h_i⟩ =>
  simp [empty,get]
  simp [zero_shiftRight]

def toString (bv : BitVec n) :=
  String.leftpad n '0' (String.mk (Nat.toDigits 2 bv.val))

instance : ToString (BitVec n) := ⟨toString⟩

instance : DecidableEq (BitVec n) :=
  cast (by simp [BitVec]) (inferInstance : DecidableEq (Fin (2^n)))

instance : Inhabited (BitVec n) := ⟨empty n⟩

end BitVec