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

import algebra.module.basic
import algebra.ring.equiv
import algebra.ring.prod
import data.set.finite
import group_theory.submonoid.centralizer
import group_theory.submonoid.membership

/-!
# Bundled subsemirings

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

open_locale big_operators

universes u v w

variables {R : Type u} {S : Type v} {T : Type w} [non_assoc_semiring R] (M : submonoid R)

section subsemiring_class

/-- `subsemiring_class S R` states that `S` is a type of subsets `s ⊆ R` that
are both a multiplicative and an additive submonoid. -/
class subsemiring_class (S : Type*) (R : out_param $ Type u) [non_assoc_semiring R] [set_like S R]
  extends submonoid_class S R :=
(add_mem : ∀ {s : S} {a b : R}, a ∈ s → b ∈ s → a + b ∈ s)
(zero_mem : ∀ (s : S), (0 : R) ∈ s)

@[priority 100] -- See note [lower instance priority]
instance subsemiring_class.add_submonoid_class (S : Type*) (R : out_param $ Type u)
  [non_assoc_semiring R] [set_like S R] [h : subsemiring_class S R] :
  add_submonoid_class S R :=
{ .. h }

variables [set_like S R] [hSR : subsemiring_class S R] (s : S)
include hSR

open one_mem_class add_submonoid_class

namespace subsemiring_class

lemma coe_nat_mem (n : ℕ) : (n : R) ∈ s :=
by simp only [← nsmul_one, nsmul_mem, one_mem]

/-- A subsemiring of a `non_assoc_semiring` inherits a `non_assoc_semiring` structure -/
@[priority 75] -- Prefer subclasses of `non_assoc_semiring` over subclasses of `subsemiring_class`.
instance to_non_assoc_semiring : non_assoc_semiring s :=
subtype.coe_injective.non_assoc_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance nontrivial [nontrivial R] : nontrivial s :=
nontrivial_of_ne 0 1 $ λ H, zero_ne_one (congr_arg subtype.val H)

instance no_zero_divisors [no_zero_divisors R] : no_zero_divisors s :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y h,
  or.cases_on (eq_zero_or_eq_zero_of_mul_eq_zero $ subtype.ext_iff.mp h)
    (λ h, or.inl $ subtype.eq h) (λ h, or.inr $ subtype.eq h) }

/-- The natural ring hom from a subsemiring of semiring `R` to `R`. -/
def subtype : s →+* R :=
{ to_fun := coe, .. submonoid_class.subtype s, .. add_submonoid_class.subtype s }

@[simp] theorem coe_subtype : (subtype s : s → R) = coe := rfl

omit hSR

/-- A subsemiring of a `semiring` is a `semiring`. -/
@[priority 75] -- Prefer subclasses of `semiring` over subclasses of `subsemiring_class`.
instance to_semiring {R} [semiring R] [set_like S R] [subsemiring_class S R] : semiring s :=
subtype.coe_injective.semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

@[simp, norm_cast] lemma coe_pow {R} [semiring R] [set_like S R] [subsemiring_class S R]
  (x : s) (n : ℕ) :
  ((x^n : s) : R) = (x^n : R) :=
begin
  induction n with n ih,
  { simp, },
  { simp [pow_succ, ih], },
end

/-- A subsemiring of a `comm_semiring` is a `comm_semiring`. -/
instance to_comm_semiring {R} [comm_semiring R] [set_like S R] [subsemiring_class S R] :
  comm_semiring s :=
subtype.coe_injective.comm_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

/-- A subsemiring of an `ordered_semiring` is an `ordered_semiring`. -/
instance to_ordered_semiring {R} [ordered_semiring R] [set_like S R] [subsemiring_class S R] :
  ordered_semiring s :=
subtype.coe_injective.ordered_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl)

/-- A subsemiring of an `ordered_comm_semiring` is an `ordered_comm_semiring`. -/
instance to_ordered_comm_semiring {R} [ordered_comm_semiring R] [set_like S R]
  [subsemiring_class S R] : ordered_comm_semiring s :=
subtype.coe_injective.ordered_comm_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl)

/-- A subsemiring of a `linear_ordered_semiring` is a `linear_ordered_semiring`. -/
instance to_linear_ordered_semiring {R} [linear_ordered_semiring R] [set_like S R]
  [subsemiring_class S R] : linear_ordered_semiring s :=
subtype.coe_injective.linear_ordered_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl)

/-! Note: currently, there is no `linear_ordered_comm_semiring`. -/

end subsemiring_class

end subsemiring_class

variables [non_assoc_semiring S] [non_assoc_semiring T]

set_option old_structure_cmd true

/-- A subsemiring of a semiring `R` is a subset `s` that is both a multiplicative and an additive
submonoid. -/
structure subsemiring (R : Type u) [non_assoc_semiring R] extends submonoid R, add_submonoid R

/-- Reinterpret a `subsemiring` as a `submonoid`. -/
add_decl_doc subsemiring.to_submonoid

/-- Reinterpret a `subsemiring` as an `add_submonoid`. -/
add_decl_doc subsemiring.to_add_submonoid

namespace subsemiring

instance : set_like (subsemiring R) R :=
{ coe := subsemiring.carrier,
  coe_injective' := λ p q h, by cases p; cases q; congr' }

instance : subsemiring_class (subsemiring R) R :=
{ zero_mem := zero_mem',
  add_mem := add_mem',
  one_mem := one_mem',
  mul_mem := mul_mem' }

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

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

/-- Copy of a subsemiring with a new `carrier` equal to the old one. Useful to fix definitional
equalities.-/
protected def copy (S : subsemiring R) (s : set R) (hs : s = ↑S) : subsemiring R :=
{ carrier := s,
  ..S.to_add_submonoid.copy s hs,
  ..S.to_submonoid.copy s hs }

@[simp] lemma coe_copy (S : subsemiring R) (s : set R) (hs : s = ↑S) :
  (S.copy s hs : set R) = s := rfl

lemma copy_eq (S : subsemiring R) (s : set R) (hs : s = ↑S) : S.copy s hs = S :=
set_like.coe_injective hs

lemma to_submonoid_injective : function.injective (to_submonoid : subsemiring R → submonoid R)
| r s h := ext (set_like.ext_iff.mp h : _)

@[mono] lemma to_submonoid_strict_mono : strict_mono (to_submonoid : subsemiring R → submonoid R) :=
λ _ _, id

@[mono] lemma to_submonoid_mono : monotone (to_submonoid : subsemiring R → submonoid R) :=
to_submonoid_strict_mono.monotone

lemma to_add_submonoid_injective :
  function.injective (to_add_submonoid : subsemiring R → add_submonoid R)
| r s h := ext (set_like.ext_iff.mp h : _)

@[mono] lemma to_add_submonoid_strict_mono :
  strict_mono (to_add_submonoid : subsemiring R → add_submonoid R) := λ _ _, id

@[mono]
lemma to_add_submonoid_mono : monotone (to_add_submonoid : subsemiring R → add_submonoid R) :=
to_add_submonoid_strict_mono.monotone

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

@[simp] lemma coe_mk' {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_submonoid R} (ha : ↑sa = s) :
  (subsemiring.mk' s sm hm sa ha : set R) = s := rfl

@[simp] lemma mem_mk' {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_submonoid R} (ha : ↑sa = s) {x : R} :
  x ∈ subsemiring.mk' s sm hm sa ha ↔ x ∈ s :=
iff.rfl

@[simp] lemma mk'_to_submonoid {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_submonoid R} (ha : ↑sa = s) :
  (subsemiring.mk' s sm hm sa ha).to_submonoid = sm :=
set_like.coe_injective hm.symm

@[simp] lemma mk'_to_add_submonoid {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_submonoid R} (ha : ↑sa  =s) :
  (subsemiring.mk' s sm hm sa ha).to_add_submonoid = sa :=
set_like.coe_injective ha.symm

end subsemiring

namespace subsemiring

variables (s : subsemiring R)

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

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

/-- A subsemiring is closed under multiplication. -/
theorem mul_mem : ∀ {x y : R}, x ∈ s → y ∈ s → x * y ∈ s := s.mul_mem'

/-- A subsemiring is closed under addition. -/
theorem add_mem : ∀ {x y : R}, x ∈ s → y ∈ s → x + y ∈ s := s.add_mem'

/-- Product of a list of elements in a `subsemiring` is in the `subsemiring`. -/
lemma list_prod_mem {R : Type*} [semiring R] (s : subsemiring R) {l : list R} :
  (∀x ∈ l, x ∈ s) → l.prod ∈ s :=
s.to_submonoid.list_prod_mem

/-- Sum of a list of elements in a `subsemiring` is in the `subsemiring`. -/
lemma list_sum_mem {l : list R} : (∀x ∈ l, x ∈ s) → l.sum ∈ s :=
s.to_add_submonoid.list_sum_mem

/-- Product of a multiset of elements in a `subsemiring` of a `comm_semiring`
    is in the `subsemiring`. -/
lemma multiset_prod_mem {R} [comm_semiring R] (s : subsemiring R) (m : multiset R) :
  (∀a ∈ m, a ∈ s) → m.prod ∈ s :=
s.to_submonoid.multiset_prod_mem m

/-- Sum of a multiset of elements in a `subsemiring` of a `semiring` is
in the `add_subsemiring`. -/
lemma multiset_sum_mem (m : multiset R) :
  (∀a ∈ m, a ∈ s) → m.sum ∈ s :=
s.to_add_submonoid.multiset_sum_mem m

/-- Product of elements of a subsemiring of a `comm_semiring` indexed by a `finset` is in the
    subsemiring. -/
lemma prod_mem {R : Type*} [comm_semiring R] (s : subsemiring R)
  {ι : Type*} {t : finset ι} {f : ι → R} (h : ∀c ∈ t, f c ∈ s) :
  ∏ i in t, f i ∈ s :=
s.to_submonoid.prod_mem h

/-- Sum of elements in an `subsemiring` of an `semiring` indexed by a `finset`
is in the `add_subsemiring`. -/
lemma sum_mem (s : subsemiring R)
  {ι : Type*} {t : finset ι} {f : ι → R} (h : ∀c ∈ t, f c ∈ s) :
  ∑ i in t, f i ∈ s :=
s.to_add_submonoid.sum_mem h

lemma pow_mem {R : Type*} [semiring R] (s : subsemiring R) {x : R} (hx : x ∈ s) (n : ℕ) :
  x^n ∈ s := s.to_submonoid.pow_mem hx n

lemma nsmul_mem {x : R} (hx : x ∈ s) (n : ℕ) :
  n • x ∈ s := s.to_add_submonoid.nsmul_mem hx n

lemma coe_nat_mem (n : ℕ) : (n : R) ∈ s :=
by simp only [← nsmul_one, nsmul_mem, one_mem]

/-- A subsemiring of a `non_assoc_semiring` inherits a `non_assoc_semiring` structure -/
instance to_non_assoc_semiring : non_assoc_semiring s :=
{ mul_zero := λ x, subtype.eq $ mul_zero x,
  zero_mul := λ x, subtype.eq $ zero_mul x,
  right_distrib := λ x y z, subtype.eq $ right_distrib x y z,
  left_distrib := λ x y z, subtype.eq $ left_distrib x y z,
  .. s.to_submonoid.to_mul_one_class, .. s.to_add_submonoid.to_add_comm_monoid }

@[simp, norm_cast] lemma coe_one : ((1 : s) : R) = (1 : R) := rfl
@[simp, norm_cast] lemma coe_zero : ((0 : s) : R) = (0 : R) := rfl
@[simp, norm_cast] lemma coe_add (x y : s) : ((x + y : s) : R) = (x + y : R) := rfl
@[simp, norm_cast] lemma coe_mul (x y : s) : ((x * y : s) : R) = (x * y : R) := rfl

instance nontrivial [nontrivial R] : nontrivial s :=
nontrivial_of_ne 0 1 $ λ H, zero_ne_one (congr_arg subtype.val H)

instance no_zero_divisors [no_zero_divisors R] : no_zero_divisors s :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y h,
  or.cases_on (eq_zero_or_eq_zero_of_mul_eq_zero $ subtype.ext_iff.mp h)
    (λ h, or.inl $ subtype.eq h) (λ h, or.inr $ subtype.eq h) }

/-- A subsemiring of a `semiring` is a `semiring`. -/
instance to_semiring {R} [semiring R] (s : subsemiring R) : semiring s :=
{ ..s.to_non_assoc_semiring, ..s.to_submonoid.to_monoid }

@[simp, norm_cast] lemma coe_pow {R} [semiring R] (s : subsemiring R) (x : s) (n : ℕ) :
  ((x^n : s) : R) = (x^n : R) :=
begin
  induction n with n ih,
  { simp, },
  { simp [pow_succ, ih], },
end

/-- A subsemiring of a `comm_semiring` is a `comm_semiring`. -/
instance to_comm_semiring {R} [comm_semiring R] (s : subsemiring R) : comm_semiring s :=
{ mul_comm := λ _ _, subtype.eq $ mul_comm _ _, ..s.to_semiring}

/-- The natural ring hom from a subsemiring of semiring `R` to `R`. -/
def subtype : s →+* R :=
{ to_fun := coe, .. s.to_submonoid.subtype, .. s.to_add_submonoid.subtype }

@[simp] theorem coe_subtype : ⇑s.subtype = coe := rfl

/-- A subsemiring of an `ordered_semiring` is an `ordered_semiring`. -/
instance to_ordered_semiring {R} [ordered_semiring R] (s : subsemiring R) : ordered_semiring s :=
subtype.coe_injective.ordered_semiring coe
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

/-- A subsemiring of an `ordered_comm_semiring` is an `ordered_comm_semiring`. -/
instance to_ordered_comm_semiring {R} [ordered_comm_semiring R] (s : subsemiring R) :
  ordered_comm_semiring s :=
subtype.coe_injective.ordered_comm_semiring coe
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

/-- A subsemiring of a `linear_ordered_semiring` is a `linear_ordered_semiring`. -/
instance to_linear_ordered_semiring {R} [linear_ordered_semiring R] (s : subsemiring R) :
  linear_ordered_semiring s :=
subtype.coe_injective.linear_ordered_semiring coe
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

/-! Note: currently, there is no `linear_ordered_comm_semiring`. -/

@[simp] lemma mem_to_submonoid {s : subsemiring R} {x : R} : x ∈ s.to_submonoid ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_submonoid (s : subsemiring R) : (s.to_submonoid : set R) = s := rfl
@[simp] lemma mem_to_add_submonoid {s : subsemiring R} {x : R} :
  x ∈ s.to_add_submonoid ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_add_submonoid (s : subsemiring R) : (s.to_add_submonoid : set R) = s := rfl

/-- The subsemiring `R` of the semiring `R`. -/
instance : has_top (subsemiring R) :=
⟨{ .. (⊤ : submonoid R), .. (⊤ : add_submonoid R) }⟩

@[simp] lemma mem_top (x : R) : x ∈ (⊤ : subsemiring R) := set.mem_univ x

@[simp] lemma coe_top : ((⊤ : subsemiring R) : set R) = set.univ := rfl

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

@[simp]

@[simp]
lemma mem_comap {s : subsemiring S} {f : R →+* S} {x : R} : x ∈ s.comap f ↔ f x ∈ s := iff.rfl

lemma comap_comap (s : subsemiring T) (g : S →+* T) (f : R →+* S) :
  (s.comap g).comap f = s.comap (g.comp f) :=
rfl

/-- The image of a subsemiring along a ring homomorphism is a subsemiring. -/
def map (f : R →+* S) (s : subsemiring R) : subsemiring S :=
{ carrier := f '' s,
  .. s.to_submonoid.map (f : R →* S), .. s.to_add_submonoid.map (f : R →+ S) }

@[simp] lemma coe_map (f : R →+* S) (s : subsemiring R) : (s.map f : set S) = f '' s := rfl

@[simp] lemma mem_map {f : R →+* S} {s : subsemiring R} {y : S} :
  y ∈ s.map f ↔ ∃ x ∈ s, f x = y :=
set.mem_image_iff_bex

@[simp] lemma map_id : s.map (ring_hom.id R) = s :=
set_like.coe_injective $ set.image_id _

lemma map_map (g : S →+* T) (f : R →+* S) : (s.map f).map g = s.map (g.comp f) :=
set_like.coe_injective $ set.image_image _ _ _

lemma map_le_iff_le_comap {f : R →+* S} {s : subsemiring R} {t : subsemiring S} :
  s.map f ≤ t ↔ s ≤ t.comap f :=
set.image_subset_iff

lemma gc_map_comap (f : R →+* S) : galois_connection (map f) (comap f) :=
λ S T, map_le_iff_le_comap

/-- A subsemiring is isomorphic to its image under an injective function -/
noncomputable def equiv_map_of_injective
  (f : R →+* S) (hf : function.injective f) : s ≃+* s.map f :=
{ map_mul' := λ _ _, subtype.ext (f.map_mul _ _),
  map_add' := λ _ _, subtype.ext (f.map_add _ _),
  ..equiv.set.image f s hf }

@[simp] lemma coe_equiv_map_of_injective_apply
  (f : R →+* S) (hf : function.injective f) (x : s) :
  (equiv_map_of_injective s f hf x : S) = f x := rfl

end subsemiring

namespace ring_hom

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

/-- The range of a ring homomorphism is a subsemiring. See Note [range copy pattern]. -/
def srange : subsemiring S :=
((⊤ : subsemiring R).map f).copy (set.range f) set.image_univ.symm

@[simp] lemma coe_srange : (f.srange : set S) = set.range f := rfl

@[simp] lemma mem_srange {f : R →+* S} {y : S} : y ∈ f.srange ↔ ∃ x, f x = y :=
iff.rfl

lemma srange_eq_map (f : R →+* S) : f.srange = (⊤ : subsemiring R).map f :=
by { ext, simp }

lemma mem_srange_self (f : R →+* S) (x : R) : f x ∈ f.srange :=
mem_srange.mpr ⟨x, rfl⟩

lemma map_srange : f.srange.map g = (g.comp f).srange :=
by simpa only [srange_eq_map] using (⊤ : subsemiring R).map_map g f

/-- The range of a morphism of semirings is a fintype, if the domain is a fintype.
Note: this instance can form a diamond with `subtype.fintype` in the
  presence of `fintype S`.-/
instance fintype_srange [fintype R] [decidable_eq S] (f : R →+* S) : fintype (srange f) :=
set.fintype_range f

end ring_hom

namespace subsemiring

instance : has_bot (subsemiring R) := ⟨(nat.cast_ring_hom R).srange⟩

instance : inhabited (subsemiring R) := ⟨⊥⟩

lemma coe_bot : ((⊥ : subsemiring R) : set R) = set.range (coe : ℕ → R) :=
(nat.cast_ring_hom R).coe_srange

lemma mem_bot {x : R} : x ∈ (⊥ : subsemiring R) ↔ ∃ n : ℕ, ↑n=x := ring_hom.mem_srange

/-- The inf of two subsemirings is their intersection. -/
instance : has_inf (subsemiring R) :=
⟨λ s t,
  { carrier := s ∩ t,
    .. s.to_submonoid ⊓ t.to_submonoid,
    .. s.to_add_submonoid ⊓ t.to_add_submonoid }⟩

@[simp] lemma coe_inf (p p' : subsemiring R) : ((p ⊓ p' : subsemiring R) : set R) = p ∩ p' := rfl

@[simp] lemma mem_inf {p p' : subsemiring R} {x : R} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' := iff.rfl

instance : has_Inf (subsemiring R) :=
⟨λ s, subsemiring.mk' (⋂ t ∈ s, ↑t) (⨅ t ∈ s, subsemiring.to_submonoid t) (by simp)
  (⨅ t ∈ s, subsemiring.to_add_submonoid t) (by simp)⟩

@[simp, norm_cast] lemma coe_Inf (S : set (subsemiring R)) :
  ((Inf S : subsemiring R) : set R) = ⋂ s ∈ S, ↑s := rfl

lemma mem_Inf {S : set (subsemiring R)} {x : R} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p := set.mem_Inter₂

@[simp] lemma Inf_to_submonoid (s : set (subsemiring R)) :
  (Inf s).to_submonoid = ⨅ t ∈ s, subsemiring.to_submonoid t :=
mk'_to_submonoid _ _

@[simp] lemma Inf_to_add_submonoid (s : set (subsemiring R)) :
  (Inf s).to_add_submonoid = ⨅ t ∈ s, subsemiring.to_add_submonoid t :=
mk'_to_add_submonoid _ _

/-- Subsemirings of a semiring form a complete lattice. -/
instance : complete_lattice (subsemiring R) :=
{ bot := (⊥),
  bot_le := λ s x hx, let ⟨n, hn⟩ := mem_bot.1 hx in hn ▸ s.coe_nat_mem n,
  top := (⊤),
  le_top := λ s x hx, trivial,
  inf := (⊓),
  inf_le_left := λ s t x, and.left,
  inf_le_right := λ s t x, and.right,
  le_inf := λ s t₁ t₂ h₁ h₂ x hx, ⟨h₁ hx, h₂ hx⟩,
  .. complete_lattice_of_Inf (subsemiring R)
    (λ s, is_glb.of_image (λ s t,
      show (s : set R) ≤ t ↔ s ≤ t, from set_like.coe_subset_coe) is_glb_binfi)}

lemma eq_top_iff' (A : subsemiring R) : A = ⊤ ↔ ∀ x : R, x ∈ A :=
eq_top_iff.trans ⟨λ h m, h $ mem_top m, λ h m _, h m⟩

section center

/-- The center of a semiring `R` is the set of elements that commute with everything in `R` -/
def center (R) [semiring R] : subsemiring R :=
{ carrier := set.center R,
  zero_mem' := set.zero_mem_center R,
  add_mem' := λ a b, set.add_mem_center,
  .. submonoid.center R }

lemma coe_center (R) [semiring R] : ↑(center R) = set.center R := rfl

@[simp]
lemma center_to_submonoid (R) [semiring R] : (center R).to_submonoid = submonoid.center R := rfl

lemma mem_center_iff {R} [semiring R] {z : R} : z ∈ center R ↔ ∀ g, g * z = z * g :=
iff.rfl

instance decidable_mem_center {R} [semiring R] [decidable_eq R] [fintype R] :
  decidable_pred (∈ center R) :=
λ _, decidable_of_iff' _ mem_center_iff

@[simp] lemma center_eq_top (R) [comm_semiring R] : center R = ⊤ :=
set_like.coe_injective (set.center_eq_univ R)

/-- The center is commutative. -/
instance {R} [semiring R] : comm_semiring (center R) :=
{ ..submonoid.center.comm_monoid,
  ..(center R).to_semiring}

end center

section centralizer

/-- The centralizer of a set as subsemiring. -/
def centralizer {R} [semiring R] (s : set R) : subsemiring R :=
{ carrier := s.centralizer,
  zero_mem' := set.zero_mem_centralizer _,
  add_mem' := λ x y hx hy, set.add_mem_centralizer hx hy,
  ..submonoid.centralizer s }

@[simp, norm_cast]
lemma coe_centralizer {R} [semiring R] (s : set R) : (centralizer s : set R) = s.centralizer := rfl

lemma centralizer_to_submonoid {R} [semiring R] (s : set R) :
  (centralizer s).to_submonoid = submonoid.centralizer s := rfl

lemma mem_centralizer_iff {R} [semiring R] {s : set R} {z : R} :
  z ∈ centralizer s ↔ ∀ g ∈ s, g * z = z * g :=
iff.rfl

lemma centralizer_le {R} [semiring R] (s t : set R) (h : s ⊆ t) :
  centralizer t ≤ centralizer s :=
set.centralizer_subset h

@[simp]
lemma centralizer_univ {R} [semiring R] : centralizer set.univ = center R :=
set_like.ext' (set.centralizer_univ R)

end centralizer

/-- The `subsemiring` generated by a set. -/
def closure (s : set R) : subsemiring R := Inf {S | s ⊆ S}

lemma mem_closure {x : R} {s : set R} : x ∈ closure s ↔ ∀ S : subsemiring R, s ⊆ S → x ∈ S :=
mem_Inf

/-- The subsemiring generated by a set includes the set. -/
@[simp] lemma subset_closure {s : set R} : s ⊆ closure s := λ x hx, mem_closure.2 $ λ S hS, hS hx

lemma not_mem_of_not_mem_closure {s : set R} {P : R} (hP : P ∉ closure s) : P ∉ s :=
λ h, hP (subset_closure h)

/-- A subsemiring `S` includes `closure s` if and only if it includes `s`. -/
@[simp]
lemma closure_le {s : set R} {t : subsemiring R} : closure s ≤ t ↔ s ⊆ t :=
⟨set.subset.trans subset_closure, λ h, Inf_le h⟩

/-- Subsemiring closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
lemma closure_mono ⦃s t : set R⦄ (h : s ⊆ t) : closure s ≤ closure t :=
closure_le.2 $ set.subset.trans h subset_closure

lemma closure_eq_of_le {s : set R} {t : subsemiring R} (h₁ : s ⊆ t) (h₂ : t ≤ closure s) :
  closure s = t :=
le_antisymm (closure_le.2 h₁) h₂

lemma mem_map_equiv {f : R ≃+* S} {K : subsemiring R} {x : S} :
  x ∈ K.map (f : R →+* S) ↔ f.symm x ∈ K :=
@set.mem_image_equiv _ _ ↑K f.to_equiv x

lemma map_equiv_eq_comap_symm (f : R ≃+* S) (K : subsemiring R) :
  K.map (f : R →+* S) = K.comap f.symm :=
set_like.coe_injective (f.to_equiv.image_eq_preimage K)

lemma comap_equiv_eq_map_symm (f : R ≃+* S) (K : subsemiring S) :
  K.comap (f : R →+* S) = K.map f.symm :=
(map_equiv_eq_comap_symm f.symm K).symm

end subsemiring

namespace submonoid

/-- The additive closure of a submonoid is a subsemiring. -/
def subsemiring_closure (M : submonoid R) : subsemiring R :=
{ one_mem' := add_submonoid.mem_closure.mpr (λ y hy, hy M.one_mem),
  mul_mem' := λ x y, M.mul_mem_add_closure,
  ..add_submonoid.closure (M : set R)}

lemma subsemiring_closure_coe :
  (M.subsemiring_closure : set R) = add_submonoid.closure (M : set R) := rfl

lemma subsemiring_closure_to_add_submonoid :
  M.subsemiring_closure.to_add_submonoid = add_submonoid.closure (M : set R) := rfl

/-- The `subsemiring` generated by a multiplicative submonoid coincides with the
`subsemiring.closure` of the submonoid itself . -/
lemma subsemiring_closure_eq_closure : M.subsemiring_closure = subsemiring.closure (M : set R) :=
begin
  ext,
  refine ⟨λ hx, _, λ hx, (subsemiring.mem_closure.mp hx) M.subsemiring_closure (λ s sM, _)⟩;
  rintros - ⟨H1, rfl⟩;
  rintros - ⟨H2, rfl⟩,
  { exact add_submonoid.mem_closure.mp hx H1.to_add_submonoid H2 },
  { exact H2 sM }
end

end submonoid

namespace subsemiring

@[simp]
lemma closure_submonoid_closure (s : set R) : closure ↑(submonoid.closure s) = closure s :=
le_antisymm
  (closure_le.mpr (λ y hy, (submonoid.mem_closure.mp hy) (closure s).to_submonoid subset_closure))
  (closure_mono (submonoid.subset_closure))

/-- The elements of the subsemiring closure of `M` are exactly the elements of the additive closure
of a multiplicative submonoid `M`. -/
lemma coe_closure_eq (s : set R) :
  (closure s : set R) = add_submonoid.closure (submonoid.closure s : set R) :=
by simp [← submonoid.subsemiring_closure_to_add_submonoid, submonoid.subsemiring_closure_eq_closure]

lemma mem_closure_iff {s : set R} {x} :
  x ∈ closure s ↔ x ∈ add_submonoid.closure (submonoid.closure s : set R) :=
set.ext_iff.mp (coe_closure_eq s) x

@[simp]
lemma closure_add_submonoid_closure {s : set R} : closure ↑(add_submonoid.closure s) = closure s :=
begin
  ext x,
  refine ⟨λ hx, _, λ hx, closure_mono add_submonoid.subset_closure hx⟩,
  rintros - ⟨H, rfl⟩,
  rintros - ⟨J, rfl⟩,
  refine (add_submonoid.mem_closure.mp (mem_closure_iff.mp hx)) H.to_add_submonoid (λ y hy, _),
  refine (submonoid.mem_closure.mp hy) H.to_submonoid (λ z hz, _),
  exact (add_submonoid.mem_closure.mp hz) H.to_add_submonoid (λ w hw, J hw),
end

/-- 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_eliminator]
lemma closure_induction {s : set R} {p : R → Prop} {x} (h : x ∈ closure s)
  (Hs : ∀ x ∈ s, p x) (H0 : p 0) (H1 : p 1)
  (Hadd : ∀ x y, p x → p y → p (x + y)) (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
(@closure_le _ _ _ ⟨p, Hmul, H1, Hadd, H0⟩).2 Hs h

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

lemma mem_closure_iff_exists_list {R} [semiring R] {s : set R} {x} : x ∈ closure s ↔
  ∃ L : list (list R), (∀ t ∈ L, ∀ y ∈ t, y ∈ s) ∧ (L.map list.prod).sum = x :=
⟨λ hx, add_submonoid.closure_induction (mem_closure_iff.1 hx)
  (λ x hx, suffices ∃ t : list R, (∀ y ∈ t, y ∈ s) ∧ t.prod = x,
    from let ⟨t, ht1, ht2⟩ := this in ⟨[t], list.forall_mem_singleton.2 ht1,
      by rw [list.map_singleton, list.sum_singleton, ht2]⟩,
    submonoid.closure_induction hx
      (λ x hx, ⟨[x], list.forall_mem_singleton.2 hx, one_mul x⟩)
      ⟨[], list.forall_mem_nil _, rfl⟩
      (λ x y ⟨t, ht1, ht2⟩ ⟨u, hu1, hu2⟩, ⟨t ++ u, list.forall_mem_append.2 ⟨ht1, hu1⟩,
        by rw [list.prod_append, ht2, hu2]⟩))
  ⟨[], list.forall_mem_nil _, rfl⟩
  (λ x y ⟨L, HL1, HL2⟩ ⟨M, HM1, HM2⟩, ⟨L ++ M, list.forall_mem_append.2 ⟨HL1, HM1⟩,
    by rw [list.map_append, list.sum_append, HL2, HM2]⟩),
λ ⟨L, HL1, HL2⟩, HL2 ▸ list_sum_mem _ (λ r hr, let ⟨t, ht1, ht2⟩ := list.mem_map.1 hr in
  ht2 ▸ list_prod_mem _ (λ y hy, subset_closure $ HL1 t ht1 y hy))⟩

variable (R)

/-- `closure` forms a Galois insertion with the coercion to set. -/
protected def gi : galois_insertion (@closure R _) coe :=
{ choice := λ s _, closure s,
  gc := λ s t, closure_le,
  le_l_u := λ s, subset_closure,
  choice_eq := λ s h, rfl }

variable {R}

/-- Closure of a subsemiring `S` equals `S`. -/
lemma closure_eq (s : subsemiring R) : closure (s : set R) = s := (subsemiring.gi R).l_u_eq s

@[simp] lemma closure_empty : closure (∅ : set R) = ⊥ := (subsemiring.gi R).gc.l_bot

@[simp] lemma closure_univ : closure (set.univ : set R) = ⊤ := @coe_top R _ ▸ closure_eq ⊤

lemma closure_union (s t : set R) : closure (s ∪ t) = closure s ⊔ closure t :=
(subsemiring.gi R).gc.l_sup

lemma closure_Union {ι} (s : ι → set R) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
(subsemiring.gi R).gc.l_supr

lemma closure_sUnion (s : set (set R)) : closure (⋃₀ s) = ⨆ t ∈ s, closure t :=
(subsemiring.gi R).gc.l_Sup

lemma map_sup (s t : subsemiring R) (f : R →+* S) : (s ⊔ t).map f = s.map f ⊔ t.map f :=
(gc_map_comap f).l_sup

lemma map_supr {ι : Sort*} (f : R →+* S) (s : ι → subsemiring R) :
  (supr s).map f = ⨆ i, (s i).map f :=
(gc_map_comap f).l_supr

lemma comap_inf (s t : subsemiring S) (f : R →+* S) : (s ⊓ t).comap f = s.comap f ⊓ t.comap f :=
(gc_map_comap f).u_inf

lemma comap_infi {ι : Sort*} (f : R →+* S) (s : ι → subsemiring S) :
  (infi s).comap f = ⨅ i, (s i).comap f :=
(gc_map_comap f).u_infi

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

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

/-- Given `subsemiring`s `s`, `t` of semirings `R`, `S` respectively, `s.prod t` is `s × t`
as a subsemiring of `R × S`. -/
def prod (s : subsemiring R) (t : subsemiring S) : subsemiring (R × S) :=
{ carrier := (s : set R) ×ˢ (t : set S),
  .. s.to_submonoid.prod t.to_submonoid, .. s.to_add_submonoid.prod t.to_add_submonoid}

@[norm_cast]
lemma coe_prod (s : subsemiring R) (t : subsemiring S) :
  (s.prod t : set (R × S)) = (s : set R) ×ˢ (t : set S) :=
rfl

lemma mem_prod {s : subsemiring R} {t : subsemiring S} {p : R × S} :
  p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl

@[mono] lemma prod_mono ⦃s₁ s₂ : subsemiring R⦄ (hs : s₁ ≤ s₂) ⦃t₁ t₂ : subsemiring S⦄
  (ht : t₁ ≤ t₂) : s₁.prod t₁ ≤ s₂.prod t₂ :=
set.prod_mono hs ht

lemma prod_mono_right (s : subsemiring R) : monotone (λ t : subsemiring S, s.prod t) :=
prod_mono (le_refl s)

lemma prod_mono_left (t : subsemiring S) : monotone (λ s : subsemiring R, s.prod t) :=
λ s₁ s₂ hs, prod_mono hs (le_refl t)

lemma prod_top (s : subsemiring R) :
  s.prod (⊤ : subsemiring S) = s.comap (ring_hom.fst R S) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_fst]

lemma top_prod (s : subsemiring S) :
  (⊤ : subsemiring R).prod s = s.comap (ring_hom.snd R S) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_snd]

@[simp]
lemma top_prod_top : (⊤ : subsemiring R).prod (⊤ : subsemiring S) = ⊤ :=
(top_prod _).trans $ comap_top _

/-- Product of subsemirings is isomorphic to their product as monoids. -/
def prod_equiv (s : subsemiring R) (t : subsemiring S) : s.prod t ≃+* s × t :=
{ map_mul' := λ x y, rfl, map_add' := λ x y, rfl, .. equiv.set.prod ↑s ↑t }

lemma mem_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subsemiring R} (hS : directed (≤) S)
  {x : R} :
  x ∈ (⨆ i, S i) ↔ ∃ i, x ∈ S i :=
begin
  refine ⟨_, λ ⟨i, hi⟩, (set_like.le_def.1 $ le_supr S i) hi⟩,
  let U : subsemiring R := subsemiring.mk' (⋃ i, (S i : set R))
    (⨆ i, (S i).to_submonoid) (submonoid.coe_supr_of_directed $ hS.mono_comp _ (λ _ _, id))
    (⨆ i, (S i).to_add_submonoid) (add_submonoid.coe_supr_of_directed $ hS.mono_comp _ (λ _ _, id)),
  suffices : (⨆ i, S i) ≤ U, by simpa using @this x,
  exact supr_le (λ i x hx, set.mem_Union.2 ⟨i, hx⟩),
end

lemma coe_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subsemiring R} (hS : directed (≤) S) :
  ((⨆ i, S i : subsemiring R) : set R) = ⋃ i, ↑(S i) :=
set.ext $ λ x, by simp [mem_supr_of_directed hS]

lemma mem_Sup_of_directed_on {S : set (subsemiring R)} (Sne : S.nonempty)
  (hS : directed_on (≤) S) {x : R} :
  x ∈ Sup S ↔ ∃ s ∈ S, x ∈ s :=
begin
  haveI : nonempty S := Sne.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed hS.directed_coe, set_coe.exists, subtype.coe_mk]
end

lemma coe_Sup_of_directed_on {S : set (subsemiring R)} (Sne : S.nonempty) (hS : directed_on (≤) S) :
  (↑(Sup S) : set R) = ⋃ s ∈ S, ↑s :=
set.ext $ λ x, by simp [mem_Sup_of_directed_on Sne hS]

end subsemiring

namespace ring_hom

variables [non_assoc_semiring T] {s : subsemiring R}

open subsemiring

/-- Restriction of a ring homomorphism to a subsemiring of the domain. -/
def srestrict (f : R →+* S) (s : subsemiring R) : s →+* S := f.comp s.subtype

@[simp] lemma srestrict_apply (f : R →+* S) (x : s) : f.srestrict s x = f x := rfl

/-- Restriction of a ring homomorphism to a subsemiring of the codomain. -/
def cod_srestrict (f : R →+* S) (s : subsemiring S) (h : ∀ x, f x ∈ s) : R →+* s :=
{ to_fun := λ n, ⟨f n, h n⟩,
  .. (f : R →* S).cod_mrestrict s.to_submonoid h,
  .. (f : R →+ S).cod_mrestrict s.to_add_submonoid h }

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

This is the bundled version of `set.range_factorization`. -/
def srange_restrict (f : R →+* S) : R →+* f.srange :=
f.cod_srestrict f.srange f.mem_srange_self

@[simp] lemma coe_srange_restrict (f : R →+* S) (x : R) :
  (f.srange_restrict x : S) = f x :=
rfl

lemma srange_restrict_surjective (f : R →+* S) : function.surjective f.srange_restrict :=
λ ⟨y, hy⟩, let ⟨x, hx⟩ := mem_srange.mp hy in ⟨x, subtype.ext hx⟩

lemma srange_top_iff_surjective {f : R →+* S} :
  f.srange = (⊤ : subsemiring S) ↔ function.surjective f :=
set_like.ext'_iff.trans $ iff.trans (by rw [coe_srange, coe_top]) set.range_iff_surjective

/-- The range of a surjective ring homomorphism is the whole of the codomain. -/
lemma srange_top_of_surjective (f : R →+* S) (hf : function.surjective f) :
  f.srange = (⊤ : subsemiring S) :=
srange_top_iff_surjective.2 hf

/-- The subsemiring of elements `x : R` such that `f x = g x` -/
def eq_slocus (f g : R →+* S) : subsemiring R :=
{ carrier := {x | f x = g x}, .. (f : R →* S).eq_mlocus g, .. (f : R →+ S).eq_mlocus g }

/-- If two ring homomorphisms are equal on a set, then they are equal on its subsemiring closure. -/
lemma eq_on_sclosure {f g : R →+* S} {s : set R} (h : set.eq_on f g s) :
  set.eq_on f g (closure s) :=
show closure s ≤ f.eq_slocus g, from closure_le.2 h

lemma eq_of_eq_on_stop {f g : R →+* S} (h : set.eq_on f g (⊤ : subsemiring R)) :
  f = g :=
ext $ λ x, h trivial

lemma eq_of_eq_on_sdense {s : set R} (hs : closure s = ⊤) {f g : R →+* S} (h : s.eq_on f g) :
  f = g :=
eq_of_eq_on_stop $ hs ▸ eq_on_sclosure h

lemma sclosure_preimage_le (f : R →+* S) (s : set S) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

/-- The image under a ring homomorphism of the subsemiring generated by a set equals
the subsemiring generated by the image of the set. -/
lemma map_sclosure (f : R →+* S) (s : set R) :
  (closure s).map f = closure (f '' s) :=
le_antisymm
  (map_le_iff_le_comap.2 $ le_trans (closure_mono $ set.subset_preimage_image _ _)
    (sclosure_preimage_le _ _))
  (closure_le.2 $ set.image_subset _ subset_closure)

end ring_hom

namespace subsemiring

open ring_hom

/-- The ring homomorphism associated to an inclusion of subsemirings. -/
def inclusion {S T : subsemiring R} (h : S ≤ T) : S →* T :=
S.subtype.cod_srestrict _ (λ x, h x.2)

@[simp] lemma srange_subtype (s : subsemiring R) : s.subtype.srange = s :=
set_like.coe_injective $ (coe_srange _).trans subtype.range_coe

@[simp]
lemma range_fst : (fst R S).srange = ⊤ :=
(fst R S).srange_top_of_surjective $ prod.fst_surjective

@[simp]
lemma range_snd : (snd R S).srange = ⊤ :=
(snd R S).srange_top_of_surjective $ prod.snd_surjective

@[simp]
lemma prod_bot_sup_bot_prod (s : subsemiring R) (t : subsemiring S) :
  (s.prod ⊥) ⊔ (prod ⊥ t) = s.prod t :=
le_antisymm (sup_le (prod_mono_right s bot_le) (prod_mono_left t bot_le)) $
assume p hp, prod.fst_mul_snd p ▸ mul_mem _
  ((le_sup_left : s.prod ⊥ ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨hp.1, set_like.mem_coe.2 $ one_mem ⊥⟩)
  ((le_sup_right : prod ⊥ t ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨set_like.mem_coe.2 $ one_mem ⊥, hp.2⟩)

end subsemiring

namespace ring_equiv

variables {s t : subsemiring R}

/-- Makes the identity isomorphism from a proof two subsemirings of a multiplicative
    monoid are equal. -/
def subsemiring_congr (h : s = t) : s ≃+* t :=
{ map_mul' :=  λ _ _, rfl, map_add' := λ _ _, rfl, ..equiv.set_congr $ congr_arg _ h }

/-- Restrict a ring homomorphism with a left inverse to a ring isomorphism to its
`ring_hom.srange`. -/
def sof_left_inverse {g : S → R} {f : R →+* S} (h : function.left_inverse g f) :
  R ≃+* f.srange :=
{ to_fun := λ x, f.srange_restrict x,
  inv_fun := λ x, (g ∘ f.srange.subtype) x,
  left_inv := h,
  right_inv := λ x, subtype.ext $
    let ⟨x', hx'⟩ := ring_hom.mem_srange.mp x.prop in
    show f (g x) = x, by rw [←hx', h x'],
  ..f.srange_restrict }

@[simp] lemma sof_left_inverse_apply
  {g : S → R} {f : R →+* S} (h : function.left_inverse g f) (x : R) :
  ↑(sof_left_inverse h x) = f x := rfl

@[simp] lemma sof_left_inverse_symm_apply
  {g : S → R} {f : R →+* S} (h : function.left_inverse g f) (x : f.srange) :
  (sof_left_inverse h).symm x = g x := rfl

/-- Given an equivalence `e : R ≃+* S` of semirings and a subsemiring `s` of `R`,
`subsemiring_map e s` is the induced equivalence between `s` and `s.map e` -/
@[simps] def subsemiring_map (e : R ≃+* S) (s : subsemiring R) :
  s ≃+* s.map e.to_ring_hom :=
{ ..e.to_add_equiv.add_submonoid_map s.to_add_submonoid,
  ..e.to_mul_equiv.submonoid_map s.to_submonoid }

end ring_equiv

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

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

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

namespace subsemiring

variables {R' α β : Type*}

section non_assoc_semiring
variables [non_assoc_semiring R']

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [has_scalar R' α] (S : subsemiring R') : has_scalar S α := S.to_submonoid.has_scalar

lemma smul_def [has_scalar R' α] {S : subsemiring R'} (g : S) (m : α) : g • m = (g : R') • m := rfl

instance smul_comm_class_left
  [has_scalar R' β] [has_scalar α β] [smul_comm_class R' α β] (S : subsemiring R') :
  smul_comm_class S α β :=
S.to_submonoid.smul_comm_class_left

instance smul_comm_class_right
  [has_scalar α β] [has_scalar R' β] [smul_comm_class α R' β] (S : subsemiring R') :
  smul_comm_class α S β :=
S.to_submonoid.smul_comm_class_right

/-- Note that this provides `is_scalar_tower S R R` which is needed by `smul_mul_assoc`. -/
instance [has_scalar α β] [has_scalar R' α] [has_scalar R' β] [is_scalar_tower R' α β]
  (S : subsemiring R') :
  is_scalar_tower S α β :=
S.to_submonoid.is_scalar_tower

instance [has_scalar R' α] [has_faithful_scalar R' α] (S : subsemiring R') :
  has_faithful_scalar S α :=
S.to_submonoid.has_faithful_scalar

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [has_zero α] [smul_with_zero R' α] (S : subsemiring R') : smul_with_zero S α :=
smul_with_zero.comp_hom _ S.subtype.to_monoid_with_zero_hom.to_zero_hom

end non_assoc_semiring

variables [semiring R']

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [mul_action R' α] (S : subsemiring R') : mul_action S α :=
S.to_submonoid.mul_action

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [add_monoid α] [distrib_mul_action R' α] (S : subsemiring R') : distrib_mul_action S α :=
S.to_submonoid.distrib_mul_action

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [monoid α] [mul_distrib_mul_action R' α] (S : subsemiring R') :
  mul_distrib_mul_action S α :=
S.to_submonoid.mul_distrib_mul_action

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [has_zero α] [mul_action_with_zero R' α] (S : subsemiring R') : mul_action_with_zero S α :=
mul_action_with_zero.comp_hom _ S.subtype.to_monoid_with_zero_hom

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [add_comm_monoid α] [module R' α] (S : subsemiring R') : module S α :=
{ smul := (•), .. module.comp_hom _ S.subtype }

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

end subsemiring

end actions

-- While this definition is not about `subsemiring`s, this is the earliest we have
-- both `ordered_semiring` and `submonoid` available.

/-- Submonoid of positive elements of an ordered semiring. -/
def pos_submonoid (R : Type*) [ordered_semiring R] [nontrivial R] : submonoid R :=
{ carrier := {x | 0 < x},
  one_mem' := show (0 : R) < 1, from zero_lt_one,
  mul_mem' := λ x y (hx : 0 < x) (hy : 0 < y), mul_pos hx hy }

@[simp] lemma mem_pos_monoid {R : Type*} [ordered_semiring R] [nontrivial R] (u : Rˣ) :
  ↑u ∈ pos_submonoid R ↔ (0 : R) < u := iff.rfl


import algebra.module.basic
import algebra.module.linear_map
import linear_algebra.basic
import linear_algebra.prod
import linear_algebra.projection
import order.bounded_lattice
import logic.function.conjugate

-- Montrer qu'un endomorphisme f d'un K -espace vectoriel E commute avec un
-- projecteur p si, et seulement si, les espaces Im(p) et Ker(p) sont stables par f .

theorem cpge_reduction_2
  {K : Type*} [ring K] {E : Type*}
  [add_comm_group E] [module K E]
  (A B : submodule K E)
  (h : is_compl A B)
  (u : linear_map K E E):
  let p: linear_map K E E := A.subtype.comp (A.linear_proj_of_is_compl B h) in
  function.commute p u <-> (A.map u = A /\ B.map u = B)
:= sorry


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.char_p.basic
import Mathlib.data.equiv.ring
import Mathlib.algebra.group_with_zero.power
import Mathlib.algebra.iterate_hom
import Mathlib.PostPort

universes u l v u_1

namespace Mathlib

/-!
# The perfect closure of a field
-/

/-- A perfect ring is a ring of characteristic p that has p-th root. -/
class perfect_ring (R : Type u) [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p]
where
  pth_root' : R → R
  frobenius_pth_root' : ∀ (x : R), coe_fn (frobenius R p) (pth_root' x) = x
  pth_root_frobenius' : ∀ (x : R), pth_root' (coe_fn (frobenius R p) x) = x

/-- Frobenius automorphism of a perfect ring. -/
def frobenius_equiv (R : Type u) [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] [perfect_ring R p] : R ≃+* R :=
  ring_equiv.mk (ring_hom.to_fun (frobenius R p)) (perfect_ring.pth_root' p) perfect_ring.pth_root_frobenius'
    perfect_ring.frobenius_pth_root' sorry sorry

/-- `p`-th root of an element in a `perfect_ring` as a `ring_hom`. -/
def pth_root (R : Type u) [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] [perfect_ring R p] : R →+* R :=
  ↑(ring_equiv.symm (frobenius_equiv R p))

@[simp] theorem coe_frobenius_equiv {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] : ⇑(frobenius_equiv R p) = ⇑(frobenius R p) :=
  rfl

@[simp] theorem coe_frobenius_equiv_symm {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] : ⇑(ring_equiv.symm (frobenius_equiv R p)) = ⇑(pth_root R p) :=
  rfl

@[simp] theorem frobenius_pth_root {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] (x : R) : coe_fn (frobenius R p) (coe_fn (pth_root R p) x) = x :=
  ring_equiv.apply_symm_apply (frobenius_equiv R p) x

@[simp] theorem pth_root_pow_p {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] (x : R) : coe_fn (pth_root R p) x ^ p = x :=
  frobenius_pth_root x

@[simp] theorem pth_root_frobenius {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] (x : R) : coe_fn (pth_root R p) (coe_fn (frobenius R p) x) = x :=
  ring_equiv.symm_apply_apply (frobenius_equiv R p) x

@[simp] theorem pth_root_pow_p' {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] (x : R) : coe_fn (pth_root R p) (x ^ p) = x :=
  pth_root_frobenius x

theorem left_inverse_pth_root_frobenius {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] : function.left_inverse ⇑(pth_root R p) ⇑(frobenius R p) :=
  pth_root_frobenius

theorem right_inverse_pth_root_frobenius {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] : function.right_inverse ⇑(pth_root R p) ⇑(frobenius R p) :=
  frobenius_pth_root

theorem commute_frobenius_pth_root {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] : function.commute ⇑(frobenius R p) ⇑(pth_root R p) :=
  fun (x : R) => Eq.trans (frobenius_pth_root x) (Eq.symm (pth_root_frobenius x))

theorem eq_pth_root_iff {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] {x : R} {y : R} : x = coe_fn (pth_root R p) y ↔ coe_fn (frobenius R p) x = y :=
  equiv.eq_symm_apply (ring_equiv.to_equiv (frobenius_equiv R p))

theorem pth_root_eq_iff {R : Type u} [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] {x : R} {y : R} : coe_fn (pth_root R p) x = y ↔ x = coe_fn (frobenius R p) y :=
  equiv.symm_apply_eq (ring_equiv.to_equiv (frobenius_equiv R p))

theorem monoid_hom.map_pth_root {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] (f : R →* S) {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] [char_p S p] [perfect_ring S p] (x : R) : coe_fn f (coe_fn (pth_root R p) x) = coe_fn (pth_root S p) (coe_fn f x) := sorry

theorem monoid_hom.map_iterate_pth_root {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] (f : R →* S) {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] [char_p S p] [perfect_ring S p] (x : R) (n : ℕ) : coe_fn f (nat.iterate (⇑(pth_root R p)) n x) = nat.iterate (⇑(pth_root S p)) n (coe_fn f x) :=
  function.semiconj.iterate_right (monoid_hom.map_pth_root f) n x

theorem ring_hom.map_pth_root {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] (g : R →+* S) {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] [char_p S p] [perfect_ring S p] (x : R) : coe_fn g (coe_fn (pth_root R p) x) = coe_fn (pth_root S p) (coe_fn g x) :=
  monoid_hom.map_pth_root (ring_hom.to_monoid_hom g) x

theorem ring_hom.map_iterate_pth_root {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] (g : R →+* S) {p : ℕ} [fact (nat.prime p)] [char_p R p] [perfect_ring R p] [char_p S p] [perfect_ring S p] (x : R) (n : ℕ) : coe_fn g (nat.iterate (⇑(pth_root R p)) n x) = nat.iterate (⇑(pth_root S p)) n (coe_fn g x) :=
  monoid_hom.map_iterate_pth_root (ring_hom.to_monoid_hom g) x n

theorem injective_pow_p {R : Type u} [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] [perfect_ring R p] {x : R} {y : R} (hxy : x ^ p = y ^ p) : x = y :=
  function.left_inverse.injective left_inverse_pth_root_frobenius hxy

/-- `perfect_closure K p` is the quotient by this relation. -/
inductive perfect_closure.r (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : ℕ × K → ℕ × K → Prop
where
| intro : ∀ (n : ℕ) (x : K), perfect_closure.r K p (n, x) (n + 1, coe_fn (frobenius K p) x)

/-- The perfect closure is the smallest extension that makes frobenius surjective. -/
def perfect_closure (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] :=
  Quot sorry

namespace perfect_closure

/-- Constructor for `perfect_closure`. -/
def mk (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ × K) : perfect_closure K p :=
  Quot.mk (r K p) x

@[simp] theorem quot_mk_eq_mk (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ × K) : Quot.mk (r K p) x = mk K p x :=
  rfl

/-- Lift a function `ℕ × K → L` to a function on `perfect_closure K p`. -/
def lift_on {K : Type u} [comm_ring K] {p : ℕ} [fact (nat.prime p)] [char_p K p] {L : Type u_1} (x : perfect_closure K p) (f : ℕ × K → L) (hf : ∀ (x y : ℕ × K), r K p x y → f x = f y) : L :=
  quot.lift_on x f hf

@[simp] theorem lift_on_mk {K : Type u} [comm_ring K] {p : ℕ} [fact (nat.prime p)] [char_p K p] {L : Type u_1} (f : ℕ × K → L) (hf : ∀ (x y : ℕ × K), r K p x y → f x = f y) (x : ℕ × K) : lift_on (mk K p x) f hf = f x :=
  rfl

theorem induction_on {K : Type u} [comm_ring K] {p : ℕ} [fact (nat.prime p)] [char_p K p] (x : perfect_closure K p) {q : perfect_closure K p → Prop} (h : ∀ (x : ℕ × K), q (mk K p x)) : q x :=
  quot.induction_on x h

protected instance has_mul (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : Mul (perfect_closure K p) :=
  { mul :=
      Quot.lift
        (fun (x : ℕ × K) =>
          Quot.lift
            (fun (y : ℕ × K) =>
              mk K p
                (prod.fst x + prod.fst y,
                nat.iterate (⇑(frobenius K p)) (prod.fst y) (prod.snd x) *
                  nat.iterate (⇑(frobenius K p)) (prod.fst x) (prod.snd y)))
            (mul_aux_right K p x))
        sorry }

@[simp] theorem mk_mul_mk (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ × K) (y : ℕ × K) : mk K p x * mk K p y =
  mk K p
    (prod.fst x + prod.fst y,
    nat.iterate (⇑(frobenius K p)) (prod.fst y) (prod.snd x) * nat.iterate (⇑(frobenius K p)) (prod.fst x) (prod.snd y)) :=
  rfl

protected instance comm_monoid (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : comm_monoid (perfect_closure K p) :=
  comm_monoid.mk Mul.mul sorry (mk K p (0, 1)) sorry sorry sorry

theorem one_def (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : 1 = mk K p (0, 1) :=
  rfl

protected instance inhabited (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : Inhabited (perfect_closure K p) :=
  { default := 1 }

protected instance has_add (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : Add (perfect_closure K p) :=
  { add :=
      Quot.lift
        (fun (x : ℕ × K) =>
          Quot.lift
            (fun (y : ℕ × K) =>
              mk K p
                (prod.fst x + prod.fst y,
                nat.iterate (⇑(frobenius K p)) (prod.fst y) (prod.snd x) +
                  nat.iterate (⇑(frobenius K p)) (prod.fst x) (prod.snd y)))
            (add_aux_right K p x))
        sorry }

@[simp] theorem mk_add_mk (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ × K) (y : ℕ × K) : mk K p x + mk K p y =
  mk K p
    (prod.fst x + prod.fst y,
    nat.iterate (⇑(frobenius K p)) (prod.fst y) (prod.snd x) + nat.iterate (⇑(frobenius K p)) (prod.fst x) (prod.snd y)) :=
  rfl

protected instance has_neg (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : Neg (perfect_closure K p) :=
  { neg := Quot.lift (fun (x : ℕ × K) => mk K p (prod.fst x, -prod.snd x)) sorry }

@[simp] theorem neg_mk (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ × K) : -mk K p x = mk K p (prod.fst x, -prod.snd x) :=
  rfl

protected instance has_zero (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : HasZero (perfect_closure K p) :=
  { zero := mk K p (0, 0) }

theorem zero_def (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : 0 = mk K p (0, 0) :=
  rfl

theorem mk_zero (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (n : ℕ) : mk K p (n, 0) = 0 := sorry

theorem r.sound (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (m : ℕ) (n : ℕ) (x : K) (y : K) (H : nat.iterate (⇑(frobenius K p)) m x = y) : mk K p (n, x) = mk K p (m + n, y) := sorry

protected instance comm_ring (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : comm_ring (perfect_closure K p) :=
  comm_ring.mk Add.add sorry 0 sorry sorry Neg.neg (ring.sub._default Add.add sorry 0 sorry sorry Neg.neg) sorry sorry
    comm_monoid.mul sorry comm_monoid.one sorry sorry sorry sorry sorry

theorem eq_iff' (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ × K) (y : ℕ × K) : mk K p x = mk K p y ↔
  ∃ (z : ℕ),
    nat.iterate (⇑(frobenius K p)) (prod.fst y + z) (prod.snd x) =
      nat.iterate (⇑(frobenius K p)) (prod.fst x + z) (prod.snd y) := sorry

theorem nat_cast (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (n : ℕ) (x : ℕ) : ↑x = mk K p (n, ↑x) := sorry

theorem int_cast (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℤ) : ↑x = mk K p (0, ↑x) := sorry

theorem nat_cast_eq_iff (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ) (y : ℕ) : ↑x = ↑y ↔ ↑x = ↑y := sorry

protected instance char_p (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : char_p (perfect_closure K p) p :=
  char_p.mk
    fun (x : ℕ) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (↑x = 0 ↔ p ∣ x)) (Eq.symm (propext (char_p.cast_eq_zero_iff K p x)))))
        (eq.mpr (id (Eq._oldrec (Eq.refl (↑x = 0 ↔ ↑x = 0)) (Eq.symm nat.cast_zero)))
          (eq.mpr (id (Eq._oldrec (Eq.refl (↑x = ↑0 ↔ ↑x = 0)) (propext (nat_cast_eq_iff K p x 0))))
            (eq.mpr (id (Eq._oldrec (Eq.refl (↑x = ↑0 ↔ ↑x = 0)) nat.cast_zero)) (iff.refl (↑x = 0)))))

theorem frobenius_mk (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ × K) : coe_fn (frobenius (perfect_closure K p) p) (mk K p x) = mk K p (prod.fst x, prod.snd x ^ p) := sorry

/-- Embedding of `K` into `perfect_closure K p` -/
def of (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : K →+* perfect_closure K p :=
  ring_hom.mk (fun (x : K) => mk K p (0, x)) sorry sorry sorry sorry

theorem of_apply (K : Type u) [comm_ring K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : K) : coe_fn (of K p) x = mk K p (0, x) :=
  rfl

theorem eq_iff (K : Type u) [integral_domain K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ × K) (y : ℕ × K) : Quot.mk (r K p) x = Quot.mk (r K p) y ↔
  nat.iterate (⇑(frobenius K p)) (prod.fst y) (prod.snd x) = nat.iterate (⇑(frobenius K p)) (prod.fst x) (prod.snd y) := sorry

protected instance has_inv (K : Type u) [field K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : has_inv (perfect_closure K p) :=
  has_inv.mk (Quot.lift (fun (x : ℕ × K) => Quot.mk (r K p) (prod.fst x, prod.snd x⁻¹)) sorry)

protected instance field (K : Type u) [field K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : field (perfect_closure K p) :=
  field.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry comm_ring.mul sorry
    comm_ring.one sorry sorry sorry sorry sorry has_inv.inv sorry sorry sorry

protected instance perfect_ring (K : Type u) [field K] (p : ℕ) [fact (nat.prime p)] [char_p K p] : perfect_ring (perfect_closure K p) p :=
  perfect_ring.mk
    (fun (e : perfect_closure K p) => lift_on e (fun (x : ℕ × K) => mk K p (prod.fst x + 1, prod.snd x)) sorry) sorry
    sorry

theorem eq_pth_root (K : Type u) [field K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (x : ℕ × K) : mk K p x = nat.iterate (⇑(pth_root (perfect_closure K p) p)) (prod.fst x) (coe_fn (of K p) (prod.snd x)) := sorry

/-- Given a field `K` of characteristic `p` and a perfect ring `L` of the same characteristic,
any homomorphism `K →+* L` can be lifted to `perfect_closure K p`. -/
def lift (K : Type u) [field K] (p : ℕ) [fact (nat.prime p)] [char_p K p] (L : Type v) [comm_semiring L] [char_p L p] [perfect_ring L p] : (K →+* L) ≃ (perfect_closure K p →+* L) :=
  equiv.mk
    (fun (f : K →+* L) =>
      ring_hom.mk
        (fun (e : perfect_closure K p) =>
          lift_on e (fun (x : ℕ × K) => nat.iterate (⇑(pth_root L p)) (prod.fst x) (coe_fn f (prod.snd x))) sorry)
        sorry sorry sorry sorry)
    (fun (f : perfect_closure K p →+* L) => ring_hom.comp f (of K p)) sorry sorry


/-
Copyright (c) 2020 Johan Commelin, Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis

! This file was ported from Lean 3 source module ring_theory.witt_vector.init_tail
! leanprover-community/mathlib commit 0798037604b2d91748f9b43925fb7570a5f3256c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.WittVector.Basic
import Mathbin.RingTheory.WittVector.IsPoly

/-!

# `init` and `tail`

Given a Witt vector `x`, we are sometimes interested
in its components before and after an index `n`.
This file defines those operations, proves that `init` is polynomial,
and shows how that polynomial interacts with `mv_polynomial.bind₁`.

## Main declarations

* `witt_vector.init n x`: the first `n` coefficients of `x`, as a Witt vector. All coefficients at
  indices ≥ `n` are 0.
* `witt_vector.tail n x`: the complementary part to `init`. All coefficients at indices < `n` are 0,
  otherwise they are the same as in `x`.
* `witt_vector.coeff_add_of_disjoint`: if `x` and `y` are Witt vectors such that for every `n`
  the `n`-th coefficient of `x` or of `y` is `0`, then the coefficients of `x + y`
  are just `x.coeff n + y.coeff n`.

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]

-/

variable {p : ℕ} [hp : Fact p.Prime] (n : ℕ) {R : Type _} [CommRing R]

-- mathport name: expr𝕎
local notation "𝕎" => WittVector p

-- type as `\bbW`
namespace Tactic

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `init_ring` is an auxiliary tactic that discharges goals factoring `init` over ring operations.
      -/
    unsafe
  def
    init_ring
    ( assert : parse ( tk "using" *> parser.pexpr ) ? ) : tactic Unit
    :=
      do
        sorry
          match
            assert
            with
            | none => skip | some e => do sorry tactic.replace `h `( $ ( e ) p _ h ) sorry
#align tactic.interactive.init_ring tactic.interactive.init_ring

end Interactive

end Tactic

namespace WittVector

open MvPolynomial

open Classical

noncomputable section

section

/-- `witt_vector.select P x`, for a predicate `P : ℕ → Prop` is the Witt vector
whose `n`-th coefficient is `x.coeff n` if `P n` is true, and `0` otherwise.
-/
def select (P : ℕ → Prop) (x : 𝕎 R) : 𝕎 R :=
  mk p fun n => if P n then x.coeff n else 0
#align witt_vector.select WittVector.select

section Select

variable (P : ℕ → Prop)

/-- The polynomial that witnesses that `witt_vector.select` is a polynomial function.
`select_poly n` is `X n` if `P n` holds, and `0` otherwise. -/
def selectPoly (n : ℕ) : MvPolynomial ℕ ℤ :=
  if P n then X n else 0
#align witt_vector.select_poly WittVector.selectPoly

theorem coeff_select (x : 𝕎 R) (n : ℕ) : (select P x).coeff n = aeval x.coeff (selectPoly P n) :=
  by
  dsimp [select, select_poly]
  split_ifs with hi
  · rw [aeval_X]
  · rw [AlgHom.map_zero]
#align witt_vector.coeff_select WittVector.coeff_select

@[is_poly]
theorem selectIsPoly (P : ℕ → Prop) : IsPoly p fun R _Rcr x => select P x :=
  by
  use select_poly P
  rintro R _Rcr x
  funext i
  apply coeff_select
#align witt_vector.select_is_poly WittVector.selectIsPoly

include hp

theorem select_add_select_not : ∀ x : 𝕎 R, select P x + select (fun i => ¬P i) x = x :=
  by
  ghost_calc _
  intro n
  simp only [RingHom.map_add]
  suffices
    (bind₁ (select_poly P)) (wittPolynomial p ℤ n) +
        (bind₁ (select_poly fun i => ¬P i)) (wittPolynomial p ℤ n) =
      wittPolynomial p ℤ n
    by
    apply_fun aeval x.coeff  at this
    simpa only [AlgHom.map_add, aeval_bind₁, ← coeff_select]
  simp only [wittPolynomial_eq_sum_c_mul_x_pow, select_poly, AlgHom.map_sum, AlgHom.map_pow,
    AlgHom.map_mul, bind₁_X_right, bind₁_C_right, ← Finset.sum_add_distrib, ← mul_add]
  apply Finset.sum_congr rfl
  refine' fun m hm => mul_eq_mul_left_iff.mpr (Or.inl _)
  rw [ite_pow, ite_pow, zero_pow (pow_pos hp.out.pos _)]
  by_cases Pm : P m
  · rw [if_pos Pm, if_neg _, add_zero]
    exact not_not.mpr Pm
  · rwa [if_neg Pm, if_pos, zero_add]
#align witt_vector.select_add_select_not WittVector.select_add_select_not

theorem coeff_add_of_disjoint (x y : 𝕎 R) (h : ∀ n, x.coeff n = 0 ∨ y.coeff n = 0) :
    (x + y).coeff n = x.coeff n + y.coeff n :=
  by
  let P : ℕ → Prop := fun n => y.coeff n = 0
  haveI : DecidablePred P := Classical.decPred P
  set z := mk p fun n => if P n then x.coeff n else y.coeff n with hz
  have hx : select P z = x := by
    ext1 n
    rw [select, coeff_mk, coeff_mk]
    split_ifs with hn
    · rfl
    · rw [(h n).resolve_right hn]
  have hy : select (fun i => ¬P i) z = y := by
    ext1 n
    rw [select, coeff_mk, coeff_mk]
    split_ifs with hn
    · exact hn.symm
    · rfl
  calc
    (x + y).coeff n = z.coeff n := by rw [← hx, ← hy, select_add_select_not P z]
    _ = x.coeff n + y.coeff n := _

  dsimp [z]
  split_ifs with hn
  · dsimp [P] at hn
    rw [hn, add_zero]
  · rw [(h n).resolve_right hn, zero_add]
#align witt_vector.coeff_add_of_disjoint WittVector.coeff_add_of_disjoint

end Select

/-- `witt_vector.init n x` is the Witt vector of which the first `n` coefficients are those from `x`
and all other coefficients are `0`.
See `witt_vector.tail` for the complementary part.
-/
def init (n : ℕ) : 𝕎 R → 𝕎 R :=
  select fun i => i < n
#align witt_vector.init WittVector.init

/-- `witt_vector.tail n x` is the Witt vector of which the first `n` coefficients are `0`
and all other coefficients are those from `x`.
See `witt_vector.init` for the complementary part. -/
def tail (n : ℕ) : 𝕎 R → 𝕎 R :=
  select fun i => n ≤ i
#align witt_vector.tail WittVector.tail

include hp

@[simp]
theorem init_add_tail (x : 𝕎 R) (n : ℕ) : init n x + tail n x = x := by
  simp only [init, tail, ← not_lt, select_add_select_not]
#align witt_vector.init_add_tail WittVector.init_add_tail

end

@[simp]
theorem init_init (x : 𝕎 R) (n : ℕ) : init n (init n x) = init n x := by init_ring
#align witt_vector.init_init WittVector.init_init

include hp

theorem init_add (x y : 𝕎 R) (n : ℕ) : init n (x + y) = init n (init n x + init n y) := by
  init_ring using witt_add_vars
#align witt_vector.init_add WittVector.init_add

theorem init_mul (x y : 𝕎 R) (n : ℕ) : init n (x * y) = init n (init n x * init n y) := by
  init_ring using witt_mul_vars
#align witt_vector.init_mul WittVector.init_mul

theorem init_neg (x : 𝕎 R) (n : ℕ) : init n (-x) = init n (-init n x) := by
  init_ring using witt_neg_vars
#align witt_vector.init_neg WittVector.init_neg

theorem init_sub (x y : 𝕎 R) (n : ℕ) : init n (x - y) = init n (init n x - init n y) := by
  init_ring using witt_sub_vars
#align witt_vector.init_sub WittVector.init_sub

theorem init_nsmul (m : ℕ) (x : 𝕎 R) (n : ℕ) : init n (m • x) = init n (m • init n x) := by
  init_ring using fun p [Fact (Nat.Prime p)] n => witt_nsmul_vars p m n
#align witt_vector.init_nsmul WittVector.init_nsmul

theorem init_zsmul (m : ℤ) (x : 𝕎 R) (n : ℕ) : init n (m • x) = init n (m • init n x) := by
  init_ring using fun p [Fact (Nat.Prime p)] n => witt_zsmul_vars p m n
#align witt_vector.init_zsmul WittVector.init_zsmul

theorem init_pow (m : ℕ) (x : 𝕎 R) (n : ℕ) : init n (x ^ m) = init n (init n x ^ m) := by
  init_ring using fun p [Fact (Nat.Prime p)] n => witt_pow_vars p m n
#align witt_vector.init_pow WittVector.init_pow

section

variable (p)

omit hp

/-- `witt_vector.init n x` is polynomial in the coefficients of `x`. -/
theorem initIsPoly (n : ℕ) : IsPoly p fun R _Rcr => init n :=
  selectIsPoly fun i => i < n
#align witt_vector.init_is_poly WittVector.initIsPoly

end

end WittVector


import order.filter.basic topology.separation tactic

variables {α : Type*}

noncomputable theory

open set classical
local attribute [instance] classical.prop_decidable

/-
structure filter (α : Type*) :=
(sets                   : set (set α))
(univ_sets              : set.univ ∈ sets)
(sets_of_superset {x y} : x ∈ sets → x ⊆ y → y ∈ sets)
(inter_sets {x y}       : x ∈ sets → y ∈ sets → x ∩ y ∈ sets)

-- A filter on `α` is a set of sets of `α` containing `α` itself, closed under
-- supersets and intersection.

-- NB. This definition of filters does not require `∅ ∉ sets`. This is done so
-- we can create a lattice structure. `∅ ∉ sets` should be included as a
-- seperate proposition in lemmas.
-/

-- I'm going to follow
-- https://web.archive.org/web/20071009170540/http://www.efnet-math.org/~david/mathematics/filters.pdf

-- First, we will find a way to generate filters for any given set of sets of α
-- To achieve this, we consider that the intersection of a collection of filters
-- is also a filter, so therefore, a filter can be generated form a set of sets
-- by taking the intersection of all filters containing this set, i.e. if `S` is
-- type `set (set α)`, then the filter generated by `S` is
-- ⋂₀ { F : filter α | S ⊆ F.sets }

namespace filter

instance : has_coe (filter α) (set (set α)) := ⟨λ F, F.sets⟩

/-! ### Basics -/

/- /-- The intersection of two filters is a filter-/
instance : has_inter (filter α) := ⟨λ F G,
  { sets := (F : set (set α)) ∩ (G : set (set α)),
    univ_sets := ⟨F.univ_sets, G.univ_sets⟩,
    sets_of_superset := λ _ _ ⟨hxF, hxG⟩ hsub,
      ⟨F.sets_of_superset hxF hsub, G.sets_of_superset hxG hsub⟩,
    inter_sets := λ x y ⟨hxF, hxG⟩ ⟨hyF, hyG⟩,
      ⟨F.inter_sets hxF hyF, G.inter_sets hxG hyG⟩ }⟩ -/

/-- The intersection of a collection of filters is a filter -/
instance : has_Inf (filter α) := { Inf := λ 𝒞,
  { sets := ⋂ (F ∈ 𝒞), (F : set (set α)),
    univ_sets := mem_bInter $ λ F hF, F.univ_sets,
    sets_of_superset := λ _ _ hx hsub, mem_bInter $ λ F hF,
      F.sets_of_superset (mem_bInter_iff.1 hx F hF) hsub,
    inter_sets := λ x y hx hy, mem_bInter $ λ F hF,
      F.inter_sets (mem_bInter_iff.1 hx F hF) (mem_bInter_iff.1 hy F hF) }}

-- With that we can now define the filter generated by an arbitary set of sets

/-- The filter generated from `S`, a set of sets of `α` is the Inf of all filters
  containing `S` -/
def generated_from (S : set (set α)) : filter α :=
  Inf { F : filter α | S ⊆ F.sets }

-- The method above generates the smallest filter that contains `S : set (set α)`
-- On the other hand, we can generate a filter using `s : set α` be letting the
-- filter be all supersets of `s`, this is called `principal s`
localized "notation `𝓟` := filter.principal" in filter

variables {S : set (set α)}

lemma le_generated_from : S ⊆ generated_from S :=
  λ s hs, mem_bInter (λ F hF, hF hs)

-- Straightaway, we see that if `∅ ∈ S`, then `filter_generated_from S` is the
-- powerset of `α`

lemma generated_of_empty (hS : ∅ ∈ S) (s : set α) : s ∈ generated_from S :=
  (generated_from S).sets_of_superset (le_generated_from hS) (empty_subset s)

/-- Let `F` be a `ne_bot` filter on `α`, `F` is an ultra filter if for all
  `S : set α`, `S ∈ F` or `Sᶜ ∈ F` -/
@[class] structure ultra (F : filter α) :=
(ne_bot : ne_bot F)
(mem_or_compl_mem {S : set α} : S ∈ F ∨ Sᶜ ∈ F)

-- The ultra filter theorem states that for all `F : filter α`, there exists
-- some ultra filter `𝕌`, `F ⊆ 𝕌`.

-- The proof of this follows from Zorn's lemma.
-- Let `F` be a filter on `α`, We have the filters of `α` that contain `F` form
-- a poset. Let `𝒞` be a chain (a totaly ordered set) within this set, then by
-- Zorn's lemma, `𝒞` has at least one maximum element. Thus, by checking this
-- maximum element is indeed an ultra filter, we have found a ultra filter
-- containing `F`.

-- #check exists_maximal_of_chains_bounded

-- theorem exists_ultra_ge (F : filter α) [ne_bot F] :
--   ∃ (G : filter α) [H : ultra G], F ≤ G := sorry

-- Let X be a Hausdorff space
variables {X : Type*} [topological_space X]

/-- A filter `F` on a Hausdorff space `X` has at most one limit -/
theorem tendsto_unique {x y : X} {F : filter X} [H : ne_bot F] [t2_space X]
  (hFx : tendsto id F (nhds x))
  (hFy : tendsto id F (nhds y)) : x = y :=
begin
  by_contra hneq,
  rcases t2_space.t2 _ _ hneq with ⟨U, V, hU, hV, hxU, hyV, hdisj⟩,
  apply H, rw [←empty_in_sets_eq_bot, ←hdisj],
  refine F.inter_sets _ _,
    { rw ←@preimage_id _ U,
      exact tendsto_def.1 hFx U (mem_nhds_sets hU hxU) },
    { rw ←@preimage_id _ V,
      exact tendsto_def.1 hFy V (mem_nhds_sets hV hyV) }
end

variables {Y : Type*} [topological_space Y]

@[reducible] def filter_image (f : X → Y) (F : filter X) : filter Y :=
  generate $ (λ s : set X, f '' s) '' F

-- We'll use mathlib's `generate` and `map` which are the same
-- as the ones we've defined but there is more APIs to work with

/-- A filter `F : filter X` is said to converge to some `x : X` if `nhds x ⊆ F` -/
@[reducible] private def converge_to (F : filter X) (x : X) : Prop :=
  (nhds x : set (set X)) ⊆ F

-- This definition is equivalent to `tendsto id F (nhds x)`
private lemma converge_to_iff (F : filter X) (x : X) :
  converge_to F x ↔ tendsto id F (nhds x) :=
begin
  refine ⟨λ h, tendsto_def.1 $ λ s hs, _, λ h, _⟩,
    { rw map_id, simpa using h hs },
    { simp_rw [tendsto_def, preimage_id] at h, exact h }
end

/-- The neighbourhood filter of `x` converges to `x` -/
lemma nhds_tendsto (x : X) : tendsto id (nhds x) (nhds x) :=
λ U hU, by rwa map_id

lemma mem_filter_image_iff {f : X → Y} {F : filter X} (V) :
  V ∈ map f F ↔ ∃ U ∈ F, f '' U ⊆ V :=
begin
  refine ⟨λ h, ⟨_, h, image_preimage_subset _ _⟩, λ h, _⟩,
    rcases h with ⟨U, hU₀, hU₁⟩,
    rw mem_map,
    apply F.sets_of_superset hU₀,
    intros u hu,
    rw mem_set_of_eq,
    apply hU₁, rw mem_image,
    exact ⟨u, hu, rfl⟩
end

lemma nhds_subset_filter_of_tendsto {x : X} {F : filter X}
  (hF : tendsto id F (nhds x)) : (nhds x : set (set X)) ⊆ F :=
begin
  intros s hs,
  have := tendsto_def.1 hF _ hs,
  rwa preimage_id at this
end

/-- A map between topological spaces `f : X → Y` is continuous at some `x : X`
  if for all `F : filter X` that tends to `x`, `map F` tends to `f(x)` -/
theorem continuous_of_filter_tendsto {x : X} (f : X → Y)
  (hF : ∀ F : filter X, tendsto id F (nhds x) →
    tendsto id (map f F) (nhds (f x))) : continuous_at f x :=
λ _ hU, tendsto_def.1 (hF _ $ nhds_tendsto x) _ hU

/-- If `f : X → Y` is a continuous map between topological spaces, then for all
  `F : filter X` that tends to `x`, `map F` tends to `f(x)` -/
theorem filter_tendsto_of_continuous {x : X} {F : filter X} (f : X → Y)
  (hf : continuous_at f x) (hF : tendsto id F (nhds x)) :
  tendsto id (map f F) (nhds (f x)) :=
begin
  rw tendsto_def at *, intros U hU,
  exact nhds_subset_filter_of_tendsto hF (hf hU),
end

/-! ### Product Filters -/

/- Given two filters `F` and `G` on the topological spaces `X` and `Y` respectively,
  we define the the product filter `F × G` as a filter on the product space `X × Y`
  such that

  `prod F G := F.comap prod.fst ⊓ G.comap prod.snd`

  where `prod.fst = (a, b) ↦ a`, `prod.snd = (a, b) ↦ b` and
  `(C : filter β).comap (f : α → β)` is the filter generated by the set of preimages
  of sets contained in `C`, i.e. `(C.comap f).sets = generate { f⁻¹(s) | s ∈ C }`. -/

-- We borrow the notation of product filters from mathlib
localized "infix ` ×ᶠ `:60 := filter.prod" in filter

-- Write some theorems here maybe?
-- TODO : make the natural projection : filter (X × Y) → filter X

/-! ### Compactness -/

variables {C : Type*} [topological_space C] [compact_space C]
/- In mathlib a compact space is a topological space that satisfy the
  `is_compact` proposition where

  `def is_compact (s : set α) := ∀ ⦃f⦄ [ne_bot f], f ≤ 𝓟 s → ∃ a ∈ s, cluster_pt a f`

  (`cluset_pt a f` means a is a limit point of f) -/

end filter


/-
Copyright (c) 2020 Kyle Miller All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kyle Miller.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.multiset.basic
import Mathlib.data.vector2
import Mathlib.tactic.tidy
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Symmetric powers

This file defines symmetric powers of a type.  The nth symmetric power
consists of homogeneous n-tuples modulo permutations by the symmetric
group.

The special case of 2-tuples is called the symmetric square, which is
addressed in more detail in `data.sym2`.

TODO: This was created as supporting material for `data.sym2`; it
needs a fleshed-out interface.

## Tags

symmetric powers

-/

/--
The nth symmetric power is n-tuples up to permutation.  We define it
as a subtype of `multiset` since these are well developed in the
library.  We also give a definition `sym.sym'` in terms of vectors, and we
show these are equivalent in `sym.sym_equiv_sym'`.
-/
def sym (α : Type u) (n : ℕ) := Subtype fun (s : multiset α) => coe_fn multiset.card s = n

/--
This is the `list.perm` setoid lifted to `vector`.
-/
def vector.perm.is_setoid (α : Type u) (n : ℕ) : setoid (vector α n) :=
  setoid.mk (fun (a b : vector α n) => subtype.val a ~ subtype.val b) sorry

namespace sym

/--
This is the quotient map that takes a list of n elements as an n-tuple and produces an nth
symmetric power.
-/
def of_vector {α : Type u} {n : ℕ} (x : vector α n) : sym α n :=
  { val := ↑(subtype.val x), property := sorry }

protected instance has_lift {α : Type u} {n : ℕ} : has_lift (vector α n) (sym α n) :=
  has_lift.mk of_vector

/--
The unique element in `sym α 0`.
-/
def nil {α : Type u} : sym α 0 := { val := 0, property := sorry }

/--
Inserts an element into the term of `sym α n`, increasing the length by one.
-/
def cons {α : Type u} {n : ℕ} : α → sym α n → sym α (Nat.succ n) := sorry

infixr:67 " :: " => Mathlib.sym.cons

@[simp] theorem cons_inj_right {α : Type u} {n : ℕ} (a : α) (s : sym α n) (s' : sym α n) :
    a :: s = a :: s' ↔ s = s' :=
  sorry

@[simp] theorem cons_inj_left {α : Type u} {n : ℕ} (a : α) (a' : α) (s : sym α n) :
    a :: s = a' :: s ↔ a = a' :=
  sorry

theorem cons_swap {α : Type u} {n : ℕ} (a : α) (b : α) (s : sym α n) : a :: b :: s = b :: a :: s :=
  sorry

/--
`α ∈ s` means that `a` appears as one of the factors in `s`.
-/
def mem {α : Type u} {n : ℕ} (a : α) (s : sym α n) := a ∈ subtype.val s

protected instance has_mem {α : Type u} {n : ℕ} : has_mem α (sym α n) := has_mem.mk mem

protected instance decidable_mem {α : Type u} {n : ℕ} [DecidableEq α] (a : α) (s : sym α n) :
    Decidable (a ∈ s) :=
  subtype.cases_on s
    fun (s_val : multiset α) (s_property : coe_fn multiset.card s_val = n) =>
      id (multiset.decidable_mem a s_val)

@[simp] theorem mem_cons {α : Type u} {n : ℕ} {a : α} {b : α} {s : sym α n} :
    a ∈ b :: s ↔ a = b ∨ a ∈ s :=
  sorry

theorem mem_cons_of_mem {α : Type u} {n : ℕ} {a : α} {b : α} {s : sym α n} (h : a ∈ s) :
    a ∈ b :: s :=
  iff.mpr mem_cons (Or.inr h)

@[simp] theorem mem_cons_self {α : Type u} {n : ℕ} (a : α) (s : sym α n) : a ∈ a :: s :=
  iff.mpr mem_cons (Or.inl rfl)

theorem cons_of_coe_eq {α : Type u} {n : ℕ} (a : α) (v : vector α n) : a :: ↑v = ↑(a::ᵥv) := sorry

theorem sound {α : Type u} {n : ℕ} {a : vector α n} {b : vector α n}
    (h : subtype.val a ~ subtype.val b) : ↑a = ↑b :=
  sorry

/--
Another definition of the nth symmetric power, using vectors modulo permutations. (See `sym`.)
-/
def sym' (α : Type u) (n : ℕ) := quotient (vector.perm.is_setoid α n)

/--
This is `cons` but for the alternative `sym'` definition.
-/
def cons' {α : Type u} {n : ℕ} : α → sym' α n → sym' α (Nat.succ n) :=
  fun (a : α) => quotient.map (vector.cons a) sorry

infixr:67 " :: " => Mathlib.sym.cons'

/--
Multisets of cardinality n are equivalent to length-n vectors up to permutations.
-/
def sym_equiv_sym' {α : Type u} {n : ℕ} : sym α n ≃ sym' α n :=
  equiv.subtype_quotient_equiv_quotient_subtype (fun (l : List α) => list.length l = n)
    (fun (s : multiset α) => coe_fn multiset.card s = n) sorry sorry

theorem cons_equiv_eq_equiv_cons (α : Type u) (n : ℕ) (a : α) (s : sym α n) :
    a :: coe_fn sym_equiv_sym' s = coe_fn sym_equiv_sym' (a :: s) :=
  sorry

-- Instances to make the linter happy

protected instance inhabited_sym {α : Type u} [Inhabited α] (n : ℕ) : Inhabited (sym α n) :=
  { default := { val := multiset.repeat Inhabited.default n, property := sorry } }

protected instance inhabited_sym' {α : Type u} [Inhabited α] (n : ℕ) : Inhabited (sym' α n) :=
  { default := quotient.mk' (vector.repeat Inhabited.default n) }

end Mathlib


example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    cases h.right with hq hr,
      show (p ∧ q) ∨ (p ∧ r),
        { left, split, exact h.left, assumption },
      show (p ∧ q) ∨ (p ∧ r),
        { right, split, exact h.left, assumption },
    intro h,
    cases h with hpq hpr,
      show p ∧ (q ∨ r),
        { cases hpq, split, assumption, left, assumption },
      show p ∧ (q ∨ r),
        { cases hpr, split, assumption, right, assumption }
end


import game.world3.level4 -- hide
import mynat.mul -- hide

namespace mynat -- hide

/-
# Multiplication World

## Level 5: `mul_assoc`

We now have enough to prove that multiplication is associative.

## Random tactic hints

1) Did you know you can do `repeat {rw mul_succ}`?

2) Did you know you can do `rwa [hd, mul_add]`?
I learnt that trick from Ken Lee. Ken spotted that
`rwa` will do the rewrites and will then check to
see if the goal can be proved by `refl`, and if it
can, it will close it! [It will also close goals which
are exactly equal to hypotheses, which will be helpful later on.]
-/

/- Lemma
Multiplication is associative.
In other words, for all natural numbers $a$, $b$ and $c$, we have
$$ (ab)c = a(bc). $$
-/
lemma mul_assoc (a b c : mynat) : (a * b) * c = a * (b * c) :=
begin [nat_num_game]
  induction c with d hd,
  {
    repeat {rw mul_zero},
  },
  {
    rw mul_succ,
    rw mul_succ,
    rw hd,
    rw mul_add,
    refl,

  }
end

/-
A mathematician could now remark that you have proved that the natural
numbers form a monoid under multiplication.
-/
def collectible_4 : monoid mynat := by structure_helper -- hide

end mynat -- hide


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module init.data.option.instances
! leanprover-community/mathlib commit e611ee5c2bd410148bcd493c58cb17498d667175
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Option.Basic
import Leanbin.Init.Meta.Tactic
import Leanbin.Init.Control.Lawful

universe u v

instance : LawfulMonad Option
    where
  id_map α x := Option.rec rfl (fun x => rfl) x
  pure_bind α β x f := rfl
  bind_assoc α β γ x f g := Option.rec rfl (fun x => rfl) x

#print Option.eq_of_eq_some /-
theorem Option.eq_of_eq_some {α : Type u} :
    ∀ {x y : Option α}, (∀ z, x = some z ↔ y = some z) → x = y
  | none, none, h => rfl
  | none, some z, h => Option.noConfusion ((h z).2 rfl)
  | some z, none, h => Option.noConfusion ((h z).1 rfl)
  | some z, some w, h => Option.noConfusion ((h w).2 rfl) (congr_arg some)
#align option.eq_of_eq_some Option.eq_of_eq_some
-/

#print Option.eq_some_of_isSome /-
theorem Option.eq_some_of_isSome {α : Type u} :
    ∀ {o : Option α} (h : Option.isSome o), o = some (Option.get h)
  | some x, h => rfl
#align option.eq_some_of_is_some Option.eq_some_of_isSome
-/

#print Option.eq_none_of_isNone /-
theorem Option.eq_none_of_isNone {α : Type u} : ∀ {o : Option α}, o.isNone → o = none
  | none, h => rfl
#align option.eq_none_of_is_none Option.eq_none_of_isNone
-/


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

The integers, with addition, multiplication, and subtraction.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.nat.lemmas
import Mathlib.Lean3Lib.init.data.nat.gcd

universes l

namespace Mathlib

/- the type, coercions, and notation -/

notation:1024 "ℤ" => Mathlib.int

protected instance int.has_coe : has_coe ℕ ℤ :=
  has_coe.mk Int.ofNat

protected def int.repr : ℤ → string :=
  sorry

protected instance int.has_repr : has_repr ℤ :=
  has_repr.mk int.repr

protected instance int.has_to_string : has_to_string ℤ :=
  has_to_string.mk int.repr

namespace int

protected theorem coe_nat_eq (n : ℕ) : ↑n = Int.ofNat n :=
  rfl

protected def zero : ℤ :=
  Int.ofNat 0

protected def one : ℤ :=
  Int.ofNat 1

protected instance has_zero : HasZero ℤ :=
  { zero := int.zero }

protected instance has_one : HasOne ℤ :=
  { one := int.one }

theorem of_nat_zero : Int.ofNat 0 = 0 :=
  rfl

theorem of_nat_one : Int.ofNat 1 = 1 :=
  rfl

/- definitions of basic functions -/

def neg_of_nat : ℕ → ℤ :=
  sorry

def sub_nat_nat (m : ℕ) (n : ℕ) : ℤ :=
  sorry

theorem sub_nat_nat_of_sub_eq_zero {m : ℕ} {n : ℕ} (h : n - m = 0) : sub_nat_nat m n = Int.ofNat (m - n) := sorry

theorem sub_nat_nat_of_sub_eq_succ {m : ℕ} {n : ℕ} {k : ℕ} (h : n - m = Nat.succ k) : sub_nat_nat m n = Int.negSucc k := sorry

protected def neg : ℤ → ℤ :=
  sorry

protected def add : ℤ → ℤ → ℤ :=
  sorry

protected def mul : ℤ → ℤ → ℤ :=
  sorry

protected instance has_neg : Neg ℤ :=
  { neg := int.neg }

protected instance has_add : Add ℤ :=
  { add := int.add }

protected instance has_mul : Mul ℤ :=
  { mul := int.mul }

-- defeq to algebra.sub which gives subtraction for arbitrary `add_group`s

protected def sub : ℤ → ℤ → ℤ :=
  fun (m n : ℤ) => m + -n

protected instance has_sub : Sub ℤ :=
  { sub := int.sub }

protected theorem neg_zero : -0 = 0 :=
  rfl

theorem of_nat_add (n : ℕ) (m : ℕ) : Int.ofNat (n + m) = Int.ofNat n + Int.ofNat m :=
  rfl

theorem of_nat_mul (n : ℕ) (m : ℕ) : Int.ofNat (n * m) = Int.ofNat n * Int.ofNat m :=
  rfl

theorem of_nat_succ (n : ℕ) : Int.ofNat (Nat.succ n) = Int.ofNat n + 1 :=
  rfl

theorem neg_of_nat_zero : -Int.ofNat 0 = 0 :=
  rfl

theorem neg_of_nat_of_succ (n : ℕ) : -Int.ofNat (Nat.succ n) = Int.negSucc n :=
  rfl

theorem neg_neg_of_nat_succ (n : ℕ) : -Int.negSucc n = Int.ofNat (Nat.succ n) :=
  rfl

theorem of_nat_eq_coe (n : ℕ) : Int.ofNat n = ↑n :=
  rfl

theorem neg_succ_of_nat_coe (n : ℕ) : Int.negSucc n = -↑(n + 1) :=
  rfl

protected theorem coe_nat_add (m : ℕ) (n : ℕ) : ↑(m + n) = ↑m + ↑n :=
  rfl

protected theorem coe_nat_mul (m : ℕ) (n : ℕ) : ↑(m * n) = ↑m * ↑n :=
  rfl

protected theorem coe_nat_zero : ↑0 = 0 :=
  rfl

protected theorem coe_nat_one : ↑1 = 1 :=
  rfl

protected theorem coe_nat_succ (n : ℕ) : ↑(Nat.succ n) = ↑n + 1 :=
  rfl

protected theorem coe_nat_add_out (m : ℕ) (n : ℕ) : ↑m + ↑n = ↑m + ↑n :=
  rfl

protected theorem coe_nat_mul_out (m : ℕ) (n : ℕ) : ↑m * ↑n = ↑(m * n) :=
  rfl

protected theorem coe_nat_add_one_out (n : ℕ) : ↑n + 1 = ↑(Nat.succ n) :=
  rfl

/- these are only for internal use -/

theorem of_nat_add_of_nat (m : ℕ) (n : ℕ) : Int.ofNat m + Int.ofNat n = Int.ofNat (m + n) :=
  rfl

theorem of_nat_add_neg_succ_of_nat (m : ℕ) (n : ℕ) : Int.ofNat m + Int.negSucc n = sub_nat_nat m (Nat.succ n) :=
  rfl

theorem neg_succ_of_nat_add_of_nat (m : ℕ) (n : ℕ) : Int.negSucc m + Int.ofNat n = sub_nat_nat n (Nat.succ m) :=
  rfl

theorem neg_succ_of_nat_add_neg_succ_of_nat (m : ℕ) (n : ℕ) : Int.negSucc m + Int.negSucc n = Int.negSucc (Nat.succ (m + n)) :=
  rfl

theorem of_nat_mul_of_nat (m : ℕ) (n : ℕ) : Int.ofNat m * Int.ofNat n = Int.ofNat (m * n) :=
  rfl

theorem of_nat_mul_neg_succ_of_nat (m : ℕ) (n : ℕ) : Int.ofNat m * Int.negSucc n = neg_of_nat (m * Nat.succ n) :=
  rfl

theorem neg_succ_of_nat_of_nat (m : ℕ) (n : ℕ) : Int.negSucc m * Int.ofNat n = neg_of_nat (Nat.succ m * n) :=
  rfl

theorem mul_neg_succ_of_nat_neg_succ_of_nat (m : ℕ) (n : ℕ) : Int.negSucc m * Int.negSucc n = Int.ofNat (Nat.succ m * Nat.succ n) :=
  rfl

/- some basic functions and properties -/

protected theorem coe_nat_inj {m : ℕ} {n : ℕ} (h : ↑m = ↑n) : m = n :=
  of_nat.inj h

theorem of_nat_eq_of_nat_iff (m : ℕ) (n : ℕ) : Int.ofNat m = Int.ofNat n ↔ m = n :=
  { mp := of_nat.inj, mpr := congr_arg fun (m : ℕ) => Int.ofNat m }

protected theorem coe_nat_eq_coe_nat_iff (m : ℕ) (n : ℕ) : ↑m = ↑n ↔ m = n :=
  of_nat_eq_of_nat_iff m n

theorem neg_succ_of_nat_inj_iff {m : ℕ} {n : ℕ} : Int.negSucc m = Int.negSucc n ↔ m = n := sorry

theorem neg_succ_of_nat_eq (n : ℕ) : Int.negSucc n = -(↑n + 1) :=
  rfl

/- neg -/

protected theorem neg_neg (a : ℤ) : --a = a := sorry

protected theorem neg_inj {a : ℤ} {b : ℤ} (h : -a = -b) : a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b)) (Eq.symm (int.neg_neg a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl ( --a = b)) (Eq.symm (int.neg_neg b))))
      (eq.mpr (id (Eq._oldrec (Eq.refl ( --a = --b)) h)) (Eq.refl ( --b))))

protected theorem sub_eq_add_neg {a : ℤ} {b : ℤ} : a - b = a + -b :=
  rfl

/- basic properties of sub_nat_nat -/

theorem sub_nat_nat_elim (m : ℕ) (n : ℕ) (P : ℕ → ℕ → ℤ → Prop) (hp : ∀ (i n : ℕ), P (n + i) n (Int.ofNat i)) (hn : ∀ (i m : ℕ), P m (m + i + 1) (Int.negSucc i)) : P m n (sub_nat_nat m n) := sorry

theorem sub_nat_nat_add_left {m : ℕ} {n : ℕ} : sub_nat_nat (m + n) m = Int.ofNat n := sorry

theorem sub_nat_nat_add_right {m : ℕ} {n : ℕ} : sub_nat_nat m (m + n + 1) = Int.negSucc n := sorry

theorem sub_nat_nat_add_add (m : ℕ) (n : ℕ) (k : ℕ) : sub_nat_nat (m + k) (n + k) = sub_nat_nat m n := sorry

theorem sub_nat_nat_of_ge {m : ℕ} {n : ℕ} (h : m ≥ n) : sub_nat_nat m n = Int.ofNat (m - n) :=
  sub_nat_nat_of_sub_eq_zero (nat.sub_eq_zero_of_le h)

theorem sub_nat_nat_of_lt {m : ℕ} {n : ℕ} (h : m < n) : sub_nat_nat m n = Int.negSucc (Nat.pred (n - m)) := sorry

/- nat_abs -/

@[simp] def nat_abs : ℤ → ℕ :=
  sorry

theorem nat_abs_of_nat (n : ℕ) : nat_abs ↑n = n :=
  rfl

theorem eq_zero_of_nat_abs_eq_zero {a : ℤ} : nat_abs a = 0 → a = 0 := sorry

theorem nat_abs_pos_of_ne_zero {a : ℤ} (h : a ≠ 0) : nat_abs a > 0 :=
  or.resolve_left (nat.eq_zero_or_pos (nat_abs a)) (mt eq_zero_of_nat_abs_eq_zero h)

theorem nat_abs_zero : nat_abs 0 = 0 :=
  rfl

theorem nat_abs_one : nat_abs 1 = 1 :=
  rfl

theorem nat_abs_mul_self {a : ℤ} : ↑(nat_abs a * nat_abs a) = a * a := sorry

@[simp] theorem nat_abs_neg (a : ℤ) : nat_abs (-a) = nat_abs a := sorry

theorem nat_abs_eq (a : ℤ) : a = ↑(nat_abs a) ∨ a = -↑(nat_abs a) := sorry

theorem eq_coe_or_neg (a : ℤ) : ∃ (n : ℕ), a = ↑n ∨ a = -↑n :=
  Exists.intro (nat_abs a) (nat_abs_eq a)

/- sign -/

def sign : ℤ → ℤ :=
  sorry

@[simp] theorem sign_zero : sign 0 = 0 :=
  rfl

@[simp] theorem sign_one : sign 1 = 1 :=
  rfl

@[simp] theorem sign_neg_one : sign (-1) = -1 :=
  rfl

/- Quotient and remainder -/

-- There are three main conventions for integer division,

-- referred here as the E, F, T rounding conventions.

-- All three pairs satisfy the identity x % y + (x / y) * y = x

-- unconditionally.

-- E-rounding: This pair satisfies 0 ≤ mod x y < nat_abs y for y ≠ 0

protected def div : ℤ → ℤ → ℤ :=
  sorry

protected def mod : ℤ → ℤ → ℤ :=
  sorry

-- F-rounding: This pair satisfies fdiv x y = floor (x / y)

def fdiv : ℤ → ℤ → ℤ :=
  sorry

def fmod : ℤ → ℤ → ℤ :=
  sorry

-- T-rounding: This pair satisfies quot x y = round_to_zero (x / y)

def quot : ℤ → ℤ → ℤ :=
  sorry

def rem : ℤ → ℤ → ℤ :=
  sorry

protected instance has_div : Div ℤ :=
  { div := int.div }

protected instance has_mod : Mod ℤ :=
  { mod := int.mod }

/- gcd -/

def gcd (m : ℤ) (n : ℤ) : ℕ :=
  nat.gcd (nat_abs m) (nat_abs n)

/-
   int is a ring
-/

/- addition -/

protected theorem add_comm (a : ℤ) (b : ℤ) : a + b = b + a := sorry

protected theorem add_zero (a : ℤ) : a + 0 = a :=
  int.cases_on a (fun (a : ℕ) => idRhs (Int.ofNat a + 0 = Int.ofNat a + 0) rfl)
    fun (a : ℕ) => idRhs (Int.negSucc a + 0 = Int.negSucc a + 0) rfl

protected theorem zero_add (a : ℤ) : 0 + a = a :=
  int.add_comm a 0 ▸ int.add_zero a

theorem sub_nat_nat_sub {m : ℕ} {n : ℕ} (h : m ≥ n) (k : ℕ) : sub_nat_nat (m - n) k = sub_nat_nat m (k + n) := sorry

theorem sub_nat_nat_add (m : ℕ) (n : ℕ) (k : ℕ) : sub_nat_nat (m + n) k = Int.ofNat m + sub_nat_nat n k := sorry

theorem sub_nat_nat_add_neg_succ_of_nat (m : ℕ) (n : ℕ) (k : ℕ) : sub_nat_nat m n + Int.negSucc k = sub_nat_nat m (n + Nat.succ k) := sorry

theorem add_assoc_aux1 (m : ℕ) (n : ℕ) (c : ℤ) : Int.ofNat m + Int.ofNat n + c = Int.ofNat m + (Int.ofNat n + c) := sorry

theorem add_assoc_aux2 (m : ℕ) (n : ℕ) (k : ℕ) : Int.negSucc m + Int.negSucc n + Int.ofNat k = Int.negSucc m + (Int.negSucc n + Int.ofNat k) := sorry

protected theorem add_assoc (a : ℤ) (b : ℤ) (c : ℤ) : a + b + c = a + (b + c) := sorry

/- negation -/

theorem sub_nat_self (n : ℕ) : sub_nat_nat n n = 0 := sorry

protected theorem add_left_neg (a : ℤ) : -a + a = 0 := sorry

protected theorem add_right_neg (a : ℤ) : a + -a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + -a = 0)) (int.add_comm a (-a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-a + a = 0)) (int.add_left_neg a))) (Eq.refl 0))

/- multiplication -/

protected theorem mul_comm (a : ℤ) (b : ℤ) : a * b = b * a := sorry

theorem of_nat_mul_neg_of_nat (m : ℕ) (n : ℕ) : Int.ofNat m * neg_of_nat n = neg_of_nat (m * n) := sorry

theorem neg_of_nat_mul_of_nat (m : ℕ) (n : ℕ) : neg_of_nat m * Int.ofNat n = neg_of_nat (m * n) := sorry

theorem neg_succ_of_nat_mul_neg_of_nat (m : ℕ) (n : ℕ) : Int.negSucc m * neg_of_nat n = Int.ofNat (Nat.succ m * n) := sorry

theorem neg_of_nat_mul_neg_succ_of_nat (m : ℕ) (n : ℕ) : neg_of_nat n * Int.negSucc m = Int.ofNat (n * Nat.succ m) := sorry

protected theorem mul_assoc (a : ℤ) (b : ℤ) (c : ℤ) : a * b * c = a * (b * c) := sorry

protected theorem mul_zero (a : ℤ) : a * 0 = 0 :=
  int.cases_on a (fun (a : ℕ) => idRhs (Int.ofNat a * 0 = Int.ofNat a * 0) rfl)
    fun (a : ℕ) => idRhs (Int.negSucc a * 0 = Int.negSucc a * 0) rfl

protected theorem zero_mul (a : ℤ) : 0 * a = 0 :=
  int.mul_comm a 0 ▸ int.mul_zero a

theorem neg_of_nat_eq_sub_nat_nat_zero (n : ℕ) : neg_of_nat n = sub_nat_nat 0 n :=
  nat.cases_on n (idRhs (neg_of_nat 0 = neg_of_nat 0) rfl)
    fun (n : ℕ) => idRhs (neg_of_nat (Nat.succ n) = neg_of_nat (Nat.succ n)) rfl

theorem of_nat_mul_sub_nat_nat (m : ℕ) (n : ℕ) (k : ℕ) : Int.ofNat m * sub_nat_nat n k = sub_nat_nat (m * n) (m * k) := sorry

theorem neg_of_nat_add (m : ℕ) (n : ℕ) : neg_of_nat m + neg_of_nat n = neg_of_nat (m + n) := sorry

theorem neg_succ_of_nat_mul_sub_nat_nat (m : ℕ) (n : ℕ) (k : ℕ) : Int.negSucc m * sub_nat_nat n k = sub_nat_nat (Nat.succ m * k) (Nat.succ m * n) := sorry

protected theorem distrib_left (a : ℤ) (b : ℤ) (c : ℤ) : a * (b + c) = a * b + a * c := sorry

protected theorem distrib_right (a : ℤ) (b : ℤ) (c : ℤ) : (a + b) * c = a * c + b * c := sorry

protected theorem zero_ne_one : 0 ≠ 1 :=
  fun (h : 0 = 1) => nat.succ_ne_zero 0 (Eq.symm (of_nat.inj h))

theorem of_nat_sub {n : ℕ} {m : ℕ} (h : m ≤ n) : Int.ofNat (n - m) = Int.ofNat n - Int.ofNat m := sorry

protected theorem add_left_comm (a : ℤ) (b : ℤ) (c : ℤ) : a + (b + c) = b + (a + c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + (b + c) = b + (a + c))) (Eq.symm (int.add_assoc a b c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + b + c = b + (a + c))) (int.add_comm a b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (b + a + c = b + (a + c))) (int.add_assoc b a c))) (Eq.refl (b + (a + c)))))

protected theorem add_left_cancel {a : ℤ} {b : ℤ} {c : ℤ} (h : a + b = a + c) : b = c := sorry

protected theorem neg_add {a : ℤ} {b : ℤ} : -(a + b) = -a + -b := sorry

theorem neg_succ_of_nat_coe' (n : ℕ) : Int.negSucc n = -↑n - 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (Int.negSucc n = -↑n - 1)) int.sub_eq_add_neg))
    (eq.mpr (id (Eq._oldrec (Eq.refl (Int.negSucc n = -↑n + -1)) (Eq.symm int.neg_add))) (Eq.refl (Int.negSucc n)))

protected theorem coe_nat_sub {n : ℕ} {m : ℕ} : n ≤ m → ↑(m - n) = ↑m - ↑n :=
  of_nat_sub

protected theorem sub_nat_nat_eq_coe {m : ℕ} {n : ℕ} : sub_nat_nat m n = ↑m - ↑n := sorry

def to_nat : ℤ → ℕ :=
  sorry

theorem to_nat_sub (m : ℕ) (n : ℕ) : to_nat (↑m - ↑n) = m - n := sorry

-- Since mod x y is always nonnegative when y ≠ 0, we can make a nat version of it

def nat_mod (m : ℤ) (n : ℤ) : ℕ :=
  to_nat (m % n)

protected theorem one_mul (a : ℤ) : 1 * a = a := sorry

protected theorem mul_one (a : ℤ) : a * 1 = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = a)) (int.mul_comm a 1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 * a = a)) (int.one_mul a))) (Eq.refl a))

protected theorem neg_eq_neg_one_mul (a : ℤ) : -a = -1 * a := sorry

theorem sign_mul_nat_abs (a : ℤ) : sign a * ↑(nat_abs a) = a := sorry


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Alex Kontorovich
-/
import order.filter.bases

/-!
# (Co)product of a family of filters

In this file we define two filters on `Π i, α i` and prove some basic properties of these filters.

* `filter.pi (f : Π i, filter (α i))` to be the maximal filter on `Π i, α i` such that
  `∀ i, filter.tendsto (function.eval i) (filter.pi f) (f i)`. It is defined as
  `Π i, filter.comap (function.eval i) (f i)`. This is a generalization of `filter.prod` to indexed
  products.

* `filter.Coprod (f : Π i, filter (α i))`: a generalization of `filter.coprod`; it is the supremum
  of `comap (eval i) (f i)`.
-/

open set function
open_locale classical filter

namespace filter

variables {ι : Type*} {α : ι → Type*} {f f₁ f₂ : Π i, filter (α i)} {s : Π i, set (α i)}

section pi

/-- The product of an indexed family of filters. -/
def pi (f : Π i, filter (α i)) : filter (Π i, α i) := ⨅ i, comap (eval i) (f i)

lemma tendsto_eval_pi (f : Π i, filter (α i)) (i : ι) :
  tendsto (eval i) (pi f) (f i) :=
tendsto_infi' i tendsto_comap

lemma tendsto_pi {β : Type*} {m : β → Π i, α i} {l : filter β} :
  tendsto m l (pi f) ↔ ∀ i, tendsto (λ x, m x i) l (f i) :=
by simp only [pi, tendsto_infi, tendsto_comap_iff]

lemma le_pi {g : filter (Π i, α i)} : g ≤ pi f ↔ ∀ i, tendsto (eval i) g (f i) := tendsto_pi

@[mono] lemma pi_mono (h : ∀ i, f₁ i ≤ f₂ i) : pi f₁ ≤ pi f₂ :=
infi_le_infi $ λ i, comap_mono $ h i

lemma mem_pi_of_mem (i : ι) {s : set (α i)} (hs : s ∈ f i) :
  eval i ⁻¹' s ∈ pi f :=
mem_infi_of_mem i $ preimage_mem_comap hs

lemma pi_mem_pi {I : set ι} (hI : finite I) (h : ∀ i ∈ I, s i ∈ f i) :
  I.pi s ∈ pi f :=
begin
  rw [pi_def, bInter_eq_Inter],
  refine mem_infi_of_Inter hI (λ i, _) subset.rfl,
  exact preimage_mem_comap (h i i.2)
end

lemma mem_pi {s : set (Π i, α i)} : s ∈ pi f ↔
  ∃ (I : set ι), finite I ∧ ∃ t : Π i, set (α i), (∀ i, t i ∈ f i) ∧ I.pi t ⊆ s :=
begin
  split,
  { simp only [pi, mem_infi', mem_comap, pi_def],
    rintro ⟨I, If, V, hVf, hVI, rfl, -⟩, choose t htf htV using hVf,
    exact ⟨I, If, t, htf, bInter_mono (λ i _, htV i)⟩ },
  { rintro ⟨I, If, t, htf, hts⟩,
    exact mem_of_superset (pi_mem_pi If $ λ i _, htf i) hts }
end

lemma mem_pi' {s : set (Π i, α i)} : s ∈ pi f ↔
  ∃ (I : finset ι), ∃ t : Π i, set (α i), (∀ i, t i ∈ f i) ∧ set.pi ↑I t ⊆ s :=
mem_pi.trans exists_finite_iff_finset

lemma mem_of_pi_mem_pi [∀ i, ne_bot (f i)] {I : set ι} (h : I.pi s ∈ pi f) {i : ι} (hi : i ∈ I) :
  s i ∈ f i :=
begin
  rcases mem_pi.1 h with ⟨I', I'f, t, htf, hts⟩,
  refine mem_of_superset (htf i) (λ x hx, _),
  have : ∀ i, (t i).nonempty, from λ i, nonempty_of_mem (htf i),
  choose g hg,
  have : update g i x ∈ I'.pi t,
  { intros j hj, rcases eq_or_ne j i with (rfl|hne); simp * },
  simpa using hts this i hi
end

@[simp] lemma pi_mem_pi_iff [∀ i, ne_bot (f i)] {I : set ι} (hI : finite I) :
  I.pi s ∈ pi f ↔ ∀ i ∈ I, s i ∈ f i :=
⟨λ h i hi, mem_of_pi_mem_pi h hi, pi_mem_pi hI⟩

@[simp] lemma pi_inf_principal_univ_pi_eq_bot :
  pi f ⊓ 𝓟 (set.pi univ s) = ⊥ ↔ ∃ i, f i ⊓ 𝓟 (s i) = ⊥ :=
begin
  split,
  { simp only [inf_principal_eq_bot, mem_pi], contrapose!,
    rintros (hsf : ∀ i, ∃ᶠ x in f i, x ∈ s i) I If t htf hts,
    have : ∀ i, (s i ∩ t i).nonempty, from λ i, ((hsf i).and_eventually (htf i)).exists,
    choose x hxs hxt,
    exact hts (λ i hi, hxt i) (mem_univ_pi.2 hxs) },
  { simp only [inf_principal_eq_bot],
    rintro ⟨i, hi⟩,
    filter_upwards [mem_pi_of_mem i hi],
    exact λ x, mt (λ h, h i trivial) }
end

@[simp] lemma pi_inf_principal_pi_eq_bot [Π i, ne_bot (f i)] {I : set ι} :
  pi f ⊓ 𝓟 (set.pi I s) = ⊥ ↔ ∃ i ∈ I, f i ⊓ 𝓟 (s i) = ⊥ :=
begin
  rw [← univ_pi_piecewise I, pi_inf_principal_univ_pi_eq_bot],
  refine exists_congr (λ i, _),
  by_cases hi : i ∈ I; simp [hi, (‹Π i, ne_bot (f i)› i).ne]
end

@[simp] lemma pi_inf_principal_univ_pi_ne_bot :
  ne_bot (pi f ⊓ 𝓟 (set.pi univ s)) ↔ ∀ i, ne_bot (f i ⊓ 𝓟 (s i)) :=
by simp [ne_bot_iff]

@[simp] lemma pi_inf_principal_pi_ne_bot [Π i, ne_bot (f i)] {I : set ι} :
  ne_bot (pi f ⊓ 𝓟 (I.pi s)) ↔ ∀ i ∈ I, ne_bot (f i ⊓ 𝓟 (s i)) :=
by simp [ne_bot_iff]

instance pi_inf_principal_pi.ne_bot [h : ∀ i, ne_bot (f i ⊓ 𝓟 (s i))] {I : set ι} :
  ne_bot (pi f ⊓ 𝓟 (I.pi s)) :=
(pi_inf_principal_univ_pi_ne_bot.2 ‹_›).mono $ inf_le_inf_left _ $ principal_mono.2 $
  λ x hx i hi, hx i trivial

@[simp] lemma pi_eq_bot : pi f = ⊥ ↔ ∃ i, f i = ⊥ :=
by simpa using @pi_inf_principal_univ_pi_eq_bot ι α f (λ _, univ)

@[simp]

instance [∀ i, ne_bot (f i)] : ne_bot (pi f) := pi_ne_bot.2 ‹_›

end pi

/-! ### `n`-ary coproducts of filters -/

section Coprod

/-- Coproduct of filters. -/
protected def Coprod (f : Π i, filter (α i)) : filter (Π i, α i) :=
⨆ i : ι, comap (eval i) (f i)

lemma mem_Coprod_iff {s : set (Π i, α i)} :
  (s ∈ filter.Coprod f) ↔ (∀ i : ι, (∃ t₁ ∈ f i, eval i ⁻¹' t₁ ⊆ s)) :=
by simp [filter.Coprod]

lemma compl_mem_Coprod_iff {s : set (Π i, α i)} :
  sᶜ ∈ filter.Coprod f ↔ ∃ t : Π i, set (α i), (∀ i, (t i)ᶜ ∈ f i) ∧ s ⊆ set.pi univ (λ i, t i) :=
begin
  rw [(surjective_pi_map (λ i, @compl_surjective (set (α i)) _)).exists],
  simp_rw [mem_Coprod_iff, classical.skolem, exists_prop, @subset_compl_comm _ _ s,
    ← preimage_compl, ← subset_Inter_iff, ← univ_pi_eq_Inter, compl_compl]
end

lemma Coprod_ne_bot_iff' :
  ne_bot (filter.Coprod f) ↔ (∀ i, nonempty (α i)) ∧ ∃ d, ne_bot (f d) :=
by simp only [filter.Coprod, supr_ne_bot, ← exists_and_distrib_left, ← comap_eval_ne_bot_iff']

@[simp] lemma Coprod_ne_bot_iff [∀ i, nonempty (α i)] :
  ne_bot (filter.Coprod f) ↔ ∃ d, ne_bot (f d) :=
by simp [Coprod_ne_bot_iff', *]

lemma ne_bot.Coprod [∀ i, nonempty (α i)] {i : ι} (h : ne_bot (f i)) :
  ne_bot (filter.Coprod f) :=
Coprod_ne_bot_iff.2 ⟨i, h⟩

@[instance] lemma Coprod_ne_bot [∀ i, nonempty (α i)] [nonempty ι] (f : Π i, filter (α i))
  [H : ∀ i, ne_bot (f i)] : ne_bot (filter.Coprod f) :=
(H (classical.arbitrary ι)).Coprod

@[mono] lemma Coprod_mono (hf : ∀ i, f₁ i ≤ f₂ i) : filter.Coprod f₁ ≤ filter.Coprod f₂ :=
supr_le_supr $ λ i, comap_mono (hf i)

variables {β : ι → Type*} {m : Π i, α i → β i}

lemma map_pi_map_Coprod_le :
  map (λ (k : Π i, α i), λ i, m i (k i)) (filter.Coprod f) ≤ filter.Coprod (λ i, map (m i) (f i)) :=
begin
  simp only [le_def, mem_map, mem_Coprod_iff],
  intros s h i,
  obtain ⟨t, H, hH⟩ := h i,
  exact ⟨{x : α i | m i x ∈ t}, H, λ x hx, hH hx⟩
end

lemma tendsto.pi_map_Coprod {g : Π i, filter (β i)} (h : ∀ i, tendsto (m i) (f i) (g i)) :
  tendsto (λ (k : Π i, α i), λ i, m i (k i)) (filter.Coprod f) (filter.Coprod g) :=
map_pi_map_Coprod_le.trans (Coprod_mono h)

end Coprod

end filter