/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import algebra.group_power.lemmas
import group_theory.group_action.opposite

/-!
# Iterates of monoid and ring homomorphisms

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

Iterate of a monoid/ring homomorphism is a monoid/ring homomorphism but it has a wrong type, so Lean
can't apply lemmas like `monoid_hom.map_one` to `f^[n] 1`. Though it is possible to define
a monoid structure on the endomorphisms, quite often we do not want to convert from
`M →* M` to `monoid.End M` and from `f^[n]` to `f^n` just to apply a simple lemma.

So, we restate standard `*_hom.map_*` lemmas under names `*_hom.iterate_map_*`.

We also prove formulas for iterates of add/mul left/right.

## Tags

homomorphism, iterate
-/

open function

variables {M : Type*} {N : Type*} {G : Type*} {H : Type*}

/-- An auxiliary lemma that can be used to prove `⇑(f ^ n) = (⇑f^[n])`. -/
lemma hom_coe_pow {F : Type*} [monoid F] (c : F → M → M) (h1 : c 1 = id)
  (hmul : ∀ f g, c (f * g) = c f ∘ c g) (f : F) : ∀ n, c (f ^ n) = (c f^[n])
| 0 := by { rw [pow_zero, h1], refl }
| (n + 1) := by rw [pow_succ, iterate_succ', hmul, hom_coe_pow]

namespace monoid_hom

section

variables [mul_one_class M] [mul_one_class N]

@[simp, to_additive]
theorem iterate_map_one (f : M →* M) (n : ℕ) : f^[n] 1 = 1 :=
iterate_fixed f.map_one n

@[simp, to_additive]
theorem iterate_map_mul (f : M →* M) (n : ℕ) (x y) :
  f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
semiconj₂.iterate f.map_mul n x y

end

variables [monoid M] [monoid N] [group G] [group H]

@[simp, to_additive]
theorem iterate_map_inv (f : G →* G) (n : ℕ) (x) :
  f^[n] (x⁻¹) = (f^[n] x)⁻¹ :=
commute.iterate_left f.map_inv n x

@[simp, to_additive]
theorem iterate_map_div (f : G →* G) (n : ℕ) (x y) :
  f^[n] (x / y) = (f^[n] x) / (f^[n] y) :=
semiconj₂.iterate f.map_div n x y

theorem iterate_map_pow (f : M →* M) (n : ℕ) (a) (m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_pow x m) n a

theorem iterate_map_zpow (f : G →* G) (n : ℕ) (a) (m : ℤ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_zpow x m) n a

end monoid_hom

lemma monoid.End.coe_pow {M} [monoid M] (f : monoid.End M) (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) _ _

-- we define these manually so that we can pick a better argument order
namespace add_monoid_hom
variables [add_monoid M] [add_group G]

theorem iterate_map_smul (f : M →+ M) (n m : ℕ) (x : M) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_pow n x m

attribute [to_additive, to_additive_reorder 5] monoid_hom.iterate_map_pow

theorem iterate_map_zsmul (f : G →+ G) (n : ℕ) (m : ℤ) (x : G) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_zpow n x m

attribute [to_additive, to_additive_reorder 5] monoid_hom.iterate_map_zpow

end add_monoid_hom

lemma add_monoid.End.coe_pow {A} [add_monoid A] (f : add_monoid.End A) (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) _ _

namespace ring_hom

section semiring

variables {R : Type*} [semiring R] (f : R →+* R) (n : ℕ) (x y : R)

lemma coe_pow (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) f n

theorem iterate_map_one : f^[n] 1 = 1 := f.to_monoid_hom.iterate_map_one n

theorem iterate_map_zero : f^[n] 0 = 0 := f.to_add_monoid_hom.iterate_map_zero n

theorem iterate_map_add : f^[n] (x + y) = (f^[n] x) + (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_add n x y

theorem iterate_map_mul : f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
f.to_monoid_hom.iterate_map_mul n x y

theorem iterate_map_pow (a) (n m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
f.to_monoid_hom.iterate_map_pow n a m

theorem iterate_map_smul (n m : ℕ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_smul n m x

end semiring

variables {R : Type*} [ring R] (f : R →+* R) (n : ℕ) (x y : R)

theorem iterate_map_sub : f^[n] (x - y) = (f^[n] x) - (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_sub n x y

theorem iterate_map_neg : f^[n] (-x) = -(f^[n] x) :=
f.to_add_monoid_hom.iterate_map_neg n x

theorem iterate_map_zsmul (n : ℕ) (m : ℤ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_zsmul n m x

end ring_hom

--what should be the namespace for this section?
section monoid

variables [monoid G] (a : G) (n : ℕ)

@[simp, to_additive] lemma smul_iterate [mul_action G H] :
  ((•) a : H → H)^[n] = (•) (a^n) :=
funext (λ b, nat.rec_on n (by rw [iterate_zero, id.def, pow_zero, one_smul])
  (λ n ih, by rw [iterate_succ', comp_app, ih, pow_succ, mul_smul]))

@[simp, to_additive] lemma mul_left_iterate : ((*) a)^[n] = (*) (a^n) :=
smul_iterate a n

@[simp, to_additive] lemma mul_right_iterate : (* a)^[n] = (* a ^ n) :=
smul_iterate (mul_opposite.op a) n

@[to_additive]
lemma mul_right_iterate_apply_one : (* a)^[n] 1 = a ^ n :=
by simp [mul_right_iterate]

@[simp, to_additive]
lemma pow_iterate (n : ℕ) (j : ℕ) : ((λ (x : G), x^n)^[j]) = λ x, x^(n^j) :=
begin
  letI : mul_action ℕ G :=
  { smul := λ n g, g^n,
    one_smul := pow_one,
    mul_smul := λ m n g, pow_mul' g m n },
  exact smul_iterate n j,
end

end monoid

section group

variables [group G]

@[simp, to_additive]
lemma zpow_iterate (n : ℤ) (j : ℕ) : ((λ (x : G), x^n)^[j]) = λ x, x^(n^j) :=
begin
  letI : mul_action ℤ G :=
  { smul := λ n g, g^n,
    one_smul := zpow_one,
    mul_smul := λ m n g, zpow_mul' g m n },
  exact smul_iterate n j,
end

end group

section semigroup

variables [semigroup G] {a b c : G}

@[to_additive]
lemma semiconj_by.function_semiconj_mul_left (h : semiconj_by a b c) :
  function.semiconj ((*)a) ((*)b) ((*)c) :=
λ j, by rw [← mul_assoc, h.eq, mul_assoc]

@[to_additive]
lemma commute.function_commute_mul_left (h : commute a b) :
  function.commute ((*)a) ((*)b) :=
semiconj_by.function_semiconj_mul_left h

@[to_additive]
lemma semiconj_by.function_semiconj_mul_right_swap (h : semiconj_by a b c) :
  function.semiconj (*a) (*c) (*b) :=
λ j, by simp_rw [mul_assoc, ← h.eq]

@[to_additive]
lemma commute.function_commute_mul_right (h : commute a b) :
  function.commute (*a) (*b) :=
semiconj_by.function_semiconj_mul_right_swap h

end semigroup


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark, Kyle Miller
-/
import combinatorics.simple_graph.adj_matrix
import linear_algebra.matrix.charpoly.finite_field
import data.int.modeq
import data.zmod.basic
import tactic.interval_cases

/-!
# The Friendship Theorem

## Definitions and Statement
- A `friendship` graph is one in which any two distinct vertices have exactly one neighbor in common
- A `politician`, at least in the context of this problem, is a vertex in a graph which is adjacent
  to every other vertex.
- The friendship theorem (Erdős, Rényi, Sós 1966) states that every finite friendship graph has a
  politician.

## Proof outline
The proof revolves around the theory of adjacency matrices, although some steps could equivalently
be phrased in terms of counting walks.
- Assume `G` is a finite friendship graph.
- First we show that any two nonadjacent vertices have the same degree
- Assume for contradiction that `G` does not have a politician.
- Conclude from the last two points that `G` is `d`-regular for some `d : ℕ`.
- Show that `G` has `d ^ 2 - d + 1` vertices.
- By casework, show that if `d = 0, 1, 2`, then `G` has a politician.
- If `3 ≤ d`, let `p` be a prime factor of `d - 1`.
- If `A` is the adjacency matrix of `G` with entries in `ℤ/pℤ`, we show that `A ^ p` has trace `1`.
- This gives a contradiction, as `A` has trace `0`, and thus `A ^ p` has trace `0`.

## References
- [P. Erdős, A. Rényi, V. Sós, *On A Problem of Graph Theory*][erdosrenyisos]
- [C. Huneke, *The Friendship Theorem*][huneke2002]

-/

open_locale classical big_operators
noncomputable theory

open finset simple_graph matrix

universes u v
variables {V : Type u} {R : Type v} [semiring R]

section friendship_def
variables (G : simple_graph V)

/--
This property of a graph is the hypothesis of the friendship theorem:
every pair of nonadjacent vertices has exactly one common friend,
a vertex to which both are adjacent.
-/
def friendship [fintype V] : Prop := ∀ ⦃v w : V⦄, v ≠ w → fintype.card (G.common_neighbors v w) = 1

/--
A politician is a vertex that is adjacent to all other vertices.
-/
def exists_politician : Prop := ∃ (v : V), ∀ (w : V), v ≠ w → G.adj v w

end friendship_def

variables [fintype V] {G : simple_graph V} {d : ℕ} (hG : friendship G)
include hG

namespace friendship

variables (R)
/-- One characterization of a friendship graph is that there is exactly one walk of length 2
  between distinct vertices. These walks are counted in off-diagonal entries of the square of
  the adjacency matrix, so for a friendship graph, those entries are all 1. -/
theorem adj_matrix_sq_of_ne {v w : V} (hvw : v ≠ w) :
  ((G.adj_matrix R) ^ 2) v w = 1 :=
begin
  rw [sq, ← nat.cast_one, ← hG hvw],
  simp [common_neighbors, neighbor_finset_eq_filter, finset.filter_filter,
    and_comm, ← neighbor_finset_def],
end

/-- This calculation amounts to counting the number of length 3 walks between nonadjacent vertices.
  We use it to show that nonadjacent vertices have equal degrees. -/
lemma adj_matrix_pow_three_of_not_adj {v w : V} (non_adj : ¬ G.adj v w) :
  ((G.adj_matrix R) ^ 3) v w = degree G v :=
begin
  rw [pow_succ, mul_eq_mul, adj_matrix_mul_apply, degree, card_eq_sum_ones, nat.cast_sum],
  apply sum_congr rfl,
  intros x hx,
  rw [adj_matrix_sq_of_ne _ hG, nat.cast_one],
  rintro ⟨rfl⟩,
  rw mem_neighbor_finset at hx,
  exact non_adj hx,
end

variable {R}

/-- As `v` and `w` not being adjacent implies
  `degree G v = ((G.adj_matrix R) ^ 3) v w` and `degree G w = ((G.adj_matrix R) ^ 3) v w`,
  the degrees are equal if `((G.adj_matrix R) ^ 3) v w = ((G.adj_matrix R) ^ 3) w v`

  This is true as the adjacency matrix is symmetric. -/
lemma degree_eq_of_not_adj {v w : V} (hvw : ¬ G.adj v w) :
  degree G v = degree G w :=
begin
  rw [← nat.cast_id (G.degree v), ← nat.cast_id (G.degree w),
      ← adj_matrix_pow_three_of_not_adj ℕ hG hvw,
      ← adj_matrix_pow_three_of_not_adj ℕ hG (λ h, hvw (G.symm h))],
  conv_lhs {rw ← transpose_adj_matrix},
  simp only [pow_succ, sq, mul_eq_mul, ← transpose_mul, transpose_apply],
  simp only [← mul_eq_mul, mul_assoc],
end

/-- Let `A` be the adjacency matrix of a graph `G`.
  If `G` is a friendship graph, then all of the off-diagonal entries of `A^2` are 1.
  If `G` is `d`-regular, then all of the diagonal entries of `A^2` are `d`.
  Putting these together determines `A^2` exactly for a `d`-regular friendship graph. -/
theorem adj_matrix_sq_of_regular (hd : G.is_regular_of_degree d) :
  ((G.adj_matrix R) ^ 2) = λ v w, if v = w then d else 1 :=
begin
  ext v w, by_cases h : v = w,
  { rw [h, sq, mul_eq_mul, adj_matrix_mul_self_apply_self, hd], simp, },
  { rw [adj_matrix_sq_of_ne R hG h, if_neg h], },
end

lemma adj_matrix_sq_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1)
  (hd : G.is_regular_of_degree d) :
  (G.adj_matrix (zmod p)) ^ 2 = λ _ _, 1 :=
by simp [adj_matrix_sq_of_regular hG hd, dmod]

section nonempty

variable [nonempty V]

/-- If `G` is a friendship graph without a politician (a vertex adjacent to all others), then
  it is regular. We have shown that nonadjacent vertices of a friendship graph have the same degree,
  and if there isn't a politician, we can show this for adjacent vertices by finding a vertex
  neither is adjacent to, and then using transitivity. -/
theorem is_regular_of_not_exists_politician (hG' : ¬exists_politician G) :
  ∃ (d : ℕ), G.is_regular_of_degree d :=
begin
  have v := classical.arbitrary V,
  use G.degree v,
  intro x,
  by_cases hvx : G.adj v x, swap, { exact (degree_eq_of_not_adj hG hvx).symm, },
  dunfold exists_politician at hG',
  push_neg at hG',
  rcases hG' v with ⟨w, hvw', hvw⟩,
  rcases hG' x with ⟨y, hxy', hxy⟩,
  by_cases hxw : G.adj x w,
    swap, { rw degree_eq_of_not_adj hG hvw, exact degree_eq_of_not_adj hG hxw },
  rw degree_eq_of_not_adj hG hxy,
  by_cases hvy : G.adj v y,
    swap, { exact (degree_eq_of_not_adj hG hvy).symm },
  rw degree_eq_of_not_adj hG hvw,
  apply degree_eq_of_not_adj hG,
  intro hcontra,
  rcases finset.card_eq_one.mp (hG hvw') with ⟨⟨a, ha⟩, h⟩,
  have key : ∀ {x}, x ∈ G.common_neighbors v w → x = a,
  { intros x hx,
    have h' := mem_univ (subtype.mk x hx),
    rw [h, mem_singleton] at h',
    injection h', },
  apply hxy',
  rw [key ((mem_common_neighbors G).mpr ⟨hvx, G.symm hxw⟩),
      key ((mem_common_neighbors G).mpr ⟨hvy, G.symm hcontra⟩)],
end

/-- Let `A` be the adjacency matrix of a `d`-regular friendship graph, and let `v` be a vector
  all of whose components are `1`. Then `v` is an eigenvector of `A ^ 2`, and we can compute
  the eigenvalue to be `d * d`, or as `d + (fintype.card V - 1)`, so those quantities must be equal.

  This essentially means that the graph has `d ^ 2 - d + 1` vertices. -/
lemma card_of_regular (hd : G.is_regular_of_degree d) :
  d + (fintype.card V - 1) = d * d :=
begin
  have v := classical.arbitrary V,
  transitivity ((G.adj_matrix ℕ) ^ 2).mul_vec (λ _, 1) v,
  { rw [adj_matrix_sq_of_regular hG hd, mul_vec, dot_product, ← insert_erase (mem_univ v)],
    simp only [sum_insert, mul_one, if_true, nat.cast_id, eq_self_iff_true,
               mem_erase, not_true, ne.def, not_false_iff, add_right_inj, false_and],
    rw [finset.sum_const_nat, card_erase_of_mem (mem_univ v), mul_one], { refl },
    intros x hx, simp [(ne_of_mem_erase hx).symm], },
  { rw [sq, mul_eq_mul, ← mul_vec_mul_vec],
    simp [adj_matrix_mul_vec_const_apply_of_regular hd, neighbor_finset,
          card_neighbor_set_eq_degree, hd v], }
end

/-- The size of a `d`-regular friendship graph is `1 mod (d-1)`, and thus `1 mod p` for a
  factor `p ∣ d-1`. -/
lemma card_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) (hd : G.is_regular_of_degree d) :
  (fintype.card V : zmod p) = 1 :=
begin
  have hpos : 0 < fintype.card V := fintype.card_pos_iff.mpr infer_instance,
  rw [← nat.succ_pred_eq_of_pos hpos, nat.succ_eq_add_one, nat.pred_eq_sub_one],
  simp only [add_left_eq_self, nat.cast_add, nat.cast_one],
  have h := congr_arg (λ n, (↑n : zmod p)) (card_of_regular hG hd),
  revert h, simp [dmod],
end

end nonempty

omit hG

lemma adj_matrix_sq_mul_const_one_of_regular (hd : G.is_regular_of_degree d) :
  (G.adj_matrix R) * (λ _ _, 1) = λ _ _, d :=
by { ext x, simp [← hd x, degree] }

lemma adj_matrix_mul_const_one_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1)
  (hd : G.is_regular_of_degree d) :
  (G.adj_matrix (zmod p)) * (λ _ _, 1) = λ _ _, 1 :=
by rw [adj_matrix_sq_mul_const_one_of_regular hd, dmod]

include hG

/-- Modulo a factor of `d-1`, the square and all higher powers of the adjacency matrix
  of a `d`-regular friendship graph reduce to the matrix whose entries are all 1. -/
lemma adj_matrix_pow_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1)
  (hd : G.is_regular_of_degree d) {k : ℕ} (hk : 2 ≤ k) :
  (G.adj_matrix (zmod p)) ^ k = λ _ _, 1 :=
begin
  iterate 2 {cases k with k, { exfalso, linarith, }, },
  induction k with k hind,
  { exact adj_matrix_sq_mod_p_of_regular hG dmod hd, },
  rw [pow_succ, hind (nat.le_add_left 2 k)],
  exact adj_matrix_mul_const_one_mod_p_of_regular dmod hd,
end

variable [nonempty V]

/-- This is the main proof. Assuming that `3 ≤ d`, we take `p` to be a prime factor of `d-1`.
  Then the `p`th power of the adjacency matrix of a `d`-regular friendship graph must have trace 1
  mod `p`, but we can also show that the trace must be the `p`th power of the trace of the original
  adjacency matrix, which is 0, a contradiction.
-/
lemma false_of_three_le_degree (hd : G.is_regular_of_degree d) (h : 3 ≤ d) : false :=
begin
  -- get a prime factor of d - 1
  let p : ℕ := (d - 1).min_fac,
  have p_dvd_d_pred := (zmod.nat_coe_zmod_eq_zero_iff_dvd _ _).mpr (d - 1).min_fac_dvd,
  have dpos : 0 < d := by linarith,
  have d_cast : ↑(d - 1) = (d : ℤ) - 1 := by norm_cast,
  haveI : fact p.prime := ⟨nat.min_fac_prime (by linarith)⟩,
  have hp2 : 2 ≤ p := (fact.out p.prime).two_le,
  have dmod : (d : zmod p) = 1,
  { rw [← nat.succ_pred_eq_of_pos dpos, nat.succ_eq_add_one, nat.pred_eq_sub_one],
    simp only [add_left_eq_self, nat.cast_add, nat.cast_one],
    exact p_dvd_d_pred, },
  have Vmod := card_mod_p_of_regular hG dmod hd,
  -- now we reduce to a trace calculation
  have := zmod.trace_pow_card (G.adj_matrix (zmod p)),
  contrapose! this, clear this,
  -- the trace is 0 mod p when computed one way
  rw [trace_adj_matrix, zero_pow (fact.out p.prime).pos],
  -- but the trace is 1 mod p when computed the other way
  rw adj_matrix_pow_mod_p_of_regular hG dmod hd hp2,
  dunfold fintype.card at Vmod,
  simp only [matrix.trace, matrix.diag, mul_one, nsmul_eq_mul, linear_map.coe_mk, sum_const],
  rw [Vmod, ← nat.cast_one, zmod.nat_coe_zmod_eq_zero_iff_dvd, nat.dvd_one,
    nat.min_fac_eq_one_iff],
  linarith,
end

/-- If `d ≤ 1`, a `d`-regular friendship graph has at most one vertex, which is
  trivially a politician. -/
lemma exists_politician_of_degree_le_one (hd : G.is_regular_of_degree d) (hd1 : d ≤ 1) :
  exists_politician G :=
begin
  have sq : d * d = d := by { interval_cases d; norm_num },
  have h := card_of_regular hG hd,
  rw sq at h,
  have : fintype.card V ≤ 1,
  { cases fintype.card V with n,
    { exact zero_le _, },
    { have : n = 0,
      { rw [nat.succ_sub_succ_eq_sub, tsub_zero] at h,
        linarith },
      subst n, } },
  use classical.arbitrary V,
  intros w h, exfalso,
  apply h,
  apply fintype.card_le_one_iff.mp this,
end

/-- If `d = 2`, a `d`-regular friendship graph has 3 vertices, so it must be complete graph,
  and all the vertices are politicians. -/
lemma neighbor_finset_eq_of_degree_eq_two (hd : G.is_regular_of_degree 2) (v : V) :
  G.neighbor_finset v = finset.univ.erase v :=
begin
  apply finset.eq_of_subset_of_card_le,
  { rw finset.subset_iff,
    intro x,
    rw [mem_neighbor_finset, finset.mem_erase],
    exact λ h, ⟨(G.ne_of_adj h).symm, finset.mem_univ _⟩ },
  convert_to 2 ≤ _,
  { convert_to _ = fintype.card V - 1,
    { have hfr:= card_of_regular hG hd,
      linarith },
    { exact finset.card_erase_of_mem (finset.mem_univ _), }, },
  { dsimp [is_regular_of_degree, degree] at hd,
    rw hd, }
end

lemma exists_politician_of_degree_eq_two (hd : G.is_regular_of_degree 2) :
  exists_politician G :=
begin
  have v := classical.arbitrary V,
  use v,
  intros w hvw,
  rw [← mem_neighbor_finset, neighbor_finset_eq_of_degree_eq_two hG hd v, finset.mem_erase],
  exact ⟨hvw.symm, finset.mem_univ _⟩,
end

lemma exists_politician_of_degree_le_two (hd : G.is_regular_of_degree d) (h : d ≤ 2) :
  exists_politician G :=
begin
  interval_cases d,
  iterate 2 { apply exists_politician_of_degree_le_one hG hd, norm_num },
  { exact exists_politician_of_degree_eq_two hG hd },
end

end friendship

/-- **Friendship theorem**: We wish to show that a friendship graph has a politician (a vertex
  adjacent to all others). We proceed by contradiction, and assume the graph has no politician.
  We have already proven that a friendship graph with no politician is `d`-regular for some `d`,
  and now we do casework on `d`.
  If the degree is at most 2, we observe by casework that it has a politician anyway.
  If the degree is at least 3, the graph cannot exist. -/
theorem friendship_theorem [nonempty V] : exists_politician G :=
begin
  by_contradiction npG,
  rcases hG.is_regular_of_not_exists_politician npG with ⟨d, dreg⟩,
  cases lt_or_le d 3 with dle2 dge3,
  { exact npG (hG.exists_politician_of_degree_le_two dreg (nat.lt_succ_iff.mp dle2)) },
  { exact hG.false_of_three_le_degree dreg dge3 },
end


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

! This file was ported from Lean 3 source module data.nat.modeq
! leanprover-community/mathlib commit c0dbeca1a7a7f4959cdf6b2817629bafbf1547a0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Gcd
import Mathbin.Tactic.Abel

/-!
# Congruences modulo a natural number

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

This file defines the equivalence relation `a ≡ b [MOD n]` on the natural numbers,
and proves basic properties about it such as the Chinese Remainder Theorem
`modeq_and_modeq_iff_modeq_mul`.

## Notations

`a ≡ b [MOD n]` is notation for `nat.modeq n a b`, which is defined to mean `a % n = b % n`.

## Tags

modeq, congruence, mod, MOD, modulo
-/

namespace Nat

#print Nat.ModEq /-
/-- Modular equality. `n.modeq a b`, or `a ≡ b [MOD n]`, means that `a - b` is a multiple of `n`. -/
def ModEq (n a b : ℕ) :=
  a % n = b % n deriving Decidable
#align nat.modeq Nat.ModEq
-/

-- mathport name: «expr ≡ [MOD ]»
notation:50 a " ≡ " b " [MOD " n "]" => ModEq n a b

variable {m n a b c d : ℕ}

namespace Modeq

#print Nat.ModEq.refl /-
@[refl]
protected theorem refl (a : ℕ) : a ≡ a [MOD n] :=
  @rfl _ _
#align nat.modeq.refl Nat.ModEq.refl
-/

#print Nat.ModEq.rfl /-
protected theorem rfl : a ≡ a [MOD n] :=
  ModEq.refl _
#align nat.modeq.rfl Nat.ModEq.rfl
-/

instance : IsRefl _ (ModEq n) :=
  ⟨ModEq.refl⟩

#print Nat.ModEq.symm /-
@[symm]
protected theorem symm : a ≡ b [MOD n] → b ≡ a [MOD n] :=
  Eq.symm
#align nat.modeq.symm Nat.ModEq.symm
-/

#print Nat.ModEq.trans /-
@[trans]
protected theorem trans : a ≡ b [MOD n] → b ≡ c [MOD n] → a ≡ c [MOD n] :=
  Eq.trans
#align nat.modeq.trans Nat.ModEq.trans
-/

#print Nat.ModEq.comm /-
protected theorem comm : a ≡ b [MOD n] ↔ b ≡ a [MOD n] :=
  ⟨ModEq.symm, ModEq.symm⟩
#align nat.modeq.comm Nat.ModEq.comm
-/

end Modeq

#print Nat.modEq_zero_iff_dvd /-
theorem modEq_zero_iff_dvd : a ≡ 0 [MOD n] ↔ n ∣ a := by rw [modeq, zero_mod, dvd_iff_mod_eq_zero]
#align nat.modeq_zero_iff_dvd Nat.modEq_zero_iff_dvd
-/

#print Dvd.dvd.modEq_zero_nat /-
theorem Dvd.dvd.modEq_zero_nat (h : n ∣ a) : a ≡ 0 [MOD n] :=
  modEq_zero_iff_dvd.2 h
#align has_dvd.dvd.modeq_zero_nat Dvd.dvd.modEq_zero_nat
-/

#print Dvd.dvd.zero_modEq_nat /-
theorem Dvd.dvd.zero_modEq_nat (h : n ∣ a) : 0 ≡ a [MOD n] :=
  h.modEq_zero_nat.symm
#align has_dvd.dvd.zero_modeq_nat Dvd.dvd.zero_modEq_nat
-/

/- warning: nat.modeq_iff_dvd -> Nat.modEq_iff_dvd is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {a : Nat} {b : Nat}, Iff (Nat.ModEq n a b) (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) n) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.hasSub) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) b) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) a)))
but is expected to have type
  forall {n : Nat} {a : Nat} {b : Nat}, Iff (Nat.ModEq n a b) (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt n) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.instSubInt) (Nat.cast.{0} Int instNatCastInt b) (Nat.cast.{0} Int instNatCastInt a)))
Case conversion may be inaccurate. Consider using '#align nat.modeq_iff_dvd Nat.modEq_iff_dvdₓ'. -/
theorem modEq_iff_dvd : a ≡ b [MOD n] ↔ (n : ℤ) ∣ b - a := by
  rw [modeq, eq_comm, ← Int.coe_nat_inj', Int.coe_nat_mod, Int.coe_nat_mod,
    Int.emod_eq_emod_iff_emod_sub_eq_zero, Int.dvd_iff_emod_eq_zero]
#align nat.modeq_iff_dvd Nat.modEq_iff_dvd

/- warning: nat.modeq.dvd -> Nat.ModEq.dvd is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {a : Nat} {b : Nat}, (Nat.ModEq n a b) -> (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) n) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.hasSub) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) b) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) a)))
but is expected to have type
  forall {n : Nat} {a : Nat} {b : Nat}, (Nat.ModEq n a b) -> (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt n) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.instSubInt) (Nat.cast.{0} Int instNatCastInt b) (Nat.cast.{0} Int instNatCastInt a)))
Case conversion may be inaccurate. Consider using '#align nat.modeq.dvd Nat.ModEq.dvdₓ'. -/
/- warning: nat.modeq_of_dvd -> Nat.modEq_of_dvd is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {a : Nat} {b : Nat}, (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) n) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.hasSub) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) b) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) a))) -> (Nat.ModEq n a b)
but is expected to have type
  forall {n : Nat} {a : Nat} {b : Nat}, (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt n) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.instSubInt) (Nat.cast.{0} Int instNatCastInt b) (Nat.cast.{0} Int instNatCastInt a))) -> (Nat.ModEq n a b)
Case conversion may be inaccurate. Consider using '#align nat.modeq_of_dvd Nat.modEq_of_dvdₓ'. -/
alias modeq_iff_dvd ↔ modeq.dvd modeq_of_dvd
#align nat.modeq.dvd Nat.ModEq.dvd
#align nat.modeq_of_dvd Nat.modEq_of_dvd

#print Nat.modEq_iff_dvd' /-
/-- A variant of `modeq_iff_dvd` with `nat` divisibility -/
theorem modEq_iff_dvd' (h : a ≤ b) : a ≡ b [MOD n] ↔ n ∣ b - a := by
  rw [modeq_iff_dvd, ← Int.coe_nat_dvd, Int.ofNat_sub h]
#align nat.modeq_iff_dvd' Nat.modEq_iff_dvd'
-/

#print Nat.mod_modEq /-
theorem mod_modEq (a n) : a % n ≡ a [MOD n] :=
  mod_mod _ _
#align nat.mod_modeq Nat.mod_modEq
-/

namespace Modeq

#print Nat.ModEq.of_dvd /-
protected theorem of_dvd (d : m ∣ n) (h : a ≡ b [MOD n]) : a ≡ b [MOD m] :=
  modEq_of_dvd ((Int.coe_nat_dvd.2 d).trans h.Dvd)
#align nat.modeq.of_dvd Nat.ModEq.of_dvd
-/

#print Nat.ModEq.mul_left' /-
protected theorem mul_left' (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD c * n] := by
  unfold modeq at * <;> rw [mul_mod_mul_left, mul_mod_mul_left, h]
#align nat.modeq.mul_left' Nat.ModEq.mul_left'
-/

#print Nat.ModEq.mul_left /-
protected theorem mul_left (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD n] :=
  (h.mul_left' _).of_dvd (dvd_mul_left _ _)
#align nat.modeq.mul_left Nat.ModEq.mul_left
-/

#print Nat.ModEq.mul_right' /-
protected theorem mul_right' (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD n * c] := by
  rw [mul_comm a, mul_comm b, mul_comm n] <;> exact h.mul_left' c
#align nat.modeq.mul_right' Nat.ModEq.mul_right'
-/

#print Nat.ModEq.mul_right /-
protected theorem mul_right (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD n] := by
  rw [mul_comm a, mul_comm b] <;> exact h.mul_left c
#align nat.modeq.mul_right Nat.ModEq.mul_right
-/

#print Nat.ModEq.mul /-
protected theorem mul (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a * c ≡ b * d [MOD n] :=
  (h₂.mul_left _).trans (h₁.mul_right _)
#align nat.modeq.mul Nat.ModEq.mul
-/

#print Nat.ModEq.pow /-
protected theorem pow (m : ℕ) (h : a ≡ b [MOD n]) : a ^ m ≡ b ^ m [MOD n] :=
  by
  induction' m with d hd; · rfl
  rw [pow_succ, pow_succ]
  exact h.mul hd
#align nat.modeq.pow Nat.ModEq.pow
-/

#print Nat.ModEq.add /-
protected theorem add (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a + c ≡ b + d [MOD n] :=
  by
  rw [modeq_iff_dvd, Int.ofNat_add, Int.ofNat_add, add_sub_add_comm]
  exact dvd_add h₁.dvd h₂.dvd
#align nat.modeq.add Nat.ModEq.add
-/

#print Nat.ModEq.add_left /-
protected theorem add_left (c : ℕ) (h : a ≡ b [MOD n]) : c + a ≡ c + b [MOD n] :=
  ModEq.rfl.add h
#align nat.modeq.add_left Nat.ModEq.add_left
-/

#print Nat.ModEq.add_right /-
protected theorem add_right (c : ℕ) (h : a ≡ b [MOD n]) : a + c ≡ b + c [MOD n] :=
  h.add ModEq.rfl
#align nat.modeq.add_right Nat.ModEq.add_right
-/

#print Nat.ModEq.add_left_cancel /-
protected theorem add_left_cancel (h₁ : a ≡ b [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) :
    c ≡ d [MOD n] := by
  simp only [modeq_iff_dvd, Int.ofNat_add] at *
  rw [add_sub_add_comm] at h₂
  convert _root_.dvd_sub h₂ h₁ using 1
  rw [add_sub_cancel']
#align nat.modeq.add_left_cancel Nat.ModEq.add_left_cancel
-/

#print Nat.ModEq.add_left_cancel' /-
protected theorem add_left_cancel' (c : ℕ) (h : c + a ≡ c + b [MOD n]) : a ≡ b [MOD n] :=
  ModEq.rfl.add_left_cancel h
#align nat.modeq.add_left_cancel' Nat.ModEq.add_left_cancel'
-/

#print Nat.ModEq.add_right_cancel /-
protected theorem add_right_cancel (h₁ : c ≡ d [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) :
    a ≡ b [MOD n] := by
  rw [add_comm a, add_comm b] at h₂
  exact h₁.add_left_cancel h₂
#align nat.modeq.add_right_cancel Nat.ModEq.add_right_cancel
-/

#print Nat.ModEq.add_right_cancel' /-
protected theorem add_right_cancel' (c : ℕ) (h : a + c ≡ b + c [MOD n]) : a ≡ b [MOD n] :=
  ModEq.rfl.add_right_cancel h
#align nat.modeq.add_right_cancel' Nat.ModEq.add_right_cancel'
-/

#print Nat.ModEq.mul_left_cancel' /-
/-- Cancel left multiplication on both sides of the `≡` and in the modulus.

For cancelling left multiplication in the modulus, see `nat.modeq.of_mul_left`. -/
protected theorem mul_left_cancel' {a b c m : ℕ} (hc : c ≠ 0) :
    c * a ≡ c * b [MOD c * m] → a ≡ b [MOD m] := by
  simp [modeq_iff_dvd, ← mul_sub, mul_dvd_mul_iff_left (by simp [hc] : (c : ℤ) ≠ 0)]
#align nat.modeq.mul_left_cancel' Nat.ModEq.mul_left_cancel'
-/

#print Nat.ModEq.mul_left_cancel_iff' /-
protected theorem mul_left_cancel_iff' {a b c m : ℕ} (hc : c ≠ 0) :
    c * a ≡ c * b [MOD c * m] ↔ a ≡ b [MOD m] :=
  ⟨ModEq.mul_left_cancel' hc, ModEq.mul_left' _⟩
#align nat.modeq.mul_left_cancel_iff' Nat.ModEq.mul_left_cancel_iff'
-/

#print Nat.ModEq.mul_right_cancel' /-
/-- Cancel right multiplication on both sides of the `≡` and in the modulus.

For cancelling right multiplication in the modulus, see `nat.modeq.of_mul_right`. -/
protected theorem mul_right_cancel' {a b c m : ℕ} (hc : c ≠ 0) :
    a * c ≡ b * c [MOD m * c] → a ≡ b [MOD m] := by
  simp [modeq_iff_dvd, ← sub_mul, mul_dvd_mul_iff_right (by simp [hc] : (c : ℤ) ≠ 0)]
#align nat.modeq.mul_right_cancel' Nat.ModEq.mul_right_cancel'
-/

#print Nat.ModEq.mul_right_cancel_iff' /-
protected theorem mul_right_cancel_iff' {a b c m : ℕ} (hc : c ≠ 0) :
    a * c ≡ b * c [MOD m * c] ↔ a ≡ b [MOD m] :=
  ⟨ModEq.mul_right_cancel' hc, ModEq.mul_right' _⟩
#align nat.modeq.mul_right_cancel_iff' Nat.ModEq.mul_right_cancel_iff'
-/

#print Nat.ModEq.of_mul_left /-
/-- Cancel left multiplication in the modulus.

For cancelling left multiplication on both sides of the `≡`, see `nat.modeq.mul_left_cancel'`. -/
theorem of_mul_left (m : ℕ) (h : a ≡ b [MOD m * n]) : a ≡ b [MOD n] :=
  by
  rw [modeq_iff_dvd] at *
  exact (dvd_mul_left (n : ℤ) (m : ℤ)).trans h
#align nat.modeq.of_mul_left Nat.ModEq.of_mul_left
-/

#print Nat.ModEq.of_mul_right /-
/-- Cancel right multiplication in the modulus.

For cancelling right multiplication on both sides of the `≡`, see `nat.modeq.mul_right_cancel'`. -/
theorem of_mul_right (m : ℕ) : a ≡ b [MOD n * m] → a ≡ b [MOD n] :=
  mul_comm m n ▸ of_mul_left _
#align nat.modeq.of_mul_right Nat.ModEq.of_mul_right
-/

end Modeq

#print Nat.modEq_sub /-
theorem modEq_sub (h : b ≤ a) : a ≡ b [MOD a - b] :=
  (modEq_of_dvd <| by rw [Int.ofNat_sub h]).symm
#align nat.modeq_sub Nat.modEq_sub
-/

#print Nat.modEq_one /-
theorem modEq_one : a ≡ b [MOD 1] :=
  modEq_of_dvd <| one_dvd _
#align nat.modeq_one Nat.modEq_one
-/

#print Nat.modEq_zero_iff /-
@[simp]
theorem modEq_zero_iff : a ≡ b [MOD 0] ↔ a = b := by rw [modeq, mod_zero, mod_zero]
#align nat.modeq_zero_iff Nat.modEq_zero_iff
-/

#print Nat.add_modEq_left /-
@[simp]
theorem add_modEq_left : n + a ≡ a [MOD n] := by rw [modeq, add_mod_left]
#align nat.add_modeq_left Nat.add_modEq_left
-/

#print Nat.add_modEq_right /-
@[simp]
theorem add_modEq_right : a + n ≡ a [MOD n] := by rw [modeq, add_mod_right]
#align nat.add_modeq_right Nat.add_modEq_right
-/

namespace Modeq

#print Nat.ModEq.le_of_lt_add /-
theorem le_of_lt_add (h1 : a ≡ b [MOD m]) (h2 : a < b + m) : a ≤ b :=
  (le_total a b).elim id fun h3 =>
    Nat.le_of_sub_eq_zero
      (eq_zero_of_dvd_of_lt ((modEq_iff_dvd' h3).mp h1.symm) ((tsub_lt_iff_left h3).mpr h2))
#align nat.modeq.le_of_lt_add Nat.ModEq.le_of_lt_add
-/

#print Nat.ModEq.add_le_of_lt /-
theorem add_le_of_lt (h1 : a ≡ b [MOD m]) (h2 : a < b) : a + m ≤ b :=
  le_of_lt_add (add_modEq_right.trans h1) (add_lt_add_right h2 m)
#align nat.modeq.add_le_of_lt Nat.ModEq.add_le_of_lt
-/

#print Nat.ModEq.dvd_iff /-
theorem dvd_iff (h : a ≡ b [MOD m]) (hdm : d ∣ m) : d ∣ a ↔ d ∣ b :=
  by
  simp only [← modeq_zero_iff_dvd]
  replace h := h.of_dvd hdm
  exact ⟨h.symm.trans, h.trans⟩
#align nat.modeq.dvd_iff Nat.ModEq.dvd_iff
-/

#print Nat.ModEq.gcd_eq /-
theorem gcd_eq (h : a ≡ b [MOD m]) : gcd a m = gcd b m :=
  by
  have h1 := gcd_dvd_right a m
  have h2 := gcd_dvd_right b m
  exact
    dvd_antisymm (dvd_gcd ((h.dvd_iff h1).mp (gcd_dvd_left a m)) h1)
      (dvd_gcd ((h.dvd_iff h2).mpr (gcd_dvd_left b m)) h2)
#align nat.modeq.gcd_eq Nat.ModEq.gcd_eq
-/

/- warning: nat.modeq.eq_of_abs_lt -> Nat.ModEq.eq_of_abs_lt is a dubious translation:
lean 3 declaration is
  forall {m : Nat} {a : Nat} {b : Nat}, (Nat.ModEq m a b) -> (LT.lt.{0} Int Int.hasLt (Abs.abs.{0} Int (Neg.toHasAbs.{0} Int Int.hasNeg (SemilatticeSup.toHasSup.{0} Int (Lattice.toSemilatticeSup.{0} Int (LinearOrder.toLattice.{0} Int Int.linearOrder)))) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.hasSub) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) b) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) a))) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) m)) -> (Eq.{1} Nat a b)
but is expected to have type
  forall {m : Nat} {a : Nat} {b : Nat}, (Nat.ModEq m a b) -> (LT.lt.{0} Int Int.instLTInt (Abs.abs.{0} Int (Neg.toHasAbs.{0} Int Int.instNegInt (SemilatticeSup.toSup.{0} Int (Lattice.toSemilatticeSup.{0} Int (DistribLattice.toLattice.{0} Int (instDistribLattice.{0} Int Int.instLinearOrderInt))))) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.instSubInt) (Nat.cast.{0} Int instNatCastInt b) (Nat.cast.{0} Int instNatCastInt a))) (Nat.cast.{0} Int instNatCastInt m)) -> (Eq.{1} Nat a b)
Case conversion may be inaccurate. Consider using '#align nat.modeq.eq_of_abs_lt Nat.ModEq.eq_of_abs_ltₓ'. -/
theorem eq_of_abs_lt (h : a ≡ b [MOD m]) (h2 : |(b - a : ℤ)| < m) : a = b :=
  by
  apply Int.ofNat.inj
  rw [eq_comm, ← sub_eq_zero]
  exact Int.eq_zero_of_abs_lt_dvd (modeq_iff_dvd.mp h) h2
#align nat.modeq.eq_of_abs_lt Nat.ModEq.eq_of_abs_lt

#print Nat.ModEq.eq_of_lt_of_lt /-
theorem eq_of_lt_of_lt (h : a ≡ b [MOD m]) (ha : a < m) (hb : b < m) : a = b :=
  h.eq_of_abs_lt <|
    abs_sub_lt_iff.2
      ⟨(sub_le_self _ <| Int.coe_nat_nonneg _).trans_lt <| cast_lt.2 hb,
        (sub_le_self _ <| Int.coe_nat_nonneg _).trans_lt <| cast_lt.2 ha⟩
#align nat.modeq.eq_of_lt_of_lt Nat.ModEq.eq_of_lt_of_lt
-/

#print Nat.ModEq.cancel_left_div_gcd /-
/-- To cancel a common factor `c` from a `modeq` we must divide the modulus `m` by `gcd m c` -/
theorem cancel_left_div_gcd (hm : 0 < m) (h : c * a ≡ c * b [MOD m]) : a ≡ b [MOD m / gcd m c] :=
  by
  let d := gcd m c
  have hmd := gcd_dvd_left m c
  have hcd := gcd_dvd_right m c
  rw [modeq_iff_dvd]
  refine' Int.dvd_of_dvd_mul_right_of_gcd_one _ _
  show (m / d : ℤ) ∣ c / d * (b - a)
  · rw [mul_comm, ← Int.mul_ediv_assoc (b - a) (int.coe_nat_dvd.mpr hcd), mul_comm]
    apply Int.ediv_dvd_ediv (int.coe_nat_dvd.mpr hmd)
    rw [mul_sub]
    exact modeq_iff_dvd.mp h
  show Int.gcd (m / d) (c / d) = 1
  ·
    simp only [← Int.coe_nat_div, Int.coe_nat_gcd (m / d) (c / d), gcd_div hmd hcd,
      Nat.div_self (gcd_pos_of_pos_left c hm)]
#align nat.modeq.cancel_left_div_gcd Nat.ModEq.cancel_left_div_gcd
-/

#print Nat.ModEq.cancel_right_div_gcd /-
theorem cancel_right_div_gcd (hm : 0 < m) (h : a * c ≡ b * c [MOD m]) : a ≡ b [MOD m / gcd m c] :=
  by
  apply cancel_left_div_gcd hm
  simpa [mul_comm] using h
#align nat.modeq.cancel_right_div_gcd Nat.ModEq.cancel_right_div_gcd
-/

#print Nat.ModEq.cancel_left_div_gcd' /-
theorem cancel_left_div_gcd' (hm : 0 < m) (hcd : c ≡ d [MOD m]) (h : c * a ≡ d * b [MOD m]) :
    a ≡ b [MOD m / gcd m c] :=
  (h.trans (ModEq.mul_right b hcd).symm).cancel_left_div_gcd hm
#align nat.modeq.cancel_left_div_gcd' Nat.ModEq.cancel_left_div_gcd'
-/

#print Nat.ModEq.cancel_right_div_gcd' /-
theorem cancel_right_div_gcd' (hm : 0 < m) (hcd : c ≡ d [MOD m]) (h : a * c ≡ b * d [MOD m]) :
    a ≡ b [MOD m / gcd m c] :=
  hcd.cancel_left_div_gcd' hm <| by simpa [mul_comm] using h
#align nat.modeq.cancel_right_div_gcd' Nat.ModEq.cancel_right_div_gcd'
-/

#print Nat.ModEq.cancel_left_of_coprime /-
/-- A common factor that's coprime with the modulus can be cancelled from a `modeq` -/
theorem cancel_left_of_coprime (hmc : gcd m c = 1) (h : c * a ≡ c * b [MOD m]) : a ≡ b [MOD m] :=
  by
  rcases m.eq_zero_or_pos with (rfl | hm)
  · simp only [gcd_zero_left] at hmc
    simp only [gcd_zero_left, hmc, one_mul, modeq_zero_iff] at h
    subst h
  simpa [hmc] using h.cancel_left_div_gcd hm
#align nat.modeq.cancel_left_of_coprime Nat.ModEq.cancel_left_of_coprime
-/

#print Nat.ModEq.cancel_right_of_coprime /-
/-- A common factor that's coprime with the modulus can be cancelled from a `modeq` -/
theorem cancel_right_of_coprime (hmc : gcd m c = 1) (h : a * c ≡ b * c [MOD m]) : a ≡ b [MOD m] :=
  cancel_left_of_coprime hmc <| by simpa [mul_comm] using h
#align nat.modeq.cancel_right_of_coprime Nat.ModEq.cancel_right_of_coprime
-/

end Modeq

#print Nat.chineseRemainder' /-
/-- The natural number less than `lcm n m` congruent to `a` mod `n` and `b` mod `m` -/
def chineseRemainder' (h : a ≡ b [MOD gcd n m]) : { k // k ≡ a [MOD n] ∧ k ≡ b [MOD m] } :=
  if hn : n = 0 then ⟨a, by rw [hn, gcd_zero_left] at h; constructor; rfl; exact h⟩
  else
    if hm : m = 0 then ⟨b, by rw [hm, gcd_zero_right] at h; constructor; exact h.symm; rfl⟩
    else
      ⟨let (c, d) := xgcd n m
        Int.toNat ((n * c * b + m * d * a) / gcd n m % lcm n m),
        by
        rw [xgcd_val]
        dsimp [chinese_remainder'._match_1]
        rw [modeq_iff_dvd, modeq_iff_dvd,
          Int.toNat_of_nonneg (Int.emod_nonneg _ (Int.coe_nat_ne_zero.2 (lcm_ne_zero hn hm)))]
        have hnonzero : (gcd n m : ℤ) ≠ 0 := by
          norm_cast
          rw [Nat.gcd_eq_zero_iff, not_and]
          exact fun _ => hm
        have hcoedvd : ∀ t, (gcd n m : ℤ) ∣ t * (b - a) := fun t => h.dvd.mul_left _
        have := gcd_eq_gcd_ab n m
        constructor <;> rw [Int.mod_def, ← sub_add] <;>
            refine' dvd_add _ (dvd_mul_of_dvd_left _ _) <;>
          try norm_cast
        · rw [← sub_eq_iff_eq_add'] at this
          rw [← this, sub_mul, ← add_sub_assoc, add_comm, add_sub_assoc, ← mul_sub,
            Int.add_ediv_of_dvd_left, Int.mul_ediv_cancel_left _ hnonzero,
            Int.mul_ediv_assoc _ h.dvd, ← sub_sub, sub_self, zero_sub, dvd_neg, mul_assoc]
          exact dvd_mul_right _ _
          norm_cast
          exact dvd_mul_right _ _
        · exact dvd_lcm_left n m
        · rw [← sub_eq_iff_eq_add] at this
          rw [← this, sub_mul, sub_add, ← mul_sub, Int.sub_ediv_of_dvd,
            Int.mul_ediv_cancel_left _ hnonzero, Int.mul_ediv_assoc _ h.dvd, ← sub_add, sub_self,
            zero_add, mul_assoc]
          exact dvd_mul_right _ _
          exact hcoedvd _
        · exact dvd_lcm_right n m⟩
#align nat.chinese_remainder' Nat.chineseRemainder'
-/

#print Nat.chineseRemainder /-
/-- The natural number less than `n*m` congruent to `a` mod `n` and `b` mod `m` -/
def chineseRemainder (co : coprime n m) (a b : ℕ) : { k // k ≡ a [MOD n] ∧ k ≡ b [MOD m] } :=
  chineseRemainder' (by convert modeq_one)
#align nat.chinese_remainder Nat.chineseRemainder
-/

#print Nat.chineseRemainder'_lt_lcm /-
theorem chineseRemainder'_lt_lcm (h : a ≡ b [MOD gcd n m]) (hn : n ≠ 0) (hm : m ≠ 0) :
    ↑(chineseRemainder' h) < lcm n m :=
  by
  dsimp only [chinese_remainder']
  rw [dif_neg hn, dif_neg hm, Subtype.coe_mk, xgcd_val, ← Int.toNat_coe_nat (lcm n m)]
  have lcm_pos := int.coe_nat_pos.mpr (Nat.pos_of_ne_zero (lcm_ne_zero hn hm))
  exact (Int.toNat_lt_toNat lcm_pos).mpr (Int.emod_lt_of_pos _ lcm_pos)
#align nat.chinese_remainder'_lt_lcm Nat.chineseRemainder'_lt_lcm
-/

#print Nat.chineseRemainder_lt_mul /-
theorem chineseRemainder_lt_mul (co : coprime n m) (a b : ℕ) (hn : n ≠ 0) (hm : m ≠ 0) :
    ↑(chineseRemainder co a b) < n * m :=
  lt_of_lt_of_le (chineseRemainder'_lt_lcm _ hn hm) (le_of_eq co.lcm_eq_mul)
#align nat.chinese_remainder_lt_mul Nat.chineseRemainder_lt_mul
-/

#print Nat.modEq_and_modEq_iff_modEq_mul /-
theorem modEq_and_modEq_iff_modEq_mul {a b m n : ℕ} (hmn : coprime m n) :
    a ≡ b [MOD m] ∧ a ≡ b [MOD n] ↔ a ≡ b [MOD m * n] :=
  ⟨fun h =>
    by
    rw [Nat.modEq_iff_dvd, Nat.modEq_iff_dvd, ← Int.dvd_natAbs, Int.coe_nat_dvd, ← Int.dvd_natAbs,
      Int.coe_nat_dvd] at h
    rw [Nat.modEq_iff_dvd, ← Int.dvd_natAbs, Int.coe_nat_dvd]
    exact hmn.mul_dvd_of_dvd_of_dvd h.1 h.2, fun h => ⟨h.of_mul_right _, h.of_mul_left _⟩⟩
#align nat.modeq_and_modeq_iff_modeq_mul Nat.modEq_and_modEq_iff_modEq_mul
-/

#print Nat.coprime_of_mul_modEq_one /-
theorem coprime_of_mul_modEq_one (b : ℕ) {a n : ℕ} (h : a * b ≡ 1 [MOD n]) : coprime a n :=
  by
  obtain ⟨g, hh⟩ := Nat.gcd_dvd_right a n
  rw [Nat.coprime_iff_gcd_eq_one, ← Nat.dvd_one, ← Nat.modEq_zero_iff_dvd]
  calc
    1 ≡ a * b [MOD a.gcd n] := Nat.ModEq.of_mul_right g (hh.subst h).symm
    _ ≡ 0 * b [MOD a.gcd n] := ((nat.modeq_zero_iff_dvd.mpr (Nat.gcd_dvd_left _ _)).mul_right b)
    _ = 0 := by rw [MulZeroClass.zero_mul]

#align nat.coprime_of_mul_modeq_one Nat.coprime_of_mul_modEq_one
-/

#print Nat.mod_mul_right_mod /-
@[simp]
theorem mod_mul_right_mod (a b c : ℕ) : a % (b * c) % b = a % b :=
  (mod_modEq _ _).of_mul_right _
#align nat.mod_mul_right_mod Nat.mod_mul_right_mod
-/

#print Nat.mod_mul_left_mod /-
@[simp]
theorem mod_mul_left_mod (a b c : ℕ) : a % (b * c) % c = a % c :=
  (mod_modEq _ _).of_mul_left _
#align nat.mod_mul_left_mod Nat.mod_mul_left_mod
-/

#print Nat.div_mod_eq_mod_mul_div /-
theorem div_mod_eq_mod_mul_div (a b c : ℕ) : a / b % c = a % (b * c) / b :=
  if hb0 : b = 0 then by simp [hb0]
  else by
    rw [← @add_right_cancel_iff _ _ _ (c * (a / b / c)), mod_add_div, Nat.div_div_eq_div_mul, ←
      mul_right_inj' hb0, ← @add_left_cancel_iff _ _ _ (a % b), mod_add_div, mul_add, ←
      @add_left_cancel_iff _ _ _ (a % (b * c) % b), add_left_comm, ← add_assoc (a % (b * c) % b),
      mod_add_div, ← mul_assoc, mod_add_div, mod_mul_right_mod]
#align nat.div_mod_eq_mod_mul_div Nat.div_mod_eq_mod_mul_div
-/

/- warning: nat.add_mod_add_ite -> Nat.add_mod_add_ite is a dubious translation:
lean 3 declaration is
  forall (a : Nat) (b : Nat) (c : Nat), Eq.{1} Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) a b) c) (ite.{1} Nat (LE.le.{0} Nat Nat.hasLe c (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) b c))) (Nat.decidableLe c (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) b c))) c (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) b c))
but is expected to have type
  forall (a : Nat) (b : Nat) (c : Nat), Eq.{1} Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) a b) c) (ite.{1} Nat (LE.le.{0} Nat instLENat c (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) b c))) (Nat.decLe c (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) b c))) c (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) b c))
Case conversion may be inaccurate. Consider using '#align nat.add_mod_add_ite Nat.add_mod_add_iteₓ'. -/
theorem add_mod_add_ite (a b c : ℕ) :
    ((a + b) % c + if c ≤ a % c + b % c then c else 0) = a % c + b % c :=
  have : (a + b) % c = (a % c + b % c) % c := ((mod_modEq _ _).add <| mod_modEq _ _).symm
  if hc0 : c = 0 then by simp [hc0]
  else by
    rw [this]
    split_ifs
    · have h2 : (a % c + b % c) / c < 2 :=
        Nat.div_lt_of_lt_mul
          (by
            rw [mul_two] <;>
              exact
                add_lt_add (Nat.mod_lt _ (Nat.pos_of_ne_zero hc0))
                  (Nat.mod_lt _ (Nat.pos_of_ne_zero hc0)))
      have h0 : 0 < (a % c + b % c) / c := Nat.div_pos h (Nat.pos_of_ne_zero hc0)
      rw [← @add_right_cancel_iff _ _ _ (c * ((a % c + b % c) / c)), add_comm _ c, add_assoc,
        mod_add_div, le_antisymm (le_of_lt_succ h2) h0, mul_one, add_comm]
    · rw [Nat.mod_eq_of_lt (lt_of_not_ge h), add_zero]
#align nat.add_mod_add_ite Nat.add_mod_add_ite

#print Nat.add_mod_of_add_mod_lt /-
theorem add_mod_of_add_mod_lt {a b c : ℕ} (hc : a % c + b % c < c) : (a + b) % c = a % c + b % c :=
  by rw [← add_mod_add_ite, if_neg (not_le_of_lt hc), add_zero]
#align nat.add_mod_of_add_mod_lt Nat.add_mod_of_add_mod_lt
-/

#print Nat.add_mod_add_of_le_add_mod /-
theorem add_mod_add_of_le_add_mod {a b c : ℕ} (hc : c ≤ a % c + b % c) :
    (a + b) % c + c = a % c + b % c := by rw [← add_mod_add_ite, if_pos hc]
#align nat.add_mod_add_of_le_add_mod Nat.add_mod_add_of_le_add_mod
-/

/- warning: nat.add_div -> Nat.add_div is a dubious translation:
lean 3 declaration is
  forall {a : Nat} {b : Nat} {c : Nat}, (LT.lt.{0} Nat Nat.hasLt (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) c) -> (Eq.{1} Nat (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) a b) c) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) a c) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) b c)) (ite.{1} Nat (LE.le.{0} Nat Nat.hasLe c (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) b c))) (Nat.decidableLe c (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) b c))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))))
but is expected to have type
  forall {a : Nat} {b : Nat} {c : Nat}, (LT.lt.{0} Nat instLTNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) c) -> (Eq.{1} Nat (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) a b) c) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) a c) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) b c)) (ite.{1} Nat (LE.le.{0} Nat instLENat c (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) b c))) (Nat.decLe c (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) a c) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) b c))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))))
Case conversion may be inaccurate. Consider using '#align nat.add_div Nat.add_divₓ'. -/
theorem add_div {a b c : ℕ} (hc0 : 0 < c) :
    (a + b) / c = a / c + b / c + if c ≤ a % c + b % c then 1 else 0 :=
  by
  rw [← mul_right_inj' hc0.ne', ← @add_left_cancel_iff _ _ _ ((a + b) % c + a % c + b % c)]
  suffices
    (a + b) % c + c * ((a + b) / c) + a % c + b % c =
      (a % c + c * (a / c) + (b % c + c * (b / c)) + c * if c ≤ a % c + b % c then 1 else 0) +
        (a + b) % c
    by simpa only [mul_add, add_comm, add_left_comm, add_assoc]
  rw [mod_add_div, mod_add_div, mod_add_div, mul_ite, add_assoc, add_assoc]
  conv_lhs => rw [← add_mod_add_ite]
  simp
  ac_rfl
#align nat.add_div Nat.add_div

#print Nat.add_div_eq_of_add_mod_lt /-
theorem add_div_eq_of_add_mod_lt {a b c : ℕ} (hc : a % c + b % c < c) :
    (a + b) / c = a / c + b / c :=
  if hc0 : c = 0 then by simp [hc0]
  else by rw [add_div (Nat.pos_of_ne_zero hc0), if_neg (not_le_of_lt hc), add_zero]
#align nat.add_div_eq_of_add_mod_lt Nat.add_div_eq_of_add_mod_lt
-/

#print Nat.add_div_of_dvd_right /-
protected theorem add_div_of_dvd_right {a b c : ℕ} (hca : c ∣ a) : (a + b) / c = a / c + b / c :=
  if h : c = 0 then by simp [h]
  else
    add_div_eq_of_add_mod_lt
      (by
        rw [Nat.mod_eq_zero_of_dvd hca, zero_add]
        exact Nat.mod_lt _ (pos_iff_ne_zero.mpr h))
#align nat.add_div_of_dvd_right Nat.add_div_of_dvd_right
-/

#print Nat.add_div_of_dvd_left /-
protected theorem add_div_of_dvd_left {a b c : ℕ} (hca : c ∣ b) : (a + b) / c = a / c + b / c := by
  rwa [add_comm, Nat.add_div_of_dvd_right, add_comm]
#align nat.add_div_of_dvd_left Nat.add_div_of_dvd_left
-/

#print Nat.add_div_eq_of_le_mod_add_mod /-
theorem add_div_eq_of_le_mod_add_mod {a b c : ℕ} (hc : c ≤ a % c + b % c) (hc0 : 0 < c) :
    (a + b) / c = a / c + b / c + 1 := by rw [add_div hc0, if_pos hc]
#align nat.add_div_eq_of_le_mod_add_mod Nat.add_div_eq_of_le_mod_add_mod
-/

#print Nat.add_div_le_add_div /-
theorem add_div_le_add_div (a b c : ℕ) : a / c + b / c ≤ (a + b) / c :=
  if hc0 : c = 0 then by simp [hc0]
  else by rw [Nat.add_div (Nat.pos_of_ne_zero hc0)] <;> exact Nat.le_add_right _ _
#align nat.add_div_le_add_div Nat.add_div_le_add_div
-/

#print Nat.le_mod_add_mod_of_dvd_add_of_not_dvd /-
theorem le_mod_add_mod_of_dvd_add_of_not_dvd {a b c : ℕ} (h : c ∣ a + b) (ha : ¬c ∣ a) :
    c ≤ a % c + b % c :=
  by_contradiction fun hc =>
    by
    have : (a + b) % c = a % c + b % c := add_mod_of_add_mod_lt (lt_of_not_ge hc)
    simp_all [dvd_iff_mod_eq_zero]
#align nat.le_mod_add_mod_of_dvd_add_of_not_dvd Nat.le_mod_add_mod_of_dvd_add_of_not_dvd
-/

#print Nat.odd_mul_odd /-
theorem odd_mul_odd {n m : ℕ} : n % 2 = 1 → m % 2 = 1 → n * m % 2 = 1 := by
  simpa [Nat.ModEq] using @modeq.mul 2 n 1 m 1
#align nat.odd_mul_odd Nat.odd_mul_odd
-/

#print Nat.odd_mul_odd_div_two /-
theorem odd_mul_odd_div_two {m n : ℕ} (hm1 : m % 2 = 1) (hn1 : n % 2 = 1) :
    m * n / 2 = m * (n / 2) + m / 2 :=
  have hm0 : 0 < m := Nat.pos_of_ne_zero fun h => by simp_all
  have hn0 : 0 < n := Nat.pos_of_ne_zero fun h => by simp_all
  mul_right_injective₀ two_ne_zero <| by
    rw [mul_add, two_mul_odd_div_two hm1, mul_left_comm, two_mul_odd_div_two hn1,
      two_mul_odd_div_two (Nat.odd_mul_odd hm1 hn1), mul_tsub, mul_one, ←
      add_tsub_assoc_of_le (succ_le_of_lt hm0),
      tsub_add_cancel_of_le (le_mul_of_one_le_right (Nat.zero_le _) hn0)]
#align nat.odd_mul_odd_div_two Nat.odd_mul_odd_div_two
-/

#print Nat.odd_of_mod_four_eq_one /-
theorem odd_of_mod_four_eq_one {n : ℕ} : n % 4 = 1 → n % 2 = 1 := by
  simpa [modeq, show 2 * 2 = 4 by norm_num] using @modeq.of_mul_left 2 n 1 2
#align nat.odd_of_mod_four_eq_one Nat.odd_of_mod_four_eq_one
-/

#print Nat.odd_of_mod_four_eq_three /-
theorem odd_of_mod_four_eq_three {n : ℕ} : n % 4 = 3 → n % 2 = 1 := by
  simpa [modeq, show 2 * 2 = 4 by norm_num, show 3 % 4 = 3 by norm_num] using
    @modeq.of_mul_left 2 n 3 2
#align nat.odd_of_mod_four_eq_three Nat.odd_of_mod_four_eq_three
-/

#print Nat.odd_mod_four_iff /-
/-- A natural number is odd iff it has residue `1` or `3` mod `4`-/
theorem odd_mod_four_iff {n : ℕ} : n % 2 = 1 ↔ n % 4 = 1 ∨ n % 4 = 3 :=
  have help : ∀ m : ℕ, m < 4 → m % 2 = 1 → m = 1 ∨ m = 3 := by decide
  ⟨fun hn =>
    help (n % 4) (mod_lt n (by norm_num)) <| (mod_mod_of_dvd n (by norm_num : 2 ∣ 4)).trans hn,
    fun h => Or.dcases_on h odd_of_mod_four_eq_one odd_of_mod_four_eq_three⟩
#align nat.odd_mod_four_iff Nat.odd_mod_four_iff
-/

end Nat


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import algebra.order.monoid.canonical.defs
import algebra.order.sub.defs

/-!
# Lemmas about subtraction in canonically ordered monoids

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

variables {α : Type*}

section has_exists_add_of_le
variables [add_comm_semigroup α] [partial_order α] [has_exists_add_of_le α]
  [covariant_class α α (+) (≤)] [has_sub α] [has_ordered_sub α] {a b c d : α}

@[simp] lemma add_tsub_cancel_of_le (h : a ≤ b) : a + (b - a) = b :=
begin
  refine le_antisymm _ le_add_tsub,
  obtain ⟨c, rfl⟩ := exists_add_of_le h,
  exact add_le_add_left add_tsub_le_left a,
end

lemma tsub_add_cancel_of_le (h : a ≤ b) : b - a + a = b :=
by { rw [add_comm], exact add_tsub_cancel_of_le h }

lemma add_le_of_le_tsub_right_of_le (h : b ≤ c) (h2 : a ≤ c - b) : a + b ≤ c :=
(add_le_add_right h2 b).trans_eq $ tsub_add_cancel_of_le h

lemma add_le_of_le_tsub_left_of_le (h : a ≤ c) (h2 : b ≤ c - a) : a + b ≤ c :=
(add_le_add_left h2 a).trans_eq $ add_tsub_cancel_of_le h

lemma tsub_le_tsub_iff_right (h : c ≤ b) : a - c ≤ b - c ↔ a ≤ b :=
by rw [tsub_le_iff_right, tsub_add_cancel_of_le h]

lemma tsub_left_inj (h1 : c ≤ a) (h2 : c ≤ b) : a - c = b - c ↔ a = b :=
by simp_rw [le_antisymm_iff, tsub_le_tsub_iff_right h1, tsub_le_tsub_iff_right h2]

lemma tsub_inj_left (h₁ : a ≤ b) (h₂ : a ≤ c) : b - a = c - a → b = c := (tsub_left_inj h₁ h₂).1

/-- See `lt_of_tsub_lt_tsub_right` for a stronger statement in a linear order. -/
lemma lt_of_tsub_lt_tsub_right_of_le (h : c ≤ b) (h2 : a - c < b - c) : a < b :=
by { refine ((tsub_le_tsub_iff_right h).mp h2.le).lt_of_ne _, rintro rfl, exact h2.false }

lemma tsub_add_tsub_cancel (hab : b ≤ a) (hcb : c ≤ b) : (a - b) + (b - c) = a - c :=
begin
  convert tsub_add_cancel_of_le (tsub_le_tsub_right hab c) using 2,
  rw [tsub_tsub, add_tsub_cancel_of_le hcb],
end

lemma tsub_tsub_tsub_cancel_right (h : c ≤ b) : (a - c) - (b - c) = a - b :=
by rw [tsub_tsub, add_tsub_cancel_of_le h]

/-! #### Lemmas that assume that an element is `add_le_cancellable`. -/

namespace add_le_cancellable

protected lemma eq_tsub_iff_add_eq_of_le (hc : add_le_cancellable c) (h : c ≤ b) :
  a = b - c ↔ a + c = b :=
⟨by { rintro rfl, exact tsub_add_cancel_of_le h }, hc.eq_tsub_of_add_eq⟩

protected lemma tsub_eq_iff_eq_add_of_le (hb : add_le_cancellable b) (h : b ≤ a) :
  a - b = c ↔ a = c + b :=
by rw [eq_comm, hb.eq_tsub_iff_add_eq_of_le h, eq_comm]

protected lemma add_tsub_assoc_of_le (hc : add_le_cancellable c) (h : c ≤ b) (a : α) :
  a + b - c = a + (b - c) :=
by conv_lhs { rw [← add_tsub_cancel_of_le h, add_comm c, ← add_assoc,
  hc.add_tsub_cancel_right] }

protected lemma tsub_add_eq_add_tsub (hb : add_le_cancellable b) (h : b ≤ a) :
  a - b + c = a + c - b :=
by rw [add_comm a, hb.add_tsub_assoc_of_le h, add_comm]

protected lemma tsub_tsub_assoc (hbc : add_le_cancellable (b - c)) (h₁ : b ≤ a) (h₂ : c ≤ b) :
  a - (b - c) = a - b + c :=
hbc.tsub_eq_of_eq_add $ by rw [add_assoc, add_tsub_cancel_of_le h₂, tsub_add_cancel_of_le h₁]

protected lemma tsub_add_tsub_comm (hb : add_le_cancellable b) (hd : add_le_cancellable d)
  (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) :=
by rw [hb.tsub_add_eq_add_tsub hba, ←hd.add_tsub_assoc_of_le hdc, tsub_tsub, add_comm d]

protected lemma le_tsub_iff_left (ha : add_le_cancellable a) (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c :=
⟨add_le_of_le_tsub_left_of_le h, ha.le_tsub_of_add_le_left⟩

protected lemma le_tsub_iff_right (ha : add_le_cancellable a) (h : a ≤ c) : b ≤ c - a ↔ b + a ≤ c :=
by { rw [add_comm], exact ha.le_tsub_iff_left h }

protected lemma tsub_lt_iff_left (hb : add_le_cancellable b) (hba : b ≤ a) :
  a - b < c ↔ a < b + c :=
begin
  refine ⟨hb.lt_add_of_tsub_lt_left, _⟩,
  intro h, refine (tsub_le_iff_left.mpr h.le).lt_of_ne _,
  rintro rfl, exact h.ne' (add_tsub_cancel_of_le hba)
end

protected lemma tsub_lt_iff_right (hb : add_le_cancellable b) (hba : b ≤ a) :
  a - b < c ↔ a < c + b :=
by { rw [add_comm], exact hb.tsub_lt_iff_left hba }

protected lemma tsub_lt_iff_tsub_lt (hb : add_le_cancellable b) (hc : add_le_cancellable c)
  (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b :=
by rw [hb.tsub_lt_iff_left h₁, hc.tsub_lt_iff_right h₂]

protected lemma le_tsub_iff_le_tsub (ha : add_le_cancellable a) (hc : add_le_cancellable c)
  (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a :=
by rw [ha.le_tsub_iff_left h₁, hc.le_tsub_iff_right h₂]

protected lemma lt_tsub_iff_right_of_le (hc : add_le_cancellable c) (h : c ≤ b) :
  a < b - c ↔ a + c < b :=
begin
  refine ⟨λ h', (add_le_of_le_tsub_right_of_le h h'.le).lt_of_ne _, hc.lt_tsub_of_add_lt_right⟩,
  rintro rfl,
  exact h'.ne' hc.add_tsub_cancel_right,
end

protected lemma lt_tsub_iff_left_of_le (hc : add_le_cancellable c) (h : c ≤ b) :
  a < b - c ↔ c + a < b :=
by { rw [add_comm], exact hc.lt_tsub_iff_right_of_le h }

protected lemma tsub_inj_right (hab : add_le_cancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a)
  (h₃ : a - b = a - c) : b = c :=
by { rw ← hab.inj, rw [tsub_add_cancel_of_le h₁, h₃, tsub_add_cancel_of_le h₂] }

protected lemma lt_of_tsub_lt_tsub_left_of_le [contravariant_class α α (+) (<)]
  (hb : add_le_cancellable b) (hca : c ≤ a) (h : a - b < a - c) : c < b :=
begin
  conv_lhs at h { rw [← tsub_add_cancel_of_le hca] },
  exact lt_of_add_lt_add_left (hb.lt_add_of_tsub_lt_right h),
end

protected lemma tsub_lt_tsub_left_of_le (hab : add_le_cancellable (a - b)) (h₁ : b ≤ a)
  (h : c < b) : a - b < a - c :=
(tsub_le_tsub_left h.le _).lt_of_ne $ λ h', h.ne' $ hab.tsub_inj_right h₁ (h.le.trans h₁) h'

protected lemma tsub_lt_tsub_right_of_le (hc : add_le_cancellable c) (h : c ≤ a) (h2 : a < b) :
  a - c < b - c :=
by { apply hc.lt_tsub_of_add_lt_left, rwa [add_tsub_cancel_of_le h] }

protected lemma tsub_lt_tsub_iff_left_of_le_of_le [contravariant_class α α (+) (<)]
  (hb : add_le_cancellable b) (hab : add_le_cancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a) :
  a - b < a - c ↔ c < b :=
⟨hb.lt_of_tsub_lt_tsub_left_of_le h₂, hab.tsub_lt_tsub_left_of_le h₁⟩

@[simp] protected lemma add_tsub_tsub_cancel (hac : add_le_cancellable (a - c)) (h : c ≤ a) :
  (a + b) - (a - c) = b + c :=
hac.tsub_eq_of_eq_add $ by rw [add_assoc, add_tsub_cancel_of_le h, add_comm]

protected lemma tsub_tsub_cancel_of_le (hba : add_le_cancellable (b - a)) (h : a ≤ b) :
  b - (b - a) = a :=
hba.tsub_eq_of_eq_add (add_tsub_cancel_of_le h).symm

protected lemma tsub_tsub_tsub_cancel_left (hab : add_le_cancellable (a - b)) (h : b ≤ a) :
  a - c - (a - b) = b - c :=
by rw [tsub_right_comm, hab.tsub_tsub_cancel_of_le h]

end add_le_cancellable

section contra
/-! ### Lemmas where addition is order-reflecting. -/
variable [contravariant_class α α (+) (≤)]

lemma eq_tsub_iff_add_eq_of_le (h : c ≤ b) : a = b - c ↔ a + c = b :=
contravariant.add_le_cancellable.eq_tsub_iff_add_eq_of_le h

lemma tsub_eq_iff_eq_add_of_le (h : b ≤ a) : a - b = c ↔ a = c + b :=
contravariant.add_le_cancellable.tsub_eq_iff_eq_add_of_le h

/-- See `add_tsub_le_assoc` for an inequality. -/
lemma add_tsub_assoc_of_le (h : c ≤ b) (a : α) : a + b - c = a + (b - c) :=
contravariant.add_le_cancellable.add_tsub_assoc_of_le h a

lemma tsub_add_eq_add_tsub (h : b ≤ a) : a - b + c = a + c - b :=
contravariant.add_le_cancellable.tsub_add_eq_add_tsub h

lemma tsub_tsub_assoc (h₁ : b ≤ a) (h₂ : c ≤ b) : a - (b - c) = a - b + c :=
contravariant.add_le_cancellable.tsub_tsub_assoc h₁ h₂

lemma tsub_add_tsub_comm (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) :=
contravariant.add_le_cancellable.tsub_add_tsub_comm contravariant.add_le_cancellable hba hdc

lemma le_tsub_iff_left (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c :=
contravariant.add_le_cancellable.le_tsub_iff_left h

lemma le_tsub_iff_right (h : a ≤ c) : b ≤ c - a ↔ b + a ≤ c :=
contravariant.add_le_cancellable.le_tsub_iff_right h

lemma tsub_lt_iff_left (hbc : b ≤ a) : a - b < c ↔ a < b + c :=
contravariant.add_le_cancellable.tsub_lt_iff_left hbc

lemma tsub_lt_iff_right (hbc : b ≤ a) : a - b < c ↔ a < c + b :=
contravariant.add_le_cancellable.tsub_lt_iff_right hbc

lemma tsub_lt_iff_tsub_lt (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b :=
contravariant.add_le_cancellable.tsub_lt_iff_tsub_lt contravariant.add_le_cancellable h₁ h₂

lemma le_tsub_iff_le_tsub (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a :=
contravariant.add_le_cancellable.le_tsub_iff_le_tsub contravariant.add_le_cancellable h₁ h₂

/-- See `lt_tsub_iff_right` for a stronger statement in a linear order. -/
lemma lt_tsub_iff_right_of_le (h : c ≤ b) : a < b - c ↔ a + c < b :=
contravariant.add_le_cancellable.lt_tsub_iff_right_of_le h

/-- See `lt_tsub_iff_left` for a stronger statement in a linear order. -/
lemma lt_tsub_iff_left_of_le (h : c ≤ b) : a < b - c ↔ c + a < b :=
contravariant.add_le_cancellable.lt_tsub_iff_left_of_le h

/-- See `lt_of_tsub_lt_tsub_left` for a stronger statement in a linear order. -/
lemma lt_of_tsub_lt_tsub_left_of_le  [contravariant_class α α (+) (<)]
  (hca : c ≤ a) (h : a - b < a - c) : c < b :=
contravariant.add_le_cancellable.lt_of_tsub_lt_tsub_left_of_le hca h

lemma tsub_lt_tsub_left_of_le : b ≤ a → c < b → a - b < a - c :=
contravariant.add_le_cancellable.tsub_lt_tsub_left_of_le

lemma tsub_lt_tsub_right_of_le (h : c ≤ a) (h2 : a < b) : a - c < b - c :=
contravariant.add_le_cancellable.tsub_lt_tsub_right_of_le h h2

lemma tsub_inj_right (h₁ : b ≤ a) (h₂ : c ≤ a) (h₃ : a - b = a - c) : b = c :=
contravariant.add_le_cancellable.tsub_inj_right h₁ h₂ h₃

/-- See `tsub_lt_tsub_iff_left_of_le` for a stronger statement in a linear order. -/
lemma tsub_lt_tsub_iff_left_of_le_of_le  [contravariant_class α α (+) (<)]
  (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < a - c ↔ c < b :=
contravariant.add_le_cancellable.tsub_lt_tsub_iff_left_of_le_of_le
  contravariant.add_le_cancellable h₁ h₂

@[simp] lemma add_tsub_tsub_cancel (h : c ≤ a) : (a + b) - (a - c) = b + c :=
contravariant.add_le_cancellable.add_tsub_tsub_cancel h

/-- See `tsub_tsub_le` for an inequality. -/
lemma tsub_tsub_cancel_of_le (h : a ≤ b) : b - (b - a) = a :=
contravariant.add_le_cancellable.tsub_tsub_cancel_of_le h

lemma tsub_tsub_tsub_cancel_left (h : b ≤ a) : a - c - (a - b) = b - c :=
contravariant.add_le_cancellable.tsub_tsub_tsub_cancel_left h

end contra
end has_exists_add_of_le

/-! ### Lemmas in a canonically ordered monoid. -/

section canonically_ordered_add_monoid
variables [canonically_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] {a b c d : α}

lemma add_tsub_cancel_iff_le : a + (b - a) = b ↔ a ≤ b :=
⟨λ h, le_iff_exists_add.mpr ⟨b - a, h.symm⟩, add_tsub_cancel_of_le⟩

lemma tsub_add_cancel_iff_le : b - a + a = b ↔ a ≤ b :=
by { rw [add_comm], exact add_tsub_cancel_iff_le }

@[simp] lemma tsub_eq_zero_iff_le : a - b = 0 ↔ a ≤ b :=
by rw [← nonpos_iff_eq_zero, tsub_le_iff_left, add_zero]

alias tsub_eq_zero_iff_le ↔ _ tsub_eq_zero_of_le

attribute [simp] tsub_eq_zero_of_le

@[simp] lemma tsub_self (a : α) : a - a = 0 := tsub_eq_zero_of_le le_rfl

@[simp] lemma tsub_le_self : a - b ≤ a := tsub_le_iff_left.mpr $ le_add_left le_rfl

@[simp] lemma zero_tsub (a : α) : 0 - a = 0 := tsub_eq_zero_of_le $ zero_le a

lemma tsub_self_add (a b : α) : a - (a + b) = 0 := tsub_eq_zero_of_le $ self_le_add_right _ _

lemma tsub_pos_iff_not_le : 0 < a - b ↔ ¬ a ≤ b :=
by rw [pos_iff_ne_zero, ne.def, tsub_eq_zero_iff_le]

lemma tsub_pos_of_lt (h : a < b) : 0 < b - a := tsub_pos_iff_not_le.mpr h.not_le

lemma tsub_lt_of_lt (h : a < b) : a - c < b := lt_of_le_of_lt tsub_le_self h

namespace add_le_cancellable

protected lemma tsub_le_tsub_iff_left (ha : add_le_cancellable a) (hc : add_le_cancellable c)
  (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b :=
begin
  refine ⟨_, λ h, tsub_le_tsub_left h a⟩,
  rw [tsub_le_iff_left, ← hc.add_tsub_assoc_of_le h, hc.le_tsub_iff_right (h.trans le_add_self),
    add_comm b],
  apply ha,
end

protected lemma tsub_right_inj (ha : add_le_cancellable a) (hb : add_le_cancellable b)
  (hc : add_le_cancellable c) (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c :=
by simp_rw [le_antisymm_iff, ha.tsub_le_tsub_iff_left hb hba, ha.tsub_le_tsub_iff_left hc hca,
  and_comm]

end add_le_cancellable

/-! #### Lemmas where addition is order-reflecting. -/

section contra
variable [contravariant_class α α (+) (≤)]

lemma tsub_le_tsub_iff_left (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b :=
contravariant.add_le_cancellable.tsub_le_tsub_iff_left contravariant.add_le_cancellable h

lemma tsub_right_inj (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c :=
contravariant.add_le_cancellable.tsub_right_inj contravariant.add_le_cancellable
  contravariant.add_le_cancellable hba hca

variables (α)

/-- A `canonically_ordered_add_monoid` with ordered subtraction and order-reflecting addition is
cancellative. This is not an instance at it would form a typeclass loop.

See note [reducible non-instances]. -/
@[reducible]
def canonically_ordered_add_monoid.to_add_cancel_comm_monoid : add_cancel_comm_monoid α :=
{ add_left_cancel := λ a b c h, by simpa only [add_tsub_cancel_left] using congr_arg (λ x, x - a) h,
  ..(by apply_instance : add_comm_monoid α) }

end contra

end canonically_ordered_add_monoid

/-! ### Lemmas in a linearly canonically ordered monoid. -/

section canonically_linear_ordered_add_monoid
variables [canonically_linear_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] {a b c d : α}

@[simp] lemma tsub_pos_iff_lt : 0 < a - b ↔ b < a :=
by rw [tsub_pos_iff_not_le, not_le]

lemma tsub_eq_tsub_min (a b : α) : a - b = a - min a b :=
begin
  cases le_total a b with h h,
  { rw [min_eq_left h, tsub_self, tsub_eq_zero_of_le h] },
  { rw [min_eq_right h] },
end

namespace add_le_cancellable

protected lemma lt_tsub_iff_right (hc : add_le_cancellable c) : a < b - c ↔ a + c < b :=
⟨lt_imp_lt_of_le_imp_le tsub_le_iff_right.mpr, hc.lt_tsub_of_add_lt_right⟩

protected lemma lt_tsub_iff_left (hc : add_le_cancellable c) : a < b - c ↔ c + a < b :=
⟨lt_imp_lt_of_le_imp_le tsub_le_iff_left.mpr, hc.lt_tsub_of_add_lt_left⟩

protected lemma tsub_lt_tsub_iff_right (hc : add_le_cancellable c) (h : c ≤ a) :
  a - c < b - c ↔ a < b :=
by rw [hc.lt_tsub_iff_left, add_tsub_cancel_of_le h]

protected lemma tsub_lt_self (ha : add_le_cancellable a) (h₁ : 0 < a) (h₂ : 0 < b) : a - b < a :=
begin
  refine tsub_le_self.lt_of_ne (λ h, _),
  rw [← h, tsub_pos_iff_lt] at h₁,
  exact h₂.not_le (ha.add_le_iff_nonpos_left.1 $ add_le_of_le_tsub_left_of_le h₁.le h.ge),
end

protected lemma tsub_lt_self_iff (ha : add_le_cancellable a) : a - b < a ↔ 0 < a ∧ 0 < b :=
begin
  refine ⟨λ h, ⟨(zero_le _).trans_lt h, (zero_le b).lt_of_ne _⟩, λ h, ha.tsub_lt_self h.1 h.2⟩,
  rintro rfl,
  rw [tsub_zero] at h,
  exact h.false
end

/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/
protected lemma tsub_lt_tsub_iff_left_of_le (ha : add_le_cancellable a) (hb : add_le_cancellable b)
  (h : b ≤ a) : a - b < a - c ↔ c < b :=
lt_iff_lt_of_le_iff_le $ ha.tsub_le_tsub_iff_left hb h

end add_le_cancellable

section contra
variable [contravariant_class α α (+) (≤)]

/-- This lemma also holds for `ennreal`, but we need a different proof for that. -/
lemma tsub_lt_tsub_iff_right (h : c ≤ a) : a - c < b - c ↔ a < b :=
contravariant.add_le_cancellable.tsub_lt_tsub_iff_right h

lemma tsub_lt_self : 0 < a → 0 < b → a - b < a := contravariant.add_le_cancellable.tsub_lt_self

lemma tsub_lt_self_iff : a - b < a ↔ 0 < a ∧ 0 < b :=
contravariant.add_le_cancellable.tsub_lt_self_iff

/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/
lemma tsub_lt_tsub_iff_left_of_le (h : b ≤ a) : a - b < a - c ↔ c < b :=
contravariant.add_le_cancellable.tsub_lt_tsub_iff_left_of_le contravariant.add_le_cancellable h

end contra

/-! ### Lemmas about `max` and `min`. -/

lemma tsub_add_eq_max : a - b + b = max a b :=
begin
  cases le_total a b with h h,
  { rw [max_eq_right h, tsub_eq_zero_of_le h, zero_add] },
  { rw [max_eq_left h, tsub_add_cancel_of_le h] }
end

lemma add_tsub_eq_max : a + (b - a) = max a b :=
by rw [add_comm, max_comm, tsub_add_eq_max]

lemma tsub_min : a - min a b = a - b :=
begin
  cases le_total a b with h h,
  { rw [min_eq_left h, tsub_self, tsub_eq_zero_of_le h] },
  { rw [min_eq_right h] }
end

lemma tsub_add_min : a - b + min a b = a :=
by { rw [← tsub_min, tsub_add_cancel_of_le], apply min_le_left }

end canonically_linear_ordered_add_monoid


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.order.basic
import topology.algebra.group.basic

/-!
# Topology on a linear ordered additive commutative group

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

In this file we prove that a linear ordered additive commutative group with order topology is a
topological group. We also prove continuity of `abs : G → G` and provide convenience lemmas like
`continuous_at.abs`.
-/

open set filter
open_locale topology filter

variables {α G : Type*} [topological_space G] [linear_ordered_add_comm_group G] [order_topology G]
variables {l : filter α} {f g : α → G}

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_add_comm_group.topological_add_group : topological_add_group G :=
{ continuous_add :=
    begin
      refine continuous_iff_continuous_at.2 _,
      rintro ⟨a, b⟩,
      refine linear_ordered_add_comm_group.tendsto_nhds.2 (λ ε ε0, _),
      rcases dense_or_discrete 0 ε with (⟨δ, δ0, δε⟩|⟨h₁, h₂⟩),
      { -- If there exists `δ ∈ (0, ε)`, then we choose `δ`-nhd of `a` and `(ε-δ)`-nhd of `b`
        filter_upwards [(eventually_abs_sub_lt a δ0).prod_nhds
          (eventually_abs_sub_lt b (sub_pos.2 δε))],
        rintros ⟨x, y⟩ ⟨hx : |x - a| < δ, hy : |y - b| < ε - δ⟩,
        rw [add_sub_add_comm],
        calc |x - a + (y - b)| ≤ |x - a| + |y - b| : abs_add _ _
        ... < δ + (ε - δ) : add_lt_add hx hy
        ... = ε : add_sub_cancel'_right _ _ },
      { -- Otherwise `ε`-nhd of each point `a` is `{a}`
        have hε : ∀ {x y}, |x - y| < ε → x = y,
        { intros x y h,
          simpa [sub_eq_zero] using h₂ _ h },
        filter_upwards [(eventually_abs_sub_lt a ε0).prod_nhds (eventually_abs_sub_lt b ε0)],
        rintros ⟨x, y⟩ ⟨hx : |x - a| < ε, hy : |y - b| < ε⟩,
        simpa [hε hx, hε hy] }
    end,
  continuous_neg := continuous_iff_continuous_at.2 $ λ a,
    linear_ordered_add_comm_group.tendsto_nhds.2 $ λ ε ε0,
      (eventually_abs_sub_lt a ε0).mono $ λ x hx, by rwa [neg_sub_neg, abs_sub_comm] }

@[continuity]
lemma continuous_abs : continuous (abs : G → G) := continuous_id.max continuous_neg

protected lemma filter.tendsto.abs {a : G} (h : tendsto f l (𝓝 a)) :
  tendsto (λ x, |f x|) l (𝓝 (|a|)) :=
(continuous_abs.tendsto _).comp h

lemma tendsto_zero_iff_abs_tendsto_zero (f : α → G) :
  tendsto f l (𝓝 0) ↔ tendsto (abs ∘ f) l (𝓝 0) :=
begin
  refine ⟨λ h, (abs_zero : |(0 : G)| = 0) ▸ h.abs, λ h, _⟩,
  have : tendsto (λ a, -|f a|) l (𝓝 0) := (neg_zero : -(0 : G) = 0) ▸ h.neg,
  exact tendsto_of_tendsto_of_tendsto_of_le_of_le this h
    (λ x, neg_abs_le_self $ f x) (λ x, le_abs_self $ f x),
end

variables [topological_space α] {a : α} {s : set α}

protected lemma continuous.abs (h : continuous f) : continuous (λ x, |f x|) := continuous_abs.comp h

protected lemma continuous_at.abs (h : continuous_at f a) : continuous_at (λ x, |f x|) a := h.abs

protected lemma continuous_within_at.abs (h : continuous_within_at f s a) :
  continuous_within_at (λ x, |f x|) s a := h.abs

protected lemma continuous_on.abs (h : continuous_on f s) : continuous_on (λ x, |f x|) s :=
λ x hx, (h x hx).abs

lemma tendsto_abs_nhds_within_zero : tendsto (abs : G → G) (𝓝[≠] 0) (𝓝[>] 0) :=
(continuous_abs.tendsto' (0 : G) 0 abs_zero).inf $ tendsto_principal_principal.2 $ λ x, abs_pos.2


import tactic.structure_helper
import tactic.nat_num_game
/-

  mynat/definition.lean -- definition of mynat.

  Supplies:
  constants zero : mynat and one : mynat
  function S : mynat → mynat
  notation 0 for zero and 1 for one.

The below code will be *invisible to the player*
-/

-- definition of "the natural numbers"
@[derive decidable_eq]
inductive mynat
| zero : mynat
| succ (n : mynat) : mynat

namespace mynat

instance : has_zero mynat := ⟨mynat.zero⟩
@[leakage] theorem mynat_zero_eq_zero : mynat.zero = 0 := rfl

def one : mynat := succ 0

instance : has_one mynat := ⟨mynat.one⟩

theorem one_eq_succ_zero : 1 = succ 0 := rfl

lemma zero_ne_succ (m : mynat) : (0 : mynat) ≠ succ m := λ h, by cases h

lemma succ_inj {m n : mynat} (h : succ m = succ n) : m = n := by cases h; refl

end mynat

attribute [symm] ne.symm


import data.nat.basic
--import data.nat.fib
import data.nat.modeq
open nat

lemma lemma_1_92
  (fib:ℕ→ℕ)
  (fib_add_two: ∀ {n:ℕ}, fib (n+2)=fib(n)+fib(n+1) )
  (t p s : ℕ)
  (h : fib (t+1) ≡ 0 [MOD p]) :
  2*s ≤ t → (fib (t+1+2*s) + fib(t+1-2*s) ≡ 0 [MOD p]) ∧ fib (t + 2+2*s) ≡ fib (t  - 2*s) [MOD p] :=
  nat.rec_on s (λ hs,
    and.intro
    ( -- Base case
      calc  fib (t+1) + fib (t+1)
          ≡ 0 +         fib (t+1) [MOD p]: nat.modeq.add_right (fib (t+1)) h
      ... = fib (t+1)                    : by ring_nf
      ... ≡ 0                     [MOD p]: h
    ) (
      calc fib (t+2) = fib t + fib (t+1)       : fib_add_two
                ... ≡ fib t + 0         [MOD p]: nat.modeq.add_left (fib t) h
                ... = fib t                    : by ring_nf
    )
  ) (λ s, λ h_ind, λ hs, -- Inductive step

      have hsk: ∀ k:ℕ, k ≤ 2 → k+2*s ≤ t, from λ k, λ hk,
      calc k+2*s ≤ 2+2*s: add_le_add_right hk (2*s)
             ... = 2*succ s: by ring
             ... ≤ t: hs,
      have hs2: 2+2*s ≤ t, from hsk 2 (le_refl 2),
      have hs1: 1+2*s ≤ t, from hsk 1 (one_le_two),
      have hs0: 2*s ≤ t, from
        calc  2*s = 0+2*s: (zero_add (2*s)).symm
              ... ≤ t: hsk 0 (zero_le_two),

      have ht2: 2 ≤ t-2*s, from (le_tsub_iff_right hs0).mpr hs2,
      have hs1: 1≤ t-2*s, from (le_tsub_iff_right hs0).mpr hs1,

      have help1: t-2*s-1=t+1-2*succ s, from calc
                t-2*s-1 = t-2*s+1-2   : by ring
                    ... = t-2*s-2+1   : by rw (tsub_add_eq_add_tsub ht2)
                    ... = t-2*(s+1)+1 : by ring
                    ... = t+1-2*(s+1) : by rw tsub_add_eq_add_tsub hs,

      have help2: t + 1 - 2 * succ s = t - 2 * s - 1, from calc
                  t + 1 - 2 * succ s = t + 1 - 2 * s - 2: rfl
                                  ...= t - 2 * s + 1 - 2: by rw (tsub_add_eq_add_tsub hs0)
                                  ...= t - 2 * s - 1    : by ring,
      have help3: t - 2 * s - 1 + 2 = t + 1 - 2 * s, from calc
                  t - 2 * s - 1 + 2 = t - 2 * s + 2 - 1 : by rw tsub_add_eq_add_tsub hs1
                               ...  = t - 2 * s + 1     : by ring
                               ...  = t + 1 - 2 * s     : by rw tsub_add_eq_add_tsub hs0,
      have H1_help: fib (t + 1 + 2 * succ s) = fib (t + 2 + 2 * s) + fib (t + 1 + 2 * s), from calc
              fib (t + 1 + 2 * succ s)
            = fib (t + 1 + 2 * (s + 1))                     : by ring
        ... = fib (t + 1 + 2 * s + 2)                       : by ring_nf
        ... = fib (t + 1 + 2 * s) + fib (t + 1 + 2 * s+1)   : by rw fib_add_two
        ... = fib (t + 2 + 2 * s) + (fib (t + 1 + 2 * s)  ) : by ring_nf,

      have H1:fib (t + 1 + 2 * succ s)               + fib (t + 1 - 2 * succ s)≡ 0 [MOD p], from calc
          fib (t + 1 + 2 * succ s)                   + fib (t + 1 - 2 * succ s)
        = fib (t + 2 + 2 * s) + fib (t + 1 + 2 * s)  + fib (t + 1 - 2 * succ s) : by rw H1_help ...
        = fib (t + 2 + 2 * s) + (fib (t + 1 + 2 * s) + fib (t + 1 - 2 * succ s)) : by ring ...
        ≡ fib (t - 2 * s)     + (fib (t + 1 + 2 * s) + fib (t + 1 - 2 * succ s)) [MOD p]: nat.modeq.add_right _ (h_ind hs0).2
        ...
        = fib (t + 1 + 2 * s) + fib (t + 1 - 2 * succ s) + fib (t - 2 * s)           : by ring_nf ...
        = fib (t + 1 + 2 * s) + fib (t + 1 - 2 * succ s) + fib (t - 2 * s + 1 - 1)   : by ring_nf ...
        = fib (t + 1 + 2 * s) + fib (t + 1 - 2 * succ s) + fib (t - 2 * s - 1 + 1)   : by rw (tsub_add_eq_add_tsub hs1).symm
        ...
        = fib (t + 1 + 2 * s) + (fib (t + 1 - 2 * succ s) + fib (t - 2 * s - 1 + 1)) : by ring_nf

        ... = fib (t + 1 + 2 * s) + (fib (t - 2 * s - 1)  + fib (t - 2 * s - 1 + 1)) :by {rw help2}
        ... = fib (t + 1 + 2 * s) + fib (t - 2 * s - 1 + 2)                          : by rw fib_add_two
        ... = fib (t + 1 + 2 * s) + fib (t + 1 - 2 * s)                              :by rw help3
        ... ≡ 0 [MOD p]: (h_ind hs0).1,

    have H2: fib (t + 2 + 2 * succ s)≡ fib (t - 2 * succ s) [MOD p], from
      have  fib (t+2+2*succ s) +fib (t-2*s-1) ≡ fib(t-2*succ s)+fib (t-2*s-1) [MOD p], from calc
            fib (t+2+2*succ s) +fib (t-2*s-1)
          = fib (t+2*succ s+2) +fib (t-2*s-1) : by ring_nf
      ... = fib (t+2*succ s)   +fib(t+2*succ s+1)+fib (t-2*s-1)              : by rw fib_add_two
      ... = fib (t+2*(s+1))    +(fib (t-2*s-1)+fib(t+2*succ s+1)) : by ring
      ... = fib (t+2+2* s)     +(fib (t-2*s-1)+fib(t+2*succ s+1))  : by ring_nf
      ... ≡ fib (t-2* s)       +(fib (t-2*s-1)     +fib(t+2*succ s+1)) [MOD p]: nat.modeq.add_right _ (h_ind hs0).2
      ... = fib (t-2* s)       +(fib (t+1-2*succ s)+fib(t+2*succ s+1)) : by rw help1
      ... = fib (t-2* s)       +(fib (t+1+2*succ s)+fib(t+1-2*succ s)) : by ring_nf
      ... ≡ fib (t-2* s)       + 0        [MOD p]: nat.modeq.add_left _ H1
      ... = fib (t-2* s+2-2)                   : by ring_nf
      ... = fib (t-2*s-2+2)                    : by rw (tsub_add_eq_add_tsub ht2)
      ... = fib (t-2*s-2)    + fib (t-2*s-2+1) : by rw fib_add_two
      ... = fib (t-2*s-2)    + fib (t-2*s+1-2) : by rw tsub_add_eq_add_tsub ht2
      ... = fib (t-2*s-2)    + fib (t-2*s-1)   : by ring
      ... = fib (t-(2*s+2))  + fib (t-2*s-1)   : rfl
      ... = fib (t-2*(s+1))  + fib (t-2*s-1)   : by ring_nf
      ... = fib (t-2*succ s) + fib (t-2*s-1)   : by ring,
      calc fib (t + 2 + 2 * succ s)
      ≡ fib (t - 2 * succ s) [MOD p]: modeq.add_right_cancel' (fib (t - 2 * s - 1)) this,
  and.intro H1 H2
  )


import game.max.level01 -- hide

open_locale classical -- hide

noncomputable theory -- hide

namespace xena -- hide

/-
# Chapter ? : Max and abs

## Level 2

`max_comm` is the statement that `max a b = max b a`. See if you can prove it.
-/

/- Hint : Hint
Again, do a case split with `cases le_total a b`.
-/

/- Lemma
For any real numbers $a$ and $b$, we have $\max(a,b) = \max(b,a).$
-/
theorem max_comm (a b : ℝ) : max a b = max b a :=
begin
  cases le_total a b with hab hba,
  { rw max_eq_right hab,
    rw max_eq_left hab,
  },
  { rw max_eq_left hba,
    rw max_eq_right hba
  }

end

end xena --hide


/-
Copyright (c) 2021 Jordan Brown, Thomas Browning, Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jordan Brown, Thomas Browning, Patrick Lutz
-/

import data.fin.vec_notation
import group_theory.abelianization
import set_theory.cardinal
import group_theory.general_commutator

/-!
# Solvable Groups

In this file we introduce the notion of a solvable group. We define a solvable group as one whose
derived series is eventually trivial. This requires defining the commutator of two subgroups and
the derived series of a group.

## Main definitions

* `derived_series G n` : the `n`th term in the derived series of `G`, defined by iterating
    `general_commutator` starting with the top subgroup
* `is_solvable G` : the group `G` is solvable
-/

open subgroup

variables {G G' : Type*} [group G] [group G'] {f : G →* G'}

section derived_series

variables (G)

/-- The derived series of the group `G`, obtained by starting from the subgroup `⊤` and repeatedly
  taking the commutator of the previous subgroup with itself for `n` times. -/
def derived_series : ℕ → subgroup G
| 0       := ⊤
| (n + 1) := ⁅(derived_series n), (derived_series n)⁆

@[simp] lemma derived_series_zero : derived_series G 0 = ⊤ := rfl

@[simp] lemma derived_series_succ (n : ℕ) :
  derived_series G (n + 1) = ⁅(derived_series G n), (derived_series G n)⁆ := rfl

lemma derived_series_normal (n : ℕ) : (derived_series G n).normal :=
begin
  induction n with n ih,
  { exact (⊤ : subgroup G).normal_of_characteristic },
  { exactI general_commutator_normal (derived_series G n) (derived_series G n) }
end

@[simp] lemma general_commutator_eq_commutator :
  ⁅(⊤ : subgroup G), (⊤ : subgroup G)⁆ = commutator G :=
begin
  rw [commutator, general_commutator_def'],
  apply le_antisymm; apply normal_closure_mono,
  { exact λ x ⟨p, _, q, _, h⟩, ⟨p, q, h⟩, },
  { exact λ x ⟨p, q, h⟩, ⟨p, mem_top p, q, mem_top q, h⟩, }
end

lemma commutator_def' : commutator G = subgroup.closure {x : G | ∃ p q, p * q * p⁻¹ * q⁻¹ = x} :=
begin
  rw [← general_commutator_eq_commutator, general_commutator],
  apply le_antisymm; apply closure_mono,
  { exact λ x ⟨p, _, q, _, h⟩, ⟨p, q, h⟩ },
  { exact λ x ⟨p, q, h⟩, ⟨p, mem_top p, q, mem_top q, h⟩ }
end

@[simp] lemma derived_series_one : derived_series G 1 = commutator G :=
general_commutator_eq_commutator G

end derived_series

section commutator_map

lemma map_commutator_eq_commutator_map (H₁ H₂ : subgroup G) :
  ⁅H₁, H₂⁆.map f = ⁅H₁.map f, H₂.map f⁆ :=
begin
  rw [general_commutator, general_commutator, monoid_hom.map_closure],
  apply le_antisymm; apply closure_mono,
  { rintros _ ⟨x, ⟨p, hp, q, hq, rfl⟩, rfl⟩,
    refine ⟨f p, mem_map.mpr ⟨p, hp, rfl⟩, f q, mem_map.mpr ⟨q, hq, rfl⟩, by simp *⟩, },
  { rintros x ⟨_, ⟨p, hp, rfl⟩, _, ⟨q, hq, rfl⟩, rfl⟩,
    refine ⟨p * q * p⁻¹ * q⁻¹, ⟨p, hp, q, hq, rfl⟩, by simp *⟩, },
end

lemma commutator_le_map_commutator {H₁ H₂ : subgroup G} {K₁ K₂ : subgroup G'} (h₁ : K₁ ≤ H₁.map f)
  (h₂ : K₂ ≤ H₂.map f) : ⁅K₁, K₂⁆ ≤ ⁅H₁, H₂⁆.map f :=
by { rw map_commutator_eq_commutator_map, exact general_commutator_mono h₁ h₂ }

section derived_series_map

variables (f)

lemma map_derived_series_le_derived_series (n : ℕ) :
  (derived_series G n).map f ≤ derived_series G' n :=
begin
  induction n with n ih,
  { simp only [derived_series_zero, le_top], },
  { simp only [derived_series_succ, map_commutator_eq_commutator_map, general_commutator_mono, *], }
end

variables {f}

lemma derived_series_le_map_derived_series (hf : function.surjective f) (n : ℕ) :
  derived_series G' n ≤ (derived_series G n).map f :=
begin
  induction n with n ih,
  { rwa [derived_series_zero, derived_series_zero, top_le_iff, ← monoid_hom.range_eq_map,
    ← monoid_hom.range_top_iff_surjective.mpr], },
  { simp only [*, derived_series_succ, commutator_le_map_commutator], }
end

lemma map_derived_series_eq (hf : function.surjective f) (n : ℕ) :
  (derived_series G n).map f = derived_series G' n :=
le_antisymm (map_derived_series_le_derived_series f n) (derived_series_le_map_derived_series hf n)

end derived_series_map
end commutator_map

section solvable

variables (G)

/-- A group `G` is solvable if its derived series is eventually trivial. We use this definition
  because it's the most convenient one to work with. -/
class is_solvable : Prop :=
(solvable : ∃ n : ℕ, derived_series G n = ⊥)

lemma is_solvable_def : is_solvable G ↔ ∃ n : ℕ, derived_series G n = ⊥ :=
⟨λ h, h.solvable, λ h, ⟨h⟩⟩

@[priority 100]
instance comm_group.is_solvable {G : Type*} [comm_group G] : is_solvable G :=
begin
  use 1,
  rw [eq_bot_iff, derived_series_one],
  calc commutator G ≤ (monoid_hom.id G).ker : abelianization.commutator_subset_ker (monoid_hom.id G)
  ... = ⊥ : rfl,
end

lemma is_solvable_of_comm {G : Type*} [hG : group G]
  (h : ∀ a b : G, a * b = b * a) : is_solvable G :=
begin
  letI hG' : comm_group G := { mul_comm := h .. hG },
  tactic.unfreeze_local_instances,
  cases hG,
  exact comm_group.is_solvable,
end

lemma is_solvable_of_top_eq_bot (h : (⊤ : subgroup G) = ⊥) : is_solvable G :=
⟨⟨0, h⟩⟩

@[priority 100]
instance is_solvable_of_subsingleton [subsingleton G] : is_solvable G :=
is_solvable_of_top_eq_bot G (by ext; simp at *)

variables {G}

lemma solvable_of_solvable_injective (hf : function.injective f) [h : is_solvable G'] :
  is_solvable G :=
begin
  rw is_solvable_def at *,
  cases h with n hn,
  use n,
  rw ← map_eq_bot_iff_of_injective _ hf,
  rw eq_bot_iff at *,
  calc map f (derived_series G n) ≤ derived_series G' n : map_derived_series_le_derived_series f n
  ... ≤ ⊥ : hn,
end

instance subgroup_solvable_of_solvable (H : subgroup G) [h : is_solvable G] : is_solvable H :=
solvable_of_solvable_injective (show function.injective (subtype H), from subtype.val_injective)

lemma solvable_of_surjective (hf : function.surjective f) [h : is_solvable G] :
  is_solvable G' :=
begin
  rw is_solvable_def at *,
  cases h with n hn,
  use n,
  calc derived_series G' n = (derived_series G n).map f : eq.symm (map_derived_series_eq hf n)
    ... = (⊥ : subgroup G).map f : by rw hn
    ... = ⊥ : map_bot f,
end

instance solvable_quotient_of_solvable (H : subgroup G) [H.normal] [h : is_solvable G] :
  is_solvable (G ⧸ H) :=
solvable_of_surjective (show function.surjective (quotient_group.mk' H), by tidy)

lemma solvable_of_ker_le_range {G' G'' : Type*} [group G'] [group G''] (f : G' →* G)
  (g : G →* G'') (hfg : g.ker ≤ f.range) [hG' : is_solvable G'] [hG'' : is_solvable G''] :
  is_solvable G :=
begin
  tactic.unfreeze_local_instances,
  obtain ⟨n, hn⟩ := hG'',
  suffices : ∀ k : ℕ, derived_series G (n + k) ≤ (derived_series G' k).map f,
  { obtain ⟨m, hm⟩ := hG',
    use n + m,
    specialize this m,
    rwa [hm, map_bot, le_bot_iff] at this },
  intro k,
  induction k with k hk,
  { rw [add_zero, derived_series_zero, ←monoid_hom.range_eq_map],
    refine le_trans _ hfg,
    rw [←map_eq_bot_iff, eq_bot_iff, ←hn],
    exact map_derived_series_le_derived_series g n },
  { rw [nat.add_succ, derived_series_succ, derived_series_succ],
    exact commutator_le_map_commutator hk hk },
end

instance solvable_prod {G' : Type*} [group G'] [h : is_solvable G] [h' : is_solvable G'] :
  is_solvable (G × G') :=
solvable_of_ker_le_range (monoid_hom.inl G G') (monoid_hom.snd G G')
  (λ x hx, ⟨x.1, prod.ext rfl hx.symm⟩)

end solvable

section is_simple_group

variable [is_simple_group G]

lemma is_simple_group.derived_series_succ {n : ℕ} : derived_series G n.succ = commutator G :=
begin
  induction n with n ih,
  { exact derived_series_one _ },
  rw [derived_series_succ, ih],
  cases (commutator.normal G).eq_bot_or_eq_top with h h; simp [h]
end

lemma is_simple_group.comm_iff_is_solvable :
  (∀ a b : G, a * b = b * a) ↔ is_solvable G :=
⟨is_solvable_of_comm, λ ⟨⟨n, hn⟩⟩, begin
  cases n,
  { rw derived_series_zero at hn,
    intros a b,
    refine (mem_bot.1 _).trans (mem_bot.1 _).symm;
    { rw ← hn,
      exact mem_top _ } },
  { rw is_simple_group.derived_series_succ at hn,
    intros a b,
    rw [← mul_inv_eq_one, mul_inv_rev, ← mul_assoc, ← mem_bot, ← hn],
    exact subset_normal_closure ⟨a, b, rfl⟩ }
end⟩

end is_simple_group

section perm_not_solvable

lemma not_solvable_of_mem_derived_series {g : G} (h1 : g ≠ 1)
  (h2 : ∀ n : ℕ, g ∈ derived_series G n) : ¬ is_solvable G :=
mt (is_solvable_def _).mp (not_exists_of_forall_not
  (λ n h, h1 (subgroup.mem_bot.mp ((congr_arg (has_mem.mem g) h).mp (h2 n)))))

lemma equiv.perm.fin_5_not_solvable : ¬ is_solvable (equiv.perm (fin 5)) :=
begin
  let x : equiv.perm (fin 5) := ⟨![1, 2, 0, 3, 4], ![2, 0, 1, 3, 4], dec_trivial, dec_trivial⟩,
  let y : equiv.perm (fin 5) := ⟨![3, 4, 2, 0, 1], ![3, 4, 2, 0, 1], dec_trivial, dec_trivial⟩,
  let z : equiv.perm (fin 5) := ⟨![0, 3, 2, 1, 4], ![0, 3, 2, 1, 4], dec_trivial, dec_trivial⟩,
  have x_ne_one : x ≠ 1, { rw [ne.def, equiv.ext_iff], dec_trivial },
  have key : x = z * (x * (y * x * y⁻¹) * x⁻¹ * (y * x * y⁻¹)⁻¹) * z⁻¹,
  { ext a, dec_trivial! },
  refine not_solvable_of_mem_derived_series x_ne_one (λ n, _),
  induction n with n ih,
  { exact mem_top x },
  { rw key,
    exact (derived_series_normal _ _).conj_mem _
      (general_commutator_containment _ _ ih ((derived_series_normal _ _).conj_mem _ ih _)) _ },
end

lemma equiv.perm.not_solvable (X : Type*) (hX : 5 ≤ cardinal.mk X) :
  ¬ is_solvable (equiv.perm X) :=
begin
  introI h,
  have key : nonempty (fin 5 ↪ X),
  { rwa [←cardinal.lift_mk_le, cardinal.mk_fin, cardinal.lift_nat_cast,
    nat.cast_bit1, nat.cast_bit0, nat.cast_one, cardinal.lift_id] },
  exact equiv.perm.fin_5_not_solvable (solvable_of_solvable_injective
    (equiv.perm.via_embedding_hom_injective (nonempty.some key))),
end

end perm_not_solvable


import topology.instances.real

namespace real

theorem Inf_le_Sup (S : set ℝ) (h₁ : ∃ x, x ∈ S) (h₂ : ∃ x, ∀ y ∈ S, y ≤ x)
  (h₃ : ∃ x, ∀ y ∈ S, x ≤ y) :
  Inf S ≤ Sup S :=
begin
  cases h₁ with k hk,
  exact le_trans (real.Inf_le _ h₃ hk) (real.le_Sup _ h₂ hk),
end

end real

lemma exists_of_range_eq_range {α : Type*} [linear_order α] {f g : ℕ → α}
  (hfg : set.range f = set.range g) (n : ℕ) :
  ∃ k, f n = g k :=
begin
  have h₁ : f n ∈ set.range g,
  { simp [←hfg] },
  rcases h₁ with ⟨t, ht⟩,
  use t, rw ht
end

lemma eq_of_strict_mono_of_range_eq {α : Type*} [linear_order α] {f g : ℕ → α} (hf : strict_mono f)
  (hg : strict_mono g) (hfg : set.range f = set.range g) : f = g :=
begin
  ext i,
  apply nat.strong_induction_on i,
  clear i,
  intros i ih,
  by_contra h,
  cases ne.lt_or_lt h with h₁ h₁,
  { cases exists_of_range_eq_range hfg i with m hm,
    have hmi : m < i,
    { rwa [hm, hg.lt_iff_lt] at h₁ },
    specialize ih m hmi,
    rwa [←hf.lt_iff_lt, hm, ih] at hmi,
    exact lt_irrefl _ hmi },
  { cases exists_of_range_eq_range hfg.symm i with m hm,
    have hmi : m < i,
    { rwa [hm, hf.lt_iff_lt] at h₁ },
    specialize ih m hmi,
    rwa [←hg.lt_iff_lt, hm, ih] at hmi,
    exact lt_irrefl _ hmi }
end

def bounded_within (f : ℝ → ℝ) (a b : ℝ) := ∃ k, ∀ x ∈ set.Icc a b, abs (f x) < k


theorem succ_eq_succ_of_eq {a b : mynat} : a = b → succ(a) = succ(b) :=
begin
intro h,
rw h,
refl,
end


variable f : ℕ → ℕ
variable h : ∀ x : ℕ, f x ≤ f (x + 1)

example : f 0 ≥ f 1 → f 1 ≥ f 2 → f 0 = f 2 :=
  assume : f 0 ≥ f 1,
  assume : f 1 ≥ f 2,
  have f 0 ≥ f 2, from le_trans this ‹f 0 ≥ f 1›,
  have f 0 ≤ f 2, from le_trans (h 0) (h 1),
  show f 0 = f 2, from le_antisymm this ‹f 0 ≥ f 2›


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import topology.continuous_function.compact
import analysis.normed_space.units
import algebra.algebra.spectrum

/-!
# Units of continuous functions

This file concerns itself with `C(X, M)ˣ` and `C(X, Mˣ)` when `X` is a topological space
and `M` has some monoid structure compatible with its topology.
-/

variables {X M R 𝕜 : Type*} [topological_space X]

namespace continuous_map

section monoid

variables [monoid M] [topological_space M] [has_continuous_mul M]

/-- Equivalence between continuous maps into the units of a monoid with continuous multiplication
and the units of the monoid of continuous maps. -/
@[to_additive "Equivalence between continuous maps into the additive units of an additive monoid
with continuous addition and the additive units of the additive monoid of continuous maps.", simps]
def units_lift : C(X, Mˣ) ≃ C(X, M)ˣ :=
{ to_fun := λ f,
  { val := ⟨λ x, f x, units.continuous_coe.comp f.continuous⟩,
    inv := ⟨λ x, ↑(f x)⁻¹, units.continuous_coe.comp (continuous_inv.comp f.continuous)⟩,
    val_inv := ext $ λ x, units.mul_inv _,
    inv_val := ext $ λ x, units.inv_mul _ },
  inv_fun := λ f,
  { to_fun := λ x, ⟨f x, f⁻¹ x, continuous_map.congr_fun f.mul_inv x,
                                continuous_map.congr_fun f.inv_mul x⟩,
    continuous_to_fun := continuous_induced_rng $ continuous.prod_mk (f : C(X, M)).continuous
      $ mul_opposite.continuous_op.comp (↑f⁻¹ : C(X, M)).continuous },
  left_inv := λ f, by { ext, refl },
  right_inv := λ f, by { ext, refl } }

end monoid

section normed_ring

variables [normed_ring R] [complete_space R]

lemma _root_.normed_ring.is_unit_unit_continuous {f : C(X, R)} (h : ∀ x, is_unit (f x)) :
  continuous (λ x, (h x).unit) :=
begin
  refine continuous_induced_rng (continuous.prod_mk f.continuous
    (mul_opposite.continuous_op.comp (continuous_iff_continuous_at.mpr (λ x, _)))),
  have := normed_ring.inverse_continuous_at (h x).unit,
  simp only [←ring.inverse_unit, is_unit.unit_spec, ←function.comp_apply] at this ⊢,
  exact this.comp (f.continuous_at x),
end

/-- Construct a continuous map into the group of units of a normed ring from a function into the
normed ring and a proof that every element of the range is a unit. -/
@[simps]
noncomputable def units_of_forall_is_unit {f : C(X, R)} (h : ∀ x, is_unit (f x)) : C(X, Rˣ) :=
{ to_fun := λ x, (h x).unit,
  continuous_to_fun :=  normed_ring.is_unit_unit_continuous h }

instance : can_lift C(X, R) C(X, Rˣ) :=
{ coe := λ f, ⟨λ x, f x, units.continuous_coe.comp f.continuous⟩,
  cond := λ f, ∀ x, is_unit (f x),
  prf := λ f h, ⟨units_of_forall_is_unit h, by { ext, refl }⟩ }

lemma is_unit_iff_forall_is_unit (f : C(X, R)) :
  is_unit f ↔ ∀ x, is_unit (f x) :=
iff.intro (λ h, λ x, ⟨units_lift.symm h.unit x, rfl⟩)
  (λ h, ⟨(units_of_forall_is_unit h).units_lift, by { ext, refl }⟩)

end normed_ring

section normed_field

variables [normed_field 𝕜] [complete_space 𝕜]

lemma is_unit_iff_forall_ne_zero (f : C(X, 𝕜)) :
  is_unit f ↔ ∀ x, f x ≠ 0 :=
by simp_rw [f.is_unit_iff_forall_is_unit, is_unit_iff_ne_zero]

lemma spectrum_eq_range (f : C(X, 𝕜)) :
  spectrum 𝕜 f = set.range f :=
begin
  ext,
  simp only [spectrum.mem_iff, is_unit_iff_forall_ne_zero, not_forall, coe_sub,
    pi.sub_apply, algebra_map_apply, algebra.id.smul_eq_mul, mul_one, not_not, set.mem_range,
    sub_eq_zero, @eq_comm _ x _]
end

end normed_field

end continuous_map


import tactic
import analysis.inner_product_space.basic
import data.set
import data.real.basic
variables {V : Type*} [inner_product_space ℝ V] [finite_dimensional ℝ V] (T : V →ₗ[ℝ] V ) (h_non_triv_space : ∃ (v : V), v ≠ 0)

def S : set ℝ := {x : ℝ | ∃ (y : V), (y ≠ 0) ∧ (λ (x : V) , ∥T x∥/∥x∥) y = x}
def S2 : set ℝ := {x : ℝ | ∃ (y : V), (λ (x : V) , ⟪T x, T x⟫_ℝ/⟪x, x⟫_ℝ) y = x}

example : ∀ (v : V), ⟪v, v⟫_ℝ = ∥v∥^2 :=
begin
  intro v,
  rw real_inner_self_eq_norm_mul_norm,
  ring,
end

lemma S2_map_nonneg : ∀(x : V), x ≠ 0 → 0 ≤ ⟪T x, T x⟫_ℝ / ⟪x, x⟫_ℝ:=
begin
  intro x,
  intro h,
  have h2: 0 ≤ ⟪T x, T x⟫_ℝ,
  exact real_inner_self_nonneg,
  have h3 : 0 < ⟪x,x⟫_ℝ,
    have h4: 0 ≠ ⟪x,x⟫_ℝ,
      by_contra h3,
      rw eq_comm at h3,
      rw inner_self_eq_zero at h3,
      apply h, exact h3,
    rw ne_iff_lt_or_gt at h4,
    cases h4,
      exact h4,
      exfalso,
      change ⟪x,x⟫_ℝ < 0 at h4,
      rw ←not_le at h4,
      apply h4,
      exact real_inner_self_nonneg,
  rw le_div_iff,
  rw zero_mul, exact h2,
  exact h3,
end

lemma S_map_nonneg: ∀(x : V), x ≠ 0 → 0 ≤ ∥T x∥/∥x∥:=
begin
  intro x,
  intro h,
  rw norm_eq_sqrt_real_inner,
  rw norm_eq_sqrt_real_inner,
  rw ←real.sqrt_div,
  rw ←real.sqrt_zero,
  apply real.sqrt_le_sqrt,
  apply S2_map_nonneg,
  exact h,
  exact real_inner_self_nonneg,
end

lemma V_nonempty : nonempty V :=
begin
  exact has_zero.nonempty,
end

lemma max_squared {h: is_lub (S2 T) (Sup (S2 T))} (h_non_triv_space : ∃ (v : V), v ≠ 0): is_lub (S T) (real.sqrt (Sup (S2 T))) :=
begin
  cases h with hup hleast,
  have hup2: real.sqrt (Sup (S2 T)) ∈ upper_bounds (S T),
  {
    change ∀⦃a : ℝ⦄, a ∈ (S T) → a ≤  real.sqrt (Sup (S2 T)),
    intro a,
    intro h2,
    change ∃(y : V), (y ≠ 0) ∧ ∥T y∥/∥y∥  = a at h2,
    cases h2,
    cases h2_h with h2_h_nz h2_h,
    rw norm_eq_sqrt_real_inner at h2_h,
    rw norm_eq_sqrt_real_inner at h2_h,
    rw ←real.sqrt_div at h2_h,
    {
      rw ←h2_h,
      rw real.sqrt_le_sqrt_iff,
      apply le_cSup,
      use Sup (S2 T), exact hup,
      use h2_w,
      apply le_cSup_of_le,
      use Sup (S2 T), exact hup,
      use h2_w,
      apply S2_map_nonneg, exact h2_h_nz,
    },{
      exact real_inner_self_nonneg,
    }
  },
  split,
    exact hup2,
  change ∀ ⦃a : ℝ⦄, a ∈ upper_bounds (S T) → real.sqrt (Sup (S2 T)) ≤ a,
  intro a,
  intro h,
  change ∀⦃b : ℝ⦄, b ∈ (S T) → b ≤  a at h,
  by_contra h2,
  rw not_le at h2,
  let b := a^2,
  have h3: b < Sup (S2 T),
  rw ←real.sqrt_lt_sqrt_iff,
  rw real.sqrt_sq,
  exact h2,
  cases h_non_triv_space with vnz hv,
  have h4 := S_map_nonneg,
  specialize h4 T,
  specialize h4 vnz,
  have h5 : 0 ≤ ∥T vnz∥ / ∥vnz∥,
  apply h4, exact hv,
  have h6 : ∥T vnz∥ / ∥vnz∥ ≤ a,
  have h7 :  ∥T vnz∥ / ∥vnz∥ ∈ (S T),
  use vnz, split, exact hv, refl,
  apply h, exact h7, linarith [h5,h6],
  exact _inst_2,
  exact sq_nonneg a,

end

example (a : ℝ): 0 ≤ a^2 :=
begin
  exact sq_nonneg a,
end