/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Yury Kudryashov
-/
import algebra.algebra.operations

/-!
# Subalgebras over Commutative Semiring

In this file we define `subalgebra`s and the usual operations on them (`map`, `comap`).

More lemmas about `adjoin` can be found in `ring_theory.adjoin`.
-/
universes u v w

open_locale tensor_product big_operators

set_option old_structure_cmd true

/-- A subalgebra is a sub(semi)ring that includes the range of `algebra_map`. -/
structure subalgebra (R : Type u) (A : Type v)
  [comm_semiring R] [semiring A] [algebra R A] extends subsemiring A : Type v :=
(algebra_map_mem' : ∀ r, algebra_map R A r ∈ carrier)
(zero_mem' := (algebra_map R A).map_zero ▸ algebra_map_mem' 0)
(one_mem' := (algebra_map R A).map_one ▸ algebra_map_mem' 1)

/-- Reinterpret a `subalgebra` as a `subsemiring`. -/
add_decl_doc subalgebra.to_subsemiring

namespace subalgebra

variables {R : Type u} {A : Type v} {B : Type w}
variables [comm_semiring R] [semiring A] [algebra R A] [semiring B] [algebra R B]
include R

instance : set_like (subalgebra R A) A :=
⟨subalgebra.carrier, λ p q h, by cases p; cases q; congr'⟩

@[simp]
lemma mem_carrier {s : subalgebra R A} {x : A} : x ∈ s.carrier ↔ x ∈ s := iff.rfl

@[ext] theorem ext {S T : subalgebra R A} (h : ∀ x : A, x ∈ S ↔ x ∈ T) : S = T := set_like.ext h

/-- Copy of a submodule with a new `carrier` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (S : subalgebra R A) (s : set A) (hs : s = ↑S) : subalgebra R A :=
{ carrier := s,
  add_mem' := hs.symm ▸ S.add_mem',
  mul_mem' := hs.symm ▸ S.mul_mem',
  algebra_map_mem' := hs.symm ▸ S.algebra_map_mem' }

variables (S : subalgebra R A)

theorem algebra_map_mem (r : R) : algebra_map R A r ∈ S :=
S.algebra_map_mem' r

theorem srange_le : (algebra_map R A).srange ≤ S.to_subsemiring :=
λ x ⟨r, hr⟩, hr ▸ S.algebra_map_mem r

theorem range_subset : set.range (algebra_map R A) ⊆ S :=
λ x ⟨r, hr⟩, hr ▸ S.algebra_map_mem r

theorem range_le : set.range (algebra_map R A) ≤ S :=
S.range_subset

theorem one_mem : (1 : A) ∈ S :=
S.to_subsemiring.one_mem

theorem mul_mem {x y : A} (hx : x ∈ S) (hy : y ∈ S) : x * y ∈ S :=
S.to_subsemiring.mul_mem hx hy

theorem smul_mem {x : A} (hx : x ∈ S) (r : R) : r • x ∈ S :=
(algebra.smul_def r x).symm ▸ S.mul_mem (S.algebra_map_mem r) hx

theorem pow_mem {x : A} (hx : x ∈ S) (n : ℕ) : x ^ n ∈ S :=
S.to_subsemiring.pow_mem hx n

theorem zero_mem : (0 : A) ∈ S :=
S.to_subsemiring.zero_mem

theorem add_mem {x y : A} (hx : x ∈ S) (hy : y ∈ S) : x + y ∈ S :=
S.to_subsemiring.add_mem hx hy

theorem neg_mem {R : Type u} {A : Type v} [comm_ring R] [ring A]
  [algebra R A] (S : subalgebra R A) {x : A} (hx : x ∈ S) : -x ∈ S :=
neg_one_smul R x ▸ S.smul_mem hx _

theorem sub_mem {R : Type u} {A : Type v} [comm_ring R] [ring A]
  [algebra R A] (S : subalgebra R A) {x y : A} (hx : x ∈ S) (hy : y ∈ S) : x - y ∈ S :=
by simpa only [sub_eq_add_neg] using S.add_mem hx (S.neg_mem hy)

theorem nsmul_mem {x : A} (hx : x ∈ S) (n : ℕ) : n • x ∈ S :=
S.to_subsemiring.nsmul_mem hx n

theorem gsmul_mem {R : Type u} {A : Type v} [comm_ring R] [ring A]
  [algebra R A] (S : subalgebra R A) {x : A} (hx : x ∈ S) : ∀ (n : ℤ), n • x ∈ S
| (n : ℕ) := by { rw [gsmul_coe_nat], exact S.nsmul_mem hx n }
| -[1+ n] := by { rw [gsmul_neg_succ_of_nat], exact S.neg_mem (S.nsmul_mem hx _) }

theorem coe_nat_mem (n : ℕ) : (n : A) ∈ S :=
S.to_subsemiring.coe_nat_mem n

theorem coe_int_mem {R : Type u} {A : Type v} [comm_ring R] [ring A]
  [algebra R A] (S : subalgebra R A) (n : ℤ) : (n : A) ∈ S :=
int.cases_on n (λ i, S.coe_nat_mem i) (λ i, S.neg_mem $ S.coe_nat_mem $ i + 1)

theorem list_prod_mem {L : list A} (h : ∀ x ∈ L, x ∈ S) : L.prod ∈ S :=
S.to_subsemiring.list_prod_mem h

theorem list_sum_mem {L : list A} (h : ∀ x ∈ L, x ∈ S) : L.sum ∈ S :=
S.to_subsemiring.list_sum_mem h

theorem multiset_prod_mem {R : Type u} {A : Type v} [comm_semiring R] [comm_semiring A]
  [algebra R A] (S : subalgebra R A) {m : multiset A} (h : ∀ x ∈ m, x ∈ S) : m.prod ∈ S :=
S.to_subsemiring.multiset_prod_mem m h

theorem multiset_sum_mem {m : multiset A} (h : ∀ x ∈ m, x ∈ S) : m.sum ∈ S :=
S.to_subsemiring.multiset_sum_mem m h

theorem prod_mem {R : Type u} {A : Type v} [comm_semiring R] [comm_semiring A]
  [algebra R A] (S : subalgebra R A) {ι : Type w} {t : finset ι} {f : ι → A}
  (h : ∀ x ∈ t, f x ∈ S) : ∏ x in t, f x ∈ S :=
S.to_subsemiring.prod_mem h

theorem sum_mem {ι : Type w} {t : finset ι} {f : ι → A}
  (h : ∀ x ∈ t, f x ∈ S) : ∑ x in t, f x ∈ S :=
S.to_subsemiring.sum_mem h

instance {R : Type u} {A : Type v} [comm_semiring R] [semiring A] [algebra R A]
  (S : subalgebra R A) : is_add_submonoid (S : set A) :=
{ zero_mem := S.zero_mem,
  add_mem := λ _ _, S.add_mem }

instance {R : Type u} {A : Type v} [comm_semiring R] [semiring A] [algebra R A]
  (S : subalgebra R A) : is_submonoid (S : set A) :=
{ one_mem := S.one_mem,
  mul_mem := λ _ _, S.mul_mem }

/-- A subalgebra over a ring is also a `subring`. -/
def to_subring {R : Type u} {A : Type v} [comm_ring R] [ring A] [algebra R A] (S : subalgebra R A) :
  subring A :=
{ neg_mem' := λ _, S.neg_mem,
  .. S.to_subsemiring }

instance {R : Type u} {A : Type v} [comm_ring R] [ring A] [algebra R A] (S : subalgebra R A) :
  is_subring (S : set A) :=
{ neg_mem := λ _, S.neg_mem }

instance : inhabited S := ⟨(0 : S.to_subsemiring)⟩

section

/-! `subalgebra`s inherit structure from their `subsemiring` / `semiring` coercions. -/

instance to_semiring {R A}
  [comm_semiring R] [semiring A] [algebra R A] (S : subalgebra R A) :
  semiring S := S.to_subsemiring.to_semiring
instance to_comm_semiring {R A}
  [comm_semiring R] [comm_semiring A] [algebra R A] (S : subalgebra R A) :
  comm_semiring S := S.to_subsemiring.to_comm_semiring
instance to_ring {R A}
  [comm_ring R] [ring A] [algebra R A] (S : subalgebra R A) :
  ring S := S.to_subring.to_ring
instance to_comm_ring {R A}
  [comm_ring R] [comm_ring A] [algebra R A] (S : subalgebra R A) :
  comm_ring S := S.to_subring.to_comm_ring

instance to_ordered_semiring {R A}
  [comm_semiring R] [ordered_semiring A] [algebra R A] (S : subalgebra R A) :
  ordered_semiring S := S.to_subsemiring.to_ordered_semiring
instance to_ordered_comm_semiring {R A}
  [comm_semiring R] [ordered_comm_semiring A] [algebra R A] (S : subalgebra R A) :
  ordered_comm_semiring S := S.to_subsemiring.to_ordered_comm_semiring
instance to_ordered_ring {R A}
  [comm_ring R] [ordered_ring A] [algebra R A] (S : subalgebra R A) :
  ordered_ring S := S.to_subring.to_ordered_ring
instance to_ordered_comm_ring {R A}
  [comm_ring R] [ordered_comm_ring A] [algebra R A] (S : subalgebra R A) :
  ordered_comm_ring S := S.to_subring.to_ordered_comm_ring

instance to_linear_ordered_semiring {R A}
  [comm_semiring R] [linear_ordered_semiring A] [algebra R A] (S : subalgebra R A) :
  linear_ordered_semiring S := S.to_subsemiring.to_linear_ordered_semiring
/-! There is no `linear_ordered_comm_semiring`. -/
instance to_linear_ordered_ring {R A}
  [comm_ring R] [linear_ordered_ring A] [algebra R A] (S : subalgebra R A) :
  linear_ordered_ring S := S.to_subring.to_linear_ordered_ring
instance to_linear_ordered_comm_ring {R A}
  [comm_ring R] [linear_ordered_comm_ring A] [algebra R A] (S : subalgebra R A) :
  linear_ordered_comm_ring S := S.to_subring.to_linear_ordered_comm_ring

end

instance algebra : algebra R S :=
{ smul := λ (c:R) x, ⟨c • x.1, S.smul_mem x.2 c⟩,
  commutes' := λ c x, subtype.eq $ algebra.commutes _ _,
  smul_def' := λ c x, subtype.eq $ algebra.smul_def _ _,
  .. (algebra_map R A).cod_srestrict S.to_subsemiring $ λ x, S.range_le ⟨x, rfl⟩ }

instance to_algebra {R A B : Type*} [comm_semiring R] [comm_semiring A] [semiring B]
  [algebra R A] [algebra A B] (A₀ : subalgebra R A) : algebra A₀ B :=
algebra.of_subsemiring A₀.to_subsemiring

instance nontrivial [nontrivial A] : nontrivial S :=
S.to_subsemiring.nontrivial

instance no_zero_smul_divisors_bot [no_zero_smul_divisors R A] : no_zero_smul_divisors R S :=
⟨λ c x h,
  have c = 0 ∨ (x : A) = 0,
  from eq_zero_or_eq_zero_of_smul_eq_zero (congr_arg coe h),
  this.imp_right (@subtype.ext_iff _ _ x 0).mpr⟩

@[simp, norm_cast] lemma coe_add (x y : S) : (↑(x + y) : A) = ↑x + ↑y := rfl
@[simp, norm_cast] lemma coe_mul (x y : S) : (↑(x * y) : A) = ↑x * ↑y := rfl
@[simp, norm_cast] lemma coe_zero : ((0 : S) : A) = 0 := rfl
@[simp, norm_cast] lemma coe_one : ((1 : S) : A) = 1 := rfl
@[simp, norm_cast] lemma coe_neg {R : Type u} {A : Type v} [comm_ring R] [ring A] [algebra R A]
  {S : subalgebra R A} (x : S) : (↑(-x) : A) = -↑x := rfl
@[simp, norm_cast] lemma coe_sub {R : Type u} {A : Type v} [comm_ring R] [ring A] [algebra R A]
  {S : subalgebra R A} (x y : S) : (↑(x - y) : A) = ↑x - ↑y := rfl
@[simp, norm_cast] lemma coe_smul (r : R) (x : S) : (↑(r • x) : A) = r • ↑x := rfl
@[simp, norm_cast] lemma coe_algebra_map (r : R) : ↑(algebra_map R S r) = algebra_map R A r :=
rfl

@[simp, norm_cast] lemma coe_pow (x : S) (n : ℕ) : (↑(x^n) : A) = (↑x)^n :=
begin
  induction n with n ih,
  { simp, },
  { simp [pow_succ, ih], },
end

@[simp, norm_cast] lemma coe_eq_zero {x : S} : (x : A) = 0 ↔ x = 0 :=
(subtype.ext_iff.symm : (x : A) = (0 : S) ↔ x = 0)
@[simp, norm_cast] lemma coe_eq_one {x : S} : (x : A) = 1 ↔ x = 1 :=
(subtype.ext_iff.symm : (x : A) = (1 : S) ↔ x = 1)

-- todo: standardize on the names these morphisms
-- compare with submodule.subtype

/-- Embedding of a subalgebra into the algebra. -/
def val : S →ₐ[R] A :=
by refine_struct { to_fun := (coe : S → A) }; intros; refl

@[simp] lemma coe_val : (S.val : S → A) = coe := rfl

lemma val_apply (x : S) : S.val x = (x : A) := rfl

/-- Convert a `subalgebra` to `submodule` -/
def to_submodule : submodule R A :=
{ carrier := S,
  zero_mem' := (0:S).2,
  add_mem' := λ x y hx hy, (⟨x, hx⟩ + ⟨y, hy⟩ : S).2,
  smul_mem' := λ c x hx, (algebra.smul_def c x).symm ▸
    (⟨algebra_map R A c, S.range_le ⟨c, rfl⟩⟩ * ⟨x, hx⟩:S).2 }

instance to_submodule.is_subring {R : Type u} {A : Type v} [comm_ring R] [ring A] [algebra R A]
  (S : subalgebra R A) : is_subring (S.to_submodule : set A) := S.is_subring

@[simp] lemma mem_to_submodule {x} : x ∈ S.to_submodule ↔ x ∈ S := iff.rfl

theorem to_submodule_injective :
  function.injective (to_submodule : subalgebra R A → submodule R A) :=
λ S T h, ext $ λ x, by rw [← mem_to_submodule, ← mem_to_submodule, h]

theorem to_submodule_inj {S U : subalgebra R A} : S.to_submodule = U.to_submodule ↔ S = U :=
to_submodule_injective.eq_iff

/-- As submodules, subalgebras are idempotent. -/
@[simp] theorem mul_self : S.to_submodule * S.to_submodule = S.to_submodule :=
begin
  apply le_antisymm,
  { rw submodule.mul_le,
    intros y hy z hz,
    exact mul_mem S hy hz },
  { intros x hx1,
    rw ← mul_one x,
    exact submodule.mul_mem_mul hx1 (one_mem S) }
end

/-- Linear equivalence between `S : submodule R A` and `S`. Though these types are equal,
we define it as a `linear_equiv` to avoid type equalities. -/
def to_submodule_equiv (S : subalgebra R A) : S.to_submodule ≃ₗ[R] S :=
linear_equiv.of_eq _ _ rfl

/-- Reinterpret an `S`-subalgebra as an `R`-subalgebra in `comap R S A`. -/
def comap {R : Type u} {S : Type v} {A : Type w}
  [comm_semiring R] [comm_semiring S] [semiring A] [algebra R S] [algebra S A]
  (iSB : subalgebra S A) : subalgebra R (algebra.comap R S A) :=
{ algebra_map_mem' := λ r, iSB.algebra_map_mem (algebra_map R S r),
  .. iSB }

/-- If `S` is an `R`-subalgebra of `A` and `T` is an `S`-subalgebra of `A`,
then `T` is an `R`-subalgebra of `A`. -/
def under {R : Type u} {A : Type v} [comm_semiring R] [comm_semiring A]
  {i : algebra R A} (S : subalgebra R A)
  (T : subalgebra S A) : subalgebra R A :=
{ algebra_map_mem' := λ r, T.algebra_map_mem ⟨algebra_map R A r, S.algebra_map_mem r⟩,
  .. T }

/-- Transport a subalgebra via an algebra homomorphism. -/
def map (S : subalgebra R A) (f : A →ₐ[R] B) : subalgebra R B :=
{ algebra_map_mem' := λ r, f.commutes r ▸ set.mem_image_of_mem _ (S.algebra_map_mem r),
  .. S.to_subsemiring.map (f : A →+* B) }

lemma map_mono {S₁ S₂ : subalgebra R A} {f : A →ₐ[R] B} :
  S₁ ≤ S₂ → S₁.map f ≤ S₂.map f :=
set.image_subset f

lemma map_injective {S₁ S₂ : subalgebra R A} (f : A →ₐ[R] B)
  (hf : function.injective f) (ih : S₁.map f = S₂.map f) : S₁ = S₂ :=
ext $ set.ext_iff.1 $ set.image_injective.2 hf $ set.ext $ set_like.ext_iff.mp ih

lemma mem_map {S : subalgebra R A} {f : A →ₐ[R] B} {y : B} :
  y ∈ map S f ↔ ∃ x ∈ S, f x = y :=
subsemiring.mem_map

/-- Preimage of a subalgebra under an algebra homomorphism. -/
def comap' (S : subalgebra R B) (f : A →ₐ[R] B) : subalgebra R A :=
{ algebra_map_mem' := λ r, show f (algebra_map R A r) ∈ S,
    from (f.commutes r).symm ▸ S.algebra_map_mem r,
  .. S.to_subsemiring.comap (f : A →+* B) }

theorem map_le {S : subalgebra R A} {f : A →ₐ[R] B} {U : subalgebra R B} :
  map S f ≤ U ↔ S ≤ comap' U f :=
set.image_subset_iff

@[simp] lemma mem_comap (S : subalgebra R B) (f : A →ₐ[R] B) (x : A) :
  x ∈ S.comap' f ↔ f x ∈ S :=
iff.rfl

@[simp, norm_cast] lemma coe_comap (S : subalgebra R B) (f : A →ₐ[R] B) :
  (S.comap' f : set A) = f ⁻¹' (S : set B) :=
by { ext, simp, }

instance no_zero_divisors {R A : Type*} [comm_ring R] [semiring A] [no_zero_divisors A]
  [algebra R A] (S : subalgebra R A) : no_zero_divisors S :=
S.to_subsemiring.no_zero_divisors

instance no_zero_smul_divisors_top {R A : Type*} [comm_semiring R] [comm_semiring A] [algebra R A]
  [no_zero_divisors A] (S : subalgebra R A) : no_zero_smul_divisors S A :=
⟨λ c x h,
  have (c : A) = 0 ∨ x = 0,
  from eq_zero_or_eq_zero_of_mul_eq_zero h,
  this.imp_left (@subtype.ext_iff _ _ c 0).mpr⟩

instance integral_domain {R A : Type*} [comm_ring R] [integral_domain A] [algebra R A]
  (S : subalgebra R A) : integral_domain S :=
@subring.domain A _ S _

end subalgebra

namespace alg_hom

variables {R : Type u} {A : Type v} {B : Type w}
variables [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
variables (φ : A →ₐ[R] B)

/-- Range of an `alg_hom` as a subalgebra. -/
protected def range (φ : A →ₐ[R] B) : subalgebra R B :=
{ algebra_map_mem' := λ r, ⟨algebra_map R A r, φ.commutes r⟩,
  .. φ.to_ring_hom.srange }

@[simp] lemma mem_range (φ : A →ₐ[R] B) {y : B} :
  y ∈ φ.range ↔ ∃ x, φ x = y := ring_hom.mem_srange

theorem mem_range_self (φ : A →ₐ[R] B) (x : A) : φ x ∈ φ.range := φ.mem_range.2 ⟨x, rfl⟩

@[simp] lemma coe_range (φ : A →ₐ[R] B) : (φ.range : set B) = set.range φ :=
by { ext, rw [set_like.mem_coe, mem_range], refl }

/-- Restrict the codomain of an algebra homomorphism. -/
def cod_restrict (f : A →ₐ[R] B) (S : subalgebra R B) (hf : ∀ x, f x ∈ S) : A →ₐ[R] S :=
{ commutes' := λ r, subtype.eq $ f.commutes r,
  .. ring_hom.cod_srestrict (f : A →+* B) S.to_subsemiring hf }

@[simp] lemma val_comp_cod_restrict (f : A →ₐ[R] B) (S : subalgebra R B) (hf : ∀ x, f x ∈ S) :
  S.val.comp (f.cod_restrict S hf) = f :=
alg_hom.ext $ λ _, rfl

@[simp] lemma coe_cod_restrict (f : A →ₐ[R] B) (S : subalgebra R B) (hf : ∀ x, f x ∈ S) (x : A) :
  ↑(f.cod_restrict S hf x) = f x := rfl

theorem injective_cod_restrict (f : A →ₐ[R] B) (S : subalgebra R B) (hf : ∀ x, f x ∈ S) :
  function.injective (f.cod_restrict S hf) ↔ function.injective f :=
⟨λ H x y hxy, H $ subtype.eq hxy, λ H x y hxy, H (congr_arg subtype.val hxy : _)⟩

/-- Restrict the codomain of a alg_hom `f` to `f.range`.

This is the bundled version of `set.range_factorization`. -/
@[reducible] def range_restrict (f : A →ₐ[R] B) : A →ₐ[R] f.range :=
f.cod_restrict f.range f.mem_range_self

/-- The equalizer of two R-algebra homomorphisms -/
def equalizer (ϕ ψ : A →ₐ[R] B) : subalgebra R A :=
{ carrier := {a | ϕ a = ψ a},
  add_mem' := λ x y hx hy, by
  { change ϕ x = ψ x at hx,
    change ϕ y = ψ y at hy,
    change ϕ (x + y) = ψ (x + y),
    rw [alg_hom.map_add, alg_hom.map_add, hx, hy] },
  mul_mem' := λ x y hx hy, by
  { change ϕ x = ψ x at hx,
    change ϕ y = ψ y at hy,
    change ϕ (x * y) = ψ (x * y),
    rw [alg_hom.map_mul, alg_hom.map_mul, hx, hy] },
  algebra_map_mem' := λ x, by
  { change ϕ (algebra_map R A x) = ψ (algebra_map R A x),
    rw [alg_hom.commutes, alg_hom.commutes] } }

@[simp] lemma mem_equalizer (ϕ ψ : A →ₐ[R] B) (x : A) :
  x ∈ ϕ.equalizer ψ ↔ ϕ x = ψ x := iff.rfl

end alg_hom

namespace alg_equiv

variables {R : Type u} {A : Type v} {B : Type w}
variables [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]

/-- Restrict an algebra homomorphism with a left inverse to an algebra isomorphism to its range.

This is a computable alternative to `alg_equiv.of_injective`. -/
def of_left_inverse
  {g : B → A} {f : A →ₐ[R] B} (h : function.left_inverse g f) :
  A ≃ₐ[R] f.range :=
{ to_fun := f.range_restrict,
  inv_fun := g ∘ f.range.val,
  left_inv := h,
  right_inv := λ x, subtype.ext $
    let ⟨x', hx'⟩ := f.mem_range.mp x.prop in
    show f (g x) = x, by rw [←hx', h x'],
  ..f.range_restrict }

@[simp] lemma of_left_inverse_apply
  {g : B → A} {f : A →ₐ[R] B} (h : function.left_inverse g f) (x : A) :
  ↑(of_left_inverse h x) = f x := rfl

@[simp] lemma of_left_inverse_symm_apply
  {g : B → A} {f : A →ₐ[R] B} (h : function.left_inverse g f) (x : f.range) :
  (of_left_inverse h).symm x = g x := rfl

/-- Restrict an injective algebra homomorphism to an algebra isomorphism -/
noncomputable def of_injective (f : A →ₐ[R] B) (hf : function.injective f) :
  A ≃ₐ[R] f.range :=
of_left_inverse (classical.some_spec hf.has_left_inverse)

@[simp] lemma of_injective_apply (f : A →ₐ[R] B) (hf : function.injective f) (x : A) :
  ↑(of_injective f hf x) = f x := rfl

/-- Restrict an algebra homomorphism between fields to an algebra isomorphism -/
noncomputable def of_injective_field {E F : Type*} [division_ring E] [semiring F]
  [nontrivial F] [algebra R E] [algebra R F] (f : E →ₐ[R] F) : E ≃ₐ[R] f.range :=
of_injective f f.to_ring_hom.injective

end alg_equiv

namespace algebra

variables (R : Type u) {A : Type v} {B : Type w}
variables [comm_semiring R] [semiring A] [algebra R A] [semiring B] [algebra R B]

/-- The minimal subalgebra that includes `s`. -/
def adjoin (s : set A) : subalgebra R A :=
{ algebra_map_mem' := λ r, subsemiring.subset_closure $ or.inl ⟨r, rfl⟩,
  .. subsemiring.closure (set.range (algebra_map R A) ∪ s) }
variables {R}

protected lemma gc : galois_connection (adjoin R : set A → subalgebra R A) coe :=
λ s S, ⟨λ H, le_trans (le_trans (set.subset_union_right _ _) subsemiring.subset_closure) H,
λ H, show subsemiring.closure (set.range (algebra_map R A) ∪ s) ≤ S.to_subsemiring,
     from subsemiring.closure_le.2 $ set.union_subset S.range_subset H⟩

/-- Galois insertion between `adjoin` and `coe`. -/
protected def gi : galois_insertion (adjoin R : set A → subalgebra R A) coe :=
{ choice := λ s hs, adjoin R s,
  gc := algebra.gc,
  le_l_u := λ S, (algebra.gc (S : set A) (adjoin R S)).1 $ le_refl _,
  choice_eq := λ _ _, rfl }

instance : complete_lattice (subalgebra R A) :=
galois_insertion.lift_complete_lattice algebra.gi

instance : inhabited (subalgebra R A) := ⟨⊥⟩

theorem mem_bot {x : A} : x ∈ (⊥ : subalgebra R A) ↔ x ∈ set.range (algebra_map R A) :=
suffices (of_id R A).range = (⊥ : subalgebra R A),
by { rw [← this, ←set_like.mem_coe, alg_hom.coe_range], refl },
le_bot_iff.mp (λ x hx, subalgebra.range_le _ ((of_id R A).coe_range ▸ hx))

theorem to_submodule_bot : (⊥ : subalgebra R A).to_submodule = R ∙ 1 :=
by { ext x, simp [mem_bot, -set.singleton_one, submodule.mem_span_singleton, algebra.smul_def] }

@[simp] theorem mem_top {x : A} : x ∈ (⊤ : subalgebra R A) :=
subsemiring.subset_closure $ or.inr trivial

@[simp] theorem top_to_submodule : (⊤ : subalgebra R A).to_submodule = ⊤ :=
submodule.ext $ λ x, iff_of_true mem_top trivial

@[simp] theorem top_to_subsemiring : (⊤ : subalgebra R A).to_subsemiring = ⊤ :=
subsemiring.ext $ λ x, iff_of_true mem_top trivial

@[simp] theorem coe_bot : ((⊥ : subalgebra R A) : set A) = set.range (algebra_map R A) :=
by simp [set.ext_iff, algebra.mem_bot]

theorem eq_top_iff {S : subalgebra R A} :
  S = ⊤ ↔ ∀ x : A, x ∈ S :=
⟨λ h x, by rw h; exact mem_top, λ h, by ext x; exact ⟨λ _, mem_top, λ _, h x⟩⟩

@[simp] theorem map_top (f : A →ₐ[R] B) : subalgebra.map (⊤ : subalgebra R A) f = f.range :=
subalgebra.ext $ λ x,
  ⟨λ ⟨y, _, hy⟩, ⟨y, hy⟩, λ ⟨y, hy⟩, ⟨y, algebra.mem_top, hy⟩⟩

@[simp] theorem map_bot (f : A →ₐ[R] B) : subalgebra.map (⊥ : subalgebra R A) f = ⊥ :=
eq_bot_iff.2 $ λ x ⟨y, hy, hfy⟩, let ⟨r, hr⟩ := mem_bot.1 hy in subalgebra.range_le _
⟨r, by rwa [← f.commutes, hr]⟩

@[simp] theorem comap_top (f : A →ₐ[R] B) : subalgebra.comap' (⊤ : subalgebra R B) f = ⊤ :=
eq_top_iff.2 $ λ x, mem_top

/-- `alg_hom` to `⊤ : subalgebra R A`. -/
def to_top : A →ₐ[R] (⊤ : subalgebra R A) :=
by refine_struct { to_fun := λ x, (⟨x, mem_top⟩ : (⊤ : subalgebra R A)) }; intros; refl

theorem surjective_algebra_map_iff :
  function.surjective (algebra_map R A) ↔ (⊤ : subalgebra R A) = ⊥ :=
⟨λ h, eq_bot_iff.2 $ λ y _, let ⟨x, hx⟩ := h y in hx ▸ subalgebra.algebra_map_mem _ _,
λ h y, algebra.mem_bot.1 $ eq_bot_iff.1 h (algebra.mem_top : y ∈ _)⟩

theorem bijective_algebra_map_iff {R A : Type*} [field R] [semiring A] [nontrivial A]
  [algebra R A] :
  function.bijective (algebra_map R A) ↔ (⊤ : subalgebra R A) = ⊥ :=
⟨λ h, surjective_algebra_map_iff.1 h.2,
λ h, ⟨(algebra_map R A).injective, surjective_algebra_map_iff.2 h⟩⟩

/-- The bottom subalgebra is isomorphic to the base ring. -/
noncomputable def bot_equiv_of_injective (h : function.injective (algebra_map R A)) :
  (⊥ : subalgebra R A) ≃ₐ[R] R :=
alg_equiv.symm $ alg_equiv.of_bijective (algebra.of_id R _)
⟨λ x y hxy, h (congr_arg subtype.val hxy : _),
 λ ⟨y, hy⟩, let ⟨x, hx⟩ := algebra.mem_bot.1 hy in ⟨x, subtype.eq hx⟩⟩

/-- The bottom subalgebra is isomorphic to the field. -/
noncomputable def bot_equiv (F R : Type*) [field F] [semiring R] [nontrivial R] [algebra F R] :
  (⊥ : subalgebra F R) ≃ₐ[F] F :=
bot_equiv_of_injective (ring_hom.injective _)

/-- The top subalgebra is isomorphic to the field. -/
noncomputable def top_equiv : (⊤ : subalgebra R A) ≃ₐ[R] A :=
(alg_equiv.of_bijective to_top ⟨λ _ _, subtype.mk.inj,
  λ x, ⟨x.val, by { ext, refl }⟩⟩ : A ≃ₐ[R] (⊤ : subalgebra R A)).symm

end algebra

namespace subalgebra
open algebra

variables {R : Type u} {A : Type v} {B : Type w}
variables [comm_semiring R] [semiring A] [algebra R A] [semiring B] [algebra R B]
variables (S : subalgebra R A)

-- TODO[gh-6025]: make this an instance once safe to do so
lemma subsingleton_of_subsingleton [subsingleton A] : subsingleton (subalgebra R A) :=
⟨λ B C, ext (λ x, by { simp only [subsingleton.elim x 0, zero_mem] })⟩

-- TODO[gh-6025]: make this an instance once safe to do so
lemma alg_hom.subsingleton [subsingleton (subalgebra R A)] : subsingleton (A →ₐ[R] B) :=
⟨λ f g, alg_hom.ext $ λ a,
  have a ∈ (⊥ : subalgebra R A) := subsingleton.elim (⊤ : subalgebra R A) ⊥ ▸ mem_top,
  let ⟨x, hx⟩ := set.mem_range.mp (mem_bot.mp this) in
  hx ▸ (f.commutes _).trans (g.commutes _).symm⟩

-- TODO[gh-6025]: make this an instance once safe to do so
lemma alg_equiv.subsingleton_left [subsingleton (subalgebra R A)] : subsingleton (A ≃ₐ[R] B) :=
begin
  haveI : subsingleton (A →ₐ[R] B) := alg_hom.subsingleton,
  exact ⟨λ f g, alg_equiv.ext
    (λ x, alg_hom.ext_iff.mp (subsingleton.elim f.to_alg_hom g.to_alg_hom) x)⟩,
end

-- TODO[gh-6025]: make this an instance once safe to do so
lemma alg_equiv.subsingleton_right [subsingleton (subalgebra R B)] : subsingleton (A ≃ₐ[R] B) :=
begin
  haveI : subsingleton (B ≃ₐ[R] A) := alg_equiv.subsingleton_left,
  exact ⟨λ f g, eq.trans (alg_equiv.symm_symm _).symm
    (by rw [subsingleton.elim f.symm g.symm, alg_equiv.symm_symm])⟩
end

lemma range_val : S.val.range = S :=
ext $ set.ext_iff.1 $ S.val.coe_range.trans subtype.range_val

instance : unique (subalgebra R R) :=
{ uniq :=
  begin
    intro S,
    refine le_antisymm (λ r hr, _) bot_le,
    simp only [set.mem_range, mem_bot, id.map_eq_self, exists_apply_eq_apply, default],
  end
  .. algebra.subalgebra.inhabited }

end subalgebra

section nat

variables {R : Type*} [semiring R]

/-- A subsemiring is a `ℕ`-subalgebra. -/
def subalgebra_of_subsemiring (S : subsemiring R) : subalgebra ℕ R :=
{ algebra_map_mem' := λ i, S.coe_nat_mem i,
  .. S }

@[simp] lemma mem_subalgebra_of_subsemiring {x : R} {S : subsemiring R} :
  x ∈ subalgebra_of_subsemiring S ↔ x ∈ S :=
iff.rfl

end nat

section int

variables {R : Type*} [ring R]

/-- A subring is a `ℤ`-subalgebra. -/
def subalgebra_of_subring (S : subring R) : subalgebra ℤ R :=
{ algebra_map_mem' := λ i, int.induction_on i S.zero_mem
  (λ i ih, S.add_mem ih S.one_mem)
  (λ i ih, show ((-i - 1 : ℤ) : R) ∈ S, by { rw [int.cast_sub, int.cast_one],
    exact S.sub_mem ih S.one_mem }),
  .. S }

/-- A subset closed under the ring operations is a `ℤ`-subalgebra. -/
def subalgebra_of_is_subring (S : set R) [is_subring S] : subalgebra ℤ R :=
subalgebra_of_subring S.to_subring

variables {S : Type*} [semiring S]

@[simp] lemma mem_subalgebra_of_subring {x : R} {S : subring R} :
  x ∈ subalgebra_of_subring S ↔ x ∈ S :=
iff.rfl

@[simp] lemma mem_subalgebra_of_is_subring {x : R} {S : set R} [is_subring S] :
  x ∈ subalgebra_of_is_subring S ↔ x ∈ S :=
iff.rfl

end int


/-
Copyright (c) 2017 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johannes Hölzl, Chris Hughes, Jens Wagemaker
-/
import algebra.group.basic
import logic.nontrivial

/-!
# Units (i.e., invertible elements) of a monoid

An element of a `monoid` is a unit if it has a two-sided inverse.

## Main declarations

* `units M`: the group of units (i.e., invertible elements) of a monoid.
* `is_unit x`: a predicate asserting that `x` is a unit (i.e., invertible element) of a monoid.

For both declarations, there is an additive counterpart: `add_units` and `is_add_unit`.

## Notation

We provide `Mˣ` as notation for `units M`,
resembling the notation $R^{\times}$ for the units of a ring, which is common in mathematics.

-/

universe u
variable {α : Type u}

/-- Units of a `monoid`, bundled version. Notation: `αˣ`.

An element of a `monoid` is a unit if it has a two-sided inverse.
This version bundles the inverse element so that it can be computed.
For a predicate see `is_unit`. -/
structure units (α : Type u) [monoid α] :=
(val : α)
(inv : α)
(val_inv : val * inv = 1)
(inv_val : inv * val = 1)

postfix `ˣ`:1025 := units
-- We don't provide notation for the additive version, because its use is somewhat rare.

/-- Units of an `add_monoid`, bundled version.

An element of an `add_monoid` is a unit if it has a two-sided additive inverse.
This version bundles the inverse element so that it can be computed.
For a predicate see `is_add_unit`. -/
structure add_units (α : Type u) [add_monoid α] :=
(val : α)
(neg : α)
(val_neg : val + neg = 0)
(neg_val : neg + val = 0)

attribute [to_additive] units

section has_elem

@[to_additive] lemma unique_has_one {α : Type*} [unique α] [has_one α] :
  default = (1 : α) :=
unique.default_eq 1

end has_elem

namespace units

variables [monoid α]

@[to_additive] instance : has_coe αˣ α := ⟨val⟩

@[to_additive] instance : has_inv αˣ := ⟨λ u, ⟨u.2, u.1, u.4, u.3⟩⟩

/-- See Note [custom simps projection] -/
@[to_additive /-" See Note [custom simps projection] "-/]
def simps.coe (u : αˣ) : α := u

/-- See Note [custom simps projection] -/
@[to_additive /-" See Note [custom simps projection] "-/]
def simps.coe_inv (u : αˣ) : α := ↑(u⁻¹)

initialize_simps_projections units (val → coe as_prefix, inv → coe_inv as_prefix)
initialize_simps_projections add_units (val → coe as_prefix, neg → coe_neg as_prefix)

@[simp, to_additive] lemma coe_mk (a : α) (b h₁ h₂) : ↑(units.mk a b h₁ h₂) = a := rfl

@[ext, to_additive] theorem ext :
  function.injective (coe : αˣ → α)
| ⟨v, i₁, vi₁, iv₁⟩ ⟨v', i₂, vi₂, iv₂⟩ e :=
  by change v = v' at e; subst v'; congr;
      simpa only [iv₂, vi₁, one_mul, mul_one] using mul_assoc i₂ v i₁

@[norm_cast, to_additive] theorem eq_iff {a b : αˣ} :
  (a : α) = b ↔ a = b := ext.eq_iff

@[to_additive] theorem ext_iff {a b : αˣ} :
  a = b ↔ (a : α) = b := eq_iff.symm

@[to_additive] instance [decidable_eq α] : decidable_eq αˣ :=
λ a b, decidable_of_iff' _ ext_iff

@[simp, to_additive] theorem mk_coe (u : αˣ) (y h₁ h₂) :
  mk (u : α) y h₁ h₂ = u :=
ext rfl

/-- Copy a unit, adjusting definition equalities. -/
@[to_additive /-"Copy an `add_unit`, adjusting definitional equalities."-/, simps]
def copy (u : αˣ) (val : α) (hv : val = u) (inv : α) (hi : inv = ↑(u⁻¹)) : αˣ :=
{ val := val, inv := inv,
  inv_val := hv.symm ▸ hi.symm ▸ u.inv_val, val_inv := hv.symm ▸ hi.symm ▸ u.val_inv }

@[to_additive]
lemma copy_eq (u : αˣ) (val hv inv hi) :
  u.copy val hv inv hi = u :=
ext hv

/-- Units of a monoid form a group. -/
@[to_additive "Additive units of an additive monoid form an additive group."] instance : group αˣ :=
{ mul := λ u₁ u₂, ⟨u₁.val * u₂.val, u₂.inv * u₁.inv,
    by rw [mul_assoc, ← mul_assoc u₂.val, val_inv, one_mul, val_inv],
    by rw [mul_assoc, ← mul_assoc u₁.inv, inv_val, one_mul, inv_val]⟩,
  one := ⟨1, 1, one_mul 1, one_mul 1⟩,
  mul_one := λ u, ext $ mul_one u,
  one_mul := λ u, ext $ one_mul u,
  mul_assoc := λ u₁ u₂ u₃, ext $ mul_assoc u₁ u₂ u₃,
  inv := has_inv.inv,
  mul_left_inv := λ u, ext u.inv_val }

variables (a b : αˣ) {c : αˣ}
@[simp, norm_cast, to_additive] lemma coe_mul : (↑(a * b) : α) = a * b := rfl

@[simp, norm_cast, to_additive] lemma coe_one : ((1 : αˣ) : α) = 1 := rfl

@[simp, norm_cast, to_additive] lemma coe_eq_one {a : αˣ} : (a : α) = 1 ↔ a = 1 :=
by rw [←units.coe_one, eq_iff]

@[simp, to_additive] lemma inv_mk (x y : α) (h₁ h₂) : (mk x y h₁ h₂)⁻¹ = mk y x h₂ h₁ := rfl

@[simp, to_additive] lemma val_eq_coe : a.val = (↑a : α) := rfl

@[simp, to_additive] lemma inv_eq_coe_inv : a.inv = ((a⁻¹ : αˣ) : α) := rfl

@[simp, to_additive] lemma inv_mul : (↑a⁻¹ * a : α) = 1 := inv_val _
@[simp, to_additive] lemma mul_inv : (a * ↑a⁻¹ : α) = 1 := val_inv _

@[to_additive] lemma inv_mul_of_eq {u : αˣ} {a : α} (h : ↑u = a) : ↑u⁻¹ * a = 1 :=
by { rw [←h, u.inv_mul], }

@[to_additive] lemma mul_inv_of_eq {u : αˣ} {a : α} (h : ↑u = a) : a * ↑u⁻¹ = 1 :=
by { rw [←h, u.mul_inv], }

@[simp, to_additive] lemma mul_inv_cancel_left (a : αˣ) (b : α) : (a:α) * (↑a⁻¹ * b) = b :=
by rw [← mul_assoc, mul_inv, one_mul]

@[simp, to_additive] lemma inv_mul_cancel_left (a : αˣ) (b : α) : (↑a⁻¹:α) * (a * b) = b :=
by rw [← mul_assoc, inv_mul, one_mul]

@[simp, to_additive] lemma mul_inv_cancel_right (a : α) (b : αˣ) : a * b * ↑b⁻¹ = a :=
by rw [mul_assoc, mul_inv, mul_one]

@[simp, to_additive] lemma inv_mul_cancel_right (a : α) (b : αˣ) : a * ↑b⁻¹ * b = a :=
by rw [mul_assoc, inv_mul, mul_one]

@[to_additive] instance : inhabited αˣ := ⟨1⟩

@[to_additive] instance {α} [comm_monoid α] : comm_group αˣ :=
{ mul_comm := λ u₁ u₂, ext $ mul_comm _ _, ..units.group }

@[to_additive] instance [has_repr α] : has_repr αˣ := ⟨repr ∘ val⟩

@[simp, to_additive] theorem mul_right_inj (a : αˣ) {b c : α} : (a:α) * b = a * c ↔ b = c :=
⟨λ h, by simpa only [inv_mul_cancel_left] using congr_arg ((*) ↑(a⁻¹ : αˣ)) h, congr_arg _⟩

@[simp, to_additive] theorem mul_left_inj (a : αˣ) {b c : α} : b * a = c * a ↔ b = c :=
⟨λ h, by simpa only [mul_inv_cancel_right] using congr_arg (* ↑(a⁻¹ : αˣ)) h, congr_arg _⟩

@[to_additive] theorem eq_mul_inv_iff_mul_eq {a b : α} : a = b * ↑c⁻¹ ↔ a * c = b :=
⟨λ h, by rw [h, inv_mul_cancel_right], λ h, by rw [← h, mul_inv_cancel_right]⟩

@[to_additive] theorem eq_inv_mul_iff_mul_eq {a c : α} : a = ↑b⁻¹ * c ↔ ↑b * a = c :=
⟨λ h, by rw [h, mul_inv_cancel_left], λ h, by rw [← h, inv_mul_cancel_left]⟩

@[to_additive] theorem inv_mul_eq_iff_eq_mul {b c : α} : ↑a⁻¹ * b = c ↔ b = a * c :=
⟨λ h, by rw [← h, mul_inv_cancel_left], λ h, by rw [h, inv_mul_cancel_left]⟩

@[to_additive]

lemma inv_eq_of_mul_eq_one {u : αˣ} {a : α} (h : ↑u * a = 1) : ↑u⁻¹ = a :=
calc ↑u⁻¹ = ↑u⁻¹ * 1 : by rw mul_one
      ... = ↑u⁻¹ * ↑u * a : by rw [←h, ←mul_assoc]
      ... = a : by rw [u.inv_mul, one_mul]

lemma inv_unique {u₁ u₂ : αˣ} (h : (↑u₁ : α) = ↑u₂) : (↑u₁⁻¹ : α) = ↑u₂⁻¹ :=
inv_eq_of_mul_eq_one $ by rw [h, u₂.mul_inv]

end units

/-- For `a, b` in a `comm_monoid` such that `a * b = 1`, makes a unit out of `a`. -/
@[to_additive "For `a, b` in an `add_comm_monoid` such that `a + b = 0`, makes an add_unit
out of `a`."]
def units.mk_of_mul_eq_one [comm_monoid α] (a b : α) (hab : a * b = 1) :
  αˣ :=
⟨a, b, hab, (mul_comm b a).trans hab⟩

@[simp, to_additive] lemma units.coe_mk_of_mul_eq_one [comm_monoid α] {a b : α} (h : a * b = 1) :
  (units.mk_of_mul_eq_one a b h : α) = a := rfl

section monoid
variables [monoid α] {a b c : α}

/-- Partial division. It is defined when the
  second argument is invertible, and unlike the division operator
  in `division_ring` it is not totalized at zero. -/
def divp (a : α) (u) : α := a * (u⁻¹ : αˣ)

infix ` /ₚ `:70 := divp

@[simp] theorem divp_self (u : αˣ) : (u : α) /ₚ u = 1 := units.mul_inv _

@[simp] theorem divp_one (a : α) : a /ₚ 1 = a := mul_one _

theorem divp_assoc (a b : α) (u : αˣ) : a * b /ₚ u = a * (b /ₚ u) :=
mul_assoc _ _ _

@[simp] theorem divp_inv (u : αˣ) : a /ₚ u⁻¹ = a * u := rfl

@[simp] theorem divp_mul_cancel (a : α) (u : αˣ) : a /ₚ u * u = a :=
(mul_assoc _ _ _).trans $ by rw [units.inv_mul, mul_one]

@[simp] theorem mul_divp_cancel (a : α) (u : αˣ) : (a * u) /ₚ u = a :=
(mul_assoc _ _ _).trans $ by rw [units.mul_inv, mul_one]

@[simp] theorem divp_left_inj (u : αˣ) {a b : α} : a /ₚ u = b /ₚ u ↔ a = b :=
units.mul_left_inj _

theorem divp_divp_eq_divp_mul (x : α) (u₁ u₂ : αˣ) : (x /ₚ u₁) /ₚ u₂ = x /ₚ (u₂ * u₁) :=
by simp only [divp, mul_inv_rev, units.coe_mul, mul_assoc]

theorem divp_eq_iff_mul_eq {x : α} {u : αˣ} {y : α} : x /ₚ u = y ↔ y * u = x :=
u.mul_left_inj.symm.trans $ by rw [divp_mul_cancel]; exact ⟨eq.symm, eq.symm⟩

theorem divp_eq_one_iff_eq {a : α} {u : αˣ} : a /ₚ u = 1 ↔ a = u :=
(units.mul_left_inj u).symm.trans $ by rw [divp_mul_cancel, one_mul]

@[simp] theorem one_divp (u : αˣ) : 1 /ₚ u = ↑u⁻¹ :=
one_mul _

end monoid

section comm_monoid

variables [comm_monoid α]

theorem divp_eq_divp_iff {x y : α} {ux uy : αˣ} :
  x /ₚ ux = y /ₚ uy ↔ x * uy = y * ux :=
by rw [divp_eq_iff_mul_eq, mul_comm, ← divp_assoc, divp_eq_iff_mul_eq, mul_comm y ux]

theorem divp_mul_divp (x y : α) (ux uy : αˣ) :
  (x /ₚ ux) * (y /ₚ uy) = (x * y) /ₚ (ux * uy) :=
by rw [← divp_divp_eq_divp_mul, divp_assoc, mul_comm x, divp_assoc, mul_comm]

end comm_monoid

/-!
# `is_unit` predicate

In this file we define the `is_unit` predicate on a `monoid`, and
prove a few basic properties. For the bundled version see `units`. See
also `prime`, `associated`, and `irreducible` in `algebra/associated`.

-/

section is_unit

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

/-- An element `a : M` of a monoid is a unit if it has a two-sided inverse.
The actual definition says that `a` is equal to some `u : Mˣ`, where
`Mˣ` is a bundled version of `is_unit`. -/
@[to_additive "An element `a : M` of an add_monoid is an `add_unit` if it has
a two-sided additive inverse. The actual definition says that `a` is equal to some
`u : add_units M`, where `add_units M` is a bundled version of `is_add_unit`."]
def is_unit [monoid M] (a : M) : Prop := ∃ u : Mˣ, (u : M) = a

@[nontriviality, to_additive]
lemma is_unit_of_subsingleton [monoid M] [subsingleton M] (a : M) : is_unit a :=
⟨⟨a, a, subsingleton.elim _ _, subsingleton.elim _ _⟩, rfl⟩

attribute [nontriviality] is_add_unit_of_subsingleton

@[to_additive] instance [monoid M] : can_lift M Mˣ :=
{ coe := coe,
  cond := is_unit,
  prf := λ _, id }

@[to_additive] instance [monoid M] [subsingleton M] : unique Mˣ :=
{ default := 1,
  uniq := λ a, units.coe_eq_one.mp $ subsingleton.elim (a : M) 1 }

@[simp, to_additive is_add_unit_add_unit]
protected lemma units.is_unit [monoid M] (u : Mˣ) : is_unit (u : M) := ⟨u, rfl⟩

@[simp, to_additive]
theorem is_unit_one [monoid M] : is_unit (1:M) := ⟨1, rfl⟩

@[to_additive] theorem is_unit_of_mul_eq_one [comm_monoid M]
  (a b : M) (h : a * b = 1) : is_unit a :=
⟨units.mk_of_mul_eq_one a b h, rfl⟩

@[to_additive is_add_unit.exists_neg] theorem is_unit.exists_right_inv [monoid M]
  {a : M} (h : is_unit a) : ∃ b, a * b = 1 :=
by { rcases h with ⟨⟨a, b, hab, _⟩, rfl⟩, exact ⟨b, hab⟩ }

@[to_additive is_add_unit.exists_neg'] theorem is_unit.exists_left_inv [monoid M]
  {a : M} (h : is_unit a) : ∃ b, b * a = 1 :=
by { rcases h with ⟨⟨a, b, _, hba⟩, rfl⟩, exact ⟨b, hba⟩ }

@[to_additive] theorem is_unit_iff_exists_inv [comm_monoid M]
  {a : M} : is_unit a ↔ ∃ b, a * b = 1 :=
⟨λ h, h.exists_right_inv,
 λ ⟨b, hab⟩, is_unit_of_mul_eq_one _ b hab⟩

@[to_additive] theorem is_unit_iff_exists_inv' [comm_monoid M]
  {a : M} : is_unit a ↔ ∃ b, b * a = 1 :=
by simp [is_unit_iff_exists_inv, mul_comm]

@[to_additive]
lemma is_unit.mul [monoid M] {x y : M} : is_unit x → is_unit y → is_unit (x * y) :=
by { rintros ⟨x, rfl⟩ ⟨y, rfl⟩, exact ⟨x * y, units.coe_mul _ _⟩ }

/-- Multiplication by a `u : Mˣ` on the right doesn't affect `is_unit`. -/
@[simp, to_additive "Addition of a `u : add_units M` on the right doesn't
affect `is_add_unit`."]
theorem units.is_unit_mul_units [monoid M] (a : M) (u : Mˣ) :
  is_unit (a * u) ↔ is_unit a :=
iff.intro
  (assume ⟨v, hv⟩,
    have is_unit (a * ↑u * ↑u⁻¹), by existsi v * u⁻¹; rw [←hv, units.coe_mul],
    by rwa [mul_assoc, units.mul_inv, mul_one] at this)
  (λ v, v.mul u.is_unit)

/-- Multiplication by a `u : Mˣ` on the left doesn't affect `is_unit`. -/
@[simp, to_additive "Addition of a `u : add_units M` on the left doesn't affect `is_add_unit`."]
theorem units.is_unit_units_mul {M : Type*} [monoid M] (u : Mˣ) (a : M) :
  is_unit (↑u * a) ↔ is_unit a :=
iff.intro
  (assume ⟨v, hv⟩,
    have is_unit (↑u⁻¹ * (↑u * a)), by existsi u⁻¹ * v; rw [←hv, units.coe_mul],
    by rwa [←mul_assoc, units.inv_mul, one_mul] at this)
  u.is_unit.mul

@[to_additive]
theorem is_unit_of_mul_is_unit_left [comm_monoid M] {x y : M}
  (hu : is_unit (x * y)) : is_unit x :=
let ⟨z, hz⟩ := is_unit_iff_exists_inv.1 hu in
is_unit_iff_exists_inv.2 ⟨y * z, by rwa ← mul_assoc⟩

@[to_additive] theorem is_unit_of_mul_is_unit_right [comm_monoid M] {x y : M}
  (hu : is_unit (x * y)) : is_unit y :=
@is_unit_of_mul_is_unit_left _ _ y x $ by rwa mul_comm

@[simp, to_additive]
lemma is_unit.mul_iff [comm_monoid M] {x y : M} : is_unit (x * y) ↔ is_unit x ∧ is_unit y :=
⟨λ h, ⟨is_unit_of_mul_is_unit_left h, is_unit_of_mul_is_unit_right h⟩,
  λ h, is_unit.mul h.1 h.2⟩

@[to_additive] theorem is_unit.mul_right_inj [monoid M] {a b c : M} (ha : is_unit a) :
  a * b = a * c ↔ b = c :=
by cases ha with a ha; rw [←ha, units.mul_right_inj]

@[to_additive] theorem is_unit.mul_left_inj [monoid M] {a b c : M} (ha : is_unit a) :
  b * a = c * a ↔ b = c :=
by cases ha with a ha; rw [←ha, units.mul_left_inj]

/-- The element of the group of units, corresponding to an element of a monoid which is a unit. -/
@[to_additive "The element of the additive group of additive units, corresponding to an element of
an additive monoid which is an additive unit."]
noncomputable def is_unit.unit [monoid M] {a : M} (h : is_unit a) : Mˣ :=
(classical.some h).copy a (classical.some_spec h).symm _ rfl

@[to_additive]
lemma is_unit.unit_spec [monoid M] {a : M} (h : is_unit a) : ↑h.unit = a :=
rfl

@[to_additive]
lemma is_unit.coe_inv_mul [monoid M] {a : M} (h : is_unit a) :
  ↑(h.unit)⁻¹ * a = 1 :=
units.mul_inv _

@[to_additive]
lemma is_unit.mul_coe_inv [monoid M] {a : M} (h : is_unit a) :
  a * ↑(h.unit)⁻¹ = 1 :=
begin
  convert units.mul_inv _,
  simp [h.unit_spec]
end

end is_unit

section noncomputable_defs

variables {M : Type*}

/-- Constructs a `group` structure on a `monoid` consisting only of units. -/
noncomputable def group_of_is_unit [hM : monoid M] (h : ∀ (a : M), is_unit a) : group M :=
{ inv := λ a, ↑((h a).unit)⁻¹,
  mul_left_inv := λ a, by
  { change ↑((h a).unit)⁻¹ * a = 1,
    rw [units.inv_mul_eq_iff_eq_mul, (h a).unit_spec, mul_one] },
  .. hM }

/-- Constructs a `comm_group` structure on a `comm_monoid` consisting only of units. -/
noncomputable def comm_group_of_is_unit [hM : comm_monoid M] (h : ∀ (a : M), is_unit a) :
  comm_group M :=
{ inv := λ a, ↑((h a).unit)⁻¹,
  mul_left_inv := λ a, by
  { change ↑((h a).unit)⁻¹ * a = 1,
    rw [units.inv_mul_eq_iff_eq_mul, (h a).unit_spec, mul_one] },
  .. hM }

end noncomputable_defs


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.submonoid.operations
import algebra.pointwise

/-! # Pointwise instances on `submonoid`s and `add_submonoid`s

This file provides:

* `submonoid.has_inv`
* `add_submonoid.has_neg`

and the actions

* `submonoid.pointwise_mul_action`
* `add_submonoid.pointwise_mul_action`

which matches the action of `mul_action_set`.

These are all available in the `pointwise` locale.

## Implementation notes

Most of the lemmas in this file are direct copies of lemmas from `algebra/pointwise.lean`.
While the statements of these lemmas are defeq, we repeat them here due to them not being
syntactically equal. Before adding new lemmas here, consider if they would also apply to the action
on `set`s.

-/

variables {α : Type*} {M : Type*} {G : Type*} {A : Type*} [monoid M] [add_monoid A]

namespace submonoid

variables [group G]

open_locale pointwise

/-- The submonoid with every element inverted. -/
@[to_additive /-" The additive submonoid with every element negated. "-/]
protected def has_inv : has_inv (submonoid G):=
{ inv := λ S,
  { carrier := (S : set G)⁻¹,
    one_mem' := show (1 : G)⁻¹ ∈ S, by { rw one_inv, exact S.one_mem },
    mul_mem' := λ a b (ha : a⁻¹ ∈ S) (hb : b⁻¹ ∈ S), show (a * b)⁻¹ ∈ S,
      by { rw mul_inv_rev, exact S.mul_mem hb ha } } }

localized "attribute [instance] submonoid.has_inv" in pointwise
open_locale pointwise

@[simp, to_additive] lemma coe_inv (S : submonoid G) : ↑(S⁻¹) = (S : set G)⁻¹ := rfl

@[simp, to_additive] lemma mem_inv {g : G} {S : submonoid G} : g ∈ S⁻¹ ↔ g⁻¹ ∈ S := iff.rfl

@[simp, to_additive] protected lemma inv_inv (S : submonoid G) : S⁻¹⁻¹ = S :=
set_like.coe_injective set.inv_inv

@[simp, to_additive] lemma inv_le_inv (S T : submonoid G) : S⁻¹ ≤ T⁻¹ ↔ S ≤ T :=
set_like.coe_subset_coe.symm.trans set.inv_subset_inv

@[to_additive] lemma inv_le (S T : submonoid G) : S⁻¹ ≤ T ↔ S ≤ T⁻¹ :=
set_like.coe_subset_coe.symm.trans set.inv_subset

/-- `submonoid.has_inv` as an order isomorphism. -/
@[to_additive /-" `add_submonoid.has_neg` as an order isomorphism "-/, simps]
def inv_order_iso : submonoid G ≃o submonoid G :=
{ to_fun := has_inv.inv,
  inv_fun := has_inv.inv,
  left_inv := submonoid.inv_inv,
  right_inv := submonoid.inv_inv,
  map_rel_iff' := inv_le_inv }

@[to_additive] lemma closure_inv (s : set G) : closure s⁻¹ = (closure s)⁻¹ :=
begin
  apply le_antisymm,
  { rw [closure_le, coe_inv, ←set.inv_subset, set.inv_inv],
    exact subset_closure },
  { rw [inv_le, closure_le, coe_inv, ←set.inv_subset],
    exact subset_closure }
end

@[simp, to_additive]
lemma inv_inf (S T : submonoid G) : (S ⊓ T)⁻¹ = S⁻¹ ⊓ T⁻¹ :=
set_like.coe_injective set.inter_inv

@[simp, to_additive]
lemma inv_sup (S T : submonoid G) : (S ⊔ T)⁻¹ = S⁻¹ ⊔ T⁻¹ :=
(inv_order_iso : submonoid G ≃o submonoid G).map_sup S T

@[simp, to_additive]
lemma inv_bot : (⊥ : submonoid G)⁻¹ = ⊥ :=
set_like.coe_injective $ (set.inv_singleton 1).trans $ congr_arg _ one_inv

@[simp, to_additive]
lemma inv_top : (⊤ : submonoid G)⁻¹ = ⊤ :=
set_like.coe_injective $ set.inv_univ

@[simp, to_additive]
lemma inv_infi {ι : Sort*} (S : ι → submonoid G) : (⨅ i, S i)⁻¹ = ⨅ i, (S i)⁻¹ :=
(inv_order_iso : submonoid G ≃o submonoid G).map_infi _

@[simp, to_additive]
lemma inv_supr {ι : Sort*} (S : ι → submonoid G) : (⨆ i, S i)⁻¹ = ⨆ i, (S i)⁻¹ :=
(inv_order_iso : submonoid G ≃o submonoid G).map_supr _

end submonoid

namespace submonoid

section monoid
variables [monoid α] [mul_distrib_mul_action α M]

/-- The action on a submonoid corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (submonoid M) :=
{ smul := λ a S, S.map (mul_distrib_mul_action.to_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] submonoid.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : submonoid M) : ↑(a • S) = a • (S : set M) := rfl

lemma smul_mem_pointwise_smul (m : M) (a : α) (S : submonoid M) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set M))

end monoid

section group
variables [group α] [mul_distrib_mul_action α M]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : submonoid M} {x : M} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : submonoid M} {x : M} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : submonoid M} {x : M} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : submonoid M} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_subset_iff {a : α} {S T : submonoid M} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma subset_pointwise_smul_iff {a : α} {S T : submonoid M} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

end group

section group_with_zero
variables [group_with_zero α] [mul_distrib_mul_action α M]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : submonoid M)
  (x : M) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set M) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : submonoid M) (x : M) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set M) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : submonoid M} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : submonoid M} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : submonoid M} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

open_locale pointwise

@[to_additive]
lemma mem_closure_inv {G : Type*} [group G] (S : set G) (x : G) :
  x ∈ submonoid.closure S⁻¹ ↔ x⁻¹ ∈ submonoid.closure S :=
by rw [closure_inv, mem_inv]

end submonoid

namespace add_submonoid

section monoid
variables [monoid α] [distrib_mul_action α A]

/-- The action on an additive submonoid corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (add_submonoid A) :=
{ smul := λ a S, S.map (distrib_mul_action.to_add_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] add_submonoid.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : add_submonoid A) : ↑(a • S) = a • (S : set A) := rfl

lemma smul_mem_pointwise_smul (m : A) (a : α) (S : add_submonoid A) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set A))

end monoid

section group
variables [group α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : add_submonoid A} {x : A} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : add_submonoid A} {x : A} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : add_submonoid A} {x : A} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : add_submonoid A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_le_iff {a : α} {S T : add_submonoid A} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma le_pointwise_smul_iff {a : α} {S T : add_submonoid A} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

end group

section group_with_zero
variables [group_with_zero α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_submonoid A)
  (x : A) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set A) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : add_submonoid A) (x : A) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set A) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_submonoid A) (x : A) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set A) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_submonoid A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : add_submonoid A} :
  a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_submonoid A} :
  S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

open_locale pointwise

end add_submonoid


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Yury Kudryashov
-/
import algebra.algebra.basic
import linear_algebra.tensor_product
import algebra.iterate_hom

/-!
# Facts about algebras involving bilinear maps and tensor products

We move a few basic statements about algebras out of `algebra.algebra.basic`,
in order to avoid importing `linear_algebra.bilinear_map` and
`linear_algebra.tensor_product` unnecessarily.
-/

universes u v w

namespace algebra

open_locale tensor_product
open module

section

variables (R A : Type*) [comm_semiring R] [semiring A] [algebra R A]

/-- The multiplication in an algebra is a bilinear map.

A weaker version of this for semirings exists as `add_monoid_hom.mul`. -/
def lmul : A →ₐ[R] (End R A) :=
{ map_one' := by { ext a, exact one_mul a },
  map_mul' := by { intros a b, ext c, exact mul_assoc a b c },
  map_zero' := by { ext a, exact zero_mul a },
  commutes' := by { intro r, ext a, dsimp, rw [smul_def] },
  .. (show A →ₗ[R] A →ₗ[R] A, from linear_map.mk₂ R (*)
  (λ x y z, add_mul x y z)
  (λ c x y, by rw [smul_def, smul_def, mul_assoc _ x y])
  (λ x y z, mul_add x y z)
  (λ c x y, by rw [smul_def, smul_def, left_comm])) }

variables {R A}

@[simp] lemma lmul_apply (p q : A) : lmul R A p q = p * q := rfl

variables (R)

/-- The multiplication on the left in an algebra is a linear map. -/
def lmul_left (r : A) : A →ₗ[R] A :=
lmul R A r

@[simp] lemma lmul_left_to_add_monoid_hom (r : A) :
  (lmul_left R r : A →+ A) = add_monoid_hom.mul_left r :=
fun_like.coe_injective rfl

/-- The multiplication on the right in an algebra is a linear map. -/
def lmul_right (r : A) : A →ₗ[R] A :=
(lmul R A).to_linear_map.flip r

@[simp] lemma lmul_right_to_add_monoid_hom (r : A) :
  (lmul_right R r : A →+ A) = add_monoid_hom.mul_right r :=
fun_like.coe_injective rfl

/-- Simultaneous multiplication on the left and right is a linear map. -/
def lmul_left_right (vw: A × A) : A →ₗ[R] A :=
(lmul_right R vw.2).comp (lmul_left R vw.1)

lemma commute_lmul_left_right (a b : A) :
  commute (lmul_left R a) (lmul_right R b) :=
by { ext c, exact (mul_assoc a c b).symm, }

/-- The multiplication map on an algebra, as an `R`-linear map from `A ⊗[R] A` to `A`. -/
def lmul' : A ⊗[R] A →ₗ[R] A :=
tensor_product.lift (lmul R A).to_linear_map

variables {R A}

@[simp] lemma lmul'_apply {x y : A} : lmul' R (x ⊗ₜ y) = x * y :=
by simp only [algebra.lmul', tensor_product.lift.tmul, alg_hom.to_linear_map_apply, lmul_apply]

@[simp] lemma lmul_left_apply (p q : A) : lmul_left R p q = p * q := rfl
@[simp] lemma lmul_right_apply (p q : A) : lmul_right R p q = q * p := rfl
@[simp] lemma lmul_left_right_apply (vw : A × A) (p : A) :
  lmul_left_right R vw p = vw.1 * p * vw.2 := rfl

@[simp] lemma lmul_left_one : lmul_left R (1:A) = linear_map.id :=
by { ext, simp only [linear_map.id_coe, one_mul, id.def, lmul_left_apply] }

@[simp] lemma lmul_left_mul (a b : A) :
  lmul_left R (a * b) = (lmul_left R a).comp (lmul_left R b) :=
by { ext, simp only [lmul_left_apply, linear_map.comp_apply, mul_assoc] }

@[simp] lemma lmul_right_one : lmul_right R (1:A) = linear_map.id :=
by { ext, simp only [linear_map.id_coe, mul_one, id.def, lmul_right_apply] }

@[simp] lemma lmul_right_mul (a b : A) :
  lmul_right R (a * b) = (lmul_right R b).comp (lmul_right R a) :=
by { ext, simp only [lmul_right_apply, linear_map.comp_apply, mul_assoc] }

@[simp] lemma lmul_left_zero_eq_zero :
  lmul_left R (0 : A) = 0 :=
(lmul R A).map_zero

@[simp] lemma lmul_right_zero_eq_zero :
  lmul_right R (0 : A) = 0 :=
(lmul R A).to_linear_map.flip.map_zero

@[simp] lemma lmul_left_eq_zero_iff (a : A) :
  lmul_left R a = 0 ↔ a = 0 :=
begin
  split; intros h,
  { rw [← mul_one a, ← lmul_left_apply a 1, h, linear_map.zero_apply], },
  { rw h, exact lmul_left_zero_eq_zero, },
end

@[simp] lemma lmul_right_eq_zero_iff (a : A) :
  lmul_right R a = 0 ↔ a = 0 :=
begin
  split; intros h,
  { rw [← one_mul a, ← lmul_right_apply a 1, h, linear_map.zero_apply], },
  { rw h, exact lmul_right_zero_eq_zero, },
end

@[simp] lemma pow_lmul_left (a : A) (n : ℕ) :
  (lmul_left R a) ^ n = lmul_left R (a ^ n) :=
((lmul R A).map_pow a n).symm

@[simp] lemma pow_lmul_right (a : A) (n : ℕ) :
  (lmul_right R a) ^ n = lmul_right R (a ^ n) :=
linear_map.coe_injective $ ((lmul_right R a).coe_pow n).symm ▸ (mul_right_iterate a n)

end

section

variables {R A : Type*} [comm_semiring R] [ring A] [algebra R A]

lemma lmul_left_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) :
  function.injective (lmul_left R x) :=
by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› },
     exact mul_right_injective₀ hx }

lemma lmul_right_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) :
  function.injective (lmul_right R x) :=
by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› },
     exact mul_left_injective₀ hx }

lemma lmul_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) :
  function.injective (lmul R A x) :=
by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› },
     exact mul_right_injective₀ hx }

end

end algebra


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

! This file was ported from Lean 3 source module number_theory.legendre_symbol.mul_character
! leanprover-community/mathlib commit 6623e6af705e97002a9054c1c05a980180276fc1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Basic
import Mathbin.Algebra.EuclideanDomain.Instances
import Mathbin.Algebra.Group.ConjFinite

/-!
# Multiplicative characters of finite rings and fields

Let `R` and `R'` be a commutative rings.
A *multiplicative character* of `R` with values in `R'` is a morphism of
monoids from the multiplicative monoid of `R` into that of `R'`
that sends non-units to zero.

We use the namespace `mul_char` for the definitions and results.

## Main results

We show that the multiplicative characters form a group (if `R'` is commutative);
see `mul_char.comm_group`. We also provide an equivalence with the
homomorphisms `Rˣ →* R'ˣ`; see `mul_char.equiv_to_unit_hom`.

We define a multiplicative character to be *quadratic* if its values
are among `0`, `1` and `-1`, and we prove some properties of quadratic characters.

Finally, we show that the sum of all values of a nontrivial multiplicative
character vanishes; see `mul_char.is_nontrivial.sum_eq_zero`.

## Tags

multiplicative character
-/

section DefinitionAndGroup

/-!
### Definitions related to multiplicative characters

Even though the intended use is when domain and target of the characters
are commutative rings, we define them in the more general setting when
the domain is a commutative monoid and the target is a commutative monoid
with zero. (We need a zero in the target, since non-units are supposed
to map to zero.)

In this setting, there is an equivalence between multiplicative characters
`R → R'` and group homomorphisms `Rˣ → R'ˣ`, and the multiplicative characters
have a natural structure as a commutative group.
-/

universe u v

section Defi

-- The domain of our multiplicative characters
variable (R : Type u) [CommMonoid R]

-- The target
variable (R' : Type v) [CommMonoidWithZero R']

/-- Define a structure for multiplicative characters.
A multiplicative character from a commutative monoid `R` to a commutative monoid with zero `R'`
is a homomorphism of (multiplicative) monoids that sends non-units to zero. -/
structure MulChar extends MonoidHom R R' where
  map_nonunit' : ∀ a : R, ¬IsUnit a → to_fun a = 0
#align mul_char MulChar

/-- This is the corresponding extension of `monoid_hom_class`. -/
class MulCharClass (F : Type _) (R R' : outParam <| Type _) [CommMonoid R]
  [CommMonoidWithZero R'] extends MonoidHomClass F R R' where
  map_nonunit : ∀ (χ : F) {a : R} (ha : ¬IsUnit a), χ a = 0
#align mul_char_class MulCharClass

attribute [simp] MulCharClass.map_nonunit

end Defi

section Group

namespace MulChar

-- The domain of our multiplicative characters
variable {R : Type u} [CommMonoid R]

-- The target
variable {R' : Type v} [CommMonoidWithZero R']

instance coeToFun : CoeFun (MulChar R R') fun _ => R → R' :=
  ⟨fun χ => χ.toFun⟩
#align mul_char.coe_to_fun MulChar.coeToFun

/-- See note [custom simps projection] -/
protected def Simps.apply (χ : MulChar R R') : R → R' :=
  χ
#align mul_char.simps.apply MulChar.Simps.apply

initialize_simps_projections MulChar (to_monoid_hom_to_fun → apply, -toMonoidHom)

section trivial

variable (R R')

/-- The trivial multiplicative character. It takes the value `0` on non-units and
the value `1` on units. -/
@[simps]
noncomputable def trivial : MulChar R R'
    where
  toFun := by classical exact fun x => if IsUnit x then 1 else 0
  map_nonunit' := by
    intro a ha
    simp only [ha, if_false]
  map_one' := by simp only [isUnit_one, if_true]
  map_mul' := by
    intro x y
    classical
      simp only [IsUnit.mul_iff, boole_mul]
      split_ifs <;> tauto
#align mul_char.trivial MulChar.trivial

end trivial

@[simp]
theorem coe_coe (χ : MulChar R R') : (χ.toMonoidHom : R → R') = χ :=
  rfl
#align mul_char.coe_coe MulChar.coe_coe

@[simp]
theorem toFun_eq_coe (χ : MulChar R R') : χ.toFun = χ :=
  rfl
#align mul_char.to_fun_eq_coe MulChar.toFun_eq_coe

@[simp]
theorem coe_mk (f : R →* R') (hf) : (MulChar.mk f hf : R → R') = f :=
  rfl
#align mul_char.coe_mk MulChar.coe_mk

/-- Extensionality. See `ext` below for the version that will actually be used. -/
theorem ext' {χ χ' : MulChar R R'} (h : ∀ a, χ a = χ' a) : χ = χ' :=
  by
  cases χ
  cases χ'
  congr
  exact MonoidHom.ext h
#align mul_char.ext' MulChar.ext'

instance : MulCharClass (MulChar R R') R R'
    where
  coe χ := χ.toMonoidHom.toFun
  coe_injective' f g h := ext' fun a => congr_fun h a
  map_mul χ := χ.map_mul'
  map_one χ := χ.map_one'
  map_nonunit χ := χ.map_nonunit'

theorem map_nonunit (χ : MulChar R R') {a : R} (ha : ¬IsUnit a) : χ a = 0 :=
  χ.map_nonunit' a ha
#align mul_char.map_nonunit MulChar.map_nonunit

/-- Extensionality. Since `mul_char`s always take the value zero on non-units, it is sufficient
to compare the values on units. -/
@[ext]
theorem ext {χ χ' : MulChar R R'} (h : ∀ a : Rˣ, χ a = χ' a) : χ = χ' :=
  by
  apply ext'
  intro a
  by_cases ha : IsUnit a
  · exact h ha.unit
  · rw [map_nonunit χ ha, map_nonunit χ' ha]
#align mul_char.ext MulChar.ext

theorem ext_iff {χ χ' : MulChar R R'} : χ = χ' ↔ ∀ a : Rˣ, χ a = χ' a :=
  ⟨by
    rintro rfl a
    rfl, ext⟩
#align mul_char.ext_iff MulChar.ext_iff

/-!
### Equivalence of multiplicative characters with homomorphisms on units

We show that restriction / extension by zero gives an equivalence
between `mul_char R R'` and `Rˣ →* R'ˣ`.
-/

/-- Turn a `mul_char` into a homomorphism between the unit groups. -/
def toUnitHom (χ : MulChar R R') : Rˣ →* R'ˣ :=
  Units.map χ
#align mul_char.to_unit_hom MulChar.toUnitHom

theorem coe_toUnitHom (χ : MulChar R R') (a : Rˣ) : ↑(χ.toUnitHom a) = χ a :=
  rfl
#align mul_char.coe_to_unit_hom MulChar.coe_toUnitHom

/-- Turn a homomorphism between unit groups into a `mul_char`. -/
noncomputable def ofUnitHom (f : Rˣ →* R'ˣ) : MulChar R R'
    where
  toFun := by classical exact fun x => if hx : IsUnit x then f hx.Unit else 0
  map_one' := by
    have h1 : (is_unit_one.unit : Rˣ) = 1 := units.eq_iff.mp rfl
    simp only [h1, dif_pos, Units.val_eq_one, map_one, isUnit_one]
  map_mul' := by
    classical
      intro x y
      by_cases hx : IsUnit x
      · simp only [hx, IsUnit.mul_iff, true_and_iff, dif_pos]
        by_cases hy : IsUnit y
        · simp only [hy, dif_pos]
          have hm : (is_unit.mul_iff.mpr ⟨hx, hy⟩).Unit = hx.unit * hy.unit := units.eq_iff.mp rfl
          rw [hm, map_mul]
          norm_cast
        · simp only [hy, not_false_iff, dif_neg, MulZeroClass.mul_zero]
      · simp only [hx, IsUnit.mul_iff, false_and_iff, not_false_iff, dif_neg, MulZeroClass.zero_mul]
  map_nonunit' := by
    intro a ha
    simp only [ha, not_false_iff, dif_neg]
#align mul_char.of_unit_hom MulChar.ofUnitHom

theorem ofUnitHom_coe (f : Rˣ →* R'ˣ) (a : Rˣ) : of_unit_hom f ↑a = f a := by simp [of_unit_hom]
#align mul_char.of_unit_hom_coe MulChar.ofUnitHom_coe

/-- The equivalence between multiplicative characters and homomorphisms of unit groups. -/
noncomputable def equivToUnitHom : MulChar R R' ≃ (Rˣ →* R'ˣ)
    where
  toFun := to_unit_hom
  invFun := of_unit_hom
  left_inv := by
    intro χ
    ext x
    rw [of_unit_hom_coe, coe_to_unit_hom]
  right_inv := by
    intro f
    ext x
    rw [coe_to_unit_hom, of_unit_hom_coe]
#align mul_char.equiv_to_unit_hom MulChar.equivToUnitHom

@[simp]
theorem toUnitHom_eq (χ : MulChar R R') : to_unit_hom χ = equiv_to_unit_hom χ :=
  rfl
#align mul_char.to_unit_hom_eq MulChar.toUnitHom_eq

@[simp]
theorem ofUnitHom_eq (χ : Rˣ →* R'ˣ) : of_unit_hom χ = equiv_to_unit_hom.symm χ :=
  rfl
#align mul_char.of_unit_hom_eq MulChar.ofUnitHom_eq

@[simp]
theorem coe_equivToUnitHom (χ : MulChar R R') (a : Rˣ) : ↑(equiv_to_unit_hom χ a) = χ a :=
  coe_to_unit_hom χ a
#align mul_char.coe_equiv_to_unit_hom MulChar.coe_equivToUnitHom

@[simp]
theorem equiv_unit_hom_symm_coe (f : Rˣ →* R'ˣ) (a : Rˣ) : equiv_to_unit_hom.symm f ↑a = f a :=
  of_unit_hom_coe f a
#align mul_char.equiv_unit_hom_symm_coe MulChar.equiv_unit_hom_symm_coe

/-!
### Commutative group structure on multiplicative characters

The multiplicative characters `R → R'` form a commutative group.
-/

protected theorem map_one (χ : MulChar R R') : χ (1 : R) = 1 :=
  χ.map_one'
#align mul_char.map_one MulChar.map_one

/-- If the domain has a zero (and is nontrivial), then `χ 0 = 0`. -/
protected theorem map_zero {R : Type u} [CommMonoidWithZero R] [Nontrivial R] (χ : MulChar R R') :
    χ (0 : R) = 0 := by rw [map_nonunit χ not_isUnit_zero]
#align mul_char.map_zero MulChar.map_zero

/-- If the domain is a ring `R`, then `χ (ring_char R) = 0`. -/
theorem map_ringChar {R : Type u} [CommRing R] [Nontrivial R] (χ : MulChar R R') :
    χ (ringChar R) = 0 := by rw [ringChar.Nat.cast_ringChar, χ.map_zero]
#align mul_char.map_ring_char MulChar.map_ringChar

noncomputable instance hasOne : One (MulChar R R') :=
  ⟨trivial R R'⟩
#align mul_char.has_one MulChar.hasOne

noncomputable instance inhabited : Inhabited (MulChar R R') :=
  ⟨1⟩
#align mul_char.inhabited MulChar.inhabited

/-- Evaluation of the trivial character -/
@[simp]
theorem one_apply_coe (a : Rˣ) : (1 : MulChar R R') a = 1 := by classical exact dif_pos a.is_unit
#align mul_char.one_apply_coe MulChar.one_apply_coe

/-- Multiplication of multiplicative characters. (This needs the target to be commutative.) -/
def mul (χ χ' : MulChar R R') : MulChar R R' :=
  { χ.toMonoidHom * χ'.toMonoidHom with
    toFun := χ * χ'
    map_nonunit' := fun a ha => by simp [map_nonunit χ ha] }
#align mul_char.mul MulChar.mul

instance hasMul : Mul (MulChar R R') :=
  ⟨mul⟩
#align mul_char.has_mul MulChar.hasMul

theorem mul_apply (χ χ' : MulChar R R') (a : R) : (χ * χ') a = χ a * χ' a :=
  rfl
#align mul_char.mul_apply MulChar.mul_apply

@[simp]
theorem coeToFun_mul (χ χ' : MulChar R R') : ⇑(χ * χ') = χ * χ' :=
  rfl
#align mul_char.coe_to_fun_mul MulChar.coeToFun_mul

protected theorem one_mul (χ : MulChar R R') : (1 : MulChar R R') * χ = χ :=
  by
  ext
  simp
#align mul_char.one_mul MulChar.one_mul

protected theorem mul_one (χ : MulChar R R') : χ * 1 = χ :=
  by
  ext
  simp
#align mul_char.mul_one MulChar.mul_one

/-- The inverse of a multiplicative character. We define it as `inverse ∘ χ`. -/
noncomputable def inv (χ : MulChar R R') : MulChar R R' :=
  {
    MonoidWithZero.inverse.toMonoidHom.comp
      χ.toMonoidHom with
    toFun := fun a => MonoidWithZero.inverse (χ a)
    map_nonunit' := fun a ha => by simp [map_nonunit _ ha] }
#align mul_char.inv MulChar.inv

noncomputable instance hasInv : Inv (MulChar R R') :=
  ⟨inv⟩
#align mul_char.has_inv MulChar.hasInv

/-- The inverse of a multiplicative character `χ`, applied to `a`, is the inverse of `χ a`. -/
theorem inv_apply_eq_inv (χ : MulChar R R') (a : R) : χ⁻¹ a = Ring.inverse (χ a) :=
  Eq.refl <| inv χ a
#align mul_char.inv_apply_eq_inv MulChar.inv_apply_eq_inv

/-- The inverse of a multiplicative character `χ`, applied to `a`, is the inverse of `χ a`.
Variant when the target is a field -/
theorem inv_apply_eq_inv' {R' : Type v} [Field R'] (χ : MulChar R R') (a : R) : χ⁻¹ a = (χ a)⁻¹ :=
  (inv_apply_eq_inv χ a).trans <| Ring.inverse_eq_inv (χ a)
#align mul_char.inv_apply_eq_inv' MulChar.inv_apply_eq_inv'

/-- When the domain has a zero, then the inverse of a multiplicative character `χ`,
applied to `a`, is `χ` applied to the inverse of `a`. -/
theorem inv_apply {R : Type u} [CommMonoidWithZero R] (χ : MulChar R R') (a : R) :
    χ⁻¹ a = χ (Ring.inverse a) := by
  by_cases ha : IsUnit a
  · rw [inv_apply_eq_inv]
    have h := IsUnit.map χ ha
    apply_fun (· * ·) (χ a) using IsUnit.mul_right_injective h
    rw [Ring.mul_inverse_cancel _ h, ← map_mul, Ring.mul_inverse_cancel _ ha, MulChar.map_one]
  · revert ha
    nontriviality R
    intro ha
    -- `nontriviality R` by itself doesn't do it
    rw [map_nonunit _ ha, Ring.inverse_non_unit a ha, MulChar.map_zero χ]
#align mul_char.inv_apply MulChar.inv_apply

/-- When the domain has a zero, then the inverse of a multiplicative character `χ`,
applied to `a`, is `χ` applied to the inverse of `a`. -/
theorem inv_apply' {R : Type u} [Field R] (χ : MulChar R R') (a : R) : χ⁻¹ a = χ a⁻¹ :=
  (inv_apply χ a).trans <| congr_arg _ (Ring.inverse_eq_inv a)
#align mul_char.inv_apply' MulChar.inv_apply'

/-- The product of a character with its inverse is the trivial character. -/
@[simp]
theorem inv_mul (χ : MulChar R R') : χ⁻¹ * χ = 1 :=
  by
  ext x
  rw [coe_to_fun_mul, Pi.mul_apply, inv_apply_eq_inv,
    Ring.inverse_mul_cancel _ (IsUnit.map _ x.is_unit), one_apply_coe]
#align mul_char.inv_mul MulChar.inv_mul

/-- The commutative group structure on `mul_char R R'`. -/
noncomputable instance commGroup : CommGroup (MulChar R R') :=
  { one := 1
    mul := (· * ·)
    inv := Inv.inv
    mul_left_inv := inv_mul
    mul_assoc := by
      intro χ₁ χ₂ χ₃
      ext a
      simp [mul_assoc]
    mul_comm := by
      intro χ₁ χ₂
      ext a
      simp [mul_comm]
    one_mul
    mul_one }
#align mul_char.comm_group MulChar.commGroup

/-- If `a` is a unit and `n : ℕ`, then `(χ ^ n) a = (χ a) ^ n`. -/
theorem pow_apply_coe (χ : MulChar R R') (n : ℕ) (a : Rˣ) : (χ ^ n) a = χ a ^ n :=
  by
  induction' n with n ih
  · rw [pow_zero, pow_zero, one_apply_coe]
  · rw [pow_succ, pow_succ, mul_apply, ih]
#align mul_char.pow_apply_coe MulChar.pow_apply_coe

/-- If `n` is positive, then `(χ ^ n) a = (χ a) ^ n`. -/
theorem pow_apply' (χ : MulChar R R') {n : ℕ} (hn : 0 < n) (a : R) : (χ ^ n) a = χ a ^ n :=
  by
  by_cases ha : IsUnit a
  · exact pow_apply_coe χ n ha.unit
  · rw [map_nonunit (χ ^ n) ha, map_nonunit χ ha, zero_pow hn]
#align mul_char.pow_apply' MulChar.pow_apply'

end MulChar

end Group

end DefinitionAndGroup

/-!
### Properties of multiplicative characters

We introduce the properties of being nontrivial or quadratic and prove
some basic facts about them.

We now assume that domain and target are commutative rings.
-/

section Properties

namespace MulChar

universe u v w

variable {R : Type u} [CommRing R] {R' : Type v} [CommRing R'] {R'' : Type w} [CommRing R'']

/-- A multiplicative character is *nontrivial* if it takes a value `≠ 1` on a unit. -/
def IsNontrivial (χ : MulChar R R') : Prop :=
  ∃ a : Rˣ, χ a ≠ 1
#align mul_char.is_nontrivial MulChar.IsNontrivial

/-- A multiplicative character is nontrivial iff it is not the trivial character. -/
theorem isNontrivial_iff (χ : MulChar R R') : χ.IsNontrivial ↔ χ ≠ 1 := by
  simp only [is_nontrivial, Ne.def, ext_iff, not_forall, one_apply_coe]
#align mul_char.is_nontrivial_iff MulChar.isNontrivial_iff

/-- A multiplicative character is *quadratic* if it takes only the values `0`, `1`, `-1`. -/
def IsQuadratic (χ : MulChar R R') : Prop :=
  ∀ a, χ a = 0 ∨ χ a = 1 ∨ χ a = -1
#align mul_char.is_quadratic MulChar.IsQuadratic

/-- If two values of quadratic characters with target `ℤ` agree after coercion into a ring
of characteristic not `2`, then they agree in `ℤ`. -/
theorem IsQuadratic.eq_of_eq_coe {χ : MulChar R ℤ} (hχ : IsQuadratic χ) {χ' : MulChar R' ℤ}
    (hχ' : IsQuadratic χ') [Nontrivial R''] (hR'' : ringChar R'' ≠ 2) {a : R} {a' : R'}
    (h : (χ a : R'') = χ' a') : χ a = χ' a' :=
  Int.cast_injOn_of_ringChar_ne_two hR'' (hχ a) (hχ' a') h
#align mul_char.is_quadratic.eq_of_eq_coe MulChar.IsQuadratic.eq_of_eq_coe

/-- We can post-compose a multiplicative character with a ring homomorphism. -/
@[simps]
def ringHomComp (χ : MulChar R R') (f : R' →+* R'') : MulChar R R'' :=
  {
    f.toMonoidHom.comp χ.toMonoidHom with
    toFun := fun a => f (χ a)
    map_nonunit' := fun a ha => by simp only [map_nonunit χ ha, map_zero] }
#align mul_char.ring_hom_comp MulChar.ringHomComp

/-- Composition with an injective ring homomorphism preserves nontriviality. -/
theorem IsNontrivial.comp {χ : MulChar R R'} (hχ : χ.IsNontrivial) {f : R' →+* R''}
    (hf : Function.Injective f) : (χ.ringHomComp f).IsNontrivial :=
  by
  obtain ⟨a, ha⟩ := hχ
  use a
  rw [ring_hom_comp_apply, ← RingHom.map_one f]
  exact fun h => ha (hf h)
#align mul_char.is_nontrivial.comp MulChar.IsNontrivial.comp

/-- Composition with a ring homomorphism preserves the property of being a quadratic character. -/
theorem IsQuadratic.comp {χ : MulChar R R'} (hχ : χ.IsQuadratic) (f : R' →+* R'') :
    (χ.ringHomComp f).IsQuadratic := by
  intro a
  rcases hχ a with (ha | ha | ha) <;> simp [ha]
#align mul_char.is_quadratic.comp MulChar.IsQuadratic.comp

/-- The inverse of a quadratic character is itself. →  -/
theorem IsQuadratic.inv {χ : MulChar R R'} (hχ : χ.IsQuadratic) : χ⁻¹ = χ :=
  by
  ext x
  rw [inv_apply_eq_inv]
  rcases hχ x with (h₀ | h₁ | h₂)
  · rw [h₀, Ring.inverse_zero]
  · rw [h₁, Ring.inverse_one]
  · rw [h₂, (by norm_cast : (-1 : R') = (-1 : R'ˣ)), Ring.inverse_unit (-1 : R'ˣ)]
    rfl
#align mul_char.is_quadratic.inv MulChar.IsQuadratic.inv

/-- The square of a quadratic character is the trivial character. -/
theorem IsQuadratic.sq_eq_one {χ : MulChar R R'} (hχ : χ.IsQuadratic) : χ ^ 2 = 1 :=
  by
  convert mul_left_inv _
  rw [pow_two, hχ.inv]
#align mul_char.is_quadratic.sq_eq_one MulChar.IsQuadratic.sq_eq_one

/-- The `p`th power of a quadratic character is itself, when `p` is the (prime) characteristic
of the target ring. -/
theorem IsQuadratic.pow_char {χ : MulChar R R'} (hχ : χ.IsQuadratic) (p : ℕ) [hp : Fact p.Prime]
    [CharP R' p] : χ ^ p = χ := by
  ext x
  rw [pow_apply_coe]
  rcases hχ x with (hx | hx | hx) <;> rw [hx]
  · rw [zero_pow (Fact.out p.prime).Pos]
  · rw [one_pow]
  · exact CharP.neg_one_pow_char R' p
#align mul_char.is_quadratic.pow_char MulChar.IsQuadratic.pow_char

/-- The `n`th power of a quadratic character is the trivial character, when `n` is even. -/
theorem IsQuadratic.pow_even {χ : MulChar R R'} (hχ : χ.IsQuadratic) {n : ℕ} (hn : Even n) :
    χ ^ n = 1 := by
  obtain ⟨n, rfl⟩ := even_iff_two_dvd.mp hn
  rw [pow_mul, hχ.sq_eq_one, one_pow]
#align mul_char.is_quadratic.pow_even MulChar.IsQuadratic.pow_even

/-- The `n`th power of a quadratic character is itself, when `n` is odd. -/
theorem IsQuadratic.pow_odd {χ : MulChar R R'} (hχ : χ.IsQuadratic) {n : ℕ} (hn : Odd n) :
    χ ^ n = χ := by
  obtain ⟨n, rfl⟩ := hn
  rw [pow_add, pow_one, hχ.pow_even (even_two_mul _), one_mul]
#align mul_char.is_quadratic.pow_odd MulChar.IsQuadratic.pow_odd

open BigOperators

/-- The sum over all values of a nontrivial multiplicative character on a finite ring is zero
(when the target is a domain). -/
theorem IsNontrivial.sum_eq_zero [Fintype R] [IsDomain R'] {χ : MulChar R R'}
    (hχ : χ.IsNontrivial) : (∑ a, χ a) = 0 :=
  by
  rcases hχ with ⟨b, hb⟩
  refine' eq_zero_of_mul_eq_self_left hb _
  simp only [Finset.mul_sum, ← map_mul]
  exact Fintype.sum_bijective _ (Units.mulLeft_bijective b) _ _ fun x => rfl
#align mul_char.is_nontrivial.sum_eq_zero MulChar.IsNontrivial.sum_eq_zero

/-- The sum over all values of the trivial multiplicative character on a finite ring is
the cardinality of its unit group. -/
theorem sum_one_eq_card_units [Fintype R] [DecidableEq R] :
    (∑ a, (1 : MulChar R R') a) = Fintype.card Rˣ :=
  by
  calc
    (∑ a, (1 : MulChar R R') a) = ∑ a : R, if IsUnit a then 1 else 0 :=
      Finset.sum_congr rfl fun a _ => _
    _ = ((Finset.univ : Finset R).filterₓ IsUnit).card := Finset.sum_boole
    _ = (finset.univ.map ⟨(coe : Rˣ → R), Units.ext⟩).card := _
    _ = Fintype.card Rˣ := congr_arg _ (Finset.card_map _)

  · split_ifs with h h
    · exact one_apply_coe h.unit
    · exact map_nonunit _ h
  · congr
    ext a
    simp only [Finset.mem_filter, Finset.mem_univ, true_and_iff, Finset.mem_map,
      Function.Embedding.coeFn_mk, exists_true_left, IsUnit]
#align mul_char.sum_one_eq_card_units MulChar.sum_one_eq_card_units

end MulChar

end Properties


import syntax.consistency
import data.set.finite
import data.fintype.basic
import data.set.basic
open set

-- ⊢ ((¬ φ) → (¬ (K i φ)))
def n_imp_nk {agents : Type} [hN : fintype agents] {form : Type} [ft : formula form]
  [fax : formula_ax form] [kf : Kformula agents form] {φ : form} {i : agents} :
  ax ((¬' φ) →' (¬' (K' i φ))) :=
begin
  apply by_contra_ax,
  apply imp_switch,
  apply cut,
  apply kf.T,
  rw ft.notdef,
  exact likemp,
end

lemma nk_imp_nk {agents : Type} [hN : fintype agents] {form : Type} [ft : formula form]
  [fax : formula_ax form] [kf : Kformula agents form] {i : agents} {φ ψ : form} (h : ax (ψ →' φ)) :
  ax ((¬' (K' i φ)) →' (¬' (K' i ψ))) :=
begin
  apply contrapos.mpr,
  apply MP' (RN _ _ h),
  apply K,
end

lemma nnk_imp_k {agents : Type} [hN : fintype agents] {form : Type} [ft : formula form]
  [fax : formula_ax form] [kf : Kformula agents form] {i : agents} {φ : form} :
  ax ((¬' (K' i (¬' (K' i (φ))))) →' (K' i (φ))) :=
begin
  apply contrapos.mp,
  apply cut (Five _ _),
  exact dni,
end

lemma knows_conjunction {agents : Type} [hN : fintype agents] {form : Type} [ft : formula form]
  [fax : formula_ax form] [kf : Kformula agents form]
  {i : agents} {φs : list (form)} :
  ax ((finite_conjunction (list.map (K' i) φs)) →' (K' i (finite_conjunction φs))) :=
begin
induction φs,
{ apply mp,
  exact p1 _ _,
  apply RN,
  exact prtrue, },
{ apply cut,
  { apply imp_and_imp,
    exact φs_ih, },
  { exact (mp _ _ double_imp (cut2 (p6 _ _) (cut (p5 _ _)
    (cut (mp _ _ (K _ _ _) ((RN _ _ )(p4 _ _))) (K _ _ _))))), }, },
end

lemma nk_disjunction {agents : Type} [hN : fintype agents] {form : Type} [ft : formula form]
  [fax : formula_ax form] [kf : Kformula agents form]
  {i : agents} {φs : list (form)} :
  ax ((¬' (K' i (¬' (finite_disjunction φs)))) →'
    (finite_disjunction (list.map (λ φ, ¬' (K' i (¬' φ))) φs))) :=
begin
  apply cut (nk_imp_nk (iff_r demorans_fin_dis)),
  apply cut,
  apply contrapos.mpr,
  apply knows_conjunction,
  apply cut,
  apply iff_l,
  apply demorans_fin_con,
  have heq : list.map ¬' (list.map (K' i) (list.map ¬' φs)) =
    list.map (λ (φ : form), ¬' (K' i (¬' φ))) φs, from by simp,
  rw heq,
  exact iden,
end

lemma everyone_empty {agents : Type} [hN : fintype agents] {form : Type} [ft : formula form]
  [fax : formula_ax form] [kf : Kformula agents form] {φ : form} :
  ax (E' ∅ φ) :=
begin
  rw kf.edef,
  simp,
  exact prtrue,
end

lemma everyone_knows_pr {agents : Type} [hN : fintype agents] {form : Type} [ft : formula form]
  [fax : formula_ax form] [kf : Kformula agents form] {φ : form} {G : set (agents)} (h : ax φ) :
  ax (E' G φ) :=
begin
  rw kf.edef,
  apply finite_conj_forall_iff.mp,
  simp,
  intros i hi,
  apply RN,
  exact h,
end

lemma everyone_knows_imp_knows {agents : Type} [hN : fintype agents] {form : Type} [ft : formula form]
  [fax : formula_ax form] [kf : Kformula agents form] {φ : form} {G : set (agents)} {i : agents} (hi : i ∈ G) :
  ax ((E' G φ) →' (K' i φ)) :=
begin
  rw kf.edef,
  apply finite_conj_imp,
  simp,
  apply exists.intro i,
  exact and.intro hi rfl,
end

lemma K_everyone {agents : Type} [hN : fintype agents] {form : Type} [ft : formula form]
  [fax : formula_ax form] [kf : Kformula agents form] {φ ψ : form} {G : set (agents)} :
  ax ((E' G (φ →' ψ)) →' ((E' G φ) →' (E' G ψ))) :=
begin
  rw kf.edef,
  apply imp_switch,
  simp,
  induction (finset.to_list (finite.to_finset (finite.of_fintype G))),
  { simp,
    exact prtrue, },
  { simp,
    apply imp_and_and_and_imp,
    apply and_ax _ ih,
    apply cut2,
    apply K,
    exact likemp, },
end