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

! This file was ported from Lean 3 source module ring_theory.subsemiring.basic
! leanprover-community/mathlib commit feb99064803fd3108e37c18b0f77d0a8344677a3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Module.Basic
import Mathlib.Algebra.Ring.Equiv
import Mathlib.Algebra.Ring.Prod
import Mathlib.Algebra.Order.Ring.InjSurj
import Mathlib.Algebra.GroupRingAction.Subobjects
import Mathlib.Data.Set.Finite
import Mathlib.GroupTheory.Submonoid.Centralizer
import Mathlib.GroupTheory.Submonoid.Membership

/-!
# Bundled subsemirings

We define bundled subsemirings and some standard constructions: `CompleteLattice` structure,
`Subtype` and `inclusion` ring homomorphisms, subsemiring `map`, `comap` and range (`rangeS`) of
a `RingHom` etc.
-/

open BigOperators

universe u v w

section AddSubmonoidWithOneClass

/-- `AddSubmonoidWithOneClass S R` says `S` is a type of subsets `s ≤ R` that contain `0`, `1`,
and are closed under `(+)` -/
class AddSubmonoidWithOneClass (S R : Type _) [AddMonoidWithOne R]
  [SetLike S R] extends AddSubmonoidClass S R, OneMemClass S R : Prop
#align add_submonoid_with_one_class AddSubmonoidWithOneClass

variable {S R : Type _} [AddMonoidWithOne R] [SetLike S R] (s : S)

theorem natCast_mem [AddSubmonoidWithOneClass S R] (n : ℕ) : (n : R) ∈ s := by
  induction n <;> simp [zero_mem, add_mem, one_mem, *]
#align nat_cast_mem natCast_mem

instance (priority := 74) AddSubmonoidWithOneClass.toAddMonoidWithOne
    [AddSubmonoidWithOneClass S R] : AddMonoidWithOne s :=
  { AddSubmonoidClass.toAddMonoid s with
    one := ⟨_, one_mem s⟩
    natCast := fun n => ⟨n, natCast_mem s n⟩
    natCast_zero := Subtype.ext Nat.cast_zero
    natCast_succ := fun _ => Subtype.ext (Nat.cast_succ _) }
#align add_submonoid_with_one_class.to_add_monoid_with_one AddSubmonoidWithOneClass.toAddMonoidWithOne

end AddSubmonoidWithOneClass

variable {R : Type u} {S : Type v} {T : Type w} [NonAssocSemiring R] (M : Submonoid R)

section SubsemiringClass

/-- `SubsemiringClass S R` states that `S` is a type of subsets `s ⊆ R` that
are both a multiplicative and an additive submonoid. -/
class SubsemiringClass (S : Type _) (R : Type u) [NonAssocSemiring R]
  [SetLike S R] extends SubmonoidClass S R, AddSubmonoidClass S R : Prop
#align subsemiring_class SubsemiringClass

-- See note [lower instance priority]
instance (priority := 100) SubsemiringClass.addSubmonoidWithOneClass (S : Type _)
    (R : Type u) [NonAssocSemiring R] [SetLike S R] [h : SubsemiringClass S R] :
    AddSubmonoidWithOneClass S R :=
  { h with }
#align subsemiring_class.add_submonoid_with_one_class SubsemiringClass.addSubmonoidWithOneClass

variable [SetLike S R] [hSR : SubsemiringClass S R] (s : S)

theorem coe_nat_mem (n : ℕ) : (n : R) ∈ s := by
  rw [← nsmul_one]
  exact nsmul_mem (one_mem _) _
#align coe_nat_mem coe_nat_mem

namespace SubsemiringClass

-- Prefer subclasses of `NonAssocSemiring` over subclasses of `SubsemiringClass`.
/-- A subsemiring of a `NonAssocSemiring` inherits a `NonAssocSemiring` structure -/
instance (priority := 75) toNonAssocSemiring : NonAssocSemiring s :=
  Subtype.coe_injective.nonAssocSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ => rfl
#align subsemiring_class.to_non_assoc_semiring SubsemiringClass.toNonAssocSemiring

instance nontrivial [Nontrivial R] : Nontrivial s :=
  nontrivial_of_ne 0 1 fun H => zero_ne_one (congr_arg Subtype.val H)
#align subsemiring_class.nontrivial SubsemiringClass.nontrivial

instance noZeroDivisors [NoZeroDivisors R] : NoZeroDivisors s :=
  Subtype.coe_injective.noZeroDivisors _ rfl fun _ _ => rfl
#align subsemiring_class.no_zero_divisors SubsemiringClass.noZeroDivisors

/-- The natural ring hom from a subsemiring of semiring `R` to `R`. -/
def subtype : s →+* R :=
  { SubmonoidClass.Subtype s, AddSubmonoidClass.Subtype s with toFun := (↑) }
#align subsemiring_class.subtype SubsemiringClass.subtype

@[simp]
theorem coe_subtype : (subtype s : s → R) = ((↑) : s → R) :=
  rfl
#align subsemiring_class.coe_subtype SubsemiringClass.coe_subtype

-- Prefer subclasses of `Semiring` over subclasses of `SubsemiringClass`.
/-- A subsemiring of a `Semiring` is a `Semiring`. -/
instance (priority := 75) toSemiring {R} [Semiring R] [SetLike S R] [SubsemiringClass S R] :
    Semiring s :=
  Subtype.coe_injective.semiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ => rfl
#align subsemiring_class.to_semiring SubsemiringClass.toSemiring

@[simp, norm_cast]
theorem coe_pow {R} [Semiring R] [SetLike S R] [SubsemiringClass S R] (x : s) (n : ℕ) :
    ((x ^ n : s) : R) = (x : R) ^ n := by
  induction' n with n ih
  · simp
  · simp [pow_succ, ih]
#align subsemiring_class.coe_pow SubsemiringClass.coe_pow

/-- A subsemiring of a `CommSemiring` is a `CommSemiring`. -/
instance toCommSemiring {R} [CommSemiring R] [SetLike S R] [SubsemiringClass S R] :
    CommSemiring s :=
  Subtype.coe_injective.commSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ => rfl
#align subsemiring_class.to_comm_semiring SubsemiringClass.toCommSemiring

/-- A subsemiring of an `OrderedSemiring` is an `OrderedSemiring`. -/
instance toOrderedSemiring {R} [OrderedSemiring R] [SetLike S R] [SubsemiringClass S R] :
    OrderedSemiring s :=
  Subtype.coe_injective.orderedSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl
#align subsemiring_class.to_ordered_semiring SubsemiringClass.toOrderedSemiring

/-- A subsemiring of an `StrictOrderedSemiring` is an `StrictOrderedSemiring`. -/
instance toStrictOrderedSemiring {R} [StrictOrderedSemiring R] [SetLike S R]
    [SubsemiringClass S R] : StrictOrderedSemiring s :=
  Subtype.coe_injective.strictOrderedSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl
#align subsemiring_class.to_strict_ordered_semiring SubsemiringClass.toStrictOrderedSemiring

/-- A subsemiring of an `OrderedCommSemiring` is an `OrderedCommSemiring`. -/
instance toOrderedCommSemiring {R} [OrderedCommSemiring R] [SetLike S R] [SubsemiringClass S R] :
    OrderedCommSemiring s :=
  Subtype.coe_injective.orderedCommSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl
#align subsemiring_class.to_ordered_comm_semiring SubsemiringClass.toOrderedCommSemiring

/-- A subsemiring of an `StrictOrderedCommSemiring` is an `StrictOrderedCommSemiring`. -/
instance toStrictOrderedCommSemiring {R} [StrictOrderedCommSemiring R] [SetLike S R]
    [SubsemiringClass S R] : StrictOrderedCommSemiring s :=
  Subtype.coe_injective.strictOrderedCommSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl
#align subsemiring_class.to_strict_ordered_comm_semiring SubsemiringClass.toStrictOrderedCommSemiring

/-- A subsemiring of a `LinearOrderedSemiring` is a `LinearOrderedSemiring`. -/
instance toLinearOrderedSemiring {R} [LinearOrderedSemiring R] [SetLike S R]
    [SubsemiringClass S R] : LinearOrderedSemiring s :=
  Subtype.coe_injective.linearOrderedSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) fun _ _ => rfl
#align subsemiring_class.to_linear_ordered_semiring SubsemiringClass.toLinearOrderedSemiring

/-- A subsemiring of a `LinearOrderedCommSemiring` is a `LinearOrderedCommSemiring`. -/
instance toLinearOrderedCommSemiring {R} [LinearOrderedCommSemiring R] [SetLike S R]
    [SubsemiringClass S R] : LinearOrderedCommSemiring s :=
  Subtype.coe_injective.linearOrderedCommSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) fun _ _ => rfl
#align subsemiring_class.to_linear_ordered_comm_semiring SubsemiringClass.toLinearOrderedCommSemiring

end SubsemiringClass

end SubsemiringClass

variable [NonAssocSemiring S] [NonAssocSemiring T]

/-- A subsemiring of a semiring `R` is a subset `s` that is both a multiplicative and an additive
submonoid. -/
structure Subsemiring (R : Type u) [NonAssocSemiring R] extends Submonoid R, AddSubmonoid R
#align subsemiring Subsemiring

/-- Reinterpret a `Subsemiring` as a `Submonoid`. -/
add_decl_doc Subsemiring.toSubmonoid

/-- Reinterpret a `Subsemiring` as an `AddSubmonoid`. -/
add_decl_doc Subsemiring.toAddSubmonoid

namespace Subsemiring

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

instance : SubsemiringClass (Subsemiring R) R
    where
  zero_mem := zero_mem'
  add_mem {s} := AddSubsemigroup.add_mem' s.toAddSubmonoid.toAddSubsemigroup
  one_mem {s} := Submonoid.one_mem' s.toSubmonoid
  mul_mem {s} := Subsemigroup.mul_mem' s.toSubmonoid.toSubsemigroup

@[simp]
theorem mem_toSubmonoid {s : Subsemiring R} {x : R} : x ∈ s.toSubmonoid ↔ x ∈ s :=
  Iff.rfl
#align subsemiring.mem_to_submonoid Subsemiring.mem_toSubmonoid

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

/-- Two subsemirings are equal if they have the same elements. -/
@[ext]
theorem ext {S T : Subsemiring R} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T :=
  SetLike.ext h
#align subsemiring.ext Subsemiring.ext

/-- Copy of a subsemiring with a new `carrier` equal to the old one. Useful to fix definitional
equalities.-/
protected def copy (S : Subsemiring R) (s : Set R) (hs : s = ↑S) : Subsemiring R :=
  { S.toAddSubmonoid.copy s hs, S.toSubmonoid.copy s hs with carrier := s }
#align subsemiring.copy Subsemiring.copy

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

theorem copy_eq (S : Subsemiring R) (s : Set R) (hs : s = ↑S) : S.copy s hs = S :=
  SetLike.coe_injective hs
#align subsemiring.copy_eq Subsemiring.copy_eq

theorem toSubmonoid_injective : Function.Injective (toSubmonoid : Subsemiring R → Submonoid R)
  | _, _, h => ext (SetLike.ext_iff.mp h : _)
#align subsemiring.to_submonoid_injective Subsemiring.toSubmonoid_injective

@[mono]
theorem toSubmonoid_strictMono : StrictMono (toSubmonoid : Subsemiring R → Submonoid R) :=
  fun _ _ => id
#align subsemiring.to_submonoid_strict_mono Subsemiring.toSubmonoid_strictMono

@[mono]
theorem toSubmonoid_mono : Monotone (toSubmonoid : Subsemiring R → Submonoid R) :=
  toSubmonoid_strictMono.monotone
#align subsemiring.to_submonoid_mono Subsemiring.toSubmonoid_mono

theorem toAddSubmonoid_injective :
    Function.Injective (toAddSubmonoid : Subsemiring R → AddSubmonoid R)
  | _, _, h => ext (SetLike.ext_iff.mp h : _)
#align subsemiring.to_add_submonoid_injective Subsemiring.toAddSubmonoid_injective

@[mono]
theorem toAddSubmonoid_strictMono : StrictMono (toAddSubmonoid : Subsemiring R → AddSubmonoid R) :=
  fun _ _ => id
#align subsemiring.to_add_submonoid_strict_mono Subsemiring.toAddSubmonoid_strictMono

@[mono]
theorem toAddSubmonoid_mono : Monotone (toAddSubmonoid : Subsemiring R → AddSubmonoid R) :=
  toAddSubmonoid_strictMono.monotone
#align subsemiring.to_add_submonoid_mono Subsemiring.toAddSubmonoid_mono

/-- Construct a `Subsemiring R` from a set `s`, a submonoid `sm`, and an additive
submonoid `sa` such that `x ∈ s ↔ x ∈ sm ↔ x ∈ sa`. -/
protected def mk' (s : Set R) (sm : Submonoid R) (hm : ↑sm = s) (sa : AddSubmonoid R)
    (ha : ↑sa = s) : Subsemiring R where
  carrier := s
  zero_mem' := by exact ha ▸ sa.zero_mem
  one_mem' := by exact hm ▸ sm.one_mem
  add_mem' {x y} := by simpa only [← ha] using sa.add_mem
  mul_mem' {x y} := by simpa only [← hm] using sm.mul_mem
#align subsemiring.mk' Subsemiring.mk'

@[simp]
theorem coe_mk' {s : Set R} {sm : Submonoid R} (hm : ↑sm = s) {sa : AddSubmonoid R} (ha : ↑sa = s) :
    (Subsemiring.mk' s sm hm sa ha : Set R) = s :=
  rfl
#align subsemiring.coe_mk' Subsemiring.coe_mk'

@[simp]
theorem mem_mk' {s : Set R} {sm : Submonoid R} (hm : ↑sm = s) {sa : AddSubmonoid R} (ha : ↑sa = s)
    {x : R} : x ∈ Subsemiring.mk' s sm hm sa ha ↔ x ∈ s :=
  Iff.rfl
#align subsemiring.mem_mk' Subsemiring.mem_mk'

@[simp]
theorem mk'_toSubmonoid {s : Set R} {sm : Submonoid R} (hm : ↑sm = s) {sa : AddSubmonoid R}
    (ha : ↑sa = s) : (Subsemiring.mk' s sm hm sa ha).toSubmonoid = sm :=
  SetLike.coe_injective hm.symm
#align subsemiring.mk'_to_submonoid Subsemiring.mk'_toSubmonoid

@[simp]
theorem mk'_toAddSubmonoid {s : Set R} {sm : Submonoid R} (hm : ↑sm = s) {sa : AddSubmonoid R}
    (ha : ↑sa = s) : (Subsemiring.mk' s sm hm sa ha).toAddSubmonoid = sa :=
  SetLike.coe_injective ha.symm
#align subsemiring.mk'_to_add_submonoid Subsemiring.mk'_toAddSubmonoid

end Subsemiring

namespace Subsemiring

variable (s : Subsemiring R)

/-- A subsemiring contains the semiring's 1. -/
protected theorem one_mem : (1 : R) ∈ s :=
  one_mem s
#align subsemiring.one_mem Subsemiring.one_mem

/-- A subsemiring contains the semiring's 0. -/
protected theorem zero_mem : (0 : R) ∈ s :=
  zero_mem s
#align subsemiring.zero_mem Subsemiring.zero_mem

/-- A subsemiring is closed under multiplication. -/
protected theorem mul_mem {x y : R} : x ∈ s → y ∈ s → x * y ∈ s :=
  mul_mem
#align subsemiring.mul_mem Subsemiring.mul_mem

/-- A subsemiring is closed under addition. -/
protected theorem add_mem {x y : R} : x ∈ s → y ∈ s → x + y ∈ s :=
  add_mem
#align subsemiring.add_mem Subsemiring.add_mem

/-- Product of a list of elements in a `Subsemiring` is in the `Subsemiring`. -/
nonrec theorem list_prod_mem {R : Type _} [Semiring R] (s : Subsemiring R) {l : List R} :
    (∀ x ∈ l, x ∈ s) → l.prod ∈ s :=
  list_prod_mem
#align subsemiring.list_prod_mem Subsemiring.list_prod_mem

/-- Sum of a list of elements in a `Subsemiring` is in the `Subsemiring`. -/
protected theorem list_sum_mem {l : List R} : (∀ x ∈ l, x ∈ s) → l.sum ∈ s :=
  list_sum_mem
#align subsemiring.list_sum_mem Subsemiring.list_sum_mem

/-- Product of a multiset of elements in a `Subsemiring` of a `CommSemiring`
    is in the `Subsemiring`. -/
protected theorem multiset_prod_mem {R} [CommSemiring R] (s : Subsemiring R) (m : Multiset R) :
    (∀ a ∈ m, a ∈ s) → m.prod ∈ s :=
  multiset_prod_mem m
#align subsemiring.multiset_prod_mem Subsemiring.multiset_prod_mem

/-- Sum of a multiset of elements in a `Subsemiring` of a `Semiring` is
in the `add_subsemiring`. -/
protected theorem multiset_sum_mem (m : Multiset R) : (∀ a ∈ m, a ∈ s) → m.sum ∈ s :=
  multiset_sum_mem m
#align subsemiring.multiset_sum_mem Subsemiring.multiset_sum_mem

/-- Product of elements of a subsemiring of a `CommSemiring` indexed by a `Finset` is in the
    subsemiring. -/
protected theorem prod_mem {R : Type _} [CommSemiring R] (s : Subsemiring R) {ι : Type _}
    {t : Finset ι} {f : ι → R} (h : ∀ c ∈ t, f c ∈ s) : (∏ i in t, f i) ∈ s :=
  prod_mem h
#align subsemiring.prod_mem Subsemiring.prod_mem

/-- Sum of elements in an `Subsemiring` of an `Semiring` indexed by a `Finset`
is in the `add_subsemiring`. -/
protected theorem sum_mem (s : Subsemiring R) {ι : Type _} {t : Finset ι} {f : ι → R}
    (h : ∀ c ∈ t, f c ∈ s) : (∑ i in t, f i) ∈ s :=
  sum_mem h
#align subsemiring.sum_mem Subsemiring.sum_mem

/-- A subsemiring of a `NonAssocSemiring` inherits a `NonAssocSemiring` structure -/
instance toNonAssocSemiring : NonAssocSemiring s :=
  -- Porting note: this used to be a specialized instance which needed to be expensively unified.
  SubsemiringClass.toNonAssocSemiring _
#align subsemiring.to_non_assoc_semiring Subsemiring.toNonAssocSemiring

@[simp, norm_cast]
theorem coe_one : ((1 : s) : R) = (1 : R) :=
  rfl
#align subsemiring.coe_one Subsemiring.coe_one

@[simp, norm_cast]
theorem coe_zero : ((0 : s) : R) = (0 : R) :=
  rfl
#align subsemiring.coe_zero Subsemiring.coe_zero

@[simp, norm_cast]
theorem coe_add (x y : s) : ((x + y : s) : R) = (x + y : R) :=
  rfl
#align subsemiring.coe_add Subsemiring.coe_add

@[simp, norm_cast]
theorem coe_mul (x y : s) : ((x * y : s) : R) = (x * y : R) :=
  rfl
#align subsemiring.coe_mul Subsemiring.coe_mul

instance nontrivial [Nontrivial R] : Nontrivial s :=
  nontrivial_of_ne 0 1 fun H => zero_ne_one (congr_arg Subtype.val H)
#align subsemiring.nontrivial Subsemiring.nontrivial

protected theorem pow_mem {R : Type _} [Semiring R] (s : Subsemiring R) {x : R} (hx : x ∈ s)
    (n : ℕ) : x ^ n ∈ s :=
  pow_mem hx n
#align subsemiring.pow_mem Subsemiring.pow_mem

instance noZeroDivisors [NoZeroDivisors R] : NoZeroDivisors s where
  eq_zero_or_eq_zero_of_mul_eq_zero {_ _} h :=
    (eq_zero_or_eq_zero_of_mul_eq_zero <| Subtype.ext_iff.mp h).imp Subtype.eq Subtype.eq
#align subsemiring.no_zero_divisors Subsemiring.noZeroDivisors

/-- A subsemiring of a `Semiring` is a `Semiring`. -/
instance toSemiring {R} [Semiring R] (s : Subsemiring R) : Semiring s :=
  { s.toNonAssocSemiring, s.toSubmonoid.toMonoid with }
#align subsemiring.to_semiring Subsemiring.toSemiring

@[simp, norm_cast]
theorem coe_pow {R} [Semiring R] (s : Subsemiring R) (x : s) (n : ℕ) :
    ((x ^ n : s) : R) = (x : R) ^ n := by
  induction' n with n ih
  · simp
  · simp [pow_succ, ih]
#align subsemiring.coe_pow Subsemiring.coe_pow

/-- A subsemiring of a `CommSemiring` is a `CommSemiring`. -/
instance toCommSemiring {R} [CommSemiring R] (s : Subsemiring R) : CommSemiring s :=
  { s.toSemiring with mul_comm := fun _ _ => Subtype.eq <| mul_comm _ _ }
#align subsemiring.to_comm_semiring Subsemiring.toCommSemiring

/-- The natural ring hom from a subsemiring of semiring `R` to `R`. -/
def subtype : s →+* R :=
  { s.toSubmonoid.subtype, s.toAddSubmonoid.subtype with toFun := (↑) }
#align subsemiring.subtype Subsemiring.subtype

@[simp]
theorem coe_subtype : ⇑s.subtype = ((↑) : s → R) :=
  rfl
#align subsemiring.coe_subtype Subsemiring.coe_subtype

/-- A subsemiring of an `OrderedSemiring` is an `OrderedSemiring`. -/
instance toOrderedSemiring {R} [OrderedSemiring R] (s : Subsemiring R) : OrderedSemiring s :=
  Subtype.coe_injective.orderedSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl
#align subsemiring.to_ordered_semiring Subsemiring.toOrderedSemiring

/-- A subsemiring of a `StrictOrderedSemiring` is a `StrictOrderedSemiring`. -/
instance toStrictOrderedSemiring {R} [StrictOrderedSemiring R] (s : Subsemiring R) :
    StrictOrderedSemiring s :=
  Subtype.coe_injective.strictOrderedSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl
#align subsemiring.to_strict_ordered_semiring Subsemiring.toStrictOrderedSemiring

/-- A subsemiring of an `OrderedCommSemiring` is an `OrderedCommSemiring`. -/
instance toOrderedCommSemiring {R} [OrderedCommSemiring R] (s : Subsemiring R) :
    OrderedCommSemiring s :=
  Subtype.coe_injective.orderedCommSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl
#align subsemiring.to_ordered_comm_semiring Subsemiring.toOrderedCommSemiring

/-- A subsemiring of a `StrictOrderedCommSemiring` is a `StrictOrderedCommSemiring`. -/
instance toStrictOrderedCommSemiring {R} [StrictOrderedCommSemiring R] (s : Subsemiring R) :
    StrictOrderedCommSemiring s :=
  Subtype.coe_injective.strictOrderedCommSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl
#align subsemiring.to_strict_ordered_comm_semiring Subsemiring.toStrictOrderedCommSemiring

/-- A subsemiring of a `LinearOrderedSemiring` is a `LinearOrderedSemiring`. -/
instance toLinearOrderedSemiring {R} [LinearOrderedSemiring R] (s : Subsemiring R) :
    LinearOrderedSemiring s :=
  Subtype.coe_injective.linearOrderedSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) fun _ _ => rfl
#align subsemiring.to_linear_ordered_semiring Subsemiring.toLinearOrderedSemiring

/-- A subsemiring of a `LinearOrderedCommSemiring` is a `LinearOrderedCommSemiring`. -/
instance toLinearOrderedCommSemiring {R} [LinearOrderedCommSemiring R] (s : Subsemiring R) :
    LinearOrderedCommSemiring s :=
  Subtype.coe_injective.linearOrderedCommSemiring (↑) rfl rfl (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) fun _ _ => rfl
#align subsemiring.to_linear_ordered_comm_semiring Subsemiring.toLinearOrderedCommSemiring

protected theorem nsmul_mem {x : R} (hx : x ∈ s) (n : ℕ) : n • x ∈ s :=
  nsmul_mem hx n
#align subsemiring.nsmul_mem Subsemiring.nsmul_mem

@[simp]
theorem coe_toSubmonoid (s : Subsemiring R) : (s.toSubmonoid : Set R) = s :=
  rfl
#align subsemiring.coe_to_submonoid Subsemiring.coe_toSubmonoid

-- Porting note: adding this as `simp`-normal form for `coe_toAddSubmonoid`
@[simp]
theorem coe_carrier_toSubmonoid (s : Subsemiring R) : (s.toSubmonoid.carrier : Set R) = s :=
  rfl

-- Porting note: can be proven using `SetLike` so removing `@[simp]`
theorem mem_toAddSubmonoid {s : Subsemiring R} {x : R} : x ∈ s.toAddSubmonoid ↔ x ∈ s :=
  Iff.rfl
#align subsemiring.mem_to_add_submonoid Subsemiring.mem_toAddSubmonoid

-- Porting note: new normal form is `coe_carrier_toSubmonoid` so removing `@[simp]`
theorem coe_toAddSubmonoid (s : Subsemiring R) : (s.toAddSubmonoid : Set R) = s :=
  rfl
#align subsemiring.coe_to_add_submonoid Subsemiring.coe_toAddSubmonoid

/-- The subsemiring `R` of the semiring `R`. -/
instance : Top (Subsemiring R) :=
  ⟨{ (⊤ : Submonoid R), (⊤ : AddSubmonoid R) with }⟩

@[simp]
theorem mem_top (x : R) : x ∈ (⊤ : Subsemiring R) :=
  Set.mem_univ x
#align subsemiring.mem_top Subsemiring.mem_top

@[simp]
theorem coe_top : ((⊤ : Subsemiring R) : Set R) = Set.univ :=
  rfl
#align subsemiring.coe_top Subsemiring.coe_top

/-- The ring equiv between the top element of `Subsemiring R` and `R`. -/
@[simps]
def topEquiv : (⊤ : Subsemiring R) ≃+* R where
  toFun r := r
  invFun r := ⟨r, Subsemiring.mem_top r⟩
  left_inv _ := rfl
  right_inv _ := rfl
  map_mul' := (⊤ : Subsemiring R).coe_mul
  map_add' := (⊤ : Subsemiring R).coe_add
#align subsemiring.top_equiv Subsemiring.topEquiv

/-- The preimage of a subsemiring along a ring homomorphism is a subsemiring. -/
def comap (f : R →+* S) (s : Subsemiring S) : Subsemiring R :=
  { s.toSubmonoid.comap (f : R →* S), s.toAddSubmonoid.comap (f : R →+ S) with carrier := f ⁻¹' s }
#align subsemiring.comap Subsemiring.comap

@[simp]
theorem coe_comap (s : Subsemiring S) (f : R →+* S) : (s.comap f : Set R) = f ⁻¹' s :=
  rfl
#align subsemiring.coe_comap Subsemiring.coe_comap

@[simp]
theorem mem_comap {s : Subsemiring S} {f : R →+* S} {x : R} : x ∈ s.comap f ↔ f x ∈ s :=
  Iff.rfl
#align subsemiring.mem_comap Subsemiring.mem_comap

theorem comap_comap (s : Subsemiring T) (g : S →+* T) (f : R →+* S) :
    (s.comap g).comap f = s.comap (g.comp f) :=
  rfl
#align subsemiring.comap_comap Subsemiring.comap_comap

/-- The image of a subsemiring along a ring homomorphism is a subsemiring. -/
def map (f : R →+* S) (s : Subsemiring R) : Subsemiring S :=
  { s.toSubmonoid.map (f : R →* S), s.toAddSubmonoid.map (f : R →+ S) with carrier := f '' s }
#align subsemiring.map Subsemiring.map

@[simp]
theorem coe_map (f : R →+* S) (s : Subsemiring R) : (s.map f : Set S) = f '' s :=
  rfl
#align subsemiring.coe_map Subsemiring.coe_map

@[simp]
theorem mem_map {f : R →+* S} {s : Subsemiring R} {y : S} : y ∈ s.map f ↔ ∃ x ∈ s, f x = y :=
  by
    -- Porting note: was `exact Set.mem_image_iff_bex`
    convert Set.mem_image_iff_bex (f := f) (s := s.carrier) (y := y) using 1
    simp

#align subsemiring.mem_map Subsemiring.mem_map

@[simp]
theorem map_id : s.map (RingHom.id R) = s :=
  SetLike.coe_injective <| Set.image_id _
#align subsemiring.map_id Subsemiring.map_id

theorem map_map (g : S →+* T) (f : R →+* S) : (s.map f).map g = s.map (g.comp f) :=
  SetLike.coe_injective <| Set.image_image _ _ _
#align subsemiring.map_map Subsemiring.map_map

theorem map_le_iff_le_comap {f : R →+* S} {s : Subsemiring R} {t : Subsemiring S} :
    s.map f ≤ t ↔ s ≤ t.comap f :=
  Set.image_subset_iff
#align subsemiring.map_le_iff_le_comap Subsemiring.map_le_iff_le_comap

theorem gc_map_comap (f : R →+* S) : GaloisConnection (map f) (comap f) := fun _ _ =>
  map_le_iff_le_comap
#align subsemiring.gc_map_comap Subsemiring.gc_map_comap

/-- A subsemiring is isomorphic to its image under an injective function -/
noncomputable def equivMapOfInjective (f : R →+* S) (hf : Function.Injective f) : s ≃+* s.map f :=
  { Equiv.Set.image f s hf with
    map_mul' := fun _ _ => Subtype.ext (f.map_mul _ _)
    map_add' := fun _ _ => Subtype.ext (f.map_add _ _) }
#align subsemiring.equiv_map_of_injective Subsemiring.equivMapOfInjective

@[simp]
theorem coe_equivMapOfInjective_apply (f : R →+* S) (hf : Function.Injective f) (x : s) :
    (equivMapOfInjective s f hf x : S) = f x :=
  rfl
#align subsemiring.coe_equiv_map_of_injective_apply Subsemiring.coe_equivMapOfInjective_apply

end Subsemiring

namespace RingHom

variable (g : S →+* T) (f : R →+* S)

/-- The range of a ring homomorphism is a subsemiring. See Note [range copy pattern]. -/
def rangeS : Subsemiring S :=
  ((⊤ : Subsemiring R).map f).copy (Set.range f) Set.image_univ.symm
#align ring_hom.srange RingHom.rangeS

@[simp]
theorem coe_rangeS : (f.rangeS : Set S) = Set.range f :=
  rfl
#align ring_hom.coe_srange RingHom.coe_rangeS

@[simp]
theorem mem_rangeS {f : R →+* S} {y : S} : y ∈ f.rangeS ↔ ∃ x, f x = y :=
  Iff.rfl
#align ring_hom.mem_srange RingHom.mem_rangeS

theorem rangeS_eq_map (f : R →+* S) : f.rangeS = (⊤ : Subsemiring R).map f := by
  ext
  simp
#align ring_hom.srange_eq_map RingHom.rangeS_eq_map

theorem mem_rangeS_self (f : R →+* S) (x : R) : f x ∈ f.rangeS :=
  mem_rangeS.mpr ⟨x, rfl⟩
#align ring_hom.mem_srange_self RingHom.mem_rangeS_self

theorem map_rangeS : f.rangeS.map g = (g.comp f).rangeS := by
  simpa only [rangeS_eq_map] using (⊤ : Subsemiring R).map_map g f
#align ring_hom.map_srange RingHom.map_rangeS

/-- The range of a morphism of semirings is a fintype, if the domain is a fintype.
Note: this instance can form a diamond with `Subtype.fintype` in the
  presence of `Fintype S`.-/
instance fintypeRangeS [Fintype R] [DecidableEq S] (f : R →+* S) : Fintype (rangeS f) :=
  Set.fintypeRange f
#align ring_hom.fintype_srange RingHom.fintypeRangeS

end RingHom

namespace Subsemiring

instance : Bot (Subsemiring R) :=
  ⟨(Nat.castRingHom R).rangeS⟩

instance : Inhabited (Subsemiring R) :=
  ⟨⊥⟩

theorem coe_bot : ((⊥ : Subsemiring R) : Set R) = Set.range ((↑) : ℕ → R) :=
  (Nat.castRingHom R).coe_rangeS
#align subsemiring.coe_bot Subsemiring.coe_bot

theorem mem_bot {x : R} : x ∈ (⊥ : Subsemiring R) ↔ ∃ n : ℕ, ↑n = x :=
  RingHom.mem_rangeS
#align subsemiring.mem_bot Subsemiring.mem_bot

/-- The inf of two subsemirings is their intersection. -/
instance : Inf (Subsemiring R) :=
  ⟨fun s t =>
    { s.toSubmonoid ⊓ t.toSubmonoid, s.toAddSubmonoid ⊓ t.toAddSubmonoid with carrier := s ∩ t }⟩

@[simp]
theorem coe_inf (p p' : Subsemiring R) : ((p ⊓ p' : Subsemiring R) : Set R) = (p : Set R) ∩ p' :=
  rfl
#align subsemiring.coe_inf Subsemiring.coe_inf

@[simp]
theorem mem_inf {p p' : Subsemiring R} {x : R} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' :=
  Iff.rfl
#align subsemiring.mem_inf Subsemiring.mem_inf

instance : InfSet (Subsemiring R) :=
  ⟨fun s =>
    Subsemiring.mk' (⋂ t ∈ s, ↑t) (⨅ t ∈ s, Subsemiring.toSubmonoid t) (by simp)
      (⨅ t ∈ s, Subsemiring.toAddSubmonoid t)
      (by simp)⟩

@[simp, norm_cast]
theorem coe_infₛ (S : Set (Subsemiring R)) : ((infₛ S : Subsemiring R) : Set R) = ⋂ s ∈ S, ↑s :=
  rfl
#align subsemiring.coe_Inf Subsemiring.coe_infₛ

theorem mem_infₛ {S : Set (Subsemiring R)} {x : R} : x ∈ infₛ S ↔ ∀ p ∈ S, x ∈ p :=
  Set.mem_interᵢ₂
#align subsemiring.mem_Inf Subsemiring.mem_infₛ

@[simp]
theorem infₛ_toSubmonoid (s : Set (Subsemiring R)) :
    (infₛ s).toSubmonoid = ⨅ t ∈ s, Subsemiring.toSubmonoid t :=
  mk'_toSubmonoid _ _
#align subsemiring.Inf_to_submonoid Subsemiring.infₛ_toSubmonoid

@[simp]
theorem infₛ_toAddSubmonoid (s : Set (Subsemiring R)) :
    (infₛ s).toAddSubmonoid = ⨅ t ∈ s, Subsemiring.toAddSubmonoid t :=
  mk'_toAddSubmonoid _ _
#align subsemiring.Inf_to_add_submonoid Subsemiring.infₛ_toAddSubmonoid

/-- Subsemirings of a semiring form a complete lattice. -/
instance : CompleteLattice (Subsemiring R) :=
  { completeLatticeOfInf (Subsemiring R) fun _ =>
      IsGLB.of_image
        (fun {s t : Subsemiring R} => show (s : Set R) ⊆ t ↔ s ≤ t from SetLike.coe_subset_coe)
        isGLB_binfᵢ with
    bot := ⊥
    bot_le := fun s _ hx =>
      let ⟨n, hn⟩ := mem_bot.1 hx
      hn ▸ coe_nat_mem s n
    top := ⊤
    le_top := fun _ _ _ => trivial
    inf := (· ⊓ ·)
    inf_le_left := fun _ _ _ => And.left
    inf_le_right := fun _ _ _ => And.right
    le_inf := fun _ _ _ h₁ h₂ _ hx => ⟨h₁ hx, h₂ hx⟩ }

theorem eq_top_iff' (A : Subsemiring R) : A = ⊤ ↔ ∀ x : R, x ∈ A :=
  eq_top_iff.trans ⟨fun h m => h <| mem_top m, fun h m _ => h m⟩
#align subsemiring.eq_top_iff' Subsemiring.eq_top_iff'

section Center

/-- The center of a semiring `R` is the set of elements that commute with everything in `R` -/
def center (R) [Semiring R] : Subsemiring R :=
  { Submonoid.center R with
    carrier := Set.center R
    zero_mem' := Set.zero_mem_center R
    add_mem' := Set.add_mem_center }
#align subsemiring.center Subsemiring.center

theorem coe_center (R) [Semiring R] : ↑(center R) = Set.center R :=
  rfl
#align subsemiring.coe_center Subsemiring.coe_center

@[simp]
theorem center_toSubmonoid (R) [Semiring R] : (center R).toSubmonoid = Submonoid.center R :=
  rfl
#align subsemiring.center_to_submonoid Subsemiring.center_toSubmonoid

theorem mem_center_iff {R} [Semiring R] {z : R} : z ∈ center R ↔ ∀ g, g * z = z * g :=
  Iff.rfl
#align subsemiring.mem_center_iff Subsemiring.mem_center_iff

instance decidableMemCenter {R} [Semiring R] [DecidableEq R] [Fintype R] :
    DecidablePred (· ∈ center R) := fun _ => decidable_of_iff' _ mem_center_iff
#align subsemiring.decidable_mem_center Subsemiring.decidableMemCenter

@[simp]
theorem center_eq_top (R) [CommSemiring R] : center R = ⊤ :=
  SetLike.coe_injective (Set.center_eq_univ R)
#align subsemiring.center_eq_top Subsemiring.center_eq_top

/-- The center is commutative. -/
instance commSemiring {R} [Semiring R] : CommSemiring (center R) :=
  { Submonoid.center.commMonoid, (center R).toSemiring with }

end Center

section Centralizer

/-- The centralizer of a set as subsemiring. -/
def centralizer {R} [Semiring R] (s : Set R) : Subsemiring R :=
  { Submonoid.centralizer s with
    carrier := s.centralizer
    zero_mem' := Set.zero_mem_centralizer _
    add_mem' := Set.add_mem_centralizer }
#align subsemiring.centralizer Subsemiring.centralizer

@[simp, norm_cast]
theorem coe_centralizer {R} [Semiring R] (s : Set R) : (centralizer s : Set R) = s.centralizer :=
  rfl
#align subsemiring.coe_centralizer Subsemiring.coe_centralizer

theorem centralizer_toSubmonoid {R} [Semiring R] (s : Set R) :
    (centralizer s).toSubmonoid = Submonoid.centralizer s :=
  rfl
#align subsemiring.centralizer_to_submonoid Subsemiring.centralizer_toSubmonoid

theorem mem_centralizer_iff {R} [Semiring R] {s : Set R} {z : R} :
    z ∈ centralizer s ↔ ∀ g ∈ s, g * z = z * g :=
  Iff.rfl
#align subsemiring.mem_centralizer_iff Subsemiring.mem_centralizer_iff

theorem centralizer_le {R} [Semiring R] (s t : Set R) (h : s ⊆ t) : centralizer t ≤ centralizer s :=
  Set.centralizer_subset h
#align subsemiring.centralizer_le Subsemiring.centralizer_le

@[simp]
theorem centralizer_univ {R} [Semiring R] : centralizer Set.univ = center R :=
  SetLike.ext' (Set.centralizer_univ R)
#align subsemiring.centralizer_univ Subsemiring.centralizer_univ

end Centralizer

/-- The `Subsemiring` generated by a set. -/
def closure (s : Set R) : Subsemiring R :=
  infₛ { S | s ⊆ S }
#align subsemiring.closure Subsemiring.closure

theorem mem_closure {x : R} {s : Set R} : x ∈ closure s ↔ ∀ S : Subsemiring R, s ⊆ S → x ∈ S :=
  mem_infₛ
#align subsemiring.mem_closure Subsemiring.mem_closure

/-- The subsemiring generated by a set includes the set. -/
@[simp]
theorem subset_closure {s : Set R} : s ⊆ closure s := fun _ hx => mem_closure.2 fun _ hS => hS hx
#align subsemiring.subset_closure Subsemiring.subset_closure

theorem not_mem_of_not_mem_closure {s : Set R} {P : R} (hP : P ∉ closure s) : P ∉ s := fun h =>
  hP (subset_closure h)
#align subsemiring.not_mem_of_not_mem_closure Subsemiring.not_mem_of_not_mem_closure

/-- A subsemiring `S` includes `closure s` if and only if it includes `s`. -/
@[simp]
theorem closure_le {s : Set R} {t : Subsemiring R} : closure s ≤ t ↔ s ⊆ t :=
  ⟨Set.Subset.trans subset_closure, fun h => infₛ_le h⟩
#align subsemiring.closure_le Subsemiring.closure_le

/-- Subsemiring closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
theorem closure_mono ⦃s t : Set R⦄ (h : s ⊆ t) : closure s ≤ closure t :=
  closure_le.2 <| Set.Subset.trans h subset_closure
#align subsemiring.closure_mono Subsemiring.closure_mono

theorem closure_eq_of_le {s : Set R} {t : Subsemiring R} (h₁ : s ⊆ t) (h₂ : t ≤ closure s) :
    closure s = t :=
  le_antisymm (closure_le.2 h₁) h₂
#align subsemiring.closure_eq_of_le Subsemiring.closure_eq_of_le

theorem mem_map_equiv {f : R ≃+* S} {K : Subsemiring R} {x : S} :
    x ∈ K.map (f : R →+* S) ↔ f.symm x ∈ K := by
  convert @Set.mem_image_equiv _ _ (↑K) f.toEquiv x using 1
#align subsemiring.mem_map_equiv Subsemiring.mem_map_equiv

theorem map_equiv_eq_comap_symm (f : R ≃+* S) (K : Subsemiring R) :
    K.map (f : R →+* S) = K.comap f.symm :=
  SetLike.coe_injective (f.toEquiv.image_eq_preimage K)
#align subsemiring.map_equiv_eq_comap_symm Subsemiring.map_equiv_eq_comap_symm

theorem comap_equiv_eq_map_symm (f : R ≃+* S) (K : Subsemiring S) :
    K.comap (f : R →+* S) = K.map f.symm :=
  (map_equiv_eq_comap_symm f.symm K).symm
#align subsemiring.comap_equiv_eq_map_symm Subsemiring.comap_equiv_eq_map_symm

end Subsemiring

namespace Submonoid

/-- The additive closure of a submonoid is a subsemiring. -/
def subsemiringClosure (M : Submonoid R) : Subsemiring R :=
  { AddSubmonoid.closure (M : Set R) with
    one_mem' := AddSubmonoid.mem_closure.mpr fun _ hy => hy M.one_mem
    mul_mem' := MulMemClass.mul_mem_add_closure }
#align submonoid.subsemiring_closure Submonoid.subsemiringClosure

theorem subsemiringClosure_coe :
    (M.subsemiringClosure : Set R) = AddSubmonoid.closure (M : Set R) :=
  rfl
#align submonoid.subsemiring_closure_coe Submonoid.subsemiringClosure_coe

theorem subsemiringClosure_toAddSubmonoid :
    M.subsemiringClosure.toAddSubmonoid = AddSubmonoid.closure (M : Set R) :=
  rfl
#align submonoid.subsemiring_closure_to_add_submonoid Submonoid.subsemiringClosure_toAddSubmonoid

/-- The `Subsemiring` generated by a multiplicative submonoid coincides with the
`Subsemiring.closure` of the submonoid itself . -/
theorem subsemiringClosure_eq_closure : M.subsemiringClosure = Subsemiring.closure (M : Set R) := by
  ext
  refine'
    ⟨fun hx => _, fun hx =>
      (Subsemiring.mem_closure.mp hx) M.subsemiringClosure fun s sM => _⟩
  <;> rintro - ⟨H1, rfl⟩
  <;> rintro - ⟨H2, rfl⟩
  · exact AddSubmonoid.mem_closure.mp hx H1.toAddSubmonoid H2
  · exact H2 sM
#align submonoid.subsemiring_closure_eq_closure Submonoid.subsemiringClosure_eq_closure

end Submonoid

namespace Subsemiring

@[simp]
theorem closure_submonoid_closure (s : Set R) : closure ↑(Submonoid.closure s) = closure s :=
  le_antisymm
    (closure_le.mpr fun _ hy =>
      (Submonoid.mem_closure.mp hy) (closure s).toSubmonoid subset_closure)
    (closure_mono Submonoid.subset_closure)
#align subsemiring.closure_submonoid_closure Subsemiring.closure_submonoid_closure

/-- The elements of the subsemiring closure of `M` are exactly the elements of the additive closure
of a multiplicative submonoid `M`. -/
theorem coe_closure_eq (s : Set R) :
    (closure s : Set R) = AddSubmonoid.closure (Submonoid.closure s : Set R) := by
  simp [← Submonoid.subsemiringClosure_toAddSubmonoid, Submonoid.subsemiringClosure_eq_closure]
#align subsemiring.coe_closure_eq Subsemiring.coe_closure_eq

theorem mem_closure_iff {s : Set R} {x} :
    x ∈ closure s ↔ x ∈ AddSubmonoid.closure (Submonoid.closure s : Set R) :=
  Set.ext_iff.mp (coe_closure_eq s) x
#align subsemiring.mem_closure_iff Subsemiring.mem_closure_iff

@[simp]
theorem closure_addSubmonoid_closure {s : Set R} : closure ↑(AddSubmonoid.closure s) = closure s :=
  by
  ext x
  refine' ⟨fun hx => _, fun hx => closure_mono AddSubmonoid.subset_closure hx⟩
  rintro - ⟨H, rfl⟩
  rintro - ⟨J, rfl⟩
  refine' (AddSubmonoid.mem_closure.mp (mem_closure_iff.mp hx)) H.toAddSubmonoid fun y hy => _
  refine' (Submonoid.mem_closure.mp hy) H.toSubmonoid fun z hz => _
  exact (AddSubmonoid.mem_closure.mp hz) H.toAddSubmonoid fun w hw => J hw
#align subsemiring.closure_add_submonoid_closure Subsemiring.closure_addSubmonoid_closure

/-- An induction principle for closure membership. If `p` holds for `0`, `1`, and all elements
of `s`, and is preserved under addition and multiplication, then `p` holds for all elements
of the closure of `s`. -/
@[elab_as_elim]
theorem closure_induction {s : Set R} {p : R → Prop} {x} (h : x ∈ closure s) (Hs : ∀ x ∈ s, p x)
    (H0 : p 0) (H1 : p 1) (Hadd : ∀ x y, p x → p y → p (x + y))
    (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
  (@closure_le _ _ _ ⟨⟨⟨p, @Hmul⟩, H1⟩, @Hadd, H0⟩).2 Hs h
#align subsemiring.closure_induction Subsemiring.closure_induction

/-- An induction principle for closure membership for predicates with two arguments. -/
@[elab_as_elim]
theorem closure_induction₂ {s : Set R} {p : R → R → Prop} {x} {y : R} (hx : x ∈ closure s)
    (hy : y ∈ closure s) (Hs : ∀ x ∈ s, ∀ y ∈ s, p x y) (H0_left : ∀ x, p 0 x)
    (H0_right : ∀ x, p x 0) (H1_left : ∀ x, p 1 x) (H1_right : ∀ x, p x 1)
    (Hadd_left : ∀ x₁ x₂ y, p x₁ y → p x₂ y → p (x₁ + x₂) y)
    (Hadd_right : ∀ x y₁ y₂, p x y₁ → p x y₂ → p x (y₁ + y₂))
    (Hmul_left : ∀ x₁ x₂ y, p x₁ y → p x₂ y → p (x₁ * x₂) y)
    (Hmul_right : ∀ x y₁ y₂, p x y₁ → p x y₂ → p x (y₁ * y₂)) : p x y :=
  closure_induction hx
    (fun x₁ x₁s =>
      closure_induction hy (Hs x₁ x₁s) (H0_right x₁) (H1_right x₁) (Hadd_right x₁) (Hmul_right x₁))
    (H0_left y) (H1_left y) (fun z z' => Hadd_left z z' y) fun z z' => Hmul_left z z' y
#align subsemiring.closure_induction₂ Subsemiring.closure_induction₂

theorem mem_closure_iff_exists_list {R} [Semiring R] {s : Set R} {x} :
    x ∈ closure s ↔ ∃ L : List (List R), (∀ t ∈ L, ∀ y ∈ t, y ∈ s) ∧ (L.map List.prod).sum = x := by
  constructor
  · intro hx
    -- Porting note: needed explicit `p`
    let p : R → Prop := fun x =>
      ∃ (L : List (List R)),
        (∀ (t : List R), t ∈ L → ∀ (y : R), y ∈ t → y ∈ s) ∧ (List.map List.prod L).sum = x
    exact AddSubmonoid.closure_induction (p := p) (mem_closure_iff.1 hx)
      (fun x hx =>
        suffices ∃ t : List R, (∀ y ∈ t, y ∈ s) ∧ t.prod = x from
          let ⟨t, ht1, ht2⟩ := this
          ⟨[t], List.forall_mem_singleton.2 ht1, by
            rw [List.map_singleton, List.sum_singleton, ht2]⟩
        Submonoid.closure_induction hx
          (fun x hx => ⟨[x], List.forall_mem_singleton.2 hx, one_mul x⟩)
          ⟨[], List.forall_mem_nil _, rfl⟩ fun x y ⟨t, ht1, ht2⟩ ⟨u, hu1, hu2⟩ =>
          ⟨t ++ u, List.forall_mem_append.2 ⟨ht1, hu1⟩, by rw [List.prod_append, ht2, hu2]⟩)
      ⟨[], List.forall_mem_nil _, rfl⟩ fun x y ⟨L, HL1, HL2⟩ ⟨M, HM1, HM2⟩ =>
      ⟨L ++ M, List.forall_mem_append.2 ⟨HL1, HM1⟩, by
        rw [List.map_append, List.sum_append, HL2, HM2]⟩
  · rintro ⟨L, HL1, HL2⟩
    exact HL2 ▸
      list_sum_mem fun r hr =>
        let ⟨t, ht1, ht2⟩ := List.mem_map.1 hr
        ht2 ▸ list_prod_mem _ fun y hy => subset_closure <| HL1 t ht1 y hy
#align subsemiring.mem_closure_iff_exists_list Subsemiring.mem_closure_iff_exists_list

variable (R)

/-- `closure` forms a Galois insertion with the coercion to set. -/
protected def gi : GaloisInsertion (@closure R _) (↑)
    where
  choice s _ := closure s
  gc _ _ := closure_le
  le_l_u _ := subset_closure
  choice_eq _ _ := rfl
#align subsemiring.gi Subsemiring.gi

variable {R}

/-- Closure of a subsemiring `S` equals `S`. -/
theorem closure_eq (s : Subsemiring R) : closure (s : Set R) = s :=
  (Subsemiring.gi R).l_u_eq s
#align subsemiring.closure_eq Subsemiring.closure_eq

@[simp]
theorem closure_empty : closure (∅ : Set R) = ⊥ :=
  (Subsemiring.gi R).gc.l_bot
#align subsemiring.closure_empty Subsemiring.closure_empty

@[simp]
theorem closure_univ : closure (Set.univ : Set R) = ⊤ :=
  @coe_top R _ ▸ closure_eq ⊤
#align subsemiring.closure_univ Subsemiring.closure_univ

theorem closure_union (s t : Set R) : closure (s ∪ t) = closure s ⊔ closure t :=
  (Subsemiring.gi R).gc.l_sup
#align subsemiring.closure_union Subsemiring.closure_union

theorem closure_unionᵢ {ι} (s : ι → Set R) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
  (Subsemiring.gi R).gc.l_supᵢ
#align subsemiring.closure_Union Subsemiring.closure_unionᵢ

theorem closure_unionₛ (s : Set (Set R)) : closure (⋃₀ s) = ⨆ t ∈ s, closure t :=
  (Subsemiring.gi R).gc.l_supₛ
#align subsemiring.closure_sUnion Subsemiring.closure_unionₛ

theorem map_sup (s t : Subsemiring R) (f : R →+* S) : (s ⊔ t).map f = s.map f ⊔ t.map f :=
  (gc_map_comap f).l_sup
#align subsemiring.map_sup Subsemiring.map_sup

theorem map_supᵢ {ι : Sort _} (f : R →+* S) (s : ι → Subsemiring R) :
    (supᵢ s).map f = ⨆ i, (s i).map f :=
  (gc_map_comap f).l_supᵢ
#align subsemiring.map_supr Subsemiring.map_supᵢ

theorem comap_inf (s t : Subsemiring S) (f : R →+* S) : (s ⊓ t).comap f = s.comap f ⊓ t.comap f :=
  (gc_map_comap f).u_inf
#align subsemiring.comap_inf Subsemiring.comap_inf

theorem comap_infᵢ {ι : Sort _} (f : R →+* S) (s : ι → Subsemiring S) :
    (infᵢ s).comap f = ⨅ i, (s i).comap f :=
  (gc_map_comap f).u_infᵢ
#align subsemiring.comap_infi Subsemiring.comap_infᵢ

@[simp]
theorem map_bot (f : R →+* S) : (⊥ : Subsemiring R).map f = ⊥ :=
  (gc_map_comap f).l_bot
#align subsemiring.map_bot Subsemiring.map_bot

@[simp]
theorem comap_top (f : R →+* S) : (⊤ : Subsemiring S).comap f = ⊤ :=
  (gc_map_comap f).u_top
#align subsemiring.comap_top Subsemiring.comap_top

/-- Given `Subsemiring`s `s`, `t` of semirings `R`, `S` respectively, `s.prod t` is `s × t`
as a subsemiring of `R × S`. -/
def prod (s : Subsemiring R) (t : Subsemiring S) : Subsemiring (R × S) :=
  { s.toSubmonoid.prod t.toSubmonoid, s.toAddSubmonoid.prod t.toAddSubmonoid with
    carrier := s ×ˢ t }
#align subsemiring.prod Subsemiring.prod

@[norm_cast]
theorem coe_prod (s : Subsemiring R) (t : Subsemiring S) : (s.prod t : Set (R × S)) = s ×ˢ t :=
  rfl
#align subsemiring.coe_prod Subsemiring.coe_prod

theorem mem_prod {s : Subsemiring R} {t : Subsemiring S} {p : R × S} :
    p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t :=
  Iff.rfl
#align subsemiring.mem_prod Subsemiring.mem_prod

@[mono]
theorem prod_mono ⦃s₁ s₂ : Subsemiring R⦄ (hs : s₁ ≤ s₂) ⦃t₁ t₂ : Subsemiring S⦄ (ht : t₁ ≤ t₂) :
    s₁.prod t₁ ≤ s₂.prod t₂ :=
  Set.prod_mono hs ht
#align subsemiring.prod_mono Subsemiring.prod_mono

theorem prod_mono_right (s : Subsemiring R) : Monotone fun t : Subsemiring S => s.prod t :=
  prod_mono (le_refl s)
#align subsemiring.prod_mono_right Subsemiring.prod_mono_right

theorem prod_mono_left (t : Subsemiring S) : Monotone fun s : Subsemiring R => s.prod t :=
  fun _ _ hs => prod_mono hs (le_refl t)
#align subsemiring.prod_mono_left Subsemiring.prod_mono_left

theorem prod_top (s : Subsemiring R) : s.prod (⊤ : Subsemiring S) = s.comap (RingHom.fst R S) :=
  ext fun x => by simp [mem_prod, MonoidHom.coe_fst]
#align subsemiring.prod_top Subsemiring.prod_top

theorem top_prod (s : Subsemiring S) : (⊤ : Subsemiring R).prod s = s.comap (RingHom.snd R S) :=
  ext fun x => by simp [mem_prod, MonoidHom.coe_snd]
#align subsemiring.top_prod Subsemiring.top_prod

@[simp]
theorem top_prod_top : (⊤ : Subsemiring R).prod (⊤ : Subsemiring S) = ⊤ :=
  (top_prod _).trans <| comap_top _
#align subsemiring.top_prod_top Subsemiring.top_prod_top

/-- Product of subsemirings is isomorphic to their product as monoids. -/
def prodEquiv (s : Subsemiring R) (t : Subsemiring S) : s.prod t ≃+* s × t :=
  { Equiv.Set.prod (s : Set R) (t : Set S) with
    map_mul' := fun _ _ => rfl
    map_add' := fun _ _ => rfl }
#align subsemiring.prod_equiv Subsemiring.prodEquiv

theorem mem_supᵢ_of_directed {ι} [hι : Nonempty ι] {S : ι → Subsemiring R} (hS : Directed (· ≤ ·) S)
    {x : R} : (x ∈ ⨆ i, S i) ↔ ∃ i, x ∈ S i := by
  refine' ⟨_, fun ⟨i, hi⟩ => (SetLike.le_def.1 <| le_supᵢ S i) hi⟩
  let U : Subsemiring R :=
    Subsemiring.mk' (⋃ i, (S i : Set R)) (⨆ i, (S i).toSubmonoid)
      (Submonoid.coe_supᵢ_of_directed <| hS.mono_comp _ fun _ _ => id) (⨆ i, (S i).toAddSubmonoid)
      (AddSubmonoid.coe_supᵢ_of_directed <| hS.mono_comp _ fun _ _ => id)
  -- Porting note: gave the hypothesis an explicit name because `@this` doesn't work
  suffices h : (⨆ i, S i) ≤ U by simpa using @h x
  exact supᵢ_le fun i x hx => Set.mem_unionᵢ.2 ⟨i, hx⟩
#align subsemiring.mem_supr_of_directed Subsemiring.mem_supᵢ_of_directed

theorem coe_supᵢ_of_directed {ι} [hι : Nonempty ι] {S : ι → Subsemiring R}
    (hS : Directed (· ≤ ·) S) : ((⨆ i, S i : Subsemiring R) : Set R) = ⋃ i, ↑(S i) :=
  Set.ext fun x => by simp [mem_supᵢ_of_directed hS]
#align subsemiring.coe_supr_of_directed Subsemiring.coe_supᵢ_of_directed

theorem mem_supₛ_of_directedOn {S : Set (Subsemiring R)} (Sne : S.Nonempty)
    (hS : DirectedOn (· ≤ ·) S) {x : R} : x ∈ supₛ S ↔ ∃ s ∈ S, x ∈ s := by
  haveI : Nonempty S := Sne.to_subtype
  simp only [supₛ_eq_supᵢ', mem_supᵢ_of_directed hS.directed_val, SetCoe.exists, Subtype.coe_mk,
    exists_prop]
#align subsemiring.mem_Sup_of_directed_on Subsemiring.mem_supₛ_of_directedOn

theorem coe_supₛ_of_directedOn {S : Set (Subsemiring R)} (Sne : S.Nonempty)
    (hS : DirectedOn (· ≤ ·) S) : (↑(supₛ S) : Set R) = ⋃ s ∈ S, ↑s :=
  Set.ext fun x => by simp [mem_supₛ_of_directedOn Sne hS]
#align subsemiring.coe_Sup_of_directed_on Subsemiring.coe_supₛ_of_directedOn

end Subsemiring

namespace RingHom

variable [NonAssocSemiring T] {s : Subsemiring R}

variable {σR σS : Type _}

variable [SetLike σR R] [SetLike σS S] [SubsemiringClass σR R] [SubsemiringClass σS S]

open Subsemiring

/-- Restriction of a ring homomorphism to a subsemiring of the domain. -/
def domRestrict (f : R →+* S) (s : σR) : s →+* S :=
  f.comp <| SubsemiringClass.subtype s
#align ring_hom.dom_restrict RingHom.domRestrict

@[simp]
theorem restrict_apply (f : R →+* S) {s : σR} (x : s) : f.domRestrict s x = f x :=
  rfl
#align ring_hom.restrict_apply RingHom.restrict_apply

/-- Restriction of a ring homomorphism to a subsemiring of the codomain. -/
def codRestrict (f : R →+* S) (s : σS) (h : ∀ x, f x ∈ s) : R →+* s :=
  { (f : R →* S).codRestrict s h, (f : R →+ S).codRestrict s h with toFun := fun n => ⟨f n, h n⟩ }
#align ring_hom.cod_restrict RingHom.codRestrict

/-- The ring homomorphism from the preimage of `s` to `s`. -/
def restrict (f : R →+* S) (s' : σR) (s : σS) (h : ∀ x ∈ s', f x ∈ s) : s' →+* s :=
  (f.domRestrict s').codRestrict s fun x => h x x.2
#align ring_hom.restrict RingHom.restrict

@[simp]
theorem coe_restrict_apply (f : R →+* S) (s' : σR) (s : σS) (h : ∀ x ∈ s', f x ∈ s) (x : s') :
    (f.restrict s' s h x : S) = f x :=
  rfl
#align ring_hom.coe_restrict_apply RingHom.coe_restrict_apply

@[simp]
theorem comp_restrict (f : R →+* S) (s' : σR) (s : σS) (h : ∀ x ∈ s', f x ∈ s) :
    (SubsemiringClass.subtype s).comp (f.restrict s' s h) = f.comp (SubsemiringClass.subtype s') :=
  rfl
#align ring_hom.comp_restrict RingHom.comp_restrict

/-- Restriction of a ring homomorphism to its range interpreted as a subsemiring.

This is the bundled version of `Set.rangeFactorization`. -/
def rangeSRestrict (f : R →+* S) : R →+* f.rangeS :=
  f.codRestrict (R := R) (S := S) (σS := Subsemiring S) f.rangeS f.mem_rangeS_self
#align ring_hom.srange_restrict RingHom.rangeSRestrict

@[simp]
theorem coe_rangeSRestrict (f : R →+* S) (x : R) : (f.rangeSRestrict x : S) = f x :=
  rfl
#align ring_hom.coe_srange_restrict RingHom.coe_rangeSRestrict

theorem rangeSRestrict_surjective (f : R →+* S) : Function.Surjective f.rangeSRestrict :=
  fun ⟨_, hy⟩ =>
  let ⟨x, hx⟩ := mem_rangeS.mp hy
  ⟨x, Subtype.ext hx⟩
#align ring_hom.srange_restrict_surjective RingHom.rangeSRestrict_surjective

theorem rangeS_top_iff_surjective {f : R →+* S} :
    f.rangeS = (⊤ : Subsemiring S) ↔ Function.Surjective f :=
  SetLike.ext'_iff.trans <| Iff.trans (by rw [coe_rangeS, coe_top]) Set.range_iff_surjective
#align ring_hom.srange_top_iff_surjective RingHom.rangeS_top_iff_surjective

/-- The range of a surjective ring homomorphism is the whole of the codomain. -/
theorem rangeS_top_of_surjective (f : R →+* S) (hf : Function.Surjective f) :
    f.rangeS = (⊤ : Subsemiring S) :=
  rangeS_top_iff_surjective.2 hf
#align ring_hom.srange_top_of_surjective RingHom.rangeS_top_of_surjective

/-- The subsemiring of elements `x : R` such that `f x = g x` -/
def eqLocusS (f g : R →+* S) : Subsemiring R :=
  { (f : R →* S).eqLocusM g, (f : R →+ S).eqLocusM g with carrier := { x | f x = g x } }
#align ring_hom.eq_slocus RingHom.eqLocusS

@[simp]
theorem eqLocusS_same (f : R →+* S) : f.eqLocusS f = ⊤ :=
  SetLike.ext fun _ => eq_self_iff_true _
#align ring_hom.eq_slocus_same RingHom.eqLocusS_same

/-- If two ring homomorphisms are equal on a set, then they are equal on its subsemiring closure. -/

theorem eq_of_eqOn_stop {f g : R →+* S} (h : Set.EqOn f g (⊤ : Subsemiring R)) : f = g :=
  ext fun _ => h trivial
#align ring_hom.eq_of_eq_on_stop RingHom.eq_of_eqOn_stop

theorem eq_of_eqOn_sdense {s : Set R} (hs : closure s = ⊤) {f g : R →+* S} (h : s.EqOn f g) :
    f = g :=
  eq_of_eqOn_stop <| hs ▸ eqOn_sclosure h
#align ring_hom.eq_of_eq_on_sdense RingHom.eq_of_eqOn_sdense

theorem sclosure_preimage_le (f : R →+* S) (s : Set S) : closure (f ⁻¹' s) ≤ (closure s).comap f :=
  closure_le.2 fun _ hx => SetLike.mem_coe.2 <| mem_comap.2 <| subset_closure hx
#align ring_hom.sclosure_preimage_le RingHom.sclosure_preimage_le

/-- The image under a ring homomorphism of the subsemiring generated by a set equals
the subsemiring generated by the image of the set. -/
theorem map_closureS (f : R →+* S) (s : Set R) : (closure s).map f = closure (f '' s) :=
  le_antisymm
    (map_le_iff_le_comap.2 <|
      le_trans (closure_mono <| Set.subset_preimage_image _ _) (sclosure_preimage_le _ _))
    (closure_le.2 <| Set.image_subset _ subset_closure)
#align ring_hom.map_sclosure RingHom.map_closureS

end RingHom

namespace Subsemiring

open RingHom

/-- The ring homomorphism associated to an inclusion of subsemirings. -/
def inclusion {S T : Subsemiring R} (h : S ≤ T) : S →+* T :=
  S.subtype.codRestrict _ fun x => h x.2
#align subsemiring.inclusion Subsemiring.inclusion

@[simp]
theorem rangeS_subtype (s : Subsemiring R) : s.subtype.rangeS = s :=
  SetLike.coe_injective <| (coe_rangeS _).trans Subtype.range_coe
#align subsemiring.srange_subtype Subsemiring.rangeS_subtype

@[simp]
theorem range_fst : (fst R S).rangeS = ⊤ :=
  (fst R S).rangeS_top_of_surjective <| Prod.fst_surjective
#align subsemiring.range_fst Subsemiring.range_fst

@[simp]
theorem range_snd : (snd R S).rangeS = ⊤ :=
  (snd R S).rangeS_top_of_surjective <| Prod.snd_surjective
#align subsemiring.range_snd Subsemiring.range_snd

@[simp]
theorem prod_bot_sup_bot_prod (s : Subsemiring R) (t : Subsemiring S) :
    s.prod ⊥ ⊔ prod ⊥ t = s.prod t :=
  le_antisymm (sup_le (prod_mono_right s bot_le) (prod_mono_left t bot_le)) fun p hp =>
    Prod.fst_mul_snd p ▸
      mul_mem
        ((le_sup_left : s.prod ⊥ ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨hp.1, SetLike.mem_coe.2 <| one_mem ⊥⟩)
        ((le_sup_right : prod ⊥ t ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨SetLike.mem_coe.2 <| one_mem ⊥, hp.2⟩)
#align subsemiring.prod_bot_sup_bot_prod Subsemiring.prod_bot_sup_bot_prod

end Subsemiring

namespace RingEquiv

variable {s t : Subsemiring R}

/-- Makes the identity isomorphism from a proof two subsemirings of a multiplicative
    monoid are equal. -/
def subsemiringCongr (h : s = t) : s ≃+* t :=
  {
    Equiv.setCongr <| congr_arg _ h with
    map_mul' := fun _ _ => rfl
    map_add' := fun _ _ => rfl }
#align ring_equiv.subsemiring_congr RingEquiv.subsemiringCongr

/-- Restrict a ring homomorphism with a left inverse to a ring isomorphism to its
`RingHom.rangeS`. -/
def ofLeftInverseS {g : S → R} {f : R →+* S} (h : Function.LeftInverse g f) : R ≃+* f.rangeS :=
  { f.rangeSRestrict with
    toFun := fun x => f.rangeSRestrict x
    invFun := fun x => (g ∘ f.rangeS.subtype) x
    left_inv := h
    right_inv := fun x =>
      Subtype.ext <|
        let ⟨x', hx'⟩ := RingHom.mem_rangeS.mp x.prop
        show f (g x) = x by rw [← hx', h x'] }
#align ring_equiv.sof_left_inverse RingEquiv.ofLeftInverseS

@[simp]
theorem ofLeftInverseS_apply {g : S → R} {f : R →+* S} (h : Function.LeftInverse g f) (x : R) :
    ↑(ofLeftInverseS h x) = f x :=
  rfl
#align ring_equiv.sof_left_inverse_apply RingEquiv.ofLeftInverseS_apply

@[simp]
theorem ofLeftInverseS_symm_apply {g : S → R} {f : R →+* S} (h : Function.LeftInverse g f)
    (x : f.rangeS) : (ofLeftInverseS h).symm x = g x :=
  rfl
#align ring_equiv.sof_left_inverse_symm_apply RingEquiv.ofLeftInverseS_symm_apply

/-- Given an equivalence `e : R ≃+* S` of semirings and a subsemiring `s` of `R`,
`subsemiring_map e s` is the induced equivalence between `s` and `s.map e` -/
@[simps!]
def subsemiringMap (e : R ≃+* S) (s : Subsemiring R) : s ≃+* s.map e.toRingHom :=
  { e.toAddEquiv.addSubmonoidMap s.toAddSubmonoid, e.toMulEquiv.submonoidMap s.toSubmonoid with }
#align ring_equiv.subsemiring_map RingEquiv.subsemiringMap

end RingEquiv

/-! ### Actions by `Subsemiring`s

These are just copies of the definitions about `Submonoid` starting from `submonoid.mul_action`.
The only new result is `subsemiring.module`.

When `R` is commutative, `algebra.of_subsemiring` provides a stronger result than those found in
this file, which uses the same scalar action.
-/

section Actions

namespace Subsemiring

variable {R' α β : Type _}

section NonAssocSemiring

variable [NonAssocSemiring R']

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance smul [SMul R' α] (S : Subsemiring R') : SMul S α :=
  S.toSubmonoid.smul

theorem smul_def [SMul R' α] {S : Subsemiring R'} (g : S) (m : α) : g • m = (g : R') • m :=
  rfl
#align subsemiring.smul_def Subsemiring.smul_def

instance smulCommClass_left [SMul R' β] [SMul α β] [SMulCommClass R' α β] (S : Subsemiring R') :
    SMulCommClass S α β :=
  S.toSubmonoid.smulCommClass_left
#align subsemiring.smul_comm_class_left Subsemiring.smulCommClass_left

instance smulCommClass_right [SMul α β] [SMul R' β] [SMulCommClass α R' β] (S : Subsemiring R') :
    SMulCommClass α S β :=
  S.toSubmonoid.smulCommClass_right
#align subsemiring.smul_comm_class_right Subsemiring.smulCommClass_right

/-- Note that this provides `IsScalarTower S R R` which is needed by `smul_mul_assoc`. -/
instance isScalarTower [SMul α β] [SMul R' α] [SMul R' β] [IsScalarTower R' α β]
    (S : Subsemiring R') :
    IsScalarTower S α β :=
  S.toSubmonoid.isScalarTower

instance faithfulSMul [SMul R' α] [FaithfulSMul R' α] (S : Subsemiring R') : FaithfulSMul S α :=
  S.toSubmonoid.faithfulSMul

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [Zero α] [SMulWithZero R' α] (S : Subsemiring R') : SMulWithZero S α :=
  SMulWithZero.compHom _ S.subtype.toMonoidWithZeroHom.toZeroHom

end NonAssocSemiring

variable [Semiring R']

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance mulAction [MulAction R' α] (S : Subsemiring R') : MulAction S α :=
  S.toSubmonoid.mulAction

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance distribMulAction [AddMonoid α] [DistribMulAction R' α] (S : Subsemiring R') :
    DistribMulAction S α :=
  S.toSubmonoid.distribMulAction

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance mulDistribMulAction [Monoid α] [MulDistribMulAction R' α] (S : Subsemiring R') :
    MulDistribMulAction S α :=
  S.toSubmonoid.mulDistribMulAction

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance mulActionWithZero [Zero α] [MulActionWithZero R' α] (S : Subsemiring R') :
    MulActionWithZero S α :=
  MulActionWithZero.compHom _ S.subtype.toMonoidWithZeroHom

-- Porting note: instance named explicitly for use in `RingTheory/Subring/Basic`
/-- The action by a subsemiring is the action by the underlying semiring. -/
instance module [AddCommMonoid α] [Module R' α] (S : Subsemiring R') : Module S α :=
  -- Porting note: copying over the `smul` field causes a timeout
  -- { Module.compHom _ S.subtype with smul := (· • ·) }
  Module.compHom _ S.subtype

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [Semiring α] [MulSemiringAction R' α] (S : Subsemiring R') : MulSemiringAction S α :=
  S.toSubmonoid.mulSemiringAction

/-- The center of a semiring acts commutatively on that semiring. -/
instance center.smulCommClass_left : SMulCommClass (center R') R' R' :=
  Submonoid.center.smulCommClass_left
#align subsemiring.center.smul_comm_class_left Subsemiring.center.smulCommClass_left

/-- The center of a semiring acts commutatively on that semiring. -/
instance center.smulCommClass_right : SMulCommClass R' (center R') R' :=
  Submonoid.center.smulCommClass_right
#align subsemiring.center.smul_comm_class_right Subsemiring.center.smulCommClass_right

/-- If all the elements of a set `s` commute, then `closure s` is a commutative monoid. -/
def closureCommSemiringOfComm {s : Set R'} (hcomm : ∀ a ∈ s, ∀ b ∈ s, a * b = b * a) :
    CommSemiring (closure s) :=
  { (closure s).toSemiring with
    mul_comm := fun x y => by
      ext
      simp only [Subsemiring.coe_mul]
      refine'
        closure_induction₂ x.prop y.prop hcomm (fun x => by simp only [zero_mul, mul_zero])
          (fun x => by simp only [zero_mul, mul_zero]) (fun x => by simp only [one_mul, mul_one])
          (fun x => by simp only [one_mul, mul_one])
          (fun x y z h₁ h₂ => by simp only [add_mul, mul_add, h₁, h₂])
          (fun x y z h₁ h₂ => by simp only [add_mul, mul_add, h₁, h₂])
          (fun x y z h₁ h₂ => by rw [mul_assoc, h₂, ← mul_assoc, h₁, mul_assoc]) fun x y z h₁ h₂ =>
          by rw [← mul_assoc, h₁, mul_assoc, h₂, ← mul_assoc] }
#align subsemiring.closure_comm_semiring_of_comm Subsemiring.closureCommSemiringOfComm

end Subsemiring

end Actions

-- While this definition is not about `Subsemiring`s, this is the earliest we have
-- both `StrictOrderedSemiring` and `Submonoid` available.
/-- Submonoid of positive elements of an ordered semiring. -/
def posSubmonoid (R : Type _) [StrictOrderedSemiring R] : Submonoid R
    where
  carrier := { x | 0 < x }
  one_mem' := show (0 : R) < 1 from zero_lt_one
  mul_mem' {x y} (hx : 0 < x) (hy : 0 < y) := mul_pos hx hy
#align pos_submonoid posSubmonoid

@[simp]
theorem mem_posSubmonoid {R : Type _} [StrictOrderedSemiring R] (u : Rˣ) :
    ↑u ∈ posSubmonoid R ↔ (0 : R) < u :=
  Iff.rfl
#align mem_pos_monoid mem_posSubmonoid


/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison

! This file was ported from Lean 3 source module topology.algebra.field
! leanprover-community/mathlib commit c10e724be91096453ee3db13862b9fb9a992fef2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Algebra.Ring.Basic
import Mathlib.Topology.Algebra.GroupWithZero
import Mathlib.Topology.LocalExtr
import Mathlib.FieldTheory.Subfield

/-!
# Topological fields

A topological division ring is a topological ring whose inversion function is continuous at every
non-zero element.

-/

variable {K : Type _} [DivisionRing K] [TopologicalSpace K]

/-- Left-multiplication by a nonzero element of a topological division ring is proper, i.e.,
inverse images of compact sets are compact. -/
theorem Filter.tendsto_cocompact_mul_left₀ [ContinuousMul K] {a : K} (ha : a ≠ 0) :
    Filter.Tendsto (fun x : K => a * x) (Filter.cocompact K) (Filter.cocompact K) :=
  Filter.tendsto_cocompact_mul_left (inv_mul_cancel ha)
#align filter.tendsto_cocompact_mul_left₀ Filter.tendsto_cocompact_mul_left₀

/-- Right-multiplication by a nonzero element of a topological division ring is proper, i.e.,
inverse images of compact sets are compact. -/
theorem Filter.tendsto_cocompact_mul_right₀ [ContinuousMul K] {a : K} (ha : a ≠ 0) :
    Filter.Tendsto (fun x : K => x * a) (Filter.cocompact K) (Filter.cocompact K) :=
  Filter.tendsto_cocompact_mul_right (mul_inv_cancel ha)
#align filter.tendsto_cocompact_mul_right₀ Filter.tendsto_cocompact_mul_right₀

variable (K)

/-- A topological division ring is a division ring with a topology where all operations are
    continuous, including inversion. -/
class TopologicalDivisionRing extends TopologicalRing K, HasContinuousInv₀ K : Prop
#align topological_division_ring TopologicalDivisionRing

section Subfield

variable {α : Type _} [Field α] [TopologicalSpace α] [TopologicalDivisionRing α]

/-- The (topological-space) closure of a subfield of a topological field is
itself a subfield. -/
def Subfield.topologicalClosure (K : Subfield α) : Subfield α :=
  { K.toSubring.topologicalClosure with
    carrier := _root_.closure (K : Set α)
    inv_mem' := fun x hx => by
      dsimp only at hx ⊢
      rcases eq_or_ne x 0 with (rfl | h)
      · rwa [inv_zero]
      · -- porting note: todo: Lean fails to find InvMemClass instance
        rw [← @inv_coe_set α (Subfield α) _ _ SubfieldClass.toInvMemClass K, ← Set.image_inv]
        exact mem_closure_image (continuousAt_inv₀ h) hx }
#align subfield.topological_closure Subfield.topologicalClosure

theorem Subfield.le_topologicalClosure (s : Subfield α) : s ≤ s.topologicalClosure :=
  _root_.subset_closure
#align subfield.le_topological_closure Subfield.le_topologicalClosure

theorem Subfield.isClosed_topologicalClosure (s : Subfield α) :
    IsClosed (s.topologicalClosure : Set α) :=
  isClosed_closure
#align subfield.is_closed_topological_closure Subfield.isClosed_topologicalClosure

theorem Subfield.topologicalClosure_minimal (s : Subfield α) {t : Subfield α} (h : s ≤ t)
    (ht : IsClosed (t : Set α)) : s.topologicalClosure ≤ t :=
  closure_minimal h ht
#align subfield.topological_closure_minimal Subfield.topologicalClosure_minimal

end Subfield

section affineHomeomorph

/-!
This section is about affine homeomorphisms from a topological field `𝕜` to itself.
Technically it does not require `𝕜` to be a topological field, a topological ring that
happens to be a field is enough.
-/

variable {𝕜 : Type _} [Field 𝕜] [TopologicalSpace 𝕜] [TopologicalRing 𝕜]

/--
The map `fun x => a * x + b`, as a homeomorphism from `𝕜` (a topological field) to itself,
when `a ≠ 0`.
-/
@[simps]
def affineHomeomorph (a b : 𝕜) (h : a ≠ 0) : 𝕜 ≃ₜ 𝕜 where
  toFun x := a * x + b
  invFun y := (y - b) / a
  left_inv x := by
    simp only [add_sub_cancel]
    exact mul_div_cancel_left x h
  right_inv y := by simp [mul_div_cancel' _ h]
#align affine_homeomorph affineHomeomorph

end affineHomeomorph

section LocalExtr

variable {α β : Type _} [TopologicalSpace α] [LinearOrderedSemifield β] {a : α}

open Topology

theorem IsLocalMin.inv {f : α → β} {a : α} (h1 : IsLocalMin f a) (h2 : ∀ᶠ z in 𝓝 a, 0 < f z) :
    IsLocalMax f⁻¹ a := by
  filter_upwards [h1, h2]with z h3 h4 using(inv_le_inv h4 h2.self_of_nhds).mpr h3
#align is_local_min.inv IsLocalMin.inv

end LocalExtr

section Preconnected

/-! Some results about functions on preconnected sets valued in a ring or field with a topology. -/

open Set

variable {α 𝕜 : Type _} {f g : α → 𝕜} {S : Set α} [TopologicalSpace α] [TopologicalSpace 𝕜]
  [T1Space 𝕜]

/-- If `f` is a function `α → 𝕜` which is continuous on a preconnected set `S`, and
`f ^ 2 = 1` on `S`, then either `f = 1` on `S`, or `f = -1` on `S`. -/
theorem IsPreconnected.eq_one_or_eq_neg_one_of_sq_eq [Ring 𝕜] [NoZeroDivisors 𝕜]
    (hS : IsPreconnected S) (hf : ContinuousOn f S) (hsq : EqOn (f ^ 2) 1 S) :
    EqOn f 1 S ∨ EqOn f (-1) S := by
  have : DiscreteTopology ({1, -1} : Set 𝕜) := discrete_of_t1_of_finite
  have hmaps : MapsTo f S {1, -1}
  · simpa only [EqOn, Pi.one_apply, Pi.pow_apply, sq_eq_one_iff] using hsq
  simpa using hS.eqOn_const_of_mapsTo hf hmaps
#align is_preconnected.eq_one_or_eq_neg_one_of_sq_eq IsPreconnected.eq_one_or_eq_neg_one_of_sq_eq

/-- If `f, g` are functions `α → 𝕜`, both continuous on a preconnected set `S`, with
`f ^ 2 = g ^ 2` on `S`, and `g z ≠ 0` all `z ∈ S`, then either `f = g` or `f = -g` on
`S`. -/
theorem IsPreconnected.eq_or_eq_neg_of_sq_eq [Field 𝕜] [HasContinuousInv₀ 𝕜] [ContinuousMul 𝕜]
    (hS : IsPreconnected S) (hf : ContinuousOn f S) (hg : ContinuousOn g S)
    (hsq : EqOn (f ^ 2) (g ^ 2) S) (hg_ne : ∀ {x : α}, x ∈ S → g x ≠ 0) :
    EqOn f g S ∨ EqOn f (-g) S := by
  have hsq : EqOn ((f / g) ^ 2) 1 S := fun x hx => by
    simpa [div_eq_one_iff_eq (pow_ne_zero _ (hg_ne hx))] using hsq hx
  simpa (config := { contextual := true }) [EqOn, div_eq_iff (hg_ne _)]
    using hS.eq_one_or_eq_neg_one_of_sq_eq (hf.div hg fun z => hg_ne) hsq
#align is_preconnected.eq_or_eq_neg_of_sq_eq IsPreconnected.eq_or_eq_neg_of_sq_eq

/-- If `f, g` are functions `α → 𝕜`, both continuous on a preconnected set `S`, with
`f ^ 2 = g ^ 2` on `S`, and `g z ≠ 0` all `z ∈ S`, then as soon as `f = g` holds at
one point of `S` it holds for all points. -/
theorem IsPreconnected.eq_of_sq_eq [Field 𝕜] [HasContinuousInv₀ 𝕜] [ContinuousMul 𝕜]
    (hS : IsPreconnected S) (hf : ContinuousOn f S) (hg : ContinuousOn g S)
    (hsq : EqOn (f ^ 2) (g ^ 2) S) (hg_ne : ∀ {x : α}, x ∈ S → g x ≠ 0) {y : α} (hy : y ∈ S)
    (hy' : f y = g y) : EqOn f g S := fun x hx => by
  rcases hS.eq_or_eq_neg_of_sq_eq hf hg @hsq @hg_ne with (h | h)
  · exact h hx
  · rw [h _, Pi.neg_apply, neg_eq_iff_add_eq_zero, ← two_mul, mul_eq_zero,
      iff_false_iff.2 (hg_ne _)] at hy' ⊢ <;> assumption
#align is_preconnected.eq_of_sq_eq IsPreconnected.eq_of_sq_eq

end Preconnected


import system_of_complexes.basic
import rescale.normed_group
/-!

# rescaling norms on a system of complexes

This file defines the `rescale` functor which will take a system of complexes of seminormed groups
and systematically rescale all the norms on all the seminormed groups by a constant factor.

-/
noncomputable theory

universe variables u

open category_theory
open_locale nat nnreal

namespace nnreal

def MulLeft (κ : ℝ≥0) : ℝ≥0 ⥤ ℝ≥0 :=
{ obj := λ c, κ * c,
  map := λ c₁ c₂ h, hom_of_le $ mul_le_mul' le_rfl (le_of_hom h) }

def MulRight (κ : ℝ≥0) : ℝ≥0 ⥤ ℝ≥0 :=
{ obj := λ c, c * κ,
  map := λ c₁ c₂ h, hom_of_le $ mul_le_mul' (le_of_hom h) le_rfl }

end nnreal

namespace system_of_complexes

def rescale (r : ℝ≥0) [fact (0 < r)] : system_of_complexes.{u} ⥤ system_of_complexes.{u} :=
(whiskering_right _ _ _).obj $ (SemiNormedGroup.rescale r).map_homological_complex _

lemma rescale_obj (r c : ℝ≥0) [fact (0 < r)] (C : system_of_complexes) (i : ℕ) :
  ↥(((rescale r).obj C) c i) = _root_.rescale r (C c i) := rfl

lemma rescale_d (r c : ℝ≥0) [fact (0 < r)] (C : system_of_complexes) (i j : ℕ)
  (v : (((rescale r).obj C) c i)) :
  (((rescale r).obj C).d i j) v = @rescale.of r _ ((C.d i j) (((@rescale.of r _).symm) v)) :=
rfl

instance rescale.additive (r : ℝ≥0) [fact (0 < r)] : (rescale r).additive :=
{ map_add' := λ X Y f g, by { ext, refl } } -- a heavy refl
.

-- can we golf this? speed it up?
def to_rescale (r : ℝ≥0) [fact (0 < r)] : 𝟭 system_of_complexes ⟶ rescale r :=
{ app := λ C,
  { app := λ c,
    { f := λ _, (SemiNormedGroup.to_rescale r).app _,
      comm' := by { intros, exact ((SemiNormedGroup.to_rescale r).naturality _).symm } },
    naturality' := by { intros c₁ c₂ h, ext i : 2, refl } },
  naturality' := λ C₁ C₂ f, by { ext, refl } }
.

def scale (i j : ℝ≥0) [fact (0 < i)] [fact (0 < j)] : rescale i ⟶ rescale j :=
(whiskering_right _ _ _).map $ nat_trans.map_homological_complex (SemiNormedGroup.scale i j) _

section exact_and_admissible

variables {k K : ℝ≥0} [fact (1 ≤ k)] {m : ℕ} {c₀ : ℝ≥0}

lemma rescale_is_weak_bounded_exact (r : ℝ≥0) [hr : fact (0 < r)] (C : system_of_complexes)
  (hC : C.is_weak_bounded_exact k K m c₀) :
  ((rescale r).obj C).is_weak_bounded_exact k K m c₀ :=
begin
  intros c hc i hi x ε hε,
  obtain ⟨_, _, rfl, rfl, y, hy⟩ := hC c hc i hi ((@rescale.of r _).symm x) (ε * r) _,
  swap, { exact mul_pos hε hr.out },
  refine ⟨_, _, rfl, rfl, (@rescale.of r _) y, _⟩,
  erw [rescale.norm_def, rescale.norm_def],
  rwa [div_le_iff, add_mul, mul_assoc, div_mul_cancel],
  { apply ne_of_gt, exact hr.out },
  { exact hr.out },
end
.
/-- `rescale C` is admissible if `C` is. -/
lemma rescale_admissible (r : ℝ≥0) [fact (0 < r)] (C : system_of_complexes) (hC : C.admissible) :
  ((rescale r).obj C).admissible :=
{ d_norm_noninc' := begin
    rintro c i j h,
    rintro (v : _root_.rescale r (C c i)), -- rw rescale_obj gives motive issues
    rw [rescale_d, rescale.norm_def, rescale.norm_def, equiv.symm_apply_apply],
    refine div_le_div_of_le_of_nonneg _ _,
    { apply hC.d_norm_noninc' c i j h},
    { exact nnreal.coe_nonneg r },
  end,
  res_norm_noninc := λ c' c i h v, div_le_div_of_le_of_nonneg
    (hC.res_norm_noninc c' c i h _) (nnreal.coe_nonneg r) }

end exact_and_admissible

instance (m : ℕ) : fact (0 < m!) :=
⟨nat.factorial_pos _⟩

def rescale_functor : ℕ → (system_of_complexes ⥤ system_of_complexes)
| 0     := 𝟭 _
| 1     := 𝟭 _
| (m+2) := rescale (m+2)!

instance rescale_functor.additive : Π m, (rescale_functor m).additive
| 0     := functor.id.additive
| 1     := functor.id.additive
| (m+2) := show (rescale (m+2)!).additive, from rescale.additive _

def rescale_nat_trans : Π i j, rescale_functor i ⟶ rescale_functor j
| 0     1     := 𝟙 _
| 1     (j+2) := to_rescale (j+2)!
| (i+2) (j+2) := scale (i+2)! (j+2)!
| _     _     := 0

section scale_index

@[simps]
def ScaleIndexLeft (κ : ℝ≥0) : system_of_complexes ⥤ system_of_complexes :=
(whiskering_left _ _ _).obj (nnreal.MulLeft κ).op

@[simp] lemma ScaleIndexLeft_apply (C : system_of_complexes) (κ c : ℝ≥0) (i : ℕ) :
  (ScaleIndexLeft κ).obj C c i = C (κ * c) i := rfl

def scale_index_left (C : system_of_complexes) (κ : ℝ≥0) := (ScaleIndexLeft κ).obj C

lemma admissible.scale_index_left {C : system_of_complexes} (hC : C.admissible) (κ : ℝ≥0) :
  (C.scale_index_left κ).admissible :=
{ d_norm_noninc' := λ c i j hij, (by { apply admissible.d_norm_noninc C hC (κ * c) i j, }),
  res_norm_noninc := λ c₁ c₂ i hc, hC.res_norm_noninc _ _ i
    (by { resetI, dsimp, apply_instance }) }

lemma is_weak_bounded_exact.scale_index_left
  {C : system_of_complexes} {k K :ℝ≥0} {m : ℕ} (c₀ c₁: ℝ≥0) [fact (1 ≤ k)]
  (hC : C.is_weak_bounded_exact k K m c₀) (κ : ℝ≥0) [hκ : fact (c₀ ≤ κ * c₁)]
  (C_adm : C.admissible) :
  (C.scale_index_left κ).is_weak_bounded_exact k K m c₁ :=
begin
  intros c hc i hi x ε hε,
  dsimp [scale_index_left, ScaleIndexLeft_apply] at x,
  haveI aux1 : fact (k * (κ * c) ≤ κ * (k * c)) := ⟨(mul_left_comm _ _ _).le⟩,
  obtain ⟨i₀, j, hi₀, hj, y, hy⟩ := hC (κ * c) _ i hi (res x) ε hε,
  swap, { exact ⟨hκ.1.trans $ fact.out _⟩, },
  refine ⟨i₀, j, hi₀, hj, y, _⟩,
  simp only [res_res, d_res] at hy,
  refine hy.trans (add_le_add (mul_le_mul le_rfl _ (norm_nonneg _) K.coe_nonneg) le_rfl),
  apply C_adm.res_norm_noninc,
end

@[simps]
def ScaleIndexRight (κ : ℝ≥0) : system_of_complexes ⥤ system_of_complexes :=
(whiskering_left _ _ _).obj (nnreal.MulRight κ).op

@[simp] lemma ScaleIndexRight_apply (C : system_of_complexes) (κ c : ℝ≥0) (i : ℕ) :
  (ScaleIndexRight κ).obj C c i = C (c * κ) i := rfl

def scale_index_right (C : system_of_complexes) (κ : ℝ≥0) := (ScaleIndexRight κ).obj C

lemma admissible.scale_index_right {C : system_of_complexes} (hC : C.admissible) (κ : ℝ≥0) :
  (C.scale_index_right κ).admissible :=
{ d_norm_noninc' := λ c i j hij, (by { apply admissible.d_norm_noninc C hC (c * κ) i j, }),
  res_norm_noninc := λ c₁ c₂ i hc, hC.res_norm_noninc _ _ i
    (by { resetI, dsimp, apply_instance }) }

lemma is_weak_bounded_exact.scale_index_right
  {C : system_of_complexes} {k K :ℝ≥0} {m : ℕ} (c₀ c₁ : ℝ≥0) [fact (1 ≤ k)]
  (hC : C.is_weak_bounded_exact k K m c₀) (κ : ℝ≥0) [hκ : fact (c₀ ≤ κ * c₁)]
  (C_adm : C.admissible) :
  (C.scale_index_right κ).is_weak_bounded_exact k K m c₁ :=
begin
  intros c hc i hi x ε hε,
  dsimp [scale_index_right, ScaleIndexRight_apply] at x,
  haveI aux1 : fact (k * (c * κ) ≤ k * c * κ) := ⟨(mul_assoc _ _ _).ge⟩,
  obtain ⟨i₀, j, hi₀, hj, y, hy⟩ := hC (c * κ) _ i hi (res x) ε hε,
  swap, { rw mul_comm, exact ⟨hκ.1.trans $ fact.out _⟩, },
  refine ⟨i₀, j, hi₀, hj, y, _⟩,
  simp only [res_res, d_res] at hy,
  refine hy.trans (add_le_add (mul_le_mul le_rfl _ (norm_nonneg _) K.coe_nonneg) le_rfl),
  apply C_adm.res_norm_noninc,
end

end scale_index

end system_of_complexes

namespace thm95

def rescale_functor' : ℕ → ((ℝ≥0ᵒᵖ ⥤ SemiNormedGroup) ⥤ (ℝ≥0ᵒᵖ ⥤ SemiNormedGroup))
| 0     := 𝟭 _
| 1     := 𝟭 _
| (m+2) := (whiskering_right _ _ _).obj (SemiNormedGroup.rescale (m+2)!)

instance rescale_functor'.additive : Π m, (rescale_functor' m).additive
| 0     := functor.id.additive
| 1     := functor.id.additive
| (m+2) := {}

def to_rescale' (r : ℝ≥0) [fact (0 < r)] :
  𝟭 (ℝ≥0ᵒᵖ ⥤ SemiNormedGroup) ⟶ ((whiskering_right _ _ _).obj (SemiNormedGroup.rescale r)) :=
{ app := λ V,
  { app := λ c, (SemiNormedGroup.to_rescale r).app _,
    naturality' := by { intros c₁ c₂ h, dsimp, ext i : 2, refl } },
  naturality' := λ C₁ C₂ f, by { ext, refl } }

@[simps app]
def scale' (i j : ℝ≥0) [fact (0 < i)] [fact (0 < j)] :
  ((whiskering_right ℝ≥0ᵒᵖ _ _).obj (SemiNormedGroup.rescale i)) ⟶
  ((whiskering_right ℝ≥0ᵒᵖ _ _).obj (SemiNormedGroup.rescale j)) :=
(whiskering_right ℝ≥0ᵒᵖ _ _).map $ SemiNormedGroup.scale i j

def rescale_nat_trans' : Π i j, rescale_functor' i ⟶ rescale_functor' j
| 0     1     := 𝟙 _
| 1     (j+2) := to_rescale' (j+2)!
| (i+2) (j+2) := scale' (i+2)! (j+2)!
| _     _     := 0

end thm95


/-
Defines a normal ASP program and its three-valued semantics
-/

import primitives
import misc
import .complete_lattice.I
import order.fixed_points
open tv
open order_hom
open atom

structure Rule :=
  (head : atom)
  (pbody : list atom)
  (nbody : list atom)
def Program := list Rule

-- set_option trace.simplify.rewrite true

namespace Rule
  def eval_pbody (self : Rule) (i : I) : tv := tv.conj (i.eval self.pbody)
  def eval_nbody (self : Rule) (i : I) : tv := tv.conj (tv.negl (i.eval self.nbody))
  def eval_body (self : Rule) (i_pos i_neg : I) : tv := (self.eval_pbody i_pos) ⊓ (self.eval_nbody i_neg)
  def eval_head (self : Rule) (i : I) : tv := i self.head

  @[simp] def eval_pbody_monotone (r : Rule) : monotone r.eval_pbody := λ a b c, begin
    unfold Rule.eval_pbody,
    induction r.pbody, exact rfl.ge,
    unfold tv.conj at |- ih, unfold tv.inf at |- ih,
    rw [I.unfold_eval a, I.unfold_eval b],
    have t : ⊤ = vtrue := by { refl },
    have rd_a := tv.foldl_remove_default (a hd),
    have rd_b := tv.foldl_remove_default (b hd),
    rw t at rd_a rd_b, rw [rd_a, rd_b], rw [@tv.foldl_min_extract (a hd), @tv.foldl_min_extract (b hd)],
    exact min_le_min (c.p hd) ih,
  end

  def eval_body_monotone (r : Rule) (i_neg : I) : monotone (λ i_pos, r.eval_body i_pos i_neg) :=
      λ a b c, inf_le_inf (eval_pbody_monotone r c) (rfl.ge)

  def reduct_satisfied (r : Rule) (i_pos i_neg : I) : Prop := r.eval_body i_pos i_neg <= r.eval_head i_pos
  def satisfied (r : Rule) (i : I) := r.reduct_satisfied i i

end Rule

instance : has_mem Rule Program := ⟨@list.mem Rule⟩
namespace Program
  structure reduct_model (self : Program) (i_pos i_neg : I) : Prop :=
    (p : ∀r ∈ self, Rule.reduct_satisfied r i_pos i_neg)
  def model (self : Program) (i : I) := self.reduct_model i i
  structure stable_model (self : Program) (i : I) : Prop :=
    (m : self.model i)
    (p : ∀ii < i, ¬(self.reduct_model ii i))

  def atoms (p : Program) : set atom := {
    a : atom | ∃ (r : Rule) (m : r ∈ p), a = r.head ∨ a ∈ r.pbody ∨ a ∈ r.nbody
  }

  instance Program.has_subset : has_subset Program := list.has_subset

  lemma subset_atoms_subset (p : Program) {p' : Program} (ss : p ⊆ p') : p.atoms ⊆ p'.atoms := λ a amem, begin
    cases amem with r b, cases b with rmem,
    exact Exists.intro r (Exists.intro (ss rmem) b_h),
  end

  def atoms_list : Program -> list atom
  | [] := []
  | (r::tl) := (r.head::(r.pbody ++ r.nbody)) ++ (atoms_list tl)

  lemma atoms_atoms_list_mem_iff {p : Program} (a : atom) : a ∈ p.atoms ↔ a ∈ p.atoms_list := begin     split; assume h,     induction p,      cases h, cases h_h, change false at h_h_w,     contradiction,     cases h with r h2, cases h2 with r_mem acond,     cases r_mem,     unfold atoms_list,     cases acond,     rw [<-r_mem, acond],     exact list.mem_cons_self r.head ((r.pbody ++ r.nbody).append (atoms_list p_tl)),     cases acond; right; rw <-r_mem,     change a ∈ ((r.pbody ++ r.nbody) ++ (atoms_list p_tl)),     rw list.mem_append_eq, left, rw list.mem_append_eq, left,     exact acond,     change a ∈ ((r.pbody ++ r.nbody) ++ (atoms_list p_tl)),     rw list.mem_append_eq, left, rw list.mem_append_eq, right,     exact acond, right,     change a ∈ ((p_hd.pbody ++ p_hd.nbody) ++ (atoms_list p_tl)),     change r ∈ p_tl at r_mem,     rw list.mem_append_eq, right,     refine p_ih _,     exact Exists.intro r (Exists.intro r_mem acond),     induction p, change false at h, contradiction,     cases h,     refine Exists.intro p_hd (Exists.intro (list.mem_cons_self p_hd p_tl) _),     exact or.inl h,     change a ∈ ((p_hd.pbody ++ p_hd.nbody) ++ (atoms_list p_tl)) at h,     repeat {rw list.mem_append_eq at h},     repeat {cases h},     refine Exists.intro p_hd (Exists.intro (list.mem_cons_self p_hd p_tl) _),     right, left, exact h,     refine Exists.intro p_hd (Exists.intro (list.mem_cons_self p_hd p_tl) _),     right, right, exact h,     have h2 := p_ih h,     cases h2 with r h3, cases h3 with rmem acond,     have rmem2 : r ∈ p_hd :: p_tl := list.mem_of_mem_tail rmem,     exact Exists.intro r (Exists.intro rmem2 acond),   end

  instance program_atom_mem_decidable {p : Program} {a : atom} : decidable (a ∈ p.atoms) := begin
    rw (@atoms_atoms_list_mem_iff p a),
    exact @list.decidable_mem atom atom.decidable_eq a p.atoms_list
  end

  instance program_forall_atom_mem_decidable (p : Program) {prop : atom -> Prop} [decidable_pred prop] : decidable (∀ a ∈ p.atoms, prop a) := begin
    by_cases ∀ a ∈ p.atoms_list, prop a,
    apply decidable.is_true, intros a amem,
    exact h a ((atoms_atoms_list_mem_iff a).mp amem),
    apply decidable.is_false, simp at |- h, cases h with x,
    refine Exists.intro x (and.intro ((atoms_atoms_list_mem_iff x).mpr h_h.left) h_h.right),
  end

  instance program_exists_atom_mem_decidable (p : Program) {prop : atom -> Prop} [decidable_pred prop] : decidable (∃ a ∈ p.atoms, prop a) := begin
    by_cases ∀ a ∈ p.atoms, ¬prop a,
    apply decidable.is_false, simp, exact h,
    apply decidable.is_true, simp at h, exact bex_def.mpr h,
  end
end Program

def localize (p : Program) (i : I) : I := λ a, if a ∈ p.atoms then i a else vfalse
lemma localize.monotone {p : Program} : monotone $ localize p := λ _ _ c, I.less_than_or_equal.mk (λ a, by {unfold localize, split_ifs, exact c.p a, exact rfl.le})
def Program.localize (p : Program) : I →o I := ⟨localize p, localize.monotone⟩

def Program.I (p : Program) := { i : I // p.localize i = i }
@[reducible] noncomputable instance Program.I.complete_lattice {p : Program} : complete_lattice p.I := fixed_points.function.fixed_points.complete_lattice p.localize
lemma Program.localize_single_fixedpoint {p : Program} {i : I} : p.localize (p.localize i) = p.localize i := by {ext, unfold_coes, simp, unfold_coes, unfold Program.localize, simp, unfold localize, split_ifs, all_goals {refl}}
def Program.I.mk {p : Program} (i : I) : p.I := subtype.mk (p.localize i) Program.localize_single_fixedpoint
-- p.localize pi.val carries more info and may be more convenient.
-- Program.I.ext validates the correctness of this choice
instance {p : Program} : has_coe_to_fun p.I (λ _, I) := ⟨λ pi, p.localize pi.val⟩
@[ext] lemma Program.I.ext {p : Program} {i ii : p.I} : (∀ a : atom, i a = ii a) ↔ i = ii := begin
  have i_prop := i.prop, unfold_coes at i_prop,
  have ii_prop := ii.prop, unfold_coes at ii_prop,
  split; intro h, unfold_coes at h,
  rw [i_prop, ii_prop] at h,
  ext, unfold_coes, exact h x,
  intro a, unfold_coes,
  rw [function.funext_iff.mp i_prop a, function.funext_iff.mp ii_prop a],
  exact congr_fun (congr_arg subtype.val h) a,
end
lemma Program.I.not_mem_atom_vfalse {p : Program} {pi : p.I} {a : atom} (anmem : a ∉ p.atoms) : pi a = vfalse := by { unfold_coes, unfold Program.localize, simp, unfold localize, split_ifs, refl }

instance Program.has_subset : has_subset Program := list.has_subset

instance {p : Program} : decidable_eq p.I := begin
  intros i1 i2,
  by_cases ∀ a ∈ p.atoms, i1 a = i2 a,
  apply decidable.is_true,
  apply Program.I.ext.mp, intro a,
  by_cases h2 : a ∈ p.atoms, exact h a h2,
  repeat {rw Program.I.not_mem_atom_vfalse h2},
  apply decidable.is_false,
  simp at h, rw <-Program.I.ext, simp, cases h with c,
  exact Exists.intro c h_h.right,
end

def construct_all_interps {p : Program} : list p.I := sorry
def all_interps_complete {p : Program} (i : p.I) : i ∈ (@construct_all_interps p) := sorry

instance {p : Program} : fintype p.I := fintype.mk ((@construct_all_interps p).to_finset) (λ x, list.mem_to_finset.mpr (all_interps_complete x))

instance Program.I.has_compl {p : Program} : has_compl p.I := begin
  constructor, assume i, fconstructor,
  exact p.localize (λ x : atom, -(i x)),
  rw Program.localize_single_fixedpoint,
end

instance Program.I.is_complemented {p : Program} : is_complemented p.I := begin
  fconstructor, assume a,
  refine Exists.intro _ _,
  exact aᶜ,
  fconstructor,
  fconstructor, assume x,
end

-- def finset_interpretation {p.I} (fs : finset atom) : finset

-- #check [].to_finset

-- instance {p : Program} : fintype p.I := begin
--   let atoms_pow := p.atoms_list.to_finset.powerset,
--   have atoms_pow2 := p.atoms_list.to_finset.powerset,
--   have g := atoms_pow2.map (λ x, x),
--   let interps := finset.map (λ x : finset atom, x) atoms_pow,

--   refine fintype.mk _ _,
--   have h := p.atoms_list,
--   refine finset.mk _ _,
-- end

namespace Rule
  lemma atom_program_mem_pbody {p : Program} (r : Rule) (rmem : r ∈ p) (a : atom) : a ∈ r.pbody -> a ∈ p.atoms := λ h, begin
    refine Exists.intro r (Exists.intro rmem _),
    right, left, exact h,
  end
  lemma atom_program_mem_nbody {p : Program} (r : Rule) (rmem : r ∈ p) (a : atom) : a ∈ r.nbody -> a ∈ p.atoms := λ h, begin
    refine Exists.intro r (Exists.intro rmem _),
    right, right, exact h,
  end
end Rule


/-
https://leanprover.zulipchat.com/#narrow/stream/113489-new-members/topic/Redefine.20precedence.20of.20.60infix.60
-/
import tactic.localized
open tactic

universe u

namespace domain

class has_wedge (α : Type u) := (wedge : α → α → α)

localized "infix ∧:70 := has_wedge.wedge" in domain

end domain

namespace userland

open domain
open_locale domain

-- I'm being lazy here to define a dummy wedge
instance nat.to_has_wedge : has_wedge ℕ := {
  wedge := (*)
}

lemma dummy : 2 ∧ 3 = 6 := rfl

/-
failed to synthesize type class instance for
⊢ has_wedge Prop
-/
-- lemma dummy' : (2 ∧ 3 = 6) ∧ (2 ∧ 9 = 18) := sorry

end userland

-- \curlywedge ⋏
-- \curlyvee ⋎


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.elementwise
import category_theory.concrete_category.bundled_hom
import algebra.punit_instances
import category_theory.functor.reflects_isomorphisms

/-!
# Category instances for monoid, add_monoid, comm_monoid, and add_comm_monoid.

We introduce the bundled categories:
* `Mon`
* `AddMon`
* `CommMon`
* `AddCommMon`
along with the relevant forgetful functors between them.
-/

universes u v

open category_theory

/-- The category of monoids and monoid morphisms. -/
@[to_additive AddMon]
def Mon : Type (u+1) := bundled monoid

/-- The category of additive monoids and monoid morphisms. -/
add_decl_doc AddMon

namespace Mon

/-- `monoid_hom` doesn't actually assume associativity. This alias is needed to make the category
theory machinery work. -/
@[to_additive "`add_monoid_hom` doesn't actually assume associativity. This alias is needed to make
the category theory machinery work."]
abbreviation assoc_monoid_hom (M N : Type*) [monoid M] [monoid N] := monoid_hom M N

@[to_additive]
instance bundled_hom : bundled_hom assoc_monoid_hom :=
⟨λ M N [monoid M] [monoid N], by exactI @monoid_hom.to_fun M N _ _,
 λ M [monoid M], by exactI @monoid_hom.id M _,
 λ M N P [monoid M] [monoid N] [monoid P], by exactI @monoid_hom.comp M N P _ _ _,
 λ M N [monoid M] [monoid N], by exactI @monoid_hom.coe_inj M N _ _⟩

attribute [derive [large_category, concrete_category]] Mon
attribute [to_additive] Mon.large_category Mon.concrete_category

@[to_additive] instance : has_coe_to_sort Mon Type* := bundled.has_coe_to_sort

/-- Construct a bundled `Mon` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [monoid M] : Mon := bundled.of M

/-- Construct a bundled `Mon` from the underlying type and typeclass. -/
add_decl_doc AddMon.of

/-- Typecheck a `monoid_hom` as a morphism in `Mon`. -/
@[to_additive] def of_hom {X Y : Type u} [monoid X] [monoid Y] (f : X →* Y) :
  of X ⟶ of Y := f

/-- Typecheck a `add_monoid_hom` as a morphism in `AddMon`. -/
add_decl_doc AddMon.of_hom

@[simp] lemma of_hom_apply {X Y : Type u} [monoid X] [monoid Y] (f : X →* Y)
  (x : X) : of_hom f x = f x := rfl

@[to_additive]
instance : inhabited Mon :=
-- The default instance for `monoid punit` is derived via `punit.comm_ring`,
-- which breaks to_additive.
⟨@of punit $ @group.to_monoid _ $ @comm_group.to_group _ punit.comm_group⟩

@[to_additive]
instance (M : Mon) : monoid M := M.str

@[simp, to_additive] lemma coe_of (R : Type u) [monoid R] : (Mon.of R : Type u) = R := rfl

end Mon

/-- The category of commutative monoids and monoid morphisms. -/
@[to_additive AddCommMon]
def CommMon : Type (u+1) := bundled comm_monoid

/-- The category of additive commutative monoids and monoid morphisms. -/
add_decl_doc AddCommMon

namespace CommMon

@[to_additive]
instance : bundled_hom.parent_projection comm_monoid.to_monoid := ⟨⟩

attribute [derive [large_category, concrete_category]] CommMon
attribute [to_additive] CommMon.large_category CommMon.concrete_category

@[to_additive] instance : has_coe_to_sort CommMon Type* := bundled.has_coe_to_sort

/-- Construct a bundled `CommMon` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [comm_monoid M] : CommMon := bundled.of M

/-- Construct a bundled `AddCommMon` from the underlying type and typeclass. -/
add_decl_doc AddCommMon.of

@[to_additive]
instance : inhabited CommMon :=
-- The default instance for `comm_monoid punit` is derived via `punit.comm_ring`,
-- which breaks to_additive.
⟨@of punit $ @comm_group.to_comm_monoid _ punit.comm_group⟩

@[to_additive]
instance (M : CommMon) : comm_monoid M := M.str

@[simp, to_additive] lemma coe_of (R : Type u) [comm_monoid R] : (CommMon.of R : Type u) = R := rfl

@[to_additive has_forget_to_AddMon]
instance has_forget_to_Mon : has_forget₂ CommMon Mon := bundled_hom.forget₂ _ _

end CommMon

-- We verify that the coercions of morphisms to functions work correctly:
example {R S : Mon}     (f : R ⟶ S) : (R : Type) → (S : Type) := f
example {R S : CommMon} (f : R ⟶ S) : (R : Type) → (S : Type) := f

-- We verify that when constructing a morphism in `CommMon`,
-- when we construct the `to_fun` field, the types are presented as `↥R`,
-- rather than `R.α` or (as we used to have) `↥(bundled.map comm_monoid.to_monoid R)`.
example (R : CommMon.{u}) : R ⟶ R :=
{ to_fun := λ x,
  begin
    match_target (R : Type u),
    match_hyp x : (R : Type u),
    exact x * x
  end ,
  map_one' := by simp,
  map_mul' := λ x y,
  begin rw [mul_assoc x y (x * y), ←mul_assoc y x y, mul_comm y x, mul_assoc, mul_assoc], end, }

variables {X Y : Type u}

section
variables [monoid X] [monoid Y]

/-- Build an isomorphism in the category `Mon` from a `mul_equiv` between `monoid`s. -/
@[to_additive add_equiv.to_AddMon_iso "Build an isomorphism in the category `AddMon` from
an `add_equiv` between `add_monoid`s.", simps]
def mul_equiv.to_Mon_iso (e : X ≃* Y) : Mon.of X ≅ Mon.of Y :=
{ hom := e.to_monoid_hom,
  inv := e.symm.to_monoid_hom }

end

section
variables [comm_monoid X] [comm_monoid Y]

/-- Build an isomorphism in the category `CommMon` from a `mul_equiv` between `comm_monoid`s. -/
@[to_additive add_equiv.to_AddCommMon_iso "Build an isomorphism in the category `AddCommMon`
from an `add_equiv` between `add_comm_monoid`s.", simps]
def mul_equiv.to_CommMon_iso (e : X ≃* Y) : CommMon.of X ≅ CommMon.of Y :=
{ hom := e.to_monoid_hom,
  inv := e.symm.to_monoid_hom }

end

namespace category_theory.iso

/-- Build a `mul_equiv` from an isomorphism in the category `Mon`. -/
@[to_additive AddMon_iso_to_add_equiv "Build an `add_equiv` from an isomorphism in the category
`AddMon`."]
def Mon_iso_to_mul_equiv {X Y : Mon} (i : X ≅ Y) : X ≃* Y :=
i.hom.to_mul_equiv i.inv i.hom_inv_id i.inv_hom_id

/-- Build a `mul_equiv` from an isomorphism in the category `CommMon`. -/
@[to_additive "Build an `add_equiv` from an isomorphism in the category
`AddCommMon`."]
def CommMon_iso_to_mul_equiv {X Y : CommMon} (i : X ≅ Y) : X ≃* Y :=
i.hom.to_mul_equiv i.inv i.hom_inv_id i.inv_hom_id

end category_theory.iso

/-- multiplicative equivalences between `monoid`s are the same as (isomorphic to) isomorphisms
in `Mon` -/
@[to_additive add_equiv_iso_AddMon_iso "additive equivalences between `add_monoid`s are the same
as (isomorphic to) isomorphisms in `AddMon`"]
def mul_equiv_iso_Mon_iso {X Y : Type u} [monoid X] [monoid Y] :
  (X ≃* Y) ≅ (Mon.of X ≅ Mon.of Y) :=
{ hom := λ e, e.to_Mon_iso,
  inv := λ i, i.Mon_iso_to_mul_equiv, }

/-- multiplicative equivalences between `comm_monoid`s are the same as (isomorphic to) isomorphisms
in `CommMon` -/
@[to_additive add_equiv_iso_AddCommMon_iso "additive equivalences between `add_comm_monoid`s are
the same as (isomorphic to) isomorphisms in `AddCommMon`"]
def mul_equiv_iso_CommMon_iso {X Y : Type u} [comm_monoid X] [comm_monoid Y] :
  (X ≃* Y) ≅ (CommMon.of X ≅ CommMon.of Y) :=
{ hom := λ e, e.to_CommMon_iso,
  inv := λ i, i.CommMon_iso_to_mul_equiv, }

@[to_additive]
instance Mon.forget_reflects_isos : reflects_isomorphisms (forget Mon.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget Mon).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_Mon_iso).1⟩,
  end }

@[to_additive]
instance CommMon.forget_reflects_isos : reflects_isomorphisms (forget CommMon.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget CommMon).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_CommMon_iso).1⟩,
  end }

/-!
Once we've shown that the forgetful functors to type reflect isomorphisms,
we automatically obtain that the `forget₂` functors between our concrete categories
reflect isomorphisms.
-/
example : reflects_isomorphisms (forget₂ CommMon Mon) := by apply_instance