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

noncomputable theory

universe u

open_locale big_operators

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 }

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 local_ring

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

structure point_local_ring_hom_pair :=
(pt : prime_spectrum A)
(ring_hom_ : localization.at_prime pt.as_ideal →+* R)
[is_local_ring_hom_ : is_local_ring_hom ring_hom_]

structure point_local_ring_hom_pair'_aux :=
(pt : prime_spectrum A)
(localized_ring : Type u)
[comm_ring_localized_ring : comm_ring localized_ring]
[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.is_local_ring_hom_
attribute [instance] point_local_ring_hom_pair'_aux.comm_ring_localized_ring
attribute [instance] point_local_ring_hom_pair'_aux.algebra_localized_ring
attribute [instance] point_local_ring_hom_pair'_aux.is_localization
attribute [instance] point_local_ring_hom_pair'_aux.is_local_ring_hom_

@[ext] lemma point_local_ring_hom_pair_ext (α β : point_local_ring_hom_pair A R)
  (h1 : α.pt = β.pt)
  (h2 : α.ring_hom_.comp (localization.local_ring_hom _ _ (ring_hom.id _) $ by rw [ideal.comap_id, h1]) = β.ring_hom_) :
  α = β :=
begin
  obtain ⟨pt, f, h⟩ := α,
  obtain ⟨pt', f', h'⟩ := β,
  dsimp at *,
  subst h1,
  congr,
  rw [←h2, localization.local_ring_hom_id, ring_hom.comp_id],
end

namespace point_local_ring_hom_pair'_aux

variables {A R}

@[simps] def localized_ring_equiv_of_pt_eq {α β : point_local_ring_hom_pair'_aux A R}
  (pt_eq : α.pt = β.pt) :
  α.localized_ring ≃+* β.localized_ring :=
{ to_fun := @is_localization.map A _ α.pt.as_ideal.prime_compl α.localized_ring
    _ _ A _ _ β.pt.as_ideal.prime_compl β.localized_ring _ _ _ (ring_hom.id _) $
    by { erw submonoid.comap_id, rw pt_eq, exact le_refl _, },
  inv_fun := @is_localization.map A _ β.pt.as_ideal.prime_compl β.localized_ring
    _ _ A _ _ α.pt.as_ideal.prime_compl α.localized_ring _ _ _ (ring_hom.id _) $
    by { erw submonoid.comap_id, rw pt_eq, exact le_refl _, },
  left_inv := λ x,
  begin
    rw [←ring_hom.comp_apply, is_localization.map_comp_map],
    simp only [ring_hom_inv_pair.comp_eq₂, is_localization.map_id],
  end,
  right_inv := λ x,
  begin
    rw [←ring_hom.comp_apply, is_localization.map_comp_map],
    simp only [ring_hom_inv_pair.comp_eq₂, is_localization.map_id],
  end,
  map_mul' := map_mul _,
  map_add' := map_add _ }

@[simps] def localized_ring_alg_equiv_of_pt_eq {α β : point_local_ring_hom_pair'_aux A R}
  (pt_eq : α.pt = β.pt) :
  α.localized_ring ≃ₐ[A] β.localized_ring :=
{ commutes' := λ a,
  begin
    dsimp,
    rw [←ring_hom.comp_apply, is_localization.map_comp, ring_hom.comp_id],
  end,
  ..localized_ring_equiv_of_pt_eq pt_eq}

structure rel_aux (α β : point_local_ring_hom_pair'_aux A R) :=
(pt_eq : α.pt = β.pt)
(ring_hom_comp_eq :
    α.ring_hom_.comp
      (localized_ring_equiv_of_pt_eq pt_eq).symm.to_ring_hom
  = β.ring_hom_)

@[reducible] def rel (α β : point_local_ring_hom_pair'_aux A R) : Prop :=
nonempty $ rel_aux α β

@[refl] lemma rel_refl (α : point_local_ring_hom_pair'_aux A R) :
  rel α α := nonempty.intro
{ pt_eq := rfl,
  ring_hom_comp_eq := ring_hom.ext $ λ x, by erw [ring_hom.comp_apply,
    localized_ring_equiv_of_pt_eq_symm_apply, is_localization.map_id] }

@[trans] lemma rel_trans (α β γ : point_local_ring_hom_pair'_aux A R)
  (hαβ : rel α β) (hβγ : rel β γ) : rel α γ :=
begin
  unfreezingI
  { rcases hαβ with ⟨h1, h1'⟩,
    rcases hβγ with ⟨h2, h2'⟩ },
  refine ⟨⟨h1.trans h2, _⟩⟩,
  rw [←h2', ←h1', ring_hom.comp_assoc],
  refine congr_arg _ _,
  ext x : 1,
  generalize_proofs H1,
  erw [ring_hom.comp_apply, ring_equiv.to_ring_hom_eq_coe,
    ring_equiv.to_ring_hom_eq_coe, ring_equiv.to_ring_hom_eq_coe,
    localized_ring_equiv_of_pt_eq_symm_apply H1 x,
    localized_ring_equiv_of_pt_eq_symm_apply h2 x,
    localized_ring_equiv_of_pt_eq_symm_apply h1, ←ring_hom.comp_apply,
    is_localization.map_comp_map],
  congr' 1,
end

@[symm] lemma rel_symm (α β : point_local_ring_hom_pair'_aux A R) (h : rel α β) :
  rel β α := nonempty.intro
{ pt_eq := h.some.pt_eq.symm,
  ring_hom_comp_eq :=
  begin
    rw [←h.some.ring_hom_comp_eq, ring_hom.comp_assoc],
    convert ring_hom.comp_id _,
    ext : 1,
    generalize_proofs h1 h2,
    erw [ring_hom.comp_apply, localized_ring_equiv_of_pt_eq_symm_apply h2,
      localized_ring_equiv_of_pt_eq_symm_apply h1, ←ring_hom.comp_apply],
    congr' 1,
    convert is_localization.map_comp_map _ _,
    ext y : 1,
    simp only [ring_hom.id_apply, ring_hom_inv_pair.comp_eq₂,
      is_localization.map_id],
  end }

variables (A R)

@[simps] def setoid_ : setoid (point_local_ring_hom_pair'_aux A R) :=
{ r := rel,
  iseqv := ⟨rel_refl, rel_symm, rel_trans⟩ }

variables {A R}
variables (a b : point_local_ring_hom_pair'_aux A R) (h : (setoid_ A R).r a b)

lemma setoid_.r_pt_eq : a.pt = b.pt := h.some.pt_eq

lemma setoid_.r_ring_hom_comp_eq :
    a.ring_hom_.comp
      (localized_ring_equiv_of_pt_eq $
        point_local_ring_hom_pair'_aux.setoid_.r_pt_eq _ _ h).symm.to_ring_hom
  = b.ring_hom_ :=
h.some.ring_hom_comp_eq

end point_local_ring_hom_pair'_aux

def point_local_ring_hom_pair' : Type (u+1) :=
  quotient $ point_local_ring_hom_pair'_aux.setoid_ A R

namespace point_local_ring_hom_pair'

open point_local_ring_hom_pair

variables {A R} (a b : point_local_ring_hom_pair' A R)

def pt : prime_spectrum A :=
a.out'.pt

lemma mk_pt_eq (p : prime_spectrum A) (M : Type u) [comm_ring M] [algebra A M]
  [is_localization.at_prime M p.as_ideal] (f : M →+* R) [is_local_ring_hom f] :
  pt (quotient.mk' (⟨p, M, f⟩) : point_local_ring_hom_pair' A R) = p :=
point_local_ring_hom_pair'_aux.setoid_.r_pt_eq _ _ (quotient.mk_out' _)

lemma mk_pt_eq' (a' : point_local_ring_hom_pair'_aux A R) :
  pt (quotient.mk' a') = a'.pt :=
point_local_ring_hom_pair'_aux.setoid_.r_pt_eq _ _ (quotient.mk_out' _)

lemma pt_eq (h : a = b) : a.pt = b.pt :=
begin
  induction a using quotient.induction_on',
  induction b using quotient.induction_on',
  rcases a with ⟨pt, M, f⟩,
  rcases b with ⟨pt', M', f'⟩,
  resetI,
  rw [mk_pt_eq, mk_pt_eq],
  rw quotient.eq' at h,
  rcases h with ⟨h1, h2⟩,
  exact h1,
end

def localized_ring : Type u :=
a.out'.localized_ring

instance comm_ring_is_localized_ring : comm_ring a.localized_ring :=
a.out'.comm_ring_localized_ring

instance algebra_localized_ring : algebra A a.localized_ring :=
a.out'.algebra_localized_ring

instance is_localization :
  is_localization.at_prime a.localized_ring a.pt.as_ideal :=
a.out'.is_localization

def ring_hom_ :
  a.localized_ring →+* R :=
a.out'.ring_hom_

instance is_local_ring_hom_ : is_local_ring_hom a.ring_hom_ :=
a.out'.is_local_ring_hom_

lemma mk_ring_hom_ (p : prime_spectrum A) (M : Type u) [comm_ring M]
  [algebra A M] [is_localization.at_prime M p.as_ideal]
  (f : M →+* R) [is_local_ring_hom f] :
    (ring_hom_ (quotient.mk' ⟨p, M, f⟩)).comp
      (begin
        haveI : is_localization.at_prime
          (localized_ring (quotient.mk' (point_local_ring_hom_pair'_aux.mk p M f)))
          p.as_ideal ,
        { convert point_local_ring_hom_pair'.is_localization _,
          rw mk_pt_eq', },
        refine @is_localization.map A _ p.as_ideal.prime_compl M _ _ A _
          _ p.as_ideal.prime_compl _ _ _ _ (ring_hom.id A)
            (by erw [submonoid.comap_id]; exact le_refl _),
      end : M →+* localized_ring (quotient.mk' (point_local_ring_hom_pair'_aux.mk p M f)))
  = f :=
begin
  haveI : is_localization.at_prime
    (localized_ring (quotient.mk' (point_local_ring_hom_pair'_aux.mk p M f)))
    p.as_ideal ,
  { convert point_local_ring_hom_pair'.is_localization _,
    rw mk_pt_eq', },
  exact point_local_ring_hom_pair'_aux.setoid_.r_ring_hom_comp_eq
    (quotient.out' $ quotient.mk' (⟨p, M, f⟩ : point_local_ring_hom_pair'_aux A R))
    ⟨p, M, f⟩ (quotient.mk_out' _),
end

lemma mk_ring_hom_₂ (p : prime_spectrum A) (M : Type u) [comm_ring M]
  [algebra A M] [is_localization.at_prime M p.as_ideal]
  (f : M →+* R) [is_local_ring_hom f] :
    (ring_hom_ (quotient.mk' ⟨p, M, f⟩))
  = f.comp
    (begin
      haveI : is_localization p.as_ideal.prime_compl
        (localized_ring
          (quotient.mk' (point_local_ring_hom_pair'_aux.mk p M f))),
      { convert point_local_ring_hom_pair'.is_localization _,
        rw mk_pt_eq', },
      refine @is_localization.map A _ p.as_ideal.prime_compl
        (localized_ring (quotient.mk' ⟨p, M, f⟩)) _ _ _ _ _ p.as_ideal.prime_compl _ _ _ _ (ring_hom.id A)
        (by erw [submonoid.comap_id]; exact le_refl _),
    end) :=
begin
  simp_rw ←mk_ring_hom_ p M f,
  rw [ring_hom.comp_assoc],
  convert (ring_hom.comp_id _).symm,
  rw [is_localization.map_comp_map],
  ext : 1,
  simp only [ring_hom_inv_pair.comp_eq₂, is_localization.map_id, ring_hom.id_apply],
end

lemma mk_ring_hom_' (α : point_local_ring_hom_pair'_aux A R) :
    (ring_hom_ (quotient.mk' α)).comp
    begin
      haveI : is_localization.at_prime
        (localized_ring (quotient.mk' α))
        α.pt.as_ideal ,
      { refine @@is_localization.is_localization_of_alg_equiv _ _ _ _ _ _
          α.is_localization _,
        refine point_local_ring_hom_pair'_aux.localized_ring_alg_equiv_of_pt_eq
          _,
        exact (mk_pt_eq' α).symm, },
      refine @is_localization.map A _ α.pt.as_ideal.prime_compl α.localized_ring
        _ _ A _
        _ α.pt.as_ideal.prime_compl _ _ _ _ (ring_hom.id A)
          (by erw [submonoid.comap_id]; exact le_refl _),
    end
  = α.ring_hom_ :=
by rcases α; apply mk_ring_hom_

lemma mk_ring_hom_₂' (α : point_local_ring_hom_pair'_aux A R) :
    (ring_hom_ (quotient.mk' α))
  = α.ring_hom_.comp
  (begin
    haveI : is_localization α.pt.as_ideal.prime_compl
      (localized_ring (quotient.mk' α)),
    { refine @@is_localization.is_localization_of_alg_equiv _ _ _ _ _ _
        α.is_localization _,
      refine point_local_ring_hom_pair'_aux.localized_ring_alg_equiv_of_pt_eq
        _,
      exact (mk_pt_eq' α).symm, },
    refine @is_localization.map A _ α.pt.as_ideal.prime_compl
      (localized_ring (quotient.mk' α)) _ _ _ _ _ α.pt.as_ideal.prime_compl _ _ _ _ (ring_hom.id A)
      (by erw [submonoid.comap_id]; exact le_refl _),
    end)  :=
by rcases α; apply mk_ring_hom_₂

lemma ring_hom_comp_eq (h : a = b) :
    a.ring_hom_.comp
    (point_local_ring_hom_pair'_aux.localized_ring_equiv_of_pt_eq
      (begin
        induction a using quotient.induction_on',
        induction b using quotient.induction_on',
        rw h,
      end : a.pt = b.pt)).symm.to_ring_hom
  = b.ring_hom_ :=
begin
  subst h,
  induction a using quotient.induction_on',
  convert ring_hom.comp_id _,
  ext x : 1,
  dsimp,
  erw point_local_ring_hom_pair'_aux.localized_ring_equiv_of_pt_eq_apply,
  simp only [is_localization.map_id],
  refl,
end

lemma ring_hom_comp_eq₂ (h : a = b) :
    a.ring_hom_
  = b.ring_hom_.comp
    (point_local_ring_hom_pair'_aux.localized_ring_equiv_of_pt_eq
      (begin
        induction a using quotient.induction_on',
        induction b using quotient.induction_on',
        rw h,
      end : a.pt = b.pt)).to_ring_hom :=
begin
  subst h,
  induction a using quotient.induction_on',
  convert ring_hom.comp_id _,
  ext x : 1,
  dsimp,
  erw point_local_ring_hom_pair'_aux.localized_ring_equiv_of_pt_eq_apply,
  simp only [is_localization.map_id],
end

@[ext] lemma ext
  (h1 : a.pt = b.pt)
  (h2 : a.ring_hom_.comp
      (point_local_ring_hom_pair'_aux.localized_ring_equiv_of_pt_eq
        h1).symm.to_ring_hom
    = b.ring_hom_) : a = b :=
begin
  rcases a with ⟨pt, M, f⟩,
  rcases b with ⟨pt', M', f'⟩,
  resetI,
  have h1' : pt = pt',
  { erw [mk_pt_eq', mk_pt_eq'] at h1,
    exact h1, },
  erw quotient.eq',
  refine nonempty.intro ⟨h1', _⟩,
  dsimp,
  simp_rw [←mk_ring_hom_ pt M f, ←mk_ring_hom_ pt' M' f'],
  erw ←h2,
  simp only [ring_hom.comp_assoc],
  congr' 1,
  ext : 1,
  dsimp,
  generalize_proofs h1 h2 h3 h4 h5 h6,
  erw point_local_ring_hom_pair'_aux.localized_ring_equiv_of_pt_eq_symm_apply
    (_ : (point_local_ring_hom_pair'_aux.mk pt M f).pt =
      (point_local_ring_hom_pair'_aux.mk pt' M' f').pt) x,
  rw [←ring_hom.comp_apply, is_localization.map_comp_map],
  simp only [ring_hom_inv_pair.comp_eq₂],
  erw point_local_ring_hom_pair'_aux.localized_ring_equiv_of_pt_eq_symm_apply,
  swap, dsimp, rw ←h1', exact mk_pt_eq pt M f,
  erw point_local_ring_hom_pair'_aux.localized_ring_equiv_of_pt_eq_symm_apply
    (_ : local_ring.point_local_ring_hom_pair'.pt
        (quotient.mk' (point_local_ring_hom_pair'_aux.mk pt M f))
      = local_ring.point_local_ring_hom_pair'.pt
          (quotient.mk' (point_local_ring_hom_pair'_aux.mk pt' M' f'))),
  erw [←ring_hom.comp_apply, is_localization.map_comp_map],
  congr' 1,
  erw [submonoid.comap_id],
  change pt'.as_ideal.prime_compl ≤
    (point_local_ring_hom_pair'.pt (quotient.mk' ⟨pt', M', f'⟩)).as_ideal.prime_compl,
  erw mk_pt_eq pt' M' f',
  exact le_refl _,
end

end point_local_ring_hom_pair'

def point_local_ring_hom_pair_equiv_point_local_ring_hom_pair'
  (M : Type u) [comm_ring M] [algebra A M] :
  point_local_ring_hom_pair A R ≃
  point_local_ring_hom_pair' A R :=
{ to_fun := λ P, quotient.mk'
  { pt := P.pt,
    localized_ring := localization.at_prime P.pt.as_ideal,
    comm_ring_localized_ring := infer_instance,
    algebra_localized_ring := infer_instance,
    is_localization := infer_instance,
    ring_hom_ := P.ring_hom_,
    is_local_ring_hom_ := infer_instance },
  inv_fun := λ P,
  { pt := P.pt,
    ring_hom_ := P.ring_hom_.comp _,
    is_local_ring_hom_ := @@is_local_ring_hom_comp _ _ _ _ _ infer_instance $
      by exactI is_local_ring_hom_equiv
        ((is_localization.alg_equiv P.pt.as_ideal.prime_compl
          (localization.at_prime P.pt.as_ideal)
            P.localized_ring).to_ring_equiv) },
  left_inv := λ P,
  begin
    ext : 1,
    swap,
    { dsimp, rw point_local_ring_hom_pair'.mk_pt_eq, },
    { dsimp, ext x : 1,
      induction x using localization.induction_on with data,
      rcases data with ⟨a, b⟩,
      simp only [ring_hom.comp_apply, localization.mk_eq_mk',
        localization.local_ring_hom_mk', ring_equiv.to_ring_hom_eq_coe],
      dsimp [is_localization.alg_equiv_mk', ideal.comap_id],
      rw [is_localization.map_mk'],
      have := point_local_ring_hom_pair'.mk_ring_hom_'
        (point_local_ring_hom_pair'_aux.mk P.pt (localization.at_prime P.pt.as_ideal) P.ring_hom_),
      dsimp at this,
      simp_rw ←this,
      congr' 1,
      rw [is_localization.map_mk'],
      refl, },
  end,
  right_inv := λ P,
  begin
    dsimp,
    induction P using quotient.induction_on',
    haveI : is_localization P.pt.as_ideal.prime_compl (point_local_ring_hom_pair'.localized_ring (quotient.mk' P)),
    { refine @@is_localization.is_localization_of_alg_equiv _ _ _ _ _ _
        P.is_localization _,
      refine point_local_ring_hom_pair'_aux.localized_ring_alg_equiv_of_pt_eq
        _,
      exact (point_local_ring_hom_pair'.mk_pt_eq' P).symm, },

    haveI : is_localization P.pt.as_ideal.prime_compl
        (localization.at_prime (point_local_ring_hom_pair'.pt (quotient.mk' P)).as_ideal),
    { have := point_local_ring_hom_pair'.mk_pt_eq' P,
      erw this,
      exact localization.is_localization },
    rw quotient.eq',
    refine nonempty.intro ⟨_, _⟩,
    { dsimp, rw point_local_ring_hom_pair'.mk_pt_eq', },
    { simp_rw [point_local_ring_hom_pair'.mk_pt_eq'],
      have eq0 : localization.at_prime (point_local_ring_hom_pair'.pt (quotient.mk' P)).as_ideal =
        localization.at_prime P.pt.as_ideal,
      { rw point_local_ring_hom_pair'.mk_pt_eq' },

      simp_rw point_local_ring_hom_pair'.mk_ring_hom_₂' P,
      rw [ring_hom.comp_assoc, ring_hom.comp_assoc],
      convert ring_hom.comp_id _,
      dsimp,
      ext : 1,
      rw [ring_hom.id_apply, ring_hom.comp_apply, ring_hom.comp_apply],
      erw point_local_ring_hom_pair'_aux.localized_ring_alg_equiv_of_pt_eq_symm_apply,
      dsimp,
      rw [←ring_hom.comp_apply, is_localization.map_comp_map,
        ←ring_hom.comp_apply],
      erw [is_localization.map_comp_map],
      simp only [ring_hom_comp_triple.comp_eq],
      erw is_localization.map_id,
      erw submonoid.comap_id,
      exact le_refl _,
       },
  end }

end local_ring

namespace ring_hom

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

section target

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

@[simps] def factor_through_target_local_ring :
  localization.at_prime (ideal.comap φ (local_ring.maximal_ideal _)) →+* R :=
{ to_fun := λ x, x.lift_on (λ a b, φ a * (begin
    have := (local_ring.mem_maximal_ideal (φ b)).not.mp _,
    rwa [mem_nonunits_iff, not_not] at this,
    have : b.1 ∉ ideal.comap φ (local_ring.maximal_ideal _) := b.2,
    simpa only [ideal.mem_comap] using this,
  end : is_unit (φ b)).unit.inv) $ λ a a' b b' h,
  begin
    dsimp,
    rw localization.r_iff_exists at h,
    obtain ⟨⟨c, (hc1 : c ∉ ideal.comap φ (local_ring.maximal_ideal R))⟩, hc2⟩ := h,
    have hc3 := ideal.mem_comap.not.mp hc1,
    dsimp only [subtype.coe_mk] at hc2,
    have hc4 := ring_hom.congr_arg φ hc2,
    rw [map_mul, map_mul, map_mul, map_mul] at hc4,
    have hc5 : is_unit (φ c),
    { simpa only [mem_nonunits_iff, not_not] using
        (local_ring.mem_maximal_ideal (φ c)).not.mp hc3, },
    have eq0 := is_unit.mul_left_injective hc5 hc4,
    generalize_proofs h0 h1 h2,
    refine h2.mul_right_injective _,
    rw [←mul_assoc, mul_comm _ (φ a), eq0, ←mul_assoc, mul_comm _ (φ a'),
      mul_assoc, mul_assoc, is_unit.mul_coe_inv, is_unit.mul_coe_inv],
  end,
  map_one' :=
  begin
    rw [←localization.mk_one, localization.lift_on_mk, map_one, one_mul],
    generalize_proofs h0 h1,
    rw [units.inv_eq_coe_inv, units.coe_eq_one, inv_eq_one],
    ext1,
    change φ 1 = 1,
    rw map_one,
  end,
  map_mul' := λ x y,
  begin
    induction x using localization.induction_on with data_x,
    induction y using localization.induction_on with data_y,
    rcases data_x with ⟨a, b⟩,
    rcases data_y with ⟨a', b'⟩,
    rw [localization.mk_mul, localization.lift_on_mk, localization.lift_on_mk,
      localization.lift_on_mk, map_mul],
    dsimp only [],
    rw [←mul_assoc, mul_assoc _ _ (φ a'), mul_comm (_ : is_unit _).unit.inv (φ a'),
      ←mul_assoc, mul_assoc, mul_assoc, mul_assoc],
    congr' 2,
    rw [units.inv_eq_coe_inv, units.inv_eq_coe_inv, units.inv_eq_coe_inv,
      ←units.coe_mul, ←mul_inv],
    congr' 2,
    ext1,
    change φ (b * b') = φ b * φ b',
    rw map_mul,
  end,
  map_zero' :=
  begin
    rw [←localization.mk_zero, localization.lift_on_mk, map_zero, zero_mul],
    use 1,
  end,
  map_add' := λ x y,
  begin
    induction x using localization.induction_on with data_x,
    induction y using localization.induction_on with data_y,
    rcases data_x with ⟨a, b⟩,
    rcases data_y with ⟨a', b'⟩,
    rw [localization.add_mk, localization.lift_on_mk, localization.lift_on_mk,
      localization.lift_on_mk, map_add, map_mul, map_mul],
    dsimp only,
    generalize_proofs h0 h1 h2 h3,
    symmetry,
    rw [units.inv_eq_coe_inv, units.inv_eq_coe_inv, units.inv_eq_coe_inv,
      units.eq_mul_inv_iff_mul_eq],
    change _ * φ (b * b') = _,
    rw [map_mul, add_mul, mul_assoc, ←mul_assoc ↑(h2.unit)⁻¹,
      is_unit.coe_inv_mul, one_mul, mul_assoc, mul_comm (φ b),
      ←mul_assoc ↑(h3.unit)⁻¹, is_unit.coe_inv_mul, one_mul,
      mul_comm (φ a), mul_comm (φ a'), add_comm],
  end }

instance is_local.factor_through_target_local_ring :
  is_local_ring_hom (factor_through_target_local_ring φ) :=
{ map_nonunit := localization.ind
  begin
    rintros ⟨a, b⟩ h,
    dsimp at h ⊢,
    rw [localization.lift_on_mk] at h,
    generalize_proofs h0 h1 at h,
    have ha : is_unit (φ a),
    { have := h.mul h1,
      rw [mul_assoc] at this,
      erw [units.inv_mul] at this,
      rwa [mul_one] at this, },
    have ha' := (local_ring.mem_maximal_ideal (φ a)).not.mpr (λ r, r ha),
    have ha'' : a ∉ ideal.comap φ (local_ring.maximal_ideal R),
    { rwa ideal.mem_comap, },
    refine ⟨⟨localization.mk a b, localization.mk b ⟨a, ha''⟩, _, _⟩, rfl⟩;
    { rw [localization.mk_mul, mul_comm],
      convert localization.mk_self _,
      refl, },
  end }

@[simp] lemma target_local_ring_eq_comp_factors :
  (factor_through_target_local_ring φ).comp
    (algebra_map A (localization.at_prime (ideal.comap φ (local_ring.maximal_ideal _)))) = φ :=
begin
  ext a,
  rw [ring_hom.comp_apply],
  change φ.factor_through_target_local_ring (localization.mk a 1) = _,
  rw [factor_through_target_local_ring_apply, localization.lift_on_mk],
  rw [units.inv_eq_coe_inv, mul_comm, units.inv_mul_eq_iff_eq_mul],
  change φ a = φ 1 * _,
  rw [map_one, one_mul]
end

-- 01J6, first sentence in proof
lemma factor_through_target_local_ring_uniq (p : ideal A) [p.is_prime]
  (f : localization.at_prime p →+* R)
  (hf1 : f.comp (algebra_map A (localization.at_prime p)) = φ)
  (hf2 : is_local_ring_hom f) :
  ∃ (eq1 : p = ideal.comap φ (local_ring.maximal_ideal _)),
    (f.comp $ localization.local_ring_hom _ _ (ring_hom.id A) $
      by rw [ideal.comap_id, eq1] : localization.at_prime (ideal.comap φ (local_ring.maximal_ideal _)) →+* R) =
    φ.factor_through_target_local_ring :=
begin
  let 𝔪 := ideal.comap φ (local_ring.maximal_ideal _),
  have ineq1 : p ≤ 𝔪,
  { intros a ha,
    rw [ideal.mem_comap, local_ring.mem_maximal_ideal, mem_nonunits_iff],
    contrapose! ha,
    have eq2 := ring_hom.congr_fun hf1 a,
    rw [ring_hom.comp_apply] at eq2,
    change f (localization.mk a 1) = φ a at eq2,
    have := hf2.map_nonunit (localization.mk a 1) (by rwa eq2),
    rwa localization.at_prime.mk_is_unit_iff at this, },
  have ineq2' := ideal.map_mono ineq1,
  rw ←localization.at_prime.maximal_ideal_is' p at ineq2',
  have ideal_eq' := ideal.is_maximal.eq_of_le (local_ring.maximal_ideal.is_maximal _) _ ineq2',
  swap,
  { intros rid,
    rw [ideal.eq_top_iff_one] at rid,
    have rid' : f 1 ∈ ideal.map φ 𝔪,
    { rw [←hf1, ←ideal.map_map],
      refine ideal.mem_map_of_mem _ rid, },
    rw [map_one] at rid',
    have rid'' := ideal.map_comap_le rid',
    rw [←ideal.eq_top_iff_one] at rid'',
    refine (_ : ideal.is_prime _).ne_top rid'',
    exact ideal.is_maximal.is_prime' (local_ring.maximal_ideal R) },
  have ineq2 : 𝔪 ≤ p,
  { intros m hm,
    rw [localization.at_prime.maximal_ideal_is'] at ideal_eq',
    have mem1 : (localization.mk m 1 : localization.at_prime p) ∈
      ideal.map (algebra_map A (localization.at_prime p)) 𝔪,
    { rw ←localization.at_prime.ideal_map_is, exact ⟨⟨m, hm⟩, 1, rfl⟩, },
    rw [←ideal_eq', ←localization.at_prime.ideal_map_is] at mem1,
    obtain ⟨a, b, eq0⟩ := mem1,
    rw [localization.mk_eq_mk_iff, localization.r_iff_exists] at eq0,
    obtain ⟨c, eq0⟩ := eq0,
    dsimp at eq0,
    rw [mul_one] at eq0,
    have mem1 : (a * c : A) ∈ p := ideal.mul_mem_right _ _ a.2,
    rw [←eq0] at mem1,
    obtain h0|h2 := ideal.is_prime.mem_or_mem infer_instance mem1,
    obtain h0|h1 := ideal.is_prime.mem_or_mem infer_instance h0,
    exact h0, exact (b.2 h1).elim, exact (c.2 h2).elim, },
  have ideal_eq : p = 𝔪 := le_antisymm ineq1 ineq2,
  refine ⟨ideal_eq, _⟩,
  ext x : 1,
  induction x using localization.induction_on with data,
  rcases data with ⟨a, b⟩,
  rw [factor_through_target_local_ring_apply, localization.lift_on_mk,
    ring_hom.comp_apply, localization.local_ring_hom, localization.mk_eq_mk',
    is_localization.map_mk', ←localization.mk_eq_mk'],
  dsimp,
  generalize_proofs h0 h1 h2,
  rw show localization.mk a ⟨b, h1⟩ = localization.mk a 1 * localization.mk 1 ⟨b, h1⟩, from _,
  work_on_goal 2
  { rw [localization.mk_mul, mul_one, one_mul], },
  rw [map_mul],
  change (f.comp (algebra_map A (localization.at_prime p))) _ * _ = _,
  rw hf1, congr' 1,
  apply units.eq_inv_of_mul_eq_one_left,
  change φ b * f _ = 1,
  simp_rw ←hf1,
  rw [ring_hom.comp_apply, ←map_mul],
  convert_to f 1 = 1,
  { congr' 1,
    change localization.mk ↑b 1 * _ = 1,
    rw [localization.mk_mul, mul_one, one_mul],
    exact localization.mk_self (⟨_, h1⟩ : ideal.prime_compl _), },
  rw map_one,
end

variables (A R)

def target_local_ring_equiv' :
  (A →+* R) ≃ local_ring.point_local_ring_hom_pair' A R :=
{ to_fun := λ φ, quotient.mk'
  { pt := ⟨(local_ring.maximal_ideal _).comap φ, infer_instance⟩,
    localized_ring := localization.at_prime $
      (local_ring.maximal_ideal _).comap φ,
    comm_ring_localized_ring := infer_instance,
    algebra_localized_ring := infer_instance,
    is_localization := localization.is_localization,
    ring_hom_ := φ.factor_through_target_local_ring,
    is_local_ring_hom_ := infer_instance },
  inv_fun := λ P, P.ring_hom_.comp $ algebra_map A _,
  left_inv := λ φ,
  begin
    dsimp,
    rw local_ring.point_local_ring_hom_pair'.mk_ring_hom_₂,
    rw [ring_hom.comp_assoc],
    conv_rhs { rw ←φ.target_local_ring_eq_comp_factors },
    congr' 1,
    ext : 1,
    rw is_localization.map_comp,
    refl,
  end,
  right_inv := λ P,
  begin
    dsimp,
    induction P using quotient.induction_on',
    rw quotient.eq',
    have pt_eq : (⟨ideal.comap
      ((local_ring.point_local_ring_hom_pair'.ring_hom_ (quotient.mk' P)).comp
          (algebra_map A (local_ring.point_local_ring_hom_pair'.localized_ring (quotient.mk' P))))
        (local_ring.maximal_ideal R), infer_instance⟩ : prime_spectrum _) =
      P.pt,
    { dsimp,
      rw [local_ring.point_local_ring_hom_pair'.mk_ring_hom_₂',
        ring_hom.comp_assoc, is_localization.map_comp, ring_hom.comp_id],
      ext z : 2,
      rw [subtype.coe_mk, ideal.mem_comap, local_ring.mem_maximal_ideal,
        mem_nonunits_iff],
      split,
      { contrapose!, rintros rid,
        exact is_localization.is_unit_comp P.pt.as_ideal.prime_compl P.ring_hom_
          ⟨z, rid⟩, },
      { contrapose!, rintros rid,
        rw [ring_hom.comp_apply] at rid,
        have rid' := P.is_local_ring_hom_.map_nonunit _ rid,
        resetI,
        let x : P.localized_ring := ↑rid'.unit⁻¹,
        obtain ⟨a, b, h⟩ := is_localization.mk'_surjective P.pt.as_ideal.prime_compl x,
        have eq0 : algebra_map A P.localized_ring z
          = is_localization.mk' P.localized_ring z 1,
        { rw is_localization.mk'_one, },
        have eq1 : is_localization.mk' P.localized_ring z (1 : P.pt.as_ideal.prime_compl) *
            is_localization.mk' P.localized_ring a b
          = is_localization.mk' P.localized_ring 1 (1 : P.pt.as_ideal.prime_compl),
        { rw [is_localization.mk'_one, h, is_unit.mul_coe_inv,
            is_localization.mk'_one, map_one], },
        work_on_goal 2 { exact P.pt.as_ideal.prime_compl },
        work_on_goal 2 { apply_instance },
        rw [←is_localization.mk'_mul, one_mul,
          is_localization.eq,
          submonoid.coe_one, one_mul,
          mul_one] at eq1,
        obtain ⟨c, hc⟩ := eq1,
        have mem1 : (b * c : A) ∉ P.pt.as_ideal,
        { exact submonoid.mul_mem _ b.2 c.2, },
        rw ←hc at mem1,
        rintros (rid2 : z ∈ P.pt.as_ideal),
        refine mem1 (P.pt.as_ideal.mul_mem_right _
          (P.pt.as_ideal.mul_mem_right _ rid2)), }, },
    refine nonempty.intro ⟨pt_eq, _⟩,
    { dsimp,
      ext1 z,
      obtain ⟨a, b, rfl⟩ := is_localization.mk'_surjective P.pt.as_ideal.prime_compl z,
      simp only [ring_hom.comp_apply],
      erw is_localization.map_mk',
      dsimp only,
      rw factor_through_target_local_ring_apply,
      dsimp,
      erw localization.lift_on_mk',
      simp_rw [local_ring.point_local_ring_hom_pair'.mk_ring_hom_₂'],
      rw [ring_hom.comp_apply, ←ring_hom.comp_apply _ (algebra_map A _),
        is_localization.map_comp, ring_hom.comp_id,
        units.mul_inv_eq_iff_eq_mul],
      erw [←map_mul],
      congr' 1,
      rw [←ring_hom.comp_apply, is_localization.map_comp, ring_hom.comp_id,
        subtype.coe_mk],
      rw [←is_localization.mk'_one P.localized_ring,
        ←is_localization.mk'_one P.localized_ring,
        ←is_localization.mk'_mul P.localized_ring, mul_one,
        is_localization.eq],
      refine ⟨1, _⟩,
      simp only [submonoid.coe_one, mul_one], },
  end }

@[simps] def target_local_ring_equiv :
  (A →+* R) ≃ local_ring.point_local_ring_hom_pair A R :=
{ to_fun := λ φ,
  { pt := ⟨(local_ring.maximal_ideal _).comap φ, infer_instance⟩,
    ring_hom_ := φ.factor_through_target_local_ring,
    is_local_ring_hom_ := infer_instance },
  inv_fun := λ P, P.ring_hom_.comp $ algebra_map A _,
  left_inv := target_local_ring_eq_comp_factors,
  right_inv := λ P,
  begin
    obtain ⟨x, f⟩ := P,
    resetI,
    ext : 1,
    work_on_goal 2
    { ext z : 2,
      dsimp only,
      rw [subtype.coe_mk, ideal.mem_comap, local_ring.mem_maximal_ideal, mem_nonunits_iff],
      split,
      { contrapose!, rintros rid,
        rwa [ring_hom.comp_apply, show algebra_map A (localization.at_prime x.as_ideal) z = localization.mk z 1, from rfl,
          is_unit_map_iff, localization.at_prime.mk_is_unit_iff] },
      { contrapose!, rintros rid,
        rwa [ring_hom.comp_apply, show algebra_map A (localization.at_prime x.as_ideal) z = localization.mk z 1, from rfl,
          is_unit_map_iff, localization.at_prime.mk_is_unit_iff] at rid } },
    { ext z : 1,
      induction z using localization.induction_on with data,
      rcases data with ⟨a, b⟩,
      dsimp only at *,
      rw [ring_hom.comp_apply],
      simp_rw [localization.mk_eq_mk', localization.local_ring_hom_mk', ←localization.mk_eq_mk',
        ring_hom.factor_through_target_local_ring_apply, localization.lift_on_mk, ring_hom.id_apply,
        ring_hom.comp_apply, show algebra_map A (localization.at_prime x.as_ideal) a = localization.mk a 1, from rfl],
      rw [units.inv_eq_coe_inv],
      symmetry,
      rw [units.eq_mul_inv_iff_mul_eq],
      change _ * f (localization.mk b 1) = _,
      rw [←map_mul, localization.mk_mul, mul_one],
      congr' 1,
      rw [localization.mk_eq_mk_iff, localization.r_iff_exists],
      exact ⟨1, by simp only [subtype.coe_mk, submonoid.coe_one, mul_one]⟩, }
  end }

end target

end ring_hom

namespace local_ring

variables (R S : Type u) [comm_ring R] [comm_ring S] [local_ring S] (f : R ≃+* S)

def of_equiv : local_ring R :=
@@local_ring.of_is_unit_or_is_unit_of_is_unit_add _
  (⟨⟨f.symm nontrivial.exists_pair_ne.some,
    f.symm nontrivial.exists_pair_ne.some_spec.some,
    λ r, nontrivial.exists_pair_ne.some_spec.some_spec $ f.symm.injective r⟩⟩ : nontrivial R) $ λ a b h,
begin
  have h' : is_unit (f (a + b)) := f.to_ring_hom.is_unit_map h,
  rw [map_add] at h',
  obtain h''|h'' := local_ring.is_unit_or_is_unit_of_is_unit_add h',
  left,
  convert f.symm.to_ring_hom.is_unit_map h'',
  erw [equiv.symm_apply_apply],
  right,
  convert f.symm.to_ring_hom.is_unit_map h'',
  erw [equiv.symm_apply_apply],
end

end local_ring


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

/-!
# Extended norm

In this file we define a structure `enorm 𝕜 V` representing an extended norm (i.e., a norm that can
take the value `∞`) on a vector space `V` over a normed field `𝕜`. We do not use `class` for
an `enorm` because the same space can have more than one extended norm. For example, the space of
measurable functions `f : α → ℝ` has a family of `L_p` extended norms.

We prove some basic inequalities, then define

* `emetric_space` structure on `V` corresponding to `e : enorm 𝕜 V`;
* the subspace of vectors with finite norm, called `e.finite_subspace`;
* a `normed_space` structure on this space.

The last definition is an instance because the type involves `e`.

## Implementation notes

We do not define extended normed groups. They can be added to the chain once someone will need them.

## Tags

normed space, extended norm
-/

noncomputable theory
local attribute [instance, priority 1001] classical.prop_decidable
open_locale ennreal

/-- Extended norm on a vector space. As in the case of normed spaces, we require only
`∥c • x∥ ≤ ∥c∥ * ∥x∥` in the definition, then prove an equality in `map_smul`. -/
structure enorm (𝕜 : Type*) (V : Type*) [normed_field 𝕜] [add_comm_group V] [module 𝕜 V] :=
(to_fun : V → ℝ≥0∞)
(eq_zero' : ∀ x, to_fun x = 0 → x = 0)
(map_add_le' : ∀ x y : V, to_fun (x + y) ≤ to_fun x + to_fun y)
(map_smul_le' : ∀ (c : 𝕜) (x : V), to_fun (c • x) ≤ nnnorm c * to_fun x)

namespace enorm

variables {𝕜 : Type*} {V : Type*} [normed_field 𝕜] [add_comm_group V] [module 𝕜 V]
  (e : enorm 𝕜 V)

instance : has_coe_to_fun (enorm 𝕜 V) (λ _, V → ℝ≥0∞) := ⟨enorm.to_fun⟩

lemma coe_fn_injective : function.injective (coe_fn : enorm 𝕜 V → (V → ℝ≥0∞)) :=
λ e₁ e₂ h, by cases e₁; cases e₂; congr; exact h

@[ext] lemma ext {e₁ e₂ : enorm 𝕜 V} (h : ∀ x, e₁ x = e₂ x) : e₁ = e₂ :=
coe_fn_injective $ funext h

lemma ext_iff {e₁ e₂ : enorm 𝕜 V} : e₁ = e₂ ↔ ∀ x, e₁ x = e₂ x :=
⟨λ h x, h ▸ rfl, ext⟩

@[simp, norm_cast] lemma coe_inj {e₁ e₂ : enorm 𝕜 V} : (e₁ : V → ℝ≥0∞) = e₂ ↔ e₁ = e₂ :=
coe_fn_injective.eq_iff

@[simp] lemma map_smul (c : 𝕜) (x : V) : e (c • x) = nnnorm c * e x :=
le_antisymm (e.map_smul_le' c x) $
begin
  by_cases hc : c = 0, { simp [hc] },
  calc (nnnorm c : ℝ≥0∞) * e x = nnnorm c * e (c⁻¹ • c • x) : by rw [inv_smul_smul₀ hc]
  ... ≤ nnnorm c * (nnnorm (c⁻¹) * e (c • x)) : _
  ... = e (c • x) : _,
  { exact ennreal.mul_le_mul (le_refl _) (e.map_smul_le' _ _) },
  { rw [← mul_assoc, normed_field.nnnorm_inv, ennreal.coe_inv,
     ennreal.mul_inv_cancel _ ennreal.coe_ne_top, one_mul]; simp [hc] }
end

@[simp] lemma map_zero : e 0 = 0 :=
by { rw [← zero_smul 𝕜 (0:V), e.map_smul], norm_num }

@[simp] lemma eq_zero_iff {x : V} : e x = 0 ↔ x = 0 :=
⟨e.eq_zero' x, λ h, h.symm ▸ e.map_zero⟩

@[simp] lemma map_neg (x : V) : e (-x) = e x :=
calc e (-x) = nnnorm (-1:𝕜) * e x : by rw [← map_smul, neg_one_smul]
        ... = e x                 : by simp

lemma map_sub_rev (x y : V) : e (x - y) = e (y - x) :=
by rw [← neg_sub, e.map_neg]

lemma map_add_le (x y : V) : e (x + y) ≤ e x + e y := e.map_add_le' x y

lemma map_sub_le (x y : V) : e (x - y) ≤ e x + e y :=
calc e (x - y) = e (x + -y)   : by rw sub_eq_add_neg
           ... ≤ e x + e (-y) : e.map_add_le x (-y)
           ... = e x + e y    : by rw [e.map_neg]

instance : partial_order (enorm 𝕜 V) :=
{ le := λ e₁ e₂, ∀ x, e₁ x ≤ e₂ x,
  le_refl := λ e x, le_refl _,
  le_trans := λ e₁ e₂ e₃ h₁₂ h₂₃ x, le_trans (h₁₂ x) (h₂₃ x),
  le_antisymm := λ e₁ e₂ h₁₂ h₂₁, ext $ λ x, le_antisymm (h₁₂ x) (h₂₁ x) }

/-- The `enorm` sending each non-zero vector to infinity. -/
noncomputable instance : has_top (enorm 𝕜 V) :=
⟨{ to_fun := λ x, if x = 0 then 0 else ⊤,
   eq_zero' := λ x, by { split_ifs; simp [*] },
   map_add_le' := λ x y,
     begin
       split_ifs with hxy hx hy hy hx hy hy; try { simp [*] },
       simpa [hx, hy] using hxy
     end,
   map_smul_le' := λ c x,
     begin
       split_ifs with hcx hx hx; simp only [smul_eq_zero, not_or_distrib] at hcx,
       { simp only [mul_zero, le_refl] },
       { have : c = 0, by tauto,
         simp [this] },
       { tauto },
       { simp [hcx.1] }
     end }⟩

noncomputable instance : inhabited (enorm 𝕜 V) := ⟨⊤⟩

lemma top_map {x : V} (hx : x ≠ 0) : (⊤ : enorm 𝕜 V) x = ⊤ := if_neg hx

noncomputable instance : order_top (enorm 𝕜 V) :=
{ top := ⊤,
  le_top := λ e x, if h : x = 0 then by simp [h] else by simp [top_map h] }

noncomputable instance : semilattice_sup (enorm 𝕜 V) :=
{ le := (≤),
  lt := (<),
  sup := λ e₁ e₂,
  { to_fun := λ x, max (e₁ x) (e₂ x),
    eq_zero' := λ x h, e₁.eq_zero_iff.1 (ennreal.max_eq_zero_iff.1 h).1,
    map_add_le' := λ x y, max_le
      (le_trans (e₁.map_add_le _ _) $ add_le_add (le_max_left _ _) (le_max_left _ _))
      (le_trans (e₂.map_add_le _ _) $ add_le_add (le_max_right _ _) (le_max_right _ _)),
    map_smul_le' := λ c x, le_of_eq $ by simp only [map_smul, ennreal.mul_max] },
  le_sup_left := λ e₁ e₂ x, le_max_left _ _,
  le_sup_right := λ e₁ e₂ x, le_max_right _ _,
  sup_le := λ e₁ e₂ e₃ h₁ h₂ x, max_le (h₁ x) (h₂ x),
  .. enorm.partial_order }

@[simp, norm_cast]

@[norm_cast]
lemma max_map (e₁ e₂ : enorm 𝕜 V) (x : V) : (e₁ ⊔ e₂) x = max (e₁ x) (e₂ x) := rfl

/-- Structure of an `emetric_space` defined by an extended norm. -/
def emetric_space : emetric_space V :=
{ edist := λ x y, e (x - y),
  edist_self := λ x, by simp,
  eq_of_edist_eq_zero := λ x y, by simp [sub_eq_zero],
  edist_comm := e.map_sub_rev,
  edist_triangle := λ x y z,
    calc e (x - z) = e ((x - y) + (y - z)) : by rw [sub_add_sub_cancel]
               ... ≤ e (x - y) + e (y - z) : e.map_add_le (x - y) (y - z) }

/-- The subspace of vectors with finite enorm. -/
def finite_subspace : subspace 𝕜 V :=
{ carrier   := {x | e x < ⊤},
  zero_mem' := by simp,
  add_mem'  := λ x y hx hy, lt_of_le_of_lt (e.map_add_le x y) (ennreal.add_lt_top.2 ⟨hx, hy⟩),
  smul_mem' := λ c x (hx : _ < _),
    calc e (c • x) = nnnorm c * e x : e.map_smul c x
               ... < ⊤              : ennreal.mul_lt_top ennreal.coe_ne_top hx.ne }

/-- Metric space structure on `e.finite_subspace`. We use `emetric_space.to_metric_space_of_dist`
to ensure that this definition agrees with `e.emetric_space`. -/
instance : metric_space e.finite_subspace :=
begin
  letI := e.emetric_space,
  refine emetric_space.to_metric_space_of_dist _ (λ x y, _) (λ x y, rfl),
  change e (x - y) ≠ ⊤,
  exact ne_top_of_le_ne_top (ennreal.add_lt_top.2 ⟨x.2, y.2⟩).ne (e.map_sub_le x y)
end

lemma finite_dist_eq (x y : e.finite_subspace) : dist x y = (e (x - y)).to_real := rfl

lemma finite_edist_eq (x y : e.finite_subspace) : edist x y = e (x - y) := rfl

/-- Normed group instance on `e.finite_subspace`. -/
instance : normed_group e.finite_subspace :=
{ norm := λ x, (e x).to_real,
  dist_eq := λ x y, rfl }

lemma finite_norm_eq (x : e.finite_subspace) : ∥x∥ = (e x).to_real := rfl

/-- Normed space instance on `e.finite_subspace`. -/
instance : normed_space 𝕜 e.finite_subspace :=
{ norm_smul_le := λ c x, le_of_eq $ by simp [finite_norm_eq, ennreal.to_real_mul] }

end enorm


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ m₁ m₂ : ℤ, m₁ ≠ m₂ → int.fract (α * (m₁ : ℝ)) ≠ int.fract (α * (m₂ : ℝ)), from sorry,

  have h2 : (λ (m : ℤ), int.fract (α * ↑m)) '' @set.univ ℤ = _ := sorry,

  have h3 : set.finite ((λ (m : ℤ), int.fract (α * ↑m)) '' @set.univ ℤ) = false, from sorry,

  have h4 : ∃ (l : ℝ), is_limit ((λ (m : ℤ), int.fract (α * ↑m)) '' @set.univ ℤ) l, from sorry,

  have h5 : ∃ (l : ℝ), is_limit ((λ (m : ℤ), int.fract (α * ↑m)) '' @set.univ ℤ) l ∧ l = 0, from sorry,

  have h6 : ∀ (y : ℝ), 0 < y → ∃ (m : ℤ), abs y < abs (int.fract (α * ↑m)), from sorry,

  have h7 : ∀ (y : ℝ) (h : 0 < y), ∃ (m : ℤ), (abs y < abs (int.fract (α * ↑m))) ∧ (y < (m + 1) * (int.fract (α * ↑m))) ∧ ((m : ℝ) * (int.fract (α * ↑m)) ≤ y), from sorry,

  have h8 : ∀ (y : ℝ) (h : 0 < y), ∃ (m : ℤ), abs y - abs (int.fract (α * ↑m)) < y, from sorry,

  show closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from sorry,
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
    sorry,
end

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  assume y : ℝ,
  assume h_neq_zero : y ≠ 0,
  assume h_neq_one : y ≠ 1,

  have h1 : (λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' (set.Ico y 1) ≠ ∅, from sorry,
  have h2 : (λ (m : ℤ), int.fract (α * ↑m)) '' (set.univ) = set.Icc 0 1, from sorry,
  have h3 : (λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' (set.Ico y 1) ∈ (λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' (set.Icc 0 1), from sorry,
  have h4: (λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' (set.Ico y 1) ⊆ (λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' (set.Icc 0 1), from sorry,

  have h5 : (λ (m : ℤ), int.fract (α * ↑m)) '' (set.univ) ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' (set.Icc 0 1)), from sorry,

  show (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' (set.Icc 0 1)), from sorry,
end

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 := sorry

/--`theorem`
Density of rational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be a rational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  rational_orbit_dense {α : ℝ} (hα_rat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 := sorry

/--`theorem`
Union of Intervals
Let $I, J$ be open intervals.
Then $I \cup J$ is an interval.
`proof`
Let $I = (a, b), J = (c, d) \mathop{\in} \mathcal{I}$.

The cases fall into two separate cases.

In the first case, $I$, $J$ do not overlap.

In the second case, $I$, $J$ overlap.

TODO: Finish
{{qed}}
-/
theorem union_interval {a b c d : ℝ} (hab : a < b) (hcd : c < d) :
  is_interval (set.Ioo a b) (set.Ioo c d) → is_interval (set.Ioo a b) (set.Ioo c d)
| ⟨h1, h2, h3⟩ :=
  begin
    by_cases hc1 : (a ≤ c),
    { have hac2 : c ≤ a ∨ a < c, from le_or_lt a c,
      have hac3 : a ≤ c ∨ a < c, from le_or_lt a c,
      have hac4 : a < c ∨ a ≤ c, from lt_or_le c a,
      have hac5 : a < c ∨ a < c, from lt_or_lt c a,
      have hac6 : c < a ∨ c < a, from lt_or_lt c a,
      have hac7 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac8 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac9 : c ≤ a ∨ c ≤ a, from le_or_le a c,
      have hac10 : c ≤ a ∨ c < a, from le_or_lt a c,
      have hac11 : c ≤ a ∨ c ≤ a, from le_or_le a c,

      have hb : b > a, from hab.lt_of_le hac1,
      have h1 : b > c, from hb.lt_of_le hac1,
      have h2 : b > c, from hab.lt_of_le hc1,
      have h3 : b > c, from h2,
      have h5 : b < b, from h3,

      show is_interval (set.Ioo a b) (set.Ioo c d), from sorry,
      --{
      --cases hcd {
      --  assume h4 : c < d,
      --  assume h6 : a < b,
      --  show is_interval (set.Ioo a b) (set.Ioo c d), from sorry,
      --  },
      --cases hcd {
      --  assume h4 : c ≤ d,
      --  assume h6 : a < b,
      --  show is_interval (set.Ioo a b) (set.Ioo c d), from sorry,
      --  },
      --},
    },
    { cases hc1,
      have hac2 : c ≤ a ∨ a < c, from le_or_lt a c,
      have hac3 : a ≤ c ∨ a < c, from le_or_lt a c,
      have hac4 : a < c ∨ a ≤ c, from lt_or_le c a,
      have hac5 : a < c ∨ a < c, from lt_or_lt c a,
      have hac6 : c < a ∨ c < a, from lt_or_lt c a,
      have hac7 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac8 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac9 : c ≤ a ∨ c ≤ a, from le_or_le a c,
      have hac10 : c ≤ a ∨ c < a, from le_or_lt a c,
      have hac11 : c ≤ a ∨ c ≤ a, from le_or_le a c,
      have hac12 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac13 : c < a ∨ c < a, from lt_or_lt a c,
      have hac14 : c ≤ a ∨ c < a, from le_or_lt a c,
      have hac15 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac16 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac17 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac18 : c < a ∨ c < a, from lt_or_lt a c,
      have hac19 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac20 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac21 : c < a ∨ c ≤ a, from lt_or_le a c,
      have hac22 : c ∈ set.Ioo a b, from sorry,
      have hac23 : c ∈ set.Ioo a b, from sorry,
      have hac24 : c < a ∨ c < a, from lt_or_lt a c,
      have hac25 : c < a ∨ c < a, from lt_or_lt a c,
      have hac26 : c < a ∨ c < a, from lt_or_lt a c,
      have hac27 : c < a ∨ c < a, from lt_or_lt a c,
      have hac28 : c < a ∨ c < a, from lt_or_lt a c,
      have hac29 : c < a ∨ c < a, from lt_or_lt a c,
      have hac30
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  let hm_eq : ∀ m n : ℤ, m ≠ n → (λ m : ℤ, int.fract (α * ↑m)) m ≠ (λ m : ℤ, int.fract (α * ↑m)) n, from sorry,

  have h1 : ∀ a b ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), (abs (a - b)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from sorry,

  have h2 : ∀ a : ℝ, 0 <= a → a ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∨ a ∈ set.Icc 0 1 - (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from sorry,

  have h3 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from sorry,

  have h4 : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1, from sorry,

  have h5 : ∀ a : ℝ, 0 <= a → a ∈ set.Icc 0 1 - (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) → closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ {a}, from sorry,

  have h6 : ∀ a : ℝ, 0 <= a → closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ {a} ∨ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1 - {a}, from sorry,

  have h7 : is_open {a} ∧ is_open (set.Icc 0 1 - {a}) → is_open (set.Icc 0 1), from sorry,

  have h8 : is_open {a}, from sorry,

  have h9 : is_open (set.Icc 0 1 - {a}), from sorry,

  have h10 : is_open (set.Icc 0 1), from sorry,

  have h11 : is_connected (set.Icc 0 1), from sorry,

  have h12 : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from sorry,

  sorry,
end

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  show closure ((λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // true}) = set.Icc 0 1, from sorry,
end

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j hij,
    assume h1 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h2 : α = ↑(int.nat_abs (1/(α * ↑i - α * ↑j)) / ↑(i - j)), from by sorry,
    have h3 : α ∈ ℚ, from by sorry,
    show false, from int.irrational_of_not_rat h3 h2,
  },
  have h2 : ∀ i j k : ℤ, i ≠ j →  (k : ℝ) * (int.fract (α * ↑i) - int.fract (α * ↑j)) = int.fract (α * ↑k *(int.fract (α * ↑i) - int.fract (α * ↑j))), from by {
    assume i j k hij,
    rw int.fract_mul,
    rw int.fract_mul,
    rw int.fract_add,
    rw sub_add_cancel' (int.floor_le _),
    rw sub_add_cancel' (int.floor_le _),
    rw int.nat_abs_mul,
    rw int.fract_eq_self_of_irrational at h1,
    sorry,
  },
  have h3 : ∀ i j : ℤ,  (int.nat_abs (1/(α * ↑i - α * ↑j)) : ℝ) * (int.fract (α * ↑i) - int.fract (α * ↑j)) = int.fract (α * ↑(int.nat_abs (1/(α * ↑i - α * ↑j))) *(int.fract (α * ↑i) - int.fract (α * ↑j))), from sorry,
  have h4 : ∀ i j : ℤ,  int.nat_abs (1/(α * ↑i - α * ↑j)) ≠ 0, from sorry,
  have h5 : ∀ i j : ℤ, i ≠ j → int.nat_abs (1/(α * ↑i - α * ↑j)) = ↑ (int.nat_abs (1/(α * ↑i - α * ↑j))), from sorry,
  sorry,
end

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  sorry
end

--OUTPUT 9
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j ∈ @set.univ ℤ, ∀ (h : i ≠ j), α * ↑i - floor (α * ↑i) ≠ α * ↑j - floor (α * ↑j), from sorry,
  have h2 : ∀ i j ∈ @set.univ ℤ, ∀ (h : i ≠ j), α * ↑i - floor (α * ↑i) ≠ α * ↑j - floor (α * ↑j), from sorry,
  have h3 : ∀ i j ∈ @set.univ ℤ, ∀ (h : i ≠ j), int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h4 : ∀ i j ∈ @set.univ ℤ, ∀ (h : i ≠ j), int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h5 : ∀ i : ℝ, i ≠ 0 → ∃ (j : ℝ), j ∈ (λ i : ℕ, α * ↑i) '' ({n : ℕ | n ≤ abs i}),
    from sorry,
  have h6 : ∀ i j : ℤ, i < j → ∃(k : ℤ), k ∈ (λ (m : ℤ), ↑m * int.fract (α * ↑m)) '' ({n : ℤ | n < j}) ∧ k < i,
    from sorry,
-- Now we prove that the set of fractional parts of integer multiples of an irrational number is closed.
  have h7 : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) = (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from sorry,
-- Now we prove that the set of fractional parts of integer multiples of an irrational number contains zero.
  have h8 : ∃ (k : ℤ), k ∈ (@set.univ ℤ), from sorry,
  have h9 : 0 ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from sorry,
-- Now we prove that the set of fractional parts of integer multiples of an irrational number is bounded above by 1.
  have h10 : ∃ (k : ℤ), k ∈ (@set.univ ℤ), from sorry,
  have h11 : 1 ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from sorry,
  show closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from sorry,
end

--OUTPUT 10
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 := set.eq_univ_iff_forall.2 $ λ y, ⟨⟨y, le_refl 0, by linarith⟩, λ ε hε, ⟨⟨1, int.fract_lt_one 1⟩, λ m hm, show abs (y - int.fract (↑m * α)) < ε, by rw [show m = ↑m, from rfl]; exact int.fract_lt_of_ne_zero_of_ne_zero hα_irrat.ne_zero⟩, λ ⟨m, hm⟩, begin
  have := int.fract_lt_of_ne_zero_of_ne_zero hα_irrat.ne_zero,
  rw show m = ↑m, from rfl at this,
  exact this hm
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


import algebra.field
import gtm106.weierstrass_equation.basic
import gtm106.weierstrass_equation.point
import gtm106.weierstrass_equation.non_singular_criterion
import gtm106.weierstrass_equation.linear_change_of_variable
import gtm106.weierstrass_equation.group_law.basic
import gtm106.weierstrass_equation.group_law.linear_change_of_variable
import tactic

namespace weierstrass_equation

namespace affine_point

-- copied from [Fri17] An elementary proof of the group law for elliptic curves

lemma add.x_of_a_add_b_eq_x_of_a_iff
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 : affine_plane_point K)
(h1 : E.affine_point_on_curve P1)
(h2 : E.affine_point_on_curve P2)
(hx : P1.x - P2.x ≠ 0)
: P1.x = neg_of_add_of_affine_plane_point.x E P1 P2
↔ (P1.x - P2.x) * E.eval_dx_at_affine_point P1 + (P1.y - P2.y) * E.eval_dy_at_affine_point P1 = 0 :=
begin
  simp [neg_of_add_of_affine_plane_point.iwl_x'],
  rw (neg_of_add_of_affine_plane_point.iwl E P1 P2).poly.is_multiple_root'
    P1.x P2.x (neg_of_add_of_affine_plane_point.iwl_x1 E P1 P2 h1)
    (neg_of_add_of_affine_plane_point.iwl_x2 E P1 P2 h2 hx) (sub_ne_zero.1 hx),
  rw intersection_with_line.is_on_2',
  simp [neg_of_add_of_affine_plane_point.iwl,
    intersection_with_line.point_this, h1],
  simp [neg_of_add_of_affine_plane_point.A, neg_of_add_of_affine_plane_point.C],
  field_simp [hx],
  split, {
    intro hk,
    rw [← hk],
    ring,
  },
  intro hk,
  transitivity - E.eval_dx_at_affine_point P1 * (P1.x - P2.x) + 0, {
    rw ← sub_eq_zero, ring,
  },
  rw [← hk, ← sub_eq_zero],
  ring,
end

-- Lemma 2.5 (modified)
lemma add.assoc.lemma_2_5'
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 : affine_point E)
: P1.add P2 = P1.add P2.neg → (P1 = P1.neg → P1.regular) → P2 = P2.neg :=
match P1, P2 with
| infinite, infinite := by {
  intros _ _,
  simp [neg],
}
| infinite, (finite P2 h2) := by {
  simp [neg, regular],
}
| (finite P1 h1), infinite := by {
  intros _ _,
  simp [neg],
}
| (finite P1 h1), (finite P2 h2) := by {
  intros hh1 hhreg,
  by_cases hx : P1.x - P2.x = 0, {
    cases same_x_implies_same_or_neg' P1 P2 h1 h2 hx with hP hP, {
      replace hP : finite P1 h1 = finite P2 h2 := by {
        simp only [hP],
      },
      rw [← hP, add.add_right_neg, add.add_to_zero_iff_neg, hP] at hh1,
      exact hh1,
    },
    replace hP : finite P1 h1 = (finite P2 h2).neg := by {
      simp only [neg, hP],
    },
    replace hh1 := hh1.symm,
    rw [hP, add.add_left_neg, add.add_to_zero_iff_neg, neg_of_neg] at hh1,
    exact hh1.symm,
  },
  simp [add, neg_of_add, neg, hx, neg_of_affine_plane_point,
    neg_of_add_of_affine_plane_point] at hh1,
  cases hh1 with hh1 hh1',
  simp only [← hh1, neg_of_add_of_affine_plane_point.y,
    neg_of_add_of_affine_plane_point.A,
    neg_of_add_of_affine_plane_point.C] at hh1',
  rw ← sub_eq_zero at hh1',
  field_simp [hx] at hh1',
  replace hh1' : (neg_of_add_of_affine_plane_point.x E P1 P2 - P1.x) * (2*P2.y + E.a1*P2.x + E.a3) * (P1.x - P2.x) = 0 := by {
    rw [← hh1', ← sub_eq_zero],
    ring,
  },
  replace hh1 := sub_eq_zero.2 hh1.symm,
  simp only [neg_of_add_of_affine_plane_point.x,
    neg_of_add_of_affine_plane_point.A,
    neg_of_add_of_affine_plane_point.C] at hh1,
  field_simp [hx] at hh1,
  replace hh1 : (2*P1.y + E.a1*P1.x + E.a3) * (2*P2.y + E.a1*P2.x + E.a3) * (P1.x - P2.x)^2 = 0 := by {
    rw [← hh1, ← sub_eq_zero],
    ring,
  },
  simp only [neg, neg_of_affine_plane_point.self_eq_neg_iff],
  by_cases hh2 : 2*P1.y + E.a1*P1.x + E.a3 = 0, swap, {
    simp [hx, hh2] at hh1,
    exact hh1,
  },
  by_cases hh3 : neg_of_add_of_affine_plane_point.x E P1 P2 - P1.x = 0, swap, {
    simp [hx, hh3] at hh1',
    exact hh1',
  },
  exfalso,
  replace hh3 := (sub_eq_zero.1 hh3).symm,
  rw add.x_of_a_add_b_eq_x_of_a_iff P1 P2 h1 h2 hx at hh3,
  replace hhreg := hhreg (by {
    simp only [neg, neg_of_affine_plane_point.self_eq_neg_iff],
    exact hh2,
  }),
  change E.eval_dy_at_affine_point P1 = 0 at hh2,
  simp [regular, affine_point_regular, h1, hh2] at hhreg,
  simp [hh2, hx, hhreg] at hh3,
  exact hh3,
}
end

-- Lemma 2.6 (modified)
lemma add.a_add_b_eq_a_iff
{K : Type*} [field K] {E : weierstrass_equation K}
(hns : E.non_singular')
(P1 P2 : affine_point E)
: (P1 = P1.neg → P1.regular) → (P1.add P2 = P1 ↔ P2 = infinite) :=
match P1, P2 with
| infinite, infinite := by {
  intro _,
  simp [add, neg_of_add, neg],
}
| infinite, (finite P2 h2) := by {
  intro _,
  simp [add, neg_of_add, neg],
}
| (finite P1 h1), infinite := by {
  intro _,
  simp [add, neg_of_add, neg],
}
| (finite P1 h1), (finite P2 h2) := by {
  intro hreg,
  simp only [iff_false],
  intro h0,
  have h := h0,
  by_cases hx : P1.x - P2.x = 0, {
    by_cases hy : P1.y + P2.y + E.a1*P1.x + E.a3 = 0, {
      simp [add, neg_of_add, hx, hy] at h,
      simp only [neg] at h,
      exact h,
    },
    simp [add, neg_of_add, hx, hy, neg,
      neg_of_double_of_affine_plane_point, affine_plane_point.ext_iff,
      neg_of_affine_plane_point] at h,
    cases h with h h',
    simp [h, neg_of_double_of_affine_plane_point.y] at h',
    have hP := same_x_implies_same_or_neg P1 P2 h1 h2 hx,
    simp [hy] at hP,
    have hy' : P1.y + P2.y + E.a1*P1.x + E.a3 = 0 := by {
      rw [← h', ← sub_eq_zero.1 hP],
      ring,
    },
    exact hy hy',
  },
  simp [add, neg_of_add, hx, neg,
    neg_of_add_of_affine_plane_point, affine_plane_point.ext_iff,
    neg_of_affine_plane_point] at h,
  cases h with h h',
  simp [h, neg_of_add_of_affine_plane_point.y] at h',
  replace h' : 2*P1.y + E.a1*P1.x + E.a3 = 0 := by {
    rw [← sub_eq_zero.2 h'.symm],
    ring,
  },
  have h'' : E.eval_dy_at_affine_point P1 = 0 := h',
  replace h' : finite P1 h1 = (finite P1 h1).neg := by {
    simp only [neg],
    exact (neg_of_affine_plane_point.self_eq_neg_iff E P1).2 h',
  },
  replace hreg := hreg h',
  replace h := h.symm,
  rw add.x_of_a_add_b_eq_x_of_a_iff P1 P2 h1 h2 hx at h,
  simp [regular, affine_point_regular, h1, h''] at hreg,
  simp [h'', hx, hreg] at h,
  exact h,
}
end

lemma add.assoc
{K : Type*} [field K] {E : weierstrass_equation K}
(P1 P2 P3 : affine_point E)
: (P1.add P2).add P3 = P1.add (P2.add P3) :=
begin
  sorry,
end

noncomputable instance to_add_comm_group
{K : Type*} [field K] (E : weierstrass_equation K)
: add_comm_group (affine_point E)
:= ⟨ add, add.assoc, infinite,
  add.zero_add, add.add_zero, neg,
  (λ P1 P2, P1.add P2.neg), by {
    intros _ _, simp only [has_add.add, add_zero_class.add],
  }, add.add_left_neg, add.comm ⟩

end affine_point

end weierstrass_equation


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.list.lex
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.RelClasses

/-!
# Lexicographic ordering of lists.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

The lexicographic order on `list α` is defined by `L < M` iff
* `[] < (a :: L)` for any `a` and `L`,
* `(a :: L) < (b :: M)` where `a < b`, or
* `(a :: L) < (a :: M)` where `L < M`.

## See also

Related files are:
* `data.finset.colex`: Colexicographic order on finite sets.
* `data.psigma.order`: Lexicographic order on `Σ' i, α i`.
* `data.pi.lex`: Lexicographic order on `Πₗ i, α i`.
* `data.sigma.order`: Lexicographic order on `Σ i, α i`.
* `data.prod.lex`: Lexicographic order on `α × β`.
-/

namespace List

open Nat

universe u

variable {α : Type u}

/-! ### lexicographic ordering -/

#print List.Lex /-
/-- Given a strict order `<` on `α`, the lexicographic strict order on `list α`, for which
`[a0, ..., an] < [b0, ..., b_k]` if `a0 < b0` or `a0 = b0` and `[a1, ..., an] < [b1, ..., bk]`.
The definition is given for any relation `r`, not only strict orders. -/
inductive Lex (r : α → α → Prop) : List α → List α → Prop
  | nil {a l} : Lex [] (a :: l)
  | cons {a l₁ l₂} (h : Lex l₁ l₂) : Lex (a :: l₁) (a :: l₂)
  | Rel {a₁ l₁ a₂ l₂} (h : r a₁ a₂) : Lex (a₁ :: l₁) (a₂ :: l₂)
#align list.lex List.Lex
-/

namespace Lex

#print List.Lex.cons_iff /-
theorem cons_iff {r : α → α → Prop} [IsIrrefl α r] {a l₁ l₂} :
    Lex r (a :: l₁) (a :: l₂) ↔ Lex r l₁ l₂ :=
  ⟨fun h => by cases' h with _ _ _ _ _ h _ _ _ _ h <;> [exact h, exact (irrefl_of r a h).elim],
    Lex.cons⟩
#align list.lex.cons_iff List.Lex.cons_iff
-/

#print List.Lex.not_nil_right /-
@[simp]
theorem not_nil_right (r : α → α → Prop) (l : List α) : ¬Lex r l [] :=
  fun.
#align list.lex.not_nil_right List.Lex.not_nil_right
-/

#print List.Lex.isOrderConnected /-
instance isOrderConnected (r : α → α → Prop) [IsOrderConnected α r] [IsTrichotomous α r] :
    IsOrderConnected (List α) (Lex r) :=
  ⟨fun l₁ =>
    match l₁ with
    | _, [], c :: l₃, nil => Or.inr nil
    | _, [], c :: l₃, Rel _ => Or.inr nil
    | _, [], c :: l₃, cons _ => Or.inr nil
    | _, b :: l₂, c :: l₃, nil => Or.inl nil
    | a :: l₁, b :: l₂, c :: l₃, Rel h => (IsOrderConnected.conn _ b _ h).imp rel rel
    | a :: l₁, b :: l₂, _ :: l₃, cons h =>
      by
      rcases trichotomous_of r a b with (ab | rfl | ab)
      · exact Or.inl (Rel ab)
      · exact (_match _ l₂ _ h).imp cons cons
      · exact Or.inr (Rel ab)⟩
#align list.lex.is_order_connected List.Lex.isOrderConnected
-/

#print List.Lex.isTrichotomous /-
instance isTrichotomous (r : α → α → Prop) [IsTrichotomous α r] : IsTrichotomous (List α) (Lex r) :=
  ⟨fun l₁ =>
    match l₁ with
    | [], [] => Or.inr (Or.inl rfl)
    | [], b :: l₂ => Or.inl nil
    | a :: l₁, [] => Or.inr (Or.inr nil)
    | a :: l₁, b :: l₂ => by
      rcases trichotomous_of r a b with (ab | rfl | ab)
      · exact Or.inl (Rel ab)
      · exact (_match l₁ l₂).imp cons (Or.imp (congr_arg _) cons)
      · exact Or.inr (Or.inr (Rel ab))⟩
#align list.lex.is_trichotomous List.Lex.isTrichotomous
-/

#print List.Lex.isAsymm /-
instance isAsymm (r : α → α → Prop) [IsAsymm α r] : IsAsymm (List α) (Lex r) :=
  ⟨fun l₁ =>
    match l₁ with
    | a :: l₁, b :: l₂, lex.rel h₁, lex.rel h₂ => asymm h₁ h₂
    | a :: l₁, b :: l₂, lex.rel h₁, lex.cons h₂ => asymm h₁ h₁
    | a :: l₁, b :: l₂, lex.cons h₁, lex.rel h₂ => asymm h₂ h₂
    | a :: l₁, b :: l₂, lex.cons h₁, lex.cons h₂ => _match _ _ h₁ h₂⟩
#align list.lex.is_asymm List.Lex.isAsymm
-/

#print List.Lex.isStrictTotalOrder /-
instance isStrictTotalOrder (r : α → α → Prop) [IsStrictTotalOrder α r] :
    IsStrictTotalOrder (List α) (Lex r) :=
  { isStrictWeakOrder_of_isOrderConnected with }
#align list.lex.is_strict_total_order List.Lex.isStrictTotalOrder
-/

#print List.Lex.decidableRel /-
instance decidableRel [DecidableEq α] (r : α → α → Prop) [DecidableRel r] : DecidableRel (Lex r)
  | l₁, [] => isFalse fun h => by cases h
  | [], b :: l₂ => isTrue Lex.nil
  | a :: l₁, b :: l₂ => by
    haveI := DecidableRel l₁ l₂
    refine' decidable_of_iff (r a b ∨ a = b ∧ Lex r l₁ l₂) ⟨fun h => _, fun h => _⟩
    · rcases h with (h | ⟨rfl, h⟩)
      · exact lex.rel h
      · exact lex.cons h
    · rcases h with (_ | h | h)
      · exact Or.inr ⟨rfl, h⟩
      · exact Or.inl h
#align list.lex.decidable_rel List.Lex.decidableRel
-/

#print List.Lex.append_right /-
theorem append_right (r : α → α → Prop) : ∀ {s₁ s₂} (t), Lex r s₁ s₂ → Lex r s₁ (s₂ ++ t)
  | _, _, t, nil => nil
  | _, _, t, cons h => cons (append_right _ h)
  | _, _, t, Rel r => rel r
#align list.lex.append_right List.Lex.append_right
-/

#print List.Lex.append_left /-
theorem append_left (R : α → α → Prop) {t₁ t₂} (h : Lex R t₁ t₂) : ∀ s, Lex R (s ++ t₁) (s ++ t₂)
  | [] => h
  | a :: l => cons (append_left l)
#align list.lex.append_left List.Lex.append_left
-/

#print List.Lex.imp /-
theorem imp {r s : α → α → Prop} (H : ∀ a b, r a b → s a b) : ∀ l₁ l₂, Lex r l₁ l₂ → Lex s l₁ l₂
  | _, _, nil => nil
  | _, _, cons h => cons (imp _ _ h)
  | _, _, Rel r => rel (H _ _ r)
#align list.lex.imp List.Lex.imp
-/

#print List.Lex.to_ne /-
theorem to_ne : ∀ {l₁ l₂ : List α}, Lex (· ≠ ·) l₁ l₂ → l₁ ≠ l₂
  | _, _, cons h, e => to_ne h (List.cons.inj e).2
  | _, _, Rel r, e => r (List.cons.inj e).1
#align list.lex.to_ne List.Lex.to_ne
-/

#print Decidable.List.Lex.ne_iff /-
theorem Decidable.List.Lex.ne_iff [DecidableEq α] {l₁ l₂ : List α} (H : length l₁ ≤ length l₂) :
    Lex (· ≠ ·) l₁ l₂ ↔ l₁ ≠ l₂ :=
  ⟨to_ne, fun h =>
    by
    induction' l₁ with a l₁ IH generalizing l₂ <;> cases' l₂ with b l₂
    · contradiction
    · apply nil
    · exact (not_lt_of_ge H).elim (succ_pos _)
    · by_cases ab : a = b
      · subst b
        apply cons
        exact IH (le_of_succ_le_succ H) (mt (congr_arg _) h)
      · exact Rel ab⟩
#align decidable.list.lex.ne_iff Decidable.List.Lex.ne_iff
-/

#print List.Lex.ne_iff /-
theorem ne_iff {l₁ l₂ : List α} (H : length l₁ ≤ length l₂) : Lex (· ≠ ·) l₁ l₂ ↔ l₁ ≠ l₂ := by
  classical exact Decidable.List.Lex.ne_iff H
#align list.lex.ne_iff List.Lex.ne_iff
-/

end Lex

#print List.LT' /-
--Note: this overrides an instance in core lean
instance LT' [LT α] : LT (List α) :=
  ⟨Lex (· < ·)⟩
#align list.has_lt' List.LT'
-/

#print List.nil_lt_cons /-
theorem nil_lt_cons [LT α] (a : α) (l : List α) : [] < a :: l :=
  Lex.nil
#align list.nil_lt_cons List.nil_lt_cons
-/

instance [LinearOrder α] : LinearOrder (List α) :=
  linearOrderOfSTO (Lex (· < ·))

#print List.LE' /-
--Note: this overrides an instance in core lean
instance LE' [LinearOrder α] : LE (List α) :=
  Preorder.toLE _
#align list.has_le' List.LE'
-/

end List


import data.equiv.basic
import group_theory.perm.cycles

open function

namespace equiv

universe u

def has_fixed_point {α : Type u} (f : α → α) := ∃ x, f x = x

@[simp]
lemma symm_involution {α : Type u} (f : perm α) (inv : involutive f) : f.symm = f :=
begin
  ext,
  calc f.symm x = f.symm (f (f x)) : by rw inv x
            ... = (f.symm ∘ f) (f x) : by refl
            ... = id (f x) : by rw symm_comp_self
            ... = f x : by refl,
end

@[simp]
lemma involution_comp_involution {α : Type u} (f : perm α) (inv : involutive f) : f ∘ f = id :=
begin
  ext, exact inv x,
end

lemma involution_pow_nat_reduce {α : Type u} (f : perm α) (inv : involutive f) (n : ℕ) : f ^ n = 1 ∨ f ^ n = f :=
begin
  induction n,
  left, simp,
  rw [nat.succ_eq_add_one, pow_succ'],
  cases n_ih,
  right, rw n_ih, simp,
  left, rw n_ih, ext, simp, rw inv,
end

lemma involution_pow_reduce {α : Type u} (f : perm α) (inv : involutive f) (n : ℤ) : f ^ n = 1 ∨ f ^ n = f :=
begin
  induction n,
  exact involution_pow_nat_reduce f inv n,
  have h : f ^-[1+n] = f⁻¹^(1+n), {
    rw gpow_neg_succ_of_nat,
    change (f ^ (↑(n.succ):ℤ))⁻¹ = _,
    rw ← inv_gpow,
    change f⁻¹ ^ (n+1) = _,
    rw add_comm,
  },
  change _ = f.symm ^ (1 + n) at h,
  conv at h { to_rhs, rw symm_involution f inv, },
  rw h,
  exact involution_pow_nat_reduce f inv (1+n),
end

lemma involution_same_cycle {α : Type u} (f : perm α) (inv : involutive f) {x y : α} (h : perm.same_cycle f x y) : x = y ∨ f x = y :=
begin
  rcases h with ⟨n, h⟩,
  have h' := involution_pow_reduce f inv n,
  cases h',
  left, rwa h' at h,
  right, rwa h' at h,
end

@[simp]
lemma symm_trans_eq_trans_sym {α : Type u} (f g : equiv α α) : (f.trans g).symm = g.symm.trans f.symm :=
begin
  ext, simp,
end

namespace perm

lemma same_cycle.equiv {β : Type u} (f : perm β) : equivalence (perm.same_cycle f) :=
⟨perm.same_cycle.refl f, (λ _ _ r, perm.same_cycle.symm f r), (λ _ _ _ r1 r2, perm.same_cycle.trans f r1 r2)⟩

def psetoid {α : Type u} (f : perm α) : setoid α := ⟨perm.same_cycle f, equiv.perm.same_cycle.equiv f⟩

instance psetoid.quotient.fintype {α : Type u} (f : perm α) [fintype α] [decidable_eq α]
: fintype (quotient (psetoid f)) :=
begin
  have rel_inst : decidable_rel (psetoid f).r, change decidable_rel (perm.same_cycle _), apply_instance,
  apply @quotient.fintype _ _ (psetoid f) rel_inst,
end

end perm

end equiv