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

! This file was ported from Lean 3 source module category_theory.limits.shapes.strong_epi
! leanprover-community/mathlib commit 3dadefa3f544b1db6214777fe47910739b54c66a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Balanced
import Mathbin.CategoryTheory.LiftingProperties.Basic

/-!
# Strong epimorphisms

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

In this file, we define strong epimorphisms. A strong epimorphism is an epimorphism `f`
which has the (unique) left lifting property with respect to monomorphisms. Similarly,
a strong monomorphisms in a monomorphism which has the (unique) right lifting property
with respect to epimorphisms.

## Main results

Besides the definition, we show that
* the composition of two strong epimorphisms is a strong epimorphism,
* if `f ≫ g` is a strong epimorphism, then so is `g`,
* if `f` is both a strong epimorphism and a monomorphism, then it is an isomorphism

We also define classes `strong_mono_category` and `strong_epi_category` for categories in which
every monomorphism or epimorphism is strong, and deduce that these categories are balanced.

## TODO

Show that the dual of a strong epimorphism is a strong monomorphism, and vice versa.

## References

* [F. Borceux, *Handbook of Categorical Algebra 1*][borceux-vol1]
-/

universe v u

namespace CategoryTheory

variable {C : Type u} [Category.{v} C]

variable {P Q : C}

#print CategoryTheory.StrongEpi /-
/-- A strong epimorphism `f` is an epimorphism which has the left lifting property
with respect to monomorphisms. -/
class StrongEpi (f : P ⟶ Q) : Prop where
  Epi : Epi f
  llp : ∀ ⦃X Y : C⦄ (z : X ⟶ Y) [Mono z], HasLiftingProperty f z
#align category_theory.strong_epi CategoryTheory.StrongEpi
-/

#print CategoryTheory.StrongEpi.mk' /-
theorem StrongEpi.mk' {f : P ⟶ Q} [Epi f]
    (hf :
      ∀ (X Y : C) (z : X ⟶ Y) (hz : Mono z) (u : P ⟶ X) (v : Q ⟶ Y) (sq : CommSq u f z v),
        sq.HasLift) :
    StrongEpi f :=
  { Epi := inferInstance
    llp := fun X Y z hz => ⟨fun u v sq => hf X Y z hz u v sq⟩ }
#align category_theory.strong_epi.mk' CategoryTheory.StrongEpi.mk'
-/

#print CategoryTheory.StrongMono /-
/-- A strong monomorphism `f` is a monomorphism which has the right lifting property
with respect to epimorphisms. -/
class StrongMono (f : P ⟶ Q) : Prop where
  Mono : Mono f
  rlp : ∀ ⦃X Y : C⦄ (z : X ⟶ Y) [Epi z], HasLiftingProperty z f
#align category_theory.strong_mono CategoryTheory.StrongMono
-/

#print CategoryTheory.StrongMono.mk' /-
theorem StrongMono.mk' {f : P ⟶ Q} [Mono f]
    (hf :
      ∀ (X Y : C) (z : X ⟶ Y) (hz : Epi z) (u : X ⟶ P) (v : Y ⟶ Q) (sq : CommSq u z f v),
        sq.HasLift) :
    StrongMono f :=
  { Mono := inferInstance
    rlp := fun X Y z hz => ⟨fun u v sq => hf X Y z hz u v sq⟩ }
#align category_theory.strong_mono.mk' CategoryTheory.StrongMono.mk'
-/

attribute [instance] strong_epi.llp

attribute [instance] strong_mono.rlp

#print CategoryTheory.epi_of_strongEpi /-
instance (priority := 100) epi_of_strongEpi (f : P ⟶ Q) [StrongEpi f] : Epi f :=
  StrongEpi.epi
#align category_theory.epi_of_strong_epi CategoryTheory.epi_of_strongEpi
-/

#print CategoryTheory.mono_of_strongMono /-
instance (priority := 100) mono_of_strongMono (f : P ⟶ Q) [StrongMono f] : Mono f :=
  StrongMono.mono
#align category_theory.mono_of_strong_mono CategoryTheory.mono_of_strongMono
-/

section

variable {R : C} (f : P ⟶ Q) (g : Q ⟶ R)

#print CategoryTheory.strongEpi_comp /-
/-- The composition of two strong epimorphisms is a strong epimorphism. -/
theorem strongEpi_comp [StrongEpi f] [StrongEpi g] : StrongEpi (f ≫ g) :=
  { Epi := epi_comp _ _
    llp := by
      intros
      infer_instance }
#align category_theory.strong_epi_comp CategoryTheory.strongEpi_comp
-/

#print CategoryTheory.strongMono_comp /-
/-- The composition of two strong monomorphisms is a strong monomorphism. -/
theorem strongMono_comp [StrongMono f] [StrongMono g] : StrongMono (f ≫ g) :=
  { Mono := mono_comp _ _
    rlp := by
      intros
      infer_instance }
#align category_theory.strong_mono_comp CategoryTheory.strongMono_comp
-/

#print CategoryTheory.strongEpi_of_strongEpi /-
/-- If `f ≫ g` is a strong epimorphism, then so is `g`. -/
theorem strongEpi_of_strongEpi [StrongEpi (f ≫ g)] : StrongEpi g :=
  { Epi := epi_of_epi f g
    llp := by
      intros
      constructor
      intro u v sq
      have h₀ : (f ≫ u) ≫ z = (f ≫ g) ≫ v := by simp only [category.assoc, sq.w]
      exact
        comm_sq.has_lift.mk'
          ⟨(comm_sq.mk h₀).lift, by
            simp only [← cancel_mono z, category.assoc, comm_sq.fac_right, sq.w], by simp⟩ }
#align category_theory.strong_epi_of_strong_epi CategoryTheory.strongEpi_of_strongEpi
-/

#print CategoryTheory.strongMono_of_strongMono /-
/-- If `f ≫ g` is a strong monomorphism, then so is `f`. -/
theorem strongMono_of_strongMono [StrongMono (f ≫ g)] : StrongMono f :=
  { Mono := mono_of_mono f g
    rlp := by
      intros
      constructor
      intro u v sq
      have h₀ : u ≫ f ≫ g = z ≫ v ≫ g := by rw [reassoc_of sq.w]
      exact comm_sq.has_lift.mk' ⟨(comm_sq.mk h₀).lift, by simp, by simp [← cancel_epi z, sq.w]⟩ }
#align category_theory.strong_mono_of_strong_mono CategoryTheory.strongMono_of_strongMono
-/

#print CategoryTheory.strongEpi_of_isIso /-
/-- An isomorphism is in particular a strong epimorphism. -/
instance (priority := 100) strongEpi_of_isIso [IsIso f] : StrongEpi f
    where
  Epi := by infer_instance
  llp X Y z hz := HasLiftingProperty.of_left_iso _ _
#align category_theory.strong_epi_of_is_iso CategoryTheory.strongEpi_of_isIso
-/

#print CategoryTheory.strongMono_of_isIso /-
/-- An isomorphism is in particular a strong monomorphism. -/
instance (priority := 100) strongMono_of_isIso [IsIso f] : StrongMono f
    where
  Mono := by infer_instance
  rlp X Y z hz := HasLiftingProperty.of_right_iso _ _
#align category_theory.strong_mono_of_is_iso CategoryTheory.strongMono_of_isIso
-/

#print CategoryTheory.StrongEpi.of_arrow_iso /-
theorem StrongEpi.of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
    (e : Arrow.mk f ≅ Arrow.mk g) [h : StrongEpi f] : StrongEpi g :=
  { Epi := by
      rw [arrow.iso_w' e]
      haveI := epi_comp f e.hom.right
      apply epi_comp
    llp := fun X Y z => by
      intro
      apply has_lifting_property.of_arrow_iso_left e z }
#align category_theory.strong_epi.of_arrow_iso CategoryTheory.StrongEpi.of_arrow_iso
-/

#print CategoryTheory.StrongMono.of_arrow_iso /-
theorem StrongMono.of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
    (e : Arrow.mk f ≅ Arrow.mk g) [h : StrongMono f] : StrongMono g :=
  { Mono := by
      rw [arrow.iso_w' e]
      haveI := mono_comp f e.hom.right
      apply mono_comp
    rlp := fun X Y z => by
      intro
      apply has_lifting_property.of_arrow_iso_right z e }
#align category_theory.strong_mono.of_arrow_iso CategoryTheory.StrongMono.of_arrow_iso
-/

#print CategoryTheory.StrongEpi.iff_of_arrow_iso /-
theorem StrongEpi.iff_of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
    (e : Arrow.mk f ≅ Arrow.mk g) : StrongEpi f ↔ StrongEpi g :=
  by
  constructor <;> intro
  exacts[strong_epi.of_arrow_iso e, strong_epi.of_arrow_iso e.symm]
#align category_theory.strong_epi.iff_of_arrow_iso CategoryTheory.StrongEpi.iff_of_arrow_iso
-/

#print CategoryTheory.StrongMono.iff_of_arrow_iso /-
theorem StrongMono.iff_of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
    (e : Arrow.mk f ≅ Arrow.mk g) : StrongMono f ↔ StrongMono g :=
  by
  constructor <;> intro
  exacts[strong_mono.of_arrow_iso e, strong_mono.of_arrow_iso e.symm]
#align category_theory.strong_mono.iff_of_arrow_iso CategoryTheory.StrongMono.iff_of_arrow_iso
-/

end

#print CategoryTheory.isIso_of_mono_of_strongEpi /-
/-- A strong epimorphism that is a monomorphism is an isomorphism. -/
theorem isIso_of_mono_of_strongEpi (f : P ⟶ Q) [Mono f] [StrongEpi f] : IsIso f :=
  ⟨⟨(CommSq.mk (show 𝟙 P ≫ f = f ≫ 𝟙 Q by simp)).lift, by tidy⟩⟩
#align category_theory.is_iso_of_mono_of_strong_epi CategoryTheory.isIso_of_mono_of_strongEpi
-/

#print CategoryTheory.isIso_of_epi_of_strongMono /-
/-- A strong monomorphism that is an epimorphism is an isomorphism. -/
theorem isIso_of_epi_of_strongMono (f : P ⟶ Q) [Epi f] [StrongMono f] : IsIso f :=
  ⟨⟨(CommSq.mk (show 𝟙 P ≫ f = f ≫ 𝟙 Q by simp)).lift, by tidy⟩⟩
#align category_theory.is_iso_of_epi_of_strong_mono CategoryTheory.isIso_of_epi_of_strongMono
-/

section

variable (C)

#print CategoryTheory.StrongEpiCategory /-
/-- A strong epi category is a category in which every epimorphism is strong. -/
class StrongEpiCategory : Prop where
  strongEpi_of_epi : ∀ {X Y : C} (f : X ⟶ Y) [Epi f], StrongEpi f
#align category_theory.strong_epi_category CategoryTheory.StrongEpiCategory
-/

#print CategoryTheory.StrongMonoCategory /-
/-- A strong mono category is a category in which every monomorphism is strong. -/
class StrongMonoCategory : Prop where
  strongMono_of_mono : ∀ {X Y : C} (f : X ⟶ Y) [Mono f], StrongMono f
#align category_theory.strong_mono_category CategoryTheory.StrongMonoCategory
-/

end

#print CategoryTheory.strongEpi_of_epi /-
theorem strongEpi_of_epi [StrongEpiCategory C] (f : P ⟶ Q) [Epi f] : StrongEpi f :=
  StrongEpiCategory.strongEpi_of_epi _
#align category_theory.strong_epi_of_epi CategoryTheory.strongEpi_of_epi
-/

#print CategoryTheory.strongMono_of_mono /-
theorem strongMono_of_mono [StrongMonoCategory C] (f : P ⟶ Q) [Mono f] : StrongMono f :=
  StrongMonoCategory.strongMono_of_mono _
#align category_theory.strong_mono_of_mono CategoryTheory.strongMono_of_mono
-/

section

attribute [local instance] strong_epi_of_epi

#print CategoryTheory.balanced_of_strongEpiCategory /-
instance (priority := 100) balanced_of_strongEpiCategory [StrongEpiCategory C] : Balanced C
    where isIso_of_mono_of_epi _ _ _ _ _ := is_iso_of_mono_of_strong_epi _
#align category_theory.balanced_of_strong_epi_category CategoryTheory.balanced_of_strongEpiCategory
-/

end

section

attribute [local instance] strong_mono_of_mono

#print CategoryTheory.balanced_of_strongMonoCategory /-
instance (priority := 100) balanced_of_strongMonoCategory [StrongMonoCategory C] : Balanced C
    where isIso_of_mono_of_epi _ _ _ _ _ := is_iso_of_epi_of_strong_mono _
#align category_theory.balanced_of_strong_mono_category CategoryTheory.balanced_of_strongMonoCategory
-/

end

end CategoryTheory


import analysis.p_series
import number_theory.arithmetic_function
import analysis.special_functions.log.basic
import data.finset.basic
import topology.algebra.infinite_sum
import topology.bases
import topology.uniform_space.basic
import tactic.abel
import tactic.linarith
import analysis.normed_space.basic
import topology.algebra.order.liminf_limsup
import topology.local_homeomorph

noncomputable theory

universes u v

open filter topological_space set classical uniform_space function
open_locale classical uniformity topological_space filter

variables {α : Type u} {β : Type v} [uniform_space α]
open finset
open_locale big_operators
open filter set
open_locale topological_space big_operators classical filter nnreal

namespace asymptotics

namespace nat
namespace arithmetic_function
variable (R : Type*)
section has_zero
variable [has_zero R]

localized "notation `ζ` := nat.arithmetic_function.zeta" in arithmetic_function
notation `⌊` a `⌋₊` := nat.floor a

--Already Have...
--counts the number of prime numbers less than x.
def pi : ℕ → ℕ := λ(x: ℕ), ((range x).filter prime).card
def pi_eps (eps: ℝ) : ℕ → ℕ := λ(x: ℕ), ((Ioc (x:ℝ)^((1:ℝ) - eps) (x:ℝ)).filter prime).card
def zeta': ℂ → ℂ:= λ (x:ℂ ), ∑'n, 1 / (n ^ x)
def p_log : ℕ → ℝ  := λ (x:ℕ ), if hx : prime x  then real.log x else 0
def theta :ℕ → ℝ := λ (x : ℕ), ∑ p in range x, p_log p
def phi  : ℂ → ℂ := λ (s : ℂ), ∑'p, (p_log p) / (p ^ s)

def PNTfunc: ℕ → ℝ :=  λ(x: ℕ), (pi x:ℝ ) / ((x:ℝ ) /real.log (x:ℝ):ℝ)
def thetafunc:ℕ → ℝ :=  λ(x: ℕ), theta x/ (x:ℝ)

theorem tendsto_equiv_has_bound (seq : ℕ → ℝ):
tendsto seq at_top (𝓝 1) ↔ ∀ c_1 < 1, ∀ c_2 > 1,
∃ N, ∀ n ≥ N, c_1 < seq n ∧ seq n < c_2 :=
begin
  rw [at_top_basis.tendsto_iff (nhds_basis_Ioo (1 : ℝ))],
  simp only [set.mem_Ici, set.mem_Ioo, exists_true_left,
  and_imp, prod.forall, gt_iff_lt,
    ge_iff_le],
  exact forall_congr (λ _, forall_swap),
  apply_instance,
end

theorem PNT : tendsto PNTfunc at_top (𝓝 1)
:=begin
rw tendsto_equiv_has_bound,
have statement_1: tendsto thetafunc at_top (𝓝 1):=begin
   rw tendsto_equiv_has_bound,
   sorry,end,
have h₁: ∀ ε ∈ Ioc 0 (1/2), ∀ x > 1, theta x ≤ (real.log x)* pi x:=sorry,
sorry,
end

lemma have_bounds_equiv_is_O:
∃ a > 0, ∃b > a,
∃ N :ℕ, ∀ n ≥ N, a < PNTfunc n ∧ PNTfunc n < b ↔ is_O at_top (λ x, (pi x : ℝ)) (λ x, x / real.log x):=sorry

theorem Chebyshevs_bounds: ∃ a > 0, ∃b > a,
∃ N :ℕ, ∀ n ≥ N, a < PNTfunc n ∧ PNTfunc n < b:=
begin
/-have h₁: ∃ N :ℕ, ∀ n ≥ N, (4/3)^n ≤ ((range 2* n).filter prime):=sorry,-/
sorry,
end

--my attempt
lemma step₁ (n: ℕ): choose (2*n) n < (4^n):=
begin
have h₁: (4^n) = ((1+1)^(2*n)):=begin
 have h₁₁: (4^n) = (2^2)^n:=by ring,
 rw h₁₁,
 rw pow_mul,
 end,
rw h₁,
have h₂: ((1+1)^(2*n)) = ∑ k in range (2*n), choose (2*n) k:=begin
sorry,
end,
rw h₂,
sorry,
end

lemma step₂ (n: ℕ): choose (2*n) n ≥  (2^n):=
begin
induction n with d hd,
simp,
sorry,
end

end nat
end arithmetic_function

end


lemma pow_add (a m n : mynat) : a ^ (m + n) = a ^ m * a ^ n :=
begin
induction n with k Pk,
rw add_zero,
rw pow_zero,
rw mul_one,
refl,

rw pow_succ,
rw ← mul_assoc,
rw ← Pk,
rw ← pow_succ,
rw add_succ,
refl,
end


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

! This file was ported from Lean 3 source module data.finset.pi_induction
! leanprover-community/mathlib commit a11f9106a169dd302a285019e5165f8ab32ff433
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Lattice
import Mathbin.Data.Finset.Sigma

/-!
# Induction principles for `Π i, finset (α i)`

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

In this file we prove a few induction principles for functions `Π i : ι, finset (α i)` defined on a
finite type.

* `finset.induction_on_pi` is a generic lemma that requires only `[finite ι]`, `[decidable_eq ι]`,
  and `[Π i, decidable_eq (α i)]`; this version can be seen as a direct generalization of
  `finset.induction_on`.

* `finset.induction_on_pi_max` and `finset.induction_on_pi_min`: generalizations of
  `finset.induction_on_max`; these versions require `Π i, linear_order (α i)` but assume
  `∀ y ∈ g i, y < x` and `∀ y ∈ g i, x < y` respectively in the induction step.

## Tags
finite set, finite type, induction, function
-/

open Function

variable {ι : Type _} {α : ι → Type _} [Finite ι] [DecidableEq ι] [∀ i, DecidableEq (α i)]

namespace Finset

/- warning: finset.induction_on_pi_of_choice -> Finset.induction_on_pi_of_choice is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : Finite.{succ u1} ι] [_inst_2 : DecidableEq.{succ u1} ι] [_inst_3 : forall (i : ι), DecidableEq.{succ u2} (α i)] (r : forall (i : ι), (α i) -> (Finset.{u2} (α i)) -> Prop), (forall (i : ι) (s : Finset.{u2} (α i)), (Finset.Nonempty.{u2} (α i) s) -> (Exists.{succ u2} (α i) (fun (x : α i) => Exists.{0} (Membership.Mem.{u2, u2} (α i) (Finset.{u2} (α i)) (Finset.hasMem.{u2} (α i)) x s) (fun (H : Membership.Mem.{u2, u2} (α i) (Finset.{u2} (α i)) (Finset.hasMem.{u2} (α i)) x s) => r i x (Finset.erase.{u2} (α i) (fun (a : α i) (b : α i) => _inst_3 i a b) s x))))) -> (forall {p : (forall (i : ι), Finset.{u2} (α i)) -> Prop} (f : forall (i : ι), Finset.{u2} (α i)), (p (fun (_x : ι) => EmptyCollection.emptyCollection.{u2} (Finset.{u2} (α _x)) (Finset.hasEmptyc.{u2} (α _x)))) -> (forall (g : forall (i : ι), Finset.{u2} (α i)) (i : ι) (x : α i), (r i x (g i)) -> (p g) -> (p (Function.update.{succ u1, succ u2} ι (fun (i : ι) => Finset.{u2} (α i)) (fun (a : ι) (b : ι) => _inst_2 a b) g i (Insert.insert.{u2, u2} (α i) (Finset.{u2} (α i)) (Finset.hasInsert.{u2} (α i) (fun (a : α i) (b : α i) => _inst_3 i a b)) x (g i))))) -> (p f))
but is expected to have type
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : Finite.{succ u1} ι] [_inst_2 : DecidableEq.{succ u1} ι] [_inst_3 : forall (i : ι), DecidableEq.{succ u2} (α i)] (r : forall (i : ι), (α i) -> (Finset.{u2} (α i)) -> Prop), (forall (i : ι) (s : Finset.{u2} (α i)), (Finset.Nonempty.{u2} (α i) s) -> (Exists.{succ u2} (α i) (fun (x : α i) => And (Membership.mem.{u2, u2} (α i) (Finset.{u2} (α i)) (Finset.instMembershipFinset.{u2} (α i)) x s) (r i x (Finset.erase.{u2} (α i) (fun (a : α i) (b : α i) => _inst_3 i a b) s x))))) -> (forall {p : (forall (i : ι), Finset.{u2} (α i)) -> Prop} (f : forall (i : ι), Finset.{u2} (α i)), (p (fun (_x : ι) => EmptyCollection.emptyCollection.{u2} (Finset.{u2} (α _x)) (Finset.instEmptyCollectionFinset.{u2} (α _x)))) -> (forall (g : forall (i : ι), Finset.{u2} (α i)) (i : ι) (x : α i), (r i x (g i)) -> (p g) -> (p (Function.update.{succ u1, succ u2} ι (fun (i : ι) => Finset.{u2} (α i)) (fun (a : ι) (b : ι) => _inst_2 a b) g i (Insert.insert.{u2, u2} (α i) (Finset.{u2} (α i)) (Finset.instInsertFinset.{u2} (α i) (fun (a : α i) (b : α i) => _inst_3 i a b)) x (g i))))) -> (p f))
Case conversion may be inaccurate. Consider using '#align finset.induction_on_pi_of_choice Finset.induction_on_pi_of_choiceₓ'. -/
/-- General theorem for `finset.induction_on_pi`-style induction principles. -/
theorem induction_on_pi_of_choice (r : ∀ i, α i → Finset (α i) → Prop)
    (H_ex : ∀ (i) (s : Finset (α i)) (hs : s.Nonempty), ∃ x ∈ s, r i x (s.eraseₓ x))
    {p : (∀ i, Finset (α i)) → Prop} (f : ∀ i, Finset (α i)) (h0 : p fun _ => ∅)
    (step :
      ∀ (g : ∀ i, Finset (α i)) (i : ι) (x : α i),
        r i x (g i) → p g → p (update g i (insert x (g i)))) :
    p f := by
  cases nonempty_fintype ι
  induction' hs : univ.sigma f using Finset.strongInductionOn with s ihs generalizing f; subst s
  cases' eq_empty_or_nonempty (univ.sigma f) with he hne
  · convert h0
    simpa [funext_iff] using he
  · rcases sigma_nonempty.1 hne with ⟨i, -, hi⟩
    rcases H_ex i (f i) hi with ⟨x, x_mem, hr⟩
    set g := update f i ((f i).eraseₓ x) with hg
    clear_value g
    have hx' : x ∉ g i := by
      rw [hg, update_same]
      apply not_mem_erase
    obtain rfl : f = update g i (insert x (g i)) := by
      rw [hg, update_idem, update_same, insert_erase x_mem, update_eq_self]
    clear hg
    rw [update_same, erase_insert hx'] at hr
    refine' step _ _ _ hr (ihs (univ.sigma g) _ _ rfl)
    rw [ssubset_iff_of_subset (sigma_mono (subset.refl _) _)]
    exacts[⟨⟨i, x⟩, mem_sigma.2 ⟨mem_univ _, by simp⟩, by simp [hx']⟩,
      (@le_update_iff _ _ _ _ g g i _).2 ⟨subset_insert _ _, fun _ _ => le_rfl⟩]
#align finset.induction_on_pi_of_choice Finset.induction_on_pi_of_choice

#print Finset.induction_on_pi /-
/-- Given a predicate on functions `Π i, finset (α i)` defined on a finite type, it is true on all
maps provided that it is true on `λ _, ∅` and for any function `g : Π i, finset (α i)`, an index
`i : ι`, and `x ∉ g i`, `p g` implies `p (update g i (insert x (g i)))`.

See also `finset.induction_on_pi_max` and `finset.induction_on_pi_min` for specialized versions
that require `Π i, linear_order (α i)`.  -/
theorem induction_on_pi {p : (∀ i, Finset (α i)) → Prop} (f : ∀ i, Finset (α i)) (h0 : p fun _ => ∅)
    (step :
      ∀ (g : ∀ i, Finset (α i)) (i : ι) (x : α i) (hx : x ∉ g i),
        p g → p (update g i (insert x (g i)))) :
    p f :=
  induction_on_pi_of_choice (fun i x s => x ∉ s) (fun i s ⟨x, hx⟩ => ⟨x, hx, not_mem_erase x s⟩) f
    h0 step
#align finset.induction_on_pi Finset.induction_on_pi
-/

#print Finset.induction_on_pi_max /-
/-- Given a predicate on functions `Π i, finset (α i)` defined on a finite type, it is true on all
maps provided that it is true on `λ _, ∅` and for any function `g : Π i, finset (α i)`, an index
`i : ι`, and an element`x : α i` that is strictly greater than all elements of `g i`, `p g` implies
`p (update g i (insert x (g i)))`.

This lemma requires `linear_order` instances on all `α i`. See also `finset.induction_on_pi` for a
version that `x ∉ g i` instead of ` does not need `Π i, linear_order (α i)`. -/
theorem induction_on_pi_max [∀ i, LinearOrder (α i)] {p : (∀ i, Finset (α i)) → Prop}
    (f : ∀ i, Finset (α i)) (h0 : p fun _ => ∅)
    (step :
      ∀ (g : ∀ i, Finset (α i)) (i : ι) (x : α i),
        (∀ y ∈ g i, y < x) → p g → p (update g i (insert x (g i)))) :
    p f :=
  induction_on_pi_of_choice (fun i x s => ∀ y ∈ s, y < x)
    (fun i s hs => ⟨s.max' hs, s.max'_mem hs, fun y => s.lt_max'_of_mem_erase_max' _⟩) f h0 step
#align finset.induction_on_pi_max Finset.induction_on_pi_max
-/

#print Finset.induction_on_pi_min /-
/-- Given a predicate on functions `Π i, finset (α i)` defined on a finite type, it is true on all
maps provided that it is true on `λ _, ∅` and for any function `g : Π i, finset (α i)`, an index
`i : ι`, and an element`x : α i` that is strictly less than all elements of `g i`, `p g` implies
`p (update g i (insert x (g i)))`.

This lemma requires `linear_order` instances on all `α i`. See also `finset.induction_on_pi` for a
version that `x ∉ g i` instead of ` does not need `Π i, linear_order (α i)`. -/
theorem induction_on_pi_min [∀ i, LinearOrder (α i)] {p : (∀ i, Finset (α i)) → Prop}
    (f : ∀ i, Finset (α i)) (h0 : p fun _ => ∅)
    (step :
      ∀ (g : ∀ i, Finset (α i)) (i : ι) (x : α i),
        (∀ y ∈ g i, x < y) → p g → p (update g i (insert x (g i)))) :
    p f :=
  @induction_on_pi_max ι (fun i => (α i)ᵒᵈ) _ _ _ _ _ _ h0 step
#align finset.induction_on_pi_min Finset.induction_on_pi_min
-/

end Finset


import algebra.indicator_function
import probability.integration
import probability.notation
open measure_theory probability_theory function
open_locale measure_theory probability_theory ennreal

variables {α : Type*} {m1 m2 : measurable_space α} {p : ennreal} {μ : measure α} {hm : m1 ≤ m2}

namespace measure_theory

lemma Lp.integrable [is_finite_measure μ] {p : ennreal} [fact (1 ≤ p)] (f : Lp ℝ p μ) :
  integrable f μ :=
(Lp.mem_ℒp f).integrable (fact.out _)

lemma L2.integrable_mul : ∀ (f g : Lp ℝ 2 μ), integrable (f * g) μ :=
@L2.integrable_inner α ℝ ℝ _ _ μ _

noncomputable def Lp_trim_to_Lp (p : ennreal) (μ : measure α) (hm : m1 ≤ m2) :
  Lp ℝ p (μ.trim hm) → Lp ℝ p μ :=
λ f, Lp_trim_to_Lp_meas ℝ ℝ p μ hm f

namespace Lp_trim_to_Lp

lemma ae_eq {f : Lp ℝ p (μ.trim hm)} :
  Lp_trim_to_Lp p μ hm f =ᵐ[μ] f :=
@Lp_trim_to_Lp_meas_ae_eq α ℝ ℝ p _ _ _ _ _ μ hm f

lemma snorm {f : Lp ℝ p (μ.trim hm)} :
  snorm (Lp_trim_to_Lp p μ hm f) p μ = snorm f p μ :=
snorm_congr_ae ae_eq

lemma isometry [fact (1 ≤ p)] :
  isometry (Lp_trim_to_Lp p μ hm) :=
begin
  rintro f g,
  rw [Lp.edist_def, Lp.edist_def],
  rw [snorm_trim_ae hm ((Lp.ae_strongly_measurable f).sub (Lp.ae_strongly_measurable g))],
  exact snorm_congr_ae (ae_eq.sub ae_eq)
end

@[continuity]
lemma continuous [fact (1 ≤ p)] :
  continuous (Lp_trim_to_Lp p μ hm) :=
Lp_trim_to_Lp.isometry.continuous

end Lp_trim_to_Lp

@[continuity]
lemma continuous_integral_trim :
  continuous (λ (f : Lp ℝ 1 (μ.trim hm)), integral μ f) :=
begin
  simp_rw [← integral_congr_ae Lp_trim_to_Lp.ae_eq],
  exact continuous_integral.comp Lp_trim_to_Lp.isometry.continuous
end

@[continuity]
lemma continuous_set_integral_trim {S : set α} (hS : measurable_set S) :
  continuous (λ f : Lp ℝ 1 (μ.trim hm), ∫ a in S, f a ∂μ) :=
begin
  simp_rw [← integral_congr_ae Lp_trim_to_Lp.ae_eq.restrict],
  exact (continuous_set_integral S).comp Lp_trim_to_Lp.isometry.continuous,
end

example {S : set α} {hS1 : measurable_set S} {hS : indep_sets m1.measurable_set' {S} μ}
  {f : α → ℝ} {hf : integrable f (μ.trim hm)} :
  ∫ a in S, f a ∂μ = (μ S).to_real • ∫ a, f a ∂μ :=
begin
  revert f, apply integrable.induction,
  { rintro c s hs1 -,
    rw [integral_indicator_const _ (hm _ hs1), integral_indicator_const _ (hm _ hs1),
      measure.restrict_apply (hm _ hs1), hS s S hs1 (set.mem_singleton _), ennreal.to_real_mul,
      smul_eq_mul, smul_eq_mul, smul_eq_mul, ← mul_assoc, mul_comm (ennreal.to_real _)] },
  { rintro f g - hf hg h1 h2,
    have hfi : integrable f μ := integrable_of_integrable_trim hm hf,
    have hgi : integrable g μ := integrable_of_integrable_trim hm hg,
    have hfr : integrable f (μ.restrict S) := integrable.mono_measure hfi measure.restrict_le_self,
    have hgr : integrable g (μ.restrict S) := integrable.mono_measure hgi measure.restrict_le_self,
    rw [integral_add' hfr hgr, integral_add' hfi hgi, h1, h2, smul_add] },
  { apply is_closed_eq; continuity },
  { rintro f g hfg - h,
    have h1 : f =ᵐ[μ] g := ae_eq_of_ae_eq_trim hfg,
    rwa [← integral_congr_ae h1, ← integral_congr_ae h1.restrict] }
end

end measure_theory

open measure_theory

namespace probability_theory

theorem indep_fun.integral_mul_of_Lp [is_finite_measure μ] {p : ennreal} [fact (1 ≤ p)]
  {X Y : Lp ℝ p μ} (hXY : indep_fun X Y μ) :
  integral μ (X * Y) = integral μ X * integral μ Y :=
hXY.integral_mul_of_integrable (Lp.integrable X) (Lp.integrable Y)

end probability_theory


import global.immersion
open metric finite_dimensional set model_with_corners
open_locale manifold topology

/-! # The sphere eversion project

The goal of this project was to formalize Gromov's flexibility theorem for open and ample
partial differential relation. A famous corollary of this theorem is Smale's sphere eversion
theorem: you can turn a sphere inside-out. Let us state this corollary first.
-/

section Smale

-- As usual, we denote by `ℝ³` the Euclidean 3-space and by `𝕊²` its unit sphere.
notation `ℝ³` := euclidean_space ℝ (fin 3)
notation `𝕊²` := sphere (0 : ℝ³) 1

-- In the following statements, notation involving `𝓘` and `𝓡` denote smooth structures in the
-- sense of differential geometry.

theorem Smale :
  -- There exists a family of functions `f t` indexed by `ℝ` going from `𝕊²` to `ℝ³` such that
  ∃ f : ℝ → 𝕊² → ℝ³,
    -- it is smooth in both variables (for the obvious smooth structures on `ℝ × 𝕊²` and `ℝ³`) and
    (cont_mdiff (𝓘(ℝ, ℝ).prod (𝓡 2)) 𝓘(ℝ, ℝ³) ∞ ↿f) ∧
    -- `f 0` is the inclusion map, sending `x` to `x` and
    (f 0 = λ x, x) ∧
    -- `f 1` is the antipodal map, sending `x` to `-x` and
    (f 1 = λ x, -x) ∧
    -- every `f t` is an immersion.
    ∀ t, immersion (𝓡 2) 𝓘(ℝ, ℝ³) (f t) :=
sphere_eversion ℝ³

end Smale

/-
The above result is an easy corollary of a much more general theorem by Gromov.
The next three paragraphs lines simply introduce three real dimensional manifolds
`M`, `M'` and `P` and assume they are separated and sigma-compact. They are rather verbose because
mathlib has a very general theory of manifolds (including manifolds with boundary and corners).
We will consider families of maps from `M` to `M'` parametrized by `P`.
Actually `M'` is assumed to be equipped with a preferred metric space structure in order to make it
easier to state the `𝓒⁰` approximation property.
-/

section Gromov

variables (n n' d : ℕ)
{M : Type*} [topological_space M] [charted_space ℝ^n M] [smooth_manifold_with_corners (𝓡 n) M]
[t2_space M] [sigma_compact_space M]

{M' : Type*} [metric_space M'] [charted_space ℝ^n' M'] [smooth_manifold_with_corners (𝓡 n') M']
[sigma_compact_space M']

{P : Type*} [topological_space P] [charted_space ℝ^d P] [smooth_manifold_with_corners (𝓡 d) P]
[t2_space P] [sigma_compact_space P]

/-- Gromov's flexibility theorem for open and ample first order partial differential relations
for maps between manifolds. -/
theorem Gromov
  -- Let `R` be an open and ample first order partial differential relation for maps
  -- from `M` to `M'`.
  {R : rel_mfld 𝓘(ℝ, ℝ^n) M 𝓘(ℝ, ℝ^n') M'} (hRample : R.ample) (hRopen : is_open R)
  -- Let `C` be a closed subset in `P × M`
  {C : set (P × M)} (hC : is_closed C)
  -- Let `ε` be a continuous positive function on `M`
  {ε : M → ℝ} (ε_pos : ∀ x, 0 < ε x) (ε_cont : continuous ε)
  -- Let `𝓕₀` be a family of formal solutions to `R` parametrized by `P`
  (𝓕₀ : family_formal_sol 𝓘(ℝ, ℝ^d) P R)
  -- Assume it is holonomic near `C`.
  (hhol : ∀ᶠ (p : P × M) in 𝓝ˢ C, (𝓕₀ p.1).is_holonomic_at p.2) :
-- then there is a homotopy of such families
∃ 𝓕 : family_formal_sol (𝓘(ℝ, ℝ).prod 𝓘(ℝ, ℝ^d)) (ℝ × P) R,
  -- that agrees with `𝓕₀` at time `t = 0` for every parameter and every point in the source
  (∀ (p : P) (x : M), 𝓕 (0, p) x = 𝓕₀ p x) ∧
  -- is holonomic everywhere for `t = 1`,
  (∀ (p : P), (𝓕 (1, p)).to_one_jet_sec.is_holonomic) ∧
  -- agrees with `𝓕₀` near `C`,
  (∀ᶠ (p : P × M) in 𝓝ˢ C, ∀ t : ℝ, 𝓕 (t, p.1) p.2 = 𝓕₀ p.1 p.2) ∧
  -- and whose underlying maps are `ε`--close to `𝓕₀`.
  (∀ (t : ℝ) (p : P) (x : M), dist ((𝓕 (t, p)).bs x) ((𝓕₀ p).bs x) ≤ ε x) :=
by apply rel_mfld.ample.satisfies_h_principle_with ; assumption

end Gromov


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.homology.homological_complex
import category_theory.differential_object

/-!
# Homological complexes are differential graded objects.

We verify that a `homological_complex` indexed by an `add_comm_group` is
essentially the same thing as a differential graded object.

This equivalence is probably not particularly useful in practice;
it's here to check that definitions match up as expected.
-/

open category_theory
open category_theory.limits

open_locale classical
noncomputable theory

namespace homological_complex

variables {β : Type*} [add_comm_group β] {b : β}
variables {V : Type*} [category V] [has_zero_morphisms V]

/-- Since `eq_to_hom` only preserves the fact that `X.X i = X.X j` but not `i = j`, this definition
is used to aid the simplifier. -/
abbreviation _root_.category_theory.differential_object.X_eq_to_hom
  (X : differential_object (graded_object_with_shift b V))
  {i j : β} (h : i = j) : X.X i ⟶ X.X j := eq_to_hom (congr_arg X.X h)

@[simp] lemma _root_.category_theory.differential_object.X_eq_to_hom_refl
  (X : differential_object (graded_object_with_shift b V)) (i : β) :
  X.X_eq_to_hom (refl i) = 𝟙 _ := rfl

@[simp, reassoc] lemma eq_to_hom_d (X : differential_object (graded_object_with_shift b V))
  {x y : β} (h : x = y) :
  X.X_eq_to_hom h ≫ X.d y = X.d x ≫ X.X_eq_to_hom (by { cases h, refl }) :=
by { cases h, dsimp, simp }

@[simp, reassoc] lemma d_eq_to_hom (X : homological_complex V (complex_shape.up' b))
  {x y z : β} (h : y = z) :
  X.d x y ≫ eq_to_hom (congr_arg X.X h) = X.d x z :=
by { cases h, simp }

@[simp, reassoc] lemma eq_to_hom_f' {X Y : differential_object (graded_object_with_shift b V)}
  (f : X ⟶ Y) {x y : β} (h : x = y) :
  X.X_eq_to_hom h ≫ f.f y = f.f x ≫ Y.X_eq_to_hom h :=
by { cases h, simp }

variables (b V)

local attribute [reducible] graded_object.has_shift

/--
The functor from differential graded objects to homological complexes.
-/
@[simps]
def dgo_to_homological_complex :
  differential_object (graded_object_with_shift b V) ⥤
    homological_complex V (complex_shape.up' b) :=
{ obj := λ X,
  { X := λ i, X.X i,
    d := λ i j, if h : i + b = j then
      X.d i ≫ X.X_eq_to_hom (show i + (1 : ℤ) • b = j, by simp [h]) else 0,
    shape' := λ i j w, by { dsimp at w, convert dif_neg w },
    d_comp_d' := λ i j k hij hjk, begin
      dsimp at hij hjk, substs hij hjk,
      have : X.d i ≫ X.d _ = _ := (congr_fun X.d_squared i : _),
      reassoc! this,
      simp [this],
    end },
  map := λ X Y f,
  { f := f.f,
    comm' := λ i j h, begin
      dsimp at h ⊢,
      subst h,
      have : f.f i ≫ Y.d i = X.d i ≫ f.f (i + 1 • b) := (congr_fun f.comm i).symm,
      reassoc! this,
      simp only [category.comp_id, eq_to_hom_refl, dif_pos rfl, this, category.assoc, eq_to_hom_f']
    end, } }

/--
The functor from homological complexes to differential graded objects.
-/
@[simps]
def homological_complex_to_dgo :
  homological_complex V (complex_shape.up' b) ⥤
    differential_object (graded_object_with_shift b V) :=
{ obj := λ X,
  { X := λ i, X.X i,
    d := λ i, X.d i (i + 1 • b),
    d_squared' := by { ext i, dsimp, simp, } },
  map := λ X Y f,
  { f := f.f,
    comm' := by { ext i, dsimp, simp, }, } }

/--
The unit isomorphism for `dgo_equiv_homological_complex`.
-/
@[simps]
def dgo_equiv_homological_complex_unit_iso :
  𝟭 (differential_object (graded_object_with_shift b V)) ≅
    dgo_to_homological_complex b V ⋙ homological_complex_to_dgo b V :=
nat_iso.of_components (λ X,
  { hom := { f := λ i, 𝟙 (X.X i), },
    inv := { f := λ i, 𝟙 (X.X i), }, }) (by tidy)

/--
The counit isomorphism for `dgo_equiv_homological_complex`.
-/
@[simps]
def dgo_equiv_homological_complex_counit_iso :
  homological_complex_to_dgo b V ⋙ dgo_to_homological_complex b V ≅
    𝟭 (homological_complex V (complex_shape.up' b)) :=
nat_iso.of_components (λ X,
  { hom :=
    { f := λ i, 𝟙 (X.X i),
      comm' := λ i j h, begin
        dsimp at h ⊢, subst h,
        delta homological_complex_to_dgo,
        simp,
      end },
    inv :=
    { f := λ i, 𝟙 (X.X i),
      comm' := λ i j h, begin
        dsimp at h ⊢, subst h,
        delta homological_complex_to_dgo,
        simp,
      end }, }) (by tidy)

/--
The category of differential graded objects in `V` is equivalent
to the category of homological complexes in `V`.
-/
@[simps]
def dgo_equiv_homological_complex :
  differential_object (graded_object_with_shift b V) ≌
    homological_complex V (complex_shape.up' b) :=
{ functor := dgo_to_homological_complex b V,
  inverse := homological_complex_to_dgo b V,
  unit_iso := dgo_equiv_homological_complex_unit_iso b V,
  counit_iso := dgo_equiv_homological_complex_counit_iso b V, }

end homological_complex


import analysis.calculus.deriv

open filter asymptotics

open_locale topological_space

lemma is_o_pow_pow {α : Type*} [normed_field α] [discrete_linear_ordered_field α]
  {p q : ℕ} (hpq : p < q) : is_o (λ (x : α), x^p) (λ x, x^q) at_top :=
begin
  rw is_o_iff_tendsto sorry,
  suffices h : tendsto (λ (x : α), x ^ ((p : ℤ) - q)) at_top (𝓝 0),
  { refine (tendsto_congr' ((eventually_gt_at_top (0 : α)).mono (λ x hx, _))).mp h,
    simp [fpow_sub hx.ne.symm] },
  rw ← neg_sub,
  rw ← int.coe_nat_sub hpq.le,
  have : 1 ≤ q - p := nat.sub_pos_of_lt hpq,
  exact @tendsto_pow_neg_at_top α _ _ (by apply_instance) _ this,
end

lemma tendsto_pow_div_pow {α : Type*} [normed_field α] [discrete_linear_ordered_field α]
  {p q : ℕ} (hpq : p < q) : tendsto (λ (x : α), x^p / x^q) at_top (𝓝 0) :=
begin
  suffices h : tendsto (λ (x : α), x ^ ((p : ℤ) - q)) at_top (𝓝 0),
  { refine (tendsto_congr' ((eventually_gt_at_top (0 : α)).mono (λ x hx, _))).mp h,
    simp [fpow_sub hx.ne.symm] },
  rw ← neg_sub,
  rw ← int.coe_nat_sub hpq.le,
  have : 1 ≤ q - p := nat.sub_pos_of_lt hpq,
  exact @tendsto_pow_neg_at_top α _ _ (by apply_instance) _ this,
end


namespace Ex1

inductive Wk: Nat -> Nat -> Type 0 where
  | id: Wk n n
  | step: Wk m n -> Wk (Nat.succ m) n
  | lift: Wk m n -> Wk (Nat.succ m) (Nat.succ n)

def wk_comp {n m l: Nat} (ρ: Wk n m) (σ: Wk m l): Wk n l :=
  match n, m, l, ρ, σ with
    | _, _, _, Wk.id, σ => σ
    | _, _, _, Wk.step ρ, σ => Wk.step (wk_comp ρ σ)
    | _, _, _, Wk.lift ρ, Wk.id => Wk.lift ρ
    | _, _, _, Wk.lift ρ, Wk.step σ => Wk.step (wk_comp ρ σ)
    | _, _, _, Wk.lift ρ, Wk.lift σ => Wk.lift (wk_comp ρ σ)

theorem wk_comp_id_id {ρ: Wk m n}: wk_comp Wk.id ρ = ρ := rfl

end Ex1

namespace Ex2

inductive Wk: Nat -> Nat -> Type 0 where
  | id: Wk n n
  | step: Wk m n -> Wk (Nat.succ m) n

def wk_comp : Wk n m → Wk m l → Wk n l
  | Wk.id, σ => σ
  | Wk.step ρ, σ => Wk.step (wk_comp ρ σ)

theorem wk_comp_id_id {ρ: Wk m n}: wk_comp Wk.id ρ = ρ := rfl

end Ex2


import algebra.indicator_function
import analysis.special_functions.pow
import analysis.special_functions.complex.log

import rnd_var_one_symbol

open real set finset

open_locale big_operators

lemma le_div_of_pos {a b c d : ℝ} :
  b * exp(d - c) ≤ a → 0 < b → exp(d - c) ≤ a / b :=
λ H G, by {rw mul_comm at H, exact (le_div_iff G).mpr H}

lemma exp_tmp_lemma {a b c d : ℝ} :
  a ≥ b * exp(d - c) → 0 < b → 1 ≤ a / b * exp(c - d) :=
begin
  intros H G,
  have h3 : a/b ≥ exp(d - c) → a/b * exp(c - d) ≥ exp(d - c) * exp(c - d), {
    intro H, apply mul_le_mul_of_nonneg_right, exact H, apply le_of_lt, exact exp_pos (c - d),
  },
  have h4 : a/b * exp(c - d) ≥ exp(d - c) * exp(c - d) → a/b * exp(c - d) ≥ 1, {
    intro H, rw ← exp_add (d-c) (c-d) at H,
    norm_num at H, exact H,
  },
  apply h4, apply h3,
  exact le_div_of_pos H G,
end

lemma a_le_c {b : ℝ → ℝ} {a c : ℝ} :
  (∀ s, a ≤ b s) → (∃ s, c = b s) → (a ≤ c) :=
by finish

lemma mul_add_ge_of_ge {a b c d : ℝ} :
  b > 0 → a ≥ d → a * b + c ≥ d * b + c :=
begin
  intros G H,
  norm_num at *,
  rw mul_le_mul_right, exact H, exact G,
end

lemma zero_le_div_exp_pow {a b c d : ℝ} :
  0 ≤ a → 0 ≤ b → 0 ≤ (a / b * exp(c))^d :=
begin
  intros ha hb,
  apply rpow_nonneg_of_nonneg,
  apply mul_nonneg, apply div_nonneg,
  exact ha, exact hb,
  apply le_of_lt, apply exp_pos,
end

noncomputable theory

/-- indicator function: if k ∈ S then 1 else 0 -/
def Φ {ι : Type} (S : set ι) (k : ι) : ℝ :=
indicator S 1 k

lemma indicator_zero_of_not_one {ι : Type} {S : set ι} {k} :
  ¬ (Φ S k = 1) → (Φ S k = 0) :=
λ H, by {rw [Φ, indicator] at *, by_contradiction H1, finish}

variables {ι : Type} [fintype ι]

/-- if A ⊆ B then ∑ k ∈ A, f k < ∑ k ∈ B, f k-/
lemma sum_le_of_subset {A B : set ι} {f : ι → ℝ} (f_pos : ∀ k, 0 < f k) :
  A ⊆ B → ∑ k, f k * (Φ A k) ≤ ∑ k, f k * (Φ B k) :=
begin
  intro H,
  have h_indicator : ∀ k, Φ A k ≤ Φ B k, {
    apply indicator_le_indicator_of_subset H, simp,
  },
  apply sum_le_sum,
  intros k hk,
  exact (mul_le_mul_left (f_pos k)).mpr (h_indicator k),
end

lemma add_ge_sum_union {A B : set ι} {f : ι → ℝ} (f_pos : ∀ k, 0 < f k) :
  ∑ k, f k * (Φ (A∪B) k) ≤ ∑ k, f k * (Φ A k) + ∑ k, f k * (Φ B k) :=
begin
  rw ← sum_add_distrib,
  apply sum_le_sum,
  intros k hk,
  rw [← mul_add, mul_le_mul_left],
  swap,
  exact (f_pos k),
  rw Φ, rw Φ, rw Φ,
  apply indicator_le',
  intros a ha,
  simp,
  have : a ∈ A ∨ a ∈ B, by {apply ha,},
  by_cases a ∈ A,
  rw indicator, simp only [h], simp,
  by_cases a ∈ B,
  rw indicator, simp only [h], simp,
  rw indicator, simp only [h], simp,
  rw indicator, simp only [h], simp,
  have : a ∈ B, by finish,
  rw indicator, simp only [this], simp,
  intros,
  simp at H, rw or_iff_not_and_not at H, rw not_not at H,
  rw indicator, simp only [H.1], simp,
  rw indicator, simp only [H.2], simp,
end

lemma in_self_or_in_compl {ι : Type} [fintype ι] [decidable_eq ι] {q : ι → ℝ} [rnd_var_1 q] {S : set ι} :
  ∑ k, q k * Φ S k = 1 - ∑ k, q k * Φ Sᶜ k :=
begin
  rw [eq_sub_iff_add_eq, ← sum_add_distrib],
  have hq : ∑ k, q k = 1, by exact rnd_var_1.sum_probs_one,
  rw [← hq, sum_eq_sum_iff_of_le],
  intros k hk,
  rw [← mul_add, add_comm, Φ, Φ],
  rw indicator_compl_add_self_apply S 1 k, simp,
  intros k hk,
  rw [← mul_add, add_comm, Φ, Φ],
  rw indicator_compl_add_self_apply S 1 k, simp,
end

lemma gt_compl_le {ι : Type} {f g : ι → ℝ} :
  {k | f k > g k}ᶜ = {k | f k ≤ g k} :=
by {rw compl_def, simp}

lemma subset_abs {ι : Type} {f : ι → ℝ} {a : ℝ} :
  { k:ι | f k ≥ a } ⊆ { k:ι | abs(f k) ≥ a } :=
by {norm_num, intros x hx, rw le_abs, left, exact hx}

variables [decidable_eq ι]

/-- expected value of a function of a random variable -/
def μ (q : ι → ℝ) [rnd_var_1 q] (f : ι → ℝ) :=
∑ k, q k * f k

/-- variance of a function of a random variable -/
def Var (q : ι → ℝ) [rnd_var_1 q] (f : ι → ℝ) :=
(∑ k, q k * (f k)^2) - (∑ k, q k * f k)^2

lemma helper1 {q f : ι → ℝ} {a : ℝ} :
  ∑ k, (q k) * 2 * (f k) * a = 2 * a * ∑ k, (q k) * (f k) :=
begin
  rw mul_sum,
  apply sum_congr, refl,
  intros k hk,
  rw ← mul_assoc,
  rw mul_comm (q k),
  rw mul_assoc 2 (q k),
  rw mul_assoc 2 (q k * f k) (a),
  rw mul_comm (q k * f k),
  rw ← mul_assoc,
  rw ← mul_assoc,
end

lemma Var_rw {q : ι → ℝ} [rnd_var_1 q] {f : ι → ℝ} :
  ∑ k, (q k) * (f k - μ q f)^2 = Var q f :=
begin
  calc ∑ k, (q k) * (f k - μ q f)^2 = ∑ k, (q k) * ((f k)^2 - 2 * (f k) * (μ q f) + (μ q f)^2) : by {apply sum_congr, refl, intros k hk, linarith}
            ... = ∑ k, ((q k) * (f k)^2 - (q k) * 2 * (f k) * (μ q f) + (q k) * (μ q f)^2) : by {apply sum_congr, refl, intros k hk, rw mul_add, rw mul_sub, linarith}
            ... = ∑ k, (q k) * (f k)^2 - ∑ k, (q k) * 2 * (f k) * (μ q f) + ∑ k, (q k) * (μ q f)^2 : by {rw sum_add_distrib, rw sum_sub_distrib}
            ... = ∑ k, (q k) * (f k)^2 - ∑ k, (q k) * 2 * (f k) * (μ q f) + ∑ k, (μ q f)^2 * (q k) : by simp only [mul_comm]
            ... = ∑ k, (q k) * (f k)^2 - ∑ k, (q k) * 2 * (f k) * (μ q f) + (μ q f)^2 * ∑ k, q k : by simp only [mul_sum]
            ... = ∑ k, (q k) * (f k)^2 - ∑ k, (q k) * 2 * (f k) * (μ q f) + (μ q f)^2 * 1 : by simp only [rnd_var_1.sum_probs_one]
            ... = ∑ k, (q k) * (f k)^2 - ∑ k, (q k) * 2 * (f k) * (μ q f) + (μ q f)^2 : by simp
            ... = ∑ k, (q k) * (f k)^2 - 2 * (μ q f) * ∑ k, (q k) * (f k) + (μ q f)^2 : by simp only [helper1]
            ... = ∑ k, (q k) * (f k)^2 - 2 * (μ q f) * (μ q f) + (μ q f)^2 : by rw μ
            ... = ∑ k, (q k) * (f k)^2 - 2 * (μ q f)^2 + (μ q f)^2 : by ring
            ... = ∑ k, (q k) * (f k)^2 - (μ q f)^2 : by linarith
            ... = ∑ k, (q k) * (f k)^2 - (∑ k, q k * f k)^2 : by rw μ
            ... = Var q f : by rw Var,
end

lemma helper2 {ι : Type} {k : ι} {S : set ι} :
  (Φ S k) + (Φ Sᶜ k) = 1 :=
begin
  rw [Φ, Φ, indicator, indicator],
  simp, by_cases p : k ∈ S,
  simp only [p], simp, intro H, contradiction,
  simp only [p], simp, intro H, contradiction,
end

lemma helper3 {ι : Type} [fintype ι] [decidable_eq ι] {a : ℝ} {f : ι → ℝ} :
  (∀ k, |f k| ≥ a) → (∑ k, |f k| ≥ ∑ k : ι, a) :=
λ H, fintype.sum_mono H

lemma helper4 {ι : Type} {k : ι} {f : ι → ℝ} {ε : ℝ} :
  {k | f k ≥ ε}ᶜ = {k | f k < ε} :=
by {ext, split; simp}

lemma helper5 {a b : ℝ} :
  a ≥ 0 → b ≥ 0 → a + b ≥ a :=
by {intros Ha Hb, linarith}

lemma helper6 {X : ι → ℝ} [rnd_var_1 X] {f g : ι → ℝ} {ε : ℝ} :
∑ k, (X k) * (g k)^2 * (Φ {x | |g x| ≥ ε} k)
                   + ∑ k, (X k) * (g k)^2 * (Φ {x | |g x| < ε} k)
            ≥ (∑ k, (X k) * (g k)^2 * (Φ {x | |g x| ≥ ε} k)) :=
begin
  apply helper5,
  apply sum_nonneg',
  intro i,
  apply mul_nonneg,
  apply mul_nonneg,
  apply le_of_lt,
  exact rnd_var_1.probs_pos i,
  apply sq_nonneg,
  rw Φ, rw indicator,
  by_cases p : i ∈ {x : ι | |g x| ≥ ε},
  simp only [p], simp,
  simp only [p], simp,
  apply sum_nonneg',
  intro i,
  apply mul_nonneg,
  apply mul_nonneg,
  apply le_of_lt,
  exact rnd_var_1.probs_pos i,
  apply sq_nonneg,
  rw Φ, rw indicator,
  by_cases p : i ∈ {x : ι | |g x| < ε},
  simp only [p], simp,
  simp only [p], simp,
end

lemma helper7 {X : ι → ℝ} [rnd_var_1 X] {f g : ι → ℝ} {ε > (0:ℝ)} :
  ∑ k, (X k) * (f k - μ X f)^2 * (Φ {x | |f x - μ X f| ≥ ε} k)
            ≥ ∑ k, (X k) * ε^2 * (Φ {x | |f x - μ X f| ≥ ε} k) :=
begin
  -- intro hε,
  apply sum_le_sum,
  intros i hi,
  rw Φ, rw indicator,
  by_cases p : i ∈ {x : ι | |f x - μ X f| ≥ ε},
  simp only [p], simp,
  have : |f i - μ X f| ≥ ε, { finish },
  have : ε^2 ≤ (f i - μ X f)^2, {
    rw [sq_le_sq, abs_of_pos],
    exact this, assumption,
  },
  have : (f i - μ X f)^2 ≥ ε^2, { exact this },
  apply mul_le_mul_of_nonneg_left,
  exact this,
  apply le_of_lt,
  exact rnd_var_1.probs_pos i,
  simp only [p], simp,
end

lemma Chebyshevs_ineq' (X : ι → ℝ) [rnd_var_1 X] (f : ι → ℝ) {ε > (0:ℝ)} :
  Var X f ≥ ε^2 * (∑ k, (X k) * (Φ {x | |f x - μ X f| ≥ ε} k)) :=
begin
  have : 0 < ε, { assumption, },
  calc Var X f  = ∑ k, (X k) * (f k - μ X f)^2 : by rw Var_rw
      ... = ∑ k, (X k) * (f k - μ X f)^2 * 1 : by simp
      ... = ∑ k, (X k) * (f k - μ X f)^2 * ((Φ {x | |f x - μ X f| ≥ ε} k) + (Φ {x | |f x - μ X f| ≥ ε}ᶜ k)) : by simp only [helper2]
      ... = ∑ k, (X k) * (f k - μ X f)^2 * ((Φ {x | |f x - μ X f| ≥ ε} k) + (Φ {x | |f x - μ X f| < ε} k)) : by {apply sum_congr, refl, intros x hx, rwa helper4}
      ... = ∑ k, ( (X k) * (f k - μ X f)^2 * (Φ {x | |f x - μ X f| ≥ ε} k)
              + (X k) * (f k - μ X f)^2 * (Φ {x | |f x - μ X f| < ε} k) ) : by simp only [mul_add]
      ... = ∑ k, (X k) * (f k - μ X f)^2 * (Φ {x | |f x - μ X f| ≥ ε} k)
              + ∑ k, (X k) * (f k - μ X f)^2 * (Φ {x | |f x - μ X f| < ε} k) : by exact sum_add_distrib
      ... ≥ ∑ k, (X k) * (f k - μ X f)^2 * (Φ {x | |f x - μ X f| ≥ ε} k) : by {apply helper6, exact f}
      ... ≥ ∑ k, (X k) * ε^2 * (Φ {x | |f x - μ X f| ≥ ε} k) : by {apply helper7, exact f, exact this,}
      ... = ∑ k, ε^2 * ((X k) * (Φ {x | |f x - μ X f| ≥ ε} k)) : by {apply sum_congr, refl, intros k hk, rw [mul_comm (X k) (ε^2), mul_assoc]}
      ... = ε^2 * ∑ k, (X k) * (Φ {x | |f x - μ X f| ≥ ε} k) : by simp only [mul_sum],
end

theorem Chebyshevs_ineq {X : ι → ℝ} [rnd_var_1 X] {f : ι → ℝ} {ε > (0:ℝ)} :
  ∑ k, X k * (Φ {k | |f k - μ X f| ≥ ε} k) ≤ Var X f/ε^2 :=
begin
  have ε_pos : ε > 0, { assumption },
  have ε_sq_pos : ε^2 > 0, { exact pow_pos ε_pos 2 },
  have : Var X f / ε^2 ≥ (∑ k, (X k) * (Φ {k | |f k - μ X f| ≥ ε} k)), {
    apply (le_div_iff' ε_sq_pos).mpr,
    apply (Chebyshevs_ineq' X f),
    assumption,
  },
  exact this,
end


example : ∀ (n m o : ℕ), n + m + o = n + (m + o) :=
by intros; simp *


import gtm106.weierstrass_equation.basic
import gtm106.naive_plane
import tactic

namespace weierstrass_equation

-- ================
-- Affine points
-- ================

def eval_at_affine_point
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K) : K :=
P.y^2 + E.a1*P.x*P.y + E.a3*P.y - P.x^3 - E.a2*P.x^2 - E.a4*P.x - E.a6

@[simp]
lemma eval_at_affine_point.base_change
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K)
{L : Type*} [comm_ring L] (f : ring_hom K L)
: (E.base_change f).eval_at_affine_point (P.base_change f) = f (E.eval_at_affine_point P) :=
begin
  simp [base_change, affine_plane_point.base_change, eval_at_affine_point],
end

def eval_dx_at_affine_point
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K) : K :=
E.a1*P.y - 3*P.x^2 - 2*E.a2*P.x - E.a4

@[simp]
lemma eval_dx_at_affine_point.base_change
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K)
{L : Type*} [comm_ring L] (f : ring_hom K L)
: (E.base_change f).eval_dx_at_affine_point (P.base_change f) = f (E.eval_dx_at_affine_point P) :=
begin
  simp [base_change, affine_plane_point.base_change, eval_dx_at_affine_point],
end

def eval_dy_at_affine_point
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K) : K :=
2*P.y + E.a1*P.x + E.a3

@[simp]
lemma eval_dy_at_affine_point.base_change
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K)
{L : Type*} [comm_ring L] (f : ring_hom K L)
: (E.base_change f).eval_dy_at_affine_point (P.base_change f) = f (E.eval_dy_at_affine_point P) :=
begin
  simp [base_change, affine_plane_point.base_change, eval_dy_at_affine_point],
end

/--
`Prop` which asserts that an affine point is on curve
-/
def affine_point_on_curve
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K) :=
E.eval_at_affine_point P = 0

lemma affine_point_on_curve.base_change
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K)
{L : Type*} [comm_ring L] (f : ring_hom K L)
(h : E.affine_point_on_curve P) : (E.base_change f).affine_point_on_curve (P.base_change f) :=
begin
  simp [affine_point_on_curve] at h ⊢,
  simp [h],
end

@[simp]
lemma affine_point_on_curve.base_change_field
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).affine_point_on_curve (P.base_change f) ↔ E.affine_point_on_curve P :=
begin
  simp [affine_point_on_curve],
end

/--
`Prop` which asserts that an affine point is on curve, and which is regular
-/
def affine_point_regular
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K) :=
E.affine_point_on_curve P ∧ ¬ (E.eval_dx_at_affine_point P = 0 ∧ E.eval_dy_at_affine_point P = 0)

@[simp]
lemma affine_point_regular.base_change_field
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).affine_point_regular (P.base_change f) ↔ E.affine_point_regular P :=
begin
  simp [affine_point_regular],
end

/--
`Prop` which asserts that an affine point is on curve, and which is singular
-/
def affine_point_singular
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K) :=
E.affine_point_on_curve P ∧ E.eval_dx_at_affine_point P = 0 ∧ E.eval_dy_at_affine_point P = 0

@[simp]
lemma affine_point_singular.base_change_field
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).affine_point_singular (P.base_change f) ↔ E.affine_point_singular P :=
begin
  simp [affine_point_singular],
end

lemma affine_point_is_regular_or_singular
{K : Type*} [comm_ring K] (E : weierstrass_equation K) (P : affine_plane_point K) :
E.affine_point_on_curve P → (¬ E.affine_point_regular P ↔ E.affine_point_singular P) :=
begin
  intro h,
  simp [h, affine_point_regular, affine_point_singular],
end

/--
`Prop` which asserts that all affine points on curve are regular
-/
def affine_non_singular
{K : Type*} [comm_ring K] (E : weierstrass_equation K) :=
∀ P : affine_plane_point K, E.affine_point_on_curve P → E.affine_point_regular P

/--
Represents all affine points on curve, with the infinity point O
-/
inductive affine_point
{K : Type*} [comm_ring K] (E : weierstrass_equation K)
| infinite : affine_point
| finite (P : affine_plane_point K) (h : E.affine_point_on_curve P) : affine_point

def affine_point.regular
{K : Type*} [comm_ring K] {E : weierstrass_equation K}
: affine_point E → Prop
| affine_point.infinite := true
| (affine_point.finite P h) := E.affine_point_regular P

def affine_point.base_change
{K : Type*} [comm_ring K] {E : weierstrass_equation K}
{L : Type*} [comm_ring L] (f : ring_hom K L)
: affine_point E → affine_point (E.base_change f)
| affine_point.infinite := affine_point.infinite
| (affine_point.finite P h) := affine_point.finite (P.base_change f)
(affine_point_on_curve.base_change E P f h)

-- ================
-- Projective points
-- ================

def eval_at_projective_point'
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K) : K :=
P.Y^2*P.Z + E.a1*P.X*P.Y*P.Z + E.a3*P.Y*P.Z^2 - P.X^3 - E.a2*P.X^2*P.Z - E.a4*P.X*P.Z^2 - E.a6*P.Z^3

@[simp]
lemma eval_at_projective_point'.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).eval_at_projective_point' (P.base_change' f) = f (E.eval_at_projective_point' P) :=
begin
  simp [base_change, projective_plane_point'.base_change', eval_at_projective_point'],
end

def eval_dX_at_projective_point'
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K) : K :=
E.a1*P.Y*P.Z - 3*P.X^2 - 2*E.a2*P.X*P.Z - E.a4*P.Z^2

@[simp]
lemma eval_dX_at_projective_point'.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).eval_dX_at_projective_point' (P.base_change' f) = f (E.eval_dX_at_projective_point' P) :=
begin
  simp [base_change, projective_plane_point'.base_change', eval_dX_at_projective_point'],
end

def eval_dY_at_projective_point'
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K) : K :=
2*P.Y*P.Z + E.a1*P.X*P.Z + E.a3*P.Z^2

@[simp]
lemma eval_dY_at_projective_point'.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).eval_dY_at_projective_point' (P.base_change' f) = f (E.eval_dY_at_projective_point' P) :=
begin
  simp [base_change, projective_plane_point'.base_change', eval_dY_at_projective_point'],
end

def eval_dZ_at_projective_point'
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K) : K :=
P.Y^2 + E.a1*P.X*P.Y + 2*E.a3*P.Y*P.Z - E.a2*P.X^2 - 2*E.a4*P.X*P.Z - 3*E.a6*P.Z^2

@[simp]
lemma eval_dZ_at_projective_point'.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).eval_dZ_at_projective_point' (P.base_change' f) = f (E.eval_dZ_at_projective_point' P) :=
begin
  simp [base_change, projective_plane_point'.base_change', eval_dZ_at_projective_point'],
end

def projective_point_on_curve'
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K) :=
E.eval_at_projective_point' P = 0

@[simp]
lemma projective_point_on_curve'.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).projective_point_on_curve' (P.base_change' f) ↔ E.projective_point_on_curve' P :=
begin
  simp [projective_point_on_curve'],
end

def projective_point_dX_zero'
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K) :=
E.eval_dX_at_projective_point' P = 0

@[simp]
lemma projective_point_dX_zero'.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).projective_point_dX_zero' (P.base_change' f) ↔ E.projective_point_dX_zero' P :=
begin
  simp [projective_point_dX_zero'],
end

def projective_point_dY_zero'
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K) :=
E.eval_dY_at_projective_point' P = 0

@[simp]
lemma projective_point_dY_zero'.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).projective_point_dY_zero' (P.base_change' f) ↔ E.projective_point_dY_zero' P :=
begin
  simp [projective_point_dY_zero'],
end

def projective_point_dZ_zero'
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K) :=
E.eval_dZ_at_projective_point' P = 0

@[simp]
lemma projective_point_dZ_zero'.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point' K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).projective_point_dZ_zero' (P.base_change' f) ↔ E.projective_point_dZ_zero' P :=
begin
  simp [projective_point_dZ_zero'],
end

lemma projective_point_on_curve'.sound
{K : Type*} [field K] (E : weierstrass_equation K) (P P' : projective_plane_point' K)
(h : P.is_equal P') :
E.projective_point_on_curve' P = E.projective_point_on_curve' P' :=
begin
  rcases h with ⟨ a, ha, hX, hY, hZ ⟩,
  have key : E.eval_at_projective_point' P'
  = (E.eval_at_projective_point' P)*a^3 := by {
    unfold eval_at_projective_point',
    rw [hX, hY, hZ],
    ring,
  },
  simp [projective_point_on_curve', key, ha],
end

lemma projective_point_dX_zero'.sound
{K : Type*} [field K] (E : weierstrass_equation K) (P P' : projective_plane_point' K)
(h : P.is_equal P') :
E.projective_point_dX_zero' P = E.projective_point_dX_zero' P' :=
begin
  rcases h with ⟨ a, ha, hX, hY, hZ ⟩,
  have key : E.eval_dX_at_projective_point' P'
  = (E.eval_dX_at_projective_point' P)*a^2 := by {
    unfold eval_dX_at_projective_point',
    rw [hX, hY, hZ],
    ring,
  },
  simp [projective_point_dX_zero', key, ha],
end

lemma projective_point_dY_zero'.sound
{K : Type*} [field K] (E : weierstrass_equation K) (P P' : projective_plane_point' K)
(h : P.is_equal P') :
E.projective_point_dY_zero' P = E.projective_point_dY_zero' P' :=
begin
  rcases h with ⟨ a, ha, hX, hY, hZ ⟩,
  have key : E.eval_dY_at_projective_point' P'
  = (E.eval_dY_at_projective_point' P)*a^2 := by {
    unfold eval_dY_at_projective_point',
    rw [hX, hY, hZ],
    ring,
  },
  simp [projective_point_dY_zero', key, ha],
end

lemma projective_point_dZ_zero'.sound
{K : Type*} [field K] (E : weierstrass_equation K) (P P' : projective_plane_point' K)
(h : P.is_equal P') :
E.projective_point_dZ_zero' P = E.projective_point_dZ_zero' P' :=
begin
  rcases h with ⟨ a, ha, hX, hY, hZ ⟩,
  have key : E.eval_dZ_at_projective_point' P'
  = (E.eval_dZ_at_projective_point' P)*a^2 := by {
    unfold eval_dZ_at_projective_point',
    rw [hX, hY, hZ],
    ring,
  },
  simp [projective_point_dZ_zero', key, ha],
end

/--
`Prop` which asserts that a projective point is on curve
-/
def projective_point_on_curve
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K) :=
quotient.lift (E.projective_point_on_curve')
(projective_point_on_curve'.sound E) P

@[simp]
lemma projective_point_on_curve.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).projective_point_on_curve (P.base_change f) ↔ E.projective_point_on_curve P :=
begin
  revert P,
  refine quotient.ind _,
  intro P,
  simp [projective_point_on_curve, projective_plane_point.base_change,
    projective_plane_point'.base_change],
end

def projective_point_dX_zero
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K) :=
quotient.lift (E.projective_point_dX_zero')
(projective_point_dX_zero'.sound E) P

@[simp]
lemma projective_point_dX_zero.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).projective_point_dX_zero (P.base_change f) ↔ E.projective_point_dX_zero P :=
begin
  revert P,
  refine quotient.ind _,
  intro P,
  simp [projective_point_dX_zero, projective_plane_point.base_change,
    projective_plane_point'.base_change],
end

def projective_point_dY_zero
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K) :=
quotient.lift (E.projective_point_dY_zero')
(projective_point_dY_zero'.sound E) P

@[simp]
lemma projective_point_dY_zero.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).projective_point_dY_zero (P.base_change f) ↔ E.projective_point_dY_zero P :=
begin
  revert P,
  refine quotient.ind _,
  intro P,
  simp [projective_point_dY_zero, projective_plane_point.base_change,
    projective_plane_point'.base_change],
end

def projective_point_dZ_zero
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K) :=
quotient.lift (E.projective_point_dZ_zero')
(projective_point_dZ_zero'.sound E) P

@[simp]
lemma projective_point_dZ_zero.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).projective_point_dZ_zero (P.base_change f) ↔ E.projective_point_dZ_zero P :=
begin
  revert P,
  refine quotient.ind _,
  intro P,
  simp [projective_point_dZ_zero, projective_plane_point.base_change,
    projective_plane_point'.base_change],
end

/--
`Prop` which asserts that a projective point is on curve, and which is regular
-/
def projective_point_regular
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K) :=
E.projective_point_on_curve P ∧ ¬ (E.projective_point_dX_zero P
∧ E.projective_point_dY_zero P ∧ E.projective_point_dZ_zero P)

@[simp]
lemma projective_point_regular.base_change
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K)
{L : Type*} [field L] (f : ring_hom K L)
: (E.base_change f).projective_point_regular (P.base_change f) ↔ E.projective_point_regular P :=
begin
  simp [projective_point_regular],
end

/--
`Prop` which asserts that all projective points on curve are regular
-/
def non_singular
{K : Type*} [field K] (E : weierstrass_equation K) :=
∀ P : projective_plane_point K, E.projective_point_on_curve P → E.projective_point_regular P

/--
Represents all projective points on curve
-/
@[ext]
structure projective_point
{K : Type*} [field K] (E : weierstrass_equation K) :=
mk :: (P : projective_plane_point K) (h : E.projective_point_on_curve P)

def projective_point.regular
{K : Type*} [field K] {E : weierstrass_equation K}
(P : projective_point E) : Prop := E.projective_point_regular P.P

def projective_point.base_change
{K : Type*} [field K] {E : weierstrass_equation K}
{L : Type*} [field L] (f : ring_hom K L)
(P : projective_point E) : projective_point (E.base_change f)
:= ⟨ P.P.base_change f, by simp [P.h] ⟩

-- ================
-- Relations of affine points and projective points
-- ================

/--
For any affine point, it is on curve if and only if
the corresponding projective point is on curve
-/
lemma affine_point_is_projective_point
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) :
E.affine_point_on_curve P ↔ E.projective_point_on_curve P.to_projective_plane :=
begin
  simp [projective_point_on_curve,
    affine_plane_point.to_projective_plane,
    projective_point_on_curve',
    affine_point_on_curve],
  have key : E.eval_at_projective_point' P.to_projective_plane' = E.eval_at_affine_point P := by {
    simp [affine_plane_point.to_projective_plane',
      eval_at_projective_point',
      eval_at_affine_point],
  },
  rw key,
end

/--
For any affine point, it is a regular point on curve if and only if
the corresponding projective point is regular on curve
-/
lemma affine_point_regular_iff_projective_point_regular
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) :
E.affine_point_regular P ↔ E.projective_point_regular P.to_projective_plane :=
begin
  have keyX : E.eval_dX_at_projective_point' P.to_projective_plane' = E.eval_dx_at_affine_point P := by {
    simp [affine_plane_point.to_projective_plane',
      eval_dX_at_projective_point',
      eval_dx_at_affine_point],
  },
  have keyY : E.eval_dY_at_projective_point' P.to_projective_plane' = E.eval_dy_at_affine_point P := by {
    simp [affine_plane_point.to_projective_plane',
      eval_dY_at_projective_point',
      eval_dy_at_affine_point],
  },
  have keyZ : E.eval_dZ_at_projective_point' P.to_projective_plane'
  = 3 * E.eval_at_affine_point P - P.x * E.eval_dx_at_affine_point P - P.y * E.eval_dy_at_affine_point P := by {
    simp [affine_plane_point.to_projective_plane',
      eval_dZ_at_projective_point',
      eval_at_affine_point,
      eval_dx_at_affine_point,
      eval_dy_at_affine_point],
    ring,
  },
  unfold affine_point_regular
    projective_point_regular
    projective_point_dX_zero
    projective_point_dY_zero
    projective_point_dZ_zero,
  rw [← E.affine_point_is_projective_point P],
  simp [affine_point_on_curve,
    affine_plane_point.to_projective_plane,
    projective_point_dX_zero',
    projective_point_dY_zero',
    projective_point_dZ_zero',
    keyX, keyY, keyZ],
  intro h,
  split, {
    intros h1 h2 h3,
    exfalso,
    exact h1 h2 h3,
  },
  intros h1 h2 h3,
  rw [h, h2, h3] at h1,
  simp at h1,
  exact h1,
end

/--
For any projective point, it is on curve if and only if it is `[0:1:0]`
or it is a finite point and the corresponding affine point is on curve
-/
lemma projective_point_is_affine_point
{K : Type*} [field K] (E : weierstrass_equation K) (P : projective_plane_point K) :
E.projective_point_on_curve P ↔ P = projective_plane_point.infinite_point_Y K
∨ (P.is_finite ∧ E.affine_point_on_curve P.to_affine_plane) :=
begin
  split, {
    revert P,
    refine quotient.ind _,
    simp [projective_point_on_curve,
      projective_plane_point.infinite_point_Y,
      projective_plane_point.is_finite,
      projective_plane_point.to_affine_plane],
    intro P,
    have h1 := P.h,
    intro h2,
    unfold projective_point_on_curve' at h2,
    by_cases hZ : P.Z = 0, {
      left,
      simp [eval_at_projective_point',
        hZ, zero_pow] at h2,
      simp [hZ, h2] at h1,
      use 1/P.Y,
      simp [projective_plane_point'.infinite_point_Y, h1, h2, hZ],
    },
    right,
    use hZ,
    calc E.eval_at_affine_point P.to_affine_plane
    = (E.eval_at_projective_point' P)/P.Z^3 : by {
      simp [eval_at_projective_point',
        eval_at_affine_point,
        projective_plane_point'.to_affine_plane],
      field_simp [pow_succ, hZ],
      ring,
    }
    ... = 0 : by {
      simp [h2],
    },
  },
  intro h,
  rcases h with h | ⟨ h1, h2 ⟩, {
    rw h,
    simp [projective_point_on_curve,
      projective_plane_point.infinite_point_Y,
      projective_point_on_curve',
      eval_at_projective_point',
      projective_plane_point'.infinite_point_Y, zero_pow],
  },
  rw [E.affine_point_is_projective_point, P.embed_invertible h1] at h2,
  exact h2,
end

/--
The point `[0:1:0]` is on curve and is regular
-/
@[simp]
lemma infinite_point_is_regular
{K : Type*} [field K] (E : weierstrass_equation K) : E.projective_point_regular (projective_plane_point.infinite_point_Y K) :=
begin
  simp [projective_plane_point.infinite_point_Y,
    projective_point_regular,
    projective_point_on_curve,
    projective_point_dX_zero,
    projective_point_dY_zero,
    projective_point_dZ_zero,
    projective_plane_point'.infinite_point_Y,
    projective_point_on_curve',
    projective_point_dX_zero',
    projective_point_dY_zero',
    projective_point_dZ_zero',
    eval_at_projective_point',
    eval_dX_at_projective_point',
    eval_dY_at_projective_point',
    eval_dZ_at_projective_point',
    zero_pow],
end

def affine_point.to_projective_point
{K : Type*} [field K] {E : weierstrass_equation K}
: affine_point E → projective_point E
| affine_point.infinite := ⟨ projective_plane_point.infinite_point_Y K, E.infinite_point_is_regular.1 ⟩
| (affine_point.finite P h) := ⟨ P.to_projective_plane, (E.affine_point_is_projective_point P).1 h ⟩

noncomputable def projective_point.to_affine_point
{K : Type*} [field K] {E : weierstrass_equation K}
(P : projective_point E) : affine_point E :=
begin
  by_cases h : P.P.is_finite, {
    exact affine_point.finite P.P.to_affine_plane (by {
      rcases (E.projective_point_is_affine_point P.P).1 P.h with h1 | ⟨ h2, h3 ⟩, {
        exfalso,
        simp [h1, projective_plane_point.infinite_point_Y,
          projective_plane_point'.infinite_point_Y,
          projective_plane_point.is_finite,
          projective_plane_point'.is_finite] at h,
        exact h,
      },
      exact h3,
    }),
  },
  exact affine_point.infinite,
end

@[simp]
lemma affine_point.embed_invertible
{K : Type*} [field K] {E : weierstrass_equation K}
(P : affine_point E) : P.to_projective_point.to_affine_point = P :=
match P with
| affine_point.infinite := by {
  simp [affine_point.to_projective_point,
    projective_plane_point.infinite_point_Y,
    projective_plane_point'.infinite_point_Y,
    projective_plane_point.is_finite,
    projective_plane_point'.is_finite,
    projective_point.to_affine_point],
}
| (affine_point.finite P h) := by {
  simp [affine_point.to_projective_point,
    affine_plane_point.to_projective_plane,
    affine_plane_point.to_projective_plane',
    projective_plane_point.is_finite,
    projective_plane_point'.is_finite,
    projective_point.to_affine_point,
    projective_plane_point.to_affine_plane,
    projective_plane_point'.to_affine_plane,
    affine_plane_point.ext_iff],
}
end

@[simp]
lemma projective_point.embed_invertible
{K : Type*} [field K] {E : weierstrass_equation K}
(P : projective_point E) : P.to_affine_point.to_projective_point = P :=
begin
  by_cases h : P.P.is_finite, {
    simp [projective_point.to_affine_point, h,
      affine_point.to_projective_point,
      projective_point.ext_iff,
      projective_plane_point.embed_invertible],
  },
  simp [projective_point.to_affine_point, h,
    affine_point.to_projective_point,
    projective_point.ext_iff],
  have h1 := (E.projective_point_is_affine_point P.P).1 P.h,
  simp [h] at h1,
  exact h1.symm,
end

noncomputable def affine_point_equiv_to_projective_point
{K : Type*} [field K] (E : weierstrass_equation K)
: equiv E.affine_point E.projective_point :=
⟨ affine_point.to_projective_point, projective_point.to_affine_point,
  affine_point.embed_invertible, projective_point.embed_invertible ⟩

lemma affine_point.embed_commutes_with_base_change
{K : Type*} [field K] {E : weierstrass_equation K}
{L : Type*} [field L] (f : ring_hom K L)
(P : affine_point E)
: (P.base_change f).to_projective_point = P.to_projective_point.base_change f :=
begin
  cases P, {
    simp [affine_point.base_change, affine_point.to_projective_point,
      projective_point.base_change,
      projective_plane_point.base_change,
      projective_plane_point.infinite_point_Y,
      projective_plane_point'.base_change,
      projective_plane_point'.base_change',
      projective_plane_point'.infinite_point_Y],
  },
  simp [affine_point.base_change, affine_point.to_projective_point,
    projective_point.base_change,
    affine_plane_point.base_change,
    affine_plane_point.to_projective_plane,
    projective_plane_point.base_change,
    affine_plane_point.to_projective_plane',
    projective_plane_point'.base_change,
    projective_plane_point'.base_change'],
end

lemma projective_point.embed_commutes_with_base_change
{K : Type*} [field K] {E : weierstrass_equation K}
{L : Type*} [field L] (f : ring_hom K L)
(P : projective_point E)
: (P.base_change f).to_affine_point = P.to_affine_point.base_change f :=
begin
  set Q := P.to_affine_point with hQ, clear_value Q,
  rw [← projective_point.embed_invertible P, ← hQ,
    ← affine_point.embed_commutes_with_base_change,
    affine_point.embed_invertible],
end

/--
All projective points on curve are regular if and only if
all affine points on curve are regular
-/
lemma non_singular_iff_affine_non_singular
{K : Type*} [field K] (E : weierstrass_equation K) :
E.non_singular ↔ E.affine_non_singular :=
begin
  split, {
    intros h P,
    rw [E.affine_point_is_projective_point, E.affine_point_regular_iff_projective_point_regular],
    exact h P.to_projective_plane,
  },
  intros h P h1,
  rw E.projective_point_is_affine_point at h1,
  rcases h1 with h1 | ⟨ h1, h2 ⟩, {
    rw h1,
    exact E.infinite_point_is_regular,
  },
  replace h := h P.to_affine_plane h2,
  rw [E.affine_point_regular_iff_projective_point_regular, P.embed_invertible h1] at h,
  exact h,
end

-- ================
-- Singular point: node and cusp
-- ================

def has_affine_singular_point
{K : Type*} [field K] (E : weierstrass_equation K) :=
∃ P : affine_plane_point K, E.affine_point_singular P

lemma singular_iff_has_affine_singular_point
{K : Type*} [field K] (E : weierstrass_equation K) :
¬ E.non_singular ↔ E.has_affine_singular_point :=
begin
  rw E.non_singular_iff_affine_non_singular,
  simp [affine_non_singular, has_affine_singular_point],
  split, {
    intro h,
    rcases h with ⟨ P, h1, h2 ⟩,
    use [P, h1],
    unfold affine_point_regular at h2,
    finish,
  },
  intro h,
  rcases h with ⟨ P, h1, h2 ⟩,
  use [P, h1],
  unfold affine_point_regular,
  finish,
end

/-
def eval_dxdx_at_affine_point
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) : K :=
-6*P.x - 2*E.a2

def eval_dxdy_at_affine_point
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) : K :=
E.a1

def eval_dydy_at_affine_point
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) : K :=
2

def eval_hessian_at_affine_point
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) : K :=
(E.eval_dxdx_at_affine_point P)*(E.eval_dydy_at_affine_point P) - (E.eval_dxdy_at_affine_point P)^2
-/

def eval_hessian_at_affine_point
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) : K :=
-12*P.x - E.b2

def affine_point_is_node
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) :=
E.affine_point_singular P ∧ E.eval_hessian_at_affine_point P ≠ 0

def affine_point_is_cusp
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) :=
E.affine_point_singular P ∧ E.eval_hessian_at_affine_point P = 0

lemma singular_point_is_node_or_cusp
{K : Type*} [field K] (E : weierstrass_equation K) (P : affine_plane_point K) :
E.affine_point_singular P → (¬ E.affine_point_is_node P ↔ E.affine_point_is_cusp P) :=
begin
  intro h1,
  simp [h1, affine_point_is_node, affine_point_is_cusp],
end

def has_node
{K : Type*} [field K] (E : weierstrass_equation K) :=
∃ P : affine_plane_point K, E.affine_point_is_node P

def has_cusp
{K : Type*} [field K] (E : weierstrass_equation K) :=
∃ P : affine_plane_point K, E.affine_point_is_cusp P

end weierstrass_equation