import ring_theory.ideal.local_ring
import ring_theory.localization.at_prime
import algebraic_geometry.prime_spectrum.basic

import random_lemmas

noncomputable theory

universe u

open_locale big_operators
open category_theory

namespace ring_hom

variables {R R' S S' : Type u}
variables [comm_ring R] [comm_ring R'] [comm_ring S] [comm_ring S']
variables (f : R →+* S) (g : R →+* S') (e : S ≃+* S') (e' : R ≃+* R')
variables (f' : R' →+* S)

lemma equiv_to_ring_hom_comp_eq_iff :
  e.to_ring_hom.comp f = g ↔ f = e.symm.to_ring_hom.comp g :=
{ mp := λ h, by simp [←h, ←comp_assoc],
  mpr := λ h, by erw [h, ←comp_assoc]; simp }

lemma comp_equiv_to_ring_hom_eq_iff :
  f.comp e'.symm.to_ring_hom = f' ↔ f = f'.comp e'.to_ring_hom :=
{ mp := λ h, by rw [←h, comp_assoc]; simp,
  mpr := λ h, by erw [h, comp_assoc]; simp }

lemma is_local_ring_hom.map_inv [is_local_ring_hom f]
  (x : R) (h : is_unit x) :
  f (h.unit.inv) = (is_unit.map f h).unit.inv :=
begin
  generalize_proofs h1,
  rw [units.inv_eq_coe_inv, units.inv_eq_coe_inv],
  apply units.eq_inv_of_mul_eq_one_left,
  erw [←map_mul], convert map_one _,
  convert units.mul_inv _,
  refl,
end

end ring_hom

namespace localization.at_prime

variables {R : Type u} [comm_ring R] (p : ideal R) [ideal.is_prime p]

lemma mk_is_unit_iff (a : R) (b : p.prime_compl) : is_unit (localization.mk a b) ↔ a ∉ p :=
{ mp := λ ⟨⟨x, y, hx1, hx2⟩, hx⟩,
  begin
    dsimp at hx,
    rw hx at hx1 hx2,
    induction y using localization.induction_on with data,
    rcases data with ⟨c, d⟩,
    dsimp at hx1 hx2,
    rw [←localization.mk_one, localization.mk_mul, localization.mk_eq_mk_iff,
      localization.r_iff_exists] at hx1 hx2,
    obtain ⟨e, he⟩ := hx1,
    dsimp at he,
    rw [mul_one, one_mul] at he,
    intros r,
    have mem1 : a * c * e ∈ p := ideal.mul_mem_right _ _ (ideal.mul_mem_right _ _ r),
    rw he at mem1,
    exact submonoid.mul_mem _ (submonoid.mul_mem _ b.2 d.2) e.2 mem1,
  end,
  mpr := λ ha, ⟨⟨localization.mk a b, localization.mk b ⟨a, ha⟩,
    by { rw [localization.mk_mul, mul_comm], exact localization.mk_self (b * ⟨a, ha⟩) },
    by { rw [localization.mk_mul, mul_comm], exact localization.mk_self (⟨a, _⟩ * b)}⟩, rfl⟩ }

@[simps] def concrete_description_of_ideal_map (m : ideal R) :
  ideal (localization.at_prime p) :=
{ carrier := {x | ∃ (a : m) (b : p.prime_compl), x = localization.mk a b},
    add_mem' :=
    begin
      rintros _ _ ⟨a, b, rfl⟩ ⟨a', b', rfl⟩,
      rw [localization.add_mk],
      refine ⟨⟨b * a' + b' * a, _⟩, b*b', rfl⟩,
      refine submodule.add_mem _
        (ideal.mul_mem_left _ _ a'.2)
        (ideal.mul_mem_left _ _ a.2),
    end,
    zero_mem' := ⟨0, 1, (localization.mk_zero _).symm⟩,
    smul_mem' :=
    begin
      rintros c _ ⟨a, b, rfl⟩,
      induction c using localization.induction_on with data,
      rcases data with ⟨x, y⟩,
      dsimp,
      rw [localization.mk_mul],
      refine ⟨⟨x * a, ideal.mul_mem_left _ _ a.2⟩, y * b, rfl⟩,
    end }

lemma ideal_map_is (m : ideal R) :
  concrete_description_of_ideal_map p m =
  m.map (algebra_map R (localization.at_prime p)) :=
have aux1 : ∀ (x : localization.at_prime p),
    x ∈ ideal.map (algebra_map R (localization.at_prime p)) m →
    ∃ (a : m) (b: p.prime_compl), x = localization.mk a b,
begin
  rintros x h,
  refine submodule.span_induction h _ _ _ _,
  { rintros _ ⟨y, hy, rfl⟩, refine ⟨⟨y, hy⟩, 1, rfl⟩, },
  { refine ⟨0, 1, (localization.mk_zero _).symm⟩, },
  { rintros _ _ ⟨a, b, rfl⟩ ⟨a', b', rfl⟩,
    refine ⟨⟨b * a' + b' * a, submodule.add_mem _ (ideal.mul_mem_left _ _ a'.2) (ideal.mul_mem_left _ _ a.2) ⟩, b * b', _⟩,
    rw [localization.add_mk],
    refl, },
  { rintros x _ ⟨a, b, rfl⟩,
    induction x using localization.induction_on with data,
    rcases data with ⟨c, d⟩,
    refine ⟨⟨c * a, ideal.mul_mem_left _ _ a.2⟩, d * b, _⟩,
    dsimp,
    rw [localization.mk_mul], }
end,
begin
  ext : 1, split,
  { rintros ⟨a, b, rfl⟩,
    rw show (localization.mk a b : localization.at_prime p) =
      localization.mk a 1 * localization.mk 1 b, from _,
    refine ideal.mul_mem_right _ _ (submodule.subset_span _),
    refine ⟨a, a.2, rfl⟩,
    rw [localization.mk_mul, mul_one, one_mul], },
  { exact aux1 _, }
end

lemma maximal_ideal_is :
  local_ring.maximal_ideal (localization.at_prime p) =
  concrete_description_of_ideal_map p p :=
begin
  ext x : 1,
  induction x using localization.induction_on with data,
  rcases data with ⟨a, b⟩,
  dsimp only,
  rw [local_ring.mem_maximal_ideal, mem_nonunits_iff, mk_is_unit_iff, not_not],
  split,
  { intros ha,
    rw show localization.mk a b = localization.mk a 1 * localization.mk 1 b,
      by rw [localization.mk_mul, mul_one, one_mul],
    refine ideal.mul_mem_right _ _ _,
    refine ⟨⟨a, ha⟩, 1, rfl⟩, },
  { rintros ⟨c, d, h⟩,
    erw [localization.mk_eq_mk_iff, localization.r_iff_exists] at h,
    obtain ⟨e, he⟩ := h,
    dsimp at he,
    have eq0 : (c * b * e : R) ∈ p := ideal.mul_mem_right _ _ (ideal.mul_mem_right _ _ c.2),
    rw ←he at eq0,
    obtain h0|h1 := ideal.is_prime.mem_or_mem infer_instance eq0,
    work_on_goal 2 { exact (e.2 h1).elim },
    obtain h0|h1 := ideal.is_prime.mem_or_mem infer_instance h0,
    exact h0,
    exact (d.2 h1).elim, },
end

lemma maximal_ideal_is' :
  local_ring.maximal_ideal (localization.at_prime p) =
  p.map (algebra_map R (localization.at_prime p)) :=
(maximal_ideal_is p).trans $ ideal_map_is _ _

end localization.at_prime

namespace ring_hom

variables (R : Type u) [comm_ring R] [local_ring R]

section target_local_ring

variables {R} {A : Type u} [comm_ring A] (φ : A →+* R)

variables (M : Type u) [comm_ring M] [algebra A M]
variable [is_localization.at_prime M ((local_ring.maximal_ideal R).comap φ)]

@[reducible]
def fac' : M →+* R :=
@is_localization.lift A _ ((local_ring.maximal_ideal R).comap φ).prime_compl
  _ _ _ _ _ _ φ
begin
  intros y,
  have h' := y.2,
  contrapose! h',
  rw [←mem_nonunits_iff, ←local_ring.mem_maximal_ideal, ←ideal.mem_comap] at h',
  exact λ r, r h',
end

lemma fac'_comp_algebra_map : (φ.fac' M).comp (algebra_map _ _) = φ :=
is_localization.lift_comp _

section fac'_uniq

variables (p : ideal A) [ideal.is_prime p]
variables (N : Type u) [comm_ring N]
variables [algebra A N] [is_localization.at_prime N p]
variables (f : N →+* R) [is_local_ring_hom f]

lemma fac'_uniq_pt_eq (h : f.comp (algebra_map A N) = φ) :
  p = (local_ring.maximal_ideal R).comap φ :=
begin
  refine le_antisymm _ _,
  { intros x hx,
    rw [ideal.mem_comap, local_ring.mem_maximal_ideal, ←h, mem_nonunits_iff,
      ring_hom.comp_apply],
    intros r,
    have r' := is_local_ring_hom.map_nonunit _ r,
    rw [←is_localization.mk'_one N,
      is_localization.at_prime.is_unit_mk'_iff N p] at r',
    exact r' hx, },
  { intros x hx,
    rw [ideal.mem_comap, ←h, local_ring.mem_maximal_ideal, ring_hom.comp_apply,
      mem_nonunits_iff] at hx,
    contrapose! hx,
    replace hx := (is_localization.at_prime.is_unit_mk'_iff N p x 1).mpr hx,
    rw is_localization.mk'_one at hx,
    refine is_unit.map _ hx, },
end

lemma fac'_uniq (h : f.comp (algebra_map A N) = φ) :
  f = (φ.fac' M).comp (is_localization.map M (ring_hom.id A)
    (by { refine le_of_eq _, simp_rw [fac'_uniq_pt_eq φ p N f h],
      erw submonoid.comap_id, } : p.prime_compl ≤
        submonoid.comap _ ((local_ring.maximal_ideal R).comap φ).prime_compl)) :=
begin
  simp_rw [←h],
  ext x : 1,
  obtain ⟨a, b, rfl⟩ := is_localization.mk'_surjective p.prime_compl x,
  rw [ring_hom.comp_apply, is_localization.map_mk', is_localization.lift_mk',
    ring_hom.id_apply],
  simp_rw [ring_hom.id_apply],
  rw units.eq_mul_inv_iff_mul_eq,
  change _ * f _ = _,
  rw [←map_mul, ring_hom.comp_apply, ←is_localization.mk'_one N,
    ←is_localization.mk'_one N a, ←is_localization.mk'_mul, mul_one],
  work_on_goal 3 { exactI (infer_instance : is_localization.at_prime N p) },
  congr' 1,
  dsimp,
  rw is_localization.eq,
  refine ⟨1, _⟩,
  simp only [submonoid.coe_one, mul_one],
end

end fac'_uniq

instance is_local_fac' : is_local_ring_hom $ φ.fac' M :=
{ map_nonunit := λ x hx,
  begin
    obtain ⟨a, b, rfl⟩ := is_localization.mk'_surjective
      ((local_ring.maximal_ideal _).comap φ).prime_compl x,
    rw is_localization.at_prime.is_unit_mk'_iff,
    rintros rid,
    rw [set_like.mem_coe, ideal.mem_comap, local_ring.mem_maximal_ideal,
      mem_nonunits_iff] at rid,
    refine rid _, clear rid,
    rw is_localization.lift_mk' at hx,
    refine (units.is_unit_mul_units _ _).mp hx,
  end }

@[simps] def fac :
  localization.at_prime (ideal.comap φ (local_ring.maximal_ideal _)) →+* R :=
φ.fac' _

instance is_local.fac : is_local_ring_hom φ.fac := φ.is_local_fac' _

@[simp] lemma fac_comp_algebra_map : φ.fac.comp (algebra_map A _) = φ :=
φ.fac'_comp_algebra_map _

lemma fac_uniq_pt_eq (p : ideal A) [p.is_prime]
  (f : localization.at_prime p →+* R) [is_local_ring_hom f]
  (hf : f.comp (algebra_map A (localization.at_prime p)) = φ) :
  p = (local_ring.maximal_ideal _).comap φ :=
φ.fac'_uniq_pt_eq _ (localization.at_prime p) f hf

-- 01J6, first sentence in proof
lemma fac_uniq (p : ideal A) [p.is_prime]
  (f : localization.at_prime p →+* R)
  (hf : f.comp (algebra_map A (localization.at_prime p)) = φ)
  [is_local_ring_hom f] :
  f = φ.fac.comp (is_localization.map _ (ring_hom.id A)
    (by { simp_rw [φ.fac_uniq_pt_eq p f hf], erw submonoid.comap_id,
      exact le_refl _} : p.prime_compl ≤ submonoid.comap (ring_hom.id A)
        ((local_ring.maximal_ideal R).comap φ).prime_compl)) :=
φ.fac'_uniq _ _ _ f hf

end target_local_ring

end ring_hom

namespace local_ring

section

variables (A R : Type u) [comm_ring A] [comm_ring R] [local_ring R]

variables {A} (pt : prime_spectrum A)

@[ext] structure local_ring_hom_ (M : Type u) [comm_ring M]
  [algebra A M] [is_localization.at_prime M pt.as_ideal] :=
(to_ring_hom : M →+* R)
[to_ring_hom_is_local : is_local_ring_hom to_ring_hom]

attribute [instance] local_ring_hom_.to_ring_hom_is_local
attribute [instance] is_localization.at_prime.local_ring

lemma local_ring_hom_.pt_eq {M : Type u} [comm_ring M]
  [algebra A M] [is_localization.at_prime M pt.as_ideal]
  (g : local_ring_hom_ R pt M) :
  (local_ring.maximal_ideal R).comap
    (g.to_ring_hom.comp $ algebra_map _ _ : A →+* R) = pt.as_ideal :=
begin
  ext : 1,
  rw [ideal.mem_comap, ring_hom.comp_apply],
  split,
  { intros h,
    contrapose! h,
    rw ←is_localization.at_prime.to_map_mem_maximal_iff M pt.as_ideal at h,
    rw [local_ring.mem_maximal_ideal, mem_nonunits_iff, not_not] at h ⊢,
    exact is_unit.map _ h, },
  { intros h0,
    refine map_nonunit g.to_ring_hom _ _,
    rwa is_localization.at_prime.to_map_mem_maximal_iff _ pt.as_ideal, },
end

@[ext] structure ring_hom_ :=
(to_ring_hom : A →+* R)
(pt_eq : (local_ring.maximal_ideal R).comap to_ring_hom = pt.as_ideal)

def local_ring_hom__equiv_ring_hom_ (M : Type  u) [comm_ring M]
  [algebra A M] [is_localization.at_prime M pt.as_ideal] :
  local_ring_hom_ R pt M ≃ ring_hom_ R pt :=
{ to_fun := λ g, ⟨g.1.comp $ algebra_map _ _, g.pt_eq _ _⟩,
  inv_fun := λ f,
  { to_ring_hom :=  @@ring_hom.fac' _ _ _ f.1 M _ _
    (by { simp_rw f.2, apply_instance }),
    to_ring_hom_is_local := infer_instance },
  left_inv := λ g,
  begin
    rcases g with ⟨g, hg⟩,
    resetI,
    ext,
    -- rw subtype.ext_iff_val,
    dsimp only,
    obtain ⟨a, b, rfl⟩ := is_localization.mk'_surjective _ x,
    rw [is_localization.lift_mk'], symmetry,
    rw [units.eq_mul_inv_iff_mul_eq],
    change _ * (g _) = _,
    dsimp,
    rw [←map_mul],
    congr' 1,
    rw [←is_localization.mk'_one M, ←is_localization.mk'_one M,
      ←is_localization.mk'_mul, mul_one, is_localization.eq],
    refine ⟨1, _⟩,
    simp only [submonoid.coe_one, one_mul, mul_one],
  end,
  right_inv := λ ⟨f, eq1⟩,
  begin
    ext : 1, dsimp only,
    haveI : is_localization.at_prime M (ideal.comap f (maximal_ideal R)),
    { simp_rw eq1, apply_instance },
    exact ring_hom.fac'_comp_algebra_map f M,
  end }

end

section

variables (A R : CommRing.{u}) [local_ring R]

@[ext] structure point_local_ring_hom_pair :=
(pt : prime_spectrum A)
(localized_ring : CommRing.{u})
[algebra_localized_ring : algebra A localized_ring]
[is_localization : is_localization.at_prime localized_ring pt.as_ideal]
(ring_hom_ : localized_ring ⟶ R)
[is_local_ring_hom_ : is_local_ring_hom ring_hom_]

attribute [instance] point_local_ring_hom_pair.algebra_localized_ring
attribute [instance] point_local_ring_hom_pair.is_localization
attribute [instance] point_local_ring_hom_pair.is_local_ring_hom_

namespace point_local_ring_hom_pair

variables (P Q S : point_local_ring_hom_pair A R)

section

variables {A R P Q}

@[simps]
def localized_ring_equiv_of_pt_eq (pt_eq : P.pt = Q.pt) :
  P.localized_ring ≅ Q.localized_ring :=
{ hom := is_localization.map _ (ring_hom.id A) $
      show P.pt.as_ideal.prime_compl ≤
        submonoid.comap (ring_hom.id A) Q.pt.as_ideal.prime_compl,
      by erw [submonoid.comap_id, pt_eq]; exact le_refl _,
  inv := is_localization.map _ (ring_hom.id A) $
      show Q.pt.as_ideal.prime_compl ≤
        submonoid.comap (ring_hom.id A) P.pt.as_ideal.prime_compl,
      by erw [submonoid.comap_id, pt_eq]; exact le_refl _,
  hom_inv_id' :=
  begin
    change ring_hom.comp _ _ = ring_hom.id _,
    rw is_localization.map_comp_map,
    simp_rw [ring_hom.id_comp],
    ext : 1,
    rw is_localization.map_id,
    refl,
  end,
  inv_hom_id' :=
  begin
    change ring_hom.comp _ _ = ring_hom.id _,
    rw is_localization.map_comp_map,
    simp_rw [ring_hom.id_comp],
    ext : 1,
    rw is_localization.map_id,
    refl,
  end }
-- { to_fun :=
-- is_localization.map _ (ring_hom.id A) $
--       show P.pt.as_ideal.prime_compl ≤
--         submonoid.comap (ring_hom.id A) Q.pt.as_ideal.prime_compl,
--       by erw [submonoid.comap_id, pt_eq]; exact le_refl _,
--   inv_fun := is_localization.map _ (ring_hom.id A) $
--       show Q.pt.as_ideal.prime_compl ≤
--         submonoid.comap (ring_hom.id A) P.pt.as_ideal.prime_compl,
--       by erw [submonoid.comap_id, pt_eq]; exact le_refl _,
--   left_inv := λ x,
--   begin
--     obtain ⟨a, b, eq0⟩ := is_localization.mk'_surjective P.pt.as_ideal.prime_compl x,
--     rw [←eq0, is_localization.map_mk', is_localization.map_mk',
--       ring_hom.id_apply, ring_hom.id_apply],
--     congr,
--     ext,
--     refl,
--   end,
--   right_inv := λ x,
--   begin
--     obtain ⟨a, b, eq0⟩ := is_localization.mk'_surjective Q.pt.as_ideal.prime_compl x,
--     rw [←eq0, is_localization.map_mk', is_localization.map_mk',
--       ring_hom.id_apply, ring_hom.id_apply],
--     congr,
--     ext,
--     refl,
--   end,
--   map_mul' := map_mul _,
--   map_add' := map_add _ }

variable (P)

def localized_ring_equiv :
  P.localized_ring ≃+* localization.at_prime P.pt.as_ideal :=
(is_localization.alg_equiv P.pt.as_ideal.prime_compl P.localized_ring
  (localization.at_prime P.pt.as_ideal)).to_ring_equiv

end

variables {A R}

@[reducible]
def ring_hom_' : localization.at_prime P.pt.as_ideal →+* R :=
P.ring_hom_.comp $ P.localized_ring_equiv.symm.to_ring_hom

instance is_local_ring_hom' : is_local_ring_hom P.ring_hom_' :=
@@is_local_ring_hom_comp _ _ _ _ _ _ $
  is_local_ring_hom_equiv (P.localized_ring_equiv.symm)

lemma ring_hom'_comp_algebra_map :
  P.ring_hom_'.comp (algebra_map A _) =
  P.ring_hom_.comp (algebra_map A _) :=
begin
  dsimp [ring_hom_'],
  erw [ring_hom.comp_assoc, is_localization.map_comp],
  congr,
  convert ring_hom.comp_id _,
end

section

variables {A R}

structure equiv : Prop :=
(pt_eq : P.pt = Q.pt)
(ring_hom_eq : P.ring_hom_
    = (localized_ring_equiv_of_pt_eq pt_eq).hom ≫ Q.ring_hom_)

lemma equiv.refl : P.equiv P :=
{ pt_eq := rfl,
  ring_hom_eq :=
  begin
    ext : 1,
    obtain ⟨a, b, rfl⟩ := is_localization.mk'_surjective
      P.pt.as_ideal.prime_compl x,
    erw [ring_hom.comp_apply, is_localization.map_mk'],
    refl,
  end }

lemma equiv.symm (h : P.equiv Q) : Q.equiv P :=
{ pt_eq := h.pt_eq.symm,
  ring_hom_eq :=
  begin
    rw [h.ring_hom_eq, ←category.assoc],
    symmetry, convert ring_hom.comp_id _,
    change ring_hom.comp _ _ = _,
    erw is_localization.map_comp_map,
    ext : 1,
    erw [is_localization.map_id, ring_hom.id_apply],
  end }

lemma equiv.trans (h1 : P.equiv Q) (h2 : Q.equiv S) : P.equiv S :=
{ pt_eq := h1.pt_eq.trans h2.pt_eq,
  ring_hom_eq :=
  begin
    rw [h1.ring_hom_eq, h2.ring_hom_eq, ←category.assoc],
    congr' 1,
    change ring_hom.comp _ _ = _,
    erw [is_localization.map_comp_map],
    refl,
  end }

end

end point_local_ring_hom_pair

variables {A R}

@[simps]
def to_point_local_ring_hom_pair (f : A ⟶ R) :
  point_local_ring_hom_pair A R :=
{ pt := ⟨(local_ring.maximal_ideal R).comap f, infer_instance⟩,
  localized_ring := CommRing.of $ localization.at_prime $
    (local_ring.maximal_ideal R).comap f,
  algebra_localized_ring := localization.algebra,
  is_localization := localization.is_localization ,
  ring_hom_ := f.fac,
  is_local_ring_hom_ := infer_instance }

@[simps]
def from_point_local_ring_hom_pair (P : point_local_ring_hom_pair A R) :
  A ⟶ R :=
P.ring_hom_.comp $ algebra_map _ _

lemma from_point_local_ring_hom_pair.resp_equiv
  {P Q : point_local_ring_hom_pair A R} (r : P.equiv Q) :
  from_point_local_ring_hom_pair P = from_point_local_ring_hom_pair Q :=
begin
  ext a,
  rw [from_point_local_ring_hom_pair_apply, from_point_local_ring_hom_pair,
    r.ring_hom_eq, ring_hom.comp_apply],
  erw [point_local_ring_hom_pair.localized_ring_equiv_of_pt_eq_hom],
  rw [←comp_apply, ←comp_apply, ←category.assoc],
  change ring_hom.comp _ (ring_hom.comp _ _) _ = ring_hom.comp _ _ _,
  rw [is_localization.map_comp, ring_hom.comp_id],
end

lemma from_point_local_ring_hom_pair.surjective (f : A ⟶ R) :
  ∃ (P : point_local_ring_hom_pair A R), from_point_local_ring_hom_pair P = f :=
⟨{ pt := ⟨(local_ring.maximal_ideal R).comap f, infer_instance⟩,
    localized_ring := CommRing.of $ localization.at_prime $
      (local_ring.maximal_ideal R).comap f,
    algebra_localized_ring := localization.algebra,
    is_localization := localization.is_localization,
    ring_hom_ := f.fac,
    is_local_ring_hom_ := infer_instance },
begin
  dsimp [from_point_local_ring_hom_pair],
  rw f.fac_comp_algebra_map,
end⟩

lemma from_point_local_ring_hom_pair.almost_injective {P Q : point_local_ring_hom_pair A R}
  (h : from_point_local_ring_hom_pair P = from_point_local_ring_hom_pair Q) :
  P.equiv Q :=
begin
  have pt_eq : P.pt = Q.pt,
  { dsimp [from_point_local_ring_hom_pair] at h,
    have eq0 := ring_hom.fac_uniq_pt_eq (P.ring_hom_.comp (algebra_map A P.localized_ring))
      P.pt.as_ideal P.ring_hom_' P.ring_hom'_comp_algebra_map,
    have eq1 := ring_hom.fac_uniq_pt_eq (Q.ring_hom_.comp (algebra_map A Q.localized_ring))
      Q.pt.as_ideal Q.ring_hom_' Q.ring_hom'_comp_algebra_map,
    ext1,
    change P.pt.as_ideal = Q.pt.as_ideal,
    rw [eq0, eq1, h], },
  refine ⟨pt_eq, _⟩,
  ext : 1,
  obtain ⟨a, b, rfl⟩:= is_localization.mk'_surjective P.pt.as_ideal.prime_compl x,
  rw [comp_apply],
  erw [is_localization.map_mk'],
  simp_rw [ring_hom.id_apply],
  haveI u1 : is_unit (algebra_map A P.localized_ring b),
  { rw [←is_localization.mk'_one P.localized_ring,
      is_localization.at_prime.is_unit_mk'_iff _ P.pt.as_ideal],
    exact b.2,
    exactI P.is_localization },
  generalize_proofs h1 h2 h3 h4 h5,
  haveI u2 : is_unit (algebra_map A Q.localized_ring (⟨_, h5⟩ : Q.pt.as_ideal.prime_compl)),
  { rw [←is_localization.mk'_one Q.localized_ring,
      is_localization.at_prime.is_unit_mk'_iff _ Q.pt.as_ideal],
    exact h5,
    exactI Q.is_localization },
  have eq0 : is_localization.mk' P.localized_ring a b =
    (algebra_map _ _ a) * u1.unit.inv,
  { erw [units.eq_mul_inv_iff_mul_eq, u1.some_spec,
      ←is_localization.mk'_one P.localized_ring,
      ←is_localization.mk'_one P.localized_ring,
      ←is_localization.mk'_mul, mul_one, is_localization.eq],
    refine ⟨1, _⟩,
    simp only [submonoid.coe_one, mul_one], },
  have eq1 : is_localization.mk' Q.localized_ring a ⟨_, h5⟩ =
    (algebra_map _ _ a) * u2.unit.inv,
  { erw [units.eq_mul_inv_iff_mul_eq, u2.some_spec,
      ←is_localization.mk'_one Q.localized_ring,
      ←is_localization.mk'_one Q.localized_ring,
      ←is_localization.mk'_mul, mul_one, is_localization.eq],
    refine ⟨1, _⟩,
    simp only [submonoid.coe_one, mul_one], },
  rw [eq0, eq1, map_mul, map_mul, ←ring_hom.comp_apply, ←ring_hom.comp_apply,
    units.inv_eq_coe_inv, units.inv_eq_coe_inv],
  erw [fun_like.congr_fun h a, ring_hom.is_local_ring_hom.map_inv,
    ring_hom.is_local_ring_hom.map_inv],
  congr' 1,
  rw [units.inv_eq_coe_inv, units.inv_eq_coe_inv],
  apply units.eq_inv_of_mul_eq_one_left, symmetry,
  rw [units.eq_mul_inv_iff_mul_eq, one_mul],
  dsimp,
  rw [←ring_hom.comp_apply, ←ring_hom.comp_apply],
  erw fun_like.congr_fun h (b : A),
  refl,
end

lemma to_point_local_ring_hom_pair.almost_surjective (f : A →+* R) :
  ∃ (P : point_local_ring_hom_pair A R),
    P.equiv (to_point_local_ring_hom_pair f) :=
  /-
  This is saying if `f : A →+* R`, then there exists a triple
  `P := (𝔭, M ⟶ R, M ≅ A_𝔭)` such that `to_point_local_ring_hom_pair f` is
  equivalent to `P`.
  -/
⟨{ pt := ⟨(local_ring.maximal_ideal R).comap f, infer_instance⟩,
    localized_ring := CommRing.of $ localization.at_prime $
      (local_ring.maximal_ideal R).comap f,
    algebra_localized_ring := localization.algebra,
    is_localization := localization.is_localization,
    ring_hom_ := f.fac,
    is_local_ring_hom_ := infer_instance },
  { pt_eq := rfl,
    ring_hom_eq :=
    begin
      dsimp only [to_point_local_ring_hom_pair_ring_hom_],
      symmetry, convert ring_hom.comp_id _,
      ext x : 1,
      induction x using localization.induction_on with data,
      rcases data with ⟨a, b, hab⟩,
      erw point_local_ring_hom_pair.localized_ring_equiv_of_pt_eq_hom,
      rw [ring_hom.id_apply],
      erw is_localization.map_id,
    end }⟩

lemma to_point_local_ring_hom_pair.almost_injective {f g : A ⟶ R}
  (hfg : (to_point_local_ring_hom_pair f).equiv (to_point_local_ring_hom_pair g)) :
  f = g :=
begin
  have := hfg.ring_hom_eq,
  dsimp at this,
  replace this := congr_arg (λ h, ring_hom.comp h (algebra_map A (localization.at_prime (ideal.comap f (maximal_ideal R))))) this,
  dsimp at this,
  rw f.fac_comp_algebra_map at this,
  erw [this, ring_hom.comp_assoc],
  convert ←g.fac_comp_algebra_map,
  erw is_localization.map_comp,
  rw [ring_hom.comp_id],
  refl,
end

lemma from_to_point_local_ring_hom_pair (f : A ⟶ R) :
  from_point_local_ring_hom_pair (to_point_local_ring_hom_pair f) = f :=
begin
  ext x : 1,
  rw [from_point_local_ring_hom_pair_apply,
    to_point_local_ring_hom_pair_ring_hom_, ←ring_hom.comp_apply],
  conv_rhs { rw ←f.fac_comp_algebra_map },
  congr' 1,
end

lemma to_from_point_local_ring_hom_pair (P : point_local_ring_hom_pair A R) :
  (to_point_local_ring_hom_pair (from_point_local_ring_hom_pair P)).equiv P :=
from_point_local_ring_hom_pair.almost_injective
  (from_to_point_local_ring_hom_pair _)

end

end local_ring


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Scott Morrison
-/
import category_theory.preadditive.injective
import algebra.homology.single

/-!
# Injective resolutions

A injective resolution `I : InjectiveResolution Z` of an object `Z : C` consists of
a `ℕ`-indexed cochain complex `I.cocomplex` of injective objects,
along with a cochain map `I.ι` from cochain complex consisting just of `Z` in degree zero to `C`,
so that the augmented cochain complex is exact.
```
Z ----> 0 ----> ... ----> 0 ----> ...
|       |                 |
|       |                 |
v       v                 v
I⁰ ---> I¹ ---> ... ----> Iⁿ ---> ...
```
-/

noncomputable theory

open category_theory
open category_theory.limits

universes v u

namespace category_theory
variables {C : Type u} [category.{v} C]

open injective

variables [has_zero_object C] [has_zero_morphisms C] [has_equalizers C] [has_images C]

/--
An `InjectiveResolution Z` consists of a bundled `ℕ`-indexed cochain complex of injective objects,
along with a quasi-isomorphism to the complex consisting of just `Z` supported in degree `0`.

Except in situations where you want to provide a particular injective resolution
(for example to compute a derived functor),
you will not typically need to use this bundled object, and will instead use
* `injective_resolution Z`: the `ℕ`-indexed cochain complex
  (equipped with `injective` and `exact` instances)
* `injective_resolution.ι Z`: the cochain map from  `(single C _ 0).obj Z` to
  `injective_resolution Z` (all the components are equipped with `mono` instances,
  and when the category is `abelian` we will show `ι` is a quasi-iso).
-/
@[nolint has_inhabited_instance]
structure InjectiveResolution (Z : C) :=
(cocomplex : cochain_complex C ℕ)
(ι: ((cochain_complex.single₀ C).obj Z) ⟶ cocomplex)
(injective : ∀ n, injective (cocomplex.X n) . tactic.apply_instance)
(exact₀ : exact (ι.f 0) (cocomplex.d 0 1) . tactic.apply_instance)
(exact : ∀ n, exact (cocomplex.d n (n+1)) (cocomplex.d (n+1) (n+2)) . tactic.apply_instance)
(mono : mono (ι.f 0) . tactic.apply_instance)

attribute [instance] InjectiveResolution.injective InjectiveResolution.mono

/-- An object admits a injective resolution. -/
class has_injective_resolution (Z : C) : Prop :=
(out [] : nonempty (InjectiveResolution Z))

section
variables (C)

/-- You will rarely use this typeclass directly: it is implied by the combination
`[enough_injectives C]` and `[abelian C]`. -/
class has_injective_resolutions : Prop :=
(out : ∀ Z : C, has_injective_resolution Z)

attribute [instance, priority 100] has_injective_resolutions.out

end

namespace InjectiveResolution

@[simp] lemma ι_f_succ {Z : C} (I : InjectiveResolution Z) (n : ℕ) :
  I.ι.f (n+1) = 0 :=
begin
  apply zero_of_source_iso_zero,
  dsimp, refl,
end

@[simp] lemma ι_f_zero_comp_complex_d {Z : C} (I : InjectiveResolution Z) :
  I.ι.f 0 ≫ I.cocomplex.d 0 1 = 0 :=
I.exact₀.w

@[simp] lemma complex_d_comp {Z : C} (I : InjectiveResolution Z) (n : ℕ) :
  I.cocomplex.d n (n + 1) ≫ I.cocomplex.d (n + 1) (n + 2) = 0 :=
(I.exact _).w

instance {Z : C} (I : InjectiveResolution Z) (n : ℕ) : category_theory.mono (I.ι.f n) :=
by cases n; apply_instance

/-- An injective object admits a trivial injective resolution: itself in degree 0. -/
def self (Z : C) [category_theory.injective Z] : InjectiveResolution Z :=
{ cocomplex := (cochain_complex.single₀ C).obj Z,
  ι := 𝟙 ((cochain_complex.single₀ C).obj Z),
  injective := λ n, begin
    cases n;
    { dsimp, apply_instance },
  end,
  exact₀ := by { dsimp, exact exact_epi_zero _ },
  exact := λ n, by { dsimp, exact exact_of_zero _ _ },
  mono := by { dsimp, apply_instance, }, }

end InjectiveResolution

end category_theory


theorem Fin.ext_iff : (Fin.mk m h₁ : Fin k) = Fin.mk n h₂ ↔ m = n :=
  Fin.mk.injEq _ _ _ _ ▸ Iff.rfl

example (h : m = n) : (Fin.mk m h₁ : Fin k) = Fin.mk n h₂ := by
  apply Fin.ext_iff.2
  exact h

example (h : m = n) : (Fin.mk m h₁ : Fin k) = Fin.mk n h₂ := by
  simp
  exact h


/-
Copyright (c) 2022 Huub Vromen. All rights reserved.
Author: Huub Vromen
-/

import data.finset.basic
import tactic.induction

/- Multi-agent propositional modal logic-/

/-- indiv is the type of individuals -/
variable {indiv : Type}

/-- a frame is a set of worlds with accessibility relations for each individual -/
structure m_frame (indiv : Type) :=
(wo : Type) (h1 : inhabited wo) (h2 : inhabited indiv) (r : indiv → wo → wo → Prop)

variable {f : m_frame indiv}
variables φ ψ : f.wo → Prop

/-- we define `implication`, `conjunction`, `negation` and `validity` for modal propositions
   (that is, functions `wo → Prop`) -/
def m_imp (φ ψ : f.wo → Prop): f.wo → Prop := λw, φ w → ψ w
infixr ` ⟶ ` : 90 := m_imp

def m_neg (φ : f.wo → Prop) : f.wo → Prop := λw, ¬ φ w
notation ` ¬ₘ ` := m_neg

def m_conj (φ ψ : f.wo → Prop): f.wo → Prop := λw, φ w ∧ ψ w
infixr ` ∧ₘ ` : 90 := m_conj

def m_valid (φ : f.wo → Prop) : Prop := ∀w, φ w
notation `⊢ ` φ := m_valid φ

/-- We define 'agent i has reason to believe φ' -/
def R (i : indiv) (φ : f.wo → Prop) : f.wo → Prop :=
    λw, ∀v, f.r i w v → φ v

/-- We define 'all agents have reason to believe φ' -/
def Rg : f.wo → Prop :=
    λw, ∀i, R i φ w

/-- Two worlds are connected iff the second one is accessible from the first one for
    some individual  -/
def connected (w v : f.wo) : Prop := ∃i, f.r i w v

/-- We define the transitive closure of r -/
inductive trcl (r : indiv → f.wo → f.wo → Prop) : f.wo → f.wo → Prop
| base {w v : f.wo }    : connected w v → trcl w v
| trans {w v u : f.wo } : connected w u → trcl u v → trcl w v

/-- We define 'common reason to believe φ' -/
def CRg (φ : f.wo → Prop) : f.wo → Prop :=
    λw, ∀v, trcl f.r w v → φ v

-- Common reason to believe can be axiomatically characterized

lemma fixed_point_theorem : ∀w, (CRg φ w) ↔ (Rg (φ ∧ₘ CRg φ)) w :=
-- the proof follows Fagin (1995, p. 36-37)
begin
intro s,
split,
{   intro h1,
    rw CRg at h1,
    rw Rg,
    intro i,
    rw R,
    intros u hu,
    simp [m_conj],
    have h2 : connected s u, by apply exists.intro i; assumption,
    split,
    { have h3 : trcl f.r s u := trcl.base h2,
      exact h1 u h3  },
    { rw CRg,
      intros t ht,
      have h4 : trcl f.r s t := trcl.trans h2 ht,
      exact h1 t h4 }   },
{   intros h2,
    rw CRg,
    intros v hv,
    cases' hv,
    {   cases' h with i hi,
        have h5 : R i (φ ∧ₘ CRg φ) s := h2 i,
        rw R at h5,
        have h6 : (φ ∧ₘ CRg φ) v := h5 v hi,
        exact h6.1   },
    {   cases' h with i hu,
        have h5 : R i (φ ∧ₘ CRg φ) s := h2 i,
        rw R at h5,
        have h6 : (φ ∧ₘ CRg φ) u := h5 u hu,
        have h7 : CRg φ u := h6.2,
        exact h7 v hv,   },   },
end

lemma induction_rule : (⊢ φ ⟶ Rg (φ ∧ₘ ψ)) → (⊢ (φ ⟶ CRg ψ)) :=
-- the proof follows Fagin (1995, p. 36-37)
begin
intros h1 s h2 v hv,
have hh : φ v ∧ ψ v :=
    begin
    --rw m_imp at h1,
    have h3 : Rg (φ ∧ₘ ψ) s, from h1 s h2,
    --rw Rg at h3,
    induction' hv with s u,
    {   cases h with k hk,
        have h4 : R k (φ ∧ₘ ψ) s, from h3 k,
        --rw R at h4,
        have h5 : (φ ∧ₘ ψ) u, from h4 u hk,
        --rw m_conj at h5,
        assumption, },
    {   cases' h with k hk,
        have h6 : R k (φ ∧ₘ ψ) s, from h3 k,
        --rw m_conj at h6,
        --rw R at h6,
        have h12 : φ u := (h6 u hk).1,
        have h13 : Rg (φ ∧ₘ ψ) u := h1 u h12,
        have h7 : Rg (φ ∧ₘ ψ) u → (φ v ∧ ψ v) := ih φ ψ h1 h12,
        exact h7 h13,    },
    end,
exact hh.2,
end


import data.real.basic
import data.real.nnreal
import analysis.special_functions.pow

theorem CAMOProblemsProblem1_2020 (f : nnreal -> nnreal) :
(∀ x y : nnreal, f(x)*f(y)*f(x+y) = f(x)+f(y) - f(x+y)) →
(∃ a : nnreal, (a > 1 ∧ ∀ x : nnreal, f(x) = (a.rpow x -1) / (a.rpow x +1))):= sorry


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import algebra.module.basic
import algebra.gcd_monoid.basic
import algebra.group_ring_action
import group_theory.group_action.defs

/-!
# Instances on punit

This file collects facts about algebraic structures on the one-element type, e.g. that it is a
commutative ring.
-/

universes u

namespace punit
variables {R S : Type*} (x y : punit.{u+1}) (s : set punit.{u+1})

@[to_additive]
instance : comm_group punit :=
by refine_struct
{ mul := λ _ _, star,
  one := star,
  inv := λ _, star,
  div := λ _ _, star,
  npow := λ _ _, star,
  zpow := λ _ _, star,
  .. };
intros; exact subsingleton.elim _ _

@[simp, to_additive] lemma one_eq : (1 : punit) = star := rfl
@[simp, to_additive] lemma mul_eq : x * y = star := rfl
-- `sub_eq` simplifies `punit.sub_eq`, but the latter is eligible for `dsimp`
@[simp, nolint simp_nf, to_additive] lemma div_eq : x / y = star := rfl
-- `neg_eq` simplifies `punit.neg_eq`, but the latter is eligible for `dsimp`
@[simp, nolint simp_nf, to_additive] lemma inv_eq : x⁻¹ = star := rfl

instance : comm_ring punit :=
by refine
{ .. punit.comm_group,
  .. punit.add_comm_group,
  .. };
intros; exact subsingleton.elim _ _

instance : cancel_comm_monoid_with_zero punit :=
by refine
{ .. punit.comm_ring,
  .. };
intros; exact subsingleton.elim _ _

instance : normalized_gcd_monoid punit :=
by refine
{ gcd := λ _ _, star,
  lcm := λ _ _, star,
  norm_unit := λ x, 1,
  gcd_dvd_left := λ _ _, ⟨star, subsingleton.elim _ _⟩,
  gcd_dvd_right := λ _ _, ⟨star, subsingleton.elim _ _⟩,
  dvd_gcd := λ _ _ _ _ _, ⟨star, subsingleton.elim _ _⟩,
  gcd_mul_lcm := λ _ _, ⟨1, subsingleton.elim _ _⟩,
  .. };
intros; exact subsingleton.elim _ _

@[simp] lemma gcd_eq : gcd x y = star := rfl
@[simp] lemma lcm_eq : lcm x y = star := rfl
@[simp] lemma norm_unit_eq : norm_unit x = 1 := rfl

instance : complete_boolean_algebra punit :=
by refine
{ le := λ _ _, true,
  le_antisymm := λ _ _ _ _, subsingleton.elim _ _,
  lt := λ _ _, false,
  lt_iff_le_not_le := λ _ _, iff_of_false not_false (λ H, H.2 trivial),
  top := star,
  bot := star,
  sup := λ _ _, star,
  inf := λ _ _, star,
  Sup := λ _, star,
  Inf := λ _, star,
  compl := λ _, star,
  sdiff := λ _ _, star,
  .. };
intros; trivial <|> simp only [eq_iff_true_of_subsingleton]

@[simp] lemma top_eq : (⊤ : punit) = star := rfl
@[simp] lemma bot_eq : (⊥ : punit) = star := rfl
@[simp] lemma sup_eq : x ⊔ y = star := rfl
@[simp] lemma inf_eq : x ⊓ y = star := rfl
@[simp] lemma Sup_eq : Sup s = star := rfl
@[simp] lemma Inf_eq : Inf s = star := rfl
@[simp] lemma compl_eq : xᶜ = star := rfl
@[simp] lemma sdiff_eq : x \ y = star := rfl
@[simp] protected lemma le : x ≤ y := trivial
@[simp] lemma not_lt : ¬(x < y) := not_false

instance : canonically_ordered_add_monoid punit :=
by refine
{ le_iff_exists_add := λ _ _, iff_of_true _ ⟨star, subsingleton.elim _ _⟩,
  .. punit.comm_ring, .. punit.complete_boolean_algebra, .. };
intros; trivial

instance : linear_ordered_cancel_add_comm_monoid punit :=
{ add_left_cancel := λ _ _ _ _, subsingleton.elim _ _,
  le_of_add_le_add_left := λ _ _ _ _, trivial,
  le_total := λ _ _, or.inl trivial,
  decidable_le := λ _ _, decidable.true,
  decidable_eq := punit.decidable_eq,
  decidable_lt := λ _ _, decidable.false,
  .. punit.canonically_ordered_add_monoid }

instance : has_scalar R punit :=
{ smul := λ _ _, star }

@[simp] lemma smul_eq (r : R) : r • y = star := rfl

instance : is_central_scalar R punit := ⟨λ _ _, rfl⟩

instance : smul_comm_class R S punit := ⟨λ _ _ _, subsingleton.elim _ _⟩

instance [has_scalar R S] : is_scalar_tower R S punit := ⟨λ _ _ _, subsingleton.elim _ _⟩

instance [has_zero R] : smul_with_zero R punit :=
by refine { ..punit.has_scalar, .. };
intros; exact subsingleton.elim _ _

instance [monoid R] : mul_action R punit :=
by refine { ..punit.has_scalar, .. };
intros; exact subsingleton.elim _ _

instance [monoid R] : distrib_mul_action R punit :=
by refine { ..punit.mul_action, .. };
intros; exact subsingleton.elim _ _

instance [monoid R] : mul_distrib_mul_action R punit :=
by refine { ..punit.mul_action, .. };
intros; exact subsingleton.elim _ _

instance [semiring R] : mul_semiring_action R punit :=
{ ..punit.distrib_mul_action, ..punit.mul_distrib_mul_action }

instance [monoid_with_zero R] : mul_action_with_zero R punit :=
{ .. punit.mul_action, .. punit.smul_with_zero }

instance [semiring R] : module R punit :=
by refine { .. punit.distrib_mul_action, .. };
intros; exact subsingleton.elim _ _

end punit


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.metric_space.polish
import measure_theory.constructions.borel_space

/-!
# The Borel sigma-algebra on Polish spaces

We discuss several results pertaining to the relationship between the topology and the Borel
structure on Polish spaces.

## Main definitions and results

First, we define the class of analytic sets and establish its basic properties.

* `measure_theory.analytic_set s`: a set in a topological space is analytic if it is the continuous
  image of a Polish space. Equivalently, it is empty, or the image of `ℕ → ℕ`.
* `measure_theory.analytic_set.image_of_continuous`: a continuous image of an analytic set is
  analytic.
* `measurable_set.analytic_set`: in a Polish space, any Borel-measurable set is analytic.

Then, we show Lusin's theorem that two disjoint analytic sets can be separated by Borel sets.

* `measurably_separable s t` states that there exists a measurable set containing `s` and disjoint
  from `t`.
* `analytic_set.measurably_separable` shows that two disjoint analytic sets are separated by a
  Borel set.

Finally, we prove the Lusin-Souslin theorem that a continuous injective image of a Borel subset of
a Polish space is Borel. The proof of this nontrivial result relies on the above results on
analytic sets.

* `measurable_set.image_of_continuous_on_inj_on` asserts that, if `s` is a Borel measurable set in
  a Polish space, then the image of `s` under a continuous injective map is still Borel measurable.
* `continuous.measurable_embedding` states that a continuous injective map on a Polish space
  is a measurable embedding for the Borel sigma-algebra.
* `continuous_on.measurable_embedding` is the same result for a map restricted to a measurable set
  on which it is continuous.
* `measurable.measurable_embedding` states that a measurable injective map from a Polish space
  to a second-countable topological space is a measurable embedding.
* `is_clopenable_iff_measurable_set`: in a Polish space, a set is clopenable (i.e., it can be made
  open and closed by using a finer Polish topology) if and only if it is Borel-measurable.
-/

open set function polish_space pi_nat topological_space metric filter
open_locale topology measure_theory filter

variables {α : Type*} [topological_space α] {ι : Type*}

namespace measure_theory

/-! ### Analytic sets -/

/-- An analytic set is a set which is the continuous image of some Polish space. There are several
equivalent characterizations of this definition. For the definition, we pick one that avoids
universe issues: a set is analytic if and only if it is a continuous image of `ℕ → ℕ` (or if it
is empty). The above more usual characterization is given
in `analytic_set_iff_exists_polish_space_range`.

Warning: these are analytic sets in the context of descriptive set theory (which is why they are
registered in the namespace `measure_theory`). They have nothing to do with analytic sets in the
context of complex analysis. -/
@[irreducible] def analytic_set (s : set α) : Prop :=
s = ∅ ∨ ∃ (f : (ℕ → ℕ) → α), continuous f ∧ range f = s

lemma analytic_set_empty : analytic_set (∅ : set α) :=
begin
  rw analytic_set,
  exact or.inl rfl
end

lemma analytic_set_range_of_polish_space
  {β : Type*} [topological_space β] [polish_space β] {f : β → α} (f_cont : continuous f) :
  analytic_set (range f) :=
begin
  casesI is_empty_or_nonempty β,
  { rw range_eq_empty,
    exact analytic_set_empty },
  { rw analytic_set,
    obtain ⟨g, g_cont, hg⟩ : ∃ (g : (ℕ → ℕ) → β), continuous g ∧ surjective g :=
      exists_nat_nat_continuous_surjective β,
    refine or.inr ⟨f ∘ g, f_cont.comp g_cont, _⟩,
    rwa hg.range_comp }
end

/-- The image of an open set under a continuous map is analytic. -/
lemma _root_.is_open.analytic_set_image {β : Type*} [topological_space β] [polish_space β]
  {s : set β} (hs : is_open s) {f : β → α} (f_cont : continuous f) :
  analytic_set (f '' s) :=
begin
  rw image_eq_range,
  haveI : polish_space s := hs.polish_space,
  exact analytic_set_range_of_polish_space (f_cont.comp continuous_subtype_coe),
end

/-- A set is analytic if and only if it is the continuous image of some Polish space. -/
theorem analytic_set_iff_exists_polish_space_range {s : set α} :
  analytic_set s ↔ ∃ (β : Type) (h : topological_space β) (h' : @polish_space β h) (f : β → α),
    @continuous _ _ h _ f ∧ range f = s :=
begin
  split,
  { assume h,
    rw analytic_set at h,
    cases h,
    { refine ⟨empty, by apply_instance, by apply_instance, empty.elim, continuous_bot, _⟩,
      rw h,
      exact range_eq_empty _ },
    { exact ⟨ℕ → ℕ, by apply_instance, by apply_instance, h⟩ } },
  { rintros ⟨β, h, h', f, f_cont, f_range⟩,
    resetI,
    rw ← f_range,
    exact analytic_set_range_of_polish_space f_cont }
end

/-- The continuous image of an analytic set is analytic -/
lemma analytic_set.image_of_continuous_on {β : Type*} [topological_space β]
  {s : set α} (hs : analytic_set s) {f : α → β} (hf : continuous_on f s) :
  analytic_set (f '' s) :=
begin
  rcases analytic_set_iff_exists_polish_space_range.1 hs with ⟨γ, γtop, γpolish, g, g_cont, gs⟩,
  resetI,
  have : f '' s = range (f ∘ g), by rw [range_comp, gs],
  rw this,
  apply analytic_set_range_of_polish_space,
  apply hf.comp_continuous g_cont (λ x, _),
  rw ← gs,
  exact mem_range_self _
end

lemma analytic_set.image_of_continuous {β : Type*} [topological_space β]
  {s : set α} (hs : analytic_set s) {f : α → β} (hf : continuous f) :
  analytic_set (f '' s) :=
hs.image_of_continuous_on hf.continuous_on

/-- A countable intersection of analytic sets is analytic. -/
theorem analytic_set.Inter [hι : nonempty ι] [countable ι] [t2_space α]
  {s : ι → set α} (hs : ∀ n, analytic_set (s n)) :
  analytic_set (⋂ n, s n) :=
begin
  unfreezingI { rcases hι with ⟨i₀⟩ },
  /- For the proof, write each `s n` as the continuous image under a map `f n` of a
  Polish space `β n`. The product space `γ = Π n, β n` is also Polish, and so is the subset
  `t` of sequences `x n` for which `f n (x n)` is independent of `n`. The set `t` is Polish, and the
  range of `x ↦ f 0 (x 0)` on `t` is exactly `⋂ n, s n`, so this set is analytic. -/
  choose β hβ h'β f f_cont f_range using λ n, analytic_set_iff_exists_polish_space_range.1 (hs n),
  resetI,
  let γ := Π n, β n,
  let t : set γ := ⋂ n, {x | f n (x n) = f i₀ (x i₀)},
  have t_closed : is_closed t,
  { apply is_closed_Inter,
    assume n,
    exact is_closed_eq ((f_cont n).comp (continuous_apply n))
      ((f_cont i₀).comp (continuous_apply i₀)) },
  haveI : polish_space t := t_closed.polish_space,
  let F : t → α := λ x, f i₀ ((x : γ) i₀),
  have F_cont : continuous F :=
    (f_cont i₀).comp ((continuous_apply i₀).comp continuous_subtype_coe),
  have F_range : range F = ⋂ (n : ι), s n,
  { apply subset.antisymm,
    { rintros y ⟨x, rfl⟩,
      apply mem_Inter.2 (λ n, _),
      have : f n ((x : γ) n) = F x := (mem_Inter.1 x.2 n : _),
      rw [← this, ← f_range n],
      exact mem_range_self _ },
    { assume y hy,
      have A : ∀ n, ∃ (x : β n), f n x = y,
      { assume n,
        rw [← mem_range, f_range n],
        exact mem_Inter.1 hy n },
      choose x hx using A,
      have xt : x ∈ t,
      { apply mem_Inter.2 (λ n, _),
        simp [hx] },
        refine ⟨⟨x, xt⟩, _⟩,
        exact hx i₀ } },
  rw ← F_range,
  exact analytic_set_range_of_polish_space F_cont,
end

/-- A countable union of analytic sets is analytic. -/
theorem analytic_set.Union [countable ι] {s : ι → set α} (hs : ∀ n, analytic_set (s n)) :
  analytic_set (⋃ n, s n) :=
begin
  /- For the proof, write each `s n` as the continuous image under a map `f n` of a
  Polish space `β n`. The union space `γ = Σ n, β n` is also Polish, and the map `F : γ → α` which
  coincides with `f n` on `β n` sends it to `⋃ n, s n`. -/
  choose β hβ h'β f f_cont f_range using λ n, analytic_set_iff_exists_polish_space_range.1 (hs n),
  resetI,
  let γ := Σ n, β n,
  let F : γ → α := by { rintros ⟨n, x⟩, exact f n x },
  have F_cont : continuous F := continuous_sigma f_cont,
  have F_range : range F = ⋃ n, s n,
  { rw [range_sigma_eq_Union_range],
    congr,
    ext1 n,
    rw ← f_range n },
  rw ← F_range,
  exact analytic_set_range_of_polish_space F_cont,
end

theorem _root_.is_closed.analytic_set [polish_space α] {s : set α} (hs : is_closed s) :
  analytic_set s :=
begin
  haveI : polish_space s := hs.polish_space,
  rw ← @subtype.range_val α s,
  exact analytic_set_range_of_polish_space continuous_subtype_coe,
end

/-- Given a Borel-measurable set in a Polish space, there exists a finer Polish topology making
it clopen. This is in fact an equivalence, see `is_clopenable_iff_measurable_set`. -/
lemma _root_.measurable_set.is_clopenable [polish_space α] [measurable_space α] [borel_space α]
  {s : set α} (hs : measurable_set s) :
  is_clopenable s :=
begin
  revert s,
  apply measurable_set.induction_on_open,
  { exact λ u hu, hu.is_clopenable },
  { exact λ u hu h'u, h'u.compl },
  { exact λ f f_disj f_meas hf, is_clopenable.Union hf }
end

theorem _root_.measurable_set.analytic_set
  {α : Type*} [t : topological_space α] [polish_space α] [measurable_space α] [borel_space α]
  {s : set α} (hs : measurable_set s) :
  analytic_set s :=
begin
  /- For a short proof (avoiding measurable induction), one sees `s` as a closed set for a finer
  topology `t'`. It is analytic for this topology. As the identity from `t'` to `t` is continuous
  and the image of an analytic set is analytic, it follows that `s` is also analytic for `t`. -/
  obtain ⟨t', t't, t'_polish, s_closed, s_open⟩ :
    ∃ t' : topological_space α, t' ≤ t ∧ @polish_space α t' ∧ is_closed[t'] s ∧ is_open[t'] s :=
    hs.is_clopenable,
  have A := @is_closed.analytic_set α t' t'_polish s s_closed,
  convert @analytic_set.image_of_continuous α t' α t s A id (continuous_id_of_le t't),
  simp only [id.def, image_id'],
end

/-- Given a Borel-measurable function from a Polish space to a second-countable space, there exists
a finer Polish topology on the source space for which the function is continuous. -/
lemma _root_.measurable.exists_continuous {α β : Type*}
  [t : topological_space α] [polish_space α] [measurable_space α] [borel_space α]
  [tβ : topological_space β] [second_countable_topology β] [measurable_space β] [borel_space β]
  {f : α → β} (hf : measurable f) :
  ∃ (t' : topological_space α), t' ≤ t ∧ @continuous α β t' tβ f ∧ @polish_space α t' :=
begin
  obtain ⟨b, b_count, -, hb⟩ : ∃b : set (set β), b.countable ∧ ∅ ∉ b ∧ is_topological_basis b :=
    exists_countable_basis β,
  haveI : encodable b := b_count.to_encodable,
  have : ∀ (s : b), is_clopenable (f ⁻¹' s),
  { assume s,
    apply measurable_set.is_clopenable,
    exact hf (hb.is_open s.2).measurable_set },
  choose T Tt Tpolish Tclosed Topen using this,
  obtain ⟨t', t'T, t't, t'_polish⟩ :
    ∃ (t' : topological_space α), (∀ i, t' ≤ T i) ∧ (t' ≤ t) ∧ @polish_space α t' :=
      exists_polish_space_forall_le T Tt Tpolish,
  refine ⟨t', t't, _, t'_polish⟩,
  apply hb.continuous _ (λ s hs, _),
  exact t'T ⟨s, hs⟩ _ (Topen ⟨s, hs⟩),
end

/-! ### Separating sets with measurable sets -/

/-- Two sets `u` and `v` in a measurable space are measurably separable if there
exists a measurable set containing `u` and disjoint from `v`.
This is mostly interesting for Borel-separable sets. -/
def measurably_separable {α : Type*} [measurable_space α] (s t : set α) : Prop :=
∃ u, s ⊆ u ∧ disjoint t u ∧ measurable_set u

lemma measurably_separable.Union [countable ι]
  {α : Type*} [measurable_space α] {s t : ι → set α}
  (h : ∀ m n, measurably_separable (s m) (t n)) :
  measurably_separable (⋃ n, s n) (⋃ m, t m) :=
begin
  choose u hsu htu hu using h,
  refine ⟨⋃ m, (⋂ n, u m n), _, _, _⟩,
  { refine Union_subset (λ m, subset_Union_of_subset m _),
    exact subset_Inter (λ n, hsu m n) },
  { simp_rw [disjoint_Union_left, disjoint_Union_right],
    assume n m,
    apply disjoint.mono_right _ (htu m n),
    apply Inter_subset },
  { refine measurable_set.Union (λ m, _),
    exact measurable_set.Inter (λ n, hu m n) }
end

/-- The hard part of the Lusin separation theorem saying that two disjoint analytic sets are
contained in disjoint Borel sets (see the full statement in `analytic_set.measurably_separable`).
Here, we prove this when our analytic sets are the ranges of functions from `ℕ → ℕ`.
-/
lemma measurably_separable_range_of_disjoint [t2_space α] [measurable_space α] [borel_space α]
  {f g : (ℕ → ℕ) → α} (hf : continuous f) (hg : continuous g) (h : disjoint (range f) (range g)) :
  measurably_separable (range f) (range g) :=
begin
  /- We follow [Kechris, *Classical Descriptive Set Theory* (Theorem 14.7)][kechris1995].
  If the ranges are not Borel-separated, then one can find two cylinders of length one whose images
  are not Borel-separated, and then two smaller cylinders of length two whose images are not
  Borel-separated, and so on. One thus gets two sequences of cylinders, that decrease to two
  points `x` and `y`. Their images are different by the disjointness assumption, hence contained
  in two disjoint open sets by the T2 property. By continuity, long enough cylinders around `x`
  and `y` have images which are separated by these two disjoint open sets, a contradiction.
  -/
  by_contra hfg,
  have I : ∀ n x y, (¬(measurably_separable (f '' (cylinder x n)) (g '' (cylinder y n))))
    → ∃ x' y', x' ∈ cylinder x n ∧ y' ∈ cylinder y n ∧
                ¬(measurably_separable (f '' (cylinder x' (n+1))) (g '' (cylinder y' (n+1)))),
  { assume n x y,
    contrapose!,
    assume H,
    rw [← Union_cylinder_update x n, ← Union_cylinder_update y n, image_Union, image_Union],
    refine measurably_separable.Union (λ i j, _),
    exact H _ _ (update_mem_cylinder _ _ _) (update_mem_cylinder _ _ _) },
  -- consider the set of pairs of cylinders of some length whose images are not Borel-separated
  let A := {p : ℕ × (ℕ → ℕ) × (ℕ → ℕ) //
              ¬(measurably_separable (f '' (cylinder p.2.1 p.1)) (g '' (cylinder p.2.2 p.1)))},
  -- for each such pair, one can find longer cylinders whose images are not Borel-separated either
  have : ∀ (p : A), ∃ (q : A), q.1.1 = p.1.1 + 1 ∧ q.1.2.1 ∈ cylinder p.1.2.1 p.1.1
    ∧ q.1.2.2 ∈ cylinder p.1.2.2 p.1.1,
  { rintros ⟨⟨n, x, y⟩, hp⟩,
    rcases I n x y hp with ⟨x', y', hx', hy', h'⟩,
    exact ⟨⟨⟨n+1, x', y'⟩, h'⟩, rfl, hx', hy'⟩ },
  choose F hFn hFx hFy using this,
  let p0 : A := ⟨⟨0, λ n, 0, λ n, 0⟩, by simp [hfg]⟩,
  -- construct inductively decreasing sequences of cylinders whose images are not separated
  let p : ℕ → A := λ n, F^[n] p0,
  have prec : ∀ n, p (n+1) = F (p n) := λ n, by simp only [p, iterate_succ'],
  -- check that at the `n`-th step we deal with cylinders of length `n`
  have pn_fst : ∀ n, (p n).1.1 = n,
  { assume n,
    induction n with n IH,
    { refl },
    { simp only [prec, hFn, IH] } },
  -- check that the cylinders we construct are indeed decreasing, by checking that the coordinates
  -- are stationary.
  have Ix : ∀ m n, m + 1 ≤ n → (p n).1.2.1 m = (p (m+1)).1.2.1 m,
  { assume m,
    apply nat.le_induction,
    { refl },
    assume n hmn IH,
    have I : (F (p n)).val.snd.fst m = (p n).val.snd.fst m,
    { apply hFx (p n) m,
      rw pn_fst,
      exact hmn },
    rw [prec, I, IH] },
  have Iy : ∀ m n, m + 1 ≤ n → (p n).1.2.2 m = (p (m+1)).1.2.2 m,
  { assume m,
    apply nat.le_induction,
    { refl },
    assume n hmn IH,
    have I : (F (p n)).val.snd.snd m = (p n).val.snd.snd m,
    { apply hFy (p n) m,
      rw pn_fst,
      exact hmn },
    rw [prec, I, IH] },
  -- denote by `x` and `y` the limit points of these two sequences of cylinders.
  set x : ℕ → ℕ := λ n, (p (n+1)).1.2.1 n with hx,
  set y : ℕ → ℕ := λ n, (p (n+1)).1.2.2 n with hy,
  -- by design, the cylinders around these points have images which are not Borel-separable.
  have M : ∀ n, ¬(measurably_separable (f '' (cylinder x n)) (g '' (cylinder y n))),
  { assume n,
    convert (p n).2 using 3,
    { rw [pn_fst, ← mem_cylinder_iff_eq, mem_cylinder_iff],
      assume i hi,
      rw hx,
      exact (Ix i n hi).symm },
    { rw [pn_fst, ← mem_cylinder_iff_eq, mem_cylinder_iff],
      assume i hi,
      rw hy,
      exact (Iy i n hi).symm } },
  -- consider two open sets separating `f x` and `g y`.
  obtain ⟨u, v, u_open, v_open, xu, yv, huv⟩ :
    ∃ u v : set α, is_open u ∧ is_open v ∧ f x ∈ u ∧ g y ∈ v ∧ disjoint u v,
  { apply t2_separation,
    exact disjoint_iff_forall_ne.1 h _ (mem_range_self _) _ (mem_range_self _) },
  letI : metric_space (ℕ → ℕ) := metric_space_nat_nat,
  obtain ⟨εx, εxpos, hεx⟩ : ∃ (εx : ℝ) (H : εx > 0), metric.ball x εx ⊆ f ⁻¹' u,
  { apply metric.mem_nhds_iff.1,
    exact hf.continuous_at.preimage_mem_nhds (u_open.mem_nhds xu) },
  obtain ⟨εy, εypos, hεy⟩ : ∃ (εy : ℝ) (H : εy > 0), metric.ball y εy ⊆ g ⁻¹' v,
  { apply metric.mem_nhds_iff.1,
    exact hg.continuous_at.preimage_mem_nhds (v_open.mem_nhds yv) },
  obtain ⟨n, hn⟩ : ∃ (n : ℕ), (1/2 : ℝ)^n < min εx εy :=
    exists_pow_lt_of_lt_one (lt_min εxpos εypos) (by norm_num),
  -- for large enough `n`, these open sets separate the images of long cylinders around `x` and `y`
  have B : measurably_separable (f '' (cylinder x n)) (g '' (cylinder y n)),
  { refine ⟨u, _, _, u_open.measurable_set⟩,
    { rw image_subset_iff,
      apply subset.trans _ hεx,
      assume z hz,
      rw mem_cylinder_iff_dist_le at hz,
      exact hz.trans_lt (hn.trans_le (min_le_left _ _)) },
    { refine disjoint.mono_left _ huv.symm,
      change g '' cylinder y n ⊆ v,
      rw image_subset_iff,
      apply subset.trans _ hεy,
      assume z hz,
      rw mem_cylinder_iff_dist_le at hz,
      exact hz.trans_lt (hn.trans_le (min_le_right _ _)) } },
  -- this is a contradiction.
  exact M n B
end

/-- The Lusin separation theorem: if two analytic sets are disjoint, then they are contained in
disjoint Borel sets. -/
theorem analytic_set.measurably_separable [t2_space α] [measurable_space α] [borel_space α]
  {s t : set α} (hs : analytic_set s) (ht : analytic_set t) (h : disjoint s t) :
  measurably_separable s t :=
begin
  rw analytic_set at hs ht,
  rcases hs with rfl|⟨f, f_cont, rfl⟩,
  { refine ⟨∅, subset.refl _, by simp, measurable_set.empty⟩ },
  rcases ht with rfl|⟨g, g_cont, rfl⟩,
  { exact ⟨univ, subset_univ _, by simp, measurable_set.univ⟩ },
  exact measurably_separable_range_of_disjoint f_cont g_cont h,
end

/-! ### Injective images of Borel sets -/

variables {γ : Type*} [tγ : topological_space γ] [polish_space γ]
include tγ

/-- The Lusin-Souslin theorem: the range of a continuous injective function defined on a Polish
space is Borel-measurable. -/
theorem measurable_set_range_of_continuous_injective {β : Type*}
  [topological_space β] [t2_space β] [measurable_space β] [borel_space β]
  {f : γ → β} (f_cont : continuous f) (f_inj : injective f) :
  measurable_set (range f) :=
begin
  /- We follow [Fremlin, *Measure Theory* (volume 4, 423I)][fremlin_vol4].
  Let `b = {s i}` be a countable basis for `α`. When `s i` and `s j` are disjoint, their images are
  disjoint analytic sets, hence by the separation theorem one can find a Borel-measurable set
  `q i j` separating them.
  Let `E i = closure (f '' s i) ∩ ⋂ j, q i j \ q j i`. It contains `f '' (s i)` and it is
  measurable. Let `F n = ⋃ E i`, where the union is taken over those `i` for which `diam (s i)`
  is bounded by some number `u n` tending to `0` with `n`.
  We claim that `range f = ⋂ F n`, from which the measurability is obvious. The inclusion `⊆` is
  straightforward. To show `⊇`, consider a point `x` in the intersection. For each `n`, it belongs
  to some `E i` with `diam (s i) ≤ u n`. Pick a point `y i ∈ s i`. We claim that for such `i`
  and `j`, the intersection `s i ∩ s j` is nonempty: if it were empty, then thanks to the
  separating set `q i j` in the definition of `E i` one could not have `x ∈ E i ∩ E j`.
  Since these two sets have small diameter, it follows that `y i` and `y j` are close.
  Thus, `y` is a Cauchy sequence, converging to a limit `z`. We claim that `f z = x`, completing
  the proof.
  Otherwise, one could find open sets `v` and `w` separating `f z` from `x`. Then, for large `n`,
  the image `f '' (s i)` would be included in `v` by continuity of `f`, so its closure would be
  contained in the closure of `v`, and therefore it would be disjoint from `w`. This is a
  contradiction since `x` belongs both to this closure and to `w`. -/
  letI := upgrade_polish_space γ,
  obtain ⟨b, b_count, b_nonempty, hb⟩ :
    ∃ b : set (set γ), b.countable ∧ ∅ ∉ b ∧ is_topological_basis b := exists_countable_basis γ,
  haveI : encodable b := b_count.to_encodable,
  let A := {p : b × b // disjoint (p.1 : set γ) p.2},
  -- for each pair of disjoint sets in the topological basis `b`, consider Borel sets separating
  -- their images, by injectivity of `f` and the Lusin separation theorem.
  have : ∀ (p : A), ∃ (q : set β), f '' (p.1.1 : set γ) ⊆ q ∧ disjoint (f '' (p.1.2 : set γ)) q
    ∧ measurable_set q,
  { assume p,
    apply analytic_set.measurably_separable ((hb.is_open p.1.1.2).analytic_set_image f_cont)
      ((hb.is_open p.1.2.2).analytic_set_image f_cont),
    exact disjoint.image p.2 (f_inj.inj_on univ) (subset_univ _) (subset_univ _) },
  choose q hq1 hq2 q_meas using this,
  -- define sets `E i` and `F n` as in the proof sketch above
  let E : b → set β := λ s, closure (f '' s) ∩
    (⋂ (t : b) (ht : disjoint s.1 t.1), q ⟨(s, t), ht⟩ \ q ⟨(t, s), ht.symm⟩),
  obtain ⟨u, u_anti, u_pos, u_lim⟩ :
    ∃ (u : ℕ → ℝ), strict_anti u ∧ (∀ (n : ℕ), 0 < u n) ∧ tendsto u at_top (𝓝 0) :=
      exists_seq_strict_anti_tendsto (0 : ℝ),
  let F : ℕ → set β := λ n, ⋃ (s : b) (hs : bounded s.1 ∧ diam s.1 ≤ u n), E s,
  -- it is enough to show that `range f = ⋂ F n`, as the latter set is obviously measurable.
  suffices : range f = ⋂ n, F n,
  { have E_meas : ∀ (s : b), measurable_set (E s),
    { assume b,
      refine is_closed_closure.measurable_set.inter _,
      refine measurable_set.Inter (λ s, _),
      exact measurable_set.Inter (λ hs, (q_meas _).diff (q_meas _)) },
    have F_meas : ∀ n, measurable_set (F n),
    { assume n,
      refine measurable_set.Union (λ s, _),
      exact measurable_set.Union (λ hs, E_meas _) },
    rw this,
    exact measurable_set.Inter (λ n, F_meas n) },
  -- we check both inclusions.
  apply subset.antisymm,
  -- we start with the easy inclusion `range f ⊆ ⋂ F n`. One just needs to unfold the definitions.
  { rintros x ⟨y, rfl⟩,
    apply mem_Inter.2 (λ n, _),
    obtain ⟨s, sb, ys, hs⟩ : ∃ (s : set γ) (H : s ∈ b), y ∈ s ∧ s ⊆ ball y (u n / 2),
    { apply hb.mem_nhds_iff.1,
      exact ball_mem_nhds _ (half_pos (u_pos n)) },
    have diam_s : diam s ≤ u n,
    { apply (diam_mono hs bounded_ball).trans,
      convert diam_ball (half_pos (u_pos n)).le,
      ring },
    refine mem_Union.2 ⟨⟨s, sb⟩, _⟩,
    refine mem_Union.2 ⟨⟨metric.bounded.mono hs bounded_ball, diam_s⟩, _⟩,
    apply mem_inter (subset_closure (mem_image_of_mem _ ys)),
    refine mem_Inter.2 (λ t, mem_Inter.2 (λ ht, ⟨_, _⟩)),
    { apply hq1,
      exact mem_image_of_mem _ ys },
    { apply disjoint_left.1 (hq2 ⟨(t, ⟨s, sb⟩), ht.symm⟩),
      exact mem_image_of_mem _ ys } },
  -- Now, let us prove the harder inclusion `⋂ F n ⊆ range f`.
  { assume x hx,
    -- pick for each `n` a good set `s n` of small diameter for which `x ∈ E (s n)`.
    have C1 : ∀ n, ∃ (s : b) (hs : bounded s.1 ∧ diam s.1 ≤ u n), x ∈ E s :=
      λ n, by simpa only [mem_Union] using mem_Inter.1 hx n,
    choose s hs hxs using C1,
    have C2 : ∀ n, (s n).1.nonempty,
    { assume n,
      rw nonempty_iff_ne_empty,
      assume hn,
      have := (s n).2,
      rw hn at this,
      exact b_nonempty this },
    -- choose a point `y n ∈ s n`.
    choose y hy using C2,
    have I : ∀ m n, ((s m).1 ∩ (s n).1).nonempty,
    { assume m n,
      rw ← not_disjoint_iff_nonempty_inter,
      by_contra' h,
      have A : x ∈ q ⟨(s m, s n), h⟩ \ q ⟨(s n, s m), h.symm⟩,
      { have := mem_Inter.1 (hxs m).2 (s n), exact (mem_Inter.1 this h : _) },
      have B : x ∈ q ⟨(s n, s m), h.symm⟩ \ q ⟨(s m, s n), h⟩,
      { have := mem_Inter.1 (hxs n).2 (s m), exact (mem_Inter.1 this h.symm : _) },
      exact A.2 B.1 },
    -- the points `y n` are nearby, and therefore they form a Cauchy sequence.
    have cauchy_y : cauchy_seq y,
    { have : tendsto (λ n, 2 * u n) at_top (𝓝 0), by simpa only [mul_zero] using u_lim.const_mul 2,
      apply cauchy_seq_of_le_tendsto_0' (λ n, 2 * u n) (λ m n hmn, _) this,
      rcases I m n with ⟨z, zsm, zsn⟩,
      calc dist (y m) (y n) ≤ dist (y m) z + dist z (y n) : dist_triangle _ _ _
      ... ≤ u m + u n :
        add_le_add ((dist_le_diam_of_mem (hs m).1 (hy m) zsm).trans (hs m).2)
                   ((dist_le_diam_of_mem (hs n).1 zsn (hy n)).trans (hs n).2)
      ... ≤ 2 * u m : by linarith [u_anti.antitone hmn] },
    haveI : nonempty γ := ⟨y 0⟩,
    -- let `z` be its limit.
    let z := lim at_top y,
    have y_lim : tendsto y at_top (𝓝 z) := cauchy_y.tendsto_lim,
    suffices : f z = x, by { rw ← this, exact mem_range_self _ },
    -- assume for a contradiction that `f z ≠ x`.
    by_contra' hne,
    -- introduce disjoint open sets `v` and `w` separating `f z` from `x`.
    obtain ⟨v, w, v_open, w_open, fzv, xw, hvw⟩ := t2_separation hne,
    obtain ⟨δ, δpos, hδ⟩ : ∃ δ > (0 : ℝ), ball z δ ⊆ f ⁻¹' v,
    { apply metric.mem_nhds_iff.1,
      exact f_cont.continuous_at.preimage_mem_nhds (v_open.mem_nhds fzv) },
    obtain ⟨n, hn⟩ : ∃ n, u n + dist (y n) z < δ,
    { have : tendsto (λ n, u n + dist (y n) z) at_top (𝓝 0),
        by simpa only [add_zero] using u_lim.add (tendsto_iff_dist_tendsto_zero.1 y_lim),
      exact ((tendsto_order.1 this).2 _ δpos).exists },
    -- for large enough `n`, the image of `s n` is contained in `v`, by continuity of `f`.
    have fsnv : f '' (s n) ⊆ v,
    { rw image_subset_iff,
      apply subset.trans _ hδ,
      assume a ha,
      calc dist a z ≤ dist a (y n) + dist (y n) z : dist_triangle _ _ _
      ... ≤ u n + dist (y n) z :
        add_le_add_right ((dist_le_diam_of_mem (hs n).1 ha (hy n)).trans (hs n).2) _
      ... < δ : hn },
    -- as `x` belongs to the closure of `f '' (s n)`, it belongs to the closure of `v`.
    have : x ∈ closure v := closure_mono fsnv (hxs n).1,
    -- this is a contradiction, as `x` is supposed to belong to `w`, which is disjoint from
    -- the closure of `v`.
    exact disjoint_left.1 (hvw.closure_left w_open) this xw }
end

theorem _root_.is_closed.measurable_set_image_of_continuous_on_inj_on
  {β : Type*} [topological_space β] [t2_space β] [measurable_space β] [borel_space β]
  {s : set γ} (hs : is_closed s) {f : γ → β} (f_cont : continuous_on f s) (f_inj : inj_on f s) :
  measurable_set (f '' s) :=
begin
  rw image_eq_range,
  haveI : polish_space s := is_closed.polish_space hs,
  apply measurable_set_range_of_continuous_injective,
  { rwa continuous_on_iff_continuous_restrict at f_cont },
  { rwa inj_on_iff_injective at f_inj }
end

variables [measurable_space γ] [hγb : borel_space γ]
{β : Type*} [tβ : topological_space β] [t2_space β] [measurable_space β] [borel_space β]
{s : set γ} {f : γ → β}
include tβ hγb

/-- The Lusin-Souslin theorem: if `s` is Borel-measurable in a Polish space, then its image under
a continuous injective map is also Borel-measurable. -/
theorem _root_.measurable_set.image_of_continuous_on_inj_on
  (hs : measurable_set s) (f_cont : continuous_on f s) (f_inj : inj_on f s) :
  measurable_set (f '' s) :=
begin
  obtain ⟨t', t't, t'_polish, s_closed, s_open⟩ :
    ∃ (t' : topological_space γ), t' ≤ tγ ∧ @polish_space γ t' ∧ is_closed[t'] s ∧
      is_open[t'] s := hs.is_clopenable,
  exact @is_closed.measurable_set_image_of_continuous_on_inj_on γ t' t'_polish β _ _ _ _ s
    s_closed f (f_cont.mono_dom t't) f_inj,
end

/-- The Lusin-Souslin theorem: if `s` is Borel-measurable in a Polish space, then its image under
a measurable injective map taking values in a second-countable topological space
is also Borel-measurable. -/
theorem _root_.measurable_set.image_of_measurable_inj_on [second_countable_topology β]
  (hs : measurable_set s) (f_meas : measurable f) (f_inj : inj_on f s) :
  measurable_set (f '' s) :=
begin
  -- for a finer Polish topology, `f` is continuous. Therefore, one may apply the corresponding
  -- result for continuous maps.
  obtain ⟨t', t't, f_cont, t'_polish⟩ :
    ∃ (t' : topological_space γ), t' ≤ tγ ∧ @continuous γ β t' tβ f ∧ @polish_space γ t' :=
      f_meas.exists_continuous,
  have M : measurable_set[@borel γ t'] s :=
    @continuous.measurable γ γ t' (@borel γ t')
      (@borel_space.opens_measurable γ t' (@borel γ t') (by { constructor, refl }))
      tγ _ _ _ (continuous_id_of_le t't) s hs,
  exact @measurable_set.image_of_continuous_on_inj_on γ t' t'_polish
    (@borel γ t') (by { constructor, refl }) β _ _ _ _ s f M
    (@continuous.continuous_on γ β t' tβ f s f_cont) f_inj,
end

/-- An injective continuous function on a Polish space is a measurable embedding. -/
theorem _root_.continuous.measurable_embedding (f_cont : continuous f) (f_inj : injective f) :
  measurable_embedding f :=
{ injective := f_inj,
  measurable := f_cont.measurable,
  measurable_set_image' := λ u hu,
    hu.image_of_continuous_on_inj_on f_cont.continuous_on (f_inj.inj_on _) }

/-- If `s` is Borel-measurable in a Polish space and `f` is continuous injective on `s`, then
the restriction of `f` to `s` is a measurable embedding. -/
theorem _root_.continuous_on.measurable_embedding (hs : measurable_set s)
  (f_cont : continuous_on f s) (f_inj : inj_on f s) :
  measurable_embedding (s.restrict f) :=
{ injective := inj_on_iff_injective.1 f_inj,
  measurable := (continuous_on_iff_continuous_restrict.1 f_cont).measurable,
  measurable_set_image' :=
  begin
    assume u hu,
    have A : measurable_set ((coe : s → γ) '' u) :=
      (measurable_embedding.subtype_coe hs).measurable_set_image.2 hu,
    have B : measurable_set (f '' ((coe : s → γ) '' u)) :=
      A.image_of_continuous_on_inj_on (f_cont.mono (subtype.coe_image_subset s u))
        (f_inj.mono ((subtype.coe_image_subset s u))),
    rwa ← image_comp at B,
  end }

/-- An injective measurable function from a Polish space to a second-countable topological space
is a measurable embedding. -/
theorem _root_.measurable.measurable_embedding [second_countable_topology β]
  (f_meas : measurable f) (f_inj : injective f) :
  measurable_embedding f :=
{ injective := f_inj,
  measurable := f_meas,
  measurable_set_image' := λ u hu, hu.image_of_measurable_inj_on f_meas (f_inj.inj_on _) }

omit tβ

/-- In a Polish space, a set is clopenable if and only if it is Borel-measurable. -/
lemma is_clopenable_iff_measurable_set :
  is_clopenable s ↔ measurable_set s :=
begin
  -- we already know that a measurable set is clopenable. Conversely, assume that `s` is clopenable.
  refine ⟨λ hs, _, λ hs, hs.is_clopenable⟩,
  -- consider a finer topology `t'` in which `s` is open and closed.
  obtain ⟨t', t't, t'_polish, s_closed, s_open⟩ :
    ∃ (t' : topological_space γ), t' ≤ tγ ∧ @polish_space γ t' ∧ is_closed[t'] s ∧
      is_open[t'] s := hs,
  -- the identity is continuous from `t'` to `tγ`.
  have C : @continuous γ γ t' tγ id := continuous_id_of_le t't,
  -- therefore, it is also a measurable embedding, by the Lusin-Souslin theorem
  have E := @continuous.measurable_embedding γ t' t'_polish (@borel γ t') (by { constructor, refl })
    γ tγ (polish_space.t2_space γ) _ _ id C injective_id,
  -- the set `s` is measurable for `t'` as it is closed.
  have M : @measurable_set γ (@borel γ t') s :=
    @is_closed.measurable_set γ s t' (@borel γ t')
      (@borel_space.opens_measurable γ t' (@borel γ t') (by { constructor, refl })) s_closed,
  -- therefore, its image under the measurable embedding `id` is also measurable for `tγ`.
  convert E.measurable_set_image.2 M,
  simp only [id.def, image_id'],
end

omit hγb

/-- The set of points for which a measurable sequence of functions converges is measurable. -/
@[measurability] lemma measurable_set_exists_tendsto
  [hγ : opens_measurable_space γ] [countable ι] {l : filter ι}
  [l.is_countably_generated] {f : ι → β → γ} (hf : ∀ i, measurable (f i)) :
  measurable_set {x | ∃ c, tendsto (λ n, f n x) l (𝓝 c)} :=
begin
  by_cases hl : l.ne_bot,
  swap, { rw not_ne_bot at hl, simp [hl] },
  letI := upgrade_polish_space γ,
  rcases l.exists_antitone_basis with ⟨u, hu⟩,
  simp_rw ← cauchy_map_iff_exists_tendsto,
  change measurable_set {x | _ ∧ _},
  have : ∀ x, ((map (λ i, f i x) l) ×ᶠ (map (λ i, f i x) l)).has_antitone_basis
    (λ n, ((λ i, f i x) '' u n) ×ˢ ((λ i, f i x) '' u n)) := λ x, hu.map.prod hu.map,
  simp_rw [and_iff_right (hl.map _), filter.has_basis.le_basis_iff (this _).to_has_basis
    metric.uniformity_basis_dist_inv_nat_succ, set.set_of_forall],
  refine measurable_set.bInter set.countable_univ (λ K _, _),
  simp_rw set.set_of_exists,
  refine measurable_set.bUnion set.countable_univ (λ N hN, _),
  simp_rw [prod_image_image_eq, image_subset_iff, prod_subset_iff, set.set_of_forall],
  exact measurable_set.bInter (to_countable (u N)) (λ i _,
    measurable_set.bInter (to_countable (u N)) (λ j _,
    measurable_set_lt (measurable.dist (hf i) (hf j)) measurable_const)),
end

end measure_theory


import algebra.ofe.basic

universes u v

/-- Applies `γ` to two `Σ` types. If their first components match, applies `γ` as expected,
otherwise, returns `false`. The cast is alright here, because we're inside `Prop`. -/
def map_or_false {α : Type u} {β : α → Type v} (γ : Π (x : α), β x → β x → Prop)
  (x y : Σ (x : α), β x) : Prop :=
@dite _ (x.fst = y.fst) (classical.dec _)
  (λ h, γ x.fst x.snd (cast (congr_arg β h.symm) y.snd))
  (λ _, false)

@[simp] lemma map_or_false_self {α : Type u} {β : α → Type v} (γ : Π (x : α), β x → β x → Prop)
  (x : Σ (x : α), β x) : map_or_false γ x x = γ x.fst x.snd x.snd :=
begin
  unfold map_or_false,
  rw dif_pos rfl,
  refl,
end

@[simp] lemma map_or_false_mk {α : Type u} {β : α → Type v} (γ : Π (x : α), β x → β x → Prop)
  (x : α) (y z : β x) : map_or_false γ ⟨x, y⟩ ⟨x, z⟩ = γ x y z :=
begin
  unfold map_or_false,
  rw dif_pos rfl,
  refl,
end

lemma map_or_false_implies {α : Type u} {β : α → Type v} {γ : Π (x : α), β x → β x → Prop}
  {x₁ x₂ : α} {y₁ : β x₁} {y₂ : β x₂} : map_or_false γ ⟨x₁, y₁⟩ ⟨x₂, y₂⟩ → x₁ = x₂ :=
begin
  unfold map_or_false,
  split_ifs,
  { cases h,
    exact λ _, rfl, },
  { intro h,
    cases h, },
end

instance {α : Type u} {β : α → Type v} [ofe α] [Π (a : α), ofe (β a)] :
  ofe (Σ (a : α), β a) := {
  eq_at := λ n x y, map_or_false (λ a b c, b =[n] c) x y,
  eq_at_reflexive := begin
    intros n x,
    rw map_or_false_self,
  end,
  eq_at_symmetric := begin
    rintros n ⟨x₁, x₂⟩ ⟨y₁, y₂⟩ h,
    cases map_or_false_implies h,
    rw map_or_false_mk at h ⊢,
    rw eq_at_symm_iff,
    exact h,
  end,
  eq_at_transitive := begin
    rintros n ⟨x₁, x₂⟩ ⟨y₁, y₂⟩ ⟨z₁, z₂⟩ hxy hyz,
    cases map_or_false_implies hxy,
    cases map_or_false_implies hyz,
    rw map_or_false_mk at hxy hyz ⊢,
    transitivity y₂,
    exact hxy,
    exact hyz,
  end,
  eq_at_mono' := begin
    rintros m n hmn ⟨x₁, x₂⟩ ⟨y₁, y₂⟩ h,
    cases map_or_false_implies h,
    rw map_or_false_mk at h ⊢,
    exact eq_at_mono hmn h,
  end,
  eq_at_limit' := begin
    rintros ⟨x₁, x₂⟩ ⟨y₁, y₂⟩ h,
    cases map_or_false_implies (h 0),
    simp only [eq_self_iff_true, heq_iff_eq, true_and],
    rw eq_at_limit,
    intro n,
    have := h n,
    rw map_or_false_mk at this,
    exact this,
  end,
}

/-- TODO: Make nicer versions of this lemma. -/
@[simp] lemma sigma.eq_at {α : Type u} {β : α → Type v} [ofe α] [Π (a : α), ofe (β a)]
  (n : ℕ) (x y : Σ (a : α), β a) :
  x =[n] y ↔ map_or_false (λ a b c, b =[n] c) x y := iff.rfl


structure Point where
  x : Nat
  y : Nat

def f (x : Nat) : Point :=
  let y := x + 1
  { x, y }

theorem ex1 : f x = { x, y := x + 1 } :=
  rfl

def g (p : Point) : Nat :=
  p.x + p.y

def Set (α : Type u) : Type u :=
  α → Prop

def Set.empty : Set α :=
  fun a => False

def Set.insert (s : Set α) (a : α) : Set α :=
  fun x => x = a ∨ s a

syntax (name := finSet) "{" term,* "}" : term

macro_rules (kind := finSet)
  | `({ $as,* }) => do
     as.getElems.foldlM (init := ← `(Set.empty)) fun s a => `(Set.insert $s $a)

#check { 1, 2, 3 }

#check fun x y => g {x, y}

#check fun x y : Nat => {x, y}

#check fun x y : Nat => {x, y : Point}

theorem ex2 (x y : Nat) : { x, y } = (Set.empty.insert x |>.insert y) :=
  rfl


-- action of cyclic n.succ on lists of length n.succ
-- whose product is 1

import sylow.prod_eq_one

namespace mygroup

variables (G : Type) [group G] (n : ℕ)

def cycle : {v : fin n.succ → G // finmap.prod_eq_one v} ≃
  {v : fin n.succ → G // finmap.prod_eq_one v} :=
{ to_fun := λ f, ⟨f.1 ∘ fin.S.succ, finmap.prod_eq_one_succ f.2⟩,
  inv_fun := λ f, ⟨f.1 ∘ ((fin.S.succ) ^ (n : ℤ) : fin n.succ ≃ fin n.succ),
    finmap.prod_eq_one_iterate n f.2⟩,
  left_inv := λ f, begin
    cases f with v hv,
    ext x, simp, congr',
    convert fin.S.succ.pow_n n x
  end,
  right_inv := λ f, begin
    cases f with v hv,
    ext x, simp, congr',
    change (_ * (fin.S.succ)) x = _,
    convert fin.S.succ.pow_n n x using 1,
    apply congr_fun, simp,
    rw [group.pow_add, group.pow_one], refl
  end }

lemma cycle_pow_aux (d : ℕ) (v : fin n.succ → G)
  (hv : v ∈ @finmap.prod_eq_one G _ n.succ) (x : fin n.succ) :
  (((cycle G n : _ ≃ _) ^ (d : ℤ)).to_fun ⟨v, hv⟩).1 x =
  v (((fin.S.succ' n : _ ≃ _) ^ (d : ℤ)) x) :=
begin
  revert x, induction d with e he,
  { simp },
  { intro x,
    simp_rw nat.succ_eq_add_one,
    rw int.coe_nat_add,
    conv_lhs {rw add_comm},
    rw [group.pow_add, int.coe_nat_one, group.pow_one,
        group.pow_add, group.pow_one],
    simpa [← he] }
end

lemma cycle_pow_n_succ : (cycle G n) ^ (n.succ : ℤ) = equiv.refl _ :=
begin
  ext i,
  cases i with v hv,
  simp,
  have h := fin.S.succ.pow_n n x,
  apply_fun v at h,
  convert h,
  simp,
  unfold_coes,
  simp,
  apply cycle_pow_aux
end

def cool_thing : cyclic (n.succ : ℕ) →* _ :=
  cyclic.to_hom (cycle G n) n.succ (cycle_pow_n_succ G n)

def cool_action : laction (cyclic n.succ) {v // finmap.prod_eq_one v} :=
  laction.equiv_hom.symm (cool_thing G n)

-- need to know the size of {v // finmap.prod_eq_one v}
-- and we do this by showing it's equiv to `fin n → G`

lemma fixed_point_const (v : fixed_points (cool_action G n)) (i : fin n.succ ):
v.1.1 i = v.1.1 ⟨0, nat.zero_lt_succ n⟩ :=
begin
  cases i with i hi,
  have h := v.2 (quotient.mk (mod n.succ) (i : ℤ)),
  unfold cool_action cool_thing laction.equiv_hom cyclic.to_hom at h,
  simp at h,
  rw mygroup.quotient.lift_mk at h,
  unfold order_map at h,
  unfold_coes at h,
  simp at h,
  rw subtype.ext_iff at h,
  replace h := congr_fun h ⟨0, nat.zero_lt_succ n⟩,
  convert h using 1,
  convert (cycle_pow_aux G n i v.1.1 v.1.2 ⟨0, nat.zero_lt_succ n⟩).symm,
  swap, ext x, refl,
  rw fin.S.succ.pow_k,
  ext,
  rw fin.val_add,
  unfold has_add.add fin.add,
  rw fin.coe_val_of_lt hi,
  simp,
  exact (nat.mod_eq_of_lt hi).symm
end

-- lemma list.repeat_nth_le (α : Type) (a : α) (n i : ℕ) (h : i < n) :
--   (list.repeat a n).nth_le i (begin convert h, simp, end) = a :=
-- begin
--   apply list.nth_le_repeat
-- end

/-
i: fin n.succ
⊢ (list.repeat (v.val.val ⟨0, _⟩) n.succ).nth_le i.val _ = v.val.val ⟨0, _⟩
-/
lemma fixed_point_eq_repeat (v : fixed_points (cool_action G n)) :
  list.of_fn v.1.1 = list.repeat (v.1.1 ⟨0, nat.zero_lt_succ n⟩) n.succ :=
begin
  apply @list.ext' n.succ,
  { intros i,
    convert fixed_point_const G n v i,
    simp,
    { rw list.nth_le_repeat },
    simp,
    simp },
end

lemma fixed_point_pow (v : fixed_points (cool_action G n)) :
  (v.1.1 ⟨0, nat.zero_lt_succ n⟩) ^ (n.succ : ℤ) = 1 :=
begin
  have h := v.2,
  have h2 := v.1.2,
  convert h2,
  unfold finmap.prod_eq_one at h2,
  rw ←list.prod_repeat',
  congr',
  rw ←fixed_point_eq_repeat,
  simp
end

def fixed_points_eq_roots :
  fixed_points (cool_action G n) ≃ {g : G // g ^ (n.succ : ℤ) = 1} :=
{ to_fun := λ f, ⟨f.1.1 ⟨0, nat.zero_lt_succ n⟩, begin
    apply fixed_point_pow
  end⟩,
  inv_fun := λ g, ⟨⟨λ _, g.1, begin
    unfold finmap.prod_eq_one,
    convert list.prod_repeat' n.succ g.1,
    swap, exact g.2.symm,
    apply @list.ext' n.succ;
    [skip, simp, simp],
    intro i,
    rw list.nth_le_repeat,
    simp
  end⟩, begin
    rw mem_fixed_points_iff_stabilizer_univ,
    rw eq_top_iff,
    rw ← cyclic.generator_generates,
    rw subgroup.closure_le,
    show _ ⊆ _,
    rw set.singleton_subset_iff,
    rw subgroup.mem_coe',
    rw laction.mem_stabilizer,
    cases g with g hg,
    simp,
    ext,
    refl
  end⟩,
  left_inv := begin
    intro f,
    simp,
    ext i,
    exact (fixed_point_const G n f i).symm,
  end,
  right_inv := begin
    intro g,
    simp
  end }

end mygroup