/-
Copyright (c) 2022 Tian Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tian Chen, Mantas Bakšys
-/
import algebra.geom_sum
import data.int.parity
import data.zmod.basic
import number_theory.padics.padic_val
import ring_theory.ideal.quotient_operations

/-!
# Multiplicity in Number Theory

This file contains results in number theory relating to multiplicity.

## Main statements

* `multiplicity.int.pow_sub_pow` is the lifting the exponent lemma for odd primes.
  We also prove several variations of the lemma.

## References

* [Wikipedia, *Lifting-the-exponent lemma*]
  (https://en.wikipedia.org/wiki/Lifting-the-exponent_lemma)
-/

open ideal ideal.quotient finset
open_locale big_operators

variables {R : Type*} {n : ℕ}

section comm_ring
variables [comm_ring R] {a b x y : R}

lemma dvd_geom_sum₂_iff_of_dvd_sub {x y p : R} (h : p ∣ x - y) :
  p ∣ ∑ i in range n, x ^ i * y ^ (n - 1 - i) ↔ p ∣ n * y ^ (n - 1) :=
begin
  rw [← mem_span_singleton, ← ideal.quotient.eq] at h,
  simp only [← mem_span_singleton, ← eq_zero_iff_mem, ring_hom.map_geom_sum₂, h, geom_sum₂_self,
    _root_.map_mul, map_pow, map_nat_cast]
end

lemma dvd_geom_sum₂_iff_of_dvd_sub' {x y p : R} (h : p ∣ x - y) :
  p ∣ ∑ i in range n, x ^ i * y ^ (n - 1 - i) ↔ p ∣ n * x ^ (n - 1) :=
by rw [geom_sum₂_comm, dvd_geom_sum₂_iff_of_dvd_sub]; simpa using (dvd_neg _ _).mpr h

lemma dvd_geom_sum₂_self {x y : R} (h : ↑n ∣ x - y) : ↑n ∣ ∑ i in range n, x ^ i * y ^ (n - 1 - i):=
(dvd_geom_sum₂_iff_of_dvd_sub h).mpr (dvd_mul_right _ _)

lemma sq_dvd_add_pow_sub_sub (p x : R) (n : ℕ) :
  p ^ 2 ∣ (x + p) ^ n - x ^ (n - 1) * p * n - x ^ n :=
begin
  cases n,
  { simp only [pow_zero, nat.cast_zero, mul_zero, sub_zero, sub_self, dvd_zero]},
  { simp only [nat.succ_sub_succ_eq_sub, tsub_zero, nat.cast_succ, add_pow,
      finset.sum_range_succ, nat.choose_self, nat.succ_sub _, tsub_self, pow_one,
      nat.choose_succ_self_right, pow_zero, mul_one, nat.cast_zero, zero_add, nat.succ_eq_add_one],
    suffices : p ^ 2 ∣ ∑ (i : ℕ) in range n, x ^ i * p ^ (n + 1 - i) * ↑((n + 1).choose i),
    { convert this; abel },
    { apply finset.dvd_sum,
      intros y hy,
      calc p ^ 2 ∣ p ^ (n + 1 - y) : pow_dvd_pow p (le_tsub_of_add_le_left
        (by linarith [finset.mem_range.mp hy]))
      ... ∣ x ^ y * p ^ (n + 1 - y) * ↑((n + 1).choose y) : dvd_mul_of_dvd_left (dvd_mul_left _ _)
        ((n + 1).choose y) }}
end

lemma not_dvd_geom_sum₂ {p : R} (hp : prime p)
  (hxy : p ∣ x - y) (hx : ¬p ∣ x) (hn : ¬p ∣ n) :
  ¬p ∣ ∑ i in range n, x ^ i * y ^ (n - 1 - i) :=
λ h, hx $ hp.dvd_of_dvd_pow $
(hp.dvd_or_dvd $ (dvd_geom_sum₂_iff_of_dvd_sub' hxy).mp h).resolve_left hn

variables {p : ℕ} (a b)

lemma odd_sq_dvd_geom_sum₂_sub (hp : odd p) :
  ↑p ^ 2 ∣ ∑ i in range p, (a + p * b) ^ i * a ^ (p - 1 - i) - p * a ^ (p - 1) :=
begin
  have h1 : ∀ i, ↑p ^ 2 ∣ (a + ↑p * b) ^ i - (a ^ (i - 1) * (↑p * b) * ↑i + a ^ i),
  { intro i,
    calc ↑p ^ 2 ∣ (↑p * b) ^ 2 : by simp only [mul_pow, dvd_mul_right]
    ... ∣ (a + ↑p * b) ^ i - (a ^ (i - 1) * (↑p * b) * ↑i + a ^ i) :
      by simp only [sq_dvd_add_pow_sub_sub (↑p * b) a i, ← sub_sub] },
  simp_rw [← mem_span_singleton, ← ideal.quotient.eq] at *,
  calc ideal.quotient.mk (span {↑p ^ 2}) (∑ i in range p, (a + ↑p * b) ^ i * a ^ (p - 1 - i))
      = ∑ (i : ℕ) in finset.range p, mk (span {↑p ^ 2})
          ((a ^ (i - 1) * (↑p * b) * ↑i + a ^ i) * a ^ (p - 1 - i)) :
    by simp_rw [ring_hom.map_geom_sum₂, ← map_pow, h1, ← _root_.map_mul]
  ... = mk (span {↑p ^ 2}) (∑ (x : ℕ) in finset.range p,
          a ^ (x - 1) * (a ^ (p - 1 - x) * (↑p * (b * ↑x)))) +
        mk (span {↑p ^ 2}) (∑ (x : ℕ) in finset.range p, a ^ (x + (p - 1 - x))) :
    by { ring_exp,
         simp only [← pow_add, map_add, finset.sum_add_distrib, ← map_sum] }
  ... = mk (span {↑p ^ 2}) (∑ (x : ℕ) in finset.range p,
          a ^ (x - 1) * (a ^ (p - 1 - x) * (↑p * (b * ↑x)))) +
        mk (span {↑ p ^ 2}) ∑ (x : ℕ) in finset.range p, a ^ (p - 1) :
    by { rw [add_right_inj, finset.sum_congr rfl],
         intros x hx,
         rw [← nat.add_sub_assoc _ x, nat.add_sub_cancel_left],
         exact nat.le_pred_of_lt (finset.mem_range.mp hx) }
  ... = mk (span {↑p ^ 2}) (∑ (x : ℕ) in finset.range p,
          a ^ (x - 1) * (a ^ (p - 1 - x) * (↑p * (b * ↑x)))) +
        mk (span {↑ p ^ 2}) (↑p * a ^ (p - 1)) :
    by simp only [add_right_inj, finset.sum_const, finset.card_range, nsmul_eq_mul]
  ... = mk (span {↑p ^ 2}) (↑p * b * ∑ (x : ℕ) in finset.range p, a ^ (p - 2) * x) +
        mk (span {↑p ^ 2}) (↑p * a ^ (p - 1)) :
    by { simp only [finset.mul_sum, ← mul_assoc, ← pow_add],
         rw finset.sum_congr rfl,
         rintros (⟨⟩|⟨x⟩) hx,
         { rw [nat.cast_zero, mul_zero, mul_zero] },
         { have : x.succ - 1 + (p - 1 - x.succ) = p - 2,
           { rw ← nat.add_sub_assoc (nat.le_pred_of_lt (finset.mem_range.mp hx)),
             exact congr_arg nat.pred (nat.add_sub_cancel_left _ _)},
           rw this,
           ring_exp_eq }}
  ... = mk (span {↑p ^ 2}) (↑p * a ^ (p - 1)) :
    by { simp only [add_left_eq_self, ← finset.mul_sum],
         norm_cast,
         simp only [finset.sum_range_id, nat.cast_mul, _root_.map_mul,
           nat.mul_div_assoc _ (even_iff_two_dvd.mp (nat.odd.sub_odd hp odd_one))],
         ring_exp,
         simp only [← map_pow, mul_eq_zero_of_left, ideal.quotient.eq_zero_iff_mem,
           mem_span_singleton] }
end

namespace multiplicity

section integral_domain
variables [is_domain R] [@decidable_rel R (∣)]

lemma pow_sub_pow_of_prime {p : R} (hp : prime p) {x y : R} (hxy : p ∣ x - y) (hx : ¬p ∣ x)
  {n : ℕ} (hn : ¬p ∣ n) :
  multiplicity p (x ^ n - y ^ n) = multiplicity p (x - y) :=
by rw [←geom_sum₂_mul, multiplicity.mul hp,
  multiplicity_eq_zero.2 (not_dvd_geom_sum₂ hp hxy hx hn), zero_add]

variables (hp : prime (p : R)) (hp1 : odd p) (hxy : ↑p ∣ x - y) (hx : ¬↑p ∣ x)
include hp hp1 hxy hx

lemma geom_sum₂_eq_one : multiplicity ↑p (∑ i in range p, x ^ i * y ^ (p - 1 - i)) = 1 :=
begin
  rw ← nat.cast_one,
  refine multiplicity.eq_coe_iff.2 ⟨_, _⟩,
  { rw pow_one,
    exact dvd_geom_sum₂_self hxy },
  rw dvd_iff_dvd_of_dvd_sub hxy at hx,
  cases hxy with k hk,
  rw [one_add_one_eq_two, eq_add_of_sub_eq' hk],
  refine mt (dvd_iff_dvd_of_dvd_sub (@odd_sq_dvd_geom_sum₂_sub _ _ y k _ hp1)).mp _,
  rw [pow_two, mul_dvd_mul_iff_left hp.ne_zero],
  exact mt hp.dvd_of_dvd_pow hx
end

lemma pow_prime_sub_pow_prime : multiplicity ↑p (x ^ p - y ^ p) = multiplicity ↑p (x - y) + 1 :=
by rw [←geom_sum₂_mul, multiplicity.mul hp, geom_sum₂_eq_one hp hp1 hxy hx, add_comm]

lemma pow_prime_pow_sub_pow_prime_pow (a : ℕ) :
  multiplicity ↑p (x ^ p ^ a - y ^ p ^ a) = multiplicity ↑p (x - y) + a :=
begin
  induction a with a h_ind,
  { rw [nat.cast_zero, add_zero, pow_zero, pow_one, pow_one] },
  rw [←nat.add_one, nat.cast_add, nat.cast_one, ←add_assoc, ←h_ind, pow_succ', pow_mul, pow_mul],
  apply pow_prime_sub_pow_prime hp hp1,
  { rw ←geom_sum₂_mul,
    exact dvd_mul_of_dvd_right hxy _ },
  { exact λ h, hx (hp.dvd_of_dvd_pow h) }
end

end integral_domain

section lifting_the_exponent
variables (hp : nat.prime p) (hp1 : odd p)
include hp hp1

/-- **Lifting the exponent lemma** for odd primes. -/
lemma int.pow_sub_pow {x y : ℤ} (hxy : ↑p ∣ x - y) (hx : ¬↑p ∣ x) (n : ℕ) :
  multiplicity ↑p (x ^ n - y ^ n) = multiplicity ↑p (x - y) + multiplicity p n :=
begin
  cases n,
  { simp only [multiplicity.zero, add_top, pow_zero, sub_self] },
  have h : (multiplicity _ _).dom := finite_nat_iff.mpr ⟨hp.ne_one, n.succ_pos⟩,
  rcases eq_coe_iff.mp (part_enat.coe_get h).symm with ⟨⟨k, hk⟩, hpn⟩,
  conv_lhs { rw [hk, pow_mul, pow_mul] },
  rw nat.prime_iff_prime_int at hp,
  rw [pow_sub_pow_of_prime hp, pow_prime_pow_sub_pow_prime_pow hp hp1 hxy hx, part_enat.coe_get],
  { rw ←geom_sum₂_mul,
    exact dvd_mul_of_dvd_right hxy _ },
  { exact λ h, hx (hp.dvd_of_dvd_pow h) },
  { rw int.coe_nat_dvd,
    rintro ⟨c, rfl⟩,
    refine hpn ⟨c, _⟩,
    rwa [pow_succ', mul_assoc] }
end
lemma int.pow_add_pow {x y : ℤ} (hxy : ↑p ∣ x + y) (hx : ¬↑p ∣ x) {n : ℕ} (hn : odd n) :
  multiplicity ↑p (x ^ n + y ^ n) = multiplicity ↑p (x + y) + multiplicity p n :=
begin
  rw ←sub_neg_eq_add at hxy,
  rw [←sub_neg_eq_add, ←sub_neg_eq_add, ←odd.neg_pow hn],
  exact int.pow_sub_pow hp hp1 hxy hx n
end

lemma nat.pow_sub_pow {x y : ℕ} (hxy : p ∣ x - y) (hx : ¬p ∣ x) (n : ℕ) :
  multiplicity p (x ^ n - y ^ n) = multiplicity p (x - y) + multiplicity p n :=
begin
  obtain hyx | hyx := le_total y x,
 { iterate 2 { rw ← int.coe_nat_multiplicity },
    rw int.coe_nat_sub (nat.pow_le_pow_of_le_left hyx n),
    rw ← int.coe_nat_dvd at hxy hx,
    push_cast at *,
    exact int.pow_sub_pow hp hp1 hxy hx n },
  { simp only [nat.sub_eq_zero_iff_le.mpr hyx,
      nat.sub_eq_zero_iff_le.mpr (nat.pow_le_pow_of_le_left hyx n), multiplicity.zero,
      part_enat.top_add] }
end

lemma nat.pow_add_pow {x y : ℕ} (hxy : p ∣ x + y) (hx : ¬p ∣ x) {n : ℕ} (hn : odd n) :
  multiplicity p (x ^ n + y ^ n) = multiplicity p (x + y) + multiplicity p n :=
begin
  iterate 2 { rw [←int.coe_nat_multiplicity] },
  rw ←int.coe_nat_dvd at hxy hx,
  push_cast at *,
  exact int.pow_add_pow hp hp1 hxy hx hn
end

end lifting_the_exponent
end multiplicity
end comm_ring

lemma pow_two_pow_sub_pow_two_pow [comm_ring R] {x y : R} (n : ℕ) :
  x ^ (2 ^ n) - y ^ (2 ^ n) = (∏ i in finset.range n, (x ^ (2 ^ i) + y ^ (2 ^ i))) * (x - y) :=
begin
  induction n with d hd,
  { simp only [pow_zero, pow_one, finset.range_zero, finset.prod_empty, one_mul] },
  { suffices : x ^ 2 ^ d.succ - y ^ 2 ^ d.succ = (x ^ 2 ^ d + y ^ 2 ^ d) * (x ^ 2 ^ d - y ^ 2 ^ d),
    { rw [this, hd, finset.prod_range_succ, ← mul_assoc, mul_comm (x ^ 2 ^ d + y ^ 2 ^ d)] },
    { ring_exp_eq } }
end

lemma _root_.int.sq_mod_four_eq_one_of_odd {x : ℤ} : odd x → x ^ 2 % 4 = 1 :=
begin
  intro hx,
  -- Replace `x : ℤ` with `y : zmod 4`
  replace hx : x % (2 : ℕ) = 1 % (2 : ℕ), { rw int.odd_iff at hx, norm_num [hx] },
  calc x^2 % (4 : ℕ)
      = 1 % (4 : ℕ) : _
  ... = 1 : by norm_num,
  rw ← zmod.int_coe_eq_int_coe_iff' at hx ⊢,
  push_cast,
  rw [← map_int_cast (zmod.cast_hom (show 2 ∣ 4, by norm_num) (zmod 2)) x] at hx,
  set y : zmod 4 := x,
  change zmod.cast_hom _ (zmod 2) y = _ at hx,
  -- Now we can just consider each of the 4 possible values for y
  fin_cases y using hy;
    rw hy at ⊢ hx; revert hx; dec_trivial
end

lemma int.two_pow_two_pow_add_two_pow_two_pow {x y : ℤ}
  (hx : ¬ 2 ∣ x) (hxy : 4 ∣ (x - y))
  (i : ℕ) : multiplicity 2 (x ^ 2 ^ i + y ^ 2 ^ i) = ↑(1 : ℕ) :=
begin
  have hx_odd : odd x, { rwa [int.odd_iff_not_even, even_iff_two_dvd] },
  have hxy_even : even (x - y) := even_iff_two_dvd.mpr (dvd_trans (by norm_num) hxy),
  have hy_odd : odd y := by simpa using hx_odd.sub_even hxy_even,
  refine multiplicity.eq_coe_iff.mpr ⟨_, _⟩,
  { rw [pow_one, ← even_iff_two_dvd],
    exact (hx_odd.pow).add_odd hy_odd.pow },
  cases i with i,
  { intro hxy',
    have : 2 * 2 ∣ 2 * x, { convert dvd_add hxy hxy', ring_exp },
    have : 2 ∣ x := (mul_dvd_mul_iff_left (by norm_num)).mp this,
    contradiction },
  suffices : ∀ (x : ℤ), odd x → x ^ (2 ^ (i + 1)) % 4 = 1,
  { rw [show (2 ^ (1 + 1) : ℤ) = 4, by norm_num, int.dvd_iff_mod_eq_zero, int.add_mod,
        this _ hx_odd, this _ hy_odd],
    norm_num },
  intros x hx,
  rw [pow_succ, mul_comm, pow_mul, int.sq_mod_four_eq_one_of_odd hx.pow]
end

lemma int.two_pow_two_pow_sub_pow_two_pow {x y : ℤ} (n : ℕ) (hxy : 4 ∣ x - y) (hx : ¬ 2 ∣ x) :
  multiplicity 2 (x ^ (2 ^ n) - y ^ (2 ^ n)) = multiplicity 2 (x - y) + n :=
by simp only [pow_two_pow_sub_pow_two_pow  n, multiplicity.mul int.prime_two,
    multiplicity.finset.prod (int.prime_two), add_comm, nat.cast_one, finset.sum_const,
    finset.card_range, nsmul_one, int.two_pow_two_pow_add_two_pow_two_pow hx hxy]

lemma int.two_pow_sub_pow' {x y : ℤ} (n : ℕ) (hxy : 4 ∣ x - y) (hx : ¬ 2 ∣ x) :
  multiplicity 2 (x ^ n - y ^ n) = multiplicity 2 (x - y) + multiplicity (2 : ℤ) n :=
begin
  have hx_odd : odd x, { rwa [int.odd_iff_not_even, even_iff_two_dvd] },
  have hxy_even : even (x - y) := even_iff_two_dvd.mpr (dvd_trans (by norm_num) hxy),
  have hy_odd : odd y := by simpa using hx_odd.sub_even hxy_even,
  cases n,
  { simp only [pow_zero, sub_self, multiplicity.zero, int.coe_nat_zero, part_enat.add_top] },
  have h : (multiplicity 2 n.succ).dom := multiplicity.finite_nat_iff.mpr ⟨by norm_num, n.succ_pos⟩,
  rcases multiplicity.eq_coe_iff.mp (part_enat.coe_get h).symm with ⟨⟨k, hk⟩, hpn⟩,
  rw [hk, pow_mul, pow_mul, multiplicity.pow_sub_pow_of_prime,
      int.two_pow_two_pow_sub_pow_two_pow _ hxy hx,
      ← hk, part_enat.coe_get],
  { norm_cast },
  { exact int.prime_two },
  { simpa only [even_iff_two_dvd] using hx_odd.pow.sub_odd hy_odd.pow },
  { simpa only [even_iff_two_dvd, int.odd_iff_not_even] using hx_odd.pow },
  erw [int.coe_nat_dvd], -- `erw` to deal with `2 : ℤ` vs `(2 : ℕ) : ℤ`
  contrapose! hpn,
  rw pow_succ',
  conv_rhs { rw hk },
  exact mul_dvd_mul_left _ hpn
end

/-- **Lifting the exponent lemma** for `p = 2` -/
lemma int.two_pow_sub_pow {x y : ℤ} {n : ℕ} (hxy : 2 ∣ x - y) (hx : ¬ 2 ∣ x) (hn : even n) :
  multiplicity 2 (x ^ n - y ^ n) + 1 = multiplicity 2 (x + y) + multiplicity 2 (x - y) +
    multiplicity (2 : ℤ) n :=
begin
  have hy : odd y,
  { rw [← even_iff_two_dvd, ← int.odd_iff_not_even] at hx,
    replace hxy := (@even_neg _ _ (x - y)).mpr (even_iff_two_dvd.mpr hxy),
    convert even.add_odd hxy hx,
    abel },
  cases hn with d hd,
  subst hd,
  simp only [← two_mul, pow_mul],
  have hxy4 : 4 ∣ x ^ 2 - y ^ 2,
  { rw [int.dvd_iff_mod_eq_zero, int.sub_mod, int.sq_mod_four_eq_one_of_odd _,
      int.sq_mod_four_eq_one_of_odd hy],
    { norm_num },
    { simp only [int.odd_iff_not_even, even_iff_two_dvd, hx, not_false_iff] }},
  rw [int.two_pow_sub_pow' d hxy4 _, sq_sub_sq, ← int.coe_nat_mul_out,
    multiplicity.mul (int.prime_two), multiplicity.mul (int.prime_two)],
  suffices : multiplicity (2 : ℤ) ↑(2 : ℕ) = 1,
  { rw [this, add_comm (1 : part_enat), ← add_assoc] },
  { norm_cast,
    rw multiplicity.multiplicity_self _ _,
    { apply prime.not_unit,
      simp only [← nat.prime_iff, nat.prime_two] },
    { exact two_ne_zero }},
  { rw [← even_iff_two_dvd, ← int.odd_iff_not_even],
    apply odd.pow,
    simp only [int.odd_iff_not_even, even_iff_two_dvd, hx, not_false_iff] }
end

lemma nat.two_pow_sub_pow {x y : ℕ} (hxy : 2 ∣ x - y) (hx : ¬2 ∣ x) {n : ℕ} (hn : even n) :
  multiplicity 2 (x ^ n - y ^ n) + 1 = multiplicity 2 (x + y) + multiplicity 2 (x - y) +
    multiplicity 2 n :=
begin
  obtain hyx | hyx := le_total y x,
  { iterate 3 { rw ←multiplicity.int.coe_nat_multiplicity },
    have hxyn : y ^ n ≤ x ^ n := pow_le_pow_of_le_left' hyx _,
    simp only [int.coe_nat_sub hyx, int.coe_nat_sub (pow_le_pow_of_le_left' hyx _), int.coe_nat_add,
      int.coe_nat_pow],
    rw ←int.coe_nat_dvd at hx,
    rw [←int.coe_nat_dvd, int.coe_nat_sub hyx] at hxy,
    convert int.two_pow_sub_pow hxy hx hn using 2,
    rw ← multiplicity.int.coe_nat_multiplicity,
    refl },
  { simp only [nat.sub_eq_zero_iff_le.mpr hyx,
      nat.sub_eq_zero_iff_le.mpr (pow_le_pow_of_le_left' hyx n), multiplicity.zero,
      part_enat.top_add, part_enat.add_top] }
end

namespace padic_val_nat

variables {x y : ℕ}

lemma pow_two_sub_pow (hyx : y < x) (hxy : 2 ∣ x - y) (hx : ¬ 2 ∣ x) {n : ℕ} (hn : 0 < n)
  (hneven : even n) :
  padic_val_nat 2 (x ^ n - y ^ n) + 1 =
    padic_val_nat 2 (x + y) + padic_val_nat 2 (x - y) + padic_val_nat 2 n :=
begin
  simp only [←part_enat.coe_inj, nat.cast_add],
  iterate 4 { rw [padic_val_nat_def, part_enat.coe_get] },
  { convert nat.two_pow_sub_pow hxy hx hneven using 2 },
  { exact hn },
  { exact (nat.sub_pos_of_lt hyx) },
  { linarith },
  { simp only [tsub_pos_iff_lt, pow_lt_pow_of_lt_left hyx (@zero_le' _ y _) hn] }
end

variables {p : ℕ} [hp : fact p.prime] (hp1 : odd p)
include hp hp1

lemma pow_sub_pow (hyx : y < x) (hxy : p ∣ x - y) (hx : ¬p ∣ x) {n : ℕ} (hn : 0 < n) :
  padic_val_nat p (x ^ n - y ^ n) = padic_val_nat p (x - y) + padic_val_nat p n :=
begin
  rw [←part_enat.coe_inj, nat.cast_add],
  iterate 3 { rw [padic_val_nat_def, part_enat.coe_get] },
  { exact multiplicity.nat.pow_sub_pow hp.out hp1 hxy hx n },
  { exact hn },
  { exact nat.sub_pos_of_lt hyx },
  { exact nat.sub_pos_of_lt (nat.pow_lt_pow_of_lt_left hyx hn) }
end

lemma pow_add_pow (hxy : p ∣ x + y) (hx : ¬p ∣ x) {n : ℕ} (hn : odd n) :
  padic_val_nat p (x ^ n + y ^ n) = padic_val_nat p (x + y) + padic_val_nat p n :=
begin
  cases y,
  { have := dvd_zero p, contradiction },
  rw [←part_enat.coe_inj, nat.cast_add],
  iterate 3 { rw [padic_val_nat_def, part_enat.coe_get] },
  { exact multiplicity.nat.pow_add_pow hp.out hp1 hxy hx hn },
  { exact (odd.pos hn) },
  { simp only [add_pos_iff, nat.succ_pos', or_true] },
  { exact (nat.lt_add_left _ _ _ (pow_pos y.succ_pos _)) }
end

end padic_val_nat


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.finite_products
import Mathlib.category_theory.limits.shapes.binary_products
import Mathlib.category_theory.limits.preserves.shapes.products
import Mathlib.category_theory.limits.preserves.shapes.binary_products
import Mathlib.category_theory.limits.shapes.pullbacks
import Mathlib.category_theory.pempty
import Mathlib.data.equiv.fin
import Mathlib.PostPort

universes v u u'

namespace Mathlib

/-!
# Constructing finite products from binary products and terminal.

If a category has binary products and a terminal object then it has finite products.
If a functor preserves binary products and the terminal object then it preserves finite products.

# TODO

Provide the dual results.
Show the analogous results for functors which reflect or create (co)limits.
-/

namespace category_theory

/--
Given `n+1` objects of `C`, a fan for the last `n` with point `c₁.X` and a binary fan on `c₁.X` and
`f 0`, we can build a fan for all `n+1`.

In `extend_fan_is_limit` we show that if the two given fans are limits, then this fan is also a
limit.
-/
@[simp] theorem extend_fan_X {C : Type u} [category C] {n : ℕ} {f : ulift (fin (n + 1)) → C} (c₁ : limits.fan fun (i : ulift (fin n)) => f (ulift.up (fin.succ (ulift.down i)))) (c₂ : limits.binary_fan (f (ulift.up 0)) (limits.cone.X c₁)) : limits.cone.X (extend_fan c₁ c₂) = limits.cone.X c₂ :=
  Eq.refl (limits.cone.X (extend_fan c₁ c₂))

/--
Show that if the two given fans in `extend_fan` are limits, then the constructed fan is also a
limit.
-/
def extend_fan_is_limit {C : Type u} [category C] {n : ℕ} (f : ulift (fin (n + 1)) → C) {c₁ : limits.fan fun (i : ulift (fin n)) => f (ulift.up (fin.succ (ulift.down i)))} {c₂ : limits.binary_fan (f (ulift.up 0)) (limits.cone.X c₁)} (t₁ : limits.is_limit c₁) (t₂ : limits.is_limit c₂) : limits.is_limit (extend_fan c₁ c₂) :=
  limits.is_limit.mk
    fun (s : limits.cone (discrete.functor f)) =>
      subtype.val
        (limits.binary_fan.is_limit.lift' t₂ (nat_trans.app (limits.cone.π s) (ulift.up 0))
          (limits.is_limit.lift t₁
            (limits.cone.mk (limits.cone.X s)
              (discrete.nat_trans
                fun (i : discrete (ulift (fin n))) =>
                  nat_trans.app (limits.cone.π s) (ulift.up (fin.succ (ulift.down i)))))))

/--
If `C` has a terminal object and binary products, then it has a product for objects indexed by
`ulift (fin n)`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
/--
If `C` has a terminal object and binary products, then it has limits of shape
`discrete (ulift (fin n))` for any `n : ℕ`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
/-- If `C` has a terminal object and binary products, then it has finite products. -/
theorem has_finite_products_of_has_binary_and_terminal {C : Type u} [category C] [limits.has_binary_products C] [limits.has_terminal C] : limits.has_finite_products C := sorry

/--
If `F` preserves the terminal object and binary products, then it preserves products indexed by
`ulift (fin n)` for any `n`.
-/
def preserves_fin_of_preserves_binary_and_terminal {C : Type u} [category C] {D : Type u'} [category D] (F : C ⥤ D) [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] [limits.preserves_limits_of_shape (discrete pempty) F] [limits.has_finite_products C] (n : ℕ) (f : ulift (fin n) → C) : limits.preserves_limit (discrete.functor f) F :=
  sorry

/--
If `F` preserves the terminal object and binary products, then it preserves limits of shape
`discrete (ulift (fin n))`.
-/
def preserves_ulift_fin_of_preserves_binary_and_terminal {C : Type u} [category C] {D : Type u'} [category D] (F : C ⥤ D) [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] [limits.preserves_limits_of_shape (discrete pempty) F] [limits.has_finite_products C] (n : ℕ) : limits.preserves_limits_of_shape (discrete (ulift (fin n))) F :=
  limits.preserves_limits_of_shape.mk
    fun (K : discrete (ulift (fin n)) ⥤ C) =>
      let this : discrete.functor (functor.obj K) ≅ K :=
        discrete.nat_iso
          fun (i : discrete (discrete (ulift (fin n)))) => iso.refl (functor.obj (discrete.functor (functor.obj K)) i);
      limits.preserves_limit_of_iso_diagram F this

/-- If `F` preserves the terminal object and binary products then it preserves finite products. -/
def preserves_finite_products_of_preserves_binary_and_terminal {C : Type u} [category C] {D : Type u'} [category D] (F : C ⥤ D) [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] [limits.preserves_limits_of_shape (discrete pempty) F] [limits.has_finite_products C] (J : Type v) [fintype J] : limits.preserves_limits_of_shape (discrete J) F :=
  trunc.rec_on_subsingleton (fintype.equiv_fin J)
    fun (e : J ≃ fin (fintype.card J)) =>
      limits.preserves_limits_of_shape_of_equiv
        (equivalence.symm (discrete.equivalence (equiv.trans e (equiv.symm equiv.ulift)))) F


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov, Frédéric Dupuis,
  Heather Macbeth
-/
import linear_algebra.basic
import order.compactly_generated
import order.omega_complete_partial_order

/-!
# The span of a set of vectors, as a submodule

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

* `submodule.span s` is defined to be the smallest submodule containing the set `s`.

## Notations

* We introduce the notation `R ∙ v` for the span of a singleton, `submodule.span R {v}`.  This is
  `\.`, not the same as the scalar multiplication `•`/`\bub`.

-/
variables {R R₂ K M M₂ V S : Type*}

namespace submodule

open function set
open_locale pointwise

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [module R M]
variables {x : M} (p p' : submodule R M)
variables [semiring R₂] {σ₁₂ : R →+* R₂}
variables [add_comm_monoid M₂] [module R₂ M₂]

section
variables (R)

/-- The span of a set `s ⊆ M` is the smallest submodule of M that contains `s`. -/
def span (s : set M) : submodule R M := Inf {p | s ⊆ p}
end

variables {s t : set M}
lemma mem_span : x ∈ span R s ↔ ∀ p : submodule R M, s ⊆ p → x ∈ p := mem_Inter₂

lemma subset_span : s ⊆ span R s :=
λ x h, mem_span.2 $ λ p hp, hp h

lemma span_le {p} : span R s ≤ p ↔ s ⊆ p :=
⟨subset.trans subset_span, λ ss x h, mem_span.1 h _ ss⟩

lemma span_mono (h : s ⊆ t) : span R s ≤ span R t :=
span_le.2 $ subset.trans h subset_span

lemma span_monotone : monotone (span R : set M → submodule R M) :=
λ _ _, span_mono

lemma span_eq_of_le (h₁ : s ⊆ p) (h₂ : p ≤ span R s) : span R s = p :=
le_antisymm (span_le.2 h₁) h₂

lemma span_eq : span R (p : set M) = p :=
span_eq_of_le _ (subset.refl _) subset_span

lemma span_eq_span (hs : s ⊆ span R t) (ht : t ⊆ span R s) : span R s = span R t :=
le_antisymm (span_le.2 hs) (span_le.2 ht)

/-- A version of `submodule.span_eq` for when the span is by a smaller ring. -/
@[simp] lemma span_coe_eq_restrict_scalars
  [semiring S] [has_smul S R] [module S M] [is_scalar_tower S R M] :
  span S (p : set M) = p.restrict_scalars S :=
span_eq (p.restrict_scalars S)

lemma map_span [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : set M) :
  (span R s).map f = span R₂ (f '' s) :=
eq.symm $ span_eq_of_le _ (set.image_subset f subset_span) $
map_le_iff_le_comap.2 $ span_le.2 $ λ x hx, subset_span ⟨x, hx, rfl⟩

alias submodule.map_span ← _root_.linear_map.map_span

lemma map_span_le [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : set M)
  (N : submodule R₂ M₂) : map f (span R s) ≤ N ↔ ∀ m ∈ s, f m ∈ N :=
begin
  rw [f.map_span, span_le, set.image_subset_iff],
  exact iff.rfl
end

alias submodule.map_span_le ← _root_.linear_map.map_span_le

@[simp] lemma span_insert_zero : span R (insert (0 : M) s) = span R s :=
begin
  refine le_antisymm _ (submodule.span_mono (set.subset_insert 0 s)),
  rw [span_le, set.insert_subset],
  exact ⟨by simp only [set_like.mem_coe, submodule.zero_mem], submodule.subset_span⟩,
end

/- See also `span_preimage_eq` below. -/
lemma span_preimage_le (f : M →ₛₗ[σ₁₂] M₂) (s : set M₂) :
  span R (f ⁻¹' s) ≤ (span R₂ s).comap f :=
by { rw [span_le, comap_coe], exact preimage_mono (subset_span), }

alias submodule.span_preimage_le ← _root_.linear_map.span_preimage_le

lemma closure_subset_span {s : set M} :
  (add_submonoid.closure s : set M) ⊆ span R s :=
(@add_submonoid.closure_le _ _ _ (span R s).to_add_submonoid).mpr subset_span

lemma closure_le_to_add_submonoid_span {s : set M} :
  add_submonoid.closure s ≤ (span R s).to_add_submonoid :=
closure_subset_span

@[simp] lemma span_closure {s : set M} : span R (add_submonoid.closure s : set M) = span R s :=
le_antisymm (span_le.mpr closure_subset_span) (span_mono add_submonoid.subset_closure)

/-- An induction principle for span membership. If `p` holds for 0 and all elements of `s`, and is
preserved under addition and scalar multiplication, then `p` holds for all elements of the span of
`s`. -/
@[elab_as_eliminator] lemma span_induction {p : M → Prop} (h : x ∈ span R s)
  (Hs : ∀ x ∈ s, p x) (H0 : p 0)
  (H1 : ∀ x y, p x → p y → p (x + y))
  (H2 : ∀ (a:R) x, p x → p (a • x)) : p x :=
(@span_le _ _ _ _ _ _ ⟨p, H1, H0, H2⟩).2 Hs h

/-- A dependent version of `submodule.span_induction`. -/
lemma span_induction' {p : Π x, x ∈ span R s → Prop}
  (Hs : ∀ x (h : x ∈ s), p x (subset_span h))
  (H0 : p 0 (submodule.zero_mem _))
  (H1 : ∀ x hx y hy, p x hx → p y hy → p (x + y) (submodule.add_mem _ ‹_› ‹_›))
  (H2 : ∀ (a : R) x hx, p x hx → p (a • x) (submodule.smul_mem _ _ ‹_›)) {x} (hx : x ∈ span R s) :
  p x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ span R s) (hc : p x hx), hc),
  refine span_induction hx (λ m hm, ⟨subset_span hm, Hs m hm⟩) ⟨zero_mem _, H0⟩
    (λ x y hx hy, exists.elim hx $ λ hx' hx, exists.elim hy $ λ hy' hy,
    ⟨add_mem hx' hy', H1 _ _ _ _ hx hy⟩) (λ r x hx, exists.elim hx $ λ hx' hx,
    ⟨smul_mem _ _ hx', H2 r _ _ hx⟩)
end

@[simp] lemma span_span_coe_preimage : span R ((coe : span R s → M) ⁻¹' s) = ⊤ :=
eq_top_iff.2 $ λ x, subtype.rec_on x $ λ x hx _, begin
  refine span_induction' (λ x hx, _) _ (λ x y _ _, _) (λ r x _, _) hx,
  { exact subset_span hx },
  { exact zero_mem _ },
  { exact add_mem },
  { exact smul_mem _ _ }
end

lemma span_nat_eq_add_submonoid_closure (s : set M) :
  (span ℕ s).to_add_submonoid = add_submonoid.closure s :=
begin
  refine eq.symm (add_submonoid.closure_eq_of_le subset_span _),
  apply add_submonoid.to_nat_submodule.symm.to_galois_connection.l_le _,
  rw span_le,
  exact add_submonoid.subset_closure,
end

@[simp] lemma span_nat_eq (s : add_submonoid M) : (span ℕ (s : set M)).to_add_submonoid = s :=
by rw [span_nat_eq_add_submonoid_closure, s.closure_eq]

lemma span_int_eq_add_subgroup_closure {M : Type*} [add_comm_group M] (s : set M) :
  (span ℤ s).to_add_subgroup = add_subgroup.closure s :=
eq.symm $ add_subgroup.closure_eq_of_le _ subset_span $ λ x hx, span_induction hx
  (λ x hx, add_subgroup.subset_closure hx) (add_subgroup.zero_mem _)
  (λ _ _, add_subgroup.add_mem _) (λ _ _ _, add_subgroup.zsmul_mem _ ‹_› _)

@[simp]

section
variables (R M)

/-- `span` forms a Galois insertion with the coercion from submodule to set. -/
protected def gi : galois_insertion (@span R M _ _ _) coe :=
{ choice := λ s _, span R s,
  gc := λ s t, span_le,
  le_l_u := λ s, subset_span,
  choice_eq := λ s h, rfl }

end

@[simp] lemma span_empty : span R (∅ : set M) = ⊥ :=
(submodule.gi R M).gc.l_bot

@[simp] lemma span_univ : span R (univ : set M) = ⊤ :=
eq_top_iff.2 $ set_like.le_def.2 $ subset_span

lemma span_union (s t : set M) : span R (s ∪ t) = span R s ⊔ span R t :=
(submodule.gi R M).gc.l_sup

lemma span_Union {ι} (s : ι → set M) : span R (⋃ i, s i) = ⨆ i, span R (s i) :=
(submodule.gi R M).gc.l_supr

lemma span_Union₂ {ι} {κ : ι → Sort*} (s : Π i, κ i → set M) :
  span R (⋃ i j, s i j) = ⨆ i j, span R (s i j) :=
(submodule.gi R M).gc.l_supr₂

lemma span_attach_bUnion [decidable_eq M] {α : Type*} (s : finset α) (f : s → finset M) :
  span R (s.attach.bUnion f : set M) = ⨆ x, span R (f x) :=
by simpa [span_Union]

lemma sup_span : p ⊔ span R s = span R (p ∪ s) :=
by rw [submodule.span_union, p.span_eq]

lemma span_sup : span R s ⊔ p = span R (s ∪ p) :=
by rw [submodule.span_union, p.span_eq]

/- Note that the character `∙` U+2219 used below is different from the scalar multiplication
character `•` U+2022 and the matrix multiplication character `⬝` U+2B1D. -/
notation R` ∙ `:1000 x := span R (@singleton _ _ set.has_singleton x)

lemma span_eq_supr_of_singleton_spans (s : set M) : span R s = ⨆ x ∈ s, R ∙ x :=
by simp only [←span_Union, set.bUnion_of_singleton s]

lemma span_range_eq_supr {ι : Type*} {v : ι → M} : span R (range v) = ⨆ i, R ∙ v i :=
by rw [span_eq_supr_of_singleton_spans, supr_range]

lemma span_smul_le (s : set M) (r : R) :
  span R (r • s) ≤ span R s :=
begin
  rw span_le,
  rintros _ ⟨x, hx, rfl⟩,
  exact smul_mem (span R s) r (subset_span hx),
end

lemma subset_span_trans {U V W : set M} (hUV : U ⊆ submodule.span R V)
  (hVW : V ⊆ submodule.span R W) :
  U ⊆ submodule.span R W :=
(submodule.gi R M).gc.le_u_l_trans hUV hVW

/-- See `submodule.span_smul_eq` (in `ring_theory.ideal.operations`) for
`span R (r • s) = r • span R s` that holds for arbitrary `r` in a `comm_semiring`. -/
lemma span_smul_eq_of_is_unit (s : set M) (r : R) (hr : is_unit r) :
  span R (r • s) = span R s :=
begin
  apply le_antisymm,
  { apply span_smul_le },
  { convert span_smul_le (r • s) ((hr.unit ⁻¹ : _) : R),
    rw smul_smul,
    erw hr.unit.inv_val,
    rw one_smul }
end

@[simp] theorem coe_supr_of_directed {ι} [hι : nonempty ι]
  (S : ι → submodule R M) (H : directed (≤) S) :
  ((supr S : submodule R M) : set M) = ⋃ i, S i :=
begin
  refine subset.antisymm _ (Union_subset $ le_supr S),
  suffices : (span R (⋃ i, (S i : set M)) : set M) ⊆ ⋃ (i : ι), ↑(S i),
    by simpa only [span_Union, span_eq] using this,
  refine (λ x hx, span_induction hx (λ _, id) _ _ _);
    simp only [mem_Union, exists_imp_distrib],
  { exact hι.elim (λ i, ⟨i, (S i).zero_mem⟩) },
  { intros x y i hi j hj,
    rcases H i j with ⟨k, ik, jk⟩,
    exact ⟨k, add_mem (ik hi) (jk hj)⟩ },
  { exact λ a x i hi, ⟨i, smul_mem _ a hi⟩ },
end

@[simp] theorem mem_supr_of_directed {ι} [nonempty ι]
  (S : ι → submodule R M) (H : directed (≤) S) {x} :
  x ∈ supr S ↔ ∃ i, x ∈ S i :=
by { rw [← set_like.mem_coe, coe_supr_of_directed S H, mem_Union], refl }

theorem mem_Sup_of_directed {s : set (submodule R M)}
  {z} (hs : s.nonempty) (hdir : directed_on (≤) s) :
  z ∈ Sup s ↔ ∃ y ∈ s, z ∈ y :=
begin
  haveI : nonempty s := hs.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed _ hdir.directed_coe, set_coe.exists, subtype.coe_mk]
end

@[norm_cast, simp] lemma coe_supr_of_chain (a : ℕ →o submodule R M) :
  (↑(⨆ k, a k) : set M) = ⋃ k, (a k : set M) :=
coe_supr_of_directed a a.monotone.directed_le

/-- We can regard `coe_supr_of_chain` as the statement that `coe : (submodule R M) → set M` is
Scott continuous for the ω-complete partial order induced by the complete lattice structures. -/
lemma coe_scott_continuous : omega_complete_partial_order.continuous'
  (coe : submodule R M → set M) :=
⟨set_like.coe_mono, coe_supr_of_chain⟩

@[simp] lemma mem_supr_of_chain (a : ℕ →o submodule R M) (m : M) :
  m ∈ (⨆ k, a k) ↔ ∃ k, m ∈ a k :=
mem_supr_of_directed a a.monotone.directed_le

section

variables {p p'}

lemma mem_sup : x ∈ p ⊔ p' ↔ ∃ (y ∈ p) (z ∈ p'), y + z = x :=
⟨λ h, begin
  rw [← span_eq p, ← span_eq p', ← span_union] at h,
  apply span_induction h,
  { rintro y (h | h),
    { exact ⟨y, h, 0, by simp, by simp⟩ },
    { exact ⟨0, by simp, y, h, by simp⟩ } },
  { exact ⟨0, by simp, 0, by simp⟩ },
  { rintro _ _ ⟨y₁, hy₁, z₁, hz₁, rfl⟩ ⟨y₂, hy₂, z₂, hz₂, rfl⟩,
    exact ⟨_, add_mem hy₁ hy₂, _, add_mem hz₁ hz₂, by simp [add_assoc]; cc⟩ },
  { rintro a _ ⟨y, hy, z, hz, rfl⟩,
    exact ⟨_, smul_mem _ a hy, _, smul_mem _ a hz, by simp [smul_add]⟩ }
end,
by rintro ⟨y, hy, z, hz, rfl⟩; exact add_mem
  ((le_sup_left : p ≤ p ⊔ p') hy)
  ((le_sup_right : p' ≤ p ⊔ p') hz)⟩

lemma mem_sup' : x ∈ p ⊔ p' ↔ ∃ (y : p) (z : p'), (y:M) + z = x :=
mem_sup.trans $ by simp only [set_like.exists, coe_mk]

variables (p p')

lemma coe_sup : ↑(p ⊔ p') = (p + p' : set M) :=
by { ext, rw [set_like.mem_coe, mem_sup, set.mem_add], simp, }

lemma sup_to_add_submonoid :
  (p ⊔ p').to_add_submonoid = p.to_add_submonoid ⊔ p'.to_add_submonoid :=
begin
  ext x,
  rw [mem_to_add_submonoid, mem_sup, add_submonoid.mem_sup],
  refl,
end

lemma sup_to_add_subgroup {R M : Type*} [ring R] [add_comm_group M] [module R M]
  (p p' : submodule R M) :
  (p ⊔ p').to_add_subgroup = p.to_add_subgroup ⊔ p'.to_add_subgroup :=
begin
  ext x,
  rw [mem_to_add_subgroup, mem_sup, add_subgroup.mem_sup],
  refl,
end

end

lemma mem_span_singleton_self (x : M) : x ∈ R ∙ x := subset_span rfl

lemma nontrivial_span_singleton {x : M} (h : x ≠ 0) : nontrivial (R ∙ x) :=
⟨begin
    use [0, x, submodule.mem_span_singleton_self x],
    intros H,
    rw [eq_comm, submodule.mk_eq_zero] at H,
    exact h H
end⟩

lemma mem_span_singleton {y : M} : x ∈ (R ∙ y) ↔ ∃ a:R, a • y = x :=
⟨λ h, begin
  apply span_induction h,
  { rintro y (rfl|⟨⟨⟩⟩), exact ⟨1, by simp⟩ },
  { exact ⟨0, by simp⟩ },
  { rintro _ _ ⟨a, rfl⟩ ⟨b, rfl⟩,
    exact ⟨a + b, by simp [add_smul]⟩ },
  { rintro a _ ⟨b, rfl⟩,
    exact ⟨a * b, by simp [smul_smul]⟩ }
end,
by rintro ⟨a, y, rfl⟩; exact
  smul_mem _ _ (subset_span $ by simp)⟩

lemma le_span_singleton_iff {s : submodule R M} {v₀ : M} :
  s ≤ (R ∙ v₀) ↔ ∀ v ∈ s, ∃ r : R, r • v₀ = v :=
by simp_rw [set_like.le_def, mem_span_singleton]

variables (R)

lemma span_singleton_eq_top_iff (x : M) : (R ∙ x) = ⊤ ↔ ∀ v, ∃ r : R, r • x = v :=
by { rw [eq_top_iff, le_span_singleton_iff], tauto }

@[simp] lemma span_zero_singleton : (R ∙ (0:M)) = ⊥ :=
by { ext, simp [mem_span_singleton, eq_comm] }

lemma span_singleton_eq_range (y : M) : ↑(R ∙ y) = range ((• y) : R → M) :=
set.ext $ λ x, mem_span_singleton

lemma span_singleton_smul_le {S} [monoid S] [has_smul S R] [mul_action S M]
  [is_scalar_tower S R M] (r : S) (x : M) : (R ∙ (r • x)) ≤ R ∙ x :=
begin
  rw [span_le, set.singleton_subset_iff, set_like.mem_coe],
  exact smul_of_tower_mem _ _ (mem_span_singleton_self _)
end

lemma span_singleton_group_smul_eq {G} [group G] [has_smul G R] [mul_action G M]
  [is_scalar_tower G R M] (g : G) (x : M) : (R ∙ (g • x)) = R ∙ x :=
begin
  refine le_antisymm (span_singleton_smul_le R g x) _,
  convert span_singleton_smul_le R (g⁻¹) (g • x),
  exact (inv_smul_smul g x).symm
end

variables {R}

lemma span_singleton_smul_eq {r : R} (hr : is_unit r) (x : M) : (R ∙ (r • x)) = R ∙ x :=
begin
  lift r to Rˣ using hr,
  rw ←units.smul_def,
  exact span_singleton_group_smul_eq R r x,
end

lemma disjoint_span_singleton {K E : Type*} [division_ring K] [add_comm_group E] [module K E]
  {s : submodule K E} {x : E} :
  disjoint s (K ∙ x) ↔ (x ∈ s → x = 0) :=
begin
  refine disjoint_def.trans ⟨λ H hx, H x hx $ subset_span $ mem_singleton x, _⟩,
  assume H y hy hyx,
  obtain ⟨c, rfl⟩ := mem_span_singleton.1 hyx,
  by_cases hc : c = 0,
  { rw [hc, zero_smul] },
  { rw [s.smul_mem_iff hc] at hy,
    rw [H hy, smul_zero] }
end

lemma disjoint_span_singleton' {K E : Type*} [division_ring K] [add_comm_group E] [module K E]
  {p : submodule K E} {x : E} (x0 : x ≠ 0) :
  disjoint p (K ∙ x) ↔ x ∉ p :=
disjoint_span_singleton.trans ⟨λ h₁ h₂, x0 (h₁ h₂), λ h₁ h₂, (h₁ h₂).elim⟩

lemma mem_span_singleton_trans {x y z : M} (hxy : x ∈ R ∙ y) (hyz : y ∈ R ∙ z) :
  x ∈ R ∙ z :=
begin
  rw [← set_like.mem_coe, ← singleton_subset_iff] at *,
  exact submodule.subset_span_trans hxy hyz
end

lemma mem_span_insert {y} : x ∈ span R (insert y s) ↔ ∃ (a:R) (z ∈ span R s), x = a • y + z :=
begin
  simp only [← union_singleton, span_union, mem_sup, mem_span_singleton, exists_prop,
    exists_exists_eq_and],
  rw [exists_comm],
  simp only [eq_comm, add_comm, exists_and_distrib_left]
end

lemma mem_span_pair {x y z : M} : z ∈ span R ({x, y} : set M) ↔ ∃ a b : R, a • x + b • y = z :=
by simp_rw [mem_span_insert, mem_span_singleton, exists_prop, exists_exists_eq_and, eq_comm]

lemma span_insert (x) (s : set M) : span R (insert x s) = span R ({x} : set M) ⊔ span R s :=
by rw [insert_eq, span_union]

lemma span_insert_eq_span (h : x ∈ span R s) : span R (insert x s) = span R s :=
span_eq_of_le _ (set.insert_subset.mpr ⟨h, subset_span⟩) (span_mono $ subset_insert _ _)

lemma span_span : span R (span R s : set M) = span R s := span_eq _

variables (R S s)

/-- If `R` is "smaller" ring than `S` then the span by `R` is smaller than the span by `S`. -/
lemma span_le_restrict_scalars [semiring S] [has_smul R S] [module S M] [is_scalar_tower R S M] :
  span R s ≤ (span S s).restrict_scalars R :=
submodule.span_le.2 submodule.subset_span

/-- A version of `submodule.span_le_restrict_scalars` with coercions. -/
@[simp] lemma span_subset_span [semiring S] [has_smul R S] [module S M] [is_scalar_tower R S M] :
  ↑(span R s) ⊆ (span S s : set M) :=
span_le_restrict_scalars R S s

/-- Taking the span by a large ring of the span by the small ring is the same as taking the span
by just the large ring. -/
lemma span_span_of_tower [semiring S] [has_smul R S] [module S M] [is_scalar_tower R S M] :
  span S (span R s : set M) = span S s :=
le_antisymm (span_le.2 $ span_subset_span R S s) (span_mono subset_span)

variables {R S s}

lemma span_eq_bot : span R (s : set M) = ⊥ ↔ ∀ x ∈ s, (x:M) = 0 :=
eq_bot_iff.trans ⟨
  λ H x h, (mem_bot R).1 $ H $ subset_span h,
  λ H, span_le.2 (λ x h, (mem_bot R).2 $ H x h)⟩

@[simp] lemma span_singleton_eq_bot : (R ∙ x) = ⊥ ↔ x = 0 :=
span_eq_bot.trans $ by simp

@[simp] lemma span_zero : span R (0 : set M) = ⊥ := by rw [←singleton_zero, span_singleton_eq_bot]

lemma span_singleton_eq_span_singleton {R M : Type*} [ring R] [add_comm_group M] [module R M]
  [no_zero_smul_divisors R M] {x y : M} : (R ∙ x) = (R ∙ y) ↔ ∃ z : Rˣ, z • x = y :=
begin
  by_cases hx : x = 0,
  { rw [hx, span_zero_singleton, eq_comm, span_singleton_eq_bot],
    exact ⟨λ hy, ⟨1, by rw [hy, smul_zero]⟩, λ ⟨_, hz⟩, by rw [← hz, smul_zero]⟩ },
  by_cases hy : y = 0,
  { rw [hy, span_zero_singleton, span_singleton_eq_bot],
    exact ⟨λ hx, ⟨1, by rw [hx, smul_zero]⟩, λ ⟨z, hz⟩, (smul_eq_zero_iff_eq z).mp hz⟩ },
  split,
  { intro hxy,
    cases mem_span_singleton.mp (by { rw [hxy], apply mem_span_singleton_self }) with v hv,
    cases mem_span_singleton.mp (by { rw [← hxy], apply mem_span_singleton_self }) with i hi,
    have vi : v * i = 1 :=
    by { rw [← one_smul R y, ← hi, smul_smul] at hv, exact smul_left_injective R hy hv },
    have iv : i * v = 1 :=
    by { rw [← one_smul R x, ← hv, smul_smul] at hi, exact smul_left_injective R hx hi },
    exact ⟨⟨v, i, vi, iv⟩, hv⟩ },
  { rintro ⟨v, rfl⟩,
    rw span_singleton_group_smul_eq }
end

@[simp] lemma span_image [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) :
  span R₂ (f '' s) = map f (span R s) :=
(map_span f s).symm

lemma apply_mem_span_image_of_mem_span
   [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) {x : M} {s : set M} (h : x ∈ submodule.span R s) :
   f x ∈ submodule.span R₂ (f '' s) :=
begin
  rw submodule.span_image,
  exact submodule.mem_map_of_mem h
end

@[simp] lemma map_subtype_span_singleton {p : submodule R M} (x : p) :
  map p.subtype (R ∙ x) = R ∙ (x : M) :=
by simp [← span_image]

/-- `f` is an explicit argument so we can `apply` this theorem and obtain `h` as a new goal. -/
lemma not_mem_span_of_apply_not_mem_span_image
   [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) {x : M} {s : set M}
   (h : f x ∉ submodule.span R₂ (f '' s)) :
   x ∉ submodule.span R s :=
h.imp (apply_mem_span_image_of_mem_span f)

lemma supr_span {ι : Sort*} (p : ι → set M) : (⨆ i, span R (p i)) = span R (⋃ i, p i) :=
le_antisymm (supr_le $ λ i, span_mono $ subset_Union _ i) $
  span_le.mpr $ Union_subset $ λ i m hm, mem_supr_of_mem i $ subset_span hm

lemma supr_eq_span {ι : Sort*} (p : ι → submodule R M) : (⨆ i, p i) = span R (⋃ i, ↑(p i)) :=
by simp_rw [← supr_span, span_eq]

lemma supr_to_add_submonoid {ι : Sort*} (p : ι → submodule R M) :
  (⨆ i, p i).to_add_submonoid = ⨆ i, (p i).to_add_submonoid :=
begin
  refine le_antisymm (λ x, _) (supr_le $ λ i, to_add_submonoid_mono $ le_supr _ i),
  simp_rw [supr_eq_span, add_submonoid.supr_eq_closure, mem_to_add_submonoid, coe_to_add_submonoid],
  intros hx,
  refine submodule.span_induction hx (λ x hx, _) _ (λ x y hx hy, _) (λ r x hx, _),
  { exact add_submonoid.subset_closure hx },
  { exact add_submonoid.zero_mem _ },
  { exact add_submonoid.add_mem _ hx hy },
  { apply add_submonoid.closure_induction hx,
    { rintros x ⟨_, ⟨i, rfl⟩, hix : x ∈ p i⟩,
      apply add_submonoid.subset_closure (set.mem_Union.mpr ⟨i, _⟩),
      exact smul_mem _ r hix },
    { rw smul_zero,
      exact add_submonoid.zero_mem _ },
    { intros x y hx hy,
      rw smul_add,
      exact add_submonoid.add_mem _ hx hy, } }
end

/-- An induction principle for elements of `⨆ i, p i`.
If `C` holds for `0` and all elements of `p i` for all `i`, and is preserved under addition,
then it holds for all elements of the supremum of `p`. -/
@[elab_as_eliminator]
lemma supr_induction {ι : Sort*} (p : ι → submodule R M) {C : M → Prop} {x : M} (hx : x ∈ ⨆ i, p i)
  (hp : ∀ i (x ∈ p i), C x)
  (h0 : C 0)
  (hadd : ∀ x y, C x → C y → C (x + y)) : C x :=
begin
  rw [←mem_to_add_submonoid, supr_to_add_submonoid] at hx,
  exact add_submonoid.supr_induction _ hx hp h0 hadd,
end

/-- A dependent version of `submodule.supr_induction`. -/
@[elab_as_eliminator]
lemma supr_induction' {ι : Sort*} (p : ι → submodule R M) {C : Π x, (x ∈ ⨆ i, p i) → Prop}
  (hp : ∀ i (x ∈ p i), C x (mem_supr_of_mem i ‹_›))
  (h0 : C 0 (zero_mem _))
  (hadd : ∀ x y hx hy, C x hx → C y hy → C (x + y) (add_mem ‹_› ‹_›))
  {x : M} (hx : x ∈ ⨆ i, p i) : C x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ ⨆ i, p i) (hc : C x hx), hc),
  refine supr_induction p hx (λ i x hx, _) _ (λ x y, _),
  { exact ⟨_, hp _ _ hx⟩ },
  { exact ⟨_, h0⟩ },
  { rintro ⟨_, Cx⟩ ⟨_, Cy⟩,
    refine ⟨_, hadd _ _ _ _ Cx Cy⟩ },
end

@[simp] lemma span_singleton_le_iff_mem (m : M) (p : submodule R M) : (R ∙ m) ≤ p ↔ m ∈ p :=
by rw [span_le, singleton_subset_iff, set_like.mem_coe]

lemma singleton_span_is_compact_element (x : M) :
  complete_lattice.is_compact_element (span R {x} : submodule R M) :=
begin
  rw complete_lattice.is_compact_element_iff_le_of_directed_Sup_le,
  intros d hemp hdir hsup,
  have : x ∈ Sup d, from (set_like.le_def.mp hsup) (mem_span_singleton_self x),
  obtain ⟨y, ⟨hyd, hxy⟩⟩ := (mem_Sup_of_directed hemp hdir).mp this,
  exact ⟨y, ⟨hyd, by simpa only [span_le, singleton_subset_iff]⟩⟩,
end

/-- The span of a finite subset is compact in the lattice of submodules. -/
lemma finset_span_is_compact_element (S : finset M) :
  complete_lattice.is_compact_element (span R S : submodule R M) :=
begin
  rw span_eq_supr_of_singleton_spans,
  simp only [finset.mem_coe],
  rw ←finset.sup_eq_supr,
  exact complete_lattice.finset_sup_compact_of_compact S
    (λ x _, singleton_span_is_compact_element x),
end

/-- The span of a finite subset is compact in the lattice of submodules. -/
lemma finite_span_is_compact_element (S : set M) (h : S.finite) :
  complete_lattice.is_compact_element (span R S : submodule R M) :=
finite.coe_to_finset h ▸ (finset_span_is_compact_element h.to_finset)

instance : is_compactly_generated (submodule R M) :=
⟨λ s, ⟨(λ x, span R {x}) '' s, ⟨λ t ht, begin
  rcases (set.mem_image _ _ _).1 ht with ⟨x, hx, rfl⟩,
  apply singleton_span_is_compact_element,
end, by rw [Sup_eq_supr, supr_image, ←span_eq_supr_of_singleton_spans, span_eq]⟩⟩⟩

/-- A submodule is equal to the supremum of the spans of the submodule's nonzero elements. -/
lemma submodule_eq_Sup_le_nonzero_spans (p : submodule R M) :
  p = Sup {T : submodule R M | ∃ (m : M) (hm : m ∈ p) (hz : m ≠ 0), T = span R {m}} :=
begin
  let S := {T : submodule R M | ∃ (m : M) (hm : m ∈ p) (hz : m ≠ 0), T = span R {m}},
  apply le_antisymm,
  { intros m hm, by_cases h : m = 0,
    { rw h, simp },
    { exact @le_Sup _ _ S _ ⟨m, ⟨hm, ⟨h, rfl⟩⟩⟩ m (mem_span_singleton_self m) } },
  { rw Sup_le_iff, rintros S ⟨_, ⟨_, ⟨_, rfl⟩⟩⟩, rwa span_singleton_le_iff_mem }
end

lemma lt_sup_iff_not_mem {I : submodule R M} {a : M} : I < I ⊔ (R ∙ a) ↔ a ∉ I :=
begin
  split,
  { intro h,
    by_contra akey,
    have h1 : I ⊔ (R ∙ a) ≤ I,
    { simp only [sup_le_iff],
      split,
      { exact le_refl I, },
      { exact (span_singleton_le_iff_mem a I).mpr akey, } },
    have h2 := gt_of_ge_of_gt h1 h,
    exact lt_irrefl I h2, },
  { intro h,
    apply set_like.lt_iff_le_and_exists.mpr, split,
    simp only [le_sup_left],
    use a,
    split, swap, { assumption, },
    { have : (R ∙ a) ≤ I ⊔ (R ∙ a) := le_sup_right,
      exact this (mem_span_singleton_self a), } },
end

lemma mem_supr {ι : Sort*} (p : ι → submodule R M) {m : M} :
  (m ∈ ⨆ i, p i) ↔ (∀ N, (∀ i, p i ≤ N) → m ∈ N) :=
begin
  rw [← span_singleton_le_iff_mem, le_supr_iff],
  simp only [span_singleton_le_iff_mem],
end

section

open_locale classical

/-- For every element in the span of a set, there exists a finite subset of the set
such that the element is contained in the span of the subset. -/
lemma mem_span_finite_of_mem_span {S : set M} {x : M} (hx : x ∈ span R S) :
  ∃ T : finset M, ↑T ⊆ S ∧ x ∈ span R (T : set M) :=
begin
  refine span_induction hx (λ x hx, _) _ _ _,
  { refine ⟨{x}, _, _⟩,
    { rwa [finset.coe_singleton, set.singleton_subset_iff] },
    { rw finset.coe_singleton,
      exact submodule.mem_span_singleton_self x } },
  { use ∅, simp },
  { rintros x y ⟨X, hX, hxX⟩ ⟨Y, hY, hyY⟩,
    refine ⟨X ∪ Y, _, _⟩,
    { rw finset.coe_union,
      exact set.union_subset hX hY },
    rw [finset.coe_union, span_union, mem_sup],
    exact ⟨x, hxX, y, hyY, rfl⟩, },
  { rintros a x ⟨T, hT, h2⟩,
    exact ⟨T, hT, smul_mem _ _ h2⟩ }
end

end

variables {M' : Type*} [add_comm_monoid M'] [module R M'] (q₁ q₁' : submodule R M')

/-- The product of two submodules is a submodule. -/
def prod : submodule R (M × M') :=
{ carrier   := p ×ˢ q₁,
  smul_mem' := by rintro a ⟨x, y⟩ ⟨hx, hy⟩; exact ⟨smul_mem _ a hx, smul_mem _ a hy⟩,
  .. p.to_add_submonoid.prod q₁.to_add_submonoid }

@[simp] lemma prod_coe : (prod p q₁ : set (M × M')) = p ×ˢ q₁ := rfl

@[simp] lemma mem_prod {p : submodule R M} {q : submodule R M'} {x : M × M'} :
  x ∈ prod p q ↔ x.1 ∈ p ∧ x.2 ∈ q := set.mem_prod

lemma span_prod_le (s : set M) (t : set M') :
  span R (s ×ˢ t) ≤ prod (span R s) (span R t) :=
span_le.2 $ set.prod_mono subset_span subset_span

@[simp] lemma prod_top : (prod ⊤ ⊤ : submodule R (M × M')) = ⊤ :=
by ext; simp

@[simp] lemma prod_bot : (prod ⊥ ⊥ : submodule R (M × M')) = ⊥ :=
by ext ⟨x, y⟩; simp [prod.zero_eq_mk]

lemma prod_mono {p p' : submodule R M} {q q' : submodule R M'} :
  p ≤ p' → q ≤ q' → prod p q ≤ prod p' q' := prod_mono

@[simp] lemma prod_inf_prod : prod p q₁ ⊓ prod p' q₁' = prod (p ⊓ p') (q₁ ⊓ q₁') :=
set_like.coe_injective set.prod_inter_prod

@[simp] lemma prod_sup_prod : prod p q₁ ⊔ prod p' q₁' = prod (p ⊔ p') (q₁ ⊔ q₁') :=
begin
  refine le_antisymm (sup_le
    (prod_mono le_sup_left le_sup_left)
    (prod_mono le_sup_right le_sup_right)) _,
  simp [set_like.le_def], intros xx yy hxx hyy,
  rcases mem_sup.1 hxx with ⟨x, hx, x', hx', rfl⟩,
  rcases mem_sup.1 hyy with ⟨y, hy, y', hy', rfl⟩,
  refine mem_sup.2 ⟨(x, y), ⟨hx, hy⟩, (x', y'), ⟨hx', hy'⟩, rfl⟩
end

end add_comm_monoid

section add_comm_group

variables [ring R] [add_comm_group M] [module R M]

@[simp] lemma span_neg (s : set M) : span R (-s) = span R s :=
calc span R (-s) = span R ((-linear_map.id : M →ₗ[R] M) '' s) : by simp
 ... = map (-linear_map.id) (span R s) : ((-linear_map.id).map_span _).symm
... = span R s : by simp

lemma mem_span_insert' {x y} {s : set M} : x ∈ span R (insert y s) ↔ ∃(a:R), x + a • y ∈ span R s :=
begin
  rw mem_span_insert, split,
  { rintro ⟨a, z, hz, rfl⟩, exact ⟨-a, by simp [hz, add_assoc]⟩ },
  { rintro ⟨a, h⟩, exact ⟨-a, _, h, by simp [add_comm, add_left_comm]⟩ }
end

instance : is_modular_lattice (submodule R M) :=
⟨λ x y z xz a ha, begin
  rw [mem_inf, mem_sup] at ha,
  rcases ha with ⟨⟨b, hb, c, hc, rfl⟩, haz⟩,
  rw mem_sup,
  refine ⟨b, hb, c, mem_inf.2 ⟨hc, _⟩, rfl⟩,
  rw [← add_sub_cancel c b, add_comm],
  apply z.sub_mem haz (xz hb),
end⟩

end add_comm_group

section add_comm_group

variables [semiring R] [semiring R₂]
variables [add_comm_group M] [module R M] [add_comm_group M₂] [module R₂ M₂]
variables {τ₁₂ : R →+* R₂} [ring_hom_surjective τ₁₂]
variables {F : Type*} [sc : semilinear_map_class F τ₁₂ M M₂]

include sc
lemma comap_map_eq (f : F) (p : submodule R M) :
  comap f (map f p) = p ⊔ (linear_map.ker f) :=
begin
  refine le_antisymm _ (sup_le (le_comap_map _ _) (comap_mono bot_le)),
  rintro x ⟨y, hy, e⟩,
  exact mem_sup.2 ⟨y, hy, x - y, by simpa using sub_eq_zero.2 e.symm, by simp⟩
end

lemma comap_map_eq_self {f : F} {p : submodule R M} (h : linear_map.ker f ≤ p) :
  comap f (map f p) = p :=
by rw [submodule.comap_map_eq, sup_of_le_left h]
omit sc

end add_comm_group

end submodule

namespace linear_map

open submodule function

section add_comm_group

variables [semiring R] [semiring R₂]
variables [add_comm_group M] [add_comm_group M₂]
variables [module R M] [module R₂ M₂]
variables {τ₁₂ : R →+* R₂} [ring_hom_surjective τ₁₂]
variables {F : Type*} [sc : semilinear_map_class F τ₁₂ M M₂]
include R

include sc
protected lemma map_le_map_iff (f : F) {p p'} : map f p ≤ map f p' ↔ p ≤ p' ⊔ ker f :=
by rw [map_le_iff_le_comap, submodule.comap_map_eq]

theorem map_le_map_iff' {f : F} (hf : ker f = ⊥) {p p'} :
  map f p ≤ map f p' ↔ p ≤ p' :=
by rw [linear_map.map_le_map_iff, hf, sup_bot_eq]

theorem map_injective {f : F} (hf : ker f = ⊥) : injective (map f) :=
λ p p' h, le_antisymm ((map_le_map_iff' hf).1 (le_of_eq h)) ((map_le_map_iff' hf).1 (ge_of_eq h))

theorem map_eq_top_iff {f : F} (hf : range f = ⊤) {p : submodule R M} :
  p.map f = ⊤ ↔ p ⊔ linear_map.ker f = ⊤ :=
by simp_rw [← top_le_iff, ← hf, range_eq_map, linear_map.map_le_map_iff]

end add_comm_group

section
variables (R) (M) [semiring R] [add_comm_monoid M] [module R M]

/-- Given an element `x` of a module `M` over `R`, the natural map from
    `R` to scalar multiples of `x`.-/
@[simps] def to_span_singleton (x : M) : R →ₗ[R] M := linear_map.id.smul_right x

/-- The range of `to_span_singleton x` is the span of `x`.-/
lemma span_singleton_eq_range (x : M) : (R ∙ x) = (to_span_singleton R M x).range :=
submodule.ext $ λ y, by {refine iff.trans _ linear_map.mem_range.symm, exact mem_span_singleton }

@[simp] lemma to_span_singleton_one (x : M) : to_span_singleton R M x 1 = x := one_smul _ _

@[simp] lemma to_span_singleton_zero : to_span_singleton R M 0 = 0 := by { ext, simp, }

end

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [module R M]
variables [semiring R₂] [add_comm_monoid M₂] [module R₂ M₂]
variables {σ₁₂ : R →+* R₂}

/-- If two linear maps are equal on a set `s`, then they are equal on `submodule.span s`.

See also `linear_map.eq_on_span'` for a version using `set.eq_on`. -/
lemma eq_on_span {s : set M} {f g : M →ₛₗ[σ₁₂] M₂} (H : set.eq_on f g s) ⦃x⦄ (h : x ∈ span R s) :
  f x = g x :=
by apply span_induction h H; simp {contextual := tt}

/-- If two linear maps are equal on a set `s`, then they are equal on `submodule.span s`.

This version uses `set.eq_on`, and the hidden argument will expand to `h : x ∈ (span R s : set M)`.
See `linear_map.eq_on_span` for a version that takes `h : x ∈ span R s` as an argument. -/
lemma eq_on_span' {s : set M} {f g : M →ₛₗ[σ₁₂] M₂} (H : set.eq_on f g s) :
  set.eq_on f g (span R s : set M) :=
eq_on_span H

/-- If `s` generates the whole module and linear maps `f`, `g` are equal on `s`, then they are
equal. -/
lemma ext_on {s : set M} {f g : M →ₛₗ[σ₁₂] M₂} (hv : span R s = ⊤) (h : set.eq_on f g s) :
  f = g :=
linear_map.ext (λ x, eq_on_span h (eq_top_iff'.1 hv _))

/-- If the range of `v : ι → M` generates the whole module and linear maps `f`, `g` are equal at
each `v i`, then they are equal. -/
lemma ext_on_range {ι : Type*} {v : ι → M} {f g : M →ₛₗ[σ₁₂] M₂} (hv : span R (set.range v) = ⊤)
  (h : ∀i, f (v i) = g (v i)) : f = g :=
ext_on hv (set.forall_range_iff.2 h)

end add_comm_monoid

section field

variables {K V} [field K] [add_comm_group V] [module K V]

noncomputable theory
open_locale classical

lemma span_singleton_sup_ker_eq_top (f : V →ₗ[K] K) {x : V} (hx : f x ≠ 0) :
  (K ∙ x) ⊔ f.ker = ⊤ :=
eq_top_iff.2 (λ y hy, submodule.mem_sup.2 ⟨(f y * (f x)⁻¹) • x,
  submodule.mem_span_singleton.2 ⟨f y * (f x)⁻¹, rfl⟩,
    ⟨y - (f y * (f x)⁻¹) • x,
      by rw [linear_map.mem_ker, f.map_sub, f.map_smul, smul_eq_mul, mul_assoc,
             inv_mul_cancel hx, mul_one, sub_self],
      by simp only [add_sub_cancel'_right]⟩⟩)

variables (K V)

lemma ker_to_span_singleton {x : V} (h : x ≠ 0) : (to_span_singleton K V x).ker = ⊥ :=
begin
  ext c, split,
  { intros hc, rw submodule.mem_bot, rw mem_ker at hc, by_contra hc',
    have : x = 0,
      calc x = c⁻¹ • (c • x) : by rw [← mul_smul, inv_mul_cancel hc', one_smul]
      ... = c⁻¹ • ((to_span_singleton K V x) c) : rfl
      ... = 0 : by rw [hc, smul_zero],
    tauto },
  { rw [mem_ker, submodule.mem_bot], intros h, rw h, simp }
end

end field

end linear_map

open linear_map

namespace linear_equiv

section field

variables (K V) [field K] [add_comm_group V] [module K V]

/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural
    map from `K` to the span of `x`, with invertibility check to consider it as an
    isomorphism.-/
def to_span_nonzero_singleton (x : V) (h : x ≠ 0) : K ≃ₗ[K] (K ∙ x) :=
linear_equiv.trans
  (linear_equiv.of_injective
    (linear_map.to_span_singleton K V x) (ker_eq_bot.1 $ linear_map.ker_to_span_singleton K V h))
  (linear_equiv.of_eq (to_span_singleton K V x).range (K ∙ x)
    (span_singleton_eq_range K V x).symm)

lemma to_span_nonzero_singleton_one (x : V) (h : x ≠ 0) :
  linear_equiv.to_span_nonzero_singleton K V x h 1 =
    (⟨x, submodule.mem_span_singleton_self x⟩ : K ∙ x) :=
begin
  apply set_like.coe_eq_coe.mp,
  have : ↑(to_span_nonzero_singleton K V x h 1) = to_span_singleton K V x 1 := rfl,
  rw [this, to_span_singleton_one, submodule.coe_mk],
end

/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural map
    from the span of `x` to `K`.-/
abbreviation coord (x : V) (h : x ≠ 0) : (K ∙ x) ≃ₗ[K] K :=
(to_span_nonzero_singleton K V x h).symm

lemma coord_self (x : V) (h : x ≠ 0) :
  (coord K V x h) (⟨x, submodule.mem_span_singleton_self x⟩ : K ∙ x) = 1 :=
by rw [← to_span_nonzero_singleton_one K V x h, linear_equiv.symm_apply_apply]

end field

end linear_equiv


-- Propiedades de la composición de funciones
-- ==========================================

import tactic

open function

variables {X Y Z W : Type}

-- ----------------------------------------------------
-- Ej. 1. Demostrar que
--    id ∘ f = f
-- ----------------------------------------------------

-- 1ª demostración
example
  (f : X → Y)
  : id ∘ f = f :=
begin
  ext,
  calc (id ∘ f) x = id (f x) : by rw comp_app
       ...        = f x      : by rw id.def,
end

-- 2ª demostración
example
  (f : X → Y)
  : id ∘ f = f :=
begin
  ext,
  rw comp_app,
  rw id.def,
end

-- 3ª demostración
example
  (f : X → Y)
  : id ∘ f = f :=
begin
  ext,
  rw [comp_app, id.def],
end

-- 4ª demostración
example
  (f : X → Y)
  : id ∘ f = f :=
begin
  ext,
  calc (id ∘ f) x = id (f x) : rfl
       ...        = f x      : rfl,
end

-- 5ª demostración
example
  (f : X → Y)
  : id ∘ f = f :=
rfl

-- 6ª demostración
example
  (f : X → Y)
  : id ∘ f = f :=
-- by library_search
left_id f

-- 7ª demostración
example
  (f : X → Y)
  : id ∘ f = f :=
comp.left_id f

-- ----------------------------------------------------
-- Ej. 2. Demostrar que
--    f ∘ id = f
-- ----------------------------------------------------

-- 1ª demostración
example
  (f : X → Y)
  : f ∘ id = f :=
begin
  ext,
  calc (f ∘ id) x = f (id x) : by rw comp_app
       ...        = f x      : by rw id.def,
end

-- 2ª demostración
example
  (f : X → Y)
  : f ∘ id = f :=
begin
  ext,
  rw comp_app,
  rw id.def,
end

-- 3ª demostración
example
  (f : X → Y)
  : f ∘ id = f :=
begin
  ext,
  rw [comp_app, id.def],
end

-- 4ª demostración
example
  (f : X → Y)
  : f ∘ id = f :=
begin
  ext,
  calc (f ∘ id) x = f (id x) : rfl
       ...        = f x      : rfl,
end

-- 5ª demostración
example
  (f : X → Y)
  : f ∘ id = f :=
rfl

-- 6ª demostración
example
  (f : X → Y)
  : f ∘ id = f :=
-- by library_search
right_id f

-- 7ª demostración
example
  (f : X → Y)
  : f ∘ id = f :=
comp.right_id f

-- ----------------------------------------------------
-- Ej. 3. Demostrar que
--    (f ∘ g) ∘ h = f ∘ (g ∘ h)
-- ----------------------------------------------------

-- 1ª demostración
example
  (f : Z → W)
  (g : Y → Z)
  (h : X → Y)
  : (f ∘ g) ∘ h = f ∘ (g ∘ h) :=
begin
  ext,
  calc ((f ∘ g) ∘ h) x
           = (f ∘ g) (h x)   : by rw comp_app
       ... = f (g (h x))     : by rw comp_app
       ... = f ((g ∘ h) x)   : by rw comp_app
       ... = (f ∘ (g ∘ h)) x : by rw comp_app
end

-- 2ª demostración
example
  (f : Z → W)
  (g : Y → Z)
  (h : X → Y)
  : (f ∘ g) ∘ h = f ∘ (g ∘ h) :=
begin
  ext,
  rw comp_app,
end

-- 3ª demostración
example
  (f : Z → W)
  (g : Y → Z)
  (h : X → Y)
  : (f ∘ g) ∘ h = f ∘ (g ∘ h) :=
begin
  ext,
  calc ((f ∘ g) ∘ h) x
           = (f ∘ g) (h x)   : rfl
       ... = f (g (h x))     : rfl
       ... = f ((g ∘ h) x)   : rfl
       ... = (f ∘ (g ∘ h)) x : rfl
end

-- 4ª demostración
example
  (f : Z → W)
  (g : Y → Z)
  (h : X → Y)
  : (f ∘ g) ∘ h = f ∘ (g ∘ h) :=
rfl

-- 5ª demostración
example
  (f : Z → W)
  (g : Y → Z)
  (h : X → Y)
  : (f ∘ g) ∘ h = f ∘ (g ∘ h) :=
comp.assoc f g h


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

import data.fintype.basic
import group_theory.perm.sign
import logic.equiv.defs

/-! # Equivalence between fintypes

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

This file contains some basic results on equivalences where one or both
sides of the equivalence are `fintype`s.

# Main definitions

 - `function.embedding.to_equiv_range`: computably turn an embedding of a
   fintype into an `equiv` of the domain to its range
 - `equiv.perm.via_fintype_embedding : perm α → (α ↪ β) → perm β` extends the domain of
   a permutation, fixing everything outside the range of the embedding

# Implementation details

 - `function.embedding.to_equiv_range` uses a computable inverse, but one that has poor
   computational performance, since it operates by exhaustive search over the input `fintype`s.
-/

variables {α β : Type*} [fintype α] [decidable_eq β] (e : equiv.perm α) (f : α ↪ β)

/--
Computably turn an embedding `f : α ↪ β` into an equiv `α ≃ set.range f`,
if `α` is a `fintype`. Has poor computational performance, due to exhaustive searching in
constructed inverse. When a better inverse is known, use `equiv.of_left_inverse'` or
`equiv.of_left_inverse` instead. This is the computable version of `equiv.of_injective`.
-/
def function.embedding.to_equiv_range : α ≃ set.range f :=
⟨λ a, ⟨f a, set.mem_range_self a⟩, f.inv_of_mem_range, λ _, by simp, λ _, by simp⟩

@[simp] lemma function.embedding.to_equiv_range_apply (a : α) :
  f.to_equiv_range a = ⟨f a, set.mem_range_self a⟩ := rfl

@[simp] lemma function.embedding.to_equiv_range_symm_apply_self (a : α) :
  f.to_equiv_range.symm ⟨f a, set.mem_range_self a⟩ = a :=
by simp [equiv.symm_apply_eq]

lemma function.embedding.to_equiv_range_eq_of_injective :
  f.to_equiv_range = equiv.of_injective f f.injective :=
by { ext, simp }

/--
Extend the domain of `e : equiv.perm α`, mapping it through `f : α ↪ β`.
Everything outside of `set.range f` is kept fixed. Has poor computational performance,
due to exhaustive searching in constructed inverse due to using `function.embedding.to_equiv_range`.
When a better `α ≃ set.range f` is known, use `equiv.perm.via_set_range`.
When `[fintype α]` is not available, a noncomputable version is available as
`equiv.perm.via_embedding`.
-/
def equiv.perm.via_fintype_embedding : equiv.perm β :=
e.extend_domain f.to_equiv_range

@[simp] lemma equiv.perm.via_fintype_embedding_apply_image (a : α) :
  e.via_fintype_embedding f (f a) = f (e a) :=
begin
  rw equiv.perm.via_fintype_embedding,
  convert equiv.perm.extend_domain_apply_image e _ _
end

lemma equiv.perm.via_fintype_embedding_apply_mem_range {b : β} (h : b ∈ set.range f) :
  e.via_fintype_embedding f b = f (e (f.inv_of_mem_range ⟨b, h⟩)) :=
by simpa [equiv.perm.via_fintype_embedding, equiv.perm.extend_domain_apply_subtype, h]

lemma equiv.perm.via_fintype_embedding_apply_not_mem_range {b : β} (h : b ∉ set.range f) :
  e.via_fintype_embedding f b = b :=
by rwa [equiv.perm.via_fintype_embedding, equiv.perm.extend_domain_apply_not_subtype]

@[simp] lemma equiv.perm.via_fintype_embedding_sign [decidable_eq α] [fintype β] :
  equiv.perm.sign (e.via_fintype_embedding f) = equiv.perm.sign e :=
by simp [equiv.perm.via_fintype_embedding]

namespace equiv
variables {p q : α → Prop} [decidable_pred p] [decidable_pred q]

/-- If `e` is an equivalence between two subtypes of a fintype `α`, `e.to_compl`
is an equivalence between the complement of those subtypes.

See also `equiv.compl`, for a computable version when a term of type
`{e' : α ≃ α // ∀ x : {x // p x}, e' x = e x}` is known. -/
noncomputable def to_compl (e : {x // p x} ≃ {x // q x}) : {x // ¬ p x} ≃ {x // ¬ q x} :=
classical.choice (fintype.card_eq.mp (fintype.card_compl_eq_card_compl _ _ (fintype.card_congr e)))

/-- If `e` is an equivalence between two subtypes of a fintype `α`, `e.extend_subtype`
is a permutation of `α` acting like `e` on the subtypes and doing something arbitrary outside.

Note that when `p = q`, `equiv.perm.subtype_congr e (equiv.refl _)` can be used instead. -/
noncomputable abbreviation extend_subtype (e : {x // p x} ≃ {x // q x}) : perm α :=
subtype_congr e e.to_compl

lemma extend_subtype_apply_of_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : p x) :
  e.extend_subtype x = e ⟨x, hx⟩ :=
by { dunfold extend_subtype,
     simp only [subtype_congr, equiv.trans_apply, equiv.sum_congr_apply],
     rw [sum_compl_apply_symm_of_pos _ _ hx, sum.map_inl, sum_compl_apply_inl] }

lemma extend_subtype_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : p x) :
  q (e.extend_subtype x) :=
by { convert (e ⟨x, hx⟩).2,
     rw [e.extend_subtype_apply_of_mem _ hx, subtype.val_eq_coe] }

lemma extend_subtype_not_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : ¬ p x) :
  ¬ q (e.extend_subtype x) :=
by { convert (e.to_compl ⟨x, hx⟩).2,
     rw [e.extend_subtype_apply_of_not_mem _ hx, subtype.val_eq_coe] }

end equiv


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.terminal
import Mathlib.category_theory.limits.shapes.binary_products
import Mathlib.PostPort

universes v₁ u₁

namespace Mathlib

/-!
# Subterminal objects

Subterminal objects are the objects which can be thought of as subobjects of the terminal object.
In fact, the definition can be constructed to not require a terminal object, by defining `A` to be
subterminal iff for any `Z`, there is at most one morphism `Z ⟶ A`.
An alternate definition is that the diagonal morphism `A ⟶ A ⨯ A` is an isomorphism.
In this file we define subterminal objects and show the equivalence of these three definitions.

We also construct the subcategory of subterminal objects.

## TODO

* Define exponential ideals, and show this subcategory is an exponential ideal.
* Define subobject lattices in general, show that `subterminals C` is equivalent to the subobject
category of a terminal object.
* Use both the above to show that in a locally cartesian closed category, every subobject lattice
  is cartesian closed (equivalently, a Heyting algebra).

-/

namespace category_theory

/-- An object `A` is subterminal iff for any `Z`, there is at most one morphism `Z ⟶ A`. -/
def is_subterminal {C : Type u₁} [category C] (A : C) := ∀ {Z : C} (f g : Z ⟶ A), f = g

theorem is_subterminal.def {C : Type u₁} [category C] {A : C} :
    is_subterminal A ↔ ∀ {Z : C} (f g : Z ⟶ A), f = g :=
  iff.rfl

/--
If `A` is subterminal, the unique morphism from it to a terminal object is a monomorphism.
The converse of `is_subterminal_of_mono_is_terminal_from`.
-/
theorem is_subterminal.mono_is_terminal_from {C : Type u₁} [category C] {A : C}
    (hA : is_subterminal A) {T : C} (hT : limits.is_terminal T) :
    mono (limits.is_terminal.from hT A) :=
  mono.mk
    fun (Z : C) (g h : Z ⟶ A)
      (_x : g ≫ limits.is_terminal.from hT A = h ≫ limits.is_terminal.from hT A) => hA g h

/--
If `A` is subterminal, the unique morphism from it to the terminal object is a monomorphism.
The converse of `is_subterminal_of_mono_terminal_from`.
-/
theorem is_subterminal.mono_terminal_from {C : Type u₁} [category C] {A : C} [limits.has_terminal C]
    (hA : is_subterminal A) : mono (limits.terminal.from A) :=
  is_subterminal.mono_is_terminal_from hA limits.terminal_is_terminal

/--
If the unique morphism from `A` to a terminal object is a monomorphism, `A` is subterminal.
The converse of `is_subterminal.mono_is_terminal_from`.
-/
theorem is_subterminal_of_mono_is_terminal_from {C : Type u₁} [category C] {A : C} {T : C}
    (hT : limits.is_terminal T) [mono (limits.is_terminal.from hT A)] : is_subterminal A :=
  fun (Z : C) (f g : Z ⟶ A) =>
    eq.mpr
      (id
        (Eq._oldrec (Eq.refl (f = g))
          (Eq.symm (propext (cancel_mono (limits.is_terminal.from hT A))))))
      (limits.is_terminal.hom_ext hT (f ≫ limits.is_terminal.from hT A)
        (g ≫ limits.is_terminal.from hT A))

/--
If the unique morphism from `A` to the terminal object is a monomorphism, `A` is subterminal.
The converse of `is_subterminal.mono_terminal_from`.
-/
theorem is_subterminal_of_mono_terminal_from {C : Type u₁} [category C] {A : C}
    [limits.has_terminal C] [mono (limits.terminal.from A)] : is_subterminal A :=
  fun (Z : C) (f g : Z ⟶ A) =>
    eq.mpr
      (id (Eq._oldrec (Eq.refl (f = g)) (Eq.symm (propext (cancel_mono (limits.terminal.from A))))))
      (subsingleton.elim (f ≫ limits.terminal.from A) (g ≫ limits.terminal.from A))

theorem is_subterminal_of_is_terminal {C : Type u₁} [category C] {T : C}
    (hT : limits.is_terminal T) : is_subterminal T :=
  fun (Z : C) (f g : Z ⟶ T) => limits.is_terminal.hom_ext hT f g

theorem is_subterminal_of_terminal {C : Type u₁} [category C] [limits.has_terminal C] :
    is_subterminal (⊤_C) :=
  fun (Z : C) (f g : Z ⟶ ⊤_C) => subsingleton.elim f g

/--
If `A` is subterminal, its diagonal morphism is an isomorphism.
The converse of `is_subterminal_of_is_iso_diag`.
-/
def is_subterminal.is_iso_diag {C : Type u₁} [category C] {A : C} (hA : is_subterminal A)
    [limits.has_binary_product A A] : is_iso (limits.diag A) :=
  is_iso.mk limits.prod.fst

/--
If the diagonal morphism of `A` is an isomorphism, then it is subterminal.
The converse of `is_subterminal.is_iso_diag`.
-/
theorem is_subterminal_of_is_iso_diag {C : Type u₁} [category C] {A : C}
    [limits.has_binary_product A A] [is_iso (limits.diag A)] : is_subterminal A :=
  sorry

/-- If `A` is subterminal, it is isomorphic to `A ⨯ A`. -/
@[simp] theorem is_subterminal.iso_diag_hom {C : Type u₁} [category C] {A : C}
    (hA : is_subterminal A) [limits.has_binary_product A A] :
    iso.hom (is_subterminal.iso_diag hA) = inv (limits.diag A) :=
  Eq.refl (inv (limits.diag A))

/--
The (full sub)category of subterminal objects.
TODO: If `C` is the category of sheaves on a topological space `X`, this category is equivalent
to the lattice of open subsets of `X`. More generally, if `C` is a topos, this is the lattice of
"external truth values".
-/
def subterminals (C : Type u₁) [category C] := Subtype fun (A : C) => is_subterminal A

protected instance subterminals.inhabited (C : Type u₁) [category C] [limits.has_terminal C] :
    Inhabited (subterminals C) :=
  { default := { val := ⊤_C, property := is_subterminal_of_terminal } }

/-- The inclusion of the subterminal objects into the original category. -/
def subterminal_inclusion (C : Type u₁) [category C] : subterminals C ⥤ C :=
  full_subcategory_inclusion fun (A : C) => is_subterminal A

end Mathlib


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

! This file was ported from Lean 3 source module algebraic_geometry.prime_spectrum.maximal
! leanprover-community/mathlib commit 052f6013363326d50cb99c6939814a4b8eb7b301
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicGeometry.PrimeSpectrum.Basic
import Mathbin.RingTheory.Localization.AsSubring

/-!
# Maximal spectrum of a commutative ring

The maximal spectrum of a commutative ring is the type of all maximal ideals.
It is naturally a subset of the prime spectrum endowed with the subspace topology.

## Main definitions

* `maximal_spectrum R`: The maximal spectrum of a commutative ring `R`,
  i.e., the set of all maximal ideals of `R`.

## Implementation notes

The Zariski topology on the maximal spectrum is defined as the subspace topology induced by the
natural inclusion into the prime spectrum to avoid API duplication for zero loci.
-/

noncomputable section

open Classical

universe u v

variable (R : Type u) [CommRing R]

/-- The maximal spectrum of a commutative ring `R` is the type of all maximal ideals of `R`. -/
@[ext]
structure MaximalSpectrum where
  asIdeal : Ideal R
  IsMaximal : as_ideal.IsMaximal
#align maximal_spectrum MaximalSpectrum

attribute [instance] MaximalSpectrum.isMaximal

variable {R}

namespace MaximalSpectrum

instance [Nontrivial R] : Nonempty <| MaximalSpectrum R :=
  let ⟨I, hI⟩ := Ideal.exists_maximal R
  ⟨⟨I, hI⟩⟩

/-- The natural inclusion from the maximal spectrum to the prime spectrum. -/
def toPrimeSpectrum (x : MaximalSpectrum R) : PrimeSpectrum R :=
  ⟨x.asIdeal, x.IsMaximal.IsPrime⟩
#align maximal_spectrum.to_prime_spectrum MaximalSpectrum.toPrimeSpectrum

theorem toPrimeSpectrum_injective : (@toPrimeSpectrum R _).Injective := fun ⟨_, _⟩ ⟨_, _⟩ h => by
  simpa only [mk.inj_eq] using (PrimeSpectrum.ext_iff _ _).mp h
#align maximal_spectrum.to_prime_spectrum_injective MaximalSpectrum.toPrimeSpectrum_injective

open PrimeSpectrum Set

theorem toPrimeSpectrum_range :
    Set.range (@toPrimeSpectrum R _) = { x | IsClosed ({x} : Set <| PrimeSpectrum R) } :=
  by
  simp only [is_closed_singleton_iff_is_maximal]
  ext ⟨x, _⟩
  exact ⟨fun ⟨y, hy⟩ => hy ▸ y.IsMaximal, fun hx => ⟨⟨x, hx⟩, rfl⟩⟩
#align maximal_spectrum.to_prime_spectrum_range MaximalSpectrum.toPrimeSpectrum_range

/-- The Zariski topology on the maximal spectrum of a commutative ring is defined as the subspace
topology induced by the natural inclusion into the prime spectrum. -/
instance zariskiTopology : TopologicalSpace <| MaximalSpectrum R :=
  PrimeSpectrum.zariskiTopology.induced toPrimeSpectrum
#align maximal_spectrum.zariski_topology MaximalSpectrum.zariskiTopology

instance : T1Space <| MaximalSpectrum R :=
  ⟨fun x =>
    isClosed_induced_iff.mpr
      ⟨{toPrimeSpectrum x}, (isClosed_singleton_iff_isMaximal _).mpr x.IsMaximal, by
        simpa only [← image_singleton] using preimage_image_eq {x} to_prime_spectrum_injective⟩⟩

theorem toPrimeSpectrum_continuous : Continuous <| @toPrimeSpectrum R _ :=
  continuous_induced_dom
#align maximal_spectrum.to_prime_spectrum_continuous MaximalSpectrum.toPrimeSpectrum_continuous

variable (R) [IsDomain R] (K : Type v) [Field K] [Algebra R K] [IsFractionRing R K]

/-- An integral domain is equal to the intersection of its localizations at all its maximal ideals
viewed as subalgebras of its field of fractions. -/
theorem infᵢ_localization_eq_bot :
    (⨅ v : MaximalSpectrum R,
        Localization.subalgebra.ofField K _ v.asIdeal.primeCompl_le_nonZeroDivisors) =
      ⊥ :=
  by
  ext x
  rw [Algebra.mem_bot, Algebra.mem_infᵢ]
  constructor
  · apply imp_of_not_imp_not
    intro hrange hlocal
    let denom : Ideal R := (Submodule.span R {1} : Submodule R K).colon (Submodule.span R {x})
    have hdenom : (1 : R) ∉ denom := by
      intro hdenom
      rcases submodule.mem_span_singleton.mp
          (submodule.mem_colon.mp hdenom x <| Submodule.mem_span_singleton_self x) with
        ⟨y, hy⟩
      exact hrange ⟨y, by rw [← mul_one <| algebraMap R K y, ← Algebra.smul_def, hy, one_smul]⟩
    rcases denom.exists_le_maximal fun h => (h ▸ hdenom) Submodule.mem_top with ⟨max, hmax, hle⟩
    rcases hlocal ⟨max, hmax⟩ with ⟨n, d, hd, rfl⟩
    apply hd (hle <| submodule.mem_colon.mpr fun _ hy => _)
    rcases submodule.mem_span_singleton.mp hy with ⟨y, rfl⟩
    exact
      submodule.mem_span_singleton.mpr
        ⟨y * n, by
          rw [Algebra.smul_def, mul_one, map_mul, smul_comm, Algebra.smul_def, Algebra.smul_def,
            mul_comm <| algebraMap R K d,
            inv_mul_cancel_right₀ <|
              (map_ne_zero_iff _ <| NoZeroSMulDivisors.algebraMap_injective R K).mpr fun h =>
                (h ▸ hd) max.zero_mem]⟩
  · rintro ⟨y, rfl⟩ ⟨v, hv⟩
    exact ⟨y, 1, v.ne_top_iff_one.mp hv.ne_top, by rw [map_one, inv_one, mul_one]⟩
#align maximal_spectrum.infi_localization_eq_bot MaximalSpectrum.infᵢ_localization_eq_bot

end MaximalSpectrum

namespace PrimeSpectrum

variable (R) [IsDomain R] (K : Type v) [Field K] [Algebra R K] [IsFractionRing R K]

/-- An integral domain is equal to the intersection of its localizations at all its prime ideals
viewed as subalgebras of its field of fractions. -/
theorem infᵢ_localization_eq_bot :
    (⨅ v : PrimeSpectrum R,
        Localization.subalgebra.ofField K _ <| v.asIdeal.primeCompl_le_nonZeroDivisors) =
      ⊥ :=
  by
  ext x
  rw [Algebra.mem_infᵢ]
  constructor
  · rw [← MaximalSpectrum.infᵢ_localization_eq_bot, Algebra.mem_infᵢ]
    exact fun hx ⟨v, hv⟩ => hx ⟨v, hv.IsPrime⟩
  · rw [Algebra.mem_bot]
    rintro ⟨y, rfl⟩ ⟨v, hv⟩
    exact ⟨y, 1, v.ne_top_iff_one.mp hv.ne_top, by rw [map_one, inv_one, mul_one]⟩
#align prime_spectrum.infi_localization_eq_bot PrimeSpectrum.infᵢ_localization_eq_bot

end PrimeSpectrum


import data.finset.basic
import combinatorics.simple_graph.basic
import algebra.module.submodule.basic
import linear_algebra.finite_dimensional
import linear_algebra.finrank
import linear_algebra.finsupp
import data.setoid.partition
import linear_algebra.projective_space.basic
import linear_algebra.span

universes u v w

open finset

variables {α : Type u} [decidable_eq α]

variables [fintype α]

-- any d-dimensional vector space over GF(q) has exactly (q^d-1) / (q - 1) 1-dimensional subspaces
-- do i count it as fintype.card or do i try to do set of subspaces?
-- fintype.card {x : subspace α V | findim x = 1} = (q^d-1) / (q - 1)
variables (K : Type u) (V : Type v) [field K] [add_comm_group V] [module K V] [fintype K]
variables [finite_dimensional K V] (q d : ℕ)
--variables [fintype (module K V)]
variables [fintype {S : submodule K V | finite_dimensional.finrank K S = 1}]
-- size of K should be q
-- we get [fintype V] from finite_dimensional K V and fintype K

/-instance fintype_submodules [fintype V] : fintype (submodule K V) :=
begin
  rw submodule,
  sorry,
end-/

/-instance fintype_subspaces [fintype V] : fintype {S : submodule K V | finite_dimensional.finrank K S = 1} :=
begin
  simp,
  --have h : subtype ↑(powerset (@finset.univ V _)),
  apply subtype,
  sorry,
end-/

-- lemma num_basis_vectors :

-- use basis_unique, basis_singleton

-- some kind of lemma stating that if c ⬝ x = d ⬝ y then their respective subspaces are the same
-- do we have some kind of map from basis to subspace?
-- i think the notation here is K ∙ x = K ∙ y
-- this is just span_singleton_eq_span_singleton
lemma subspace_eq_of_basis_scalar (x y : V) (b : K) (h2 : b ≠ 0) :
  x = (b • y) → (K ∙ x) = (K ∙ y) :=
begin
  intros h,
  ext v;
  simp_rw [submodule.mem_span_singleton],
  --refine ⟨λ ⟨n, hn⟩, _, λ n, _⟩,
  split,
  rintros ⟨n, hn⟩,
  rw [← hn, h, smul_smul],
  use (n * b),
  rintros ⟨n, hn⟩,
  use (n * b⁻¹),
  rw [← hn, h, smul_smul, mul_assoc, inv_mul_cancel h2, mul_one],
end

lemma mem_span_singleton_smul (a : K) (x : V) : a • x ∈ K ∙ x :=
begin
  apply submodule.mem_span_singleton.2,
  use a,
end

open_locale classical

-- only true if V & K nontrivial
-- use this for principal of inclusion-exclusion?
lemma sUnion_dimone_univ (hV : nontrivial V) :
  set.sUnion {x : set V | ∃ (m : submodule K V), x = m.carrier ∧ finite_dimensional.finrank K m = 1} = set.univ :=
begin
  ext;
  split,
  { intros h,
    simp at h },
  simp,
  by_cases h : x ≠ 0,
  { use (K ∙ x).carrier,
    refine ⟨_, submodule.mem_span_singleton_self x⟩,
    use (K ∙ x),
    refine ⟨rfl, finrank_span_singleton h⟩ },
  push_neg at h,
  cases ((nontrivial_iff_exists_ne 0).1 hV) with v hv,
  use (K ∙ v).carrier,
  rw h,
  refine ⟨_, (submodule.mem_carrier (K ∙ v)).2 (submodule.zero_mem (K ∙ v))⟩,
  use (K ∙ v),
  refine ⟨rfl, finrank_span_singleton hv⟩,
end

variables {ι : Type*}
lemma nonzero_elems [fintype ι] (b : basis ι K V) [fintype V] :
 ({0}ᶜ : finset V).card = fintype.card K ^ fintype.card ι - 1 :=
begin
  rw [← module.card_fintype b, ← card_singleton (0 : V), card_compl],
end

variables {K V}
def subspace_rem_zero (S : submodule K V) : set V := S \ {0}

noncomputable def subspace_rem_zero_finset [fintype V] (S : submodule K V) : finset V := (subspace_rem_zero S).to_finset

-- i don't know why the lemma doesn't see the instances
variables [nontrivial K] (p : submodule K V) [no_zero_smul_divisors K p]
lemma span_singleton_eq_iff_mem_dim_one (m : V) (hk : m ≠ 0) : (K ∙ m) = p ↔ m ∈ p ∧ finite_dimensional.finrank K p = 1 :=
begin
  refine ⟨λ h2, _, λ h2, _⟩,
  { rw ← h2,
    refine ⟨submodule.mem_span_singleton_self m, finrank_span_singleton hk⟩ },
  ext;
  refine ⟨λ h3, _, λ h4, _⟩,
  { simp only [submodule.mem_span, set.singleton_subset_iff, set_like.mem_coe] at h3,
    apply h3 p h2.1 },
  have h6 : (⟨m, h2.1⟩ : p) ≠ 0,
  { simp only [ne.def, submodule.mk_eq_zero],
    exact hk },
  have hbas : nonempty (basis (fin 1) K p),
  { use (finite_dimensional.basis_singleton (fin 1) h2.2) ⟨m, h2.1⟩ h6 },
  rcases (basis.basis_singleton_iff (fin 1)).1 hbas with ⟨a, ⟨ha, hb⟩⟩,
  cases hb ⟨x, h4⟩ with r hr,
  cases hb ⟨m, h2.1⟩ with s hs,
  by_cases x = 0,
  simp only [h, submodule.zero_mem],
  have h16 : s ≠ 0,
  { rw ← hs at h6,
    exact (smul_ne_zero_iff.1 h6).1 },
  have h17 : m = s • ↑a,
  { rw [← submodule.coe_smul, hs, submodule.coe_mk] },
  rw [subspace_eq_of_basis_scalar K V m a s h16 h17, submodule.mem_span_singleton],
  use r,
  rw [← submodule.coe_mk x h4, ← hr, submodule.coe_smul],
end

noncomputable def of_span [fintype V] : finpartition ({0}ᶜ : finset V) :=
{ parts := finset.image subspace_rem_zero_finset ({S : submodule K V | finite_dimensional.finrank K S = 1}.to_finset),
  sup_indep := λ S h a ha hna,
    begin
      simp only [mem_image, set.mem_to_finset, set.mem_set_of_eq, exists_prop] at ha,
      rcases ha with ⟨H, ⟨hH1, hH2⟩⟩,
      simp_rw [disjoint_iff_ne, mem_sup],
      rintros x hx y ⟨Y, ⟨hY1, hY2⟩⟩,
      have h2 := mem_of_subset h hY1,
      simp only [mem_image, set.mem_to_finset, set.mem_set_of_eq, exists_prop] at h2,
      rcases h2 with ⟨P, ⟨hP1, hP2⟩⟩,
      have hxH : x ∈ H,
      { simp only [← hH2, subspace_rem_zero_finset, subspace_rem_zero, set.to_finset_diff,
          id.def, mem_sdiff, set.mem_to_finset, set_like.mem_coe, set.mem_singleton_iff] at hx,
        exact hx.1 },
      have hyP : y ∈ P,
      { simp only [id.def, ← hP2, subspace_rem_zero_finset, subspace_rem_zero,
          set.to_finset_diff, mem_sdiff, set.mem_to_finset, set_like.mem_coe, set.mem_singleton_iff] at hY2,
        exact hY2.1 },
      have hx0 : x ≠ 0,
      { simp only [← hH2, subspace_rem_zero_finset, subspace_rem_zero,
          set.to_finset_diff, id.def, mem_sdiff, set.mem_to_finset,
          set_like.mem_coe, set.mem_singleton_iff] at hx,
        exact hx.2 },
      by_contra hxy,
      rw ← hxy at hyP,
      have hHP : H = P,
      { rw [← (span_singleton_eq_iff_mem_dim_one H x hx0).2 ⟨hxH, hH1⟩, ← (span_singleton_eq_iff_mem_dim_one P x hx0).2 ⟨hyP, hP1⟩] },
      have haY : a = Y,
      { rw [← hP2, ← hHP, ← hH2] },
      rw ← haY at hY1,
      apply hna hY1,
    end,
  sup_parts :=
    begin
      ext a;
      simp only [mem_sup, mem_compl, mem_singleton],
      refine ⟨λ h, _, λ h, _⟩,
      { rcases h with ⟨f, ⟨h1, h2⟩⟩,
        rw mem_image at h1,
        rcases h1 with ⟨S, ⟨h4, h5⟩⟩,
        rw [subspace_rem_zero_finset, subspace_rem_zero] at h5,
        simp only [← h5, set.to_finset_diff, id.def, mem_sdiff, set.mem_to_finset,
          set_like.mem_coe, set.mem_singleton_iff] at h2,
        exact h2.2 },
      { use subspace_rem_zero_finset (K ∙ a),
        simp only [mem_image, set.mem_to_finset, set.mem_set_of_eq, exists_prop, id.def],
        refine ⟨_, _⟩,
        { use (K ∙ a),
          refine ⟨_, rfl⟩,
          rw ← finrank_span_singleton h },
        rw [subspace_rem_zero_finset, subspace_rem_zero, set.mem_to_finset,
          set.mem_diff, set_like.mem_coe, set.mem_singleton_iff],
        exact ⟨submodule.mem_span_singleton_self a, h⟩ },
    end,
  not_bot_mem :=
    begin
      by_contra,
      simp at h,
      rcases h with ⟨a, ⟨ha1, ha2⟩⟩,
      simp only [subspace_rem_zero_finset, subspace_rem_zero, set.to_finset_diff,
        sdiff_eq_empty_iff_subset, set.to_finset_subset, set.coe_to_finset,
        set.subset_singleton_iff, set_like.mem_coe] at ha2,
      have h2 : finite_dimensional.finrank K a = 0,
      { rw finrank_zero_iff_forall_zero,
        intros x,
        specialize ha2 x x.2,
        simp only [submodule.coe_eq_zero] at ha2,
        apply ha2 },
      apply nat.one_ne_zero,
      rw [← ha1, ← h2],
    end }

lemma card_subspace_rem_zero [fintype V] [nontrivial V] :
  (∀ (x : finset V), x ∈ finset.image subspace_rem_zero_finset ({S : submodule K V | finite_dimensional.finrank K S = 1}.to_finset) → finset.card x = (fintype.card K) - 1) :=
begin
  simp_rw [mem_image, set.mem_to_finset, set.mem_set_of_eq,
    subspace_rem_zero_finset, subspace_rem_zero],
  rintros x ⟨h, ⟨ha, hb⟩⟩,
  have h6 : 0 < finite_dimensional.finrank K ↥h,
  { simp only [ha, nat.lt_one_iff] },
  haveI := finite_dimensional.finrank_pos_iff.1 h6,
  cases (exists_ne (0 : h)) with y hy,
  have hy' : y.1 ≠ 0,
  { simp only [subtype.val_eq_coe, ne.def, submodule.coe_eq_zero],
    exact hy },
  have h9 := linear_equiv.to_span_nonzero_singleton K V y.1 hy',
  have h13 : nonempty (K ≃ (submodule.span K {y.1})),
  { use (equiv.of_bijective h9.to_equiv h9.to_equiv.bijective) },
  rw [← hb, ← (span_singleton_eq_iff_mem_dim_one h y.1 hy').2 ⟨y.2, ha⟩,
    set.to_finset_diff, card_sdiff, set.to_finset_card],
  simp only [set_like.coe_sort_coe, ← fintype.card_eq.2 h13,
    set.to_finset_card, set.card_singleton],
  simp only [set.to_finset_subset, set.coe_to_finset,
    set.singleton_subset_iff, set_like.mem_coe, submodule.zero_mem],
end

lemma num_subspaces_dim_one [nontrivial V] :
  fintype.card {S : subspace K V | finite_dimensional.finrank K S = 1} * ((fintype.card K) - 1) = (fintype.card K) ^ (finite_dimensional.finrank K V) - 1 :=
begin
  haveI := module.fintype_of_fintype (finite_dimensional.fin_basis K V), -- this part is necessary for fintype V instance

  have h5 := @finpartition.sum_card_parts V _ ({0}ᶜ : finset V) (@of_span K V _ _ _ _ _ _ _ _),
  have h6 : (@of_span K V _ _ _ _ _ _ _ _).parts.sum (λ (i : finset V), i.card) = (@of_span K V _ _ _ _ _ _ _ _).parts.sum (λ (i : finset V), ((fintype.card K) - 1)),
  apply sum_congr rfl,
  { exact λ a ha, card_subspace_rem_zero a ha },

  rw @sum_const _ (finset V) of_span.parts _ ((fintype.card K) - 1) at h6,
  simp at h6,
  rw nonzero_elems K V (finite_dimensional.fin_basis K V) at h5,
  simp at h5,
  rw [← h5, h6],
  simp,
  left,
  rw of_span,
  simp only,
  rw [finset.card_image_of_injective, set.to_finset_card],
  intros a b hg,
  rw [subspace_rem_zero_finset, subspace_rem_zero_finset, subspace_rem_zero,
    subspace_rem_zero, set.to_finset_inj] at hg,
  ext;
  by_cases x ∈ ({0} : set V),
  { simp only [set.mem_singleton_iff] at h,
    rw h,
    refine ⟨λ ha, submodule.zero_mem _, λ hb, submodule.zero_mem _⟩ },
  refine ⟨λ ha, _, λ hb, _⟩,
  { have ha' : x ∈ ↑a,
    apply ha,
    have hm := (set.mem_diff x).2 ⟨ha', h⟩,
    rw [hg, set.mem_diff] at hm,
    apply hm.1 },
  { have hb' : x ∈ ↑b,
    apply hb,
    have hm := (set.mem_diff x).2 ⟨hb', h⟩,
    rw [← hg, set.mem_diff] at hm,
    apply hm.1 },
end

variables [fintype (subspace K V)]
-- for general dimension of the subspace we might be able to set up an induction argument
-- need to show that if S is k-dimensional subspace, there are k (unique?) 1-dimensional subspaces whose closure is S
lemma dim_unique_subspaces [nontrivial V] (S : subspace K V) (h : 0 < finite_dimensional.finrank K S) :
  ∃ (X : set (submodule K V)),
    ∀ (y : submodule K V), y ∈ X → finite_dimensional.finrank K y = 1 ∧
    fintype.card X = finite_dimensional.finrank K S ∧ (Sup X) = S :=
begin
  have B := (finite_dimensional.fin_basis K V),
  /-have M := λ x : (fin (finite_dimensional.finrank K ↥S)), K ∙ B ↑x,
  --have M2 := λ (y : subspace K V), ∃ x : fin (finite_dimensional.finrank K ↥S), (M x) = y.to_submodule,
  have M2 := set.image M (@univ (fin (finite_dimensional.finrank K ↥S)) _),
  use M2,-/
  sorry,
end


import pq_to_group
import sub_pq

universe u

section minimal_sub_pq

structure group_sub_pq (G : Type u) [group G] :=
(carrier : set G)
(closed_rhd : ∀ x y : G, x ∈ carrier → y ∈ carrier → (x * y * x⁻¹) ∈ carrier)
(closed_pow : ∀ x : G, ∀ n : ℤ, x ∈ carrier → x ^ n ∈ carrier)
(closed_one : (1 : G) ∈ carrier)

variables {G : Type u} [group G]

inductive free_group_sub_pq_carrier (gen : set G) : G → Prop
| incl (x : G) (hx : x ∈ gen) : free_group_sub_pq_carrier x
| rhd (x y : G) (hx : free_group_sub_pq_carrier x) (hy : free_group_sub_pq_carrier y) : free_group_sub_pq_carrier (x * y * x⁻¹)
| pow (x : G) (n : ℤ) (hx : free_group_sub_pq_carrier x) : free_group_sub_pq_carrier (x ^ n)
| one : free_group_sub_pq_carrier (1)

lemma gen_in_free_group_sub_pq_carrier (gen : set G) : gen ≤ free_group_sub_pq_carrier gen :=
begin
  intros x hx,
  apply free_group_sub_pq_carrier.incl,
  exact hx,
end

def free_group_sub_pq (gen : set G) : group_sub_pq G := {
  carrier := free_group_sub_pq_carrier gen,
  closed_rhd := free_group_sub_pq_carrier.rhd,
  closed_pow := free_group_sub_pq_carrier.pow,
  closed_one := free_group_sub_pq_carrier.one
}

def gen_group_sub_pq (x : group_sub_pq G) : sub_power_quandle G := {
  carrier := x.carrier,
  closed_rhd := x.closed_rhd,
  closed_pow := x.closed_pow,
  closed_one := x.closed_one }

def free_gen_group_sub_pq (gen : set G) : sub_power_quandle G := gen_group_sub_pq (free_group_sub_pq gen)

end minimal_sub_pq

section minimal_sub_pq_L

variables {Q : Type u} [power_quandle Q]

def of_gen : set (pq_group Q) := λ x, ∃ g : Q, x = of g

def of_gen_group_sub_pq : group_sub_pq (pq_group Q) := {
  carrier := of_gen,
  closed_rhd := begin
    intros x y hx hy,
    rw ←rhd_def_group,
    cases hx with q1 hq1,
    cases hy with q2 hq2,
    use (q1 ▷ q2),
    rw hq1,
    rw hq2,
    rw rhd_of_eq_of_rhd,
  end,
  closed_pow := begin
    intros x n hx,
    cases hx with q hq,
    use (q^n),
    rw hq,
    rw of_pow_eq_pow_of,
  end,
  closed_one := begin
    use 1,
    rw of_one,
  end }

def pq_group_to_sub_pq : (pq_group Q) →* (pq_group (gen_group_sub_pq (@of_gen_group_sub_pq Q _))) :=
begin
  fapply pq_morph_to_L_morph_adj,
  {
    intro q,
    apply of,
    fconstructor,
    exact of q,
    use q,
  },
  {
    split,
    {
      intros a b,
      simp_rw rhd_of_eq_of_rhd,
      apply congr_arg,
      simp_rw ←rhd_of_eq_of_rhd,
      refl,
    },
    {
      intros a n,
      simp_rw ←of_pow_eq_pow_of,
      apply congr_arg,
      simp_rw of_pow_eq_pow_of,
      refl,
    },
  },
end

def sub_pq_to_pq_group : (pq_group (gen_group_sub_pq (@of_gen_group_sub_pq Q _))) →* (pq_group Q) :=
begin
  fapply pq_morph_to_L_morph_adj,
  {
    intro x,
    cases x with x hx,
    exact x,
  },
  {
    split,
    {
      intros a b,
      cases a with a ha,
      cases b with b hb,
      simp only,
      have hab := sub_power_quandle.closed_rhd _ a b ha hb,
      have rhd_rw : (⟨a, ha⟩ : {x // x ∈ has_coe_t_aux.coe (gen_group_sub_pq of_gen_group_sub_pq)}) ▷ ⟨b, hb⟩ = ⟨a ▷ b, hab⟩ := rfl,
      rw rhd_rw,
    },
    {
      intros a n,
      cases a with a ha,
      simp only,
      have han := sub_power_quandle.closed_pow _ a n ha,
      have pow_rw : (⟨a, ha⟩ : {x // x ∈ has_coe_t_aux.coe (gen_group_sub_pq of_gen_group_sub_pq)}) ^ n = ⟨a ^ n, han⟩ := rfl,
      rw pow_rw,
    },
  },
end

def pq_group_iso_sub_pq : (pq_group Q) ≃* (pq_group (gen_group_sub_pq (@of_gen_group_sub_pq Q _))) :=
begin
  fconstructor,
  {
    exact pq_group_to_sub_pq,
  },
  {
    exact sub_pq_to_pq_group,
  },
  {
    intro x,
    induction x,
    {
      rw quot_mk_helper,
      induction x,
      {
        rw incl_unit_eq_unit,
        simp only [monoid_hom.map_one],
      },
      {
        rw ←of_def,
        unfold pq_group_to_sub_pq,
        rw pq_morph_to_L_morph_adj_comm_of,
        unfold sub_pq_to_pq_group,
        rw pq_morph_to_L_morph_adj_comm_of,
      },
      {
        rw ←mul_def,
        simp only [monoid_hom.map_mul],
        rw x_ih_a,
        rw x_ih_b,
      },
      {
        rw ←inv_def,
        simp only [inv_inj, monoid_hom.map_inv],
        assumption,
      },
    },
    {refl,},
  },
  {
    intro x,
    induction x,
    {
      rw quot_mk_helper,
      induction x,
      {
        rw incl_unit_eq_unit,
        simp only [monoid_hom.map_one],
      },
      {
        rw ←of_def,
        unfold sub_pq_to_pq_group,
        rw pq_morph_to_L_morph_adj_comm_of,
        cases x with x hx,
        simp only,
        cases hx with y hy,
        simp_rw hy,
        unfold pq_group_to_sub_pq,
        rw pq_morph_to_L_morph_adj_comm_of,
        refl,
      },
      {
        rw ←mul_def,
        simp only [monoid_hom.map_mul],
        rw x_ih_a,
        rw x_ih_b,
      },
      {
        rw ←inv_def,
        simp only [inv_inj, monoid_hom.map_inv],
        assumption,
      },
    },
    {refl,},
  },
  {
    intros a b,
    simp only [monoid_hom.map_mul],
  },
end

/-
noncomputable def sub_pq_to_pq_group : (pq_group (gen_group_sub_pq (@of_gen_group_sub_pq Q _))) →* (pq_group Q) :=
begin
  fapply pq_morph_to_L_morph_adj,
  {
    intro x,
    apply of,
    cases x with x hx,
    exact classical.some hx,
  },
  {
    split,
    {
      intros a b,
      cases a with a ha,
      cases b with b hb,
      simp only,
      have hx := classical.some_spec ha,
      have hy := classical.some_spec hb,
      rw ←hx,
      rw ←hy,
      have hab := sub_power_quandle.closed_rhd _ a b ha hb,
      have rhd_rw : (⟨a, ha⟩ : {x // x ∈ has_coe_t_aux.coe (gen_group_sub_pq of_gen_group_sub_pq)}) ▷ ⟨b, hb⟩ = ⟨a ▷ b, hab⟩ := rfl,
      rw rhd_rw,
      simp only,
      have hxy := classical.some_spec hab,
      rw ←hxy,
    },
    {
      intros a n,
      cases a with a ha,
      simp only,
      have hx := classical.some_spec ha,
      rw ←hx,
      have han := sub_power_quandle.closed_pow _ a n ha,
      have pow_rw : (⟨a, ha⟩ : {x // x ∈ has_coe_t_aux.coe (gen_group_sub_pq of_gen_group_sub_pq)}) ^ n = ⟨a ^ n, han⟩ := rfl,
      rw pow_rw,
      simp only,
      have hxn := classical.some_spec han,
      rw ←hxn,
    },
  },
end

noncomputable def pq_group_iso_sub_pq : (pq_group Q) ≃* (pq_group (gen_group_sub_pq (@of_gen_group_sub_pq Q _))) :=
begin
  fconstructor,
  {
    exact pq_group_to_sub_pq,
  },
  {
    exact sub_pq_to_pq_group,
  },
  {
    intro x,
    induction x,
    {
      rw quot_mk_helper,
      induction x,
      {
        rw incl_unit_eq_unit,
        simp only [monoid_hom.map_one],
      },
      {
        rw ←of_def,
        unfold pq_group_to_sub_pq,
        rw pq_morph_to_L_morph_adj_comm_of,
        unfold sub_pq_to_pq_group,
        rw pq_morph_to_L_morph_adj_comm_of,
        simp only,
        have hx := classical.some_spec (_ : ∃ (g : Q), of x = of g),
        rw ←hx,
      },
      {
        rw ←mul_def,
        simp only [monoid_hom.map_mul],
        rw x_ih_a,
        rw x_ih_b,
      },
      {
        rw ←inv_def,
        simp only [inv_inj, monoid_hom.map_inv],
        assumption,
      },
    },
    {refl,},
  },
  {
    intro x,
    induction x,
    {
      rw quot_mk_helper,
      induction x,
      {
        rw incl_unit_eq_unit,
        simp only [monoid_hom.map_one],
      },
      {
        rw ←of_def,
        unfold sub_pq_to_pq_group,
        rw pq_morph_to_L_morph_adj_comm_of,
        simp only,
        cases x with x hx,
        simp only,
        unfold pq_group_to_sub_pq,
        rw pq_morph_to_L_morph_adj_comm_of,
        have hx1 := classical.some_spec hx,
        apply congr_arg,
        ext1,
        simp only [subtype.coe_mk],
        rw ←hx1,
      },
      {
        rw ←mul_def,
        simp only [monoid_hom.map_mul],
        rw x_ih_a,
        rw x_ih_b,
      },
      {
        rw ←inv_def,
        simp only [inv_inj, monoid_hom.map_inv],
        assumption,
      },
    },
    {refl,},
  },
  {
    intros a b,
    simp only [monoid_hom.map_mul],
  },
end
-/

end minimal_sub_pq_L