/-
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.special_functions.exp_deriv

/-!
# 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_add_comm_group E] [normed_space ℝ E]
          {F : Type*} [normed_add_comm_group F] [normed_space ℝ F]

open metric set asymptotics filter real
open_locale classical topology 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 𝓝[>] 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,
  refine this.trans ((add_le_add (add_le_add (f_bound t ht) (g_bound t ht))
    (hv t (f t) (hfs t ht) (g t) (hgs t ht))).trans _),
  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 hx y 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 hx y 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 hx y hy, (hv t).dist_le_mul x y)
  hf hf' hfs hg hg' (λ t ht, trivial) ha


import algebra.order data.fintype group_theory.subgroup data.set.basic data.rat

variables {G : Type*} [group G]
variables (H K : set G)
variables [is_subgroup H] [is_subgroup K]

definition is_cyclic (G : Type*) [group G] := ∃ x : G, gpowers x = set.univ
-- 1. Let G be a group. For each of the following statements, say whether or not it is true in general, and give a proof or a counterexample.

-- (a) If G is not cyclic then G is not abelian.
    -- False (e.g : (ℝ,+))

-- (b) For every element g of G there is an abelian subgroup of G which contains g.
--theorem sheet06_q1b (G : Type*) (g : G) (H : Type*) [comm_group H]: ∃ H ∧ g ∈ H := sorry
--theorem sheet06_q1b (G : Type*) : exists H : set G, [is_subgroup H] ∧ (∀ a b ∈ H, a * b = b * a) := sorry

-- (c) If G = ⟨g⟩ is an infinite cyclic group, then the only generators for G are g and g⁻¹.
--theorem sheet06_q1c (G : Type*) : is_cyclic G → (gpowers g = G) ∧ (gpowers g⁻¹ = G) := sorry

-- (d) If G is infinite then G has an element of infinite order.
    -- False (e.g: set of all complex roots of unity)

-- (e) If the order of every non-identity element of G is a prime number, then G is cyclic.
--theorem sheet06_q1e (G : Type*) (g : G) (g ≠ 1) (order_of g : prime) : is_cyclic G := sorry

-- (f) If G has order 4, then G is abelian.
    --False. (e.g: Klein Four Group)

-- (g) If G is abelian then every subgroup of G is abelian.
--theorem sheet06_q1g (G : Type*) [comm_group G] (H : set G) [is_subgroup H] : comm_group H := sorry

-- (h) If G is cyclic then every subgroup of G is cyclic.
--theorem sheet06_q1h (G : Type*) : is_cyclic G → is_cyclic H := sorry

-- (i) If x, y ∈ G, then x and y⁻¹xy have the same order.
-- theorem sheet06_q1i (G : Type*) (x y : G): order_of x = order_of (y⁻¹ * x * y) := sorry

-- (j) If x,y ∈ G have order 2, then xy has order 2.
    -- False. (e.g:(1,2),(2,3)∈ S₃)

definition gsymmetric (n : ℕ) := equiv.perm (fin n)

-- *2. (a) Write down all of the cycle shapes of the elements of S₅. For each cycle shape, calculate how many elements there are with that shape. (Check that your answers add up to |S₅| = 120.)
-- theorem sheet06_q2a:

-- (b) How many elements of S₅ have order 2?
-- theorem sheet06_q2b:

-- (c) How many subgroups of size 3 are there in the group S₅?
-- theorem sheet06_q2c:

-- 3. (a) Let H₁ be the cyclic subgroup ⟨(1234)⟩ of S₄ . Write down the right cosets of H in S₄.
-- theorem sheet06_q2d:

-- (b) Find a subgroup H₂ of S₄ of order 4, in which all of the non-identity elements have the same cycle shape. Write down its right cosets in S₄.
-- theorem sheet06_q2e:

-- (c) Which of the right cosets you have found for H₁ and H₂ are also left cosets?
-- theorem sheet06_q2f:

-- 4. Let G be a finite group of order n, and H a subgroup of G of order m.

-- (a) For x,y ∈ G, show that Hx = Hy ⇐⇒ xy⁻¹ ∈ H.
-- theorem sheet06_q4a (x y : G) : x * l  = x * l ↔ x * y⁻¹ ∈ H := sorry

-- (c) Give an example to show that in (b), the integer k need not divide r.
-- theorem sheet06_q4c:

-- 5. Let G be a group,and let S be a subset of G.We say that S generates G if every element in G can be written as a product of elements of S and their inverses. (For example, if G is the cyclic group ⟨g⟩, then {g} generates G.)
-- theorem sheet06_q4d:

-- (a) Let 2≤k≤n. Show that a k-cycle (a1 ...,ak)in Sn can be written as a product of k−1 distinct cycles of length 2. Deduce that the set of 2-cycles in Sn generates Sn.
-- theorem sheet06_q4e:

-- (b) Show that the group (Q, +) is not generated by any finite subset.
--theorem sheet06_q4f (:

-- bit0 stands for the binary representation of 2*n. n in binary -> 2*n appends a zero
#print bit0


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import probability.probability_mass_function.constructions

/-!
# Uniform Probability Mass Functions

This file defines a number of uniform `pmf` distributions from various inputs,
  uniformly drawing from the corresponding object.

`pmf.uniform_of_finset` gives each element in the set equal probability,
  with `0` probability for elements not in the set.

`pmf.uniform_of_fintype` gives all elements equal probability,
  equal to the inverse of the size of the `fintype`.

`pmf.of_multiset` draws randomly from the given `multiset`, treating duplicate values as distinct.
  Each probability is given by the count of the element divided by the size of the `multiset`

-/

namespace pmf

noncomputable theory
variables {α β γ : Type*}
open_locale classical big_operators nnreal ennreal

section uniform_of_finset

/-- Uniform distribution taking the same non-zero probability on the nonempty finset `s` -/
def uniform_of_finset (s : finset α) (hs : s.nonempty) : pmf α :=
of_finset (λ a, if a ∈ s then s.card⁻¹ else 0) s (Exists.rec_on hs (λ x hx,
  calc ∑ (a : α) in s, ite (a ∈ s) (s.card : ℝ≥0∞)⁻¹ 0
    = ∑ (a : α) in s, (s.card : ℝ≥0∞)⁻¹ : finset.sum_congr rfl (λ x hx, by simp [hx])
    ... = (s.card : ℝ≥0∞) * (s.card : ℝ≥0∞)⁻¹ : by rw [finset.sum_const, nsmul_eq_mul]
    ... = 1 : ennreal.mul_inv_cancel (by simpa only [ne.def, nat.cast_eq_zero, finset.card_eq_zero]
      using (finset.nonempty_iff_ne_empty.1 hs)) (ennreal.nat_ne_top s.card)))
        (λ x hx, by simp only [hx, if_false])

variables {s : finset α} (hs : s.nonempty) {a : α}

@[simp] lemma uniform_of_finset_apply (a : α) :
  uniform_of_finset s hs a = if a ∈ s then s.card⁻¹ else 0 := rfl

lemma uniform_of_finset_apply_of_mem (ha : a ∈ s) : uniform_of_finset s hs a = (s.card)⁻¹ :=
by simp [ha]

lemma uniform_of_finset_apply_of_not_mem (ha : a ∉ s) : uniform_of_finset s hs a = 0 :=
by simp [ha]

@[simp] lemma support_uniform_of_finset : (uniform_of_finset s hs).support = s :=
set.ext (let ⟨a, ha⟩ := hs in by simp [mem_support_iff, finset.ne_empty_of_mem ha])

lemma mem_support_uniform_of_finset_iff (a : α) : a ∈ (uniform_of_finset s hs).support ↔ a ∈ s :=
by simp

section measure

variable (t : set α)

@[simp] lemma to_outer_measure_uniform_of_finset_apply :
  (uniform_of_finset s hs).to_outer_measure t = (s.filter (∈ t)).card / s.card :=
calc (uniform_of_finset s hs).to_outer_measure t
  = ∑' x, if x ∈ t then (uniform_of_finset s hs x) else 0 :
    to_outer_measure_apply (uniform_of_finset s hs) t
  ... = ∑' x, if x ∈ s ∧ x ∈ t then (s.card : ℝ≥0∞)⁻¹ else 0 :
    (tsum_congr (λ x, by simp only [uniform_of_finset_apply,
      and_comm (x ∈ s), ite_and, ennreal.coe_nat]))
  ... = (∑ x in (s.filter (∈ t)), if x ∈ s ∧ x ∈ t then (s.card : ℝ≥0∞)⁻¹ else 0) :
    (tsum_eq_sum (λ x hx, if_neg (λ h, hx (finset.mem_filter.2 h))))
  ... = (∑ x in (s.filter (∈ t)), (s.card : ℝ≥0∞)⁻¹) :
    (finset.sum_congr rfl $ λ x hx, let this : x ∈ s ∧ x ∈ t := by simpa using hx in
      by simp only [this, and_self, if_true])
  ... = (s.filter (∈ t)).card / s.card :
    have (s.card : ℝ≥0∞) ≠ 0 := nat.cast_ne_zero.2 (hs.rec_on $ λ _, finset.card_ne_zero_of_mem),
    by simp only [div_eq_mul_inv, finset.sum_const, nsmul_eq_mul]

@[simp] lemma to_measure_uniform_of_finset_apply [measurable_space α] (ht : measurable_set t) :
  (uniform_of_finset s hs).to_measure t = (s.filter (∈ t)).card / s.card :=
(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
  (to_outer_measure_uniform_of_finset_apply hs t)

end measure

end uniform_of_finset

section uniform_of_fintype

/-- The uniform pmf taking the same uniform value on all of the fintype `α` -/
def uniform_of_fintype (α : Type*) [fintype α] [nonempty α] : pmf α :=
  uniform_of_finset (finset.univ) (finset.univ_nonempty)

variables [fintype α] [nonempty α]

@[simp] lemma uniform_of_fintype_apply (a : α) : uniform_of_fintype α a = (fintype.card α)⁻¹ :=
by simpa only [uniform_of_fintype, finset.mem_univ, if_true, uniform_of_finset_apply]

@[simp] lemma support_uniform_of_fintype (α : Type*) [fintype α] [nonempty α] :
  (uniform_of_fintype α).support = ⊤ :=
set.ext (λ x, by simp [mem_support_iff])

lemma mem_support_uniform_of_fintype (a : α) : a ∈ (uniform_of_fintype α).support := by simp

section measure

variable (s : set α)

lemma to_outer_measure_uniform_of_fintype_apply :
  (uniform_of_fintype α).to_outer_measure s = fintype.card s / fintype.card α :=
by simpa [uniform_of_fintype]

lemma to_measure_uniform_of_fintype_apply [measurable_space α] (hs : measurable_set s) :
  (uniform_of_fintype α).to_measure s = fintype.card s / fintype.card α :=
by simpa [uniform_of_fintype, hs]

end measure

end uniform_of_fintype

section of_multiset

/-- Given a non-empty multiset `s` we construct the `pmf` which sends `a` to the fraction of
  elements in `s` that are `a`. -/
def of_multiset (s : multiset α) (hs : s ≠ 0) : pmf α :=
⟨λ a, s.count a / s.card, ennreal.summable.has_sum_iff.2
  (calc ∑' (b : α), (s.count b : ℝ≥0∞) / s.card = s.card⁻¹ * ∑' b, s.count b :
      by simp_rw [ennreal.div_eq_inv_mul, ennreal.tsum_mul_left]
    ... = s.card⁻¹ * ∑ b in s.to_finset, (s.count b : ℝ≥0∞) :
      congr_arg (λ x, s.card⁻¹ * x) (tsum_eq_sum $ λ a ha, (nat.cast_eq_zero.2 $
        by rwa [multiset.count_eq_zero, ← multiset.mem_to_finset]))
    ... = 1 : by rw [← nat.cast_sum, multiset.to_finset_sum_count_eq s, ennreal.inv_mul_cancel
      (nat.cast_ne_zero.2 (hs ∘ multiset.card_eq_zero.1)) (ennreal.nat_ne_top _)] ) ⟩

variables {s : multiset α} (hs : s ≠ 0)

@[simp] lemma of_multiset_apply (a : α) : of_multiset s hs a = s.count a / s.card := rfl

@[simp] lemma support_of_multiset : (of_multiset s hs).support = s.to_finset :=
set.ext (by simp [mem_support_iff, hs])

lemma of_multiset_apply_of_not_mem {a : α} (ha : a ∉ s) : of_multiset s hs a = 0 :=
by simpa only [of_multiset_apply, ennreal.div_zero_iff, nat.cast_eq_zero,
  multiset.count_eq_zero, ennreal.nat_ne_top, or_false] using ha

section measure

variable (t : set α)

@[simp] lemma to_outer_measure_of_multiset_apply :
  (of_multiset s hs).to_outer_measure t = (∑' x, (s.filter (∈ t)).count x) / s.card :=
begin
  rw [div_eq_mul_inv, ← ennreal.tsum_mul_right, to_outer_measure_apply],
  refine tsum_congr (λ x, _),
  by_cases hx : x ∈ t;
  simp [set.indicator, hx, div_eq_mul_inv],
end

@[simp] lemma to_measure_of_multiset_apply [measurable_space α] (ht : measurable_set t) :
  (of_multiset s hs).to_measure t = (∑' x, (s.filter (∈ t)).count x) / s.card :=
(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
  (to_outer_measure_of_multiset_apply hs t)

end measure

end of_multiset

end pmf


/-
Ported by Deniz Aydin from the lean3 prelude:
https://github.com/leanprover-community/lean/blob/master/library/init/algebra/order.lean

Original file's license:
  Copyright (c) 2016 Microsoft Corporation. All rights reserved.
  Released under Apache 2.0 license as described in the file LICENSE.
  Authors: Leonardo de Moura
-/
import Mathlib.Init.Logic

/-!
# Orders

Defines classes for preorders, partial orders, and linear orders
and proves some basic lemmas about them.
-/

/-
TODO: Does Lean4 have an equivalent for this:
  Make sure instances defined in this file have lower priority than the ones
  defined for concrete structures
set_option default_priority 100
-/

universe u
variable {α : Type u}

-- set_option auto_param.check_exists false

section Preorder

/-!
### Definition of `Preorder` and lemmas about types with a `Preorder`
-/

/-- A preorder is a reflexive, transitive relation `≤` with `a < b` defined in the obvious way. -/
class Preorder (α : Type u) extends LE α, LT α :=
(le_refl : ∀ a : α, a ≤ a)
(le_trans : ∀ a b c : α, a ≤ b → b ≤ c → a ≤ c)
(lt := λ a b => a ≤ b ∧ ¬ b ≤ a)
(lt_iff_le_not_le : ∀ a b : α, a < b ↔ (a ≤ b ∧ ¬ b ≤ a)) -- . order_laws_tac)

variable [Preorder α]

/-- The relation `≤` on a preorder is reflexive. -/
@[simp] theorem le_refl : ∀ (a : α), a ≤ a :=
Preorder.le_refl

/-- The relation `≤` on a preorder is transitive. -/
theorem le_trans : ∀ {a b c : α}, a ≤ b → b ≤ c → a ≤ c :=
Preorder.le_trans _ _ _

theorem lt_iff_le_not_le : ∀ {a b : α}, a < b ↔ (a ≤ b ∧ ¬ b ≤ a) :=
Preorder.lt_iff_le_not_le _ _

theorem lt_of_le_not_le : ∀ {a b : α}, a ≤ b → ¬ b ≤ a → a < b
| a, b, hab, hba => lt_iff_le_not_le.mpr ⟨hab, hba⟩

theorem le_not_le_of_lt : ∀ {a b : α}, a < b → a ≤ b ∧ ¬ b ≤ a
| a, b, hab => lt_iff_le_not_le.mp hab

theorem le_of_eq {a b : α} : a = b → a ≤ b :=
λ h => h ▸ le_refl a

theorem ge_trans : ∀ {a b c : α}, a ≥ b → b ≥ c → a ≥ c :=
λ h₁ h₂ => le_trans h₂ h₁

theorem lt_irrefl : ∀ a : α, ¬ a < a
| a, haa => match le_not_le_of_lt haa with
  | ⟨h1, h2⟩ => h2 h1

theorem gt_irrefl : ∀ a : α, ¬ a > a :=
lt_irrefl

theorem lt_trans : ∀ {a b c : α}, a < b → b < c → a < c
| a, b, c, hab, hbc =>
  match le_not_le_of_lt hab, le_not_le_of_lt hbc with
  | ⟨hab, hba⟩, ⟨hbc, hcb⟩ => lt_of_le_not_le (le_trans hab hbc) (λ hca => hcb (le_trans hca hab))

theorem gt_trans : ∀ {a b c : α}, a > b → b > c → a > c :=
λ h₁ h₂ => lt_trans h₂ h₁

theorem ne_of_lt {a b : α} (h : a < b) : a ≠ b :=
λ he => absurd h (he ▸ lt_irrefl a)

theorem ne_of_gt {a b : α} (h : b < a) : a ≠ b :=
λ he => absurd h (he ▸ lt_irrefl a)

theorem lt_asymm {a b : α} (h : a < b) : ¬ b < a :=
λ h1 : b < a => lt_irrefl a (lt_trans h h1)

theorem le_of_lt : ∀ {a b : α}, a < b → a ≤ b
| a, b, hab => (le_not_le_of_lt hab).left

theorem lt_of_lt_of_le : ∀ {a b c : α}, a < b → b ≤ c → a < c
| a, b, c, hab, hbc =>
  let ⟨hab, hba⟩ := le_not_le_of_lt hab
  lt_of_le_not_le (le_trans hab hbc) $ λ hca => hba (le_trans hbc hca)

theorem lt_of_le_of_lt : ∀ {a b c : α}, a ≤ b → b < c → a < c
| a, b, c, hab, hbc =>
  let ⟨hbc, hcb⟩ := le_not_le_of_lt hbc
  lt_of_le_not_le (le_trans hab hbc) $ λ hca => hcb (le_trans hca hab)

theorem gt_of_gt_of_ge {a b c : α} (h₁ : a > b) (h₂ : b ≥ c) : a > c :=
lt_of_le_of_lt h₂ h₁

theorem gt_of_ge_of_gt {a b c : α} (h₁ : a ≥ b) (h₂ : b > c) : a > c :=
lt_of_lt_of_le h₂ h₁

instance : @Trans α α α LE.le LE.le LE.le := ⟨le_trans⟩
instance : @Trans α α α LT.lt LE.le LT.lt := ⟨lt_of_lt_of_le⟩
instance : @Trans α α α LE.le LT.lt LT.lt := ⟨lt_of_le_of_lt⟩
instance : @Trans α α α GE.ge GE.ge GE.ge := ⟨ge_trans⟩
instance : @Trans α α α GT.gt GE.ge GT.gt := ⟨gt_of_gt_of_ge⟩
instance : @Trans α α α GE.ge GT.gt GT.gt := ⟨gt_of_ge_of_gt⟩

theorem not_le_of_gt {a b : α} (h : a > b) : ¬ a ≤ b :=
(le_not_le_of_lt h).right

theorem not_lt_of_ge {a b : α} (h : a ≥ b) : ¬ a < b :=
λ hab => not_le_of_gt hab h

theorem le_of_lt_or_eq : ∀ {a b : α}, (a < b ∨ a = b) → a ≤ b
| a, b, (Or.inl hab) => le_of_lt hab
| a, b, (Or.inr hab) => hab ▸ le_refl _

theorem le_of_eq_or_lt {a b : α} (h : a = b ∨ a < b) : a ≤ b := match h with
| (Or.inl h) => le_of_eq h
| (Or.inr h) => le_of_lt h

instance decidableLt_of_decidableLe [DecidableRel (. ≤ . : α → α → Prop)] :
  DecidableRel (. < . : α → α → Prop)
| a, b =>
  if hab : a ≤ b then
    if hba : b ≤ a then
      isFalse $ λ hab' => not_le_of_gt hab' hba
    else
      isTrue $ lt_of_le_not_le hab hba
  else
    isFalse $ λ hab' => hab (le_of_lt hab')

end Preorder

section PartialOrder

/-!
### Definition of `PartialOrder` and lemmas about types with a partial order
-/

/-- A partial order is a reflexive, transitive, antisymmetric relation `≤`. -/
class PartialOrder (α : Type u) extends Preorder α :=
(le_antisymm : ∀ a b : α, a ≤ b → b ≤ a → a = b)

variable [PartialOrder α]

theorem le_antisymm : ∀ {a b : α}, a ≤ b → b ≤ a → a = b :=
PartialOrder.le_antisymm _ _

theorem le_antisymm_iff {a b : α} : a = b ↔ a ≤ b ∧ b ≤ a :=
⟨λ e => ⟨le_of_eq e, le_of_eq e.symm⟩, λ ⟨h1, h2⟩ => le_antisymm h1 h2⟩

theorem lt_of_le_of_ne {a b : α} : a ≤ b → a ≠ b → a < b :=
λ h₁ h₂ => lt_of_le_not_le h₁ $ mt (le_antisymm h₁) h₂

instance decidableEq_of_decidableLe [DecidableRel (. ≤ . : α → α → Prop)] :
  DecidableEq α
| a, b =>
  if hab : a ≤ b then
    if hba : b ≤ a then
      isTrue (le_antisymm hab hba)
    else
      isFalse (λ heq => hba (heq ▸ le_refl _))
  else
    isFalse (λ heq => hab (heq ▸ le_refl _))

namespace Decidable

variable [@DecidableRel α (. ≤ .)]

theorem lt_or_eq_of_le {a b : α} (hab : a ≤ b) : a < b ∨ a = b :=
if hba : b ≤ a then Or.inr (le_antisymm hab hba)
else Or.inl (lt_of_le_not_le hab hba)

theorem eq_or_lt_of_le {a b : α} (hab : a ≤ b) : a = b ∨ a < b :=
(lt_or_eq_of_le hab).symm

theorem le_iff_lt_or_eq {a b : α} : a ≤ b ↔ a < b ∨ a = b :=
⟨lt_or_eq_of_le, le_of_lt_or_eq⟩

end Decidable

attribute [local instance] Classical.propDecidable

theorem lt_or_eq_of_le {a b : α} : a ≤ b → a < b ∨ a = b := Decidable.lt_or_eq_of_le

theorem le_iff_lt_or_eq {a b : α} : a ≤ b ↔ a < b ∨ a = b := Decidable.le_iff_lt_or_eq

end PartialOrder

section LinearOrder

/-!
### Definition of `LinearOrder` and lemmas about types with a linear order
-/

/-- A linear order is reflexive, transitive, antisymmetric and total relation `≤`.
We assume that every linear ordered type has decidable `(≤)`, `(<)`, and `(=)`. -/
class LinearOrder (α : Type u) extends PartialOrder α :=
(le_total : ∀ a b : α, a ≤ b ∨ b ≤ a)
(decidable_le : DecidableRel (. ≤ . : α → α → Prop))
(decidable_eq : DecidableEq α := @decidableEq_of_decidableLe _ _ decidable_le)
(decidable_lt : DecidableRel (. < . : α → α → Prop) :=
    @decidableLt_of_decidableLe _ _ decidable_le)

variable [LinearOrder α]

attribute [local instance] LinearOrder.decidable_le

theorem le_total : ∀ a b : α, a ≤ b ∨ b ≤ a :=
LinearOrder.le_total

theorem le_of_not_ge {a b : α} : ¬ a ≥ b → a ≤ b :=
Or.resolve_left (le_total b a)

theorem le_of_not_le {a b : α} : ¬ a ≤ b → b ≤ a :=
Or.resolve_left (le_total a b)

theorem not_lt_of_gt {a b : α} (h : a > b) : ¬ a < b :=
lt_asymm h

theorem lt_trichotomy (a b : α) : a < b ∨ a = b ∨ b < a :=
Or.elim
  (le_total a b)
  (λ h : a ≤ b   => Or.elim
    (Decidable.lt_or_eq_of_le h)
    (λ h : a < b => Or.inl h)
    (λ h : a = b => Or.inr (Or.inl h)))
  (λ h : b ≤ a   => Or.elim
    (Decidable.lt_or_eq_of_le h)
    (λ h : b < a => Or.inr (Or.inr h))
    (λ h : b = a => Or.inr (Or.inl h.symm)))

theorem le_of_not_lt {a b : α} (h : ¬ b < a) : a ≤ b :=
match lt_trichotomy a b with
| Or.inl hlt          => le_of_lt hlt
| Or.inr (Or.inl heq) => heq ▸ le_refl a
| Or.inr (Or.inr hgt) => absurd hgt h

theorem le_of_not_gt {a b : α} : ¬ a > b → a ≤ b := le_of_not_lt

theorem lt_of_not_ge {a b : α} (h : ¬ a ≥ b) : a < b :=
lt_of_le_not_le ((le_total _ _).resolve_right h) h

theorem lt_or_le (a b : α) : a < b ∨ b ≤ a :=
if hba : b ≤ a then Or.inr hba else Or.inl $ lt_of_not_ge hba

theorem le_or_lt (a b : α) : a ≤ b ∨ b < a :=
(lt_or_le b a).symm

theorem lt_or_ge : ∀ (a b : α), a < b ∨ a ≥ b := lt_or_le
theorem le_or_gt : ∀ (a b : α), a ≤ b ∨ a > b := le_or_lt

theorem lt_or_gt_of_ne {a b : α} (h : a ≠ b) : a < b ∨ a > b :=
match lt_trichotomy a b with
| Or.inl hlt          => Or.inl hlt
| Or.inr (Or.inl heq) => absurd heq h
| Or.inr (Or.inr hgt) => Or.inr hgt

theorem ne_iff_lt_or_gt {a b : α} : a ≠ b ↔ a < b ∨ a > b :=
⟨lt_or_gt_of_ne, λ o => match o with
  | Or.inl ol => ne_of_lt ol
  | Or.inr or => ne_of_gt or
⟩

theorem lt_iff_not_ge (x y : α) : x < y ↔ ¬ x ≥ y :=
⟨not_le_of_gt, lt_of_not_ge⟩

@[simp] theorem not_lt {a b : α} : ¬ a < b ↔ b ≤ a := ⟨le_of_not_gt, not_lt_of_ge⟩

@[simp] theorem not_le {a b : α} : ¬ a ≤ b ↔ b < a := (lt_iff_not_ge _ _).symm

instance (a b : α) : Decidable (a < b) :=
LinearOrder.decidable_lt a b

instance (a b : α) : Decidable (a ≤ b) :=
LinearOrder.decidable_le a b

instance (a b : α) : Decidable (a = b) :=
LinearOrder.decidable_eq a b

theorem eq_or_lt_of_not_lt {a b : α} (h : ¬ a < b) : a = b ∨ b < a :=
if h₁ : a = b then Or.inl h₁
else Or.inr (lt_of_not_ge (λ hge => h (lt_of_le_of_ne hge h₁)))

/- TODO: instances of classes that haven't been defined.

instance : is_total_preorder α (≤) :=
{trans := @le_trans _ _, total := le_total}

instance is_strict_weak_order_of_linear_order : is_strict_weak_order α (<) :=
is_strict_weak_order_of_is_total_preorder lt_iff_not_ge

instance is_strict_total_order_of_linear_order : is_strict_total_order α (<) :=
{ trichotomous := lt_trichotomy }
-/

/-- Perform a case-split on the ordering of `x` and `y` in a decidable linear order. -/
def lt_by_cases (x y : α) {P : Sort _}
 (h₁ : x < y → P) (h₂ : x = y → P) (h₃ : y < x → P) : P :=
if h : x < y then h₁ h else
if h' : y < x then h₃ h' else
h₂ (le_antisymm (le_of_not_gt h') (le_of_not_gt h))

theorem le_imp_le_of_lt_imp_lt {β} [Preorder α] [LinearOrder β]
  {a b : α} {c d : β} (H : d < c → b < a) (h : a ≤ b) : c ≤ d :=
le_of_not_lt $ λ h' => not_le_of_gt (H h') h

end LinearOrder


import tactic
import data.int.basic
import data.nat.prime
import number_theory.divisors
import algebra.big_operators.basic
import number_theory.arithmetic_function
--import geom_sum

open nat.arithmetic_function

def divisor_sum : ℕ → ℕ := (λ n : ℕ, n.divisors.sum id)

lemma perfect_iff_sum_divisors_eq_two_mul' (n : ℕ) (hpos : n > 0) : nat.perfect n ↔ divisor_sum n = 2*n :=
begin
  split, {
    intro hn,
    rwa nat.perfect_iff_sum_divisors_eq_two_mul at hn,
    assumption,
  }, {
    intro hn,
    rwa nat.perfect_iff_sum_divisors_eq_two_mul,
    assumption,
  }
end

lemma divisor_sum_is_multiplicative (m n : ℕ) (h_coprime : m.coprime n)
      : (sigma 1 (m*n) = sigma 1 (m) * sigma 1 (n)) :=
begin
  have h := is_multiplicative_sigma,
  have l := is_multiplicative.map_mul_of_coprime

end

lemma finite_power_series (a k : ℕ) : (finset.range k).sum (λ (x : ℕ), (a ^ x)) = (a^k - 1)/(a-1) :=
begin
  set S := (finset.range k).sum (λ (x : ℕ), a ^ x),
  suffices hS : S = 1 + a * (S - a^(k-1)),
  sorry,
  sorry,
end

-- lemma divisor_sum_of_prime_pow {p k : ℕ } (hk : k ≥ 1) (hp : nat.prime p) : ((nat.divisors (p^(k-1))).sum id = (p^k - 1)/(p-1)) :=
-- begin
--   rw nat.sum_divisors_prime_pow hp,
--   -- power series
--   have hs1 : k - 1 + 1 = k := by linarith,
--   rw hs1,
--   rw finite_power_series p k,
-- end

-- lemma obvious_lemma (a : ℕ) (k ≥ 1) : (2 * 2 ^ (k - 1) = 2^k) :=
-- begin
--   set n := k + 1,
--   induction n with d hd,
-- end

-- ∃ k, 2^k - 1 prime → 2^(k-1) * 2^k - 1 is perfect

lemma mersenne_to_perfect (k : ℕ) (hk : k > 0) (hp : nat.prime (2^k - 1)) : (nat.perfect ( 2^(k-1) * (2^k - 1))) :=
begin
  rw perfect_iff_sum_divisors_eq_two_mul',
  {
    rw divisor_sum_is_multiplicative,
    {
      unfold divisor_sum,
      rw nat.prime.sum_divisors hp,
      have h2 : nat.prime 2 := nat.prime_two,
      rw nat.divisors_prime_pow h2,
      simp,
      have hs : k - 1 + 1 = k := by linarith,
      rw hs,
      rw finite_power_series 2 k,

      rw ← mul_assoc,
      have hpow : 2^k ≥ 1 := nat.one_le_pow' k 1,
      have hs1: 2^k - 1 + 1 = 2^k := by linarith,
      have hs2 : 2 * 2 ^ (k - 1) = 2^k,
      {
        zify,
        sorry,
      },
      rw [hs1, hs2, mul_comm],
    },

    {
      set d : ℕ := nat.gcd (2 ^ (k - 1)) (2 ^ k - 1),

    },

  },

  { simpa using nat.one_lt_two_pow k hk, },

end

-- n is an even perfect number → n = 2^(k-1) * (2^k - 1) for some mersenne prime 2^k - 1


import Mathlib.Algebra.Ring.Basic
import Mathlib.Algebra.Group.Defs

/-!
# Free modules

We construct the free module over a ring `R` generated by a set `X`. It is assumed that both `R` and `X` have decidable equality.
This is to obtain decidable equality for the elements of the module, which we do (`FreeModule.decEq`).
We choose our definition to allow both such computations and to prove results.

The definition is as a quotient of *Formal Sums* (`FormalSum`),
which are simply lists of pairs `(a,x)` where `a` is a coefficient in `R` and `x` is a term in `X`.
We associate to such a formal sum a coordinate function `X → R` (`FormalSum.coords`).
We see that having the same coordinate functions gives an equivalence relation on the formal sums.
The free module (`FreeModule`) is then defined as the corresponding quotient of such formal sums.

We also give an alternative description via moves, which is more convenient for universal properties.
-/

variable {R : Type _} [Ring R] [DecidableEq R]

variable {X : Type _} [DecidableEq X]

section FormalSumCoords

/-!

## Formal sums
-/

/-- A *formal sum* represents an `R`-linear combination of finitely many elements of `X`.
  This is implemented as a list `R × X`, which associates to each element `X` of the list a coefficient from `R`. -/
abbrev FormalSum (R X : Type _) [Ring R] :=
  List (R × X)

/-!
## Coordinate functions and Supports

* We define coordinate functions X → R for formal sums.
* We define (weak) support, relate non-zero coordinates.
* We prove decidable equality on a list (easy fact).

-/

/-!
### Coordinate functions

The definition of coordinate functions is in two steps. We first define the coordinate for a pair `(a,x)`, and then define the coordinate function for a formal sum by summing over such terms.

-/

/-- Coordinates for a formal sum with one term. -/
def monomCoeff (R X : Type _) [Ring R] [DecidableEq X](x₀ : X) (nx : R × X) : R :=
  match (nx.2 == x₀) with
  | true => nx.1
  | false => 0

/-- Homomorphism property for coordinates for a formal sum with one term. -/
theorem monom_coords_hom  (x₀ x : X) (a b : R) : monomCoeff R X x₀ (a + b, x) = monomCoeff R X x₀ (a, x) + monomCoeff R X x₀ (b, x) := by
  repeat
    (
      rw [monomCoeff])
  cases x == x₀ <;> simp

/-- Associativity of scalar multiplication coordinates for a formal sum with one term. -/
theorem monom_coords_mul (x₀ : X) (a b : R) : monomCoeff R X x₀ (a * b, x) = a * monomCoeff R X x₀ (b, x) := by
  repeat
    (
      rw [monomCoeff])
  cases x == x₀ <;> simp

/-- Coordinates for a formal sum with one term with scalar `0`.
-/
theorem monom_coords_at_zero (x₀ x : X) : monomCoeff R X x₀ (0, x) = 0 := by
  rw [monomCoeff]
  cases x == x₀ <;> rfl

/-- The coordinates for a formal sum. -/
def FormalSum.coords  : FormalSum R X → X → R
  | [], _ => 0
  | h :: t, x₀ => monomCoeff R X x₀ h + coords t x₀

/-!

### Support of a formal sum

We next define the support of a formal sum and prove the property that coordinates vanish outside the support.
-/

/-- Support for a formal sum in a weak sense (coordinates may vanish on this). -/
def FormalSum.support  (s : FormalSum R X) : List X :=
  s.map <| fun (_, x) => x

open FormalSum

/-- Support contains elements `x : X` where the coordinate is not `0`. -/
theorem nonzero_coord_in_support  (s : FormalSum R X) : ∀ x : X, 0 ≠ s.coords x → x ∈ s.support :=
  match s with
  | [] => fun x hyp => by
    have d : coords [] x = (0 : R) := by
      rfl
    rw [d] at hyp
    contradiction
  | h :: t => by
    intro x hyp
    let (a₀, x₀) := h
    have d : support ((a₀, x₀) :: t) = x₀ :: (support t) := by
      rfl
    rw [d]
    match p : x₀ == x with
    | true =>
      have eqn : x₀ = x := of_decide_eq_true p
      rw [eqn]
      apply List.mem_of_elem_eq_true
      simp [List.elem]
    | false =>
      rw [coords, monomCoeff, p, zero_add] at hyp
      let step := nonzero_coord_in_support t x hyp
      apply List.mem_of_elem_eq_true
      simp [List.elem]
      have p' : (x == x₀) = false := by
        have eqn := of_decide_eq_false p
        have eqn' : ¬(x = x₀) := by
          intro contra
          let contra' := Eq.symm contra
          contradiction
        exact decide_eq_false eqn'
      rw [p']
      apply List.elem_eq_true_of_mem
      exact step

/-!
### Equality of coordinates on a list

We define equality of coordinates on a list and prove that it is decidable and implied by equality of formal sums.
-/

/-- The condition of being equal on all elements is a given list -/
def equalOnList  (l : List X) (f g : X → R) : Prop :=
  match l with
  | [] => true
  | h :: t => (f h = g h) ∧ (equalOnList t f g)

/-- Equal functions are equal on arbitrary supports. -/
theorem equalOnList_of_equal  (l : List X) (f g : X → R) :
    f = g → equalOnList l f g := by
  intro hyp
  induction l with
  | nil =>
    rw [equalOnList]
  | cons h t step =>
    rw [equalOnList]
    apply And.intro
    rw [hyp]
    exact step

/-- Functions equal on support `l` are equal on each `x ∈ l`. -/
theorem eq_mem_of_equalOnList  (l : List X) (f g : X → R) (x : X)(mhyp : x ∈ l) : equalOnList l f g → f x = g x :=
  match l with
  | [] => by
    contradiction
  | h :: t => by
    intro hyp
    simp [equalOnList] at hyp
    cases mhyp
    exact hyp.left
    have inTail : x ∈ t := by
      assumption
    have step := eq_mem_of_equalOnList t f g x inTail hyp.right
    exact step

/-- Decidability of equality on list. -/
@[instance] def decidableEqualOnList  (l : List X) (f g : X → R) : Decidable (equalOnList l f g) :=
  match l with
  | [] =>
    Decidable.isTrue
      (by
        simp [equalOnList])
  | h :: t => by
    simp [equalOnList]
    cases (decidableEqualOnList t f g)with
    | isTrue hs =>
      exact
        (if c : f h = g h then (Decidable.isTrue ⟨c, hs⟩)
        else by
          apply Decidable.isFalse
          intro contra
          have contra' := contra.left
          contradiction)
    | isFalse hs =>
      apply Decidable.isFalse
      intro contra
      have contra' := contra.right
      contradiction

end FormalSumCoords

/-!
## Quotient Free Module

* We define relation by having equal coordinates
* We show this is an equivalence relation and define the quotient
-/
section QuotientFreeModule

/-- Relation by equal coordinates. -/
def eqlCoords (R X : Type) [Ring R] [DecidableEq X](s₁ s₂ : FormalSum R X) : Prop :=
  s₁.coords = s₂.coords

namespace eqlCoords

/-- Relation by equal coordinates is reflexive. -/
theorem refl  (s : FormalSum R X) : eqlCoords R X s s :=
  by
  rfl

/-- Relation by equal coordinates is  symmetric. -/
theorem symm  {s₁ s₂ : FormalSum R X} : eqlCoords R X s₁ s₂ → eqlCoords R X s₂ s₁ := by
  intro hyp
  apply funext
  intro x
  apply Eq.symm
  exact congrFun hyp x

/-- Relation by equal coordinates is transitive. -/
theorem trans  {s₁ s₂ s₃ : FormalSum R X} : eqlCoords R X s₁ s₂ → eqlCoords R X s₂ s₃ → eqlCoords R X s₁ s₃ := by
  intro hyp₁ hyp₂
  apply funext
  intro x
  have l₁ := congrFun hyp₁ x
  have l₂ := congrFun hyp₂ x
  exact Eq.trans l₁ l₂

/-- Relation by equal coordinates is an equivalence relation. -/
theorem is_equivalence  : Equivalence (eqlCoords R X) :=
  { refl := refl, symm := symm, trans := trans }

end eqlCoords

/-- Setoid based on equal coordinates. -/
instance formalSumSetoid (R X : Type) [Ring R] [DecidableEq X] : Setoid (FormalSum R X) :=
  ⟨eqlCoords R X, eqlCoords.is_equivalence⟩

/-- Quotient free module. -/
abbrev FreeModule (R X : Type) [Ring R] [DecidableEq X] :=
  Quotient (formalSumSetoid R X)

notation R"["G"]" => FreeModule R G

end QuotientFreeModule

section DecidableEqQuotFreeModule

/-!
## Decidable equality on quotient free modules

We show that the free module `F[X]` has decidable equality. This has two steps:

* show decidable equality for images of formal sums.
* lift to quotient (by relating to formal sums).

We also show that the coordinate functions are defined on the quotient. -/

namespace FreeModule

/-- Decidable equality for quotient elements in the free module -/
@[instance]
def decideEqualQuotient  (s₁ s₂ : FormalSum R X) : Decidable (@Eq (R[X]) ⟦s₁⟧ ⟦s₂⟧) :=
  if ch₁ : equalOnList s₁.support s₁.coords s₂.coords then
    if ch₂ : equalOnList s₂.support s₁.coords s₂.coords then
      Decidable.isTrue
        (by
          apply Quotient.sound
          apply funext
          intro x
          exact
            if h₁ : (0 = s₁.coords x) then
              if h₂ : (0 = s₂.coords x) then by
                rw [← h₁, h₂]
              else by
                have lem : x ∈ s₂.support := by
                  apply nonzero_coord_in_support
                  assumption
                let lem' := eq_mem_of_equalOnList s₂.support s₁.coords s₂.coords x lem ch₂
                exact lem'
            else by
              have lem : x ∈ s₁.support := by
                apply nonzero_coord_in_support
                assumption
              let lem' := eq_mem_of_equalOnList s₁.support s₁.coords s₂.coords x lem ch₁
              exact lem')
    else
      Decidable.isFalse
        (by
          intro contra
          let lem := equalOnList_of_equal s₂.support s₁.coords s₂.coords (Quotient.exact contra)
          contradiction)
  else
    Decidable.isFalse
      (by
        intro contra
        let lem := equalOnList_of_equal s₁.support s₁.coords s₂.coords (Quotient.exact contra)
        contradiction)

/-!
### Lift to quotient
-/

/-- Boolean equality on support. -/
def beqOnSupport  (l : List X) (f g : X → R) :Bool :=
  l.all <| fun x => decide (f x = g x)

/-- Equality on support from boolean equality. -/
theorem eql_on_support_of_true {l : List X} {f g : X → R} : beqOnSupport l f g = true → equalOnList l f g := by
  intro hyp
  induction l with
  | nil =>
    simp [equalOnList]
  | cons h t step =>
    simp [equalOnList]
    simp [beqOnSupport, List.all] at hyp
    let p₂ := step hyp.right
    exact And.intro hyp.left p₂

/-- Boolean equality on support gives equal quotients. -/
theorem eqlquot_of_beq_support (s₁ s₂ : FormalSum R X)
  (c₁ : beqOnSupport s₁.support s₁.coords s₂.coords)
  (c₂ : beqOnSupport s₂.support s₁.coords s₂.coords) : @Eq (R[X]) ⟦s₁⟧ ⟦s₂⟧ :=
        by
        let ch₁ := eql_on_support_of_true c₁
        let ch₂ := eql_on_support_of_true c₂
        apply Quotient.sound
        apply funext
        intro x
        exact
          if h₁ : (0 = s₁.coords x) then
            if h₂ : (0 = s₂.coords x) then by
              rw [← h₁, h₂]
            else by
              have lem : x ∈ s₂.support := by
                apply nonzero_coord_in_support
                assumption
              let lem' := eq_mem_of_equalOnList s₂.support s₁.coords s₂.coords x lem ch₂
              exact lem'
          else by
            have lem : x ∈ s₁.support := by
              apply nonzero_coord_in_support
              assumption
            let lem' := eq_mem_of_equalOnList s₁.support s₁.coords s₂.coords x lem ch₁
            exact lem'

/--
Boolean equality for the quotient via lifting
-/
def beq_quot : (x₁ x₂ : R[X]) → Bool := by
  apply Quotient.lift₂ (fun (s₁ s₂ : FormalSum R X) => decide (@Eq (R[X]) ⟦s₁⟧ ⟦s₂⟧))
  intro a₁ b₁ a₂ b₂ eqv₁ eqv₂
  let eq₁ : Eq (α := R[X]) ⟦a₁⟧ ⟦a₂⟧ := Quot.sound eqv₁
  let eq₂ : Eq (α := R[X]) ⟦b₁⟧ ⟦b₂⟧ := Quot.sound eqv₂
  conv => lhs; congr; rw [eq₁, eq₂]

/--
Boolean equality for the quotient is equality.
-/
lemma eq_of_beq_true  : ∀ x₁ x₂ : R[X], x₁.beq_quot x₂ = true → x₁ = x₂ := by
  apply Quotient.ind₂ (motive := fun (x₁ x₂ : R[X]) => x₁.beq_quot x₂ = true → x₁ = x₂)
  intro s₁ s₂ eqv
  let eql := of_decide_eq_true eqv
  assumption

/--
Boolean inequality for the quotient is inequality.
-/
lemma neq_of_beq_false  : ∀ x₁ x₂ : R[X], x₁.beq_quot x₂ = false → Not (x₁ = x₂) := by
  apply Quotient.ind₂ (motive := fun (x₁ x₂ : R[X]) => x₁.beq_quot x₂ = false → Not (x₁ = x₂))
  intro s₁ s₂ neqv
  let neql := of_decide_eq_false neqv
  assumption

/--
Decidable equality for the free module.
-/
@[instance] def decEq  (x₁ x₂ : R[X]) : Decidable (x₁ = x₂) := by
  match p : x₁.beq_quot x₂ with
  | true =>
    apply Decidable.isTrue
    apply FreeModule.eq_of_beq_true
    assumption
  | false =>
    apply Decidable.isFalse
    apply FreeModule.neq_of_beq_false
    assumption

/-!
### Induced coordinates on the quotient.
-/

/-- Coordinates are well defined on the quotient. -/
theorem equal_coords_of_approx (s₁ s₂ : FormalSum R X): s₁ ≈ s₂ → s₁.coords = s₂.coords := by
    intro hyp
    apply funext; intro x₀
    exact congrFun hyp x₀

/-- coordinates for the quotient -/
def coordinates (x₀ : X) : R[X] →  R := by
  apply Quotient.lift (fun s : FormalSum R X => s.coords x₀)
  intro a b
  intro hyp
  let l :=  equal_coords_of_approx _ _ hyp
  exact congrFun l x₀

end FreeModule
end DecidableEqQuotFreeModule

/-!
## Module structure

We define the module structure on the quotient of the free module by the equivalence relation.

* We define scalar multiplication and addition on formal sums.
* We show that we have induced operations on the quotient.
* We show that the induced operations give a module structure on the quotient.
-/
section ModuleStruture

open FormalSum
namespace FormalSum
/-!
### Scalar multiplication: on formal sums and on the quotient.
-/

/-- Scalar multiplication on formal sums. -/
def scmul  : R → FormalSum R X → FormalSum R X
  | _, [] => []
  | r, (h :: t) =>
    let (a₀, x₀) := h
    (r * a₀, x₀) :: (scmul r t)

/-- Coordinates after scalar multiplication. -/
theorem scmul_coords  (r : R) (s : FormalSum R X) (x₀ : X) : (r * s.coords x₀) = (s.scmul r).coords x₀ := by
  induction s with
  | nil =>
    simp [coords]
  | cons h t ih =>
    simp [scmul, coords, monom_coords_mul, left_distrib, ih]

/-- Scalar multiplication on the Free Module. -/
def FreeModule.scmul  : R → R[X] → R[X] := by
  intro r
  let f : FormalSum R X → R[X] := fun s => ⟦s.scmul r⟧
  apply Quotient.lift f
  intro s₁ s₂
  simp
  intro hypeq
  apply funext
  intro x₀
  have l₁ := scmul_coords r s₁ x₀
  have l₂ := scmul_coords r s₂ x₀
  rw [← l₁, ← l₂]
  rw [hypeq]

/-!
### Addition: on formal sums and on the quotient.
-/

/-- Coordinates add when appending. -/
theorem append_coords  (s₁ s₂ : FormalSum R X) (x₀ : X) : (s₁.coords x₀) + (s₂.coords x₀) = (s₁ ++ s₂).coords x₀ := by
  induction s₁ with
  | nil =>
    simp [coords]
  | cons h t ih =>
    simp [coords, ← ih, add_assoc]

/-- Coordinates well-defined up to equivalence. -/
theorem append_equiv  (s₁ s₂ t₁ t₂ : FormalSum R X) :(s₁ ≈ s₂) → (t₁ ≈ t₂) → s₁ ++ t₁ ≈ s₂ ++ t₂ := by
    intro eqv₁ eqv₂
    apply funext
    intro x₀
    rw [← append_coords]
    rw [← append_coords]
    have ls : coords s₁ x₀ = coords s₂ x₀ := by
      apply congrFun eqv₁
    have lt : coords t₁ x₀ = coords t₂ x₀ := by
      apply congrFun eqv₂
    rw [← ls, ← lt]

end FormalSum

/-- Addition of elements in the free module. -/
def FreeModule.add  : R[X] → R[X] → R[X] := by
  let f : FormalSum R X → FormalSum R X → R[X] := fun s₁ s₂ => ⟦s₁ ++ s₂⟧
  apply Quotient.lift₂ f
  intro a₁ b₁ a₂ b₂
  simp
  intro eq₁ eq₂
  apply funext
  intro x₀
  have l₁ := append_coords a₁ b₁ x₀
  have l₂ := append_coords a₂ b₂ x₀
  rw [← l₁, ← l₂]
  rw [eq₁, eq₂]

instance  : Add (R[X]) :=
  ⟨FreeModule.add⟩

instance  : HSMul R (R[X]) (R[X]) :=
  ⟨FreeModule.scmul⟩
namespace FormalSum

/-!
### Properties of operations on formal sums.
-/

/-- Associativity for scalar multiplication for formal sums. -/
theorem action  (a b : R) (s : FormalSum R X) : (s.scmul b).scmul a = s.scmul (a * b) := by
  induction s with
  | nil =>
    simp [scmul]
  | cons h t ih =>
    simp [scmul, ih, mul_assoc]

/-- Distributivity for the module operations. -/
theorem act_sum (a b : R) (s : FormalSum R X) : (s.scmul a) ++ (s.scmul b) ≈  s.scmul (a + b) := by
  induction s with
  | nil =>
    simp [scmul]
    apply eqlCoords.refl
  | cons h t ih =>
    apply funext; intro x₀
    let il₁ := congrFun ih x₀
    rw [← append_coords]
    simp [scmul, coords, right_distrib, monom_coords_hom]
    rw [← append_coords] at il₁
    rw [← il₁]
    simp
    conv =>
      lhs
      rw [add_assoc]
      arg 2
      rw [← add_assoc]
      arg 1
      rw [add_comm]
    conv =>
      lhs
      rw [add_assoc]
      rw [← add_assoc]

end FormalSum

namespace FreeModule

/-!
### Module properties for the free module.
-/

/-- Associativity for scalar and ring products. -/
theorem module_action  (a b : R) (x : R[X]) : a • (b • x) = (a * b) • x := by
  apply @Quotient.ind (motive := fun x : R[X] => a • (b • x) = (a * b) • x)
  intro s
  apply Quotient.sound
  rw [FormalSum.action]
  apply eqlCoords.refl

/-- Commutativity of addition. -/
theorem addn_comm  (x₁ x₂ : R[X]) : x₁ + x₂ = x₂ + x₁ := by
  apply @Quotient.ind₂ (motive := fun x₁ x₂ : R[X] => x₁ + x₂ = x₂ + x₁)
  intro s₁ s₂
  apply Quotient.sound
  apply funext
  intro x₀
  let lm₁ := append_coords s₁ s₂ x₀
  let lm₂ := append_coords s₂ s₁ x₀
  rw [← lm₁, ← lm₂]
  simp [add_comm]

theorem add_assoc_aux  (s₁ : FormalSum R X) (x₂ x₃ : R[X]) : (⟦s₁⟧ + x₂) + x₃ = ⟦s₁⟧ + (x₂ + x₃) := by
  apply @Quotient.ind₂ (motive := fun x₂ x₃ : R[X] => (⟦s₁⟧ + x₂) + x₃ = ⟦s₁⟧ + (x₂ + x₃))
  intro x₂ x₃
  apply Quotient.sound
  apply funext
  intro x₀
  rw [← append_coords]
  rw [← append_coords]
  rw [← append_coords]
  rw [← append_coords]
  simp [add_assoc]

/-- Associativity of addition. -/
theorem addn_assoc  (x₁ x₂ x₃ : R[X]) : (x₁ + x₂) + x₃ = x₁ + (x₂ + x₃) := by
  apply @Quotient.ind (motive := fun x₁ : R[X] => (x₁ + x₂) + x₃ = x₁ + (x₂ + x₃))
  intro x₁
  apply add_assoc_aux

/-- The zero element of the free module. -/
def zero : R[X] := ⟦[]⟧

/-- adding zero-/
theorem addn_zero (x: R[X]) : x + zero = x := by
  apply @Quotient.ind (motive := fun x : R[X] => x + zero = x)
  intro x
  apply Quotient.sound
  apply funext
  intro x₀
  rw [← append_coords]
  simp [add_zero, coords]

/-- adding zero-/
theorem zero_addn (x: R[X]) : zero + x = x := by
  apply @Quotient.ind (motive := fun x : R[X] => zero + x = x)
  intro x
  apply Quotient.sound
  apply funext
  intro x₀
  rw [← append_coords]
  simp [add_zero, coords]

/-- Distributivity for addition of module elements. -/
theorem elem_distrib  (a : R) (x₁ x₂ : R[X]) : a • (x₁ + x₂) = a • x₁ + a • x₂ := by
  apply @Quotient.ind₂ (motive := fun x₁ x₂ : R[X] => a • (x₁ + x₂) = a • x₁ + a • x₂)
  intro s₁ s₂
  apply Quotient.sound
  apply funext
  intro x₀
  rw [← scmul_coords]
  rw [← append_coords]
  rw [← append_coords]
  rw [← scmul_coords]
  rw [← scmul_coords]
  simp [left_distrib]

/-- Distributivity with respect to scalars. -/
theorem coeffs_distrib (a b: R)(x: R[X]) : a • x + b • x = (a + b) • x:= by
  apply @Quotient.ind (motive := fun x : R[X] =>
    a • x + b • x = (a + b) • x)
  intro s
  apply Quotient.sound
  apply funext
  intro x₀
  let l := act_sum a b s
  let l'' := congrFun l x₀
  exact l''

/-- Multiplication by `1 : R`. -/
theorem unit_coeffs (x: R[X]) : (1 : R) • x =  x:= by
  apply @Quotient.ind (motive := fun x : R[X] =>
    (1 : R) • x =  x)
  intro s
  apply Quotient.sound
  apply funext
  intro x₀
  let l := scmul_coords 1 s x₀
  rw [← l]
  simp

/-- Multiplication by `0 : R`. -/
theorem zero_coeffs (x: R[X]) : (0 : R) • x =  ⟦ [] ⟧:= by
  apply @Quotient.ind (motive := fun x : R[X] =>
    (0 : R) • x =  ⟦ [] ⟧)
  intro s
  apply Quotient.sound
  apply funext
  intro x₀
  let l := scmul_coords 0 s x₀
  rw [← l]
  simp [coords]

/-- The module is an additive commutative group, mainly proved as a check -/
instance : AddCommGroup (R[X]) :=
  {
    zero := ⟦ []⟧
    add := FreeModule.add
    add_assoc := FreeModule.addn_assoc
    add_zero := FreeModule.addn_zero
    zero_add := FreeModule.zero_addn
    neg := fun x => (-1 : R) • x

    sub_eq_add_neg := by intros; rfl

    add_left_neg := by
        intro x
        let l := FreeModule.coeffs_distrib (-1 : R) (1 : R) x
        simp at l
        rw [FreeModule.unit_coeffs] at l
        rw [FreeModule.zero_coeffs] at l
        exact l

    add_comm := FreeModule.addn_comm
  }

end FreeModule

end ModuleStruture

/-!
## Equivalent definition of the relation via moves

For conceptual results such as the universal property (needed for the group ring structure) it is useful to define the relation on the free module in terms of moves. We do this, and show that this is the same as the relation defined by equality of coordinates.

* We define elementary moves on formal sums
* We show coordinates equal if and only if related by elementary moves
* Hence can define map on Free Module when invariant under elementary moves
  -/

section ElementaryMoves

open FormalSum
/-- Elementary moves for formal sums. -/
inductive ElementaryMove (R X : Type) [Ring R] [DecidableEq R][DecidableEq X] : FormalSum R X → FormalSum R X → Prop where
  | zeroCoeff (tail : FormalSum R X) (x : X) (a : R) (h : a = 0) : ElementaryMove R X ((a, x) :: tail) tail
  | addCoeffs (a b : R) (x : X) (tail : FormalSum R X) :
    ElementaryMove R X ((a, x) :: (b, x) :: tail) ((a + b, x) :: tail)
  | cons (a : R) (x : X) (s₁ s₂ : FormalSum R X) : ElementaryMove R X s₁ s₂ → ElementaryMove R X ((a, x) :: s₁) ((a, x) :: s₂)
  | swap (a₁ a₂ : R) (x₁ x₂ : X) (tail : FormalSum R X) :
    ElementaryMove R X ((a₁, x₁) :: (a₂, x₂) :: tail) ((a₂, x₂) :: (a₁, x₁) :: tail)

def FreeModuleAux (R X : Type) [Ring R] [DecidableEq R][DecidableEq X] :=
  Quot (ElementaryMove R X)

namespace FormalSum

/-- Image in the quotient (i.e., actual, not formal, sum). -/
def sum  (s : FormalSum R X) : FreeModuleAux R X :=
  Quot.mk (ElementaryMove R X) s

/-- Equivalence by having the same image. -/
def equiv  (s₁ s₂ : FormalSum R X) : Prop :=
  s₁.sum = s₂.sum

infix:65 " ≃ " => FormalSum.equiv

/-!
### Invariance of coordinates under elementary moves
-/

/-- Coordinates are invariant under moves. -/
theorem coords_move_invariant (x₀ : X) (s₁ s₂ : FormalSum R X) (h : ElementaryMove R X s₁ s₂) : coords s₁ x₀ = coords s₂ x₀ := by
  induction h with
  | zeroCoeff tail x a hyp =>
    simp [coords, hyp, monom_coords_at_zero]
  | addCoeffs a b x tail =>
    simp [coords, monom_coords_at_zero, ← add_assoc, monom_coords_hom]
  | cons a x s₁ s₂ _ step =>
    simp [coords, step]
  | swap a₁ a₂ x₁ x₂ tail =>
    simp [coords, ← add_assoc, add_comm]

end FormalSum

/-- Coordinates on the quotients. -/
def FreeModuleAux.coeff (x₀ : X) : FreeModuleAux R X → R :=
  Quot.lift (fun s => s.coords x₀) (coords_move_invariant x₀)

namespace FormalSum

/-- Commutative diagram for coordinates. -/
theorem coeff_factors (x : X) (s : FormalSum R X) : FreeModuleAux.coeff  x (sum s) = s.coords x := by
  simp [FreeModuleAux.coeff]
  apply @Quot.liftBeta (r := ElementaryMove R X) (f := fun s => s.coords x)
  apply coords_move_invariant

/-- Coordinates well-defined under the equivalence generated by moves. -/
theorem coords_well_defined  (x : X) (s₁ s₂ : FormalSum R X) : s₁ ≃ s₂ → s₁.coords x = s₂.coords x := by
  intro hyp
  have l : FreeModuleAux.coeff x (sum s₂) = s₂.coords x := by
    simp [coeff_factors, hyp]
  rw [← l]
  rw [← coeff_factors]
  rw [hyp]

/-!
### Equal coordinates implies related by elementary moves.
-/

/-- Cons respects equivalence. -/
theorem cons_equiv_of_equiv  (s₁ s₂ : FormalSum R X) (a : R) (x : X) : s₁ ≃ s₂ → (a, x) :: s₁ ≃ (a, x) :: s₂ := by
  intro h
  let f : FormalSum R X → FreeModuleAux R X := fun s => sum <| (a, x) :: s
  let wit : (s₁ s₂ : FormalSum R X) → (ElementaryMove R X s₁ s₂) → f s₁ = f s₂ := by
    intro s₁ s₂ hyp
    apply Quot.sound
    apply ElementaryMove.cons
    assumption
  let g := Quot.lift f wit
  let factorizes : (s : FormalSum R X) → g (s.sum) = sum ((a, x) :: s) := Quot.liftBeta f wit
  rw [equiv]
  rw [← factorizes]
  rw [← factorizes]
  rw [h]

/-- If a coordinate `x` for a formal sum `s` is non-zero, `s` is related by moves to a formal sum with first term `x` with coefficient its coordinates, and the rest shorter than `s`. -/
theorem nonzero_coeff_has_complement  (x₀ : X)(s : FormalSum R X) : 0 ≠ s.coords x₀ → (∃ ys : FormalSum R X, (((s.coords x₀, x₀) :: ys) ≃ s) ∧ (List.length ys < s.length)) := by
  induction s with
  | nil =>
    intro contra
    contradiction
  | cons head tail hyp =>
    let (a, x) := head
    intro pos
    cases c : x == x₀ with
    | true =>
      let k := FormalSum.coords tail x₀
      have lem : a + k = coords ((a, x) :: tail) x₀ := by
        rw [coords, monomCoeff, c]
      have c'' : x = x₀ := of_decide_eq_true c
      rw [c'']
      rw [c''] at lem
      exact
        if c' : (0 = k) then by
          have lIneq : tail.length < List.length ((a, x) :: tail) := by
            simp [List.length_cons]
          rw [← c', add_zero] at lem
          rw [← lem]
          exact ⟨tail, rfl, lIneq⟩
        else by
          let ⟨ys, eqnStep, lIneqStep⟩ := hyp c'
          have eqn₁ : (a, x₀) :: (k, x₀) :: ys ≃ (a + k, x₀) :: ys := by
            apply Quot.sound
            apply ElementaryMove.addCoeffs
          have eqn₂ : (a, x₀) :: (k, x₀) :: ys ≃ (a, x₀) :: tail := by
            apply cons_equiv_of_equiv
            assumption
          have eqn : (a + k, x₀) :: ys ≃ (a, x₀) :: tail := Eq.trans (Eq.symm eqn₁) eqn₂
          rw [← lem]
          have lIneq : ys.length < List.length ((a, x₀) :: tail) := by
            apply Nat.le_trans lIneqStep
            simp [List.length_cons, Nat.le_succ]
          exact ⟨ys, eqn, lIneq⟩
    | false =>
      let k := coords tail x₀
      have lem : k = coords ((a, x) :: tail) x₀ := by
        simp [coords, monomCoeff, c, zero_add]
      rw [← lem] at pos
      let ⟨ys', eqnStep, lIneqStep⟩ := hyp pos
      rw [← lem]
      let ys := (a, x) :: ys'
      have lIneq : ys.length < ((a, x) :: tail).length := by
        simp [List.length_cons]
        apply Nat.succ_lt_succ
        exact lIneqStep
      have eqn₁ : (k, x₀) :: ys ≃ (a, x) :: (k, x₀) :: ys' := by
        apply Quot.sound
        apply ElementaryMove.swap
      have eqn₂ : (a, x) :: (k, x₀) :: ys' ≃ (a, x) :: tail := by
        apply cons_equiv_of_equiv
        assumption
      have eqn : (k, x₀) :: ys ≃ (a, x) :: tail := by
        exact Eq.trans eqn₁ eqn₂
      exact ⟨ys, eqn, lIneq⟩

/-- If all coordinates are zero, then moves relate to the empty sum. -/
theorem equiv_e_of_zero_coeffs  (s : FormalSum R X) (hyp : ∀ x : X, s.coords x = 0) : s ≃ [] :=
  -- let canc : IsAddLeftCancel R :=
  --   ⟨fun a b c h => by
  --     rw [← neg_add_cancel_left a b, h, neg_add_cancel_left]⟩
  match mt : s with
  | [] => rfl
  | h :: t => by
    let (a₀, x₀) := h
    let hyp₀ := hyp x₀
    rw [coords] at hyp₀
    have c₀ : monomCoeff R X x₀ (a₀, x₀) = a₀ := by
      simp [monomCoeff]
    rw [c₀] at hyp₀
    exact
      if hz : a₀ = 0 then by
        rw [hz] at hyp₀
        rw [zero_add] at hyp₀
        have tail_coeffs : ∀ x : X, coords t x = 0 := by
          intro x
          simp [coords]
          exact
            if c : (x₀ = x) then by
              rw [← c]
              assumption
            else by
              let hx := hyp x
              simp [coords, monomCoeff] at hx
              have lf : (x₀ == x) = false := decide_eq_false c
              rw [lf] at hx
              simp [zero_add] at hx
              assumption
        have _ : t.length < (h :: t).length := by
          simp [List.length_cons]
        let step : t ≃ [] := by
          apply equiv_e_of_zero_coeffs
          exact tail_coeffs
        rw [hz]
        have ls : (0, x₀) :: t ≃ t := by
          apply Quot.sound
          apply ElementaryMove.zeroCoeff
          rfl
        exact Eq.trans ls step
      else by
        have non_zero : 0 ≠ coords t x₀ := by
          intro contra'
          let contra := Eq.symm contra'
          rw [contra, add_zero] at hyp₀
          contradiction
        let ⟨ys, eqnStep, lIneqStep⟩ := nonzero_coeff_has_complement x₀ t non_zero
        have tail_coeffs : ∀ x : X, coords ys x = 0 := by
          intro x
          simp [coords]
          exact
            if c : (x₀ = x) then by
              rw [← c]
              let ceq := coords_well_defined x₀ _ _ eqnStep
              simp [coords, monomCoeff] at ceq
              assumption
            else by
              let hx := hyp x
              simp [coords, monomCoeff] at hx
              have lf : (x₀ == x) = false := decide_eq_false c
              rw [lf] at hx
              simp [zero_add] at hx
              let ceq := coords_well_defined x _ _ eqnStep
              simp [coords, monomCoeff, lf] at ceq
              rw [hx] at ceq
              exact ceq
        have _ : ys.length < (h :: t).length := by
          simp [List.length_cons]
          apply Nat.le_trans lIneqStep
          apply Nat.le_succ
        let step : ys ≃ [] := by
          apply equiv_e_of_zero_coeffs
          exact tail_coeffs
        let eqn₁ := cons_equiv_of_equiv _ _ (coords t x₀) x₀ step
        let eqn₂ : t ≃ (coords t x₀, x₀) :: [] := Eq.trans (Eq.symm eqnStep) eqn₁
        let eqn₃ := cons_equiv_of_equiv _ _ a₀ x₀ eqn₂
        apply Eq.trans eqn₃
        have eqn₄ : sum [(a₀, x₀), (coords t x₀, x₀)] = sum [(a₀ + coords t x₀, x₀)] := by
          apply Quot.sound
          apply ElementaryMove.addCoeffs
        apply Eq.trans eqn₄
        rw [hyp₀]
        apply Quot.sound
        apply ElementaryMove.zeroCoeff
        rfl
  termination_by
  _ R X s h => s.length decreasing_by
  assumption

/-- If coordinates are equal, the sums are related by moves. -/
theorem equiv_of_equal_coeffs  (s₁ s₂ : FormalSum R X) (hyp : ∀ x : X, s₁.coords x = s₂.coords x) : s₁ ≃ s₂ :=
  match s₁ with
  | [] =>
    have coeffs : ∀ x : X, s₂.coords x = 0 := by
      intro x
      let h := hyp x
      rw [← h]
      rfl
    let zl := equiv_e_of_zero_coeffs s₂ coeffs
    Eq.symm zl
  | h :: t =>
    let (a₀, x₀) := h
    by
    exact
      if p : 0 = a₀ then by
        have eq₁ : (a₀, x₀) :: t ≃ t := by
          apply Quot.sound
          apply ElementaryMove.zeroCoeff
          apply Eq.symm
          assumption
        have _ : t.length < (h :: t).length := by
          simp [List.length_cons]
        have eq₂ : t ≃ s₂ := by
          apply equiv_of_equal_coeffs t s₂
          intro x
          let ceq := coords_well_defined x ((a₀, x₀) :: t) t eq₁
          simp [← ceq, hyp]
        exact Eq.trans eq₁ eq₂
      else by
        let a₁ := coords t x₀
        exact
          if p₁ : 0 = a₁ then by
            have cf₂ : s₂.coords x₀ = a₀ := by
              rw [← hyp]
              simp [coords, ← p₁, Nat.add_zero, monomCoeff]
            let ⟨ys, eqn, _⟩ :=
              nonzero_coeff_has_complement x₀ s₂
                (by
                  rw [cf₂]
                  assumption)
            let cfs := fun x => coords_well_defined x _ _ eqn
            rw [cf₂] at cfs
            let cfs' := fun (x : X) => Eq.trans (hyp x) (Eq.symm (cfs x))
            simp [coords] at cfs'
            have _ : t.length < (h :: t).length := by
              simp [List.length_cons]
            let step := equiv_of_equal_coeffs t ys cfs'
            let _step' := cons_equiv_of_equiv t ys a₀ x₀ step
            rw [cf₂] at eqn
            exact Eq.trans _step' eqn
          else by
            let ⟨ys, eqn, ineqn⟩ := nonzero_coeff_has_complement x₀ t p₁
            let s₃ := (a₀ + a₁, x₀) :: ys
            have eq₁ : (a₀, x₀) :: (a₁, x₀) :: ys ≃ s₃ := by
              apply Quot.sound
              let lem := ElementaryMove.addCoeffs a₀ a₁ x₀ ys
              exact lem
            have eq₂ : (a₀, x₀) :: (a₁, x₀) :: ys ≃ (a₀, x₀) :: t := by
              apply cons_equiv_of_equiv
              assumption
            have eq₃ : s₃ ≃ s₂ := by
              have _ : ys.length + 1 < t.length + 1 := by
                apply Nat.succ_lt_succ
                exact ineqn
              apply equiv_of_equal_coeffs
              intro x
              rw [← hyp x]
              simp [coords]
              let d := coords_well_defined x _ _ eqn
              rw [coords] at d
              rw [← d]
              simp [monom_coords_hom, coords, add_assoc]
            apply Eq.trans (Eq.trans (Eq.symm eq₂) eq₁) eq₃
  termination_by
  _ R X s _ _ => s.length decreasing_by
  assumption

/-!
## Functions invariant under moves pass to the quotient.
-/
/-- Lifting functions to the move induced quotient. -/
theorem func_eql_of_move_equiv  {β : Sort u} (f : FormalSum R X → β) : (∀ s₁ s₂ : FormalSum R X, ElementaryMove R X s₁ s₂ → f s₁ = f s₂) → (∀ s₁ s₂ : FormalSum R X, s₁ ≈ s₂ → f s₁ = f s₂) :=
  by
  intro hyp
  let fbar : FreeModuleAux R X → β := Quot.lift f hyp
  let fct : ∀ s : FormalSum R X, f s = fbar (sum s) := by
    apply Quot.liftBeta
    apply hyp
  intro s₁ s₂ sim
  have ec : eqlCoords R X s₁ s₂ := sim
  rw [eqlCoords] at ec
  have pullback : sum s₁ = sum s₂ := by
    apply equiv_of_equal_coeffs
    intro x
    exact congrFun ec x
  simp [fct, pullback]

end FormalSum
end ElementaryMoves

section Injectivity
/-!
## Injectivity of inclusions

We show that, under appropriate hypotheses, two inclusions into Free Modules are injective.

* If `a : R` is nonzero, then `x : X ↦ ⟦[(a, x)]⟧` is injective.
* If `x: X`, then `a : R ↦ ⟦[(a, x)]⟧` is injective.

These are used in proving injectivity results for related functions on group rings, which act as a check on the correctness of the definitions.
-/
open FormalSum

/-- For `a: R` and `a ≠ 0`,  injectivity of the the function `x: X ↦ [(a, x)]` up to equivalence  -/
theorem monom_elem_eq_of_coord_eq_nonzero (a : R)(non_zero: a ≠ 0) (x₀ x₁ : X) : coords [(a, x₀)] = coords [(a, x₁)] → x₀ = x₁ := by
  intro hyp
  have sup₀ : support [(a, x₀)] = [x₀] := by
    rfl
  have c₁ : coords [(a, x₁)] x₁ = a := by
    simp [coords, monomCoeff]
  rw [← c₁] at non_zero
  symm at non_zero
  rw [← hyp] at non_zero
  let lem := nonzero_coord_in_support [(a, x₀)] x₁ non_zero
  simp [support] at lem
  apply Eq.symm
  assumption

/-- For `x : X`, injectivity of the the function `a: R ↦ [(a, x)]` up to equivalence  -/
theorem monom_coeff_eq_of_coord_eq (x : X) (a₀ a₁ : R) : coords [(a₀, x)] = coords [(a₁, x)] → a₀ = a₁ := by
  intro hyp
  let h₁ := congrFun hyp x
  simp [coords, monomCoeff] at h₁
  assumption

/-- For `x: X`, the functions `a : R ↦ ⟦[(a, x)]⟧`-/
def coeffInclusion (x₀ : X) : R → R[X] :=
  fun a₀ => ⟦[(a₀, x₀)]⟧

/-- Injectivity of `coeffInclusion` -/
theorem coeffInclusion_injective (x₀ : X)
 (a₀ a₁ : R) : coeffInclusion x₀ a₀ =
                coeffInclusion x₀ a₁  →  a₀ = a₁ := by
  intro hyp
  simp [coeffInclusion] at hyp
  exact monom_coeff_eq_of_coord_eq x₀ a₀ a₁ hyp

/-- For `a: A`, the function `x: X ↦ ⟦[(a, x)]⟧`-/
def baseInclusion (a₀ : R) : X → R[X] :=
  fun x₀ => ⟦[(a₀, x₀)]⟧

/-- Injectivity of `baseInclusion a` give `a ≠0`   -/
theorem baseInclusion_injective (a₀ : R) (non_zero : a₀ ≠ 0)
 (x₀ x₁ : X) : baseInclusion  a₀ x₀ =
                baseInclusion a₀ x₁  →  x₀ = x₁ := by
  intro hyp
  simp [baseInclusion] at hyp
  exact monom_elem_eq_of_coord_eq_nonzero a₀ non_zero x₀ x₁ hyp

end Injectivity
section NormRepr

/-!
## Basic `Repr`

An instance of `Repr` on Free Modules, mainly for debugging (fairly crude). This is implemented by constructing a norm ball containing all the non-zero coordinates, and then making a list of non-zero coordinates
-/

theorem fst_le_max (a b : Nat): a ≤ max a b  := by
    simp [max]
    exact if c:a ≤ b
          then by
              unfold max
              unfold Nat.instMaxNat
              unfold maxOfLe
              simp [if_pos c]
              assumption
          else by
              unfold max
              unfold Nat.instMaxNat
              unfold maxOfLe
              simp [if_neg c]

theorem snd_le_max (a b : Nat): b ≤ max a b  := by
    simp [max]
    exact if c: a ≤ b
    then by
      unfold max
      unfold Nat.instMaxNat
      unfold maxOfLe
      simp [if_pos c]
    else by
      unfold max
      unfold Nat.instMaxNat
      unfold maxOfLe
      simp [if_neg c]
      apply Nat.le_of_lt
      let c' := Nat.gt_of_not_le c
      assumption

theorem eq_fst_or_snd_of_max (a b : Nat) : (max a b = a) ∨ (max a b = b) := by
      simp [max]
      exact if c: a ≤ b
        then by
          unfold max
          unfold Nat.instMaxNat
          unfold maxOfLe
          simp [if_pos c]
        else by
          unfold max
          unfold Nat.instMaxNat
          unfold maxOfLe
          simp [if_neg c]

def maxNormSuccOnSupp (norm: X → Nat)(crds : X → R)(s: List X) : Nat :=
  match s with
  | [] => 0
  | head :: tail =>
      if crds head ≠ 0 then
        max (norm head + 1) (maxNormSuccOnSupp norm crds tail)
      else
        maxNormSuccOnSupp norm crds tail

theorem max_in_support (norm: X → Nat)(crds : X → R)(s: List X) : maxNormSuccOnSupp norm crds s > 0 →
  ∃ x : X, crds x ≠ 0 ∧ maxNormSuccOnSupp norm crds s = norm x + 1 := by
  intro h
  induction s with
  | nil =>
    simp [maxNormSuccOnSupp] at h
  | cons head tail ih =>
    exact if c : crds head =0 then
      by
        simp [maxNormSuccOnSupp, c]
        simp [maxNormSuccOnSupp, c] at h
        exact  ih h

    else by
        simp [maxNormSuccOnSupp, c]
        simp [maxNormSuccOnSupp, c] at h
        let sl := eq_fst_or_snd_of_max (norm head + 1) (maxNormSuccOnSupp norm crds tail)
        cases sl
        case inr p =>
            rw [p]
            rw [p] at h
            exact  ih h
        case inl p =>
            rw [p]
            rw [p] at h
            exact ⟨head, And.intro c rfl⟩

theorem supp_below_max(norm: X → Nat)(crds : X → R)(s: List X) : (x: X) → x ∈ s →  crds x ≠ 0 → norm x + 1 ≤ maxNormSuccOnSupp norm crds s := by
    intro x h₁ h₂
    cases h₁
    case head as =>
      rw [maxNormSuccOnSupp]
      simp [h₂]
      apply fst_le_max
    case tail a as th =>
      rw [maxNormSuccOnSupp]
      let l := supp_below_max norm crds as  x  th h₂
      exact if c:crds a ≠ 0 then
        by
        simp [c]
        apply Nat.le_trans l
        apply snd_le_max
      else
        by
        simp [c]
        exact l

theorem supp_zero_of_max_zero(norm: X → Nat)(crds : X → R)(s: List X) : maxNormSuccOnSupp norm crds s = 0 →
    (x: X) → x ∈ s →  crds x = 0 := fun hyp x hm =>
      if c:crds x = 0 then c
      else by
        simp
        let l := supp_below_max norm crds s x hm c
        rw [hyp] at l
        contradiction

def FormalSum.normSucc (norm : X → Nat)(s: FormalSum R X) : Nat :=
      maxNormSuccOnSupp norm s.coords (s.support)

open FormalSum
theorem normsucc_le(norm : X → Nat)(s₁ s₂: FormalSum R X)(eql : s₁ ≈ s₂): s₁.normSucc norm ≤ s₂.normSucc norm :=
      if c:s₁.normSucc norm = 0 then
      by
        rw [c]
        apply Nat.zero_le
      else by
        simp [FormalSum.normSucc]
        simp [FormalSum.normSucc] at c
        let c' : maxNormSuccOnSupp norm (coords s₁) (support s₁) > 0 :=
            by
            cases Nat.eq_zero_or_pos (maxNormSuccOnSupp norm (coords s₁) (support s₁))
            contradiction
            assumption
        let l := max_in_support norm s₁.coords s₁.support c'
        let ⟨x₀, p⟩:= l
        let nonzr' := p.left
        let l := congrFun eql x₀
        rw [l] at nonzr'
        let nonzr : 0 ≠ s₂.coords x₀ := by
          intro hyp
          let l' := Eq.symm hyp
          contradiction
        let in_supp := nonzero_coord_in_support s₂ x₀ nonzr
        rw [p.right]
        simp
        apply supp_below_max norm s₂.coords s₂.support x₀ in_supp nonzr'

theorem norm_succ_eq(norm : X → Nat)(s₁ s₂: FormalSum R X)(eql : s₁ ≈ s₂):
    s₁.normSucc norm = s₂.normSucc norm := by
      apply Nat.le_antisymm <;> apply normsucc_le
      assumption
      apply eqlCoords.symm
      assumption

class NormCube (α : Type) where
  norm : α → Nat
  cube : Nat → List α

def normCube (α : Type) [nc : NormCube α](k: Nat)  := nc.cube k

instance natCube : NormCube Nat := ⟨id, fun n => (List.range n).reverse⟩

instance finCube {k: Nat} : NormCube (Fin (Nat.succ k)) :=
    let i : Nat → Fin (Nat.succ k) := fun n => ⟨n % (Nat.succ k), by
          apply Nat.mod_lt
          apply Nat.zero_lt_succ
          ⟩
    ⟨fun j => j.val, fun n => (List.range (min (k + 1) n)).reverse.map i⟩

instance intCube : NormCube ℤ where
  norm := Int.natAbs
  cube : Nat → List ℤ := fun n =>
      (List.range (n)).reverse.map (Int.ofNat) ++
      (List.range (n - 1)).map (Int.negSucc)

instance prodCube {α β : Type} [na: NormCube α] [nb :NormCube β] :  NormCube (α × β) where
  norm : (α × β) → Nat :=
    fun ⟨a, b⟩ => max (na.norm a) (nb.norm b)
  cube : Nat → List (α × β) :=
    fun n =>
      (na.cube n).bind (fun a =>
        (nb.cube n).map  (fun b =>
          (a, b)))

def FreeModule.normBound (x: R[X])[nx : NormCube X] : Nat := by
  let f : FormalSum R X → Nat := fun s => s.normSucc (nx.norm)
  apply Quotient.lift f
  apply norm_succ_eq
  exact x

-- this should be viewable directly if `R` and `X` are, as in our case
def FreeModule.coeffList (x: R[X])[nx : NormCube X] : List (R × X) :=
   (nx.cube (x.normBound)).filterMap fun x₀ =>
      let a := x.coordinates x₀
      if a =0 then none else some (a, x₀)

-- basic repr
instance basicRepr [NormCube X][Repr X][Repr R]: Repr (R[X]) :=
  ⟨fun x _ => reprStr (x.coeffList)⟩

end NormRepr


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import algebra.order.ring
import algebra.invertible

/-!
# Lemmas about `inv_of` in ordered (semi)rings.
-/

variables {α : Type*} [linear_ordered_semiring α] {a : α}

@[simp] lemma inv_of_pos [invertible a] : 0 < ⅟a ↔ 0 < a :=
begin
  have : 0 < a * ⅟a, by simp only [mul_inv_of_self, zero_lt_one],
  exact ⟨λ h, pos_of_mul_pos_right this h.le, λ h, pos_of_mul_pos_left this h.le⟩
end

@[simp] lemma inv_of_nonpos [invertible a] : ⅟a ≤ 0 ↔ a ≤ 0 :=
by simp only [← not_lt, inv_of_pos]

@[simp] lemma inv_of_nonneg [invertible a] : 0 ≤ ⅟a ↔ 0 ≤ a :=
begin
  have : 0 < a * ⅟a, by simp only [mul_inv_of_self, zero_lt_one],
  exact ⟨λ h, (pos_of_mul_pos_right this h).le, λ h, (pos_of_mul_pos_left this h).le⟩
end

@[simp] lemma inv_of_lt_zero [invertible a] : ⅟a < 0 ↔ a < 0 :=
by simp only [← not_le, inv_of_nonneg]

@[simp] lemma inv_of_le_one [invertible a] (h : 1 ≤ a) : ⅟a ≤ 1 :=
by haveI := @linear_order.decidable_le α _; exact
mul_inv_of_self a ▸ decidable.le_mul_of_one_le_left (inv_of_nonneg.2 $ zero_le_one.trans h) h


-- Let us copy Lean's definition of `eq` to our own version of equality
inductive myeq {α : Sort u} (a : α) : α → Prop
| refl : myeq a a

-- Our goal is to show that `myeq` is an equivalence relation. That is,
-- (1) Reflexivity: for all `x : α`, we have `x ∼ x`
-- (2) Symmetry: for all `x y : α`, if `x ∼ y` then `y ∼ x`
-- (3) Transitivity: for all `x y z : α`, if `x ∼ y` and `y ∼ z` then `x ∼ z`

-- For convenience, we define an infix notation `\sim` so that we can write `x ∼ y` instead of `myeq x y`
infix:50 " ∼ " => myeq

-- We create a namespace `myeq`, so that all theorems `T` we prove will be called `myeq.T`
namespace myeq

-- Also, we define some variables, so that we don't have to write them again for each theorem
variable {X : Sort u} {x y z : X}

-- (1) Reflexivity follows by definition: it is the constructor! (That is why it is called `refl`)
example : x ∼ x := refl

-- We can use the recursor `myeq.rec` to prove that `myeq` is the smallest reflexive relation, that is,
-- for any other relation `R` on `X` such that `R x x` holds for all `x : X`, if `x ∼ y`, then also `R x y`
theorem min_refl (R : X → X → Prop) (h : ∀ x, R x x) (hxy : x ∼ y) : R x y :=
  myeq.rec (h x) hxy

/-
  # Exercises
   Replace each of the sorry's below by proofs, using only things defined in this file
   That means, using no other tactics than `exact`
-/

-- (2) Symmetry: for all `x y : α`, if `x ∼ y` then `y ∼ x`
theorem symm (hxy : x ∼ y) : y ∼ x :=
  min_refl (λ u v => v ∼ u) (λ _ => myeq.refl) hxy

-- It might be useful to prove the following lemma
theorem subst (P : X → Prop) (hxy : x ∼ y) : P x → P y :=
  min_refl (λ a b => P a → P b) (λ _ p => p) hxy

-- (3) Transitivity: for all `x y z : α`, if `x ∼ y` and `y ∼ z` then `x ∼ z`
theorem trans (hxy : x ∼ y) (hyz : y ∼ z) : x ∼ z :=
  subst (λ a => x ∼ a) hyz hxy

-- Some additional exercises:
theorem function_invariant (f : X → Sort _) (hxy : x ∼ y) : f x ∼ f y :=
  min_refl (λ a b => f a ∼ f b) (λ _ => refl) hxy

-- Why is the following theorem ill-formed?
--theorem product_invariant (hxy : x ∼ y) (t : X → Sort*) (ht : t x ∼ t y) (f : Π z : X, t z) : f x ∼ f y := sorry

def rewrite (f : X → Sort u) : x ∼ y → f x → f y := λ h₁ h₂ =>
match h₁ with
  | refl => h₂

-- Application of `rewrite`:
example (x y z : Prop) (hxy : x ∼ y) (u : x ∧ z) : (y ∧ z) := rewrite (λ a => a ∧ z) hxy u

end myeq


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

! This file was ported from Lean 3 source module ring_theory.polynomial.opposites
! leanprover-community/mathlib commit 63417e01fbc711beaf25fa73b6edb395c0cfddd0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.Degree.Definitions

/-!  #  Interactions between `R[X]` and `Rᵐᵒᵖ[X]`

This file contains the basic API for "pushing through" the isomorphism
`opRingEquiv : R[X]ᵐᵒᵖ ≃+* Rᵐᵒᵖ[X]`.  It allows going back and forth between a polynomial ring
over a semiring and the polynomial ring over the opposite semiring. -/

open Polynomial

open Polynomial MulOpposite

variable {R : Type _} [Semiring R]

noncomputable section

namespace Polynomial

/-- Ring isomorphism between `R[X]ᵐᵒᵖ` and `Rᵐᵒᵖ[X]` sending each coefficient of a polynomial
to the corresponding element of the opposite ring. -/
def opRingEquiv (R : Type _) [Semiring R] : R[X]ᵐᵒᵖ ≃+* Rᵐᵒᵖ[X] :=
  ((toFinsuppIso R).op.trans AddMonoidAlgebra.opRingEquiv).trans (toFinsuppIso _).symm
#align polynomial.op_ring_equiv Polynomial.opRingEquiv

/-!  Lemmas to get started, using `opRingEquiv R` on the various expressions of
`Finsupp.single`: `monomial`, `C a`, `X`, `C a * X ^ n`. -/

@[simp]
theorem opRingEquiv_op_monomial (n : ℕ) (r : R) :
    opRingEquiv R (op (monomial n r : R[X])) = monomial n (op r) := by
  simp only [opRingEquiv, RingEquiv.coe_trans, Function.comp_apply,
    AddMonoidAlgebra.opRingEquiv_apply, RingEquiv.op_apply_apply_unop, toFinsuppIso_apply,
    toFinsupp_monomial, Finsupp.mapRange_single, toFinsuppIso_symm_apply, ofFinsupp_single]
#align polynomial.op_ring_equiv_op_monomial Polynomial.opRingEquiv_op_monomial

@[simp]
theorem opRingEquiv_op_C (a : R) : opRingEquiv R (op (C a)) = C (op a) :=
  opRingEquiv_op_monomial 0 a
set_option linter.uppercaseLean3 false in
#align polynomial.op_ring_equiv_op_C Polynomial.opRingEquiv_op_C

@[simp]
theorem opRingEquiv_op_X : opRingEquiv R (op (X : R[X])) = X :=
  opRingEquiv_op_monomial 1 1
set_option linter.uppercaseLean3 false in
#align polynomial.op_ring_equiv_op_X Polynomial.opRingEquiv_op_X

theorem opRingEquiv_op_C_mul_X_pow (r : R) (n : ℕ) :
    opRingEquiv R (op (C r * X ^ n : R[X])) = C (op r) * X ^ n := by
  simp only [X_pow_mul, op_mul, op_pow, map_mul, map_pow, opRingEquiv_op_X, opRingEquiv_op_C]
set_option linter.uppercaseLean3 false in
#align polynomial.op_ring_equiv_op_C_mul_X_pow Polynomial.opRingEquiv_op_C_mul_X_pow

/-!  Lemmas to get started, using `(opRingEquiv R).symm` on the various expressions of
`Finsupp.single`: `monomial`, `C a`, `X`, `C a * X ^ n`. -/

@[simp]
theorem opRingEquiv_symm_monomial (n : ℕ) (r : Rᵐᵒᵖ) :
    (opRingEquiv R).symm (monomial n r) = op (monomial n (unop r)) :=
  (opRingEquiv R).injective (by simp)
#align polynomial.op_ring_equiv_symm_monomial Polynomial.opRingEquiv_symm_monomial

@[simp]
theorem opRingEquiv_symm_C (a : Rᵐᵒᵖ) : (opRingEquiv R).symm (C a) = op (C (unop a)) :=
  opRingEquiv_symm_monomial 0 a
set_option linter.uppercaseLean3 false in
#align polynomial.op_ring_equiv_symm_C Polynomial.opRingEquiv_symm_C

@[simp]
theorem opRingEquiv_symm_X : (opRingEquiv R).symm (X : Rᵐᵒᵖ[X]) = op X :=
  opRingEquiv_symm_monomial 1 1
set_option linter.uppercaseLean3 false in
#align polynomial.op_ring_equiv_symm_X Polynomial.opRingEquiv_symm_X

theorem opRingEquiv_symm_C_mul_X_pow (r : Rᵐᵒᵖ) (n : ℕ) :
    (opRingEquiv R).symm (C r * X ^ n : Rᵐᵒᵖ[X]) = op (C (unop r) * X ^ n) := by
  rw [C_mul_X_pow_eq_monomial, opRingEquiv_symm_monomial, C_mul_X_pow_eq_monomial]
set_option linter.uppercaseLean3 false in
#align polynomial.op_ring_equiv_symm_C_mul_X_pow Polynomial.opRingEquiv_symm_C_mul_X_pow

/-!  Lemmas about more global properties of polynomials and opposites. -/

@[simp]
theorem coeff_opRingEquiv (p : R[X]ᵐᵒᵖ) (n : ℕ) :
    (opRingEquiv R p).coeff n = op ((unop p).coeff n) := by
  induction' p using MulOpposite.rec' with p
  cases p
  rfl
#align polynomial.coeff_op_ring_equiv Polynomial.coeff_opRingEquiv

@[simp]
theorem support_opRingEquiv (p : R[X]ᵐᵒᵖ) : (opRingEquiv R p).support = (unop p).support := by
  induction' p using MulOpposite.rec' with p
  cases p
  exact Finsupp.support_mapRange_of_injective (map_zero _) _ op_injective
#align polynomial.support_op_ring_equiv Polynomial.support_opRingEquiv

@[simp]
theorem natDegree_opRingEquiv (p : R[X]ᵐᵒᵖ) : (opRingEquiv R p).natDegree = (unop p).natDegree := by
  by_cases p0 : p = 0
  · simp only [p0, _root_.map_zero, natDegree_zero, unop_zero]
  · simp only [p0, natDegree_eq_support_max', Ne.def, AddEquivClass.map_eq_zero_iff, not_false_iff,
      support_opRingEquiv, unop_eq_zero_iff]
#align polynomial.nat_degree_op_ring_equiv Polynomial.natDegree_opRingEquiv

@[simp]
theorem leadingCoeff_opRingEquiv (p : R[X]ᵐᵒᵖ) :
    (opRingEquiv R p).leadingCoeff = op (unop p).leadingCoeff := by
  rw [leadingCoeff, coeff_opRingEquiv, natDegree_opRingEquiv, leadingCoeff]
#align polynomial.leading_coeff_op_ring_equiv Polynomial.leadingCoeff_opRingEquiv

end Polynomial