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

! This file was ported from Lean 3 source module category_theory.sites.pretopology
! leanprover-community/mathlib commit 9e7c80f638149bfb3504ba8ff48dfdbfc949fb1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Sites.Grothendieck

/-!
# Grothendieck pretopologies

Definition and lemmas about Grothendieck pretopologies.
A Grothendieck pretopology for a category `C` is a set of families of morphisms with fixed codomain,
satisfying certain closure conditions.

We show that a pretopology generates a genuine Grothendieck topology, and every topology has
a maximal pretopology which generates it.

The pretopology associated to a topological space is defined in `spaces.lean`.

## Tags

coverage, pretopology, site

## References

* [nLab, *Grothendieck pretopology*](https://ncatlab.org/nlab/show/Grothendieck+pretopology)
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]
* [Stacks, *00VG*](https://stacks.math.columbia.edu/tag/00VG)
-/

universe v u

noncomputable section

namespace CategoryTheory

open CategoryTheory Category Limits Presieve

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

variable (C)

#print CategoryTheory.Pretopology /-
/--
A (Grothendieck) pretopology on `C` consists of a collection of families of morphisms with a fixed
target `X` for every object `X` in `C`, called "coverings" of `X`, which satisfies the following
three axioms:
1. Every family consisting of a single isomorphism is a covering family.
2. The collection of covering families is stable under pullback.
3. Given a covering family, and a covering family on each domain of the former, the composition
   is a covering family.

In some sense, a pretopology can be seen as Grothendieck topology with weaker saturation conditions,
in that each covering is not necessarily downward closed.

See: https://ncatlab.org/nlab/show/Grothendieck+pretopology, or
https://stacks.math.columbia.edu/tag/00VH, or [MM92] Chapter III, Section 2, Definition 2.
Note that Stacks calls a category together with a pretopology a site, and [MM92] calls this
a basis for a topology.
-/
@[ext]
structure Pretopology where
  coverings : ∀ X : C, Set (Presieve X)
  has_isos : ∀ ⦃X Y⦄ (f : Y ⟶ X) [IsIso f], Presieve.singleton f ∈ coverings X
  pullbacks : ∀ ⦃X Y⦄ (f : Y ⟶ X) (S), S ∈ coverings X → pullbackArrows f S ∈ coverings Y
  Transitive :
    ∀ ⦃X : C⦄ (S : Presieve X) (Ti : ∀ ⦃Y⦄ (f : Y ⟶ X), S f → Presieve Y),
      S ∈ coverings X → (∀ ⦃Y⦄ (f) (H : S f), Ti f H ∈ coverings Y) → S.bind Ti ∈ coverings X
#align category_theory.pretopology CategoryTheory.Pretopology
-/

namespace Pretopology

instance : CoeFun (Pretopology C) fun _ => ∀ X : C, Set (Presieve X) :=
  ⟨coverings⟩

variable {C}

instance : LE (Pretopology C) where le K₁ K₂ := (K₁ : ∀ X : C, Set (Presieve X)) ≤ K₂

#print CategoryTheory.Pretopology.le_def /-
theorem le_def {K₁ K₂ : Pretopology C} : K₁ ≤ K₂ ↔ (K₁ : ∀ X : C, Set (Presieve X)) ≤ K₂ :=
  Iff.rfl
#align category_theory.pretopology.le_def CategoryTheory.Pretopology.le_def
-/

variable (C)

instance : PartialOrder (Pretopology C) :=
  { Pretopology.hasLe with
    le_refl := fun K => le_def.mpr le_rfl
    le_trans := fun K₁ K₂ K₃ h₁₂ h₂₃ => le_def.mpr (le_trans h₁₂ h₂₃)
    le_antisymm := fun K₁ K₂ h₁₂ h₂₁ => Pretopology.ext _ _ (le_antisymm h₁₂ h₂₁) }

instance : OrderTop (Pretopology C)
    where
  top :=
    { coverings := fun _ => Set.univ
      has_isos := fun _ _ _ _ => Set.mem_univ _
      pullbacks := fun _ _ _ _ _ => Set.mem_univ _
      Transitive := fun _ _ _ _ _ => Set.mem_univ _ }
  le_top K X S hS := Set.mem_univ _

instance : Inhabited (Pretopology C) :=
  ⟨⊤⟩

#print CategoryTheory.Pretopology.toGrothendieck /-
/-- A pretopology `K` can be completed to a Grothendieck topology `J` by declaring a sieve to be
`J`-covering if it contains a family in `K`.

See <https://stacks.math.columbia.edu/tag/00ZC>, or [MM92] Chapter III, Section 2, Equation (2).
-/
def toGrothendieck (K : Pretopology C) : GrothendieckTopology C
    where
  sieves X S := ∃ R ∈ K X, R ≤ (S : Presieve _)
  top_mem' X := ⟨Presieve.singleton (𝟙 _), K.has_isos _, fun _ _ _ => ⟨⟩⟩
  pullback_stable' X Y S g := by
    rintro ⟨R, hR, RS⟩
    refine' ⟨_, K.pullbacks g _ hR, _⟩
    rw [← sieve.sets_iff_generate, sieve.pullback_arrows_comm]
    apply sieve.pullback_monotone
    rwa [sieve.gi_generate.gc]
  transitive' := by
    rintro X S ⟨R', hR', RS⟩ R t
    choose t₁ t₂ t₃ using t
    refine' ⟨_, K.transitive _ _ hR' fun _ f hf => t₂ (RS _ hf), _⟩
    rintro Y _ ⟨Z, g, f, hg, hf, rfl⟩
    apply t₃ (RS _ hg) _ hf
#align category_theory.pretopology.to_grothendieck CategoryTheory.Pretopology.toGrothendieck
-/

/- warning: category_theory.pretopology.mem_to_grothendieck -> CategoryTheory.Pretopology.mem_toGrothendieck is a dubious translation:
lean 3 declaration is
  forall (C : Type.{u2}) [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_2 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1] (K : CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (X : C) (S : CategoryTheory.Sieve.{u1, u2} C _inst_1 X), Iff (Membership.Mem.{max u2 u1, max u2 u1} (CategoryTheory.Sieve.{u1, u2} C _inst_1 X) (Set.{max u2 u1} (CategoryTheory.Sieve.{u1, u2} C _inst_1 X)) (Set.hasMem.{max u2 u1} (CategoryTheory.Sieve.{u1, u2} C _inst_1 X)) S (coeFn.{max (succ u2) (succ u1), max (succ u2) (succ (max u2 u1))} (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (fun (_x : CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) => forall (X : C), Set.{max u2 u1} (CategoryTheory.Sieve.{u1, u2} C _inst_1 X)) (CategoryTheory.GrothendieckTopology.hasCoeToFun.{u1, u2} C _inst_1) (CategoryTheory.Pretopology.toGrothendieck.{u1, u2} C _inst_1 _inst_2 K) X)) (Exists.{succ (max u2 u1)} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (fun (R : CategoryTheory.Presieve.{u1, u2} C _inst_1 X) => Exists.{0} (Membership.Mem.{max u2 u1, max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (Set.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X)) (Set.hasMem.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X)) R (coeFn.{max (succ u2) (succ u1), max (succ u2) (succ (max u2 u1))} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (fun (_x : CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) => forall (X : C), Set.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X)) (CategoryTheory.Pretopology.hasCoeToFun.{u1, u2} C _inst_1 _inst_2) K X)) (fun (H : Membership.Mem.{max u2 u1, max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (Set.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X)) (Set.hasMem.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X)) R (coeFn.{max (succ u2) (succ u1), max (succ u2) (succ (max u2 u1))} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (fun (_x : CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) => forall (X : C), Set.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X)) (CategoryTheory.Pretopology.hasCoeToFun.{u1, u2} C _inst_1 _inst_2) K X)) => LE.le.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (Preorder.toLE.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (CompleteSemilatticeInf.toPartialOrder.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (CompleteLattice.toCompleteSemilatticeInf.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (CategoryTheory.Presieve.completeLattice.{u2, u1} C _inst_1 X))))) R (coeFn.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (CategoryTheory.Sieve.{u1, u2} C _inst_1 X) (fun (_x : CategoryTheory.Sieve.{u1, u2} C _inst_1 X) => CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (CategoryTheory.Sieve.hasCoeToFun.{u1, u2} C _inst_1 X) S))))
but is expected to have type
  forall (C : Type.{u2}) [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_2 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1] (K : CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (X : C) (S : CategoryTheory.Sieve.{u1, u2} C _inst_1 X), Iff (Membership.mem.{max u2 u1, max u2 u1} (CategoryTheory.Sieve.{u1, u2} C _inst_1 X) (Set.{max u2 u1} (CategoryTheory.Sieve.{u1, u2} C _inst_1 X)) (Set.instMembershipSet.{max u2 u1} (CategoryTheory.Sieve.{u1, u2} C _inst_1 X)) S (CategoryTheory.GrothendieckTopology.sieves.{u1, u2} C _inst_1 (CategoryTheory.Pretopology.toGrothendieck.{u1, u2} C _inst_1 _inst_2 K) X)) (Exists.{succ (max u2 u1)} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (fun (R : CategoryTheory.Presieve.{u1, u2} C _inst_1 X) => And (Membership.mem.{max u2 u1, max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (Set.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X)) (Set.instMembershipSet.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X)) R (CategoryTheory.Pretopology.coverings.{u1, u2} C _inst_1 _inst_2 K X)) (LE.le.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (Preorder.toLE.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (CompleteSemilatticeInf.toPartialOrder.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (CompleteLattice.toCompleteSemilatticeInf.{max u2 u1} (CategoryTheory.Presieve.{u1, u2} C _inst_1 X) (CategoryTheory.instCompleteLatticePresieve.{u1, u2} C _inst_1 X))))) R (CategoryTheory.Sieve.arrows.{u1, u2} C _inst_1 X S))))
Case conversion may be inaccurate. Consider using '#align category_theory.pretopology.mem_to_grothendieck CategoryTheory.Pretopology.mem_toGrothendieckₓ'. -/
theorem mem_toGrothendieck (K : Pretopology C) (X S) :
    S ∈ toGrothendieck C K X ↔ ∃ R ∈ K X, R ≤ (S : Presieve X) :=
  Iff.rfl
#align category_theory.pretopology.mem_to_grothendieck CategoryTheory.Pretopology.mem_toGrothendieck

#print CategoryTheory.Pretopology.ofGrothendieck /-
/-- The largest pretopology generating the given Grothendieck topology.

See [MM92] Chapter III, Section 2, Equations (3,4).
-/
def ofGrothendieck (J : GrothendieckTopology C) : Pretopology C
    where
  coverings X R := Sieve.generate R ∈ J X
  has_isos X Y f i := J.covering_of_eq_top (by simp)
  pullbacks X Y f R hR := by
    rw [Set.mem_def, sieve.pullback_arrows_comm]
    apply J.pullback_stable f hR
  Transitive X S Ti hS hTi := by
    apply J.transitive hS
    intro Y f
    rintro ⟨Z, g, f, hf, rfl⟩
    rw [sieve.pullback_comp]
    apply J.pullback_stable g
    apply J.superset_covering _ (hTi _ hf)
    rintro Y g ⟨W, h, g, hg, rfl⟩
    exact ⟨_, h, _, ⟨_, _, _, hf, hg, rfl⟩, by simp⟩
#align category_theory.pretopology.of_grothendieck CategoryTheory.Pretopology.ofGrothendieck
-/

/- warning: category_theory.pretopology.gi -> CategoryTheory.Pretopology.gi is a dubious translation:
lean 3 declaration is
  forall (C : Type.{u2}) [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_2 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1], GaloisInsertion.{max u2 u1, max u2 u1} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Pretopology.partialOrder.{u1, u2} C _inst_1 _inst_2)) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (CategoryTheory.GrothendieckTopology.partialOrder.{u1, u2} C _inst_1)) (CategoryTheory.Pretopology.toGrothendieck.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Pretopology.ofGrothendieck.{u1, u2} C _inst_1 _inst_2)
but is expected to have type
  forall (C : Type.{u2}) [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_2 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1], GaloisInsertion.{max u2 u1, max u2 u1} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Pretopology.instPartialOrderPretopology.{u1, u2} C _inst_1 _inst_2)) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (CategoryTheory.GrothendieckTopology.instPartialOrderGrothendieckTopology.{u1, u2} C _inst_1)) (CategoryTheory.Pretopology.toGrothendieck.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Pretopology.ofGrothendieck.{u1, u2} C _inst_1 _inst_2)
Case conversion may be inaccurate. Consider using '#align category_theory.pretopology.gi CategoryTheory.Pretopology.giₓ'. -/
/-- We have a galois insertion from pretopologies to Grothendieck topologies. -/
def gi : GaloisInsertion (toGrothendieck C) (ofGrothendieck C)
    where
  gc K J := by
    constructor
    · intro h X R hR
      exact h _ ⟨_, hR, sieve.le_generate R⟩
    · rintro h X S ⟨R, hR, RS⟩
      apply J.superset_covering _ (h _ hR)
      rwa [sieve.gi_generate.gc]
  le_l_u J X S hS := ⟨S, J.superset_covering S.le_generate hS, le_rfl⟩
  choice x hx := toGrothendieck C x
  choice_eq _ _ := rfl
#align category_theory.pretopology.gi CategoryTheory.Pretopology.gi

#print CategoryTheory.Pretopology.trivial /-
/--
The trivial pretopology, in which the coverings are exactly singleton isomorphisms. This topology is
also known as the indiscrete, coarse, or chaotic topology.

See <https://stacks.math.columbia.edu/tag/07GE>
-/
def trivial : Pretopology C
    where
  coverings X S := ∃ (Y : _)(f : Y ⟶ X)(h : IsIso f), S = Presieve.singleton f
  has_isos X Y f i := ⟨_, _, i, rfl⟩
  pullbacks X Y f S := by
    rintro ⟨Z, g, i, rfl⟩
    refine' ⟨pullback g f, pullback.snd, _, _⟩
    · skip
      refine' ⟨⟨pullback.lift (f ≫ inv g) (𝟙 _) (by simp), ⟨_, by tidy⟩⟩⟩
      apply pullback.hom_ext
      · rw [assoc, pullback.lift_fst, ← pullback.condition_assoc]
        simp
      · simp
    · apply pullback_singleton
  Transitive := by
    rintro X S Ti ⟨Z, g, i, rfl⟩ hS
    rcases hS g (singleton_self g) with ⟨Y, f, i, hTi⟩
    refine' ⟨_, f ≫ g, _, _⟩
    · skip
      infer_instance
    ext (W k)
    constructor
    · rintro ⟨V, h, k, ⟨_⟩, hh, rfl⟩
      rw [hTi] at hh
      cases hh
      apply singleton.mk
    · rintro ⟨_⟩
      refine' bind_comp g presieve.singleton.mk _
      rw [hTi]
      apply presieve.singleton.mk
#align category_theory.pretopology.trivial CategoryTheory.Pretopology.trivial
-/

instance : OrderBot (Pretopology C) where
  bot := trivial C
  bot_le K X R := by
    rintro ⟨Y, f, hf, rfl⟩
    exact K.has_isos f

/- warning: category_theory.pretopology.to_grothendieck_bot -> CategoryTheory.Pretopology.toGrothendieck_bot is a dubious translation:
lean 3 declaration is
  forall (C : Type.{u2}) [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_2 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1], Eq.{max (succ u2) (succ u1)} (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (CategoryTheory.Pretopology.toGrothendieck.{u1, u2} C _inst_1 _inst_2 (Bot.bot.{max u2 u1} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (OrderBot.toHasBot.{max u2 u1} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Pretopology.hasLe.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Pretopology.orderBot.{u1, u2} C _inst_1 _inst_2)))) (Bot.bot.{max u2 u1} (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (CompleteLattice.toHasBot.{max u2 u1} (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (CategoryTheory.GrothendieckTopology.completeLattice.{u1, u2} C _inst_1)))
but is expected to have type
  forall (C : Type.{u2}) [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_2 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1], Eq.{max (succ u2) (succ u1)} (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (CategoryTheory.Pretopology.toGrothendieck.{u1, u2} C _inst_1 _inst_2 (Bot.bot.{max u2 u1} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (OrderBot.toBot.{max u2 u1} (CategoryTheory.Pretopology.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Pretopology.LE.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Pretopology.instOrderBotPretopologyLE.{u1, u2} C _inst_1 _inst_2)))) (Bot.bot.{max u2 u1} (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (CompleteLattice.toBot.{max u2 u1} (CategoryTheory.GrothendieckTopology.{u1, u2} C _inst_1) (CategoryTheory.GrothendieckTopology.instCompleteLatticeGrothendieckTopology.{u1, u2} C _inst_1)))
Case conversion may be inaccurate. Consider using '#align category_theory.pretopology.to_grothendieck_bot CategoryTheory.Pretopology.toGrothendieck_botₓ'. -/
/-- The trivial pretopology induces the trivial grothendieck topology. -/
theorem toGrothendieck_bot : toGrothendieck C ⊥ = ⊥ :=
  (gi C).gc.l_bot
#align category_theory.pretopology.to_grothendieck_bot CategoryTheory.Pretopology.toGrothendieck_bot

end Pretopology

end CategoryTheory


import data.complex.basic

namespace cau_seq

theorem const_inv {α β : Type*} [discrete_field β] [discrete_linear_ordered_field α] {abv : β → α}
  [is_absolute_value abv] {x : β} (hx : x ≠ 0) :
  const abv (x⁻¹) = inv (const abv x) (by rwa const_lim_zero) :=
 ext (assume n, by simp[inv_apply, const_apply])

end cau_seq

namespace complex
open cau_seq

lemma re_const_equiv_of_const_equiv {f : ℕ → ℂ} (hf : is_cau_seq abs f) (z : ℂ) :
    cau_seq.const abs z ≈ ⟨f, hf⟩ → cau_seq.const _root_.abs z.re ≈ ⟨(λ (n : ℕ), (f n).re),
    complex.is_cau_seq_re ⟨f,hf⟩⟩ := begin
  assume h,assume ε ε0,cases h ε ε0 with i hi,existsi i,assume j ji,
  replace hi := hi j ji, simp at *, rw [←complex.neg_re,←complex.add_re],
  exact lt_of_le_of_lt (complex.abs_re_le_abs _) hi,
end

lemma im_const_equiv_of_const_equiv {f : ℕ → ℂ} (hf : is_cau_seq abs f) (z : ℂ) :
    cau_seq.const abs z ≈ ⟨f, hf⟩ → cau_seq.const _root_.abs z.im ≈ ⟨(λ (n : ℕ), (f n).im),
    complex.is_cau_seq_im ⟨f,hf⟩⟩ := begin
  assume h,assume ε ε0,cases h ε ε0 with i hi,existsi i,assume j ji,
  replace hi := hi j ji, simp at *, rw [←complex.neg_im,←complex.add_im],
  exact lt_of_le_of_lt (complex.abs_im_le_abs _) hi,
end

lemma eq_lim_of_const_equiv {f : cau_seq ℂ abs}  {z: ℂ} :
    cau_seq.const complex.abs z ≈ f → z = complex.lim f := begin
  assume h,
  unfold complex.lim,cases z with zre zim,simp,
  split, have := real.equiv_lim ⟨(λ (n : ℕ), (f.1 n).re), complex.is_cau_seq_re f⟩,
  rw ←cau_seq.const_equiv,simp at this,
  have hf := complex.re_const_equiv_of_const_equiv f.2 {re := zre, im := zim} h,simp at hf,
  exact setoid.trans hf this,
  have := real.equiv_lim ⟨(λ (n : ℕ), (f.1 n).im), complex.is_cau_seq_im f⟩,
  rw ←cau_seq.const_equiv,simp at this,
  have hf := complex.im_const_equiv_of_const_equiv f.2 {re := zre, im := zim} h,simp at hf,
  exact setoid.trans hf this,
end

lemma lim_eq_of_equiv_const {f : cau_seq ℂ complex.abs} {x : ℂ} (h : f ≈ cau_seq.const complex.abs x) : lim f = x :=
(eq_lim_of_const_equiv $ setoid.symm h).symm

lemma lim_eq_lim_of_equiv {f g : cau_seq ℂ complex.abs} (h : f ≈ g) : lim f = lim g :=
lim_eq_of_equiv_const $ setoid.trans h $ equiv_lim g

@[simp] lemma lim_const (x : ℂ) : lim (const abs x) = x :=
lim_eq_of_equiv_const $ setoid.refl _

lemma lim_add (f g : cau_seq ℂ complex.abs) : lim f + lim g = lim ⇑(f + g) :=
eq_lim_of_const_equiv $ show lim_zero (const complex.abs (lim ⇑f + lim ⇑g) - (f + g)),
  by rw [const_add, add_sub_comm];
  exact add_lim_zero (setoid.symm (equiv_lim f)) (setoid.symm (equiv_lim g))

lemma lim_mul_lim (f g : cau_seq ℂ complex.abs) : lim f * lim g = lim ⇑(f * g) :=
eq_lim_of_const_equiv $ show lim_zero (const complex.abs (lim ⇑f * lim ⇑g) - f * g),
  from have h : const complex.abs (lim ⇑f * lim ⇑g) - f * g = g * (const complex.abs (lim f) - f)
      + const complex.abs (lim f) * (const complex.abs (lim g) - g) :=
    by simp [mul_sub, mul_comm, const_mul, mul_add],
  by rw h; exact add_lim_zero (mul_lim_zero _ (setoid.symm (equiv_lim f)))
      (mul_lim_zero _ (setoid.symm (equiv_lim g)))

lemma lim_mul (f : cau_seq ℂ complex.abs) (x : ℂ) : lim f * x = lim ⇑(f * const complex.abs x) :=
by rw [← lim_mul_lim, lim_const]

lemma lim_neg (f : cau_seq ℂ complex.abs) : lim ⇑(-f) = -lim f :=
lim_eq_of_equiv_const (show lim_zero (-f - const complex.abs (-lim ⇑f)),
  by rw [const_neg, sub_neg_eq_add, add_comm];
  exact setoid.symm (equiv_lim f))

lemma lim_eq_zero_iff (f : cau_seq ℂ complex.abs) : lim f = 0 ↔ lim_zero f :=
⟨assume h,
  by have hf := equiv_lim f;
  rw h at hf;
  exact (lim_zero_congr hf).mpr (const_lim_zero.mpr rfl),
assume h,
  have h₁ : f = (f - const complex.abs (0 : ℂ)) := cau_seq.ext (λ n, by simp [sub_apply, const_apply]),
  by rw h₁ at h; exact lim_eq_of_equiv_const h ⟩

lemma lim_inv {f : cau_seq ℂ complex.abs} (hf : ¬ lim_zero f) : lim ⇑(inv f hf) = (lim f)⁻¹ :=
have hl : lim f ≠ 0 := by rwa ← lim_eq_zero_iff at hf,
lim_eq_of_equiv_const $ show lim_zero (inv f hf - const abs (lim ⇑f)⁻¹),
  from have h₁ : ∀ (g f : cau_seq ℂ abs) (hf : ¬ lim_zero f), lim_zero (g - f * inv f hf * g) :=
    λ g f hf, by rw [← one_mul g, ← mul_assoc, ← sub_mul, mul_one, mul_comm, mul_comm f];
    exact mul_lim_zero _ (setoid.symm (cau_seq.inv_mul_cancel _)),
  have h₂ : lim_zero ((inv f hf - const abs (lim ⇑f)⁻¹) - (const abs (lim f) - f) *
      (inv f hf * const abs (lim ⇑f)⁻¹)) :=
    by rw [sub_mul, ← sub_add, sub_sub, sub_add_eq_sub_sub, sub_right_comm, sub_add];
    exact show lim_zero (inv f hf - const abs (lim ⇑f) * (inv f hf * const abs (lim ⇑f)⁻¹)
      - (const abs (lim ⇑f)⁻¹ - f * (inv f hf * const abs (lim ⇑f)⁻¹))),
    from sub_lim_zero
      (by rw [← mul_assoc, mul_right_comm, cau_seq.const_inv hl]; exact h₁ _ _ _)
      (by rw [← mul_assoc]; exact h₁ _ _ _),
  (lim_zero_congr h₂).mpr $ by rw mul_comm; exact mul_lim_zero _ (setoid.symm (equiv_lim f))

end complex


/-
Copyright 2021 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.measurable_space

import measure_theory.measure_space
import measure_theory.outer_measure
import measure_theory.lebesgue_measure
import measure_theory.integration

import measure_theory.borel_space
import data.set.countable
import formal_ml.nnreal
import formal_ml.sum
import formal_ml.lattice
import formal_ml.measurable_space
import formal_ml.classical
import data.equiv.list
import formal_ml.probability_space
import formal_ml.prod_probability_space
import formal_ml.random_variable_independent_pair
import formal_ml.random_variable_identical_IID

/- This file introduces the uniform probability space over a finite outcome type.
   This is in turn used to define a uniform distribution over permutations. -/

--Probably stay here.------------------------

noncomputable def set.cardF {α:Type*} [F:fintype α] (s:set α):nat :=
  (@set.to_finset α s (@subtype.fintype α s (classical.decidable_pred s) F)).card

lemma set.univ_cardF_eq_fintype_card {α:Type*} [F:fintype α]:
  (@set.univ α).cardF = fintype.card α := begin
  simp [set.cardF],
  have h1:
    @finset.filter α (@set.univ α) (λ (a : α), @set.univ_decidable α a) (@finset.univ α F) =
    (@finset.univ α F),
  { ext1 a, split; intros A1; simp, },
  rw h1,
  simp [fintype.card],
end

lemma finset.disjoint_card_sum {α β:Type*} [decidable_eq α] [fintype α] [decidable_eq β]
  (f:β → finset α) (h:pairwise (disjoint on f)) (t:finset β):∀ (s:finset α),
  (⋃ (x:β) (h2:x∈ t), (@coe (finset α) (set α) _ (f x))) = ↑s → (s.card = t.sum (λ x, (f x).card)) := begin
  classical,
  apply finset.induction_on t,
  { intros s h1, simp, simp at h1,
    rw finset.ext_iff,
    intros a,
    rw set.ext_iff at h1,
    have h2 := h1 a,
    simp at h2,
    simp,
    apply h2 },
  { intros a s h3 h4 t' h5,
    rw finset.sum_insert,
    simp at h5,
    have h6:(f a) ∪ ((⋃ (x : β) (H : x ∈ s), ↑(f x)).to_finset) = t',
    { rw set.ext_iff at h5,
      rw finset.ext_iff,
      intros a',
      have h6_1 := h5 a',
      rw finset.mem_coe at h6_1,
      rw ← h6_1,
      split; intros h6_2; simp at h6_2; simp [h6_2] },
    rw ← h4 ((⋃ (x : β) (H : x ∈ s), ↑(f x)).to_finset),
    rw ← finset.card_union_eq,
    rw h6,
    rw disjoint_iff,
    simp, ext x, split; intros h1, simp at h1, cases h1 with h1 h2,
    cases h2 with i h2,
    cases h2 with h2 h7,
    have h8:i ≠ a,
    { intros contra,
       subst i, apply h3, apply h2,  },

    have h9 := h i a h8,
    simp [function.on_fun] at h9,
    rw disjoint_iff at h9,
    simp at h9,
    rw ← h9,
    simp [h1, h7],
    exfalso,
    apply h1,
    simp,
    apply h3,
         },

end

def semiring.of_nat_hom (α:Type*) [semiring α]:nat →+* α := {
  to_fun := coe,
  map_one' := begin
    simp,
  end,
  map_mul' := begin
   intros x y,
   simp,
  end,
  map_add' := begin
    intros x y,
    simp,
  end,
  map_zero' := begin
    simp,
  end
}

lemma finset.prod_coe_nat {α β:Type*} [comm_semiring α] {s:finset β} {f:β → nat}:
  (@coe nat α _) (s.prod f) = s.prod (λ (b:β), (@coe nat α _) (f b)) := begin
  have h1:(@coe nat α _) = (semiring.of_nat_hom α).to_fun,
  { refl },
  rw h1,
  simp,
end

lemma finset.sum_coe_nat {α β:Type*} [comm_semiring α] {s:finset β} {f:β → nat}:
  (@coe nat α _) (s.sum f) = s.sum (λ (b:β), (@coe nat α _) (f b)) := begin
  have h1:(@coe nat α _) = ⇑(semiring.of_nat_hom α),
  { refl },
  rw h1,
  rw ring_hom.map_sum,
end

/- TODO: reverse direction if you get a chance. -/
lemma disjoint_to_finset_iff {α:Type*} [F:fintype α] [decidable_eq α]
  {s t:set α} [decidable_pred s] [decidable_pred t]:disjoint s t ↔ disjoint (s.to_finset) (t.to_finset) :=
begin
  rw disjoint_iff,
  rw disjoint_iff,
  rw set.ext_iff,
  rw finset.ext_iff,
  simp, split; intros h1 x; have h2 := h1 x,
  { split; intros h3, apply absurd h3.right,
    apply h2, apply h3.left,  exfalso, apply h3 },
  { intros h3 h4, have h5 := and.intro h3 h4,
    rw h2 at h5, apply h5 },
end

---DEFINITELY stay here.--------------------

noncomputable def uniform_measure (α:Type*) [F:fintype α]:
  @measure_theory.measure α ⊤  := @measure_theory.measure.of_measurable α ⊤
  (λ (s:set α) (h:@measurable_set α ⊤ s),
  ((s.cardF):ennreal)/((fintype.card α):ennreal))
begin
  simp [set.cardF],
end
begin
  classical,
  intros f h_meas h_disjoint,
  let s:finset α := (⋃ (i : ℕ), f i).to_finset,
  begin
    simp,
    have h0:s = (⋃ (i : ℕ), f i).to_finset := rfl,
    rw div_eq_mul_inv,
    have h2:(λ (i:ℕ), (((f i).cardF):ennreal) / ((@fintype.card α F):ennreal)) =
         λ (i:ℕ), (((f i).cardF):ennreal) * ((@fintype.card α F):ennreal)⁻¹,
    { ext1 i, rw div_eq_mul_inv },
    rw h2,
    rw ennreal.tsum_mul_right,
    have h3:↑((@set.Union α ℕ f).cardF) = (∑' (i : ℕ), ↑((f i).cardF)),
    {

       have h4:∀ (x:α), ∃ (i:ℕ), x∈ s → x ∈ f i,
       { intros x, cases classical.em (x ∈ s) with h4_1 h4_1,
         rw h0 at h4_1,simp at h4_1, cases h4_1 with i h4_1,
         apply exists.intro i, intros h4_2, apply h4_1,
         apply exists.intro 0, intros h4_2, apply absurd h4_2, apply h4_1,  },
       rw classical.skolem at h4,
       cases h4 with g h4,
       let t := s.image g,
       rw @tsum_eq_sum ennreal ℕ _ _ _ _ t,
       have h5:s.card = (@set.Union α ℕ f).cardF,
       { simp [set.cardF], have h5_1:(λ (x : α), ∃ (i : ℕ), x ∈ f i) = (set.Union f),
         { ext;split; intros A1; simp at A1; cases A1 with i A1;
           simp; apply exists.intro i; apply A1, },
         rw h5_1,  },
       rw ← h5,
       rw ← finset.sum_coe_nat,
       simp only [nat.cast_inj, set.cardF],
       rw ← finset.disjoint_card_sum,
       { intros i j h_ne, simp [function.on_fun], rw ← disjoint_to_finset_iff,
         apply h_disjoint, apply h_ne },
       { simp, ext a, split, intros h6, simp at h6, simp,
         { cases h6 with a' h6,  cases h6 with h6 h7,
           apply exists.intro (g a'), apply h7 },
         { intros h6, simp, apply exists.intro a, split,
           { simp at h6, apply h6 },
           { apply h4, simp [s], simp at h6, apply h6 }, } },
         intros i h8,
         have h9:f i = ∅,
         { ext a, split; intros A1,
           exfalso, apply h8,
           have h9_1:a ∈ s,
           { simp [s], apply exists.intro i, apply A1 },
           have h9_2:a∈ f (g a) := h4 a h9_1,
           have h9_3:g a = i,
           { apply by_contradiction,
             intros h9_3_1,
             have h9_3_2:disjoint (f (g a)) (f i),
             { apply h_disjoint, apply h9_3_1, },
             rw disjoint_iff at h9_3_2,
             simp at h9_3_2,
             have h9_3_3:a∈ (f (g a)) ∩ (f i),
             { simp, apply and.intro h9_2 A1 },
             rw h9_3_2 at h9_3_3,
             apply h9_3_3 },
           subst i, simp [t], apply exists.intro a,
           split,
           apply exists.intro (g a),
           apply A1, refl, exfalso, apply A1 },
         rw h9,
         simp [set.cardF], refl,
     },
     rw h3,
  end
end

lemma uniform_measure_apply (α:Type*) [F:fintype α] (s:set α):
  (uniform_measure α) s =
  ((s.cardF):ennreal)/((fintype.card α):ennreal) := begin
  apply measure_theory.measure.of_measurable_apply,
  simp,
end

noncomputable def uniform_measure_space (α:Type*) [F:fintype α]:
  measure_theory.measure_space α := @measure_theory.measure_space.mk α ⊤
  (uniform_measure α)

lemma uniform_measure_space_apply (α:Type*) [F:fintype α] (s:set α):
  @measure_theory.measure_space.volume _ (uniform_measure_space α) s =
  ((s.cardF):ennreal)/((fintype.card α):ennreal) := begin
  have h1: (@measure_theory.measure_space.volume α (@uniform_measure_space α F)) =
           (uniform_measure α),
  { refl },
  rw h1,
  apply uniform_measure_apply,
end

lemma uniform_measure_space.to_measurable_space_eq_top (α:Type*) [F:fintype α]:
  (uniform_measure_space α).to_measurable_space = ⊤ := rfl

lemma uniform_measure_space.measurable_set'_all (α:Type*) [F:fintype α] (s:set α):
  (uniform_measure_space α).to_measurable_space.measurable_set' s := begin
  rw uniform_measure_space.to_measurable_space_eq_top,
  apply measurable_space.measurable_set_top,
end

/- DO NOT DELETE!
   There is already proven:
   1. permutations are finite.
   2. There cardinality is the factorial.
   This tells me we are on the right track! -/
#check fintype.card_perm

lemma fintype.card_ne_zero {α:Type*} [F:fintype α] [N:nonempty α]:
  ¬(fintype.card α = 0) := begin
  apply pos_iff_ne_zero.1,
  rw fintype.card_pos_iff,
  apply N,
end

noncomputable def uniform_probability_space (α:Type*) [F:fintype α] [N:nonempty α]:
  probability_space α := @probability_space.mk α (uniform_measure_space α)
begin
  simp,
  rw uniform_measure_space_apply,
  rw set.univ_cardF_eq_fintype_card,
  rw div_eq_mul_inv,
  apply ennreal.mul_inv_cancel,
  { simp, apply fintype.card_ne_zero },
  { simp },
end

lemma uniform_probability_space.to_measurable_space_eq_top (α:Type*) [F:fintype α] [NE:nonempty α]:
  (uniform_probability_space α).to_measurable_space = ⊤ := rfl

lemma uniform_probability_space.to_measure_space_eq (α:Type*) [F:fintype α] [NE:nonempty α]:
  (uniform_probability_space α).to_measure_space = uniform_measure_space α := rfl

lemma uniform_probability_space.measurable_set'_all (α:Type*) [F:fintype α] [nonempty α] (s:set α):
  (uniform_probability_space α).to_measurable_space.measurable_set' s := begin
  rw uniform_probability_space.to_measurable_space_eq_top,
  apply measurable_space.measurable_set_top,
end

def uniform_event {α:Type*} (s:set α) [F:fintype α] [N:nonempty α]:
  event (uniform_probability_space α) := {
  val := s,
  property := begin
    apply uniform_probability_space.measurable_set'_all,
  end
}

def uniform_probability_space.measurable_all {α β:Type*} [F:fintype α] [nonempty α]
(M:measurable_space β) (f:α → β):@measurable α β
  (uniform_probability_space α).to_measurable_space M f := begin
  intros S h1,
  apply uniform_probability_space.measurable_set'_all,
end

lemma uniform_probability_space_apply' (α:Type*) [F:fintype α] [nonempty α] (s:event (uniform_probability_space α)):
  Pr[s] =
  ((s.val.cardF):nnreal)/((fintype.card α):nnreal) := begin
  rw ← ennreal.coe_eq_coe,
  rw event_prob_def,
  rw uniform_probability_space.to_measure_space_eq,
  simp,
  rw ← subtype.val_eq_coe,
  rw @uniform_measure_space_apply α F s.val,
  rw ennreal.coe_div,
  have h1:∀ (n:ℕ), (@coe nnreal ennreal _ (@coe nat nnreal _ n)) = (@coe nat ennreal _ n),
  { simp },
  rw h1,
  rw h1,
  simp,
  apply fintype.card_ne_zero,
end

lemma uniform_probability_space_apply (α:Type*) [F:fintype α] [nonempty α] (s:set α):
  Pr[uniform_event s] =
  ((s.cardF):nnreal)/((fintype.card α):nnreal) := begin
  apply uniform_probability_space_apply',
end

def uniform_rv {α:Type*} [F:fintype α] [N:nonempty α] (M:measurable_space α):
  (uniform_probability_space α) →ᵣ M := {
  val := id,
  property := begin
    apply uniform_probability_space.measurable_all,
  end
}

def is_uniform_rv {Ω α:Type*} {P:probability_space Ω} [F:fintype α] {M:measurable_space α}
  (X:P →ᵣ M):Prop := ∀ (S:measurable_setB M),
  Pr[X ∈ᵣ S] = ((S.val.cardF):nnreal)/((fintype.card α):nnreal)

@[simp]
lemma is_uniform_rv_uniform_rv {α:Type*} [F:fintype α] [N:nonempty α] (M:measurable_space α):
  is_uniform_rv (uniform_rv M) := begin
  intros S,
  let S':= uniform_event S.val,
  begin
    have h1:@uniform_rv α F N M ∈ᵣ S = S',
    { apply event.eq, simp [uniform_rv, S', uniform_event], },
    rw h1,
    rw uniform_probability_space_apply,
  end
end

def nonempty_perm {α:Type*}:nonempty (equiv.perm α) := nonempty.intro (equiv.refl α)

def uniform_perm_rv (α:Type*) [D:decidable_eq α] [F:fintype α] (M:measurable_space (equiv.perm α)):_ →ᵣ M :=
  --(@uniform_probability_space (equiv.perm α) (@fintype_perm α D F) nonempty_perm) →ᵣ M :=
  @uniform_rv (equiv.perm α) (@fintype_perm α D F) nonempty_perm M

lemma is_uniform_rv_uniform_perm_rv {α:Type*} [F:fintype α] [N:decidable_eq α]
  (M:measurable_space (equiv.perm α)):
  @is_uniform_rv _ (equiv.perm α) _ (@fintype_perm α N F) _ (@uniform_perm_rv α N F M) := begin
  apply is_uniform_rv_uniform_rv,
end

lemma select_rv_union_helper {Ω α γ:Type*} [fintype α] [decidable_eq α] {P:probability_space Ω}
   {M:measurable_space γ} (TM:top_measurable α)
   (X:α → P →ᵣ M) (Y:P →ᵣ (TM.to_measurable_space)) (S:set γ):
   ((λ (ω : Ω), (X (Y.val ω)).val ω) ⁻¹' S) =
      ⋃ (a:α), ((Y.val ⁻¹' {a}) ∩ ((X a).val ⁻¹' S)) := begin
  ext1 ω,split; intros h1; simp at h1; simp [h1],
end

def select_rv {Ω α γ:Type*} [fintype α] [decidable_eq α] {P:probability_space Ω}
 {M:measurable_space γ}
 {TM:top_measurable α} (X:α → P →ᵣ M) (Y:P →ᵣ TM.to_measurable_space):
  P →ᵣ M := {
  val := (λ ω:Ω, (X (Y.val ω)).val ω),
  property := begin
    intros S h1,
    have h2:((λ (ω : Ω), (X (Y.val ω)).val ω) ⁻¹' S) =
      ⋃ (a:α), ((Y.val ⁻¹' {a}) ∩ ((X a).val ⁻¹' S)),
    { apply select_rv_union_helper },
    rw h2,
    haveI:encodable α := fintype.encodable α,
    apply measurable_set.Union,
    intros a,
    apply measurable_set.inter,
    apply Y.property,
    apply TM.all_measurable,
    apply (X a).property,
    apply h1,
  end
}

lemma select_rv_apply {Ω α γ:Type*} [fintype α] [decidable_eq α] {P:probability_space Ω}
   {M:measurable_space γ} {TM:top_measurable α}
   (X:α → P →ᵣ M) (Y:P →ᵣ (TM.to_measurable_space)) (S:measurable_setB M):
   (select_rv X Y ∈ᵣ S) = (∃ᵣ (a:α), ((Y =ᵣ a) ∧ ((X a) ∈ᵣ S))) := begin
  apply event.eq,
  simp [select_rv],
  ext; split; intros h1; simp at h1; simp [h1],
end

def perm_value_rv {Ω α:Type*} [fintype α] [decidable_eq α] {P:probability_space Ω}
  {TMp:top_measurable (equiv.perm α)}
  (Y:P →ᵣ (TMp.to_measurable_space)) (a:α)
  (M:measurable_space α):
  P →ᵣ M := {
  val := (λ ω:Ω, (Y.val ω) a),
  property := begin
    classical,
    intros S A1,
    let T := {p:equiv.perm α|p a ∈ S},
    begin
      have h1:((λ (ω : Ω), (Y.val ω) a) ⁻¹' S) = ⋃ (p∈ T), ((Y.val) ⁻¹' {p}),
      { ext ω, split; intros h1_1; simp [T] at h1_1; simp [h1_1,T] },
      rw h1,
      haveI:encodable (equiv.perm α) := fintype.encodable (equiv.perm α),
      apply measurable_set.Union,
      intros p,
      apply measurable_set.Union_Prop,
      intros h2,
      apply Y.property,
      apply TMp.all_measurable,
    end
  end
}

lemma perm_value_rv_apply {Ω α:Type*} [fintype α] [decidable_eq α] {P:probability_space Ω}
  {TMp:top_measurable (equiv.perm α)}
  (Y:P →ᵣ (TMp.to_measurable_space)) (a:α)
  (M:measurable_space α) (S:measurable_setB M)
  [D:decidable_pred (λ (p:equiv.perm α), p a ∈ S.val)]:
  (perm_value_rv Y a M) ∈ᵣ S =
   ∃ᵣ (p:equiv.perm α) in (set.to_finset (λ (p:equiv.perm α), p a ∈ S.val)),
    (Y =ᵣ p) :=
begin
  apply event.eq, ext ω, split; intros h1; simp [perm_value_rv] at h1;
  simp [perm_value_rv, h1]; apply h1,
end

--set_option pp.implicit true
lemma perm_value_rv_independent {Ω α κ:Type*} [fintype α] [decidable_eq α] {P:probability_space Ω}
  {TMp:top_measurable (equiv.perm α)}
  {Mκ:measurable_space κ}
  (Y:P →ᵣ (TMp.to_measurable_space)) (a:α) (X:P →ᵣ Mκ)
  (M:measurable_space α):
  random_variable_independent_pair X Y →
  random_variable_independent_pair X (perm_value_rv Y a M) :=
begin
  classical,
  intro h1,
  intros S T,
  rw perm_value_rv_apply,
  apply independent_event_pair_exists,
  { intros p h2,
    have h3:Y =ᵣ ↑p = Y ∈ᵣ ({p}:set (equiv.perm α)),
    { apply equal_eq_mem },
    rw h3,
    apply h1 },
  intros i h2 j h3 h_ne,
  simp [function.on_fun, disjoint_iff],

  { ext ω, split; intros h3,
   { simp at h3, exfalso, apply h_ne,
     cases h3, subst i, subst j },
   { exfalso, apply h3 } },
end

def permute_rv {Ω α γ:Type*} [fintype α] [decidable_eq α] {P:probability_space Ω}
   {TM:top_measurable (equiv.perm α)}
    {M:measurable_space γ} (X:α → P →ᵣ M) (perm:P →ᵣ TM.to_measurable_space)
     (TMα:top_measurable α):
   α → P  →ᵣ M := (λ (a:α), select_rv X (perm_value_rv perm a TMα))

lemma permute_rv_identical {Ω α γ:Type*} [F:fintype α] [decidable_eq α]
  {P:probability_space Ω}
   {M:measurable_space γ} {TM:top_measurable (equiv.perm α)}
  (TMα:top_measurable α)
  (X:α → P →ᵣ M) (perm:P →ᵣ (TM.to_measurable_space)):
  (∀ (a:α), random_variable_independent_pair perm (X a)) →
  (∀ (a a':α), random_variable_identical (X a) (X a')) →
  (∀ (a a':α), random_variable_identical (X a) ((permute_rv X perm TMα) a'))
   := begin
  intros h1 h2 a a',
  simp [permute_rv],
  intros S,
  rw select_rv_apply,
  have h3:eany_finset finset.univ (λ (a : α), perm_value_rv perm a' TMα =ᵣ a∧X a ∈ᵣ S)
           = (∃ᵣ (a : α), perm_value_rv perm a' TMα =ᵣ a∧X a ∈ᵣ S),
  {
    apply event.eq, simp,
  },
  rw ← h3,
  haveI:encodable α := fintype.encodable α,
  rw Pr_sum_disjoint_eq,
  have h4:(λ (b : α), Pr[perm_value_rv perm a' TMα =ᵣ b∧X b ∈ᵣ S]) =
    (λ (b : α), Pr[perm_value_rv perm a' TMα =ᵣ b] * Pr[X a ∈ᵣ S]),
  { ext b,
    have h4_1:random_variable_independent_pair (X b) perm,
    { apply random_variable_independent_pair.symm, apply (h1 b), },
    have h4_2 := perm_value_rv_independent perm a' (X b) TMα.to_measurable_space h4_1,
    have h4_3:(perm_value_rv perm a' TMα =ᵣ b) =
              perm_value_rv perm a' TMα ∈ᵣ (measurable_setB_top {b}),
    { apply equal_eq_mem },
    rw h4_3,
    have h4_4:independent_event_pair
                (perm_value_rv perm a' TMα ∈ᵣ (measurable_setB_top {b})) (X b ∈ᵣ S),
    { apply random_variable_independent_pair.symm,
      apply h4_2, },
    unfold independent_event_pair at h4_4,
    rw h4_4,
    --rw mul_comm,
    simp,
    left, apply h2 b a,
     },
   rw h4,
   rw ← @finset.sum_mul α nnreal finset.univ,
   rw  Pr_sum_univ_eq_one,
   simp,
   intros i j h_ne,
   rw function.on_fun,
   rw disjoint_iff,
   simp,
   ext ω, split; intros A1; simp at A1; simp [A1],
   apply h_ne,
   rw ← A1.left.left,
   rw ← A1.right.left,
   apply false.elim A1,
end

lemma random_variables_independent_proj {Ω α β γ:Type*} [fintype α] [fintype β]
  (P:probability_space Ω) (M:measurable_space γ) (X:α → P →ᵣ M) (f:β → α):
  (function.injective f) →
  (random_variable_independent X) →
  (random_variable_independent (λ (b:β), X (f b))) := begin
  classical,
  intros h1 h2,
  intros g T,
  simp,
  have h3:∀ (a:α), ∃ (S:measurable_setB M), ∀ (b:β), (f b = a) → (g b = S),
  { intros a, cases classical.em (∃ (b:β), f b = a) with h3_1 h3_1,
    { cases h3_1 with b h3_1,
      apply exists.intro (g b),
      intros b' h_b',
      rw ← h3_1 at h_b',
      have h3_2 := h1 h_b', rw h3_2 },
    { apply exists.intro measurable_setB_univ,
      intros b'  h_b',
      exfalso,
      apply h3_1,
      apply exists.intro b',
      apply h_b' }, },
  have h4 := classical.axiom_of_choice h3,
  cases h4 with g' h4,
  have h5:∀ (b:β), g b = g' (f b),
  { intros b, apply h4 (f b) b _, refl },
  have h6:(λ (b : β), Pr[X (f b) ∈ᵣ g b]) = (λ (a:α), Pr[X a ∈ᵣ g' a]) ∘ f,
  { ext1 b, simp, rw h5 },
  rw h6,
  have h7:T.prod ((λ (a:α), Pr[X a ∈ᵣ g' a]) ∘ f) = (T.image f).prod (λ (a:α), Pr[X a ∈ᵣ g' a]),
  { rw finset.prod_image, intros b h_b b' h_b' h_eq,
    apply h1, apply h_eq },
  rw h7,
  have h8: (∀ᵣ (s : β) in T,X (f s) ∈ᵣ g s) = (∀ᵣ (a:α) in (T.image f), X a ∈ᵣ g' a),
  { apply event.eq, simp, ext ω, split; intros h8_1; simp at h8_1; simp [h8_1];
    intros i h_i,
    { rw ← h5, apply h8_1 i h_i },
    { rw h5, apply h8_1 i h_i } },
  rw h8,
  apply h2,
end

lemma random_variables_IID_proj {Ω α β γ:Type*} [fintype α] [fintype β]
  (P:probability_space Ω) (M:measurable_space γ) (X:α → P →ᵣ M) (f:β → α):
  (function.injective f) →
  (random_variables_IID X) →
  (random_variables_IID (λ (b:β), X (f b))) := begin
  intros h1 h2, split,
  { apply random_variables_independent_proj, apply h1, apply h2.left },
  intros i j,
  apply h2.right,
end

lemma random_variable_independent_pair_combine_apply {Ω α γ κ:Type*}
  [F:fintype α]
  {P:probability_space Ω}
   {M:measurable_space γ} {Mκ:measurable_space κ}
  (X:P →ᵣ Mκ) (Y:α → P →ᵣ M) (a:α):
  random_variable_independent_pair X (pi.random_variable_combine Y) →
  random_variable_independent_pair X (Y a) := begin
  intros h1,
  intros S₁ S₂,
  have h2:(Y a ∈ᵣ S₂) = ((mf_pi (λ (a:α), M) a) ∘r (pi.random_variable_combine Y)) ∈ᵣ S₂,
  { apply event.eq, simp, split; intros h2_1; simp at h2_1; simp at h2_1, },
  rw h2,
  rw rv_compose_measurable_setB,
  apply h1,
end

lemma pairwise_disjoint_left {Ω α:Type*}
  {P:probability_space Ω}
  {E F:α → event P}:
  (pairwise (disjoint on (λ a, (E a).val))) →
 (pairwise (disjoint on (λ a, (E a ∧ F a).val))) := begin
  intros h1,
  intros i j h_eq,
  have h2 := h1 i j h_eq,
  simp [function.on_fun],
  simp [function.on_fun] at h2,
  rw disjoint_iff,
  rw disjoint_iff at h2,
  simp,
  rw ← set.subset_empty_iff,
  apply set.subset.trans,
  apply set.inter_subset_inter,
  apply set.inter_subset_left,
  apply set.inter_subset_left,
  simp at h2,
  rw h2,
end

/- Take a given event: The arugment for this is that for any fixed permutation,
   the IID property holds. If we can show that this holds for every permutation,
   then we will be done. -/
lemma permute_rv_independent {Ω α γ:Type*} [F:fintype α] [D:decidable_eq α] [inhabited α]
  {P:probability_space Ω}
   {M:measurable_space γ} {TM:top_measurable (equiv.perm α)}
  {TMα:top_measurable α}
  (X:α → P →ᵣ M) (perm:P →ᵣ (TM.to_measurable_space)):
  (random_variable_independent_pair perm (pi.random_variable_combine X)) →
  (random_variables_IID X) →
  (random_variable_independent (permute_rv X perm TMα)) := begin
  intros h1 h2,
  intros S T,
  simp,
  let a := inhabited.default α,
  begin
    have h4:∀ (S:measurable_setB M), ∀ (a':α),
       Pr[X a' ∈ᵣ S] = Pr[X a ∈ᵣ S],
    { intros S a', apply h2.right a' a },
    have h_pair_ind:∀ (a':α), random_variable_independent_pair perm (X a'),
    { intros a', apply random_variable_independent_pair_combine_apply perm X a' h1 },
    have h5:∀ (S:measurable_setB M), ∀ (a':α),
       Pr[permute_rv X perm TMα a' ∈ᵣ S] = Pr[X a ∈ᵣ S],
    { intros S a', symmetry,
      have h5_1 := permute_rv_identical TMα X perm h_pair_ind _ a a',
      apply h5_1,
      apply h2.right },
    rw @finset.prod_congr α nnreal _ T _   (λ (b:α), Pr[X a ∈ᵣ S b]),
    have h7:(∀ᵣ (s : α) in T, permute_rv X perm TMα s ∈ᵣ S s) =
      eany_finset (finset.univ) (λ (p:equiv.perm α), (perm =ᵣ p) ∧
          (∀ᵣ (s : α) in (T.image p),X s ∈ᵣ S (p.inv_fun s))),
    { apply event.eq, ext ω, split; intros h7_1;
      simp [equiv_cancel_left, permute_rv, select_rv, perm_value_rv] at h7_1;
      simp [equiv_cancel_left, permute_rv, select_rv, perm_value_rv, h7_1]; intros i h_i,
      { rw equiv_cancel_left, apply h7_1 i h_i },
      { have h7_2 := h7_1  i h_i, rw equiv_cancel_left at h7_2, apply h7_2 } },
    rw h7,
    --haveI:fintype (equiv.perm α) := infer_instance,
    haveI E:encodable (equiv.perm α) := fintype.encodable (equiv.perm α),
    rw @Pr_sum_disjoint_eq Ω (equiv.perm α) P,
    have h8:(λ (b : equiv.perm α), Pr[perm =ᵣ ↑b∧∀ᵣ (s : α) in (T.image b),X s ∈ᵣ S (b.inv_fun s)]) =
       (λ (b : equiv.perm α), T.prod (λ a', Pr[X a ∈ᵣ S a']) * Pr[perm =ᵣ ↑b]),
    { ext1 b,
      have h8_1:independent_event_pair (perm =ᵣ b) (∀ᵣ (s : α) in (T.image b),X s ∈ᵣ S (b.inv_fun s)),
      { apply random_variable_independent_pair_apply h1,
        apply equal_eq_mem_exists,
        apply joint_random_variable_mem_exists X (T.image b) (S ∘ (b.inv_fun)),
         },
      unfold independent_event_pair at h8_1,
      rw h8_1,
      rw mul_comm,
      have h8_2:random_variable_independent X :=h2.left,
      have h8_3:independent_events (λ (s : α),X s ∈ᵣ S (b.inv_fun s)),
      { apply h8_2 },
      rw ← h8_3 (T.image b), rw finset.prod_image, simp,
      left,
      apply finset.prod_congr, refl, intros x h_x, rw equiv_cancel_left, apply h4,
      intros i h_i j h_j h_eq, simp at h_eq, apply h_eq },
    rw h8,
    rw finset.sum_distrib_left,
    have h9:finset.univ.sum (λ (a : equiv.perm α), Pr[perm =ᵣ ↑a]) = 1,
    { rw Pr_sum_univ_eq_one },
    rw h9,
    simp,
    { apply pairwise_disjoint_left, apply event_eq_disjoint },
    refl,
    { intros x h_x, rw h5 },
  end
end

lemma permute_rv_IID' {Ω α γ:Type*} [fintype α] [decidable_eq α] [I:inhabited α]
  {P:probability_space Ω}
   {M:measurable_space γ} {TM:top_measurable (equiv.perm α)}
  {TMα:top_measurable α}
  (X:α → P →ᵣ M) (perm:P →ᵣ (TM.to_measurable_space)):
  (random_variables_IID X) →
  (random_variable_independent_pair perm (pi.random_variable_combine X)) →
  (random_variables_IID (permute_rv X perm TMα)) := begin
  intros h1 h2,
  split,
  apply permute_rv_independent,
  apply h2,
  apply h1,
  have h4:∀ (a a'), random_variable_identical (X a) (permute_rv X perm TMα a'),
  { apply permute_rv_identical,
    intros a'',
    apply random_variable_independent_pair_combine_apply,
    apply h2,
    apply h1.right },
  intros i j,
  apply random_variable_identical.trans,
  apply random_variable_identical.symm,
  apply h4 (inhabited.default α) i,
  apply h4,
end

lemma permute_rv_IID {Ω α γ:Type*} [fintype α] [decidable_eq α] {P:probability_space Ω}
   {M:measurable_space γ} {TM:top_measurable (equiv.perm α)}
  {TMα:top_measurable α}
  (X:α → P →ᵣ M) (perm:P →ᵣ (TM.to_measurable_space)):
  (random_variables_IID X) →
  (random_variable_independent_pair perm (pi.random_variable_combine X)) →
  (random_variables_IID (permute_rv X perm TMα)) := begin
  classical,
  cases classical.em (nonempty α) with h1 h1,
  { haveI:inhabited α := classical.inhabited_of_nonempty h1,
    apply permute_rv_IID' },
  intros h2 h3, apply random_variables_IID_empty,
  apply h1,
end

/--
   This is a core result, that a partition of an IID random variable results in two independent
   random variables.
   It is not as trivial as it appears, as one must handle events that expose correlations
   within each set. Again, the monotone class theorem is useful.

   Note: functions do not have to be injective, nor does β₁ or β₂ have to be nonempty.
   However, this can be used to prove the case when they
   are not, as you can create an injective function as an intermediate step,
   and case-based analysis can handle the cases where β₁ or β₂ are empty. -/
lemma random_variables_independent_disjoint_proj {Ω α β₁ β₂ γ:Type*} [fintype α] [fintype β₁] [fintype β₂] [nonempty β₁] [nonempty β₂]
  (P:probability_space Ω) (M:measurable_space γ) (X:α → P →ᵣ M) (f₁:β₁ → α) (f₂:β₂ → α):
  (function.injective f₁) →
  (function.injective f₂) →
  (disjoint (set.range f₁) (set.range f₂)) →
  (random_variable_independent X) →
  (random_variable_independent_pair (pi.random_variable_combine (λ (b:β₁), X (f₁ b))) (pi.random_variable_combine (λ (b:β₂), X (f₂ b)))) := begin
  intros h1 h2 h_disjoint_range h3,
  haveI:encodable β₁ := fintype.encodable β₁,
  haveI:encodable β₂ := fintype.encodable β₂,
  apply random_variable_independent_pair_on_semialgebra' pi_base,
  apply pi_base_is_semialgebra,
  apply pi_base_is_semialgebra,
  apply pi_base_eq_measurable_space_pi,
  apply pi_base_eq_measurable_space_pi,
  intros T₁ T₂ h_T₁ h_T₂,
  unfold independent_event_pair,
  have h_T₁_def := pi_base_eq T₁ h_T₁,
  have h_T₂_def := pi_base_eq T₂ h_T₂,
  cases h_T₁_def with g₁ h_T₁_def,
  cases h_T₂_def with g₂ h_T₂_def,
  subst T₁,
  subst T₂,
  classical,
  let U₁:finset α := (finset.image f₁ (@finset.univ β₁ _)),
  let U₂:finset α := (finset.image f₂ (@finset.univ β₂ _)),
  begin
    have h_mem_U₁:∀ (a:α), a ∈ U₁ ↔ a ∈ (set.range f₁),
    { simp [U₁], },
    have h_mem_U₂:∀ (a:α), a ∈ U₂ ↔ a ∈ (set.range f₂),
    { simp [U₂], },
    have h_b₁_ne_b₂:∀ (b₁:β₁) (b₂:β₂), f₁ b₁ ≠ f₂ b₂,
    { intros b₁ b₂ h_contra,
      rw disjoint_iff at h_disjoint_range,
      simp at h_disjoint_range,
      rw ← set.subset_empty_iff at h_disjoint_range,
      rw set.subset_def at h_disjoint_range,
      apply h_disjoint_range (f₁ b₁),
      rw set.mem_inter_iff,
      split,
      simp,
      rw h_contra,
      simp },

    have h_disjoint:disjoint U₁ U₂,
    { rw disjoint_iff, simp, ext a, split; intros h_sub1,
      { exfalso,
        rw finset.mem_inter at h_sub1,
        rw h_mem_U₁ at h_sub1,
        rw h_mem_U₂ at h_sub1,
        rw ← set.mem_inter_iff at h_sub1,
        rw disjoint_iff at h_disjoint_range,
        simp at h_disjoint_range,
        rw ← set.subset_empty_iff at h_disjoint_range,
        rw set.subset_def at h_disjoint_range,
        --have h_disjoint_range_contra := h_disjoint_range a h_sub1,
        apply h_disjoint_range,
        apply h_sub1 },
      { exfalso, apply h_sub1 } },
    have h_inv:∀ (a:α), ∃ (S:measurable_setB M),
      (∀ (b:β₁), f₁ b = a → S = g₁ b) ∧ (∀ (b:β₂), f₂ b = a → S = g₂ b),
    { intros a,
      cases classical.em (∃ (b:β₁), f₁ b = a) with h_in_U₁ h_notin_U₁,
      { cases h_in_U₁ with b₁ h_b₁,
        subst a,
        apply exists.intro (g₁ b₁),
        split,
        { intros b₁' h_b₁', simp [h1] at h_b₁', subst b₁' },
        { intros b₂' h_b₂', exfalso, apply h_b₁_ne_b₂ b₁ b₂', rw h_b₂' } },
      -- If a is not in U₁, then we consider when it is in U₂.
      cases classical.em (∃ (b₂:β₂), f₂ b₂ = a) with h_in_U₂ h_notin_U₂,
      { cases h_in_U₂ with b₂ h_b₂,
        subst a,
        apply exists.intro (g₂ b₂),
        split,
        { intros b₁' h_b₁', exfalso, apply h_b₁_ne_b₂ b₁' b₂, rw h_b₁' },
        { intros b₂' h_b₂', simp [h2] at h_b₂', subst b₂' } },
      -- If a is not in U₁ or U₂, then just use the universal set.
      { apply exists.intro (∅:measurable_setB M),
         split,
         { intros b₁ h_b₁, exfalso, apply h_notin_U₁,
           apply exists.intro b₁, apply h_b₁ },
         { intros b₂ h_b₂, exfalso, apply h_notin_U₂,
           apply exists.intro b₂, apply h_b₂ } } },
    rw classical.skolem at h_inv,
    cases h_inv with g_inv h_inv,
    have h_inv₁:pi.random_variable_combine (λ (b : β₁), X (f₁ b)) ∈ᵣ
          set.pi_measurable (set.univ) g₁ = (∀ᵣ a in U₁, X a ∈ᵣ g_inv a),
    { apply event.eq, ext1 ω, split; intros h_sub1;
      simp [pi.random_variable_combine, set.pi_measurable,
            pi.measurable_fun] at h_sub1;
      simp [pi.random_variable_combine, set.pi_measurable,
            pi.measurable_fun, h_sub1];
      intros b₁,
      { rw (h_inv (f₁ b₁)).left b₁ _, apply h_sub1, refl },
      { rw ← (h_inv (f₁ b₁)).left b₁ _, apply h_sub1, refl } },
    rw h_inv₁,
    have h_inv₂:pi.random_variable_combine (λ (b : β₂), X (f₂ b)) ∈ᵣ
          set.pi_measurable (set.univ) g₂ = (∀ᵣ a in U₂, X a ∈ᵣ g_inv a),
    { apply event.eq, ext1 ω, split; intros h_sub1;
      simp [pi.random_variable_combine, set.pi_measurable,
            pi.measurable_fun] at h_sub1;
      simp [pi.random_variable_combine, set.pi_measurable,
            pi.measurable_fun, h_sub1];
      intros b₂,
      { rw (h_inv (f₂ b₂)).right b₂ _, apply h_sub1, refl },
      { rw ← (h_inv (f₂ b₂)).right b₂ _, apply h_sub1, refl }, },
    rw h_inv₂,
    have h_union:((∀ᵣ (a : α) in U₁,X a ∈ᵣ g_inv a)∧(∀ᵣ (a : α) in U₂,X a ∈ᵣ g_inv a))
      = (∀ᵣ (a : α) in (U₁∪ U₂),X a ∈ᵣ g_inv a),
    { apply event.eq, ext1 ω, split; intros h_sub1; simp at h_sub1; simp [h_sub1],
      -- Simplification solves one direction.
      intros a h_sub2, cases h_sub2 with h_in_U₁ h_in_U₂,
      { cases h_in_U₁ with b₁ h_b₁, subst a, apply h_sub1.left },
      { cases h_in_U₂ with b₂ h_b₂, subst a, apply h_sub1.right } },
    rw h_union,
    rw ← h3 g_inv U₁,
    rw ← h3 g_inv U₂,
    rw ← h3 g_inv (U₁ ∪ U₂),
    rw finset.prod_union,
    apply h_disjoint,
  end
end


import mathlib.group
import group_theory.group_action.defs

/-!
# Pi instances for multiplicative actions

This file defines instances for mul_action and related structures on Pi types.

## See also

* `group_theory.group_action.prod`
* `group_theory.group_action.sigma`
* `group_theory.group_action.sum`
-/

open pi

universes u v w
variable {I : Prop}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances
variables (x y : Π i, f i) (i : I)

namespace pi_Prop

@[to_additive pi_Prop.has_vadd]
instance has_smul {α : Type*} [Π i, has_smul α $ f i] :
  has_smul α (Π i : I, f i) :=
⟨λ s x, λ i, s • (x i)⟩

@[to_additive]
lemma smul_def {α : Type*} [Π i, has_smul α $ f i] (s : α) : s • x = λ i, s • x i := rfl
@[simp, to_additive]
lemma smul_apply {α : Type*} [Π i, has_smul α $ f i] (s : α) : (s • x) i = s • x i := rfl

@[to_additive pi_Prop.has_vadd']
instance has_smul' {g : I → Type*} [Π i, has_smul (f i) (g i)] :
  has_smul (Π i, f i) (Π i : I, g i) :=
⟨λ s x, λ i, (s i) • (x i)⟩

@[simp, to_additive]
lemma smul_apply' {g : I → Type*} [∀ i, has_smul (f i) (g i)] (s : Π i, f i) (x : Π i, g i) :
  (s • x) i = s i • x i :=
rfl
instance is_scalar_tower {α β : Type*}
  [has_smul α β] [Π i, has_smul β $ f i] [Π i, has_smul α $ f i]
  [Π i, is_scalar_tower α β (f i)] : is_scalar_tower α β (Π i : I, f i) :=
⟨λ x y z, funext $ λ i, smul_assoc x y (z i)⟩

instance is_scalar_tower' {g : I → Type*} {α : Type*}
  [Π i, has_smul α $ f i] [Π i, has_smul (f i) (g i)] [Π i, has_smul α $ g i]
  [Π i, is_scalar_tower α (f i) (g i)] : is_scalar_tower α (Π i : I, f i) (Π i : I, g i) :=
⟨λ x y z, funext $ λ i, smul_assoc x (y i) (z i)⟩

instance is_scalar_tower'' {g : I → Type*} {h : I → Type*}
  [Π i, has_smul (f i) (g i)] [Π i, has_smul (g i) (h i)] [Π i, has_smul (f i) (h i)]
  [Π i, is_scalar_tower (f i) (g i) (h i)] : is_scalar_tower (Π i, f i) (Π i, g i) (Π i, h i) :=
⟨λ x y z, funext $ λ i, smul_assoc (x i) (y i) (z i)⟩

@[to_additive]
instance smul_comm_class {α β : Type*}
  [Π i, has_smul α $ f i] [Π i, has_smul β $ f i] [∀ i, smul_comm_class α β (f i)] :
  smul_comm_class α β (Π i : I, f i) :=
⟨λ x y z, funext $ λ i, smul_comm x y (z i)⟩

@[to_additive]
instance smul_comm_class' {g : I → Type*} {α : Type*}
  [Π i, has_smul α $ g i] [Π i, has_smul (f i) (g i)] [∀ i, smul_comm_class α (f i) (g i)] :
  smul_comm_class α (Π i : I, f i) (Π i : I, g i) :=
⟨λ x y z, funext $ λ i, smul_comm x (y i) (z i)⟩

@[to_additive]
instance smul_comm_class'' {g : I → Type*} {h : I → Type*}
  [Π i, has_smul (g i) (h i)] [Π i, has_smul (f i) (h i)]
  [∀ i, smul_comm_class (f i) (g i) (h i)] : smul_comm_class (Π i, f i) (Π i, g i) (Π i, h i) :=
⟨λ x y z, funext $ λ i, smul_comm (x i) (y i) (z i)⟩

instance {α : Type*} [Π i, has_smul α $ f i] [Π i, has_smul αᵐᵒᵖ $ f i]
  [∀ i, is_central_scalar α (f i)] : is_central_scalar α (Π i, f i) :=
⟨λ r m, funext $ λ i, op_smul_eq_smul _ _⟩

/-- If `f i` has a faithful scalar action for a given `i`, then so does `Π i, f i`. This is
not an instance as `i` cannot be inferred. -/
@[to_additive pi_Prop.has_faithful_vadd_at]
lemma has_faithful_smul_at {α : Type*}
  [Π i, has_smul α $ f i] [Π i, nonempty (f i)] (i : I) [has_faithful_smul α (f i)] :
  has_faithful_smul α (Π i, f i) :=
⟨λ x y h, eq_of_smul_eq_smul $ λ a : f i, begin
  classical,
  have := congr_fun (h $ function.update (λ j, classical.choice (‹Π i, nonempty (f i)› j)) i a) i,
  simpa using this,
end⟩

@[to_additive pi_Prop.has_faithful_vadd]
instance has_faithful_smul {α : Type*}
  [nonempty I] [Π i, has_smul α $ f i] [Π i, nonempty (f i)] [Π i, has_faithful_smul α (f i)] :
  has_faithful_smul α (Π i, f i) :=
let ⟨i⟩ := ‹nonempty I› in has_faithful_smul_at i

@[to_additive]
instance mul_action (α) {m : monoid α} [Π i, mul_action α $ f i] :
  @mul_action α (Π i : I, f i) m :=
{ smul := (•),
  mul_smul := λ r s f, funext $ λ i, mul_smul _ _ _,
  one_smul := λ f, funext $ λ i, one_smul α _ }

@[to_additive]
instance mul_action' {g : I → Type*} {m : Π i, monoid (f i)} [Π i, mul_action (f i) (g i)] :
  @mul_action (Π i, f i) (Π i : I, g i) (@pi_Prop.monoid I f m) :=
{ smul := (•),
  mul_smul := λ r s f, funext $ λ i, mul_smul _ _ _,
  one_smul := λ f, funext $ λ i, one_smul _ _ }

instance distrib_mul_action (α) {m : monoid α} {n : ∀ i, add_monoid $ f i}
  [∀ i, distrib_mul_action α $ f i] :
  @distrib_mul_action α (Π i : I, f i) m (@pi_Prop.add_monoid I f n) :=
{ smul_zero := λ c, funext $ λ i, smul_zero _,
  smul_add := λ c f g, funext $ λ i, smul_add _ _ _,
  ..pi_Prop.mul_action _ }

instance distrib_mul_action' {g : I → Type*} {m : Π i, monoid (f i)} {n : Π i, add_monoid $ g i}
  [Π i, distrib_mul_action (f i) (g i)] :
  @distrib_mul_action (Π i, f i) (Π i, g i) (@pi_Prop.monoid I f m) (@pi_Prop.add_monoid I g n) :=
{ smul_add := by { intros, ext x, apply smul_add },
  smul_zero := by { intros, ext x, apply smul_zero } }

instance mul_distrib_mul_action (α) {m : monoid α} {n : Π i, monoid $ f i}
  [Π i, mul_distrib_mul_action α $ f i] :
  @mul_distrib_mul_action α (Π i : I, f i) m (@pi_Prop.monoid I f n) :=
{ smul_one := λ c, funext $ λ i, smul_one _,
  smul_mul := λ c f g, funext $ λ i, smul_mul' _ _ _,
  ..pi_Prop.mul_action _ }

instance mul_distrib_mul_action' {g : I → Type*} {m : Π i, monoid (f i)} {n : Π i, monoid $ g i}
  [Π i, mul_distrib_mul_action (f i) (g i)] :
  @mul_distrib_mul_action (Π i, f i) (Π i, g i) (@pi_Prop.monoid I f m) (@pi_Prop.monoid I g n) :=
{ smul_mul := by { intros, ext x, apply smul_mul' },
  smul_one := by { intros, ext x, apply smul_one } }

end pi_Prop

namespace function_Prop

/-- Non-dependent version of `pi_Prop.has_smul`. Lean gets confused by the dependent instance if
this is not present. -/
@[to_additive]
instance has_smul {ι : Prop} {R M : Type*} [has_smul R M] : has_smul R (ι → M) := pi_Prop.has_smul

/-- Non-dependent version of `pi_Prop.smul_comm_class`. Lean gets confused by the dependent instance
if this is not present. -/
@[to_additive]
instance smul_comm_class {ι : Prop} {α β M : Type*} [has_smul α M] [has_smul β M]
  [smul_comm_class α β M] :
  smul_comm_class α β (ι → M) :=
pi_Prop.smul_comm_class

end function_Prop


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.Lean3Lib.data.vector
import Mathlib.data.list.nodup
import Mathlib.data.list.of_fn
import Mathlib.control.applicative
import Mathlib.PostPort

universes u_1 u_2 u u_3

namespace Mathlib

/-!
# Additional theorems about the `vector` type

This file introduces the infix notation `::ᵥ` for `vector.cons`.
-/

namespace vector

infixr:67 "::ᵥ" => Mathlib.vector.cons

protected instance inhabited {n : ℕ} {α : Type u_1} [Inhabited α] : Inhabited (vector α n) :=
  { default := of_fn fun (_x : fin n) => Inhabited.default }

theorem to_list_injective {n : ℕ} {α : Type u_1} : function.injective to_list :=
  subtype.val_injective

/-- Two `v w : vector α n` are equal iff they are equal at every single index. -/
theorem ext {n : ℕ} {α : Type u_1} {v : vector α n} {w : vector α n}
    (h : ∀ (m : fin n), nth v m = nth w m) : v = w :=
  sorry

/-- The empty `vector` is a `subsingleton`. -/
protected instance zero_subsingleton {α : Type u_1} : subsingleton (vector α 0) :=
  subsingleton.intro fun (_x _x_1 : vector α 0) => ext fun (m : fin 0) => fin.elim0 m

@[simp] theorem cons_val {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) :
    subtype.val (a::ᵥv) = a :: subtype.val v :=
  sorry

@[simp] theorem cons_head {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) : head (a::ᵥv) = a :=
  sorry

@[simp] theorem cons_tail {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) : tail (a::ᵥv) = v :=
  sorry

@[simp] theorem to_list_of_fn {α : Type u_1} {n : ℕ} (f : fin n → α) :
    to_list (of_fn f) = list.of_fn f :=
  sorry

@[simp] theorem mk_to_list {n : ℕ} {α : Type u_1} (v : vector α n)
    (h : list.length (to_list v) = n) : { val := to_list v, property := h } = v :=
  sorry

@[simp] theorem to_list_map {n : ℕ} {α : Type u_1} {β : Type u_2} (v : vector α n) (f : α → β) :
    to_list (map f v) = list.map f (to_list v) :=
  subtype.cases_on v
    fun (v_val : List α) (v_property : list.length v_val = n) =>
      Eq.refl (to_list (map f { val := v_val, property := v_property }))

theorem nth_eq_nth_le {n : ℕ} {α : Type u_1} (v : vector α n) (i : fin n) :
    nth v i =
        list.nth_le (to_list v) (subtype.val i)
          (eq.mpr
            (id (Eq._oldrec (Eq.refl (subtype.val i < list.length (to_list v))) (to_list_length v)))
            (subtype.property i)) :=
  subtype.cases_on v
    fun (v_val : List α) (v_property : list.length v_val = n) =>
      idRhs
        (nth { val := v_val, property := v_property } i =
          nth { val := v_val, property := v_property } i)
        rfl

@[simp] theorem nth_map {n : ℕ} {α : Type u_1} {β : Type u_2} (v : vector α n) (f : α → β)
    (i : fin n) : nth (map f v) i = f (nth v i) :=
  sorry

@[simp] theorem nth_of_fn {α : Type u_1} {n : ℕ} (f : fin n → α) (i : fin n) :
    nth (of_fn f) i = f i :=
  sorry

@[simp] theorem of_fn_nth {n : ℕ} {α : Type u_1} (v : vector α n) : of_fn (nth v) = v := sorry

@[simp] theorem nth_tail {n : ℕ} {α : Type u_1} (v : vector α (Nat.succ n)) (i : fin n) :
    nth (tail v) i = nth v (fin.succ i) :=
  sorry

@[simp] theorem tail_val {n : ℕ} {α : Type u_1} (v : vector α (Nat.succ n)) :
    subtype.val (tail v) = list.tail (subtype.val v) :=
  sorry

/-- The `tail` of a `nil` vector is `nil`. -/
@[simp] theorem tail_nil {α : Type u_1} : tail nil = nil := rfl

/-- The `tail` of a vector made up of one element is `nil`. -/
@[simp] theorem singleton_tail {α : Type u_1} (v : vector α 1) : tail v = nil :=
  eq.mpr (id (propext (eq_iff_true_of_subsingleton (tail v) nil))) trivial

@[simp] theorem tail_of_fn {α : Type u_1} {n : ℕ} (f : fin (Nat.succ n) → α) :
    tail (of_fn f) = of_fn fun (i : fin (Nat.succ n - 1)) => f (fin.succ i) :=
  sorry

/-- The list that makes up a `vector` made up of a single element,
retrieved via `to_list`, is equal to the list of that single element. -/
@[simp] theorem to_list_singleton {α : Type u_1} (v : vector α 1) : to_list v = [head v] := sorry

/-- Mapping under `id` does not change a vector. -/
@[simp] theorem map_id {α : Type u_1} {n : ℕ} (v : vector α n) : map id v = v := sorry

theorem mem_iff_nth {n : ℕ} {α : Type u_1} {a : α} {v : vector α n} :
    a ∈ to_list v ↔ ∃ (i : fin n), nth v i = a :=
  sorry

theorem nodup_iff_nth_inj {n : ℕ} {α : Type u_1} {v : vector α n} :
    list.nodup (to_list v) ↔ function.injective (nth v) :=
  sorry

@[simp] theorem nth_mem {n : ℕ} {α : Type u_1} (i : fin n) (v : vector α n) : nth v i ∈ to_list v :=
  sorry

theorem head'_to_list {n : ℕ} {α : Type u_1} (v : vector α (Nat.succ n)) :
    list.head' (to_list v) = some (head v) :=
  sorry

def reverse {n : ℕ} {α : Type u_1} (v : vector α n) : vector α n :=
  { val := list.reverse (to_list v), property := sorry }

/-- The `list` of a vector after a `reverse`, retrieved by `to_list` is equal
to the `list.reverse` after retrieving a vector's `to_list`. -/
theorem to_list_reverse {n : ℕ} {α : Type u_1} {v : vector α n} :
    to_list (reverse v) = list.reverse (to_list v) :=
  rfl

@[simp] theorem nth_zero {n : ℕ} {α : Type u_1} (v : vector α (Nat.succ n)) : nth v 0 = head v :=
  sorry

@[simp] theorem head_of_fn {α : Type u_1} {n : ℕ} (f : fin (Nat.succ n) → α) :
    head (of_fn f) = f 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (head (of_fn f) = f 0)) (Eq.symm (nth_zero (of_fn f)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nth (of_fn f) 0 = f 0)) (nth_of_fn f 0))) (Eq.refl (f 0)))

@[simp] theorem nth_cons_zero {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) : nth (a::ᵥv) 0 = a :=
  sorry

/-- Accessing the `nth` element of a vector made up
of one element `x : α` is `x` itself. -/
@[simp] theorem nth_cons_nil {α : Type u_1} {ix : fin 1} (x : α) : nth (x::ᵥnil) ix = x := sorry

@[simp] theorem nth_cons_succ {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) (i : fin n) :
    nth (a::ᵥv) (fin.succ i) = nth v i :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (nth (a::ᵥv) (fin.succ i) = nth v i)) (Eq.symm (nth_tail (a::ᵥv) i))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nth (tail (a::ᵥv)) i = nth v i)) (tail_cons a v)))
      (Eq.refl (nth v i)))

/-- The last element of a `vector`, given that the vector is at least one element. -/
def last {n : ℕ} {α : Type u_1} (v : vector α (n + 1)) : α := nth v (fin.last n)

/-- The last element of a `vector`, given that the vector is at least one element. -/
theorem last_def {n : ℕ} {α : Type u_1} {v : vector α (n + 1)} : last v = nth v (fin.last n) := rfl

/-- The `last` element of a vector is the `head` of the `reverse` vector. -/
theorem reverse_nth_zero {n : ℕ} {α : Type u_1} {v : vector α (n + 1)} :
    head (reverse v) = last v :=
  sorry

/--
Construct a `vector β (n + 1)` from a `vector α n` by scanning `f : β → α → β`
from the "left", that is, from 0 to `fin.last n`, using `b : β` as the starting value.
-/
def scanl {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) (v : vector α n) :
    vector β (n + 1) :=
  { val := list.scanl f b (to_list v), property := sorry }

/-- Providing an empty vector to `scanl` gives the starting value `b : β`. -/
@[simp] theorem scanl_nil {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) :
    scanl f b nil = b::ᵥnil :=
  rfl

/--
The recursive step of `scanl` splits a vector `x ::ᵥ v : vector α (n + 1)`
into the provided starting value `b : β` and the recursed `scanl`
`f b x : β` as the starting value.

This lemma is the `cons` version of `scanl_nth`.
-/
@[simp] theorem scanl_cons {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β)
    (v : vector α n) (x : α) : scanl f b (x::ᵥv) = b::ᵥscanl f (f b x) v :=
  sorry

/--
The underlying `list` of a `vector` after a `scanl` is the `list.scanl`
of the underlying `list` of the original `vector`.
-/
@[simp] theorem scanl_val {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β)
    {v : vector α n} : subtype.val (scanl f b v) = list.scanl f b (subtype.val v) :=
  sorry

/--
The `to_list` of a `vector` after a `scanl` is the `list.scanl`
of the `to_list` of the original `vector`.
-/
@[simp] theorem to_list_scanl {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β)
    (v : vector α n) : to_list (scanl f b v) = list.scanl f b (to_list v) :=
  rfl

/--
The recursive step of `scanl` splits a vector made up of a single element
`x ::ᵥ nil : vector α 1` into a `vector` of the provided starting value `b : β`
and the mapped `f b x : β` as the last value.
-/
@[simp] theorem scanl_singleton {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β)
    (v : vector α 1) : scanl f b v = b::ᵥf b (head v)::ᵥnil :=
  sorry

/--
The first element of `scanl` of a vector `v : vector α n`,
retrieved via `head`, is the starting value `b : β`.
-/
@[simp] theorem scanl_head {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β)
    (v : vector α n) : head (scanl f b v) = b :=
  sorry

/--
For an index `i : fin n`, the `nth` element of `scanl` of a
vector `v : vector α n` at `i.succ`, is equal to the application
function `f : β → α → β` of the `i.cast_succ` element of
`scanl f b v` and `nth v i`.

This lemma is the `nth` version of `scanl_cons`.
-/
@[simp] theorem scanl_nth {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β)
    (v : vector α n) (i : fin n) :
    nth (scanl f b v) (fin.succ i) = f (nth (scanl f b v) (coe_fn fin.cast_succ i)) (nth v i) :=
  sorry

def m_of_fn {m : Type u → Type u_1} [Monad m] {α : Type u} {n : ℕ} :
    (fin n → m α) → m (vector α n) :=
  sorry

theorem m_of_fn_pure {m : Type u_1 → Type u_2} [Monad m] [is_lawful_monad m] {α : Type u_1} {n : ℕ}
    (f : fin n → α) : (m_of_fn fun (i : fin n) => pure (f i)) = pure (of_fn f) :=
  sorry

def mmap {m : Type u → Type u_1} [Monad m] {α : Type u_2} {β : Type u} (f : α → m β) {n : ℕ} :
    vector α n → m (vector β n) :=
  sorry

@[simp] theorem mmap_nil {m : Type u_1 → Type u_2} [Monad m] {α : Type u_3} {β : Type u_1}
    (f : α → m β) : mmap f nil = pure nil :=
  rfl

@[simp] theorem mmap_cons {m : Type u_1 → Type u_2} [Monad m] {α : Type u_3} {β : Type u_1}
    (f : α → m β) (a : α) {n : ℕ} (v : vector α n) :
    mmap f (a::ᵥv) =
        do
          let h' ← f a
          let t' ← mmap f v
          pure (h'::ᵥt') :=
  sorry

/-- Define `C v` by induction on `v : vector α (n + 1)`, a vector of
at least one element.
This function has two arguments: `h0` handles the base case on `C nil`,
and `hs` defines the inductive step using `∀ x : α, C v → C (x ::ᵥ v)`. -/
def induction_on {α : Type u_1} {n : ℕ} {C : {n : ℕ} → vector α n → Sort u_2} (v : vector α (n + 1))
    (h0 : C nil) (hs : {n : ℕ} → {x : α} → {w : vector α n} → C w → C (x::ᵥw)) : C v :=
  Nat.rec (fun (v : vector α (0 + 1)) => eq.mpr sorry (eq.mpr sorry (hs h0)))
    (fun (n : ℕ) (hn : (v : vector α (n + 1)) → C v) (v : vector α (Nat.succ n + 1)) =>
      eq.mpr sorry (hs (hn (tail v))))
    n v

def to_array {n : ℕ} {α : Type u_1} : vector α n → array n α := sorry

def insert_nth {n : ℕ} {α : Type u_1} (a : α) (i : fin (n + 1)) (v : vector α n) :
    vector α (n + 1) :=
  { val := list.insert_nth (↑i) a (subtype.val v), property := sorry }

theorem insert_nth_val {n : ℕ} {α : Type u_1} {a : α} {i : fin (n + 1)} {v : vector α n} :
    subtype.val (insert_nth a i v) = list.insert_nth (subtype.val i) a (subtype.val v) :=
  rfl

@[simp] theorem remove_nth_val {n : ℕ} {α : Type u_1} {i : fin n} {v : vector α n} :
    subtype.val (remove_nth i v) = list.remove_nth (subtype.val v) ↑i :=
  sorry

theorem remove_nth_insert_nth {n : ℕ} {α : Type u_1} {a : α} {v : vector α n} {i : fin (n + 1)} :
    remove_nth i (insert_nth a i v) = v :=
  subtype.eq (list.remove_nth_insert_nth (subtype.val i) (subtype.val v))

theorem remove_nth_insert_nth_ne {n : ℕ} {α : Type u_1} {a : α} {v : vector α (n + 1)}
    {i : fin (n + bit0 1)} {j : fin (n + bit0 1)} (h : i ≠ j) :
    remove_nth i (insert_nth a j v) =
        insert_nth a (fin.pred_above i j (ne.symm h)) (remove_nth (fin.pred_above j i h) v) :=
  sorry

theorem insert_nth_comm {n : ℕ} {α : Type u_1} (a : α) (b : α) (i : fin (n + 1)) (j : fin (n + 1))
    (h : i ≤ j) (v : vector α n) :
    insert_nth b (fin.succ j) (insert_nth a i v) =
        insert_nth a (coe_fn fin.cast_succ i) (insert_nth b j v) :=
  sorry

/-- `update_nth v n a` replaces the `n`th element of `v` with `a` -/
def update_nth {n : ℕ} {α : Type u_1} (v : vector α n) (i : fin n) (a : α) : vector α n :=
  { val := list.update_nth (subtype.val v) (subtype.val i) a, property := sorry }

@[simp] theorem nth_update_nth_same {n : ℕ} {α : Type u_1} (v : vector α n) (i : fin n) (a : α) :
    nth (update_nth v i a) i = a :=
  sorry

theorem nth_update_nth_of_ne {n : ℕ} {α : Type u_1} {v : vector α n} {i : fin n} {j : fin n}
    (h : i ≠ j) (a : α) : nth (update_nth v i a) j = nth v j :=
  sorry

theorem nth_update_nth_eq_if {n : ℕ} {α : Type u_1} {v : vector α n} {i : fin n} {j : fin n}
    (a : α) : nth (update_nth v i a) j = ite (i = j) a (nth v j) :=
  sorry

end vector

namespace vector

protected def traverse {n : ℕ} {F : Type u → Type u} [Applicative F] {α : Type u} {β : Type u}
    (f : α → F β) : vector α n → F (vector β n) :=
  sorry

@[simp] protected theorem traverse_def {n : ℕ} {F : Type u → Type u} [Applicative F]
    [is_lawful_applicative F] {α : Type u} {β : Type u} (f : α → F β) (x : α) (xs : vector α n) :
    vector.traverse f (x::ᵥxs) = cons <$> f x <*> vector.traverse f xs :=
  subtype.cases_on xs
    fun (xs : List α) (xs_property : list.length xs = n) =>
      eq.drec
        (Eq.refl (vector.traverse f (x::ᵥ{ val := xs, property := Eq.refl (list.length xs) })))
        xs_property

protected theorem id_traverse {n : ℕ} {α : Type u} (x : vector α n) : vector.traverse id.mk x = x :=
  sorry

protected theorem comp_traverse {n : ℕ} {F : Type u → Type u} {G : Type u → Type u} [Applicative F]
    [Applicative G] [is_lawful_applicative F] [is_lawful_applicative G] {α : Type u} {β : Type u}
    {γ : Type u} (f : β → F γ) (g : α → G β) (x : vector α n) :
    vector.traverse (functor.comp.mk ∘ Functor.map f ∘ g) x =
        functor.comp.mk (vector.traverse f <$> vector.traverse g x) :=
  sorry

protected theorem traverse_eq_map_id {n : ℕ} {α : Type u_1} {β : Type u_1} (f : α → β)
    (x : vector α n) : vector.traverse (id.mk ∘ f) x = id.mk (map f x) :=
  sorry

protected theorem naturality {n : ℕ} {F : Type u → Type u} {G : Type u → Type u} [Applicative F]
    [Applicative G] [is_lawful_applicative F] [is_lawful_applicative G]
    (η : applicative_transformation F G) {α : Type u} {β : Type u} (f : α → F β) (x : vector α n) :
    coe_fn η (vector β n) (vector.traverse f x) = vector.traverse (coe_fn η β ∘ f) x :=
  sorry

protected instance flip.traversable {n : ℕ} : traversable (flip vector n) :=
  traversable.mk vector.traverse

protected instance flip.is_lawful_traversable {n : ℕ} : is_lawful_traversable (flip vector n) :=
  is_lawful_traversable.mk vector.id_traverse vector.comp_traverse vector.traverse_eq_map_id
    vector.naturality

end Mathlib


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.dynamics.fixed_points.basic
import Mathlib.data.set.lattice
import Mathlib.data.pnat.basic
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Periodic points

A point `x : α` is a periodic point of `f : α → α` of period `n` if `f^[n] x = x`.

## Main definitions

* `is_periodic_pt f n x` : `x` is a periodic point of `f` of period `n`, i.e. `f^[n] x = x`.
  We do not require `n > 0` in the definition.
* `pts_of_period f n` : the set `{x | is_periodic_pt f n x}`. Note that `n` is not required to
  be the minimal period of `x`.
* `periodic_pts f` : the set of all periodic points of `f`.
* `minimal_period f x` : the minimal period of a point `x` under an endomorphism `f` or zero
  if `x` is not a periodic point of `f`.

## Main statements

We provide “dot syntax”-style operations on terms of the form `h : is_periodic_pt f n x` including
arithmetic operations on `n` and `h.map (hg : semiconj_by g f f')`. We also prove that `f`
is bijective on each set `pts_of_period f n` and on `periodic_pts f`. Finally, we prove that `x`
is a periodic point of `f` of period `n` if and only if `minimal_period f x | n`.

## References

* https://en.wikipedia.org/wiki/Periodic_point

-/

namespace function

/-- A point `x` is a periodic point of `f : α → α` of period `n` if `f^[n] x = x`.
Note that we do not require `0 < n` in this definition. Many theorems about periodic points
need this assumption. -/
def is_periodic_pt {α : Type u_1} (f : α → α) (n : ℕ) (x : α) :=
  is_fixed_pt (nat.iterate f n) x

/-- A fixed point of `f` is a periodic point of `f` of any prescribed period. -/
theorem is_fixed_pt.is_periodic_pt {α : Type u_1} {f : α → α} {x : α} (hf : is_fixed_pt f x) (n : ℕ) : is_periodic_pt f n x :=
  is_fixed_pt.iterate hf n

/-- For the identity map, all points are periodic. -/
theorem is_periodic_id {α : Type u_1} (n : ℕ) (x : α) : is_periodic_pt id n x :=
  is_fixed_pt.is_periodic_pt (is_fixed_pt_id x) n

/-- Any point is a periodic point of period `0`. -/
theorem is_periodic_pt_zero {α : Type u_1} (f : α → α) (x : α) : is_periodic_pt f 0 x :=
  is_fixed_pt_id x

namespace is_periodic_pt

protected instance decidable {α : Type u_1} [DecidableEq α] {f : α → α} {n : ℕ} {x : α} : Decidable (is_periodic_pt f n x) :=
  is_fixed_pt.decidable

protected theorem is_fixed_pt {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hf : is_periodic_pt f n x) : is_fixed_pt (nat.iterate f n) x :=
  hf

protected theorem map {α : Type u_1} {β : Type u_2} {fa : α → α} {fb : β → β} {x : α} {n : ℕ} (hx : is_periodic_pt fa n x) {g : α → β} (hg : semiconj g fa fb) : is_periodic_pt fb n (g x) :=
  is_fixed_pt.map hx (semiconj.iterate_right hg n)

theorem apply_iterate {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hx : is_periodic_pt f n x) (m : ℕ) : is_periodic_pt f n (nat.iterate f m x) :=
  is_periodic_pt.map hx (commute.iterate_self f m)

protected theorem apply {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hx : is_periodic_pt f n x) : is_periodic_pt f n (f x) :=
  apply_iterate hx 1

protected theorem add {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hn : is_periodic_pt f n x) (hm : is_periodic_pt f m x) : is_periodic_pt f (n + m) x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_periodic_pt f (n + m) x)) (equations._eqn_1 f (n + m) x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_fixed_pt (nat.iterate f (n + m)) x)) (iterate_add f n m)))
      (is_fixed_pt.comp hn hm))

theorem left_of_add {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hn : is_periodic_pt f (n + m) x) (hm : is_periodic_pt f m x) : is_periodic_pt f n x := sorry

theorem right_of_add {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hn : is_periodic_pt f (n + m) x) (hm : is_periodic_pt f n x) : is_periodic_pt f m x :=
  left_of_add (eq.mp (Eq._oldrec (Eq.refl (is_periodic_pt f (n + m) x)) (add_comm n m)) hn) hm

protected theorem sub {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hm : is_periodic_pt f m x) (hn : is_periodic_pt f n x) : is_periodic_pt f (m - n) x := sorry

protected theorem mul_const {α : Type u_1} {f : α → α} {x : α} {m : ℕ} (hm : is_periodic_pt f m x) (n : ℕ) : is_periodic_pt f (m * n) x := sorry

protected theorem const_mul {α : Type u_1} {f : α → α} {x : α} {m : ℕ} (hm : is_periodic_pt f m x) (n : ℕ) : is_periodic_pt f (n * m) x := sorry

theorem trans_dvd {α : Type u_1} {f : α → α} {x : α} {m : ℕ} (hm : is_periodic_pt f m x) {n : ℕ} (hn : m ∣ n) : is_periodic_pt f n x := sorry

protected theorem iterate {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hf : is_periodic_pt f n x) (m : ℕ) : is_periodic_pt (nat.iterate f m) n x := sorry

protected theorem mod {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hm : is_periodic_pt f m x) (hn : is_periodic_pt f n x) : is_periodic_pt f (m % n) x :=
  left_of_add (eq.mp (Eq._oldrec (Eq.refl (is_periodic_pt f m x)) (Eq.symm (nat.mod_add_div m n))) hm)
    (is_periodic_pt.mul_const hn (m / n))

protected theorem gcd {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hm : is_periodic_pt f m x) (hn : is_periodic_pt f n x) : is_periodic_pt f (nat.gcd m n) x := sorry

/-- If `f` sends two periodic points `x` and `y` of the same positive period to the same point,
then `x = y`. For a similar statement about points of different periods see `eq_of_apply_eq`. -/
theorem eq_of_apply_eq_same {α : Type u_1} {f : α → α} {x : α} {y : α} {n : ℕ} (hx : is_periodic_pt f n x) (hy : is_periodic_pt f n y) (hn : 0 < n) (h : f x = f y) : x = y := sorry

/-- If `f` sends two periodic points `x` and `y` of positive periods to the same point,
then `x = y`. -/
theorem eq_of_apply_eq {α : Type u_1} {f : α → α} {x : α} {y : α} {m : ℕ} {n : ℕ} (hx : is_periodic_pt f m x) (hy : is_periodic_pt f n y) (hm : 0 < m) (hn : 0 < n) (h : f x = f y) : x = y :=
  eq_of_apply_eq_same (is_periodic_pt.mul_const hx n) (is_periodic_pt.const_mul hy m) (mul_pos hm hn) h

end is_periodic_pt

/-- The set of periodic points of a given (possibly non-minimal) period. -/
def pts_of_period {α : Type u_1} (f : α → α) (n : ℕ) : set α :=
  set_of fun (x : α) => is_periodic_pt f n x

@[simp] theorem mem_pts_of_period {α : Type u_1} {f : α → α} {x : α} {n : ℕ} : x ∈ pts_of_period f n ↔ is_periodic_pt f n x :=
  iff.rfl

theorem semiconj.maps_to_pts_of_period {α : Type u_1} {β : Type u_2} {fa : α → α} {fb : β → β} {g : α → β} (h : semiconj g fa fb) (n : ℕ) : set.maps_to g (pts_of_period fa n) (pts_of_period fb n) :=
  semiconj.maps_to_fixed_pts (semiconj.iterate_right h n)

theorem bij_on_pts_of_period {α : Type u_1} (f : α → α) {n : ℕ} (hn : 0 < n) : set.bij_on f (pts_of_period f n) (pts_of_period f n) := sorry

theorem directed_pts_of_period_pnat {α : Type u_1} (f : α → α) : directed has_subset.subset fun (n : ℕ+) => pts_of_period f ↑n := sorry

/-- The set of periodic points of a map `f : α → α`. -/
def periodic_pts {α : Type u_1} (f : α → α) : set α :=
  set_of fun (x : α) => ∃ (n : ℕ), ∃ (H : n > 0), is_periodic_pt f n x

theorem mk_mem_periodic_pts {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hn : 0 < n) (hx : is_periodic_pt f n x) : x ∈ periodic_pts f :=
  Exists.intro n (Exists.intro hn hx)

theorem mem_periodic_pts {α : Type u_1} {f : α → α} {x : α} : x ∈ periodic_pts f ↔ ∃ (n : ℕ), ∃ (H : n > 0), is_periodic_pt f n x :=
  iff.rfl

theorem bUnion_pts_of_period {α : Type u_1} (f : α → α) : (set.Union fun (n : ℕ) => set.Union fun (H : n > 0) => pts_of_period f n) = periodic_pts f := sorry

theorem Union_pnat_pts_of_period {α : Type u_1} (f : α → α) : (set.Union fun (n : ℕ+) => pts_of_period f ↑n) = periodic_pts f :=
  Eq.trans supr_subtype (bUnion_pts_of_period f)

theorem bij_on_periodic_pts {α : Type u_1} (f : α → α) : set.bij_on f (periodic_pts f) (periodic_pts f) :=
  Union_pnat_pts_of_period f ▸
    set.bij_on_Union_of_directed (directed_pts_of_period_pnat f) fun (i : ℕ+) => bij_on_pts_of_period f (pnat.pos i)

theorem semiconj.maps_to_periodic_pts {α : Type u_1} {β : Type u_2} {fa : α → α} {fb : β → β} {g : α → β} (h : semiconj g fa fb) : set.maps_to g (periodic_pts fa) (periodic_pts fb) := sorry

/-- Minimal period of a point `x` under an endomorphism `f`. If `x` is not a periodic point of `f`,
then `minimal_period f x = 0`. -/
def minimal_period {α : Type u_1} (f : α → α) (x : α) : ℕ :=
  dite (x ∈ periodic_pts f) (fun (h : x ∈ periodic_pts f) => nat.find h) fun (h : ¬x ∈ periodic_pts f) => 0

theorem is_periodic_pt_minimal_period {α : Type u_1} (f : α → α) (x : α) : is_periodic_pt f (minimal_period f x) x := sorry

theorem minimal_period_pos_of_mem_periodic_pts {α : Type u_1} {f : α → α} {x : α} (hx : x ∈ periodic_pts f) : 0 < minimal_period f x := sorry

theorem is_periodic_pt.minimal_period_pos {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hn : 0 < n) (hx : is_periodic_pt f n x) : 0 < minimal_period f x :=
  minimal_period_pos_of_mem_periodic_pts (mk_mem_periodic_pts hn hx)

theorem minimal_period_pos_iff_mem_periodic_pts {α : Type u_1} {f : α → α} {x : α} : 0 < minimal_period f x ↔ x ∈ periodic_pts f := sorry

theorem is_periodic_pt.minimal_period_le {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hn : 0 < n) (hx : is_periodic_pt f n x) : minimal_period f x ≤ n := sorry

theorem is_periodic_pt.eq_zero_of_lt_minimal_period {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hx : is_periodic_pt f n x) (hn : n < minimal_period f x) : n = 0 :=
  Eq.symm
    (or.resolve_right (eq_or_lt_of_le (nat.zero_le n))
      fun (hn0 : 0 < n) => iff.mpr not_lt (is_periodic_pt.minimal_period_le hn0 hx) hn)

theorem is_periodic_pt.minimal_period_dvd {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hx : is_periodic_pt f n x) : minimal_period f x ∣ n := sorry

theorem is_periodic_pt_iff_minimal_period_dvd {α : Type u_1} {f : α → α} {x : α} {n : ℕ} : is_periodic_pt f n x ↔ minimal_period f x ∣ n :=
  { mp := is_periodic_pt.minimal_period_dvd,
    mpr := fun (h : minimal_period f x ∣ n) => is_periodic_pt.trans_dvd (is_periodic_pt_minimal_period f x) h }


import tactic
import init.meta.expr
import init.meta.lean.parser

open tactic expr

-- Like expr.get_pis, but uses mvars instead of local variables.
meta def get_pi_mvars : expr → tactic (list expr × expr)
| (pi n bi d b)  :=
do mv ← mk_meta_var d,
   (mvs, b) ← get_pi_mvars (b.instantiate_var mv),
   pure (mv::mvs, b)
| e              := pure ([], e)

-- returns expr and its local variables
meta def mk_mvar_app_aux : expr → list expr → list expr → tactic (expr × list expr)
| g (m::ms) local_vars := do
  g ← instantiate_mvars g,
  (loc::locs, _) ← infer_type g >>= mk_local_pis,
  assigned ← is_assigned m,
  match assigned with
  | tt := mk_mvar_app_aux (app g m) ms local_vars
  | ff := do
    tm ← infer_type m,
    tm ← instantiate_mvars tm,
    tloc ← infer_type loc,
    unify tm tloc,
    unify m loc,
    mk_mvar_app_aux (app g loc) ms (loc::local_vars)
  end
| g [] local_vars := pure (g, list.reverse local_vars)

-- Given a function-type expression `f`, and a list of mvars `ms`, construct the application of `f` to `ms`
-- where assigned mvars are replaced by their instantiations and unassigned mvars are turned into local variables.
meta def mk_mvar_app : expr → list expr → tactic (expr × list expr) :=
λ e ms, mk_mvar_app_aux e ms []

-- Modus ponens in the `n`th argument of `f` usinf `g`.
meta def mp_nth_arg (f g : expr) (n : ℕ) : tactic expr :=
do tf ← infer_type f,
  tg ← infer_type g,
  (gmvs, gconc) ← get_pi_mvars tg,
  gtys ← mmap infer_type gmvs,
  let replace : list bool := list.map (= n) $ list.range (list.length gtys),
  match list.nth gtys n with
  | some t := do
    (fmvs, fconc) ← get_pi_mvars tf,
    unify fconc t,
    gmvs ← mmap (λ a, match a with
    | (m, tt) := do (app_of_list f <$> (mmap instantiate_mvars fmvs)) >>= unify m, pure m
    | (m, ff) := pure m
    end
    ) (list.zip gmvs replace),
    (res, locs) ← mk_mvar_app g gmvs,
    res ← instantiate_mvars res,
    pure $ expr.lambdas locs res
   | none := failed
   end

/- Apply modus ponens once in each argument in which it is possible, returning a list consisting of the results
   if possible and none otherwise. -/
meta def mp_core (f g : expr) : tactic (list (option expr)) :=
do tg ← infer_type g,
  let n := pi_arity tg,
  mmap (λ k, try_core $ mp_nth_arg f g k) (list.range n)

def option_list_to_list {α : Type*} (l : list (option α)) : list α :=
list.foldl list.append [] (list.map option.to_list l)

/- Apply modus ponens once in each argument in which it is possible, returning the list of results. -/
meta def mp_core' (f g : expr) : tactic (list expr) :=
option_list_to_list <$> mp_core f g

/- Define the interactive `mp` tactic-/

open interactive
open lean.parser (ident tk)

/- Turn numbers in strings to lowercase indices. -/
meta def to_lower_digits (s : string) : string :=
list.foldl (++) "" $
(list.map $ (λ (c : char), match to_string c with
| "0" := "₀"
| "1" := "₁"
| "2" := "₂"
| "3" := "₃"
| "4" := "₄"
| "5" := "₅"
| "6" := "₆"
| "7" := "₇"
| "8" := "₈"
| "9" := "₉"
| x := x
end
)) s.to_list

/- Apply the local hyposthesis `f` to an argument (assumption) of `g`, and add the resulting statements to the
   context, optionally using the name `nm` for the new hypotheses. If there are several possibilities, do it
   for each possibility once and add subscripts to the new hypothesis names. -/
meta def tactic.interactive.mp (f g : parse ident)
(nm : parse (optional (tk "with" *> ident)))
: tactic unit :=
-- Note: switched order w.r.t. to `mp_core`
let nm := nm.get_or_else `this in
do f ← get_local f,
  g ← get_local g,
  hs ← mp_core' g f,
  let num_new_hyps := list.length hs,
  let inds := list.range num_new_hyps,

  mmap ( λ (hi : expr × nat) ,
    match hi with
    | (h, i) := do
      let nm_i :=  mk_simple_name $ (name.to_string nm) ++ (to_lower_digits $ to_string i),
      let nm' := if num_new_hyps = 1 then nm else nm_i,
      interactive.have nm' none ``(%%h)
    end
  ) (list.zip hs inds),
  pure ()

/-- EXAMPLE -/

def P : ℕ → ℕ → Prop := sorry
def Q : ℕ → ℕ → ℕ → Prop := sorry

example (f : ∀ a, P a a) (g : ∀ a b c, P a b → P b c → Q a b c) (g' : ∀ a b, P a b → Q a a b): true :=
begin
  mp g f with H,        -- give the new hypotheses names starting with `H`
  mp g f,               -- use `this` instead
  mp g' f,              -- no indices if there is only one possibility
  mp H₀ f with HH₀,     -- can be applied multiple times
  mp H₁ f with HH₁,
  trivial
end

def PP : Prop := sorry
def QQ : Prop := sorry

/- The argument order was chosen such that `mp g f` is like `g(f)` or `g ∘ f` (but that can be changed). -/
example (f : PP) (g : PP → QQ) : QQ := by mp g f; assumption


import category_theory.limits.shapes.comm_sq

open category_theory.limits

namespace category_theory

variables {C : Type*} [category C]

namespace is_pushout

variables {Z X Y P : C} {f : Z ⟶ X} {g : Z ⟶ Y} {inl : X ⟶ P} {inr : Y ⟶ P}
/-
lemma of_horiz_is_iso [is_iso f] [is_iso inr] (sq : comm_sq f g inl inr) :
  is_pushout f g inl inr := of_is_colimit' sq
begin
  refine pushout_cocone.is_colimit.mk _ (λ s, inv inr ≫ s.inr) (λ s, _) (by tidy) (by tidy),
  simp only [← cancel_epi f, s.condition, sq.w_assoc, is_iso.hom_inv_id_assoc],
end

lemma of_vert_is_iso [is_iso g] [is_iso inl] (sq : comm_sq f g inl inr) :
  is_pushout f g inl inr := (of_horiz_is_iso sq.flip).flip-/

lemma of_coprod_inl_with_id {A B : C} (f : A ⟶ B) (X : C) [has_binary_coproduct A X]
  [has_binary_coproduct B X] :
  is_pushout coprod.inl f (coprod.map f (𝟙 X)) coprod.inl :=
is_pushout.of_is_colimit' (comm_sq.mk (coprod.inl_map _ _))
(pushout_cocone.is_colimit_aux _ (λ s, coprod.desc s.inr (coprod.inr ≫ s.inl))
(λ s, begin
  dsimp [comm_sq.cocone],
  ext,
  { simp only [coprod.map_desc, coprod.inl_desc, s.condition], },
  { simp only [coprod.map_desc, category.id_comp, coprod.inr_desc], },
end)
(λ s, by { dsimp [comm_sq.cocone], simp only [coprod.inl_desc], })
(λ s m hm, begin
  dsimp [comm_sq.cocone],
  ext,
  { simpa only [coprod.inl_desc] using hm walking_span.right, },
  { have h := coprod.inr ≫= hm walking_span.left,
    dsimp [comm_sq.cocone] at h,
    simpa only [coprod.inr_desc, coprod.inr_map_assoc, category.id_comp] using h, },
end))

end is_pushout

end category_theory