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

! This file was ported from Lean 3 source module ring_theory.non_unital_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 Mathbin.Algebra.Ring.Equiv
import Mathbin.Algebra.Ring.Prod
import Mathbin.Data.Set.Finite
import Mathbin.GroupTheory.Submonoid.Membership
import Mathbin.GroupTheory.Subsemigroup.Membership
import Mathbin.GroupTheory.Subsemigroup.Centralizer

/-!
# Bundled non-unital subsemirings

We define bundled non-unital subsemirings and some standard constructions:
`complete_lattice` structure, `subtype` and `inclusion` ring homomorphisms, non-unital subsemiring
`map`, `comap` and range (`srange`) of a `non_unital_ring_hom` etc.
-/

open BigOperators

universe u v w

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

/-- `non_unital_subsemiring_class S R` states that `S` is a type of subsets `s ⊆ R` that
are both an additive submonoid and also a multiplicative subsemigroup. -/
class NonUnitalSubsemiringClass (S : Type _) (R : Type u) [NonUnitalNonAssocSemiring R]
  [SetLike S R] extends AddSubmonoidClass S R where
  mul_mem : ∀ {s : S} {a b : R}, a ∈ s → b ∈ s → a * b ∈ s
#align non_unital_subsemiring_class NonUnitalSubsemiringClass

-- See note [lower instance priority]
instance (priority := 100) NonUnitalSubsemiringClass.mulMemClass (S : Type _) (R : Type u)
    [NonUnitalNonAssocSemiring R] [SetLike S R] [h : NonUnitalSubsemiringClass S R] :
    MulMemClass S R :=
  { h with }
#align non_unital_subsemiring_class.mul_mem_class NonUnitalSubsemiringClass.mulMemClass

namespace NonUnitalSubsemiringClass

variable [SetLike S R] [NonUnitalSubsemiringClass S R] (s : S)

include R S

open AddSubmonoidClass

/- Prefer subclasses of `non_unital_non_assoc_semiring` over subclasses of
`non_unital_subsemiring_class`. -/
/-- A non-unital subsemiring of a `non_unital_non_assoc_semiring` inherits a
`non_unital_non_assoc_semiring` structure -/
instance (priority := 75) toNonUnitalNonAssocSemiring : NonUnitalNonAssocSemiring s :=
  Subtype.coe_injective.NonUnitalNonAssocSemiring coe rfl (by simp) (fun _ _ => rfl) fun _ _ => rfl
#align non_unital_subsemiring_class.to_non_unital_non_assoc_semiring NonUnitalSubsemiringClass.toNonUnitalNonAssocSemiring

instance noZeroDivisors [NoZeroDivisors R] : NoZeroDivisors s :=
  Subtype.coe_injective.NoZeroDivisors coe rfl fun x y => rfl
#align non_unital_subsemiring_class.no_zero_divisors NonUnitalSubsemiringClass.noZeroDivisors

/-- The natural non-unital ring hom from a non-unital subsemiring of a non-unital semiring `R` to
`R`. -/
def subtype : s →ₙ+* R :=
  { AddSubmonoidClass.Subtype s, MulMemClass.subtype s with toFun := coe }
#align non_unital_subsemiring_class.subtype NonUnitalSubsemiringClass.subtype

@[simp]
theorem coeSubtype : (subtype s : s → R) = coe :=
  rfl
#align non_unital_subsemiring_class.coe_subtype NonUnitalSubsemiringClass.coeSubtype

omit R S

/-- A non-unital subsemiring of a `non_unital_semiring` is a `non_unital_semiring`. -/
instance toNonUnitalSemiring {R} [NonUnitalSemiring R] [SetLike S R]
    [NonUnitalSubsemiringClass S R] : NonUnitalSemiring s :=
  Subtype.coe_injective.NonUnitalSemiring coe rfl (by simp) (fun _ _ => rfl) fun _ _ => rfl
#align non_unital_subsemiring_class.to_non_unital_semiring NonUnitalSubsemiringClass.toNonUnitalSemiring

/-- A non-unital subsemiring of a `non_unital_comm_semiring` is a `non_unital_comm_semiring`. -/
instance toNonUnitalCommSemiring {R} [NonUnitalCommSemiring R] [SetLike S R]
    [NonUnitalSubsemiringClass S R] : NonUnitalCommSemiring s :=
  Subtype.coe_injective.NonUnitalCommSemiring coe rfl (by simp) (fun _ _ => rfl) fun _ _ => rfl
#align non_unital_subsemiring_class.to_non_unital_comm_semiring NonUnitalSubsemiringClass.toNonUnitalCommSemiring

/-! Note: currently, there are no ordered versions of non-unital rings. -/

end NonUnitalSubsemiringClass

variable [NonUnitalNonAssocSemiring S] [NonUnitalNonAssocSemiring T]

/-- A non-unital subsemiring of a non-unital semiring `R` is a subset `s` that is both an additive
submonoid and a semigroup. -/
structure NonUnitalSubsemiring (R : Type u) [NonUnitalNonAssocSemiring R] extends AddSubmonoid R,
  Subsemigroup R
#align non_unital_subsemiring NonUnitalSubsemiring

/-- Reinterpret a `non_unital_subsemiring` as a `subsemigroup`. -/
add_decl_doc NonUnitalSubsemiring.toSubsemigroup

/-- Reinterpret a `non_unital_subsemiring` as an `add_submonoid`. -/
add_decl_doc NonUnitalSubsemiring.toAddSubmonoid

namespace NonUnitalSubsemiring

instance : SetLike (NonUnitalSubsemiring R) R
    where
  coe := NonUnitalSubsemiring.carrier
  coe_injective' p q h := by cases p <;> cases q <;> congr

instance : NonUnitalSubsemiringClass (NonUnitalSubsemiring R) R
    where
  zero_mem := zero_mem'
  add_mem := add_mem'
  mul_mem := mul_mem'

@[simp]
theorem mem_carrier {s : NonUnitalSubsemiring R} {x : R} : x ∈ s.carrier ↔ x ∈ s :=
  Iff.rfl
#align non_unital_subsemiring.mem_carrier NonUnitalSubsemiring.mem_carrier

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

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

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

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

theorem toSubsemigroup_injective :
    Function.Injective (toSubsemigroup : NonUnitalSubsemiring R → Subsemigroup R)
  | r, s, h => ext (SetLike.ext_iff.mp h : _)
#align non_unital_subsemiring.to_subsemigroup_injective NonUnitalSubsemiring.toSubsemigroup_injective

@[mono]
theorem toSubsemigroup_strictMono :
    StrictMono (toSubsemigroup : NonUnitalSubsemiring R → Subsemigroup R) := fun _ _ => id
#align non_unital_subsemiring.to_subsemigroup_strict_mono NonUnitalSubsemiring.toSubsemigroup_strictMono

@[mono]
theorem toSubsemigroup_mono : Monotone (toSubsemigroup : NonUnitalSubsemiring R → Subsemigroup R) :=
  toSubsemigroup_strictMono.Monotone
#align non_unital_subsemiring.to_subsemigroup_mono NonUnitalSubsemiring.toSubsemigroup_mono

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

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

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

/-- Construct a `non_unital_subsemiring R` from a set `s`, a subsemigroup `sg`, and an additive
submonoid `sa` such that `x ∈ s ↔ x ∈ sg ↔ x ∈ sa`. -/
protected def mk' (s : Set R) (sg : Subsemigroup R) (hg : ↑sg = s) (sa : AddSubmonoid R)
    (ha : ↑sa = s) : NonUnitalSubsemiring R
    where
  carrier := s
  zero_mem' := ha ▸ sa.zero_mem
  add_mem' x y := by simpa only [← ha] using sa.add_mem
  mul_mem' x y := by simpa only [← hg] using sg.mul_mem
#align non_unital_subsemiring.mk' NonUnitalSubsemiring.mk'

@[simp]
theorem coe_mk' {s : Set R} {sg : Subsemigroup R} (hg : ↑sg = s) {sa : AddSubmonoid R}
    (ha : ↑sa = s) : (NonUnitalSubsemiring.mk' s sg hg sa ha : Set R) = s :=
  rfl
#align non_unital_subsemiring.coe_mk' NonUnitalSubsemiring.coe_mk'

@[simp]
theorem mem_mk' {s : Set R} {sg : Subsemigroup R} (hg : ↑sg = s) {sa : AddSubmonoid R}
    (ha : ↑sa = s) {x : R} : x ∈ NonUnitalSubsemiring.mk' s sg hg sa ha ↔ x ∈ s :=
  Iff.rfl
#align non_unital_subsemiring.mem_mk' NonUnitalSubsemiring.mem_mk'

@[simp]
theorem mk'_toSubsemigroup {s : Set R} {sg : Subsemigroup R} (hg : ↑sg = s) {sa : AddSubmonoid R}
    (ha : ↑sa = s) : (NonUnitalSubsemiring.mk' s sg hg sa ha).toSubsemigroup = sg :=
  SetLike.coe_injective hg.symm
#align non_unital_subsemiring.mk'_to_subsemigroup NonUnitalSubsemiring.mk'_toSubsemigroup

@[simp]
theorem mk'_toAddSubmonoid {s : Set R} {sg : Subsemigroup R} (hg : ↑sg = s) {sa : AddSubmonoid R}
    (ha : ↑sa = s) : (NonUnitalSubsemiring.mk' s sg hg sa ha).toAddSubmonoid = sa :=
  SetLike.coe_injective ha.symm
#align non_unital_subsemiring.mk'_to_add_submonoid NonUnitalSubsemiring.mk'_toAddSubmonoid

end NonUnitalSubsemiring

namespace NonUnitalSubsemiring

variable {F G : Type _} [NonUnitalRingHomClass F R S] [NonUnitalRingHomClass G S T]
  (s : NonUnitalSubsemiring R)

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

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

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

/-! Note: currently, there are no ordered versions of non-unital rings. -/

@[simp]
theorem mem_toSubsemigroup {s : NonUnitalSubsemiring R} {x : R} : x ∈ s.toSubsemigroup ↔ x ∈ s :=
  Iff.rfl
#align non_unital_subsemiring.mem_to_subsemigroup NonUnitalSubsemiring.mem_toSubsemigroup

@[simp]
theorem coe_toSubsemigroup (s : NonUnitalSubsemiring R) : (s.toSubsemigroup : Set R) = s :=
  rfl
#align non_unital_subsemiring.coe_to_subsemigroup NonUnitalSubsemiring.coe_toSubsemigroup

@[simp]
theorem mem_toAddSubmonoid {s : NonUnitalSubsemiring R} {x : R} : x ∈ s.toAddSubmonoid ↔ x ∈ s :=
  Iff.rfl
#align non_unital_subsemiring.mem_to_add_submonoid NonUnitalSubsemiring.mem_toAddSubmonoid

@[simp]
theorem coe_toAddSubmonoid (s : NonUnitalSubsemiring R) : (s.toAddSubmonoid : Set R) = s :=
  rfl
#align non_unital_subsemiring.coe_to_add_submonoid NonUnitalSubsemiring.coe_toAddSubmonoid

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

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

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

/-- The preimage of a non-unital subsemiring along a non-unital ring homomorphism is a
non-unital subsemiring. -/
def comap (f : F) (s : NonUnitalSubsemiring S) : NonUnitalSubsemiring R :=
  { s.toSubsemigroup.comap (f : MulHom R S), s.toAddSubmonoid.comap (f : R →+ S) with
    carrier := f ⁻¹' s }
#align non_unital_subsemiring.comap NonUnitalSubsemiring.comap

@[simp]
theorem coe_comap (s : NonUnitalSubsemiring S) (f : F) : (s.comap f : Set R) = f ⁻¹' s :=
  rfl
#align non_unital_subsemiring.coe_comap NonUnitalSubsemiring.coe_comap

@[simp]
theorem mem_comap {s : NonUnitalSubsemiring S} {f : F} {x : R} : x ∈ s.comap f ↔ f x ∈ s :=
  Iff.rfl
#align non_unital_subsemiring.mem_comap NonUnitalSubsemiring.mem_comap

-- this has some nasty coercions, how to deal with it?
theorem comap_comap (s : NonUnitalSubsemiring T) (g : G) (f : F) :
    ((s.comap g : NonUnitalSubsemiring S).comap f : NonUnitalSubsemiring R) =
      s.comap ((g : S →ₙ+* T).comp (f : R →ₙ+* S)) :=
  rfl
#align non_unital_subsemiring.comap_comap NonUnitalSubsemiring.comap_comap

/-- The image of a non-unital subsemiring along a ring homomorphism is a non-unital subsemiring. -/
def map (f : F) (s : NonUnitalSubsemiring R) : NonUnitalSubsemiring S :=
  { s.toSubsemigroup.map (f : R →ₙ* S), s.toAddSubmonoid.map (f : R →+ S) with carrier := f '' s }
#align non_unital_subsemiring.map NonUnitalSubsemiring.map

@[simp]
theorem coe_map (f : F) (s : NonUnitalSubsemiring R) : (s.map f : Set S) = f '' s :=
  rfl
#align non_unital_subsemiring.coe_map NonUnitalSubsemiring.coe_map

@[simp]
theorem mem_map {f : F} {s : NonUnitalSubsemiring R} {y : S} : y ∈ s.map f ↔ ∃ x ∈ s, f x = y :=
  Set.mem_image_iff_bex
#align non_unital_subsemiring.mem_map NonUnitalSubsemiring.mem_map

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

-- unavoidable coercions?
theorem map_map (g : G) (f : F) :
    (s.map (f : R →ₙ+* S)).map (g : S →ₙ+* T) = s.map ((g : S →ₙ+* T).comp (f : R →ₙ+* S)) :=
  SetLike.coe_injective <| Set.image_image _ _ _
#align non_unital_subsemiring.map_map NonUnitalSubsemiring.map_map

theorem map_le_iff_le_comap {f : F} {s : NonUnitalSubsemiring R} {t : NonUnitalSubsemiring S} :
    s.map f ≤ t ↔ s ≤ t.comap f :=
  Set.image_subset_iff
#align non_unital_subsemiring.map_le_iff_le_comap NonUnitalSubsemiring.map_le_iff_le_comap

theorem gc_map_comap (f : F) :
    @GaloisConnection (NonUnitalSubsemiring R) (NonUnitalSubsemiring S) _ _ (map f) (comap f) :=
  fun S T => map_le_iff_le_comap
#align non_unital_subsemiring.gc_map_comap NonUnitalSubsemiring.gc_map_comap

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

@[simp]
theorem coe_equivMapOfInjective_apply (f : F) (hf : Function.Injective f) (x : s) :
    (equivMapOfInjective s f hf x : S) = f x :=
  rfl
#align non_unital_subsemiring.coe_equiv_map_of_injective_apply NonUnitalSubsemiring.coe_equivMapOfInjective_apply

end NonUnitalSubsemiring

namespace NonUnitalRingHom

open NonUnitalSubsemiring

variable {F G : Type _} [NonUnitalRingHomClass F R S] [NonUnitalRingHomClass G S T] (f : F) (g : G)

/-- The range of a non-unital ring homomorphism is a non-unital subsemiring.
See note [range copy pattern]. -/
def srange : NonUnitalSubsemiring S :=
  ((⊤ : NonUnitalSubsemiring R).map (f : R →ₙ+* S)).copy (Set.range f) Set.image_univ.symm
#align non_unital_ring_hom.srange NonUnitalRingHom.srange

@[simp]
theorem coe_srange : (@srange R S _ _ _ _ f : Set S) = Set.range f :=
  rfl
#align non_unital_ring_hom.coe_srange NonUnitalRingHom.coe_srange

@[simp]
theorem mem_srange {f : F} {y : S} : y ∈ @srange R S _ _ _ _ f ↔ ∃ x, f x = y :=
  Iff.rfl
#align non_unital_ring_hom.mem_srange NonUnitalRingHom.mem_srange

theorem srange_eq_map : @srange R S _ _ _ _ f = (⊤ : NonUnitalSubsemiring R).map f :=
  by
  ext
  simp
#align non_unital_ring_hom.srange_eq_map NonUnitalRingHom.srange_eq_map

theorem mem_srange_self (f : F) (x : R) : f x ∈ @srange R S _ _ _ _ f :=
  mem_srange.mpr ⟨x, rfl⟩
#align non_unital_ring_hom.mem_srange_self NonUnitalRingHom.mem_srange_self

theorem map_srange (g : S →ₙ+* T) (f : R →ₙ+* S) : map g (srange f) = srange (g.comp f) := by
  simpa only [srange_eq_map] using (⊤ : NonUnitalSubsemiring R).map_map g f
#align non_unital_ring_hom.map_srange NonUnitalRingHom.map_srange

/-- The range of a morphism of non-unital semirings is finite if the domain is a finite. -/
instance finite_srange [Finite R] (f : F) : Finite (srange f : NonUnitalSubsemiring S) :=
  (Set.finite_range f).to_subtype
#align non_unital_ring_hom.finite_srange NonUnitalRingHom.finite_srange

end NonUnitalRingHom

namespace NonUnitalSubsemiring

-- should we define this as the range of the zero homomorphism?
instance : Bot (NonUnitalSubsemiring R) :=
  ⟨{  carrier := {0}
      add_mem' := fun _ _ _ _ => by simp_all
      zero_mem' := Set.mem_singleton 0
      mul_mem' := fun _ _ _ _ => by simp_all }⟩

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

theorem coe_bot : ((⊥ : NonUnitalSubsemiring R) : Set R) = {0} :=
  rfl
#align non_unital_subsemiring.coe_bot NonUnitalSubsemiring.coe_bot

theorem mem_bot {x : R} : x ∈ (⊥ : NonUnitalSubsemiring R) ↔ x = 0 :=
  Set.mem_singleton_iff
#align non_unital_subsemiring.mem_bot NonUnitalSubsemiring.mem_bot

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

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

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

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

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

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

@[simp]
theorem infₛ_toSubsemigroup (s : Set (NonUnitalSubsemiring R)) :
    (infₛ s).toSubsemigroup = ⨅ t ∈ s, NonUnitalSubsemiring.toSubsemigroup t :=
  mk'_toSubsemigroup _ _
#align non_unital_subsemiring.Inf_to_subsemigroup NonUnitalSubsemiring.infₛ_toSubsemigroup

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

/-- Non-unital subsemirings of a non-unital semiring form a complete lattice. -/
instance : CompleteLattice (NonUnitalSubsemiring R) :=
  {
    completeLatticeOfInf (NonUnitalSubsemiring R) fun s =>
      IsGLB.of_image (fun s t => show (s : Set R) ≤ t ↔ s ≤ t from SetLike.coe_subset_coe)
        isGLB_binfᵢ with
    bot := ⊥
    bot_le := fun s x hx => (mem_bot.mp hx).symm ▸ zero_mem s
    top := ⊤
    le_top := fun s x hx => trivial
    inf := (· ⊓ ·)
    inf_le_left := fun s t x => And.left
    inf_le_right := fun s t x => And.right
    le_inf := fun s t₁ t₂ h₁ h₂ x hx => ⟨h₁ hx, h₂ hx⟩ }

theorem eq_top_iff' (A : NonUnitalSubsemiring R) : A = ⊤ ↔ ∀ x : R, x ∈ A :=
  eq_top_iff.trans ⟨fun h m => h <| mem_top m, fun h m _ => h m⟩
#align non_unital_subsemiring.eq_top_iff' NonUnitalSubsemiring.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) [NonUnitalSemiring R] : NonUnitalSubsemiring R :=
  { Subsemigroup.center R with
    carrier := Set.center R
    zero_mem' := Set.zero_mem_center R
    add_mem' := fun a b => Set.add_mem_center }
#align non_unital_subsemiring.center NonUnitalSubsemiring.center

theorem coe_center (R) [NonUnitalSemiring R] : ↑(center R) = Set.center R :=
  rfl
#align non_unital_subsemiring.coe_center NonUnitalSubsemiring.coe_center

@[simp]
theorem center_toSubsemigroup (R) [NonUnitalSemiring R] :
    (center R).toSubsemigroup = Subsemigroup.center R :=
  rfl
#align non_unital_subsemiring.center_to_subsemigroup NonUnitalSubsemiring.center_toSubsemigroup

theorem mem_center_iff {R} [NonUnitalSemiring R] {z : R} : z ∈ center R ↔ ∀ g, g * z = z * g :=
  Iff.rfl
#align non_unital_subsemiring.mem_center_iff NonUnitalSubsemiring.mem_center_iff

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

@[simp]
theorem center_eq_top (R) [NonUnitalCommSemiring R] : center R = ⊤ :=
  SetLike.coe_injective (Set.center_eq_univ R)
#align non_unital_subsemiring.center_eq_top NonUnitalSubsemiring.center_eq_top

/-- The center is commutative. -/
instance {R} [NonUnitalSemiring R] : NonUnitalCommSemiring (center R) :=
  { Subsemigroup.center.commSemigroup,
    NonUnitalSubsemiringClass.toNonUnitalSemiring (center R) with }

end Center

section Centralizer

/-- The centralizer of a set as non-unital subsemiring. -/
def centralizer {R} [NonUnitalSemiring R] (s : Set R) : NonUnitalSubsemiring R :=
  { Subsemigroup.centralizer s with
    carrier := s.centralizer
    zero_mem' := Set.zero_mem_centralizer _
    add_mem' := fun x y hx hy => Set.add_mem_centralizer hx hy }
#align non_unital_subsemiring.centralizer NonUnitalSubsemiring.centralizer

@[simp, norm_cast]
theorem coe_centralizer {R} [NonUnitalSemiring R] (s : Set R) :
    (centralizer s : Set R) = s.centralizer :=
  rfl
#align non_unital_subsemiring.coe_centralizer NonUnitalSubsemiring.coe_centralizer

theorem centralizer_toSubsemigroup {R} [NonUnitalSemiring R] (s : Set R) :
    (centralizer s).toSubsemigroup = Subsemigroup.centralizer s :=
  rfl
#align non_unital_subsemiring.centralizer_to_subsemigroup NonUnitalSubsemiring.centralizer_toSubsemigroup

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

theorem centralizer_le {R} [NonUnitalSemiring R] (s t : Set R) (h : s ⊆ t) :
    centralizer t ≤ centralizer s :=
  Set.centralizer_subset h
#align non_unital_subsemiring.centralizer_le NonUnitalSubsemiring.centralizer_le

@[simp]
theorem centralizer_univ {R} [NonUnitalSemiring R] : centralizer Set.univ = center R :=
  SetLike.ext' (Set.centralizer_univ R)
#align non_unital_subsemiring.centralizer_univ NonUnitalSubsemiring.centralizer_univ

end Centralizer

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

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

/-- The non-unital subsemiring generated by a set includes the set. -/
@[simp]
theorem subset_closure {s : Set R} : s ⊆ closure s := fun x hx => mem_closure.2 fun S hS => hS hx
#align non_unital_subsemiring.subset_closure NonUnitalSubsemiring.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 non_unital_subsemiring.not_mem_of_not_mem_closure NonUnitalSubsemiring.not_mem_of_not_mem_closure

/-- A non-unital subsemiring `S` includes `closure s` if and only if it includes `s`. -/
@[simp]
theorem closure_le {s : Set R} {t : NonUnitalSubsemiring R} : closure s ≤ t ↔ s ⊆ t :=
  ⟨Set.Subset.trans subset_closure, fun h => infₛ_le h⟩
#align non_unital_subsemiring.closure_le NonUnitalSubsemiring.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 non_unital_subsemiring.closure_mono NonUnitalSubsemiring.closure_mono

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

theorem mem_map_equiv {f : R ≃+* S} {K : NonUnitalSubsemiring R} {x : S} :
    x ∈ K.map (f : R →ₙ+* S) ↔ f.symm x ∈ K :=
  @Set.mem_image_equiv _ _ (↑K) f.toEquiv x
#align non_unital_subsemiring.mem_map_equiv NonUnitalSubsemiring.mem_map_equiv

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

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

end NonUnitalSubsemiring

namespace Subsemigroup

/-- The additive closure of a non-unital subsemigroup is a non-unital subsemiring. -/
def nonUnitalSubsemiringClosure (M : Subsemigroup R) : NonUnitalSubsemiring R :=
  { AddSubmonoid.closure (M : Set R) with mul_mem' := fun x y => MulMemClass.mul_mem_add_closure }
#align subsemigroup.non_unital_subsemiring_closure Subsemigroup.nonUnitalSubsemiringClosure

theorem nonUnitalSubsemiringClosure_coe :
    (M.nonUnitalSubsemiringClosure : Set R) = AddSubmonoid.closure (M : Set R) :=
  rfl
#align subsemigroup.non_unital_subsemiring_closure_coe Subsemigroup.nonUnitalSubsemiringClosure_coe

theorem nonUnitalSubsemiringClosure_toAddSubmonoid :
    M.nonUnitalSubsemiringClosure.toAddSubmonoid = AddSubmonoid.closure (M : Set R) :=
  rfl
#align subsemigroup.non_unital_subsemiring_closure_to_add_submonoid Subsemigroup.nonUnitalSubsemiringClosure_toAddSubmonoid

/-- The `non_unital_subsemiring` generated by a multiplicative subsemigroup coincides with the
`non_unital_subsemiring.closure` of the subsemigroup itself . -/
theorem nonUnitalSubsemiringClosure_eq_closure :
    M.nonUnitalSubsemiringClosure = NonUnitalSubsemiring.closure (M : Set R) :=
  by
  ext
  refine'
        ⟨fun hx => _, fun hx =>
          (non_unital_subsemiring.mem_closure.mp hx) M.non_unital_subsemiring_closure fun s sM =>
            _⟩ <;>
      rintro - ⟨H1, rfl⟩ <;>
    rintro - ⟨H2, rfl⟩
  · exact add_submonoid.mem_closure.mp hx H1.to_add_submonoid H2
  · exact H2 sM
#align subsemigroup.non_unital_subsemiring_closure_eq_closure Subsemigroup.nonUnitalSubsemiringClosure_eq_closure

end Subsemigroup

namespace NonUnitalSubsemiring

@[simp]
theorem closure_subsemigroup_closure (s : Set R) : closure ↑(Subsemigroup.closure s) = closure s :=
  le_antisymm
    (closure_le.mpr fun y hy =>
      (Subsemigroup.mem_closure.mp hy) (closure s).toSubsemigroup subset_closure)
    (closure_mono Subsemigroup.subset_closure)
#align non_unital_subsemiring.closure_subsemigroup_closure NonUnitalSubsemiring.closure_subsemigroup_closure

/-- The elements of the non-unital subsemiring closure of `M` are exactly the elements of the
additive closure of a multiplicative subsemigroup `M`. -/
theorem coe_closure_eq (s : Set R) :
    (closure s : Set R) = AddSubmonoid.closure (Subsemigroup.closure s : Set R) := by
  simp [← Subsemigroup.nonUnitalSubsemiringClosure_toAddSubmonoid,
    Subsemigroup.nonUnitalSubsemiringClosure_eq_closure]
#align non_unital_subsemiring.coe_closure_eq NonUnitalSubsemiring.coe_closure_eq

theorem mem_closure_iff {s : Set R} {x} :
    x ∈ closure s ↔ x ∈ AddSubmonoid.closure (Subsemigroup.closure s : Set R) :=
  Set.ext_iff.mp (coe_closure_eq s) x
#align non_unital_subsemiring.mem_closure_iff NonUnitalSubsemiring.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' (add_submonoid.mem_closure.mp (mem_closure_iff.mp hx)) H.to_add_submonoid fun y hy => _
  refine' (subsemigroup.mem_closure.mp hy) H.to_subsemigroup fun z hz => _
  exact (add_submonoid.mem_closure.mp hz) H.to_add_submonoid fun w hw => J hw
#align non_unital_subsemiring.closure_add_submonoid_closure NonUnitalSubsemiring.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) (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, Hadd, H0, Hmul⟩).2 Hs h
#align non_unital_subsemiring.closure_induction NonUnitalSubsemiring.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) (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₁) (Hadd_right x₁) (Hmul_right x₁))
    (H0_left y) (fun z z' => Hadd_left z z' y) fun z z' => Hmul_left z z' y
#align non_unital_subsemiring.closure_induction₂ NonUnitalSubsemiring.closure_induction₂

variable (R)

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

variable {R} {F : Type _} [NonUnitalRingHomClass F R S]

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

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

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

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

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

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

theorem map_sup (s t : NonUnitalSubsemiring R) (f : F) :
    (map f (s ⊔ t) : NonUnitalSubsemiring S) = map f s ⊔ map f t :=
  @GaloisConnection.l_sup _ _ s t _ _ _ _ (gc_map_comap f)
#align non_unital_subsemiring.map_sup NonUnitalSubsemiring.map_sup

theorem map_supᵢ {ι : Sort _} (f : F) (s : ι → NonUnitalSubsemiring R) :
    (map f (supᵢ s) : NonUnitalSubsemiring S) = ⨆ i, map f (s i) :=
  @GaloisConnection.l_supᵢ _ _ _ _ _ _ _ (gc_map_comap f) s
#align non_unital_subsemiring.map_supr NonUnitalSubsemiring.map_supᵢ

theorem comap_inf (s t : NonUnitalSubsemiring S) (f : F) :
    (comap f (s ⊓ t) : NonUnitalSubsemiring R) = comap f s ⊓ comap f t :=
  @GaloisConnection.u_inf _ _ s t _ _ _ _ (gc_map_comap f)
#align non_unital_subsemiring.comap_inf NonUnitalSubsemiring.comap_inf

theorem comap_infᵢ {ι : Sort _} (f : F) (s : ι → NonUnitalSubsemiring S) :
    (comap f (infᵢ s) : NonUnitalSubsemiring R) = ⨅ i, comap f (s i) :=
  @GaloisConnection.u_infᵢ _ _ _ _ _ _ _ (gc_map_comap f) s
#align non_unital_subsemiring.comap_infi NonUnitalSubsemiring.comap_infᵢ

@[simp]
theorem map_bot (f : F) : map f (⊥ : NonUnitalSubsemiring R) = (⊥ : NonUnitalSubsemiring S) :=
  (gc_map_comap f).l_bot
#align non_unital_subsemiring.map_bot NonUnitalSubsemiring.map_bot

@[simp]
theorem comap_top (f : F) : comap f (⊤ : NonUnitalSubsemiring S) = (⊤ : NonUnitalSubsemiring R) :=
  (gc_map_comap f).u_top
#align non_unital_subsemiring.comap_top NonUnitalSubsemiring.comap_top

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Given `non_unital_subsemiring`s `s`, `t` of semirings `R`, `S` respectively, `s.prod t` is
`s × t` as a non-unital subsemiring of `R × S`. -/
def prod (s : NonUnitalSubsemiring R) (t : NonUnitalSubsemiring S) : NonUnitalSubsemiring (R × S) :=
  { s.toSubsemigroup.Prod t.toSubsemigroup, s.toAddSubmonoid.Prod t.toAddSubmonoid with
    carrier := (s : Set R) ×ˢ (t : Set S) }
#align non_unital_subsemiring.prod NonUnitalSubsemiring.prod

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[norm_cast]
theorem coe_prod (s : NonUnitalSubsemiring R) (t : NonUnitalSubsemiring S) :
    (s.Prod t : Set (R × S)) = (s : Set R) ×ˢ (t : Set S) :=
  rfl
#align non_unital_subsemiring.coe_prod NonUnitalSubsemiring.coe_prod

theorem mem_prod {s : NonUnitalSubsemiring R} {t : NonUnitalSubsemiring S} {p : R × S} :
    p ∈ s.Prod t ↔ p.1 ∈ s ∧ p.2 ∈ t :=
  Iff.rfl
#align non_unital_subsemiring.mem_prod NonUnitalSubsemiring.mem_prod

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

theorem prod_mono_right (s : NonUnitalSubsemiring R) :
    Monotone fun t : NonUnitalSubsemiring S => s.Prod t :=
  prod_mono (le_refl s)
#align non_unital_subsemiring.prod_mono_right NonUnitalSubsemiring.prod_mono_right

theorem prod_mono_left (t : NonUnitalSubsemiring S) :
    Monotone fun s : NonUnitalSubsemiring R => s.Prod t := fun s₁ s₂ hs => prod_mono hs (le_refl t)
#align non_unital_subsemiring.prod_mono_left NonUnitalSubsemiring.prod_mono_left

theorem prod_top (s : NonUnitalSubsemiring R) :
    s.Prod (⊤ : NonUnitalSubsemiring S) = s.comap (NonUnitalRingHom.fst R S) :=
  ext fun x => by simp [mem_prod, MonoidHom.coe_fst]
#align non_unital_subsemiring.prod_top NonUnitalSubsemiring.prod_top

theorem top_prod (s : NonUnitalSubsemiring S) :
    (⊤ : NonUnitalSubsemiring R).Prod s = s.comap (NonUnitalRingHom.snd R S) :=
  ext fun x => by simp [mem_prod, MonoidHom.coe_snd]
#align non_unital_subsemiring.top_prod NonUnitalSubsemiring.top_prod

@[simp]
theorem top_prod_top : (⊤ : NonUnitalSubsemiring R).Prod (⊤ : NonUnitalSubsemiring S) = ⊤ :=
  (top_prod _).trans <| comap_top _
#align non_unital_subsemiring.top_prod_top NonUnitalSubsemiring.top_prod_top

/-- Product of non-unital subsemirings is isomorphic to their product as semigroups. -/
def prodEquiv (s : NonUnitalSubsemiring R) (t : NonUnitalSubsemiring S) : s.Prod t ≃+* s × t :=
  { Equiv.Set.prod ↑s ↑t with
    map_mul' := fun x y => rfl
    map_add' := fun x y => rfl }
#align non_unital_subsemiring.prod_equiv NonUnitalSubsemiring.prodEquiv

theorem mem_supᵢ_of_directed {ι} [hι : Nonempty ι] {S : ι → NonUnitalSubsemiring 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 : NonUnitalSubsemiring R :=
    NonUnitalSubsemiring.mk' (⋃ i, (S i : Set R)) (⨆ i, (S i).toSubsemigroup)
      (Subsemigroup.coe_supᵢ_of_directed <| hS.mono_comp _ fun _ _ => id)
      (⨆ i, (S i).toAddSubmonoid)
      (AddSubmonoid.coe_supᵢ_of_directed <| hS.mono_comp _ fun _ _ => id)
  suffices (⨆ i, S i) ≤ U by simpa using @this x
  exact supᵢ_le fun i x hx => Set.mem_unionᵢ.2 ⟨i, hx⟩
#align non_unital_subsemiring.mem_supr_of_directed NonUnitalSubsemiring.mem_supᵢ_of_directed

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

theorem mem_supₛ_of_directedOn {S : Set (NonUnitalSubsemiring 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_supr_of_directed hS.directed_coe, SetCoe.exists, Subtype.coe_mk]
#align non_unital_subsemiring.mem_Sup_of_directed_on NonUnitalSubsemiring.mem_supₛ_of_directedOn

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

end NonUnitalSubsemiring

namespace NonUnitalRingHom

variable {F : Type _} [NonUnitalNonAssocSemiring T] [NonUnitalRingHomClass F R S]
  {s : NonUnitalSubsemiring R}

open NonUnitalSubsemiringClass NonUnitalSubsemiring

/-- Restriction of a non-unital ring homomorphism to a non-unital subsemiring of the codomain. -/
def codRestrict (f : F) (s : NonUnitalSubsemiring S) (h : ∀ x, f x ∈ s) : R →ₙ+* s :=
  { (f : R →ₙ* S).codRestrict s.toSubsemigroup h, (f : R →+ S).codRestrict s.toAddSubmonoid h with
    toFun := fun n => ⟨f n, h n⟩ }
#align non_unital_ring_hom.cod_restrict NonUnitalRingHom.codRestrict

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

This is the bundled version of `set.range_factorization`. -/
def srangeRestrict (f : F) : R →ₙ+* (srange f : NonUnitalSubsemiring S) :=
  codRestrict f (srange f) (mem_srange_self f)
#align non_unital_ring_hom.srange_restrict NonUnitalRingHom.srangeRestrict

@[simp]
theorem coe_srangeRestrict (f : F) (x : R) : (srangeRestrict f x : S) = f x :=
  rfl
#align non_unital_ring_hom.coe_srange_restrict NonUnitalRingHom.coe_srangeRestrict

theorem srangeRestrict_surjective (f : F) :
    Function.Surjective (srangeRestrict f : R → (srange f : NonUnitalSubsemiring S)) :=
  fun ⟨y, hy⟩ =>
  let ⟨x, hx⟩ := mem_srange.mp hy
  ⟨x, Subtype.ext hx⟩
#align non_unital_ring_hom.srange_restrict_surjective NonUnitalRingHom.srangeRestrict_surjective

theorem srange_top_iff_surjective {f : F} :
    srange f = (⊤ : NonUnitalSubsemiring S) ↔ Function.Surjective (f : R → S) :=
  SetLike.ext'_iff.trans <| Iff.trans (by rw [coe_srange, coe_top]) Set.range_iff_surjective
#align non_unital_ring_hom.srange_top_iff_surjective NonUnitalRingHom.srange_top_iff_surjective

/-- The range of a surjective non-unital ring homomorphism is the whole of the codomain. -/
theorem srange_top_of_surjective (f : F) (hf : Function.Surjective (f : R → S)) :
    srange f = (⊤ : NonUnitalSubsemiring S) :=
  srange_top_iff_surjective.2 hf
#align non_unital_ring_hom.srange_top_of_surjective NonUnitalRingHom.srange_top_of_surjective

/-- The non-unital subsemiring of elements `x : R` such that `f x = g x` -/
def eqSlocus (f g : F) : NonUnitalSubsemiring R :=
  { (f : R →ₙ* S).eqLocus (g : R →ₙ* S), (f : R →+ S).eqLocus g with carrier := { x | f x = g x } }
#align non_unital_ring_hom.eq_slocus NonUnitalRingHom.eqSlocus

/-- If two non-unital ring homomorphisms are equal on a set, then they are equal on its
non-unital subsemiring closure. -/
theorem eqOn_sclosure {f g : F} {s : Set R} (h : Set.EqOn (f : R → S) (g : R → S) s) :
    Set.EqOn f g (closure s) :=
  show closure s ≤ eqSlocus f g from closure_le.2 h
#align non_unital_ring_hom.eq_on_sclosure NonUnitalRingHom.eqOn_sclosure

theorem eq_of_eqOn_stop {f g : F}
    (h : Set.EqOn (f : R → S) (g : R → S) (⊤ : NonUnitalSubsemiring R)) : f = g :=
  FunLike.ext _ _ fun x => h trivial
#align non_unital_ring_hom.eq_of_eq_on_stop NonUnitalRingHom.eq_of_eqOn_stop

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

theorem sclosure_preimage_le (f : F) (s : Set S) :
    closure ((f : R → S) ⁻¹' s) ≤ (closure s).comap f :=
  closure_le.2 fun x hx => SetLike.mem_coe.2 <| mem_comap.2 <| subset_closure hx
#align non_unital_ring_hom.sclosure_preimage_le NonUnitalRingHom.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_sclosure (f : F) (s : Set R) : (closure s).map f = closure ((f : R → S) '' 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 non_unital_ring_hom.map_sclosure NonUnitalRingHom.map_sclosure

end NonUnitalRingHom

namespace NonUnitalSubsemiring

open NonUnitalRingHom NonUnitalSubsemiringClass

/-- The non-unital ring homomorphism associated to an inclusion of
non-unital subsemirings. -/
def inclusion {S T : NonUnitalSubsemiring R} (h : S ≤ T) : S →ₙ+* T :=
  codRestrict (Subtype S) _ fun x => h x.2
#align non_unital_subsemiring.inclusion NonUnitalSubsemiring.inclusion

@[simp]
theorem srange_subtype (s : NonUnitalSubsemiring R) : (Subtype s).srange = s :=
  SetLike.coe_injective <| (coe_srange _).trans Subtype.range_coe
#align non_unital_subsemiring.srange_subtype NonUnitalSubsemiring.srange_subtype

@[simp]
theorem range_fst : (fst R S).srange = ⊤ :=
  NonUnitalRingHom.srange_top_of_surjective (fst R S) Prod.fst_surjective
#align non_unital_subsemiring.range_fst NonUnitalSubsemiring.range_fst

@[simp]
theorem range_snd : (snd R S).srange = ⊤ :=
  NonUnitalRingHom.srange_top_of_surjective (snd R S) <| Prod.snd_surjective
#align non_unital_subsemiring.range_snd NonUnitalSubsemiring.range_snd

end NonUnitalSubsemiring

namespace RingEquiv

open NonUnitalRingHom NonUnitalSubsemiringClass

variable {s t : NonUnitalSubsemiring R}

variable {F : Type _} [NonUnitalRingHomClass F R S]

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

/-- Restrict a non-unital ring homomorphism with a left inverse to a ring isomorphism to its
`non_unital_ring_hom.srange`. -/
def sofLeftInverse' {g : S → R} {f : F} (h : Function.LeftInverse g f) : R ≃+* srange f :=
  { srangeRestrict f with
    toFun := srangeRestrict f
    invFun := fun x => g (Subtype (srange f) x)
    left_inv := h
    right_inv := fun x =>
      Subtype.ext <|
        let ⟨x', hx'⟩ := NonUnitalRingHom.mem_srange.mp x.Prop
        show f (g x) = x by rw [← hx', h x'] }
#align ring_equiv.sof_left_inverse' RingEquiv.sofLeftInverse'

@[simp]
theorem sofLeftInverse'_apply {g : S → R} {f : F} (h : Function.LeftInverse g f) (x : R) :
    ↑(sofLeftInverse' h x) = f x :=
  rfl
#align ring_equiv.sof_left_inverse'_apply RingEquiv.sofLeftInverse'_apply

@[simp]
theorem sofLeftInverse'_symm_apply {g : S → R} {f : F} (h : Function.LeftInverse g f)
    (x : srange f) : (sofLeftInverse' h).symm x = g x :=
  rfl
#align ring_equiv.sof_left_inverse'_symm_apply RingEquiv.sofLeftInverse'_symm_apply

/-- Given an equivalence `e : R ≃+* S` of non-unital semirings and a non-unital subsemiring
`s` of `R`, `non_unital_subsemiring_map e s` is the induced equivalence between `s` and
`s.map e` -/
@[simps]
def nonUnitalSubsemiringMap (e : R ≃+* S) (s : NonUnitalSubsemiring R) :
    s ≃+* NonUnitalSubsemiring.map e.toNonUnitalRingHom s :=
  { e.toAddEquiv.addSubmonoidMap s.toAddSubmonoid,
    e.toMulEquiv.subsemigroupMap s.toSubsemigroup with }
#align ring_equiv.non_unital_subsemiring_map RingEquiv.nonUnitalSubsemiringMap

end RingEquiv


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import data.zmod.basic
import ring_theory.witt_vector.compare
import nat_properties

/-!
# Properties of ℤ/nℤ

This file defines a topological structure (the discrete topology) on `zmod n` for all `n`.
We also enlist several properties that are helpful with modular arithmetic.

## Main definitions and theorems
 * `zmod.topological_space`
 * `proj_fst`, `proj_snd`, `inv_fst`, `inv_snd` : lemmas regarding CRT
 * `cast_hom_apply'` : a version of `cast_hom_apply` where `R` is explicit
 * `induced_top_cont_inv` : Inverse function on the units is continuous
 * `disc_top_units` : giving discrete topology to `units (zmod n)`

## Implementation notes
TODO (optional)

## References

## Tags
zmod
-/

/-- Making `zmod` a discrete topological space. -/
def zmod.topological_space (d : ℕ) : topological_space (zmod d) := ⊥

local attribute [instance] zmod.topological_space

variables {p : ℕ} {d : ℕ}
open zmod

lemma proj_fst' {m n : ℕ} (h : m.coprime n) (a : zmod m) (b : zmod n) :
  zmod.cast_hom (show m ∣ m * n, from dvd.intro n rfl) (zmod m)
    ((zmod.chinese_remainder h).symm (a,b)) = a :=
begin
  have h2 : zmod.cast_hom (show m.lcm n ∣ m * n, by simp [nat.lcm_dvd_iff]) (zmod m × zmod n) _ = _,
    exact (zmod.chinese_remainder h).right_inv (a,b),
  change _ = prod.fst (a, b),
  conv_rhs { rw ←h2, },
  convert_to _ = (ring_hom.comp (ring_hom.fst (zmod m) (zmod n))
    (zmod.cast_hom _ (zmod m × zmod n))) ((zmod.chinese_remainder h).inv_fun (a, b)) using 1,
  apply congr _ rfl, congr,
  refine ring_hom.ext_zmod _ _,
end

open padic_int

lemma proj_fst [fact p.prime] {n : ℕ} (x : zmod d × ℤ_[p]) (cop : d.coprime (p^n)) :
  ↑((zmod.chinese_remainder cop).symm (x.fst, (to_zmod_pow n) x.snd)) = x.fst := proj_fst' _ _ _

lemma proj_snd' {m n : ℕ} (h : m.coprime n) (a : zmod m) (b : zmod n) :
  zmod.cast_hom (show n ∣ m * n, from dvd.intro_left m rfl) (zmod n)
    ((zmod.chinese_remainder h).symm (a,b)) = b :=
begin
  have h2 : zmod.cast_hom (show m.lcm n ∣ m * n, by simp [nat.lcm_dvd_iff]) (zmod m × zmod n) _ = _,
    exact (zmod.chinese_remainder h).right_inv (a,b),
  change _ = prod.snd (a, b),
  conv_rhs { rw ←h2, },
  convert_to _ = (ring_hom.comp (ring_hom.snd (zmod m) (zmod n))
    (zmod.cast_hom _ (zmod m × zmod n))) ((zmod.chinese_remainder h).inv_fun (a, b)) using 1,
  apply congr _ rfl, congr,
  refine ring_hom.ext_zmod _ _,
end

lemma proj_snd [fact p.prime] {n : ℕ} (x : zmod d × ℤ_[p]) (cop : d.coprime (p^n)) :
  ↑((zmod.chinese_remainder cop).symm (x.fst, (to_zmod_pow n) x.snd)) =
  (to_zmod_pow n) x.snd :=
proj_snd' _ _ _

lemma inv_fst' {m n : ℕ} (x : zmod (m * n)) (cop : m.coprime n) :
  (((zmod.chinese_remainder cop).to_equiv) x).fst = (x : zmod m) :=
begin
  rw zmod.chinese_remainder,
  simp only [ring_equiv.to_equiv_eq_coe, ring_equiv.coe_to_equiv, ring_equiv.coe_mk,
    zmod.cast_hom_apply, prod.fst_zmod_cast],
end

lemma inv_fst {n : ℕ} (x : zmod (d * p^n)) (cop : d.coprime (p^n)) :
  (((zmod.chinese_remainder cop).to_equiv) x).fst = (x : zmod d) := inv_fst' x _

lemma inv_snd' {m n : ℕ} (x : zmod (m * n)) (cop : m.coprime n) :
  (((zmod.chinese_remainder cop).to_equiv) x).snd = (x : zmod n) :=
begin
  rw zmod.chinese_remainder,
  simp only [ring_equiv.to_equiv_eq_coe, ring_equiv.coe_to_equiv, ring_equiv.coe_mk,
    zmod.cast_hom_apply, prod.snd_zmod_cast],
end

lemma inv_snd {n : ℕ} (x : zmod (d * p^n)) (cop : d.coprime (p^n)) :
  (((zmod.chinese_remainder cop).to_equiv) x).snd = (x : zmod (p^n)) := inv_snd' _ _

lemma val_coe_val_le_val {n m : ℕ} [fact (0 < m)] (y : zmod n) : (y.val : zmod m).val ≤ y.val :=
begin
  by_cases y.val < m,
  { rw zmod.val_cast_of_lt h, },
  { push_neg at h,
    apply le_of_lt (gt_of_ge_of_gt h (zmod.val_lt (y.val : zmod m))), },
end

lemma val_coe_val_le_val' {n m : ℕ} [fact (0 < m)] [fact (0 < n)] (y : zmod n) :
  (y : zmod m).val ≤ y.val := (@zmod.nat_cast_val _ (zmod m) _ _ y) ▸ val_coe_val_le_val y

lemma coe_val_eq_val_of_lt {n m : ℕ} [fact (0 < n)] (h : n < m) (b : zmod n) :
  (b.val : zmod m).val = b.val :=
begin
  have h2 : b.val = (b : zmod m).val,
  { have h2 : b.val < m, { transitivity n, apply zmod.val_lt b, assumption, },
    rw ←zmod.val_cast_of_lt h2,
    refine congr_arg _ (zmod.nat_cast_val _), },
  conv_rhs { rw h2, },
  refine congr_arg _ _,
  rw zmod.nat_cast_val _,
  assumption,
end

namespace int
lemma eq_iff_succ_eq {a b : ℤ} : a = b ↔ a.succ = b.succ :=
⟨congr_arg (λ (a : ℤ), a.succ), λ h, (add_left_inj 1).1 h⟩

lemma nat_cast_coe_eq_coe_base : (nat.cast_coe : has_coe_t ℕ ℤ) = coe_base :=
begin
  rw [nat.cast_coe, coe_base],
  congr,
  ext,
  rw coe_b,
  induction x,
  { norm_num,
    change int.of_nat 0 = _, change int.of_nat 0 = (0 : ℤ),
    simp only [int.of_nat_eq_coe, int.coe_nat_zero], },
  { rw int.eq_iff_succ_eq at x_ih,
    convert x_ih, },
end
end int

namespace zmod
lemma nat_cast_val_to_int {n : ℕ} [fact (0 < n)] (a : zmod n) : (a.val : ℤ) = (a : ℤ) :=
begin
  rw ←nat_cast_val a,
  congr,
  rw int.nat_cast_coe_eq_coe_base,
end

lemma coe_int_add {n : ℕ} [fact (0 < n)] (a b : zmod n) :
  (((a + b) : zmod n) : ℤ) = (a + (b : ℤ)) % n :=
begin
  rw [←nat_cast_val_to_int, val_add],
  simp only [int.coe_nat_add, int.coe_nat_mod],
  apply _root_.congr_fun,
  refine congr_arg _ _,
  rw [←nat_cast_val_to_int, ←nat_cast_val_to_int],
end

open nat

lemma zero_le_div_and_div_lt_one {n : ℕ} [fact (0 < n)] (x : zmod n) :
  0 ≤ (x.val : ℚ) / n ∧ (x.val : ℚ) / n < 1 :=
⟨div_nonneg (cast_le.2 (nat.zero_le _)) (cast_le.2 (nat.zero_le _)), (div_lt_one
  begin refine cast_pos.2 (fact_iff.1 infer_instance), end).2 -- this does not work?
    (cast_lt.2 (zmod.val_lt _))⟩

lemma coe_add_eq_pos' {n : ℕ} {a b : zmod n} (h : (a + b : ℤ) < n) :
  (((a + b) : zmod n) : ℤ) = (a : ℤ) + (b : ℤ) :=
begin
  rw [zmod.coe_add_eq_ite, if_neg],
  push_neg, assumption,
end

lemma val_add_fin_mul_lt [fact p.prime] [fact (0 < d)] {m : ℕ} (a : zmod (d * p^m)) (x : fin p) :
  a.val + ↑x * (d * p ^ m) < d * p ^ m.succ :=
begin
  have h : ↑x * (d * p ^ m) ≤ (d * p ^ m) * (p - 1),
  { rw mul_comm,
    apply nat.mul_le_mul_left,
    rw [←nat.lt_succ_iff, nat.succ_eq_add_one, nat.sub_add_cancel
      (le_of_lt (fact_iff.1 (nat.prime.one_lt' p)))],
    apply x.2, },
  convert add_lt_add_of_lt_of_le (zmod.val_lt a) h,
  ring_nf,
  rw [nat.sub_add_cancel (le_of_lt (fact_iff.1 (nat.prime.one_lt' p))), ←pow_succ],
end

lemma nat_cast_zmod_cast_int {n a : ℕ} (h : a < n) : ((a : zmod n) : ℤ) = (a : ℤ) :=
begin
  by_cases h' : 0 < n,
  { rw ←zmod.nat_cast_val _,
    { apply congr (funext int.nat_cast_eq_coe_nat) (zmod.val_cast_of_lt h), },
    { apply fact_iff.2, assumption, }, },
  simp only [not_lt, _root_.le_zero_iff] at h',
  rw h',
  simp only [zmod.cast_id', id.def, int.nat_cast_eq_coe_nat],
end

lemma cast_val_eq_of_le {m n : ℕ} (y : fin m) (h : m ≤ n) : (y : zmod n).val = y :=
zmod.val_cast_of_lt (lt_of_lt_of_le (fin.is_lt y) h)

lemma fin_prime_coe_coe (m : ℕ) (y : fin p) :
  (y : zmod (d * p^m.succ)) = ((y : ℕ) : zmod (d * p^m.succ)) := coe_coe y

lemma fin_prime_mul_prime_pow_lt_mul_prime_pow_succ [fact p.prime] [fact (0 < d)] (y : fin p) (m : ℕ) :
  (y : ℕ) * (d * p ^ m) < d * p ^ m.succ :=
begin
  rw [pow_succ', ←mul_assoc d _ _, mul_comm (y : ℕ) _],
  apply mul_lt_mul' le_rfl y.prop (nat.zero_le _) (fact_iff.1 infer_instance),
  apply_instance,
end

lemma cast_int_one {n : ℕ} [fact (1 < n)] : ((1 : zmod n) : ℤ) = 1 :=
begin
  rw [←zmod.nat_cast_val _, zmod.val_one _],
  simp only [int.coe_nat_zero, int.coe_nat_succ, zero_add, int.nat_cast_eq_coe_nat],
  { assumption, },
  { apply fact_iff.2 (lt_trans zero_lt_one (fact.out _)),
    all_goals { apply_instance, }, },
end

lemma cast_eq_of_dvd {m n : ℕ} (h : m ∣ n) (a : zmod m) : ((a : zmod n) : zmod m) = a :=
begin
  conv_rhs { rw ←zmod.ring_hom_map_cast (zmod.cast_hom h (zmod m)) a, },
  rw zmod.cast_hom_apply,
end

lemma fract_eq_val {n : ℕ} [h : fact (0 < n)] (a : zmod n) :
  int.fract ((a : ℚ) / n) = (a.val : ℚ) / n :=
int.fract_eq_iff.2 ⟨div_nonneg (zmod.val a).cast_nonneg n.cast_nonneg,
  ⟨(div_lt_one ((@cast_pos ℚ _ _ _).2 (fact_iff.1 infer_instance))).2
  (cast_lt.2 (zmod.val_lt _)), ⟨0, by { rw [←zmod.nat_cast_val, sub_self, int.cast_zero], }⟩⟩⟩

/-- Same as `zmod.cast_hom_apply` with some hypotheses being made explicit. -/
lemma cast_hom_apply' {n : ℕ} (R : Type*) [_inst_1 : ring R] {m : ℕ} [_inst_2 : char_p R m]
  (h : m ∣ n) (i : zmod n) : (cast_hom h R) i = ↑i := cast_hom_apply i

lemma coe_map_of_dvd {a b : ℕ} (h : a ∣ b) (x : units (zmod b)) :
  is_unit (x : zmod a) :=
begin
  change is_unit ((x : zmod b) : zmod a),
  rw [←zmod.cast_hom_apply' (zmod a) h (x : zmod b), ←ring_hom.coe_monoid_hom, ←units.coe_map],
  apply units.is_unit,
end

lemma is_unit_of_is_coprime_dvd {a b : ℕ} (h : a ∣ b) {x : ℕ} (hx : x.coprime b) :
  is_unit (x : zmod a) :=
begin
  convert_to is_unit ((zmod.unit_of_coprime _ hx : zmod b) : zmod a),
  { rw ←cast_nat_cast h x,
    { congr, },
    { refine zmod.char_p _, }, },
    { apply coe_map_of_dvd h _, },
end

lemma is_unit_mul {a b g : ℕ} (n : ℕ) (h1 : g.coprime a) (h2 : g.coprime b) :
  is_unit (g : zmod (a * b^n)) :=
is_unit_of_is_coprime_dvd dvd_rfl ((coprime.mul_right h1 (coprime.pow_right _ h2)))

lemma cast_inv {a m n : ℕ} (ha : a.coprime n) (h : m ∣ n) :
  (((a : zmod n)⁻¹ : zmod n) : zmod m) = ((a : zmod n) : zmod m)⁻¹ :=
begin
  change ((((zmod.unit_of_coprime a ha)⁻¹ : units (zmod n)) : zmod n) : zmod m) = _,
  have h1 : ∀ c : (zmod m)ˣ, (c : zmod m)⁻¹ = ((c⁻¹ : units (zmod m)) : zmod m),
  { intro c, simp only [inv_coe_unit], },
  rw [← zmod.cast_hom_apply' (zmod m) h _, ← ring_hom.coe_monoid_hom,
    ← units.coe_map_inv _ (zmod.unit_of_coprime a ha), ← h1],
  congr,
end

lemma fract_eq_of_zmod_eq {n a b : ℕ} [fact (0 < n)] (h : (a : zmod n) = (b : zmod n)) :
  int.fract (a / n : ℚ) = int.fract (b / n : ℚ) :=
begin
  rw [int.fract_eq_fract, div_sub_div_same],
  obtain ⟨z, hz⟩ := dvd_sub_comm _ _ _ (modeq_iff_dvd.1 ((eq_iff_modeq_nat _).1 h)),
  refine ⟨z, _⟩,
  have h : ∀ z : ℕ, (z : ℚ) = ((z : ℤ) : ℚ),
  { intro z, norm_cast, },
  rw [h a, h b, ← int.cast_sub, hz, int.cast_mul, ← h n, mul_comm, mul_div_cancel],
  norm_cast,
  apply ne_of_gt (fact.out _),
  any_goals { apply_instance, },
end

lemma dvd_val_sub_cast_val {m : ℕ} (n : ℕ) [fact (0 < m)] [fact (0 < n)] (a : zmod m) :
  n ∣ a.val - (a : zmod n).val :=
begin
  have : (a.val : zmod n) = ((a : zmod n).val : zmod n),
  { rw [nat_cast_val, nat_cast_val], norm_cast, },
  exact (dvd_iff_mod_eq_zero _ _).2 (sub_mod_eq_zero_of_mod_eq ((eq_iff_modeq_nat _).1 this)),
end

instance {p : ℕ} [fact (nat.prime p)] [fact (2 < p)] : nontrivial (units (zmod p)) :=
fintype.one_lt_card_iff_nontrivial.mp ((zmod.card_units p).symm ▸ lt_tsub_iff_right.mpr (fact.out _))

@[continuity]
lemma induced_top_cont_inv {n : ℕ} : @continuous _ _ (topological_space.induced
  (units.coe_hom (zmod n)) infer_instance) _ (units.inv : (zmod n)ˣ → zmod n) :=
by { convert continuous_of_discrete_topology,
  refine discrete_topology_induced (λ a b h, units.eq_iff.1 h), }

instance {α : Type*} [_root_.topological_space α] : _root_.topological_space αᵒᵖ :=
topological_space.induced opposite.unop infer_instance

instance {α : Type*} [_root_.topological_space α] [discrete_topology α] : discrete_topology αᵒᵖ :=
discrete_topology_induced opposite.unop_injective

instance {α : Type*} [_root_.topological_space α] [discrete_topology α] : discrete_topology αᵐᵒᵖ :=
discrete_topology_induced mul_opposite.unop_injective

instance {k : ℕ} : discrete_topology (units (zmod k)) :=
begin
  convert @discrete_topology_induced _ _ _ _ _ (units.embed_product_injective _),
  apply @prod.discrete_topology _ _ infer_instance infer_instance infer_instance infer_instance,
  swap, apply discrete_topology_induced mul_opposite.unop_injective,
  any_goals { apply_instance, },
end

instance disc_top_units {m n : ℕ} : discrete_topology (units (zmod m × zmod n)) :=
begin
  apply discrete_topology_induced (λ x y h, _),
  { apply prod.discrete_topology, },
  { rw units.embed_product at h,
    simp only [prod.mk.inj_iff, opposite.op_inj_iff, monoid_hom.coe_mk] at h,
    rw [units.ext_iff, h.1], },
end

@[simp]
lemma cast_hom_self {n : ℕ} : zmod.cast_hom dvd_rfl (zmod n) = ring_hom.id (zmod n) := by simp

@[simp]
lemma cast_hom_comp {n m d : ℕ} (hm : n ∣ m) (hd : m ∣ d) :
  (zmod.cast_hom hm (zmod n)).comp (zmod.cast_hom hd (zmod m)) = zmod.cast_hom (dvd_trans hm hd) (zmod n) :=
ring_hom.ext_zmod _ _

lemma val_le_self (a n : ℕ) : (a : zmod n).val ≤ a :=
begin
  cases n,
  { simp only [int.nat_cast_eq_coe_nat], refl, },
  { by_cases a < n.succ,
    rw zmod.val_cast_of_lt h,
    apply le_trans (zmod.val_le _) _,
    { apply succ_pos'' _, },
    { apply le_of_not_gt h, }, },
end

--`not_is_unit_of_not_coprime` changed to `zmod.coprime_of_is_unit`
lemma coprime_of_is_unit {m a : ℕ} (ha : is_unit (a : zmod m)) : nat.coprime a m :=
begin
  have f := zmod.val_coe_unit_coprime (is_unit.unit ha),
  rw is_unit.unit_spec at f,
  have : m ∣ (a - (a : zmod m).val),
  { rw ← zmod.nat_coe_zmod_eq_zero_iff_dvd,
    rw nat.cast_sub (zmod.val_le_self _ _),
    rw sub_eq_zero,
    cases m,
    { simp only [int.coe_nat_inj', int.nat_cast_eq_coe_nat], refl, },
    { rw zmod.nat_cast_val, simp only [zmod.cast_nat_cast'], }, },
  cases this with y hy,
  rw nat.sub_eq_iff_eq_add _ at hy,
  { rw hy, rw add_comm, rw ← nat.is_coprime_iff_coprime,
    simp only [int.coe_nat_add, int.coe_nat_mul],
    rw is_coprime.add_mul_left_left_iff,
    rw nat.is_coprime_iff_coprime,
    convert zmod.val_coe_unit_coprime (is_unit.unit ha), },
  { apply zmod.val_le_self, },
end

lemma cast_nat_eq_zero_of_dvd {m : ℕ} {n : ℕ} (h : m ∣ n) : (n : zmod m) = 0 :=
begin
  rw [←zmod.cast_nat_cast h, zmod.nat_cast_self, zmod.cast_zero],
  refine zmod.char_p _,
end

instance units_fintype (n : ℕ) : fintype (zmod n)ˣ :=
begin
  by_cases n = 0,
  { rw h, refine units_int.fintype, },
  { haveI : fact (0 < n),
    { apply fact_iff.2, apply nat.pos_of_ne_zero h, },
    apply_instance, },
end

variable (p)
lemma proj_fst'' {n : ℕ} (hd : d.coprime p) (a : (zmod d)ˣ × (zmod (p^n))ˣ) :
((zmod.chinese_remainder (nat.coprime.pow_right n hd)).inv_fun (↑(a.fst), ↑(a.snd)) : zmod d) = a.fst :=
by { rw ring_equiv.inv_fun_eq_symm, apply proj_fst', }

lemma proj_snd'' [fact p.prime] {n : ℕ} (hd : d.coprime p) (a : (zmod d)ˣ × (zmod (p^n))ˣ) :
(padic_int.to_zmod_pow n) ((zmod.chinese_remainder (nat.coprime.pow_right n hd)).inv_fun (↑(a.fst), ↑(a.snd)) : ℤ_[p]) = a.snd :=
begin
  rw ← zmod.int_cast_cast,
  rw ring_hom.map_int_cast,
  rw zmod.int_cast_cast, rw ring_equiv.inv_fun_eq_symm, convert proj_snd' _ _ _,
end

lemma is_unit_of_is_unit_mul {m n : ℕ} (x : ℕ) (hx : is_unit (x : zmod (m * n))) :
  is_unit (x : zmod m) :=
begin
  rw is_unit_iff_dvd_one at *,
  cases hx with k hk,
  refine ⟨(k : zmod m), _⟩,
  rw ← zmod.cast_nat_cast (dvd_mul_right m n),
  rw ← zmod.cast_mul (dvd_mul_right m n),
  rw ← hk, rw zmod.cast_one (dvd_mul_right m n),
  any_goals { refine zmod.char_p _, },
end

lemma is_unit_of_is_unit_mul' {m n : ℕ} (x : ℕ) (hx : is_unit (x : zmod (m * n))) :
  is_unit (x : zmod n) :=
begin
  rw mul_comm at hx,
  apply is_unit_of_is_unit_mul x hx,
end

open zmod
lemma is_unit_of_is_unit_mul_iff {m n : ℕ} (x : ℕ) : is_unit (x : zmod (m * n)) ↔
  is_unit (x : zmod m) ∧ is_unit (x : zmod n) :=
  ⟨λ h, ⟨is_unit_of_is_unit_mul x h, is_unit_of_is_unit_mul' x h⟩,
  begin
    rintros ⟨h1, h2⟩,
    apply units.is_unit (zmod.unit_of_coprime x (nat.coprime.mul_right
      (coprime_of_is_unit h1) (coprime_of_is_unit h2))),
  end ⟩ -- solve_by_elim gives a funny error

lemma not_is_unit_of_not_is_unit_mul {m n x : ℕ} (hx : ¬ is_unit (x : zmod (m * n))) :
  ¬ is_unit (x : zmod m) ∨ ¬ is_unit (x : zmod n) :=
begin
  rw ← not_and_distrib,
  contrapose hx,
  rw not_not at *,
  rw is_unit_of_is_unit_mul_iff, refine ⟨hx.1, hx.2⟩,
end

lemma not_is_unit_of_not_is_unit_mul' {m n : ℕ} [fact (0 < m * n)] (x : zmod (m * n))
  (hx : ¬ is_unit x) : ¬ is_unit (x : zmod m) ∨ ¬ is_unit (x : zmod n) :=
begin
  rw ← zmod.cast_id _ x at hx,
  rw ← zmod.nat_cast_val at hx,
  rw ← zmod.nat_cast_val, rw ← zmod.nat_cast_val,
  apply not_is_unit_of_not_is_unit_mul hx,
end

lemma is_unit_val_of_unit {n k : ℕ} [fact (0 < n)] (hk : k ∣ n) (u : (zmod n)ˣ) :
  is_unit ((u : zmod n).val : zmod k) :=
by { apply zmod.is_unit_of_is_coprime_dvd hk, --rw nat.is_coprime_iff_coprime,
  apply coprime_of_is_unit,
  rw zmod.nat_cast_val, rw zmod.cast_id, apply units.is_unit _, }

lemma unit_ne_zero {n : ℕ} [fact (1 < n)] (a : (zmod n)ˣ) : (a : zmod n).val ≠ 0 :=
begin
  intro h,
  rw zmod.val_eq_zero at h,
  have : is_unit (0 : zmod n),
  { rw ← h, simp, },
  rw is_unit_zero_iff at this,
  apply @zero_ne_one _ _ _,
  rw this,
  apply zmod.nontrivial,
end

lemma inv_is_unit_of_is_unit {n : ℕ} {u : zmod n} (h : is_unit u) : is_unit u⁻¹ :=
begin
  have h' := is_unit_iff_dvd_one.1 h,
  cases h' with k h',
  rw is_unit_iff_dvd_one,
  refine ⟨u, _⟩,
  rw zmod.inv_mul_of_unit u h,
end
end zmod


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash

! This file was ported from Lean 3 source module analysis.normed_space.continuous_affine_map
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.ContinuousAffineMap
import Mathbin.Analysis.NormedSpace.AffineIsometry
import Mathbin.Analysis.NormedSpace.OperatorNorm

/-!
# Continuous affine maps between normed spaces.

This file develops the theory of continuous affine maps between affine spaces modelled on normed
spaces.

In the particular case that the affine spaces are just normed vector spaces `V`, `W`, we define a
norm on the space of continuous affine maps by defining the norm of `f : V →A[𝕜] W` to be
`‖f‖ = max ‖f 0‖ ‖f.cont_linear‖`. This is chosen so that we have a linear isometry:
`(V →A[𝕜] W) ≃ₗᵢ[𝕜] W × (V →L[𝕜] W)`.

The abstract picture is that for an affine space `P` modelled on a vector space `V`, together with
a vector space `W`, there is an exact sequence of `𝕜`-modules: `0 → C → A → L → 0` where `C`, `A`
are the spaces of constant and affine maps `P → W` and `L` is the space of linear maps `V → W`.

Any choice of a base point in `P` corresponds to a splitting of this sequence so in particular if we
take `P = V`, using `0 : V` as the base point provides a splitting, and we prove this is an
isometric decomposition.

On the other hand, choosing a base point breaks the affine invariance so the norm fails to be
submultiplicative: for a composition of maps, we have only `‖f.comp g‖ ≤ ‖f‖ * ‖g‖ + ‖f 0‖`.

## Main definitions:

 * `continuous_affine_map.cont_linear`
 * `continuous_affine_map.has_norm`
 * `continuous_affine_map.norm_comp_le`
 * `continuous_affine_map.to_const_prod_continuous_linear_map`

-/

namespace ContinuousAffineMap

variable {𝕜 R V W W₂ P Q Q₂ : Type _}

variable [NormedAddCommGroup V] [MetricSpace P] [NormedAddTorsor V P]

variable [NormedAddCommGroup W] [MetricSpace Q] [NormedAddTorsor W Q]

variable [NormedAddCommGroup W₂] [MetricSpace Q₂] [NormedAddTorsor W₂ Q₂]

variable [NormedField R] [NormedSpace R V] [NormedSpace R W] [NormedSpace R W₂]

variable [NontriviallyNormedField 𝕜] [NormedSpace 𝕜 V] [NormedSpace 𝕜 W] [NormedSpace 𝕜 W₂]

include V W

/-- The linear map underlying a continuous affine map is continuous. -/
def contLinear (f : P →A[R] Q) : V →L[R] W :=
  { f.linear with
    toFun := f.linear
    cont := by
      rw [AffineMap.continuous_linear_iff]
      exact f.cont }
#align continuous_affine_map.cont_linear ContinuousAffineMap.contLinear

@[simp]
theorem coe_contLinear (f : P →A[R] Q) : (f.contLinear : V → W) = f.linear :=
  rfl
#align continuous_affine_map.coe_cont_linear ContinuousAffineMap.coe_contLinear

@[simp]
theorem coe_contLinear_eq_linear (f : P →A[R] Q) :
    (f.contLinear : V →ₗ[R] W) = (f : P →ᵃ[R] Q).linear :=
  by
  ext
  rfl
#align continuous_affine_map.coe_cont_linear_eq_linear ContinuousAffineMap.coe_contLinear_eq_linear

@[simp]
theorem coe_mk_const_linear_eq_linear (f : P →ᵃ[R] Q) (h) :
    ((⟨f, h⟩ : P →A[R] Q).contLinear : V → W) = f.linear :=
  rfl
#align continuous_affine_map.coe_mk_const_linear_eq_linear ContinuousAffineMap.coe_mk_const_linear_eq_linear

theorem coe_linear_eq_coe_contLinear (f : P →A[R] Q) :
    ((f : P →ᵃ[R] Q).linear : V → W) = (⇑f.contLinear : V → W) :=
  rfl
#align continuous_affine_map.coe_linear_eq_coe_cont_linear ContinuousAffineMap.coe_linear_eq_coe_contLinear

include W₂

@[simp]
theorem comp_contLinear (f : P →A[R] Q) (g : Q →A[R] Q₂) :
    (g.comp f).contLinear = g.contLinear.comp f.contLinear :=
  rfl
#align continuous_affine_map.comp_cont_linear ContinuousAffineMap.comp_contLinear

omit W₂

@[simp]
theorem map_vadd (f : P →A[R] Q) (p : P) (v : V) : f (v +ᵥ p) = f.contLinear v +ᵥ f p :=
  f.map_vadd' p v
#align continuous_affine_map.map_vadd ContinuousAffineMap.map_vadd

@[simp]
theorem contLinear_map_vsub (f : P →A[R] Q) (p₁ p₂ : P) : f.contLinear (p₁ -ᵥ p₂) = f p₁ -ᵥ f p₂ :=
  f.toAffineMap.linearMap_vsub p₁ p₂
#align continuous_affine_map.cont_linear_map_vsub ContinuousAffineMap.contLinear_map_vsub

@[simp]
theorem const_contLinear (q : Q) : (const R P q).contLinear = 0 :=
  rfl
#align continuous_affine_map.const_cont_linear ContinuousAffineMap.const_contLinear

theorem contLinear_eq_zero_iff_exists_const (f : P →A[R] Q) :
    f.contLinear = 0 ↔ ∃ q, f = const R P q :=
  by
  have h₁ : f.cont_linear = 0 ↔ (f : P →ᵃ[R] Q).linear = 0 :=
    by
    refine' ⟨fun h => _, fun h => _⟩ <;> ext
    · rw [← coe_cont_linear_eq_linear, h]
      rfl
    · rw [← coe_linear_eq_coe_cont_linear, h]
      rfl
  have h₂ : ∀ q : Q, f = const R P q ↔ (f : P →ᵃ[R] Q) = AffineMap.const R P q :=
    by
    intro q
    refine' ⟨fun h => _, fun h => _⟩ <;> ext
    · rw [h]
      rfl
    · rw [← coe_to_affine_map, h]
      rfl
  simp_rw [h₁, h₂]
  exact (f : P →ᵃ[R] Q).linear_eq_zero_iff_exists_const
#align continuous_affine_map.cont_linear_eq_zero_iff_exists_const ContinuousAffineMap.contLinear_eq_zero_iff_exists_const

@[simp]
theorem to_affine_map_contLinear (f : V →L[R] W) : f.toContinuousAffineMap.contLinear = f :=
  by
  ext
  rfl
#align continuous_affine_map.to_affine_map_cont_linear ContinuousAffineMap.to_affine_map_contLinear

@[simp]
theorem zero_contLinear : (0 : P →A[R] W).contLinear = 0 :=
  rfl
#align continuous_affine_map.zero_cont_linear ContinuousAffineMap.zero_contLinear

@[simp]
theorem add_contLinear (f g : P →A[R] W) : (f + g).contLinear = f.contLinear + g.contLinear :=
  rfl
#align continuous_affine_map.add_cont_linear ContinuousAffineMap.add_contLinear

@[simp]
theorem sub_contLinear (f g : P →A[R] W) : (f - g).contLinear = f.contLinear - g.contLinear :=
  rfl
#align continuous_affine_map.sub_cont_linear ContinuousAffineMap.sub_contLinear

@[simp]
theorem neg_contLinear (f : P →A[R] W) : (-f).contLinear = -f.contLinear :=
  rfl
#align continuous_affine_map.neg_cont_linear ContinuousAffineMap.neg_contLinear

@[simp]
theorem smul_contLinear (t : R) (f : P →A[R] W) : (t • f).contLinear = t • f.contLinear :=
  rfl
#align continuous_affine_map.smul_cont_linear ContinuousAffineMap.smul_contLinear

theorem decomp (f : V →A[R] W) : (f : V → W) = f.contLinear + Function.const V (f 0) :=
  by
  rcases f with ⟨f, h⟩
  rw [coe_mk_const_linear_eq_linear, coe_mk, f.decomp, Pi.add_apply, LinearMap.map_zero, zero_add]
#align continuous_affine_map.decomp ContinuousAffineMap.decomp

section NormedSpaceStructure

variable (f : V →A[𝕜] W)

/-- Note that unlike the operator norm for linear maps, this norm is _not_ submultiplicative:
we do _not_ necessarily have `‖f.comp g‖ ≤ ‖f‖ * ‖g‖`. See `norm_comp_le` for what we can say. -/
noncomputable instance hasNorm : Norm (V →A[𝕜] W) :=
  ⟨fun f => max ‖f 0‖ ‖f.contLinear‖⟩
#align continuous_affine_map.has_norm ContinuousAffineMap.hasNorm

theorem norm_def : ‖f‖ = max ‖f 0‖ ‖f.contLinear‖ :=
  rfl
#align continuous_affine_map.norm_def ContinuousAffineMap.norm_def

theorem norm_contLinear_le : ‖f.contLinear‖ ≤ ‖f‖ :=
  le_max_right _ _
#align continuous_affine_map.norm_cont_linear_le ContinuousAffineMap.norm_contLinear_le

theorem norm_image_zero_le : ‖f 0‖ ≤ ‖f‖ :=
  le_max_left _ _
#align continuous_affine_map.norm_image_zero_le ContinuousAffineMap.norm_image_zero_le

@[simp]
theorem norm_eq (h : f 0 = 0) : ‖f‖ = ‖f.contLinear‖ :=
  calc
    ‖f‖ = max ‖f 0‖ ‖f.contLinear‖ := by rw [norm_def]
    _ = max 0 ‖f.contLinear‖ := by rw [h, norm_zero]
    _ = ‖f.contLinear‖ := max_eq_right (norm_nonneg _)

#align continuous_affine_map.norm_eq ContinuousAffineMap.norm_eq

noncomputable instance : NormedAddCommGroup (V →A[𝕜] W) :=
  AddGroupNorm.toNormedAddCommGroup
    { toFun := fun f => max ‖f 0‖ ‖f.contLinear‖
      map_zero' := by simp
      neg' := fun f => by simp
      add_le' := fun f g =>
        by
        simp only [Pi.add_apply, add_cont_linear, coe_add, max_le_iff]
        exact
          ⟨(norm_add_le _ _).trans (add_le_add (le_max_left _ _) (le_max_left _ _)),
            (norm_add_le _ _).trans (add_le_add (le_max_right _ _) (le_max_right _ _))⟩
      eq_zero_of_map_eq_zero' := fun f h₀ =>
        by
        rcases max_eq_iff.mp h₀ with (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩) <;> rw [h₁] at h₂
        · rw [norm_le_zero_iff, cont_linear_eq_zero_iff_exists_const] at h₂
          obtain ⟨q, rfl⟩ := h₂
          simp only [Function.const_apply, coe_const, norm_eq_zero] at h₁
          rw [h₁]
          rfl
        · rw [norm_eq_zero', cont_linear_eq_zero_iff_exists_const] at h₁
          obtain ⟨q, rfl⟩ := h₁
          simp only [Function.const_apply, coe_const, norm_le_zero_iff] at h₂
          rw [h₂]
          rfl }

instance : NormedSpace 𝕜 (V →A[𝕜] W)
    where norm_smul_le t f := by
    simp only [norm_def, smul_cont_linear, coe_smul, Pi.smul_apply, norm_smul, ←
      mul_max_of_nonneg _ _ (norm_nonneg t)]

theorem norm_comp_le (g : W₂ →A[𝕜] V) : ‖f.comp g‖ ≤ ‖f‖ * ‖g‖ + ‖f 0‖ :=
  by
  rw [norm_def, max_le_iff]
  constructor
  ·
    calc
      ‖f.comp g 0‖ = ‖f (g 0)‖ := by simp
      _ = ‖f.cont_linear (g 0) + f 0‖ := by
        rw [f.decomp]
        simp
      _ ≤ ‖f.cont_linear‖ * ‖g 0‖ + ‖f 0‖ :=
        ((norm_add_le _ _).trans (add_le_add_right (f.cont_linear.le_op_norm _) _))
      _ ≤ ‖f‖ * ‖g‖ + ‖f 0‖ :=
        add_le_add_right
          (mul_le_mul f.norm_cont_linear_le g.norm_image_zero_le (norm_nonneg _) (norm_nonneg _)) _

  ·
    calc
      ‖(f.comp g).contLinear‖ ≤ ‖f.cont_linear‖ * ‖g.cont_linear‖ :=
        (g.comp_cont_linear f).symm ▸ f.cont_linear.op_norm_comp_le _
      _ ≤ ‖f‖ * ‖g‖ :=
        (mul_le_mul f.norm_cont_linear_le g.norm_cont_linear_le (norm_nonneg _) (norm_nonneg _))
      _ ≤ ‖f‖ * ‖g‖ + ‖f 0‖ := by
        rw [le_add_iff_nonneg_right]
        apply norm_nonneg

#align continuous_affine_map.norm_comp_le ContinuousAffineMap.norm_comp_le

variable (𝕜 V W)

/-- The space of affine maps between two normed spaces is linearly isometric to the product of the
codomain with the space of linear maps, by taking the value of the affine map at `(0 : V)` and the
linear part. -/
def toConstProdContinuousLinearMap : (V →A[𝕜] W) ≃ₗᵢ[𝕜] W × (V →L[𝕜] W)
    where
  toFun f := ⟨f 0, f.contLinear⟩
  invFun p := p.2.toContinuousAffineMap + const 𝕜 V p.1
  left_inv f := by
    ext
    rw [f.decomp]
    simp
  right_inv := by
    rintro ⟨v, f⟩
    ext <;> simp
  map_add' _ _ := rfl
  map_smul' _ _ := rfl
  norm_map' f := rfl
#align continuous_affine_map.to_const_prod_continuous_linear_map ContinuousAffineMap.toConstProdContinuousLinearMap

@[simp]
theorem toConstProdContinuousLinearMap_fst (f : V →A[𝕜] W) :
    (toConstProdContinuousLinearMap 𝕜 V W f).fst = f 0 :=
  rfl
#align continuous_affine_map.to_const_prod_continuous_linear_map_fst ContinuousAffineMap.toConstProdContinuousLinearMap_fst

@[simp]
theorem toConstProdContinuousLinearMap_snd (f : V →A[𝕜] W) :
    (toConstProdContinuousLinearMap 𝕜 V W f).snd = f.contLinear :=
  rfl
#align continuous_affine_map.to_const_prod_continuous_linear_map_snd ContinuousAffineMap.toConstProdContinuousLinearMap_snd

end NormedSpaceStructure

end ContinuousAffineMap


import algebra.category.Module.filtered_colimits
import algebra.category.Module.limits
import category_theory.sites.sheafification
import category_theory.sites.whiskering
import linear_algebra.pi
import linear_algebra.multilinear.basic

open_locale classical

namespace Module

universe u
variables {R : Type u} [comm_ring R]

def product {ι : Type u} (e : ι → Module.{u} R) : Module.{u} R :=
Module.of _ $ Π i, e i

def product.π {ι : Type u} (e : ι → Module.{u} R) (i) : product e ⟶ e i :=
(linear_map.proj i : (Π j, e j) →ₗ[R] e i)

def product.lift {M : Module.{u} R} {ι : Type u} (e : ι → Module.{u} R)
  (f : Π i, M ⟶ e i) : M ⟶ product e := linear_map.pi f

@[simp, reassoc, elementwise]
lemma product.lift_π {M : Module.{u} R} {ι : Type u} (e : ι → Module.{u} R)
  (f : Π i, M ⟶ e i) (i) : product.lift e f ≫ product.π e i = f i := by { ext, refl }

lemma product.hom_ext {M : Module.{u} R} {ι : Type u} (e : ι → Module.{u} R)
  (f g : M ⟶ product e) (h : ∀ i, f ≫ product.π e i = g ≫ product.π e i) : f = g :=
begin
  ext m i,
  specialize h i,
  apply_fun (λ e, e m) at h,
  exact h
end

end Module

namespace category_theory

universes w v u

variables (C : Type (max v u)) [category.{v} C] (J : grothendieck_topology C)
variables (R : Type (max v u)) [comm_ring R]

abbreviation functor_of_modules := C ⥤ Module.{max v u} R

variable {C}

abbreviation Sheaf_of_modules := Sheaf J (Module.{max v u} R)

variables {R J}

@[simps]
def functor_of_modules.product {ι : Type (max v u)} (e : ι → functor_of_modules C R) :
  functor_of_modules C R :=
{ obj := λ U, Module.product (λ i, (e i).obj U),
  map := λ U V f, Module.product.lift _ $ λ i, Module.product.π _ i ≫ (e i).map f }

@[simps]
def functor_of_modules.product.π {ι : Type (max v u)} (e : ι → functor_of_modules C R) (i) :
  functor_of_modules.product e ⟶ e i :=
{ app := λ U, Module.product.π _ _ }

@[simps]
def functor_of_modules.product.lift {M : functor_of_modules C R} {ι : Type (max v u)}
  (e : ι → functor_of_modules C R)
  (f : Π i, M ⟶ e i) : M ⟶ functor_of_modules.product e :=
{ app := λ U, Module.product.lift _ $ λ i, (f i).app U,
  naturality' := begin
    intros U V f,
    apply Module.product.hom_ext,
    intros i,
    simp,
  end }

@[simp, reassoc]
lemma functor_of_modules.product.lift_π {M : functor_of_modules C R} {ι : Type (max v u)}
  (e : ι → functor_of_modules C R)
  (f : Π i, M ⟶ e i) (i) :
  functor_of_modules.product.lift e f ≫ functor_of_modules.product.π e i = f i :=
by { ext : 2, dsimp, simp }

lemma functor_of_modules.product.hom_ext {M : functor_of_modules C R} {ι : Type (max v u)}
  (e : ι → functor_of_modules C R) (f g : M ⟶ functor_of_modules.product e)
  (h : ∀ i, f ≫ functor_of_modules.product.π e i = g ≫ functor_of_modules.product.π e i) :
  f = g :=
begin
  ext x : 2,
  apply Module.product.hom_ext,
  intros i,
  specialize h i,
  apply_fun (λ e, e.app x) at h,
  simpa using h,
end

structure functor_of_modules.multilinear_map {ι : Type (max v u)}
  (e : ι → functor_of_modules C R) (M : functor_of_modules C R) :=
(η : functor_of_modules.product e ⋙ forget _ ⟶ M ⋙ forget _)
(F : Π U : C, multilinear_map R (λ i, (e i).obj U) (M.obj U))
(h : ∀ U, η.app U = F U)

@[simps val_obj val_map]
def Sheaf_of_modules.product {ι : Type (max v u)} (e : ι → Sheaf_of_modules J R) :
  Sheaf_of_modules J R :=
{ val := functor_of_modules.product (λ i, (e i).val),
  cond := begin
    -- Idea: The underlying presheaf is the product of the underlying presheaves of
    -- the given sheaves. The forgetful functor from sheaves to presheaves creates limits.
    sorry,
  end }

@[simps val_app]
def Sheaf_of_modules.product.π {ι : Type (max v u)} (e : ι → Sheaf_of_modules J R) (i) :
  Sheaf_of_modules.product e ⟶ e i :=
⟨functor_of_modules.product.π _ _⟩

@[simps val_app]
def Sheaf_of_modules.product.lift {M : Sheaf_of_modules J R} {ι : Type (max v u)}
  (e : ι → Sheaf_of_modules J R)
  (f : Π i, M ⟶ e i) : M ⟶ Sheaf_of_modules.product e :=
⟨functor_of_modules.product.lift _ $ λ i, (f i).val⟩

@[simp]
lemma Sheaf_of_modules.product.lift_π {M : Sheaf_of_modules J R} {ι : Type (max v u)}
  (e : ι → Sheaf_of_modules J R)
  (f : Π i, M ⟶ e i) (i) :
  Sheaf_of_modules.product.lift e f ≫ Sheaf_of_modules.product.π e i = f i :=
by { ext, simp }

lemma Sheaf_of_modules.product.hom_ext {M : Sheaf_of_modules J R} {ι : Type (max v u)}
  (e : ι → Sheaf_of_modules J R) (f g : M ⟶ Sheaf_of_modules.product e)
  (h : ∀ i, f ≫ Sheaf_of_modules.product.π _ i = g ≫ Sheaf_of_modules.product.π _ i) : f = g :=
begin
  ext1,
  apply functor_of_modules.product.hom_ext,
  intros i,
  specialize h i,
  apply_fun (λ e, e.val) at h,
  exact h
end

abbreviation Sheaf_of_modules.forget (M : Sheaf_of_modules J R) : Sheaf J (Type (max v u)) :=
(Sheaf_compose _ $ forget _).obj M

structure Sheaf_of_modules.multilinear_map {ι : Type (max v u)}
  (e : ι → Sheaf_of_modules J R) (M : Sheaf_of_modules J R) :=
(η : functor_of_modules.multilinear_map (λ i, (e i).val) M.val)

end category_theory


import Lean

open Lean

#eval Compiler.compile #[``List.map]

#eval Compiler.compile #[``Lean.Elab.Term.synthesizeInstMVarCore]

#eval Compiler.compile #[``Eq.ndrec]

def g1 (x : Nat) (h : Nat = Int) : Int :=
  (h ▸ x) + 1

#eval Compiler.compile #[``g1]

def f (h : False) (x : Nat) : Nat :=
  (h.rec : Nat → Nat) x

#eval Compiler.compile #[``f]

def g (as : Array (Nat → Nat)) (h : i < as.size ∧ q) : Nat :=
  h.casesOn (fun _ _ => as[i]) i

#eval Compiler.compile #[``g]

def f2 {r : Nat → Nat → Prop} (q : Quot r) : Nat :=
  (q.lift (·+·) sorry : Nat → Nat) 2

#eval Compiler.compile #[``f2]

inductive Vec (α : Type u) : Nat → Type u
  | nil : Vec α 0
  | cons : α → Vec α n → Vec α (n+1)

def Vec.zip : Vec α n → Vec β n → Vec (α × β) n
  | .cons a as, .cons b bs => .cons (a, b) (zip as bs)
  | .nil, .nil => .nil

def Vec.head : Vec α (n+1) → α
  | .cons a _ => a

#eval Compiler.compile #[``Lean.Elab.Term.reportStuckSyntheticMVar]

#eval Compiler.compile #[``Lean.Elab.Term.synthesizeSyntheticMVars]

set_option profiler true
#eval Compiler.compile #[``Lean.Meta.isExprDefEqAuxImpl]

def foo (a b : Nat) :=
  let d := match a with
  | .zero => b
  | .succ c => c
  let e := match b with
  | .zero => a
  | .succ f => f
  Nat.add d e

#eval Compiler.compile #[``foo]

#eval Compiler.compile #[``Vec.zip]

structure Foo where
  α : Sort u
  x : α

def foo1 :=  Foo.mk Type Nat

#eval Compiler.compile #[``foo1]

def Tuple (α : Type u) : Nat → Type u
  | 0   => PUnit
  | 1   => α
  | n+2 => α × Tuple α (n+1)

def mkConstTuple (a : α) : (n : Nat) → Tuple α n
  | 0 => ⟨⟩
  | 1 => a
  | n+2 => (a, mkConstTuple a (n+1))

def Tuple.map (f : α → β) (xs : Tuple α n) : Tuple β n :=
  match n with
  | 0 => ⟨⟩
  | 1 => f xs
  | _+2 => match xs with
    | (a, xs) => (f a, Tuple.map f xs)

def Tuple.example (a b : Nat) :=
  Tuple.map (n := 2) (· + 1) (a, b)

#eval Compiler.compile #[``mkConstTuple]
#eval Compiler.compile #[``Tuple.map]
#eval Compiler.compile #[``Tuple.example]

def gebner1 (x : UInt64) : UInt64 := assert! x > 0; x - 1
-- set_option pp.letVarTypes true in
#eval Compiler.compile #[``gebner1]

def gebner2 (x : UInt64) := x &&& ((1 : UInt64) <<< 5 : UInt64)
-- set_option pp.letVarTypes true in
#eval Compiler.compile #[``gebner2]

#eval Compiler.compile #[``Lean.Meta.instMonadMetaM]
#eval Compiler.compile #[``Lean.Core.instMonadCoreM]
#eval Compiler.compile #[``instMonadEIO]
-- set_option pp.explicit true in
#eval Compiler.compile #[``EStateM.instMonadEStateM]


import data.nat.basic
open nat
/- definition of the rules of the island. Left hand side of output is everything brown know about the number of blue eyed people on day d,rhs is for blue eyes
d is day_no
i is number of islanders
b is number of blue eyed islanders
-/
def island_rules : ℕ → ℕ → ℕ → ((ℕ → Prop) × (ℕ → Prop))
--on the first day they all know that the number of blue eyed people is one of two possible values, and that b ≥ 1
| 0        i b := (λ bb:ℕ, b = bb ∨ b + 1 = bb,λ bb:ℕ, (b = bb ∨ b - 1 = bb) ∧ bb ≥ 1)
-- on subsequent days they know wverything they knew the previous day as well as whether any blue eyed or brown eyed people knew b the previous day
--
-- it would have been nicer to have a function which expected a proof before the islanders could know something
| (succ d) i b := (λ bb, (island_rules d i b).1 bb ∧
    -- bb is used to represent the unknown value of b, b is the actual value
    -- the below two lines mean that brown eyed islanders know whether or not anyone left the previous day. The first line isn't really necessary,
    -- since if any brown eyed islanders left, they would have already deduced that brown eyed islanders should leave.
    ((∀ c:ℕ, (island_rules d i b).1 c → c = b) ↔ (∀ c:ℕ, (island_rules d i bb).1 c → c = bb)) ∧
    ((∀ c:ℕ, (island_rules d i b).2 c → c = b) ↔ (∀ c:ℕ, (island_rules d i bb).2 c → c = bb)),
    -- strictly there may be other things that should be added here, but none of them change the result
    λ bb, (island_rules d i b).2 bb ∧
    ((∀ c:ℕ, (island_rules d i b).1 c → c = b) ↔ (∀ c:ℕ, (island_rules d i bb).1 c → c = bb)) ∧
    ((∀ c:ℕ, (island_rules d i b).2 c → c = b) ↔ (∀ c:ℕ, (island_rules d i bb).2 c → c = bb)))
theorem init_island_1 {d i b bb:ℕ} : (island_rules d i b).2 bb → (b = bb ∨ b - 1 = bb) ∧ bb ≥ 1:=begin
    induction d,simp[island_rules] at *,intros,exact ⟨a,a_1⟩,
    simp [island_rules],intros,exact d_ih a,
end
theorem init_island_2  {d i b bb:ℕ} : (island_rules d i b).1 bb → (b = bb ∨ b + 1 = bb):=begin
    induction d,simp[island_rules] at *,intros,
    simp [island_rules] at a,exact d_ih a.left,
end
theorem blue_eyed_islander : ∀ d b : ℕ, b > 0 → (d + 1 ≥ b ↔ (∀ bb:ℕ, (island_rules d 1000 b).2 bb → bb = b)) ∧ ((∀ bb:ℕ, (island_rules d 1000 b).1 bb → bb = b) → d ≥ b):=begin
    assume d, induction d with d hid,assume b,induction b with b hib,
    simp[(dec_trivial:¬0>0)],cases b with b,simp[island_rules,(dec_trivial:1>0),(dec_trivial:0+1≥ 1)],
    apply and.intro, assume bb hbb hbb1,
    cases hbb,rw hbb,rw ←hbb at hbb1,simp[(dec_trivial:¬0≥1)] at hbb1,contradiction,
    simp[(dec_trivial:¬0≥1)],intro,have:= a 2,simp at this,exact (dec_trivial:¬2=1) this,
    cases b,simp[(dec_trivial:2>0),(dec_trivial:¬0+1≥2),island_rules],apply and.intro,assume hbb,have:=hbb 1,simp[(dec_trivial:1≥1),(dec_trivial:¬1 = succ 1)] at this,assumption,
    simp[(dec_trivial:¬0≥succ 1)],intro,have:= a 3,simp at this,exact (dec_trivial:¬3 = succ 1) this,
    simp[(dec_trivial:succ(succ b)>0),(dec_trivial:¬0+1≥succ(succ b)),(dec_trivial:succ(succ(succ b))>0),(dec_trivial:¬0+1≥succ(succ(succ b))),island_rules] at *,
    apply and.intro,
    intro,cases classical.em (∃ (bb : ℕ), ¬(succ (succ b) = bb ∨ succ b = bb → bb ≥ 1 → succ (succ b) = bb)),
    cases h,have h2:= a (succ h_w), have h3:(succ (succ b) = h_w ∨ succ b = h_w → h_w ≥ 1 → succ (succ b) = h_w),
    assume h4 h5,cases h4,assumption,have h5:succ (succ b) = succ h_w,rw h4,exact succ_inj (eq.symm (h2 (or.inr h5) dec_trivial)),exact h_h h3,
    have:∀ (bb : ℕ), ¬¬(succ (succ b) = bb ∨ succ b = bb → bb ≥ 1 → succ (succ b) = bb):=forall_not_of_not_exists h,
    have h5:∀ (bb : ℕ), succ (succ b) = bb ∨ succ b = bb → bb ≥ 1 → bb = succ (succ b),assume bb h h1, rw eq_comm,revert h h1,
    exact iff.elim_left not_not (this bb),exact hib.left h5,
    simp[(dec_trivial:¬0≥succ(succ(succ b)))],intro,have:= a (1 + succ (succ (succ b))),simp at this,rw one_add at this,exact succ_ne_self (succ(succ(succ b))) this,

    assume b hb,apply and.intro,apply iff.intro,simp[island_rules],
    assume hd,cases lt_or_eq_of_le hd,
    rw [succ_add]at h,intros,have h1 :=le_of_lt_succ h,have:= iff.elim_left(hid b hb).left h1 bb,exact this a,
    intros,have h1:= init_island_1 a,cases h1.left,
    rw h_1,have h2:=lt_of_succ_le h1.right,
    rw h at h_1,simp at h_1,have h3:d + 1 ≥ bb,rw [←h_1,add_one],apply le_refl,
    have hid1:=iff.elim_left (hid bb h2).left h3,
    have hid2:=hid b hb,have:¬d + 1 ≥ b,rw [h,succ_add],apply not_le_of_lt,apply lt_succ_self,simp [this] at hid2,
    have:¬(∀ (c : ℕ), (island_rules d 1000 b).snd c → c = b),intro,
    have:∀ (c : ℕ), (island_rules d 1000 b).snd c → b = c,intros,exact eq.symm (a_3 c a_4),
    exact hid2.left a_3,simp[this]at a_2,have:=λb h,eq.symm (hid1 b h),contradiction,

    intro,apply by_contradiction,intro,rw succ_add at a_1,
    have :¬d+1≥b,intro,have:=le_succ_of_le a_2,exact a_1 this,
    have h:=hid b hb,simp[this] at h,simp[island_rules] at a,
    have h1:=iff.elim_left classical.not_forall h.left,cases h1 with bb hbb,
    rw @not_imp _ _ (classical.prop_decidable ((island_rules d 1000 b).snd bb)) at hbb,
    have:= a bb hbb.left,
    simp[hbb.right] at this,rw eq_comm at hbb,
    have h2:=init_island_1 hbb.left,simp[hbb.right] at h2,
    have h3:¬∀ (bb : ℕ), (island_rules d 1000 b).snd bb → bb = b,
    rw classical.not_forall,existsi bb,simp [hbb.left],rw eq_comm,exact hbb.right,
    simp [h3] at this,rw ←h2.left at this,
    cases b,exact (dec_trivial:¬0>0) hb,
    cases b,simp at h2,have:= h2.left, rw ← this at h2,simp[(dec_trivial:¬0≥1)] at h2,contradiction,
    simp[island_rules] at this,have h4:= hid (succ b) dec_trivial,have h5:¬d+1 ≥ succ b,
    intro,have: succ b ≤ d + 1:=a_2,rw ←succ_le_succ_iff at this,exact a_1 this,
    simp [h5] at h4,simp [h4] at this,have h6:¬d≥succ b,intro,have:=le_trans a_2 (le_succ d),rw ←add_one d at this,
    contradiction,simp[h6] at h4,simp[h4] at this,
    have h7:= (hid (succ(succ b)) dec_trivial).right,
    have h8:¬d ≥ succ (succ b),intro,have:=le_trans (le_succ (succ b)) a_2,contradiction,
    simp[h8] at h7,simp[h7] at this,exact this,

    simp[island_rules], intro,apply by_contradiction,
    intro,have:= hid b hb,
    have h1:¬d≥b,intro,exact a_1 (le_trans a_2 (le_succ d)),rw add_one at this,simp[a_1,h1] at this,
    simp [this.left,this.right] at a,rw [classical.not_forall] at this,
    cases this.left with x hx, have hy:=not.intro this.right,rw classical.not_forall at hy,
    cases hy with y hy,

    rw @not_imp _ _ (classical.prop_decidable _) at hy,have ha:=a y,
    simp [hy.left,hy.right] at ha,have hyy:= init_island_2 hy.left,rw eq_comm at hyy, simp [hy.right] at hyy,

    have hiy1:y>0,have:= lt_trans hb (lt_succ_self b), rw [←add_one,hyy] at this,exact this,
    have hiy2:¬succ d ≥ y,intro,rw [←hyy,add_one] at a_2,exact a_1 (le_trans (le_succ b) a_2),
    have hiy3:¬d≥y,intro,exact hiy2 (le_trans a_2 (le_succ d)),
    have hidy:= hid y hiy1,
    simp[hiy2,hiy3] at hidy,simp [hidy.left,hidy.right] at ha,assumption,
end

--final theorem for the puzzle, blue eyed islanders know how many blue eyed islanders there are iff it is day 99 or later
theorem blue_eyed_islander_100 : ∀ d : ℕ, (d + 1 ≥ 100 ↔ (∀ bb:ℕ, (island_rules d 1000 100).2 bb → bb = 100)):=λ d,(blue_eyed_islander d 100 dec_trivial).left


/-
Copyright (c) 2023 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.dual_number
import analysis.normed_space.triv_sq_zero_ext

/-!
# Results on `dual_number R` related to the norm

These are just restatements of similar statements about `triv_sq_zero_ext R M`.

## Main results

* `exp_eps`

-/

namespace dual_number
open triv_sq_zero_ext

variables (𝕜 : Type*) {R : Type*}

variables [is_R_or_C 𝕜] [normed_comm_ring R] [normed_algebra 𝕜 R]
variables [topological_ring R] [complete_space R] [t2_space R]

@[simp] lemma exp_eps : exp 𝕜 (eps : dual_number R) = 1 + eps :=
exp_inr _ _

@[simp] lemma exp_smul_eps (r : R) : exp 𝕜 (r • eps : dual_number R) = 1 + r • eps :=
by rw [eps, ←inr_smul, exp_inr]

end dual_number


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import tactic.pi_instances
import algebra.group.pi
import algebra.ring.basic

/-!
# Pi instances for ring

This file defines instances for ring, semiring and related structures on Pi Types
-/

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

instance distrib [Π i, distrib $ f i] : distrib (Π i : I, f i) :=
by refine_struct { add := (+), mul := (*), .. }; tactic.pi_instance_derive_field

instance semiring [∀ i, semiring $ f i] : semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  nsmul := λ n x i, nsmul n (x i), npow := λ n x i, npow n (x i) };
tactic.pi_instance_derive_field

instance comm_semiring [∀ i, comm_semiring $ f i] : comm_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  nsmul := λ n x i, nsmul n (x i), npow := λ n x i, npow n (x i) };
tactic.pi_instance_derive_field

instance ring [∀ i, ring $ f i] : ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  neg := has_neg.neg, nsmul := λ n x i, nsmul n (x i), npow := λ n x i, npow n (x i) };
tactic.pi_instance_derive_field

instance comm_ring [∀ i, comm_ring $ f i] : comm_ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  neg := has_neg.neg, nsmul := λ n x i, nsmul n (x i), npow := λ n x i, npow n (x i) };
tactic.pi_instance_derive_field

/-- A family of ring homomorphisms `f a : γ →+* β a` defines a ring homomorphism
`pi.ring_hom f : γ →+* Π a, β a` given by `pi.ring_hom f x b = f b x`. -/
protected def ring_hom
  {α : Type u} {β : α → Type v} [R : Π a : α, semiring (β a)]
  {γ : Type w} [semiring γ] (f : Π a : α, γ →+* β a) :
  γ →+* Π a, β a :=
{ to_fun := λ x b, f b x,
  map_add' := λ x y, funext $ λ z, (f z).map_add x y,
  map_mul' := λ x y, funext $ λ z, (f z).map_mul x y,
  map_one' := funext $ λ z, (f z).map_one,
  map_zero' := funext $ λ z, (f z).map_zero }

@[simp] lemma ring_hom_apply
  {α : Type u} {β : α → Type v} [R : Π a : α, semiring (β a)]
  {γ : Type w} [semiring γ] (f : Π a : α, γ →+* β a) (g) (a) :
  pi.ring_hom f g a = f a g :=
rfl

end pi

section ring_hom

variable {I : Type*}     -- The indexing type
variable (f : I → Type*) -- The family of types already equipped with instances
variables [Π i, semiring (f i)]

/-- Evaluation of functions into an indexed collection of monoids at a point is a monoid
homomorphism. -/
def ring_hom.apply (i : I) : (Π i, f i) →+* f i :=
{ ..(monoid_hom.apply f i),
  ..(add_monoid_hom.apply f i) }

@[simp]
lemma ring_hom.apply_apply (i : I) (g : Π i, f i) : (ring_hom.apply f i) g = g i := rfl

end ring_hom


import data.equiv

universes u v w

variables {α : Type u} {β : Type v} {γ : Type w} [group α] [group β] [group γ]

variables (α β)

structure isomorphism extends equiv α β :=
(map_mul : is_group_hom to_fun)

namespace isomorphism

variables {α β} (f : isomorphism α β) (g : isomorphism β γ) {x y : α}

def comp : isomorphism α γ :=
{ equiv.trans f.to_equiv g.to_equiv with
  map_mul := λ x y, calc
          g.to_fun (f.to_fun (x * y))
        = g.to_fun (f.to_fun x * f.to_fun y) : congr_arg g.to_fun $ @isomorphism.map_mul _ _ _ _ f x y
    ... = g.to_fun (f.to_fun x) * g.to_fun (f.to_fun y) : @isomorphism.map_mul _ _ _ _ g _ _ }

def inv : isomorphism β α :=
{ equiv.symm f.to_equiv with
  map_mul := λ x y, calc
    f.inv_fun (x * y) = f.inv_fun (f.to_fun (f.inv_fun x) * y) : congr_arg f.inv_fun $ congr_arg (λ z, z * y) $ eq.symm $ f.right_inv x
    ... = f.inv_fun (f.to_fun (f.inv_fun x) * f.to_fun (f.inv_fun y)) : congr_arg f.inv_fun $ congr_arg (λ z, f.to_fun (f.inv_fun x) * z) $ eq.symm $ f.right_inv y
    ... = f.inv_fun (f.to_fun (f.inv_fun x * f.inv_fun y)) : congr_arg f.inv_fun $ eq.symm $ @isomorphism.map_mul _ _ _ _ f _ _
    ... = f.inv_fun x * f.inv_fun y : f.left_inv (f.inv_fun x * f.inv_fun y) }

def id : isomorphism α α :=
{ equiv.refl α with
  map_mul := λ x y, rfl }

end isomorphism

structure automorphism extends isomorphism α α

theorem automorphism.ext (f g : automorphism α) (H : ∀ x, f.to_isomorphism.to_equiv.to_fun x = g.to_isomorphism.to_equiv.to_fun x) : f = g :=
by cases f; cases f; cases g; cases g; congr; apply equiv.ext; exact H

namespace automorphism

instance : has_coe (automorphism α) (α → α) := ⟨λ f, f.to_isomorphism.to_equiv⟩

theorem map_mul (f : automorphism α) (x y : α) :
  (f : α → α) (x * y) = (f : α → α) x * (f : α → α) y :=
@isomorphism.map_mul _ _ _ _ f.to_isomorphism _ _

variable {α}

theorem is_group_hom (f : automorphism α) : is_group_hom (f : α → α) :=
map_mul α f

variable α

instance : group (automorphism α) :=
{ mul := λ f g, automorphism.mk $ g.to_isomorphism.comp f.to_isomorphism,
  mul_assoc := λ f g h, by unfold has_mul.mul; congr,
  one := automorphism.mk $ isomorphism.id,
  one_mul := λ f, by apply automorphism.ext; intro x; refl,
  mul_one := λ f, by apply automorphism.ext; intro x; refl,
  inv := λ f, automorphism.mk $ f.to_isomorphism.inv,
  mul_left_inv := λ f, by apply automorphism.ext; intro x; exact ((f.to_isomorphism).to_equiv).left_inv x}

@[simp] lemma mul_apply (f g : automorphism α) (x : α) :
  (((f * g) : automorphism α) : α → α) x = (f:α → α) ((g:α → α) x) :=
rfl

end automorphism

variables (α β)

def group_direct_product : group (α × β) :=
{ mul := λ x y, (x.fst * y.fst, x.snd * y.snd),
  mul_assoc := λ x y z, by simp [mul_assoc],
  one := (1, 1),
  one_mul := λ x, by simp,
  mul_one := λ x, by rw prod.ext; split; apply mul_one,
  inv := λ x, (x.fst⁻¹, x.snd⁻¹),
  mul_left_inv := λ x, by rw prod.ext; split; apply mul_left_inv }

def group_semidirect_product (f : β → automorphism α) (H : is_group_hom f) : group (α × β) :=
{ mul := λ x y, (x.fst * (f x.snd : α → α) y.fst, x.snd * y.snd),
  mul_assoc := λ x y z, by rw prod.ext; split;
    simp [H, H x.snd, automorphism.map_mul α (f x.snd), mul_assoc],
  one := (1, 1),
  one_mul := λ x, by rw prod.ext; split; simp [H.one]; refl,
  mul_one := λ x, by rw prod.ext; split;
    simp [(*), semigroup.mul, monoid.mul, group.mul, (f x.snd).is_group_hom.one]; apply mul_one,
  inv := λ x, ((f x.snd⁻¹ : α → α) (x.fst⁻¹), x.snd⁻¹),
  mul_left_inv := λ x, calc
      ((f x.snd⁻¹ : α → α) (x.fst⁻¹) * (f x.snd⁻¹ : α → α) x.fst, x.snd⁻¹ * x.snd)
    = (1, 1) : by rw ← (f x.snd⁻¹).is_group_hom; simp [(f x.snd⁻¹).is_group_hom.one] }


variables p q : Prop

example (h : p ∧ q) : q ∧ p ∧ q := ⟨h.right, ⟨h.left, h.right⟩⟩
example (h : p ∧ q) : q ∧ p ∧ q := ⟨h.right, h.left, h.right⟩


import Std.Tactic.Lint

set_option linter.missingDocs false

protected def Sum.elim {α β γ : Sort _} (f : α → γ) (g : β → γ) : Sum α β → γ :=
  fun x => Sum.casesOn x f g

structure Equiv (α : Sort _) (β : Sort _) where
  toFun : α → β
  invFun : β → α

infixl:25 " ≃ " => Equiv

namespace Equiv

instance : CoeFun (α ≃ β) fun _ => α → β := ⟨toFun⟩

protected def symm (e : α ≃ β) : β ≃ α := ⟨e.invFun, e.toFun⟩

def sumCompl {α : Type _} (p : α → Prop) [DecidablePred p] :
    Sum { a // p a } { a // ¬p a } ≃ α where
  toFun := Sum.elim Subtype.val Subtype.val
  invFun a := if h : p a then Sum.inl ⟨a, h⟩ else Sum.inr ⟨a, h⟩

@[simp]
theorem sumCompl_apply_symm_of_pos (p : α → Prop) [DecidablePred p] (a : α) (h : p a) :
    (sumCompl p).symm a = Sum.inl ⟨a, h⟩ :=
  dif_pos h

#lint- only simpNF


def sum.left {a b} : a ⊕ b → option a
| (sum.inl a) := option.some a
| (sum.inr b) := option.none

def sum.right {a b} : a ⊕ b → option b
| (sum.inl a) := option.none
| (sum.inr b) := option.some b

def sum.fmap {c a b} : (a → b) → c ⊕ a → c ⊕ b
| f (sum.inl e) := sum.inl e
| f (sum.inr v) := sum.inr (f v)

def sum.bind {c a b} : c ⊕ a → (a → c ⊕ b) → c ⊕ b
| (sum.inl e) f := sum.inl e
| (sum.inr a) f := f a

instance sum_is_monad {e} : monad (sum e) :=
{ pure := @sum.inr  e
, bind := @sum.bind e
, id_map := λα x,
  begin
    -- Split on x having form(inl y) or (inr y)
    cases x,
    -- Simplify each goal after exposing definitions
    all_goals { simp [monad.map._default, sum.bind, function.comp], },
  end
, pure_bind := λα β x f, by simp [sum.bind]
, bind_assoc :=
  begin
   intros α β γ x f g,
   cases x,
   all_goals { simp [sum.bind] },
  end
}

namespace sum

  universe variable u

  variables {α β e γ : Type u}

  @[simp]
  theorem map_inl (f : α → β) (x : e) : f <$> (@sum.inl e α x) = sum.inl x := rfl

  @[simp]
  theorem map_inr (f : α → β) (x : α) : f <$> (@sum.inr e α x) = sum.inr (f x) := rfl

  @[simp]
  theorem inl_bind (x : e) (h : α → sum e β)  : (@sum.inl e α x) >>= h = sum.inl x := rfl

  @[simp]
  theorem inr_bind (x : α) (f : α → e ⊕ β) : (sum.inr x >>= f) = f x := rfl

  def orelse : e ⊕ β → α ⊕ β → α ⊕ β
    | (sum.inl _) y := y
    | (sum.inr x) _ := sum.inr x
end sum