/-
Copyright (c) 2018 . All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Thomas Browning
-/

import data.zmod.basic
import group_theory.index
import group_theory.group_action.conj_act
import group_theory.perm.cycle.type
import group_theory.quotient_group

/-!
# p-groups

This file contains a proof that if `G` is a `p`-group acting on a finite set `α`,
then the number of fixed points of the action is congruent mod `p` to the cardinality of `α`.
It also contains proofs of some corollaries of this lemma about existence of fixed points.
-/

open_locale big_operators

open fintype mul_action

variables (p : ℕ) (G : Type*) [group G]

/-- A p-group is a group in which every element has prime power order -/
def is_p_group : Prop := ∀ g : G, ∃ k : ℕ, g ^ (p ^ k) = 1

variables {p} {G}

namespace is_p_group

lemma iff_order_of [hp : fact p.prime] :
  is_p_group p G ↔ ∀ g : G, ∃ k : ℕ, order_of g = p ^ k :=
forall_congr (λ g, ⟨λ ⟨k, hk⟩, exists_imp_exists (by exact λ j, Exists.snd)
  ((nat.dvd_prime_pow hp.out).mp (order_of_dvd_of_pow_eq_one hk)),
  exists_imp_exists (λ k hk, by rw [←hk, pow_order_of_eq_one])⟩)

lemma of_card [fintype G] {n : ℕ} (hG : card G = p ^ n) : is_p_group p G :=
λ g, ⟨n, by rw [←hG, pow_card_eq_one]⟩

lemma of_bot : is_p_group p (⊥ : subgroup G) :=
of_card (subgroup.card_bot.trans (pow_zero p).symm)

lemma iff_card [fact p.prime] [fintype G] :
  is_p_group p G ↔ ∃ n : ℕ, card G = p ^ n :=
begin
  have hG : card G ≠ 0 := card_ne_zero,
  refine ⟨λ h, _, λ ⟨n, hn⟩, of_card hn⟩,
  suffices : ∀ q ∈ nat.factors (card G), q = p,
  { use (card G).factors.length,
    rw [←list.prod_repeat, ←list.eq_repeat_of_mem this, nat.prod_factors hG] },
  intros q hq,
  obtain ⟨hq1, hq2⟩ := (nat.mem_factors hG).mp hq,
  haveI : fact q.prime := ⟨hq1⟩,
  obtain ⟨g, hg⟩ := exists_prime_order_of_dvd_card q hq2,
  obtain ⟨k, hk⟩ := (iff_order_of.mp h) g,
  exact (hq1.pow_eq_iff.mp (hg.symm.trans hk).symm).1.symm,
end

section G_is_p_group

variables (hG : is_p_group p G)

include hG

lemma of_injective {H : Type*} [group H] (ϕ : H →* G) (hϕ : function.injective ϕ) :
  is_p_group p H :=
begin
  simp_rw [is_p_group, ←hϕ.eq_iff, ϕ.map_pow, ϕ.map_one],
  exact λ h, hG (ϕ h),
end

lemma to_subgroup (H : subgroup G) : is_p_group p H :=
hG.of_injective H.subtype subtype.coe_injective

lemma of_surjective {H : Type*} [group H] (ϕ : G →* H) (hϕ : function.surjective ϕ) :
  is_p_group p H :=
begin
  refine λ h, exists.elim (hϕ h) (λ g hg, exists_imp_exists (λ k hk, _) (hG g)),
  rw [←hg, ←ϕ.map_pow, hk, ϕ.map_one],
end

lemma to_quotient (H : subgroup G) [H.normal] :
  is_p_group p (G ⧸ H) :=
hG.of_surjective (quotient_group.mk' H) quotient.surjective_quotient_mk'

lemma of_equiv {H : Type*} [group H] (ϕ : G ≃* H) : is_p_group p H :=
hG.of_surjective ϕ.to_monoid_hom ϕ.surjective

variables [hp : fact p.prime]

include hp

lemma index (H : subgroup G) [fintype (G ⧸ H)] :
  ∃ n : ℕ, H.index = p ^ n :=
begin
  obtain ⟨n, hn⟩ := iff_card.mp (hG.to_quotient H.normal_core),
  obtain ⟨k, hk1, hk2⟩ := (nat.dvd_prime_pow hp.out).mp ((congr_arg _
    (H.normal_core.index_eq_card.trans hn)).mp (subgroup.index_dvd_of_le H.normal_core_le)),
  exact ⟨k, hk2⟩,
end

variables {α : Type*} [mul_action G α]

lemma card_orbit (a : α) [fintype (orbit G a)] :
  ∃ n : ℕ, card (orbit G a) = p ^ n :=
begin
  let ϕ := orbit_equiv_quotient_stabilizer G a,
  haveI := fintype.of_equiv (orbit G a) ϕ,
  rw [card_congr ϕ, ←subgroup.index_eq_card],
  exact hG.index (stabilizer G a),
end

variables (α) [fintype α] [fintype (fixed_points G α)]

/-- If `G` is a `p`-group acting on a finite set `α`, then the number of fixed points
  of the action is congruent mod `p` to the cardinality of `α` -/
lemma card_modeq_card_fixed_points : card α ≡ card (fixed_points G α) [MOD p] :=
begin
  classical,
  calc card α = card (Σ y : quotient (orbit_rel G α), {x // quotient.mk' x = y}) :
    card_congr (equiv.sigma_fiber_equiv (@quotient.mk' _ (orbit_rel G α))).symm
  ... = ∑ a : quotient (orbit_rel G α), card {x // quotient.mk' x = a} : card_sigma _
  ... ≡ ∑ a : fixed_points G α, 1 [MOD p] : _
  ... = _ : by simp; refl,
  rw [←zmod.eq_iff_modeq_nat p, nat.cast_sum, nat.cast_sum],
  have key : ∀ x, card {y // (quotient.mk' y : quotient (orbit_rel G α)) = quotient.mk' x} =
    card (orbit G x) := λ x, by simp only [quotient.eq']; congr,
  refine eq.symm (finset.sum_bij_ne_zero (λ a _ _, quotient.mk' a.1) (λ _ _ _, finset.mem_univ _)
    (λ a₁ a₂ _ _ _ _ h, subtype.eq ((mem_fixed_points' α).mp a₂.2 a₁.1 (quotient.exact' h)))
      (λ b, quotient.induction_on' b (λ b _ hb, _)) (λ a ha _, by
      { rw [key, mem_fixed_points_iff_card_orbit_eq_one.mp a.2] })),
  obtain ⟨k, hk⟩ := hG.card_orbit b,
  have : k = 0 := nat.le_zero_iff.1 (nat.le_of_lt_succ (lt_of_not_ge (mt (pow_dvd_pow p)
    (by rwa [pow_one, ←hk, ←nat.modeq_zero_iff_dvd, ←zmod.eq_iff_modeq_nat, ←key,
      nat.cast_zero])))),
  exact ⟨⟨b, mem_fixed_points_iff_card_orbit_eq_one.2 $ by rw [hk, this, pow_zero]⟩,
    finset.mem_univ _, (ne_of_eq_of_ne nat.cast_one one_ne_zero), rfl⟩,
end

/-- If a p-group acts on `α` and the cardinality of `α` is not a multiple
  of `p` then the action has a fixed point. -/
lemma nonempty_fixed_point_of_prime_not_dvd_card (hpα : ¬ p ∣ card α) :
  (fixed_points G α).nonempty :=
@set.nonempty_of_nonempty_subtype _ _ begin
rw [←card_pos_iff, pos_iff_ne_zero],
  contrapose! hpα,
  rw [←nat.modeq_zero_iff_dvd, ←hpα],
  exact hG.card_modeq_card_fixed_points α,
end

/-- If a p-group acts on `α` and the cardinality of `α` is a multiple
  of `p`, and the action has one fixed point, then it has another fixed point. -/
lemma exists_fixed_point_of_prime_dvd_card_of_fixed_point
  (hpα : p ∣ card α) {a : α} (ha : a ∈ fixed_points G α) :
  ∃ b, b ∈ fixed_points G α ∧ a ≠ b :=
have hpf : p ∣ card (fixed_points G α) :=
  nat.modeq_zero_iff_dvd.mp ((hG.card_modeq_card_fixed_points α).symm.trans hpα.modeq_zero_nat),
have hα : 1 < card (fixed_points G α) :=
  (fact.out p.prime).one_lt.trans_le (nat.le_of_dvd (card_pos_iff.2 ⟨⟨a, ha⟩⟩) hpf),
let ⟨⟨b, hb⟩, hba⟩ := exists_ne_of_one_lt_card hα ⟨a, ha⟩ in
⟨b, hb, λ hab, hba (by simp_rw [hab])⟩

lemma center_nontrivial [nontrivial G] [fintype G] : nontrivial (subgroup.center G) :=
begin
  classical,
  have := (hG.of_equiv conj_act.to_conj_act).exists_fixed_point_of_prime_dvd_card_of_fixed_point G,
  rw conj_act.fixed_points_eq_center at this,
  obtain ⟨g, hg⟩ := this _ (subgroup.center G).one_mem,
  { exact ⟨⟨1, ⟨g, hg.1⟩, mt subtype.ext_iff.mp hg.2⟩⟩ },
  { obtain ⟨n, hn⟩ := is_p_group.iff_card.mp hG,
    rw hn,
    apply dvd_pow_self,
    rintro rfl,
    exact (fintype.one_lt_card).ne' hn },
end

lemma bot_lt_center [nontrivial G] [fintype G] : ⊥ < subgroup.center G :=
begin
  haveI := center_nontrivial hG,
  classical,
  exact bot_lt_iff_ne_bot.mpr ((subgroup.center G).one_lt_card_iff_ne_bot.mp fintype.one_lt_card),
end

end G_is_p_group

lemma to_le {H K : subgroup G} (hK : is_p_group p K) (hHK : H ≤ K) : is_p_group p H :=
hK.of_injective (subgroup.inclusion hHK) (λ a b h, subtype.ext (show _, from subtype.ext_iff.mp h))

lemma to_inf_left {H K : subgroup G} (hH : is_p_group p H) : is_p_group p (H ⊓ K : subgroup G) :=
hH.to_le inf_le_left

lemma to_inf_right {H K : subgroup G} (hK : is_p_group p K) : is_p_group p (H ⊓ K : subgroup G) :=
hK.to_le inf_le_right

lemma map {H : subgroup G} (hH : is_p_group p H) {K : Type*} [group K]
  (ϕ : G →* K) : is_p_group p (H.map ϕ) :=
begin
  rw [←H.subtype_range, monoid_hom.map_range],
  exact hH.of_surjective (ϕ.restrict H).range_restrict (ϕ.restrict H).range_restrict_surjective,
end

lemma comap_of_ker_is_p_group {H : subgroup G} (hH : is_p_group p H) {K : Type*} [group K]
  (ϕ : K →* G) (hϕ : is_p_group p ϕ.ker) : is_p_group p (H.comap ϕ) :=
begin
  intro g,
  obtain ⟨j, hj⟩ := hH ⟨ϕ g.1, g.2⟩,
  rw [subtype.ext_iff, H.coe_pow, subtype.coe_mk, ←ϕ.map_pow] at hj,
  obtain ⟨k, hk⟩ := hϕ ⟨g.1 ^ p ^ j, hj⟩,
  rwa [subtype.ext_iff, ϕ.ker.coe_pow, subtype.coe_mk, ←pow_mul, ←pow_add] at hk,
  exact ⟨j + k, by rwa [subtype.ext_iff, (H.comap ϕ).coe_pow]⟩,
end

lemma ker_is_p_group_of_injective {K : Type*} [group K] {ϕ : K →* G} (hϕ : function.injective ϕ) :
  is_p_group p ϕ.ker :=
(congr_arg (λ Q : subgroup K, is_p_group p Q) (ϕ.ker_eq_bot_iff.mpr hϕ)).mpr is_p_group.of_bot

lemma comap_of_injective {H : subgroup G} (hH : is_p_group p H) {K : Type*} [group K]
  (ϕ : K →* G) (hϕ : function.injective ϕ) : is_p_group p (H.comap ϕ) :=
hH.comap_of_ker_is_p_group ϕ (ker_is_p_group_of_injective hϕ)

lemma comap_subtype {H : subgroup G} (hH : is_p_group p H) {K : subgroup G} :
  is_p_group p (H.comap K.subtype) :=
hH.comap_of_injective K.subtype subtype.coe_injective

lemma to_sup_of_normal_right {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  [K.normal] : is_p_group p (H ⊔ K : subgroup G) :=
begin
  rw [←quotient_group.ker_mk K, ←subgroup.comap_map_eq],
  apply (hH.map (quotient_group.mk' K)).comap_of_ker_is_p_group,
  rwa quotient_group.ker_mk,
end

lemma to_sup_of_normal_left {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  [H.normal] : is_p_group p (H ⊔ K : subgroup G) :=
(congr_arg (λ H : subgroup G, is_p_group p H) sup_comm).mp (to_sup_of_normal_right hK hH)

lemma to_sup_of_normal_right' {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  (hHK : H ≤ K.normalizer) : is_p_group p (H ⊔ K : subgroup G) :=
let hHK' := to_sup_of_normal_right (hH.of_equiv (subgroup.comap_subtype_equiv_of_le hHK).symm)
  (hK.of_equiv (subgroup.comap_subtype_equiv_of_le subgroup.le_normalizer).symm) in
((congr_arg (λ H : subgroup K.normalizer, is_p_group p H)
  (subgroup.sup_subgroup_of_eq hHK subgroup.le_normalizer)).mp hHK').of_equiv
  (subgroup.comap_subtype_equiv_of_le (sup_le hHK subgroup.le_normalizer))

lemma to_sup_of_normal_left' {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  (hHK : K ≤ H.normalizer) : is_p_group p (H ⊔ K : subgroup G) :=
(congr_arg (λ H : subgroup G, is_p_group p H) sup_comm).mp (to_sup_of_normal_right' hK hH hHK)

/-- finite p-groups with different p have coprime orders -/
lemma coprime_card_of_ne {G₂ : Type*} [group G₂]
  (p₁ p₂ : ℕ) [hp₁ : fact p₁.prime] [hp₂ : fact p₂.prime] (hne : p₁ ≠ p₂)
  (H₁ : subgroup G) (H₂ : subgroup G₂) [fintype H₁] [fintype H₂]
  (hH₁ : is_p_group p₁ H₁) (hH₂ : is_p_group p₂ H₂) :
  nat.coprime (fintype.card H₁) (fintype.card H₂) :=
begin
  obtain ⟨n₁, heq₁⟩ := iff_card.mp hH₁, rw heq₁, clear heq₁,
  obtain ⟨n₂, heq₂⟩ := iff_card.mp hH₂, rw heq₂, clear heq₂,
  exact nat.coprime_pow_primes _ _ (hp₁.elim) (hp₂.elim) hne,
end

/-- p-groups with different p are disjoint -/
lemma disjoint_of_ne (p₁ p₂ : ℕ) [hp₁ : fact p₁.prime] [hp₂ : fact p₂.prime] (hne : p₁ ≠ p₂)
  (H₁ H₂ : subgroup G) (hH₁ : is_p_group p₁ H₁) (hH₂ : is_p_group p₂ H₂) :
  disjoint H₁ H₂ :=
begin
  rintro x ⟨hx₁, hx₂⟩,
  rw subgroup.mem_bot,
  obtain ⟨n₁, hn₁⟩ := iff_order_of.mp hH₁ ⟨x, hx₁⟩,
  obtain ⟨n₂, hn₂⟩ := iff_order_of.mp hH₂ ⟨x, hx₂⟩,
  rw [← order_of_subgroup, subgroup.coe_mk] at hn₁ hn₂,
  have : p₁ ^ n₁ = p₂ ^ n₂, by rw [← hn₁, ← hn₂],
  have : n₁ = 0,
  { contrapose! hne with h,
    rw ← associated_iff_eq at this ⊢,
    exact associated.of_pow_associated_of_prime
      (nat.prime_iff.mp hp₁.elim) (nat.prime_iff.mp hp₂.elim) (ne.bot_lt h) this },
  simpa [this] using hn₁,
end

end is_p_group


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Simon Hudon, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.defs
import Mathlib.logic.function.basic
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/--
Composing two associative operations of `f : α → α → α` on the left
is equal to an associative operation on the left.
-/
theorem comp_assoc_left {α : Type u} (f : α → α → α) [is_associative α f] (x : α) (y : α) : f x ∘ f y = f (f x y) := sorry

/--
Composing two associative operations of `f : α → α → α` on the right
is equal to an associative operation on the right.
-/
theorem comp_assoc_right {α : Type u} (f : α → α → α) [is_associative α f] (x : α) (y : α) : ((fun (z : α) => f z x) ∘ fun (z : α) => f z y) = fun (z : α) => f z (f y x) := sorry

/--
Composing two multiplications on the left by `y` then `x`
is equal to a multiplication on the left by `x * y`.
-/
@[simp] theorem comp_mul_left {α : Type u_1} [semigroup α] (x : α) (y : α) : Mul.mul x ∘ Mul.mul y = Mul.mul (x * y) :=
  comp_assoc_left Mul.mul x y

/--
Composing two multiplications on the right by `y` and `x`
is equal to a multiplication on the right by `y * x`.
-/
@[simp] theorem comp_add_right {α : Type u_1} [add_semigroup α] (x : α) (y : α) : ((fun (_x : α) => _x + x) ∘ fun (_x : α) => _x + y) = fun (_x : α) => _x + (y + x) :=
  comp_assoc_right Add.add x y

theorem ite_add_zero {M : Type u} [add_monoid M] {P : Prop} [Decidable P] {a : M} {b : M} : ite P (a + b) 0 = ite P a 0 + ite P b 0 := sorry

theorem eq_one_iff_eq_one_of_mul_eq_one {M : Type u} [monoid M] {a : M} {b : M} (h : a * b = 1) : a = 1 ↔ b = 1 := sorry

theorem add_left_comm {G : Type u} [add_comm_semigroup G] (a : G) (b : G) (c : G) : a + (b + c) = b + (a + c) :=
  left_comm Add.add add_comm add_assoc

theorem mul_right_comm {G : Type u} [comm_semigroup G] (a : G) (b : G) (c : G) : a * b * c = a * c * b :=
  right_comm Mul.mul mul_comm mul_assoc

theorem add_add_add_comm {G : Type u} [add_comm_semigroup G] (a : G) (b : G) (c : G) (d : G) : a + b + (c + d) = a + c + (b + d) := sorry

@[simp] theorem bit0_zero {M : Type u} [add_monoid M] : bit0 0 = 0 :=
  add_zero 0

@[simp] theorem bit1_zero {M : Type u} [add_monoid M] [HasOne M] : bit1 0 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (bit1 0 = 1)) (bit1.equations._eqn_1 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (bit0 0 + 1 = 1)) bit0_zero))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 + 1 = 1)) (zero_add 1))) (Eq.refl 1)))

theorem neg_unique {M : Type u} [add_comm_monoid M] {x : M} {y : M} {z : M} (hy : x + y = 0) (hz : x + z = 0) : y = z :=
  left_neg_eq_right_neg (trans (add_comm y x) hy) hz

@[simp] theorem mul_eq_left_iff {M : Type u} [left_cancel_monoid M] {a : M} {b : M} : a * b = a ↔ b = 1 :=
  iff.trans (eq.mpr (id (Eq._oldrec (Eq.refl (a * b = a ↔ a * b = a * 1)) (mul_one a))) (iff.refl (a * b = a)))
    mul_left_cancel_iff

@[simp] theorem left_eq_add_iff {M : Type u} [add_left_cancel_monoid M] {a : M} {b : M} : a = a + b ↔ b = 0 :=
  iff.trans eq_comm add_eq_left_iff

@[simp] theorem mul_eq_right_iff {M : Type u} [right_cancel_monoid M] {a : M} {b : M} : a * b = b ↔ a = 1 :=
  iff.trans (eq.mpr (id (Eq._oldrec (Eq.refl (a * b = b ↔ a * b = 1 * b)) (one_mul b))) (iff.refl (a * b = b)))
    mul_right_cancel_iff

@[simp] theorem right_eq_mul_iff {M : Type u} [right_cancel_monoid M] {a : M} {b : M} : b = a * b ↔ a = 1 :=
  iff.trans eq_comm mul_eq_right_iff

theorem neg_eq_zero_sub {G : Type u} [sub_neg_monoid G] (x : G) : -x = 0 - x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-x = 0 - x)) (sub_eq_add_neg 0 x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-x = 0 + -x)) (zero_add (-x)))) (Eq.refl (-x)))

theorem mul_one_div {G : Type u} [div_inv_monoid G] (x : G) (y : G) : x * (1 / y) = x / y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x * (1 / y) = x / y)) (div_eq_mul_inv 1 y)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x * (1 * (y⁻¹)) = x / y)) (one_mul (y⁻¹))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (x * (y⁻¹) = x / y)) (div_eq_mul_inv x y))) (Eq.refl (x * (y⁻¹)))))

theorem mul_div_assoc {G : Type u} [div_inv_monoid G] {a : G} {b : G} {c : G} : a * b / c = a * (b / c) := sorry

theorem mul_div_assoc' {G : Type u} [div_inv_monoid G] (a : G) (b : G) (c : G) : a * (b / c) = a * b / c :=
  Eq.symm mul_div_assoc

@[simp] theorem one_div {G : Type u} [div_inv_monoid G] (a : G) : 1 / a = (a⁻¹) :=
  Eq.symm (inv_eq_one_div a)

@[simp] theorem neg_add_cancel_right {G : Type u} [add_group G] (a : G) (b : G) : a + -b + b = a := sorry

@[simp] theorem neg_zero {G : Type u} [add_group G] : -0 = 0 :=
  neg_eq_of_add_eq_zero (zero_add 0)

theorem left_inverse_inv (G : Type u_1) [group G] : function.left_inverse (fun (a : G) => a⁻¹) fun (a : G) => a⁻¹ :=
  inv_inv

@[simp] theorem inv_involutive {G : Type u} [group G] : function.involutive has_inv.inv :=
  inv_inv

theorem neg_injective {G : Type u} [add_group G] : function.injective Neg.neg :=
  function.involutive.injective neg_involutive

@[simp] theorem neg_inj {G : Type u} [add_group G] {a : G} {b : G} : -a = -b ↔ a = b :=
  function.injective.eq_iff neg_injective

@[simp] theorem add_neg_cancel_left {G : Type u} [add_group G] (a : G) (b : G) : a + (-a + b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + (-a + b) = b)) (Eq.symm (add_assoc a (-a) b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -a + b = b)) (add_right_neg a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 + b = b)) (zero_add b))) (Eq.refl b)))

theorem add_left_surjective {G : Type u} [add_group G] (a : G) : function.surjective (Add.add a) :=
  fun (x : G) => Exists.intro (-a + x) (add_neg_cancel_left a x)

theorem add_right_surjective {G : Type u} [add_group G] (a : G) : function.surjective fun (x : G) => x + a :=
  fun (x : G) => Exists.intro (x + -a) (neg_add_cancel_right x a)

@[simp] theorem mul_inv_rev {G : Type u} [group G] (a : G) (b : G) : a * b⁻¹ = b⁻¹ * (a⁻¹) := sorry

theorem eq_neg_of_eq_neg {G : Type u} [add_group G] {a : G} {b : G} (h : a = -b) : b = -a := sorry

theorem eq_neg_of_add_eq_zero {G : Type u} [add_group G] {a : G} {b : G} (h : a + b = 0) : a = -b := sorry

theorem eq_add_neg_of_add_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a + c = b) : a = b + -c := sorry

theorem eq_neg_add_of_add_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : b + a = c) : a = -b + c := sorry

theorem neg_add_eq_of_eq_add {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : b = a + c) : -a + b = c := sorry

theorem mul_inv_eq_of_eq_mul {G : Type u} [group G] {a : G} {b : G} {c : G} (h : a = c * b) : a * (b⁻¹) = c := sorry

theorem eq_add_of_add_neg_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a + -c = b) : a = b + c := sorry

theorem eq_mul_of_inv_mul_eq {G : Type u} [group G] {a : G} {b : G} {c : G} (h : b⁻¹ * a = c) : a = b * c := sorry

theorem mul_eq_of_eq_inv_mul {G : Type u} [group G] {a : G} {b : G} {c : G} (h : b = a⁻¹ * c) : a * b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b = c)) h))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (a⁻¹ * c) = c)) (mul_inv_cancel_left a c))) (Eq.refl c))

theorem mul_eq_of_eq_mul_inv {G : Type u} [group G] {a : G} {b : G} {c : G} (h : a = c * (b⁻¹)) : a * b = c := sorry

theorem add_self_iff_eq_zero {G : Type u} [add_group G] {a : G} : a + a = a ↔ a = 0 :=
  eq.mp (Eq._oldrec (Eq.refl (a + a = a + 0 ↔ a = 0)) (add_zero a)) (add_right_inj a)

@[simp] theorem neg_eq_zero {G : Type u} [add_group G] {a : G} : -a = 0 ↔ a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-a = 0 ↔ a = 0)) (Eq.symm (propext neg_inj))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-a = 0 ↔ -a = -0)) neg_zero)) (iff.refl (-a = 0)))

@[simp] theorem zero_eq_neg {G : Type u} [add_group G] {a : G} : 0 = -a ↔ a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 = -a ↔ a = 0)) (propext eq_comm)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-a = 0 ↔ a = 0)) (propext neg_eq_zero))) (iff.refl (a = 0)))

theorem neg_ne_zero {G : Type u} [add_group G] {a : G} : -a ≠ 0 ↔ a ≠ 0 :=
  not_congr neg_eq_zero

theorem eq_neg_iff_eq_neg {G : Type u} [add_group G] {a : G} {b : G} : a = -b ↔ b = -a :=
  { mp := eq_neg_of_eq_neg, mpr := eq_neg_of_eq_neg }

theorem neg_eq_iff_neg_eq {G : Type u} [add_group G] {a : G} {b : G} : -a = b ↔ -b = a :=
  iff.trans eq_comm (iff.trans eq_neg_iff_eq_neg eq_comm)

theorem mul_eq_one_iff_eq_inv {G : Type u} [group G] {a : G} {b : G} : a * b = 1 ↔ a = (b⁻¹) := sorry

theorem mul_eq_one_iff_inv_eq {G : Type u} [group G] {a : G} {b : G} : a * b = 1 ↔ a⁻¹ = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b = 1 ↔ a⁻¹ = b)) (propext mul_eq_one_iff_eq_inv)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = (b⁻¹) ↔ a⁻¹ = b)) (propext eq_inv_iff_eq_inv)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (b = (a⁻¹) ↔ a⁻¹ = b)) (propext eq_comm))) (iff.refl (a⁻¹ = b))))

theorem eq_neg_iff_add_eq_zero {G : Type u} [add_group G] {a : G} {b : G} : a = -b ↔ a + b = 0 :=
  iff.symm add_eq_zero_iff_eq_neg

theorem neg_eq_iff_add_eq_zero {G : Type u} [add_group G] {a : G} {b : G} : -a = b ↔ a + b = 0 :=
  iff.symm add_eq_zero_iff_neg_eq

theorem eq_mul_inv_iff_mul_eq {G : Type u} [group G] {a : G} {b : G} {c : G} : a = b * (c⁻¹) ↔ a * c = b := sorry

theorem eq_inv_mul_iff_mul_eq {G : Type u} [group G] {a : G} {b : G} {c : G} : a = b⁻¹ * c ↔ b * a = c := sorry

theorem inv_mul_eq_iff_eq_mul {G : Type u} [group G] {a : G} {b : G} {c : G} : a⁻¹ * b = c ↔ b = a * c := sorry

theorem add_neg_eq_iff_eq_add {G : Type u} [add_group G] {a : G} {b : G} {c : G} : a + -b = c ↔ a = c + b := sorry

theorem mul_inv_eq_one {G : Type u} [group G] {a : G} {b : G} : a * (b⁻¹) = 1 ↔ a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * (b⁻¹) = 1 ↔ a = b)) (propext mul_eq_one_iff_eq_inv)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = (b⁻¹⁻¹) ↔ a = b)) (inv_inv b))) (iff.refl (a = b)))

theorem inv_mul_eq_one {G : Type u} [group G] {a : G} {b : G} : a⁻¹ * b = 1 ↔ a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * b = 1 ↔ a = b)) (propext mul_eq_one_iff_eq_inv)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ = (b⁻¹) ↔ a = b)) (propext inv_inj))) (iff.refl (a = b)))

@[simp] theorem mul_left_eq_self {G : Type u} [group G] {a : G} {b : G} : a * b = b ↔ a = 1 := sorry

@[simp] theorem add_right_eq_self {G : Type u} [add_group G] {a : G} {b : G} : a + b = a ↔ b = 0 := sorry

theorem sub_left_injective {G : Type u} [add_group G] {b : G} : function.injective fun (a : G) => a - b := sorry

theorem div_right_injective {G : Type u} [group G] {b : G} : function.injective fun (a : G) => b / a := sorry

@[simp] theorem sub_self {G : Type u} [add_group G] (a : G) : a - a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - a = 0)) (sub_eq_add_neg a a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -a = 0)) (add_right_neg a))) (Eq.refl 0))

@[simp] theorem sub_add_cancel {G : Type u} [add_group G] (a : G) (b : G) : a - b + b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b + b = a)) (sub_eq_add_neg a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -b + b = a)) (neg_add_cancel_right a b))) (Eq.refl a))

@[simp] theorem add_sub_cancel {G : Type u} [add_group G] (a : G) (b : G) : a + b - b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b - b = a)) (sub_eq_add_neg (a + b) b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + b + -b = a)) (add_neg_cancel_right a b))) (Eq.refl a))

theorem add_sub_assoc {G : Type u} [add_group G] (a : G) (b : G) (c : G) : a + b - c = a + (b - c) := sorry

theorem eq_of_sub_eq_zero {G : Type u} [add_group G] {a : G} {b : G} (h : a - b = 0) : a = b := sorry

theorem sub_eq_zero_of_eq {G : Type u} [add_group G] {a : G} {b : G} (h : a = b) : a - b = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = 0)) h))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b - b = 0)) (sub_self b))) (Eq.refl 0))

theorem sub_eq_zero_iff_eq {G : Type u} [add_group G] {a : G} {b : G} : a - b = 0 ↔ a = b :=
  { mp := eq_of_sub_eq_zero, mpr := sub_eq_zero_of_eq }

@[simp] theorem sub_zero {G : Type u} [add_group G] (a : G) : a - 0 = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - 0 = a)) (sub_eq_add_neg a 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -0 = a)) neg_zero))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a + 0 = a)) (add_zero a))) (Eq.refl a)))

theorem sub_ne_zero_of_ne {G : Type u} [add_group G] {a : G} {b : G} (h : a ≠ b) : a - b ≠ 0 :=
  id fun (hab : a - b = 0) => h (eq_of_sub_eq_zero hab)

@[simp] theorem sub_neg_eq_add {G : Type u} [add_group G] (a : G) (b : G) : a - -b = a + b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - -b = a + b)) (sub_eq_add_neg a (-b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + --b = a + b)) (neg_neg b))) (Eq.refl (a + b)))

@[simp] theorem neg_sub {G : Type u} [add_group G] (a : G) (b : G) : -(a - b) = b - a := sorry

theorem add_sub {G : Type u} [add_group G] (a : G) (b : G) (c : G) : a + (b - c) = a + b - c := sorry

theorem sub_add_eq_sub_sub_swap {G : Type u} [add_group G] (a : G) (b : G) (c : G) : a - (b + c) = a - c - b := sorry

@[simp] theorem add_sub_add_right_eq_sub {G : Type u} [add_group G] (a : G) (b : G) (c : G) : a + c - (b + c) = a - b := sorry

theorem eq_sub_of_add_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a + c = b) : a = b - c := sorry

theorem sub_eq_of_eq_add {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a = c + b) : a - b = c := sorry

theorem eq_add_of_sub_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a - c = b) : a = b + c := sorry

theorem add_eq_of_eq_sub {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a = c - b) : a + b = c := sorry

@[simp] theorem sub_right_inj {G : Type u} [add_group G] {a : G} {b : G} {c : G} : a - b = a - c ↔ b = c :=
  function.injective.eq_iff sub_right_injective

@[simp] theorem sub_left_inj {G : Type u} [add_group G] {a : G} {b : G} {c : G} : b - a = c - a ↔ b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b - a = c - a ↔ b = c)) (sub_eq_add_neg b a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b + -a = c - a ↔ b = c)) (sub_eq_add_neg c a))) (add_left_inj (-a)))

theorem sub_add_sub_cancel {G : Type u} [add_group G] (a : G) (b : G) (c : G) : a - b + (b - c) = a - c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b + (b - c) = a - c)) (Eq.symm (add_sub_assoc (a - b) b c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - b + b - c = a - c)) (sub_add_cancel a b))) (Eq.refl (a - c)))

theorem sub_sub_sub_cancel_right {G : Type u} [add_group G] (a : G) (b : G) (c : G) : a - c - (b - c) = a - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - c - (b - c) = a - b)) (Eq.symm (neg_sub c b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - c - -(c - b) = a - b)) (sub_neg_eq_add (a - c) (c - b))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a - c + (c - b) = a - b)) (sub_add_sub_cancel a c b))) (Eq.refl (a - b))))

theorem sub_sub_assoc_swap {G : Type u} [add_group G] {a : G} {b : G} {c : G} : a - (b - c) = a + c - b := sorry

theorem sub_eq_zero {G : Type u} [add_group G] {a : G} {b : G} : a - b = 0 ↔ a = b := sorry

theorem sub_ne_zero {G : Type u} [add_group G] {a : G} {b : G} : a - b ≠ 0 ↔ a ≠ b :=
  not_congr sub_eq_zero

theorem eq_sub_iff_add_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} : a = b - c ↔ a + c = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b - c ↔ a + c = b)) (sub_eq_add_neg b c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = b + -c ↔ a + c = b)) (propext eq_add_neg_iff_add_eq))) (iff.refl (a + c = b)))

theorem sub_eq_iff_eq_add {G : Type u} [add_group G] {a : G} {b : G} {c : G} : a - b = c ↔ a = c + b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = c ↔ a = c + b)) (sub_eq_add_neg a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -b = c ↔ a = c + b)) (propext add_neg_eq_iff_eq_add))) (iff.refl (a = c + b)))

theorem eq_iff_eq_of_sub_eq_sub {G : Type u} [add_group G] {a : G} {b : G} {c : G} {d : G} (H : a - b = c - d) : a = b ↔ c = d :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b ↔ c = d)) (Eq.symm (propext sub_eq_zero))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - b = 0 ↔ c = d)) H))
      (eq.mpr (id (Eq._oldrec (Eq.refl (c - d = 0 ↔ c = d)) (propext sub_eq_zero))) (iff.refl (c = d))))

theorem left_inverse_sub_add_left {G : Type u} [add_group G] (c : G) : function.left_inverse (fun (x : G) => x - c) fun (x : G) => x + c :=
  fun (x : G) => add_sub_cancel x c

theorem left_inverse_add_left_sub {G : Type u} [add_group G] (c : G) : function.left_inverse (fun (x : G) => x + c) fun (x : G) => x - c :=
  fun (x : G) => sub_add_cancel x c

theorem left_inverse_add_right_neg_add {G : Type u} [add_group G] (c : G) : function.left_inverse (fun (x : G) => c + x) fun (x : G) => -c + x :=
  fun (x : G) => add_neg_cancel_left c x

theorem left_inverse_neg_add_add_right {G : Type u} [add_group G] (c : G) : function.left_inverse (fun (x : G) => -c + x) fun (x : G) => c + x :=
  fun (x : G) => neg_add_cancel_left c x

theorem neg_add {G : Type u} [add_comm_group G] (a : G) (b : G) : -(a + b) = -a + -b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-(a + b) = -a + -b)) (neg_add_rev a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-b + -a = -a + -b)) (add_comm (-b) (-a)))) (Eq.refl (-a + -b)))

theorem sub_add_eq_sub_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - (b + c) = a - b - c := sorry

theorem neg_add_eq_sub {G : Type u} [add_comm_group G] (a : G) (b : G) : -a + b = b - a := sorry

theorem sub_add_eq_add_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - b + c = a + c - b := sorry

theorem sub_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - b - c = a - (b + c) := sorry

theorem sub_add {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - b + c = a - (b - c) := sorry

@[simp] theorem add_sub_add_left_eq_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : c + a - (c + b) = a - b := sorry

theorem eq_sub_of_add_eq' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} (h : c + a = b) : a = b - c := sorry

theorem sub_eq_of_eq_add' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} (h : a = b + c) : a - b = c := sorry

theorem eq_add_of_sub_eq' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} (h : a - b = c) : a = b + c := sorry

theorem add_eq_of_eq_sub' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} (h : b = c - a) : a + b = c := sorry

theorem sub_sub_self {G : Type u} [add_comm_group G] (a : G) (b : G) : a - (a - b) = b := sorry

theorem add_sub_comm {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) (d : G) : a + b - (c + d) = a - c + (b - d) := sorry

theorem sub_eq_sub_add_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - b = c - b + (a - c) := sorry

theorem neg_neg_sub_neg {G : Type u} [add_comm_group G] (a : G) (b : G) : -(-a - -b) = a - b := sorry

@[simp] theorem sub_sub_cancel {G : Type u} [add_comm_group G] (a : G) (b : G) : a - (a - b) = b :=
  sub_sub_self a b

theorem sub_eq_neg_add {G : Type u} [add_comm_group G] (a : G) (b : G) : a - b = -b + a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = -b + a)) (sub_eq_add_neg a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -b = -b + a)) (add_comm a (-b)))) (Eq.refl (-b + a)))

theorem neg_add' {G : Type u} [add_comm_group G] (a : G) (b : G) : -(a + b) = -a - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-(a + b) = -a - b)) (sub_eq_add_neg (-a) b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-(a + b) = -a + -b)) (neg_add a b))) (Eq.refl (-a + -b)))

@[simp] theorem neg_sub_neg {G : Type u} [add_comm_group G] (a : G) (b : G) : -a - -b = b - a := sorry

theorem eq_sub_iff_add_eq' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} : a = b - c ↔ c + a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b - c ↔ c + a = b)) (propext eq_sub_iff_add_eq)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + c = b ↔ c + a = b)) (add_comm a c))) (iff.refl (c + a = b)))

theorem sub_eq_iff_eq_add' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} : a - b = c ↔ a = b + c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = c ↔ a = b + c)) (propext sub_eq_iff_eq_add)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = c + b ↔ a = b + c)) (add_comm c b))) (iff.refl (a = b + c)))

@[simp] theorem add_sub_cancel' {G : Type u} [add_comm_group G] (a : G) (b : G) : a + b - a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b - a = b)) (sub_eq_neg_add (a + b) a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-a + (a + b) = b)) (neg_add_cancel_left a b))) (Eq.refl b))

@[simp] theorem add_sub_cancel'_right {G : Type u} [add_comm_group G] (a : G) (b : G) : a + (b - a) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + (b - a) = b)) (Eq.symm (add_sub_assoc a b a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + b - a = b)) (add_sub_cancel' a b))) (Eq.refl b))

-- This lemma is in the `simp` set under the name `add_neg_cancel_comm_assoc`,

-- defined  in `algebra/group/commute`

theorem add_add_neg_cancel'_right {G : Type u} [add_comm_group G] (a : G) (b : G) : a + (b + -a) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + (b + -a) = b)) (Eq.symm (sub_eq_add_neg b a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + (b - a) = b)) (add_sub_cancel'_right a b))) (Eq.refl b))

theorem sub_right_comm {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - b - c = a - c - b := sorry

@[simp] theorem add_add_sub_cancel {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a + c + (b - c) = a + b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + c + (b - c) = a + b)) (add_assoc a c (b - c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + (c + (b - c)) = a + b)) (add_sub_cancel'_right c b))) (Eq.refl (a + b)))

@[simp] theorem sub_add_add_cancel {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - c + (b + c) = a + b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - c + (b + c) = a + b)) (add_left_comm (a - c) b c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b + (a - c + c) = a + b)) (sub_add_cancel a c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (b + a = a + b)) (add_comm b a))) (Eq.refl (a + b))))

@[simp] theorem sub_add_sub_cancel' {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - b + (c - a) = c - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b + (c - a) = c - b)) (add_comm (a - b) (c - a)))) (sub_add_sub_cancel c a b)

@[simp] theorem add_sub_sub_cancel {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a + b - (a - c) = b + c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b - (a - c) = b + c)) (Eq.symm (sub_add (a + b) a c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + b - a + c = b + c)) (add_sub_cancel' a b))) (Eq.refl (b + c)))

@[simp] theorem sub_sub_sub_cancel_left {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : c - a - (c - b) = b - a := sorry

theorem sub_eq_sub_iff_add_eq_add {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} {d : G} : a - b = c - d ↔ a + d = c + b := sorry

theorem sub_eq_sub_iff_sub_eq_sub {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} {d : G} : a - b = c - d ↔ a - c = b - d := sorry


import data.real.basic
import data.nat.prime

/- Good work!
62/62
-/

/-
# Assignment 5

- Homework 5 is due on Friday, February 24.
- It is worth 62 points total.
- Goal: get a working copy of the proof of the ivt

# The intermediate value theorem
-/

def approaches_at (f : ℝ → ℝ) (b : ℝ) (a : ℝ) :=
∀ ε > 0, ∃ δ > 0, ∀ x, abs (x - a) < δ → abs (f x - b) < ε

def continuous (f : ℝ → ℝ) := ∀ a, approaches_at f (f a) a

section
variables (a b : ℝ) (f : ℝ → ℝ) (S : set ℝ)

#check Sup S

#check @Sup
#check Sup { x : ℝ | a ≤ x ∧ x ≤ b ∧ f x < 0 }

#check le_cSup
#check @le_cSup

#check cSup_le
--#check @cSup_le

--#print bdd_above.
--#print upper_bounds.

#check exists_lt_of_lt_cSup
--#check @exists_lt_of_lt_cSup

#check tactic.linarith

theorem ivt {f : ℝ → ℝ} {a b : ℝ} (aleb : a ≤ b)
    (ctsf : continuous f) (hfa : f a < 0) (hfb : 0 < f b) :
  ∃ x, a ≤ x ∧ x ≤ b ∧ f x = 0 :=
begin
  let S := {x : ℝ | a ≤ x ∧ x ≤ b ∧ f x < 0 },
  have ainS : a ∈ S,
  { --dsimp,
    exact ⟨le_refl a, aleb, hfa⟩,
  },

  have bddS : bdd_above S,
  { unfold bdd_above,
  use b,
  intros s sinS,
  exact sinS.2.1,
  },
  have Sfull : S.nonempty,
  {
  use a, exact ainS,
  },

  have e := Sup S,-- not the same
  let d := Sup S,-- same, but no eqn
  set c :=  Sup S with cdef,

  have cleb: c ≤ b,
  { apply cSup_le Sfull,
    intros s sinS,
    exact sinS.2.1,
  },

  have alec: a ≤ c,
  { exact le_cSup bddS ainS,
  },

  rcases trichotomous_of (<) (f c) 0 with h | h | h,
  {-- case where f c < 0, going for a contradiction
  exfalso,
  specialize ctsf c,
  set ε := - f c / 2 with εdef,
  have εpos : ε > 0 , linarith,
  specialize ctsf ε εpos,
  rcases ctsf with ⟨δ, δpos, hδ⟩,
  -- We need to check that c+δ/2 is _in_ S
  by_cases hcb: c+δ/2 > b,
  { have bnearc : | b - c | < δ,
    { rw abs_lt,
      split; linarith,-- note the ;
    },
    specialize hδ b bnearc,
    rw abs_lt at hδ,
    linarith, --deduces false from the inequalities
  },
  push_neg at hcb,
  -- now in the case where c+δ/2 ≤ b.
  have c2nearc: | c+ δ/2 -c | < δ,
  { simp,
    rw abs_lt,
    split; --; says "apply next command to all goals"
    linarith,
  },
  specialize hδ (c+δ/2) c2nearc,
  rw abs_lt at hδ,
  have fc2lt0 : f (c+δ/2) <0,
  { linarith,
  },
  have c2inS: c+δ/2 ∈ S,  --added after lecture
  { exact ⟨ by linarith,hcb, fc2lt0⟩,
  },
  have c2lec : c+δ/2 ≤c,  --added after lecture
  { exact le_cSup bddS c2inS,
  },
  linarith   /-PROBLEM 1 [2pts]: replace `sorry` with
             a single command on this line, using one
             that will work with linear equaltions and/or
             inequalities and derive a contradiction.
             Hint: it has closed 5 subgoals above already!-/
  },

  {/- case where f c = 0
      PROBLEM 2 [8pts]: complete the proof in this case.
      We wrote `Done!` for this case on the board-/
    exact ⟨c, alec, cleb, h⟩ --can be done in one line using angle braces like these: ⟨ , , ⟩
  },

  --case where 0 < f c , also for a contradiction
  /- PROBLEM 3 [52pts]: Fill in all the `sorry` commands below.
     OR, if you are looking for a challenge, delete the rest of the
     proof below and try to fill it in from scratch (or you
     can try a middle ground, where you comment out the proof,
     and only refer to it when you get stuck).  You get full credit
     either way, so it is fine to use the outline.
   -/

  exfalso,
  set ε := f c /2 with εdef, -- define a new ε = (f c)/2
  have εpos : 0 < ε, -- ε is positive
  { --[2pts]
    linarith
  },
  specialize ctsf c,  -- we are inerested in continuity at c
  specialize ctsf ε (εpos), -- use ε = (f c) / 2 in continuity at c
  rcases ctsf with ⟨ δ, δpos, hδ⟩, -- that produces a δ >0, which we study next

  have find_s : ∃ s ∈ S , c-δ/2 < s,
  { --[10pts] -- if you get stuck, look through the #check statements above.
    apply exists_lt_of_lt_cSup,
    apply Sfull,
    linarith
  },

  rcases find_s with ⟨ s, sinS, hs ⟩,-- pick a particular s ∈ S with c-δ/2 < s

  have slec : s ≤ c,
  { --[10pts]
    apply le_cSup,
    apply bddS,
    apply sinS
  },

  have snearc : |s - c| < δ,
  { --[10pts]
    have : |s - c| = c - s,
    {
      nth_rewrite 1 ←neg_sub,
      apply abs_of_nonpos,
      linarith
    },
    linarith
  },

  have fspos : 0 < f s,
  { --[15pts]
    by_contra fspos',
    push_neg at fspos',
    specialize (hδ s snearc),
    rw ←not_le at hδ,
    apply hδ,
    have : f s - f c ≤ 0, { linarith },
    rw abs_of_nonpos this,
    linarith
  },
  --[5pts]
  /- Verify that `linarith` alone does not work below.
     What is missing?
     It turns out the missing equation is f s < 0.
     We essentially want to type:
     linarith [f s < 0],
     which tells linarith to run its usual plan, but also
     use the inequality f s < 0.  However, we do not actually
     write an inequality in the square brackets; we instead
     write a _proof_ of the relevant inequality.
     So enter below the command
     linarith [something],
     where you replace the `something` with a proof term
     for  f s < 0.
     (Hint: use the fact that s ∈ S.)
  -/
  linarith [sinS.right.right]

end

end


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä, Moritz Doll
-/
import topology.algebra.module.basic
import linear_algebra.bilinear_map

/-!
# Weak dual topology

This file defines the weak topology given two vector spaces `E` and `F` over a commutative semiring
`𝕜` and a bilinear form `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`. The weak topology on `E` is the coarsest topology
such that for all `y : F` every map `λ x, B x y` is continuous.

In the case that `F = E →L[𝕜] 𝕜` and `B` being the canonical pairing, we obtain the weak-* topology,
`weak_dual 𝕜 E := (E →L[𝕜] 𝕜)`. Interchanging the arguments in the bilinear form yields the
weak topology `weak_space 𝕜 E := E`.

## Main definitions

The main definitions are the types `weak_bilin B` for the general case and the two special cases
`weak_dual 𝕜 E` and `weak_space 𝕜 E` with the respective topology instances on it.

* Given `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`, the type `weak_bilin B` is a type synonym for `E`.
* The instance `weak_bilin.topological_space` is the weak topology induced by the bilinear form `B`.
* `weak_dual 𝕜 E` is a type synonym for `dual 𝕜 E` (when the latter is defined): both are equal to
  the type `E →L[𝕜] 𝕜` of continuous linear maps from a module `E` over `𝕜` to the ring `𝕜`.
* The instance `weak_dual.topological_space` is the weak-* topology on `weak_dual 𝕜 E`, i.e., the
  coarsest topology making the evaluation maps at all `z : E` continuous.
* `weak_space 𝕜 E` is a type synonym for `E` (when the latter is defined).
* The instance `weak_dual.topological_space` is the weak topology on `E`, i.e., the
  coarsest topology such that all `v : dual 𝕜 E` remain continuous.

## Main results

We establish that `weak_bilin B` has the following structure:
* `weak_bilin.has_continuous_add`: The addition in `weak_bilin B` is continuous.
* `weak_bilin.has_continuous_smul`: The scalar multiplication in `weak_bilin B` is continuous.

We prove the following results characterizing the weak topology:
* `eval_continuous`: For any `y : F`, the evaluation mapping `λ x, B x y` is continuous.
* `continuous_of_continuous_eval`: For a mapping to `weak_bilin B` to be continuous,
  it suffices that its compositions with pairing with `B` at all points `y : F` is continuous.
* `tendsto_iff_forall_eval_tendsto`: Convergence in `weak_bilin B` can be characterized
  in terms of convergence of the evaluations at all points `y : F`.

## Notations

No new notation is introduced.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

weak-star, weak dual, duality

-/

noncomputable theory
open filter
open_locale topology

variables {α 𝕜 𝕝 R E F M : Type*}

section weak_topology

/-- The space `E` equipped with the weak topology induced by the bilinear form `B`. -/
@[derive [add_comm_monoid, module 𝕜],
nolint has_nonempty_instance unused_arguments]
def weak_bilin [comm_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] [add_comm_monoid F]
  [module 𝕜 F] (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) := E

namespace weak_bilin

instance [comm_semiring 𝕜] [a : add_comm_group E] [module 𝕜 E] [add_comm_monoid F]
  [module 𝕜 F] (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) : add_comm_group (weak_bilin B) := a

@[priority 100]
instance module' [comm_semiring 𝕜] [comm_semiring 𝕝] [add_comm_group E] [module 𝕜 E]
  [add_comm_group F] [module 𝕜 F] [m : module 𝕝 E] (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) :
  module 𝕝 (weak_bilin B) := m

instance [comm_semiring 𝕜] [comm_semiring 𝕝] [add_comm_group E] [module 𝕜 E]
  [add_comm_group F] [module 𝕜 F] [has_smul 𝕝 𝕜] [module 𝕝 E] [s : is_scalar_tower 𝕝 𝕜 E]
  (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) : is_scalar_tower 𝕝 𝕜 (weak_bilin B) := s

section semiring

variables [topological_space 𝕜] [comm_semiring 𝕜]
variables [add_comm_monoid E] [module 𝕜 E]
variables [add_comm_monoid F] [module 𝕜 F]
variables (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜)

instance : topological_space (weak_bilin B) :=
topological_space.induced (λ x y, B x y) Pi.topological_space

/-- The coercion `(λ x y, B x y) : E → (F → 𝕜)` is continuous. -/
lemma coe_fn_continuous : continuous (λ (x : weak_bilin B) y, B x y) :=
continuous_induced_dom

lemma eval_continuous (y : F) : continuous (λ x : weak_bilin B, B x y) :=
( continuous_pi_iff.mp (coe_fn_continuous B)) y

lemma continuous_of_continuous_eval [topological_space α] {g : α → weak_bilin B}
  (h : ∀ y, continuous (λ a, B (g a) y)) : continuous g :=
continuous_induced_rng.2 (continuous_pi_iff.mpr h)

/-- The coercion `(λ x y, B x y) : E → (F → 𝕜)` is an embedding. -/
lemma embedding {B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜} (hB : function.injective B) :
  embedding (λ (x : weak_bilin B)  y, B x y) :=
function.injective.embedding_induced $ linear_map.coe_injective.comp hB

theorem tendsto_iff_forall_eval_tendsto {l : filter α} {f : α → (weak_bilin B)} {x : weak_bilin B}
  (hB : function.injective B) : tendsto f l (𝓝 x) ↔ ∀ y, tendsto (λ i, B (f i) y) l (𝓝 (B x y)) :=
by rw [← tendsto_pi_nhds, embedding.tendsto_nhds_iff (embedding hB)]

/-- Addition in `weak_space B` is continuous. -/
instance [has_continuous_add 𝕜] : has_continuous_add (weak_bilin B) :=
begin
  refine ⟨continuous_induced_rng.2 _⟩,
  refine cast (congr_arg _ _) (((coe_fn_continuous B).comp continuous_fst).add
    ((coe_fn_continuous B).comp continuous_snd)),
  ext,
  simp only [function.comp_app, pi.add_apply, map_add, linear_map.add_apply],
end

/-- Scalar multiplication by `𝕜` on `weak_bilin B` is continuous. -/
instance [has_continuous_smul 𝕜 𝕜] : has_continuous_smul 𝕜 (weak_bilin B) :=
begin
  refine ⟨continuous_induced_rng.2 _⟩,
  refine cast (congr_arg _ _) (continuous_fst.smul ((coe_fn_continuous B).comp continuous_snd)),
  ext,
  simp only [function.comp_app, pi.smul_apply, linear_map.map_smulₛₗ, ring_hom.id_apply,
    linear_map.smul_apply],
end

end semiring

section ring

variables [topological_space 𝕜] [comm_ring 𝕜]
variables [add_comm_group E] [module 𝕜 E]
variables [add_comm_group F] [module 𝕜 F]
variables (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜)

/-- `weak_space B` is a `topological_add_group`, meaning that addition and negation are
continuous. -/
instance [has_continuous_add 𝕜] : topological_add_group (weak_bilin B) :=
{ to_has_continuous_add := by apply_instance,
  continuous_neg := begin
    refine continuous_induced_rng.2 (continuous_pi_iff.mpr (λ y, _)),
    refine cast (congr_arg _ _) (eval_continuous B (-y)),
    ext,
    simp only [map_neg, function.comp_app, linear_map.neg_apply],
  end }

end ring

end weak_bilin

end weak_topology

section weak_star_topology

/-- The canonical pairing of a vector space and its topological dual. -/
def top_dual_pairing (𝕜 E) [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
  [add_comm_monoid E] [module 𝕜 E] [topological_space E]
  [has_continuous_const_smul 𝕜 𝕜] :
  (E →L[𝕜] 𝕜) →ₗ[𝕜] E →ₗ[𝕜] 𝕜 := continuous_linear_map.coe_lm 𝕜

variables [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
variables [has_continuous_const_smul 𝕜 𝕜]
variables [add_comm_monoid E] [module 𝕜 E] [topological_space E]

lemma dual_pairing_apply (v : (E →L[𝕜] 𝕜)) (x : E) : top_dual_pairing 𝕜 E v x = v x := rfl

/-- The weak star topology is the topology coarsest topology on `E →L[𝕜] 𝕜` such that all
functionals `λ v, top_dual_pairing 𝕜 E v x` are continuous. -/
@[derive [add_comm_monoid, module 𝕜, topological_space, has_continuous_add]]
def weak_dual (𝕜 E) [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
  [has_continuous_const_smul 𝕜 𝕜] [add_comm_monoid E] [module 𝕜 E] [topological_space E] :=
weak_bilin (top_dual_pairing 𝕜 E)

namespace weak_dual

instance : inhabited (weak_dual 𝕜 E) := continuous_linear_map.inhabited

instance weak_dual.continuous_linear_map_class :
  continuous_linear_map_class (weak_dual 𝕜 E) 𝕜 E 𝕜 :=
continuous_linear_map.continuous_semilinear_map_class

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (weak_dual 𝕜 E) (λ _, E → 𝕜) := fun_like.has_coe_to_fun

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it acts on `weak_dual 𝕜 E`. -/
instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [has_continuous_const_smul M 𝕜] :
  mul_action M (weak_dual 𝕜 E) :=
continuous_linear_map.mul_action

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it acts distributively on `weak_dual 𝕜 E`. -/
instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [has_continuous_const_smul M 𝕜] :
  distrib_mul_action M (weak_dual 𝕜 E) :=
continuous_linear_map.distrib_mul_action

/-- If `𝕜` is a topological module over a semiring `R` and scalar multiplication commutes with the
multiplication on `𝕜`, then `weak_dual 𝕜 E` is a module over `R`. -/
instance module' (R) [semiring R] [module R 𝕜] [smul_comm_class 𝕜 R 𝕜]
  [has_continuous_const_smul R 𝕜] :
  module R (weak_dual 𝕜 E) :=
continuous_linear_map.module

instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [has_continuous_const_smul M 𝕜] : has_continuous_const_smul M (weak_dual 𝕜 E) :=
⟨λ m, continuous_induced_rng.2 $ (weak_bilin.coe_fn_continuous (top_dual_pairing 𝕜 E)).const_smul m⟩

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it continuously acts on `weak_dual 𝕜 E`. -/
instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [topological_space M] [has_continuous_smul M 𝕜] :
  has_continuous_smul M (weak_dual 𝕜 E) :=
⟨continuous_induced_rng.2 $ continuous_fst.smul ((weak_bilin.coe_fn_continuous
                          (top_dual_pairing 𝕜 E)).comp continuous_snd)⟩

lemma coe_fn_continuous : continuous (λ (x : weak_dual 𝕜 E) y, x y) :=
continuous_induced_dom

lemma eval_continuous (y : E) : continuous (λ x : weak_dual 𝕜 E, x y) :=
continuous_pi_iff.mp coe_fn_continuous y

lemma continuous_of_continuous_eval [topological_space α] {g : α → weak_dual 𝕜 E}
  (h : ∀ y, continuous (λ a, (g a) y)) : continuous g :=
continuous_induced_rng.2 (continuous_pi_iff.mpr h)

instance [t2_space 𝕜] : t2_space (weak_dual 𝕜 E) :=
embedding.t2_space $ weak_bilin.embedding $
  show function.injective (top_dual_pairing 𝕜 E), from continuous_linear_map.coe_injective

end weak_dual

/-- The weak topology is the topology coarsest topology on `E` such that all
functionals `λ x, top_dual_pairing 𝕜 E v x` are continuous. -/
@[derive [add_comm_monoid, module 𝕜, topological_space, has_continuous_add],
nolint has_nonempty_instance]
def weak_space (𝕜 E) [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
  [has_continuous_const_smul 𝕜 𝕜] [add_comm_monoid E] [module 𝕜 E] [topological_space E] :=
weak_bilin (top_dual_pairing 𝕜 E).flip

namespace weak_space

variables {𝕜 E F} [add_comm_monoid F] [module 𝕜 F] [topological_space F]

/-- A continuous linear map from `E` to `F` is still continuous when `E` and `F` are equipped with
their weak topologies. -/
def map (f : E →L[𝕜] F) :
  weak_space 𝕜 E →L[𝕜] weak_space 𝕜 F :=
{ cont := weak_bilin.continuous_of_continuous_eval _ (λ l, weak_bilin.eval_continuous _ (l ∘L f)),
  ..f }

lemma map_apply (f : E →L[𝕜] F) (x : E) : weak_space.map f x = f x := rfl
@[simp] lemma coe_map (f : E →L[𝕜] F) : (weak_space.map f : E → F) = f := rfl

end weak_space

theorem tendsto_iff_forall_eval_tendsto_top_dual_pairing
  {l : filter α} {f : α → weak_dual 𝕜 E} {x : weak_dual 𝕜 E} :
  tendsto f l (𝓝 x) ↔
    ∀ y, tendsto (λ i, top_dual_pairing 𝕜 E (f i) y) l (𝓝 (top_dual_pairing 𝕜 E x y)) :=
weak_bilin.tendsto_iff_forall_eval_tendsto _ continuous_linear_map.coe_injective

end weak_star_topology


/-
Copyright (c) 2018 Guy Leroy. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sangwoo Jo (aka Jason), Guy Leroy, Johannes Hölzl, Mario Carneiro

! This file was ported from Lean 3 source module data.int.gcd
! leanprover-community/mathlib commit d4f69d96f3532729da8ebb763f4bc26fcf640f06
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.GCD.Basic
import Mathlib.Algebra.Ring.Regular
import Mathlib.Data.Int.Dvd.Basic
import Mathlib.Order.Bounds.Basic
import Mathlib.Tactic.NormNum

/-!
# Extended GCD and divisibility over ℤ

## Main definitions

* Given `x y : ℕ`, `xgcd x y` computes the pair of integers `(a, b)` such that
  `gcd x y = x * a + y * b`. `gcd_a x y` and `gcd_b x y` are defined to be `a` and `b`,
  respectively.

## Main statements

* `gcd_eq_gcd_ab`: Bézout's lemma, given `x y : ℕ`, `gcd x y = x * gcd_a x y + y * gcd_b x y`.

## Tags

Bézout's lemma, Bezout's lemma
-/

/-! ### Extended Euclidean algorithm -/

namespace Nat

/-- Helper function for the extended GCD algorithm (`Nat.xgcd`). -/
def xgcdAux : ℕ → ℤ → ℤ → ℕ → ℤ → ℤ → ℕ × ℤ × ℤ
  | 0, _, _, r', s', t' => (r', s', t')
  | succ k, s, t, r', s', t' =>
    have : r' % succ k < succ k := mod_lt _ <| (succ_pos _).gt
    let q := r' / succ k
    xgcdAux (r' % succ k) (s' - q * s) (t' - q * t) (succ k) s t
#align nat.xgcd_aux Nat.xgcdAux

-- porting note: these are not in mathlib3; these equation lemmas are to fix
-- complaints by the Lean 4 `unusedHavesSuffices` linter obtained when `simp [xgcdAux]` is used.
theorem xgcdAux_zero : xgcdAux 0 s t r' s' t' = (r', s', t') := rfl

theorem xgcdAux_succ : xgcdAux (succ k) s t r' s' t' =
  xgcdAux (r' % succ k) (s' - (r' / succ k) * s) (t' - (r' / succ k) * t) (succ k) s t := rfl

@[simp]
theorem xgcd_zero_left {s t r' s' t'} : xgcdAux 0 s t r' s' t' = (r', s', t') := by simp [xgcdAux]
#align nat.xgcd_zero_left Nat.xgcd_zero_left

theorem xgcd_aux_rec {r s t r' s' t'} (h : 0 < r) :
    xgcdAux r s t r' s' t' = xgcdAux (r' % r) (s' - r' / r * s) (t' - r' / r * t) r s t := by
  obtain ⟨r, rfl⟩ := Nat.exists_eq_succ_of_ne_zero h.ne'
  rfl
#align nat.xgcd_aux_rec Nat.xgcd_aux_rec

/-- Use the extended GCD algorithm to generate the `a` and `b` values
  satisfying `gcd x y = x * a + y * b`. -/
def xgcd (x y : ℕ) : ℤ × ℤ :=
  (xgcdAux x 1 0 y 0 1).2
#align nat.xgcd Nat.xgcd

/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/
def gcdA (x y : ℕ) : ℤ :=
  (xgcd x y).1
#align nat.gcd_a Nat.gcdA

/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/
def gcdB (x y : ℕ) : ℤ :=
  (xgcd x y).2
#align nat.gcd_b Nat.gcdB

@[simp]
theorem gcdA_zero_left {s : ℕ} : gcdA 0 s = 0 := by
  unfold gcdA
  rw [xgcd, xgcd_zero_left]
#align nat.gcd_a_zero_left Nat.gcdA_zero_left

@[simp]
theorem gcdB_zero_left {s : ℕ} : gcdB 0 s = 1 := by
  unfold gcdB
  rw [xgcd, xgcd_zero_left]
#align nat.gcd_b_zero_left Nat.gcdB_zero_left

@[simp]
theorem gcdA_zero_right {s : ℕ} (h : s ≠ 0) : gcdA s 0 = 1 := by
  unfold gcdA xgcd
  obtain ⟨s, rfl⟩ := Nat.exists_eq_succ_of_ne_zero h
  -- Porting note: `simp [xgcdAux_succ]` crashes Lean here
  rw [xgcdAux_succ]
  rfl
#align nat.gcd_a_zero_right Nat.gcdA_zero_right

@[simp]
theorem gcdB_zero_right {s : ℕ} (h : s ≠ 0) : gcdB s 0 = 0 := by
  unfold gcdB xgcd
  obtain ⟨s, rfl⟩ := Nat.exists_eq_succ_of_ne_zero h
  -- Porting note: `simp [xgcdAux_succ]` crashes Lean here
  rw [xgcdAux_succ]
  rfl
#align nat.gcd_b_zero_right Nat.gcdB_zero_right

@[simp]
theorem xgcd_aux_fst (x y) : ∀ s t s' t', (xgcdAux x s t y s' t').1 = gcd x y :=
  gcd.induction x y (by simp) fun x y h IH s t s' t' => by
    simp [xgcd_aux_rec, h, IH]
    rw [← gcd_rec]
#align nat.xgcd_aux_fst Nat.xgcd_aux_fst

theorem xgcd_val (x y) : xgcd x y = (gcdA x y, gcdB x y) := by
  unfold gcdA gcdB; cases xgcd x y; rfl
#align nat.xgcd_val Nat.xgcd_val

section

variable (x y : ℕ)

private def P : ℕ × ℤ × ℤ → Prop
  | (r, s, t) => (r : ℤ) = x * s + y * t

theorem xgcd_aux_P {r r'} :
    ∀ {s t s' t'}, P x y (r, s, t) → P x y (r', s', t') → P x y (xgcdAux r s t r' s' t') := by
  induction r, r' using gcd.induction with
  | H0 => simp
  | H1 a b h IH =>
    intro s t s' t' p p'
    rw [xgcd_aux_rec h]; refine' IH _ p; dsimp [P] at *
    rw [Int.emod_def]; generalize (b / a : ℤ) = k
    rw [p, p', mul_sub, sub_add_eq_add_sub, mul_sub, add_mul, mul_comm k t, mul_comm k s,
      ← mul_assoc, ← mul_assoc, add_comm (x * s * k), ← add_sub_assoc, sub_sub]
set_option linter.uppercaseLean3 false in
#align nat.xgcd_aux_P Nat.xgcd_aux_P

/-- **Bézout's lemma**: given `x y : ℕ`, `gcd x y = x * a + y * b`, where `a = gcd_a x y` and
`b = gcd_b x y` are computed by the extended Euclidean algorithm.
-/
theorem gcd_eq_gcd_ab : (gcd x y : ℤ) = x * gcdA x y + y * gcdB x y := by
  have := @xgcd_aux_P x y x y 1 0 0 1 (by simp [P]) (by simp [P])
  rwa [xgcd_aux_val, xgcd_val] at this
#align nat.gcd_eq_gcd_ab Nat.gcd_eq_gcd_ab

end

theorem exists_mul_emod_eq_gcd {k n : ℕ} (hk : gcd n k < k) : ∃ m, n * m % k = gcd n k := by
  have hk' := Int.ofNat_ne_zero.2 (ne_of_gt (lt_of_le_of_lt (zero_le (gcd n k)) hk))
  have key := congr_arg (fun (m : ℤ) => (m % k).toNat) (gcd_eq_gcd_ab n k)
  simp only at key
  rw [Int.add_mul_emod_self_left, ← Int.coe_nat_mod, Int.toNat_coe_nat, mod_eq_of_lt hk] at key
  refine' ⟨(n.gcdA k % k).toNat, Eq.trans (Int.ofNat.inj _) key.symm⟩
  rw [Int.ofNat_eq_coe, Int.coe_nat_mod, Int.ofNat_mul, Int.toNat_of_nonneg (Int.emod_nonneg _ hk'),
    Int.ofNat_eq_coe, Int.toNat_of_nonneg (Int.emod_nonneg _ hk'), Int.mul_emod, Int.emod_emod,
    ← Int.mul_emod]
#align nat.exists_mul_mod_eq_gcd Nat.exists_mul_emod_eq_gcd

theorem exists_mul_emod_eq_one_of_coprime {k n : ℕ} (hkn : coprime n k) (hk : 1 < k) :
    ∃ m, n * m % k = 1 :=
  Exists.recOn (exists_mul_emod_eq_gcd (lt_of_le_of_lt (le_of_eq hkn) hk)) fun m hm ↦
    ⟨m, hm.trans hkn⟩
#align nat.exists_mul_mod_eq_one_of_coprime Nat.exists_mul_emod_eq_one_of_coprime

end Nat

/-! ### Divisibility over ℤ -/

namespace Int

protected theorem coe_nat_gcd (m n : ℕ) : Int.gcd ↑m ↑n = Nat.gcd m n :=
  rfl
#align int.coe_nat_gcd Int.coe_nat_gcd

/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/
def gcdA : ℤ → ℤ → ℤ
  | ofNat m, n => m.gcdA n.natAbs
  | -[m+1], n => -m.succ.gcdA n.natAbs
#align int.gcd_a Int.gcdA

/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/
def gcdB : ℤ → ℤ → ℤ
  | m, ofNat n => m.natAbs.gcdB n
  | m, -[n+1] => -m.natAbs.gcdB n.succ
#align int.gcd_b Int.gcdB

/-- **Bézout's lemma** -/
theorem gcd_eq_gcd_ab : ∀ x y : ℤ, (gcd x y : ℤ) = x * gcdA x y + y * gcdB x y
  | (m : ℕ), (n : ℕ) => Nat.gcd_eq_gcd_ab _ _
  | (m : ℕ), -[n+1] =>
    show (_ : ℤ) = _ + -(n + 1) * -_ by rw [neg_mul_neg]; apply Nat.gcd_eq_gcd_ab
  | -[m+1], (n : ℕ) =>
    show (_ : ℤ) = -(m + 1) * -_ + _ by rw [neg_mul_neg]; apply Nat.gcd_eq_gcd_ab
  | -[m+1], -[n+1] =>
    show (_ : ℤ) = -(m + 1) * -_ + -(n + 1) * -_ by
      rw [neg_mul_neg, neg_mul_neg]
      apply Nat.gcd_eq_gcd_ab
#align int.gcd_eq_gcd_ab Int.gcd_eq_gcd_ab

theorem natAbs_ediv (a b : ℤ) (H : b ∣ a) : natAbs (a / b) = natAbs a / natAbs b := by
  rcases Nat.eq_zero_or_pos (natAbs b) with (h | h)
  rw [natAbs_eq_zero.1 h]
  simp [Int.ediv_zero]
  calc
    natAbs (a / b) = natAbs (a / b) * 1 := by rw [mul_one]
    _ = natAbs (a / b) * (natAbs b / natAbs b) := by rw [Nat.div_self h]
    _ = natAbs (a / b) * natAbs b / natAbs b := by rw [Nat.mul_div_assoc _ dvd_rfl]
    _ = natAbs (a / b * b) / natAbs b := by rw [natAbs_mul (a / b) b]
    _ = natAbs a / natAbs b := by rw [Int.ediv_mul_cancel H]
#align int.nat_abs_div Int.natAbs_ediv

theorem dvd_of_mul_dvd_mul_left {i j k : ℤ} (k_non_zero : k ≠ 0) (H : k * i ∣ k * j) : i ∣ j :=
  Dvd.elim H fun l H1 => by rw [mul_assoc] at H1; exact ⟨_, mul_left_cancel₀ k_non_zero H1⟩
#align int.dvd_of_mul_dvd_mul_left Int.dvd_of_mul_dvd_mul_left

theorem dvd_of_mul_dvd_mul_right {i j k : ℤ} (k_non_zero : k ≠ 0) (H : i * k ∣ j * k) : i ∣ j := by
  rw [mul_comm i k, mul_comm j k] at H; exact dvd_of_mul_dvd_mul_left k_non_zero H
#align int.dvd_of_mul_dvd_mul_right Int.dvd_of_mul_dvd_mul_right

/-- ℤ specific version of least common multiple. -/
def lcm (i j : ℤ) : ℕ :=
  Nat.lcm (natAbs i) (natAbs j)
#align int.lcm Int.lcm

theorem lcm_def (i j : ℤ) : lcm i j = Nat.lcm (natAbs i) (natAbs j) :=
  rfl
#align int.lcm_def Int.lcm_def

protected theorem coe_nat_lcm (m n : ℕ) : Int.lcm ↑m ↑n = Nat.lcm m n :=
  rfl
#align int.coe_nat_lcm Int.coe_nat_lcm

theorem gcd_dvd_left (i j : ℤ) : (gcd i j : ℤ) ∣ i :=
  dvd_natAbs.mp <| coe_nat_dvd.mpr <| Nat.gcd_dvd_left _ _
#align int.gcd_dvd_left Int.gcd_dvd_left

theorem gcd_dvd_right (i j : ℤ) : (gcd i j : ℤ) ∣ j :=
  dvd_natAbs.mp <| coe_nat_dvd.mpr <| Nat.gcd_dvd_right _ _
#align int.gcd_dvd_right Int.gcd_dvd_right

theorem dvd_gcd {i j k : ℤ} (h1 : k ∣ i) (h2 : k ∣ j) : k ∣ gcd i j :=
  natAbs_dvd.1 <|
    coe_nat_dvd.2 <| Nat.dvd_gcd (natAbs_dvd_natAbs.2 h1) (natAbs_dvd_natAbs.2 h2)
#align int.dvd_gcd Int.dvd_gcd

theorem gcd_mul_lcm (i j : ℤ) : gcd i j * lcm i j = natAbs (i * j) := by
  rw [Int.gcd, Int.lcm, Nat.gcd_mul_lcm, natAbs_mul]
#align int.gcd_mul_lcm Int.gcd_mul_lcm

theorem gcd_comm (i j : ℤ) : gcd i j = gcd j i :=
  Nat.gcd_comm _ _
#align int.gcd_comm Int.gcd_comm

theorem gcd_assoc (i j k : ℤ) : gcd (gcd i j) k = gcd i (gcd j k) :=
  Nat.gcd_assoc _ _ _
#align int.gcd_assoc Int.gcd_assoc

@[simp]
theorem gcd_self (i : ℤ) : gcd i i = natAbs i := by simp [gcd]
#align int.gcd_self Int.gcd_self

@[simp]
theorem gcd_zero_left (i : ℤ) : gcd 0 i = natAbs i := by simp [gcd]
#align int.gcd_zero_left Int.gcd_zero_left

@[simp]
theorem gcd_zero_right (i : ℤ) : gcd i 0 = natAbs i := by simp [gcd]
#align int.gcd_zero_right Int.gcd_zero_right

@[simp]
theorem gcd_one_left (i : ℤ) : gcd 1 i = 1 :=
  Nat.gcd_one_left _
#align int.gcd_one_left Int.gcd_one_left

@[simp]
theorem gcd_one_right (i : ℤ) : gcd i 1 = 1 :=
  Nat.gcd_one_right _
#align int.gcd_one_right Int.gcd_one_right

@[simp]
theorem gcd_neg_right {x y : ℤ} : gcd x (-y) = gcd x y := by rw [Int.gcd, Int.gcd, natAbs_neg]
#align int.gcd_neg_right Int.gcd_neg_right

@[simp]
theorem gcd_neg_left {x y : ℤ} : gcd (-x) y = gcd x y := by rw [Int.gcd, Int.gcd, natAbs_neg]
#align int.gcd_neg_left Int.gcd_neg_left

theorem gcd_mul_left (i j k : ℤ) : gcd (i * j) (i * k) = natAbs i * gcd j k := by
  rw [Int.gcd, Int.gcd, natAbs_mul, natAbs_mul]
  apply Nat.gcd_mul_left
#align int.gcd_mul_left Int.gcd_mul_left

theorem gcd_mul_right (i j k : ℤ) : gcd (i * j) (k * j) = gcd i k * natAbs j := by
  rw [Int.gcd, Int.gcd, natAbs_mul, natAbs_mul]
  apply Nat.gcd_mul_right
#align int.gcd_mul_right Int.gcd_mul_right

theorem gcd_pos_of_non_zero_left {i : ℤ} (j : ℤ) (i_non_zero : i ≠ 0) : 0 < gcd i j :=
  Nat.gcd_pos_of_pos_left (natAbs j) (natAbs_pos.2 i_non_zero)
#align int.gcd_pos_of_non_zero_left Int.gcd_pos_of_non_zero_left

theorem gcd_pos_of_non_zero_right (i : ℤ) {j : ℤ} (j_non_zero : j ≠ 0) : 0 < gcd i j :=
  Nat.gcd_pos_of_pos_right (natAbs i) (natAbs_pos.2 j_non_zero)
#align int.gcd_pos_of_non_zero_right Int.gcd_pos_of_non_zero_right

theorem gcd_eq_zero_iff {i j : ℤ} : gcd i j = 0 ↔ i = 0 ∧ j = 0 := by
  rw [gcd, Nat.gcd_eq_zero_iff, natAbs_eq_zero, natAbs_eq_zero]
#align int.gcd_eq_zero_iff Int.gcd_eq_zero_iff

theorem gcd_pos_iff {i j : ℤ} : 0 < gcd i j ↔ i ≠ 0 ∨ j ≠ 0 :=
  pos_iff_ne_zero.trans <| gcd_eq_zero_iff.not.trans not_and_or
#align int.gcd_pos_iff Int.gcd_pos_iff

theorem gcd_div {i j k : ℤ} (H1 : k ∣ i) (H2 : k ∣ j) :
    gcd (i / k) (j / k) = gcd i j / natAbs k := by
  rw [gcd, natAbs_ediv i k H1, natAbs_ediv j k H2]
  exact Nat.gcd_div (natAbs_dvd_natAbs.mpr H1) (natAbs_dvd_natAbs.mpr H2)
#align int.gcd_div Int.gcd_div

theorem gcd_div_gcd_div_gcd {i j : ℤ} (H : 0 < gcd i j) : gcd (i / gcd i j) (j / gcd i j) = 1 := by
  rw [gcd_div (gcd_dvd_left i j) (gcd_dvd_right i j), natAbs_ofNat, Nat.div_self H]
#align int.gcd_div_gcd_div_gcd Int.gcd_div_gcd_div_gcd

theorem gcd_dvd_gcd_of_dvd_left {i k : ℤ} (j : ℤ) (H : i ∣ k) : gcd i j ∣ gcd k j :=
  Int.coe_nat_dvd.1 <| dvd_gcd ((gcd_dvd_left i j).trans H) (gcd_dvd_right i j)
#align int.gcd_dvd_gcd_of_dvd_left Int.gcd_dvd_gcd_of_dvd_left

theorem gcd_dvd_gcd_of_dvd_right {i k : ℤ} (j : ℤ) (H : i ∣ k) : gcd j i ∣ gcd j k :=
  Int.coe_nat_dvd.1 <| dvd_gcd (gcd_dvd_left j i) ((gcd_dvd_right j i).trans H)
#align int.gcd_dvd_gcd_of_dvd_right Int.gcd_dvd_gcd_of_dvd_right

theorem gcd_dvd_gcd_mul_left (i j k : ℤ) : gcd i j ∣ gcd (k * i) j :=
  gcd_dvd_gcd_of_dvd_left _ (dvd_mul_left _ _)
#align int.gcd_dvd_gcd_mul_left Int.gcd_dvd_gcd_mul_left

theorem gcd_dvd_gcd_mul_right (i j k : ℤ) : gcd i j ∣ gcd (i * k) j :=
  gcd_dvd_gcd_of_dvd_left _ (dvd_mul_right _ _)
#align int.gcd_dvd_gcd_mul_right Int.gcd_dvd_gcd_mul_right

theorem gcd_dvd_gcd_mul_left_right (i j k : ℤ) : gcd i j ∣ gcd i (k * j) :=
  gcd_dvd_gcd_of_dvd_right _ (dvd_mul_left _ _)
#align int.gcd_dvd_gcd_mul_left_right Int.gcd_dvd_gcd_mul_left_right

theorem gcd_dvd_gcd_mul_right_right (i j k : ℤ) : gcd i j ∣ gcd i (j * k) :=
  gcd_dvd_gcd_of_dvd_right _ (dvd_mul_right _ _)
#align int.gcd_dvd_gcd_mul_right_right Int.gcd_dvd_gcd_mul_right_right

theorem gcd_eq_left {i j : ℤ} (H : i ∣ j) : gcd i j = natAbs i :=
  Nat.dvd_antisymm (Nat.gcd_dvd_left _ _) (Nat.dvd_gcd dvd_rfl (natAbs_dvd_natAbs.mpr H))
#align int.gcd_eq_left Int.gcd_eq_left

theorem gcd_eq_right {i j : ℤ} (H : j ∣ i) : gcd i j = natAbs j := by rw [gcd_comm, gcd_eq_left H]
#align int.gcd_eq_right Int.gcd_eq_right

theorem ne_zero_of_gcd {x y : ℤ} (hc : gcd x y ≠ 0) : x ≠ 0 ∨ y ≠ 0 := by
  contrapose! hc
  rw [hc.left, hc.right, gcd_zero_right, natAbs_zero]
#align int.ne_zero_of_gcd Int.ne_zero_of_gcd

theorem exists_gcd_one {m n : ℤ} (H : 0 < gcd m n) :
    ∃ m' n' : ℤ, gcd m' n' = 1 ∧ m = m' * gcd m n ∧ n = n' * gcd m n :=
  ⟨_, _, gcd_div_gcd_div_gcd H, (Int.ediv_mul_cancel (gcd_dvd_left m n)).symm,
    (Int.ediv_mul_cancel (gcd_dvd_right m n)).symm⟩
#align int.exists_gcd_one Int.exists_gcd_one

theorem exists_gcd_one' {m n : ℤ} (H : 0 < gcd m n) :
    ∃ (g : ℕ)(m' n' : ℤ), 0 < g ∧ gcd m' n' = 1 ∧ m = m' * g ∧ n = n' * g :=
  let ⟨m', n', h⟩ := exists_gcd_one H
  ⟨_, m', n', H, h⟩
#align int.exists_gcd_one' Int.exists_gcd_one'

theorem pow_dvd_pow_iff {m n : ℤ} {k : ℕ} (k0 : 0 < k) : m ^ k ∣ n ^ k ↔ m ∣ n := by
  refine' ⟨fun h => _, fun h => pow_dvd_pow_of_dvd h _⟩
  rwa [← natAbs_dvd_natAbs, ← Nat.pow_dvd_pow_iff k0, ← Int.natAbs_pow, ← Int.natAbs_pow,
    natAbs_dvd_natAbs]
#align int.pow_dvd_pow_iff Int.pow_dvd_pow_iff

theorem gcd_dvd_iff {a b : ℤ} {n : ℕ} : gcd a b ∣ n ↔ ∃ x y : ℤ, ↑n = a * x + b * y := by
  constructor
  · intro h
    rw [← Nat.mul_div_cancel' h, Int.ofNat_mul, gcd_eq_gcd_ab, add_mul, mul_assoc, mul_assoc]
    exact ⟨_, _, rfl⟩
  · rintro ⟨x, y, h⟩
    rw [← Int.coe_nat_dvd, h]
    exact
      dvd_add (dvd_mul_of_dvd_left (gcd_dvd_left a b) _) (dvd_mul_of_dvd_left (gcd_dvd_right a b) y)
#align int.gcd_dvd_iff Int.gcd_dvd_iff

theorem gcd_greatest {a b d : ℤ} (hd_pos : 0 ≤ d) (hda : d ∣ a) (hdb : d ∣ b)
    (hd : ∀ e : ℤ, e ∣ a → e ∣ b → e ∣ d) : d = gcd a b :=
  dvd_antisymm hd_pos (ofNat_zero_le (gcd a b)) (dvd_gcd hda hdb)
    (hd _ (gcd_dvd_left a b) (gcd_dvd_right a b))
#align int.gcd_greatest Int.gcd_greatest

/-- Euclid's lemma: if `a ∣ b * c` and `gcd a c = 1` then `a ∣ b`.
Compare with `IsCoprime.dvd_of_dvd_mul_left` and
`UniqueFactorizationMonoid.dvd_of_dvd_mul_left_of_no_prime_factors` -/
theorem dvd_of_dvd_mul_left_of_gcd_one {a b c : ℤ} (habc : a ∣ b * c) (hab : gcd a c = 1) :
    a ∣ b := by
  have := gcd_eq_gcd_ab a c
  simp only [hab, Int.ofNat_zero, Int.ofNat_succ, zero_add] at this
  have : b * a * gcdA a c + b * c * gcdB a c = b := by simp [mul_assoc, ← mul_add, ← this]
  rw [← this]
  exact dvd_add (dvd_mul_of_dvd_left (dvd_mul_left a b) _) (dvd_mul_of_dvd_left habc _)
#align int.dvd_of_dvd_mul_left_of_gcd_one Int.dvd_of_dvd_mul_left_of_gcd_one

/-- Euclid's lemma: if `a ∣ b * c` and `gcd a b = 1` then `a ∣ c`.
Compare with `IsCoprime.dvd_of_dvd_mul_right` and
`UniqueFactorizationMonoid.dvd_of_dvd_mul_right_of_no_prime_factors` -/
theorem dvd_of_dvd_mul_right_of_gcd_one {a b c : ℤ} (habc : a ∣ b * c) (hab : gcd a b = 1) :
    a ∣ c := by
  rw [mul_comm] at habc
  exact dvd_of_dvd_mul_left_of_gcd_one habc hab
#align int.dvd_of_dvd_mul_right_of_gcd_one Int.dvd_of_dvd_mul_right_of_gcd_one

/-- For nonzero integers `a` and `b`, `gcd a b` is the smallest positive natural number that can be
written in the form `a * x + b * y` for some pair of integers `x` and `y` -/
theorem gcd_least_linear {a b : ℤ} (ha : a ≠ 0) :
    IsLeast { n : ℕ | 0 < n ∧ ∃ x y : ℤ, ↑n = a * x + b * y } (a.gcd b) := by
  simp_rw [← gcd_dvd_iff]
  constructor
  · simpa [and_true_iff, dvd_refl, Set.mem_setOf_eq] using gcd_pos_of_non_zero_left b ha
  · simp only [lowerBounds, and_imp, Set.mem_setOf_eq]
    exact fun n hn_pos hn => Nat.le_of_dvd hn_pos hn
#align int.gcd_least_linear Int.gcd_least_linear

/-! ### lcm -/

theorem lcm_comm (i j : ℤ) : lcm i j = lcm j i := by
  rw [Int.lcm, Int.lcm]
  exact Nat.lcm_comm _ _
#align int.lcm_comm Int.lcm_comm

theorem lcm_assoc (i j k : ℤ) : lcm (lcm i j) k = lcm i (lcm j k) := by
  rw [Int.lcm, Int.lcm, Int.lcm, Int.lcm, natAbs_ofNat, natAbs_ofNat]
  apply Nat.lcm_assoc
#align int.lcm_assoc Int.lcm_assoc

@[simp]
theorem lcm_zero_left (i : ℤ) : lcm 0 i = 0 := by
  rw [Int.lcm]
  apply Nat.lcm_zero_left
#align int.lcm_zero_left Int.lcm_zero_left

@[simp]
theorem lcm_zero_right (i : ℤ) : lcm i 0 = 0 := by
  rw [Int.lcm]
  apply Nat.lcm_zero_right
#align int.lcm_zero_right Int.lcm_zero_right

@[simp]
theorem lcm_one_left (i : ℤ) : lcm 1 i = natAbs i := by
  rw [Int.lcm]
  apply Nat.lcm_one_left
#align int.lcm_one_left Int.lcm_one_left

@[simp]
theorem lcm_one_right (i : ℤ) : lcm i 1 = natAbs i := by
  rw [Int.lcm]
  apply Nat.lcm_one_right
#align int.lcm_one_right Int.lcm_one_right

@[simp]
theorem lcm_self (i : ℤ) : lcm i i = natAbs i := by
  rw [Int.lcm]
  apply Nat.lcm_self
#align int.lcm_self Int.lcm_self

theorem dvd_lcm_left (i j : ℤ) : i ∣ lcm i j := by
  rw [Int.lcm]
  apply coe_nat_dvd_right.mpr
  apply Nat.dvd_lcm_left
#align int.dvd_lcm_left Int.dvd_lcm_left

theorem dvd_lcm_right (i j : ℤ) : j ∣ lcm i j := by
  rw [Int.lcm]
  apply coe_nat_dvd_right.mpr
  apply Nat.dvd_lcm_right
#align int.dvd_lcm_right Int.dvd_lcm_right

theorem lcm_dvd {i j k : ℤ} : i ∣ k → j ∣ k → (lcm i j : ℤ) ∣ k := by
  rw [Int.lcm]
  intro hi hj
  exact coe_nat_dvd_left.mpr (Nat.lcm_dvd (natAbs_dvd_natAbs.mpr hi) (natAbs_dvd_natAbs.mpr hj))
#align int.lcm_dvd Int.lcm_dvd

end Int

@[to_additive gcd_nsmul_eq_zero]
theorem pow_gcd_eq_one {M : Type _} [Monoid M] (x : M) {m n : ℕ} (hm : x ^ m = 1) (hn : x ^ n = 1) :
    x ^ m.gcd n = 1 := by
  rcases m with (rfl | m); · simp [hn]
  obtain ⟨y, rfl⟩ := isUnit_ofPowEqOne hm m.succ_ne_zero
  simp only [← Units.val_pow_eq_pow_val] at *
  rw [← Units.val_one, ← zpow_coe_nat, ← Units.ext_iff] at *
  simp only [Nat.gcd_eq_gcd_ab, zpow_add, zpow_mul, hm, hn, one_zpow, one_mul]
#align pow_gcd_eq_one pow_gcd_eq_one
#align gcd_nsmul_eq_zero gcd_nsmul_eq_zero

/-! ### GCD prover -/

-- open NormNum

-- namespace Tactic

-- namespace NormNum

-- theorem int_gcd_helper' {d : ℕ} {x y a b : ℤ} (h₁ : (d : ℤ) ∣ x) (h₂ : (d : ℤ) ∣ y)
--     (h₃ : x * a + y * b = d) : Int.gcd x y = d := by
--   refine' Nat.dvd_antisymm _ (Int.coe_nat_dvd.1 (Int.dvd_gcd h₁ h₂))
--   rw [← Int.coe_nat_dvd, ← h₃]
--   apply dvd_add
--   · exact (Int.gcd_dvd_left _ _).mul_right _
--   · exact (Int.gcd_dvd_right _ _).mul_right _
-- #align tactic.norm_num.int_gcd_helper' Tactic.NormNum.int_gcd_helper'

-- theorem nat_gcd_helper_dvd_left (x y a : ℕ) (h : x * a = y) : Nat.gcd x y = x :=
--   Nat.gcd_eq_left ⟨a, h.symm⟩
-- #align tactic.norm_num.nat_gcd_helper_dvd_left Tactic.NormNum.nat_gcd_helper_dvd_left

-- theorem nat_gcd_helper_dvd_right (x y a : ℕ) (h : y * a = x) : Nat.gcd x y = y :=
--   Nat.gcd_eq_right ⟨a, h.symm⟩
-- #align tactic.norm_num.nat_gcd_helper_dvd_right Tactic.NormNum.nat_gcd_helper_dvd_right

-- theorem nat_gcd_helper_2 (d x y a b u v tx ty : ℕ) (hu : d * u = x) (hv : d * v = y)
--     (hx : x * a = tx) (hy : y * b = ty) (h : ty + d = tx) : Nat.gcd x y = d := by
--   rw [← Int.coe_nat_gcd];
--   apply
--     @int_gcd_helper' _ _ _ a (-b) (Int.coe_nat_dvd.2 ⟨_, hu.symm⟩) (Int.coe_nat_dvd.2
--      ⟨_, hv.symm⟩)
--   rw [mul_neg, ← sub_eq_add_neg, sub_eq_iff_eq_add']
--   norm_cast; rw [hx, hy, h]
-- #align tactic.norm_num.nat_gcd_helper_2 Tactic.NormNum.nat_gcd_helper_2

-- theorem nat_gcd_helper_1 (d x y a b u v tx ty : ℕ) (hu : d * u = x) (hv : d * v = y)
--     (hx : x * a = tx) (hy : y * b = ty) (h : tx + d = ty) : Nat.gcd x y = d :=
--   (Nat.gcd_comm _ _).trans <| nat_gcd_helper_2 _ _ _ _ _ _ _ _ _ hv hu hy hx h
-- #align tactic.norm_num.nat_gcd_helper_1 Tactic.NormNum.nat_gcd_helper_1

-- --Porting note: the `simp only` was not necessary in Lean3.
-- theorem nat_lcm_helper (x y d m n : ℕ) (hd : Nat.gcd x y = d) (d0 : 0 < d) (xy : x * y = n)
--     (dm : d * m = n) : Nat.lcm x y = m :=
--   mul_right_injective₀ d0.ne' <| by simp only; rw [dm, ← xy, ← hd, Nat.gcd_mul_lcm]
-- #align tactic.norm_num.nat_lcm_helper Tactic.NormNum.nat_lcm_helper

-- theorem nat_coprime_helper_zero_left (x : ℕ) (h : 1 < x) : ¬Nat.coprime 0 x :=
--   mt (Nat.coprime_zero_left _).1 <| ne_of_gt h
-- #align tactic.norm_num.nat_coprime_helper_zero_left Tactic.NormNum.nat_coprime_helper_zero_left

-- theorem nat_coprime_helper_zero_right (x : ℕ) (h : 1 < x) : ¬Nat.coprime x 0 :=
--   mt (Nat.coprime_zero_right _).1 <| ne_of_gt h
-- #align tactic.norm_num.nat_coprime_helper_zero_right Tactic.NormNum.nat_coprime_helper_zero_right

-- theorem nat_coprime_helper_1 (x y a b tx ty : ℕ) (hx : x * a = tx) (hy : y * b = ty)
--     (h : tx + 1 = ty) : Nat.coprime x y :=
--   nat_gcd_helper_1 _ _ _ _ _ _ _ _ _ (one_mul _) (one_mul _) hx hy h
-- #align tactic.norm_num.nat_coprime_helper_1 Tactic.NormNum.nat_coprime_helper_1

-- theorem nat_coprime_helper_2 (x y a b tx ty : ℕ) (hx : x * a = tx) (hy : y * b = ty)
--     (h : ty + 1 = tx) : Nat.coprime x y :=
--   nat_gcd_helper_2 _ _ _ _ _ _ _ _ _ (one_mul _) (one_mul _) hx hy h
-- #align tactic.norm_num.nat_coprime_helper_2 Tactic.NormNum.nat_coprime_helper_2

-- theorem nat_not_coprime_helper (d x y u v : ℕ) (hu : d * u = x) (hv : d * v = y) (h : 1 < d) :
--     ¬Nat.coprime x y :=
--   Nat.not_coprime_of_dvd_of_dvd h ⟨_, hu.symm⟩ ⟨_, hv.symm⟩
-- #align tactic.norm_num.nat_not_coprime_helper Tactic.NormNum.nat_not_coprime_helper

-- theorem int_gcd_helper (x y : ℤ) (nx ny d : ℕ) (hx : (nx : ℤ) = x) (hy : (ny : ℤ) = y)
--     (h : Nat.gcd nx ny = d) : Int.gcd x y = d := by rwa [← hx, ← hy, Int.coe_nat_gcd]
-- #align tactic.norm_num.int_gcd_helper Tactic.NormNum.int_gcd_helper

-- theorem int_gcd_helper_neg_left (x y : ℤ) (d : ℕ) (h : Int.gcd x y = d) : Int.gcd (-x) y = d :=
--  by rw [Int.gcd] at h⊢; rwa [Int.natAbs_neg]
-- #align tactic.norm_num.int_gcd_helper_neg_left Tactic.NormNum.int_gcd_helper_neg_left

-- theorem int_gcd_helper_neg_right (x y : ℤ) (d : ℕ) (h : Int.gcd x y = d) : Int.gcd x (-y) = d :=
--  by rw [Int.gcd] at h⊢; rwa [Int.natAbs_neg]
-- #align tactic.norm_num.int_gcd_helper_neg_right Tactic.NormNum.int_gcd_helper_neg_right

-- theorem int_lcm_helper (x y : ℤ) (nx ny d : ℕ) (hx : (nx : ℤ) = x) (hy : (ny : ℤ) = y)
--     (h : Nat.lcm nx ny = d) : Int.lcm x y = d := by rwa [← hx, ← hy, Int.coe_nat_lcm]
-- #align tactic.norm_num.int_lcm_helper Tactic.NormNum.int_lcm_helper

-- theorem int_lcm_helper_neg_left (x y : ℤ) (d : ℕ) (h : Int.lcm x y = d) : Int.lcm (-x) y = d :=
--  by rw [Int.lcm] at h⊢; rwa [Int.natAbs_neg]
-- #align tactic.norm_num.int_lcm_helper_neg_left Tactic.NormNum.int_lcm_helper_neg_left

-- theorem int_lcm_helper_neg_right (x y : ℤ) (d : ℕ) (h : Int.lcm x y = d) : Int.lcm x (-y) = d :=
--  by rw [Int.lcm] at h⊢; rwa [Int.natAbs_neg]
-- #align tactic.norm_num.int_lcm_helper_neg_right Tactic.NormNum.int_lcm_helper_neg_right

-- /-- Evaluates the `nat.gcd` function. -/
-- unsafe def prove_gcd_nat (c : instance_cache) (ex ey : expr) :
--     tactic (instance_cache × expr × expr) := do
--   let x ← ex.toNat
--   let y ← ey.toNat
--   match x, y with
--     | 0, _ => pure (c, ey, q(Nat.gcd_zero_left).mk_app [ey])
--     | _, 0 => pure (c, ex, q(Nat.gcd_zero_right).mk_app [ex])
--     | 1, _ => pure (c, q((1 : ℕ)), q(Nat.gcd_one_left).mk_app [ey])
--     | _, 1 => pure (c, q((1 : ℕ)), q(Nat.gcd_one_right).mk_app [ex])
--     | _, _ => do
--       let (d, a, b) := Nat.xgcdAux x 1 0 y 0 1
--       if d = x then do
--           let (c, ea) ← c (y / x)
--           let (c, _, p) ← prove_mul_nat c ex ea
--           pure (c, ex, q(nat_gcd_helper_dvd_left).mk_app [ex, ey, ea, p])
--         else
--           if d = y then do
--             let (c, ea) ← c (x / y)
--             let (c, _, p) ← prove_mul_nat c ey ea
--             pure (c, ey, q(nat_gcd_helper_dvd_right).mk_app [ex, ey, ea, p])
--           else do
--             let (c, ed) ← c d
--             let (c, ea) ← c a
--             let (c, eb) ← c b
--             let (c, eu) ← c (x / d)
--             let (c, ev) ← c (y / d)
--             let (c, _, pu) ← prove_mul_nat c ed eu
--             let (c, _, pv) ← prove_mul_nat c ed ev
--             let (c, etx, px) ← prove_mul_nat c ex ea
--             let (c, ety, py) ← prove_mul_nat c ey eb
--             let (c, p) ← if a ≥ 0 then prove_add_nat c ety ed etx else prove_add_nat c etx ed ety
--             let pf : expr := if a ≥ 0 then q(nat_gcd_helper_2) else q(nat_gcd_helper_1)
--             pure (c, ed, pf [ed, ex, ey, ea, eb, eu, ev, etx, ety, pu, pv, px, py, p])
-- #align tactic.norm_num.prove_gcd_nat tactic.norm_num.prove_gcd_nat

-- /-- Evaluates the `nat.lcm` function. -/
-- unsafe def prove_lcm_nat (c : instance_cache) (ex ey : expr) :
--     tactic (instance_cache × expr × expr) := do
--   let x ← ex.toNat
--   let y ← ey.toNat
--   match x, y with
--     | 0, _ => pure (c, q((0 : ℕ)), q(Nat.lcm_zero_left).mk_app [ey])
--     | _, 0 => pure (c, q((0 : ℕ)), q(Nat.lcm_zero_right).mk_app [ex])
--     | 1, _ => pure (c, ey, q(Nat.lcm_one_left).mk_app [ey])
--     | _, 1 => pure (c, ex, q(Nat.lcm_one_right).mk_app [ex])
--     | _, _ => do
--       let (c, ed, pd) ← prove_gcd_nat c ex ey
--       let (c, p0) ← prove_pos c ed
--       let (c, en, xy) ← prove_mul_nat c ex ey
--       let d ← ed
--       let (c, em) ← c (x * y / d)
--       let (c, _, dm) ← prove_mul_nat c ed em
--       pure (c, em, q(nat_lcm_helper).mk_app [ex, ey, ed, em, en, pd, p0, xy, dm])
-- #align tactic.norm_num.prove_lcm_nat tactic.norm_num.prove_lcm_nat

-- /-- Evaluates the `int.gcd` function. -/
-- unsafe def prove_gcd_int (zc nc : instance_cache) :
--     expr → expr → tactic (instance_cache × instance_cache × expr × expr)
--   | x, y =>
--     match match_neg x with
--     | some x => do
--       let (zc, nc, d, p) ← prove_gcd_int x y
--       pure (zc, nc, d, q(int_gcd_helper_neg_left).mk_app [x, y, d, p])
--     | none =>
--       match match_neg y with
--       | some y => do
--         let (zc, nc, d, p) ← prove_gcd_int x y
--         pure (zc, nc, d, q(int_gcd_helper_neg_right).mk_app [x, y, d, p])
--       | none => do
--         let (zc, nc, nx, px) ← prove_nat_uncast zc nc x
--         let (zc, nc, ny, py) ← prove_nat_uncast zc nc y
--         let (nc, d, p) ← prove_gcd_nat nc nx ny
--         pure (zc, nc, d, q(int_gcd_helper).mk_app [x, y, nx, ny, d, px, py, p])
-- #align tactic.norm_num.prove_gcd_int tactic.norm_num.prove_gcd_int

-- /-- Evaluates the `int.lcm` function. -/
-- unsafe def prove_lcm_int (zc nc : instance_cache) :
--     expr → expr → tactic (instance_cache × instance_cache × expr × expr)
--   | x, y =>
--     match match_neg x with
--     | some x => do
--       let (zc, nc, d, p) ← prove_lcm_int x y
--       pure (zc, nc, d, q(int_lcm_helper_neg_left).mk_app [x, y, d, p])
--     | none =>
--       match match_neg y with
--       | some y => do
--         let (zc, nc, d, p) ← prove_lcm_int x y
--         pure (zc, nc, d, q(int_lcm_helper_neg_right).mk_app [x, y, d, p])
--       | none => do
--         let (zc, nc, nx, px) ← prove_nat_uncast zc nc x
--         let (zc, nc, ny, py) ← prove_nat_uncast zc nc y
--         let (nc, d, p) ← prove_lcm_nat nc nx ny
--         pure (zc, nc, d, q(int_lcm_helper).mk_app [x, y, nx, ny, d, px, py, p])
-- #align tactic.norm_num.prove_lcm_int tactic.norm_num.prove_lcm_int

-- /-- Evaluates the `nat.coprime` function. -/
-- unsafe def prove_coprime_nat (c : instance_cache) (ex ey : expr) :
--     tactic (instance_cache × Sum expr expr) := do
--   let x ← ex.toNat
--   let y ← ey.toNat
--   match x, y with
--     | 1, _ => pure (c, Sum.inl <| q(Nat.coprime_one_left).mk_app [ey])
--     | _, 1 => pure (c, Sum.inl <| q(Nat.coprime_one_right).mk_app [ex])
--     | 0, 0 => pure (c, Sum.inr q(Nat.not_coprime_zero_zero))
--     | 0, _ => do
--       let c ← mk_instance_cache q(ℕ)
--       let (c, p) ← prove_lt_nat c q(1) ey
--       pure (c, Sum.inr <| q(nat_coprime_helper_zero_left).mk_app [ey, p])
--     | _, 0 => do
--       let c ← mk_instance_cache q(ℕ)
--       let (c, p) ← prove_lt_nat c q(1) ex
--       pure (c, Sum.inr <| q(nat_coprime_helper_zero_right).mk_app [ex, p])
--     | _, _ => do
--       let c ← mk_instance_cache q(ℕ)
--       let (d, a, b) := Nat.xgcdAux x 1 0 y 0 1
--       if d = 1 then do
--           let (c, ea) ← c a
--           let (c, eb) ← c b
--           let (c, etx, px) ← prove_mul_nat c ex ea
--           let (c, ety, py) ← prove_mul_nat c ey eb
--           let (c, p) ← if a ≥ 0 then
--             prove_add_nat c ety q(1) etx else prove_add_nat c etx q(1) ety
--           let pf : expr := if a ≥ 0 then q(nat_coprime_helper_2) else q(nat_coprime_helper_1)
--           pure (c, Sum.inl <| pf [ex, ey, ea, eb, etx, ety, px, py, p])
--         else do
--           let (c, ed) ← c d
--           let (c, eu) ← c (x / d)
--           let (c, ev) ← c (y / d)
--           let (c, _, pu) ← prove_mul_nat c ed eu
--           let (c, _, pv) ← prove_mul_nat c ed ev
--           let (c, p) ← prove_lt_nat c q(1) ed
--           pure (c, Sum.inr <| q(nat_not_coprime_helper).mk_app [ed, ex, ey, eu, ev, pu, pv, p])
-- #align tactic.norm_num.prove_coprime_nat tactic.norm_num.prove_coprime_nat

-- /-- Evaluates the `gcd`, `lcm`, and `coprime` functions. -/
-- @[norm_num]
-- unsafe def eval_gcd : expr → tactic (expr × expr)
--   | q(Nat.gcd $(ex) $(ey)) => do
--     let c ← mk_instance_cache q(ℕ)
--     Prod.snd <$> prove_gcd_nat c ex ey
--   | q(Nat.lcm $(ex) $(ey)) => do
--     let c ← mk_instance_cache q(ℕ)
--     Prod.snd <$> prove_lcm_nat c ex ey
--   | q(Nat.Coprime $(ex) $(ey)) => do
--     let c ← mk_instance_cache q(ℕ)
--     prove_coprime_nat c ex ey >>= Sum.elim true_intro false_intro ∘ Prod.snd
--   | q(Int.gcd $(ex) $(ey)) => do
--     let zc ← mk_instance_cache q(ℤ)
--     let nc ← mk_instance_cache q(ℕ)
--     (Prod.snd ∘ Prod.snd) <$> prove_gcd_int zc nc ex ey
--   | q(Int.lcm $(ex) $(ey)) => do
--     let zc ← mk_instance_cache q(ℤ)
--     let nc ← mk_instance_cache q(ℕ)
--     (Prod.snd ∘ Prod.snd) <$> prove_lcm_int zc nc ex ey
--   | _ => failed
-- #align tactic.norm_num.eval_gcd tactic.norm_num.eval_gcd

-- end NormNum

-- end Tactic


import linear_algebra.bilinear_form
import algebra.invertible
import annihilator
-- import linear_algebra.direct_sum_module

open_locale classical

universes u v w

namespace bilin_form

variables {M : Type u} {R : Type v} [add_comm_group M] [ring R] [module R M]

/-- The perpendicular submodule of a submodule `N` is the set of elements all of
  which are orthogonal to all elements of `N`. -/
def ortho (B : bilin_form R M) (N : submodule R M) : submodule R M :=
{ carrier := { m | ∀ n ∈ N, is_ortho B m n },
  zero_mem' := λ x _, ortho_zero x,
  add_mem' := λ x y hx hy n hn,
    by rw [is_ortho, add_left, show B x n = 0, by exact hx n hn,
        show B y n = 0, by exact hy n hn, zero_add],
  smul_mem' := λ c x hx n hn,
    by rw [is_ortho, smul_left, show B x n = 0, by exact hx n hn, mul_zero] }

/-- A set of vectors `v` is orthogonal with respect to some bilinear form `B` if
  and only if for all `i ≠ j`, `B (v i) (v j) = 0`. -/
def is_ortho' {n : Type w} (B : bilin_form R M) (v : n → M) : Prop :=
  ∀ i j : n, i ≠ j → B (v j) (v i) = 0

/-- The restriction of a bilinear form on a submodule. -/
def restrict (B : bilin_form R M) (W : submodule R M) : bilin_form R W :=
{ bilin := λ a b, B a.1 b.1,
  bilin_add_left := by simp,
  bilin_smul_left := by simp,
  bilin_add_right := by simp,
  bilin_smul_right := by simp }.

@[simp] lemma restrict_def (B : bilin_form R M) (W : submodule R M) (x y : W) :
  B.restrict W x y = B x.1 y.1 := rfl

lemma restrict_sym (B : bilin_form R M) (hB : sym_bilin_form.is_sym B)
  (W : submodule R M) : sym_bilin_form.is_sym $ B.restrict W :=
λ x y, hB x.1 y.1

end bilin_form

/-- `std_basis` is the standard basis for vectors. -/
noncomputable def std_basis {R : Type v} [ring R] {n : Type w}
  (i : n) : n → R := λ j, if j = i then 1 else 0

namespace std_basis

variables {R : Type v} [ring R] {n : Type w}

lemma eq_update (m : n) : std_basis m = function.update 0 m (1 : R) :=
by { ext, rw function.update_apply, refl }

lemma linear_map.eq_std_basis (m : n) :
  (std_basis m : n → R) = linear_map.std_basis R (λ _, R) m 1 :=
by { rw linear_map.std_basis_apply, exact eq_update m }

@[simp] lemma neq_eq_zero {i j : n} (h : i ≠ j) : std_basis i j = (0 : R) :=
  if_neg h.symm

@[simp] lemma eq_eq_one {i j : n} (h : i = j) : std_basis i j = (1 : R) :=
  if_pos h.symm

lemma is_basis [fintype n] : @is_basis n R (n → R) std_basis _ _ _ :=
begin
  convert pi.is_basis_fun R n,
  ext1 m, exact linear_map.eq_std_basis m,
end

lemma dot_product_eq_val (v : n → R) (i : n) [fintype n]:
  v i = matrix.dot_product v (std_basis i) :=
begin
  rw [matrix.dot_product, finset.sum_eq_single i, eq_eq_one rfl, mul_one],
  exact λ _ _ hb, by rw [neq_eq_zero hb.symm, mul_zero],
  exact λ hi, false.elim (hi $ finset.mem_univ _)
end

end std_basis

namespace bilin_form

variables {M : Type u} {R : Type v}

/-- A nondegenerate bilinear form is a bilinear form such that the only element
  that is orthogonal to every other element is `0`. -/
def nondegenerate [add_comm_group M] [ring R] [module R M] (B : bilin_form R M) :=
  ∀ m : M, (∀ n : M, B m n = 0) → m = 0

variables {n : Type w} [fintype n]
variables [add_comm_group M] [comm_ring R] [module R M]

section matrix

lemma matrix.to_lin'_apply' (A : matrix n n R) (v w : n → R) :
  (matrix.to_bilin' A) v w = matrix.dot_product v (A.mul_vec w) :=
begin
  simp_rw [matrix.to_bilin'_apply, matrix.dot_product,
           matrix.mul_vec, matrix.dot_product],
  refine finset.sum_congr rfl (λ _ _, _),
  rw finset.mul_sum,
  refine finset.sum_congr rfl (λ _ _, _),
  rw ← mul_assoc,
end

lemma matrix.dot_product_eq_zero
  (v : n → R) (h : ∀ w, matrix.dot_product v w = 0) : v = 0 :=
begin
  refine funext (λ x, _),
  rw [std_basis.dot_product_eq_val v x, h _], refl,
end

lemma matrix.dot_product_vec_mul_eq_mul_vec {R : Type u} [ring R]
  (A : matrix n n R) (v w : n → R) :
  matrix.dot_product (A.vec_mul v) w = matrix.dot_product v (A.mul_vec w) :=
begin
  simp_rw [matrix.dot_product, matrix.vec_mul, matrix.mul_vec,
    matrix.dot_product, finset.mul_sum, finset.sum_mul, ← mul_assoc],
  rw [finset.sum_comm]
end

/-- Let `A` be a symmetric matrix. Then `A` has trivial kernel, that is it is
  invertible if and only if the induced bilinear form of `A` is nondegenerate. -/
theorem matrix.invertible_iff_nondegenerate (A : matrix n n R)
  (temp : sym_bilin_form.is_sym A.to_bilin') :
  A.to_bilin'.nondegenerate ↔ A.to_lin'.ker = ⊥ :=
begin
  rw linear_map.ker_eq_bot',
  split; intro h,
  { refine λ m hm, h _ (λ x, _),
    rw [matrix.to_lin'_apply] at hm,
    rw [temp, matrix.to_lin'_apply', hm],
    exact matrix.dot_product_zero _ },
  { intros m hm, apply h,
    refine matrix.dot_product_eq_zero _ (λ w, _),
    have := hm w,
    rwa [temp, matrix.to_lin'_apply', matrix.dot_product_comm] at this }
end

-- TODO:
-- We would like a necessary and sufficent condition on which A.to_bilin' is
-- symmetric so the condition is a prop on matrices not the induced bilinear
-- product.

end matrix

/-- Let `B` be a symmetric, nondegenerate bilinear form on a nontrivial module
  `M` over the ring `R` with invertible `2`. Then, there exists some `x : M`
  such that `B x x ≠ 0`. -/
lemma exists_bilin_form_self_neq_zero [htwo : invertible (2 : R)]
  {B : bilin_form R M} (hB₁ : B.nondegenerate) (hB₂ : sym_bilin_form.is_sym B)
  (hK : ∃ x : M, x ≠ 0) : ∃ x, B x x ≠ 0 :=
begin
  by_contra, push_neg at h,
  have : ∀ u v : M, 2 * B u v = 0,
  { intros u v,
    rw [show 2 * B u v = B u u + B v u + B u v + B v v,
          by rw [h u, h v, hB₂ v u]; ring,
        show B u u + B v u + B u v + B v v = B (u + v) (u + v),
          by simp [← add_assoc], h _] },
  have hcon : ∀ u v : M, B u v = 0,
  { intros u v,
    rw [show 0 = htwo.inv_of * (2 * B u v), by rw this; ring], simp [← mul_assoc] },
  exact let ⟨v, hv⟩ := hK in hv $ hB₁ v (hcon v),
end

variables {V : Type u} {K : Type v}
variables [field K] [add_comm_group V] [vector_space K V]

/-- A set of orthogonal vectors `v` with respect to some bilinear form `B` is
  linearly independent if for all `i`, `B (v i) (v i) ≠ 0`. -/
lemma is_ortho_linear_independent
  {n : Type w} (B : bilin_form K V) {v : n → V}
  (hv₁ : B.is_ortho' v) (hv₂ : ∀ i, B (v i) (v i) ≠ 0) : linear_independent K v :=
begin
  rw linear_independent_iff',
  intros s w hs i hi,
  have : B (s.sum $ λ (i : n), w i • v i) (v i) = 0,
  { rw [hs, zero_left] },
  have hsum : s.sum (λ (j : n), w j * B (v j) (v i)) =
    s.sum (λ (j : n), if i = j then w j * B (v j) (v i) else 0),
  { refine finset.sum_congr rfl (λ j hj, _),
    by_cases (i = j),
    { rw [if_pos h] },
    { rw [if_neg h, hv₁ _ _ h, mul_zero] } },
  simp_rw [map_sum_left, smul_left, hsum, finset.sum_ite_eq,
           if_pos hi, mul_eq_zero] at this,
  cases this,
  { assumption },
  { exact false.elim (hv₂ i $ this) }
end

-- ↓ This lemma only applies in fields as we require `a * b = 0 → a = 0 ∨ b = 0`
lemma span_inf_ortho_eq_bot {B : bilin_form K V} (hB₁ : B.nondegenerate)
  (hB₂ : sym_bilin_form.is_sym B) {x : V} (hx : B x x ≠ 0) :
  submodule.span K ({x} : set V) ⊓
    B.ortho (submodule.span K ({x} : set V)) = ⊥ :=
begin
  rw ← finset.coe_singleton,
  refine eq_bot_iff.2 (λ y h, _),
  rcases mem_span_finset.1 h.1 with ⟨μ, rfl⟩,
  have := h.2 x _,
  { rw finset.sum_singleton at this ⊢,
    suffices hμzero : μ x = 0,
    { rw [hμzero, zero_smul, submodule.mem_bot] },
    change B (μ x • x) x = 0 at this, rw [smul_left] at this,
    exact or.elim (zero_eq_mul.mp this.symm) id (λ hfalse, false.elim $ hx hfalse) },
  { rw submodule.mem_span; exact λ _ hp, hp $ finset.mem_singleton_self _ }
end

-- ↓ This lemma only applies in field since we use the inverse
lemma span_sup_ortho_eq_top {B : bilin_form K V} (hB₁ : B.nondegenerate)
  (hB₂ : sym_bilin_form.is_sym B) {x : V} (hx : B x x ≠ 0) :
  submodule.span K ({x} : set V) ⊔
    B.ortho (submodule.span K ({x} : set V)) = ⊤ :=
begin
  refine eq_top_iff.2 (λ y _, _), rw submodule.mem_sup,
  refine ⟨(B x y * (B x x)⁻¹) • x, _, y - (B x y * (B x x)⁻¹) • x, _, _⟩,
  { exact submodule.mem_span_singleton.2 ⟨(B x y * (B x x)⁻¹), rfl⟩ },
  { intros z hz,
    rcases submodule.mem_span_singleton.1 hz with ⟨μ, rfl⟩,
    simp [is_ortho, mul_assoc, inv_mul_cancel hx, hB₂ x] },
  { simp }
end

lemma is_compl_prop [hK : invertible (2 : K)] {B : bilin_form K V} -- temp
  (hB₁ : B.nondegenerate) (hB₂ : sym_bilin_form.is_sym B) (hV : ∃ x : V, x ≠ 0) :
  ∃ W : submodule K V, W ⊓ B.ortho W = ⊥ ∧ W ⊔ B.ortho W = ⊤ :=
begin
  rcases exists_bilin_form_self_neq_zero hB₁ hB₂ hV with ⟨x, hx⟩,
  refine ⟨submodule.span K ({x} : set V),
    span_inf_ortho_eq_bot hB₁ hB₂ hx, span_sup_ortho_eq_top hB₁ hB₂ hx⟩
end

def is_compl_singleton [hK : invertible (2 : K)] {B : bilin_form K V}
  (hB₁ : B.nondegenerate) (hB₂ : sym_bilin_form.is_sym B) {x : V} (hx : B x x ≠ 0) :
  is_compl (submodule.span K ({x} : set V))
    (B.ortho (submodule.span K ({x} : set V))) :=
{ inf_le_bot := eq_bot_iff.1 $ span_inf_ortho_eq_bot hB₁ hB₂ hx,
  top_le_sup := eq_top_iff.1 $ span_sup_ortho_eq_top hB₁ hB₂ hx }

/-- The natural isomorphism between a singleton and the quotient by its
  orthogonal complement. -/
noncomputable def quotient_equiv_of_ortho_singleton
  [hK : invertible (2 : K)] {B : bilin_form K V} (hB₁ : B.nondegenerate)
  (hB₂ : sym_bilin_form.is_sym B) {x : V} (hx : B x x ≠ 0) :=
  submodule.quotient_equiv_of_is_compl _ _ (is_compl_singleton hB₁ hB₂ hx)

/-- The natural isomorphism from the product between a singleton and its
  orthogonal component and the whole space. -/
noncomputable def prod_equiv_of_ortho_singleton
  [hK : invertible (2 : K)] {B : bilin_form K V} (hB₁ : B.nondegenerate)
  (hB₂ : sym_bilin_form.is_sym B) {x : V} (hx : B x x ≠ 0) :=
  submodule.prod_equiv_of_is_compl _ _ (is_compl_singleton hB₁ hB₂ hx)

lemma restrict_ortho_singleton_nondegenerate (B : bilin_form K V) (hB₁ : nondegenerate B)
  (hB₂ : sym_bilin_form.is_sym B) {x : V} (hx : B x x ≠ 0) :
  nondegenerate $ B.restrict $ B.ortho (submodule.span K ({x} : set V)) :=
begin
  refine λ m hm, submodule.coe_eq_zero.1 (hB₁ m.1 (λ n, _)),
  have : n ∈ submodule.span K ({x} : set V) ⊔
    B.ortho (submodule.span K ({x} : set V)) :=
    (span_sup_ortho_eq_top hB₁ hB₂ hx).symm ▸ submodule.mem_top,
  rcases submodule.mem_sup.1 this with ⟨y, hy, z, hz, rfl⟩,
  specialize hm ⟨z, hz⟩,
  rw [restrict_def, subtype.val_eq_coe] at hm,
  erw [add_right, show B m.1 y = 0, by exact m.2 y hy, hm, add_zero]
end

/- Let V be a finite dimensional vector space over the field K with the
  nondegenerate bilinear form B. Then for all m ∈ M, f_m : M → R : n ↦ B m n is
  a linear functional in the dual space.

  Furthermore, the map, φ : M → M* : m ↦ f_m is an isomorphism.
-/

/-- Given a bilinear form `B`, `to_dual_aux` maps elements `m` of the module `M`
  to the functional `λ x, B m x` in the dual space. -/
def to_dual_aux (B : bilin_form R M) (m : M) : module.dual R M :=
{ to_fun := λ n, B m n,
  map_add' := add_right m,
  map_smul' := λ _ _, by simp only [algebra.id.smul_eq_mul, smul_right] }

@[simp] lemma to_dual_aux_def {B : bilin_form R M} {m n : M} :
  B.to_dual_aux m n = B m n := rfl

/-- Given a bilinear form `B` on the modual `M`, `to_dual' B` is the linear map
  from `M` to its dual such that `to_dual B m` is the functional `λ x, B m x`. -/
def to_dual' (B : bilin_form R M) : M →ₗ[R] module.dual R M :=
{ to_fun := λ m, to_dual_aux B m,
  map_add' := by { intros, ext, simp },
  map_smul' := by { intros, ext, simp } }

lemma to_dual'_injective (B : bilin_form R M) (hB : B.nondegenerate) :
  function.injective (to_dual' B) :=
B.to_dual'.to_add_monoid_hom.injective_iff.2 (λ a ha, hB _ (linear_map.congr_fun ha))

section finite_dimensional

open finite_dimensional

variable [finite_dimensional K V]

-- In order to show that `to_dual` is a surjective map we used the fact that
-- the dimensions of a vector space equal to the dimensions of its dual.
-- So rather than working with modules over rings, we work with vecotor spaces
lemma to_dual'_bijective (B : bilin_form K V) (hB : B.nondegenerate) :
  function.bijective (to_dual' B) :=
begin
  refine ⟨B.to_dual'_injective hB, _⟩,
  change function.surjective B.to_dual',
  refine (linear_map.injective_iff_surjective_of_findim_eq_findim
    (linear_equiv.findim_eq _)).1 (B.to_dual'_injective hB),
  have hB := classical.some_spec (exists_is_basis_finite K V),
  haveI := classical.choice hB.2,
  exact is_basis.to_dual_equiv _ hB.1
end

/-- To dual is the `linear_equiv` with the underlying linear map `to_dual'`. -/
noncomputable def to_dual (B : bilin_form K V) (hB : B.nondegenerate) :
  V ≃ₗ[K] module.dual K V :=
{ map_smul' := B.to_dual'.map_smul',
  .. add_equiv.of_bijective B.to_dual'.to_add_monoid_hom (to_dual'_bijective B hB) }

-- We start proving that bilinear forms are diagonalisable
-- or equivilently there exists a orthogonal basis

-- ↓ Move
lemma is_basis.trivial (hV : findim K V = 0) : is_basis K (λ x : fin 0, (0 : V)) :=
begin
  split,
  rw linear_independent_iff', intros, exact fin.elim0 i,
  rw ← findim_top at hV,
  rw [eq_top_iff, (@findim_eq_zero K V _ _ _ _ _).1 hV],
  exact bot_le
end

lemma findim_ortho_span_singleton [hK : invertible (2 : K)]
  {B : bilin_form K V} (hB₁ : B.nondegenerate) (hB₂ : sym_bilin_form.is_sym B)
  {x : V} (hx : B x x ≠ 0) : findim K V =
    findim K (B.ortho (submodule.span K ({x} : set V))) + 1 :=
begin
  rw [← submodule.findim_quotient_add_findim (submodule.span K ({x} : set V)),
      findim_span_singleton
        (show x ≠ 0, by exact λ hx', hx (hx'.symm ▸ zero_left _)),
      (quotient_equiv_of_ortho_singleton hB₁ hB₂ hx).findim_eq]
end

/-- Given a nondegenerate symmetric basis `B` on some vector space `V` over the
  field `K` with invertible `2`, there exists a orthogonal basis. -/
theorem exists_orthogonal_basis [hK : invertible (2 : K)]
  {B : bilin_form K V} (hB₁ : B.nondegenerate) (hB₂ : sym_bilin_form.is_sym B) :
  ∃ v : fin (findim K V) → V,
    B.is_ortho' v ∧ is_basis K v ∧ ∀ i, B (v i) (v i) ≠ 0 :=
begin
  tactic.unfreeze_local_instances,
  induction hd : findim K V with d hi generalizing V,
  { refine ⟨λ _, 0, λ _ _ _, zero_left _, is_basis.trivial hd, fin.elim0⟩ },
  { cases exists_bilin_form_self_neq_zero hB₁ hB₂ _ with x hx,
    { have hd' := hd,
      rw findim_ortho_span_singleton hB₁ hB₂ hx at hd,
      rcases @hi (B.ortho (submodule.span K ({x} : set V))) _ _ _
        (B.restrict _) (B.restrict_ortho_singleton_nondegenerate hB₁ hB₂ hx)
        (B.restrict_sym hB₂ _) (nat.succ.inj hd) with ⟨v', hv₁, hv₂, hv₃⟩,
      -- We now have a orthogonal basis on the orthogonal space
      refine ⟨λ i, if h : i ≠ 0 then coe (v' (i.pred h)) else x, λ i j hij, _, _, _⟩,
      { by_cases hi : i = 0,
        { subst i,
          simp only [eq_self_iff_true, not_true, ne.def, dif_neg,
            not_false_iff, dite_not],
          rw dif_neg hij.symm,
          exact (v' (j.pred hij.symm)).2 _ (submodule.mem_span_singleton_self x) },
        by_cases hj : j = 0,
        { subst j,
          simp only [eq_self_iff_true, not_true, ne.def, dif_neg,
            not_false_iff, dite_not],
          rw [dif_neg hi, hB₂],
          exact (v' (i.pred hi)).2 _ (submodule.mem_span_singleton_self x) },
        { simp_rw [dif_pos hi, dif_pos hj],
          { rw [hB₂, ← hv₁ (j.pred hj) (i.pred hi) _], refl,
            simpa using hij.symm } } },
      { refine is_basis_of_linear_independent_of_card_eq_findim
          (B.is_ortho_linear_independent _ _)
          (by rw [hd', fintype.card_fin]),
        { intros i j hij,
          by_cases hi : i = 0,
          { subst hi,
            simp only [eq_self_iff_true, not_true, ne.def, dif_neg,
              not_false_iff, dite_not],
            rw dif_neg hij.symm,
            exact (v' (j.pred hij.symm)).2 _ (submodule.mem_span_singleton_self x) },
          by_cases hj : j = 0,
          { subst j,
            simp only [eq_self_iff_true, not_true, ne.def, dif_neg,
              not_false_iff, dite_not],
            rw [dif_neg hi, hB₂],
            exact (v' (i.pred hi)).2 _ (submodule.mem_span_singleton_self x) },
          { simp_rw [dif_pos hi, dif_pos hj],
            { rw [hB₂, ← hv₁ (j.pred hj) (i.pred hi) _], refl,
              simpa using hij.symm } } },
        { intro i,
          by_cases hi : i ≠ 0,
          { rw dif_pos hi,
            exact hv₃ (i.pred hi) },
          { rw dif_neg hi, exact hx } } },
      { intro i,
          by_cases hi : i ≠ 0,
          { rw dif_pos hi,
            exact hv₃ (i.pred hi) },
          { rw dif_neg hi, exact hx } } },
    suffices : nontrivial V,
    { rcases nontrivial_iff.1 this with ⟨x, y, hxy⟩,
      by_cases (x = 0),
      { exact ⟨y, h ▸ hxy.symm⟩ },
      { exact ⟨x, h⟩ } },
    apply (@findim_pos_iff K _ _ _ _ _).1,
    rw hd, exact nat.succ_pos _,
    apply_instance }
end .

end finite_dimensional

end bilin_form