/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.specific_limits

/-!
# The group of units of a complete normed ring

This file contains the basic theory for the group of units (invertible elements) of a complete
normed ring (Banach algebras being a notable special case).

## Main results

The constructions `one_sub`, `add` and `unit_of_nearby` state, in varying forms, that perturbations
of a unit are units.  The latter two are not stated in their optimal form; more precise versions
would use the spectral radius.

The first main result is `is_open`:  the group of units of a complete normed ring is an open subset
of the ring.

The function `inverse` (defined in `algebra.ring`), for a ring `R`, sends `a : R` to `a⁻¹` if `a` is
a unit and 0 if not.  The other major results of this file (notably `inverse_add`,
`inverse_add_norm` and `inverse_add_norm_diff_nth_order`) cover the asymptotic properties of
`inverse (x + t)` as `t → 0`.

-/

noncomputable theory
open_locale topological_space
variables {R : Type*} [normed_ring R] [complete_space R]

namespace units

/-- In a complete normed ring, a perturbation of `1` by an element `t` of distance less than `1`
from `1` is a unit.  Here we construct its `units` structure.  -/
@[simps coe]
def one_sub (t : R) (h : ∥t∥ < 1) : Rˣ :=
{ val := 1 - t,
  inv := ∑' n : ℕ, t ^ n,
  val_inv := mul_neg_geom_series t h,
  inv_val := geom_series_mul_neg t h }

/-- In a complete normed ring, a perturbation of a unit `x` by an element `t` of distance less than
`∥x⁻¹∥⁻¹` from `x` is a unit.  Here we construct its `units` structure. -/
@[simps coe]
def add (x : Rˣ) (t : R) (h : ∥t∥ < ∥(↑x⁻¹ : R)∥⁻¹) : Rˣ :=
units.copy  -- to make `coe_add` true definitionally, for convenience
  (x * (units.one_sub (-(↑x⁻¹ * t)) begin
      nontriviality R using [zero_lt_one],
      have hpos : 0 < ∥(↑x⁻¹ : R)∥ := units.norm_pos x⁻¹,
      calc ∥-(↑x⁻¹ * t)∥
          = ∥↑x⁻¹ * t∥                    : by { rw norm_neg }
      ... ≤ ∥(↑x⁻¹ : R)∥ * ∥t∥            : norm_mul_le ↑x⁻¹ _
      ... < ∥(↑x⁻¹ : R)∥ * ∥(↑x⁻¹ : R)∥⁻¹ : by nlinarith only [h, hpos]
      ... = 1                             : mul_inv_cancel (ne_of_gt hpos)
    end))
  (x + t) (by simp [mul_add]) _ rfl

/-- In a complete normed ring, an element `y` of distance less than `∥x⁻¹∥⁻¹` from `x` is a unit.
Here we construct its `units` structure. -/
@[simps coe]
def unit_of_nearby (x : Rˣ) (y : R) (h : ∥y - x∥ < ∥(↑x⁻¹ : R)∥⁻¹) : Rˣ :=
units.copy (x.add (y - x : R) h) y (by simp) _ rfl

/-- The group of units of a complete normed ring is an open subset of the ring. -/
protected lemma is_open : is_open {x : R | is_unit x} :=
begin
  nontriviality R,
  apply metric.is_open_iff.mpr,
  rintros x' ⟨x, rfl⟩,
  refine ⟨∥(↑x⁻¹ : R)∥⁻¹, _root_.inv_pos.mpr (units.norm_pos x⁻¹), _⟩,
  intros y hy,
  rw [metric.mem_ball, dist_eq_norm] at hy,
  exact (x.unit_of_nearby y hy).is_unit
end

protected lemma nhds (x : Rˣ) : {x : R | is_unit x} ∈ 𝓝 (x : R) :=
is_open.mem_nhds units.is_open x.is_unit

end units

namespace normed_ring
open_locale classical big_operators
open asymptotics filter metric finset ring

lemma inverse_one_sub (t : R) (h : ∥t∥ < 1) : inverse (1 - t) = ↑(units.one_sub t h)⁻¹ :=
by rw [← inverse_unit (units.one_sub t h), units.coe_one_sub]

/-- The formula `inverse (x + t) = inverse (1 + x⁻¹ * t) * x⁻¹` holds for `t` sufficiently small. -/
lemma inverse_add (x : Rˣ) :
  ∀ᶠ t in (𝓝 0), inverse ((x : R) + t) = inverse (1 + ↑x⁻¹ * t) * ↑x⁻¹ :=
begin
  nontriviality R,
  rw [eventually_iff, metric.mem_nhds_iff],
  have hinv : 0 < ∥(↑x⁻¹ : R)∥⁻¹, by cancel_denoms,
  use [∥(↑x⁻¹ : R)∥⁻¹, hinv],
  intros t ht,
  simp only [mem_ball, dist_zero_right] at ht,
  have ht' : ∥-↑x⁻¹ * t∥ < 1,
  { refine lt_of_le_of_lt (norm_mul_le _ _) _,
    rw norm_neg,
    refine lt_of_lt_of_le (mul_lt_mul_of_pos_left ht x⁻¹.norm_pos) _,
    cancel_denoms },
  have hright := inverse_one_sub (-↑x⁻¹ * t) ht',
  have hleft := inverse_unit (x.add t ht),
  simp only [← neg_mul_eq_neg_mul, sub_neg_eq_add] at hright,
  simp only [units.coe_add] at hleft,
  simp [hleft, hright, units.add]
end

lemma inverse_one_sub_nth_order (n : ℕ) :
  ∀ᶠ t in (𝓝 0), inverse ((1:R) - t) = (∑ i in range n, t ^ i) + (t ^ n) * inverse (1 - t) :=
begin
  simp only [eventually_iff, metric.mem_nhds_iff],
  use [1, by norm_num],
  intros t ht,
  simp only [mem_ball, dist_zero_right] at ht,
  simp only [inverse_one_sub t ht, set.mem_set_of_eq],
  have h : 1 = ((range n).sum (λ i, t ^ i)) * (units.one_sub t ht) + t ^ n,
  { simp only [units.coe_one_sub],
    rw [← geom_sum, geom_sum_mul_neg],
    simp },
  rw [← one_mul ↑(units.one_sub t ht)⁻¹, h, add_mul],
  congr,
  { rw [mul_assoc, (units.one_sub t ht).mul_inv],
    simp },
  { simp only [units.coe_one_sub],
    rw [← add_mul, ← geom_sum, geom_sum_mul_neg],
    simp }
end

/-- The formula
`inverse (x + t) = (∑ i in range n, (- x⁻¹ * t) ^ i) * x⁻¹ + (- x⁻¹ * t) ^ n * inverse (x + t)`
holds for `t` sufficiently small. -/
lemma inverse_add_nth_order (x : Rˣ) (n : ℕ) :
  ∀ᶠ t in (𝓝 0), inverse ((x : R) + t)
  = (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹ + (- ↑x⁻¹ * t) ^ n * inverse (x + t) :=
begin
  refine (inverse_add x).mp _,
  have hzero : tendsto (λ (t : R), - ↑x⁻¹ * t) (𝓝 0) (𝓝 0),
  { convert ((mul_left_continuous (- (↑x⁻¹ : R))).tendsto 0).comp tendsto_id,
    simp },
  refine (hzero.eventually (inverse_one_sub_nth_order n)).mp (eventually_of_forall _),
  simp only [neg_mul_eq_neg_mul_symm, sub_neg_eq_add],
  intros t h1 h2,
  have h := congr_arg (λ (a : R), a * ↑x⁻¹) h1,
  dsimp at h,
  convert h,
  rw [add_mul, mul_assoc],
  simp [h2.symm]
end

lemma inverse_one_sub_norm : is_O (λ t, inverse ((1:R) - t)) (λ t, (1:ℝ)) (𝓝 (0:R)) :=
begin
  simp only [is_O, is_O_with, eventually_iff, metric.mem_nhds_iff],
  refine ⟨∥(1:R)∥ + 1, (2:ℝ)⁻¹, by norm_num, _⟩,
  intros t ht,
  simp only [ball, dist_zero_right, set.mem_set_of_eq] at ht,
  have ht' : ∥t∥ < 1,
  { have : (2:ℝ)⁻¹ < 1 := by cancel_denoms,
    linarith },
  simp only [inverse_one_sub t ht', norm_one, mul_one, set.mem_set_of_eq],
  change ∥∑' n : ℕ, t ^ n∥ ≤ _,
  have := normed_ring.tsum_geometric_of_norm_lt_1 t ht',
  have : (1 - ∥t∥)⁻¹ ≤ 2,
  { rw ← inv_inv₀ (2:ℝ),
    refine inv_le_inv_of_le (by norm_num) _,
    have : (2:ℝ)⁻¹ + (2:ℝ)⁻¹ = 1 := by ring,
    linarith },
  linarith
end

/-- The function `λ t, inverse (x + t)` is O(1) as `t → 0`. -/
lemma inverse_add_norm (x : Rˣ) : is_O (λ t, inverse (↑x + t)) (λ t, (1:ℝ)) (𝓝 (0:R)) :=
begin
  simp only [is_O_iff, norm_one, mul_one],
  cases is_O_iff.mp (@inverse_one_sub_norm R _ _) with C hC,
  use C * ∥((x⁻¹:Rˣ):R)∥,
  have hzero : tendsto (λ t, - (↑x⁻¹ : R) * t) (𝓝 0) (𝓝 0),
  { convert ((mul_left_continuous (-↑x⁻¹ : R)).tendsto 0).comp tendsto_id,
    simp },
  refine (inverse_add x).mp ((hzero.eventually hC).mp (eventually_of_forall _)),
  intros t bound iden,
  rw iden,
  simp at bound,
  have hmul := norm_mul_le (inverse (1 + ↑x⁻¹ * t)) ↑x⁻¹,
  nlinarith [norm_nonneg (↑x⁻¹ : R)]
end

/-- The function
`λ t, inverse (x + t) - (∑ i in range n, (- x⁻¹ * t) ^ i) * x⁻¹`
is `O(t ^ n)` as `t → 0`. -/
lemma inverse_add_norm_diff_nth_order (x : Rˣ) (n : ℕ) :
  is_O (λ (t : R), inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹)
  (λ t, ∥t∥ ^ n) (𝓝 (0:R)) :=
begin
  by_cases h : n = 0,
  { simpa [h] using inverse_add_norm x },
  have hn : 0 < n := nat.pos_of_ne_zero h,
  simp [is_O_iff],
  cases (is_O_iff.mp (inverse_add_norm x)) with C hC,
  use C * ∥(1:ℝ)∥ * ∥(↑x⁻¹ : R)∥ ^ n,
  have h : eventually_eq (𝓝 (0:R))
    (λ t, inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹)
    (λ t, ((- ↑x⁻¹ * t) ^ n) * inverse (x + t)),
  { refine (inverse_add_nth_order x n).mp (eventually_of_forall _),
    intros t ht,
    convert congr_arg (λ a, a - (range n).sum (pow (-↑x⁻¹ * t)) * ↑x⁻¹) ht,
    simp },
  refine h.mp (hC.mp (eventually_of_forall _)),
  intros t _ hLHS,
  simp only [neg_mul_eq_neg_mul_symm] at hLHS,
  rw hLHS,
  refine le_trans (norm_mul_le _ _ ) _,
  have h' : ∥(-(↑x⁻¹ * t)) ^ n∥ ≤ ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n,
  { calc ∥(-(↑x⁻¹ * t)) ^ n∥ ≤ ∥(-(↑x⁻¹ * t))∥ ^ n : norm_pow_le' _ hn
    ... = ∥↑x⁻¹ * t∥ ^ n : by rw norm_neg
    ... ≤ (∥(↑x⁻¹ : R)∥ * ∥t∥) ^ n : _
    ... =  ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n : mul_pow _ _ n,
    exact pow_le_pow_of_le_left (norm_nonneg _) (norm_mul_le ↑x⁻¹ t) n },
  have h'' : 0 ≤ ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n,
  { refine mul_nonneg _ _;
    exact pow_nonneg (norm_nonneg _) n },
  nlinarith [norm_nonneg (inverse (↑x + t))],
end

/-- The function `λ t, inverse (x + t) - x⁻¹` is `O(t)` as `t → 0`. -/
lemma inverse_add_norm_diff_first_order (x : Rˣ) :
  is_O (λ t, inverse (↑x + t) - ↑x⁻¹) (λ t, ∥t∥) (𝓝 (0:R)) :=
by simpa using inverse_add_norm_diff_nth_order x 1

/-- The function
`λ t, inverse (x + t) - x⁻¹ + x⁻¹ * t * x⁻¹`
is `O(t ^ 2)` as `t → 0`. -/
lemma inverse_add_norm_diff_second_order (x : Rˣ) :
  is_O (λ t, inverse (↑x + t) - ↑x⁻¹ + ↑x⁻¹ * t * ↑x⁻¹) (λ t, ∥t∥ ^ 2) (𝓝 (0:R)) :=
begin
  convert inverse_add_norm_diff_nth_order x 2,
  ext t,
  simp only [range_succ, range_one, sum_insert, mem_singleton, sum_singleton, not_false_iff,
    one_ne_zero, pow_zero, add_mul, pow_one, one_mul, neg_mul_eq_neg_mul_symm,
    sub_add_eq_sub_sub_swap, sub_neg_eq_add],
end

/-- The function `inverse` is continuous at each unit of `R`. -/
lemma inverse_continuous_at (x : Rˣ) : continuous_at inverse (x : R) :=
begin
  have h_is_o : is_o (λ (t : R), inverse (↑x + t) - ↑x⁻¹) (λ _, 1 : R → ℝ) (𝓝 0),
    from ((inverse_add_norm_diff_first_order x).trans_is_o
      (is_o_id_const (@one_ne_zero ℝ _ _)).norm_left),
  have h_lim : tendsto (λ (y:R), y - x) (𝓝 x) (𝓝 0),
  { refine tendsto_zero_iff_norm_tendsto_zero.mpr _,
    exact tendsto_iff_norm_tendsto_zero.mp tendsto_id },
  rw [continuous_at, tendsto_iff_norm_tendsto_zero, inverse_unit],
  simpa [(∘)] using h_is_o.norm_left.tendsto_div_nhds_zero.comp h_lim
end

end normed_ring

namespace units
open mul_opposite filter normed_ring

/-- In a normed ring, the coercion from `Rˣ` (equipped with the induced topology from the
embedding in `R × R`) to `R` is an open map. -/
lemma is_open_map_coe : is_open_map (coe : Rˣ → R) :=
begin
  rw is_open_map_iff_nhds_le,
  intros x s,
  rw [mem_map, mem_nhds_induced],
  rintros ⟨t, ht, hts⟩,
  obtain ⟨u, hu, v, hv, huvt⟩ :
    ∃ (u : set R), u ∈ 𝓝 ↑x ∧ ∃ (v : set Rᵐᵒᵖ), v ∈ 𝓝 (op ↑x⁻¹) ∧ u ×ˢ v ⊆ t,
  { simpa [embed_product, mem_nhds_prod_iff] using ht },
  have : u ∩ (op ∘ ring.inverse) ⁻¹' v ∩ (set.range (coe : Rˣ → R)) ∈ 𝓝 ↑x,
  { refine inter_mem (inter_mem hu _) (units.nhds x),
    refine (continuous_op.continuous_at.comp (inverse_continuous_at x)).preimage_mem_nhds _,
    simpa using hv },
  refine mem_of_superset this _,
  rintros _ ⟨⟨huy, hvy⟩, ⟨y, rfl⟩⟩,
  have : embed_product R y ∈ u ×ˢ v := ⟨huy, by simpa using hvy⟩,
  simpa using hts (huvt this)
end

/-- In a normed ring, the coercion from `Rˣ` (equipped with the induced topology from the
embedding in `R × R`) to `R` is an open embedding. -/
lemma open_embedding_coe : open_embedding (coe : Rˣ → R) :=
open_embedding_of_continuous_injective_open continuous_coe ext is_open_map_coe

end units


import data.real.basic tactic.norm_num
import xenalib.M1F.real_half_not_an_integer
import xenalib.M1F.int_squared_lt_3

noncomputable theory

-- what they need to know before they embark on this:
-- x ∈ A ∩ B → x ∈ A
-- x ∈ A → x ∈ A ∪ B
-- A ⊆ C ∧ x ∈ A ∧ x ∉ C → false
-- B = {-1,0,1} (only way to prove (d))
-- rw an iff
-- real_half_not_an_integer : ¬∃ (n : ℤ), 1 / 2 = ↑n
-- ¬ x is the same as x → false
-- x ∈ C ∧ x ∉ A ∧ x ∉ B ∧ C ⊆ A ∪ B → false
-- what to do with H : x = a ∨ x = b
-- rw H at H'

def A : set ℝ := { x | x^2 < 3}
def B : set ℝ := { x | x^2 < 3 ∧ ∃ y : ℤ, x = ↑y}
def C : set ℝ := { x | x^3 < 3}

/-
theorem part_a_true : (1/2 : ℝ) ∈ A ∩ B := sorry
theorem part_a_false : ¬ (1/2 : ℝ) ∈ A ∩ B := sorry
theorem part_b_true : (1/2 : ℝ) ∈ A ∪ B := sorry
theorem part_b_false : (1/2 : ℝ) ∈ A ∪ B := sorry
theorem part_c_true : A ⊆ C := sorry
theorem part_c_false : ¬ A ⊆ C := sorry
theorem part_d_true : B ⊆ C := sorry
theorem part_d_false : ¬ B ⊆ C := sorry
theorem part_e_true : C ⊆ A ∪ B := sorry
theorem part_e_false : ¬ C ⊆ A ∪ B := sorry
theorem part_f_true : (A ∩ B) ∪ C = (A ∪ B) ∩ C := sorry
theorem part_f_false : ¬ (A ∩ B) ∪ C = (A ∪ B) ∩ C := sorry
-/

theorem part_a_false : ¬ (1/2 : ℝ) ∈ A ∩ B :=
begin
  assume H : ((1/2):ℝ) ∈ A ∩ B,
  have H2: ((1/2):ℝ) ∈ B,
    exact and.right H,
  have H3: ∃ y : ℤ, ((1/2):ℝ) = ↑y,
    exact and.right H2,
  exact real_half_not_an_integer H3,
end

theorem part_b_true : (1/2 : ℝ) ∈ A ∪ B :=
begin
  apply set.subset_union_left,
  -- goal now "1/2 in A"
  -- let's rewrite this
  show (1/2 : ℝ) ^ 2 < 3,
  norm_num
end

theorem part_c_false : ¬ A ⊆ C :=
begin
  assume H : A ⊆ C,
  let x := (3/2 : ℝ), --  strat is to prove x is in A but not C
  have H2 : x ∈ A,
    show (3/2 : ℝ)^2 < 3,
    norm_num,
  have H3 : ¬ (x ∈ C),
    show ¬ (3/2 : ℝ) ^ 3 < 3,
    norm_num,
  suffices : x ∈ C,
    exact absurd this H3,
  suffices : x ∈ A,
    exact H this,
  exact H2,
end
-- To do part (d) it's helpful to evaluate B completely.
-- def B : set ℝ := {x | (∃ y : ℤ, x = of_rat y) ∧ x^2 < 3}

-- #check @eq.subst
-- #check rat.coe_int_mul
-- #check rat.coe_int_lt

lemma B_is_minus_one_or_zero_or_one (x : ℝ) (Hx : x ∈ B) : x = -1 ∨ x = 0 ∨ x = 1 :=
(B_is_minus_one_zero_one x).1 Hx

-- set_option pp.notation false
theorem part_d : B ⊆ C :=  -- B={-1,0,1} so this is true
begin
  intros x Hx,
  cases B_is_minus_one_or_zero_or_one x Hx with H H,
    rw H,
    unfold C,
    norm_num,
  cases H with H H,
    rw H,
    unfold C,norm_num,
  rw H,unfold C,norm_num,
end

-- To do parts e and f it's useful to note that -2 is in C but not A or B.

lemma two_in_C : (-2 : ℝ) ∈ C :=
begin
  unfold C,
  norm_num,
end

lemma two_not_in_A : (-2:real) ∉ A :=
begin
  unfold A,norm_num
end

lemma two_not_in_B : (-2:real) ∉ B :=
begin
  unfold B,norm_num,
end

theorem part_e : ¬ (C ⊆ A ∪ B) := -- not true as C contains -2
begin
  let x:=(-2:real),
  have HC : x ∈ C,
    exact two_in_C,
  have HnA : x ∉ A,
    exact two_not_in_A,
  have HnB : x ∉ B,
    exact two_not_in_B,
  intro H,
  have H2 : x ∈ (A ∪ B),
    exact H HC,
  cases H2 with HA HB,
    contradiction,
    contradiction,
end

theorem part_f : ¬ ((A ∩ B) ∪ C = (A ∪ B) ∩ C) :=
begin
let x:=(-2:real),
have HC : x ∈ C,
  exact two_in_C,
have HnA : x ∉ A,
  exact two_not_in_A,
have HnB : x ∉ B,
  exact two_not_in_B,
intro H,
have H1 : x ∈ ((A ∩ B) ∪ C),
  right,exact HC,
have H2 : x ∈ (A ∪ B) ∩ C,
  rw ←H,
  exact H1,
have H3 : x ∈ (A ∪ B),
  exact H2.left,
cases H3 with HA HB,
  contradiction,
  contradiction,
end


import tactic -- hide
import data.real.basic -- hide

/-
## Some more on `cases`

There is another application of the swiss-army knife `cases`. If we have `h : ∃ x, P x`, then sometimes we want to have
a witness for such an $x$. There are possibly many choices for such an $x$, but we
will just get one. When one does `cases h with x hx`, there will be a new value `x`
added to the list of "hypotheses", and the fact `hx : P x` for us to use.
-/

/- Lemma : no-side-bar
If we have $\sqrt{2}$ then we also have $\sqrt{8}$.
-/
lemma c3 (h : ∃ (x : ℝ), x^2 = 2) : ∃ (x : ℝ), x^2 = 8 :=
begin
cases h with r hr,
use 2 * r,
rw show (2 * r) ^ 2 = 2^2 * r^2, by ring,
rw hr,
ring,

end


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

import number_theory.bernoulli

/-!
# Bernoulli polynomials

The Bernoulli polynomials (defined here : https://en.wikipedia.org/wiki/Bernoulli_polynomials)
are an important tool obtained from Bernoulli numbers.

## Mathematical overview

The $n$-th Bernoulli polynomial is defined as
$$ B_n(X) = ∑_{k = 0}^n {n \choose k} (-1)^k * B_k * X^{n - k} $$
where $B_k$ is the $k$-th Bernoulli number. The Bernoulli polynomials are generating functions,
$$ t * e^{tX} / (e^t - 1) = ∑_{n = 0}^{\infty} B_n(X) * \frac{t^n}{n!} $$

## Implementation detail

Bernoulli polynomials are defined using `bernoulli`, the Bernoulli numbers.

## Main theorems

- `sum_bernoulli_poly`: The sum of the $k^\mathrm{th}$ Bernoulli polynomial with binomial
  coefficients up to n is `(n + 1) * X^n`.
- `exp_bernoulli_poly`: The Bernoulli polynomials act as generating functions for the exponential.

## TODO

- `bernoulli_poly_eval_one_neg` : $$ B_n(1 - x) = (-1)^n*B_n(x) $$
- ``bernoulli_poly_eval_one` : Follows as a consequence of `bernoulli_poly_eval_one_neg`.

-/

noncomputable theory
open_locale big_operators
open_locale nat

open nat finset

/-- The Bernoulli polynomials are defined in terms of the negative Bernoulli numbers. -/
def bernoulli_poly (n : ℕ) : polynomial ℚ :=
  ∑ i in range (n + 1), polynomial.monomial (n - i) ((bernoulli i) * (choose n i))

lemma bernoulli_poly_def (n : ℕ) : bernoulli_poly n =
  ∑ i in range (n + 1), polynomial.monomial i ((bernoulli (n - i)) * (choose n i)) :=
begin
  rw [←sum_range_reflect, add_succ_sub_one, add_zero, bernoulli_poly],
  apply sum_congr rfl,
  rintros x hx,
  rw mem_range_succ_iff at hx, rw [choose_symm hx, nat.sub_sub_self hx],
end

namespace bernoulli_poly

/-
### examples
-/

section examples

@[simp] lemma bernoulli_poly_zero : bernoulli_poly 0 = 1 :=
by simp [bernoulli_poly]

@[simp] lemma bernoulli_poly_eval_zero (n : ℕ) : (bernoulli_poly n).eval 0 = bernoulli n :=
begin
 rw [bernoulli_poly, polynomial.eval_finset_sum, sum_range_succ],
  have : ∑ (x : ℕ) in range n, bernoulli x * (n.choose x) * 0 ^ (n - x) = 0,
  { apply sum_eq_zero (λ x hx, _),
    have h : 0 < n - x := nat.sub_pos_of_lt (mem_range.1 hx),
    simp [h] },
  simp [this],
end

@[simp] lemma bernoulli_poly_eval_one (n : ℕ) : (bernoulli_poly n).eval 1 = bernoulli' n :=
begin
  simp only [bernoulli_poly, polynomial.eval_finset_sum],
  simp only [←succ_eq_add_one, sum_range_succ, mul_one, cast_one, choose_self,
    (bernoulli _).mul_comm, sum_bernoulli, one_pow, mul_one, polynomial.eval_C,
    polynomial.eval_monomial],
  by_cases h : n = 1,
  { norm_num [h], },
  { simp [h],
    exact bernoulli_eq_bernoulli'_of_ne_one h, }
end

end examples

@[simp] theorem sum_bernoulli_poly (n : ℕ) :
  ∑ k in range (n + 1), ((n + 1).choose k : ℚ) • bernoulli_poly k =
    polynomial.monomial n (n + 1 : ℚ) :=
begin
 simp_rw [bernoulli_poly_def, finset.smul_sum, finset.range_eq_Ico, ←finset.sum_Ico_Ico_comm,
    finset.sum_Ico_eq_sum_range],
  simp only [cast_succ, nat.add_sub_cancel_left, nat.sub_zero, zero_add, linear_map.map_add],
  simp_rw [polynomial.smul_monomial, mul_comm (bernoulli _) _, smul_eq_mul, ←mul_assoc],
  conv_lhs { apply_congr, skip, conv
    { apply_congr, skip,
      rw [choose_mul ((nat.le_sub_left_iff_add_le (mem_range_le H)).1 (mem_range_le H_1))
        (le.intro rfl), add_comm x x_1, nat.add_sub_cancel, mul_assoc, mul_comm, ←smul_eq_mul,
        ←polynomial.smul_monomial], },
    rw [←sum_smul], },
  rw [sum_range_succ_comm],
  simp only [add_right_eq_self, cast_succ, mul_one, cast_one, cast_add, nat.add_sub_cancel_left,
    choose_succ_self_right, one_smul, bernoulli_zero, sum_singleton, zero_add,
    linear_map.map_add, range_one],
  apply sum_eq_zero (λ x hx, _),
  have f : ∀ x ∈ range n, ¬ n + 1 - x = 1,
  { rintros x H, rw [mem_range] at H,
    rw [eq_comm],
    exact ne_of_lt (nat.lt_of_lt_of_le one_lt_two (nat.le_sub_left_of_add_le (succ_le_succ H))),
  },
  rw [sum_bernoulli],
  have g : (ite (n + 1 - x = 1) (1 : ℚ) 0) = 0,
    { simp only [ite_eq_right_iff, one_ne_zero],
      intro h₁,
      exact (f x hx) h₁, },
  rw [g, zero_smul],
end

open power_series
open polynomial (aeval)
variables {A : Type*} [comm_ring A] [algebra ℚ A]

-- TODO: define exponential generating functions, and use them here
-- This name should probably be updated afterwards

/-- The theorem that `∑ Bₙ(t)X^n/n!)(e^X-1)=Xe^{tX}`  -/
theorem exp_bernoulli_poly' (t : A) :
  mk (λ n, aeval t ((1 / n! : ℚ) • bernoulli_poly n)) * (exp A - 1) = X * rescale t (exp A) :=
begin
  -- check equality of power series by checking coefficients of X^n
  ext n,
  -- n = 0 case solved by `simp`
  cases n, { simp },
  -- n ≥ 1, the coefficients is a sum to n+2, so use `sum_range_succ` to write as
  -- last term plus sum to n+1
  rw [coeff_succ_X_mul, coeff_rescale, coeff_exp, coeff_mul,
    nat.sum_antidiagonal_eq_sum_range_succ_mk, sum_range_succ],
  -- last term is zero so kill with `add_zero`
  simp only [ring_hom.map_sub, nat.sub_self, constant_coeff_one, constant_coeff_exp,
    coeff_zero_eq_constant_coeff, mul_zero, sub_self, add_zero],
  -- Let's multiply both sides by (n+1)! (OK because it's a unit)
  set u : units ℚ := ⟨(n+1)!, (n+1)!⁻¹,
    mul_inv_cancel (by exact_mod_cast factorial_ne_zero (n+1)),
      inv_mul_cancel (by exact_mod_cast factorial_ne_zero (n+1))⟩ with hu,
  rw ←units.mul_right_inj (units.map (algebra_map ℚ A).to_monoid_hom u),
  -- now tidy up unit mess and generally do trivial rearrangements
  -- to make RHS (n+1)*t^n
  rw [units.coe_map, mul_left_comm, ring_hom.to_monoid_hom_eq_coe,
      ring_hom.coe_monoid_hom, ←ring_hom.map_mul, hu, units.coe_mk],
  change _ = t^n * algebra_map ℚ A (((n+1)*n! : ℕ)*(1/n!)),
  rw [cast_mul, mul_assoc, mul_one_div_cancel
    (show (n! : ℚ) ≠ 0, from cast_ne_zero.2 (factorial_ne_zero n)), mul_one, mul_comm (t^n),
    ← polynomial.aeval_monomial, cast_add, cast_one],
  -- But this is the RHS of `sum_bernoulli_poly`
  rw [← sum_bernoulli_poly, finset.mul_sum, alg_hom.map_sum],
  -- and now we have to prove a sum is a sum, but all the terms are equal.
  apply finset.sum_congr rfl,
  -- The rest is just trivialities, hampered by the fact that we're coercing
  -- factorials and binomial coefficients between ℕ and ℚ and A.
  intros i hi,
  -- NB prime.choose_eq_factorial_div_factorial' is in the wrong namespace
  -- deal with coefficients of e^X-1
  simp only [choose_eq_factorial_div_factorial' (mem_range_le hi), coeff_mk,
    if_neg (mem_range_sub_ne_zero hi), one_div, alg_hom.map_smul, coeff_one, units.coe_mk,
    coeff_exp, sub_zero, linear_map.map_sub, algebra.smul_mul_assoc, algebra.smul_def,
    mul_right_comm _ ((aeval t) _), ←mul_assoc, ← ring_hom.map_mul, succ_eq_add_one],
  -- finally cancel the Bernoulli polynomial and the algebra_map
  congr',
  apply congr_arg,
  rw [mul_assoc, div_eq_mul_inv, ← mul_inv'],
end

end bernoulli_poly


import algebra.comm_rings.instances.basic

inductive pos_nat
| one  : pos_nat
| succ : pos_nat → pos_nat

notation `ℕ⁺` := pos_nat

def pos_nat_add : ℕ⁺ → ℕ⁺ → ℕ⁺
| pos_nat.one n      := pos_nat.succ n
| (pos_nat.succ k) n := pos_nat.succ (pos_nat_add k n)

instance pos_nat_has_one : has_one ℕ⁺ := ⟨pos_nat.one⟩
instance pos_nat_has_add : has_add ℕ⁺ := ⟨pos_nat_add⟩

def pos_nat_mul : ℕ⁺ → ℕ⁺ → ℕ⁺
| (1:ℕ⁺) n           := n
| (pos_nat.succ k) n := n + (pos_nat_mul k n)

instance pos_nat_has_mul : has_mul ℕ⁺ := ⟨pos_nat_mul⟩

theorem pos_nat_mul_suc : ∀ n m : ℕ⁺, (pos_nat.succ n) * m = m + (n * m) := λ _ _, rfl

theorem pos_nat.one_mul : ∀ n : ℕ⁺, pos_nat.one * n = n := λ _,rfl
theorem pos_nat.one_mul₁ : ∀ n : ℕ⁺ , 1 * n = n := λ _, rfl

def pos_nat_to_nat : ℕ⁺ → ℕ
| pos_nat.one      := 1
| (pos_nat.succ k) := nat.succ (pos_nat_to_nat k)

def pot_nat_to_int :  ℕ⁺ → ℤ
| 1       := int.of_nat 1
| (1 + n) := 1 + pot_nat_to_int n

theorem pos_nat_to_nat_never_zero : ∀ n : ℕ⁺, pos_nat_to_nat n ≠ 0 :=
begin
  intros n ab,
  cases n with n,
  cases ab,
  cases ab,
end

theorem pos_nat_to_nat_inj : ∀ {n₁ n₂ : ℕ⁺}, pos_nat_to_nat n₁ = pos_nat_to_nat n₂ → n₁ = n₂
| pos_nat.one pos_nat.one _ := rfl
| (pos_nat.succ n) pos_nat.one h :=
  begin
    apply false.elim,
    apply pos_nat_to_nat_never_zero n,
    apply nat.succ.inj,
    assumption,
  end
| pos_nat.one (pos_nat.succ n) h :=
  begin
    apply false.elim,
    apply pos_nat_to_nat_never_zero n,
    apply nat.succ.inj,
    symmetry,
    assumption,
  end
| (pos_nat.succ n₁) (pos_nat.succ n₂) h :=
  begin
    have hrw : n₁ = n₂,
      apply pos_nat_to_nat_inj,
      apply nat.succ.inj,
      assumption,
    rw hrw,
  end

instance pos_nat_coe : has_coe ℕ⁺ ℤ := ⟨pot_nat_to_int⟩

@[simp]
theorem coe_pos_one : ↑(pos_nat.one) = (1:ℤ) := rfl

@[simp]
theorem coe_pos_one₁ : ↑(1:ℕ⁺) = (1:ℤ) := rfl

@[simp]
theorem coe_pos_suc : ∀ n : ℕ⁺, ↑(pos_nat.succ n) = (1 + ↑n : ℤ) := λ _, rfl

theorem pos_nat_nat_coor : ∀ n : ℕ⁺, ∃ m : ℕ, ↑n = int.of_nat m :=
begin
  intro n,
  induction n with n hn,
  existsi 1,
  refl,
  cases hn with m hm,
  existsi nat.succ m,
  simp[hm,int.of_nat_succ,int.add_comm],
end

theorem strong_pos_nat_nat_coor : ∀ n : ℕ⁺, ↑n = int.of_nat (pos_nat_to_nat n) :=
begin
  intro n,
  induction n with n hn,
  refl,
  simp[hn],
  have trv : pos_nat_to_nat n.succ = (pos_nat_to_nat n).succ := rfl,
  simp [trv,int.of_nat_succ,int.add_comm],
end

@[simp]
theorem coe_prevs_add : ∀ n₁ n₂ : ℕ⁺, (↑(n₁ + n₂) : ℤ) = ↑n₁ + ↑n₂ :=
begin
  intros n₁ n₂,
  induction n₁ with n₁ hn₁,
  have trv : pos_nat.one + n₂ = n₂.succ := rfl,
  simp[trv],
  have trv : n₁.succ + n₂ = (n₁ + n₂).succ := rfl,
  simp[trv,hn₁,int.add_assoc],
end

@[simp]
theorem coe_prevs_mul : ∀ n₁ n₂ : ℕ⁺, (↑(n₁ * n₂) : ℤ) = ↑n₁ * ↑n₂ :=
begin
  intros n₁ n₂,
  induction n₁ with n₁ hn₁,
  simp [pos_nat.one_mul, int.one_mul],
  simp[int.distrib_right, int.one_mul],
  have trv : n₁.succ * n₂ = n₂ + n₁ * n₂ := rfl,
  simp[trv,coe_prevs_add, hn₁],
end

theorem coe_inj : ∀ n₁ n₂ : ℕ⁺, (↑n₁ : ℤ) = ↑n₂ → n₁ = n₂ :=
begin
  intros n₁ n₂,
  simp[strong_pos_nat_nat_coor],
  intro h,
  apply pos_nat_to_nat_inj,
  assumption,
end

theorem mul_zero_eq_zero : ∀ {z : ℤ} (n : ℕ⁺), z * n = 0 → z = 0 :=
begin
  intros z n h,
  cases z with m m,
  cases m,
  refl,
  apply false.elim,
  rw int.of_nat_succ at h,
  rw int.distrib_right at h,
  rw int.one_mul at h,
  cases n,
  simp[int.mul_one] at h,
  rw ← int.of_nat_succ at h,
  cases h,
  cases pos_nat_nat_coor n with c hc,
  simp [hc,int.distrib_left,int.mul_one] at h,
  rw [← int.of_nat_mul, ← int.of_nat_add, int.add_comm 1] at h,
  rw [← int.add_assoc,← int.of_nat_add,← int.of_nat_succ] at h,
  cases h,
  cases n,
  simp[int.mul_one] at h,
  assumption,
  simp[int.distrib_left] at h,
  rw int.mul_one at h,
  cases pos_nat_nat_coor n with c hc,
  simp[hc] at h,
  have hrw : -[1+ m] * int.of_nat c = int.neg_of_nat (nat.succ m * c) := rfl,
  rw hrw at h,
  cases c,
  rw nat.mul_zero m.succ at h,
  simp[int.neg_of_nat,int.add_zero] at h,
  assumption,
  simp [nat.mul_succ,nat.add_succ,int.neg_of_nat] at h,
  have trv : ∀ m₁ m₂,  -[1+ m₁] + -[1+ m₂] = -[1+ nat.succ (m₁ + m₂)] := λ _ _, rfl,
  simp[trv] at h,
  apply false.elim,
  cases h,
end

lemma pos_nat_mul_right_cancel : ∀ {z₁ z₂: ℤ} (n : ℕ⁺), z₁ * n = z₂ * n  → z₁ = z₂ :=
begin
  intros z₁ z₂ n h,
  have hrw : z₁ + -z₂ = 0,
    apply mul_zero_eq_zero n,
    rw [int.distrib_right, h,← comm_ring.minus_mul],
    rw comm_ring.minus_inverse,
    exact calc z₁ = z₁ + 0          : by rw int.add_zero z₁
              ... = z₁ + (z₂ + -z₂) : by rw comm_ring.minus_inverse
              ... = z₁ + (-z₂ + z₂) : by rw int.add_comm z₂
              ... = (z₁ + -z₂) + z₂ : by simp[int.add_assoc]
              ... = 0 + z₂          : by rw hrw
              ... = z₂              : by rw int.zero_add,
end


/-
Copyright (c) 2022 David Kurniadi Angdinata. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Kurniadi Angdinata
-/
import algebra.hom.equiv.type_tags
import data.zmod.quotient
import ring_theory.dedekind_domain.adic_valuation
import ring_theory.norm

/-!
# Selmer groups of fraction fields of Dedekind domains

Let $K$ be the field of fractions of a Dedekind domain $R$. For any set $S$ of prime ideals in the
height one spectrum of $R$, and for any natural number $n$, the Selmer group $K(S, n)$ is defined to
be the subgroup of the unit group $K^\times$ modulo $n$-th powers where each element has $v$-adic
valuation divisible by $n$ for all prime ideals $v$ away from $S$. In other words, this is precisely
$$ K(S, n) := \{x(K^\times)^n \in K^\times / (K^\times)^n \ \mid \
                \forall v \notin S, \ \mathrm{ord}_v(x) \equiv 0 \pmod n\}. $$

There is a fundamental short exact sequence
$$ 1 \to R_S^\times / (R_S^\times)^n \to K(S, n) \to \mathrm{Cl}_S(R)[n] \to 0, $$
where $R_S^\times$ is the $S$-unit group of $R$ and $\mathrm{Cl}_S(R)$ is the $S$-class group of
$R$. If the flanking groups are both finite, then $K(S, n)$ is finite by the first isomorphism
theorem. Such is the case when $R$ is the ring of integers of a number field $K$, $S$ is finite, and
$n$ is positive, in which case $R_S^\times$ is finitely generated by Dirichlet's unit theorem and
$\mathrm{Cl}_S(R)$ is finite by the class number theorem.

This file defines the Selmer group $K(S, n)$ and some basic facts.

## Main definitions

 * `is_dedekind_domain.selmer_group`: the Selmer group.
 * TODO: maps in the sequence.

## Main statements

 * TODO: proofs of exactness of the sequence.
 * TODO: proofs of finiteness for global fields.

## Notations

 * `K⟮S, n⟯`: the Selmer group with parameters `K`, `S`, and `n`.

## Implementation notes

The Selmer group is typically defined as a subgroup of the Galois cohomology group $H^1(K, \mu_n)$
with certain local conditions defined by $v$-adic valuations, where $\mu_n$ is the group of $n$-th
roots of unity over a separable closure of $K$. Here $H^1(K, \mu_n)$ is identified with
$K^\times / (K^\times)^n$ by the long exact sequence from Kummer theory and Hilbert's theorem 90,
and the fundamental short exact sequence becomes an easy consequence of the snake lemma. This file
will define all the maps explicitly for computational purposes, but isomorphisms to the Galois
cohomological definition will be provided when possible.

## References

https://doc.sagemath.org/html/en/reference/number_fields/sage/rings/number_field/selmer_group.html

## Tags

class group, selmer group, unit group
-/

local notation (name := quot) K/n := Kˣ ⧸ (pow_monoid_hom n : Kˣ →* Kˣ).range

namespace is_dedekind_domain

noncomputable theory

open_locale classical discrete_valuation non_zero_divisors

universes u v

variables {R : Type u} [comm_ring R] [is_domain R] [is_dedekind_domain R] {K : Type v} [field K]
  [algebra R K] [is_fraction_ring R K] (v : height_one_spectrum R)

/-! ### Valuations of non-zero elements -/

namespace height_one_spectrum

/-- The multiplicative `v`-adic valuation on `Kˣ`. -/
def valuation_of_ne_zero_to_fun (x : Kˣ) : multiplicative ℤ :=
let hx := is_localization.sec R⁰ (x : K) in multiplicative.of_add $
  (-(associates.mk v.as_ideal).count (associates.mk $ ideal.span {hx.fst}).factors : ℤ)
  - (-(associates.mk v.as_ideal).count (associates.mk $ ideal.span {(hx.snd : R)}).factors : ℤ)

@[simp] lemma valuation_of_ne_zero_to_fun_eq (x : Kˣ) :
  (v.valuation_of_ne_zero_to_fun x : ℤₘ₀) = v.valuation (x : K) :=
begin
  change _ = _ * _,
  rw [units.coe_inv],
  change _ = ite _ _ _ * (ite (coe _ = _) _ _)⁻¹,
  rw [is_localization.to_localization_map_sec,
      if_neg $ is_localization.sec_fst_ne_zero le_rfl x.ne_zero,
      if_neg $ non_zero_divisors.coe_ne_zero _],
  any_goals { exact is_domain.to_nontrivial R },
  refl
end

/-- The multiplicative `v`-adic valuation on `Kˣ`. -/
def valuation_of_ne_zero : Kˣ →* multiplicative ℤ :=
{ to_fun   := v.valuation_of_ne_zero_to_fun,
  map_one' := by { rw [← with_zero.coe_inj, valuation_of_ne_zero_to_fun_eq], exact map_one _ },
  map_mul' := λ _ _, by { rw [← with_zero.coe_inj, with_zero.coe_mul],
                          simp only [valuation_of_ne_zero_to_fun_eq], exact map_mul _ _ _ } }

@[simp] lemma valuation_of_ne_zero_eq (x : Kˣ) :
  (v.valuation_of_ne_zero x : ℤₘ₀) = v.valuation (x : K) :=
valuation_of_ne_zero_to_fun_eq v x

@[simp] lemma valuation_of_unit_eq (x : Rˣ) :
  v.valuation_of_ne_zero (units.map (algebra_map R K : R →* K) x) = 1 :=
begin
  rw [← with_zero.coe_inj, valuation_of_ne_zero_eq, units.coe_map, eq_iff_le_not_lt],
  split,
  { exact v.valuation_le_one x },
  { cases x with x _ hx _,
    change ¬v.valuation (algebra_map R K x) < 1,
    apply_fun v.int_valuation at hx,
    rw [map_one, map_mul] at hx,
    rw [not_lt, ← hx, ← mul_one $ v.valuation _, valuation_of_algebra_map,
        mul_le_mul_left₀ $ left_ne_zero_of_mul_eq_one hx],
    exact v.int_valuation_le_one _ }
end

local attribute [semireducible] mul_opposite

/-- The multiplicative `v`-adic valuation on `Kˣ` modulo `n`-th powers. -/
def valuation_of_ne_zero_mod (n : ℕ) : K/n →* multiplicative (zmod n) :=
(int.quotient_zmultiples_nat_equiv_zmod n).to_multiplicative.to_monoid_hom.comp $
  quotient_group.map (pow_monoid_hom n : Kˣ →* Kˣ).range
  (add_subgroup.zmultiples (n : ℤ)).to_subgroup v.valuation_of_ne_zero
begin
  rintro _ ⟨x, rfl⟩,
  exact ⟨v.valuation_of_ne_zero x, by simpa only [pow_monoid_hom_apply, map_pow, int.to_add_pow]⟩
end

@[simp] lemma valuation_of_unit_mod_eq (n : ℕ) (x : Rˣ) :
  v.valuation_of_ne_zero_mod n (units.map (algebra_map R K : R →* K) x : K/n) = 1 :=
by rw [valuation_of_ne_zero_mod, monoid_hom.comp_apply, ← quotient_group.coe_mk',
       quotient_group.map_mk', valuation_of_unit_eq, quotient_group.coe_one, map_one]

end height_one_spectrum

/-! ### Selmer groups -/

variables {S S' : set $ height_one_spectrum R} {n : ℕ}

/-- The Selmer group `K⟮S, n⟯`. -/
def selmer_group : subgroup $ K/n :=
{ carrier  := {x : K/n | ∀ v ∉ S, (v : height_one_spectrum R).valuation_of_ne_zero_mod n x = 1},
  one_mem' := λ _ _, by rw [map_one],
  mul_mem' := λ _ _ hx hy v hv, by rw [map_mul, hx v hv, hy v hv, one_mul],
  inv_mem' := λ _ hx v hv, by rw [map_inv, hx v hv, inv_one] }

localized "notation K`⟮`S, n`⟯` := @selmer_group _ _ _ _ K _ _ _ S n" in selmer_group

namespace selmer_group

lemma monotone (hS : S ≤ S') : K⟮S, n⟯ ≤ (K⟮S', n⟯) := λ _ hx v, hx v ∘ mt (@hS v)

/-- The multiplicative `v`-adic valuations on `K⟮S, n⟯` for all `v ∈ S`. -/
def valuation : K⟮S, n⟯ →* S → multiplicative (zmod n) :=
{ to_fun   := λ x v, (v : height_one_spectrum R).valuation_of_ne_zero_mod n (x : K/n),
  map_one' := funext $ λ v, map_one _,
  map_mul' := λ x y, funext $ λ v, map_mul _ x y }

lemma valuation_ker_eq :
  valuation.ker = (K⟮(∅ : set $ height_one_spectrum R), n⟯).subgroup_of (K⟮S, n⟯) :=
begin
  ext ⟨_, hx⟩,
  split,
  { intros hx' v _,
    by_cases hv : v ∈ S,
    { exact congr_fun hx' ⟨v, hv⟩ },
    { exact hx v hv } },
  { exact λ hx', funext $ λ v, hx' v $ set.not_mem_empty v }
end

/-- The natural homomorphism from `Rˣ` to `K⟮∅, n⟯`. -/
def from_unit {n : ℕ} : Rˣ →* K⟮(∅ : set $ height_one_spectrum R), n⟯ :=
{ to_fun   := λ x, ⟨quotient_group.mk $ units.map (algebra_map R K).to_monoid_hom x,
                    λ v _, v.valuation_of_unit_mod_eq n x⟩,
  map_one' := by simpa only [map_one],
  map_mul' := λ _ _, by simpa only [map_mul] }

lemma from_unit_ker [hn : fact $ 0 < n] :
  (@from_unit R _ _ _ K _ _ _ n).ker = (pow_monoid_hom n : Rˣ →* Rˣ).range :=
begin
  ext ⟨_, _, _, _⟩,
  split,
  { intro hx,
    rcases (quotient_group.eq_one_iff _).mp (subtype.mk.inj hx) with ⟨⟨v, i, vi, iv⟩, hx⟩,
    have hv : ↑(_ ^ n : Kˣ) = algebra_map R K _ := congr_arg units.val hx,
    have hi : ↑(_ ^ n : Kˣ)⁻¹ = algebra_map R K _ := congr_arg units.inv hx,
    rw [units.coe_pow] at hv,
    rw [← inv_pow, units.inv_mk, units.coe_pow] at hi,
    rcases @is_integrally_closed.exists_algebra_map_eq_of_is_integral_pow R _ _ _ _ _ _ _ v _
      hn.out (hv.symm ▸ is_integral_algebra_map) with ⟨v', rfl⟩,
    rcases @is_integrally_closed.exists_algebra_map_eq_of_is_integral_pow R _ _ _ _ _ _ _ i _
      hn.out (hi.symm ▸ is_integral_algebra_map) with ⟨i', rfl⟩,
    rw [← map_mul, map_eq_one_iff _ $ no_zero_smul_divisors.algebra_map_injective R K] at vi,
    rw [← map_mul, map_eq_one_iff _ $ no_zero_smul_divisors.algebra_map_injective R K] at iv,
    rw [units.coe_mk, ← map_pow] at hv,
    exact ⟨⟨v', i', vi, iv⟩, by simpa only [units.ext_iff, pow_monoid_hom_apply, units.coe_pow]
                               using no_zero_smul_divisors.algebra_map_injective R K hv⟩ },
  { rintro ⟨_, hx⟩,
    rw [← hx],
    exact subtype.mk_eq_mk.mpr
      ((quotient_group.eq_one_iff _).mpr ⟨_, by simp only [pow_monoid_hom_apply, map_pow]⟩) }
end

/-- The injection induced by the natural homomorphism from `Rˣ` to `K⟮∅, n⟯`. -/
def from_unit_lift [fact $ 0 < n] : R/n →* K⟮(∅ : set $ height_one_spectrum R), n⟯ :=
(quotient_group.ker_lift _).comp
  (quotient_group.quotient_mul_equiv_of_eq from_unit_ker).symm.to_monoid_hom

lemma from_unit_lift_injective [fact $ 0 < n] :
  function.injective $ @from_unit_lift R _ _ _ K _ _ _ n _ :=
function.injective.comp (quotient_group.ker_lift_injective _) (mul_equiv.injective _)

end selmer_group

end is_dedekind_domain


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

namespace SciLean

/-- Solution of differential-algebraic equation in fully implicit form:
`
  ∀ t, 0 = f t (ⅆ x t) (x t)
`

-/
noncomputable
def odeSolveFullyImplicit {X Y} [Vec X] [Vec Y] (f : ℝ → X → X → Y) (t : ℝ) (x₀ v₀ : X) : X :=
  let solution_exists := ∃ (x : ℝ → X) (_ : IsSmooth x),
      ∀ t, 0 = f t (ⅆ x t) (x t)
      ∧
      x 0 = x₀ ∧ ⅆ x 0 = v₀
  match Classical.dec solution_exists with
  | isFalse _ => 0
  | isTrue h =>
    let x := Classical.choose h
    x t

noncomputable
def odeSolveSemiImplicit {X Y} [Vec X] [Vec Y]
  (f : ℝ → X → Y → X) (g : ℝ → X → Y → Y)
  (t : ℝ) (x₀ : X) (y₀ : Y)
  : X × Y :=
  let solution_exists := ∃ (x : ℝ → X) (y : ℝ → Y) (_ : IsSmooth x) (_ : IsSmooth y),
      ∀ t, (ⅆ x t = f t (x t) (y t) ∧
            0 = g t (x t) (y t))
      ∧
      x 0 = x₀ ∧ y 0 = y₀
  match Classical.dec solution_exists with
  | isFalse _ => 0
  | isTrue h =>
    let x := Classical.choose h
    let y := Classical.choose (Classical.choose_spec h)
    (x t, y t)

/--
  Semi-implicit ODE can be rewriten as a normal ODE if the constrain has invertible jacobian in `y`
-/
theorem odeSolveSemiImplicit_as_odeSolve {X Y} [Vec X] [Vec Y]
  (f : ℝ → X → Y → X) (g : ℝ → X → Y → Y)
  (t : ℝ) (x₀ : X) (y₀ : Y)
  (valid_constraint : ∀ t x y, IsInv (∂ (g t x) y))
  :
  odeSolveSemiImplicit f g t x₀ y₀
  =
  let g' t x y :=
    (∂ (g t x) y)⁻¹ (∂ (g t) x (f t x y) y)
  odeSolve (λ t xy => (f t xy.1 xy.2, g' t xy.1 xy.2)) t (x₀,y₀)
  :=
  sorry_proof

/--
  The idea for this spliting is that we can approximate `y t ≈ y₀ + t * Δy`
  Then the evolution of `x` looks like:

    `ⅆ x t = f t (x t) (y₀ + t * Δy)`

  First order Taylor expansion yieds

    `ⅆ x t = f t (x t) y₀ + ∂ (f t (x t)) y₀ (t*Δy)`

  By splitting we can alternate between two systems

    `ⅆ x t = f t (x t) y₀`
    and
    `ⅆ x t = ∂ (f t (x t)) y₀ (t*Δy)`

  The idea is to find such `Δy` after one round than the solution satisfies the constraint

-/
theorem odeSolveSemiImplicit_evolve_and_project {X Y} [Vec X] [Vec Y]
  (f : ℝ → X → Y → X) (g : ℝ → X → Y → Y)
  (Δt : ℝ) (x₀ : X) (y₀ : Y)
  :
  odeSolveSemiImplicit f g Δt x₀ y₀
  =
  let step (n : ℕ) := λ (x,y) =>
    let Δt' := Δt/n

    let x' := odeSolve (f · · y) Δt' x

    -- It is not intirelly clear what the general form of the correction term should look like
    -- This seems like a good choice
    let dy := (λ dy => g t (x' + Δt'*Δt'/2 * ∂ (f t x') y dy) (y + Δt' * dy))⁻¹ 0

    -- Alternativelly we can minimize the residual insted of doing an exact solve.
    -- For non-linear problems exact solution might not be possible.
    -- let Δy := argmin Δy', ∥g t (x' + Δt' * ∂ (f t x') y Δy') (y + Δy')∥²

    (x' + Δt'*Δt'/2 * ∂ (f t x') y dy, y + Δt' * dy)
  limit λ n => (step n)^[n] (x₀, y₀)
  := sorry_proof

/-- Solution of differential equation `ẋ = f t x` with a constraint `g t x = 0`.
This equates to solving the following semi-implicit differential-algebraic equation:
`
  ⅆ x t = f t (x t) + ∂† (g t) (x t) μ
      0 = g t x
`
Where `∂† (g t) (x t) μ` is a modification to the original ODE, with `μ` as a Lagrange multiplier,
allowing for the solution to satisfy the constraint.
-/
noncomputable
def odeSolveConstrained {X Y} [SemiHilbert X] [SemiHilbert Y]
  (f : ℝ → X → X) (g : ℝ → X → Y)
  (t : ℝ) (x₀ : X)
  : X
  :=
  (odeSolveSemiImplicit (λ t x μ => f t x + ∂† (g t) x μ) (λ t x y => g t x) t x₀ 0).1

noncomputable
def odeSolveConstrained' {X Y} [SemiHilbert X] [SemiHilbert Y]
  (f : ℝ → X → X) (g : ℝ → X → Y)
  (t : ℝ) (x₀ : X) (y₀ : Y)
  : X × Y
  :=
  (odeSolveSemiImplicit (λ t x y => f t x + ∂† (g t) x y) (λ t x _ => g t x) t x₀ y₀)

/-- A constrained ODE is a normal ODE if the constraint is solvable at every time and point.

The constraint `valid_constraint` is roughly saying that for every time `t` and point `x`:
  1. We can find the Lagrange multiplier `μ` used to correcly modify the unconstrained ODE
  2. The jacobian of the constraint function `J := ∂ (g t) x` has full rank
  3. The square jacobian of the constraint function, `J := ∂ (g t) x`, has invertible square i.e. `J ∘ J†` is invertible matrix
-/
theorem odeSolveConstrained_as_odeSolve {X Y} [SemiHilbert X] [SemiHilbert Y]
  (f : ℝ → X → X) (g : ℝ → X → Y) (t₀ : ℝ)
  (valid_constraint : ∀ t x, let J := ∂ (g t) x; IsInv (J ∘ J†))
  :
  odeSolveConstrained f g
  =
  let solveConstraint t x :=
    -- let J  := ∂ (g t) x
    -- solve μ, J (J† μ) = - J (f t x)
    (λ μ =>
      let J := ∂ (g t) x
      J (J† μ) + J (f t x))⁻¹ 0
  let f' t x :=
    let μ := solveConstraint t x
    f t x + ∂† (g t) x μ
  odeSolve f'
  :=
  sorry_proof

theorem odeSolveConstrained_evolve_and_project {X Y} [SemiHilbert X] [SemiHilbert Y]
  (f : ℝ → X → X) (g : ℝ → X → Y) (Δt : ℝ) (x₀ : X)
  :
  odeSolveConstrained f g Δt x₀
  =
  let step (n : ℕ) := λ x =>
    let Δt' := Δt/n

    let x' := odeSolve f Δt' x

    let y := (λ y => g t (x' + Δt' * ∂† (g t) x' y))⁻¹ 0

    x' + Δt' * ∂† (g t) x y

  limit λ n => (step n)^[n] x₀
  := sorry_proof

/-- This is usefull when we want to reuse the Lagrange multiplier `y` from the previous time step -/
theorem odeSolveConstrained'_evolve_and_project {X Y} [SemiHilbert X] [SemiHilbert Y]
  (f : ℝ → X → X) (g : ℝ → X → Y) (Δt : ℝ) (x₀ : X) (y₀ : Y)
  :
  odeSolveConstrained' f g Δt x₀ y₀
  =
  let step (n : ℕ) := λ (x,_) =>
    let Δt' := Δt/n

    let x' := odeSolve f Δt' x

    let y := (λ y => g t (x' + Δt' * ∂† (g t) x' y))⁻¹ 0

    (x' + Δt' * ∂† (g t) x y, y)

  limit λ n => (step n)^[n] (x₀,y₀)
  := sorry_proof

/-- This is usefull when we want to reuse the Lagrange multiplier `y` from the previous time step -/
theorem odeSolveConstrained'_evolve_and_reflect {X Y} [SemiHilbert X] [SemiHilbert Y]
  (f : ℝ → X → X) (g : ℝ → X → Y) (Δt : ℝ) (x₀ : X) (y₀ : Y)
  :
  odeSolveConstrained' f g Δt x₀ y₀
  =
  let step (n : ℕ) := λ (x,_) =>
    let Δt' := Δt/n

    let x' := odeSolve f Δt' x

    let y := (λ y => g t (x' + Δt' * ∂† (g t) x' y))⁻¹ 0

    (x' + Δt' * ∂† (g t) x y, y)

  limit λ n => (step n)^[n] (x₀,y₀)
  := sorry_proof


lemma nat.not_self_lt_lt_succ_self {a b : nat}
  : a < b → b < a + 1 → false :=
begin
  intros h1 h2,
  cases nat.le.dest h1 with w h_1,
  cases nat.le.dest h2 with w_1 h_2,
  rw ← h_1 at h_2,
  rw ← nat.succ_add at h_2,
  apply nat.lt_irrefl (nat.succ a),
  apply nat.lt_of_lt_of_le,
  apply lt_add_of_pos_right (nat.succ a),
  refine (_ : nat.succ (w + w_1) > 0),
  apply nat.succ_pos,
  have : ∀ x y z, nat.succ x + y + z = x + nat.succ (y + z),
  { intros, rw ← nat.add_one, rw ← nat.add_one, ac_refl },
  rw this at h_2, rw h_2
end

def sub_lt_if_ge : ∀ n m k : ℕ, n ≤ k → k < n + m → k - n < m :=
begin
  intros n m k hnk h,
  rw ← nat.add_sub_of_le hnk at h,
  apply lt_of_add_lt_add_left h
end

def ge_if_not_lt {n k : ℕ} (h : ¬ (n < k)) : n ≥ k :=
by { cases nat.lt_or_ge n k, exfalso, exact h h_1, exact h_1 }

lemma pos_of_prod_pos_l {n m : ℕ} : 0 < n * m → 0 < n :=
begin
  intro h, apply decidable.by_contradiction, intro h',
  have : n = 0,
  { cases nat.lt_trichotomy n 0,
    { exfalso, apply nat.not_lt_zero _ h_1 },
    { cases h_1, assumption, trivial } },
  rw [this, zero_mul] at h, apply nat.lt_irrefl _ h,
end

lemma mod_of_add_multiple (n m k : ℕ) : (n + m * k) % m = n % m :=
begin
  induction k, simp,
  { have : m ≤ m * nat.succ k_n,
    { rw nat.mul_succ, apply nat.le_add_left },
    rw nat.mod_eq_sub_mod (nat.le_trans this (nat.le_add_left _ _)),
    rw nat.add_sub_assoc this,
    rw (_ : m * nat.succ k_n - m = m * nat.succ k_n - m * 1),
    rw ← nat.mul_sub_left_distrib, rw ← nat.add_one,
    rw nat.add_sub_cancel, assumption, simp }
end

lemma nat.mul_two : ∀ n, n * 2 = n + n :=
by simp [(*), nat.mul]

def binomial_coefficient : nat → nat → nat
| _     0     := 1
| 0     _     := 0
| (n+1) (k+1) := binomial_coefficient n (k+1) + binomial_coefficient n k

lemma binomial_coefficient_lt
  : ∀ n k, n < k → binomial_coefficient n k = 0 :=
begin
  intro, induction n with n ih; intros k h,
  { cases k, cases h, refl },
  cases k, cases h,
  simp [binomial_coefficient],
  rw [ih, ih], transitivity,
  apply nat.lt_succ_self, assumption,
  apply nat.lt_of_succ_lt_succ h
end

lemma binomial_coefficient_self
  : ∀ n, binomial_coefficient n n = 1 :=
begin
  intro, induction n with n ih, refl,
  simp [binomial_coefficient], rw ih,
  rw binomial_coefficient_lt, apply nat.lt_succ_self
end

lemma binomial_coefficient_zero
  : ∀ n, binomial_coefficient n 0 = 1 :=
by intro; cases n; refl

theorem nat.even_odd_induction (P : nat → Sort _)
  (bc₀ : P 0) (bc₁ : P 1) (rec : ∀ n, P n → P n.succ → P n.succ.succ) : ∀ n, P n
| 0     := bc₀
| 1     := bc₁
| (n+2) := rec n (nat.even_odd_induction n) (nat.even_odd_induction n.succ)


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Julian Kuelshammer
-/
import data.int.gcd
import algebra.iterate_hom
import algebra.pointwise
import dynamics.periodic_pts
import group_theory.coset

/-!
# Order of an element

This file defines the order of an element of a finite group. For a finite group `G` the order of
`x ∈ G` is the minimal `n ≥ 1` such that `x ^ n = 1`.

## Main definitions

* `is_of_fin_order` is a predicate on an element `x` of a monoid `G` saying that `x` is of finite
  order.
* `is_of_fin_add_order` is the additive analogue of `is_of_find_order`.
* `order_of x` defines the order of an element `x` of a monoid `G`, by convention its value is `0`
  if `x` has infinite order.
* `add_order_of` is the additive analogue of `order_of`.

## Tags
order of an element
-/

open function nat
open_locale pointwise

universes u v

variables {G : Type u} {A : Type v}
variables {x y : G} {a b : A} {n m : ℕ}

section monoid_add_monoid

variables [monoid G] [add_monoid A]

section is_of_fin_order

lemma is_periodic_pt_add_iff_nsmul_eq_zero (a : A) :
  is_periodic_pt ((+) a) n 0 ↔ n • a = 0 :=
by rw [is_periodic_pt, is_fixed_pt, add_left_iterate, add_zero]

@[to_additive is_periodic_pt_add_iff_nsmul_eq_zero]
lemma is_periodic_pt_mul_iff_pow_eq_one (x : G) : is_periodic_pt ((*) x) n 1 ↔ x ^ n = 1 :=
by rw [is_periodic_pt, is_fixed_pt, mul_left_iterate, mul_one]

/-- `is_of_fin_add_order` is a predicate on an element `a` of an additive monoid to be of finite
order, i.e. there exists `n ≥ 1` such that `n • a = 0`.-/
def is_of_fin_add_order (a : A) : Prop :=
(0 : A) ∈ periodic_pts ((+) a)

/-- `is_of_fin_order` is a predicate on an element `x` of a monoid to be of finite order, i.e. there
exists `n ≥ 1` such that `x ^ n = 1`.-/
@[to_additive is_of_fin_add_order]
def is_of_fin_order (x : G) : Prop :=
(1 : G) ∈ periodic_pts ((*) x)

lemma is_of_fin_add_order_of_mul_iff :
  is_of_fin_add_order (additive.of_mul x) ↔ is_of_fin_order x := iff.rfl

lemma is_of_fin_order_of_add_iff :
  is_of_fin_order (multiplicative.of_add a) ↔ is_of_fin_add_order a := iff.rfl

lemma is_of_fin_add_order_iff_nsmul_eq_zero (a : A) :
  is_of_fin_add_order a ↔ ∃ n, 0 < n ∧ n • a = 0 :=
by { convert iff.rfl, simp only [exists_prop, is_periodic_pt_add_iff_nsmul_eq_zero] }

@[to_additive is_of_fin_add_order_iff_nsmul_eq_zero]
lemma is_of_fin_order_iff_pow_eq_one (x : G) :
  is_of_fin_order x ↔ ∃ n, 0 < n ∧ x ^ n = 1 :=
by { convert iff.rfl, simp [is_periodic_pt_mul_iff_pow_eq_one] }

end is_of_fin_order

/-- `order_of x` is the order of the element `x`, i.e. the `n ≥ 1`, s.t. `x ^ n = 1` if it exists.
Otherwise, i.e. if `x` is of infinite order, then `order_of x` is `0` by convention.-/
@[to_additive add_order_of
"`add_order_of a` is the order of the element `a`, i.e. the `n ≥ 1`, s.t. `n • a = 0` if it
exists. Otherwise, i.e. if `a` is of infinite order, then `add_order_of a` is `0` by convention."]
noncomputable def order_of (x : G) : ℕ :=
minimal_period ((*) x) 1

@[to_additive]
lemma commute.order_of_mul_dvd_lcm (h : commute x y) :
  order_of (x * y) ∣ nat.lcm (order_of x) (order_of y) :=
begin
  convert function.commute.minimal_period_of_comp_dvd_lcm h.function_commute_mul_left,
  rw [order_of, comp_mul_left],
end

@[simp] lemma add_order_of_of_mul_eq_order_of (x : G) :
  add_order_of (additive.of_mul x) = order_of x := rfl

@[simp] lemma order_of_of_add_eq_add_order_of (a : A) :
  order_of (multiplicative.of_add a) = add_order_of a := rfl

@[to_additive add_order_of_pos']
lemma order_of_pos' (h : is_of_fin_order x) : 0 < order_of x :=
minimal_period_pos_of_mem_periodic_pts h

@[to_additive add_order_of_nsmul_eq_zero]
lemma pow_order_of_eq_one (x : G) : x ^ order_of x = 1 :=
begin
  convert is_periodic_pt_minimal_period ((*) x) _,
  rw [order_of, mul_left_iterate, mul_one],
end

@[to_additive add_order_of_eq_zero]
lemma order_of_eq_zero (h : ¬ is_of_fin_order x) : order_of x = 0 :=
by rwa [order_of, minimal_period, dif_neg]

@[to_additive add_order_of_eq_zero_iff] lemma order_of_eq_zero_iff :
  order_of x = 0 ↔ ¬ is_of_fin_order x :=
⟨λ h H, (order_of_pos' H).ne' h, order_of_eq_zero⟩

@[to_additive add_order_of_eq_zero_iff'] lemma order_of_eq_zero_iff' :
  order_of x = 0 ↔ ∀ n : ℕ, 0 < n → x ^ n ≠ 1 :=
by simp_rw [order_of_eq_zero_iff, is_of_fin_order_iff_pow_eq_one, not_exists, not_and]

@[to_additive nsmul_ne_zero_of_lt_add_order_of']
lemma pow_ne_one_of_lt_order_of' (n0 : n ≠ 0) (h : n < order_of x) : x ^ n ≠ 1 :=
λ j, not_is_periodic_pt_of_pos_of_lt_minimal_period n0 h
  ((is_periodic_pt_mul_iff_pow_eq_one x).mpr j)

@[to_additive add_order_of_le_of_nsmul_eq_zero]
lemma order_of_le_of_pow_eq_one (hn : 0 < n) (h : x ^ n = 1) : order_of x ≤ n :=
is_periodic_pt.minimal_period_le hn (by rwa is_periodic_pt_mul_iff_pow_eq_one)

@[simp, to_additive] lemma order_of_one : order_of (1 : G) = 1 :=
by rw [order_of, one_mul_eq_id, minimal_period_id]

@[simp, to_additive add_monoid.order_of_eq_one_iff] lemma order_of_eq_one_iff :
  order_of x = 1 ↔ x = 1 :=
by rw [order_of, is_fixed_point_iff_minimal_period_eq_one, is_fixed_pt, mul_one]

@[to_additive nsmul_eq_mod_add_order_of]
lemma pow_eq_mod_order_of {n : ℕ} : x ^ n = x ^ (n % order_of x) :=
calc x ^ n = x ^ (n % order_of x + order_of x * (n / order_of x)) : by rw [nat.mod_add_div]
       ... = x ^ (n % order_of x) : by simp [pow_add, pow_mul, pow_order_of_eq_one]

@[to_additive add_order_of_dvd_of_nsmul_eq_zero]
lemma order_of_dvd_of_pow_eq_one (h : x ^ n = 1) : order_of x ∣ n :=
is_periodic_pt.minimal_period_dvd ((is_periodic_pt_mul_iff_pow_eq_one _).mpr h)

@[to_additive add_order_of_dvd_iff_nsmul_eq_zero]
lemma order_of_dvd_iff_pow_eq_one {n : ℕ} : order_of x ∣ n ↔ x ^ n = 1 :=
⟨λ h, by rw [pow_eq_mod_order_of, nat.mod_eq_zero_of_dvd h, pow_zero], order_of_dvd_of_pow_eq_one⟩

@[to_additive exists_nsmul_eq_self_of_coprime]
lemma exists_pow_eq_self_of_coprime (h : n.coprime (order_of x)) :
  ∃ m : ℕ, (x ^ n) ^ m = x :=
begin
  by_cases h0 : order_of x = 0,
  { rw [h0, coprime_zero_right] at h,
    exact ⟨1, by rw [h, pow_one, pow_one]⟩ },
  by_cases h1 : order_of x = 1,
  { exact ⟨0, by rw [order_of_eq_one_iff.mp h1, one_pow, one_pow]⟩ },
  obtain ⟨m, hm⟩ :=
    exists_mul_mod_eq_one_of_coprime h (one_lt_iff_ne_zero_and_ne_one.mpr ⟨h0, h1⟩),
  exact ⟨m, by rw [←pow_mul, pow_eq_mod_order_of, hm, pow_one]⟩,
end

/--
If `x^n = 1`, but `x^(n/p) ≠ 1` for all prime factors `p` of `r`,
then `x` has order `n` in `G`.
-/
@[to_additive add_order_of_eq_of_nsmul_and_div_prime_nsmul]
theorem order_of_eq_of_pow_and_pow_div_prime (hn : 0 < n) (hx : x^n = 1)
  (hd : ∀ p : ℕ, p.prime → p ∣ n → x^(n/p) ≠ 1) :
  order_of x = n :=
begin
  -- Let `a` be `n/(order_of x)`, and show `a = 1`
  cases exists_eq_mul_right_of_dvd (order_of_dvd_of_pow_eq_one hx) with a ha,
  suffices : a = 1, by simp [this, ha],
  -- Assume `a` is not one...
  by_contra,
  have a_min_fac_dvd_p_sub_one : a.min_fac ∣ n,
  { obtain ⟨b, hb⟩ : ∃ (b : ℕ), a = b * a.min_fac := exists_eq_mul_left_of_dvd a.min_fac_dvd,
    rw [hb, ←mul_assoc] at ha,
    exact dvd.intro_left (order_of x * b) ha.symm, },
  -- Use the minimum prime factor of `a` as `p`.
  refine hd a.min_fac (nat.min_fac_prime h) a_min_fac_dvd_p_sub_one _,
  rw [←order_of_dvd_iff_pow_eq_one, nat.dvd_div_iff (a_min_fac_dvd_p_sub_one),
      ha, mul_comm, nat.mul_dvd_mul_iff_left (order_of_pos' _)],
  { exact nat.min_fac_dvd a, },
  { rw is_of_fin_order_iff_pow_eq_one,
    exact Exists.intro n (id ⟨hn, hx⟩) },
end

@[to_additive add_order_of_eq_add_order_of_iff]
lemma order_of_eq_order_of_iff {H : Type*} [monoid H] {y : H} :
  order_of x = order_of y ↔ ∀ n : ℕ, x ^ n = 1 ↔ y ^ n = 1 :=
by simp_rw [← is_periodic_pt_mul_iff_pow_eq_one, ← minimal_period_eq_minimal_period_iff, order_of]

@[to_additive add_order_of_injective]
lemma order_of_injective {H : Type*} [monoid H] (f : G →* H)
  (hf : function.injective f) (x : G) : order_of (f x) = order_of x :=
by simp_rw [order_of_eq_order_of_iff, ←f.map_pow, ←f.map_one, hf.eq_iff, iff_self, forall_const]

@[simp, norm_cast, to_additive] lemma order_of_submonoid {H : submonoid G}
  (y : H) : order_of (y : G) = order_of y :=
order_of_injective H.subtype subtype.coe_injective y

@[to_additive order_of_add_units]
lemma order_of_units {y : units G} : order_of (y : G) = order_of y :=
order_of_injective (units.coe_hom G) units.ext y

variables (x)
@[to_additive add_order_of_nsmul']
lemma order_of_pow' (h : n ≠ 0) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n :=
begin
  convert minimal_period_iterate_eq_div_gcd h,
  simp only [order_of, mul_left_iterate],
end

variables (a)

variable (n)

@[to_additive add_order_of_nsmul'']
lemma order_of_pow'' (h : is_of_fin_order x) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n :=
begin
  convert minimal_period_iterate_eq_div_gcd' h,
  simp only [order_of, mul_left_iterate],
end

lemma commute.order_of_mul_dvd_lcm_order_of {x y : G} (h : commute x y) :
  order_of (x * y) ∣ lcm (order_of x) (order_of y) :=
begin
  convert h.function_commute_mul_left.minimal_period_of_comp_dvd_lcm,
  simp only [order_of, comp_mul_left],
end

lemma commute.order_of_mul_dvd_mul_order_of {x y : G} (h : commute x y) :
  order_of (x * y) ∣ (order_of x) * (order_of y) :=
dvd_trans h.order_of_mul_dvd_lcm_order_of (lcm_dvd_mul _ _)

lemma commute.order_of_mul_eq_mul_order_of_of_coprime {x y : G} (h : commute x y)
  (hco : nat.coprime (order_of x) (order_of y)) :
  order_of (x * y) = (order_of x) * (order_of y) :=
begin
  convert h.function_commute_mul_left.minimal_period_of_comp_eq_mul_of_coprime hco,
  simp only [order_of, comp_mul_left],
end

section p_prime

variables {a x n} {p : ℕ} [hp : fact p.prime]
include hp

lemma add_order_of_eq_prime (hg : p • a = 0) (hg1 : a ≠ 0) : add_order_of a = p :=
minimal_period_eq_prime ((is_periodic_pt_add_iff_nsmul_eq_zero _).mpr hg)
  (by rwa [is_fixed_pt, add_zero])

@[to_additive add_order_of_eq_prime]
lemma order_of_eq_prime (hg : x ^ p = 1) (hg1 : x ≠ 1) : order_of x = p :=
minimal_period_eq_prime ((is_periodic_pt_mul_iff_pow_eq_one _).mpr hg)
  (by rwa [is_fixed_pt, mul_one])

@[to_additive add_order_of_eq_prime_pow]
lemma order_of_eq_prime_pow (hnot : ¬ x ^ p ^ n = 1) (hfin : x ^ p ^ (n + 1) = 1) :
  order_of x = p ^ (n + 1) :=
begin
  apply minimal_period_eq_prime_pow;
  rwa is_periodic_pt_mul_iff_pow_eq_one,
end

omit hp
-- An example on how to determine the order of an element of a finite group.
example : order_of (-1 : units ℤ) = 2 :=
begin
  haveI : fact (prime 2) := ⟨prime_two⟩,
  exact order_of_eq_prime (int.units_mul_self _) dec_trivial,
end

end p_prime

end monoid_add_monoid

section cancel_monoid
variables [left_cancel_monoid G] (x)
variables [add_left_cancel_monoid A] (a)

@[to_additive nsmul_injective_aux]
lemma pow_injective_aux (h : n ≤ m)
  (hm : m < order_of x) (eq : x ^ n = x ^ m) : n = m :=
by_contradiction $ assume ne : n ≠ m,
  have h₁ : m - n > 0, from nat.pos_of_ne_zero (by simp [tsub_eq_iff_eq_add_of_le h, ne.symm]),
  have h₂ : m = n + (m - n) := (add_tsub_cancel_of_le h).symm,
  have h₃ : x ^ (m - n) = 1,
    by { rw [h₂, pow_add] at eq, apply mul_left_cancel, convert eq.symm, exact mul_one (x ^ n) },
  have le : order_of x ≤ m - n, from order_of_le_of_pow_eq_one h₁ h₃,
  have lt : m - n < order_of x,
    from (tsub_lt_iff_left h).mpr $ nat.lt_add_left _ _ _ hm,
  lt_irrefl _ (le.trans_lt lt)

@[to_additive nsmul_injective_of_lt_add_order_of]
lemma pow_injective_of_lt_order_of
  (hn : n < order_of x) (hm : m < order_of x) (eq : x ^ n = x ^ m) : n = m :=
(le_total n m).elim
  (assume h, pow_injective_aux x h hm eq)
  (assume h, (pow_injective_aux x h hn eq.symm).symm)

end cancel_monoid

section group
variables [group G] [add_group A] {x a} {i : ℤ}

@[to_additive add_order_of_dvd_iff_zsmul_eq_zero]
lemma order_of_dvd_iff_zpow_eq_one : (order_of x : ℤ) ∣ i ↔ x ^ i = 1 :=
begin
  rcases int.eq_coe_or_neg i with ⟨i, rfl|rfl⟩,
  { rw [int.coe_nat_dvd, order_of_dvd_iff_pow_eq_one, zpow_coe_nat] },
  { rw [dvd_neg, int.coe_nat_dvd, zpow_neg, inv_eq_one, zpow_coe_nat,
      order_of_dvd_iff_pow_eq_one] }
end

@[simp, norm_cast, to_additive] lemma order_of_subgroup {H : subgroup G}
  (y: H) : order_of (y : G) = order_of y :=
order_of_injective H.subtype subtype.coe_injective y

@[to_additive zsmul_eq_mod_add_order_of]
lemma zpow_eq_mod_order_of : x ^ i = x ^ (i % order_of x) :=
calc x ^ i = x ^ (i % order_of x + order_of x * (i / order_of x)) :
    by rw [int.mod_add_div]
       ... = x ^ (i % order_of x) :
    by simp [zpow_add, zpow_mul, pow_order_of_eq_one]
    set_option pp.all true

@[to_additive nsmul_inj_iff_of_add_order_of_eq_zero]
lemma pow_inj_iff_of_order_of_eq_zero (h : order_of x = 0) {n m : ℕ} :
  x ^ n = x ^ m ↔ n = m :=
begin
  rw [order_of_eq_zero_iff, is_of_fin_order_iff_pow_eq_one] at h,
  push_neg at h,
  induction n with n IH generalizing m,
  { cases m,
    { simp },
    { simpa [eq_comm] using h m.succ m.zero_lt_succ } },
  { cases m,
    { simpa using h n.succ n.zero_lt_succ },
    { simp [pow_succ, IH] } }
end

@[to_additive nsmul_inj_mod]
lemma pow_inj_mod {n m : ℕ} :
  x ^ n = x ^ m ↔ n % order_of x = m % order_of x :=
begin
  cases (order_of x).zero_le.eq_or_lt with hx hx,
  { simp [pow_inj_iff_of_order_of_eq_zero, hx.symm] },
  rw [pow_eq_mod_order_of, @pow_eq_mod_order_of _ _ _ m],
  exact ⟨pow_injective_of_lt_order_of _ (nat.mod_lt _ hx) (nat.mod_lt _ hx), λ h, congr_arg _ h⟩
end

end group

section fintype
variables [fintype G] [fintype A]

section finite_monoid
variables [monoid G] [add_monoid A]
open_locale big_operators

@[to_additive sum_card_add_order_of_eq_card_nsmul_eq_zero]
lemma sum_card_order_of_eq_card_pow_eq_one [decidable_eq G] (hn : 0 < n) :
  ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
  = (finset.univ.filter (λ x : G, x ^ n = 1)).card :=
calc ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
    = _ : (finset.card_bUnion (by { intros, apply finset.disjoint_filter.2, cc })).symm
... = _ : congr_arg finset.card (finset.ext (begin
  assume x,
  suffices : order_of x ≤ n ∧ order_of x ∣ n ↔ x ^ n = 1,
  { simpa [nat.lt_succ_iff], },
  exact ⟨λ h, let ⟨m, hm⟩ := h.2 in by rw [hm, pow_mul, pow_order_of_eq_one, one_pow],
    λ h, ⟨order_of_le_of_pow_eq_one hn h, order_of_dvd_of_pow_eq_one h⟩⟩
end))

end finite_monoid

section finite_cancel_monoid
-- TODO: Of course everything also works for right_cancel_monoids.
variables [left_cancel_monoid G] [add_left_cancel_monoid A]

-- TODO: Use this to show that a finite left cancellative monoid is a group.
@[to_additive exists_nsmul_eq_zero]
lemma exists_pow_eq_one (x : G) : is_of_fin_order x :=
begin
  refine (is_of_fin_order_iff_pow_eq_one _).mpr _,
  obtain ⟨i, j, a_eq, ne⟩ : ∃(i j : ℕ), x ^ i = x ^ j ∧ i ≠ j :=
    by simpa only [not_forall, exists_prop, injective]
      using (not_injective_infinite_fintype (λi:ℕ, x^i)),
  wlog h'' : j ≤ i,
  refine ⟨i - j, tsub_pos_of_lt (lt_of_le_of_ne h'' ne.symm), mul_right_injective (x^j) _⟩,
  rw [mul_one, ← pow_add, ← a_eq, add_tsub_cancel_of_le h''],
end

@[to_additive add_order_of_le_card_univ]
lemma order_of_le_card_univ : order_of x ≤ fintype.card G :=
finset.le_card_of_inj_on_range ((^) x)
  (assume n _, finset.mem_univ _)
  (assume i hi j hj, pow_injective_of_lt_order_of x hi hj)

/-- This is the same as `order_of_pos' but with one fewer explicit assumption since this is
  automatic in case of a finite cancellative monoid.-/
@[to_additive add_order_of_pos
"This is the same as `add_order_of_pos' but with one fewer explicit assumption since this is
  automatic in case of a finite cancellative additive monoid."]
lemma order_of_pos (x : G) : 0 < order_of x := order_of_pos' (exists_pow_eq_one x)

open nat

/-- This is the same as `order_of_pow'` and `order_of_pow''` but with one assumption less which is
automatic in the case of a finite cancellative monoid.-/
@[to_additive add_order_of_nsmul
"This is the same as `add_order_of_nsmul'` and `add_order_of_nsmul` but with one assumption less
which is automatic in the case of a finite cancellative additive monoid."]
lemma order_of_pow (x : G) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n := order_of_pow'' _ _ (exists_pow_eq_one _)

@[to_additive mem_multiples_iff_mem_range_add_order_of]
lemma mem_powers_iff_mem_range_order_of [decidable_eq G] :
  y ∈ submonoid.powers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
finset.mem_range_iff_mem_finset_range_of_mod_eq' (order_of_pos x)
  (assume i, pow_eq_mod_order_of.symm)

@[to_additive decidable_multiples]
noncomputable instance decidable_powers [decidable_eq G] :
  decidable_pred (∈ submonoid.powers x) :=
begin
  assume y,
  apply decidable_of_iff'
    (y ∈ (finset.range (order_of x)).image ((^) x)),
  exact mem_powers_iff_mem_range_order_of
end

/--The equivalence between `fin (order_of x)` and `submonoid.powers x`, sending `i` to `x ^ i`."-/
@[to_additive fin_equiv_multiples "The equivalence between `fin (add_order_of a)` and
`add_submonoid.multiples a`, sending `i` to `i • a`."]
noncomputable def fin_equiv_powers (x : G) :
  fin (order_of x) ≃ (submonoid.powers x : set G) :=
equiv.of_bijective (λ n, ⟨x ^ ↑n, ⟨n, rfl⟩⟩) ⟨λ ⟨i, hi⟩ ⟨j, hj⟩ ij,
  subtype.mk_eq_mk.2 (pow_injective_of_lt_order_of x hi hj (subtype.mk_eq_mk.1 ij)),
  λ ⟨_, i, rfl⟩, ⟨⟨i % order_of x, mod_lt i (order_of_pos x)⟩, subtype.eq pow_eq_mod_order_of.symm⟩⟩

@[simp, to_additive fin_equiv_multiples_apply]
lemma fin_equiv_powers_apply {x : G} {n : fin (order_of x)} :
  fin_equiv_powers x n = ⟨x ^ ↑n, n, rfl⟩ := rfl

@[simp, to_additive fin_equiv_multiples_symm_apply]
lemma fin_equiv_powers_symm_apply (x : G) (n : ℕ)
  {hn : ∃ (m : ℕ), x ^ m = x ^ n} :
  ((fin_equiv_powers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
by rw [equiv.symm_apply_eq, fin_equiv_powers_apply, subtype.mk_eq_mk,
  pow_eq_mod_order_of, fin.coe_mk]

/-- The equivalence between `submonoid.powers` of two elements `x, y` of the same order, mapping
  `x ^ i` to `y ^ i`. -/
@[to_additive multiples_equiv_multiples
"The equivalence between `submonoid.multiples` of two elements `a, b` of the same additive order,
  mapping `i • a` to `i • b`."]
noncomputable def powers_equiv_powers (h : order_of x = order_of y) :
  (submonoid.powers x : set G) ≃ (submonoid.powers y : set G) :=
(fin_equiv_powers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_powers y))

@[simp, to_additive multiples_equiv_multiples_apply]
lemma powers_equiv_powers_apply (h : order_of x = order_of y)
  (n : ℕ) : powers_equiv_powers h ⟨x ^ n, n, rfl⟩ = ⟨y ^ n, n, rfl⟩ :=
begin
  rw [powers_equiv_powers, equiv.trans_apply, equiv.trans_apply,
    fin_equiv_powers_symm_apply, ← equiv.eq_symm_apply, fin_equiv_powers_symm_apply],
  simp [h]
end

@[to_additive add_order_of_eq_card_multiples]
lemma order_eq_card_powers [decidable_eq G] :
  order_of x = fintype.card (submonoid.powers x : set G) :=
(fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_powers x⟩)

end finite_cancel_monoid

section finite_group
variables [group G] [add_group A]

@[to_additive]
lemma exists_zpow_eq_one (x : G) : ∃ (i : ℤ) (H : i ≠ 0), x ^ (i : ℤ) = 1 :=
begin
  rcases exists_pow_eq_one x with ⟨w, hw1, hw2⟩,
  refine ⟨w, int.coe_nat_ne_zero.mpr (ne_of_gt hw1), _⟩,
  rw zpow_coe_nat,
  exact (is_periodic_pt_mul_iff_pow_eq_one _).mp hw2,
end

open subgroup

@[to_additive mem_multiples_iff_mem_zmultiples]
lemma mem_powers_iff_mem_zpowers : y ∈ submonoid.powers x ↔ y ∈ zpowers x :=
⟨λ ⟨n, hn⟩, ⟨n, by simp * at *⟩,
λ ⟨i, hi⟩, ⟨(i % order_of x).nat_abs,
  by rwa [← zpow_coe_nat, int.nat_abs_of_nonneg (int.mod_nonneg _
    (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos x))),
    ← zpow_eq_mod_order_of]⟩⟩

@[to_additive multiples_eq_zmultiples]
lemma powers_eq_zpowers (x : G) : (submonoid.powers x : set G) = zpowers x :=
set.ext $ λ x, mem_powers_iff_mem_zpowers

@[to_additive mem_zmultiples_iff_mem_range_add_order_of]
lemma mem_zpowers_iff_mem_range_order_of [decidable_eq G] :
  y ∈ subgroup.zpowers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
by rw [← mem_powers_iff_mem_zpowers, mem_powers_iff_mem_range_order_of]

@[to_additive decidable_zmultiples]
noncomputable instance decidable_zpowers [decidable_eq G] :
  decidable_pred (∈ subgroup.zpowers x) :=
begin
  simp_rw ←set_like.mem_coe,
  rw ← powers_eq_zpowers,
  exact decidable_powers,
end

/-- The equivalence between `fin (order_of x)` and `subgroup.zpowers x`, sending `i` to `x ^ i`. -/
@[to_additive fin_equiv_zmultiples
"The equivalence between `fin (add_order_of a)` and `subgroup.zmultiples a`, sending `i`
to `i • a`."]
noncomputable def fin_equiv_zpowers (x : G) :
  fin (order_of x) ≃ (subgroup.zpowers x : set G) :=
(fin_equiv_powers x).trans (equiv.set.of_eq (powers_eq_zpowers x))

@[simp, to_additive fin_equiv_zmultiples_apply]
lemma fin_equiv_zpowers_apply {n : fin (order_of x)} :
  fin_equiv_zpowers x n = ⟨x ^ (n : ℕ), n, zpow_coe_nat x n⟩ := rfl

@[simp, to_additive fin_equiv_zmultiples_symm_apply]
lemma fin_equiv_zpowers_symm_apply (x : G) (n : ℕ)
  {hn : ∃ (m : ℤ), x ^ m = x ^ n} :
  ((fin_equiv_zpowers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
by { rw [fin_equiv_zpowers, equiv.symm_trans_apply, equiv.set.of_eq_symm_apply],
  exact fin_equiv_powers_symm_apply x n }

/-- The equivalence between `subgroup.zpowers` of two elements `x, y` of the same order, mapping
  `x ^ i` to `y ^ i`. -/
@[to_additive zmultiples_equiv_zmultiples
"The equivalence between `subgroup.zmultiples` of two elements `a, b` of the same additive order,
  mapping `i • a` to `i • b`."]
noncomputable def zpowers_equiv_zpowers (h : order_of x = order_of y) :
  (subgroup.zpowers x : set G) ≃ (subgroup.zpowers y : set G) :=
(fin_equiv_zpowers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_zpowers y))

@[simp, to_additive zmultiples_equiv_zmultiples_apply]
lemma zpowers_equiv_zpowers_apply (h : order_of x = order_of y)
  (n : ℕ) : zpowers_equiv_zpowers h ⟨x ^ n, n, zpow_coe_nat x n⟩ = ⟨y ^ n, n, zpow_coe_nat y n⟩ :=
begin
  rw [zpowers_equiv_zpowers, equiv.trans_apply, equiv.trans_apply,
    fin_equiv_zpowers_symm_apply, ← equiv.eq_symm_apply, fin_equiv_zpowers_symm_apply],
  simp [h]
end

@[to_additive add_order_eq_card_zmultiples]
lemma order_eq_card_zpowers [decidable_eq G] :
  order_of x = fintype.card (subgroup.zpowers x : set G) :=
(fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_zpowers x⟩)

open quotient_group

/- TODO: use cardinal theory, introduce `card : set G → ℕ`, or setup decidability for cosets -/
@[to_additive add_order_of_dvd_card_univ]
lemma order_of_dvd_card_univ : order_of x ∣ fintype.card G :=
begin
  classical,
  have ft_prod : fintype ((G ⧸ zpowers x) × zpowers x),
    from fintype.of_equiv G group_equiv_quotient_times_subgroup,
  have ft_s : fintype (zpowers x),
    from @fintype.prod_right _ _ _ ft_prod _,
  have ft_cosets : fintype (G ⧸ zpowers x),
    from @fintype.prod_left _ _ _ ft_prod ⟨⟨1, (zpowers x).one_mem⟩⟩,
  have eq₁ : fintype.card G = @fintype.card _ ft_cosets * @fintype.card _ ft_s,
    from calc fintype.card G = @fintype.card _ ft_prod :
        @fintype.card_congr _ _ _ ft_prod group_equiv_quotient_times_subgroup
      ... = @fintype.card _ (@prod.fintype _ _ ft_cosets ft_s) :
        congr_arg (@fintype.card _) $ subsingleton.elim _ _
      ... = @fintype.card _ ft_cosets * @fintype.card _ ft_s :
        @fintype.card_prod _ _ ft_cosets ft_s,
  have eq₂ : order_of x = @fintype.card _ ft_s,
    from calc order_of x = _ : order_eq_card_zpowers
      ... = _ : congr_arg (@fintype.card _) $ subsingleton.elim _ _,
  exact dvd.intro (@fintype.card (G ⧸ subgroup.zpowers x) ft_cosets)
          (by rw [eq₁, eq₂, mul_comm])
end

@[simp, to_additive card_nsmul_eq_zero] lemma pow_card_eq_one : x ^ fintype.card G = 1 :=
let ⟨m, hm⟩ := @order_of_dvd_card_univ _ x _ _ in
by simp [hm, pow_mul, pow_order_of_eq_one]

@[to_additive nsmul_eq_mod_card] lemma pow_eq_mod_card (n : ℕ) :
  x ^ n = x ^ (n % fintype.card G) :=
by rw [pow_eq_mod_order_of, ←nat.mod_mod_of_dvd n order_of_dvd_card_univ,
  ← pow_eq_mod_order_of]

@[to_additive] lemma zpow_eq_mod_card (n : ℤ) :
  x ^ n = x ^ (n % fintype.card G) :=
by rw [zpow_eq_mod_order_of, ← int.mod_mod_of_dvd n (int.coe_nat_dvd.2 order_of_dvd_card_univ),
  ← zpow_eq_mod_order_of]

/-- If `gcd(|G|,n)=1` then the `n`th power map is a bijection -/
@[simps] def pow_coprime (h : nat.coprime (fintype.card G) n) : G ≃ G :=
{ to_fun := λ g, g ^ n,
  inv_fun := λ g, g ^ (nat.gcd_b (fintype.card G) n),
  left_inv := λ g, by
  { have key : g ^ _ = g ^ _ := congr_arg (λ n : ℤ, g ^ n) (nat.gcd_eq_gcd_ab (fintype.card G) n),
    rwa [zpow_add, zpow_mul, zpow_mul, zpow_coe_nat, zpow_coe_nat, zpow_coe_nat,
      h.gcd_eq_one, pow_one, pow_card_eq_one, one_zpow, one_mul, eq_comm] at key },
  right_inv := λ g, by
  { have key : g ^ _ = g ^ _ := congr_arg (λ n : ℤ, g ^ n) (nat.gcd_eq_gcd_ab (fintype.card G) n),
    rwa [zpow_add, zpow_mul, zpow_mul', zpow_coe_nat, zpow_coe_nat, zpow_coe_nat,
      h.gcd_eq_one, pow_one, pow_card_eq_one, one_zpow, one_mul, eq_comm] at key } }

@[simp] lemma pow_coprime_one (h : nat.coprime (fintype.card G) n) : pow_coprime h 1 = 1 :=
one_pow n

@[simp] lemma pow_coprime_inv (h : nat.coprime (fintype.card G) n) {g : G} :
  pow_coprime h g⁻¹ = (pow_coprime h g)⁻¹ :=
inv_pow g n

lemma inf_eq_bot_of_coprime {G : Type*} [group G] {H K : subgroup G} [fintype H] [fintype K]
  (h : nat.coprime (fintype.card H) (fintype.card K)) : H ⊓ K = ⊥ :=
begin
  refine (H ⊓ K).eq_bot_iff_forall.mpr (λ x hx, _),
  rw [←order_of_eq_one_iff, ←nat.dvd_one, ←h.gcd_eq_one, nat.dvd_gcd_iff],
  exact ⟨(congr_arg (∣ fintype.card H) (order_of_subgroup ⟨x, hx.1⟩)).mpr order_of_dvd_card_univ,
    (congr_arg (∣ fintype.card K) (order_of_subgroup ⟨x, hx.2⟩)).mpr order_of_dvd_card_univ⟩,
end

variable (a)

lemma image_range_add_order_of [decidable_eq A] :
  finset.image (λ i, i • a) (finset.range (add_order_of a)) =
  (add_subgroup.zmultiples a : set A).to_finset :=
by {ext x, rw [set.mem_to_finset, set_like.mem_coe, mem_zmultiples_iff_mem_range_add_order_of] }

/-- TODO: Generalise to `submonoid.powers`.-/
@[to_additive image_range_add_order_of]
lemma image_range_order_of [decidable_eq G] :
  finset.image (λ i, x ^ i) (finset.range (order_of x)) = (zpowers x : set G).to_finset :=
by { ext x, rw [set.mem_to_finset, set_like.mem_coe, mem_zpowers_iff_mem_range_order_of] }

/-- TODO: Generalise to `finite_cancel_monoid`. -/
@[to_additive gcd_nsmul_card_eq_zero_iff]
lemma pow_gcd_card_eq_one_iff : x ^ n = 1 ↔ x ^ (gcd n (fintype.card G)) = 1 :=
⟨λ h, pow_gcd_eq_one _ h $ pow_card_eq_one,
  λ h, let ⟨m, hm⟩ := gcd_dvd_left n (fintype.card G) in
    by rw [hm, pow_mul, h, one_pow]⟩

end finite_group

end fintype

section pow_is_subgroup

/-- A nonempty idempotent subset of a finite cancellative monoid is a submonoid -/
def submonoid_of_idempotent {M : Type*} [left_cancel_monoid M] [fintype M] (S : set M)
  (hS1 : S.nonempty) (hS2 : S * S = S) : submonoid M :=
have pow_mem : ∀ a : M, a ∈ S → ∀ n : ℕ, a ^ (n + 1) ∈ S :=
λ a ha, nat.rec (by rwa [zero_add, pow_one])
  (λ n ih, (congr_arg2 (∈) (pow_succ a (n + 1)).symm hS2).mp (set.mul_mem_mul ha ih)),
{ carrier := S,
  one_mem' := by
  { obtain ⟨a, ha⟩ := hS1,
    rw [←pow_order_of_eq_one a, ← tsub_add_cancel_of_le (succ_le_of_lt (order_of_pos a))],
    exact pow_mem a ha (order_of a - 1) },
  mul_mem' := λ a b ha hb, (congr_arg2 (∈) rfl hS2).mp (set.mul_mem_mul ha hb) }

/-- A nonempty idempotent subset of a finite group is a subgroup -/
def subgroup_of_idempotent {G : Type*} [group G] [fintype G] (S : set G)
  (hS1 : S.nonempty) (hS2 : S * S = S) : subgroup G :=
{ carrier := S,
  inv_mem' := λ a ha, by
  { rw [←one_mul a⁻¹, ←pow_one a, ←pow_order_of_eq_one a, ←pow_sub a (order_of_pos a)],
    exact (submonoid_of_idempotent S hS1 hS2).pow_mem ha (order_of a - 1) },
  .. submonoid_of_idempotent S hS1 hS2 }

/-- If `S` is a nonempty subset of a finite group `G`, then `S ^ |G|` is a subgroup -/
def pow_card_subgroup {G : Type*} [group G] [fintype G] (S : set G) (hS : S.nonempty) :
  subgroup G :=
have one_mem : (1 : G) ∈ (S ^ fintype.card G) := by
{ obtain ⟨a, ha⟩ := hS,
  rw ← pow_card_eq_one,
  exact set.pow_mem_pow ha (fintype.card G) },
subgroup_of_idempotent (S ^ (fintype.card G)) ⟨1, one_mem⟩ begin
  classical,
  refine (set.eq_of_subset_of_card_le
    (λ b hb, (congr_arg (∈ _) (one_mul b)).mp (set.mul_mem_mul one_mem hb)) (ge_of_eq _)).symm,
  change _ = fintype.card (_ * _ : set G),
  rw [←pow_add, group.card_pow_eq_card_pow_card_univ S (fintype.card G) le_rfl,
      group.card_pow_eq_card_pow_card_univ S (fintype.card G + fintype.card G) le_add_self],
end

end pow_is_subgroup

section linear_ordered_ring

variable [linear_ordered_ring G]

lemma order_of_abs_ne_one (h : |x| ≠ 1) : order_of x = 0 :=
begin
  rw order_of_eq_zero_iff',
  intros n hn hx,
  replace hx : |x| ^ n = 1 := by simpa only [abs_one, abs_pow] using congr_arg abs hx,
  cases h.lt_or_lt with h h,
  { exact ((pow_lt_one (abs_nonneg x) h hn.ne').ne hx).elim },
  { exact ((one_lt_pow h hn.ne').ne' hx).elim }
end

lemma linear_ordered_ring.order_of_le_two : order_of x ≤ 2 :=
begin
  cases ne_or_eq (|x|) 1 with h h,
  { simp [order_of_abs_ne_one h] },
  rcases eq_or_eq_neg_of_abs_eq h with rfl | rfl,
  { simp },
  apply order_of_le_of_pow_eq_one; norm_num
end

end linear_ordered_ring