/-
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.module.basic
import algebra.ring.aut
import algebra.ring.ulift
import algebra.module.ulift
import linear_algebra.span
import tactic.abel

/-!
# Algebras over commutative semirings

In this file we define associative unital `algebra`s over commutative (semi)rings, algebra
homomorphisms `alg_hom`, and algebra equivalences `alg_equiv`.

`subalgebra`s are defined in `algebra.algebra.subalgebra`.

For the category of `R`-algebras, denoted `Algebra R`, see the file
`algebra/category/Algebra/basic.lean`.

See the implementation notes for remarks about non-associative and non-unital algebras.

## Main definitions:

* `algebra R A`: the algebra typeclass.
* `alg_hom R A B`: the type of `R`-algebra morphisms from `A` to `B`.
* `alg_equiv R A B`: the type of `R`-algebra isomorphisms between `A` to `B`.
* `algebra_map R A : R →+* A`: the canonical map from `R` to `A`, as a `ring_hom`. This is the
  preferred spelling of this map.
* `algebra.linear_map R A : R →ₗ[R] A`: the canonical map from `R` to `A`, as a `linear_map`.
* `algebra.of_id R A : R →ₐ[R] A`: the canonical map from `R` to `A`, as n `alg_hom`.
* Instances of `algebra` in this file:
  * `algebra.id`
  * `pi.algebra`
  * `prod.algebra`
  * `algebra_nat`
  * `algebra_int`
  * `algebra_rat`
  * `mul_opposite.algebra`
  * `module.End.algebra`

## Notations

* `A →ₐ[R] B` : `R`-algebra homomorphism from `A` to `B`.
* `A ≃ₐ[R] B` : `R`-algebra equivalence from `A` to `B`.

## Implementation notes

Given a commutative (semi)ring `R`, there are two ways to define an `R`-algebra structure on a
(possibly noncommutative) (semi)ring `A`:
* By endowing `A` with a morphism of rings `R →+* A` denoted `algebra_map R A` which lands in the
  center of `A`.
* By requiring `A` be an `R`-module such that the action associates and commutes with multiplication
  as `r • (a₁ * a₂) = (r • a₁) * a₂ = a₁ * (r • a₂)`.

We define `algebra R A` in a way that subsumes both definitions, by extending `has_scalar R A` and
requiring that this scalar action `r • x` must agree with left multiplication by the image of the
structure morphism `algebra_map R A r * x`.

As a result, there are two ways to talk about an `R`-algebra `A` when `A` is a semiring:
1. ```lean
   variables [comm_semiring R] [semiring A]
   variables [algebra R A]
   ```
2. ```lean
   variables [comm_semiring R] [semiring A]
   variables [module R A] [smul_comm_class R A A] [is_scalar_tower R A A]
   ```

The first approach implies the second via typeclass search; so any lemma stated with the second set
of arguments will automatically apply to the first set. Typeclass search does not know that the
second approach implies the first, but this can be shown with:
```lean
example {R A : Type*} [comm_semiring R] [semiring A]
  [module R A] [smul_comm_class R A A] [is_scalar_tower R A A] : algebra R A :=
algebra.of_module smul_mul_assoc mul_smul_comm
```

The advantage of the first approach is that `algebra_map R A` is available, and `alg_hom R A B` and
`subalgebra R A` can be used. For concrete `R` and `A`, `algebra_map R A` is often definitionally
convenient.

The advantage of the second approach is that `comm_semiring R`, `semiring A`, and `module R A` can
all be relaxed independently; for instance, this allows us to:
* Replace `semiring A` with `non_unital_non_assoc_semiring A` in order to describe non-unital and/or
  non-associative algebras.
* Replace `comm_semiring R` and `module R A` with `comm_group R'` and `distrib_mul_action R' A`,
  which when `R' = Rˣ` lets us talk about the "algebra-like" action of `Rˣ` on an
  `R`-algebra `A`.

While `alg_hom R A B` cannot be used in the second approach, `non_unital_alg_hom R A B` still can.

You should always use the first approach when working with associative unital algebras, and mimic
the second approach only when you need to weaken a condition on either `R` or `A`.

-/

universes u v w u₁ v₁

open_locale big_operators

section prio
-- We set this priority to 0 later in this file
set_option extends_priority 200 /- control priority of
`instance [algebra R A] : has_scalar R A` -/

/--
An associative unital `R`-algebra is a semiring `A` equipped with a map into its center `R → A`.

See the implementation notes in this file for discussion of the details of this definition.
-/
@[nolint has_inhabited_instance]
class algebra (R : Type u) (A : Type v) [comm_semiring R] [semiring A]
  extends has_scalar R A, R →+* A :=
(commutes' : ∀ r x, to_fun r * x = x * to_fun r)
(smul_def' : ∀ r x, r • x = to_fun r * x)
end prio

/-- Embedding `R →+* A` given by `algebra` structure. -/
def algebra_map (R : Type u) (A : Type v) [comm_semiring R] [semiring A] [algebra R A] : R →+* A :=
algebra.to_ring_hom

/-- Creating an algebra from a morphism to the center of a semiring. -/
def ring_hom.to_algebra' {R S} [comm_semiring R] [semiring S] (i : R →+* S)
  (h : ∀ c x, i c * x = x * i c) :
  algebra R S :=
{ smul := λ c x, i c * x,
  commutes' := h,
  smul_def' := λ c x, rfl,
  to_ring_hom := i}

/-- Creating an algebra from a morphism to a commutative semiring. -/
def ring_hom.to_algebra {R S} [comm_semiring R] [comm_semiring S] (i : R →+* S) :
  algebra R S :=
i.to_algebra' $ λ _, mul_comm _

lemma ring_hom.algebra_map_to_algebra {R S} [comm_semiring R] [comm_semiring S]
  (i : R →+* S) :
  @algebra_map R S _ _ i.to_algebra = i :=
rfl

namespace algebra

variables {R : Type u} {S : Type v} {A : Type w} {B : Type*}

/-- Let `R` be a commutative semiring, let `A` be a semiring with a `module R` structure.
If `(r • 1) * x = x * (r • 1) = r • x` for all `r : R` and `x : A`, then `A` is an `algebra`
over `R`.

See note [reducible non-instances]. -/
@[reducible]
def of_module' [comm_semiring R] [semiring A] [module R A]
  (h₁ : ∀ (r : R) (x : A), (r • 1) * x = r • x)
  (h₂ : ∀ (r : R) (x : A), x * (r • 1) = r • x) : algebra R A :=
{ to_fun := λ r, r • 1,
  map_one' := one_smul _ _,
  map_mul' := λ r₁ r₂, by rw [h₁, mul_smul],
  map_zero' := zero_smul _ _,
  map_add' := λ r₁ r₂, add_smul r₁ r₂ 1,
  commutes' := λ r x, by simp only [h₁, h₂],
  smul_def' := λ r x, by simp only [h₁] }

/-- Let `R` be a commutative semiring, let `A` be a semiring with a `module R` structure.
If `(r • x) * y = x * (r • y) = r • (x * y)` for all `r : R` and `x y : A`, then `A`
is an `algebra` over `R`.

See note [reducible non-instances]. -/
@[reducible]
def of_module [comm_semiring R] [semiring A] [module R A]
  (h₁ : ∀ (r : R) (x y : A), (r • x) * y = r • (x * y))
  (h₂ : ∀ (r : R) (x y : A), x * (r • y) = r • (x * y)) : algebra R A :=
of_module' (λ r x, by rw [h₁, one_mul]) (λ r x, by rw [h₂, mul_one])

section semiring

variables [comm_semiring R] [comm_semiring S]
variables [semiring A] [algebra R A] [semiring B] [algebra R B]

/-- We keep this lemma private because it picks up the `algebra.to_has_scalar` instance
which we set to priority 0 shortly. See `smul_def` below for the public version. -/
private lemma smul_def'' (r : R) (x : A) : r • x = algebra_map R A r * x :=
algebra.smul_def' r x

/--
To prove two algebra structures on a fixed `[comm_semiring R] [semiring A]` agree,
it suffices to check the `algebra_map`s agree.
-/
-- We'll later use this to show `algebra ℤ M` is a subsingleton.
@[ext]
lemma algebra_ext {R : Type*} [comm_semiring R] {A : Type*} [semiring A] (P Q : algebra R A)
  (w : ∀ (r : R), by { haveI := P, exact algebra_map R A r } =
    by { haveI := Q, exact algebra_map R A r }) :
  P = Q :=
begin
  unfreezingI { rcases P with ⟨⟨P⟩⟩, rcases Q with ⟨⟨Q⟩⟩ },
  congr,
  { funext r a,
    replace w := congr_arg (λ s, s * a) (w r),
    simp only [←smul_def''] at w,
    apply w, },
  { ext r,
    exact w r, },
  { apply proof_irrel_heq, },
  { apply proof_irrel_heq, },
end

@[priority 200] -- see Note [lower instance priority]
instance to_module : module R A :=
{ one_smul := by simp [smul_def''],
  mul_smul := by simp [smul_def'', mul_assoc],
  smul_add := by simp [smul_def'', mul_add],
  smul_zero := by simp [smul_def''],
  add_smul := by simp [smul_def'', add_mul],
  zero_smul := by simp [smul_def''] }

-- From now on, we don't want to use the following instance anymore.
-- Unfortunately, leaving it in place causes deterministic timeouts later in mathlib.
attribute [instance, priority 0] algebra.to_has_scalar

lemma smul_def (r : R) (x : A) : r • x = algebra_map R A r * x :=
algebra.smul_def' r x

lemma algebra_map_eq_smul_one (r : R) : algebra_map R A r = r • 1 :=
calc algebra_map R A r = algebra_map R A r * 1 : (mul_one _).symm
                   ... = r • 1                 : (algebra.smul_def r 1).symm

lemma algebra_map_eq_smul_one' : ⇑(algebra_map R A) = λ r, r • (1 : A) :=
funext algebra_map_eq_smul_one

/-- `mul_comm` for `algebra`s when one element is from the base ring. -/
theorem commutes (r : R) (x : A) : algebra_map R A r * x = x * algebra_map R A r :=
algebra.commutes' r x

/-- `mul_left_comm` for `algebra`s when one element is from the base ring. -/
theorem left_comm (x : A) (r : R) (y : A) :
  x * (algebra_map R A r * y) = algebra_map R A r * (x * y) :=
by rw [← mul_assoc, ← commutes, mul_assoc]

/-- `mul_right_comm` for `algebra`s when one element is from the base ring. -/
theorem right_comm (x : A) (r : R) (y : A) :
  (x * algebra_map R A r) * y = (x * y) * algebra_map R A r :=
by rw [mul_assoc, commutes, ←mul_assoc]

instance _root_.is_scalar_tower.right : is_scalar_tower R A A :=
⟨λ x y z, by rw [smul_eq_mul, smul_eq_mul, smul_def, smul_def, mul_assoc]⟩

/-- This is just a special case of the global `mul_smul_comm` lemma that requires less typeclass
search (and was here first). -/
@[simp] protected lemma mul_smul_comm (s : R) (x y : A) :
  x * (s • y) = s • (x * y) :=
-- TODO: set up `is_scalar_tower.smul_comm_class` earlier so that we can actually prove this using
-- `mul_smul_comm s x y`.
by rw [smul_def, smul_def, left_comm]

/-- This is just a special case of the global `smul_mul_assoc` lemma that requires less typeclass
search (and was here first). -/
@[simp] protected lemma smul_mul_assoc (r : R) (x y : A) :
  (r • x) * y = r • (x * y) :=
smul_mul_assoc r x y

section
variables {r : R} {a : A}

@[simp] lemma bit0_smul_one : bit0 r • (1 : A) = bit0 (r • (1 : A)) :=
by simp [bit0, add_smul]
lemma bit0_smul_one' : bit0 r • (1 : A) = r • 2 :=
by simp [bit0, add_smul, smul_add]
@[simp] lemma bit0_smul_bit0 : bit0 r • bit0 a = r • (bit0 (bit0 a)) :=
by simp [bit0, add_smul, smul_add]
@[simp] lemma bit0_smul_bit1 : bit0 r • bit1 a = r • (bit0 (bit1 a)) :=
by simp [bit0, add_smul, smul_add]
@[simp] lemma bit1_smul_one : bit1 r • (1 : A) = bit1 (r • (1 : A)) :=
by simp [bit1, add_smul]

end

variables (R A)

/--
The canonical ring homomorphism `algebra_map R A : R →* A` for any `R`-algebra `A`,
packaged as an `R`-linear map.
-/
protected def linear_map : R →ₗ[R] A :=
{ map_smul' := λ x y, by simp [algebra.smul_def],
  ..algebra_map R A }

@[simp]
lemma linear_map_apply (r : R) : algebra.linear_map R A r = algebra_map R A r := rfl

lemma coe_linear_map : ⇑(algebra.linear_map R A) = algebra_map R A := rfl

instance id : algebra R R := (ring_hom.id R).to_algebra

variables {R A}

namespace id

@[simp] lemma map_eq_id : algebra_map R R = ring_hom.id _ := rfl

lemma map_eq_self (x : R) : algebra_map R R x = x := rfl

@[simp] lemma smul_eq_mul (x y : R) : x • y = x * y := rfl

end id

section punit

instance _root_.punit.algebra : algebra R punit :=
{ to_fun := λ x, punit.star,
  map_one' := rfl,
  map_mul' := λ _ _, rfl,
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  commutes' := λ _ _, rfl,
  smul_def' := λ _ _, rfl }

@[simp] lemma algebra_map_punit (r : R) : algebra_map R punit r = punit.star := rfl

end punit

section ulift

instance _root_.ulift.algebra : algebra R (ulift A) :=
{ to_fun := λ r, ulift.up (algebra_map R A r),
  commutes' := λ r x, ulift.down_injective $ algebra.commutes r x.down,
  smul_def' := λ r x, ulift.down_injective $ algebra.smul_def' r x.down,
  .. ulift.module',
  .. (ulift.ring_equiv : ulift A ≃+* A).symm.to_ring_hom.comp (algebra_map R A) }

lemma _root_.ulift.algebra_map_eq (r : R) :
  algebra_map R (ulift A) r = ulift.up (algebra_map R A r) := rfl

@[simp] lemma _root_.ulift.down_algebra_map (r : R) :
  (algebra_map R (ulift A) r).down = algebra_map R A r := rfl

end ulift

section prod
variables (R A B)

instance _root_.prod.algebra : algebra R (A × B) :=
{ commutes' := by { rintro r ⟨a, b⟩, dsimp, rw [commutes r a, commutes r b] },
  smul_def' := by { rintro r ⟨a, b⟩, dsimp, rw [smul_def r a, smul_def r b] },
  .. prod.module,
  .. ring_hom.prod (algebra_map R A) (algebra_map R B) }

variables {R A B}

@[simp] lemma algebra_map_prod_apply (r : R) :
  algebra_map R (A × B) r = (algebra_map R A r, algebra_map R B r) := rfl

end prod

/-- Algebra over a subsemiring. This builds upon `subsemiring.module`. -/
instance of_subsemiring (S : subsemiring R) : algebra S A :=
{ smul := (•),
  commutes' := λ r x, algebra.commutes r x,
  smul_def' := λ r x, algebra.smul_def r x,
  .. (algebra_map R A).comp S.subtype }

lemma algebra_map_of_subsemiring (S : subsemiring R) :
  (algebra_map S R : S →+* R) = subsemiring.subtype S := rfl

lemma coe_algebra_map_of_subsemiring (S : subsemiring R) :
  (algebra_map S R : S → R) = subtype.val := rfl

lemma algebra_map_of_subsemiring_apply (S : subsemiring R) (x : S) :
  algebra_map S R x = x := rfl

/-- Algebra over a subring. This builds upon `subring.module`. -/
instance of_subring {R A : Type*} [comm_ring R] [ring A] [algebra R A]
  (S : subring R) : algebra S A :=
{ smul := (•),
  .. algebra.of_subsemiring S.to_subsemiring,
  .. (algebra_map R A).comp S.subtype }

lemma algebra_map_of_subring {R : Type*} [comm_ring R] (S : subring R) :
  (algebra_map S R : S →+* R) = subring.subtype S := rfl

lemma coe_algebra_map_of_subring {R : Type*} [comm_ring R] (S : subring R) :
  (algebra_map S R : S → R) = subtype.val := rfl

lemma algebra_map_of_subring_apply {R : Type*} [comm_ring R] (S : subring R) (x : S) :
  algebra_map S R x = x := rfl

/-- Explicit characterization of the submonoid map in the case of an algebra.
`S` is made explicit to help with type inference -/
def algebra_map_submonoid (S : Type*) [semiring S] [algebra R S]
  (M : submonoid R) : (submonoid S) :=
submonoid.map (algebra_map R S : R →* S) M

lemma mem_algebra_map_submonoid_of_mem {S : Type*} [semiring S] [algebra R S] {M : submonoid R}
  (x : M) : (algebra_map R S x) ∈ algebra_map_submonoid S M :=
set.mem_image_of_mem (algebra_map R S) x.2

end semiring

section comm_semiring

variables [comm_semiring R]

lemma mul_sub_algebra_map_commutes [ring A] [algebra R A] (x : A) (r : R) :
  x * (x - algebra_map R A r) = (x - algebra_map R A r) * x :=
by rw [mul_sub, ←commutes, sub_mul]

lemma mul_sub_algebra_map_pow_commutes [ring A] [algebra R A] (x : A) (r : R) (n : ℕ) :
  x * (x - algebra_map R A r) ^ n = (x - algebra_map R A r) ^ n * x :=
begin
  induction n with n ih,
  { simp },
  { rw [pow_succ, ←mul_assoc, mul_sub_algebra_map_commutes, mul_assoc, ih, ←mul_assoc] }
end

end comm_semiring

section ring
variables [comm_ring R]

variables (R)

/-- A `semiring` that is an `algebra` over a commutative ring carries a natural `ring` structure.
See note [reducible non-instances]. -/
@[reducible]
def semiring_to_ring [semiring A] [algebra R A] : ring A :=
{ ..module.add_comm_monoid_to_add_comm_group R,
  ..(infer_instance : semiring A) }

end ring

end algebra

namespace mul_opposite

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

instance : algebra R Aᵐᵒᵖ :=
{ to_ring_hom := (algebra_map R A).to_opposite $ λ x y, algebra.commutes _ _,
  smul_def' := λ c x, unop_injective $
    by { dsimp, simp only [op_mul, algebra.smul_def, algebra.commutes, op_unop] },
  commutes' := λ r, mul_opposite.rec $ λ x, by dsimp; simp only [← op_mul, algebra.commutes],
  .. mul_opposite.has_scalar A R }

@[simp] lemma algebra_map_apply (c : R) : algebra_map R Aᵐᵒᵖ c = op (algebra_map R A c) := rfl

end mul_opposite

namespace module
variables (R : Type u) (M : Type v) [comm_semiring R] [add_comm_monoid M] [module R M]

instance : algebra R (module.End R M) :=
algebra.of_module smul_mul_assoc (λ r f g, (smul_comm r f g).symm)

lemma algebra_map_End_eq_smul_id (a : R) :
  (algebra_map R (End R M)) a = a • linear_map.id := rfl

@[simp] lemma algebra_map_End_apply (a : R) (m : M) :
  (algebra_map R (End R M)) a m = a • m := rfl

@[simp] lemma ker_algebra_map_End (K : Type u) (V : Type v)
  [field K] [add_comm_group V] [module K V] (a : K) (ha : a ≠ 0) :
  ((algebra_map K (End K V)) a).ker = ⊥ :=
linear_map.ker_smul _ _ ha

end module

set_option old_structure_cmd true
/-- Defining the homomorphism in the category R-Alg. -/
@[nolint has_inhabited_instance]
structure alg_hom (R : Type u) (A : Type v) (B : Type w)
  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] extends ring_hom A B :=
(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r)

run_cmd tactic.add_doc_string `alg_hom.to_ring_hom "Reinterpret an `alg_hom` as a `ring_hom`"

infixr ` →ₐ `:25 := alg_hom _
notation A ` →ₐ[`:25 R `] ` B := alg_hom R A B

/-- `alg_hom_class F R A B` asserts `F` is a type of bundled algebra homomorphisms
from `A` to `B`.  -/
class alg_hom_class (F : Type*) (R : out_param Type*) (A : out_param Type*) (B : out_param Type*)
  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
  extends ring_hom_class F A B :=
(commutes : ∀ (f : F) (r : R), f (algebra_map R A r) = algebra_map R B r)

-- `R` becomes a metavariable but that's fine because it's an `out_param`
attribute [nolint dangerous_instance] alg_hom_class.to_ring_hom_class

attribute [simp] alg_hom_class.commutes

namespace alg_hom_class

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

@[priority 100] -- see Note [lower instance priority]
instance {F : Type*} [alg_hom_class F R A B] : linear_map_class F R A B :=
{ map_smulₛₗ := λ f r x, by simp only [algebra.smul_def, map_mul, commutes, ring_hom.id_apply],
  ..‹alg_hom_class F R A B› }

end alg_hom_class

namespace alg_hom

variables {R : Type u} {A : Type v} {B : Type w} {C : Type u₁} {D : Type v₁}

section semiring

variables [comm_semiring R] [semiring A] [semiring B] [semiring C] [semiring D]
variables [algebra R A] [algebra R B] [algebra R C] [algebra R D]

instance : has_coe_to_fun (A →ₐ[R] B) (λ _, A → B) := ⟨alg_hom.to_fun⟩

initialize_simps_projections alg_hom (to_fun → apply)

@[simp] lemma to_fun_eq_coe (f : A →ₐ[R] B) : f.to_fun = f := rfl

instance : alg_hom_class (A →ₐ[R] B) R A B :=
{ coe := to_fun,
  coe_injective' := λ f g h, by { cases f, cases g, congr' },
  map_add := map_add',
  map_zero := map_zero',
  map_mul := map_mul',
  map_one := map_one',
  commutes := λ f, f.commutes' }

instance coe_ring_hom : has_coe (A →ₐ[R] B) (A →+* B) := ⟨alg_hom.to_ring_hom⟩

instance coe_monoid_hom : has_coe (A →ₐ[R] B) (A →* B) := ⟨λ f, ↑(f : A →+* B)⟩

instance coe_add_monoid_hom : has_coe (A →ₐ[R] B) (A →+ B) := ⟨λ f, ↑(f : A →+* B)⟩

@[simp, norm_cast] lemma coe_mk {f : A → B} (h₁ h₂ h₃ h₄ h₅) :
  ⇑(⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := rfl

-- make the coercion the simp-normal form
@[simp] lemma to_ring_hom_eq_coe (f : A →ₐ[R] B) : f.to_ring_hom = f := rfl

@[simp, norm_cast] lemma coe_to_ring_hom (f : A →ₐ[R] B) : ⇑(f : A →+* B) = f := rfl

@[simp, norm_cast] lemma coe_to_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →* B) = f := rfl

@[simp, norm_cast] lemma coe_to_add_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →+ B) = f := rfl

variables (φ : A →ₐ[R] B)

theorem coe_fn_injective : @function.injective (A →ₐ[R] B) (A → B) coe_fn := fun_like.coe_injective

theorem coe_fn_inj {φ₁ φ₂ : A →ₐ[R] B} : (φ₁ : A → B) = φ₂ ↔ φ₁ = φ₂ := fun_like.coe_fn_eq

theorem coe_ring_hom_injective : function.injective (coe : (A →ₐ[R] B) → (A →+* B)) :=
λ φ₁ φ₂ H, coe_fn_injective $ show ((φ₁ : (A →+* B)) : A → B) = ((φ₂ : (A →+* B)) : A → B),
  from congr_arg _ H

theorem coe_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B)  → (A →* B)) :=
ring_hom.coe_monoid_hom_injective.comp coe_ring_hom_injective

theorem coe_add_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B)  → (A →+ B)) :=
ring_hom.coe_add_monoid_hom_injective.comp coe_ring_hom_injective

protected lemma congr_fun {φ₁ φ₂ : A →ₐ[R] B} (H : φ₁ = φ₂) (x : A) : φ₁ x = φ₂ x :=
fun_like.congr_fun H x
protected lemma congr_arg (φ : A →ₐ[R] B) {x y : A} (h : x = y) : φ x = φ y :=
fun_like.congr_arg φ h

@[ext]
theorem ext {φ₁ φ₂ : A →ₐ[R] B} (H : ∀ x, φ₁ x = φ₂ x) : φ₁ = φ₂ := fun_like.ext _ _ H

theorem ext_iff {φ₁ φ₂ : A →ₐ[R] B} : φ₁ = φ₂ ↔ ∀ x, φ₁ x = φ₂ x := fun_like.ext_iff

@[simp] theorem mk_coe {f : A →ₐ[R] B} (h₁ h₂ h₃ h₄ h₅) :
  (⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := ext $ λ _, rfl

@[simp]
theorem commutes (r : R) : φ (algebra_map R A r) = algebra_map R B r := φ.commutes' r

theorem comp_algebra_map : (φ : A →+* B).comp (algebra_map R A) = algebra_map R B :=
ring_hom.ext $ φ.commutes

protected lemma map_add (r s : A) : φ (r + s) = φ r + φ s := map_add _ _ _
protected lemma map_zero : φ 0 = 0 := map_zero _
protected lemma map_mul (x y) : φ (x * y) = φ x * φ y := map_mul _ _ _
protected lemma map_one : φ 1 = 1 := map_one _
protected lemma map_pow (x : A) (n : ℕ) : φ (x ^ n) = (φ x) ^ n := map_pow _ _ _

@[simp] protected lemma map_smul (r : R) (x : A) : φ (r • x) = r • φ x := map_smul _ _ _

protected lemma map_sum {ι : Type*} (f : ι → A) (s : finset ι) :
  φ (∑ x in s, f x) = ∑ x in s, φ (f x) := map_sum _ _ _

protected lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) :
  φ (f.sum g) = f.sum (λ i a, φ (g i a)) := map_finsupp_sum _ _ _

protected lemma map_bit0 (x) : φ (bit0 x) = bit0 (φ x) := map_bit0 _ _
protected lemma map_bit1 (x) : φ (bit1 x) = bit1 (φ x) := map_bit1 _ _

/-- If a `ring_hom` is `R`-linear, then it is an `alg_hom`. -/
def mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : A →ₐ[R] B :=
{ to_fun := f,
  commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, h, f.map_one],
  .. f }

@[simp] lemma coe_mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : ⇑(mk' f h) = f := rfl

section

variables (R A)
/-- Identity map as an `alg_hom`. -/
protected def id : A →ₐ[R] A :=
{ commutes' := λ _, rfl,
  ..ring_hom.id A }

@[simp] lemma coe_id : ⇑(alg_hom.id R A) = id := rfl

@[simp] lemma id_to_ring_hom : (alg_hom.id R A : A →+* A) = ring_hom.id _ := rfl

end

lemma id_apply (p : A) : alg_hom.id R A p = p := rfl

/-- Composition of algebra homeomorphisms. -/
def comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : A →ₐ[R] C :=
{ commutes' := λ r : R, by rw [← φ₁.commutes, ← φ₂.commutes]; refl,
  .. φ₁.to_ring_hom.comp ↑φ₂ }

@[simp] lemma coe_comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : ⇑(φ₁.comp φ₂) = φ₁ ∘ φ₂ := rfl

lemma comp_apply (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) (p : A) : φ₁.comp φ₂ p = φ₁ (φ₂ p) := rfl

lemma comp_to_ring_hom (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) :
  ⇑(φ₁.comp φ₂ : A →+* C) = (φ₁ : B →+* C).comp ↑φ₂ := rfl

@[simp] theorem comp_id : φ.comp (alg_hom.id R A) = φ :=
ext $ λ x, rfl

@[simp] theorem id_comp : (alg_hom.id R B).comp φ = φ :=
ext $ λ x, rfl

theorem comp_assoc (φ₁ : C →ₐ[R] D) (φ₂ : B →ₐ[R] C) (φ₃ : A →ₐ[R] B) :
  (φ₁.comp φ₂).comp φ₃ = φ₁.comp (φ₂.comp φ₃) :=
ext $ λ x, rfl

/-- R-Alg ⥤ R-Mod -/
def to_linear_map : A →ₗ[R] B :=
{ to_fun := φ,
  map_add' := map_add _,
  map_smul' := map_smul _ }

@[simp] lemma to_linear_map_apply (p : A) : φ.to_linear_map p = φ p := rfl

theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A →ₗ[R] B)) :=
λ φ₁ φ₂ h, ext $ linear_map.congr_fun h

@[simp] lemma comp_to_linear_map (f : A →ₐ[R] B) (g : B →ₐ[R] C) :
  (g.comp f).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl

@[simp] lemma to_linear_map_id : to_linear_map (alg_hom.id R A) = linear_map.id :=
linear_map.ext $ λ _, rfl

/-- Promote a `linear_map` to an `alg_hom` by supplying proofs about the behavior on `1` and `*`. -/
@[simps]
def of_linear_map (f : A →ₗ[R] B) (map_one : f 1 = 1) (map_mul : ∀ x y, f (x * y) = f x * f y) :
  A →ₐ[R] B :=
{ to_fun := f,
  map_one' := map_one,
  map_mul' := map_mul,
  commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, f.map_smul, map_one],
  .. f.to_add_monoid_hom }

@[simp] lemma of_linear_map_to_linear_map (map_one) (map_mul) :
  of_linear_map φ.to_linear_map map_one map_mul = φ :=
by { ext, refl }

@[simp] lemma to_linear_map_of_linear_map (f : A →ₗ[R] B) (map_one) (map_mul) :
  to_linear_map (of_linear_map f map_one map_mul) = f :=
by { ext, refl }

@[simp] lemma of_linear_map_id (map_one) (map_mul) :
  of_linear_map linear_map.id map_one map_mul = alg_hom.id R A :=
ext $ λ _, rfl

lemma map_smul_of_tower {R'} [has_scalar R' A] [has_scalar R' B]
  [linear_map.compatible_smul A B R' R] (r : R') (x : A) : φ (r • x) = r • φ x :=
φ.to_linear_map.map_smul_of_tower r x

lemma map_list_prod (s : list A) :
  φ s.prod = (s.map φ).prod :=
φ.to_ring_hom.map_list_prod s

section prod

/-- First projection as `alg_hom`. -/
def fst : A × B →ₐ[R] A :=
{ commutes' := λ r, rfl, .. ring_hom.fst A B}

/-- Second projection as `alg_hom`. -/
def snd : A × B →ₐ[R] B :=
{ commutes' := λ r, rfl, .. ring_hom.snd A B}

end prod

lemma algebra_map_eq_apply (f : A →ₐ[R] B) {y : R} {x : A} (h : algebra_map R A y = x) :
  algebra_map R B y = f x :=
h ▸ (f.commutes _).symm

end semiring

section comm_semiring

variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B)

protected lemma map_multiset_prod (s : multiset A) :
  φ s.prod = (s.map φ).prod := map_multiset_prod _ _

protected lemma map_prod {ι : Type*} (f : ι → A) (s : finset ι) :
  φ (∏ x in s, f x) = ∏ x in s, φ (f x) := map_prod _ _ _

protected lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) :
  φ (f.prod g) = f.prod (λ i a, φ (g i a)) := map_finsupp_prod _ _ _

end comm_semiring

section ring

variables [comm_semiring R] [ring A] [ring B]
variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B)

protected lemma map_neg (x) : φ (-x) = -φ x := map_neg _ _
protected lemma map_sub (x y) : φ (x - y) = φ x - φ y := map_sub _ _ _

@[simp] lemma map_int_cast (n : ℤ) : φ n = n :=
φ.to_ring_hom.map_int_cast n

end ring

section division_ring

variables [comm_semiring R] [division_ring A] [division_ring B]
variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B)

@[simp] lemma map_inv (x) : φ (x⁻¹) = (φ x)⁻¹ :=
φ.to_ring_hom.map_inv x

@[simp] lemma map_div (x y) : φ (x / y) = φ x / φ y :=
φ.to_ring_hom.map_div x y

end division_ring

end alg_hom

@[simp] lemma rat.smul_one_eq_coe {A : Type*} [division_ring A] [algebra ℚ A] (m : ℚ) :
  m • (1 : A) = ↑m :=
by rw [algebra.smul_def, mul_one, ring_hom.eq_rat_cast]

set_option old_structure_cmd true
/-- An equivalence of algebras is an equivalence of rings commuting with the actions of scalars. -/
structure alg_equiv (R : Type u) (A : Type v) (B : Type w)
  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
  extends A ≃ B, A ≃* B, A ≃+ B, A ≃+* B :=
(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r)

attribute [nolint doc_blame] alg_equiv.to_ring_equiv
attribute [nolint doc_blame] alg_equiv.to_equiv
attribute [nolint doc_blame] alg_equiv.to_add_equiv
attribute [nolint doc_blame] alg_equiv.to_mul_equiv

notation A ` ≃ₐ[`:50 R `] ` A' := alg_equiv R A A'

/-- `alg_equiv_class F R A B` states that `F` is a type of algebra structure preserving
  equivalences. You should extend this class when you extend `alg_equiv`. -/
class alg_equiv_class (F : Type*) (R A B : out_param Type*)
  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
  extends ring_equiv_class F A B :=
(commutes : ∀ (f : F) (r : R), f (algebra_map R A r) = algebra_map R B r)

-- `R` becomes a metavariable but that's fine because it's an `out_param`
attribute [nolint dangerous_instance] alg_equiv_class.to_ring_equiv_class

namespace alg_equiv_class

@[priority 100] -- See note [lower instance priority]
instance to_alg_hom_class (F R A B : Type*)
  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
  [h : alg_equiv_class F R A B] : alg_hom_class F R A B :=
{ coe := coe_fn,
  coe_injective' := fun_like.coe_injective,
  map_zero := map_zero,
  map_one := map_one,
  .. h }

end alg_equiv_class

namespace alg_equiv

variables {R : Type u} {A₁ : Type v} {A₂ : Type w} {A₃ : Type u₁}

section semiring

variables [comm_semiring R] [semiring A₁] [semiring A₂] [semiring A₃]
variables [algebra R A₁] [algebra R A₂] [algebra R A₃]
variables (e : A₁ ≃ₐ[R] A₂)

instance : alg_equiv_class (A₁ ≃ₐ[R] A₂) R A₁ A₂ :=
{ coe := to_fun,
  inv := inv_fun,
  coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' },
  map_add := map_add',
  map_mul := map_mul',
  commutes := commutes',
  left_inv := left_inv,
  right_inv := right_inv }

/--  Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly. -/
instance : has_coe_to_fun (A₁ ≃ₐ[R] A₂) (λ _, A₁ → A₂) := ⟨alg_equiv.to_fun⟩

@[ext]
lemma ext {f g : A₁ ≃ₐ[R] A₂} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h

protected lemma congr_arg {f : A₁ ≃ₐ[R] A₂} {x x' : A₁} : x = x' → f x = f x' :=
fun_like.congr_arg f

protected lemma congr_fun {f g : A₁ ≃ₐ[R] A₂} (h : f = g) (x : A₁) : f x = g x :=
fun_like.congr_fun h x

protected lemma ext_iff {f g : A₁ ≃ₐ[R] A₂} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff

lemma coe_fun_injective : @function.injective (A₁ ≃ₐ[R] A₂) (A₁ → A₂) (λ e, (e : A₁ → A₂)) :=
fun_like.coe_injective

instance has_coe_to_ring_equiv : has_coe (A₁ ≃ₐ[R] A₂) (A₁ ≃+* A₂) := ⟨alg_equiv.to_ring_equiv⟩

@[simp] lemma coe_mk {to_fun inv_fun left_inv right_inv map_mul map_add commutes} :
  ⇑(⟨to_fun, inv_fun, left_inv, right_inv, map_mul, map_add, commutes⟩ : A₁ ≃ₐ[R] A₂) = to_fun :=
rfl

@[simp] theorem mk_coe (e : A₁ ≃ₐ[R] A₂) (e' h₁ h₂ h₃ h₄ h₅) :
  (⟨e, e', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂) = e := ext $ λ _, rfl

@[simp] lemma to_fun_eq_coe (e : A₁ ≃ₐ[R] A₂) : e.to_fun = e := rfl

@[simp] lemma to_equiv_eq_coe : e.to_equiv = e := rfl

@[simp] lemma to_ring_equiv_eq_coe : e.to_ring_equiv = e := rfl

@[simp, norm_cast] lemma coe_ring_equiv : ((e : A₁ ≃+* A₂) : A₁ → A₂) = e := rfl
lemma coe_ring_equiv' : (e.to_ring_equiv : A₁ → A₂) = e := rfl

lemma coe_ring_equiv_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ ≃+* A₂)) :=
λ e₁ e₂ h, ext $ ring_equiv.congr_fun h

protected lemma map_add : ∀ x y, e (x + y) = e x + e y := map_add e
protected lemma map_zero : e 0 = 0 := map_zero e
protected lemma map_mul : ∀ x y, e (x * y) = (e x) * (e y) := map_mul e
protected lemma map_one : e 1 = 1 := map_one e

@[simp] lemma commutes : ∀ (r : R), e (algebra_map R A₁ r) = algebra_map R A₂ r :=
  e.commutes'

@[simp] lemma map_smul (r : R) (x : A₁) : e (r • x) = r • e x :=
by simp only [algebra.smul_def, map_mul, commutes]

lemma map_sum {ι : Type*} (f : ι → A₁) (s : finset ι) :
  e (∑ x in s, f x) = ∑ x in s, e (f x) :=
e.to_add_equiv.map_sum f s

lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) :
  e (f.sum g) = f.sum (λ i b, e (g i b)) :=
e.map_sum _ _

/-- Interpret an algebra equivalence as an algebra homomorphism.

This definition is included for symmetry with the other `to_*_hom` projections.
The `simp` normal form is to use the coercion of the `has_coe_to_alg_hom` instance. -/
def to_alg_hom : A₁ →ₐ[R] A₂ :=
{ map_one' := e.map_one, map_zero' := e.map_zero, ..e }

instance has_coe_to_alg_hom : has_coe (A₁ ≃ₐ[R] A₂) (A₁ →ₐ[R] A₂) :=
⟨to_alg_hom⟩

@[simp] lemma to_alg_hom_eq_coe : e.to_alg_hom = e := rfl

@[simp, norm_cast] lemma coe_alg_hom : ((e : A₁ →ₐ[R] A₂) : A₁ → A₂) = e :=
rfl

lemma coe_alg_hom_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ →ₐ[R] A₂)) :=
λ e₁ e₂ h, ext $ alg_hom.congr_fun h

/-- The two paths coercion can take to a `ring_hom` are equivalent -/
lemma coe_ring_hom_commutes : ((e : A₁ →ₐ[R] A₂) : A₁ →+* A₂) = ((e : A₁ ≃+* A₂) : A₁ →+* A₂) :=
rfl

protected lemma map_pow : ∀ (x : A₁) (n : ℕ), e (x ^ n) = (e x) ^ n := map_pow _
protected lemma injective : function.injective e := equiv_like.injective e
protected lemma surjective : function.surjective e := equiv_like.surjective e
protected lemma bijective : function.bijective e := equiv_like.bijective e

/-- Algebra equivalences are reflexive. -/
@[refl] def refl : A₁ ≃ₐ[R] A₁ := {commutes' := λ r, rfl, ..(1 : A₁ ≃+* A₁)}

instance : inhabited (A₁ ≃ₐ[R] A₁) := ⟨refl⟩

@[simp] lemma refl_to_alg_hom : ↑(refl : A₁ ≃ₐ[R] A₁) = alg_hom.id R A₁ := rfl

@[simp] lemma coe_refl : ⇑(refl : A₁ ≃ₐ[R] A₁) = id := rfl

/-- Algebra equivalences are symmetric. -/
@[symm]
def symm (e : A₁ ≃ₐ[R] A₂) : A₂ ≃ₐ[R] A₁ :=
{ commutes' := λ r, by { rw ←e.to_ring_equiv.symm_apply_apply (algebra_map R A₁ r), congr,
                         change _ = e _, rw e.commutes, },
  ..e.to_ring_equiv.symm, }

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : A₁ ≃ₐ[R] A₂) : A₂ → A₁ := e.symm

initialize_simps_projections alg_equiv (to_fun → apply, inv_fun → symm_apply)

@[simp] lemma inv_fun_eq_symm {e : A₁ ≃ₐ[R] A₂} : e.inv_fun = e.symm := rfl

@[simp] lemma symm_symm (e : A₁ ≃ₐ[R] A₂) : e.symm.symm = e :=
by { ext, refl, }

lemma symm_bijective : function.bijective (symm : (A₁ ≃ₐ[R] A₂) → (A₂ ≃ₐ[R] A₁)) :=
equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩

@[simp] lemma mk_coe' (e : A₁ ≃ₐ[R] A₂) (f h₁ h₂ h₃ h₄ h₅) :
  (⟨f, e, h₁, h₂, h₃, h₄, h₅⟩ : A₂ ≃ₐ[R] A₁) = e.symm :=
symm_bijective.injective $ ext $ λ x, rfl

@[simp] theorem symm_mk (f f') (h₁ h₂ h₃ h₄ h₅) :
  (⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm =
  { to_fun := f', inv_fun := f,
    ..(⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm } := rfl

@[simp]
theorem refl_symm : (alg_equiv.refl : A₁ ≃ₐ[R] A₁).symm = alg_equiv.refl := rfl

/-- Algebra equivalences are transitive. -/
@[trans]
def trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : A₁ ≃ₐ[R] A₃ :=
{ commutes' := λ r, show e₂.to_fun (e₁.to_fun _) = _, by rw [e₁.commutes', e₂.commutes'],
  ..(e₁.to_ring_equiv.trans e₂.to_ring_equiv), }

@[simp] lemma apply_symm_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e (e.symm x) = x :=
  e.to_equiv.apply_symm_apply

@[simp] lemma symm_apply_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e.symm (e x) = x :=
  e.to_equiv.symm_apply_apply

@[simp] lemma symm_trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₃) :
  (e₁.trans e₂).symm x = e₁.symm (e₂.symm x) := rfl

@[simp] lemma coe_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) :
  ⇑(e₁.trans e₂) = e₂ ∘ e₁ := rfl

@[simp] lemma trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₁) :
  (e₁.trans e₂) x = e₂ (e₁ x) := rfl

@[simp] lemma comp_symm (e : A₁ ≃ₐ[R] A₂) :
  alg_hom.comp (e : A₁ →ₐ[R] A₂) ↑e.symm = alg_hom.id R A₂ :=
by { ext, simp }

@[simp] lemma symm_comp (e : A₁ ≃ₐ[R] A₂) :
  alg_hom.comp ↑e.symm (e : A₁ →ₐ[R] A₂) = alg_hom.id R A₁ :=
by { ext, simp }

theorem left_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.left_inverse e.symm e := e.left_inv

theorem right_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.right_inverse e.symm e := e.right_inv

/-- If `A₁` is equivalent to `A₁'` and `A₂` is equivalent to `A₂'`, then the type of maps
`A₁ →ₐ[R] A₂` is equivalent to the type of maps `A₁' →ₐ[R] A₂'`. -/
def arrow_congr {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂'] [algebra R A₁'] [algebra R A₂']
  (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') : (A₁ →ₐ[R] A₂) ≃ (A₁' →ₐ[R] A₂') :=
{ to_fun := λ f, (e₂.to_alg_hom.comp f).comp e₁.symm.to_alg_hom,
  inv_fun := λ f, (e₂.symm.to_alg_hom.comp f).comp e₁.to_alg_hom,
  left_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, symm_comp],
    simp only [←alg_hom.comp_assoc, symm_comp, alg_hom.id_comp, alg_hom.comp_id] },
  right_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, comp_symm],
    simp only [←alg_hom.comp_assoc, comp_symm, alg_hom.id_comp, alg_hom.comp_id] } }

lemma arrow_congr_comp {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃']
  [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂')
  (e₃ : A₃ ≃ₐ[R] A₃') (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₃) :
  arrow_congr e₁ e₃ (g.comp f) = (arrow_congr e₂ e₃ g).comp (arrow_congr e₁ e₂ f) :=
by { ext, simp only [arrow_congr, equiv.coe_fn_mk, alg_hom.comp_apply],
  congr, exact (e₂.symm_apply_apply _).symm }

@[simp] lemma arrow_congr_refl :
  arrow_congr alg_equiv.refl alg_equiv.refl = equiv.refl (A₁ →ₐ[R] A₂) :=
by { ext, refl }

@[simp] lemma arrow_congr_trans {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃']
  [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₂) (e₁' : A₁' ≃ₐ[R] A₂')
  (e₂ : A₂ ≃ₐ[R] A₃) (e₂' : A₂' ≃ₐ[R] A₃') :
  arrow_congr (e₁.trans e₂) (e₁'.trans e₂') = (arrow_congr e₁ e₁').trans (arrow_congr e₂ e₂') :=
by { ext, refl }

@[simp] lemma arrow_congr_symm {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂']
  [algebra R A₁'] [algebra R A₂'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') :
  (arrow_congr e₁ e₂).symm = arrow_congr e₁.symm e₂.symm :=
by { ext, refl }

/-- If an algebra morphism has an inverse, it is a algebra isomorphism. -/
def of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ : f.comp g = alg_hom.id R A₂)
  (h₂ : g.comp f = alg_hom.id R A₁) : A₁ ≃ₐ[R] A₂ :=
{ to_fun    := f,
  inv_fun   := g,
  left_inv  := alg_hom.ext_iff.1 h₂,
  right_inv := alg_hom.ext_iff.1 h₁,
  ..f }

lemma coe_alg_hom_of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
  ↑(of_alg_hom f g h₁ h₂) = f := alg_hom.ext $ λ _, rfl

@[simp]
lemma of_alg_hom_coe_alg_hom (f : A₁ ≃ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
  of_alg_hom ↑f g h₁ h₂ = f := ext $ λ _, rfl

lemma of_alg_hom_symm (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
  (of_alg_hom f g h₁ h₂).symm = of_alg_hom g f h₂ h₁ := rfl

/-- Promotes a bijective algebra homomorphism to an algebra equivalence. -/
noncomputable def of_bijective (f : A₁ →ₐ[R] A₂) (hf : function.bijective f) : A₁ ≃ₐ[R] A₂ :=
{ .. ring_equiv.of_bijective (f : A₁ →+* A₂) hf, .. f }

@[simp] lemma coe_of_bijective {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} :
  (alg_equiv.of_bijective f hf : A₁ → A₂) = f := rfl

lemma of_bijective_apply {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} (a : A₁) :
  (alg_equiv.of_bijective f hf) a = f a := rfl

/-- Forgetting the multiplicative structures, an equivalence of algebras is a linear equivalence. -/
@[simps apply] def to_linear_equiv (e : A₁ ≃ₐ[R] A₂) : A₁ ≃ₗ[R] A₂ :=
{ to_fun    := e,
  map_smul' := e.map_smul,
  inv_fun   := e.symm,
  .. e }

@[simp] lemma to_linear_equiv_refl :
  (alg_equiv.refl : A₁ ≃ₐ[R] A₁).to_linear_equiv = linear_equiv.refl R A₁ := rfl

@[simp] lemma to_linear_equiv_symm (e : A₁ ≃ₐ[R] A₂) :
  e.to_linear_equiv.symm = e.symm.to_linear_equiv := rfl

@[simp] lemma to_linear_equiv_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) :
  (e₁.trans e₂).to_linear_equiv = e₁.to_linear_equiv.trans e₂.to_linear_equiv := rfl

theorem to_linear_equiv_injective : function.injective (to_linear_equiv : _ → (A₁ ≃ₗ[R] A₂)) :=
λ e₁ e₂ h, ext $ linear_equiv.congr_fun h

/-- Interpret an algebra equivalence as a linear map. -/
def to_linear_map : A₁ →ₗ[R] A₂ :=
e.to_alg_hom.to_linear_map

@[simp] lemma to_alg_hom_to_linear_map :
  (e : A₁ →ₐ[R] A₂).to_linear_map = e.to_linear_map := rfl

@[simp] lemma to_linear_equiv_to_linear_map :
  e.to_linear_equiv.to_linear_map = e.to_linear_map := rfl

@[simp] lemma to_linear_map_apply (x : A₁) : e.to_linear_map x = e x := rfl

theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A₁ →ₗ[R] A₂)) :=
λ e₁ e₂ h, ext $ linear_map.congr_fun h

@[simp] lemma trans_to_linear_map (f : A₁ ≃ₐ[R] A₂) (g : A₂ ≃ₐ[R] A₃) :
  (f.trans g).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl

section of_linear_equiv

variables (l : A₁ ≃ₗ[R] A₂)
  (map_mul : ∀ x y : A₁, l (x * y) = l x * l y)
  (commutes : ∀ r : R, l (algebra_map R A₁ r) = algebra_map R A₂ r)

/--
Upgrade a linear equivalence to an algebra equivalence,
given that it distributes over multiplication and action of scalars.
-/
@[simps apply]
def of_linear_equiv : A₁ ≃ₐ[R] A₂ :=
{ to_fun := l,
  inv_fun := l.symm,
  map_mul' := map_mul,
  commutes' := commutes,
  ..l }

@[simp]
lemma of_linear_equiv_symm :
  (of_linear_equiv l map_mul commutes).symm = of_linear_equiv l.symm
    ((of_linear_equiv l map_mul commutes).symm.map_mul)
    ((of_linear_equiv l map_mul commutes).symm.commutes) :=
rfl

@[simp] lemma of_linear_equiv_to_linear_equiv (map_mul) (commutes) :
  of_linear_equiv e.to_linear_equiv map_mul commutes = e :=
by { ext, refl }

@[simp] lemma to_linear_equiv_of_linear_equiv :
  to_linear_equiv (of_linear_equiv l map_mul commutes) = l :=
by { ext, refl }

end of_linear_equiv

@[simps mul one {attrs := []}] instance aut : group (A₁ ≃ₐ[R] A₁) :=
{ mul := λ ϕ ψ, ψ.trans ϕ,
  mul_assoc := λ ϕ ψ χ, rfl,
  one := refl,
  one_mul := λ ϕ, ext $ λ x, rfl,
  mul_one := λ ϕ, ext $ λ x, rfl,
  inv := symm,
  mul_left_inv := λ ϕ, ext $ symm_apply_apply ϕ }

@[simp] lemma one_apply (x : A₁) : (1 : A₁ ≃ₐ[R] A₁) x = x := rfl

@[simp] lemma mul_apply (e₁ e₂ : A₁ ≃ₐ[R] A₁) (x : A₁) : (e₁ * e₂) x = e₁ (e₂ x) := rfl

/-- An algebra isomorphism induces a group isomorphism between automorphism groups -/
@[simps apply]
def aut_congr (ϕ : A₁ ≃ₐ[R] A₂) : (A₁ ≃ₐ[R] A₁) ≃* (A₂ ≃ₐ[R] A₂) :=
{ to_fun := λ ψ, ϕ.symm.trans (ψ.trans ϕ),
  inv_fun := λ ψ, ϕ.trans (ψ.trans ϕ.symm),
  left_inv := λ ψ, by { ext, simp_rw [trans_apply, symm_apply_apply] },
  right_inv := λ ψ, by { ext, simp_rw [trans_apply, apply_symm_apply] },
  map_mul' := λ ψ χ, by { ext, simp only [mul_apply, trans_apply, symm_apply_apply] } }

@[simp] lemma aut_congr_refl : aut_congr (alg_equiv.refl) = mul_equiv.refl (A₁ ≃ₐ[R] A₁) :=
by { ext, refl }

@[simp] lemma aut_congr_symm (ϕ : A₁ ≃ₐ[R] A₂) : (aut_congr ϕ).symm = aut_congr ϕ.symm := rfl

@[simp] lemma aut_congr_trans (ϕ : A₁ ≃ₐ[R] A₂) (ψ : A₂ ≃ₐ[R] A₃) :
  (aut_congr ϕ).trans (aut_congr ψ) = aut_congr (ϕ.trans ψ) := rfl

/-- The tautological action by `A₁ ≃ₐ[R] A₁` on `A₁`.

This generalizes `function.End.apply_mul_action`. -/
instance apply_mul_semiring_action : mul_semiring_action (A₁ ≃ₐ[R] A₁) A₁ :=
{ smul := ($),
  smul_zero := alg_equiv.map_zero,
  smul_add := alg_equiv.map_add,
  smul_one := alg_equiv.map_one,
  smul_mul := alg_equiv.map_mul,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] protected lemma smul_def (f : A₁ ≃ₐ[R] A₁) (a : A₁) : f • a = f a := rfl

instance apply_has_faithful_smul : has_faithful_smul (A₁ ≃ₐ[R] A₁) A₁ :=
⟨λ _ _, alg_equiv.ext⟩

instance apply_smul_comm_class : smul_comm_class R (A₁ ≃ₐ[R] A₁) A₁ :=
{ smul_comm := λ r e a, (e.map_smul r a).symm }

instance apply_smul_comm_class' : smul_comm_class (A₁ ≃ₐ[R] A₁) R A₁ :=
{ smul_comm := λ e r a, (e.map_smul r a) }

@[simp] lemma algebra_map_eq_apply (e : A₁ ≃ₐ[R] A₂) {y : R} {x : A₁} :
  (algebra_map R A₂ y = e x) ↔ (algebra_map R A₁ y = x) :=
⟨λ h, by simpa using e.symm.to_alg_hom.algebra_map_eq_apply h,
 λ h, e.to_alg_hom.algebra_map_eq_apply h⟩

end semiring

section comm_semiring

variables [comm_semiring R] [comm_semiring A₁] [comm_semiring A₂]
variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂)

lemma map_prod {ι : Type*} (f : ι → A₁) (s : finset ι) :
  e (∏ x in s, f x) = ∏ x in s, e (f x) :=
map_prod _ f s

lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) :
  e (f.prod g) = f.prod (λ i a, e (g i a)) :=
map_finsupp_prod _ f g

end comm_semiring

section ring

variables [comm_semiring R] [ring A₁] [ring A₂]
variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂)

protected lemma map_neg (x) : e (-x) = -e x := map_neg e x
protected lemma map_sub (x y) : e (x - y) = e x - e y := map_sub e x y

end ring

section division_ring

variables [comm_ring R] [division_ring A₁] [division_ring A₂]
variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂)

@[simp] lemma map_inv (x) : e (x⁻¹) = (e x)⁻¹ :=
e.to_alg_hom.map_inv x

@[simp] lemma map_div (x y) : e (x / y) = e x / e y :=
e.to_alg_hom.map_div x y

end division_ring

end alg_equiv

namespace mul_semiring_action

variables {M G : Type*} (R A : Type*) [comm_semiring R] [semiring A] [algebra R A]

section
variables [monoid M] [mul_semiring_action M A] [smul_comm_class M R A]

/-- Each element of the monoid defines a algebra homomorphism.

This is a stronger version of `mul_semiring_action.to_ring_hom` and
`distrib_mul_action.to_linear_map`. -/
@[simps]
def to_alg_hom (m : M) : A →ₐ[R] A :=
alg_hom.mk' (mul_semiring_action.to_ring_hom _ _ m) (smul_comm _)

theorem to_alg_hom_injective [has_faithful_smul M A] :
  function.injective (mul_semiring_action.to_alg_hom R A : M → A →ₐ[R] A) :=
λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_hom.ext_iff.1 h r

end

section
variables [group G] [mul_semiring_action G A] [smul_comm_class G R A]

/-- Each element of the group defines a algebra equivalence.

This is a stronger version of `mul_semiring_action.to_ring_equiv` and
`distrib_mul_action.to_linear_equiv`. -/
@[simps]
def to_alg_equiv (g : G) : A ≃ₐ[R] A :=
{ .. mul_semiring_action.to_ring_equiv _ _ g,
  .. mul_semiring_action.to_alg_hom R A g }

theorem to_alg_equiv_injective [has_faithful_smul G A] :
  function.injective (mul_semiring_action.to_alg_equiv R A : G → A ≃ₐ[R] A) :=
λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_equiv.ext_iff.1 h r

end

end mul_semiring_action

section nat

variables {R : Type*} [semiring R]

-- Lower the priority so that `algebra.id` is picked most of the time when working with
-- `ℕ`-algebras. This is only an issue since `algebra.id` and `algebra_nat` are not yet defeq.
-- TODO: fix this by adding an `of_nat` field to semirings.
/-- Semiring ⥤ ℕ-Alg -/
@[priority 99] instance algebra_nat : algebra ℕ R :=
{ commutes' := nat.cast_commute,
  smul_def' := λ _ _, nsmul_eq_mul _ _,
  to_ring_hom := nat.cast_ring_hom R }

instance nat_algebra_subsingleton : subsingleton (algebra ℕ R) :=
⟨λ P Q, by { ext, simp, }⟩

end nat

namespace ring_hom

variables {R S : Type*}

/-- Reinterpret a `ring_hom` as an `ℕ`-algebra homomorphism. -/
def to_nat_alg_hom [semiring R] [semiring S] (f : R →+* S) :
  R →ₐ[ℕ] S :=
{ to_fun := f, commutes' := λ n, by simp, .. f }

/-- Reinterpret a `ring_hom` as a `ℤ`-algebra homomorphism. -/
def to_int_alg_hom [ring R] [ring S] [algebra ℤ R] [algebra ℤ S] (f : R →+* S) :
  R →ₐ[ℤ] S :=
{ commutes' := λ n, by simp, .. f }

-- note that `R`, `S` could be `semiring`s but this is useless mathematically speaking -
-- a ℚ-algebra is a ring. furthermore, this change probably slows down elaboration.
@[simp] lemma map_rat_algebra_map [ring R] [ring S] [algebra ℚ R] [algebra ℚ S]
  (f : R →+* S) (r : ℚ) : f (algebra_map ℚ R r) = algebra_map ℚ S r :=
ring_hom.ext_iff.1 (subsingleton.elim (f.comp (algebra_map ℚ R)) (algebra_map ℚ S)) r

/-- Reinterpret a `ring_hom` as a `ℚ`-algebra homomorphism. This actually yields an equivalence,
see `ring_hom.equiv_rat_alg_hom`. -/
def to_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] (f : R →+* S) :
  R →ₐ[ℚ] S :=
{ commutes' := f.map_rat_algebra_map, .. f }

@[simp]
lemma to_rat_alg_hom_to_ring_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S]
  (f : R →+* S) : ↑f.to_rat_alg_hom = f :=
ring_hom.ext $ λ x, rfl

end ring_hom

section

variables {R S : Type*}

@[simp]
lemma alg_hom.to_ring_hom_to_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S]
  (f : R →ₐ[ℚ] S) : (f : R →+* S).to_rat_alg_hom = f :=
alg_hom.ext $ λ x, rfl

/-- The equivalence between `ring_hom` and `ℚ`-algebra homomorphisms. -/
@[simps]
def ring_hom.equiv_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] :
  (R →+* S) ≃ (R →ₐ[ℚ] S) :=
{ to_fun := ring_hom.to_rat_alg_hom,
  inv_fun := alg_hom.to_ring_hom,
  left_inv := ring_hom.to_rat_alg_hom_to_ring_hom,
  right_inv := alg_hom.to_ring_hom_to_rat_alg_hom, }

end

section rat

instance algebra_rat {α} [division_ring α] [char_zero α] : algebra ℚ α :=
(rat.cast_hom α).to_algebra' $ λ r x, r.cast_commute x

@[simp] theorem algebra_map_rat_rat : algebra_map ℚ ℚ = ring_hom.id ℚ :=
subsingleton.elim _ _

-- TODO[gh-6025]: make this an instance once safe to do so
lemma algebra_rat_subsingleton {α} [semiring α] :
  subsingleton (algebra ℚ α) :=
⟨λ x y, algebra.algebra_ext x y $ ring_hom.congr_fun $ subsingleton.elim _ _⟩

end rat

namespace algebra
open module

variables (R : Type u) (A : Type v)

variables [comm_semiring R] [semiring A] [algebra R A]

/-- `algebra_map` as an `alg_hom`. -/
def of_id : R →ₐ[R] A :=
{ commutes' := λ _, rfl, .. algebra_map R A }
variables {R}

theorem of_id_apply (r) : of_id R A r = algebra_map R A r := rfl

end algebra

section int

variables (R : Type*) [ring R]

-- Lower the priority so that `algebra.id` is picked most of the time when working with
-- `ℤ`-algebras. This is only an issue since `algebra.id ℤ` and `algebra_int ℤ` are not yet defeq.
-- TODO: fix this by adding an `of_int` field to rings.
/-- Ring ⥤ ℤ-Alg -/
@[priority 99] instance algebra_int : algebra ℤ R :=
{ commutes' := int.cast_commute,
  smul_def' := λ _ _, zsmul_eq_mul _ _,
  to_ring_hom := int.cast_ring_hom R }

/-- A special case of `ring_hom.eq_int_cast'` that happens to be true definitionally -/
@[simp] lemma algebra_map_int_eq : algebra_map ℤ R = int.cast_ring_hom R := rfl

variables {R}

instance int_algebra_subsingleton : subsingleton (algebra ℤ R) :=
⟨λ P Q, by { ext, simp, }⟩

end int

namespace no_zero_smul_divisors

variables {R A : Type*}

open algebra

/-- If `algebra_map R A` is injective and `A` has no zero divisors,
`R`-multiples in `A` are zero only if one of the factors is zero.

Cannot be an instance because there is no `injective (algebra_map R A)` typeclass.
-/
lemma of_algebra_map_injective
  [comm_semiring R] [semiring A] [algebra R A] [no_zero_divisors A]
  (h : function.injective (algebra_map R A)) : no_zero_smul_divisors R A :=
⟨λ c x hcx, (mul_eq_zero.mp ((smul_def c x).symm.trans hcx)).imp_left
  (map_eq_zero_iff (algebra_map R A) h).mp⟩

variables (R A)
lemma algebra_map_injective [comm_ring R] [ring A] [nontrivial A]
  [algebra R A] [no_zero_smul_divisors R A] :
  function.injective (algebra_map R A) :=
suffices function.injective (λ (c : R), c • (1 : A)),
by { convert this, ext, rw [algebra.smul_def, mul_one] },
smul_left_injective R one_ne_zero

variables {R A}
lemma iff_algebra_map_injective [comm_ring R] [ring A] [is_domain A] [algebra R A] :
  no_zero_smul_divisors R A ↔ function.injective (algebra_map R A) :=
⟨@@no_zero_smul_divisors.algebra_map_injective R A _ _ _ _,
 no_zero_smul_divisors.of_algebra_map_injective⟩

@[priority 100] -- see note [lower instance priority]
instance char_zero.no_zero_smul_divisors_nat [semiring R] [no_zero_divisors R] [char_zero R] :
  no_zero_smul_divisors ℕ R :=
no_zero_smul_divisors.of_algebra_map_injective $ (algebra_map ℕ R).injective_nat

@[priority 100] -- see note [lower instance priority]
instance char_zero.no_zero_smul_divisors_int [ring R] [no_zero_divisors R] [char_zero R] :
  no_zero_smul_divisors ℤ R :=
no_zero_smul_divisors.of_algebra_map_injective $ (algebra_map ℤ R).injective_int

section field

variables [field R] [semiring A] [algebra R A]

@[priority 100] -- see note [lower instance priority]
instance algebra.no_zero_smul_divisors [nontrivial A] [no_zero_divisors A] :
  no_zero_smul_divisors R A :=
no_zero_smul_divisors.of_algebra_map_injective (algebra_map R A).injective

end field

end no_zero_smul_divisors

/-!
The R-algebra structure on `Π i : I, A i` when each `A i` is an R-algebra.

We couldn't set this up back in `algebra.pi_instances` because this file imports it.
-/
namespace pi

variable {I : Type u}     -- The indexing type
variable {R : Type*}      -- The scalar type
variable {f : I → Type v} -- The family of types already equipped with instances
variables (x y : Π i, f i) (i : I)
variables (I f)

instance algebra {r : comm_semiring R}
  [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] :
  algebra R (Π i : I, f i) :=
{ commutes' := λ a f, begin ext, simp [algebra.commutes], end,
  smul_def' := λ a f, begin ext, simp [algebra.smul_def], end,
  ..(pi.ring_hom (λ i, algebra_map R (f i)) : R →+* Π i : I, f i) }

@[simp] lemma algebra_map_apply {r : comm_semiring R}
  [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] (a : R) (i : I) :
  algebra_map R (Π i, f i) a i = algebra_map R (f i) a := rfl

-- One could also build a `Π i, R i`-algebra structure on `Π i, A i`,
-- when each `A i` is an `R i`-algebra, although I'm not sure that it's useful.

variables {I} (R) (f)

/-- `function.eval` as an `alg_hom`. The name matches `pi.eval_ring_hom`, `pi.eval_monoid_hom`,
etc. -/
@[simps]
def eval_alg_hom {r : comm_semiring R} [Π i, semiring (f i)] [Π i, algebra R (f i)] (i : I) :
  (Π i, f i) →ₐ[R] f i :=
{ to_fun := λ f, f i, commutes' := λ r, rfl, .. pi.eval_ring_hom f i}

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

/-- `function.const` as an `alg_hom`. The name matches `pi.const_ring_hom`, `pi.const_monoid_hom`,
etc. -/
@[simps]
def const_alg_hom : B →ₐ[R] (A → B) :=
{ to_fun := function.const _,
  commutes' := λ r, rfl,
  .. pi.const_ring_hom A B}

/-- When `R` is commutative and permits an `algebra_map`, `pi.const_ring_hom` is equal to that
map. -/
@[simp] lemma const_ring_hom_eq_algebra_map : const_ring_hom A R = algebra_map R (A → R) :=
rfl

@[simp] lemma const_alg_hom_eq_algebra_of_id : const_alg_hom R A R = algebra.of_id R (A → R) :=
rfl

end pi

/-- A special case of `pi.algebra` for non-dependent types. Lean struggles to elaborate
definitions elsewhere in the library without this, -/
instance function.algebra {R : Type*} (I : Type*)  (A : Type*) [comm_semiring R]
  [semiring A] [algebra R A] : algebra R (I → A) :=
pi.algebra _ _

namespace alg_equiv

/-- A family of algebra equivalences `Π j, (A₁ j ≃ₐ A₂ j)` generates a
multiplicative equivalence between `Π j, A₁ j` and `Π j, A₂ j`.

This is the `alg_equiv` version of `equiv.Pi_congr_right`, and the dependent version of
`alg_equiv.arrow_congr`.
-/
@[simps apply]
def Pi_congr_right {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R]
  [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)]
  (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Π i, A₁ i) ≃ₐ[R] Π i, A₂ i :=
{ to_fun := λ x j, e j (x j),
  inv_fun := λ x j, (e j).symm (x j),
  commutes' := λ r, by { ext i, simp },
  .. @ring_equiv.Pi_congr_right ι A₁ A₂ _ _ (λ i, (e i).to_ring_equiv) }

@[simp]
lemma Pi_congr_right_refl {R ι : Type*} {A : ι → Type*} [comm_semiring R]
  [Π i, semiring (A i)] [Π i, algebra R (A i)] :
  Pi_congr_right (λ i, (alg_equiv.refl : A i ≃ₐ[R] A i)) = alg_equiv.refl := rfl

@[simp]
lemma Pi_congr_right_symm {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R]
  [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)]
  (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Pi_congr_right e).symm = (Pi_congr_right $ λ i, (e i).symm) := rfl

@[simp]
lemma Pi_congr_right_trans {R ι : Type*} {A₁ A₂ A₃ : ι → Type*} [comm_semiring R]
  [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, semiring (A₃ i)]
  [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)] [Π i, algebra R (A₃ i)]
  (e₁ : Π i, A₁ i ≃ₐ[R] A₂ i) (e₂ : Π i, A₂ i ≃ₐ[R] A₃ i) :
  (Pi_congr_right e₁).trans (Pi_congr_right e₂) = (Pi_congr_right $ λ i, (e₁ i).trans (e₂ i)) :=
rfl

end alg_equiv

section is_scalar_tower

variables {R : Type*} [comm_semiring R]
variables (A : Type*) [semiring A] [algebra R A]
variables {M : Type*} [add_comm_monoid M] [module A M] [module R M] [is_scalar_tower R A M]
variables {N : Type*} [add_comm_monoid N] [module A N] [module R N] [is_scalar_tower R A N]

lemma algebra_compatible_smul (r : R) (m : M) : r • m = ((algebra_map R A) r) • m :=
by rw [←(one_smul A m), ←smul_assoc, algebra.smul_def, mul_one, one_smul]

@[simp] lemma algebra_map_smul (r : R) (m : M) : ((algebra_map R A) r) • m = r • m :=
(algebra_compatible_smul A r m).symm

lemma no_zero_smul_divisors.trans (R A M : Type*) [comm_ring R] [ring A] [is_domain A] [algebra R A]
  [add_comm_group M] [module R M] [module A M] [is_scalar_tower R A M] [no_zero_smul_divisors R A]
  [no_zero_smul_divisors A M] : no_zero_smul_divisors R M :=
begin
  refine ⟨λ r m h, _⟩,
  rw [algebra_compatible_smul A r m] at h,
  cases smul_eq_zero.1 h with H H,
  { have : function.injective (algebra_map R A) :=
      no_zero_smul_divisors.iff_algebra_map_injective.1 infer_instance,
    left,
    exact (injective_iff_map_eq_zero _).1 this _ H },
  { right,
    exact H }
end

variable {A}

@[priority 100] -- see Note [lower instance priority]
instance is_scalar_tower.to_smul_comm_class : smul_comm_class R A M :=
⟨λ r a m, by rw [algebra_compatible_smul A r (a • m), smul_smul, algebra.commutes, mul_smul,
  ←algebra_compatible_smul]⟩

@[priority 100] -- see Note [lower instance priority]
instance is_scalar_tower.to_smul_comm_class' : smul_comm_class A R M :=
smul_comm_class.symm _ _ _

lemma smul_algebra_smul_comm (r : R) (a : A) (m : M) : a • r • m = r • a • m :=
smul_comm _ _ _

namespace linear_map

instance coe_is_scalar_tower : has_coe (M →ₗ[A] N) (M →ₗ[R] N) :=
⟨restrict_scalars R⟩

variables (R) {A M N}

@[simp, norm_cast squash] lemma coe_restrict_scalars_eq_coe (f : M →ₗ[A] N) :
  (f.restrict_scalars R : M → N) = f := rfl

@[simp, norm_cast squash] lemma coe_coe_is_scalar_tower (f : M →ₗ[A] N) :
  ((f : M →ₗ[R] N) : M → N) = f := rfl

/-- `A`-linearly coerce a `R`-linear map from `M` to `A` to a function, given an algebra `A` over
a commutative semiring `R` and `M` a module over `R`. -/
def lto_fun (R : Type u) (M : Type v) (A : Type w)
  [comm_semiring R] [add_comm_monoid M] [module R M] [comm_ring A] [algebra R A] :
  (M →ₗ[R] A) →ₗ[A] (M → A) :=
{ to_fun := linear_map.to_fun,
  map_add' := λ f g, rfl,
  map_smul' := λ c f, rfl }

end linear_map

end is_scalar_tower

/-! TODO: The following lemmas no longer involve `algebra` at all, and could be moved closer
to `algebra/module/submodule.lean`. Currently this is tricky because `ker`, `range`, `⊤`, and `⊥`
are all defined in `linear_algebra/basic.lean`. -/
section module
open module

variables (R S M N : Type*) [semiring R] [semiring S] [has_scalar R S]
variables [add_comm_monoid M] [module R M] [module S M] [is_scalar_tower R S M]
variables [add_comm_monoid N] [module R N] [module S N] [is_scalar_tower R S N]

variables {S M N}

@[simp]
lemma linear_map.ker_restrict_scalars (f : M →ₗ[S] N) :
  (f.restrict_scalars R).ker = f.ker.restrict_scalars R :=
rfl

end module

namespace submodule

variables (R A M : Type*)
variables [comm_semiring R] [semiring A] [algebra R A] [add_comm_monoid M]
variables [module R M] [module A M] [is_scalar_tower R A M]

/-- If `A` is an `R`-algebra such that the induced morhpsim `R →+* A` is surjective, then the
`R`-module generated by a set `X` equals the `A`-module generated by `X`. -/
lemma span_eq_restrict_scalars (X : set M) (hsur : function.surjective (algebra_map R A)) :
  span R X = restrict_scalars R (span A X) :=
begin
  apply (span_le_restrict_scalars R A X).antisymm (λ m hm, _),
  refine span_induction hm subset_span (zero_mem _) (λ _ _, add_mem) (λ a m hm, _),
  obtain ⟨r, rfl⟩ := hsur a,
  simpa [algebra_map_smul] using smul_mem _ r hm
end

end submodule

namespace alg_hom

variables {R : Type u} {A : Type v} {B : Type w} {I : Type*}

variables [comm_semiring R] [semiring A] [semiring B]
variables [algebra R A] [algebra R B]

/-- `R`-algebra homomorphism between the function spaces `I → A` and `I → B`, induced by an
`R`-algebra homomorphism `f` between `A` and `B`. -/
@[simps] protected def comp_left (f : A →ₐ[R] B) (I : Type*) : (I → A) →ₐ[R] (I → B) :=
{ to_fun := λ h, f ∘ h,
  commutes' := λ c, by { ext, exact f.commutes' c },
  .. f.to_ring_hom.comp_left I }

end alg_hom

example {R A} [comm_semiring R] [semiring A]
  [module R A] [smul_comm_class R A A] [is_scalar_tower R A A] : algebra R A :=
algebra.of_module smul_mul_assoc mul_smul_comm


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.multiset.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# The powerset of a multiset
-/

namespace multiset

/-! ### powerset -/

/-- A helper function for the powerset of a multiset. Given a list `l`, returns a list
of sublists of `l` (using `sublists_aux`), as multisets. -/
def powerset_aux {α : Type u_1} (l : List α) : List (multiset α) :=
  0 :: list.sublists_aux l fun (x : List α) (y : List (multiset α)) => ↑x :: y

theorem powerset_aux_eq_map_coe {α : Type u_1} {l : List α} :
    powerset_aux l = list.map coe (list.sublists l) :=
  sorry

@[simp] theorem mem_powerset_aux {α : Type u_1} {l : List α} {s : multiset α} :
    s ∈ powerset_aux l ↔ s ≤ ↑l :=
  sorry

/-- Helper function for the powerset of a multiset. Given a list `l`, returns a list
of sublists of `l` (using `sublists'`), as multisets. -/
def powerset_aux' {α : Type u_1} (l : List α) : List (multiset α) := list.map coe (list.sublists' l)

theorem powerset_aux_perm_powerset_aux' {α : Type u_1} {l : List α} :
    powerset_aux l ~ powerset_aux' l :=
  eq.mpr (id (Eq._oldrec (Eq.refl (powerset_aux l ~ powerset_aux' l)) powerset_aux_eq_map_coe))
    (list.perm.map coe (list.sublists_perm_sublists' l))

@[simp] theorem powerset_aux'_nil {α : Type u_1} : powerset_aux' [] = [0] := rfl

@[simp] theorem powerset_aux'_cons {α : Type u_1} (a : α) (l : List α) :
    powerset_aux' (a :: l) = powerset_aux' l ++ list.map (cons a) (powerset_aux' l) :=
  sorry

theorem powerset_aux'_perm {α : Type u_1} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) :
    powerset_aux' l₁ ~ powerset_aux' l₂ :=
  sorry

theorem powerset_aux_perm {α : Type u_1} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) :
    powerset_aux l₁ ~ powerset_aux l₂ :=
  list.perm.trans powerset_aux_perm_powerset_aux'
    (list.perm.trans (powerset_aux'_perm p) (list.perm.symm powerset_aux_perm_powerset_aux'))

/-- The power set of a multiset. -/
def powerset {α : Type u_1} (s : multiset α) : multiset (multiset α) :=
  quot.lift_on s (fun (l : List α) => ↑(powerset_aux l)) sorry

theorem powerset_coe {α : Type u_1} (l : List α) :
    powerset ↑l = ↑(list.map coe (list.sublists l)) :=
  congr_arg coe powerset_aux_eq_map_coe

@[simp] theorem powerset_coe' {α : Type u_1} (l : List α) :
    powerset ↑l = ↑(list.map coe (list.sublists' l)) :=
  quot.sound powerset_aux_perm_powerset_aux'

@[simp] theorem powerset_zero {α : Type u_1} : powerset 0 = 0 ::ₘ 0 := rfl

@[simp] theorem powerset_cons {α : Type u_1} (a : α) (s : multiset α) :
    powerset (a ::ₘ s) = powerset s + map (cons a) (powerset s) :=
  sorry

@[simp] theorem mem_powerset {α : Type u_1} {s : multiset α} {t : multiset α} :
    s ∈ powerset t ↔ s ≤ t :=
  sorry

theorem map_single_le_powerset {α : Type u_1} (s : multiset α) :
    map (fun (a : α) => a ::ₘ 0) s ≤ powerset s :=
  sorry

@[simp] theorem card_powerset {α : Type u_1} (s : multiset α) :
    coe_fn card (powerset s) = bit0 1 ^ coe_fn card s :=
  sorry

theorem revzip_powerset_aux {α : Type u_1} {l : List α} {x : multiset α × multiset α}
    (h : x ∈ list.revzip (powerset_aux l)) : prod.fst x + prod.snd x = ↑l :=
  sorry

theorem revzip_powerset_aux' {α : Type u_1} {l : List α} {x : multiset α × multiset α}
    (h : x ∈ list.revzip (powerset_aux' l)) : prod.fst x + prod.snd x = ↑l :=
  sorry

theorem revzip_powerset_aux_lemma {α : Type u_1} [DecidableEq α] (l : List α)
    {l' : List (multiset α)}
    (H : ∀ {x : multiset α × multiset α}, x ∈ list.revzip l' → prod.fst x + prod.snd x = ↑l) :
    list.revzip l' = list.map (fun (x : multiset α) => (x, ↑l - x)) l' :=
  sorry

theorem revzip_powerset_aux_perm_aux' {α : Type u_1} {l : List α} :
    list.revzip (powerset_aux l) ~ list.revzip (powerset_aux' l) :=
  sorry

theorem revzip_powerset_aux_perm {α : Type u_1} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) :
    list.revzip (powerset_aux l₁) ~ list.revzip (powerset_aux l₂) :=
  sorry

/-! ### powerset_len -/

/-- Helper function for `powerset_len`. Given a list `l`, `powerset_len_aux n l` is the list
of sublists of length `n`, as multisets. -/
def powerset_len_aux {α : Type u_1} (n : ℕ) (l : List α) : List (multiset α) :=
  list.sublists_len_aux n l coe []

theorem powerset_len_aux_eq_map_coe {α : Type u_1} {n : ℕ} {l : List α} :
    powerset_len_aux n l = list.map coe (list.sublists_len n l) :=
  sorry

@[simp] theorem mem_powerset_len_aux {α : Type u_1} {n : ℕ} {l : List α} {s : multiset α} :
    s ∈ powerset_len_aux n l ↔ s ≤ ↑l ∧ coe_fn card s = n :=
  sorry

@[simp] theorem powerset_len_aux_zero {α : Type u_1} (l : List α) : powerset_len_aux 0 l = [0] :=
  sorry

@[simp] theorem powerset_len_aux_nil {α : Type u_1} (n : ℕ) : powerset_len_aux (n + 1) [] = [] :=
  rfl

@[simp] theorem powerset_len_aux_cons {α : Type u_1} (n : ℕ) (a : α) (l : List α) :
    powerset_len_aux (n + 1) (a :: l) =
        powerset_len_aux (n + 1) l ++ list.map (cons a) (powerset_len_aux n l) :=
  sorry

theorem powerset_len_aux_perm {α : Type u_1} {n : ℕ} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) :
    powerset_len_aux n l₁ ~ powerset_len_aux n l₂ :=
  sorry

/-- `powerset_len n s` is the multiset of all submultisets of `s` of length `n`. -/
def powerset_len {α : Type u_1} (n : ℕ) (s : multiset α) : multiset (multiset α) :=
  quot.lift_on s (fun (l : List α) => ↑(powerset_len_aux n l)) sorry

theorem powerset_len_coe' {α : Type u_1} (n : ℕ) (l : List α) :
    powerset_len n ↑l = ↑(powerset_len_aux n l) :=
  rfl

theorem powerset_len_coe {α : Type u_1} (n : ℕ) (l : List α) :
    powerset_len n ↑l = ↑(list.map coe (list.sublists_len n l)) :=
  congr_arg coe powerset_len_aux_eq_map_coe

@[simp] theorem powerset_len_zero_left {α : Type u_1} (s : multiset α) :
    powerset_len 0 s = 0 ::ₘ 0 :=
  sorry

@[simp] theorem powerset_len_zero_right {α : Type u_1} (n : ℕ) : powerset_len (n + 1) 0 = 0 := rfl

@[simp] theorem powerset_len_cons {α : Type u_1} (n : ℕ) (a : α) (s : multiset α) :
    powerset_len (n + 1) (a ::ₘ s) = powerset_len (n + 1) s + map (cons a) (powerset_len n s) :=
  sorry

@[simp] theorem mem_powerset_len {α : Type u_1} {n : ℕ} {s : multiset α} {t : multiset α} :
    s ∈ powerset_len n t ↔ s ≤ t ∧ coe_fn card s = n :=
  sorry

@[simp] theorem card_powerset_len {α : Type u_1} (n : ℕ) (s : multiset α) :
    coe_fn card (powerset_len n s) = nat.choose (coe_fn card s) n :=
  sorry

theorem powerset_len_le_powerset {α : Type u_1} (n : ℕ) (s : multiset α) :
    powerset_len n s ≤ powerset s :=
  sorry

theorem powerset_len_mono {α : Type u_1} (n : ℕ) {s : multiset α} {t : multiset α} (h : s ≤ t) :
    powerset_len n s ≤ powerset_len n t :=
  sorry

end Mathlib


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u_3 l u_1 u_2

namespace Mathlib

/-!
# Submonoids: definition and `complete_lattice` structure

This file defines bundled multiplicative and additive submonoids. We also define
a `complete_lattice` structure on `submonoid`s, define the closure of a set as the minimal submonoid
that includes this set, and prove a few results about extending properties from a dense set (i.e.
a set with `closure s = ⊤`) to the whole monoid, see `submonoid.dense_induction` and
`monoid_hom.of_mdense`.

## Main definitions

* `submonoid M`: the type of bundled submonoids of a monoid `M`; the underlying set is given in
  the `carrier` field of the structure, and should be accessed through coercion as in `(S : set M)`.
* `add_submonoid M` : the type of bundled submonoids of an additive monoid `M`.

For each of the following definitions in the `submonoid` namespace, there is a corresponding
definition in the `add_submonoid` namespace.

* `submonoid.copy` : copy of a submonoid with `carrier` replaced by a set that is equal but possibly
  not definitionally equal to the carrier of the original `submonoid`.
* `submonoid.closure` :  monoid closure of a set, i.e., the least submonoid that includes the set.
* `submonoid.gi` : `closure : set M → submonoid M` and coercion `coe : submonoid M → set M`
  form a `galois_insertion`;
* `monoid_hom.eq_mlocus`: the submonoid of elements `x : M` such that `f x = g x`;
* `monoid_hom.of_mdense`:  if a map `f : M → N` between two monoids satisfies `f 1 = 1` and
  `f (x * y) = f x * f y` for `y` from some dense set `s`, then `f` is a monoid homomorphism.
  E.g., if `f : ℕ → M` satisfies `f 0 = 0` and `f (x + 1) = f x + f 1`, then `f` is an additive
  monoid homomorphism.

## Implementation notes

Submonoid inclusion is denoted `≤` rather than `⊆`, although `∈` is defined as
membership of a submonoid's underlying set.

This file is designed to have very few dependencies. In particular, it should not use natural
numbers.

## Tags
submonoid, submonoids
-/

/-- A submonoid of a monoid `M` is a subset containing 1 and closed under multiplication. -/
structure submonoid (M : Type u_3) [monoid M] where
  carrier : set M
  one_mem' : 1 ∈ carrier
  mul_mem' : ∀ {a b : M}, a ∈ carrier → b ∈ carrier → a * b ∈ carrier

/-- An additive submonoid of an additive monoid `M` is a subset containing 0 and
  closed under addition. -/
structure add_submonoid (M : Type u_3) [add_monoid M] where
  carrier : set M
  zero_mem' : 0 ∈ carrier
  add_mem' : ∀ {a b : M}, a ∈ carrier → b ∈ carrier → a + b ∈ carrier

namespace submonoid

protected instance Mathlib.add_submonoid.set.has_coe {M : Type u_1} [add_monoid M] :
    has_coe (add_submonoid M) (set M) :=
  has_coe.mk add_submonoid.carrier

protected instance has_mem {M : Type u_1} [monoid M] : has_mem M (submonoid M) :=
  has_mem.mk fun (m : M) (S : submonoid M) => m ∈ ↑S

protected instance has_coe_to_sort {M : Type u_1} [monoid M] : has_coe_to_sort (submonoid M) :=
  has_coe_to_sort.mk (Type u_1) fun (S : submonoid M) => Subtype fun (x : M) => x ∈ S

@[simp] theorem mem_carrier {M : Type u_1} [monoid M] {s : submonoid M} {x : M} :
    x ∈ carrier s ↔ x ∈ s :=
  iff.rfl

@[simp] theorem mem_coe {M : Type u_1} [monoid M] {S : submonoid M} {m : M} : m ∈ ↑S ↔ m ∈ S :=
  iff.rfl

@[simp] theorem coe_coe {M : Type u_1} [monoid M] (s : submonoid M) : ↥↑s = ↥s := rfl

protected theorem Mathlib.add_submonoid.exists {M : Type u_1} [add_monoid M] {s : add_submonoid M}
    {p : ↥s → Prop} : (∃ (x : ↥s), p x) ↔ ∃ (x : M), ∃ (H : x ∈ s), p { val := x, property := H } :=
  set_coe.exists

protected theorem forall {M : Type u_1} [monoid M] {s : submonoid M} {p : ↥s → Prop} :
    (∀ (x : ↥s), p x) ↔ ∀ (x : M) (H : x ∈ s), p { val := x, property := H } :=
  set_coe.forall

/-- Two submonoids are equal if the underlying subsets are equal. -/
theorem ext' {M : Type u_1} [monoid M] {S : submonoid M} {T : submonoid M} (h : ↑S = ↑T) : S = T :=
  sorry

/-- Two submonoids are equal if and only if the underlying subsets are equal. -/
protected theorem ext'_iff {M : Type u_1} [monoid M] {S : submonoid M} {T : submonoid M} :
    S = T ↔ ↑S = ↑T :=
  { mp := fun (h : S = T) => h ▸ rfl, mpr := fun (h : ↑S = ↑T) => ext' h }

/-- Two submonoids are equal if they have the same elements. -/
theorem Mathlib.add_submonoid.ext {M : Type u_1} [add_monoid M] {S : add_submonoid M}
    {T : add_submonoid M} (h : ∀ (x : M), x ∈ S ↔ x ∈ T) : S = T :=
  add_submonoid.ext' (set.ext h)

/-- Copy a submonoid replacing `carrier` with a set that is equal to it. -/
def copy {M : Type u_1} [monoid M] (S : submonoid M) (s : set M) (hs : s = ↑S) : submonoid M :=
  mk s sorry sorry

@[simp] theorem coe_copy {M : Type u_1} [monoid M] {S : submonoid M} {s : set M} (hs : s = ↑S) :
    ↑(copy S s hs) = s :=
  rfl

theorem copy_eq {M : Type u_1} [monoid M] {S : submonoid M} {s : set M} (hs : s = ↑S) :
    copy S s hs = S :=
  ext' hs

/-- A submonoid contains the monoid's 1. -/
theorem Mathlib.add_submonoid.zero_mem {M : Type u_1} [add_monoid M] (S : add_submonoid M) :
    0 ∈ S :=
  add_submonoid.zero_mem' S

/-- A submonoid is closed under multiplication. -/
theorem mul_mem {M : Type u_1} [monoid M] (S : submonoid M) {x : M} {y : M} :
    x ∈ S → y ∈ S → x * y ∈ S :=
  mul_mem' S

theorem coe_injective {M : Type u_1} [monoid M] (S : submonoid M) : function.injective coe :=
  subtype.val_injective

@[simp] theorem coe_eq_coe {M : Type u_1} [monoid M] (S : submonoid M) (x : ↥S) (y : ↥S) :
    ↑x = ↑y ↔ x = y :=
  set_coe.ext_iff

protected instance has_le {M : Type u_1} [monoid M] : HasLessEq (submonoid M) :=
  { LessEq := fun (S T : submonoid M) => ∀ {x : M}, x ∈ S → x ∈ T }

theorem le_def {M : Type u_1} [monoid M] {S : submonoid M} {T : submonoid M} :
    S ≤ T ↔ ∀ {x : M}, x ∈ S → x ∈ T :=
  iff.rfl

@[simp] theorem Mathlib.add_submonoid.coe_subset_coe {M : Type u_1} [add_monoid M]
    {S : add_submonoid M} {T : add_submonoid M} : ↑S ⊆ ↑T ↔ S ≤ T :=
  iff.rfl

protected instance Mathlib.add_submonoid.partial_order {M : Type u_1} [add_monoid M] :
    partial_order (add_submonoid M) :=
  partial_order.mk (fun (S T : add_submonoid M) => ∀ {x : M}, x ∈ S → x ∈ T) partial_order.lt sorry
    sorry sorry

@[simp] theorem coe_ssubset_coe {M : Type u_1} [monoid M] {S : submonoid M} {T : submonoid M} :
    ↑S ⊂ ↑T ↔ S < T :=
  iff.rfl

/-- The submonoid `M` of the monoid `M`. -/
protected instance has_top {M : Type u_1} [monoid M] : has_top (submonoid M) :=
  has_top.mk (mk set.univ sorry sorry)

/-- The trivial submonoid `{1}` of an monoid `M`. -/
protected instance Mathlib.add_submonoid.has_bot {M : Type u_1} [add_monoid M] :
    has_bot (add_submonoid M) :=
  has_bot.mk (add_submonoid.mk (singleton 0) sorry sorry)

protected instance Mathlib.add_submonoid.inhabited {M : Type u_1} [add_monoid M] :
    Inhabited (add_submonoid M) :=
  { default := ⊥ }

@[simp] theorem mem_bot {M : Type u_1} [monoid M] {x : M} : x ∈ ⊥ ↔ x = 1 := set.mem_singleton_iff

@[simp] theorem mem_top {M : Type u_1} [monoid M] (x : M) : x ∈ ⊤ := set.mem_univ x

@[simp] theorem Mathlib.add_submonoid.coe_top {M : Type u_1} [add_monoid M] : ↑⊤ = set.univ := rfl

@[simp] theorem coe_bot {M : Type u_1} [monoid M] : ↑⊥ = singleton 1 := rfl

/-- The inf of two submonoids is their intersection. -/
protected instance has_inf {M : Type u_1} [monoid M] : has_inf (submonoid M) :=
  has_inf.mk fun (S₁ S₂ : submonoid M) => mk (↑S₁ ∩ ↑S₂) sorry sorry

@[simp] theorem coe_inf {M : Type u_1} [monoid M] (p : submonoid M) (p' : submonoid M) :
    ↑(p ⊓ p') = ↑p ∩ ↑p' :=
  rfl

@[simp] theorem mem_inf {M : Type u_1} [monoid M] {p : submonoid M} {p' : submonoid M} {x : M} :
    x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' :=
  iff.rfl

protected instance has_Inf {M : Type u_1} [monoid M] : has_Inf (submonoid M) :=
  has_Inf.mk
    fun (s : set (submonoid M)) =>
      mk (set.Inter fun (t : submonoid M) => set.Inter fun (H : t ∈ s) => ↑t) sorry sorry

@[simp] theorem coe_Inf {M : Type u_1} [monoid M] (S : set (submonoid M)) :
    ↑(Inf S) = set.Inter fun (s : submonoid M) => set.Inter fun (H : s ∈ S) => ↑s :=
  rfl

theorem Mathlib.add_submonoid.mem_Inf {M : Type u_1} [add_monoid M] {S : set (add_submonoid M)}
    {x : M} : x ∈ Inf S ↔ ∀ (p : add_submonoid M), p ∈ S → x ∈ p :=
  set.mem_bInter_iff

theorem mem_infi {M : Type u_1} [monoid M] {ι : Sort u_2} {S : ι → submonoid M} {x : M} :
    (x ∈ infi fun (i : ι) => S i) ↔ ∀ (i : ι), x ∈ S i :=
  sorry

@[simp] theorem Mathlib.add_submonoid.coe_infi {M : Type u_1} [add_monoid M] {ι : Sort u_2}
    {S : ι → add_submonoid M} : ↑(infi fun (i : ι) => S i) = set.Inter fun (i : ι) => ↑(S i) :=
  sorry

/-- Submonoids of a monoid form a complete lattice. -/
protected instance complete_lattice {M : Type u_1} [monoid M] : complete_lattice (submonoid M) :=
  complete_lattice.mk complete_lattice.sup LessEq Less sorry sorry sorry sorry sorry sorry
    has_inf.inf sorry sorry sorry ⊤ sorry ⊥ sorry complete_lattice.Sup Inf sorry sorry sorry sorry

theorem subsingleton_iff {M : Type u_1} [monoid M] : subsingleton M ↔ subsingleton (submonoid M) :=
  sorry

theorem nontrivial_iff {M : Type u_1} [monoid M] : nontrivial M ↔ nontrivial (submonoid M) :=
  iff.mp not_iff_not
    (iff.trans (iff.trans not_nontrivial_iff_subsingleton subsingleton_iff)
      (iff.symm not_nontrivial_iff_subsingleton))

protected instance subsingleton {M : Type u_1} [monoid M] [subsingleton M] :
    subsingleton (submonoid M) :=
  iff.mp subsingleton_iff _inst_3

protected instance nontrivial {M : Type u_1} [monoid M] [nontrivial M] : nontrivial (submonoid M) :=
  iff.mp nontrivial_iff _inst_3

/-- The `submonoid` generated by a set. -/
def Mathlib.add_submonoid.closure {M : Type u_1} [add_monoid M] (s : set M) : add_submonoid M :=
  Inf (set_of fun (S : add_submonoid M) => s ⊆ ↑S)

theorem mem_closure {M : Type u_1} [monoid M] {s : set M} {x : M} :
    x ∈ closure s ↔ ∀ (S : submonoid M), s ⊆ ↑S → x ∈ S :=
  mem_Inf

/-- The submonoid generated by a set includes the set. -/
@[simp] theorem subset_closure {M : Type u_1} [monoid M] {s : set M} : s ⊆ ↑(closure s) :=
  fun (x : M) (hx : x ∈ s) => iff.mpr mem_closure fun (S : submonoid M) (hS : s ⊆ ↑S) => hS hx

/-- A submonoid `S` includes `closure s` if and only if it includes `s`. -/
@[simp] theorem closure_le {M : Type u_1} [monoid M] {s : set M} {S : submonoid M} :
    closure s ≤ S ↔ s ⊆ ↑S :=
  { mp := set.subset.trans subset_closure, mpr := fun (h : s ⊆ ↑S) => Inf_le h }

/-- Submonoid closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
theorem Mathlib.add_submonoid.closure_mono {M : Type u_1} [add_monoid M] {s : set M} {t : set M}
    (h : s ⊆ t) : add_submonoid.closure s ≤ add_submonoid.closure t :=
  iff.mpr add_submonoid.closure_le (set.subset.trans h add_submonoid.subset_closure)

theorem Mathlib.add_submonoid.closure_eq_of_le {M : Type u_1} [add_monoid M] {s : set M}
    {S : add_submonoid M} (h₁ : s ⊆ ↑S) (h₂ : S ≤ add_submonoid.closure s) :
    add_submonoid.closure s = S :=
  le_antisymm (iff.mpr add_submonoid.closure_le h₁) h₂

/-- An induction principle for closure membership. If `p` holds for `1` and all elements of `s`, and
is preserved under multiplication, then `p` holds for all elements of the closure of `s`. -/
theorem closure_induction {M : Type u_1} [monoid M] {s : set M} {p : M → Prop} {x : M}
    (h : x ∈ closure s) (Hs : ∀ (x : M), x ∈ s → p x) (H1 : p 1)
    (Hmul : ∀ (x y : M), p x → p y → p (x * y)) : p x :=
  iff.mpr closure_le Hs x h

/-- If `s` is a dense set in a monoid `M`, `submonoid.closure s = ⊤`, then in order to prove that
some predicate `p` holds for all `x : M` it suffices to verify `p x` for `x ∈ s`, verify `p 1`,
and verify that `p x` and `p y` imply `p (x * y)`. -/
theorem dense_induction {M : Type u_1} [monoid M] {p : M → Prop} (x : M) {s : set M}
    (hs : closure s = ⊤) (Hs : ∀ (x : M), x ∈ s → p x) (H1 : p 1)
    (Hmul : ∀ (x y : M), p x → p y → p (x * y)) : p x :=
  sorry

/-- If `s` is a dense set in an additive monoid `M`, `add_submonoid.closure s = ⊤`, then in order
to prove that some predicate `p` holds for all `x : M` it suffices to verify `p x` for `x ∈ s`,
verify `p 0`, and verify that `p x` and `p y` imply `p (x + y)`. -/
/-- `closure` forms a Galois insertion with the coercion to set. -/
protected def gi (M : Type u_1) [monoid M] : galois_insertion closure coe :=
  galois_insertion.mk (fun (s : set M) (_x : ↑(closure s) ≤ s) => closure s) sorry sorry sorry

/-- Closure of a submonoid `S` equals `S`. -/
@[simp] theorem closure_eq {M : Type u_1} [monoid M] (S : submonoid M) : closure ↑S = S :=
  galois_insertion.l_u_eq (submonoid.gi M) S

@[simp] theorem closure_empty {M : Type u_1} [monoid M] : closure ∅ = ⊥ :=
  galois_connection.l_bot (galois_insertion.gc (submonoid.gi M))

@[simp] theorem closure_univ {M : Type u_1} [monoid M] : closure set.univ = ⊤ :=
  coe_top ▸ closure_eq ⊤

theorem Mathlib.add_submonoid.closure_union {M : Type u_1} [add_monoid M] (s : set M) (t : set M) :
    add_submonoid.closure (s ∪ t) = add_submonoid.closure s ⊔ add_submonoid.closure t :=
  galois_connection.l_sup (galois_insertion.gc (add_submonoid.gi M))

theorem closure_Union {M : Type u_1} [monoid M] {ι : Sort u_2} (s : ι → set M) :
    closure (set.Union fun (i : ι) => s i) = supr fun (i : ι) => closure (s i) :=
  galois_connection.l_supr (galois_insertion.gc (submonoid.gi M))

end submonoid

/-- The submonoid consisting of the units of a monoid -/
def is_unit.submonoid (M : Type u_1) [monoid M] : submonoid M :=
  submonoid.mk (set_of is_unit) sorry sorry

theorem is_unit.mem_submonoid_iff {M : Type u_1} [monoid M] (a : M) :
    a ∈ is_unit.submonoid M ↔ is_unit a :=
  id
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ set_of is_unit ↔ is_unit a)) set.mem_set_of_eq))
      (iff.refl (is_unit a)))

namespace monoid_hom

/-- The submonoid of elements `x : M` such that `f x = g x` -/
def eq_mlocus {M : Type u_1} [monoid M] {N : Type u_3} [monoid N] (f : M →* N) (g : M →* N) :
    submonoid M :=
  submonoid.mk (set_of fun (x : M) => coe_fn f x = coe_fn g x) sorry sorry

/-- If two monoid homomorphisms are equal on a set, then they are equal on its submonoid closure. -/
theorem Mathlib.add_monoid_hom.eq_on_mclosure {M : Type u_1} [add_monoid M] {N : Type u_3}
    [add_monoid N] {f : M →+ N} {g : M →+ N} {s : set M} (h : set.eq_on (⇑f) (⇑g) s) :
    set.eq_on ⇑f ⇑g ↑(add_submonoid.closure s) :=
  (fun (this : add_submonoid.closure s ≤ add_monoid_hom.eq_mlocus f g) => this)
    (iff.mpr add_submonoid.closure_le h)

theorem Mathlib.add_monoid_hom.eq_of_eq_on_mtop {M : Type u_1} [add_monoid M] {N : Type u_3}
    [add_monoid N] {f : M →+ N} {g : M →+ N} (h : set.eq_on ⇑f ⇑g ↑⊤) : f = g :=
  add_monoid_hom.ext fun (x : M) => h trivial

theorem eq_of_eq_on_mdense {M : Type u_1} [monoid M] {N : Type u_3} [monoid N] {s : set M}
    (hs : submonoid.closure s = ⊤) {f : M →* N} {g : M →* N} (h : set.eq_on (⇑f) (⇑g) s) : f = g :=
  eq_of_eq_on_mtop (hs ▸ eq_on_mclosure h)

/-- Let `s` be a subset of a monoid `M` such that the closure of `s` is the whole monoid.
Then `monoid_hom.of_mdense` defines a monoid homomorphism from `M` asking for a proof
of `f (x * y) = f x * f y` only for `y ∈ s`. -/
def of_mdense {M : Type u_1} [monoid M] {s : set M} {N : Type u_3} [monoid N] (f : M → N)
    (hs : submonoid.closure s = ⊤) (h1 : f 1 = 1)
    (hmul : ∀ (x y : M), y ∈ s → f (x * y) = f x * f y) : M →* N :=
  mk f h1 sorry

/-- Let `s` be a subset of an additive monoid `M` such that the closure of `s` is the whole monoid.
Then `add_monoid_hom.of_mdense` defines an additive monoid homomorphism from `M` asking for a proof
of `f (x + y) = f x + f y` only for `y ∈ s`. -/
@[simp] theorem coe_of_mdense {M : Type u_1} [monoid M] {s : set M} {N : Type u_3} [monoid N]
    (f : M → N) (hs : submonoid.closure s = ⊤) (h1 : f 1 = 1)
    (hmul : ∀ (x y : M), y ∈ s → f (x * y) = f x * f y) : ⇑(of_mdense f hs h1 hmul) = f :=
  rfl

end Mathlib


/-
Copyright (c) 2019 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo, Yury Kudryashov
-/
import analysis.normed_space.basic
import topology.metric_space.hausdorff_distance

/-!
# Applications of the Hausdorff distance in normed spaces

Riesz's lemma, stated for a normed space over a normed field: for any
closed proper subspace `F` of `E`, there is a nonzero `x` such that `‖x - F‖`
is at least `r * ‖x‖` for any `r < 1`. This is `riesz_lemma`.

In a nontrivially normed field (with an element `c` of norm `> 1`) and any `R > ‖c‖`, one can
guarantee `‖x‖ ≤ R` and `‖x - y‖ ≥ 1` for any `y` in `F`. This is `riesz_lemma_of_norm_lt`.

A further lemma, `metric.closed_ball_inf_dist_compl_subset_closure`, finds a *closed* ball within
the closure of a set `s` of optimal distance from a point in `x` to the frontier of `s`.
-/

open set metric
open_locale topology

variables {𝕜 : Type*} [normed_field 𝕜]
variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
variables {F : Type*} [seminormed_add_comm_group F] [normed_space ℝ F]

/-- Riesz's lemma, which usually states that it is possible to find a
vector with norm 1 whose distance to a closed proper subspace is
arbitrarily close to 1. The statement here is in terms of multiples of
norms, since in general the existence of an element of norm exactly 1
is not guaranteed. For a variant giving an element with norm in `[1, R]`, see
`riesz_lemma_of_norm_lt`. -/
lemma riesz_lemma {F : subspace 𝕜 E} (hFc : is_closed (F : set E))
  (hF : ∃ x : E, x ∉ F) {r : ℝ} (hr : r < 1) :
  ∃ x₀ : E, x₀ ∉ F ∧ ∀ y ∈ F, r * ‖x₀‖ ≤ ‖x₀ - y‖ :=
begin
  classical,
  obtain ⟨x, hx⟩ : ∃ x : E, x ∉ F := hF,
  let d := metric.inf_dist x F,
  have hFn : (F : set E).nonempty, from ⟨_, F.zero_mem⟩,
  have hdp : 0 < d,
    from lt_of_le_of_ne metric.inf_dist_nonneg (λ heq, hx
    ((hFc.mem_iff_inf_dist_zero hFn).2 heq.symm)),
  let r' := max r 2⁻¹,
  have hr' : r' < 1, by { simp [r', hr], norm_num },
  have hlt : 0 < r' := lt_of_lt_of_le (by norm_num) (le_max_right r 2⁻¹),
  have hdlt : d < d / r', from (lt_div_iff hlt).mpr ((mul_lt_iff_lt_one_right hdp).2 hr'),
  obtain ⟨y₀, hy₀F, hxy₀⟩ : ∃ y ∈ F, dist x y < d / r' := (metric.inf_dist_lt_iff hFn).mp hdlt,
  have x_ne_y₀ : x - y₀ ∉ F,
  { by_contradiction h,
    have : (x - y₀) + y₀ ∈ F, from F.add_mem h hy₀F,
    simp only [neg_add_cancel_right, sub_eq_add_neg] at this,
    exact hx this },
  refine ⟨x - y₀, x_ne_y₀, λy hy, le_of_lt _⟩,
  have hy₀y : y₀ + y ∈ F, from F.add_mem hy₀F hy,
  calc
    r * ‖x - y₀‖ ≤ r' * ‖x - y₀‖ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _)
    ... < d : by { rw ←dist_eq_norm, exact (lt_div_iff' hlt).1 hxy₀ }
    ... ≤ dist x (y₀ + y) : metric.inf_dist_le_dist_of_mem hy₀y
    ... = ‖x - y₀ - y‖ : by { rw [sub_sub, dist_eq_norm] }
end

/--
A version of Riesz lemma: given a strict closed subspace `F`, one may find an element of norm `≤ R`
which is at distance  at least `1` of every element of `F`. Here, `R` is any given constant
strictly larger than the norm of an element of norm `> 1`. For a version without an `R`, see
`riesz_lemma`.

Since we are considering a general nontrivially normed field, there may be a gap in possible norms
(for instance no element of norm in `(1,2)`). Hence, we can not allow `R` arbitrarily close to `1`,
and require `R > ‖c‖` for some `c : 𝕜` with norm `> 1`.
-/
lemma riesz_lemma_of_norm_lt
  {c : 𝕜} (hc : 1 < ‖c‖) {R : ℝ} (hR : ‖c‖ < R)
  {F : subspace 𝕜 E} (hFc : is_closed (F : set E)) (hF : ∃ x : E, x ∉ F) :
  ∃ x₀ : E, ‖x₀‖ ≤ R ∧ ∀ y ∈ F, 1 ≤ ‖x₀ - y‖ :=
begin
  have Rpos : 0 < R := (norm_nonneg _).trans_lt hR,
  have : ‖c‖ / R < 1, by { rw div_lt_iff Rpos, simpa using hR },
  rcases riesz_lemma hFc hF this with ⟨x, xF, hx⟩,
  have x0 : x ≠ 0 := λ H, by simpa [H] using xF,
  obtain ⟨d, d0, dxlt, ledx, -⟩ :
    ∃ (d : 𝕜), d ≠ 0 ∧ ‖d • x‖ < R ∧ R / ‖c‖ ≤ ‖d • x‖ ∧ ‖d‖⁻¹ ≤ R⁻¹ * ‖c‖ * ‖x‖ :=
      rescale_to_shell hc Rpos x0,
  refine ⟨d • x, dxlt.le, λ y hy, _⟩,
  set y' := d⁻¹ • y with hy',
  have y'F : y' ∈ F, by simp [hy', submodule.smul_mem _ _ hy],
  have yy' : y = d • y', by simp [hy', smul_smul, mul_inv_cancel d0],
  calc 1 = (‖c‖/R) * (R/‖c‖) : by field_simp [Rpos.ne', (zero_lt_one.trans hc).ne']
  ... ≤ (‖c‖/R) * (‖d • x‖) :
    mul_le_mul_of_nonneg_left ledx (div_nonneg (norm_nonneg _) Rpos.le)
  ... = ‖d‖ * (‖c‖/R * ‖x‖) : by { simp [norm_smul], ring }
  ... ≤ ‖d‖ * ‖x - y'‖ :
    mul_le_mul_of_nonneg_left (hx y' (by simp [hy', submodule.smul_mem _ _ hy])) (norm_nonneg _)
  ... = ‖d • x - y‖ : by simp [yy', ← smul_sub, norm_smul],
end

lemma metric.closed_ball_inf_dist_compl_subset_closure {x : F} {s : set F} (hx : x ∈ s) :
  closed_ball x (inf_dist x sᶜ) ⊆ closure s :=
begin
  cases eq_or_ne (inf_dist x sᶜ) 0 with h₀ h₀,
  { rw [h₀, closed_ball_zero'],
    exact closure_mono (singleton_subset_iff.2 hx) },
  { rw ← closure_ball x h₀,
    exact closure_mono ball_inf_dist_compl_subset }
end


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Johan Commelin, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.ordered_group
import Mathlib.algebra.group_with_zero.default
import Mathlib.algebra.group_with_zero.power
import Mathlib.tactic.abel
import Mathlib.PostPort

universes u_1 l u_2

namespace Mathlib

/-!
# Linearly ordered commutative groups and monoids with a zero element adjoined

This file sets up a special class of linearly ordered commutative monoids
that show up as the target of so-called “valuations” in algebraic number theory.

Usually, in the informal literature, these objects are constructed
by taking a linearly ordered commutative group Γ and formally adjoining a zero element: Γ ∪ {0}.

The disadvantage is that a type such as `nnreal` is not of that form,
whereas it is a very common target for valuations.
The solutions is to use a typeclass, and that is exactly what we do in this file.

Note that to avoid issues with import cycles, `linear_ordered_comm_monoid_with_zero` is defined
in another file. However, the lemmas about it are stated here.
-/

/-- A linearly ordered commutative group with a zero element. -/
class linear_ordered_comm_group_with_zero (α : Type u_1)
extends comm_group_with_zero α, linear_ordered_comm_monoid_with_zero α
where

/-
The following facts are true more generally in a (linearly) ordered commutative monoid.
-/

theorem one_le_pow_of_one_le' {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ} (H : 1 ≤ x) : 1 ≤ x ^ n :=
  Nat.rec (le_refl 1) (fun (n : ℕ) (ih : 1 ≤ x ^ n) => one_le_mul H ih) n

theorem pow_le_one_of_le_one {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ} (H : x ≤ 1) : x ^ n ≤ 1 :=
  Nat.rec (le_refl 1) (fun (n : ℕ) (ih : x ^ n ≤ 1) => mul_le_one' H ih) n

theorem eq_one_of_pow_eq_one {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ} (hn : n ≠ 0) (H : x ^ n = 1) : x = 1 := sorry

theorem pow_eq_one_iff {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ} (hn : n ≠ 0) : x ^ n = 1 ↔ x = 1 :=
  { mp := eq_one_of_pow_eq_one hn, mpr := fun (ᾰ : x = 1) => Eq._oldrec (one_pow n) (Eq.symm ᾰ) }

theorem one_le_pow_iff {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ} (hn : n ≠ 0) : 1 ≤ x ^ n ↔ 1 ≤ x := sorry

theorem pow_le_one_iff {α : Type u_1} {x : α} [linear_ordered_comm_monoid_with_zero α] {n : ℕ} (hn : n ≠ 0) : x ^ n ≤ 1 ↔ x ≤ 1 := sorry

theorem zero_le_one' {α : Type u_1} [linear_ordered_comm_monoid_with_zero α] : 0 ≤ 1 :=
  linear_ordered_comm_monoid_with_zero.zero_le_one

@[simp] theorem zero_le' {α : Type u_1} {a : α} [linear_ordered_comm_monoid_with_zero α] : 0 ≤ a := sorry

@[simp] theorem not_lt_zero' {α : Type u_1} {a : α} [linear_ordered_comm_monoid_with_zero α] : ¬a < 0 :=
  not_lt_of_le zero_le'

@[simp] theorem le_zero_iff {α : Type u_1} {a : α} [linear_ordered_comm_monoid_with_zero α] : a ≤ 0 ↔ a = 0 :=
  { mp := fun (h : a ≤ 0) => le_antisymm h zero_le', mpr := fun (h : a = 0) => h ▸ le_refl a }

theorem zero_lt_iff {α : Type u_1} {a : α} [linear_ordered_comm_monoid_with_zero α] : 0 < a ↔ a ≠ 0 :=
  { mp := ne_of_gt, mpr := fun (h : a ≠ 0) => lt_of_le_of_ne zero_le' (ne.symm h) }

theorem ne_zero_of_lt {α : Type u_1} {a : α} {b : α} [linear_ordered_comm_monoid_with_zero α] (h : b < a) : a ≠ 0 :=
  fun (h1 : a = 0) => not_lt_zero' ((fun (this : b < 0) => this) (h1 ▸ h))

theorem zero_lt_one'' {α : Type u_1} [linear_ordered_comm_group_with_zero α] : 0 < 1 :=
  lt_of_le_of_ne zero_le_one' zero_ne_one

theorem le_of_le_mul_right {α : Type u_1} {a : α} {b : α} {c : α} [linear_ordered_comm_group_with_zero α] (h : c ≠ 0) (hab : a * c ≤ b * c) : a ≤ b := sorry

theorem le_mul_inv_of_mul_le {α : Type u_1} {a : α} {b : α} {c : α} [linear_ordered_comm_group_with_zero α] (h : c ≠ 0) (hab : a * c ≤ b) : a ≤ b * (c⁻¹) := sorry

theorem mul_inv_le_of_le_mul {α : Type u_1} {a : α} {b : α} {c : α} [linear_ordered_comm_group_with_zero α] (h : c ≠ 0) (hab : a ≤ b * c) : a * (c⁻¹) ≤ b := sorry

theorem div_le_div' {α : Type u_1} [linear_ordered_comm_group_with_zero α] (a : α) (b : α) (c : α) (d : α) (hb : b ≠ 0) (hd : d ≠ 0) : a * (b⁻¹) ≤ c * (d⁻¹) ↔ a * d ≤ c * b := sorry

@[simp] theorem units.zero_lt {α : Type u_1} [linear_ordered_comm_group_with_zero α] (u : units α) : 0 < ↑u :=
  iff.mpr zero_lt_iff (units.ne_zero u)

theorem mul_lt_mul'''' {α : Type u_1} {a : α} {b : α} {c : α} {d : α} [linear_ordered_comm_group_with_zero α] (hab : a < b) (hcd : c < d) : a * c < b * d := sorry

theorem mul_inv_lt_of_lt_mul' {α : Type u_1} {x : α} {y : α} {z : α} [linear_ordered_comm_group_with_zero α] (h : x < y * z) : x * (z⁻¹) < y := sorry

theorem mul_lt_right' {α : Type u_1} {a : α} {b : α} [linear_ordered_comm_group_with_zero α] (c : α) (h : a < b) (hc : c ≠ 0) : a * c < b * c := sorry

theorem pow_lt_pow_succ {α : Type u_1} [linear_ordered_comm_group_with_zero α] {x : α} {n : ℕ} (hx : 1 < x) : x ^ n < x ^ Nat.succ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ^ n < x ^ Nat.succ n)) (Eq.symm (one_mul (x ^ n)))))
    (mul_lt_right' (x ^ n) hx (pow_ne_zero n (ne_of_gt (lt_trans zero_lt_one'' hx))))

theorem pow_lt_pow' {α : Type u_1} [linear_ordered_comm_group_with_zero α] {x : α} {m : ℕ} {n : ℕ} (hx : 1 < x) (hmn : m < n) : x ^ m < x ^ n :=
  nat.less_than_or_equal.drec (pow_lt_pow_succ hx)
    (fun {n : ℕ} (hmn : nat.less_than_or_equal (Nat.succ m) n) (ih : x ^ m < x ^ n) => lt_trans ih (pow_lt_pow_succ hx))
    hmn

theorem inv_lt_inv'' {α : Type u_1} {a : α} {b : α} [linear_ordered_comm_group_with_zero α] (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ < (b⁻¹) ↔ b < a :=
  inv_lt_inv_iff

theorem inv_le_inv'' {α : Type u_1} {a : α} {b : α} [linear_ordered_comm_group_with_zero α] (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ ≤ (b⁻¹) ↔ b ≤ a :=
  inv_le_inv_iff

namespace monoid_hom

theorem map_neg_one {α : Type u_1} [linear_ordered_comm_group_with_zero α] {R : Type u_2} [ring R] (f : R →* α) : coe_fn f (-1) = 1 := sorry

@[simp] theorem map_neg {α : Type u_1} [linear_ordered_comm_group_with_zero α] {R : Type u_2} [ring R] (f : R →* α) (x : R) : coe_fn f (-x) = coe_fn f x := sorry

theorem map_sub_swap {α : Type u_1} [linear_ordered_comm_group_with_zero α] {R : Type u_2} [ring R] (f : R →* α) (x : R) (y : R) : coe_fn f (x - y) = coe_fn f (y - x) := sorry


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kenny Lau
-/
import data.int.basic
import data.list.range

namespace int

local attribute [semireducible] int.nonneg

/-- List enumerating `[m, n)`. -/
def range (m n : ℤ) : list ℤ :=
(list.range (to_nat (n-m))).map $ λ r, m+r

theorem mem_range_iff {m n r : ℤ} : r ∈ range m n ↔ m ≤ r ∧ r < n :=
⟨λ H, let ⟨s, h1, h2⟩ := list.mem_map.1 H in h2 ▸
  ⟨le_add_of_nonneg_right trivial,
  add_lt_of_lt_sub_left $ match n-m, h1 with
    | (k:ℕ), h1 := by rwa [list.mem_range, to_nat_coe_nat, ← coe_nat_lt] at h1
    end⟩,
λ ⟨h1, h2⟩, list.mem_map.2 ⟨to_nat (r-m),
  list.mem_range.2 $ by rw [← coe_nat_lt, to_nat_of_nonneg (sub_nonneg_of_le h1),
      to_nat_of_nonneg (sub_nonneg_of_le (le_of_lt (lt_of_le_of_lt h1 h2)))];
    exact sub_lt_sub_right h2 _,
  show m + _ = _, by rw [to_nat_of_nonneg (sub_nonneg_of_le h1), add_sub_cancel'_right]⟩⟩

instance decidable_le_lt (P : int → Prop) [decidable_pred P] (m n : ℤ) :
  decidable (∀ r, m ≤ r → r < n → P r) :=
decidable_of_iff (∀ r ∈ range m n, P r) $ by simp only [mem_range_iff, and_imp]

instance decidable_le_le (P : int → Prop) [decidable_pred P] (m n : ℤ) :
  decidable (∀ r, m ≤ r → r ≤ n → P r) :=
decidable_of_iff (∀ r ∈ range m (n+1), P r) $ by simp only [mem_range_iff, and_imp, lt_add_one_iff]

instance decidable_lt_lt (P : int → Prop) [decidable_pred P] (m n : ℤ) :
  decidable (∀ r, m < r → r < n → P r) :=
int.decidable_le_lt P _ _

instance decidable_lt_le (P : int → Prop) [decidable_pred P] (m n : ℤ) :
  decidable (∀ r, m < r → r ≤ n → P r) :=
int.decidable_le_le P _ _

end int


import mynat.le

namespace mynat

def lt (a b : mynat) := a ≤ b ∧ ¬ (b ≤ a)

-- notation
instance : has_lt mynat := ⟨mynat.lt⟩

@[leakage] theorem lt_def' : mynat.lt = (<) := rfl

end mynat


import minimal_sub_pq

universe u

section eta_injective_pq

def eta_injective (Q : Type u) [power_quandle Q] : Prop := function.injective (of : Q → pq_group Q)

variables {Q : Type u} [power_quandle Q]

noncomputable def eta_injective_iso_sub_pq (hQ : eta_injective Q) : Q ≃ gen_group_sub_pq (@of_gen_group_sub_pq Q _) :=
begin
  fapply equiv.of_bijective,
  {
    intro q,
    fconstructor,
    exact of q,
    use q,
  },
  {
    split,
    {
      intros x y hxy,
      apply hQ,
      simp only [subtype.mk_eq_mk] at hxy,
      exact hxy,
    },
    {
      intro x,
      cases x with x hx,
      cases hx with q hq,
      use q,
      simp only [subtype.mk_eq_mk],
      rw hq,
    },
  },
end

theorem eta_injective_iso_sub_pq_is_pq_morphism (hQ : eta_injective Q) : is_pq_morphism (eta_injective_iso_sub_pq hQ) :=
begin
  split,
  {
    intros a b,
    unfold eta_injective_iso_sub_pq,
    simp only [equiv.of_bijective_apply],
    simp_rw ←rhd_of_eq_of_rhd,
    refl,
  },
  {
    intros a n,
    unfold eta_injective_iso_sub_pq,
    simp only [equiv.of_bijective_apply],
    simp_rw of_pow_eq_pow_of,
    refl,
  },
end

end eta_injective_pq