/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Eric Wieser
-/
import ring_theory.localization.at_prime
import ring_theory.graded_algebra.basic

/-!
# Homogeneous Localization

## Notation
- `ι` is a commutative monoid;
- `R` is a commutative semiring;
- `A` is a commutative ring and an `R`-algebra;
- `𝒜 : ι → submodule R A` is the grading of `A`;
- `x : submonoid A` is a submonoid

## Main definitions and results

This file constructs the subring of `Aₓ` where the numerator and denominator have the same grading,
i.e. `{a/b ∈ Aₓ | ∃ (i : ι), a ∈ 𝒜ᵢ ∧ b ∈ 𝒜ᵢ}`.

* `homogeneous_localization.num_denom_same_deg`: a structure with a numerator and denominator field
  where they are required to have the same grading.

However `num_denom_same_deg 𝒜 x` cannot have a ring structure for many reasons, for example if `c`
is a `num_denom_same_deg`, then generally, `c + (-c)` is not necessarily `0` for degree reasons ---
`0` is considered to have grade zero (see `deg_zero`) but `c + (-c)` has the same degree as `c`. To
circumvent this, we quotient `num_denom_same_deg 𝒜 x` by the kernel of `c ↦ c.num / c.denom`.

* `homogeneous_localization.num_denom_same_deg.embedding` : for `x : submonoid A` and any
  `c : num_denom_same_deg 𝒜 x`, or equivalent a numerator and a denominator of the same degree,
  we get an element `c.num / c.denom` of `Aₓ`.
* `homogeneous_localization`: `num_denom_same_deg 𝒜 x` quotiented by kernel of `embedding 𝒜 x`.
* `homogeneous_localization.val`: if `f : homogeneous_localization 𝒜 x`, then `f.val` is an element
  of `Aₓ`. In another word, one can view `homogeneous_localization 𝒜 x` as a subring of `Aₓ`
  through `homogeneous_localization.val`.
* `homogeneous_localization.num`: if `f : homogeneous_localization 𝒜 x`, then `f.num : A` is the
  numerator of `f`.
* `homogeneous_localization.denom`: if `f : homogeneous_localization 𝒜 x`, then `f.denom : A` is the
  denominator of `f`.
* `homogeneous_localization.deg`: if `f : homogeneous_localization 𝒜 x`, then `f.deg : ι` is the
  degree of `f` such that `f.num ∈ 𝒜 f.deg` and `f.denom ∈ 𝒜 f.deg`
  (see `homogeneous_localization.num_mem_deg` and `homogeneous_localization.denom_mem_deg`).
* `homogeneous_localization.num_mem_deg`: if `f : homogeneous_localization 𝒜 x`, then
  `f.num_mem_deg` is a proof that `f.num ∈ 𝒜 f.deg`.
* `homogeneous_localization.denom_mem_deg`: if `f : homogeneous_localization 𝒜 x`, then
  `f.denom_mem_deg` is a proof that `f.denom ∈ 𝒜 f.deg`.
* `homogeneous_localization.eq_num_div_denom`: if `f : homogeneous_localization 𝒜 x`, then
  `f.val : Aₓ` is equal to `f.num / f.denom`.

* `homogeneous_localization.local_ring`: `homogeneous_localization 𝒜 x` is a local ring when `x` is
  the complement of some prime ideals.

## References

* [Robin Hartshorne, *Algebraic Geometry*][Har77]

-/

noncomputable theory

open_locale direct_sum big_operators pointwise
open direct_sum set_like

variables {ι R A: Type*}
variables [add_comm_monoid ι] [decidable_eq ι]
variables [comm_ring R] [comm_ring A] [algebra R A]
variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
variables (x : submonoid A)

local notation `at ` x := localization x

namespace homogeneous_localization

section
/--
Let `x` be a submonoid of `A`, then `num_denom_same_deg 𝒜 x` is a structure with a numerator and a
denominator with same grading such that the denominator is contained in `x`.
-/
@[nolint has_nonempty_instance]
structure num_denom_same_deg :=
(deg : ι)
(num denom : 𝒜 deg)
(denom_mem : (denom : A) ∈ x)

end

namespace num_denom_same_deg

open set_like.graded_monoid submodule

variable {𝒜}
@[ext] lemma ext {c1 c2 : num_denom_same_deg 𝒜 x} (hdeg : c1.deg = c2.deg)
  (hnum : (c1.num : A) = c2.num) (hdenom : (c1.denom : A) = c2.denom) :
  c1 = c2 :=
begin
  rcases c1 with ⟨i1, ⟨n1, hn1⟩, ⟨d1, hd1⟩, h1⟩,
  rcases c2 with ⟨i2, ⟨n2, hn2⟩, ⟨d2, hd2⟩, h2⟩,
  dsimp only [subtype.coe_mk] at *,
  simp only, exact ⟨hdeg, by subst hdeg; subst hnum, by subst hdeg; subst hdenom⟩,
end

instance : has_one (num_denom_same_deg 𝒜 x) :=
{ one :=
  { deg := 0,
    num := ⟨1, one_mem⟩,
    denom := ⟨1, one_mem⟩,
    denom_mem := submonoid.one_mem _ } }

@[simp] lemma deg_one : (1 : num_denom_same_deg 𝒜 x).deg = 0 := rfl
@[simp] lemma num_one : ((1 : num_denom_same_deg 𝒜 x).num : A) = 1 := rfl
@[simp] lemma denom_one : ((1 : num_denom_same_deg 𝒜 x).denom : A) = 1 := rfl

instance : has_zero (num_denom_same_deg 𝒜 x) :=
{ zero := ⟨0, 0, ⟨1, one_mem⟩, submonoid.one_mem _⟩ }

@[simp] lemma deg_zero : (0 : num_denom_same_deg 𝒜 x).deg = 0 := rfl
@[simp] lemma num_zero : (0 : num_denom_same_deg 𝒜 x).num = 0 := rfl
@[simp] lemma denom_zero : ((0 : num_denom_same_deg 𝒜 x).denom : A) = 1 := rfl

instance : has_mul (num_denom_same_deg 𝒜 x) :=
{ mul := λ p q,
  { deg := p.deg + q.deg,
    num := ⟨p.num * q.num, mul_mem p.num.prop q.num.prop⟩,
    denom := ⟨p.denom * q.denom, mul_mem p.denom.prop q.denom.prop⟩,
    denom_mem := submonoid.mul_mem _ p.denom_mem q.denom_mem } }

@[simp] lemma deg_mul (c1 c2 : num_denom_same_deg 𝒜 x) : (c1 * c2).deg = c1.deg + c2.deg := rfl
@[simp] lemma num_mul (c1 c2 : num_denom_same_deg 𝒜 x) :
  ((c1 * c2).num : A) = c1.num * c2.num := rfl
@[simp] lemma denom_mul (c1 c2 : num_denom_same_deg 𝒜 x) :
  ((c1 * c2).denom : A) = c1.denom * c2.denom := rfl

instance : has_add (num_denom_same_deg 𝒜 x) :=
{ add := λ c1 c2,
  { deg := c1.deg + c2.deg,
    num := ⟨c1.denom * c2.num + c2.denom * c1.num,
      add_mem (mul_mem c1.denom.2 c2.num.2)
        (add_comm c2.deg c1.deg ▸ mul_mem c2.denom.2 c1.num.2)⟩,
    denom := ⟨c1.denom * c2.denom, mul_mem c1.denom.2 c2.denom.2⟩,
    denom_mem := submonoid.mul_mem _ c1.denom_mem c2.denom_mem } }

@[simp] lemma deg_add (c1 c2 : num_denom_same_deg 𝒜 x) : (c1 + c2).deg = c1.deg + c2.deg := rfl
@[simp] lemma num_add (c1 c2 : num_denom_same_deg 𝒜 x) :
  ((c1 + c2).num : A) = c1.denom * c2.num + c2.denom * c1.num := rfl
@[simp] lemma denom_add (c1 c2 : num_denom_same_deg 𝒜 x) :
  ((c1 + c2).denom : A) = c1.denom * c2.denom := rfl

instance : has_neg (num_denom_same_deg 𝒜 x) :=
{ neg := λ c, ⟨c.deg, ⟨-c.num, neg_mem c.num.2⟩, c.denom, c.denom_mem⟩ }

@[simp] lemma deg_neg (c : num_denom_same_deg 𝒜 x) : (-c).deg = c.deg := rfl
@[simp] lemma num_neg (c : num_denom_same_deg 𝒜 x) : ((-c).num : A) = -c.num := rfl
@[simp] lemma denom_neg (c : num_denom_same_deg 𝒜 x) : ((-c).denom : A) = c.denom := rfl

instance : comm_monoid (num_denom_same_deg 𝒜 x) :=
{ one := 1,
  mul := (*),
  mul_assoc := λ c1 c2 c3, ext _ (add_assoc _ _ _) (mul_assoc _ _ _) (mul_assoc _ _ _),
  one_mul := λ c, ext _ (zero_add _) (one_mul _) (one_mul _),
  mul_one := λ c, ext _ (add_zero _) (mul_one _) (mul_one _),
  mul_comm := λ c1 c2, ext _ (add_comm _ _) (mul_comm _ _) (mul_comm _ _) }

instance : has_pow (num_denom_same_deg 𝒜 x) ℕ :=
{ pow := λ c n, ⟨n • c.deg,
    @graded_monoid.gmonoid.gnpow _ (λ i, ↥(𝒜 i)) _ _ n _ c.num,
    @graded_monoid.gmonoid.gnpow _ (λ i, ↥(𝒜 i)) _ _ n _ c.denom,
    begin
      induction n with n ih,
      { simpa only [coe_gnpow, pow_zero] using submonoid.one_mem _ },
      { simpa only [pow_succ', coe_gnpow] using x.mul_mem ih c.denom_mem, },
    end⟩ }

@[simp] lemma deg_pow (c : num_denom_same_deg 𝒜 x) (n : ℕ) : (c ^ n).deg = n • c.deg := rfl
@[simp] lemma num_pow (c : num_denom_same_deg 𝒜 x) (n : ℕ) : ((c ^ n).num : A) = c.num ^ n := rfl
@[simp] lemma denom_pow (c : num_denom_same_deg 𝒜 x) (n : ℕ) :
  ((c ^ n).denom : A) = c.denom ^ n := rfl

section has_smul
variables {α : Type*} [has_smul α R] [has_smul α A] [is_scalar_tower α R A]

instance : has_smul α (num_denom_same_deg 𝒜 x) :=
{ smul := λ m c, ⟨c.deg, m • c.num, c.denom, c.denom_mem⟩ }

@[simp] lemma deg_smul (c : num_denom_same_deg 𝒜 x) (m : α) : (m • c).deg = c.deg := rfl
@[simp] lemma num_smul (c : num_denom_same_deg 𝒜 x) (m : α) : ((m • c).num : A) = m • c.num := rfl
@[simp] lemma denom_smul (c : num_denom_same_deg 𝒜 x) (m : α) :
  ((m • c).denom : A) = c.denom := rfl

end has_smul

variable (𝒜)

/--
For `x : prime ideal of A` and any `p : num_denom_same_deg 𝒜 x`, or equivalent a numerator and a
denominator of the same degree, we get an element `p.num / p.denom` of `Aₓ`.
-/
def embedding (p : num_denom_same_deg 𝒜 x) : at x :=
localization.mk p.num ⟨p.denom, p.denom_mem⟩

end num_denom_same_deg

end homogeneous_localization

/--
For `x : prime ideal of A`, `homogeneous_localization 𝒜 x` is `num_denom_same_deg 𝒜 x` modulo the
kernel of `embedding 𝒜 x`. This is essentially the subring of `Aₓ` where the numerator and
denominator share the same grading.
-/
@[nolint has_nonempty_instance]
def homogeneous_localization : Type* :=
quotient (setoid.ker $ homogeneous_localization.num_denom_same_deg.embedding 𝒜 x)

namespace homogeneous_localization

open homogeneous_localization homogeneous_localization.num_denom_same_deg

variables {𝒜} {x}
/--
View an element of `homogeneous_localization 𝒜 x` as an element of `Aₓ` by forgetting that the
numerator and denominator are of the same grading.
-/
def val (y : homogeneous_localization 𝒜 x) : at x :=
quotient.lift_on' y (num_denom_same_deg.embedding 𝒜 x) $ λ _ _, id

@[simp] lemma val_mk' (i : num_denom_same_deg 𝒜 x) :
  val (quotient.mk' i) = localization.mk i.num ⟨i.denom, i.denom_mem⟩ :=
rfl

variable (x)
lemma val_injective :
  function.injective (@homogeneous_localization.val _ _ _ _ _ _ _ _ 𝒜 _ x) :=
λ a b, quotient.rec_on_subsingleton₂' a b $ λ a b h, quotient.sound' h

instance has_pow : has_pow (homogeneous_localization 𝒜 x) ℕ :=
{ pow := λ z n, (quotient.map' (^ n)
    (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _), begin
      change localization.mk _ _ = localization.mk _ _,
      simp only [num_pow, denom_pow],
      convert congr_arg (λ z, z ^ n) h;
      erw localization.mk_pow;
      refl,
    end) : homogeneous_localization 𝒜 x → homogeneous_localization 𝒜 x) z }

section has_smul
variables {α : Type*} [has_smul α R] [has_smul α A] [is_scalar_tower α R A]
variables [is_scalar_tower α A A]

instance : has_smul α (homogeneous_localization 𝒜 x) :=
{ smul := λ m, quotient.map' ((•) m)
    (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _), begin
      change localization.mk _ _ = localization.mk _ _,
      simp only [num_smul, denom_smul],
      convert congr_arg (λ z : at x, m • z) h;
      rw localization.smul_mk;
      refl,
    end) }

@[simp] lemma smul_val (y : homogeneous_localization 𝒜 x) (n : α) :
  (n • y).val = n • y.val :=
begin
  induction y using quotient.induction_on,
  unfold homogeneous_localization.val has_smul.smul,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = n • localization.mk _ _,
  dsimp only,
  rw localization.smul_mk,
  congr' 1,
end

end has_smul

instance : has_neg (homogeneous_localization 𝒜 x) :=
{ neg := quotient.map' has_neg.neg
    (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _), begin
      change localization.mk _ _ = localization.mk _ _,
      simp only [num_neg, denom_neg, ←localization.neg_mk],
      exact congr_arg (λ c, -c) h
    end) }

instance : has_add (homogeneous_localization 𝒜 x) :=
{ add := quotient.map₂' (+) (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _)
    c3 c4 (h' : localization.mk _ _ = localization.mk _ _), begin
    change localization.mk _ _ = localization.mk _ _,
    simp only [num_add, denom_add, ←localization.add_mk],
    convert congr_arg2 (+) h h';
    erw [localization.add_mk];
    refl
  end) }

instance : has_sub (homogeneous_localization 𝒜 x) :=
{ sub := λ z1 z2, z1 + (-z2) }

instance : has_mul (homogeneous_localization 𝒜 x) :=
{ mul := quotient.map₂' (*) (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _)
    c3 c4 (h' : localization.mk _ _ = localization.mk _ _), begin
    change localization.mk _ _ = localization.mk _ _,
    simp only [num_mul, denom_mul],
    convert congr_arg2 (*) h h';
    erw [localization.mk_mul];
    refl,
  end) }

instance : has_one (homogeneous_localization 𝒜 x) :=
{ one := quotient.mk' 1 }

instance : has_zero (homogeneous_localization 𝒜 x) :=
{ zero := quotient.mk' 0 }

lemma zero_eq :
  (0 : homogeneous_localization 𝒜 x) = quotient.mk' 0 := rfl

lemma one_eq :
  (1 : homogeneous_localization 𝒜 x) = quotient.mk' 1 := rfl

variable {x}
lemma zero_val : (0 : homogeneous_localization 𝒜 x).val = 0 :=
localization.mk_zero _

lemma one_val : (1 : homogeneous_localization 𝒜 x).val = 1 :=
localization.mk_one

@[simp] lemma add_val (y1 y2 : homogeneous_localization 𝒜 x) :
  (y1 + y2).val = y1.val + y2.val :=
begin
  induction y1 using quotient.induction_on,
  induction y2 using quotient.induction_on,
  unfold homogeneous_localization.val has_add.add,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = localization.mk _ _ + localization.mk _ _,
  dsimp only,
  rw [localization.add_mk],
  refl
end

@[simp] lemma mul_val (y1 y2 : homogeneous_localization 𝒜 x) :
  (y1 * y2).val = y1.val * y2.val :=
begin
  induction y1 using quotient.induction_on,
  induction y2 using quotient.induction_on,
  unfold homogeneous_localization.val has_mul.mul,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = localization.mk _ _ * localization.mk _ _,
  dsimp only,
  rw [localization.mk_mul],
  refl,
end

@[simp] lemma neg_val (y : homogeneous_localization 𝒜 x) :
  (-y).val = -y.val :=
begin
  induction y using quotient.induction_on,
  unfold homogeneous_localization.val has_neg.neg,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = - localization.mk _ _,
  dsimp only,
  rw [localization.neg_mk],
  refl,
end

@[simp] lemma sub_val (y1 y2 : homogeneous_localization 𝒜 x) :
  (y1 - y2).val = y1.val - y2.val :=
by rw [show y1 - y2 = y1 + (-y2), from rfl, add_val, neg_val]; refl

@[simp] lemma pow_val (y : homogeneous_localization 𝒜 x) (n : ℕ) :
  (y ^ n).val = y.val ^ n :=
begin
  induction y using quotient.induction_on,
  unfold homogeneous_localization.val has_pow.pow,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = (localization.mk _ _) ^ n,
  rw localization.mk_pow,
  dsimp only,
  congr' 1,
end

instance : has_nat_cast (homogeneous_localization 𝒜 x) := ⟨nat.unary_cast⟩
instance : has_int_cast (homogeneous_localization 𝒜 x) := ⟨int.cast_def⟩

@[simp] lemma nat_cast_val (n : ℕ) : (n : homogeneous_localization 𝒜 x).val = n :=
show val (nat.unary_cast n) = _, by induction n; simp [nat.unary_cast, zero_val, one_val, *]

@[simp] lemma int_cast_val (n : ℤ) : (n : homogeneous_localization 𝒜 x).val = n :=
show val (int.cast_def n) = _, by cases n; simp [int.cast_def, zero_val, one_val, *]

instance homogenous_localization_comm_ring : comm_ring (homogeneous_localization 𝒜 x) :=
(homogeneous_localization.val_injective x).comm_ring _ zero_val one_val add_val mul_val neg_val
  sub_val (λ z n, smul_val x z n) (λ z n, smul_val x z n) pow_val nat_cast_val int_cast_val

instance homogeneous_localization_algebra :
  algebra (homogeneous_localization 𝒜 x) (localization x) :=
{ smul := λ p q, p.val * q,
  to_fun := val,
  map_one' := one_val,
  map_mul' := mul_val,
  map_zero' := zero_val,
  map_add' := add_val,
  commutes' := λ p q, mul_comm _ _,
  smul_def' := λ p q, rfl }

end homogeneous_localization

namespace homogeneous_localization

open homogeneous_localization homogeneous_localization.num_denom_same_deg

variables {𝒜} {x}

/-- numerator of an element in `homogeneous_localization x`-/
def num (f : homogeneous_localization 𝒜 x) : A :=
(quotient.out' f).num

/-- denominator of an element in `homogeneous_localization x`-/
def denom (f : homogeneous_localization 𝒜 x) : A :=
(quotient.out' f).denom

/-- For an element in `homogeneous_localization x`, degree is the natural number `i` such that
  `𝒜 i` contains both numerator and denominator. -/
def deg (f : homogeneous_localization 𝒜 x) : ι :=
(quotient.out' f).deg

lemma denom_mem (f : homogeneous_localization 𝒜 x) :
  f.denom ∈ x :=
(quotient.out' f).denom_mem

lemma num_mem_deg (f : homogeneous_localization 𝒜 x) : f.num ∈ 𝒜 f.deg :=
(quotient.out' f).num.2

lemma denom_mem_deg (f : homogeneous_localization 𝒜 x) : f.denom ∈ 𝒜 f.deg :=
(quotient.out' f).denom.2

lemma eq_num_div_denom (f : homogeneous_localization 𝒜 x) :
  f.val = localization.mk f.num ⟨f.denom, f.denom_mem⟩ :=
begin
  have := (quotient.out_eq' f),
  apply_fun homogeneous_localization.val at this,
  rw ← this,
  unfold homogeneous_localization.val,
  simp only [quotient.lift_on'_mk'],
  refl,
end

lemma ext_iff_val (f g : homogeneous_localization 𝒜 x) : f = g ↔ f.val = g.val :=
{ mp := λ h, h ▸ rfl,
  mpr := λ h, begin
    induction f using quotient.induction_on,
    induction g using quotient.induction_on,
    rw quotient.eq,
    unfold homogeneous_localization.val at h,
    simpa only [quotient.lift_on'_mk] using h,
  end }

section

variables (𝒜) (𝔭 : ideal A) [ideal.is_prime 𝔭]

/--Localizing a ring homogeneously at a prime ideal-/
abbreviation at_prime  := homogeneous_localization 𝒜 𝔭.prime_compl

lemma is_unit_iff_is_unit_val (f : homogeneous_localization.at_prime 𝒜 𝔭) :
  is_unit f.val ↔ is_unit f :=
⟨λ h1, begin
  rcases h1 with ⟨⟨a, b, eq0, eq1⟩, (eq2 : a = f.val)⟩,
  rw eq2 at eq0 eq1,
  clear' a eq2,
  induction b using localization.induction_on with data,
  rcases data with ⟨a, ⟨b, hb⟩⟩,
  dsimp only at eq0 eq1,
  have b_f_denom_not_mem : b * f.denom ∈ 𝔭.prime_compl := λ r, or.elim
    (ideal.is_prime.mem_or_mem infer_instance r) (λ r2, hb r2) (λ r2, f.denom_mem r2),
  rw [f.eq_num_div_denom, localization.mk_mul,
    show (⟨b, hb⟩ : 𝔭.prime_compl) * ⟨f.denom, _⟩ = ⟨b * f.denom, _⟩, from rfl,
    show (1 : localization.at_prime 𝔭) = localization.mk 1 1, by erw localization.mk_self 1,
    localization.mk_eq_mk', is_localization.eq] at eq1,
  rcases eq1 with ⟨⟨c, hc⟩, eq1⟩,
  simp only [← subtype.val_eq_coe] at eq1,
  change c * (1 * (a * f.num)) = _ at eq1,
  simp only [one_mul, mul_one] at eq1,
  have mem1 : c * (a * f.num) ∈ 𝔭.prime_compl :=
    eq1.symm ▸ λ r, or.elim (ideal.is_prime.mem_or_mem infer_instance r) (by tauto) (by tauto),
  have mem2 : f.num ∉ 𝔭,
  { contrapose! mem1,
    erw [not_not],
    exact ideal.mul_mem_left _ _ (ideal.mul_mem_left _ _ mem1), },
  refine ⟨⟨f, quotient.mk' ⟨f.deg, ⟨f.denom, f.denom_mem_deg⟩, ⟨f.num, f.num_mem_deg⟩, mem2⟩,
    _, _⟩, rfl⟩;
  simp only [ext_iff_val, mul_val, val_mk', ← subtype.val_eq_coe, f.eq_num_div_denom,
    localization.mk_mul, one_val];
  convert localization.mk_self _;
  simpa only [mul_comm]
end, λ ⟨⟨_, b, eq1, eq2⟩, rfl⟩, begin
  simp only [ext_iff_val, mul_val, one_val] at eq1 eq2,
  exact ⟨⟨f.val, b.val, eq1, eq2⟩, rfl⟩
end⟩

instance : nontrivial (homogeneous_localization.at_prime 𝒜 𝔭) :=
⟨⟨0, 1, λ r, by simpa [ext_iff_val, zero_val, one_val, zero_ne_one] using r⟩⟩

instance : local_ring (homogeneous_localization.at_prime 𝒜 𝔭) :=
local_ring.of_is_unit_or_is_unit_one_sub_self $ λ a, begin
  simp only [← is_unit_iff_is_unit_val, sub_val, one_val],
  induction a using quotient.induction_on',
  simp only [homogeneous_localization.val_mk', ← subtype.val_eq_coe],
  by_cases mem1 : a.num.1 ∈ 𝔭,
  { right,
    have : a.denom.1 - a.num.1 ∈ 𝔭.prime_compl := λ h, a.denom_mem
      ((sub_add_cancel a.denom.val a.num.val) ▸ ideal.add_mem _ h mem1 : a.denom.1 ∈ 𝔭),
    apply is_unit_of_mul_eq_one _ (localization.mk a.denom.1 ⟨a.denom.1 - a.num.1, this⟩),
    simp only [sub_mul, localization.mk_mul, one_mul, localization.sub_mk, ← subtype.val_eq_coe,
      submonoid.coe_mul],
    convert localization.mk_self _,
    simp only [← subtype.val_eq_coe, submonoid.coe_mul],
    ring, },
  { left,
    change _ ∈ 𝔭.prime_compl at mem1,
    apply is_unit_of_mul_eq_one _ (localization.mk a.denom.1 ⟨a.num.1, mem1⟩),
    rw [localization.mk_mul],
    convert localization.mk_self _,
    simpa only [mul_comm], },
end

end

section

variables (𝒜) (f : A)

/--Localising away from powers of `f` homogeneously.-/
abbreviation away := homogeneous_localization 𝒜 (submonoid.powers f)

end

end homogeneous_localization


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Anne Baanen

! This file was ported from Lean 3 source module algebra.algebra.tower
! leanprover-community/mathlib commit 71150516f28d9826c7341f8815b31f7d8770c212
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Equiv
import Mathlib.LinearAlgebra.Span

/-!
# Towers of algebras

In this file we prove basic facts about towers of algebra.

An algebra tower A/S/R is expressed by having instances of `Algebra A S`,
`Algebra R S`, `Algebra R A` and `IsScalarTower R S A`, the later asserting the
compatibility condition `(r • s) • a = r • (s • a)`.

An important definition is `toAlgHom R S A`, the canonical `R`-algebra homomorphism `S →ₐ[R] A`.

-/

open Pointwise

universe u v w u₁ v₁

variable (R : Type u) (S : Type v) (A : Type w) (B : Type u₁) (M : Type v₁)

namespace Algebra

variable [CommSemiring R] [Semiring A] [Algebra R A]

variable [AddCommMonoid M] [Module R M] [Module A M] [IsScalarTower R A M]

variable {A}

/-- The `R`-algebra morphism `A → End (M)` corresponding to the representation of the algebra `A`
on the `R`-module `M`.

This is a stronger version of `DistribMulAction.toLinearMap`, and could also have been
called `Algebra.toModuleEnd`. -/
def lsmul : A →ₐ[R] Module.End R M where
  toFun := DistribMulAction.toLinearMap R M
  map_one' := LinearMap.ext fun _ => one_smul A _
  map_mul' a b := LinearMap.ext <| smul_assoc a b
  map_zero' := LinearMap.ext fun _ => zero_smul A _
  map_add' _a _b := LinearMap.ext fun _ => add_smul _ _ _
  commutes' r := LinearMap.ext <| algebraMap_smul A r
#align algebra.lsmul Algebra.lsmul

@[simp]
theorem lsmul_coe (a : A) : (lsmul R M a : M → M) = (· • ·) a := rfl
#align algebra.lsmul_coe Algebra.lsmul_coe

end Algebra

namespace IsScalarTower

section Module

variable [CommSemiring R] [Semiring A] [Algebra R A]

variable [SMul R M] [MulAction A M] [IsScalarTower R A M]

variable {R} {M}

theorem algebraMap_smul (r : R) (x : M) : algebraMap R A r • x = r • x := by
  rw [Algebra.algebraMap_eq_smul_one, smul_assoc, one_smul]
#align is_scalar_tower.algebra_map_smul IsScalarTower.algebraMap_smul

end Module

section Semiring

variable [CommSemiring R] [CommSemiring S] [Semiring A] [Semiring B]

variable [Algebra R S] [Algebra S A] [Algebra S B]

variable {R S A}

theorem of_algebraMap_eq [Algebra R A]
    (h : ∀ x, algebraMap R A x = algebraMap S A (algebraMap R S x)) : IsScalarTower R S A :=
  ⟨fun x y z => by simp_rw [Algebra.smul_def, RingHom.map_mul, mul_assoc, h]⟩
#align is_scalar_tower.of_algebra_map_eq IsScalarTower.of_algebraMap_eq

/-- See note [partially-applied ext lemmas]. -/
theorem of_algebraMap_eq' [Algebra R A]
    (h : algebraMap R A = (algebraMap S A).comp (algebraMap R S)) : IsScalarTower R S A :=
  of_algebraMap_eq <| RingHom.ext_iff.1 h
#align is_scalar_tower.of_algebra_map_eq' IsScalarTower.of_algebraMap_eq'

variable (R S A)

variable [Algebra R A] [Algebra R B]

variable [IsScalarTower R S A] [IsScalarTower R S B]

theorem algebraMap_eq : algebraMap R A = (algebraMap S A).comp (algebraMap R S) :=
  RingHom.ext fun x => by
    simp_rw [RingHom.comp_apply, Algebra.algebraMap_eq_smul_one, smul_assoc, one_smul]
#align is_scalar_tower.algebra_map_eq IsScalarTower.algebraMap_eq

theorem algebraMap_apply (x : R) : algebraMap R A x = algebraMap S A (algebraMap R S x) := by
  rw [algebraMap_eq R S A, RingHom.comp_apply]
#align is_scalar_tower.algebra_map_apply IsScalarTower.algebraMap_apply

@[ext]
theorem Algebra.ext {S : Type u} {A : Type v} [CommSemiring S] [Semiring A] (h1 h2 : Algebra S A)
    (h : ∀ (r : S) (x : A), (by have I := h1; exact r • x) = r • x) : h1 = h2 :=
  Algebra.algebra_ext _ _ fun r => by
    simpa only [@Algebra.smul_def _ _ _ _ h1, @Algebra.smul_def _ _ _ _ h2, mul_one] using h r 1
#align is_scalar_tower.algebra.ext IsScalarTower.Algebra.ext

/-- In a tower, the canonical map from the middle element to the top element is an
algebra homomorphism over the bottom element. -/
def toAlgHom : S →ₐ[R] A :=
  { algebraMap S A with commutes' := fun _ => (algebraMap_apply _ _ _ _).symm }
#align is_scalar_tower.to_alg_hom IsScalarTower.toAlgHom

@[simp]
theorem coe_toAlgHom : ↑(toAlgHom R S A) = algebraMap S A :=
  RingHom.ext fun _ => rfl
#align is_scalar_tower.coe_to_alg_hom IsScalarTower.coe_toAlgHom

@[simp]
theorem coe_to_alg_hom' : (toAlgHom R S A : S → A) = algebraMap S A := rfl
#align is_scalar_tower.coe_to_alg_hom' IsScalarTower.coe_to_alg_hom'

variable {R S A B}

@[simp]
theorem AlgHom.map_algebraMap (f : A →ₐ[S] B) (r : R) : f (algebraMap R A r) = algebraMap R B r :=
  by rw [algebraMap_apply R S A r, f.commutes, ← algebraMap_apply R S B]
#align alg_hom.map_algebra_map IsScalarTower.AlgHom.map_algebraMap

variable (R)

@[simp]
theorem AlgHom.comp_algebraMap_of_tower (f : A →ₐ[S] B) :
    (f : A →+* B).comp (algebraMap R A) = algebraMap R B :=
  RingHom.ext (map_algebraMap f)
#align alg_hom.comp_algebra_map_of_tower IsScalarTower.AlgHom.comp_algebraMap_of_tower

-- conflicts with IsScalarTower.Subalgebra
instance (priority := 999) subsemiring (U : Subsemiring S) : IsScalarTower U S A :=
  of_algebraMap_eq fun _x => rfl
#align is_scalar_tower.subsemiring IsScalarTower.subsemiring

-- Porting note: @[nolint instance_priority]
instance of_ring_hom {R A B : Type _} [CommSemiring R] [CommSemiring A] [CommSemiring B]
    [Algebra R A] [Algebra R B] (f : A →ₐ[R] B) :
    @IsScalarTower R A B _ f.toRingHom.toAlgebra.toSMul _ :=
  letI := (f : A →+* B).toAlgebra
  of_algebraMap_eq fun x => (f.commutes x).symm
#align is_scalar_tower.of_ring_hom IsScalarTower.of_ring_hom

end Semiring

end IsScalarTower

section Homs

variable [CommSemiring R] [CommSemiring S] [Semiring A] [Semiring B]

variable [Algebra R S] [Algebra S A] [Algebra S B]

variable [Algebra R A] [Algebra R B]

variable [IsScalarTower R S A] [IsScalarTower R S B]

variable {A S B}

open IsScalarTower

namespace AlgHom

/-- R ⟶ S induces S-Alg ⥤ R-Alg -/
def restrictScalars (f : A →ₐ[S] B) : A →ₐ[R] B :=
  { (f : A →+* B) with
    commutes' := fun r => by
      rw [algebraMap_apply R S A, algebraMap_apply R S B]
      exact f.commutes (algebraMap R S r) }
#align alg_hom.restrict_scalars AlgHom.restrictScalars

theorem restrictScalars_apply (f : A →ₐ[S] B) (x : A) : f.restrictScalars R x = f x := rfl
#align alg_hom.restrict_scalars_apply AlgHom.restrictScalars_apply

@[simp]
theorem coe_restrictScalars (f : A →ₐ[S] B) : (f.restrictScalars R : A →+* B) = f := rfl
#align alg_hom.coe_restrict_scalars AlgHom.coe_restrictScalars

@[simp]
theorem coe_restrict_scalars' (f : A →ₐ[S] B) : (restrictScalars R f : A → B) = f := rfl
#align alg_hom.coe_restrict_scalars' AlgHom.coe_restrict_scalars'

theorem restrictScalars_injective :
    Function.Injective (restrictScalars R : (A →ₐ[S] B) → A →ₐ[R] B) := fun _ _ h =>
  AlgHom.ext (AlgHom.congr_fun h : _)
#align alg_hom.restrict_scalars_injective AlgHom.restrictScalars_injective

end AlgHom

namespace AlgEquiv

/-- R ⟶ S induces S-Alg ⥤ R-Alg -/
def restrictScalars (f : A ≃ₐ[S] B) : A ≃ₐ[R] B :=
  { (f : A ≃+* B) with
    commutes' := fun r => by
      rw [algebraMap_apply R S A, algebraMap_apply R S B]
      exact f.commutes (algebraMap R S r) }
#align alg_equiv.restrict_scalars AlgEquiv.restrictScalars

theorem restrictScalars_apply (f : A ≃ₐ[S] B) (x : A) : f.restrictScalars R x = f x := rfl
#align alg_equiv.restrict_scalars_apply AlgEquiv.restrictScalars_apply

@[simp]
theorem coe_restrictScalars (f : A ≃ₐ[S] B) : (f.restrictScalars R : A ≃+* B) = f := rfl
#align alg_equiv.coe_restrict_scalars AlgEquiv.coe_restrictScalars

@[simp]
theorem coe_restrict_scalars' (f : A ≃ₐ[S] B) : (restrictScalars R f : A → B) = f := rfl
#align alg_equiv.coe_restrict_scalars' AlgEquiv.coe_restrict_scalars'

theorem restrictScalars_injective :
    Function.Injective (restrictScalars R : (A ≃ₐ[S] B) → A ≃ₐ[R] B) := fun _ _ h =>
  AlgEquiv.ext (AlgEquiv.congr_fun h : _)
#align alg_equiv.restrict_scalars_injective AlgEquiv.restrictScalars_injective

end AlgEquiv

end Homs

namespace Submodule

variable {M}

variable [CommSemiring R] [Semiring A] [Algebra R A] [AddCommMonoid M]

variable [Module R M] [Module A M] [IsScalarTower R A M]

/-- If `A` is an `R`-algebra such that the induced morphism `R →+* A` is surjective, then the
`R`-module generated by a set `X` equals the `A`-module generated by `X`. -/
theorem restrictScalars_span (hsur : Function.Surjective (algebraMap R A)) (X : Set M) :
    restrictScalars R (span A X) = span R X := by
  refine' ((span_le_restrictScalars R A X).antisymm fun m hm => _).symm
  refine' span_induction hm subset_span (zero_mem _) (fun _ _ => add_mem) fun a m hm => _
  obtain ⟨r, rfl⟩ := hsur a
  simpa [algebraMap_smul] using smul_mem _ r hm
#align submodule.restrict_scalars_span Submodule.restrictScalars_span

theorem coe_span_eq_span_of_surjective (h : Function.Surjective (algebraMap R A)) (s : Set M) :
    (Submodule.span A s : Set M) = Submodule.span R s :=
  congr_arg ((↑) : Submodule R M → Set M) (Submodule.restrictScalars_span R A h s)
#align submodule.coe_span_eq_span_of_surjective Submodule.coe_span_eq_span_of_surjective

end Submodule

section Semiring

variable {R S A}

namespace Submodule

section Module

variable [Semiring R] [Semiring S] [AddCommMonoid A]

variable [Module R S] [Module S A] [Module R A] [IsScalarTower R S A]

open IsScalarTower

theorem smul_mem_span_smul_of_mem {s : Set S} {t : Set A} {k : S} (hks : k ∈ span R s) {x : A}
    (hx : x ∈ t) : k • x ∈ span R (s • t) :=
  span_induction hks (fun c hc => subset_span <| Set.mem_smul.2 ⟨c, x, hc, hx, rfl⟩)
    (by rw [zero_smul]; exact zero_mem _)
    (fun c₁ c₂ ih₁ ih₂ => by rw [add_smul]; exact add_mem ih₁ ih₂)
    fun b c hc => by rw [IsScalarTower.smul_assoc]; exact smul_mem _ _ hc
#align submodule.smul_mem_span_smul_of_mem Submodule.smul_mem_span_smul_of_mem

variable [SMulCommClass R S A]

theorem smul_mem_span_smul {s : Set S} (hs : span R s = ⊤) {t : Set A} {k : S} {x : A}
    (hx : x ∈ span R t) : k • x ∈ span R (s • t) :=
  span_induction hx (fun x hx => smul_mem_span_smul_of_mem (hs.symm ▸ mem_top) hx)
    (by rw [smul_zero]; exact zero_mem _)
    (fun x y ihx ihy => by rw [smul_add]; exact add_mem ihx ihy)
    fun c x hx => smul_comm c k x ▸ smul_mem _ _ hx
#align submodule.smul_mem_span_smul Submodule.smul_mem_span_smul

theorem smul_mem_span_smul' {s : Set S} (hs : span R s = ⊤) {t : Set A} {k : S} {x : A}
    (hx : x ∈ span R (s • t)) : k • x ∈ span R (s • t) :=
  span_induction hx
    (fun x hx => by
      let ⟨p, q, _hp, hq, hpq⟩ := Set.mem_smul.1 hx
      rw [← hpq, smul_smul]
      exact smul_mem_span_smul_of_mem (hs.symm ▸ mem_top) hq)
    (by rw [smul_zero]; exact zero_mem _)
    (fun x y ihx ihy => by rw [smul_add]; exact add_mem ihx ihy)
    fun c x hx => smul_comm c k x ▸ smul_mem _ _ hx
#align submodule.smul_mem_span_smul' Submodule.smul_mem_span_smul'

theorem span_smul_of_span_eq_top {s : Set S} (hs : span R s = ⊤) (t : Set A) :
    span R (s • t) = (span S t).restrictScalars R :=
  le_antisymm
    (span_le.2 fun _x hx =>
      let ⟨p, _q, _hps, hqt, hpqx⟩ := Set.mem_smul.1 hx
      hpqx ▸ (span S t).smul_mem p (subset_span hqt))
    fun _p hp =>
    span_induction hp (fun x hx => one_smul S x ▸ smul_mem_span_smul hs (subset_span hx))
      (zero_mem _) (fun _ _ => add_mem) fun _k _x hx => smul_mem_span_smul' hs hx
#align submodule.span_smul_of_span_eq_top Submodule.span_smul_of_span_eq_top

end Module

section Algebra

variable [CommSemiring R] [Semiring S] [AddCommMonoid A]

variable [Algebra R S] [Module S A] [Module R A] [IsScalarTower R S A]

/-- A variant of `Submodule.span_image` for `algebraMap`. -/
theorem span_algebraMap_image (a : Set R) :
    Submodule.span R (algebraMap R S '' a) = (Submodule.span R a).map (Algebra.linearMap R S) :=
  (Submodule.span_image <| Algebra.linearMap R S).trans rfl
#align submodule.span_algebra_map_image Submodule.span_algebraMap_image

theorem span_algebraMap_image_of_tower {S T : Type _} [CommSemiring S] [Semiring T] [Module R S]
    [IsScalarTower R S S] [Algebra R T] [Algebra S T] [IsScalarTower R S T] (a : Set S) :
    Submodule.span R (algebraMap S T '' a) =
      (Submodule.span R a).map ((Algebra.linearMap S T).restrictScalars R) :=
  (Submodule.span_image <| (Algebra.linearMap S T).restrictScalars R).trans rfl
#align submodule.span_algebra_map_image_of_tower Submodule.span_algebraMap_image_of_tower

theorem map_mem_span_algebraMap_image {S T : Type _} [CommSemiring S] [Semiring T] [Algebra R S]
    [Algebra R T] [Algebra S T] [IsScalarTower R S T] (x : S) (a : Set S)
    (hx : x ∈ Submodule.span R a) : algebraMap S T x ∈ Submodule.span R (algebraMap S T '' a) := by
  rw [span_algebraMap_image_of_tower, mem_map]
  exact ⟨x, hx, rfl⟩
#align submodule.map_mem_span_algebra_map_image Submodule.map_mem_span_algebraMap_image

end Algebra

end Submodule

end Semiring

section Ring

namespace Algebra

variable [CommSemiring R] [Semiring A] [Algebra R A]

variable [AddCommGroup M] [Module A M] [Module R M] [IsScalarTower R A M]

theorem lsmul_injective [NoZeroSMulDivisors A M] {x : A} (hx : x ≠ 0) :
    Function.Injective (lsmul R M x) :=
  smul_right_injective _ hx
#align algebra.lsmul_injective Algebra.lsmul_injective

end Algebra

end Ring


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

! This file was ported from Lean 3 source module algebra.ring.add_aut
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.GroupAction.Group
import Mathbin.Algebra.Module.Basic

/-!
# Multiplication on the left/right as additive automorphisms

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

In this file we define `add_aut.mul_left` and `add_aut.mul_right`.

See also `add_monoid_hom.mul_left`, `add_monoid_hom.mul_right`, `add_monoid.End.mul_left`, and
`add_monoid.End.mul_right` for multiplication by `R` as an endomorphism instead of multiplication by
`Rˣ` as an automorphism.
-/

namespace AddAut

variable {R : Type _} [Semiring R]

/- warning: add_aut.mul_left -> AddAut.mulLeft is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R], MonoidHom.{u1, u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (AddAut.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (Units.mulOneClass.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (Monoid.toMulOneClass.{u1} (AddAut.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (DivInvMonoid.toMonoid.{u1} (AddAut.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (Group.toDivInvMonoid.{u1} (AddAut.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (AddAut.group.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R], MonoidHom.{u1, u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (AddAut.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (Units.instMulOneClassUnits.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (Monoid.toMulOneClass.{u1} (AddAut.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (DivInvMonoid.toMonoid.{u1} (AddAut.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (Group.toDivInvMonoid.{u1} (AddAut.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (AddAut.group.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))))))
Case conversion may be inaccurate. Consider using '#align add_aut.mul_left AddAut.mulLeftₓ'. -/
/-- Left multiplication by a unit of a semiring as an additive automorphism. -/
@[simps (config := { simpRhs := true })]
def mulLeft : Rˣ →* AddAut R :=
  DistribMulAction.toAddAut _ _
#align add_aut.mul_left AddAut.mulLeft

/- warning: add_aut.mul_right -> AddAut.mulRight is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R], (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) -> (AddAut.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R], (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) -> (AddAut.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))))
Case conversion may be inaccurate. Consider using '#align add_aut.mul_right AddAut.mulRightₓ'. -/
/-- Right multiplication by a unit of a semiring as an additive automorphism. -/
def mulRight (u : Rˣ) : AddAut R :=
  DistribMulAction.toAddAut Rᵐᵒᵖˣ R (Units.opEquiv.symm <| MulOpposite.op u)
#align add_aut.mul_right AddAut.mulRight

/- warning: add_aut.mul_right_apply -> AddAut.mulRight_apply is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (u : Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (x : R), Eq.{succ u1} R (coeFn.{succ u1, succ u1} (AddAut.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (fun (_x : AddEquiv.{u1, u1} R R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) => R -> R) (AddEquiv.hasCoeToFun.{u1, u1} R R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (AddAut.mulRight.{u1} R _inst_1 u) x) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) x ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) R (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) R (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) R (coeBase.{succ u1, succ u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) R (Units.hasCoe.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)))))) u))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (u : Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (x : R), Eq.{succ u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : R) => R) x) (FunLike.coe.{succ u1, succ u1, succ u1} (AddAut.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) R (fun (_x : R) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : R) => R) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (AddAut.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) R R (EquivLike.toEmbeddingLike.{succ u1, succ u1, succ u1} (AddAut.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) R R (AddEquivClass.toEquivLike.{u1, u1, u1} (AddAut.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) R R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (AddEquiv.instAddEquivClassAddEquiv.{u1, u1} R R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))))))) (AddAut.mulRight.{u1} R _inst_1 u) x) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) x (Units.val.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)) u))
Case conversion may be inaccurate. Consider using '#align add_aut.mul_right_apply AddAut.mulRight_applyₓ'. -/
@[simp]
theorem mulRight_apply (u : Rˣ) (x : R) : mulRight u x = x * u :=
  rfl
#align add_aut.mul_right_apply AddAut.mulRight_apply

/- warning: add_aut.mul_right_symm_apply -> AddAut.mulRight_symm_apply is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (u : Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (x : R), Eq.{succ u1} R (coeFn.{succ u1, succ u1} (AddEquiv.{u1, u1} R R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (fun (_x : AddEquiv.{u1, u1} R R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) => R -> R) (AddEquiv.hasCoeToFun.{u1, u1} R R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (AddEquiv.symm.{u1, u1} R R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (AddAut.mulRight.{u1} R _inst_1 u)) x) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) x ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) R (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) R (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) R (coeBase.{succ u1, succ u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) R (Units.hasCoe.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)))))) (Inv.inv.{u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (Units.hasInv.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) u)))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (u : Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (x : R), Eq.{succ u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : R) => R) x) (FunLike.coe.{succ u1, succ u1, succ u1} (AddEquiv.{u1, u1} R R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) R (fun (_x : R) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : R) => R) _x) (EmbeddingLike.toFunLike.{succ u1, succ u1, succ u1} (AddEquiv.{u1, u1} R R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) R R (EquivLike.toEmbeddingLike.{succ u1, succ u1, succ u1} (AddEquiv.{u1, u1} R R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) R R (AddEquivClass.toEquivLike.{u1, u1, u1} (AddEquiv.{u1, u1} R R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) R R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (AddEquiv.instAddEquivClassAddEquiv.{u1, u1} R R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))))))) (AddEquiv.symm.{u1, u1} R R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (AddAut.mulRight.{u1} R _inst_1 u)) x) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) x (Units.val.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)) (Inv.inv.{u1} (Units.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (Units.instInvUnits.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) u)))
Case conversion may be inaccurate. Consider using '#align add_aut.mul_right_symm_apply AddAut.mulRight_symm_applyₓ'. -/
@[simp]
theorem mulRight_symm_apply (u : Rˣ) (x : R) : (mulRight u).symm x = x * ↑u⁻¹ :=
  rfl
#align add_aut.mul_right_symm_apply AddAut.mulRight_symm_apply

end AddAut


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.eq_to_hom
import Mathlib.PostPort

universes u₁ u₂ v₂ v₁

namespace Mathlib

namespace category_theory

/--
A type synonym for promoting any type to a category,
with the only morphisms being equalities.
-/
def discrete (α : Type u₁) := α

/--
The "discrete" category on a type, whose morphisms are equalities.

Because we do not allow morphisms in `Prop` (only in `Type`),
somewhat annoyingly we have to define `X ⟶ Y` as `ulift (plift (X = Y))`.

See https://stacks.math.columbia.edu/tag/001A
-/
protected instance discrete_category (α : Type u₁) : small_category (discrete α) := category.mk

namespace discrete

protected instance inhabited {α : Type u₁} [Inhabited α] : Inhabited (discrete α) := id _inst_1

protected instance subsingleton {α : Type u₁} [subsingleton α] : subsingleton (discrete α) :=
  id _inst_1

/-- Extract the equation from a morphism in a discrete category. -/
theorem eq_of_hom {α : Type u₁} {X : discrete α} {Y : discrete α} (i : X ⟶ Y) : X = Y :=
  plift.down (ulift.down i)

@[simp] theorem id_def {α : Type u₁} (X : discrete α) : ulift.up (plift.up (Eq.refl X)) = 𝟙 := rfl

protected instance category_theory.is_iso {I : Type u₁} {i : discrete I} {j : discrete I}
    (f : i ⟶ j) : is_iso f :=
  is_iso.mk (eq_to_hom sorry)

/--
Any function `I → C` gives a functor `discrete I ⥤ C`.
-/
def functor {C : Type u₂} [category C] {I : Type u₁} (F : I → C) : discrete I ⥤ C :=
  functor.mk F
    fun (X Y : discrete I) (f : X ⟶ Y) =>
      ulift.cases_on f
        fun (f : plift (X = Y)) =>
          plift.cases_on f
            fun (f : X = Y) =>
              eq.dcases_on f
                (fun (H_1 : Y = X) => Eq._oldrec (fun (f : X = X) (H_2 : f == sorry) => 𝟙) sorry f)
                sorry sorry

@[simp] theorem functor_obj {C : Type u₂} [category C] {I : Type u₁} (F : I → C) (i : I) :
    functor.obj (functor F) i = F i :=
  rfl

theorem functor_map {C : Type u₂} [category C] {I : Type u₁} (F : I → C) {i : discrete I}
    (f : i ⟶ i) : functor.map (functor F) f = 𝟙 :=
  sorry

/--
For functors out of a discrete category,
a natural transformation is just a collection of maps,
as the naturality squares are trivial.
-/
def nat_trans {C : Type u₂} [category C] {I : Type u₁} {F : discrete I ⥤ C} {G : discrete I ⥤ C}
    (f : (i : discrete I) → functor.obj F i ⟶ functor.obj G i) : F ⟶ G :=
  nat_trans.mk f

@[simp] theorem nat_trans_app {C : Type u₂} [category C] {I : Type u₁} {F : discrete I ⥤ C}
    {G : discrete I ⥤ C} (f : (i : discrete I) → functor.obj F i ⟶ functor.obj G i)
    (i : discrete I) : nat_trans.app (nat_trans f) i = f i :=
  rfl

/--
For functors out of a discrete category,
a natural isomorphism is just a collection of isomorphisms,
as the naturality squares are trivial.
-/
def nat_iso {C : Type u₂} [category C] {I : Type u₁} {F : discrete I ⥤ C} {G : discrete I ⥤ C}
    (f : (i : discrete I) → functor.obj F i ≅ functor.obj G i) : F ≅ G :=
  nat_iso.of_components f sorry

@[simp] theorem nat_iso_hom_app {C : Type u₂} [category C] {I : Type u₁} {F : discrete I ⥤ C}
    {G : discrete I ⥤ C} (f : (i : discrete I) → functor.obj F i ≅ functor.obj G i) (i : I) :
    nat_trans.app (iso.hom (nat_iso f)) i = iso.hom (f i) :=
  rfl

@[simp] theorem nat_iso_inv_app {C : Type u₂} [category C] {I : Type u₁} {F : discrete I ⥤ C}
    {G : discrete I ⥤ C} (f : (i : discrete I) → functor.obj F i ≅ functor.obj G i) (i : I) :
    nat_trans.app (iso.inv (nat_iso f)) i = iso.inv (f i) :=
  rfl

@[simp] theorem nat_iso_app {C : Type u₂} [category C] {I : Type u₁} {F : discrete I ⥤ C}
    {G : discrete I ⥤ C} (f : (i : discrete I) → functor.obj F i ≅ functor.obj G i) (i : I) :
    iso.app (nat_iso f) i = f i :=
  iso.ext (Eq.refl (iso.hom (iso.app (nat_iso f) i)))

/-- Every functor `F` from a discrete category is naturally isomorphic (actually, equal) to
  `discrete.functor (F.obj)`. -/
def nat_iso_functor {C : Type u₂} [category C] {I : Type u₁} {F : discrete I ⥤ C} :
    F ≅ functor (functor.obj F) :=
  nat_iso fun (i : discrete I) => iso.refl (functor.obj F i)

/--
We can promote a type-level `equiv` to
an equivalence between the corresponding `discrete` categories.
-/
@[simp] theorem equivalence_functor {I : Type u₁} {J : Type u₁} (e : I ≃ J) :
    equivalence.functor (equivalence e) = functor ⇑e :=
  Eq.refl (equivalence.functor (equivalence e))

/-- We can convert an equivalence of `discrete` categories to a type-level `equiv`. -/
@[simp] theorem equiv_of_equivalence_apply {α : Type u₁} {β : Type u₁}
    (h : discrete α ≌ discrete β) :
    ∀ (ᾰ : discrete α), coe_fn (equiv_of_equivalence h) ᾰ = functor.obj (equivalence.functor h) ᾰ :=
  fun (ᾰ : discrete α) => Eq.refl (coe_fn (equiv_of_equivalence h) ᾰ)

end discrete

namespace discrete

/-- A discrete category is equivalent to its opposite category. -/
protected def opposite (α : Type u₁) : discrete αᵒᵖ ≌ discrete α :=
  let F : discrete α ⥤ (discrete αᵒᵖ) := functor fun (x : α) => opposite.op x;
  equivalence.mk (functor.left_op F) F
    (nat_iso.of_components (fun (X : discrete αᵒᵖ) => eq.mpr sorry (iso.refl X)) sorry)
    (nat_iso fun (X : discrete α) => eq.mpr sorry (iso.refl X))

@[simp] theorem functor_map_id {J : Type v₁} {C : Type u₂} [category C] (F : discrete J ⥤ C)
    {j : discrete J} (f : j ⟶ j) : functor.map F f = 𝟙 :=
  sorry

end Mathlib


import Lfea.Proofs.Set

-- An alphabet is a finite set of symbols or letters
-- A word is a finite sequence of letters with only one symbol
-- being valid that is the ε that means empty

-- A word over an alphabet α is a list of α? probably.

-- A formal language over an alpha bet A is a: L ⊆ A*
-- (The reflexive and transitive closure under A)

-- Chomsky grammar is a 4-tuple G = (V, T, P, S)
-- Where
-- - V = Finite set of variable symbols or non terminals
-- - T = Finite set of symbols disjoint of V
-- - P = (V ∪ T)+ -> (V ∪ T)* finite relations of production rules
-- - S = distinguished from V (initial symbol)

-- Derivation rule ⟹
-- The transitive closure of the derivation rule makes it derive
-- one or more symbols at once

-- Generated language is the language that is derived from the language
-- that we can achieve using Derivation rule from the start symbol

-- Finite automatas are operational semantics
-- Regular expressions are denotational semantics
-- Regular grammar are axiomatic semantics

-- Σ alphabet of input symbols
-- Q possible states
-- δ program (transition function)

-- δ: Q × Σ → Q

structure Dfa (sigma: Type) (n: Nat) where
  state   : Fin n -- Initial State
  program : Fin n -> sigma -> Fin n -- Generating program
  final   : Set (Fin n) -- Final states

def Dfa.extendedProgram : Dfa σ n → Fin n → List σ → Fin n
  | dfa, q, []        => q
  | dfa, q, (x :: xs) => extendedProgram dfa (dfa.program q x) xs

-- It is accepted if the final state is part of the DFA final set
--
structure Dfa.Accepts (lang: List σ) (dfa: Dfa σ n) where
  proof : (Dfa.extendedProgram dfa dfa.state lang) ∈ dfa.final

inductive Alpha where
  | a
  | b

def prog : Fin 4 -> Alpha -> Fin 4
  | 0, Alpha.a => 1
  | 1, Alpha.b => 2
  | 1, Alpha.a => 1
  | 2, Alpha.a => 2
  | _, _ => 3

example : Dfa.Accepts [Alpha.a, Alpha.b] { state := 0, program := prog, final := {x | x = 2}} :=
    { proof := by simp [Dfa.extendedProgram, Set.in] }

-- NFA

-- Non deterministic returns a set
structure Nfa (sigma: Type) (n: Nat) where
  state    : Fin n -- Initial State
  program  : Fin n -> sigma -> Set (Fin n)
  final    : Set (Fin n) -- Final states

def Nfa.extendedProgram : Nfa σ n → Set (Fin n) → List σ → Set (Fin n)
  | nfa, qs, []        => qs
  | nfa, qs, (x :: xs) =>
    -- Its a confusing definition
    -- The result of the extended program is the
    -- Big union of all the
    Set.bigUnion { el | ∃q, q ∈ qs ∧ (el = extendedProgram nfa (nfa.program q x) xs) }

structure Nfa.Accepts (lang: List σ) (nfa: Nfa σ n) where
  proof : ∃q, q ∈ (Nfa.extendedProgram nfa {x | x = nfa.state} lang) ∧ q ∈ nfa.final

-- Denotational semantics of Regex

inductive Regex (σ: Type) where
  | var   : σ       -> Regex σ
  | alt   : Regex σ -> Regex σ -> Regex σ
  | conc  : Regex σ -> Regex σ -> Regex σ
  | star  : Regex σ -> Regex σ
  | empty : Regex σ

def sizeOfRegex : Regex σ -> Nat
  | Regex.var _     => 1
  | Regex.alt a b   => sizeOfRegex a + sizeOfRegex b
  | Regex.conc a b  => sizeOfRegex a + sizeOfRegex b
  | Regex.star _    => 1
  | Regex.empty     => 2

inductive Regex.Accepts : List σ → Regex σ → Type where
  | acceptsEmpty : Accepts [] Regex.empty
  | acceptsVar   : Accepts [x] (Regex.var x)
  | acceptsAltL  : Accepts x l → Accepts x (Regex.alt l r)
  | acceptsAltR  : Accepts x r → Accepts x (Regex.alt l r)
  | acceptsConc  : Accepts x a → Accepts y b → Accepts (x ++ y) (Regex.conc a b)
  | acceptsStar  : Accepts [] (Regex.star a)
  | acceptsStar2 : Accepts x a → Accepts y (Regex.star a) → Accepts (x ++ y) (Regex.star a)

theorem Regex.NotMatchesEmpty: ∀ {x : σ} {xs : List σ}, Regex.Accepts (x :: xs) Regex.empty → False
  | x, xs, accepts =>
    accepts.casesOn
      (motive := λacc regex proof => (acc = (x :: xs) -> regex = Regex.empty -> False))
      (λproof _ => List.noConfusion proof) -- acceptsEmpty
      (λproof ot => Regex.noConfusion ot) -- acceptsVar
      (λ_ _ ot => Regex.noConfusion ot) -- acceptsAltL
      (λ_ _ ot => Regex.noConfusion ot) -- acceptsAltR
      (λ_ _ _ ot => Regex.noConfusion ot) -- acceptsConc
      (λ _ ot => Regex.noConfusion ot) -- acceptsStar
      (λ_ _ _ ot => Regex.noConfusion ot) -- acceptsStar2
      rfl
      rfl

example : Regex.Accepts ['a', 'a', 'b'] (Regex.conc (Regex.star (Regex.var 'a')) (Regex.var 'b')) :=
  Regex.Accepts.acceptsConc
    (Regex.Accepts.acceptsStar2
      Regex.Accepts.acceptsVar
      (Regex.Accepts.acceptsStar2
        Regex.Accepts.acceptsVar
        Regex.Accepts.acceptsStar))
    Regex.Accepts.acceptsVar

-- iff redefined lol

structure IIff (a: Type u) (b: Type u) where
  to : a -> b
  mpr: b -> a

notation:40 a "`↔" b:40 => IIff a b

universe u

axiom IIff.toEql : ∀ {a b: Type u} (_: IIff a b), a = b

-- ENFA

def Nfa.Nfa_ε.End: Set (Fin 2) := { x | x = 1 }

def Nfa.Nfa_ε.Final: Fin 2 → Prop := { x | x = 0 }

def Nfa.Nfa_ε : Nfa σ 2 := { state := 0, program := λ _ _ => Nfa.Nfa_ε.End, final := { x | x = 0 }}

def Nfa.Nfa_ε.initial: ∀ {σ: Type}, Set (Fin 2) | x => {y | y = (@Nfa.state x 2 Nfa.Nfa_ε)}

theorem Nfa.Nfa_ε.EverythingLeadToEnd : ∀ {q: (Fin 2)} {x: σ}, (Nfa.Nfa_ε.program q x) = Nfa.Nfa_ε.End := by simp; rfl

theorem Nfa.Nfa_ε.EverythingToFinal : ∀ {xs: List σ}, (Nfa.extendedProgram Nfa.Nfa_ε Nfa.Nfa_ε.End xs) = Nfa.Nfa_ε.End
  | [] => by simp [Nfa.extendedProgram]
  | (x :: xs) => by
    simp [Nfa.extendedProgram, Set.bigUnion, Set.subset, Set.in]
    apply Set.Eq
    . intro x1
      simp [Set.in]
      intro ex
      apply Exists.elim
      . assumption
      . intro state proof
        simp [Set.in]
        apply Exists.elim
        . exact (And.right proof)
        . intro ata
          rw [Nfa.Nfa_ε.EverythingLeadToEnd, EverythingToFinal]
          intro wot
          rw [←wot.right]
          exact proof.left
    . simp [Nfa.extendedProgram, Set.bigUnion, Set.subset, Set.in]
      intro x1 end_x1
      exists End
      apply And.intro
      . assumption
      . exact ⟨1, by
          simp [End]
          rw [Nfa.Nfa_ε.EverythingLeadToEnd, EverythingToFinal]
          rfl⟩

theorem Nfa.Nfa_ε.LeadToFinal: ∀ {σ: Type} {x : σ} {xs: List σ}, (Nfa.extendedProgram Nfa.Nfa_ε (@Nfa.Nfa_ε.initial σ) (x :: xs)) = Nfa.Nfa_ε.End
  | sigm, x, xs => by
    simp [extendedProgram, Nfa.Nfa_ε.EverythingToFinal, Set.bigUnion, Set.in]
    apply Set.Eq
    . simp [Set.in, Set.subset]
      intro x ex
      apply Exists.elim
      . assumption
      . intro a p
        apply Exists.elim
        . exact p.right
        . intro b
          rw [Nfa.Nfa_ε.EverythingLeadToEnd, EverythingToFinal]
          intro f
          rw [←f.right]
          exact p.left
    . simp [Nfa.extendedProgram, Set.bigUnion, Set.subset, Set.in]
      intro x1 end_x1
      exists End
      apply And.intro
      . assumption
      . exact ⟨0, And.intro rfl (by rw [Nfa.Nfa_ε.EverythingLeadToEnd, Nfa.Nfa_ε.EverythingToFinal])⟩

theorem Nfa.Nfa_ε.NotAcceptsEntries: ∀ {σ: Type} {x : σ} {xs: List σ}, Nfa.Accepts (x :: xs) Nfa.Nfa_ε → False
  | sig, x, xs, p => absurd p.proof $ by
    let f : fun y => y = (@Nfa.state sig 2 Nfa.Nfa_ε) = (@Nfa.Nfa_ε.initial sig) := rfl
    simp [Set.in,  Nfa.Nfa_ε.LeadToFinal]
    intro x2
    apply Exists.elim
    . assumption
    . intro a
      rw [f, Nfa.Nfa_ε.LeadToFinal]
      simp [End, Nfa_ε]
      intro and
      let f := Eq.trans (Eq.symm and.left) and.right
      contradiction

def toNFA : ∀ (s: List σ), (r: Regex σ) → ∃ (n : Nat), ∃ (e: Nfa σ n), (Regex.Accepts s r) = (Nfa.Accepts s e)
  | s, Regex.empty =>
    let iffRes : (s: List σ) → (Regex.Accepts s Regex.empty) `↔ (Nfa.Accepts s Nfa.Nfa_ε)
      | [] => {
          to  := by
            intro a
            simp [Nfa.Nfa_ε, Nfa.Accepts]
            exact { proof := by simp [Nfa.extendedProgram]; exact ⟨0, rfl⟩ }
          mpr := λ _ => Regex.Accepts.acceptsEmpty
        }
      | (x :: xs) => {
        to := λ x => False.elim (Regex.NotMatchesEmpty x)
        mpr := λx => False.elim (Nfa.Nfa_ε.NotAcceptsEntries x)
      }
    ⟨2, ⟨Nfa.Nfa_ε, IIff.toEql (iffRes s)⟩⟩
  | s, Regex.var a     => sorry
  | s, Regex.star a    => sorry
  | s, Regex.conc a b  => sorry
  | s, Regex.alt a b   => sorry

-- Pumping lemma
-- Assume q₀ as the initial state and qf the final state, then


/-
Copyright (c) Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.normed_space.finite_dimension
import Mathlib.data.complex.module
import Mathlib.data.complex.is_R_or_C
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Normed space structure on `ℂ`.

This file gathers basic facts on complex numbers of an analytic nature.

## Main results

This file registers `ℂ` as a normed field, expresses basic properties of the norm, and gives
tools on the real vector space structure of `ℂ`. Notably, in the namespace `complex`,
it defines functions:

* `continuous_linear_map.re`
* `continuous_linear_map.im`
* `continuous_linear_map.of_real`

They are bundled versions of the real part, the imaginary part, and the embedding of `ℝ` in `ℂ`,
as continuous `ℝ`-linear maps.

We also register the fact that `ℂ` is an `is_R_or_C` field.
-/

namespace complex

protected instance has_norm : has_norm ℂ :=
  has_norm.mk abs

protected instance normed_group : normed_group ℂ :=
  normed_group.of_core ℂ sorry

protected instance normed_field : normed_field ℂ :=
  normed_field.mk sorry abs_mul

protected instance nondiscrete_normed_field : nondiscrete_normed_field ℂ :=
  nondiscrete_normed_field.mk sorry

protected instance normed_algebra_over_reals : normed_algebra ℝ ℂ :=
  normed_algebra.mk abs_of_real

@[simp] theorem norm_eq_abs (z : ℂ) : norm z = abs z :=
  rfl

theorem dist_eq (z : ℂ) (w : ℂ) : dist z w = abs (z - w) :=
  rfl

@[simp] theorem norm_real (r : ℝ) : norm ↑r = norm r :=
  abs_of_real r

@[simp] theorem norm_rat (r : ℚ) : norm ↑r = abs ↑r := sorry

@[simp] theorem norm_nat (n : ℕ) : norm ↑n = ↑n :=
  abs_of_nat n

@[simp] theorem norm_int {n : ℤ} : norm ↑n = abs ↑n := sorry

theorem norm_int_of_nonneg {n : ℤ} (hn : 0 ≤ n) : norm ↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (norm ↑n = ↑n)) norm_int))
    (eq.mpr (id (Eq._oldrec (Eq.refl (abs ↑n = ↑n)) (abs_of_nonneg (iff.mpr int.cast_nonneg hn)))) (Eq.refl ↑n))

/-- A complex normed vector space is also a real normed vector space. -/
protected instance normed_space.restrict_scalars_real (E : Type u_1) [normed_group E] [normed_space ℂ E] : normed_space ℝ E :=
  normed_space.restrict_scalars ℝ ℂ E

/-- The space of continuous linear maps over `ℝ`, from a real vector space to a complex vector
space, is a normed vector space over `ℂ`. -/
protected instance continuous_linear_map.real_smul_complex (E : Type u_1) [normed_group E] [normed_space ℝ E] (F : Type u_2) [normed_group F] [normed_space ℂ F] : normed_space ℂ (continuous_linear_map ℝ E F) :=
  continuous_linear_map.normed_space_extend_scalars

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def continuous_linear_map.re : continuous_linear_map ℝ ℂ ℝ :=
  linear_map.to_continuous_linear_map linear_map.re

@[simp] theorem continuous_linear_map.re_coe : ↑continuous_linear_map.re = linear_map.re :=
  rfl

@[simp] theorem continuous_linear_map.re_apply (z : ℂ) : coe_fn continuous_linear_map.re z = re z :=
  rfl

@[simp] theorem continuous_linear_map.re_norm : norm continuous_linear_map.re = 1 := sorry

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def continuous_linear_map.im : continuous_linear_map ℝ ℂ ℝ :=
  linear_map.to_continuous_linear_map linear_map.im

@[simp] theorem continuous_linear_map.im_coe : ↑continuous_linear_map.im = linear_map.im :=
  rfl

@[simp] theorem continuous_linear_map.im_apply (z : ℂ) : coe_fn continuous_linear_map.im z = im z :=
  rfl

@[simp] theorem continuous_linear_map.im_norm : norm continuous_linear_map.im = 1 := sorry

/-- Linear isometry version of the canonical embedding of `ℝ` in `ℂ`. -/
def linear_isometry.of_real : linear_isometry ℝ ℝ ℂ :=
  linear_isometry.mk linear_map.of_real sorry

/-- Continuous linear map version of the canonical embedding of `ℝ` in `ℂ`. -/
def continuous_linear_map.of_real : continuous_linear_map ℝ ℝ ℂ :=
  linear_isometry.to_continuous_linear_map linear_isometry.of_real

theorem isometry_of_real : isometry coe :=
  linear_isometry.isometry linear_isometry.of_real

theorem continuous_of_real : continuous coe :=
  isometry.continuous isometry_of_real

@[simp] theorem continuous_linear_map.of_real_coe : ↑continuous_linear_map.of_real = linear_map.of_real :=
  rfl

@[simp] theorem continuous_linear_map.of_real_apply (x : ℝ) : coe_fn continuous_linear_map.of_real x = ↑x :=
  rfl

@[simp] theorem continuous_linear_map.of_real_norm : norm continuous_linear_map.of_real = 1 :=
  linear_isometry.norm_to_continuous_linear_map linear_isometry.of_real

protected instance is_R_or_C : is_R_or_C ℂ :=
  is_R_or_C.mk (add_monoid_hom.mk re zero_re add_re) (add_monoid_hom.mk im zero_im add_im) conj I sorry sorry sorry sorry
    sorry sorry sorry sorry sorry sorry sorry sorry sorry div_I

end complex

namespace is_R_or_C

@[simp] theorem re_to_complex {x : ℂ} : coe_fn re x = complex.re x :=
  rfl

@[simp] theorem im_to_complex {x : ℂ} : coe_fn im x = complex.im x :=
  rfl

@[simp] theorem conj_to_complex {x : ℂ} : coe_fn conj x = coe_fn complex.conj x :=
  rfl

@[simp] theorem I_to_complex : I = complex.I :=
  rfl

@[simp] theorem norm_sq_to_complex {x : ℂ} : coe_fn norm_sq x = coe_fn complex.norm_sq x := sorry

@[simp] theorem abs_to_complex {x : ℂ} : abs x = complex.abs x := sorry


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import ring_theory.valuation.basic

/-!
# Ring of integers under a given valuation

The elements with valuation less than or equal to 1.

TODO: Define characteristic predicate.
-/

universes u v w

namespace valuation

section ring

variables {R : Type u} {Γ₀ : Type v} [ring R] [linear_ordered_comm_group_with_zero Γ₀]
variables (v : valuation R Γ₀)

/-- The ring of integers under a given valuation is the subring of elements with valuation ≤ 1. -/
def integer : subring R :=
{ carrier := { x | v x ≤ 1 },
  one_mem' := le_of_eq v.map_one,
  mul_mem' := λ x y hx hy, trans_rel_right (≤) (v.map_mul x y) (mul_le_one' hx hy),
  zero_mem' := trans_rel_right (≤) v.map_zero zero_le_one,
  add_mem' := λ x y hx hy, le_trans (v.map_add x y) (max_le hx hy),
  neg_mem' := λ x hx, trans_rel_right (≤) (v.map_neg x) hx }

end ring

section comm_ring

variables {R : Type u} {Γ₀ : Type v} [comm_ring R] [linear_ordered_comm_group_with_zero Γ₀]
variables (v : valuation R Γ₀)
variables (O : Type w) [comm_ring O] [algebra O R]

/-- Given a valuation v : R → Γ₀ and a ring homomorphism O →+* R, we say that O is the integers of v
if f is injective, and its range is exactly `v.integer`. -/
structure integers : Prop :=
(hom_inj : function.injective (algebra_map O R))
(map_le_one : ∀ x, v (algebra_map O R x) ≤ 1)
(exists_of_le_one : ∀ ⦃r⦄, v r ≤ 1 → ∃ x, algebra_map O R x = r)

-- typeclass shortcut
instance : algebra v.integer R :=
algebra.of_subring v.integer

theorem integer.integers : v.integers v.integer :=
{ hom_inj := subtype.coe_injective,
  map_le_one := λ r, r.2,
  exists_of_le_one := λ r hr, ⟨⟨r, hr⟩, rfl⟩ }

namespace integers

variables {v O} (hv : integers v O)
include hv

lemma one_of_is_unit {x : O} (hx : is_unit x) : v (algebra_map O R x) = 1 :=
let ⟨u, hu⟩ := hx in le_antisymm (hv.2 _) $
by { rw [← v.map_one, ← (algebra_map O R).map_one, ← u.mul_inv, ← mul_one (v (algebra_map O R x)),
  hu, (algebra_map O R).map_mul, v.map_mul], exact mul_le_mul_left' (hv.2 (u⁻¹ : units O)) _ }

lemma is_unit_of_one {x : O} (hx : is_unit (algebra_map O R x)) (hvx : v (algebra_map O R x) = 1) :
  is_unit x :=
let ⟨u, hu⟩ := hx in
have h1 : v u ≤ 1, from hu.symm ▸ hv.2 x,
have h2 : v (u⁻¹ : Rˣ) ≤ 1,
  by rw [← one_mul (v _), ← hvx, ← v.map_mul, ← hu, u.mul_inv, hu, hvx, v.map_one],
let ⟨r1, hr1⟩ := hv.3 h1, ⟨r2, hr2⟩ := hv.3 h2 in
⟨⟨r1, r2, hv.1 $ by rw [ring_hom.map_mul, ring_hom.map_one, hr1, hr2, units.mul_inv],
  hv.1 $ by rw [ring_hom.map_mul, ring_hom.map_one, hr1, hr2, units.inv_mul]⟩,
hv.1 $ hr1.trans hu⟩

lemma le_of_dvd {x y : O} (h : x ∣ y) : v (algebra_map O R y) ≤ v (algebra_map O R x) :=
let ⟨z, hz⟩ := h in by { rw [← mul_one (v (algebra_map O R x)), hz, ring_hom.map_mul, v.map_mul],
  exact mul_le_mul_left' (hv.2 z) _ }

end integers

end comm_ring

section field

variables {F : Type u} {Γ₀ : Type v} [field F] [linear_ordered_comm_group_with_zero Γ₀]
variables {v : valuation F Γ₀} {O : Type w} [comm_ring O] [algebra O F] (hv : integers v O)
include hv

namespace integers

lemma dvd_of_le {x y : O} (h : v (algebra_map O F x) ≤ v (algebra_map O F y)) : y ∣ x :=
classical.by_cases (λ hy : algebra_map O F y = 0, have hx : x = 0,
    from hv.1 $ (algebra_map O F).map_zero.symm ▸
      (v.zero_iff.1 $ le_zero_iff.1 (v.map_zero ▸ hy ▸ h)),
  hx.symm ▸ dvd_zero y) $
λ hy : algebra_map O F y ≠ 0,
have v ((algebra_map O F y)⁻¹ * algebra_map O F x) ≤ 1,
  by { rw [← v.map_one, ← inv_mul_cancel hy, v.map_mul, v.map_mul], exact mul_le_mul_left' h _ },
let ⟨z, hz⟩ := hv.3 this in
⟨z, hv.1 $ ((algebra_map O F).map_mul y z).symm ▸ hz.symm ▸ (mul_inv_cancel_left₀ hy _).symm⟩

lemma dvd_iff_le {x y : O} : x ∣ y ↔ v (algebra_map O F y) ≤ v (algebra_map O F x) :=
⟨hv.le_of_dvd, hv.dvd_of_le⟩

lemma le_iff_dvd {x y : O} : v (algebra_map O F x) ≤ v (algebra_map O F y) ↔ y ∣ x :=
⟨hv.dvd_of_le, hv.le_of_dvd⟩

end integers

end field

end valuation


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .cons .map

instance tup_setoid {α : Type*} [s : setoid α] {n : ℕ} : setoid (α ^ n) :=
let tr := λ (xs ys : α ^ n), ∀ (i : fin n), @setoid.r α s xs[i] ys[i] in
have trefl : ∀ (xs : α ^ n), tr xs xs,
from (λ xs i, setoid.refl xs[i]),
have tsymm : ∀ {{xs ys : α ^ n}}, tr xs ys → tr ys xs,
from (λ xs ys h i, setoid.symm (h i)),
have ttrans : ∀ {{xs ys zs : α ^ n}}, tr xs ys → tr ys zs → tr xs zs,
from (λ xs ys ys hxy hyz i, setoid.trans (hxy i) (hyz i)),
⟨tr, trefl, tsymm, ttrans⟩

lemma tup.setoid_cons {α : Type*} [s : setoid α] {n : ℕ} {x y : α} {xs ys : α ^ n} :
x ≈ y → xs ≈ ys → x :: xs ≈ y :: ys :=
assume h hs, (λ i, match i with
| ⟨0, _⟩ := h
| ⟨i+1, _⟩ := hs ⟨i, _⟩
end)

namespace quotient
variables {α : Type*} [s : setoid α] {β : Sort*}
include s
open tup

definition tup_lift : Π {n : ℕ} (f : α ^ n → β),
(∀ xs ys : α ^ n, xs ≈ ys → f xs = f ys) → quotient s ^ n → β
| 0 f _ _ := f nil
| (n+1) f c qs :=
  let f' := (λ x xs, f (x :: xs)) in
  have c' : ∀ x y : α, x ≈ y → f' x = f' y,
  from λ x y hxy, funext (λ zs, c (x :: zs) (y :: zs) (setoid_cons hxy (setoid.refl zs))),
  have ∀ (x y : α) (xs ys : α ^ n), x ≈ y → xs ≈ ys → quotient.lift f' c' (quotient.mk x) xs = quotient.lift f' c' (quotient.mk y) ys,
  from λ x y xs ys hxy hxys, c (x :: xs) (y :: ys) (setoid_cons hxy hxys),
  have ∀ (xs ys : α ^ n), xs ≈ ys → quotient.lift f' c' (head qs) xs = quotient.lift f' c' (head qs) ys,
  from quotient.induction_on (head qs) (λ z xs ys hxy, c (z :: xs) (z :: ys) (setoid_cons (setoid.refl z) hxy)),
  tup_lift (quotient.lift f' c' (head qs)) this (tail qs)

theorem lift_beta (f : α → β) (c : ∀ (x y : α), x ≈ y → f x = f y) (x : α) :
quotient.lift f c (quotient.mk x) = f x := rfl

theorem tup_lift_beta :
Π {n : ℕ} (f : α ^ n → β) (c : ∀ xs ys : α^n, xs ≈ ys → f xs = f ys) (zs : α ^ n),
tup_lift f c (map quotient.mk zs) = f zs
| 0 f c zs := by rw eq_nil zs; reflexivity
| (n+1) f c zs :=
  let f' := (λ x xs, f (x :: xs)) in
  have c' : ∀ x y : α, x ≈ y → f' x = f' y,
  from λ x y hxy, funext (λ zs, c (x :: zs) (y :: zs) (setoid_cons hxy (setoid.refl zs))),
  let qs := map quotient.mk zs in calc
  tup_lift f c qs
      = tup_lift (quotient.lift f' c' (head qs)) _ (tail qs) : rfl
  ... = tup_lift (quotient.lift f' c' (head qs)) _ (map quotient.mk (tail zs)) : by rw map_tail
  ... = quotient.lift f' c' (head qs) (tail zs) : tup_lift_beta _ _ _
  ... = quotient.lift f' c' (quotient.mk (head zs)) (tail zs) : by rw map_head
  ... = f' (head zs) (tail zs) : rfl
  ... = f (head zs :: tail zs) : rfl
  ... = f zs : by rw cons_head_tail zs

end quotient


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau
-/
import data.finsupp.to_dfinsupp
import linear_algebra.basis

/-!
# Properties of the module `Π₀ i, M i`

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

Given an indexed collection of `R`-modules `M i`, the `R`-module structure on `Π₀ i, M i`
is defined in `data.dfinsupp`.

In this file we define `linear_map` versions of various maps:

* `dfinsupp.lsingle a : M →ₗ[R] Π₀ i, M i`: `dfinsupp.single a` as a linear map;

* `dfinsupp.lmk s : (Π i : (↑s : set ι), M i) →ₗ[R] Π₀ i, M i`: `dfinsupp.single a` as a linear map;

* `dfinsupp.lapply i : (Π₀ i, M i) →ₗ[R] M`: the map `λ f, f i` as a linear map;

* `dfinsupp.lsum`: `dfinsupp.sum` or `dfinsupp.lift_add_hom` as a `linear_map`;

## Implementation notes

This file should try to mirror `linear_algebra.finsupp` where possible. The API of `finsupp` is
much more developed, but many lemmas in that file should be eligible to copy over.

## Tags

function with finite support, module, linear algebra
-/

variables {ι : Type*} {R : Type*} {S : Type*} {M : ι → Type*} {N : Type*}

variables [dec_ι : decidable_eq ι]

namespace dfinsupp
variables [semiring R] [Π i, add_comm_monoid (M i)] [Π i, module R (M i)]
variables [add_comm_monoid N] [module R N]

include dec_ι

/-- `dfinsupp.mk` as a `linear_map`. -/
def lmk (s : finset ι) : (Π i : (↑s : set ι), M i) →ₗ[R] Π₀ i, M i :=
{ to_fun := mk s, map_add' := λ _ _, mk_add, map_smul' := λ c x, mk_smul c x}

/-- `dfinsupp.single` as a `linear_map` -/
def lsingle (i) : M i →ₗ[R] Π₀ i, M i :=
{ to_fun := single i, map_smul' := single_smul, .. dfinsupp.single_add_hom _ _ }

/-- Two `R`-linear maps from `Π₀ i, M i` which agree on each `single i x` agree everywhere. -/
lemma lhom_ext ⦃φ ψ : (Π₀ i, M i) →ₗ[R] N⦄
  (h : ∀ i x, φ (single i x) = ψ (single i x)) :
  φ = ψ :=
linear_map.to_add_monoid_hom_injective $ add_hom_ext h

/-- Two `R`-linear maps from `Π₀ i, M i` which agree on each `single i x` agree everywhere.

See note [partially-applied ext lemmas].
After apply this lemma, if `M = R` then it suffices to verify `φ (single a 1) = ψ (single a 1)`. -/
@[ext] lemma lhom_ext' ⦃φ ψ : (Π₀ i, M i) →ₗ[R] N⦄
  (h : ∀ i, φ.comp (lsingle i) = ψ.comp (lsingle i)) :
  φ = ψ :=
lhom_ext $ λ i, linear_map.congr_fun (h i)

omit dec_ι

/-- Interpret `λ (f : Π₀ i, M i), f i` as a linear map. -/
def lapply (i : ι) : (Π₀ i, M i) →ₗ[R] M i :=
{ to_fun := λ f, f i,
  map_add' := λ f g, add_apply f g i,
  map_smul' := λ c f, smul_apply c f i}

include dec_ι

@[simp] lemma lmk_apply (s : finset ι) (x) : (lmk s : _ →ₗ[R] Π₀ i, M i) x = mk s x := rfl

@[simp] lemma lsingle_apply (i : ι) (x : M i) : (lsingle i : _ →ₗ[R] _) x = single i x := rfl

omit dec_ι

@[simp] lemma lapply_apply (i : ι) (f : Π₀ i, M i) : (lapply i : _ →ₗ[R] _) f = f i := rfl

section lsum

/-- Typeclass inference can't find `dfinsupp.add_comm_monoid` without help for this case.
This instance allows it to be found where it is needed on the LHS of the colon in
`dfinsupp.module_of_linear_map`. -/
instance add_comm_monoid_of_linear_map : add_comm_monoid (Π₀ (i : ι), M i →ₗ[R] N) :=
@dfinsupp.add_comm_monoid _ (λ i, M i →ₗ[R] N) _

/-- Typeclass inference can't find `dfinsupp.module` without help for this case.
This is needed to define `dfinsupp.lsum` below.

The cause seems to be an inability to unify the `Π i, add_comm_monoid (M i →ₗ[R] N)` instance that
we have with the `Π i, has_zero (M i →ₗ[R] N)` instance which appears as a parameter to the
`dfinsupp` type. -/
instance module_of_linear_map [semiring S] [module S N] [smul_comm_class R S N] :
  module S (Π₀ (i : ι), M i →ₗ[R] N) :=
@dfinsupp.module _ _ (λ i, M i →ₗ[R] N) _ _ _

variables (S)

include dec_ι

/-- The `dfinsupp` version of `finsupp.lsum`.

See note [bundled maps over different rings] for why separate `R` and `S` semirings are used. -/
@[simps]
def lsum [semiring S] [module S N] [smul_comm_class R S N] :
  (Π i, M i →ₗ[R] N) ≃ₗ[S] ((Π₀ i, M i) →ₗ[R] N) :=
{ to_fun := λ F,
  { to_fun := sum_add_hom (λ i, (F i).to_add_monoid_hom),
    map_add' := (lift_add_hom (λ i, (F i).to_add_monoid_hom)).map_add,
    map_smul' := λ c f, by
    { dsimp,
      apply dfinsupp.induction f,
      { rw [smul_zero, add_monoid_hom.map_zero, smul_zero] },
      { intros a b f ha hb hf,
        rw [smul_add, add_monoid_hom.map_add, add_monoid_hom.map_add, smul_add, hf, ←single_smul,
          sum_add_hom_single, sum_add_hom_single, linear_map.to_add_monoid_hom_coe,
          linear_map.map_smul], } } },
  inv_fun := λ F i, F.comp (lsingle i),
  left_inv := λ F, by { ext x y, simp },
  right_inv := λ F, by { ext x y, simp },
  map_add' := λ F G, by { ext x y, simp },
  map_smul' := λ c F, by { ext, simp } }

/-- While `simp` can prove this, it is often convenient to avoid unfolding `lsum` into `sum_add_hom`
with `dfinsupp.lsum_apply_apply`. -/
lemma lsum_single [semiring S] [module S N] [smul_comm_class R S N]
  (F : Π i, M i →ₗ[R] N) (i) (x : M i) :
  lsum S F (single i x) = F i x :=
sum_add_hom_single _ _ _

end lsum

/-! ### Bundled versions of `dfinsupp.map_range`

The names should match the equivalent bundled `finsupp.map_range` definitions.
-/

section map_range

variables {β β₁ β₂: ι → Type*}
variables [Π i, add_comm_monoid (β i)] [Π i, add_comm_monoid (β₁ i)] [Π i, add_comm_monoid (β₂ i)]
variables [Π i, module R (β i)] [Π i, module R (β₁ i)] [Π i, module R (β₂ i)]

lemma map_range_smul (f : Π i, β₁ i → β₂ i) (hf : ∀ i, f i 0 = 0)
  (r : R) (hf' : ∀ i x, f i (r • x) = r • f i x) (g : Π₀ i, β₁ i):
  map_range f hf (r • g) = r • map_range f hf g :=
begin
  ext,
  simp only [map_range_apply f, coe_smul, pi.smul_apply, hf']
end

/-- `dfinsupp.map_range` as an `linear_map`. -/
@[simps apply]
def map_range.linear_map (f : Π i, β₁ i →ₗ[R] β₂ i) : (Π₀ i, β₁ i) →ₗ[R] (Π₀ i, β₂ i) :=
{ to_fun := map_range (λ i x, f i x) (λ i, (f i).map_zero),
  map_smul' := λ r, map_range_smul _ _ _ (λ i, (f i).map_smul r),
  .. map_range.add_monoid_hom (λ i, (f i).to_add_monoid_hom) }

@[simp]
lemma map_range.linear_map_id :
  map_range.linear_map (λ i, (linear_map.id : (β₂ i) →ₗ[R] _)) = linear_map.id :=
linear_map.ext map_range_id

lemma map_range.linear_map_comp (f : Π i, β₁ i →ₗ[R] β₂ i) (f₂ : Π i, β i →ₗ[R] β₁ i):
  map_range.linear_map (λ i, (f i).comp (f₂ i)) =
    (map_range.linear_map f).comp (map_range.linear_map f₂) :=
linear_map.ext $ map_range_comp (λ i x, f i x) (λ i x, f₂ i x) _ _ _

include dec_ι
lemma sum_map_range_index.linear_map
  [Π (i : ι) (x : β₁ i), decidable (x ≠ 0)] [Π (i : ι) (x : β₂ i), decidable (x ≠ 0)]
  {f : Π i, β₁ i →ₗ[R] β₂ i} {h : Π i, β₂ i →ₗ[R] N} {l : Π₀ i, β₁ i} :
  dfinsupp.lsum ℕ h (map_range.linear_map f l) = dfinsupp.lsum ℕ (λ i, (h i).comp (f i)) l :=
by simpa [dfinsupp.sum_add_hom_apply] using
  @sum_map_range_index ι N _ _ _ _ _ _ _ _ (λ i, f i) (λ i, by simp) l (λ i, h i) (λ i, by simp)
omit dec_ι

/-- `dfinsupp.map_range.linear_map` as an `linear_equiv`. -/
@[simps apply]
def map_range.linear_equiv (e : Π i, β₁ i ≃ₗ[R] β₂ i) : (Π₀ i, β₁ i) ≃ₗ[R] (Π₀ i, β₂ i) :=
{ to_fun := map_range (λ i x, e i x) (λ i, (e i).map_zero),
  inv_fun := map_range (λ i x, (e i).symm x) (λ i, (e i).symm.map_zero),
  .. map_range.add_equiv (λ i, (e i).to_add_equiv),
  .. map_range.linear_map (λ i, (e i).to_linear_map) }

@[simp]
lemma map_range.linear_equiv_refl :
  (map_range.linear_equiv $ λ i, linear_equiv.refl R (β₁ i)) = linear_equiv.refl _ _ :=
linear_equiv.ext map_range_id

lemma map_range.linear_equiv_trans (f : Π i, β i ≃ₗ[R] β₁ i) (f₂ : Π i, β₁ i ≃ₗ[R] β₂ i):
  map_range.linear_equiv (λ i, (f i).trans (f₂ i)) =
    (map_range.linear_equiv f).trans (map_range.linear_equiv f₂) :=
linear_equiv.ext $ map_range_comp (λ i x, f₂ i x) (λ i x, f i x) _ _ _

@[simp]
lemma map_range.linear_equiv_symm (e : Π i, β₁ i ≃ₗ[R] β₂ i) :
  (map_range.linear_equiv e).symm = map_range.linear_equiv (λ i, (e i).symm) := rfl

end map_range

section coprod_map

variables [decidable_eq ι] [Π (x : N), decidable (x ≠ 0)]

/-- Given a family of linear maps `f i : M i  →ₗ[R] N`, we can form a linear map
`(Π₀ i, M i) →ₗ[R] N` which sends `x : Π₀ i, M i` to the sum over `i` of `f i` applied to `x i`.
This is the map coming from the universal property of `Π₀ i, M i` as the coproduct of the `M i`.
See also `linear_map.coprod` for the binary product version. -/
noncomputable def coprod_map (f : Π (i : ι), M i  →ₗ[R] N) : (Π₀ i, M i) →ₗ[R] N :=
finsupp.lsum ℕ (λ i : ι, linear_map.id) ∘ₗ
(@finsupp_lequiv_dfinsupp ι R N _ _ _ _ _).symm.to_linear_map ∘ₗ
(dfinsupp.map_range.linear_map f)

lemma coprod_map_apply (f : Π (i : ι), M i  →ₗ[R] N) (x : Π₀ i, M i) :
  coprod_map f x =
  finsupp.sum (map_range (λ i, f i) (λ i, linear_map.map_zero _) x).to_finsupp (λ i, id) := rfl

end coprod_map

section basis

/-- The direct sum of free modules is free.

Note that while this is stated for `dfinsupp` not `direct_sum`, the types are defeq. -/
noncomputable def basis {η : ι → Type*} (b : Π i, basis (η i) R (M i)) :
  basis (Σ i, η i) R (Π₀ i, M i) :=
basis.of_repr ((map_range.linear_equiv (λ i, (b i).repr)).trans
  (sigma_finsupp_lequiv_dfinsupp R).symm)

end basis

end dfinsupp

include dec_ι

namespace submodule
variables [semiring R] [add_comm_monoid N] [module R N]
open dfinsupp

lemma dfinsupp_sum_mem {β : ι → Type*} [Π i, has_zero (β i)]
  [Π i (x : β i), decidable (x ≠ 0)] (S : submodule R N)
  (f : Π₀ i, β i) (g : Π i, β i → N) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ S) : f.sum g ∈ S :=
dfinsupp_sum_mem S f g h

lemma dfinsupp_sum_add_hom_mem {β : ι → Type*} [Π i, add_zero_class (β i)]
  (S : submodule R N) (f : Π₀ i, β i) (g : Π i, β i →+ N) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ S) :
  dfinsupp.sum_add_hom g f ∈ S :=
dfinsupp_sum_add_hom_mem S f g h

/-- The supremum of a family of submodules is equal to the range of `dfinsupp.lsum`; that is
every element in the `supr` can be produced from taking a finite number of non-zero elements
of `p i`, coercing them to `N`, and summing them. -/
lemma supr_eq_range_dfinsupp_lsum (p : ι → submodule R N) :
  supr p = (dfinsupp.lsum ℕ (λ i, (p i).subtype)).range :=
begin
  apply le_antisymm,
  { apply supr_le _,
    intros i y hy,
    exact ⟨dfinsupp.single i ⟨y, hy⟩, dfinsupp.sum_add_hom_single _ _ _⟩, },
  { rintros x ⟨v, rfl⟩,
    exact dfinsupp_sum_add_hom_mem _ v _ (λ i _, (le_supr p i : p i ≤ _) (v i).prop) }
end

/-- The bounded supremum of a family of commutative additive submonoids is equal to the range of
`dfinsupp.sum_add_hom` composed with `dfinsupp.filter_add_monoid_hom`; that is, every element in the
bounded `supr` can be produced from taking a finite number of non-zero elements from the `S i` that
satisfy `p i`, coercing them to `γ`, and summing them. -/
lemma bsupr_eq_range_dfinsupp_lsum (p : ι → Prop)
  [decidable_pred p] (S : ι → submodule R N) :
  (⨆ i (h : p i), S i) =
    ((dfinsupp.lsum ℕ (λ i, (S i).subtype)).comp (dfinsupp.filter_linear_map R _ p)).range :=
begin
  apply le_antisymm,
  { refine supr₂_le (λ i hi y hy, ⟨dfinsupp.single i ⟨y, hy⟩, _⟩),
    rw [linear_map.comp_apply, filter_linear_map_apply, filter_single_pos _ _ hi],
    exact dfinsupp.sum_add_hom_single _ _ _, },
  { rintros x ⟨v, rfl⟩,
    refine dfinsupp_sum_add_hom_mem _ _ _ (λ i hi, _),
    refine mem_supr_of_mem i _,
    by_cases hp : p i,
    { simp [hp], },
    { simp [hp] }, }
end

lemma mem_supr_iff_exists_dfinsupp (p : ι → submodule R N) (x : N) :
  x ∈ supr p ↔ ∃ f : Π₀ i, p i, dfinsupp.lsum ℕ (λ i, (p i).subtype) f = x :=
set_like.ext_iff.mp (supr_eq_range_dfinsupp_lsum p) x

/-- A variant of `submodule.mem_supr_iff_exists_dfinsupp` with the RHS fully unfolded. -/
lemma mem_supr_iff_exists_dfinsupp' (p : ι → submodule R N) [Π i (x : p i), decidable (x ≠ 0)]
  (x : N) :
  x ∈ supr p ↔ ∃ f : Π₀ i, p i, f.sum (λ i xi, ↑xi) = x :=
begin
  rw mem_supr_iff_exists_dfinsupp,
  simp_rw [dfinsupp.lsum_apply_apply, dfinsupp.sum_add_hom_apply],
  congr',
end

lemma mem_bsupr_iff_exists_dfinsupp (p : ι → Prop) [decidable_pred p] (S : ι → submodule R N)
  (x : N) :
  x ∈ (⨆ i (h : p i), S i) ↔
    ∃ f : Π₀ i, S i, dfinsupp.lsum ℕ (λ i, (S i).subtype) (f.filter p) = x :=
set_like.ext_iff.mp (bsupr_eq_range_dfinsupp_lsum p S) x

open_locale big_operators
omit dec_ι
lemma mem_supr_finset_iff_exists_sum {s : finset ι} (p : ι → submodule R N) (a : N) :
  a ∈ (⨆ i ∈ s, p i) ↔ ∃ μ : Π i, p i, ∑ i in s, (μ i : N) = a :=
begin
  classical,
  rw submodule.mem_supr_iff_exists_dfinsupp',
  split; rintro ⟨μ, hμ⟩,
  { use λ i, ⟨μ i, (supr_const_le : _ ≤ p i) (coe_mem $ μ i)⟩,
    rw ← hμ, symmetry, apply finset.sum_subset,
    { intro x, contrapose, intro hx,
      rw [mem_support_iff, not_ne_iff],
      ext, rw [coe_zero, ← mem_bot R], convert coe_mem (μ x),
      symmetry, exact supr_neg hx },
    { intros x _ hx, rw [mem_support_iff, not_ne_iff] at hx, rw hx, refl } },
  { refine ⟨dfinsupp.mk s _, _⟩,
    { rintro ⟨i, hi⟩, refine ⟨μ i, _⟩,
      rw supr_pos, { exact coe_mem _ }, { exact hi } },
    simp only [dfinsupp.sum],
    rw [finset.sum_subset support_mk_subset, ← hμ],
    exact finset.sum_congr rfl (λ x hx, congr_arg coe $ mk_of_mem hx),
    { intros x _ hx, rw [mem_support_iff, not_ne_iff] at hx, rw hx, refl } }
end

end submodule

namespace complete_lattice

open dfinsupp

section semiring
variables [semiring R] [add_comm_monoid N] [module R N]

/-- Independence of a family of submodules can be expressed as a quantifier over `dfinsupp`s.

This is an intermediate result used to prove
`complete_lattice.independent_of_dfinsupp_lsum_injective` and
`complete_lattice.independent.dfinsupp_lsum_injective`. -/
lemma independent_iff_forall_dfinsupp (p : ι → submodule R N) :
  independent p ↔
    ∀ i (x : p i) (v : Π₀ (i : ι), ↥(p i)), lsum ℕ (λ i, (p i).subtype) (erase i v) = x → x = 0 :=
begin
  simp_rw [complete_lattice.independent_def, submodule.disjoint_def,
    submodule.mem_bsupr_iff_exists_dfinsupp, exists_imp_distrib, filter_ne_eq_erase],
  apply forall_congr (λ i, _),
  refine subtype.forall'.trans _,
  simp_rw submodule.coe_eq_zero,
  refl,
end

/- If `dfinsupp.lsum` applied with `submodule.subtype` is injective then the submodules are
independent. -/
lemma independent_of_dfinsupp_lsum_injective (p : ι → submodule R N)
  (h : function.injective (lsum ℕ (λ i, (p i).subtype))) :
  independent p :=
begin
  rw independent_iff_forall_dfinsupp,
  intros i x v hv,
  replace hv : lsum ℕ (λ i, (p i).subtype) (erase i v) = lsum ℕ (λ i, (p i).subtype) (single i x),
  { simpa only [lsum_single] using hv, },
  have := dfinsupp.ext_iff.mp (h hv) i,
  simpa [eq_comm] using this,
end

/- If `dfinsupp.sum_add_hom` applied with `add_submonoid.subtype` is injective then the additive
submonoids are independent. -/
lemma independent_of_dfinsupp_sum_add_hom_injective (p : ι → add_submonoid N)
  (h : function.injective (sum_add_hom (λ i, (p i).subtype))) :
  independent p :=
begin
  rw ←independent_map_order_iso_iff (add_submonoid.to_nat_submodule : add_submonoid N ≃o _),
  exact independent_of_dfinsupp_lsum_injective _ h,
end

/-- Combining `dfinsupp.lsum` with `linear_map.to_span_singleton` is the same as `finsupp.total` -/
lemma lsum_comp_map_range_to_span_singleton
  [Π (m : R), decidable (m ≠ 0)]
  (p : ι → submodule R N) {v : ι → N} (hv : ∀ (i : ι), v i ∈ p i) :
  ((lsum ℕ) (λ i, (p i).subtype) : _ →ₗ[R] _).comp
    ((map_range.linear_map
      (λ i, linear_map.to_span_singleton R ↥(p i) ⟨v i, hv i⟩) : _ →ₗ[R] _).comp
      (finsupp_lequiv_dfinsupp R : (ι →₀ R) ≃ₗ[R] _).to_linear_map) =
  finsupp.total ι N R v :=
by { ext, simp }

end semiring

section ring
variables [ring R] [add_comm_group N] [module R N]

/- If `dfinsupp.sum_add_hom` applied with `add_submonoid.subtype` is injective then the additive
subgroups are independent. -/
lemma independent_of_dfinsupp_sum_add_hom_injective' (p : ι → add_subgroup N)
  (h : function.injective (sum_add_hom (λ i, (p i).subtype))) :
  independent p :=
begin
  rw ←independent_map_order_iso_iff (add_subgroup.to_int_submodule : add_subgroup N ≃o _),
  exact independent_of_dfinsupp_lsum_injective _ h,
end

/-- The canonical map out of a direct sum of a family of submodules is injective when the submodules
are `complete_lattice.independent`.

Note that this is not generally true for `[semiring R]`, for instance when `A` is the
`ℕ`-submodules of the positive and negative integers.

See `counterexamples/direct_sum_is_internal.lean` for a proof of this fact. -/
lemma independent.dfinsupp_lsum_injective {p : ι → submodule R N}
  (h : independent p) : function.injective (lsum ℕ (λ i, (p i).subtype)) :=
begin
  -- simplify everything down to binders over equalities in `N`
  rw independent_iff_forall_dfinsupp at h,
  suffices : (lsum ℕ (λ i, (p i).subtype)).ker = ⊥,
  { -- Lean can't find this without our help
    letI : add_comm_group (Π₀ i, p i) := @dfinsupp.add_comm_group _ (λ i, p i) _,
    rw linear_map.ker_eq_bot at this, exact this },
  rw linear_map.ker_eq_bot',
  intros m hm,
  ext i : 1,
  -- split `m` into the piece at `i` and the pieces elsewhere, to match `h`
  rw [dfinsupp.zero_apply, ←neg_eq_zero],
  refine h i (-m i) m _,
  rwa [←erase_add_single i m, linear_map.map_add, lsum_single, submodule.subtype_apply,
    add_eq_zero_iff_eq_neg, ←submodule.coe_neg] at hm,
end

/-- The canonical map out of a direct sum of a family of additive subgroups is injective when the
additive subgroups are `complete_lattice.independent`. -/
lemma independent.dfinsupp_sum_add_hom_injective {p : ι → add_subgroup N}
  (h : independent p) : function.injective (sum_add_hom (λ i, (p i).subtype)) :=
begin
  rw ←independent_map_order_iso_iff (add_subgroup.to_int_submodule : add_subgroup N ≃o _) at h,
  exact h.dfinsupp_lsum_injective,
end

/-- A family of submodules over an additive group are independent if and only iff `dfinsupp.lsum`
applied with `submodule.subtype` is injective.

Note that this is not generally true for `[semiring R]`; see
`complete_lattice.independent.dfinsupp_lsum_injective` for details. -/
lemma independent_iff_dfinsupp_lsum_injective (p : ι → submodule R N) :
  independent p ↔ function.injective (lsum ℕ (λ i, (p i).subtype)) :=
⟨independent.dfinsupp_lsum_injective, independent_of_dfinsupp_lsum_injective p⟩

/-- A family of additive subgroups over an additive group are independent if and only if
`dfinsupp.sum_add_hom` applied with `add_subgroup.subtype` is injective. -/
lemma independent_iff_dfinsupp_sum_add_hom_injective (p : ι → add_subgroup N) :
  independent p ↔ function.injective (sum_add_hom (λ i, (p i).subtype)) :=
⟨independent.dfinsupp_sum_add_hom_injective, independent_of_dfinsupp_sum_add_hom_injective' p⟩

omit dec_ι

/-- If a family of submodules is `independent`, then a choice of nonzero vector from each submodule
forms a linearly independent family.

See also `complete_lattice.independent.linear_independent'`. -/
lemma independent.linear_independent [no_zero_smul_divisors R N] (p : ι → submodule R N)
  (hp : independent p) {v : ι → N} (hv : ∀ i, v i ∈ p i) (hv' : ∀ i, v i ≠ 0) :
  linear_independent R v :=
begin
  classical,
  rw linear_independent_iff,
  intros l hl,
  let a := dfinsupp.map_range.linear_map
    (λ i, linear_map.to_span_singleton R (p i) (⟨v i, hv i⟩)) l.to_dfinsupp,
  have ha : a = 0,
  { apply hp.dfinsupp_lsum_injective,
    rwa ←lsum_comp_map_range_to_span_singleton _ hv at hl },
  ext i,
  apply smul_left_injective R (hv' i),
  have : l i • v i = a i := rfl,
  simp [this, ha],
end

lemma independent_iff_linear_independent_of_ne_zero [no_zero_smul_divisors R N] {v : ι → N}
  (h_ne_zero : ∀ i, v i ≠ 0) :
  independent (λ i, R ∙ v i) ↔ linear_independent R v :=
⟨λ hv, hv.linear_independent _ (λ i, submodule.mem_span_singleton_self $ v i) h_ne_zero,
 λ hv, hv.independent_span_singleton⟩

end ring

end complete_lattice


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module data.prod.pprod
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Basic

/-!
# Extra facts about `pprod`
-/

open Function

variable {α β γ δ : Sort _}

namespace PProd

@[simp]
theorem mk.eta {p : PProd α β} : PProd.mk p.1 p.2 = p :=
  PProd.casesOn p fun _ _ ↦ rfl
#align pprod.mk.eta PProd.mk.eta

@[simp]
theorem «forall» {p : PProd α β → Prop} : (∀ x, p x) ↔ ∀ a b, p ⟨a, b⟩ :=
  ⟨fun h a b ↦ h ⟨a, b⟩, fun h ⟨a, b⟩ ↦ h a b⟩
#align pprod.forall PProd.forall

@[simp]
theorem «exists» {p : PProd α β → Prop} : (∃ x, p x) ↔ ∃ a b, p ⟨a, b⟩ :=
  ⟨fun ⟨⟨a, b⟩, h⟩ ↦ ⟨a, b, h⟩, fun ⟨a, b, h⟩ ↦ ⟨⟨a, b⟩, h⟩⟩
#align pprod.exists PProd.exists

theorem forall' {p : α → β → Prop} : (∀ x : PProd α β, p x.1 x.2) ↔ ∀ a b, p a b :=
  PProd.forall
#align pprod.forall' PProd.forall'

theorem exists' {p : α → β → Prop} : (∃ x : PProd α β, p x.1 x.2) ↔ ∃ a b, p a b :=
  PProd.exists
#align pprod.exists' PProd.exists'

end PProd

theorem Function.Injective.pprod_map {f : α → β} {g : γ → δ} (hf : Injective f) (hg : Injective g) :
    Injective (fun x ↦ ⟨f x.1, g x.2⟩ : PProd α γ → PProd β δ) := fun _ _ h ↦
  have A := congr_arg PProd.fst h
  have B := congr_arg PProd.snd h
  congr_arg₂ PProd.mk (hf A) (hg B)
#align function.injective.pprod_map Function.Injective.pprod_map