/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
Ported by: Joël Riou

! This file was ported from Lean 3 source module combinatorics.quiver.connected_component
! leanprover-community/mathlib commit 18a5306c091183ac90884daa9373fa3b178e8607
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.Quiver.Subquiver
import Mathlib.Combinatorics.Quiver.Path
import Mathlib.Combinatorics.Quiver.Symmetric

/-!
## Weakly connected components

For a quiver `V`, define the type `WeaklyConnectedComponent V` as the quotient of `V` by
the relation which identifies `a` with `b` if there is a path from `a` to `b` in `Symmetrify V`.
(These zigzags can be seen as a proof-relevant analogue of `EqvGen`.)

Strongly connected components have not yet been defined.
-/

universe v u

namespace Quiver

variable (V : Type _) [Quiver.{u+1} V]

/-- Two vertices are related in the zigzag setoid if there is a
    zigzag of arrows from one to the other. -/
def zigzagSetoid : Setoid V :=
  ⟨fun a b ↦ Nonempty (@Path (Symmetrify V) _ a b), fun _ ↦ ⟨Path.nil⟩, fun ⟨p⟩ ↦
    ⟨p.reverse⟩, fun ⟨p⟩ ⟨q⟩ ↦ ⟨p.comp q⟩⟩
#align quiver.zigzag_setoid Quiver.zigzagSetoid

/-- The type of weakly connected components of a directed graph. Two vertices are
    in the same weakly connected component if there is a zigzag of arrows from one
    to the other. -/
def WeaklyConnectedComponent : Type _ :=
  Quotient (zigzagSetoid V)
#align quiver.weakly_connected_component Quiver.WeaklyConnectedComponent

namespace WeaklyConnectedComponent

variable {V}

/-- The weakly connected component corresponding to a vertex. -/
protected def mk : V → WeaklyConnectedComponent V :=
  @Quotient.mk' _ (zigzagSetoid V)
#align quiver.weakly_connected_component.mk Quiver.WeaklyConnectedComponent.mk

instance : CoeTC V (WeaklyConnectedComponent V) :=
  ⟨WeaklyConnectedComponent.mk⟩

instance [Inhabited V] : Inhabited (WeaklyConnectedComponent V) :=
  ⟨show V from default⟩

protected theorem eq (a b : V) :
    (a : WeaklyConnectedComponent V) = b ↔ Nonempty (@Path (Symmetrify V) _ a b) :=
  Quotient.eq''
#align quiver.weakly_connected_component.eq Quiver.WeaklyConnectedComponent.eq

end WeaklyConnectedComponent

variable {V}

-- Without the explicit universe level in `Quiver.{v+1}` Lean comes up with
-- `Quiver.{max u_2 u_3 + 1}`. This causes problems elsewhere, so we write `Quiver.{v+1}`.
/-- A wide subquiver `H` of `Symmetrify V` determines a wide subquiver of `V`, containing an
    an arrow `e` if either `e` or its reversal is in `H`. -/
def wideSubquiverSymmetrify (H : WideSubquiver (Symmetrify V)) : WideSubquiver V :=
  fun _ _ ↦ { e | H _ _ (Sum.inl e) ∨ H _ _ (Sum.inr e) }
#align quiver.wide_subquiver_symmetrify Quiver.wideSubquiverSymmetrify

end Quiver


import classes.context_free.basics.toolbox
import utilities.language_operations
import utilities.list_utils

variables {T : Type}

section auxiliary

private def reversal_grammar (g : CF_grammar T) : CF_grammar T :=
CF_grammar.mk g.nt g.initial (list.map (
    λ r : g.nt × list (symbol T g.nt), (r.fst, list.reverse r.snd)
  ) g.rules)

private lemma dual_of_reversal_grammar (g : CF_grammar T) :
  reversal_grammar (reversal_grammar g) = g :=
begin
  cases g,
  unfold reversal_grammar,
  dsimp only,
  rw list.map_map,
  simp only [eq_self_iff_true, heq_iff_eq, true_and],
  change list.map ((
      λ (r : g_nt × list (symbol T g_nt)), (r.fst, r.snd.reverse)) ∘
      λ (r : g_nt × list (symbol T g_nt)), (r.fst, r.snd.reverse))
     g_rules = g_rules,
  convert_to list.map ((λ (r : g_nt × list (symbol T g_nt)), (r.fst, r.snd.reverse.reverse))) g_rules = g_rules,
  convert_to list.map ((λ (r : g_nt × list (symbol T g_nt)), (r.fst, r.snd))) g_rules = g_rules,
  {
    simp [list.reverse_reverse],
  },
  {
    simp,
  },
end

private lemma derives_reversed (g : CF_grammar T) (v : list (symbol T g.nt)) :
  CF_derives (reversal_grammar g) [symbol.nonterminal (reversal_grammar g).initial] v →
    CF_derives g [symbol.nonterminal g.initial] v.reverse :=
begin
  intro hv,
  induction hv with u w trash orig ih,
  {
    rw list.reverse_singleton,
    apply CF_deri_self,
  },
  apply CF_deri_of_deri_tran ih,
  rcases orig with ⟨r, rin, x, y, bef, aft⟩,
  change r ∈ (list.map (
      λ r : g.nt × list (symbol T g.nt), (r.fst, list.reverse r.snd)
    ) g.rules) at rin,
  rw list.mem_map at rin,
  rcases rin with ⟨r₀, rin₀, r_from_r₀⟩,
  use r₀,
  split,
  {
    exact rin₀,
  },
  use y.reverse,
  use x.reverse,
  split,
  {
    rw ←list.reverse_singleton,
    rw ←list.reverse_append_append,
    have fst_from_r : r₀.fst = r.fst,
    {
      rw ←r_from_r₀,
    },
    rw fst_from_r,
    exact congr_arg list.reverse bef,
  },
  {
    have snd_from_r : r₀.snd = r.snd.reverse,
    {
      rw ←r_from_r₀,
      rw list.reverse_reverse,
    },
    rw snd_from_r,
    rw ←list.reverse_append_append,
    exact congr_arg list.reverse aft,
  },
end

private lemma reversed_word_in_original_language {g : CF_grammar T} {w : list T}
    (hyp : w ∈ CF_language (reversal_grammar g)) :
  w.reverse ∈ CF_language g :=
begin
  unfold CF_language at *,
  rw set.mem_set_of_eq at *,
  unfold CF_generates at *,
  unfold CF_generates_str at *,
  rw list.map_reverse,
  exact derives_reversed g (list.map symbol.terminal w) hyp,
end

end auxiliary

/-- The class of context-free languages is closed under reversal. -/
theorem CF_of_reverse_CF (L : language T) :
  is_CF L  →  is_CF (reverse_lang L)  :=
begin
  rintro ⟨g, hgL⟩,
  rw ←hgL,

  use reversal_grammar g,
  unfold reverse_lang,

  apply set.eq_of_subset_of_subset,
  {
    intros w hwL,
    change w.reverse ∈ CF_language g,

    exact reversed_word_in_original_language hwL,
  },
  {
    intros w hwL,
    change w.reverse ∈ CF_language g at hwL,

    have pre_reversal : ∃ g₀, g = reversal_grammar g₀,
    {
      use reversal_grammar g,
      rw dual_of_reversal_grammar,
    },
    cases pre_reversal with g₀ pre_rev,
    rw pre_rev at hwL ⊢,
    have finished_modulo_reverses := reversed_word_in_original_language hwL,
    rw dual_of_reversal_grammar,
    rw list.reverse_reverse at finished_modulo_reverses,
    exact finished_modulo_reverses,
  },
end


inductive BV : Nat → Type
| nil  : BV 0
| cons : (n : Nat) → (hd : Bool) → (tl : BV n) → BV (Nat.succ n)

open BV

def h : {n : Nat} → BV n.succ.succ → Bool
| _, cons (Nat.succ (Nat.succ m)) b v => b
| _, cons (Nat.succ Nat.zero) b v     => not b

theorem ex1 (m : Nat) (b : Bool) (v : BV m.succ.succ) : h (cons m.succ.succ b v) = b :=
rfl

theorem ex2 (m : Nat) (b : Bool) (v : BV 1) : h (cons 1 b v) = not b :=
rfl


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Justus Springer

! This file was ported from Lean 3 source module algebraic_geometry.Spec
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicGeometry.LocallyRingedSpace
import Mathbin.AlgebraicGeometry.StructureSheaf
import Mathbin.Logic.Equiv.TransferInstance
import Mathbin.RingTheory.Localization.LocalizationLocalization
import Mathbin.Topology.Sheaves.SheafCondition.Sites
import Mathbin.Topology.Sheaves.Functors
import Mathbin.Algebra.Module.LocalizedModule

/-!
# $Spec$ as a functor to locally ringed spaces.

We define the functor $Spec$ from commutative rings to locally ringed spaces.

## Implementation notes

We define $Spec$ in three consecutive steps, each with more structure than the last:

1. `Spec.to_Top`, valued in the category of topological spaces,
2. `Spec.to_SheafedSpace`, valued in the category of sheafed spaces and
3. `Spec.to_LocallyRingedSpace`, valued in the category of locally ringed spaces.

Additionally, we provide `Spec.to_PresheafedSpace` as a composition of `Spec.to_SheafedSpace` with
a forgetful functor.

## Related results

The adjunction `Γ ⊣ Spec` is constructed in `algebraic_geometry/Gamma_Spec_adjunction.lean`.

-/

noncomputable section

universe u v

namespace AlgebraicGeometry

open Opposite

open CategoryTheory

open StructureSheaf

open Spec (structureSheaf)

/-- The spectrum of a commutative ring, as a topological space.
-/
def Spec.topObj (R : CommRingCat) : TopCat :=
  TopCat.of (PrimeSpectrum R)
#align algebraic_geometry.Spec.Top_obj AlgebraicGeometry.Spec.topObj

/-- The induced map of a ring homomorphism on the ring spectra, as a morphism of topological spaces.
-/
def Spec.topMap {R S : CommRingCat} (f : R ⟶ S) : Spec.topObj S ⟶ Spec.topObj R :=
  PrimeSpectrum.comap f
#align algebraic_geometry.Spec.Top_map AlgebraicGeometry.Spec.topMap

@[simp]
theorem Spec.topMap_id (R : CommRingCat) : Spec.topMap (𝟙 R) = 𝟙 (Spec.topObj R) :=
  PrimeSpectrum.comap_id
#align algebraic_geometry.Spec.Top_map_id AlgebraicGeometry.Spec.topMap_id

theorem Spec.topMap_comp {R S T : CommRingCat} (f : R ⟶ S) (g : S ⟶ T) :
    Spec.topMap (f ≫ g) = Spec.topMap g ≫ Spec.topMap f :=
  PrimeSpectrum.comap_comp _ _
#align algebraic_geometry.Spec.Top_map_comp AlgebraicGeometry.Spec.topMap_comp

/-- The spectrum, as a contravariant functor from commutative rings to topological spaces.
-/
@[simps]
def Spec.toTop : CommRingCatᵒᵖ ⥤ TopCat
    where
  obj R := Spec.topObj (unop R)
  map R S f := Spec.topMap f.unop
  map_id' R := by rw [unop_id, Spec.Top_map_id]
  map_comp' R S T f g := by rw [unop_comp, Spec.Top_map_comp]
#align algebraic_geometry.Spec.to_Top AlgebraicGeometry.Spec.toTop

/-- The spectrum of a commutative ring, as a `SheafedSpace`.
-/
@[simps]
def Spec.sheafedSpaceObj (R : CommRingCat) : SheafedSpace CommRingCat
    where
  carrier := Spec.topObj R
  Presheaf := (structureSheaf R).1
  IsSheaf := (structureSheaf R).2
#align algebraic_geometry.Spec.SheafedSpace_obj AlgebraicGeometry.Spec.sheafedSpaceObj

/-- The induced map of a ring homomorphism on the ring spectra, as a morphism of sheafed spaces.
-/
@[simps]
def Spec.sheafedSpaceMap {R S : CommRingCat.{u}} (f : R ⟶ S) :
    Spec.sheafedSpaceObj S ⟶ Spec.sheafedSpaceObj R
    where
  base := Spec.topMap f
  c :=
    { app := fun U =>
        comap f (unop U) ((TopologicalSpace.Opens.map (Spec.topMap f)).obj (unop U)) fun p => id
      naturality' := fun U V i => RingHom.ext fun s => Subtype.eq <| funext fun p => rfl }
#align algebraic_geometry.Spec.SheafedSpace_map AlgebraicGeometry.Spec.sheafedSpaceMap

@[simp]
theorem Spec.sheafedSpaceMap_id {R : CommRingCat} :
    Spec.sheafedSpaceMap (𝟙 R) = 𝟙 (Spec.sheafedSpaceObj R) :=
  PresheafedSpace.ext _ _ (Spec.topMap_id R) <|
    NatTrans.ext _ _ <|
      funext fun U => by
        dsimp
        erw [PresheafedSpace.id_c_app, comap_id]; swap
        · rw [Spec.Top_map_id, TopologicalSpace.Opens.map_id_obj_unop]
        simpa [eq_to_hom_map]
#align algebraic_geometry.Spec.SheafedSpace_map_id AlgebraicGeometry.Spec.sheafedSpaceMap_id

theorem Spec.sheafedSpaceMap_comp {R S T : CommRingCat} (f : R ⟶ S) (g : S ⟶ T) :
    Spec.sheafedSpaceMap (f ≫ g) = Spec.sheafedSpaceMap g ≫ Spec.sheafedSpaceMap f :=
  PresheafedSpace.ext _ _ (Spec.topMap_comp f g) <|
    NatTrans.ext _ _ <|
      funext fun U => by
        dsimp
        rw [CategoryTheory.Functor.map_id]
        rw [category.comp_id]
        erw [comap_comp f g]
        rfl
#align algebraic_geometry.Spec.SheafedSpace_map_comp AlgebraicGeometry.Spec.sheafedSpaceMap_comp

/-- Spec, as a contravariant functor from commutative rings to sheafed spaces.
-/
@[simps]
def Spec.toSheafedSpace : CommRingCatᵒᵖ ⥤ SheafedSpace CommRingCat
    where
  obj R := Spec.sheafedSpaceObj (unop R)
  map R S f := Spec.sheafedSpaceMap f.unop
  map_id' R := by rw [unop_id, Spec.SheafedSpace_map_id]
  map_comp' R S T f g := by rw [unop_comp, Spec.SheafedSpace_map_comp]
#align algebraic_geometry.Spec.to_SheafedSpace AlgebraicGeometry.Spec.toSheafedSpace

/-- Spec, as a contravariant functor from commutative rings to presheafed spaces.
-/
def Spec.toPresheafedSpace : CommRingCatᵒᵖ ⥤ PresheafedSpace.{u} CommRingCat.{u} :=
  Spec.toSheafedSpace ⋙ SheafedSpace.forgetToPresheafedSpace
#align algebraic_geometry.Spec.to_PresheafedSpace AlgebraicGeometry.Spec.toPresheafedSpace

@[simp]
theorem Spec.toPresheafedSpace_obj (R : CommRingCatᵒᵖ) :
    Spec.toPresheafedSpace.obj R = (Spec.sheafedSpaceObj (unop R)).toPresheafedSpace :=
  rfl
#align algebraic_geometry.Spec.to_PresheafedSpace_obj AlgebraicGeometry.Spec.toPresheafedSpace_obj

theorem Spec.toPresheafedSpace_obj_op (R : CommRingCat) :
    Spec.toPresheafedSpace.obj (op R) = (Spec.sheafedSpaceObj R).toPresheafedSpace :=
  rfl
#align algebraic_geometry.Spec.to_PresheafedSpace_obj_op AlgebraicGeometry.Spec.toPresheafedSpace_obj_op

@[simp]
theorem Spec.toPresheafedSpace_map (R S : CommRingCatᵒᵖ) (f : R ⟶ S) :
    Spec.toPresheafedSpace.map f = Spec.sheafedSpaceMap f.unop :=
  rfl
#align algebraic_geometry.Spec.to_PresheafedSpace_map AlgebraicGeometry.Spec.toPresheafedSpace_map

theorem Spec.toPresheafedSpace_map_op (R S : CommRingCat) (f : R ⟶ S) :
    Spec.toPresheafedSpace.map f.op = Spec.sheafedSpaceMap f :=
  rfl
#align algebraic_geometry.Spec.to_PresheafedSpace_map_op AlgebraicGeometry.Spec.toPresheafedSpace_map_op

theorem Spec.basicOpen_hom_ext {X : RingedSpace} {R : CommRingCat}
    {α β : X ⟶ Spec.sheafedSpaceObj R} (w : α.base = β.base)
    (h :
      ∀ r : R,
        let U := PrimeSpectrum.basicOpen r
        (toOpen R U ≫ α.c.app (op U)) ≫ X.Presheaf.map (eqToHom (by rw [w])) =
          toOpen R U ≫ β.c.app (op U)) :
    α = β := by
  ext1
  · apply
      ((TopCat.Sheaf.pushforward β.base).obj X.sheaf).hom_ext _ PrimeSpectrum.isBasis_basic_opens
    intro r
    apply (structure_sheaf.to_basic_open_epi R r).1
    simpa using h r
  exact w
#align algebraic_geometry.Spec.basic_open_hom_ext AlgebraicGeometry.Spec.basicOpen_hom_ext

/-- The spectrum of a commutative ring, as a `LocallyRingedSpace`.
-/
@[simps]
def Spec.locallyRingedSpaceObj (R : CommRingCat) : LocallyRingedSpace :=
  { Spec.sheafedSpaceObj R with
    LocalRing := fun x =>
      @RingEquiv.localRing _ (show LocalRing (Localization.AtPrime _) by infer_instance) _
        (Iso.commRingIsoToRingEquiv <| stalkIso R x).symm }
#align algebraic_geometry.Spec.LocallyRingedSpace_obj AlgebraicGeometry.Spec.locallyRingedSpaceObj

@[elementwise]
theorem stalkMap_toStalk {R S : CommRingCat} (f : R ⟶ S) (p : PrimeSpectrum S) :
    toStalk R (PrimeSpectrum.comap f p) ≫ PresheafedSpace.stalkMap (Spec.sheafedSpaceMap f) p =
      f ≫ toStalk S p :=
  by
  erw [← to_open_germ S ⊤ ⟨p, trivial⟩, ← to_open_germ R ⊤ ⟨PrimeSpectrum.comap f p, trivial⟩,
    category.assoc, PresheafedSpace.stalk_map_germ (Spec.SheafedSpace_map f) ⊤ ⟨p, trivial⟩,
    Spec.SheafedSpace_map_c_app, to_open_comp_comap_assoc]
  rfl
#align algebraic_geometry.stalk_map_to_stalk AlgebraicGeometry.stalkMap_toStalk

/-- Under the isomorphisms `stalk_iso`, the map `stalk_map (Spec.SheafedSpace_map f) p` corresponds
to the induced local ring homomorphism `localization.local_ring_hom`.
-/
@[elementwise]
theorem localRingHom_comp_stalkIso {R S : CommRingCat} (f : R ⟶ S) (p : PrimeSpectrum S) :
    (stalkIso R (PrimeSpectrum.comap f p)).Hom ≫
        @CategoryStruct.comp _ _
          (CommRingCat.of (Localization.AtPrime (PrimeSpectrum.comap f p).asIdeal))
          (CommRingCat.of (Localization.AtPrime p.asIdeal)) _
          (Localization.localRingHom (PrimeSpectrum.comap f p).asIdeal p.asIdeal f rfl)
          (stalkIso S p).inv =
      PresheafedSpace.stalkMap (Spec.sheafedSpaceMap f) p :=
  (stalkIso R (PrimeSpectrum.comap f p)).eq_inv_comp.mp <|
    (stalkIso S p).comp_inv_eq.mpr <|
      Localization.localRingHom_unique _ _ _ _ fun x => by
        rw [stalk_iso_hom, stalk_iso_inv, comp_apply, comp_apply, localization_to_stalk_of,
          stalk_map_to_stalk_apply, stalk_to_fiber_ring_hom_to_stalk]
#align algebraic_geometry.local_ring_hom_comp_stalk_iso AlgebraicGeometry.localRingHom_comp_stalkIso

/--
The induced map of a ring homomorphism on the prime spectra, as a morphism of locally ringed spaces.
-/
@[simps]
def Spec.locallyRingedSpaceMap {R S : CommRingCat} (f : R ⟶ S) :
    Spec.locallyRingedSpaceObj S ⟶ Spec.locallyRingedSpaceObj R :=
  LocallyRingedSpace.Hom.mk (Spec.sheafedSpaceMap f) fun p =>
    IsLocalRingHom.mk fun a ha =>
      by
      -- Here, we are showing that the map on prime spectra induced by `f` is really a morphism of
      -- *locally* ringed spaces, i.e. that the induced map on the stalks is a local ring homomorphism.
      rw [← local_ring_hom_comp_stalk_iso_apply] at ha
      replace ha := (stalk_iso S p).Hom.isUnit_map ha
      rw [iso.inv_hom_id_apply] at ha
      replace ha := IsLocalRingHom.map_nonunit _ ha
      convert RingHom.isUnit_map (stalk_iso R (PrimeSpectrum.comap f p)).inv ha
      rw [iso.hom_inv_id_apply]
#align algebraic_geometry.Spec.LocallyRingedSpace_map AlgebraicGeometry.Spec.locallyRingedSpaceMap

@[simp]
theorem Spec.locallyRingedSpaceMap_id (R : CommRingCat) :
    Spec.locallyRingedSpaceMap (𝟙 R) = 𝟙 (Spec.locallyRingedSpaceObj R) :=
  LocallyRingedSpace.Hom.ext _ _ <|
    by
    rw [Spec.LocallyRingedSpace_map_val, Spec.SheafedSpace_map_id]
    rfl
#align algebraic_geometry.Spec.LocallyRingedSpace_map_id AlgebraicGeometry.Spec.locallyRingedSpaceMap_id

theorem Spec.locallyRingedSpaceMap_comp {R S T : CommRingCat} (f : R ⟶ S) (g : S ⟶ T) :
    Spec.locallyRingedSpaceMap (f ≫ g) =
      Spec.locallyRingedSpaceMap g ≫ Spec.locallyRingedSpaceMap f :=
  LocallyRingedSpace.Hom.ext _ _ <|
    by
    rw [Spec.LocallyRingedSpace_map_val, Spec.SheafedSpace_map_comp]
    rfl
#align algebraic_geometry.Spec.LocallyRingedSpace_map_comp AlgebraicGeometry.Spec.locallyRingedSpaceMap_comp

/-- Spec, as a contravariant functor from commutative rings to locally ringed spaces.
-/
@[simps]
def Spec.toLocallyRingedSpace : CommRingCatᵒᵖ ⥤ LocallyRingedSpace
    where
  obj R := Spec.locallyRingedSpaceObj (unop R)
  map R S f := Spec.locallyRingedSpaceMap f.unop
  map_id' R := by rw [unop_id, Spec.LocallyRingedSpace_map_id]
  map_comp' R S T f g := by rw [unop_comp, Spec.LocallyRingedSpace_map_comp]
#align algebraic_geometry.Spec.to_LocallyRingedSpace AlgebraicGeometry.Spec.toLocallyRingedSpace

section SpecΓ

open AlgebraicGeometry.LocallyRingedSpace

/-- The counit morphism `R ⟶ Γ(Spec R)` given by `algebraic_geometry.structure_sheaf.to_open`.  -/
@[simps (config := { rhsMd := Tactic.Transparency.semireducible })]
def toSpecΓ (R : CommRingCat) : R ⟶ Γ.obj (op (Spec.toLocallyRingedSpace.obj (op R))) :=
  StructureSheaf.toOpen R ⊤
#align algebraic_geometry.to_Spec_Γ AlgebraicGeometry.toSpecΓ

instance isIso_toSpecΓ (R : CommRingCat) : IsIso (toSpecΓ R) :=
  by
  cases R
  apply structure_sheaf.is_iso_to_global
#align algebraic_geometry.is_iso_to_Spec_Γ AlgebraicGeometry.isIso_toSpecΓ

@[reassoc.1]
theorem Spec_Γ_naturality {R S : CommRingCat} (f : R ⟶ S) :
    f ≫ toSpecΓ S = toSpecΓ R ≫ Γ.map (Spec.toLocallyRingedSpace.map f.op).op :=
  by
  ext
  symm
  apply Localization.localRingHom_to_map
#align algebraic_geometry.Spec_Γ_naturality AlgebraicGeometry.Spec_Γ_naturality

/-- The counit (`Spec_Γ_identity.inv.op`) of the adjunction `Γ ⊣ Spec` is an isomorphism. -/
@[simps hom_app inv_app]
def specΓIdentity : Spec.toLocallyRingedSpace.rightOp ⋙ Γ ≅ 𝟭 _ :=
  Iso.symm <| NatIso.ofComponents (fun R => asIso (toSpecΓ R) : _) fun _ _ => Spec_Γ_naturality
#align algebraic_geometry.Spec_Γ_identity AlgebraicGeometry.specΓIdentity

end SpecΓ

/-- The stalk map of `Spec M⁻¹R ⟶ Spec R` is an iso for each `p : Spec M⁻¹R`. -/
theorem Spec_map_localization_isIso (R : CommRingCat) (M : Submonoid R)
    (x : PrimeSpectrum (Localization M)) :
    IsIso
      (PresheafedSpace.stalkMap
        (Spec.toPresheafedSpace.map (CommRingCat.ofHom (algebraMap R (Localization M))).op) x) :=
  by
  erw [← local_ring_hom_comp_stalk_iso]
  apply (config := { instances := false }) is_iso.comp_is_iso
  infer_instance
  apply (config := { instances := false }) is_iso.comp_is_iso
  -- I do not know why this is defeq to the goal, but I'm happy to accept that it is.
  exact
    show
      is_iso
        (IsLocalization.localizationLocalizationAtPrimeIsoLocalization M
                x.as_ideal).toRingEquiv.toCommRingIso.Hom
      by infer_instance
  infer_instance
#align algebraic_geometry.Spec_map_localization_is_iso AlgebraicGeometry.Spec_map_localization_isIso

namespace StructureSheaf

variable {R S : CommRingCat.{u}} (f : R ⟶ S) (p : PrimeSpectrum R)

/-- For an algebra `f : R →+* S`, this is the ring homomorphism `S →+* (f∗ 𝒪ₛ)ₚ` for a `p : Spec R`.
This is shown to be the localization at `p` in `is_localized_module_to_pushforward_stalk_alg_hom`.
-/
def toPushforwardStalk : S ⟶ (Spec.topMap f _* (structureSheaf S).1).stalk p :=
  StructureSheaf.toOpen S ⊤ ≫
    @TopCat.Presheaf.germ _ _ _ _ (Spec.topMap f _* (structureSheaf S).1) ⊤ ⟨p, trivial⟩
#align algebraic_geometry.structure_sheaf.to_pushforward_stalk AlgebraicGeometry.StructureSheaf.toPushforwardStalk

@[reassoc.1]
theorem toPushforwardStalk_comp :
    f ≫ StructureSheaf.toPushforwardStalk f p =
      StructureSheaf.toStalk R p ≫
        (TopCat.Presheaf.stalkFunctor _ _).map (Spec.sheafedSpaceMap f).c :=
  by
  rw [structure_sheaf.to_stalk]
  erw [category.assoc]
  rw [TopCat.Presheaf.stalkFunctor_map_germ]
  exact Spec_Γ_naturality_assoc f _
#align algebraic_geometry.structure_sheaf.to_pushforward_stalk_comp AlgebraicGeometry.StructureSheaf.toPushforwardStalk_comp

instance : Algebra R ((Spec.topMap f _* (structureSheaf S).1).stalk p) :=
  (f ≫ StructureSheaf.toPushforwardStalk f p).toAlgebra

theorem algebraMap_pushforward_stalk :
    algebraMap R ((Spec.topMap f _* (structureSheaf S).1).stalk p) =
      f ≫ StructureSheaf.toPushforwardStalk f p :=
  rfl
#align algebraic_geometry.structure_sheaf.algebra_map_pushforward_stalk AlgebraicGeometry.StructureSheaf.algebraMap_pushforward_stalk

variable (R S) [Algebra R S]

/--
This is the `alg_hom` version of `to_pushforward_stalk`, which is the map `S ⟶ (f∗ 𝒪ₛ)ₚ` for some
algebra `R ⟶ S` and some `p : Spec R`.
-/
@[simps]
def toPushforwardStalkAlgHom :
    S →ₐ[R] (Spec.topMap (algebraMap R S) _* (structureSheaf S).1).stalk p :=
  { StructureSheaf.toPushforwardStalk (algebraMap R S) p with commutes' := fun _ => rfl }
#align algebraic_geometry.structure_sheaf.to_pushforward_stalk_alg_hom AlgebraicGeometry.StructureSheaf.toPushforwardStalkAlgHom

theorem is_localized_module_toPushforwardStalkAlgHom_aux (y) :
    ∃ x : S × p.asIdeal.primeCompl, x.2 • y = toPushforwardStalkAlgHom R S p x.1 :=
  by
  obtain ⟨U, hp, s, e⟩ := TopCat.Presheaf.germ_exist _ _ y
  obtain ⟨_, ⟨r, rfl⟩, hpr : p ∈ PrimeSpectrum.basicOpen r, hrU : PrimeSpectrum.basicOpen r ≤ U⟩ :=
    PrimeSpectrum.isTopologicalBasis_basic_opens.exists_subset_of_mem_open (show p ∈ ↑U from hp) U.2
  change PrimeSpectrum.basicOpen r ≤ U at hrU
  replace e :=
    ((Spec.Top_map (algebraMap R S) _* (structure_sheaf S).1).germ_res_apply (hom_of_le hrU)
          ⟨p, hpr⟩ _).trans
      e
  set s' := (Spec.Top_map (algebraMap R S) _* (structure_sheaf S).1).map (hom_of_le hrU).op s with h
  rw [← h] at e
  clear_value s'; clear! U
  obtain ⟨⟨s, ⟨_, n, rfl⟩⟩, hsn⟩ :=
    @IsLocalization.surj _ _ _ _ _ _
      (structure_sheaf.is_localization.to_basic_open S <| algebraMap R S r) s'
  refine' ⟨⟨s, ⟨r, hpr⟩ ^ n⟩, _⟩
  rw [Submonoid.smul_def, Algebra.smul_def, algebra_map_pushforward_stalk, to_pushforward_stalk,
    comp_apply, comp_apply]
  iterate 2
    erw [←
      (Spec.Top_map (algebraMap R S) _* (structure_sheaf S).1).germ_res_apply (hom_of_le le_top)
        ⟨p, hpr⟩]
  rw [← e, ← map_mul, mul_comm]
  dsimp only [Subtype.coe_mk] at hsn
  rw [← map_pow (algebraMap R S)] at hsn
  congr 1
#align algebraic_geometry.structure_sheaf.is_localized_module_to_pushforward_stalk_alg_hom_aux AlgebraicGeometry.StructureSheaf.is_localized_module_toPushforwardStalkAlgHom_aux

instance isLocalizedModuleToPushforwardStalkAlgHom :
    IsLocalizedModule p.asIdeal.primeCompl (toPushforwardStalkAlgHom R S p).toLinearMap :=
  by
  apply IsLocalizedModule.mkOfAlgebra
  · intro x hx
    rw [algebra_map_pushforward_stalk, to_pushforward_stalk_comp, comp_apply]
    exact (IsLocalization.map_units ((structure_sheaf R).Presheaf.stalk p) ⟨x, hx⟩).map _
  · apply is_localized_module_to_pushforward_stalk_alg_hom_aux
  · intro x hx
    rw [to_pushforward_stalk_alg_hom_apply, RingHom.toFun_eq_coe, ←
      (to_pushforward_stalk (algebraMap R S) p).map_zero, to_pushforward_stalk, comp_apply,
      comp_apply, map_zero] at hx
    obtain ⟨U, hpU, i₁, i₂, e⟩ := TopCat.Presheaf.germ_eq _ _ _ _ _ _ hx
    obtain ⟨_, ⟨r, rfl⟩, hpr, hrU⟩ :=
      PrimeSpectrum.isTopologicalBasis_basic_opens.exists_subset_of_mem_open (show p ∈ U.1 from hpU)
        U.2
    change PrimeSpectrum.basicOpen r ≤ U at hrU
    apply_fun (Spec.Top_map (algebraMap R S) _* (structure_sheaf S).1).map (hom_of_le hrU).op  at e
    simp only [TopCat.Presheaf.pushforwardObj_map, functor.op_map, map_zero, ← comp_apply,
      to_open_res] at e
    have : to_open S (PrimeSpectrum.basicOpen <| algebraMap R S r) x = 0 :=
      by
      refine' Eq.trans _ e
      rfl
    have :=
      (@IsLocalization.mk'_one _ _ _ _ _ _
            (structure_sheaf.is_localization.to_basic_open S <| algebraMap R S r) x).trans
        this
    obtain ⟨⟨_, n, rfl⟩, e⟩ := (IsLocalization.mk'_eq_zero_iff _ _).mp this
    refine' ⟨⟨r, hpr⟩ ^ n, _⟩
    rw [Submonoid.smul_def, Algebra.smul_def, [anonymous], Subtype.coe_mk, map_pow]
    exact e
#align algebraic_geometry.structure_sheaf.is_localized_module_to_pushforward_stalk_alg_hom AlgebraicGeometry.StructureSheaf.isLocalizedModuleToPushforwardStalkAlgHom

end StructureSheaf

end AlgebraicGeometry


/-
Copyright (c) 2015 Haitao Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Haitao Zhang

Cardinality for finite types.
-/
import .basic data.list data.finset.card
open eq.ops nat function list finset

namespace fintype

definition card [reducible] (A : Type) [finA : fintype A] := finset.card (@finset.univ A _)

lemma card_eq_card_image_of_inj
      {A : Type} [finA : fintype A] [deceqA : decidable_eq A]
      {B : Type} [finB : fintype B] [deceqB : decidable_eq B]
      {f : A → B} :
  injective f → finset.card (image f univ) = card A :=
assume Pinj,
card_image_eq_of_inj_on (to_set_univ⁻¹ ▸ (iff.mp !set.injective_iff_inj_on_univ Pinj))

-- General version of the pigeonhole principle. See also data.less_than.
lemma card_le_of_inj (A : Type) [finA : fintype A] [deceqA : decidable_eq A]
                     (B : Type) [finB : fintype B] [deceqB : decidable_eq B] :
   (∃ f : A → B, injective f) → card A ≤ card B :=
assume Pex, obtain f Pinj, from Pex,
have Pinj_on_univ : _, from iff.mp !set.injective_iff_inj_on_univ Pinj,
have Pinj_ts : set.inj_on f (ts univ), from to_set_univ⁻¹ ▸ Pinj_on_univ,
have Psub : (image f univ) ⊆ univ,     from !subset_univ,
finset.card_le_of_inj_on univ univ (exists.intro f (and.intro Pinj_ts Psub))

-- used to prove that inj ∧ eq card => surj
lemma univ_of_card_eq_univ {A : Type} [finA : fintype A] [deceqA : decidable_eq A] {s : finset A} :
  finset.card s = card A → s = univ :=
assume Pcardeq, ext (take a,
have D : decidable (a ∈ s), from decidable_mem a s, begin
apply iff.intro,
  intro ain, apply mem_univ,
  intro ain, cases D with Pin Pnin,
    exact Pin,
    have Pplus1 : finset.card (insert a s) = finset.card s + 1,
      from card_insert_of_not_mem Pnin,
    rewrite Pcardeq at Pplus1,
    have Ple : finset.card (insert a s) ≤ card A,
      begin apply card_le_card_of_subset, apply subset_univ end,
    rewrite Pplus1 at Ple,
    exact false.elim (not_succ_le_self Ple)
end)

end fintype


lemma zeqz' : 0 = 0 :=
begin
    apply rfl,
end

#check tt
#check true

#check true.intro

lemma t' : true := true.intro
theorem bad : true := true.intro

lemma f : tt = true := rfl -- ??
lemma f' : tt = tt := rfl
def g_ : true := bool.tt.inj f'
lemma g : tt = true := eq.refl true -- ??

#check false.elim

axiom fff : false
theorem wtf : true = false := false.elim fff
-- theorem wtf_ : 1 = tt := false.elim fff

lemma t1 : 5 = 1 + 4 := eq.refl 5
lemma t2 : "Strike" = "S" ++ "trike" := rfl
theorem t1t2 : 5 = 1 + 4 ∧ "Strike" = "S" ++ "trike" := and.intro t1 t2

theorem alt : 5 = 1 + 4 ∧ "Strike" = "S" ++ "trike" :=
begin
    apply and.intro,
    exact (eq.refl 5),
    exact (eq.refl "Strike"),
end

theorem alt' : 5 = 1 + 4 ∧ "Strike" = "S" ++ "trike" :=
begin
    have X := (eq.refl 5),
    have Y := (eq.refl "Strike"),
    exact and.intro X Y
end

def P : Prop := 0 = 0
def Q : Prop := 1 = 1
lemma pfP : P := eq.refl 0
lemma pfQ : Q := eq.refl 1
theorem pf_PQ : P ∧ Q := and.intro pfP pfQ
theorem pfQ' : Q := and.elim_right pf_PQ

theorem pfQaP : Q ∧ P :=
  and.intro
    (and.elim_right pf_PQ)
    (and.elim_left pf_PQ)

theorem pfQaP' : Q ∧ P :=
begin
    have X := (and.elim_right pf_PQ),
    have Y := (and.elim_left pf_PQ),
    apply and.intro X Y,
end

theorem and_com {P Q : Prop} (PQ : P ∧ Q) : Q ∧ P := and.intro
    (and.elim_right PQ)
    (and.elim_left PQ)

theorem pfQaP'' : Q ∧ P := and_com pf_PQ

theorem tt11 : 1 = 1 ∧ tt = tt :=
begin
    apply and.intro,
    exact (eq.refl 1),
    exact (eq.refl tt),
end

theorem q11tt : tt = tt ∧ 1 = 1 := and_com tt11


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yaël Dillies, Patrick Stevens
-/
import algebra.order.field
import data.nat.cast

/-!
# Cast of naturals into fields

This file concerns the canonical homomorphism `ℕ → F`, where `F` is a field.

## Main results

 * `nat.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n`
 * `nat.cast_div_le`: in all cases, `↑(m / n) ≤ ↑m / ↑ n`
-/

namespace nat

variables {α : Type*}

@[simp] theorem cast_div [field α] {m n : ℕ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) :
  ((m / n : ℕ) : α) = m / n :=
begin
  rcases n_dvd with ⟨k, rfl⟩,
  have : n ≠ 0, {rintro rfl, simpa using n_nonzero},
  rw [nat.mul_div_cancel_left _ this.bot_lt, cast_mul, mul_div_cancel_left _ n_nonzero],
end

section linear_ordered_field
variables [linear_ordered_field α]

/-- Natural division is always less than division in the field. -/
lemma cast_div_le {m n : ℕ} : ((m / n : ℕ) : α) ≤ m / n :=
begin
  cases n,
  { rw [cast_zero, div_zero, nat.div_zero, cast_zero] },
  rwa [le_div_iff, ←nat.cast_mul],
  exact nat.cast_le.2 (nat.div_mul_le_self m n.succ),
  { exact nat.cast_pos.2 n.succ_pos }
end

lemma inv_pos_of_nat {n : ℕ} : 0 < ((n : α) + 1)⁻¹ :=
inv_pos.2 $ add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one

lemma one_div_pos_of_nat {n : ℕ} : 0 < 1 / ((n : α) + 1) :=
by { rw one_div, exact inv_pos_of_nat }

lemma one_div_le_one_div {n m : ℕ} (h : n ≤ m) : 1 / ((m : α) + 1) ≤ 1 / ((n : α) + 1) :=
by { refine one_div_le_one_div_of_le _ _, exact nat.cast_add_one_pos _, simpa }

lemma one_div_lt_one_div {n m : ℕ} (h : n < m) : 1 / ((m : α) + 1) < 1 / ((n : α) + 1) :=
by { refine one_div_lt_one_div_of_lt _ _, exact nat.cast_add_one_pos _, simpa }

end linear_ordered_field

end nat


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne
-/
import analysis.asymptotics.theta
import analysis.complex.basic
import analysis.specific_limits.normed
import data.complex.exponential

/-!
# Complex and real exponential

In this file we prove continuity of `complex.exp` and `real.exp`. We also prove a few facts about
limits of `real.exp` at infinity.

## Tags

exp
-/

noncomputable theory

open finset filter metric asymptotics set function
open_locale classical topology

namespace complex

variables {z y x : ℝ}

lemma exp_bound_sq (x z : ℂ) (hz : ‖z‖ ≤ 1) :
  ‖exp (x + z) - exp x - z • exp x‖ ≤ ‖exp x‖ * ‖z‖ ^ 2 :=
calc ‖exp (x + z) - exp x - z * exp x‖
    = ‖exp x * (exp z - 1 - z)‖ : by { congr, rw [exp_add], ring }
... = ‖exp x‖ * ‖exp z - 1 - z‖ : norm_mul _ _
... ≤ ‖exp x‖ * ‖z‖^2 : mul_le_mul_of_nonneg_left (abs_exp_sub_one_sub_id_le hz) (norm_nonneg _)

lemma locally_lipschitz_exp {r : ℝ} (hr_nonneg : 0 ≤ r) (hr_le : r ≤ 1) (x y : ℂ)
  (hyx : ‖y - x‖ < r) :
  ‖exp y - exp x‖ ≤ (1 + r) * ‖exp x‖ * ‖y - x‖ :=
begin
  have hy_eq : y = x + (y - x), by abel,
  have hyx_sq_le : ‖y - x‖ ^ 2 ≤ r * ‖y - x‖,
  { rw pow_two,
    exact mul_le_mul hyx.le le_rfl (norm_nonneg _) hr_nonneg, },
  have h_sq : ∀ z, ‖z‖ ≤ 1 → ‖exp (x + z) - exp x‖ ≤ ‖z‖ * ‖exp x‖ + ‖exp x‖ * ‖z‖ ^ 2,
  { intros z hz,
    have : ‖exp (x + z) - exp x - z • exp x‖ ≤ ‖exp x‖ * ‖z‖ ^ 2, from exp_bound_sq x z hz,
    rw [← sub_le_iff_le_add',  ← norm_smul z],
    exact (norm_sub_norm_le _ _).trans this, },
  calc ‖exp y - exp x‖ = ‖exp (x + (y - x)) - exp x‖ : by nth_rewrite 0 hy_eq
  ... ≤ ‖y - x‖ * ‖exp x‖ + ‖exp x‖ * ‖y - x‖ ^ 2 : h_sq (y - x) (hyx.le.trans hr_le)
  ... ≤ ‖y - x‖ * ‖exp x‖ + ‖exp x‖ * (r * ‖y - x‖) :
    add_le_add_left (mul_le_mul le_rfl hyx_sq_le (sq_nonneg _) (norm_nonneg _)) _
  ... = (1 + r) * ‖exp x‖ * ‖y - x‖ : by ring,
end

@[continuity] lemma continuous_exp : continuous exp :=
continuous_iff_continuous_at.mpr $
  λ x, continuous_at_of_locally_lipschitz zero_lt_one (2 * ‖exp x‖)
    (locally_lipschitz_exp zero_le_one le_rfl x)

lemma continuous_on_exp {s : set ℂ} : continuous_on exp s :=
continuous_exp.continuous_on

end complex

section complex_continuous_exp_comp

variable {α : Type*}

open complex

lemma filter.tendsto.cexp {l : filter α} {f : α → ℂ} {z : ℂ} (hf : tendsto f l (𝓝 z)) :
  tendsto (λ x, exp (f x)) l (𝓝 (exp z)) :=
(continuous_exp.tendsto _).comp hf

variables [topological_space α] {f : α → ℂ} {s : set α} {x : α}

lemma continuous_within_at.cexp (h : continuous_within_at f s x) :
  continuous_within_at (λ y, exp (f y)) s x :=
h.cexp

lemma continuous_at.cexp (h : continuous_at f x) : continuous_at (λ y, exp (f y)) x :=
h.cexp

lemma continuous_on.cexp (h : continuous_on f s) : continuous_on (λ y, exp (f y)) s :=
λ x hx, (h x hx).cexp

lemma continuous.cexp (h : continuous f) : continuous (λ y, exp (f y)) :=
continuous_iff_continuous_at.2 $ λ x, h.continuous_at.cexp

end complex_continuous_exp_comp

namespace real

@[continuity] lemma continuous_exp : continuous exp :=
complex.continuous_re.comp complex.continuous_of_real.cexp

lemma continuous_on_exp {s : set ℝ} : continuous_on exp s :=
continuous_exp.continuous_on

end real

section real_continuous_exp_comp

variable {α : Type*}

open real

lemma filter.tendsto.exp {l : filter α} {f : α → ℝ} {z : ℝ} (hf : tendsto f l (𝓝 z)) :
  tendsto (λ x, exp (f x)) l (𝓝 (exp z)) :=
(continuous_exp.tendsto _).comp hf

variables [topological_space α] {f : α → ℝ} {s : set α} {x : α}

lemma continuous_within_at.exp (h : continuous_within_at f s x) :
  continuous_within_at (λ y, exp (f y)) s x :=
h.exp

lemma continuous_at.exp (h : continuous_at f x) : continuous_at (λ y, exp (f y)) x :=
h.exp

lemma continuous_on.exp (h : continuous_on f s) : continuous_on (λ y, exp (f y)) s :=
λ x hx, (h x hx).exp

lemma continuous.exp (h : continuous f) : continuous (λ y, exp (f y)) :=
continuous_iff_continuous_at.2 $ λ x, h.continuous_at.exp

end real_continuous_exp_comp

namespace real

variables {α : Type*} {x y z : ℝ} {l : filter α}

lemma exp_half (x : ℝ) : exp (x / 2) = sqrt (exp x) :=
by rw [eq_comm, sqrt_eq_iff_sq_eq, sq, ← exp_add, add_halves]; exact (exp_pos _).le

/-- The real exponential function tends to `+∞` at `+∞`. -/
lemma tendsto_exp_at_top : tendsto exp at_top at_top :=
begin
  have A : tendsto (λx:ℝ, x + 1) at_top at_top :=
    tendsto_at_top_add_const_right at_top 1 tendsto_id,
  have B : ∀ᶠ x in at_top, x + 1 ≤ exp x :=
    eventually_at_top.2 ⟨0, λx hx, add_one_le_exp x⟩,
  exact tendsto_at_top_mono' at_top B A
end

/-- The real exponential function tends to `0` at `-∞` or, equivalently, `exp(-x)` tends to `0`
at `+∞` -/
lemma tendsto_exp_neg_at_top_nhds_0 : tendsto (λx, exp (-x)) at_top (𝓝 0) :=
(tendsto_inv_at_top_zero.comp tendsto_exp_at_top).congr (λx, (exp_neg x).symm)

/-- The real exponential function tends to `1` at `0`. -/
lemma tendsto_exp_nhds_0_nhds_1 : tendsto exp (𝓝 0) (𝓝 1) :=
by { convert continuous_exp.tendsto 0, simp }

lemma tendsto_exp_at_bot : tendsto exp at_bot (𝓝 0) :=
(tendsto_exp_neg_at_top_nhds_0.comp tendsto_neg_at_bot_at_top).congr $
  λ x, congr_arg exp $ neg_neg x

lemma tendsto_exp_at_bot_nhds_within : tendsto exp at_bot (𝓝[>] 0) :=
tendsto_inf.2 ⟨tendsto_exp_at_bot, tendsto_principal.2 $ eventually_of_forall exp_pos⟩

@[simp] lemma is_bounded_under_ge_exp_comp (l : filter α) (f : α → ℝ) :
  is_bounded_under (≥) l (λ x, exp (f x)) :=
is_bounded_under_of ⟨0, λ x, (exp_pos _).le⟩

@[simp] lemma is_bounded_under_le_exp_comp {f : α → ℝ} :
  is_bounded_under (≤) l (λ x, exp (f x)) ↔ is_bounded_under (≤) l f :=
exp_monotone.is_bounded_under_le_comp tendsto_exp_at_top

/-- The function `exp(x)/x^n` tends to `+∞` at `+∞`, for any natural number `n` -/
lemma tendsto_exp_div_pow_at_top (n : ℕ) : tendsto (λx, exp x / x^n) at_top at_top :=
begin
  refine (at_top_basis_Ioi.tendsto_iff (at_top_basis' 1)).2 (λ C hC₁, _),
  have hC₀ : 0 < C, from zero_lt_one.trans_le hC₁,
  have : 0 < (exp 1 * C)⁻¹ := inv_pos.2 (mul_pos (exp_pos _) hC₀),
  obtain ⟨N, hN⟩ : ∃ N, ∀ k ≥ N, (↑k ^ n : ℝ) / exp 1 ^ k < (exp 1 * C)⁻¹ :=
    eventually_at_top.1 ((tendsto_pow_const_div_const_pow_of_one_lt n
      (one_lt_exp_iff.2 zero_lt_one)).eventually (gt_mem_nhds this)),
  simp only [← exp_nat_mul, mul_one, div_lt_iff, exp_pos, ← div_eq_inv_mul] at hN,
  refine ⟨N, trivial, λ x hx, _⟩, rw set.mem_Ioi at hx,
  have hx₀ : 0 < x, from N.cast_nonneg.trans_lt hx,
  rw [set.mem_Ici, le_div_iff (pow_pos hx₀ _), ← le_div_iff' hC₀],
  calc x ^ n ≤ ⌈x⌉₊ ^ n : pow_le_pow_of_le_left hx₀.le (nat.le_ceil _) _
  ... ≤ exp ⌈x⌉₊ / (exp 1 * C) : (hN _ (nat.lt_ceil.2 hx).le).le
  ... ≤ exp (x + 1) / (exp 1 * C) : div_le_div_of_le (mul_pos (exp_pos _) hC₀).le
    (exp_le_exp.2 $ (nat.ceil_lt_add_one hx₀.le).le)
  ... = exp x / C : by rw [add_comm, exp_add, mul_div_mul_left _ _ (exp_pos _).ne']
end

/-- The function `x^n * exp(-x)` tends to `0` at `+∞`, for any natural number `n`. -/
lemma tendsto_pow_mul_exp_neg_at_top_nhds_0 (n : ℕ) : tendsto (λx, x^n * exp (-x)) at_top (𝓝 0) :=
(tendsto_inv_at_top_zero.comp (tendsto_exp_div_pow_at_top n)).congr $ λx,
  by rw [comp_app, inv_eq_one_div, div_div_eq_mul_div, one_mul, div_eq_mul_inv, exp_neg]

/-- The function `(b * exp x + c) / (x ^ n)` tends to `+∞` at `+∞`, for any natural number
`n` and any real numbers `b` and `c` such that `b` is positive. -/
lemma tendsto_mul_exp_add_div_pow_at_top (b c : ℝ) (n : ℕ) (hb : 0 < b) :
  tendsto (λ x, (b * exp x + c) / x ^ n) at_top at_top :=
begin
  rcases eq_or_ne n 0 with rfl | hn,
  { simp only [pow_zero, div_one],
    exact (tendsto_exp_at_top.const_mul_at_top hb).at_top_add tendsto_const_nhds },
  simp only [add_div, mul_div_assoc],
  exact ((tendsto_exp_div_pow_at_top n).const_mul_at_top hb).at_top_add
    (tendsto_const_nhds.div_at_top (tendsto_pow_at_top hn))
end

/-- The function `(x ^ n) / (b * exp x + c)` tends to `0` at `+∞`, for any natural number
`n` and any real numbers `b` and `c` such that `b` is nonzero. -/
lemma tendsto_div_pow_mul_exp_add_at_top (b c : ℝ) (n : ℕ) (hb : 0 ≠ b) :
  tendsto (λ x, x ^ n / (b * exp x + c)) at_top (𝓝 0) :=
begin
  have H : ∀ d e, 0 < d → tendsto (λ (x:ℝ), x^n / (d * (exp x) + e)) at_top (𝓝 0),
  { intros b' c' h,
    convert (tendsto_mul_exp_add_div_pow_at_top b' c' n h).inv_tendsto_at_top ,
    ext x,
    simpa only [pi.inv_apply] using (inv_div _ _).symm },
  cases lt_or_gt_of_ne hb,
  { exact H b c h },
  { convert (H (-b) (-c) (neg_pos.mpr h)).neg,
    { ext x,
      field_simp,
      rw [← neg_add (b * exp x) c, neg_div_neg_eq] },
    { exact neg_zero.symm } },
end

/-- `real.exp` as an order isomorphism between `ℝ` and `(0, +∞)`. -/
def exp_order_iso : ℝ ≃o Ioi (0 : ℝ) :=
strict_mono.order_iso_of_surjective _ (exp_strict_mono.cod_restrict exp_pos) $
  (continuous_exp.subtype_mk _).surjective
    (by simp only [tendsto_Ioi_at_top, subtype.coe_mk, tendsto_exp_at_top])
    (by simp [tendsto_exp_at_bot_nhds_within])

@[simp] lemma coe_exp_order_iso_apply (x : ℝ) : (exp_order_iso x : ℝ) = exp x := rfl

@[simp] lemma coe_comp_exp_order_iso : coe ∘ exp_order_iso = exp := rfl

@[simp] lemma range_exp : range exp = Ioi 0 :=
by rw [← coe_comp_exp_order_iso, range_comp, exp_order_iso.range_eq, image_univ, subtype.range_coe]

@[simp] lemma map_exp_at_top : map exp at_top = at_top :=
by rw [← coe_comp_exp_order_iso, ← filter.map_map, order_iso.map_at_top, map_coe_Ioi_at_top]

@[simp] lemma comap_exp_at_top : comap exp at_top = at_top :=
by rw [← map_exp_at_top, comap_map exp_injective, map_exp_at_top]

@[simp] lemma tendsto_exp_comp_at_top {f : α → ℝ} :
  tendsto (λ x, exp (f x)) l at_top ↔ tendsto f l at_top :=
by rw [← tendsto_comap_iff, comap_exp_at_top]

lemma tendsto_comp_exp_at_top {f : ℝ → α} :
  tendsto (λ x, f (exp x)) at_top l ↔ tendsto f at_top l :=
by rw [← tendsto_map'_iff, map_exp_at_top]

@[simp] lemma map_exp_at_bot : map exp at_bot = 𝓝[>] 0 :=
by rw [← coe_comp_exp_order_iso, ← filter.map_map, exp_order_iso.map_at_bot, ← map_coe_Ioi_at_bot]

@[simp] lemma comap_exp_nhds_within_Ioi_zero : comap exp (𝓝[>] 0) = at_bot :=
by rw [← map_exp_at_bot, comap_map exp_injective]

lemma tendsto_comp_exp_at_bot {f : ℝ → α} :
  tendsto (λ x, f (exp x)) at_bot l ↔ tendsto f (𝓝[>] 0) l :=
by rw [← map_exp_at_bot, tendsto_map'_iff]

@[simp] lemma comap_exp_nhds_zero : comap exp (𝓝 0) = at_bot :=
(comap_nhds_within_range exp 0).symm.trans $ by simp

@[simp] lemma tendsto_exp_comp_nhds_zero {f : α → ℝ} :
  tendsto (λ x, exp (f x)) l (𝓝 0) ↔ tendsto f l at_bot :=
by rw [← tendsto_comap_iff, comap_exp_nhds_zero]

lemma is_o_pow_exp_at_top {n : ℕ} : (λ x, x^n) =o[at_top] real.exp :=
by simpa [is_o_iff_tendsto (λ x hx, ((exp_pos x).ne' hx).elim)]
  using tendsto_div_pow_mul_exp_add_at_top 1 0 n zero_ne_one

@[simp] lemma is_O_exp_comp_exp_comp {f g : α → ℝ} :
  (λ x, exp (f x)) =O[l] (λ x, exp (g x)) ↔ is_bounded_under (≤) l (f - g) :=
iff.trans (is_O_iff_is_bounded_under_le_div $ eventually_of_forall $ λ x, exp_ne_zero _) $
  by simp only [norm_eq_abs, abs_exp, ← exp_sub, is_bounded_under_le_exp_comp, pi.sub_def]

@[simp] lemma is_Theta_exp_comp_exp_comp {f g : α → ℝ} :
  (λ x, exp (f x)) =Θ[l] (λ x, exp (g x)) ↔ is_bounded_under (≤) l (λ x, |f x - g x|) :=
by simp only [is_bounded_under_le_abs, ← is_bounded_under_le_neg, neg_sub, is_Theta,
  is_O_exp_comp_exp_comp, pi.sub_def]

@[simp] lemma is_o_exp_comp_exp_comp {f g : α → ℝ} :
  (λ x, exp (f x)) =o[l] (λ x, exp (g x)) ↔ tendsto (λ x, g x - f x) l at_top :=
by simp only [is_o_iff_tendsto, exp_ne_zero, ← exp_sub, ← tendsto_neg_at_top_iff, false_implies_iff,
  implies_true_iff, tendsto_exp_comp_nhds_zero, neg_sub]

@[simp] lemma is_o_one_exp_comp {f : α → ℝ} :
  (λ x, 1 : α → ℝ) =o[l] (λ x, exp (f x)) ↔ tendsto f l at_top :=
by simp only [← exp_zero, is_o_exp_comp_exp_comp, sub_zero]

/-- `real.exp (f x)` is bounded away from zero along a filter if and only if this filter is bounded
from below under `f`. -/
@[simp] lemma is_O_one_exp_comp {f : α → ℝ} :
  (λ x, 1 : α → ℝ) =O[l] (λ x, exp (f x)) ↔ is_bounded_under (≥) l f :=
by simp only [← exp_zero, is_O_exp_comp_exp_comp, pi.sub_def, zero_sub, is_bounded_under_le_neg]

/-- `real.exp (f x)` is bounded away from zero along a filter if and only if this filter is bounded
from below under `f`. -/
lemma is_O_exp_comp_one {f : α → ℝ} :
  (λ x, exp (f x)) =O[l] (λ x, 1 : α → ℝ) ↔ is_bounded_under (≤) l f :=
by simp only [is_O_one_iff, norm_eq_abs, abs_exp, is_bounded_under_le_exp_comp]

/-- `real.exp (f x)` is bounded away from zero and infinity along a filter `l` if and only if
`|f x|` is bounded from above along this filter. -/
@[simp] lemma is_Theta_exp_comp_one {f : α → ℝ} :
  (λ x, exp (f x)) =Θ[l] (λ x, 1 : α → ℝ) ↔ is_bounded_under (≤) l (λ x, |f x|) :=
by simp only [← exp_zero, is_Theta_exp_comp_exp_comp, sub_zero]

end real

namespace complex

lemma comap_exp_comap_abs_at_top : comap exp (comap abs at_top) = comap re at_top :=
calc comap exp (comap abs at_top) = comap re (comap real.exp at_top) :
  by simp only [comap_comap, (∘), abs_exp]
... = comap re at_top : by rw [real.comap_exp_at_top]

lemma comap_exp_nhds_zero : comap exp (𝓝 0) = comap re at_bot :=
calc comap exp (𝓝 0) = comap re (comap real.exp (𝓝 0)) :
  by simp only [comap_comap, ← comap_abs_nhds_zero, (∘), abs_exp]
... = comap re at_bot : by rw [real.comap_exp_nhds_zero]

lemma comap_exp_nhds_within_zero : comap exp (𝓝[≠] 0) = comap re at_bot :=
have exp ⁻¹' {0}ᶜ = univ, from eq_univ_of_forall exp_ne_zero,
by simp [nhds_within, comap_exp_nhds_zero, this]

lemma tendsto_exp_nhds_zero_iff {α : Type*} {l : filter α} {f : α → ℂ} :
  tendsto (λ x, exp (f x)) l (𝓝 0) ↔ tendsto (λ x, re (f x)) l at_bot :=
by rw [← tendsto_comap_iff, comap_exp_nhds_zero, tendsto_comap_iff]

/-- `complex.abs (complex.exp z) → ∞` as `complex.re z → ∞`. TODO: use `bornology.cobounded`. -/
lemma tendsto_exp_comap_re_at_top : tendsto exp (comap re at_top) (comap abs at_top) :=
comap_exp_comap_abs_at_top ▸ tendsto_comap

/-- `complex.exp z → 0` as `complex.re z → -∞`.-/
lemma tendsto_exp_comap_re_at_bot : tendsto exp (comap re at_bot) (𝓝 0) :=
comap_exp_nhds_zero ▸ tendsto_comap

lemma tendsto_exp_comap_re_at_bot_nhds_within : tendsto exp (comap re at_bot) (𝓝[≠] 0) :=
comap_exp_nhds_within_zero ▸ tendsto_comap

end complex


/-
This file is intended for Lean beginners. The goal is to demonstrate what it feels like to prove
things using Lean and mathlib. Complicated definitions and theory building are not covered.
Everything is covered again more slowly and with exercises in the next files.
-/

-- We want real numbers and their basic properties
import data.real.basic

-- We want to be able to define functions using the law of excluded middle
noncomputable theory
open_locale classical

/-
Our first goal is to define the set of upper bounds of a set of real numbers.
This is already defined in mathlib (in a more general context), but we repeat
it for the sake of exposition. Right-click "upper_bounds" below to get offered
to jump to mathlib's version
-/
#check upper_bounds

/-- The set of upper bounds of a set of real numbers ℝ -/
def up_bounds (A : set ℝ) := { x : ℝ | ∀ a ∈ A, a ≤ x}

/-- Predicate `is_max a A` means `a` is a maximum of `A` -/
def is_max (a : ℝ) (A : set ℝ) := a ∈ A ∧ a ∈ up_bounds A

/-
In the above definition, the symbol `∧` means "and". We also see the most
visible difference between set theoretic foundations and type theoretic ones
(used by almost all proof assistants). In set theory, everything is a set, and the
only relation you get from foundations are `=` and `∈`. In type theory, there is
a meta-theoretic relation of "typing": `a : ℝ` reads "`a` is a real number" or,
more precisely, "the type of `a` is `ℝ`". Here "meta-theoretic" means this is not a
statement you can prove or disprove inside the theory, it's a fact that is true or
not. Here we impose this fact, in other circumstances, it would be checked by the
Lean kernel.
By contrast, `a ∈ A` is a statement inside the theory. Here it's part of the
definition, in other circumstances it could be something proven inside Lean.
-/

/- For illustrative purposes, we now define an infix version of the above predicate.
It will allow us to write `a is_a_max_of A`, which is closer to a sentence.
-/
infix `is_a_max_of`:55 := is_max

/-
Let's prove something now! A set of real numbers has at most one maximum. Here
everything left of the final `:` is introducing the objects and assumption. The equality
`x = y` right of the colon is the conclusion.
-/
example (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) : x = y :=
begin
  cases hx with x_in x_up,
  cases hy with y_in y_up,
  specialize x_up y y_in,
  specialize y_up x x_in,
  linarith
end

lemma unique_max (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) : x = y :=
begin
  -- We first break our assumptions in their two constituent pieces.
  -- We are free to choose the name following `with`
  cases hx with x_in x_up,
  cases hy with y_in y_up,
  -- Assumption `x_up` means x isn't less than elements of A, let's apply this to y
  specialize x_up y,
  -- Assumption `x_up` now needs the information that `y` is indeed in `A`.
  specialize x_up y_in,
  -- Let's do this quicker with roles swapped
  specialize y_up x x_in,
  -- We explained to Lean the idea of this proof.
  -- Now we know `x ≤ y` and `y ≤ x`, and Lean shouldn't need more help.
  -- `linarith` proves equalities and inequalities that follow linearly from
  -- the assumption we have.
  linarith,
end

/-
The above proof is too long, even if you remove comments. We don't really need the
unpacking steps at the beginning; we can access both parts of the assumption
`hx : x is_a_max_of A` using shortcuts `h.1` and `h.2`. We can also improve
readability without assistance from the tactic state display, clearly announcing
intermediate goals using `have`. This way we get to the following version of the
same proof.
-/

example (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) : x = y :=
begin
  have : x ≤ y, from hy.2 x hx.1,
  have : y ≤ x, from hx.2 y hy.1,
  linarith,
end

example (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) : x = y :=
begin
  have : x ≤ y, from hy.2 x hx.1,
  have : y ≤ x, from hx.2 y hy.1,
  linarith,
end

/-
Notice how mathematics based on type theory treats the assumption
`∀ a ∈ A, a ≤ y` as a function turning an element `a` of `A` into the statement
`a ≤ y`. More precisely, this assumption is the abbreviation of
`∀ a : ℝ, a ∈ A → a ≤ y`. The expression `hy.2 x` appearing in the above proof
is then the statement `x ∈ A → x ≤ y`, which itself is a function turning a
statement `x ∈ A` into `x ≤ y` so that the full expression `hy.2 x hx.1` is
indeed a proof of `x ≤ y`.

One could argue a three-line-long proof of this lemma is still two lines too long.
This is debatable, but mathlib's style is to write very short proofs for trivial
lemmas. Those proofs are not easy to read but they are meant to indicate that the
proof is probably not worth reading.

In order to reach this stage, we need to know what `linarith` did for us. It invoked
the lemma `le_antisymm` which says: `x ≤ y → y ≤ x → x = y`. This arrow, which
is used both for function and implication, is right associative. So the statement is
`x ≤ y → (y ≤ x → x = y)` which reads: I will send a proof `p` of `x ≤ y` to a function
sending a proof `q'` of `y ≤ x` to a proof of `x = y`. Hence `le_antisymm p q'` is a
proof of `x = y`.

Using this we can get our one-line proof:
-/

example (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) : x = y :=
le_antisymm (hy.2 x hx.1) (hx.2 y hy.1)

/-
Such a proof is called a proof term (or a "term mode" proof). Notice it has no `begin`
and `end`. It is directly the kind of low level proof that the Lean kernel is
consuming. Commands like `cases`, `specialize` or `linarith` are called tactics, they
help users constructing proof terms that could be very tedious to write directly.
The most efficient proof style combines tactics with proof terms like our previous
`have : x ≤ y, from hy.2 x hx.1` where `hy.2 x hx.1` is a proof term embeded inside
a tactic mode proof.

In the remaining of this file, we'll be characterizing infima of sets of real numbers
in term of sequences.
-/

/-- The set of lower bounds of a set of real numbers ℝ -/
def low_bounds (A : set ℝ) := { x : ℝ | ∀ a ∈ A, x ≤ a}

/-
We now define `a` is an infimum of `A`. Again there is already a more general version
in mathlib.
-/
def is_inf (x : ℝ) (A : set ℝ) := x is_a_max_of (low_bounds A)
infix `is_an_inf_of`:55 := is_inf

/-
We need to prove that any number which is greater than the infimum of A is greater
than some element of A.
-/
example {A : set ℝ} {x : ℝ} (hx : x is_an_inf_of A) :
  ∀ y, x < y → ∃ a ∈ A, a < y :=
begin
  intro y,
  contrapose,
  push_neg,
  intro h,
  exact hx.2 y h,
end

lemma inf_lt {A : set ℝ} {x : ℝ} (hx : x is_an_inf_of A) :
  ∀ y, x < y → ∃ a ∈ A, a < y :=
begin
  -- Let `y` be any real number.
  intro y,
  -- Let's prove the contrapositive
  contrapose,
  -- The symbol `¬` means negation. Let's ask Lean to rewrite the goal without negation,
  -- pushing negation through quantifiers and inequalities
  push_neg,
  -- Let's assume the premise, calling the assumption `h`
  intro h,
  -- `h` is exactly saying `y` is a lower bound of `A` so the second part of
  -- the infimum assumption `hx` applied to `y` and `h` is exactly what we want.
  exact hx.2 y h
end

/-
In the above proof, the sequence `contrapose, push_neg` is so common that it can be
abbreviated to `contrapose!`. With these commands, we enter the gray zone between
proof checking and proof finding. Practical computer proof checking crucially needs
the computer to handle tedious proof steps. In the next proof, we'll start using
`linarith` a bit more seriously, going one step further into automation.

Our next real goal is to prove inequalities for limits of sequences. We extract the
following lemma: if `y ≤ x + ε` for all positive `ε` then `y ≤ x`.
-/

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split; linarith,
end

lemma le_of_le_add_eps {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  -- Let's prove the contrapositive, asking Lean to push negations right away.
  contrapose!,
  -- Assume `h : x < y`.
  intro h,
  -- We need to find `ε` such that `ε` is positive and `x + ε < y`.
  -- Let's use `(y-x)/2`
  use ((y-x)/2),
  -- we now have two properties to prove. Let's do both in turn, using `linarith`
  split,
  linarith,
  linarith,
end

/-
Note how `linarith` was used for both sub-goals at the end of the above proof.
We could have shortened that using the semi-colon combinator instead of comma,
writing `split ; linarith`.

Next we will study a compressed version of that proof:
-/

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  from λ h, ⟨(y-x)/2, by linarith, by linarith⟩,
end

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  exact assume h, ⟨(y-x)/2, by linarith, by linarith⟩,
end

/-
The angle brackets `⟨` and `⟩` introduce compound data or proofs. A proof
of a `∃ z, P z` statemement is composed of a witness `z₀` and a proof `h` of
`P z₀`. The compound is denoted by `⟨z₀, h⟩`. In the example above, the predicate is
itself compound, it is a conjunction `P z ∧ Q z`. So the proof term should read
`⟨z₀, ⟨h₁, h₂⟩⟩` where `h₁` (resp. `h₂`) is a proof of `P z₀` (resp. `Q z₀`).
But these so-called "anonymous constructor" brackets are right-associative, so we can
get rid of the nested brackets.

The keyword `by` introduces tactic mode inside term mode, it is a shorter version
of the `begin`/`end` pair, which is more convenient for single tactic blocks.
In this example, `begin` enters tactic mode, `exact` leaves it, `by` re-enters it.

Going all the way to a proof term would make the proof much longer, because we
crucially use automation with `contrapose!` and `linarith`. We can still get a one-line
proof using curly braces to gather several tactic invocations, and the `by` abbreviation
instead of `begin`/`end`:
-/

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
by { contrapose!, exact assume h, ⟨(y-x)/2, by linarith, by linarith⟩ }

/-
One could argue that the above proof is a bit too terse, and we are relying too much
on linarith. Let's have more `linarith` calls for smaller steps. For the sake
of (tiny) variation, we will also assume the premise and argue by contradiction
instead of contraposing.
-/
example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  intro h,
  by_contradiction H,
  push_neg at H,
  have := calc
    y   ≤ x + (y-x)/2 : h _ (by linarith)
    ... = x/2 + y/2   : by ring
    ... < y           : by linarith,
  linarith,
end

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  intro h,
  -- Assume the conclusion is false, and call this assumption H.
  by_contradiction H,
  push_neg at H,
  -- Now let's compute.
  have key := calc
  -- Each line must end with a colon followed by a proof term
  -- We want to specialize our assumption `h` to `ε = (y-x)/2` but this is long to
  -- type, so let's put a hole `_` that Lean will fill in by comparing the
  -- statement we want to prove and our proof term with a hole. As usual,
  -- positivity of `(y-x)/2` is proved by `linarith`
    y   ≤ x + (y-x)/2 : h _ (by linarith)
    ... = x/2 + y/2   : by ring
    ... < y           : by linarith,
  -- our key now says `y < y` (notice how the sequence `≤`, `=`, `<` was correctly
  -- merged into a `<`). Let `linarith` find the desired contradiction now.
  linarith,
  -- alternatively, we could have provided the proof term
  -- `exact lt_irrefl y key`
end

/-
Now we are ready for some analysis. Let's set up notation for absolute value
-/

local notation `|`x`|` := abs x

/-
And let's define convergence of sequences of real numbers (of course there is
a much more general definition in mathlib).
-/

/-- The sequence `u` tends to `l` -/
def limit (u : ℕ → ℝ) (l : ℝ) := ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

/-
In the above definition, `u n` denotes the n-th term of the sequence. We can
add parentheses to get `u(n)` but we try to avoid parentheses because they pile up
very quickly
-/
example {x y : ℝ} {u : ℕ → ℝ} (hu : limit u x) (ineq : ∀ n, y ≤ u n) : y ≤ x :=
begin
  apply le_of_le_add_eps,
  intros ε ε_pos,
  cases hu ε ε_pos with N HN,
  calc
    y ≤ u N           : ineq N
  ... = x + (u N - x) : by linarith
  ... ≤ x + |u N - x| : add_le_add (by refl) (le_abs_self _)
  ... ≤ x + ε         : add_le_add (by refl) (HN N (by unfold ge))
end

-- If y ≤ u n for all n and u n goes to x then y ≤ x
lemma le_lim {x y : ℝ} {u : ℕ → ℝ} (hu : limit u x) (ineq : ∀ n, y ≤ u n) : y ≤ x :=
begin
  -- Let's apply our previous lemma
  apply le_of_le_add_eps,
  -- We need to prove y ≤ x + ε for all positive ε.
  -- Let ε be any positive real
  intros ε ε_pos,
  -- we now specialize our limit assumption to this `ε`, and immediately
  -- fix a `N` as promised by the definition.
  cases hu ε ε_pos with N HN,
  -- Now we only need to compute until reaching the conclusion
  calc
  y ≤ u N             : ineq N
  ... = x + (u N - x) : by linarith
    -- We'll need `add_le_add` which says `a ≤ b` and `c ≤ d` implies `a + c ≤ b + d`
    -- We need a lemma saying `z ≤ |z|`. Because we don't know the name of this lemma,
    -- let's use `library_search`. Because searching thourgh the library is slow,
    -- Lean will write what it found in the Lean message window when cursor is on
    -- that line, so that we can replace it by the lemma. We see `le_max_left` which
    -- says `a ≤ max a b`. Actually there is a more specific lemma `le_abs_self`
  ... ≤ x + |u N - x| : add_le_add (by linarith) (by library_search)
  ... ≤ x + ε         : add_le_add (by linarith) (HN N (by linarith)),
end

/-
The next lemma has been extracted from the main proof in order to discuss numbers.
In ordinary maths, we know that ℕ is *not* contained in `ℝ`, whatever the
construction of real numbers that we use. For instance a natural number is not
an equivalence class of Cauchy sequences. But it's very easy to
pretend otherwise. Formal maths requires slightly more care. In the statement below,
the "type ascription" `(n + 1 : ℝ)` forces Lean to convert the natural number
`n+1` into a real number.  The "inclusion" map will be displayed in tactic state
as `↑`. There are various lemmas asserting this map is compatible with addition and
monotone, but we don't want to bother writing their names. The `norm_cast`
tactic is designed to wisely apply those lemmas for us.
-/

example (n : ℕ) : 1/(n+1 : ℝ) > 0 :=
begin
  suffices : (n + 1 : ℝ) > 0,
  { exact one_div_pos_of_pos this },
  norm_cast,
  exact nat.succ_pos n
end

lemma inv_succ_pos : ∀ n : ℕ, 1/(n+1 : ℝ) > 0 :=
begin
  -- Let `n` be any integer
  intro n,
  -- Since we don't know the name of the relevant lemma, asserting that the inverse of
  -- a positive number is positive, let's state that is suffices
  -- to prove that `n+1`, seen as a real number, is positive, and ask `library_search`
  suffices : (n + 1 : ℝ) > 0,
  { library_search },
  -- Now we want to reduce to a statement about natural numbers, not real numbers
  -- coming from natural numbers.
  norm_cast,
  -- and then get the usual help from `linarith`
  linarith,
end

/-
That was a pretty long proof for an obvious fact. And stating it as a lemma feels
stupid, so let's find a way to write it on one line in case we want to include it
in some other proof without stating a lemma. First the `library_search` call
above displays the name of the relevant lemma: `one_div_pos_of_pos`. We can also
replace the `linarith` call on the last line by `library_search` to learn the name
of the lemma `nat.succ_pos` asserting that the successor of a natural number is
positive. There is also a variant on `norm_cast` that combines it with `exact`.
The term mode analogue of `intro` is `λ`. We get down to:
-/

example : ∀ n : ℕ, 1/(n+1 : ℝ) > 0 :=
λ n, one_div_pos_of_pos (by exact_mod_cast nat.succ_pos n)

/-
The next proof uses mostly known things, so we will commment only new aspects.
-/

example : ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  intros ε ε_pos,
  suffices : ∃ N : ℕ, 1/ε ≤ N,
  { cases this with N HN,
    use N,
    intros n Hn,
    rw [div_le_iff', ←div_le_iff ε_pos],
    replace Hn : (N : ℝ) ≤ n, exact_mod_cast Hn,
    linarith,
    exact_mod_cast nat.succ_pos n },
  exact archimedean_iff_nat_le.1 (by apply_instance) (1/ε)
end

lemma limit_inv_succ : ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  intros ε ε_pos,
  suffices : ∃ N : ℕ, 1/ε ≤ N,
  { -- Because we didn't provide a name for the above statement, Lean called it `this`.
    -- Let's fix an `N` that works.
    cases this with N HN,
    use N,
    intros n Hn,
    -- Now we want to rewrite the goal using lemmas
    -- `div_le_iff' : 0 < b →  (a / b ≤ c ↔ a ≤ b * c)`
    -- `div_le_iff : 0 < b →  (a / b ≤ c ↔ a ≤ c * b)`
    -- the second one will be rewritten from right to left, as indicated by `←`.
    -- Lean will create a side goal for the required positivity assumption that
    -- we don't provide for `div_le_iff'`.
    rw [div_le_iff', ← div_le_iff ε_pos],
    -- We want to replace assumption `Hn` by its real counter-part so that
    -- linarith can find what it needs.
    replace Hn : (N : ℝ) ≤ n, exact_mod_cast Hn,
    linarith,
    -- we are still left with the positivity assumption, but already discussed
    -- how to prove it in the preceding lemma
    exact_mod_cast nat.succ_pos n },
  -- Now we need to prove that sufficient statement.
  -- We want to use that `ℝ` is archimedean. So we start typing
  -- `exact archimedean_` and hit Ctrl-space to see what completion Lean proposes
  -- the lemma `archimedean_iff_nat_le` sounds promising. We select the left to
  -- right implication using `.1`. This a generic lemma for fields equiped with
  -- a linear (ie total) order. We need to provide a proof that `ℝ` is indeed
  -- archimedean. This is done using the `apply_instance` tactic that will be
  -- covered elsewhere.
  exact archimedean_iff_nat_le.1 (by apply_instance) (1/ε),
end

/-
We can now put all pieces together, with almost no new things to explain.
-/
example (A : set ℝ) (x : ℝ) :
  (x is_an_inf_of A) ↔ (x ∈ low_bounds A ∧ ∃ u : ℕ → ℝ, limit u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    { exact h.1 },
    have : ∀ n : ℕ, ∃ a ∈ A, a < x + 1/(n+1),
    { intro n,
      apply inf_lt h,
      have : 0 < 1/(n+1 : ℝ), from inv_succ_pos n,
      linarith },
    choose u hu using this,
    use u,
    split,
    { intros ε ε_pos,
      cases limit_inv_succ ε ε_pos with N H,
      use N,
      intros n hn,
      have : x ≤ u n, from h.1 _ (hu n).1,
      have := calc
        u n < x + 1/(n+1) : (hu n).2
        ... ≤ x + ε       : add_le_add (by refl) (H n hn),
      rw abs_of_nonneg; linarith },
    { intro n,
      exact (hu n).1 } },
  { intro h,
    rcases h with ⟨x_min, u, lim, huA⟩,
    split,
    exact x_min,
    intros y y_mino,
    apply le_lim lim,
    intro n,
    exact y_mino (u n) (huA n) },
end

lemma inf_seq (A : set ℝ) (x : ℝ) :
  (x is_an_inf_of A) ↔ (x ∈ low_bounds A ∧ ∃ u : ℕ → ℝ, limit u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    { exact h.1 },
    -- On the next line, we don't need to tell Lean to treat `n+1` as a real number because
    -- we add `x` to it, so Lean knows there is only one way to make sense of this expression.
    have key : ∀ n : ℕ, ∃ a ∈ A, a < x + 1/(n+1),
    { intro n,
      -- we can use the lemma we proved above
      apply inf_lt h,
      -- and another one we proved!
      have : 0 < 1/(n+1 : ℝ), from inv_succ_pos n,
      linarith },
    -- Now we need to use axiom of (countable) choice
    choose u hu using key,
    use u,
    split,
    { intros ε ε_pos,
      -- again we use a lemma we proved, specializing it to our fixed `ε`, and fixing a `N`
      cases limit_inv_succ ε ε_pos with N H,
      use N,
      intros n hn,
      have : x ≤ u n, from h.1 _ (hu n).1,
      have := calc
        u n < x + 1/(n + 1) : (hu n).2
        ... ≤ x + ε         : add_le_add (le_refl x) (H n hn),
      rw abs_of_nonneg ; linarith },
    { intro n,
      exact (hu n).1 } },
  { intro h,
    -- Assumption `h` is made of nested compound statements. We can use the
    -- recursive version of `cases` to unpack it in one go.
    rcases h with ⟨x_min, u, lim, huA⟩,
    split,
    exact x_min,
    intros y y_mino,
    apply le_lim lim,
    intro n,
    exact y_mino (u n) (huA n) },
end


import tactic.compute_degree

open polynomial
open_locale polynomial

variables {R : Type*} [semiring R] {a b c d e : R}

example {R : Type*} [ring R] (h : ∀ {p q : R[X]}, p.nat_degree ≤ 0 → (p * q).nat_degree = 0) :
  nat_degree (- 1 * 1 : R[X]) = 0 :=
begin
  apply h _,
  compute_degree_le,
end

example {p : R[X]} {n : ℕ} {p0 : p.nat_degree = 0} :
 (p ^ n).nat_degree ≤ 0 :=
by compute_degree_le

example {p : R[X]} {n : ℕ} {p0 : p.nat_degree = 0} :
 (p ^ n).nat_degree ≤ 0 :=
by cases n; compute_degree_le

example {p q r : R[X]} {a b c d e f m n : ℕ} {p0 : p.nat_degree = a} {q0 : q.nat_degree = b}
  {r0 : r.nat_degree = c} :
  (((q ^ e * p ^ d) ^ m * r ^ f) ^ n).nat_degree ≤ ((b * e + a * d) * m + c * f) * n :=
begin
  compute_degree_le,
  rw [p0, q0, r0],
end

example {F} [ring F] {p : F[X]} (p0 : p.nat_degree ≤ 0) :
  p.nat_degree ≤ 0 :=
begin
  success_if_fail_with_msg {compute_degree_le} "Goal did not change",
  exact p0,
end

example {F} [ring F] {p q : F[X]} (h : p.nat_degree + 1 ≤ q.nat_degree) :
  (- p * X).nat_degree ≤ q.nat_degree :=
by compute_degree_le

example {F} [ring F] {a : F} {n : ℕ} (h : n ≤ 10) :
  nat_degree (X ^ n - C a * X ^ 10 : F[X]) ≤ 10 :=
by compute_degree_le

example {F} [ring F] {a : F} {n : ℕ} (h : n ≤ 10) :
  nat_degree (X ^ n + C a * X ^ 10 : F[X]) ≤ 10 :=
by compute_degree_le

example (n : ℕ) (h : 1 + n < 11) :
  degree (5 * X ^ n + (X * monomial n 1 + X * X) + C a + C a * X ^ 10) ≤ 10 :=
begin
  compute_degree_le,
  { exact nat.lt_succ_iff.mp h },
  { exact nat.lt_succ_iff.mp ((lt_one_add n).trans h) },
end

example {n : ℕ} (h : 1 + n < 11) :
  degree (X + (X * monomial 2 1 + X * X) ^ 2) ≤ 10 :=
by compute_degree_le

example {m s: ℕ} (ms : m ≤ s) (s1 : 1 ≤ s) : nat_degree (C a * X ^ m + X + 5) ≤ s :=
by compute_degree_le; assumption

example : nat_degree (7 * X : R[X]) ≤ 1 :=
by compute_degree_le

example : (1 : R[X]).nat_degree ≤ 0 :=
by compute_degree_le

example : nat_degree (monomial 5 c * monomial 1 c + monomial 7 d +
  C a * X ^ 0 + C b * X ^ 5 + C c * X ^ 2 + X ^ 10 + C e * X) ≤ 10 :=
by compute_degree_le

example {n : ℕ} : nat_degree (0 * (X ^ 0 + X ^ n) * monomial 5 c * monomial 6 c) ≤ 9 :=
begin
  success_if_fail_with_msg {compute_degree_le}
    "the given polynomial has a term of expected degree
at least '11'",
  rw [zero_mul, zero_mul, zero_mul, nat_degree_zero],
  exact nat.zero_le _
end

example : nat_degree (monomial 0 c * (monomial 0 c * C 1) + monomial 0 d + C 1 + C a * X ^ 0) ≤ 0 :=
by compute_degree_le

example {F} [ring F] {n m : ℕ} (n4 : n ≤ 4) (m4 : m ≤ 4) {a : F} :
  nat_degree (C a * X ^ n + X ^ m + bit1 1 : F[X]) ≤ 4 :=
by compute_degree_le; assumption

example {F} [ring F] : nat_degree (X ^ 4 + bit1 1 : F[X]) ≤ 4 :=
by compute_degree_le


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.measure.measure_space
import measure_theory.measure.regular
import topology.opens
import topology.compacts

/-!
# Contents

In this file we work with *contents*. A content `λ` is a function from a certain class of subsets
(such as the compact subsets) to `ℝ≥0` that is
* additive: If `K₁` and `K₂` are disjoint sets in the domain of `λ`,
  then `λ(K₁ ∪ K₂) = λ(K₁) + λ(K₂)`;
* subadditive: If `K₁` and `K₂` are in the domain of `λ`, then `λ(K₁ ∪ K₂) ≤ λ(K₁) + λ(K₂)`;
* monotone: If `K₁ ⊆ K₂` are in the domain of `λ`, then `λ(K₁) ≤ λ(K₂)`.

We show that:
* Given a content `λ` on compact sets, let us define a function `λ*` on open sets, by letting
  `λ* U` be the supremum of `λ K` for `K` included in `U`. This is a countably subadditive map that
  vanishes at `∅`. In Halmos (1950) this is called the *inner content* `λ*` of `λ`, and formalized
  as `inner_content`.
* Given an inner content, we define an outer measure `μ*`, by letting `μ* E` be the infimum of
  `λ* U` over the open sets `U` containing `E`. This is indeed an outer measure. It is formalized
  as `outer_measure`.
* Restricting this outer measure to Borel sets gives a regular measure `μ`.

We define bundled contents as `content`.
In this file we only work on contents on compact sets, and inner contents on open sets, and both
contents and inner contents map into the extended nonnegative reals. However, in other applications
other choices can be made, and it is not a priori clear what the best interface should be.

## Main definitions

For `μ : content G`, we define
* `μ.inner_content` : the inner content associated to `μ`.
* `μ.outer_measure` : the outer measure associated to `μ`.
* `μ.measure`       : the Borel measure associated to `μ`.

We prove that, on a locally compact space, the measure `μ.measure` is regular.

## References

* Paul Halmos (1950), Measure Theory, §53
* <https://en.wikipedia.org/wiki/Content_(measure_theory)>
-/

universes u v w
noncomputable theory

open set topological_space
open_locale nnreal ennreal

namespace measure_theory

variables {G : Type w} [topological_space G]

/-- A content is an additive function on compact sets taking values in `ℝ≥0`. It is a device
from which one can define a measure. -/
structure content (G : Type w) [topological_space G] :=
(to_fun : compacts G → ℝ≥0)
(mono' : ∀ (K₁ K₂ : compacts G), K₁.1 ⊆ K₂.1 → to_fun K₁ ≤ to_fun K₂)
(sup_disjoint' : ∀ (K₁ K₂ : compacts G), disjoint K₁.1 K₂.1 →
   to_fun (K₁ ⊔ K₂) = to_fun K₁ + to_fun K₂)
(sup_le' : ∀ (K₁ K₂ : compacts G), to_fun (K₁ ⊔ K₂) ≤ to_fun K₁ + to_fun K₂)

instance : inhabited (content G) :=
⟨{ to_fun := λ K, 0,
  mono' := by simp,
  sup_disjoint' := by simp,
  sup_le' := by simp }⟩

/-- Although the `to_fun` field of a content takes values in `ℝ≥0`, we register a coercion to
functions taking values in `ℝ≥0∞` as most constructions below rely on taking suprs and infs, which
is more convenient in a complete lattice, and aim at constructing a measure. -/
instance : has_coe_to_fun (content G) (λ _, compacts G → ℝ≥0∞) := ⟨λ μ s, μ.to_fun s⟩

namespace content

variable (μ : content G)

lemma apply_eq_coe_to_fun (K : compacts G) : μ K = μ.to_fun K := rfl

lemma mono (K₁ K₂ : compacts G) (h : K₁.1 ⊆ K₂.1) : μ K₁ ≤ μ K₂ :=
by simp [apply_eq_coe_to_fun, μ.mono' _ _ h]

lemma sup_disjoint (K₁ K₂ : compacts G) (h : disjoint K₁.1 K₂.1) : μ (K₁ ⊔ K₂) = μ K₁ + μ K₂ :=
by simp [apply_eq_coe_to_fun, μ.sup_disjoint' _ _ h]

lemma sup_le (K₁ K₂ : compacts G) : μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂ :=
by { simp only [apply_eq_coe_to_fun], norm_cast, exact μ.sup_le' _ _ }

lemma lt_top (K : compacts G) : μ K < ∞ :=
ennreal.coe_lt_top

lemma empty : μ ⊥ = 0 :=
begin
  have := μ.sup_disjoint' ⊥ ⊥,
  simpa [apply_eq_coe_to_fun] using this,
end

/-- Constructing the inner content of a content. From a content defined on the compact sets, we
  obtain a function defined on all open sets, by taking the supremum of the content of all compact
  subsets. -/
def inner_content (U : opens G) : ℝ≥0∞ :=
⨆ (K : compacts G) (h : K.1 ⊆ U), μ K

lemma le_inner_content (K : compacts G) (U : opens G)
  (h2 : K.1 ⊆ U) : μ K ≤ μ.inner_content U :=
le_supr_of_le K $ le_supr _ h2

lemma inner_content_le (U : opens G) (K : compacts G) (h2 : (U : set G) ⊆ K.1) :
  μ.inner_content U ≤ μ K :=
bsupr_le $ λ K' hK', μ.mono _ _ (subset.trans hK' h2)

lemma inner_content_of_is_compact {K : set G} (h1K : is_compact K) (h2K : is_open K) :
  μ.inner_content ⟨K, h2K⟩ = μ ⟨K, h1K⟩ :=
le_antisymm (bsupr_le $ λ K' hK', μ.mono _ ⟨K, h1K⟩ hK')
            (μ.le_inner_content _ _ subset.rfl)

lemma inner_content_empty :
  μ.inner_content ∅ = 0 :=
begin
  refine le_antisymm _ (zero_le _), rw ←μ.empty,
  refine bsupr_le (λ K hK, _),
  have : K = ⊥, { ext1, rw [subset_empty_iff.mp hK, compacts.bot_val] }, rw this, refl'
end

/-- This is "unbundled", because that it required for the API of `induced_outer_measure`. -/
lemma inner_content_mono ⦃U V : set G⦄ (hU : is_open U) (hV : is_open V)
  (h2 : U ⊆ V) : μ.inner_content ⟨U, hU⟩ ≤ μ.inner_content ⟨V, hV⟩ :=
supr_le_supr $ λ K, supr_le_supr_const $ λ hK, subset.trans hK h2

lemma inner_content_exists_compact {U : opens G}
  (hU : μ.inner_content U ≠ ∞) {ε : ℝ≥0} (hε : ε ≠ 0) :
  ∃ K : compacts G, K.1 ⊆ U ∧ μ.inner_content U ≤ μ K + ε :=
begin
  have h'ε := ennreal.coe_ne_zero.2 hε,
  cases le_or_lt (μ.inner_content U) ε,
  { exact ⟨⊥, empty_subset _, le_add_left h⟩ },
  have := ennreal.sub_lt_self hU h.ne_bot h'ε,
  conv at this {to_rhs, rw inner_content }, simp only [lt_supr_iff] at this,
  rcases this with ⟨U, h1U, h2U⟩, refine ⟨U, h1U, _⟩,
  rw [← tsub_le_iff_right], exact le_of_lt h2U
end

/-- The inner content of a supremum of opens is at most the sum of the individual inner
contents. -/
lemma inner_content_Sup_nat [t2_space G] (U : ℕ → opens G) :
  μ.inner_content (⨆ (i : ℕ), U i) ≤ ∑' (i : ℕ), μ.inner_content (U i) :=
begin
  have h3 : ∀ (t : finset ℕ) (K : ℕ → compacts G), μ (t.sup K) ≤ t.sum (λ i, μ (K i)),
  { intros t K, refine finset.induction_on t _ _,
    { simp only [μ.empty, nonpos_iff_eq_zero, finset.sum_empty, finset.sup_empty], },
    { intros n s hn ih, rw [finset.sup_insert, finset.sum_insert hn],
      exact le_trans (μ.sup_le _ _) (add_le_add_left ih _) }},
  refine bsupr_le (λ K hK, _),
  rcases is_compact.elim_finite_subcover K.2 _ (λ i, (U i).prop) _ with ⟨t, ht⟩, swap,
  { convert hK, rw [opens.supr_def, subtype.coe_mk] },
  rcases K.2.finite_compact_cover t (coe ∘ U) (λ i _, (U _).prop) (by simp only [ht])
    with ⟨K', h1K', h2K', h3K'⟩,
  let L : ℕ → compacts G := λ n, ⟨K' n, h1K' n⟩,
  convert le_trans (h3 t L) _,
  { ext1, simp only [h3K', compacts.finset_sup_val, finset.sup_eq_supr, set.supr_eq_Union] },
  refine le_trans (finset.sum_le_sum _) (ennreal.sum_le_tsum t),
  intros i hi, refine le_trans _ (le_supr _ (L i)),
  refine le_trans _ (le_supr _ (h2K' i)), refl'
end

/-- The inner content of a union of sets is at most the sum of the individual inner contents.
  This is the "unbundled" version of `inner_content_Sup_nat`.
  It required for the API of `induced_outer_measure`. -/
lemma inner_content_Union_nat [t2_space G] ⦃U : ℕ → set G⦄ (hU : ∀ (i : ℕ), is_open (U i)) :
  μ.inner_content ⟨⋃ (i : ℕ), U i, is_open_Union hU⟩ ≤ ∑' (i : ℕ), μ.inner_content ⟨U i, hU i⟩ :=
by { have := μ.inner_content_Sup_nat (λ i, ⟨U i, hU i⟩), rwa [opens.supr_def] at this }

lemma inner_content_comap (f : G ≃ₜ G)
  (h : ∀ ⦃K : compacts G⦄, μ (K.map f f.continuous) = μ K) (U : opens G) :
  μ.inner_content (opens.comap f.to_continuous_map U) = μ.inner_content U :=
begin
  refine supr_congr _ ((compacts.equiv f).surjective) _,
  intro K, refine supr_congr_Prop image_subset_iff _,
  intro hK, simp only [equiv.coe_fn_mk, subtype.mk_eq_mk, ennreal.coe_eq_coe, compacts.equiv],
  apply h,
end

@[to_additive]
lemma is_mul_left_invariant_inner_content [group G] [topological_group G]
  (h : ∀ (g : G) {K : compacts G}, μ (K.map _ $ continuous_mul_left g) = μ K) (g : G)
  (U : opens G) :
  μ.inner_content (opens.comap (homeomorph.mul_left g).to_continuous_map U) = μ.inner_content U :=
by convert μ.inner_content_comap (homeomorph.mul_left g) (λ K, h g) U

@[to_additive]
lemma inner_content_pos_of_is_mul_left_invariant [t2_space G] [group G] [topological_group G]
  (h3 : ∀ (g : G) {K : compacts G}, μ (K.map _ $ continuous_mul_left g) = μ K)
  (K : compacts G) (hK : μ K ≠ 0) (U : opens G) (hU : (U : set G).nonempty) :
  0 < μ.inner_content U :=
begin
  have : (interior (U : set G)).nonempty, rwa [U.prop.interior_eq],
  rcases compact_covered_by_mul_left_translates K.2 this with ⟨s, hs⟩,
  suffices : μ K ≤ s.card * μ.inner_content U,
  { exact (ennreal.mul_pos_iff.mp $ hK.bot_lt.trans_le this).2 },
  have : K.1 ⊆ ↑⨆ (g ∈ s), opens.comap (homeomorph.mul_left g).to_continuous_map U,
  { simpa only [opens.supr_def, opens.coe_comap, subtype.coe_mk] },
  refine (μ.le_inner_content _ _ this).trans _,
  refine (rel_supr_sum (μ.inner_content) (μ.inner_content_empty) (≤)
    (μ.inner_content_Sup_nat) _ _).trans _,
  simp only [μ.is_mul_left_invariant_inner_content h3, finset.sum_const, nsmul_eq_mul, le_refl]
end

lemma inner_content_mono' ⦃U V : set G⦄
  (hU : is_open U) (hV : is_open V) (h2 : U ⊆ V) :
  μ.inner_content ⟨U, hU⟩ ≤ μ.inner_content ⟨V, hV⟩ :=
supr_le_supr $ λ K, supr_le_supr_const $ λ hK, subset.trans hK h2

/-- Extending a content on compact sets to an outer measure on all sets. -/
protected def outer_measure : outer_measure G :=
induced_outer_measure (λ U hU, μ.inner_content ⟨U, hU⟩) is_open_empty μ.inner_content_empty

variables [t2_space G]

lemma outer_measure_opens (U : opens G) : μ.outer_measure U = μ.inner_content U :=
induced_outer_measure_eq' (λ _, is_open_Union) μ.inner_content_Union_nat μ.inner_content_mono U.2

lemma outer_measure_of_is_open (U : set G) (hU : is_open U) :
  μ.outer_measure U = μ.inner_content ⟨U, hU⟩ :=
μ.outer_measure_opens ⟨U, hU⟩

lemma outer_measure_le
  (U : opens G) (K : compacts G) (hUK : (U : set G) ⊆ K.1) : μ.outer_measure U ≤ μ K :=
(μ.outer_measure_opens U).le.trans $ μ.inner_content_le U K hUK

lemma le_outer_measure_compacts (K : compacts G) : μ K ≤ μ.outer_measure K.1 :=
begin
  rw [content.outer_measure, induced_outer_measure_eq_infi],
  { exact le_infi (λ U, le_infi $ λ hU, le_infi $ μ.le_inner_content K ⟨U, hU⟩) },
  { exact μ.inner_content_Union_nat },
  { exact μ.inner_content_mono }
end

lemma outer_measure_eq_infi (A : set G) :
  μ.outer_measure A = ⨅ (U : set G) (hU : is_open U) (h : A ⊆ U), μ.inner_content ⟨U, hU⟩ :=
induced_outer_measure_eq_infi _ μ.inner_content_Union_nat μ.inner_content_mono A

lemma outer_measure_interior_compacts (K : compacts G) : μ.outer_measure (interior K.1) ≤ μ K :=
le_trans (le_of_eq $ μ.outer_measure_opens (opens.interior K.1))
         (μ.inner_content_le _ _ interior_subset)

lemma outer_measure_exists_compact {U : opens G} (hU : μ.outer_measure U ≠ ∞) {ε : ℝ≥0}
  (hε : ε ≠ 0) : ∃ K : compacts G, K.1 ⊆ U ∧ μ.outer_measure U ≤ μ.outer_measure K.1 + ε :=
begin
  rw [μ.outer_measure_opens] at hU ⊢,
  rcases μ.inner_content_exists_compact hU hε with ⟨K, h1K, h2K⟩,
  exact ⟨K, h1K, le_trans h2K $ add_le_add_right (μ.le_outer_measure_compacts K) _⟩,
end

lemma outer_measure_exists_open {A : set G} (hA : μ.outer_measure A ≠ ∞) {ε : ℝ≥0} (hε : ε ≠ 0) :
  ∃ U : opens G, A ⊆ U ∧ μ.outer_measure U ≤ μ.outer_measure A + ε :=
begin
  rcases induced_outer_measure_exists_set _ _ μ.inner_content_mono hA (ennreal.coe_ne_zero.2 hε)
    with ⟨U, hU, h2U, h3U⟩,
  exact ⟨⟨U, hU⟩, h2U, h3U⟩, swap, exact μ.inner_content_Union_nat
end

lemma outer_measure_preimage (f : G ≃ₜ G) (h : ∀ ⦃K : compacts G⦄, μ (K.map f f.continuous) = μ K)
  (A : set G) : μ.outer_measure (f ⁻¹' A) = μ.outer_measure A :=
begin
  refine induced_outer_measure_preimage _ μ.inner_content_Union_nat μ.inner_content_mono _
    (λ s, f.is_open_preimage) _,
  intros s hs, convert μ.inner_content_comap f h ⟨s, hs⟩
end

lemma outer_measure_lt_top_of_is_compact [locally_compact_space G]
  {K : set G} (hK : is_compact K) : μ.outer_measure K < ∞ :=
begin
  rcases exists_compact_superset hK with ⟨F, h1F, h2F⟩,
  calc
  μ.outer_measure K ≤ μ.outer_measure (interior F) : outer_measure.mono' _ h2F
  ... ≤ μ ⟨F, h1F⟩ :
    by apply μ.outer_measure_le ⟨interior F, is_open_interior⟩ ⟨F, h1F⟩ interior_subset
  ... < ⊤ : μ.lt_top _
end

@[to_additive]
lemma is_mul_left_invariant_outer_measure [group G] [topological_group G]
  (h : ∀ (g : G) {K : compacts G}, μ (K.map _ $ continuous_mul_left g) = μ K) (g : G)
  (A : set G) : μ.outer_measure ((λ h, g * h) ⁻¹' A) = μ.outer_measure A :=
by convert μ.outer_measure_preimage (homeomorph.mul_left g) (λ K, h g) A

lemma outer_measure_caratheodory (A : set G) :
  μ.outer_measure.caratheodory.measurable_set' A ↔ ∀ (U : opens G),
  μ.outer_measure (U ∩ A) + μ.outer_measure (U \ A) ≤ μ.outer_measure U :=
begin
  dsimp [opens], rw subtype.forall,
  apply induced_outer_measure_caratheodory,
  apply inner_content_Union_nat,
  apply inner_content_mono'
end

@[to_additive]
lemma outer_measure_pos_of_is_mul_left_invariant [group G] [topological_group G]
  (h3 : ∀ (g : G) {K : compacts G}, μ (K.map _ $ continuous_mul_left g) = μ K)
  (K : compacts G) (hK : μ K ≠ 0) {U : set G} (h1U : is_open U) (h2U : U.nonempty) :
  0 < μ.outer_measure U :=
by { convert μ.inner_content_pos_of_is_mul_left_invariant h3 K hK ⟨U, h1U⟩ h2U,
     exact μ.outer_measure_opens ⟨U, h1U⟩ }

variables [S : measurable_space G] [borel_space G]
include S

/-- For the outer measure coming from a content, all Borel sets are measurable. -/
lemma borel_le_caratheodory : S ≤ μ.outer_measure.caratheodory :=
begin
  rw [@borel_space.measurable_eq G _ _],
  refine measurable_space.generate_from_le _,
  intros U hU,
  rw μ.outer_measure_caratheodory,
  intro U',
  rw μ.outer_measure_of_is_open ((U' : set G) ∩ U) (is_open.inter U'.prop hU),
  simp only [inner_content, supr_subtype'], rw [opens.coe_mk],
  haveI : nonempty {L : compacts G // L.1 ⊆ U' ∩ U} := ⟨⟨⊥, empty_subset _⟩⟩,
  rw [ennreal.supr_add],
  refine supr_le _, rintro ⟨L, hL⟩, simp only [subset_inter_iff] at hL,
  have : ↑U' \ U ⊆ U' \ L.1 := diff_subset_diff_right hL.2,
  refine le_trans (add_le_add_left (μ.outer_measure.mono' this) _) _,
  rw μ.outer_measure_of_is_open (↑U' \ L.1) (is_open.sdiff U'.2 L.2.is_closed),
  simp only [inner_content, supr_subtype'], rw [opens.coe_mk],
  haveI : nonempty {M : compacts G // M.1 ⊆ ↑U' \ L.1} := ⟨⟨⊥, empty_subset _⟩⟩,
  rw [ennreal.add_supr], refine supr_le _, rintro ⟨M, hM⟩, simp only [subset_diff] at hM,
  have : (L ⊔ M).1 ⊆ U',
  { simp only [union_subset_iff, compacts.sup_val, hM, hL, and_self] },
  rw μ.outer_measure_of_is_open ↑U' U'.2,
  refine le_trans (ge_of_eq _) (μ.le_inner_content _ _ this),
  exact μ.sup_disjoint _ _ hM.2.symm,
end

/-- The measure induced by the outer measure coming from a content, on the Borel sigma-algebra. -/
protected def measure : measure G := μ.outer_measure.to_measure μ.borel_le_caratheodory

lemma measure_apply {s : set G} (hs : measurable_set s) : μ.measure s = μ.outer_measure s :=
to_measure_apply _ _ hs

/-- In a locally compact space, any measure constructed from a content is regular. -/
instance regular [locally_compact_space G] : μ.measure.regular :=
begin
  haveI : μ.measure.outer_regular,
  { refine ⟨λ A hA r (hr : _ < _), _⟩,
    rw [μ.measure_apply hA, outer_measure_eq_infi] at hr,
    simp only [infi_lt_iff] at hr,
    rcases hr with ⟨U, hUo, hAU, hr⟩,
    rw [← μ.outer_measure_of_is_open U hUo, ← μ.measure_apply hUo.measurable_set] at hr,
    exact ⟨U, hAU, hUo, hr⟩ },
  split,
  { intros K hK,
    rw [measure_apply _ hK.measurable_set],
    exact μ.outer_measure_lt_top_of_is_compact hK },
  { intros U hU r hr,
    rw [measure_apply _ hU.measurable_set, μ.outer_measure_of_is_open U hU] at hr,
    simp only [inner_content, lt_supr_iff] at hr,
    rcases hr with ⟨K, hKU, hr⟩,
    refine ⟨K.1, hKU, K.2, hr.trans_le _⟩,
    exact (μ.le_outer_measure_compacts K).trans (le_to_measure_apply _ _ _) },
end

end content

end measure_theory


-- *  Level 1

example (P Q : Prop) (p : P) (h : P → Q) : Q :=

begin

exact h(p)

end

-- * Level 2

lemma imp_self (P : Prop) : P → P :=

begin
intro p,
exact p
end

-- * Level 3

lemma maze (P Q R S T U: Prop)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U :=

begin
exact l(j(h(p)))
end
-- * Level 4
lemma maze2 (P Q R S T U: Prop)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U :=

begin

exact l(j(h(p)))

end

-- * Level 5
example (P Q : Prop) : P → (Q → P) :=

begin

intro p,
intro q,
exact p

end
-- * Level 6
example (P Q R : Prop) : (P → (Q → R)) → ((P → Q) → (P → R)) :=

begin
intros f g p,
apply f p,
apply g,
exact p
end
-- * Level 7
lemma imp_trans (P Q R : Prop) : (P → Q) → ((Q → R) → (P → R)) :=

begin

intros hpq hqr p,
exact hqr(hpq(p))

end
-- * Level 8
lemma contrapositive (P Q : Prop) : (P → Q) → (¬ Q → ¬ P) :=

begin
repeat {rw not_iff_imp_false},
intros f h e,
exact h(f(e))

end

-- * Level 9
example (A B C D E F G H I J K L : Prop)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L :=

begin
cc
end


import .radical
import .wronskian

/-
On `div_radical(a) = a / radical(a)`. The purpose of this file is to prove our "main lemma" that `div_radical(a)` divides `a'` for any nonzero polynomial `a`.
The proof is based on induction (`unique_factorization_domain.induction_on_coprime`).
-/

noncomputable theory
open_locale polynomial classical

namespace polynomial
open unique_factorization_monoid

variables {k: Type*} [field k]

/-- For a given polynomial `a`, `div_radical(a)` is `a` divided by its radical `rad(a)`. This is the key to our implementation. -/
def div_radical (a : k[X]) : k[X] := a / a.radical

lemma mul_radical_div_radical (a : k[X]) :
  a.radical * a.div_radical = a :=
begin
  rw div_radical,
  rw ←(euclidean_domain.mul_div_assoc),
  refine euclidean_domain.mul_div_cancel_left _ _,
  exact a.radical_ne_zero,
  exact radical_dvd_self a,
end

lemma div_radical_ne_zero {a : k[X]} (ha : a ≠ 0) : a.div_radical ≠ 0 :=
begin
  rw ← mul_radical_div_radical a at ha,
  exact right_ne_zero_of_mul ha,
end

lemma div_radical_is_unit {u : k[X]} (hu : is_unit u) :
  is_unit u.div_radical :=
begin
  rwa [div_radical, radical_is_unit hu, euclidean_domain.div_one],
end

lemma eq_div_radical {a x : k[X]} (h : a.radical * x = a) :
  x = a.div_radical :=
begin
  apply euclidean_domain.eq_div_of_mul_eq_left a.radical_ne_zero,
  rwa mul_comm,
end

lemma div_radical_mul {a b : k[X]} (hc: is_coprime a b) :
  (a * b).div_radical = a.div_radical * b.div_radical :=
begin
  by_cases ha : a = 0,
  { rw [ha, zero_mul, div_radical, euclidean_domain.zero_div, zero_mul] },
  by_cases hb : b = 0,
  { rw [hb, mul_zero, div_radical, euclidean_domain.zero_div, mul_zero] },
  symmetry, apply eq_div_radical,
  rw radical_mul hc,
  rw [mul_mul_mul_comm, mul_radical_div_radical, mul_radical_div_radical],
end

lemma div_radical_dvd_self (a : k[X]) :
  a.div_radical ∣ a :=
begin
  rw div_radical,
  apply euclidean_domain.div_dvd_of_dvd,
  exact radical_dvd_self a,
end

theorem div_radical_dvd_derivative (a : k[X]) :
  a.div_radical ∣ a.derivative :=
begin
  apply induction_on_coprime a,
  { rw derivative_zero,
    apply dvd_zero },
  { exact λ a ha, (div_radical_is_unit ha).dvd },
  { rintros p (_ | i) hp,
    { rw [pow_zero, derivative_one],
      apply dvd_zero },
    rw [←mul_dvd_mul_iff_left (radical_ne_zero (p ^ i.succ)), mul_radical_div_radical,
        radical_prime_pow hp i.succ_pos, derivative_pow_succ, ← mul_assoc],
    apply dvd_mul_of_dvd_left,
    rw [mul_comm, mul_assoc],
    apply dvd_mul_of_dvd_right,
    rw [pow_succ', mul_dvd_mul_iff_left (pow_ne_zero i hp.ne_zero), dvd_normalize_iff] },
  { intros x y hpxy hx hy,
    have hc : is_coprime x y := euclidean_domain.is_coprime_of_dvd
      (λ ⟨hx, hy⟩, not_is_unit_zero (hpxy 0 (zero_dvd_iff.mpr hx) (zero_dvd_iff.mpr hy)))
      (λ p hp _ hpx hpy, hp (hpxy p hpx hpy)),
    rw [div_radical_mul hc, derivative_mul],
    exact dvd_add (mul_dvd_mul hx y.div_radical_dvd_self)
      (mul_dvd_mul x.div_radical_dvd_self hy) },
end

theorem div_radical_dvd_wronskian_left (a b : k[X]) :
  a.div_radical ∣ wronskian a b :=
begin
  rw wronskian,
  apply dvd_sub,
  { apply dvd_mul_of_dvd_left,
    exact div_radical_dvd_self a },
  { apply dvd_mul_of_dvd_left,
    exact div_radical_dvd_derivative a },
end

theorem div_radical_dvd_wronskian_right (a b : k[X]) :
  b.div_radical ∣ wronskian a b :=
begin
  rw [wronskian_anticomm, dvd_neg],
  exact b.div_radical_dvd_wronskian_left _,
end

end polynomial


example (p q : Prop) : p ∧ q → q ∧ p := by
  intro h
  cases h with
  | intro hp hq => constructor; exact hq; exact hp

example (α : Type) (p q : α → Prop) : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x := by
  intro ⟨w, hpw, hqw⟩
  exact ⟨w, hqw, hpw⟩

example (p q : Nat → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x := by
  intro h
  cases h with
  | intro x px => constructor; apply Or.inl; exact px

theorem thm1 {p q: Prop}: (p ∧ q) → q := by
  intro pq; cases pq with
  | intro l r => exact r

#print thm1

theorem thm2 {p q: Prop}: (p ∧ q) → q := by
  intro pq
  cases pq
  case intro l r => exact r


/-
Copyright (c) 2021 Arthur Paulino. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Arthur Paulino, Kyle Miller
-/

import combinatorics.simple_graph.coloring

/-!
# Graph partitions

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

This module provides an interface for dealing with partitions on simple graphs. A partition of
a graph `G`, with vertices `V`, is a set `P` of disjoint nonempty subsets of `V` such that:

* The union of the subsets in `P` is `V`.

* Each element of `P` is an independent set. (Each subset contains no pair of adjacent vertices.)

Graph partitions are graph colorings that do not name their colors.  They are adjoint in the
following sense. Given a graph coloring, there is an associated partition from the set of color
classes, and given a partition, there is an associated graph coloring from using the partition's
subsets as colors.  Going from graph colorings to partitions and back makes a coloring "canonical":
all colors are given a canonical name and unused colors are removed.  Going from partitions to
graph colorings and back is the identity.

## Main definitions

* `simple_graph.partition` is a structure to represent a partition of a simple graph

* `simple_graph.partition.parts_card_le` is whether a given partition is an `n`-partition.
  (a partition with at most `n` parts).

* `simple_graph.partitionable n` is whether a given graph is `n`-partite

* `simple_graph.partition.to_coloring` creates colorings from partitions

* `simple_graph.coloring.to_partition` creates partitions from colorings

## Main statements

* `simple_graph.partitionable_iff_colorable` is that `n`-partitionability and
  `n`-colorability are equivalent.

-/

universes u v

namespace simple_graph
variables {V : Type u} (G : simple_graph V)

/--
A `partition` of a simple graph `G` is a structure constituted by
* `parts`: a set of subsets of the vertices `V` of `G`
* `is_partition`: a proof that `parts` is a proper partition of `V`
* `independent`: a proof that each element of `parts` doesn't have a pair of adjacent vertices
-/
structure partition :=
(parts : set (set V))
(is_partition : setoid.is_partition parts)
(independent : ∀ (s ∈ parts), is_antichain G.adj s)

/-- Whether a partition `P` has at most `n` parts. A graph with a partition
satisfying this predicate called `n`-partite. (See `simple_graph.partitionable`.) -/
def partition.parts_card_le {G : simple_graph V} (P : G.partition) (n : ℕ) : Prop :=
∃ (h : P.parts.finite), h.to_finset.card ≤ n

/-- Whether a graph is `n`-partite, which is whether its vertex set
can be partitioned in at most `n` independent sets. -/
def partitionable (n : ℕ) : Prop :=
∃ (P : G.partition), P.parts_card_le n

namespace partition
variables {G} (P : G.partition)

/-- The part in the partition that `v` belongs to -/
def part_of_vertex (v : V) : set V :=
classical.some (P.is_partition.2 v)

lemma part_of_vertex_mem (v : V) : P.part_of_vertex v ∈ P.parts :=
by { obtain ⟨h, -⟩ := (P.is_partition.2 v).some_spec.1, exact h, }

lemma mem_part_of_vertex (v : V) : v ∈ P.part_of_vertex v :=
by { obtain ⟨⟨h1, h2⟩, h3⟩ := (P.is_partition.2 v).some_spec, exact h2.1 }

lemma part_of_vertex_ne_of_adj {v w : V} (h : G.adj v w) :
  P.part_of_vertex v ≠ P.part_of_vertex w :=
begin
  intro hn,
  have hw := P.mem_part_of_vertex w,
  rw ←hn at hw,
  exact P.independent _ (P.part_of_vertex_mem v) (P.mem_part_of_vertex v) hw (G.ne_of_adj h) h,
end

/-- Create a coloring using the parts themselves as the colors.
Each vertex is colored by the part it's contained in. -/
def to_coloring : G.coloring P.parts :=
coloring.mk (λ v, ⟨P.part_of_vertex v, P.part_of_vertex_mem v⟩) $ λ _ _ hvw,
by { rw [ne.def, subtype.mk_eq_mk], exact P.part_of_vertex_ne_of_adj hvw }

/-- Like `simple_graph.partition.to_coloring` but uses `set V` as the coloring type. -/
def to_coloring' : G.coloring (set V) :=
coloring.mk P.part_of_vertex $ λ _ _ hvw, P.part_of_vertex_ne_of_adj hvw

lemma to_colorable [fintype P.parts] : G.colorable (fintype.card P.parts) :=
P.to_coloring.to_colorable

end partition

variables {G}

/-- Creates a partition from a coloring. -/
@[simps]
def coloring.to_partition {α : Type v} (C : G.coloring α) : G.partition :=
{ parts := C.color_classes,
  is_partition := C.color_classes_is_partition,
  independent := begin
    rintros s ⟨c, rfl⟩,
    apply C.color_classes_independent,
  end }

/-- The partition where every vertex is in its own part. -/
@[simps] instance : inhabited (partition G) := ⟨G.self_coloring.to_partition⟩

lemma partitionable_iff_colorable {n : ℕ} :
  G.partitionable n ↔ G.colorable n :=
begin
  split,
  { rintro ⟨P, hf, h⟩,
    haveI : fintype P.parts := hf.fintype,
    rw set.finite.card_to_finset at h,
    apply P.to_colorable.mono h, },
  { rintro ⟨C⟩,
    refine ⟨C.to_partition, C.color_classes_finite, le_trans _ (fintype.card_fin n).le⟩,
    generalize_proofs h,
    haveI : fintype C.color_classes := C.color_classes_finite.fintype,
    rw h.card_to_finset,
    exact C.card_color_classes_le },
end

end simple_graph