/-
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

! This file was ported from Lean 3 source module algebra.algebra.subalgebra.basic
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Basic
import Mathlib.Data.Set.UnionLift
import Mathlib.LinearAlgebra.Finsupp
import Mathlib.RingTheory.Ideal.Operations

/-!
# Subalgebras over Commutative Semiring

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

More lemmas about `adjoin` can be found in `RingTheory.Adjoin`.
-/

universe u u' v w w'

open BigOperators

/-- A subalgebra is a sub(semi)ring that includes the range of `algebraMap`. -/
structure Subalgebra (R : Type u) (A : Type v) [CommSemiring R] [Semiring A] [Algebra R A] extends
  Subsemiring A : Type v where
  /-- The image of `algebraMap` is contained in the underlying set of the subalgebra -/
  algebraMap_mem' : ∀ r, algebraMap R A r ∈ carrier
  zero_mem' := (algebraMap R A).map_zero ▸ algebraMap_mem' 0
  one_mem' := (algebraMap R A).map_one ▸ algebraMap_mem' 1
#align subalgebra Subalgebra

/-- Reinterpret a `Subalgebra` as a `Subsemiring`. -/
add_decl_doc Subalgebra.toSubsemiring

namespace Subalgebra

variable {R' : Type u'} {R : Type u} {A : Type v} {B : Type w} {C : Type w'}

variable [CommSemiring R]

variable [Semiring A] [Algebra R A] [Semiring B] [Algebra R B] [Semiring C] [Algebra R C]

instance : SetLike (Subalgebra R A) A where
  coe s := s.carrier
  coe_injective' p q h := by cases p; cases q; congr; exact SetLike.coe_injective' h

instance SubsemiringClass : SubsemiringClass (Subalgebra R A) A where
  add_mem {s} := add_mem (s := s.toSubsemiring)
  mul_mem {s} := mul_mem (s := s.toSubsemiring)
  one_mem {s} := one_mem s.toSubsemiring
  zero_mem {s} := zero_mem s.toSubsemiring

@[simp]
theorem mem_toSubsemiring {S : Subalgebra R A} {x} : x ∈ S.toSubsemiring ↔ x ∈ S :=
  Iff.rfl
#align subalgebra.mem_to_subsemiring Subalgebra.mem_toSubsemiring

-- @[simp] -- Porting note: simp can prove this
theorem mem_carrier {s : Subalgebra R A} {x : A} : x ∈ s.carrier ↔ x ∈ s :=
  Iff.rfl
#align subalgebra.mem_carrier Subalgebra.mem_carrier

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

@[simp]
theorem coe_toSubsemiring (S : Subalgebra R A) : (↑S.toSubsemiring : Set A) = S :=
  rfl
#align subalgebra.coe_to_subsemiring Subalgebra.coe_toSubsemiring

theorem toSubsemiring_injective :
    Function.Injective (toSubsemiring : Subalgebra R A → Subsemiring A) := fun S T h =>
  ext fun x => by rw [← mem_toSubsemiring, ← mem_toSubsemiring, h]
#align subalgebra.to_subsemiring_injective Subalgebra.toSubsemiring_injective

theorem toSubsemiring_inj {S U : Subalgebra R A} : S.toSubsemiring = U.toSubsemiring ↔ S = U :=
  toSubsemiring_injective.eq_iff
#align subalgebra.to_subsemiring_inj Subalgebra.toSubsemiring_inj

/-- Copy of a subalgebra with a new `carrier` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (S : Subalgebra R A) (s : Set A) (hs : s = ↑S) : Subalgebra R A :=
  { S.toSubsemiring.copy s hs with
    carrier := s
    algebraMap_mem' := hs.symm ▸ S.algebraMap_mem' }
#align subalgebra.copy Subalgebra.copy

@[simp]
theorem coe_copy (S : Subalgebra R A) (s : Set A) (hs : s = ↑S) : (S.copy s hs : Set A) = s :=
  rfl
#align subalgebra.coe_copy Subalgebra.coe_copy

theorem copy_eq (S : Subalgebra R A) (s : Set A) (hs : s = ↑S) : S.copy s hs = S :=
  SetLike.coe_injective hs
#align subalgebra.copy_eq Subalgebra.copy_eq

variable (S : Subalgebra R A)

theorem algebraMap_mem (r : R) : algebraMap R A r ∈ S :=
  S.algebraMap_mem' r
#align subalgebra.algebra_map_mem Subalgebra.algebraMap_mem

theorem rangeS_le : (algebraMap R A).rangeS ≤ S.toSubsemiring := fun _x ⟨r, hr⟩ =>
  hr ▸ S.algebraMap_mem r
#align subalgebra.srange_le Subalgebra.rangeS_le

theorem range_subset : Set.range (algebraMap R A) ⊆ S := fun _x ⟨r, hr⟩ => hr ▸ S.algebraMap_mem r
#align subalgebra.range_subset Subalgebra.range_subset

theorem range_le : Set.range (algebraMap R A) ≤ S :=
  S.range_subset
#align subalgebra.range_le Subalgebra.range_le

theorem smul_mem {x : A} (hx : x ∈ S) (r : R) : r • x ∈ S :=
  (Algebra.smul_def r x).symm ▸ mul_mem (S.algebraMap_mem r) hx
#align subalgebra.smul_mem Subalgebra.smul_mem

protected theorem one_mem : (1 : A) ∈ S :=
  one_mem S
#align subalgebra.one_mem Subalgebra.one_mem

protected theorem mul_mem {x y : A} (hx : x ∈ S) (hy : y ∈ S) : x * y ∈ S :=
  mul_mem hx hy
#align subalgebra.mul_mem Subalgebra.mul_mem

protected theorem pow_mem {x : A} (hx : x ∈ S) (n : ℕ) : x ^ n ∈ S :=
  pow_mem hx n
#align subalgebra.pow_mem Subalgebra.pow_mem

protected theorem zero_mem : (0 : A) ∈ S :=
  zero_mem S
#align subalgebra.zero_mem Subalgebra.zero_mem

protected theorem add_mem {x y : A} (hx : x ∈ S) (hy : y ∈ S) : x + y ∈ S :=
  add_mem hx hy
#align subalgebra.add_mem Subalgebra.add_mem

protected theorem nsmul_mem {x : A} (hx : x ∈ S) (n : ℕ) : n • x ∈ S :=
  nsmul_mem hx n
#align subalgebra.nsmul_mem Subalgebra.nsmul_mem

protected theorem coe_nat_mem (n : ℕ) : (n : A) ∈ S :=
  coe_nat_mem S n
#align subalgebra.coe_nat_mem Subalgebra.coe_nat_mem

protected theorem list_prod_mem {L : List A} (h : ∀ x ∈ L, x ∈ S) : L.prod ∈ S :=
  list_prod_mem h
#align subalgebra.list_prod_mem Subalgebra.list_prod_mem

protected theorem list_sum_mem {L : List A} (h : ∀ x ∈ L, x ∈ S) : L.sum ∈ S :=
  list_sum_mem h
#align subalgebra.list_sum_mem Subalgebra.list_sum_mem

protected theorem multiset_sum_mem {m : Multiset A} (h : ∀ x ∈ m, x ∈ S) : m.sum ∈ S :=
  multiset_sum_mem m h
#align subalgebra.multiset_sum_mem Subalgebra.multiset_sum_mem

protected theorem sum_mem {ι : Type w} {t : Finset ι} {f : ι → A} (h : ∀ x ∈ t, f x ∈ S) :
    (∑ x in t, f x) ∈ S :=
  sum_mem h
#align subalgebra.sum_mem Subalgebra.sum_mem

protected theorem multiset_prod_mem {R : Type u} {A : Type v} [CommSemiring R] [CommSemiring A]
    [Algebra R A] (S : Subalgebra R A) {m : Multiset A} (h : ∀ x ∈ m, x ∈ S) : m.prod ∈ S :=
  multiset_prod_mem m h
#align subalgebra.multiset_prod_mem Subalgebra.multiset_prod_mem

protected theorem prod_mem {R : Type u} {A : Type v} [CommSemiring R] [CommSemiring A] [Algebra R A]
    (S : Subalgebra R A) {ι : Type w} {t : Finset ι} {f : ι → A} (h : ∀ x ∈ t, f x ∈ S) :
    (∏ x in t, f x) ∈ S :=
  prod_mem h
#align subalgebra.prod_mem Subalgebra.prod_mem

-- instance : Module R A := Algebra.toModule -- Porting note: doesn't help
set_option synthInstance.etaExperiment true in
instance {R A : Type _} [CommRing R] [Ring A] [Algebra R A] : SubringClass (Subalgebra R A) A :=
  { Subalgebra.SubsemiringClass with
    neg_mem := fun {S x} hx => neg_one_smul R x ▸ S.smul_mem hx _ }

protected theorem neg_mem {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A]
    (S : Subalgebra R A) {x : A} (hx : x ∈ S) : -x ∈ S :=
  neg_mem hx
#align subalgebra.neg_mem Subalgebra.neg_mem

protected theorem sub_mem {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A]
    (S : Subalgebra R A) {x y : A} (hx : x ∈ S) (hy : y ∈ S) : x - y ∈ S :=
  sub_mem hx hy
#align subalgebra.sub_mem Subalgebra.sub_mem

protected theorem zsmul_mem {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A]
    (S : Subalgebra R A) {x : A} (hx : x ∈ S) (n : ℤ) : n • x ∈ S :=
  zsmul_mem hx n
#align subalgebra.zsmul_mem Subalgebra.zsmul_mem

protected theorem coe_int_mem {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A]
    (S : Subalgebra R A) (n : ℤ) : (n : A) ∈ S :=
  coe_int_mem S n
#align subalgebra.coe_int_mem Subalgebra.coe_int_mem

/-- The projection from a subalgebra of `A` to an additive submonoid of `A`. -/
def toAddSubmonoid {R : Type u} {A : Type v} [CommSemiring R] [Semiring A] [Algebra R A]
    (S : Subalgebra R A) : AddSubmonoid A :=
  S.toSubsemiring.toAddSubmonoid
#align subalgebra.to_add_submonoid Subalgebra.toAddSubmonoid

-- Porting note: this field already exists in Lean 4.
-- /-- The projection from a subalgebra of `A` to a submonoid of `A`. -/
-- def toSubmonoid {R : Type u} {A : Type v} [CommSemiring R] [Semiring A] [Algebra R A]
--     (S : Subalgebra R A) : Submonoid A :=
--   S.toSubsemiring.toSubmonoid
set_option align.precheck false in
#align subalgebra.to_submonoid Subalgebra.toSubmonoid

/-- A subalgebra over a ring is also a `Subring`. -/
def toSubring {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A] (S : Subalgebra R A) :
    Subring A :=
  { S.toSubsemiring with neg_mem' := S.neg_mem }
#align subalgebra.to_subring Subalgebra.toSubring

@[simp]
theorem mem_toSubring {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A]
    {S : Subalgebra R A} {x} : x ∈ S.toSubring ↔ x ∈ S :=
  Iff.rfl
#align subalgebra.mem_to_subring Subalgebra.mem_toSubring

@[simp]
theorem coe_toSubring {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A]
    (S : Subalgebra R A) : (↑S.toSubring : Set A) = S :=
  rfl
#align subalgebra.coe_to_subring Subalgebra.coe_toSubring

theorem toSubring_injective {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A] :
    Function.Injective (toSubring : Subalgebra R A → Subring A) := fun S T h =>
  ext fun x => by rw [← mem_toSubring, ← mem_toSubring, h]
#align subalgebra.to_subring_injective Subalgebra.toSubring_injective

theorem toSubring_inj {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A]
    {S U : Subalgebra R A} : S.toSubring = U.toSubring ↔ S = U :=
  toSubring_injective.eq_iff
#align subalgebra.to_subring_inj Subalgebra.toSubring_inj

instance : Inhabited S :=
  ⟨(0 : S.toSubsemiring)⟩

section

/-! `Subalgebra`s inherit structure from their `Subsemiring` / `Semiring` coercions. -/

instance toSemiring {R A} [CommSemiring R] [Semiring A] [Algebra R A] (S : Subalgebra R A) :
    Semiring S :=
  S.toSubsemiring.toSemiring
#align subalgebra.to_semiring Subalgebra.toSemiring

instance toCommSemiring {R A} [CommSemiring R] [CommSemiring A] [Algebra R A] (S : Subalgebra R A) :
    CommSemiring S :=
  S.toSubsemiring.toCommSemiring
#align subalgebra.to_comm_semiring Subalgebra.toCommSemiring

instance toRing {R A} [CommRing R] [Ring A] [Algebra R A] (S : Subalgebra R A) : Ring S :=
  S.toSubring.toRing
#align subalgebra.to_ring Subalgebra.toRing

instance toCommRing {R A} [CommRing R] [CommRing A] [Algebra R A] (S : Subalgebra R A) :
    CommRing S :=
  S.toSubring.toCommRing
#align subalgebra.to_comm_ring Subalgebra.toCommRing

instance toOrderedSemiring {R A} [CommSemiring R] [OrderedSemiring A] [Algebra R A]
    (S : Subalgebra R A) : OrderedSemiring S :=
  S.toSubsemiring.toOrderedSemiring
#align subalgebra.to_ordered_semiring Subalgebra.toOrderedSemiring

instance toStrictOrderedSemiring {R A} [CommSemiring R] [StrictOrderedSemiring A] [Algebra R A]
    (S : Subalgebra R A) : StrictOrderedSemiring S :=
  S.toSubsemiring.toStrictOrderedSemiring
#align subalgebra.to_strict_ordered_semiring Subalgebra.toStrictOrderedSemiring

instance toOrderedCommSemiring {R A} [CommSemiring R] [OrderedCommSemiring A] [Algebra R A]
    (S : Subalgebra R A) : OrderedCommSemiring S :=
  S.toSubsemiring.toOrderedCommSemiring
#align subalgebra.to_ordered_comm_semiring Subalgebra.toOrderedCommSemiring

instance toStrictOrderedCommSemiring {R A} [CommSemiring R] [StrictOrderedCommSemiring A]
    [Algebra R A] (S : Subalgebra R A) : StrictOrderedCommSemiring S :=
  S.toSubsemiring.toStrictOrderedCommSemiring
#align subalgebra.to_strict_ordered_comm_semiring Subalgebra.toStrictOrderedCommSemiring

instance toOrderedRing {R A} [CommRing R] [OrderedRing A] [Algebra R A] (S : Subalgebra R A) :
    OrderedRing S :=
  S.toSubring.toOrderedRing
#align subalgebra.to_ordered_ring Subalgebra.toOrderedRing

instance toOrderedCommRing {R A} [CommRing R] [OrderedCommRing A] [Algebra R A]
    (S : Subalgebra R A) : OrderedCommRing S :=
  S.toSubring.toOrderedCommRing
#align subalgebra.to_ordered_comm_ring Subalgebra.toOrderedCommRing

instance toLinearOrderedSemiring {R A} [CommSemiring R] [LinearOrderedSemiring A] [Algebra R A]
    (S : Subalgebra R A) : LinearOrderedSemiring S :=
  S.toSubsemiring.toLinearOrderedSemiring
#align subalgebra.to_linear_ordered_semiring Subalgebra.toLinearOrderedSemiring

instance toLinearOrderedCommSemiring {R A} [CommSemiring R] [LinearOrderedCommSemiring A]
    [Algebra R A] (S : Subalgebra R A) : LinearOrderedCommSemiring S :=
  S.toSubsemiring.toLinearOrderedCommSemiring
#align subalgebra.to_linear_ordered_comm_semiring Subalgebra.toLinearOrderedCommSemiring

instance toLinearOrderedRing {R A} [CommRing R] [LinearOrderedRing A] [Algebra R A]
    (S : Subalgebra R A) : LinearOrderedRing S :=
  S.toSubring.toLinearOrderedRing
#align subalgebra.to_linear_ordered_ring Subalgebra.toLinearOrderedRing

instance toLinearOrderedCommRing {R A} [CommRing R] [LinearOrderedCommRing A] [Algebra R A]
    (S : Subalgebra R A) : LinearOrderedCommRing S :=
  S.toSubring.toLinearOrderedCommRing
#align subalgebra.to_linear_ordered_comm_ring Subalgebra.toLinearOrderedCommRing

end

/-- The forgetful map from `Subalgebra` to `Submodule` as an `OrderEmbedding` -/
def toSubmodule : Subalgebra R A ↪o Submodule R A where
  toEmbedding :=
    { toFun := fun S =>
        { S with
          carrier := S
          smul_mem' := fun c {x} hx ↦
            (Algebra.smul_def c x).symm ▸ mul_mem (S.range_le ⟨c, rfl⟩) hx }
      inj' := fun _ _ h ↦ ext <| fun x ↦ SetLike.ext_iff.mp h x }
  map_rel_iff' := SetLike.coe_subset_coe.symm.trans SetLike.coe_subset_coe
#align subalgebra.to_submodule Subalgebra.toSubmodule

/- TODO: bundle other forgetful maps between algebraic substructures, e.g.
  `to_subsemiring` and `to_subring` in this file. -/
@[simp]
theorem mem_toSubmodule {x} : x ∈ (toSubmodule S) ↔ x ∈ S := Iff.rfl
#align subalgebra.mem_to_submodule Subalgebra.mem_toSubmodule

@[simp]
theorem coe_toSubmodule (S : Subalgebra R A) : (toSubmodule S : Set A) = S := rfl
#align subalgebra.coe_to_submodule Subalgebra.coe_toSubmodule

section

/-! `Subalgebra`s inherit structure from their `Submodule` coercions. -/

instance module' [Semiring R'] [SMul R' R] [Module R' A] [IsScalarTower R' R A] : Module R' S :=
  S.toSubmodule.module'
#align subalgebra.module' Subalgebra.module'

instance : Module R S :=
  S.module'

instance [Semiring R'] [SMul R' R] [Module R' A] [IsScalarTower R' R A] : IsScalarTower R' R S :=
  inferInstanceAs (IsScalarTower R' R (toSubmodule S))

instance algebra' [CommSemiring R'] [SMul R' R] [Algebra R' A] [IsScalarTower R' R A] :
    Algebra R' S :=
  { (algebraMap R' A).codRestrict S fun x => by
      rw [Algebra.algebraMap_eq_smul_one, ← smul_one_smul R x (1 : A), ←
        Algebra.algebraMap_eq_smul_one]
      exact algebraMap_mem S
          _ with
    commutes' := fun c x => Subtype.eq <| Algebra.commutes _ _
    smul_def' := fun c x => Subtype.eq <| Algebra.smul_def _ _ }
#align subalgebra.algebra' Subalgebra.algebra'

instance : Algebra R S := S.algebra'

end

instance noZeroSMulDivisors_bot [NoZeroSMulDivisors R A] : NoZeroSMulDivisors R S :=
  ⟨fun {c} {x : S} h =>
    have : c = 0 ∨ (x : A) = 0 := eq_zero_or_eq_zero_of_smul_eq_zero (congr_arg Subtype.val h)
    this.imp_right (@Subtype.ext_iff _ _ x 0).mpr⟩
#align subalgebra.no_zero_smul_divisors_bot Subalgebra.noZeroSMulDivisors_bot

protected theorem coe_add (x y : S) : (↑(x + y) : A) = ↑x + ↑y := rfl
#align subalgebra.coe_add Subalgebra.coe_add

protected theorem coe_mul (x y : S) : (↑(x * y) : A) = ↑x * ↑y := rfl
#align subalgebra.coe_mul Subalgebra.coe_mul

protected theorem coe_zero : ((0 : S) : A) = 0 := rfl
#align subalgebra.coe_zero Subalgebra.coe_zero

protected theorem coe_one : ((1 : S) : A) = 1 := rfl
#align subalgebra.coe_one Subalgebra.coe_one

protected theorem coe_neg {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A]
    {S : Subalgebra R A} (x : S) : (↑(-x) : A) = -↑x := rfl
#align subalgebra.coe_neg Subalgebra.coe_neg

protected theorem coe_sub {R : Type u} {A : Type v} [CommRing R] [Ring A] [Algebra R A]
    {S : Subalgebra R A} (x y : S) : (↑(x - y) : A) = ↑x - ↑y := rfl
#align subalgebra.coe_sub Subalgebra.coe_sub

@[simp, norm_cast]
theorem coe_smul [Semiring R'] [SMul R' R] [Module R' A] [IsScalarTower R' R A] (r : R') (x : S) :
    (↑(r • x) : A) = r • (x : A) := rfl
#align subalgebra.coe_smul Subalgebra.coe_smul

@[simp, norm_cast]
theorem coe_algebraMap [CommSemiring R'] [SMul R' R] [Algebra R' A] [IsScalarTower R' R A]
    (r : R') : ↑(algebraMap R' S r) = algebraMap R' A r := rfl
#align subalgebra.coe_algebra_map Subalgebra.coe_algebraMap

protected theorem coe_pow (x : S) (n : ℕ) : (↑(x ^ n) : A) = (x : A) ^ n :=
  SubmonoidClass.coe_pow x n
#align subalgebra.coe_pow Subalgebra.coe_pow

protected theorem coe_eq_zero {x : S} : (x : A) = 0 ↔ x = 0 :=
  ZeroMemClass.coe_eq_zero
#align subalgebra.coe_eq_zero Subalgebra.coe_eq_zero

protected theorem coe_eq_one {x : S} : (x : A) = 1 ↔ x = 1 :=
  OneMemClass.coe_eq_one
#align subalgebra.coe_eq_one Subalgebra.coe_eq_one

-- todo: standardize on the names these morphisms
-- compare with submodule.subtype
/-- Embedding of a subalgebra into the algebra. -/
def val : S →ₐ[R] A :=
  { toFun := ((↑) : S → A)
    map_zero' := rfl
    map_one' := rfl
    map_add' := fun _ _ ↦ rfl
    map_mul' := fun _ _ ↦ rfl
    commutes' := fun _ ↦ rfl }
#align subalgebra.val Subalgebra.val

@[simp]
theorem coe_val : (S.val : S → A) = ((↑) : S → A) := rfl
#align subalgebra.coe_val Subalgebra.coe_val

theorem val_apply (x : S) : S.val x = (x : A) := rfl
#align subalgebra.val_apply Subalgebra.val_apply

@[simp]
theorem toSubsemiring_subtype : S.toSubsemiring.subtype = (S.val : S →+* A) := rfl
#align subalgebra.to_subsemiring_subtype Subalgebra.toSubsemiring_subtype

-- Porting note: workaround for lean#2074
attribute [-instance] Ring.toNonAssocRing
@[simp]
theorem toSubring_subtype {R A : Type _} [CommRing R] [Ring A] [Algebra R A] (S : Subalgebra R A) :
    S.toSubring.subtype = (S.val : S →+* A) := rfl
#align subalgebra.to_subring_subtype Subalgebra.toSubring_subtype

/-- Linear equivalence between `S : Submodule R A` and `S`. Though these types are equal,
we define it as a `LinearEquiv` to avoid type equalities. -/
def toSubmoduleEquiv (S : Subalgebra R A) : toSubmodule S ≃ₗ[R] S :=
  LinearEquiv.ofEq _ _ rfl
#align subalgebra.to_submodule_equiv Subalgebra.toSubmoduleEquiv

/-- Transport a subalgebra via an algebra homomorphism. -/
def map (f : A →ₐ[R] B) (S : Subalgebra R A) : Subalgebra R B :=
  { S.toSubsemiring.map (f : A →+* B) with
    algebraMap_mem' := fun r => f.commutes r ▸ Set.mem_image_of_mem _ (S.algebraMap_mem r) }
#align subalgebra.map Subalgebra.map

theorem map_mono {S₁ S₂ : Subalgebra R A} {f : A →ₐ[R] B} : S₁ ≤ S₂ → S₁.map f ≤ S₂.map f :=
  Set.image_subset f
#align subalgebra.map_mono Subalgebra.map_mono

theorem map_injective {f : A →ₐ[R] B} (hf : Function.Injective f) : Function.Injective (map f) :=
  fun _S₁ _S₂ ih =>
  ext <| Set.ext_iff.1 <| Set.image_injective.2 hf <| Set.ext <| SetLike.ext_iff.mp ih
#align subalgebra.map_injective Subalgebra.map_injective

@[simp]
theorem map_id (S : Subalgebra R A) : S.map (AlgHom.id R A) = S :=
  SetLike.coe_injective <| Set.image_id _
#align subalgebra.map_id Subalgebra.map_id

theorem map_map (S : Subalgebra R A) (g : B →ₐ[R] C) (f : A →ₐ[R] B) :
    (S.map f).map g = S.map (g.comp f) :=
  SetLike.coe_injective <| Set.image_image _ _ _
#align subalgebra.map_map Subalgebra.map_map

theorem mem_map {S : Subalgebra R A} {f : A →ₐ[R] B} {y : B} : y ∈ map f S ↔ ∃ x ∈ S, f x = y :=
  Subsemiring.mem_map
#align subalgebra.mem_map Subalgebra.mem_map

theorem map_toSubmodule {S : Subalgebra R A} {f : A →ₐ[R] B} :
    (toSubmodule $ S.map f) = S.toSubmodule.map f.toLinearMap :=
  SetLike.coe_injective rfl
#align subalgebra.map_to_submodule Subalgebra.map_toSubmodule

theorem map_toSubsemiring {S : Subalgebra R A} {f : A →ₐ[R] B} :
    (S.map f).toSubsemiring = S.toSubsemiring.map f.toRingHom :=
  SetLike.coe_injective rfl
#align subalgebra.map_to_subsemiring Subalgebra.map_toSubsemiring

@[simp]
theorem coe_map (S : Subalgebra R A) (f : A →ₐ[R] B) : (S.map f : Set B) = f '' S := rfl
#align subalgebra.coe_map Subalgebra.coe_map

/-- Preimage of a subalgebra under an algebra homomorphism. -/
def comap (f : A →ₐ[R] B) (S : Subalgebra R B) : Subalgebra R A :=
  { S.toSubsemiring.comap (f : A →+* B) with
    algebraMap_mem' := fun r =>
      show f (algebraMap R A r) ∈ S from (f.commutes r).symm ▸ S.algebraMap_mem r }
#align subalgebra.comap Subalgebra.comap

theorem map_le {S : Subalgebra R A} {f : A →ₐ[R] B} {U : Subalgebra R B} :
    map f S ≤ U ↔ S ≤ comap f U :=
  Set.image_subset_iff
#align subalgebra.map_le Subalgebra.map_le

theorem gc_map_comap (f : A →ₐ[R] B) : GaloisConnection (map f) (comap f) := fun _S _U => map_le
#align subalgebra.gc_map_comap Subalgebra.gc_map_comap

@[simp]
theorem mem_comap (S : Subalgebra R B) (f : A →ₐ[R] B) (x : A) : x ∈ S.comap f ↔ f x ∈ S :=
  Iff.rfl
#align subalgebra.mem_comap Subalgebra.mem_comap

@[simp, norm_cast]
theorem coe_comap (S : Subalgebra R B) (f : A →ₐ[R] B) : (S.comap f : Set A) = f ⁻¹' (S : Set B) :=
  rfl
#align subalgebra.coe_comap Subalgebra.coe_comap

instance noZeroDivisors {R A : Type _} [CommSemiring R] [Semiring A] [NoZeroDivisors A]
    [Algebra R A] (S : Subalgebra R A) : NoZeroDivisors S :=
  inferInstanceAs (NoZeroDivisors S.toSubsemiring)
#align subalgebra.no_zero_divisors Subalgebra.noZeroDivisors

instance isDomain {R A : Type _} [CommRing R] [Ring A] [IsDomain A] [Algebra R A]
    (S : Subalgebra R A) : IsDomain S :=
  inferInstanceAs (IsDomain S.toSubring)
#align subalgebra.is_domain Subalgebra.isDomain

end Subalgebra

namespace Submodule

variable {R A : Type _} [CommSemiring R] [Semiring A] [Algebra R A]

variable (p : Submodule R A)

/-- A submodule containing `1` and closed under multiplication is a subalgebra. -/
def toSubalgebra (p : Submodule R A) (h_one : (1 : A) ∈ p)
    (h_mul : ∀ x y, x ∈ p → y ∈ p → x * y ∈ p) : Subalgebra R A :=
  { p with
    mul_mem' := fun hx hy ↦ h_mul _ _ hx hy
    one_mem' := h_one
    algebraMap_mem' := fun r => by
      rw [Algebra.algebraMap_eq_smul_one]
      exact p.smul_mem _ h_one }
#align submodule.to_subalgebra Submodule.toSubalgebra

@[simp]
theorem mem_toSubalgebra {p : Submodule R A} {h_one h_mul} {x} :
    x ∈ p.toSubalgebra h_one h_mul ↔ x ∈ p := Iff.rfl
#align submodule.mem_to_subalgebra Submodule.mem_toSubalgebra

@[simp]
theorem coe_toSubalgebra (p : Submodule R A) (h_one h_mul) :
    (p.toSubalgebra h_one h_mul : Set A) = p := rfl
#align submodule.coe_to_subalgebra Submodule.coe_toSubalgebra

-- Porting note: changed statement to reflect new structures
-- @[simp] -- Porting note: as a result, it is no longer a great simp lemma
theorem toSubalgebra_mk (s : Submodule R A) (h1 hmul) :
    s.toSubalgebra h1 hmul =
      Subalgebra.mk ⟨⟨⟨s, @hmul⟩, h1⟩, s.add_mem, s.zero_mem⟩
        (by intro r; rw [Algebra.algebraMap_eq_smul_one]; apply s.smul_mem _ h1) :=
  rfl
#align submodule.to_subalgebra_mk Submodule.toSubalgebra_mk

@[simp]
theorem toSubalgebra_toSubmodule (p : Submodule R A) (h_one h_mul) :
    Subalgebra.toSubmodule (p.toSubalgebra h_one h_mul) = p :=
  SetLike.coe_injective rfl
#align submodule.to_subalgebra_to_submodule Submodule.toSubalgebra_toSubmodule

@[simp]
theorem _root_.Subalgebra.toSubmodule_toSubalgebra (S : Subalgebra R A) :
    (S.toSubmodule.toSubalgebra S.one_mem fun _ _ => S.mul_mem) = S :=
  SetLike.coe_injective rfl
#align subalgebra.to_submodule_to_subalgebra Subalgebra.toSubmodule_toSubalgebra

end Submodule

namespace AlgHom

variable {R' : Type u'} {R : Type u} {A : Type v} {B : Type w} {C : Type w'}

variable [CommSemiring R]

variable [Semiring A] [Algebra R A] [Semiring B] [Algebra R B] [Semiring C] [Algebra R C]

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

/-- Range of an `AlgHom` as a subalgebra. -/
protected def range (φ : A →ₐ[R] B) : Subalgebra R B :=
  { φ.toRingHom.rangeS with algebraMap_mem' := fun r => ⟨algebraMap R A r, φ.commutes r⟩ }
#align alg_hom.range AlgHom.range

@[simp]
theorem mem_range (φ : A →ₐ[R] B) {y : B} : y ∈ φ.range ↔ ∃ x, φ x = y :=
  RingHom.mem_rangeS
#align alg_hom.mem_range AlgHom.mem_range

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

@[simp]
theorem coe_range (φ : A →ₐ[R] B) : (φ.range : Set B) = Set.range φ := by
  ext
  rw [SetLike.mem_coe, mem_range]
  rfl
#align alg_hom.coe_range AlgHom.coe_range

theorem range_comp (f : A →ₐ[R] B) (g : B →ₐ[R] C) : (g.comp f).range = f.range.map g :=
  SetLike.coe_injective (Set.range_comp g f)
#align alg_hom.range_comp AlgHom.range_comp

theorem range_comp_le_range (f : A →ₐ[R] B) (g : B →ₐ[R] C) : (g.comp f).range ≤ g.range :=
  SetLike.coe_mono (Set.range_comp_subset_range f g)
#align alg_hom.range_comp_le_range AlgHom.range_comp_le_range

/-- Restrict the codomain of an algebra homomorphism. -/
def codRestrict (f : A →ₐ[R] B) (S : Subalgebra R B) (hf : ∀ x, f x ∈ S) : A →ₐ[R] S :=
  { RingHom.codRestrict (f : A →+* B) S hf with commutes' := fun r => Subtype.eq <| f.commutes r }
#align alg_hom.cod_restrict AlgHom.codRestrict

@[simp]
theorem val_comp_codRestrict (f : A →ₐ[R] B) (S : Subalgebra R B) (hf : ∀ x, f x ∈ S) :
    S.val.comp (f.codRestrict S hf) = f :=
  AlgHom.ext fun _ => rfl
#align alg_hom.val_comp_cod_restrict AlgHom.val_comp_codRestrict

@[simp]
theorem coe_codRestrict (f : A →ₐ[R] B) (S : Subalgebra R B) (hf : ∀ x, f x ∈ S) (x : A) :
    ↑(f.codRestrict S hf x) = f x :=
  rfl
#align alg_hom.coe_cod_restrict AlgHom.coe_codRestrict

theorem injective_codRestrict (f : A →ₐ[R] B) (S : Subalgebra R B) (hf : ∀ x, f x ∈ S) :
    Function.Injective (f.codRestrict S hf) ↔ Function.Injective f :=
  ⟨fun H _x _y hxy => H <| Subtype.eq hxy, fun H _x _y hxy => H (congr_arg Subtype.val hxy : _)⟩
#align alg_hom.injective_cod_restrict AlgHom.injective_codRestrict

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

This is the bundled version of `Set.rangeFactorization`. -/
@[reducible]
def rangeRestrict (f : A →ₐ[R] B) : A →ₐ[R] f.range :=
  f.codRestrict f.range f.mem_range_self
#align alg_hom.range_restrict AlgHom.rangeRestrict

/-- The equalizer of two R-algebra homomorphisms -/
def equalizer (ϕ ψ : A →ₐ[R] B) : Subalgebra R A where
  carrier := { a | ϕ a = ψ a }
  zero_mem' := by simp only [Set.mem_setOf_eq, map_zero]
  one_mem' := by simp only [Set.mem_setOf_eq, map_one]
  add_mem' {x y} (hx : ϕ x = ψ x) (hy : ϕ y = ψ y) := by
    rw [Set.mem_setOf_eq, ϕ.map_add, ψ.map_add, hx, hy]
  mul_mem' {x y} (hx : ϕ x = ψ x) (hy : ϕ y = ψ y) := by
    rw [Set.mem_setOf_eq, ϕ.map_mul, ψ.map_mul, hx, hy]
  algebraMap_mem' x := by rw [Set.mem_setOf_eq, AlgHom.commutes, AlgHom.commutes]
#align alg_hom.equalizer AlgHom.equalizer

@[simp]
theorem mem_equalizer (ϕ ψ : A →ₐ[R] B) (x : A) : x ∈ ϕ.equalizer ψ ↔ ϕ x = ψ x :=
  Iff.rfl
#align alg_hom.mem_equalizer AlgHom.mem_equalizer

/-- The range of a morphism of algebras is a fintype, if the domain is a fintype.

Note that this instance can cause a diamond with `Subtype.fintype` if `B` is also a fintype. -/
instance fintypeRange [Fintype A] [DecidableEq B] (φ : A →ₐ[R] B) : Fintype φ.range :=
  Set.fintypeRange φ
#align alg_hom.fintype_range AlgHom.fintypeRange

end AlgHom

namespace AlgEquiv

variable {R : Type u} {A : Type v} {B : Type w}

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

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

This is a computable alternative to `AlgEquiv.ofInjective`. -/
def ofLeftInverse {g : B → A} {f : A →ₐ[R] B} (h : Function.LeftInverse g f) : A ≃ₐ[R] f.range :=
  { f.rangeRestrict with
    toFun := f.rangeRestrict
    invFun := g ∘ f.range.val
    left_inv := h
    right_inv := fun x =>
      Subtype.ext <|
        let ⟨x', hx'⟩ := f.mem_range.mp x.prop
        show f (g x) = x by rw [← hx', h x'] }
#align alg_equiv.of_left_inverse AlgEquiv.ofLeftInverse

@[simp]
theorem ofLeftInverse_apply {g : B → A} {f : A →ₐ[R] B} (h : Function.LeftInverse g f) (x : A) :
    ↑(ofLeftInverse h x) = f x :=
  rfl
#align alg_equiv.of_left_inverse_apply AlgEquiv.ofLeftInverse_apply

@[simp]
theorem ofLeftInverse_symm_apply {g : B → A} {f : A →ₐ[R] B} (h : Function.LeftInverse g f)
    (x : f.range) : (ofLeftInverse h).symm x = g x :=
  rfl
#align alg_equiv.of_left_inverse_symm_apply AlgEquiv.ofLeftInverse_symm_apply

/-- Restrict an injective algebra homomorphism to an algebra isomorphism -/
noncomputable def ofInjective (f : A →ₐ[R] B) (hf : Function.Injective f) : A ≃ₐ[R] f.range :=
  ofLeftInverse (Classical.choose_spec hf.hasLeftInverse)
#align alg_equiv.of_injective AlgEquiv.ofInjective

@[simp]
theorem ofInjective_apply (f : A →ₐ[R] B) (hf : Function.Injective f) (x : A) :
    ↑(ofInjective f hf x) = f x :=
  rfl
#align alg_equiv.of_injective_apply AlgEquiv.ofInjective_apply

/-- Restrict an algebra homomorphism between fields to an algebra isomorphism -/
noncomputable def ofInjectiveField {E F : Type _} [DivisionRing E] [Semiring F] [Nontrivial F]
    [Algebra R E] [Algebra R F] (f : E →ₐ[R] F) : E ≃ₐ[R] f.range :=
  ofInjective f f.toRingHom.injective
#align alg_equiv.of_injective_field AlgEquiv.ofInjectiveField

/-- Given an equivalence `e : A ≃ₐ[R] B` of `R`-algebras and a subalgebra `S` of `A`,
`subalgebra_map` is the induced equivalence between `S` and `S.map e` -/
@[simps!]
def subalgebraMap (e : A ≃ₐ[R] B) (S : Subalgebra R A) : S ≃ₐ[R] S.map e.toAlgHom :=
  { e.toRingEquiv.subsemiringMap S.toSubsemiring with
    commutes' := fun r => by
      ext; dsimp only; erw [RingEquiv.subsemiringMap_apply_coe]
      exact e.commutes _ }
#align alg_equiv.subalgebra_map AlgEquiv.subalgebraMap

end AlgEquiv

namespace Algebra

variable (R : Type u) {A : Type v} {B : Type w}

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

/-- The minimal subalgebra that includes `s`. -/
def adjoin (s : Set A) : Subalgebra R A :=
  { Subsemiring.closure (Set.range (algebraMap R A) ∪ s) with
    algebraMap_mem' := fun r => Subsemiring.subset_closure <| Or.inl ⟨r, rfl⟩ }
#align algebra.adjoin Algebra.adjoin

variable {R}

protected theorem gc : GaloisConnection (adjoin R : Set A → Subalgebra R A) (↑) := fun s S =>
  ⟨fun H => le_trans (le_trans (Set.subset_union_right _ _) Subsemiring.subset_closure) H,
   fun H => show Subsemiring.closure (Set.range (algebraMap R A) ∪ s) ≤ S.toSubsemiring from
      Subsemiring.closure_le.2 <| Set.union_subset S.range_subset H⟩
#align algebra.gc Algebra.gc

/-- Galois insertion between `adjoin` and `coe`. -/
protected def gi : GaloisInsertion (adjoin R : Set A → Subalgebra R A) (↑) where
  choice s hs := (adjoin R s).copy s <| le_antisymm (Algebra.gc.le_u_l s) hs
  gc := Algebra.gc
  le_l_u S := (Algebra.gc (S : Set A) (adjoin R S)).1 <| le_rfl
  choice_eq _ _ := Subalgebra.copy_eq _ _ _
#align algebra.gi Algebra.gi

instance : CompleteLattice (Subalgebra R A) :=
  GaloisInsertion.liftCompleteLattice Algebra.gi

@[simp]
theorem coe_top : (↑(⊤ : Subalgebra R A) : Set A) = Set.univ := rfl
#align algebra.coe_top Algebra.coe_top

@[simp]
theorem mem_top {x : A} : x ∈ (⊤ : Subalgebra R A) := Set.mem_univ x
#align algebra.mem_top Algebra.mem_top

@[simp]
theorem top_toSubmodule : Subalgebra.toSubmodule (⊤ : Subalgebra R A) = ⊤ := rfl
#align algebra.top_to_submodule Algebra.top_toSubmodule

@[simp]
theorem top_toSubsemiring : (⊤ : Subalgebra R A).toSubsemiring = ⊤ := rfl
#align algebra.top_to_subsemiring Algebra.top_toSubsemiring

@[simp]
theorem top_toSubring {R A : Type _} [CommRing R] [Ring A] [Algebra R A] :
    (⊤ : Subalgebra R A).toSubring = ⊤ := rfl
#align algebra.top_to_subring Algebra.top_toSubring

@[simp]
theorem toSubmodule_eq_top {S : Subalgebra R A} : Subalgebra.toSubmodule S = ⊤ ↔ S = ⊤ :=
  Subalgebra.toSubmodule.injective.eq_iff' top_toSubmodule
#align algebra.to_submodule_eq_top Algebra.toSubmodule_eq_top

@[simp]
theorem toSubsemiring_eq_top {S : Subalgebra R A} : S.toSubsemiring = ⊤ ↔ S = ⊤ :=
  Subalgebra.toSubsemiring_injective.eq_iff' top_toSubsemiring
#align algebra.to_subsemiring_eq_top Algebra.toSubsemiring_eq_top

@[simp]
theorem toSubring_eq_top {R A : Type _} [CommRing R] [Ring A] [Algebra R A] {S : Subalgebra R A} :
    S.toSubring = ⊤ ↔ S = ⊤ :=
  Subalgebra.toSubring_injective.eq_iff' top_toSubring
#align algebra.to_subring_eq_top Algebra.toSubring_eq_top

theorem mem_sup_left {S T : Subalgebra R A} : ∀ {x : A}, x ∈ S → x ∈ S ⊔ T :=
  have : S ≤ S ⊔ T := le_sup_left; (this ·) -- Porting note: need `have` instead of `show`
#align algebra.mem_sup_left Algebra.mem_sup_left

theorem mem_sup_right {S T : Subalgebra R A} : ∀ {x : A}, x ∈ T → x ∈ S ⊔ T :=
  have : T ≤ S ⊔ T := le_sup_right; (this ·) -- Porting note: need `have` instead of `show`
#align algebra.mem_sup_right Algebra.mem_sup_right

theorem mul_mem_sup {S T : Subalgebra R A} {x y : A} (hx : x ∈ S) (hy : y ∈ T) : x * y ∈ S ⊔ T :=
  (S ⊔ T).mul_mem (mem_sup_left hx) (mem_sup_right hy)
#align algebra.mul_mem_sup Algebra.mul_mem_sup

theorem map_sup (f : A →ₐ[R] B) (S T : Subalgebra R A) : (S ⊔ T).map f = S.map f ⊔ T.map f :=
  (Subalgebra.gc_map_comap f).l_sup
#align algebra.map_sup Algebra.map_sup

@[simp, norm_cast]
theorem coe_inf (S T : Subalgebra R A) : (↑(S ⊓ T) : Set A) = (S ∩ T : Set A) := rfl
#align algebra.coe_inf Algebra.coe_inf

@[simp]
theorem mem_inf {S T : Subalgebra R A} {x : A} : x ∈ S ⊓ T ↔ x ∈ S ∧ x ∈ T := Iff.rfl
#align algebra.mem_inf Algebra.mem_inf

open Subalgebra in
@[simp]

@[simp]
theorem inf_toSubsemiring (S T : Subalgebra R A) :
    (S ⊓ T).toSubsemiring = S.toSubsemiring ⊓ T.toSubsemiring :=
  rfl
#align algebra.inf_to_subsemiring Algebra.inf_toSubsemiring

@[simp, norm_cast]
theorem coe_infₛ (S : Set (Subalgebra R A)) : (↑(infₛ S) : Set A) = ⋂ s ∈ S, ↑s :=
  infₛ_image
#align algebra.coe_Inf Algebra.coe_infₛ

theorem mem_infₛ {S : Set (Subalgebra R A)} {x : A} : x ∈ infₛ S ↔ ∀ p ∈ S, x ∈ p := by
  simp only [← SetLike.mem_coe, coe_infₛ, Set.mem_interᵢ₂]
#align algebra.mem_Inf Algebra.mem_infₛ

@[simp]
theorem infₛ_toSubmodule (S : Set (Subalgebra R A)) :
    Subalgebra.toSubmodule (infₛ S) = infₛ (Subalgebra.toSubmodule '' S) :=
  SetLike.coe_injective <| by simp
#align algebra.Inf_to_submodule Algebra.infₛ_toSubmodule

@[simp]
theorem infₛ_toSubsemiring (S : Set (Subalgebra R A)) :
    (infₛ S).toSubsemiring = infₛ (Subalgebra.toSubsemiring '' S) :=
  SetLike.coe_injective <| by simp
#align algebra.Inf_to_subsemiring Algebra.infₛ_toSubsemiring

@[simp, norm_cast]
theorem coe_infᵢ {ι : Sort _} {S : ι → Subalgebra R A} : (↑(⨅ i, S i) : Set A) = ⋂ i, S i := by
  simp [infᵢ]
#align algebra.coe_infi Algebra.coe_infᵢ

theorem mem_infᵢ {ι : Sort _} {S : ι → Subalgebra R A} {x : A} : (x ∈ ⨅ i, S i) ↔ ∀ i, x ∈ S i := by
  simp only [infᵢ, mem_infₛ, Set.forall_range_iff]
#align algebra.mem_infi Algebra.mem_infᵢ

open Subalgebra in
@[simp]
theorem infᵢ_toSubmodule {ι : Sort _} (S : ι → Subalgebra R A) :
    toSubmodule (⨅ i, S i) = ⨅ i, toSubmodule (S i) :=
  SetLike.coe_injective <| by simp
#align algebra.infi_to_submodule Algebra.infᵢ_toSubmodule

instance : Inhabited (Subalgebra R A) := ⟨⊥⟩

theorem mem_bot {x : A} : x ∈ (⊥ : Subalgebra R A) ↔ x ∈ Set.range (algebraMap R A) :=
  suffices (ofId R A).range = (⊥ : Subalgebra R A)
    by
    rw [← this, ← SetLike.mem_coe, AlgHom.coe_range]
    rfl
  le_bot_iff.mp fun x hx => Subalgebra.range_le _ ((ofId R A).coe_range ▸ hx)
#align algebra.mem_bot Algebra.mem_bot

theorem toSubmodule_bot : Subalgebra.toSubmodule (⊥ : Subalgebra R A) = R ∙ 1 := by
  ext x
  simp [mem_bot, Submodule.mem_span_singleton, Algebra.smul_def]
#align algebra.to_submodule_bot Algebra.toSubmodule_bot

@[simp]
theorem coe_bot : ((⊥ : Subalgebra R A) : Set A) = Set.range (algebraMap R A) := by
  simp [Set.ext_iff, Algebra.mem_bot]
#align algebra.coe_bot Algebra.coe_bot

theorem eq_top_iff {S : Subalgebra R A} : S = ⊤ ↔ ∀ x : A, x ∈ S :=
  ⟨fun h x => by rw [h]; exact mem_top, fun h => by
    ext x; exact ⟨fun _ => mem_top, fun _ => h x⟩⟩
#align algebra.eq_top_iff Algebra.eq_top_iff

theorem range_top_iff_surjective (f : A →ₐ[R] B) :
    f.range = (⊤ : Subalgebra R B) ↔ Function.Surjective f :=
  Algebra.eq_top_iff
#align algebra.range_top_iff_surjective Algebra.range_top_iff_surjective

@[simp]
theorem range_id : (AlgHom.id R A).range = ⊤ :=
  SetLike.coe_injective Set.range_id
#align algebra.range_id Algebra.range_id

@[simp]
theorem map_top (f : A →ₐ[R] B) : (⊤ : Subalgebra R A).map f = f.range :=
  SetLike.coe_injective Set.image_univ
#align algebra.map_top Algebra.map_top

@[simp]
theorem map_bot (f : A →ₐ[R] B) : (⊥ : Subalgebra R A).map f = ⊥ :=
  SetLike.coe_injective <| by
    simp only [← Set.range_comp, (· ∘ ·), Algebra.coe_bot, Subalgebra.coe_map, f.commutes]
#align algebra.map_bot Algebra.map_bot

@[simp]
theorem comap_top (f : A →ₐ[R] B) : (⊤ : Subalgebra R B).comap f = ⊤ :=
  eq_top_iff.2 fun _x => mem_top
#align algebra.comap_top Algebra.comap_top

/-- `AlgHom` to `⊤ : Subalgebra R A`. -/
def toTop : A →ₐ[R] (⊤ : Subalgebra R A) :=
  (AlgHom.id R A).codRestrict ⊤ fun _ => mem_top
#align algebra.to_top Algebra.toTop

theorem surjective_algebraMap_iff :
    Function.Surjective (algebraMap R A) ↔ (⊤ : Subalgebra R A) = ⊥ :=
  ⟨fun h =>
    eq_bot_iff.2 fun y _ =>
      let ⟨_x, hx⟩ := h y
      hx ▸ Subalgebra.algebraMap_mem _ _,
    fun h y => Algebra.mem_bot.1 <| eq_bot_iff.1 h (Algebra.mem_top : y ∈ _)⟩
#align algebra.surjective_algebra_map_iff Algebra.surjective_algebraMap_iff

theorem bijective_algebraMap_iff {R A : Type _} [Field R] [Semiring A] [Nontrivial A]
    [Algebra R A] : Function.Bijective (algebraMap R A) ↔ (⊤ : Subalgebra R A) = ⊥ :=
  ⟨fun h => surjective_algebraMap_iff.1 h.2, fun h =>
    ⟨(algebraMap R A).injective, surjective_algebraMap_iff.2 h⟩⟩
#align algebra.bijective_algebra_map_iff Algebra.bijective_algebraMap_iff

/-- The bottom subalgebra is isomorphic to the base ring. -/
noncomputable def botEquivOfInjective (h : Function.Injective (algebraMap R A)) :
    (⊥ : Subalgebra R A) ≃ₐ[R] R :=
  AlgEquiv.symm <|
    AlgEquiv.ofBijective (Algebra.ofId R _)
      ⟨fun _x _y hxy => h (congr_arg Subtype.val hxy : _), fun ⟨_y, hy⟩ =>
        let ⟨x, hx⟩ := Algebra.mem_bot.1 hy
        ⟨x, Subtype.eq hx⟩⟩
#align algebra.bot_equiv_of_injective Algebra.botEquivOfInjective

/-- The bottom subalgebra is isomorphic to the field. -/
@[simps! symm_apply]
noncomputable def botEquiv (F R : Type _) [Field F] [Semiring R] [Nontrivial R] [Algebra F R] :
    (⊥ : Subalgebra F R) ≃ₐ[F] F :=
  botEquivOfInjective (RingHom.injective _)
#align algebra.bot_equiv Algebra.botEquiv

end Algebra

namespace Subalgebra

open Algebra

variable {R : Type u} {A : Type v} {B : Type w}

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

variable (S : Subalgebra R A)

/-- The top subalgebra is isomorphic to the algebra.

This is the algebra version of `Submodule.topEquiv`. -/
@[simps!]
def topEquiv : (⊤ : Subalgebra R A) ≃ₐ[R] A :=
  AlgEquiv.ofAlgHom (Subalgebra.val ⊤) toTop rfl <| AlgHom.ext fun _ => Subtype.ext rfl
#align subalgebra.top_equiv Subalgebra.topEquiv

instance subsingleton_of_subsingleton [Subsingleton A] : Subsingleton (Subalgebra R A) :=
  ⟨fun B C => ext fun x => by simp only [Subsingleton.elim x 0, zero_mem B, zero_mem C]⟩
#align subalgebra.subsingleton_of_subsingleton Subalgebra.subsingleton_of_subsingleton

instance _root_.AlgHom.subsingleton [Subsingleton (Subalgebra R A)] : Subsingleton (A →ₐ[R] B) :=
  ⟨fun f g =>
    AlgHom.ext fun a =>
      have : a ∈ (⊥ : Subalgebra R A) := Subsingleton.elim (⊤ : Subalgebra R A) ⊥ ▸ mem_top
      let ⟨_x, hx⟩ := Set.mem_range.mp (mem_bot.mp this)
      hx ▸ (f.commutes _).trans (g.commutes _).symm⟩
#align alg_hom.subsingleton AlgHom.subsingleton

instance _root_.AlgEquiv.subsingleton_left [Subsingleton (Subalgebra R A)] :
    Subsingleton (A ≃ₐ[R] B) :=
  ⟨fun f g => AlgEquiv.ext fun x => AlgHom.ext_iff.mp (Subsingleton.elim f.toAlgHom g.toAlgHom) x⟩
#align alg_equiv.subsingleton_left AlgEquiv.subsingleton_left

instance _root_.AlgEquiv.subsingleton_right [Subsingleton (Subalgebra R B)] :
    Subsingleton (A ≃ₐ[R] B) :=
  ⟨fun f g => by rw [← f.symm_symm, Subsingleton.elim f.symm g.symm, g.symm_symm]⟩
#align alg_equiv.subsingleton_right AlgEquiv.subsingleton_right

theorem range_val : S.val.range = S :=
  ext <| Set.ext_iff.1 <| S.val.coe_range.trans Subtype.range_val
#align subalgebra.range_val Subalgebra.range_val

instance : Unique (Subalgebra R R) :=
  { inferInstanceAs (Inhabited (Subalgebra R R)) with
    uniq := by
      intro S
      refine' le_antisymm ?_ bot_le
      intro _ _
      simp only [Set.mem_range, mem_bot, id.map_eq_self, exists_apply_eq_apply, default] }

/-- The map `S → T` when `S` is a subalgebra contained in the subalgebra `T`.

This is the subalgebra version of `Submodule.ofLe`, or `Subring.inclusion`  -/
def inclusion {S T : Subalgebra R A} (h : S ≤ T) : S →ₐ[R] T
    where
  toFun := Set.inclusion h
  map_one' := rfl
  map_add' _ _ := rfl
  map_mul' _ _ := rfl
  map_zero' := rfl
  commutes' _ := rfl
#align subalgebra.inclusion Subalgebra.inclusion

theorem inclusion_injective {S T : Subalgebra R A} (h : S ≤ T) : Function.Injective (inclusion h) :=
  fun _ _ => Subtype.ext ∘ Subtype.mk.inj
#align subalgebra.inclusion_injective Subalgebra.inclusion_injective

@[simp]
theorem inclusion_self {S : Subalgebra R A} : inclusion (le_refl S) = AlgHom.id R S :=
  AlgHom.ext fun _x => Subtype.ext rfl
#align subalgebra.inclusion_self Subalgebra.inclusion_self

@[simp]
theorem inclusion_mk {S T : Subalgebra R A} (h : S ≤ T) (x : A) (hx : x ∈ S) :
    inclusion h ⟨x, hx⟩ = ⟨x, h hx⟩ :=
  rfl
#align subalgebra.inclusion_mk Subalgebra.inclusion_mk

theorem inclusion_right {S T : Subalgebra R A} (h : S ≤ T) (x : T) (m : (x : A) ∈ S) :
    inclusion h ⟨x, m⟩ = x :=
  Subtype.ext rfl
#align subalgebra.inclusion_right Subalgebra.inclusion_right

@[simp]
theorem inclusion_inclusion {S T U : Subalgebra R A} (hst : S ≤ T) (htu : T ≤ U) (x : S) :
    inclusion htu (inclusion hst x) = inclusion (le_trans hst htu) x :=
  Subtype.ext rfl
#align subalgebra.inclusion_inclusion Subalgebra.inclusion_inclusion

@[simp]
theorem coe_inclusion {S T : Subalgebra R A} (h : S ≤ T) (s : S) : (inclusion h s : A) = s :=
  rfl
#align subalgebra.coe_inclusion Subalgebra.coe_inclusion

/-- Two subalgebras that are equal are also equivalent as algebras.

This is the `Subalgebra` version of `LinearEquiv.ofEq` and `Equiv.Set.ofEq`. -/
@[simps apply]
def equivOfEq (S T : Subalgebra R A) (h : S = T) : S ≃ₐ[R] T :=
  { LinearEquiv.ofEq _ _ (congr_arg toSubmodule h) with
    toFun := fun x => ⟨x, h ▸ x.2⟩
    invFun := fun x => ⟨x, h.symm ▸ x.2⟩
    map_mul' := fun _ _ => rfl
    commutes' := fun _ => rfl }
#align subalgebra.equiv_of_eq Subalgebra.equivOfEq

@[simp]
theorem equivOfEq_symm (S T : Subalgebra R A) (h : S = T) :
    (equivOfEq S T h).symm = equivOfEq T S h.symm := rfl
#align subalgebra.equiv_of_eq_symm Subalgebra.equivOfEq_symm

@[simp]
theorem equivOfEq_rfl (S : Subalgebra R A) : equivOfEq S S rfl = AlgEquiv.refl := by ext; rfl
#align subalgebra.equiv_of_eq_rfl Subalgebra.equivOfEq_rfl

@[simp]
theorem equivOfEq_trans (S T U : Subalgebra R A) (hST : S = T) (hTU : T = U) :
    (equivOfEq S T hST).trans (equivOfEq T U hTU) = equivOfEq S U (hST.trans hTU) := rfl
#align subalgebra.equiv_of_eq_trans Subalgebra.equivOfEq_trans

section Prod

variable (S₁ : Subalgebra R B)

/-- The product of two subalgebras is a subalgebra. -/
def prod : Subalgebra R (A × B) :=
  { S.toSubsemiring.prod S₁.toSubsemiring with
    carrier := S ×ˢ S₁
    algebraMap_mem' := fun _ => ⟨algebraMap_mem _ _, algebraMap_mem _ _⟩ }
#align subalgebra.prod Subalgebra.prod

@[simp]
theorem coe_prod : (prod S S₁ : Set (A × B)) = S ×ˢ S₁ :=
  rfl
#align subalgebra.coe_prod Subalgebra.coe_prod

open Subalgebra in
theorem prod_toSubmodule : toSubmodule (S.prod S₁) = (toSubmodule S).prod (toSubmodule S₁) := rfl
#align subalgebra.prod_to_submodule Subalgebra.prod_toSubmodule

@[simp]
theorem mem_prod {S : Subalgebra R A} {S₁ : Subalgebra R B} {x : A × B} :
    x ∈ prod S S₁ ↔ x.1 ∈ S ∧ x.2 ∈ S₁ := Set.mem_prod
#align subalgebra.mem_prod Subalgebra.mem_prod

@[simp]
theorem prod_top : (prod ⊤ ⊤ : Subalgebra R (A × B)) = ⊤ := by ext; simp
#align subalgebra.prod_top Subalgebra.prod_top

theorem prod_mono {S T : Subalgebra R A} {S₁ T₁ : Subalgebra R B} :
    S ≤ T → S₁ ≤ T₁ → prod S S₁ ≤ prod T T₁ :=
  Set.prod_mono
#align subalgebra.prod_mono Subalgebra.prod_mono

@[simp]
theorem prod_inf_prod {S T : Subalgebra R A} {S₁ T₁ : Subalgebra R B} :
    S.prod S₁ ⊓ T.prod T₁ = (S ⊓ T).prod (S₁ ⊓ T₁) :=
  SetLike.coe_injective Set.prod_inter_prod
#align subalgebra.prod_inf_prod Subalgebra.prod_inf_prod

end Prod

section SuprLift

variable {ι : Type _}

theorem coe_supᵢ_of_directed [Nonempty ι] {S : ι → Subalgebra R A} (dir : Directed (· ≤ ·) S) :
    ↑(supᵢ S) = ⋃ i, (S i : Set A) :=
  -- Porting note: moved up the `let i` to use it in `zero_mem'` and `one_mem'`
  let i := @Nonempty.some ι inferInstance
  let K : Subalgebra R A :=
    { carrier := ⋃ i, S i
      -- Porting note: auto_params failing, need to provide these explicitly
      zero_mem' := by simp only [Set.mem_unionᵢ, SetLike.mem_coe]; exact ⟨i, zero_mem _⟩
      one_mem' := by simp only [Set.mem_unionᵢ, SetLike.mem_coe]; exact ⟨i, one_mem _⟩
      mul_mem' := fun hx hy =>
        let ⟨i, hi⟩ := Set.mem_unionᵢ.1 hx
        let ⟨j, hj⟩ := Set.mem_unionᵢ.1 hy
        let ⟨k, hik, hjk⟩ := dir i j
        Set.mem_unionᵢ.2 ⟨k, Subalgebra.mul_mem (S k) (hik hi) (hjk hj)⟩
      add_mem' := fun hx hy =>
        let ⟨i, hi⟩ := Set.mem_unionᵢ.1 hx
        let ⟨j, hj⟩ := Set.mem_unionᵢ.1 hy
        let ⟨k, hik, hjk⟩ := dir i j
        Set.mem_unionᵢ.2 ⟨k, Subalgebra.add_mem (S k) (hik hi) (hjk hj)⟩
      algebraMap_mem' := fun _ ↦
        Set.mem_unionᵢ.2 ⟨i, Subalgebra.algebraMap_mem _ _⟩ }
  have : supᵢ S = K :=
    le_antisymm (supᵢ_le fun i => Set.subset_unionᵢ (fun i => (↑(S i) : Set A)) i)
      (SetLike.coe_subset_coe.1 (Set.unionᵢ_subset fun i => SetLike.coe_subset_coe.2 (le_supᵢ _ _)))
  this.symm ▸ rfl
#align subalgebra.coe_supr_of_directed Subalgebra.coe_supᵢ_of_directed

-- Porting note: TODO: turn `hT` into an assumption `T ≤ supᵢ K`. That's what `Set.unionᵢLift` needs
-- Porting note: the proofs of `map_{zero,one,add,mul}` got a bit uglier, probably unification trbls
/-- Define an algebra homomorphism on a directed supremum of subalgebras by defining
it on each subalgebra, and proving that it agrees on the intersection of subalgebras. -/
noncomputable def supᵢLift [Nonempty ι] (K : ι → Subalgebra R A) (dir : Directed (· ≤ ·) K)
    (f : ∀ i, K i →ₐ[R] B) (hf : ∀ (i j : ι) (h : K i ≤ K j), f i = (f j).comp (inclusion h))
    (T : Subalgebra R A) (hT : T = supᵢ K) : ↥T →ₐ[R] B :=
  { toFun := Set.unionᵢLift (fun i => ↑(K i)) (fun i x => f i x)
        (fun i j x hxi hxj => by
          let ⟨k, hik, hjk⟩ := dir i j
          dsimp
          rw [hf i k hik, hf j k hjk]
          rfl)
        T (by rw [hT, coe_supᵢ_of_directed dir])
    map_one' := by apply Set.unionᵢLift_const _ (fun _ => 1) <;> simp
    map_zero' := by dsimp; apply Set.unionᵢLift_const _ (fun _ => 0) <;> simp
    map_mul' := by
      subst hT; dsimp
      apply Set.unionᵢLift_binary (coe_supᵢ_of_directed dir) dir _ (fun _ => (· * ·))
      on_goal 3 => rw [coe_supᵢ_of_directed dir]
      all_goals simp
    map_add' := by
      subst hT; dsimp
      apply Set.unionᵢLift_binary (coe_supᵢ_of_directed dir) dir _ (fun _ => (· + ·))
      on_goal 3 => rw [coe_supᵢ_of_directed dir]
      all_goals simp
    commutes' := fun r => by
      dsimp
      apply Set.unionᵢLift_const _ (fun _ => algebraMap R _ r) <;> simp }
#align subalgebra.supr_lift Subalgebra.supᵢLift

variable [Nonempty ι] {K : ι → Subalgebra R A} {dir : Directed (· ≤ ·) K} {f : ∀ i, K i →ₐ[R] B}
  {hf : ∀ (i j : ι) (h : K i ≤ K j), f i = (f j).comp (inclusion h)} {T : Subalgebra R A}
  {hT : T = supᵢ K}

@[simp]
theorem supᵢLift_inclusion {i : ι} (x : K i) (h : K i ≤ T) :
    supᵢLift K dir f hf T hT (inclusion h x) = f i x := by
  dsimp [supᵢLift, inclusion]
  rw [Set.unionᵢLift_inclusion]
#align subalgebra.supr_lift_inclusion Subalgebra.supᵢLift_inclusion

@[simp]
theorem supᵢLift_comp_inclusion {i : ι} (h : K i ≤ T) :
    (supᵢLift K dir f hf T hT).comp (inclusion h) = f i := by ext; simp
#align subalgebra.supr_lift_comp_inclusion Subalgebra.supᵢLift_comp_inclusion

@[simp]
theorem supᵢLift_mk {i : ι} (x : K i) (hx : (x : A) ∈ T) :
    supᵢLift K dir f hf T hT ⟨x, hx⟩ = f i x := by
  dsimp [supᵢLift, inclusion]
  rw [Set.unionᵢLift_mk]
#align subalgebra.supr_lift_mk Subalgebra.supᵢLift_mk

theorem supᵢLift_of_mem {i : ι} (x : T) (hx : (x : A) ∈ K i) :
    supᵢLift K dir f hf T hT x = f i ⟨x, hx⟩ := by
  dsimp [supᵢLift, inclusion]
  rw [Set.unionᵢLift_of_mem]
#align subalgebra.supr_lift_of_mem Subalgebra.supᵢLift_of_mem

end SuprLift

/-! ## Actions by `Subalgebra`s

These are just copies of the definitions about `Subsemiring` starting from
`Subring.mulAction`.
-/

section Actions

variable {α β : Type _}

/-- The action by a subalgebra is the action by the underlying algebra. -/
instance [SMul A α] (S : Subalgebra R A) : SMul S α :=
  inferInstanceAs (SMul S.toSubsemiring α)

theorem smul_def [SMul A α] {S : Subalgebra R A} (g : S) (m : α) : g • m = (g : A) • m := rfl
#align subalgebra.smul_def Subalgebra.smul_def

instance smulCommClass_left [SMul A β] [SMul α β] [SMulCommClass A α β] (S : Subalgebra R A) :
    SMulCommClass S α β :=
  S.toSubsemiring.smulCommClass_left
#align subalgebra.smul_comm_class_left Subalgebra.smulCommClass_left

instance smulCommClass_right [SMul α β] [SMul A β] [SMulCommClass α A β] (S : Subalgebra R A) :
    SMulCommClass α S β :=
  S.toSubsemiring.smulCommClass_right
#align subalgebra.smul_comm_class_right Subalgebra.smulCommClass_right

/-- Note that this provides `IsScalarTower S R R` which is needed by `smul_mul_assoc`. -/
instance isScalarTower_left [SMul α β] [SMul A α] [SMul A β] [IsScalarTower A α β]
    (S : Subalgebra R A) : IsScalarTower S α β :=
  inferInstanceAs (IsScalarTower S.toSubsemiring α β)
#align subalgebra.is_scalar_tower_left Subalgebra.isScalarTower_left

instance isScalarTower_mid {R S T : Type _} [CommSemiring R] [Semiring S] [AddCommMonoid T]
    [Algebra R S] [Module R T] [Module S T] [IsScalarTower R S T] (S' : Subalgebra R S) :
    IsScalarTower R S' T :=
  ⟨fun _x y _z => (smul_assoc _ (y : S) _ : _)⟩
#align subalgebra.is_scalar_tower_mid Subalgebra.isScalarTower_mid

instance [SMul A α] [FaithfulSMul A α] (S : Subalgebra R A) : FaithfulSMul S α :=
  inferInstanceAs (FaithfulSMul S.toSubsemiring α)

/-- The action by a subalgebra is the action by the underlying algebra. -/
instance [MulAction A α] (S : Subalgebra R A) : MulAction S α :=
  inferInstanceAs (MulAction S.toSubsemiring α)

/-- The action by a subalgebra is the action by the underlying algebra. -/
instance [AddMonoid α] [DistribMulAction A α] (S : Subalgebra R A) : DistribMulAction S α :=
  inferInstanceAs (DistribMulAction S.toSubsemiring α)

/-- The action by a subalgebra is the action by the underlying algebra. -/
instance [Zero α] [SMulWithZero A α] (S : Subalgebra R A) : SMulWithZero S α :=
  inferInstanceAs (SMulWithZero S.toSubsemiring α)

/-- The action by a subalgebra is the action by the underlying algebra. -/
instance [Zero α] [MulActionWithZero A α] (S : Subalgebra R A) : MulActionWithZero S α :=
  inferInstanceAs (MulActionWithZero S.toSubsemiring α)

/-- The action by a subalgebra is the action by the underlying algebra. -/
instance moduleLeft [AddCommMonoid α] [Module A α] (S : Subalgebra R A) : Module S α :=
  inferInstanceAs (Module S.toSubsemiring α)
#align subalgebra.module_left Subalgebra.moduleLeft

/-- The action by a subalgebra is the action by the underlying algebra. -/
instance toAlgebra {R A : Type _} [CommSemiring R] [CommSemiring A] [Semiring α] [Algebra R A]
    [Algebra A α] (S : Subalgebra R A) : Algebra S α :=
  Algebra.ofSubsemiring S.toSubsemiring
#align subalgebra.to_algebra Subalgebra.toAlgebra

theorem algebraMap_eq {R A : Type _} [CommSemiring R] [CommSemiring A] [Semiring α] [Algebra R A]
    [Algebra A α] (S : Subalgebra R A) : algebraMap S α = (algebraMap A α).comp S.val :=
  rfl
#align subalgebra.algebra_map_eq Subalgebra.algebraMap_eq

@[simp]
theorem rangeS_algebraMap {R A : Type _} [CommSemiring R] [CommSemiring A] [Algebra R A]
    (S : Subalgebra R A) : (algebraMap S A).rangeS = S.toSubsemiring := by
  rw [algebraMap_eq, Algebra.id.map_eq_id, RingHom.id_comp, ← toSubsemiring_subtype,
    Subsemiring.rangeS_subtype]
#align subalgebra.srange_algebra_map Subalgebra.rangeS_algebraMap

@[simp]
theorem range_algebraMap {R A : Type _} [CommRing R] [CommRing A] [Algebra R A]
    (S : Subalgebra R A) : (algebraMap S A).range = S.toSubring := by
  rw [algebraMap_eq, Algebra.id.map_eq_id, RingHom.id_comp, ← toSubring_subtype,
    Subring.range_subtype]
#align subalgebra.range_algebra_map Subalgebra.range_algebraMap

instance noZeroSMulDivisors_top [NoZeroDivisors A] (S : Subalgebra R A) : NoZeroSMulDivisors S A :=
  ⟨fun {c} x h =>
    have : (c : A) = 0 ∨ x = 0 := eq_zero_or_eq_zero_of_mul_eq_zero h
    this.imp_left (@Subtype.ext_iff _ _ c 0).mpr⟩
#align subalgebra.no_zero_smul_divisors_top Subalgebra.noZeroSMulDivisors_top

end Actions

section Center

theorem _root_.Set.algebraMap_mem_center (r : R) : algebraMap R A r ∈ Set.center A := by
  simp [Algebra.commutes, Set.mem_center_iff]
#align set.algebra_map_mem_center Set.algebraMap_mem_center

variable (R A)

/-- The center of an algebra is the set of elements which commute with every element. They form a
subalgebra. -/
def center : Subalgebra R A :=
  { Subsemiring.center A with algebraMap_mem' := Set.algebraMap_mem_center }
#align subalgebra.center Subalgebra.center

theorem coe_center : (center R A : Set A) = Set.center A :=
  rfl
#align subalgebra.coe_center Subalgebra.coe_center

@[simp]
theorem center_toSubsemiring : (center R A).toSubsemiring = Subsemiring.center A :=
  rfl
#align subalgebra.center_to_subsemiring Subalgebra.center_toSubsemiring

@[simp]
theorem center_toSubring (R A : Type _) [CommRing R] [Ring A] [Algebra R A] :
    (center R A).toSubring = Subring.center A :=
  rfl
#align subalgebra.center_to_subring Subalgebra.center_toSubring

@[simp]
theorem center_eq_top (A : Type _) [CommSemiring A] [Algebra R A] : center R A = ⊤ :=
  SetLike.coe_injective (Set.center_eq_univ A)
#align subalgebra.center_eq_top Subalgebra.center_eq_top

variable {R A}

instance : CommSemiring (center R A) :=
  inferInstanceAs (CommSemiring (Subsemiring.center A))

instance {A : Type _} [Ring A] [Algebra R A] : CommRing (center R A) :=
  inferInstanceAs (CommRing (Subring.center A))

theorem mem_center_iff {a : A} : a ∈ center R A ↔ ∀ b : A, b * a = a * b :=
  Iff.rfl
#align subalgebra.mem_center_iff Subalgebra.mem_center_iff

end Center

section Centralizer

@[simp]
theorem _root_.Set.algebraMap_mem_centralizer {s : Set A} (r : R) :
    algebraMap R A r ∈ s.centralizer :=
  fun _a _h => (Algebra.commutes _ _).symm
#align set.algebra_map_mem_centralizer Set.algebraMap_mem_centralizer

variable (R)

/-- The centralizer of a set as a subalgebra. -/
def centralizer (s : Set A) : Subalgebra R A :=
  { Subsemiring.centralizer s with algebraMap_mem' := Set.algebraMap_mem_centralizer }
#align subalgebra.centralizer Subalgebra.centralizer

@[simp, norm_cast]
theorem coe_centralizer (s : Set A) : (centralizer R s : Set A) = s.centralizer :=
  rfl
#align subalgebra.coe_centralizer Subalgebra.coe_centralizer

theorem mem_centralizer_iff {s : Set A} {z : A} : z ∈ centralizer R s ↔ ∀ g ∈ s, g * z = z * g :=
  Iff.rfl
#align subalgebra.mem_centralizer_iff Subalgebra.mem_centralizer_iff

theorem centralizer_le (s t : Set A) (h : s ⊆ t) : centralizer R t ≤ centralizer R s :=
  Set.centralizer_subset h
#align subalgebra.centralizer_le Subalgebra.centralizer_le

@[simp]
theorem centralizer_univ : centralizer R Set.univ = center R A :=
  SetLike.ext' (Set.centralizer_univ A)
#align subalgebra.centralizer_univ Subalgebra.centralizer_univ

end Centralizer

-- Porting note: in the following proof, we manually add the instances `_i₁` and `_i₂`
-- Removing those lines and enabling `etaExperiment` on the next line gives a *broken* proof
-- set_option synthInstance.etaExperiment true in
/-- Suppose we are given `∑ i, lᵢ * sᵢ = 1` in `S`, and `S'` a subalgebra of `S` that contains
`lᵢ` and `sᵢ`. To check that an `x : S` falls in `S'`, we only need to show that
`sᵢ ^ n • x ∈ S'` for some `n` for each `sᵢ`. -/
theorem mem_of_finset_sum_eq_one_of_pow_smul_mem {S : Type _} [CommRing S] [Algebra R S]
    (S' : Subalgebra R S) {ι : Type _} (ι' : Finset ι) (s : ι → S) (l : ι → S)
    (e : (∑ i in ι', l i * s i) = 1) (hs : ∀ i, s i ∈ S') (hl : ∀ i, l i ∈ S') (x : S)
    (H : ∀ i, ∃ n : ℕ, (s i ^ n : S) • x ∈ S') : x ∈ S' := by
  -- Porting note: needed to add this instance
  let _i₁ : Algebra { x // x ∈ S' } { x // x ∈ S' } := Algebra.id _
  suffices x ∈ Subalgebra.toSubmodule (Algebra.ofId S' S).range by
    obtain ⟨x, rfl⟩ := this
    exact x.2
  choose n hn using H
  let s' : ι → S' := fun x => ⟨s x, hs x⟩
  let l' : ι → S' := fun x => ⟨l x, hl x⟩
  have e' : (∑ i in ι', l' i * s' i) = 1 := by
    ext
    show S'.subtype (∑ i in ι', l' i * s' i) = 1
    simpa only [map_sum, map_mul] using e
  have : Ideal.span (s' '' ι') = ⊤ := by
    rw [Ideal.eq_top_iff_one, ← e']
    apply sum_mem
    intros i hi
    exact Ideal.mul_mem_left _ _ <| Ideal.subset_span <| Set.mem_image_of_mem s' hi
  let N := ι'.sup n
  have hN := Ideal.span_pow_eq_top _ this N
  apply (Algebra.ofId S' S).range.toSubmodule.mem_of_span_top_of_smul_mem _ hN
  rintro ⟨_, _, ⟨i, hi, rfl⟩, rfl⟩
  change s' i ^ N • x ∈ _
  rw [← tsub_add_cancel_of_le (show n i ≤ N from Finset.le_sup hi), pow_add, mul_smul]
  -- Porting note: needed to add this instance
  let _i₂ : SubmonoidClass (Subalgebra R S) S := Subalgebra.SubsemiringClass.toSubmonoidClass
  refine' Submodule.smul_mem _ (⟨_, pow_mem (hs i) _⟩ : S') _
  exact ⟨⟨_, hn i⟩, rfl⟩
#align subalgebra.mem_of_finset_sum_eq_one_of_pow_smul_mem Subalgebra.mem_of_finset_sum_eq_one_of_pow_smul_mem

theorem mem_of_span_eq_top_of_smul_pow_mem {S : Type _} [CommRing S] [Algebra R S]
    (S' : Subalgebra R S) (s : Set S) (l : s →₀ S) (hs : Finsupp.total s S S (↑) l = 1)
    (hs' : s ⊆ S') (hl : ∀ i, l i ∈ S') (x : S) (H : ∀ r : s, ∃ n : ℕ, (r : S) ^ n • x ∈ S') :
    x ∈ S' :=
  mem_of_finset_sum_eq_one_of_pow_smul_mem S' l.support (↑) l hs (fun x => hs' x.2) hl x H
#align subalgebra.mem_of_span_eq_top_of_smul_pow_mem Subalgebra.mem_of_span_eq_top_of_smul_pow_mem

end Subalgebra

section Nat

variable {R : Type _} [Semiring R]

/-- A subsemiring is a `ℕ`-subalgebra. -/
def subalgebraOfSubsemiring (S : Subsemiring R) : Subalgebra ℕ R :=
  { S with algebraMap_mem' := fun i => coe_nat_mem S i }
#align subalgebra_of_subsemiring subalgebraOfSubsemiring

@[simp]
theorem mem_subalgebraOfSubsemiring {x : R} {S : Subsemiring R} :
    x ∈ subalgebraOfSubsemiring S ↔ x ∈ S :=
  Iff.rfl
#align mem_subalgebra_of_subsemiring mem_subalgebraOfSubsemiring

end Nat

section Int

variable {R : Type _} [Ring R]

/-- A subring is a `ℤ`-subalgebra. -/
def subalgebraOfSubring (S : Subring R) : Subalgebra ℤ R :=
  { S with
    algebraMap_mem' := fun i =>
      Int.induction_on i (by simpa using S.zero_mem)
        (fun i ih => by simpa using S.add_mem ih S.one_mem) fun i ih =>
        show ((-i - 1 : ℤ) : R) ∈ S by
          rw [Int.cast_sub, Int.cast_one]
          exact S.sub_mem ih S.one_mem }
#align subalgebra_of_subring subalgebraOfSubring

variable {S : Type _} [Semiring S]

@[simp]
theorem mem_subalgebraOfSubring {x : R} {S : Subring R} : x ∈ subalgebraOfSubring S ↔ x ∈ S :=
  Iff.rfl
#align mem_subalgebra_of_subring mem_subalgebraOfSubring

end Int


/-
Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn
-/
import data.fin.vec_notation
import set_theory.cardinal.basic

/-!
# Basics on First-Order Structures
This file defines first-order languages and structures in the style of the
[Flypitch project](https://flypitch.github.io/), as well as several important maps between
structures.

## Main Definitions
* A `first_order.language` defines a language as a pair of functions from the natural numbers to
  `Type l`. One sends `n` to the type of `n`-ary functions, and the other sends `n` to the type of
  `n`-ary relations.
* A `first_order.language.Structure` interprets the symbols of a given `first_order.language` in the
  context of a given type.
* A `first_order.language.hom`, denoted `M →[L] N`, is a map from the `L`-structure `M` to the
  `L`-structure `N` that commutes with the interpretations of functions, and which preserves the
  interpretations of relations (although only in the forward direction).
* A `first_order.language.embedding`, denoted `M ↪[L] N`, is an embedding from the `L`-structure `M`
  to the `L`-structure `N` that commutes with the interpretations of functions, and which preserves
  the interpretations of relations in both directions.
* A `first_order.language.elementary_embedding`, denoted `M ↪ₑ[L] N`, is an embedding from the
  `L`-structure `M` to the `L`-structure `N` that commutes with the realizations of all formulas.
* A `first_order.language.equiv`, denoted `M ≃[L] N`, is an equivalence from the `L`-structure `M`
  to the `L`-structure `N` that commutes with the interpretations of functions, and which preserves
  the interpretations of relations in both directions.

## TODO

Use `[countable L.symbols]` instead of `[L.countable]`.

## References
For the Flypitch project:
- [J. Han, F. van Doorn, *A formal proof of the independence of the continuum hypothesis*]
[flypitch_cpp]
- [J. Han, F. van Doorn, *A formalization of forcing and the unprovability of
the continuum hypothesis*][flypitch_itp]

-/
universes u v u' v' w w'

open_locale cardinal
open cardinal

namespace first_order

/-! ### Languages and Structures -/

/-- A first-order language consists of a type of functions of every natural-number arity and a
  type of relations of every natural-number arity. -/
@[nolint check_univs] -- intended to be used with explicit universe parameters
structure language :=
(functions : ℕ → Type u) (relations : ℕ → Type v)

/-- Used to define `first_order.language₂`. -/
@[simp] def sequence₂ (a₀ a₁ a₂ : Type u) : ℕ → Type u
| 0 := a₀
| 1 := a₁
| 2 := a₂
| _ := pempty

namespace sequence₂

variables (a₀ a₁ a₂ : Type u)

instance inhabited₀ [h : inhabited a₀] : inhabited (sequence₂ a₀ a₁ a₂ 0) := h

instance inhabited₁ [h : inhabited a₁] : inhabited (sequence₂ a₀ a₁ a₂ 1) := h

instance inhabited₂ [h : inhabited a₂] : inhabited (sequence₂ a₀ a₁ a₂ 2) := h

instance {n : ℕ} : is_empty (sequence₂ a₀ a₁ a₂ (n + 3)) := pempty.is_empty

@[simp] lemma lift_mk {i : ℕ} :
  cardinal.lift (# (sequence₂ a₀ a₁ a₂ i)) = # (sequence₂ (ulift a₀) (ulift a₁) (ulift a₂) i) :=
begin
  rcases i with (_ | _ | _ | i);
  simp only [sequence₂, mk_ulift, mk_fintype, fintype.card_of_is_empty, nat.cast_zero, lift_zero],
end

@[simp] lemma sum_card :
  cardinal.sum (λ i, # (sequence₂ a₀ a₁ a₂ i)) = # a₀ + # a₁ + # a₂ :=
begin
  rw [sum_nat_eq_add_sum_succ, sum_nat_eq_add_sum_succ, sum_nat_eq_add_sum_succ],
  simp [add_assoc],
end

end sequence₂

namespace language

/-- A constructor for languages with only constants, unary and binary functions, and
unary and binary relations. -/
@[simps] protected def mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) : language :=
⟨sequence₂ c f₁ f₂, sequence₂ pempty r₁ r₂⟩

/-- The empty language has no symbols. -/
protected def empty : language := ⟨λ _, empty, λ _, empty⟩

instance : inhabited language := ⟨language.empty⟩

/-- The sum of two languages consists of the disjoint union of their symbols. -/
protected def sum (L : language.{u v}) (L' : language.{u' v'}) : language :=
⟨λn, L.functions n ⊕ L'.functions n, λ n, L.relations n ⊕ L'.relations n⟩

variable (L : language.{u v})

/-- The type of constants in a given language. -/
@[nolint has_nonempty_instance] protected def «constants» := L.functions 0

@[simp] lemma constants_mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) :
  (language.mk₂ c f₁ f₂ r₁ r₂).constants = c :=
rfl

/-- The type of symbols in a given language. -/
@[nolint has_nonempty_instance] def symbols := (Σl, L.functions l) ⊕ (Σl, L.relations l)

/-- The cardinality of a language is the cardinality of its type of symbols. -/
def card : cardinal := # L.symbols

/-- A language is relational when it has no function symbols. -/
class is_relational : Prop :=
(empty_functions : ∀ n, is_empty (L.functions n))

/-- A language is algebraic when it has no relation symbols. -/
class is_algebraic : Prop :=
(empty_relations : ∀ n, is_empty (L.relations n))

variables {L} {L' : language.{u' v'}}

lemma card_eq_card_functions_add_card_relations :
  L.card = cardinal.sum (λ l, (cardinal.lift.{v} (#(L.functions l)))) +
    cardinal.sum (λ l, cardinal.lift.{u} (#(L.relations l))) :=
by simp [card, symbols]

instance [L.is_relational] {n : ℕ} : is_empty (L.functions n) := is_relational.empty_functions n

instance [L.is_algebraic] {n : ℕ} : is_empty (L.relations n) := is_algebraic.empty_relations n

instance is_relational_of_empty_functions {symb : ℕ → Type*} : is_relational ⟨λ _, empty, symb⟩ :=
⟨λ _, empty.is_empty⟩

instance is_algebraic_of_empty_relations {symb : ℕ → Type*}  : is_algebraic ⟨symb, λ _, empty⟩ :=
⟨λ _, empty.is_empty⟩

instance is_relational_empty : is_relational language.empty :=
language.is_relational_of_empty_functions

instance is_algebraic_empty : is_algebraic language.empty :=
language.is_algebraic_of_empty_relations

instance is_relational_sum [L.is_relational] [L'.is_relational] : is_relational (L.sum L') :=
⟨λ n, sum.is_empty⟩

instance is_algebraic_sum [L.is_algebraic] [L'.is_algebraic] : is_algebraic (L.sum L') :=
⟨λ n, sum.is_empty⟩

instance is_relational_mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  [h0 : is_empty c] [h1 : is_empty f₁] [h2 : is_empty f₂] :
  is_relational (language.mk₂ c f₁ f₂ r₁ r₂) :=
⟨λ n, nat.cases_on n h0 (λ n, nat.cases_on n h1 (λ n, nat.cases_on n h2 (λ _, pempty.is_empty)))⟩

instance is_algebraic_mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  [h1 : is_empty r₁] [h2 : is_empty r₂] :
  is_algebraic (language.mk₂ c f₁ f₂ r₁ r₂) :=
⟨λ n, nat.cases_on n pempty.is_empty
  (λ n, nat.cases_on n h1 (λ n, nat.cases_on n h2 (λ _, pempty.is_empty)))⟩

instance subsingleton_mk₂_functions {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  [h0 : subsingleton c] [h1 : subsingleton f₁] [h2 : subsingleton f₂] {n : ℕ} :
  subsingleton ((language.mk₂ c f₁ f₂ r₁ r₂).functions n) :=
nat.cases_on n h0 (λ n, nat.cases_on n h1 (λ n, nat.cases_on n h2 (λ n, ⟨λ x, pempty.elim x⟩)))

instance subsingleton_mk₂_relations {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  [h1 : subsingleton r₁] [h2 : subsingleton r₂] {n : ℕ} :
  subsingleton ((language.mk₂ c f₁ f₂ r₁ r₂).relations n) :=
nat.cases_on n ⟨λ x, pempty.elim x⟩
  (λ n, nat.cases_on n h1 (λ n, nat.cases_on n h2 (λ n, ⟨λ x, pempty.elim x⟩)))

@[simp] lemma empty_card : language.empty.card = 0 :=
by simp [card_eq_card_functions_add_card_relations]

instance is_empty_empty : is_empty language.empty.symbols :=
begin
  simp only [language.symbols, is_empty_sum, is_empty_sigma],
  exact ⟨λ _, infer_instance, λ _, infer_instance⟩,
end

instance countable.countable_functions [h : countable L.symbols] :
  countable (Σl, L.functions l) :=
@function.injective.countable _ _ h _ sum.inl_injective

@[simp] lemma card_functions_sum (i : ℕ) :
  #((L.sum L').functions i) = (#(L.functions i)).lift + cardinal.lift.{u} (#(L'.functions i)) :=
by simp [language.sum]

@[simp] lemma card_relations_sum (i : ℕ) :
  #((L.sum L').relations i) = (#(L.relations i)).lift + cardinal.lift.{v} (#(L'.relations i)) :=
by simp [language.sum]

@[simp] lemma card_sum :
  (L.sum L').card = cardinal.lift.{max u' v'} L.card + cardinal.lift.{max u v} L'.card :=
begin
  simp only [card_eq_card_functions_add_card_relations, card_functions_sum, card_relations_sum,
    sum_add_distrib', lift_add, lift_sum, lift_lift],
  rw [add_assoc, ←add_assoc (cardinal.sum (λ i, (# (L'.functions i)).lift)),
    add_comm (cardinal.sum (λ i, (# (L'.functions i)).lift)), add_assoc, add_assoc]
end

@[simp] lemma card_mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) :
  (language.mk₂ c f₁ f₂ r₁ r₂).card =
    cardinal.lift.{v} (# c) + cardinal.lift.{v} (# f₁) + cardinal.lift.{v} (# f₂)
    + cardinal.lift.{u} (# r₁) + cardinal.lift.{u} (# r₂) :=
by simp [card_eq_card_functions_add_card_relations, add_assoc]

variables (L) (M : Type w)

/-- A first-order structure on a type `M` consists of interpretations of all the symbols in a given
  language. Each function of arity `n` is interpreted as a function sending tuples of length `n`
  (modeled as `(fin n → M)`) to `M`, and a relation of arity `n` is a function from tuples of length
  `n` to `Prop`. -/
@[ext] class Structure :=
(fun_map : ∀{n}, L.functions n → (fin n → M) → M)
(rel_map : ∀{n}, L.relations n → (fin n → M) → Prop)

variables (N : Type w') [L.Structure M] [L.Structure N]

open Structure

/-- Used for defining `first_order.language.Theory.Model.inhabited`. -/
def inhabited.trivial_structure {α : Type*} [inhabited α] : L.Structure α := ⟨default, default⟩

/-! ### Maps -/

/-- A homomorphism between first-order structures is a function that commutes with the
  interpretations of functions and maps tuples in one structure where a given relation is true to
  tuples in the second structure where that relation is still true. -/
structure hom :=
(to_fun : M → N)
(map_fun' : ∀{n} (f : L.functions n) x, to_fun (fun_map f x) = fun_map f (to_fun ∘ x) . obviously)
(map_rel' : ∀{n} (r : L.relations n) x, rel_map r x → rel_map r (to_fun ∘ x) . obviously)

localized "notation (name := language.hom) A ` →[`:25 L `] ` B :=
  first_order.language.hom L A B" in first_order

/-- An embedding of first-order structures is an embedding that commutes with the
  interpretations of functions and relations. -/
@[ancestor function.embedding] structure embedding extends M ↪ N :=
(map_fun' : ∀{n} (f : L.functions n) x, to_fun (fun_map f x) = fun_map f (to_fun ∘ x) . obviously)
(map_rel' : ∀{n} (r : L.relations n) x, rel_map r (to_fun ∘ x) ↔ rel_map r x . obviously)

localized "notation (name := language.embedding) A ` ↪[`:25 L `] ` B :=
  first_order.language.embedding L A B" in first_order

/-- An equivalence of first-order structures is an equivalence that commutes with the
  interpretations of functions and relations. -/
structure equiv extends M ≃ N :=
(map_fun' : ∀{n} (f : L.functions n) x, to_fun (fun_map f x) = fun_map f (to_fun ∘ x) . obviously)
(map_rel' : ∀{n} (r : L.relations n) x, rel_map r (to_fun ∘ x) ↔ rel_map r x . obviously)

localized "notation (name := language.equiv) A ` ≃[`:25 L `] ` B :=
  first_order.language.equiv L A B" in first_order

variables {L M N} {P : Type*} [L.Structure P] {Q : Type*} [L.Structure Q]

instance : has_coe_t L.constants M :=
⟨λ c, fun_map c default⟩

lemma fun_map_eq_coe_constants {c : L.constants} {x : fin 0 → M} :
  fun_map c x = c := congr rfl (funext fin.elim0)

/-- Given a language with a nonempty type of constants, any structure will be nonempty. This cannot
  be a global instance, because `L` becomes a metavariable. -/
lemma nonempty_of_nonempty_constants [h : nonempty L.constants] : nonempty M :=
h.map coe

/-- The function map for `first_order.language.Structure₂`. -/
def fun_map₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  (c' : c → M) (f₁' : f₁ → M → M) (f₂' : f₂ → M → M → M) :
  ∀{n}, (language.mk₂ c f₁ f₂ r₁ r₂).functions n → (fin n → M) → M
| 0 f _ := c' f
| 1 f x := f₁' f (x 0)
| 2 f x := f₂' f (x 0) (x 1)
| (n + 3) f _ := pempty.elim f

/-- The relation map for `first_order.language.Structure₂`. -/
def rel_map₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  (r₁' : r₁ → set M) (r₂' : r₂ → M → M → Prop) :
  ∀{n}, (language.mk₂ c f₁ f₂ r₁ r₂).relations n → (fin n → M) → Prop
| 0 r _ := pempty.elim r
| 1 r x := (x 0) ∈ r₁' r
| 2 r x := r₂' r (x 0) (x 1)
| (n + 3) r _ := pempty.elim r

/-- A structure constructor to match `first_order.language₂`. -/
protected def Structure.mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  (c' : c → M) (f₁' : f₁ → M → M) (f₂' : f₂ → M → M → M)
  (r₁' : r₁ → set M) (r₂' : r₂ → M → M → Prop) :
  (language.mk₂ c f₁ f₂ r₁ r₂).Structure M :=
⟨λ _, fun_map₂ c' f₁' f₂', λ _, rel_map₂ r₁' r₂'⟩

namespace Structure

variables {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
variables {c' : c → M} {f₁' : f₁ → M → M} {f₂' : f₂ → M → M → M}
variables {r₁' : r₁ → set M} {r₂' : r₂ → M → M → Prop}

@[simp] lemma fun_map_apply₀ (c₀ : c) {x : fin 0 → M} :
  @Structure.fun_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 0 c₀ x = c' c₀ := rfl

@[simp] lemma fun_map_apply₁ (f : f₁) (x : M) :
  @Structure.fun_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 1 f (![x]) = f₁' f x := rfl

@[simp] lemma fun_map_apply₂ (f : f₂) (x y : M) :
  @Structure.fun_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 2 f (![x,y]) = f₂' f x y := rfl

@[simp] lemma rel_map_apply₁ (r : r₁) (x : M) :
  @Structure.rel_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 1 r (![x]) = (x ∈ r₁' r) := rfl

@[simp]

end Structure

/-- `hom_class L F M N` states that `F` is a type of `L`-homomorphisms. You should extend this
  typeclass when you extend `first_order.language.hom`. -/
class hom_class (L : out_param language) (F : Type*)
  (M N : out_param $ Type*) [fun_like F M (λ _, N)] [L.Structure M] [L.Structure N] :=
(map_fun : ∀ (φ : F) {n} (f : L.functions n) x, φ (fun_map f x) = fun_map f (φ ∘ x))
(map_rel : ∀ (φ : F) {n} (r : L.relations n) x, rel_map r x → rel_map r (φ ∘ x))

/-- `strong_hom_class L F M N` states that `F` is a type of `L`-homomorphisms which preserve
  relations in both directions. -/
class strong_hom_class (L : out_param language) (F : Type*) (M N : out_param $ Type*)
  [fun_like F M (λ _, N)] [L.Structure M] [L.Structure N] :=
(map_fun : ∀ (φ : F) {n} (f : L.functions n) x, φ (fun_map f x) = fun_map f (φ ∘ x))
(map_rel : ∀ (φ : F) {n} (r : L.relations n) x, rel_map r (φ ∘ x) ↔ rel_map r x)

@[priority 100] instance strong_hom_class.hom_class
  {F M N} [L.Structure M] [L.Structure N] [fun_like F M (λ _, N)] [strong_hom_class L F M N] :
  hom_class L F M N :=
{ map_fun := strong_hom_class.map_fun,
  map_rel := λ φ n R x, (strong_hom_class.map_rel φ R x).2 }

/-- Not an instance to avoid a loop. -/
def hom_class.strong_hom_class_of_is_algebraic [L.is_algebraic]
  {F M N} [L.Structure M] [L.Structure N] [fun_like F M (λ _, N)] [hom_class L F M N] :
  strong_hom_class L F M N :=
{ map_fun := hom_class.map_fun,
  map_rel := λ φ n R x, (is_algebraic.empty_relations n).elim R }

lemma hom_class.map_constants {F M N} [L.Structure M] [L.Structure N] [fun_like F M (λ _, N)]
  [hom_class L F M N]
  (φ : F) (c : L.constants) : φ (c) = c :=
(hom_class.map_fun φ c default).trans (congr rfl (funext default))

namespace hom

instance fun_like : fun_like (M →[L] N) M (λ _, N) :=
{ coe := hom.to_fun,
  coe_injective' := λ f g h, by {cases f, cases g, cases h, refl} }

instance hom_class : hom_class L (M →[L] N) M N :=
{ map_fun := map_fun',
  map_rel := map_rel' }

instance [L.is_algebraic] : strong_hom_class L (M →[L] N) M N :=
hom_class.strong_hom_class_of_is_algebraic

instance has_coe_to_fun : has_coe_to_fun (M →[L] N) (λ _, M → N) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe {f : M →[L] N} : f.to_fun = (f : M → N) := rfl

@[ext]
lemma ext ⦃f g : M →[L] N⦄ (h : ∀ x, f x = g x) : f = g :=
fun_like.ext f g h

lemma ext_iff {f g : M →[L] N} : f = g ↔ ∀ x, f x = g x :=
fun_like.ext_iff

@[simp] lemma map_fun (φ : M →[L] N) {n : ℕ} (f : L.functions n) (x : fin n → M) :
  φ (fun_map f x) = fun_map f (φ ∘ x) :=
hom_class.map_fun φ f x

@[simp] lemma map_constants (φ : M →[L] N) (c : L.constants) : φ c = c :=
hom_class.map_constants φ c

@[simp] lemma map_rel (φ : M →[L] N) {n : ℕ} (r : L.relations n) (x : fin n → M) :
  rel_map r x → rel_map r (φ ∘ x) :=
hom_class.map_rel φ r x

variables (L) (M)
/-- The identity map from a structure to itself -/
@[refl] def id : M →[L] M :=
{ to_fun := id }

variables {L} {M}

instance : inhabited (M →[L] M) := ⟨id L M⟩

@[simp] lemma id_apply (x : M) :
  id L M x = x := rfl

/-- Composition of first-order homomorphisms -/
@[trans] def comp (hnp : N →[L] P) (hmn : M →[L] N) : M →[L] P :=
{ to_fun := hnp ∘ hmn,
  map_rel' := λ _ _ _ h, by simp [h] }

@[simp] lemma comp_apply (g : N →[L] P) (f : M →[L] N) (x : M) :
  g.comp f x = g (f x) := rfl

/-- Composition of first-order homomorphisms is associative. -/
lemma comp_assoc (f : M →[L] N) (g : N →[L] P) (h : P →[L] Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl

end hom

/-- Any element of a `hom_class` can be realized as a first_order homomorphism. -/
def hom_class.to_hom {F M N} [L.Structure M] [L.Structure N]
  [fun_like F M (λ _, N)] [hom_class L F M N] :
  F → (M →[L] N) :=
λ φ, ⟨φ, λ _, hom_class.map_fun φ, λ _, hom_class.map_rel φ⟩

namespace embedding

instance embedding_like : embedding_like (M ↪[L] N) M N :=
{ coe := λ f, f.to_fun,
  injective' := λ f, f.to_embedding.injective,
  coe_injective' := λ f g h, begin
    cases f,
    cases g,
    simp only,
    ext x,
    exact function.funext_iff.1 h x end }

instance strong_hom_class : strong_hom_class L (M ↪[L] N) M N :=
{ map_fun := map_fun',
  map_rel := map_rel' }

instance has_coe_to_fun : has_coe_to_fun (M ↪[L] N) (λ _, M → N) :=
fun_like.has_coe_to_fun

@[simp] lemma map_fun (φ : M ↪[L] N) {n : ℕ} (f : L.functions n) (x : fin n → M) :
  φ (fun_map f x) = fun_map f (φ ∘ x) :=
hom_class.map_fun φ f x

@[simp] lemma map_constants (φ : M ↪[L] N) (c : L.constants) : φ c = c :=
hom_class.map_constants φ c

@[simp] lemma map_rel (φ : M ↪[L] N) {n : ℕ} (r : L.relations n) (x : fin n → M) :
  rel_map r (φ ∘ x) ↔ rel_map r x :=
strong_hom_class.map_rel φ r x

/-- A first-order embedding is also a first-order homomorphism. -/
def to_hom : (M ↪[L] N) → M →[L] N := hom_class.to_hom

@[simp]
lemma coe_to_hom {f : M ↪[L] N} : (f.to_hom : M → N) = f := rfl

lemma coe_injective : @function.injective (M ↪[L] N) (M → N) coe_fn
| f g h :=
begin
  cases f,
  cases g,
  simp only,
  ext x,
  exact function.funext_iff.1 h x,
end

@[ext]
lemma ext ⦃f g : M ↪[L] N⦄ (h : ∀ x, f x = g x) : f = g :=
coe_injective (funext h)

lemma ext_iff {f g : M ↪[L] N} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, ext h⟩

lemma injective (f : M ↪[L] N) : function.injective f := f.to_embedding.injective

/-- In an algebraic language, any injective homomorphism is an embedding. -/
@[simps] def of_injective [L.is_algebraic] {f : M →[L] N} (hf : function.injective f) : M ↪[L] N :=
{ inj' := hf,
  map_rel' := λ n r x, strong_hom_class.map_rel f r x,
  .. f }

@[simp] lemma coe_fn_of_injective [L.is_algebraic] {f : M →[L] N} (hf : function.injective f) :
  (of_injective hf : M → N) = f := rfl

@[simp] lemma of_injective_to_hom [L.is_algebraic] {f : M →[L] N} (hf : function.injective f) :
  (of_injective hf).to_hom = f :=
by { ext, simp }

variables (L) (M)
/-- The identity embedding from a structure to itself -/
@[refl] def refl : M ↪[L] M :=
{ to_embedding := function.embedding.refl M }

variables {L} {M}

instance : inhabited (M ↪[L] M) := ⟨refl L M⟩

@[simp] lemma refl_apply (x : M) :
  refl L M x = x := rfl

/-- Composition of first-order embeddings -/
@[trans] def comp (hnp : N ↪[L] P) (hmn : M ↪[L] N) : M ↪[L] P :=
{ to_fun := hnp ∘ hmn,
  inj' := hnp.injective.comp hmn.injective }

@[simp] lemma comp_apply (g : N ↪[L] P) (f : M ↪[L] N) (x : M) :
  g.comp f x = g (f x) := rfl

/-- Composition of first-order embeddings is associative. -/
lemma comp_assoc (f : M ↪[L] N) (g : N ↪[L] P) (h : P ↪[L] Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl

@[simp] lemma comp_to_hom (hnp : N ↪[L] P) (hmn : M ↪[L] N) :
  (hnp.comp hmn).to_hom = hnp.to_hom.comp hmn.to_hom :=
by { ext, simp only [coe_to_hom, comp_apply, hom.comp_apply] }

end embedding

/-- Any element of an injective `strong_hom_class` can be realized as a first_order embedding. -/
def strong_hom_class.to_embedding {F M N} [L.Structure M] [L.Structure N]
  [embedding_like F M N] [strong_hom_class L F M N] :
  F → (M ↪[L] N) :=
λ φ, ⟨⟨φ, embedding_like.injective φ⟩,
  λ _, strong_hom_class.map_fun φ, λ _, strong_hom_class.map_rel φ⟩

namespace equiv

instance : equiv_like (M ≃[L] N) M N :=
{ coe := λ f, f.to_fun,
  inv := λ f, f.inv_fun,
  left_inv := λ f, f.left_inv,
  right_inv := λ f, f.right_inv,
  coe_injective' := λ f g h₁ h₂, begin
    cases f,
    cases g,
    simp only,
    ext x,
    exact function.funext_iff.1 h₁ x,
  end, }

instance : strong_hom_class L (M ≃[L] N) M N :=
{ map_fun := map_fun',
  map_rel := map_rel', }

/-- The inverse of a first-order equivalence is a first-order equivalence. -/
@[symm] def symm (f : M ≃[L] N) : N ≃[L] M :=
{ map_fun' := λ n f' x, begin
    simp only [equiv.to_fun_as_coe],
    rw [equiv.symm_apply_eq],
    refine eq.trans _ (f.map_fun' f' (f.to_equiv.symm ∘ x)).symm,
    rw [← function.comp.assoc, equiv.to_fun_as_coe, equiv.self_comp_symm, function.comp.left_id]
  end,
  map_rel' := λ n r x, begin
    simp only [equiv.to_fun_as_coe],
    refine (f.map_rel' r (f.to_equiv.symm ∘ x)).symm.trans _,
    rw [← function.comp.assoc, equiv.to_fun_as_coe, equiv.self_comp_symm, function.comp.left_id]
  end,
  .. f.to_equiv.symm }

instance has_coe_to_fun : has_coe_to_fun (M ≃[L] N) (λ _, M → N) :=
fun_like.has_coe_to_fun

@[simp]
lemma apply_symm_apply (f : M ≃[L] N) (a : N) : f (f.symm a) = a := f.to_equiv.apply_symm_apply a

@[simp]
lemma symm_apply_apply (f : M ≃[L] N) (a : M) : f.symm (f a) = a := f.to_equiv.symm_apply_apply a

@[simp] lemma map_fun (φ : M ≃[L] N) {n : ℕ} (f : L.functions n) (x : fin n → M) :
  φ (fun_map f x) = fun_map f (φ ∘ x) :=
hom_class.map_fun φ f x

@[simp] lemma map_constants (φ : M ≃[L] N) (c : L.constants) : φ c = c :=
hom_class.map_constants φ c

@[simp] lemma map_rel (φ : M ≃[L] N) {n : ℕ} (r : L.relations n) (x : fin n → M) :
  rel_map r (φ ∘ x) ↔ rel_map r x :=
strong_hom_class.map_rel φ r x

/-- A first-order equivalence is also a first-order embedding. -/
def to_embedding : (M ≃[L] N) → M ↪[L] N := strong_hom_class.to_embedding

/-- A first-order equivalence is also a first-order homomorphism. -/
def to_hom : (M ≃[L] N) → M →[L] N := hom_class.to_hom

@[simp] lemma to_embedding_to_hom (f : M ≃[L] N) : f.to_embedding.to_hom = f.to_hom := rfl

@[simp]
lemma coe_to_hom {f : M ≃[L] N} : (f.to_hom : M → N) = (f : M → N) := rfl

@[simp] lemma coe_to_embedding (f : M ≃[L] N) : (f.to_embedding : M → N) = (f : M → N) := rfl

lemma coe_injective : @function.injective (M ≃[L] N) (M → N) coe_fn :=
fun_like.coe_injective

@[ext]
lemma ext ⦃f g : M ≃[L] N⦄ (h : ∀ x, f x = g x) : f = g :=
coe_injective (funext h)

lemma ext_iff {f g : M ≃[L] N} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, ext h⟩

lemma bijective (f : M ≃[L] N) : function.bijective f := equiv_like.bijective f

lemma injective (f : M ≃[L] N) : function.injective f := equiv_like.injective f

lemma surjective (f : M ≃[L] N) : function.surjective f := equiv_like.surjective f

variables (L) (M)
/-- The identity equivalence from a structure to itself -/
@[refl] def refl : M ≃[L] M :=
{ to_equiv := equiv.refl M }

variables {L} {M}

instance : inhabited (M ≃[L] M) := ⟨refl L M⟩

@[simp] lemma refl_apply (x : M) :
  refl L M x = x := rfl

/-- Composition of first-order equivalences -/
@[trans] def comp (hnp : N ≃[L] P) (hmn : M ≃[L] N) : M ≃[L] P :=
{ to_fun := hnp ∘ hmn,
  .. (hmn.to_equiv.trans hnp.to_equiv) }

@[simp] lemma comp_apply (g : N ≃[L] P) (f : M ≃[L] N) (x : M) :
  g.comp f x = g (f x) := rfl

/-- Composition of first-order homomorphisms is associative. -/
lemma comp_assoc (f : M ≃[L] N) (g : N ≃[L] P) (h : P ≃[L] Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl

end equiv

/-- Any element of a bijective `strong_hom_class` can be realized as a first_order isomorphism. -/
def strong_hom_class.to_equiv {F M N} [L.Structure M] [L.Structure N]
  [equiv_like F M N] [strong_hom_class L F M N] :
  F → (M ≃[L] N) :=
λ φ, ⟨⟨φ, equiv_like.inv φ, equiv_like.left_inv φ, equiv_like.right_inv φ⟩,
  λ _, hom_class.map_fun φ, λ _, strong_hom_class.map_rel φ⟩

section sum_Structure
variables (L₁ L₂ : language) (S : Type*) [L₁.Structure S] [L₂.Structure S]

instance sum_Structure :
  (L₁.sum L₂).Structure S :=
{ fun_map := λ n, sum.elim fun_map fun_map,
  rel_map := λ n, sum.elim rel_map rel_map, }

variables {L₁ L₂ S}

@[simp] lemma fun_map_sum_inl {n : ℕ} (f : L₁.functions n) :
  @fun_map (L₁.sum L₂) S _ n (sum.inl f) = fun_map f := rfl

@[simp] lemma fun_map_sum_inr {n : ℕ} (f : L₂.functions n) :
  @fun_map (L₁.sum L₂) S _ n (sum.inr f) = fun_map f := rfl

@[simp] lemma rel_map_sum_inl {n : ℕ} (R : L₁.relations n) :
  @rel_map (L₁.sum L₂) S _ n (sum.inl R) = rel_map R := rfl

@[simp] lemma rel_map_sum_inr {n : ℕ} (R : L₂.relations n) :
  @rel_map (L₁.sum L₂) S _ n (sum.inr R) = rel_map R := rfl

end sum_Structure

section empty
section
variables [language.empty.Structure M] [language.empty.Structure N]

@[simp] lemma empty.nonempty_embedding_iff :
  nonempty (M ↪[language.empty] N) ↔ cardinal.lift.{w'} (# M) ≤ cardinal.lift.{w} (# N) :=
trans ⟨nonempty.map (λ f, f.to_embedding), nonempty.map (λ f, {to_embedding := f})⟩
  cardinal.lift_mk_le'.symm

@[simp] lemma empty.nonempty_equiv_iff :
  nonempty (M ≃[language.empty] N) ↔ cardinal.lift.{w'} (# M) = cardinal.lift.{w} (# N) :=
trans ⟨nonempty.map (λ f, f.to_equiv), nonempty.map (λ f, {to_equiv := f})⟩
  cardinal.lift_mk_eq'.symm

end

instance empty_Structure : language.empty.Structure M :=
⟨λ _, empty.elim, λ _, empty.elim⟩

instance : unique (language.empty.Structure M) :=
⟨⟨language.empty_Structure⟩, λ a, begin
  ext n f,
  { exact empty.elim f },
  { exact subsingleton.elim _ _ },
end⟩

@[priority 100] instance strong_hom_class_empty {F M N} [fun_like F M (λ _, N)] :
  strong_hom_class language.empty F M N :=
⟨λ _ _ f, empty.elim f, λ _ _ r, empty.elim r⟩

/-- Makes a `language.empty.hom` out of any function. -/
@[simps] def _root_.function.empty_hom (f : M → N) : (M →[language.empty] N) :=
{ to_fun := f }

/-- Makes a `language.empty.embedding` out of any function. -/
@[simps] def _root_.embedding.empty (f : M ↪ N) : (M ↪[language.empty] N) :=
{ to_embedding := f }

/-- Makes a `language.empty.equiv` out of any function. -/
@[simps] def _root_.equiv.empty (f : M ≃ N) : (M ≃[language.empty] N) :=
{ to_equiv := f }

end empty

end language
end first_order

namespace equiv
open first_order first_order.language first_order.language.Structure
open_locale first_order

variables {L : language} {M : Type*} {N : Type*} [L.Structure M]

/-- A structure induced by a bijection. -/
@[simps] def induced_Structure (e : M ≃ N) : L.Structure N :=
⟨λ n f x, e (fun_map f (e.symm ∘ x)), λ n r x, rel_map r (e.symm ∘ x)⟩

/-- A bijection as a first-order isomorphism with the induced structure on the codomain. -/
@[simps] def induced_Structure_equiv (e : M ≃ N) :
  @language.equiv L M N _ (induced_Structure e) :=
{ map_fun' := λ n f x, by simp [← function.comp.assoc e.symm e x],
  map_rel' := λ n r x, by simp [← function.comp.assoc e.symm e x],
  .. e }

end equiv


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import topology.algebra.infinite_sum
import topology.algebra.group_with_zero

/-!
# Topology on `ℝ≥0`

The natural topology on `ℝ≥0` (the one induced from `ℝ`), and a basic API.

## Main definitions

Instances for the following typeclasses are defined:

* `topological_space ℝ≥0`
* `topological_semiring ℝ≥0`
* `second_countable_topology ℝ≥0`
* `order_topology ℝ≥0`
* `has_continuous_sub ℝ≥0`
* `has_continuous_inv' ℝ≥0` (continuity of `x⁻¹` away from `0`)

Everything is inherited from the corresponding structures on the reals.

## Main statements

Various mathematically trivial lemmas are proved about the compatibility
of limits and sums in `ℝ≥0` and `ℝ`. For example

* `tendsto_coe {f : filter α} {m : α → ℝ≥0} {x : ℝ≥0} :
  tendsto (λa, (m a : ℝ)) f (𝓝 (x : ℝ)) ↔ tendsto m f (𝓝 x)`

says that the limit of a filter along a map to `ℝ≥0` is the same in `ℝ` and `ℝ≥0`, and

* `coe_tsum {f : α → ℝ≥0} : ((∑'a, f a) : ℝ) = (∑'a, (f a : ℝ))`

says that says that a sum of elements in `ℝ≥0` is the same in `ℝ` and `ℝ≥0`.

Similarly, some mathematically trivial lemmas about infinite sums are proved,
a few of which rely on the fact that subtraction is continuous.

-/
noncomputable theory
open set topological_space metric filter
open_locale topological_space

namespace nnreal
open_locale nnreal big_operators

instance : topological_space ℝ≥0 := infer_instance -- short-circuit type class inference

instance : topological_semiring ℝ≥0 :=
{ continuous_mul := continuous_subtype_mk _ $
    (continuous_subtype_val.comp continuous_fst).mul (continuous_subtype_val.comp continuous_snd),
  continuous_add := continuous_subtype_mk _ $
    (continuous_subtype_val.comp continuous_fst).add (continuous_subtype_val.comp continuous_snd) }

instance : second_countable_topology ℝ≥0 :=
topological_space.subtype.second_countable_topology _ _

instance : order_topology ℝ≥0 := @order_topology_of_ord_connected _ _ _ _ (Ici 0) _

section coe
variable {α : Type*}
open filter finset

lemma continuous_of_real : continuous nnreal.of_real :=
continuous_subtype_mk _ $ continuous_id.max continuous_const

lemma continuous_coe : continuous (coe : ℝ≥0 → ℝ) :=
continuous_subtype_val

@[simp, norm_cast] lemma tendsto_coe {f : filter α} {m : α → ℝ≥0} {x : ℝ≥0} :
  tendsto (λa, (m a : ℝ)) f (𝓝 (x : ℝ)) ↔ tendsto m f (𝓝 x) :=
tendsto_subtype_rng.symm

lemma tendsto_coe' {f : filter α} [ne_bot f] {m : α → ℝ≥0} {x : ℝ} :
  tendsto (λ a, m a : α → ℝ) f (𝓝 x) ↔ ∃ hx : 0 ≤ x, tendsto m f (𝓝 ⟨x, hx⟩) :=
⟨λ h, ⟨ge_of_tendsto' h (λ c, (m c).2), tendsto_coe.1 h⟩, λ ⟨hx, hm⟩, tendsto_coe.2 hm⟩

@[simp] lemma map_coe_at_top : map (coe : ℝ≥0 → ℝ) at_top = at_top :=
map_coe_Ici_at_top 0

lemma comap_coe_at_top : comap (coe : ℝ≥0 → ℝ) at_top = at_top :=
(at_top_Ici_eq 0).symm

@[simp, norm_cast] lemma tendsto_coe_at_top {f : filter α} {m : α → ℝ≥0} :
  tendsto (λ a, (m a : ℝ)) f at_top ↔ tendsto m f at_top :=
tendsto_Ici_at_top.symm

lemma tendsto_of_real {f : filter α} {m : α → ℝ} {x : ℝ} (h : tendsto m f (𝓝 x)) :
  tendsto (λa, nnreal.of_real (m a)) f (𝓝 (nnreal.of_real x)) :=
(continuous_of_real.tendsto _).comp h

instance : has_continuous_sub ℝ≥0 :=
⟨continuous_subtype_mk _ $
  ((continuous_coe.comp continuous_fst).sub
   (continuous_coe.comp continuous_snd)).max continuous_const⟩

instance : has_continuous_inv' ℝ≥0 :=
⟨λ x hx, tendsto_coe.1 $ (real.tendsto_inv $ nnreal.coe_ne_zero.2 hx).comp
  continuous_coe.continuous_at⟩

@[norm_cast] lemma has_sum_coe {f : α → ℝ≥0} {r : ℝ≥0} :
  has_sum (λa, (f a : ℝ)) (r : ℝ) ↔ has_sum f r :=
by simp only [has_sum, coe_sum.symm, tendsto_coe]

lemma has_sum_of_real_of_nonneg {f : α → ℝ} (hf_nonneg : ∀ n, 0 ≤ f n) (hf : summable f) :
  has_sum (λ n, nnreal.of_real (f n)) (nnreal.of_real (∑' n, f n)) :=
begin
  have h_sum : (λ s, ∑ b in s, nnreal.of_real (f b)) = λ s, nnreal.of_real (∑ b in s, f b),
    from funext (λ _, (of_real_sum_of_nonneg (λ n _, hf_nonneg n)).symm),
  simp_rw [has_sum, h_sum],
  exact tendsto_of_real hf.has_sum,
end

@[norm_cast] lemma summable_coe {f : α → ℝ≥0} : summable (λa, (f a : ℝ)) ↔ summable f :=
begin
  split,
  exact assume ⟨a, ha⟩, ⟨⟨a, has_sum_le (λa, (f a).2) has_sum_zero ha⟩, has_sum_coe.1 ha⟩,
  exact assume ⟨a, ha⟩, ⟨a.1, has_sum_coe.2 ha⟩
end

open_locale classical

@[norm_cast] lemma coe_tsum {f : α → ℝ≥0} : ↑∑'a, f a = ∑'a, (f a : ℝ) :=
if hf : summable f
then (eq.symm $ (has_sum_coe.2 $ hf.has_sum).tsum_eq)
else by simp [tsum, hf, mt summable_coe.1 hf]

lemma tsum_mul_left (a : ℝ≥0) (f : α → ℝ≥0) : ∑' x, a * f x = a * ∑' x, f x :=
nnreal.eq $ by simp only [coe_tsum, nnreal.coe_mul, tsum_mul_left]

lemma tsum_mul_right (f : α → ℝ≥0) (a : ℝ≥0) : (∑' x, f x * a) = (∑' x, f x) * a :=
nnreal.eq $ by simp only [coe_tsum, nnreal.coe_mul, tsum_mul_right]

lemma summable_comp_injective {β : Type*} {f : α → ℝ≥0} (hf : summable f)
  {i : β → α} (hi : function.injective i) :
  summable (f ∘ i) :=
nnreal.summable_coe.1 $
show summable ((coe ∘ f) ∘ i), from (nnreal.summable_coe.2 hf).comp_injective hi

lemma summable_nat_add (f : ℕ → ℝ≥0) (hf : summable f) (k : ℕ) : summable (λ i, f (i + k)) :=
summable_comp_injective hf $ add_left_injective k

lemma summable_nat_add_iff {f : ℕ → ℝ≥0} (k : ℕ) : summable (λ i, f (i + k)) ↔ summable f :=
begin
  rw [← summable_coe, ← summable_coe],
  exact @summable_nat_add_iff ℝ _ _ _ (λ i, (f i : ℝ)) k,
end

lemma has_sum_nat_add_iff {f : ℕ → ℝ≥0} (k : ℕ) {a : ℝ≥0} :
  has_sum (λ n, f (n + k)) a ↔ has_sum f (a + ∑ i in range k, f i) :=
by simp [← has_sum_coe, coe_sum, nnreal.coe_add, ← has_sum_nat_add_iff k]

lemma sum_add_tsum_nat_add {f : ℕ → ℝ≥0} (k : ℕ) (hf : summable f) :
  ∑' i, f i = (∑ i in range k, f i) + ∑' i, f (i + k) :=
by rw [←nnreal.coe_eq, coe_tsum, nnreal.coe_add, coe_sum, coe_tsum,
  sum_add_tsum_nat_add k (nnreal.summable_coe.2 hf)]

lemma infi_real_pos_eq_infi_nnreal_pos [complete_lattice α] {f : ℝ → α} :
  (⨅ (n : ℝ) (h : 0 < n), f n) = (⨅ (n : ℝ≥0) (h : 0 < n), f n) :=
le_antisymm
  (infi_le_infi2 $ assume r, ⟨r, infi_le_infi $ assume hr, le_rfl⟩)
  (le_infi $ assume r, le_infi $ assume hr, infi_le_of_le ⟨r, hr.le⟩ $ infi_le _ hr)

end coe

lemma tendsto_cofinite_zero_of_summable {α} {f : α → ℝ≥0} (hf : summable f) :
  tendsto f cofinite (𝓝 0) :=
begin
  have h_f_coe : f = λ n, nnreal.of_real (f n : ℝ), from funext (λ n, of_real_coe.symm),
  rw [h_f_coe, ←@of_real_coe 0],
  exact tendsto_of_real ((summable_coe.mpr hf).tendsto_cofinite_zero),
end

lemma tendsto_at_top_zero_of_summable {f : ℕ → ℝ≥0} (hf : summable f) :
  tendsto f at_top (𝓝 0) :=
by { rw ←nat.cofinite_eq_at_top, exact tendsto_cofinite_zero_of_summable hf }

end nnreal


import tactic.basic

-- 2.2 Strong induction

-- Use nat.strong_induction_on
private theorem nat.strong_induction
  {p: ℕ → Prop}
  (h₀: p 0)
  (h: ∀ n, (∀ k < n, p k) → p n)
  : ∀ n, p n :=
begin
  let q := λ n, ∀ k ≤ n, p k,
  have : ∀ n, q n,
  { intro n,
    refine nat.rec_on n _ _; clear n,
    { change ∀ k ≤ 0, p k,
      intros k hk,
      convert h₀,
      cases (lt_or_eq_of_le hk) with h₁ h₂,
      { exfalso,
        have := lt_of_le_of_lt (nat.zero_le k) h₁,
        exact ne_of_lt this rfl },
      { assumption } },
    { intros n hqn k k_le_succ_n,
      cases nat.eq_or_lt_of_le k_le_succ_n with h₁ h₁,
      { rw h₁,
        refine h _ _,
        intros j j_lt_succ_n,
        exact hqn j (nat.le_of_lt_succ j_lt_succ_n) },
      { exact hqn _ (nat.le_of_lt_succ h₁) } } },
  intro n,
  refine this n n (le_refl n),
end

-- 2.4 The rationals (see constructions.rat)