/-
Copyright (c) 2016 Jacob Gross. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jacob Gross, Jeremy Avigad

Limits, following Hölzl, Immler, and Huffman, "Type classes and filters for mathematical analysis
in Isabelle/HOL".

The central notion in this file is

  tendsto f F₂ F₁

which says that f "tends to" filter F₂, as the input "tends to" filter F₁.  If f : X → Y, F₁ is a
filter on X, and F₂ is a filter on Y.

We can then use notation like this:

  f ⟶ y [at x]

... which is actually a composition of two notations: the first describes the function and the
target filter, and the second desribes the source filter.

We define the following filters:

  nhds x                           := neighborhoods of x
  [at x within s] := at_within x s := neighborhoods of x intersected with s \ '{x}
  [at x]          := at_elt x      := [at x within univ]
  [at x-]         := at_left x     := [at x within '(-∞, x)
  [at x+]         := at_right x    := [at x within '(x, ∞)
  [at ∞]          := at_infty      := "neighborhoods" of ∞
  [at -∞]         := at_ninfty     := "neighborhoods" of -∞

We also define the following abbreviations and notatations for modes of convergence:

  f ⟶ y   := approaches f y     := tendsto f (nhds y)
  f ⟶ ∞   := approaches_infty f := tendsto f at_infty
  f ⟶ -∞  := approaches_ninfty  := tendsto f at_ninfty

Thus, for example, "f ⟶ y [at x]" denotes "tendsto f (nhds y) (at_elt x)".

Note that lambdas are needed for functions given by expressions, for example:

  (λ x, x^2) ⟶ 4 [at 2]
  (λ x, x^2) ⟶ ∞ [at -∞]

Using the theorems can take some getting used to. "tendsto f F₂ F₁" is equivalent to

  ∀ P : Y → Prop, eventually P F₂ → eventually (λ x, P (f x)) F₁

In terms of sets, this is equivalent to

  ∀ s : set Y, s ∈ sets F₂ → f '- s ∈ sets F₁

so one option is to use "tendsto_intro" "tendsto_dest" and "tendsto_iff" to unpack meanings
in terms of "eventually", and then use the intro and dest rules of "eventually". For specific
topologies -- for example, those given by a metric space or norm -- see the specialized
intro and dest rules for eventually in those files.

For "approaches", "approaches_infty", and "approaches_ninfty", there are specific intro, dest,
and iff rules. Again, see also specific versions for metric spaces, normed spaces, etc.

Note that the filters at_infty and at_ninfty don't rely on topological notions at all, only the
existence of a suitable order.

We mark tendsto as irreducible after defining the intro and dest rules, because otherwise
tactics seem to unfold too much.
-/
import data.set data.nat algebra.interval .basic
import theories.move   -- TODO: remove after move to Lean 3
open set function set.filter interval

namespace topology

variables {X Y Z : Type}

/- mapfilter -/

section
  local attribute mem [reducible]

  definition mapfilter (f : X → Y) (F : filter X) : filter Y :=
  ⦃ filter,
    sets          := λ s, (f '- s) ∈ F,
    univ_mem_sets := abstract !univ_mem_sets end,
    inter_closed  := abstract take a b, assume Ha Hb, !inter_closed Ha Hb end,
    is_mono       := abstract take a b, assume Hab Ha, !is_mono (λ x H, Hab (f x) H) Ha end
  ⦄
end

-- characterize mapfilter in terms of set membership

theorem mem_mapfilter_iff (s : set Y) (F : filter X) (f : X → Y) :
  s ∈  mapfilter f F ↔ (f '- s) ∈ F :=
!iff.refl

theorem mem_mapfilter {s : set Y} {F : filter X} {f : X → Y} (H : f '- s ∈ F) :
  s ∈ mapfilter f F := H

theorem preimage_mem_filter_of_mem_mapfilter {s : set Y} {F : filter X} {f : X → Y}
    (H : s ∈ mapfilter f F) :
  f '- s ∈ F := H

-- characterize mapfilter in terms of predicates and eventually

theorem eventually_mapfilter_iff (P : Y → Prop) (F : filter X) (f : X → Y) :
  eventually P (mapfilter f F) ↔ eventually (λ x, P (f x)) F :=
!iff.refl

theorem eventually_mapfilter {P : Y → Prop} {F : filter X} {f : X → Y}
    (H : eventually (λ x, P (f x)) F) :
  eventually P (mapfilter f F) := H

theorem eventually_of_eventually_mapfilter {P : Y → Prop} {F : filter X} {f : X → Y}
    (H : eventually P (mapfilter f F)) :
  eventually (λ x, P (f x)) F:= H

-- other properties

theorem mapfilter_id (F : filter Y) : mapfilter (λ x, x) F = F := filter.eq rfl

theorem mapfilter_comp (F : filter X) (g : Y → Z) (f : X → Y) :
  mapfilter (g ∘ f) F = mapfilter g (mapfilter f F) := rfl

theorem mapfilter_le_mapfilter {F F' : filter X} (f : X → Y) (H : F ≤ F') :
  mapfilter f F ≤ mapfilter f F' :=
begin
  rewrite filter.le_iff, intro s, rewrite *mem_mapfilter_iff,
  apply filter.subset_of_le H
end
-- alternative proof: take s, assume H', by unfold mem; exact H H'

theorem mapfilter_bot (f : X → Y) : mapfilter f ⊥ = ⊥ :=
filter.eq (by rewrite *filter.bot_eq)

theorem mapfilter_sup (f : X → Y) (F F' : filter X) :
  mapfilter f (sup F F') = sup (mapfilter f F) (mapfilter f F') :=
filter.eq (ext (take x, !iff.refl))

theorem mapfilter_inf (f : X → Y) (F F' : filter X) :
  mapfilter f (inf F F') ≤ inf (mapfilter f F) (mapfilter f F') :=
le_inf (mapfilter_le_mapfilter f !inf_le_left) (mapfilter_le_mapfilter f !inf_le_right)

/- tendsto -/

definition tendsto (f : X → Y) (F₂ : filter Y) (F₁ : filter X) : Prop := mapfilter f F₁ ≤ F₂

theorem tendsto_intro' {F₂ : filter Y} {F₁ : filter X} {f : X → Y}
    (H : ∀ P, eventually P F₂ → eventually P (mapfilter f F₁)) :
  tendsto f F₂ F₁ := H

theorem tendsto_intro {F₂ : filter Y} {F₁ : filter X} {f : X → Y}
    (H : ∀ P, eventually P F₂ → eventually (λ x, P (f x)) F₁) :
  tendsto f F₂ F₁ := H

theorem tendsto_dest' {F₂ : filter Y} {F₁ : filter X} {f : X → Y}
    {P : Y → Prop} (H : tendsto f F₂ F₁) (H' : eventually P F₂) :
  eventually P (mapfilter f F₁) := H H'

theorem tendsto_dest {F₂ : filter Y} {F₁ : filter X} {f : X → Y}
    {P : Y → Prop} (H : tendsto f F₂ F₁) (H' : eventually P F₂) :
  eventually (λ x, P (f x)) F₁ := eventually_of_eventually_mapfilter (tendsto_dest' H H')

theorem tendsto_iff' (F₂ : filter Y) (F₁ : filter X) (f : X → Y) :
  tendsto f F₂ F₁ ↔ (∀ P, eventually P F₂ → eventually P (mapfilter f F₁)) :=
iff.refl _

theorem tendsto_iff (F₂ : filter Y) (F₁ : filter X) (f : X → Y) :
  tendsto f F₂ F₁ ↔ (∀ P, eventually P F₂ → eventually (λ x, P (f x)) F₁) :=
iff.refl _

theorem tendsto_comp {f : X → Y} {g : Y → Z} {F₁ : filter X} {F₂ : filter Y} {F₃ : filter Z}
  (Hf : tendsto f F₂ F₁) (Hg : tendsto g F₃ F₂) : tendsto (g ∘ f) F₃ F₁ :=
tendsto_intro (take P, suppose eventually P F₃,
    have eventually (λ y, P (g y)) F₂, from tendsto_dest Hg this,
    show eventually (λ x, P (g (f x))) F₁, from tendsto_dest Hf this)

theorem tendsto_of_le_left {f : X → Y} {F₂ F₂' : filter Y} {F₁ : filter X}
  (HF₂ : F₂ ≤ F₂') (H : tendsto f F₂ F₁) : tendsto f F₂' F₁ :=
take P, suppose eventually P F₂',
have eventually P F₂, from eventually_of_le this HF₂,
show eventually P (mapfilter f F₁), from H this

theorem tendsto_of_le_right {f : X → Y} {F₂ : filter Y} {F₁ F₁' : filter X}
  (HF₁ : F₁' ≤ F₁) (H : tendsto f F₂ F₁) : tendsto f F₂ F₁' :=
take P, suppose eventually P F₂,
have eventually P (mapfilter f F₁), from H this,
show eventually P (mapfilter f F₁'), from eventually_of_le this (mapfilter_le_mapfilter _ HF₁)

theorem tendsto_of_le_of_le {f : X → Y} {F₂ F₂' : filter Y} {F₁ F₁' : filter X}
  (HF₂ : F₂ ≤ F₂') (HF₁ : F₁' ≤ F₁) (H : tendsto f F₂ F₁) : tendsto f F₂' F₁' :=
tendsto_of_le_left HF₂ (tendsto_of_le_right HF₁ H)

theorem tendsto_id {F : filter X} : tendsto (λ x, x) F F :=
take P, assume H, H

theorem tendsto_inf_left {f : X → Y} {F₂ : filter Y} (F₁ : filter X) {F₁' : filter X}
    (H : tendsto f F₂ F₁) :
  tendsto f F₂ (inf F₁ F₁') :=
tendsto_of_le_right !inf_le_left H

theorem tendsto_inf_right {f : X → Y} {F₂ : filter Y} {F₁ : filter X} (F₁' : filter X)
    (H : tendsto f F₂ F₁') :
  tendsto f F₂ (inf F₁ F₁') :=
tendsto_of_le_right !inf_le_right H

theorem tendsto_inf {f : X → Y} {F₂ F₂' : filter Y} {F₁ : filter X}
    (H₁ : tendsto f F₂ F₁) (H₂ : tendsto f F₂' F₁) :
  tendsto f (inf F₂ F₂') F₁ :=
tendsto_intro (take P, suppose eventually P (inf F₂ F₂'),
  obtain S [eSF₂ [T [eTF₂' STsubP]]], from exists_of_eventually_inf this,
  have HS : eventually (λ x, S (f x)) F₁, from tendsto_dest H₁ eSF₂,
  have HT : eventually (λ x, T (f x)) F₁, from tendsto_dest H₂ eTF₂',
  have HST : eventually (λ x, S (f x) ∧ T (f x)) F₁, from eventually_and HS HT,
  have H' : ∀ x, S (f x) ∧ T (f x) → P (f x), from take x, STsubP (f x),
  show eventually (λ x, P (f x)) F₁, from eventually_mono HST H')

theorem tendsto_of_tendsto_inf_left {f : X → Y} {F₂ F₂' : filter Y} {F₁ : filter X}
    (H : tendsto f (inf F₂ F₂') F₁) :
  tendsto f F₂ F₁ :=
tendsto_of_le_left !inf_le_left H

theorem tendsto_of_tendsto_inf_right {f : X → Y} {F₂ F₂' : filter Y} {F₁ : filter X}
    (H : tendsto f (inf F₂ F₂') F₁) :
  tendsto f F₂' F₁ :=
tendsto_of_le_left !inf_le_right H

theorem tendsto_inf_iff (f : X → Y) (F₂ F₂' : filter Y) (F₁ : filter X) :
  tendsto f (inf F₂ F₂') F₁ ↔ tendsto f F₂ F₁ ∧ tendsto f F₂' F₁ :=
iff.intro
  (λ H, and.intro (tendsto_of_tendsto_inf_left H) (tendsto_of_tendsto_inf_right H))
  (λ H, tendsto_inf (and.left H) (and.right H))

theorem tendsto_sup_left {f : X → Y} (F₂ : filter Y) {F₂' : filter Y} {F₁ : filter X}
    (H : tendsto f F₂ F₁) :
  tendsto f (sup F₂ F₂') F₁ :=
tendsto_of_le_left !le_sup_left H

theorem tendsto_sup_right {f : X → Y} (F₂ : filter Y) {F₂' : filter Y} {F₁ : filter X}
    (H : tendsto f F₂' F₁) :
  tendsto f (sup F₂ F₂') F₁ :=
tendsto_of_le_left !le_sup_right H

theorem tendsto_comp_iff_tendsto_mapfilter (f : X → Y) (g : Y → Z) (F₁ : filter X) (F₂ : filter Z) :
  tendsto (g ∘ f) F₂ F₁ ↔ tendsto g F₂ (mapfilter f F₁) :=
!iff.refl

theorem eventually_of_tendsto_principal {f : X → Y} {F : filter X} {s : set Y}
    (H : tendsto f (principal s) F) :
  eventually (λ x, f x ∈ s) F :=
tendsto_dest H (eventually_principal (subset.refl _))

theorem tendsto_principal {f : X → Y} {F : filter X} {s : set Y} (H : eventually (λ x, f x ∈ s) F) :
  tendsto f (principal s) F :=
tendsto_intro (take P, assume ePF,
  have ∀₀ x ∈ s, P x, from subset_of_eventually_principal ePF,
  eventually_mono H (λ x Hfx, this Hfx))

theorem tendsto_principal_iff (f : X → Y) (F : filter X) (s : set Y) :
  tendsto f (principal s) F ↔ eventually (λ x, f x ∈ s) F :=
iff.intro eventually_of_tendsto_principal tendsto_principal

attribute tendsto [irreducible]

/- at_infty -/

section linorderX
  variable [linear_strong_order_pair X]

  definition at_infty : filter X := Inf ((λ x : X, principal '[x, ∞)) ' univ)

  notation `[at ` `∞]`  := at_infty

  private lemma principal_Ici_le_principal_Ici {x₁ x₂ : X} (H : x₁ ≤ x₂) :
    (principal '[x₂, ∞)) ≤ (principal '[x₁, ∞)) :=
  principal_le_principal (show '[x₂, ∞) ⊆ '[x₁, ∞), from λ y Hy, le.trans H Hy)

  theorem eventually_at_infty_intro {P : X → Prop} {x : X} (H : ∀ y, y ≥ x → P y) :
    eventually P [at ∞] :=
  have H' : eventually P (principal '[x, ∞)), from eventually_principal H,
  have principal '[x, ∞) ∈ (λ x : X, principal '[x, ∞)) ' univ, from mem_image_of_mem _ !mem_univ,
  eventually_Inf this H'

  theorem eventually_at_infty_dest {P : X → Prop} [inhabited X]
      (H : eventually P [at ∞]) :
    ∃ x, ∀ y, y ≥ x → P y :=
  let S := (λ x : X, principal '[x, ∞)) ' univ in
  have H' : ∀₀ F₁ ∈ S, ∀₀ F₂ ∈ S, ∃₀ F ∈ S, F ≤ F₁ ⊓ F₂,
    proof
      take F₁, suppose F₁ ∈ S, take F₂, suppose F₂ ∈ S,
      obtain x₁ [x₁univ F₁eq], from `F₁ ∈ S`,
      obtain x₂ [x₂univ F₂eq], from `F₂ ∈ S`,
      or.elim (le_or_gt x₁ x₂)
        (suppose x₁ ≤ x₂,
          have F₂ ≤ F₁, by rewrite [-F₁eq, -F₂eq]; exact principal_Ici_le_principal_Ici this,
          exists.intro F₂ (and.intro `F₂ ∈ S` (le_inf this !le.refl)))
        (suppose x₂ < x₁,
          have x₂ ≤ x₁, from le_of_lt this,
          have F₁ ≤ F₂, by rewrite [-F₁eq, -F₂eq]; exact principal_Ici_le_principal_Ici this,
          exists.intro F₁ (and.intro `F₁ ∈ S` (le_inf !le.refl this)))
    qed,
  have principal '[arbitrary X, ∞) ∈ S,
    from mem_image_of_mem _ !mem_univ,
  have ∃₀ F ∈ S, eventually P F,
    from exists_eventually_of_eventually_Inf this H H',
  obtain F [FS ePF], from this,
  obtain x [xuniv Feq], from FS,
  have P ⊇ '[x, ∞), from subset_of_eventually_principal (eq.subst (eq.symm Feq) ePF),
  exists.intro x this

  theorem eventually_at_infty_iff (P : X → Prop) [inhabited X] :
    eventually P [at ∞] ↔ ∃ x, ∀ y, y ≥ x → P y :=
  iff.intro eventually_at_infty_dest
    (assume H, obtain x Hx, from H, eventually_at_infty_intro Hx)
end linorderX

/- at_ninfty -/

section linorderX
  variable [linear_strong_order_pair X]

  definition at_ninfty : filter X := Inf ((λ x : X, principal '(-∞, x]) ' univ)

  notation `[at ` `-∞]` := at_ninfty

  private lemma principal_Iic_le_principal_Iic {x₁ x₂ : X} (H : x₁ ≤ x₂) :
    (principal '(-∞, x₁]) ≤ (principal '(-∞, x₂]) :=
  principal_le_principal (show '(-∞, x₁] ⊆ '(-∞, x₂], from λ y Hy, le.trans Hy H)

  theorem eventually_at_ninfty_intro {P : X → Prop} {x : X} (H : ∀ y, y ≤ x → P y) :
    eventually P [at -∞] :=
  have H' : eventually P (principal '(-∞, x]), from eventually_principal H,
  have principal '(-∞, x] ∈ (λ x : X, principal '(-∞, x]) ' univ, from mem_image_of_mem _ !mem_univ,
  eventually_Inf this H'

  theorem eventually_at_ninfty_dest {P : X → Prop} [inhabited X]
      (H : eventually P [at -∞]) :
    ∃ x, ∀ y, y ≤ x → P y :=
  let S := (λ x : X, principal '(-∞, x]) ' univ in
  have H' : ∀₀ F₁ ∈ S, ∀₀ F₂ ∈ S, ∃₀ F ∈ S, F ≤ F₁ ⊓ F₂,
    proof
      take F₁, suppose F₁ ∈ S, take F₂, suppose F₂ ∈ S,
      obtain x₁ [x₁univ F₁eq], from `F₁ ∈ S`,
      obtain x₂ [x₂univ F₂eq], from `F₂ ∈ S`,
      or.elim (le_or_gt x₁ x₂)
        (suppose x₁ ≤ x₂,
          have F₁ ≤ F₂, by rewrite [-F₁eq, -F₂eq]; exact principal_Iic_le_principal_Iic this,
          exists.intro F₁ (and.intro `F₁ ∈ S` (le_inf !le.refl this)))
        (suppose x₂ < x₁,
          have x₂ ≤ x₁, from le_of_lt this,
          have F₂ ≤ F₁, by rewrite [-F₁eq, -F₂eq]; exact principal_Iic_le_principal_Iic this,
          exists.intro F₂ (and.intro `F₂ ∈ S` (le_inf this !le.refl)))
    qed,
  have principal '(-∞, arbitrary X] ∈ S,
    from mem_image_of_mem _ !mem_univ,
  have ∃₀ F ∈ S, eventually P F,
    from exists_eventually_of_eventually_Inf this H H',
  obtain F [FS ePF], from this,
  obtain x [xuniv Feq], from FS,
  have P ⊇ '(-∞, x], from subset_of_eventually_principal (eq.subst (eq.symm Feq) ePF),
  exists.intro x this

  theorem eventually_at_ninfty_iff (P : X → Prop) [inhabited X] :
    eventually P [at -∞] ↔ ∃ x, ∀ y, y ≤ x → P y :=
  iff.intro eventually_at_ninfty_dest
    (assume H, obtain x Hx, from H, eventually_at_ninfty_intro Hx)
end linorderX

/- approaches_infty -/

section approaches_infty
  variable [linear_strong_order_pair Y]

  abbreviation approaches_infty (f : X → Y) := tendsto f [at ∞]

  notation f ` ⟶ ` ∞   := tendsto f [at ∞]

  section
  open classical

  theorem approaches_infty_intro {f : X → Y} {F : filter X}
      (H : ∀ y, eventually (λ x, f x ≥ y) F) :
    (f ⟶ ∞) F :=
  tendsto_intro
    (take P, assume eP : eventually P [at ∞],
      if H' : nonempty Y then
        have inhabited Y, from inhabited_of_nonempty H',
        obtain z (Hz : ∀ y, y ≥ z → P y), from eventually_at_infty_dest eP,
        have ∀ x, f x ≥ z → P (f x), from take x, Hz (f x),
        show eventually (λ x, P (f x)) F, from eventually_mono (H z) this
      else
        show eventually (λ x, P (f x)) F, from eventually_of_forall F
          take x, absurd (nonempty.intro (f x)) H')
  end

  theorem approaches_infty_dest {f : X → Y} {F : filter X} (H : (f ⟶ ∞) F) (y : Y) :
    eventually (λ x, f x ≥ y) F :=
  have eventually (λ x, x ≥ y) [at ∞],
    from eventually_at_infty_intro (take x, suppose x ≥ y, this),
  show eventually (λ x, f x ≥ y) F, from tendsto_dest H this

  theorem approaches_infty_iff (f : X → Y) (F : filter X) :
    (f ⟶ ∞) F ↔ ∀ y, eventually (λ x, f x ≥ y) F :=
  iff.intro approaches_infty_dest approaches_infty_intro

  theorem approaches_infty_of_eventually_ge {f g : X → Y} {F : filter X}
      (H : eventually (λ x, f x ≥ g x) F) (H' : (g ⟶ ∞) F) :
    (f ⟶ ∞) F :=
  approaches_infty_intro (take y,
    have eventually (λ x, g x ≥ y) F, from approaches_infty_dest H' y,
    show eventually (λ x, f x ≥ y) F,
      from eventually_mpr H (eventually_mpr this (eventually_of_forall _ (take x, le.trans))))

  theorem id_approaches_infty_at_infty : @id Y ⟶ ∞ [at ∞] := tendsto_id
end approaches_infty

/- approaches_ninfty -/

section approaches_ninfty
  variable [linear_strong_order_pair Y]

  abbreviation approaches_ninfty (f : X → Y) := tendsto f [at -∞]

  notation f ` ⟶ ` -∞  := tendsto f [at -∞]

  section
  open classical

  theorem approaches_ninfty_intro {f : X → Y} {F : filter X}
      (H : ∀ y, eventually (λ x, f x ≤ y) F) :
    (f ⟶ -∞) F :=
  tendsto_intro
    (take P, assume eP : eventually P [at -∞],
      if H' : nonempty Y then
        have inhabited Y, from inhabited_of_nonempty H',
        obtain z (Hz : ∀ y, y ≤ z → P y), from eventually_at_ninfty_dest eP,
        have ∀ x, f x ≤ z → P (f x), from take x, Hz (f x),
        show eventually (λ x, P (f x)) F, from eventually_mono (H z) this
      else
        show eventually (λ x, P (f x)) F, from eventually_of_forall F
          take x, absurd (nonempty.intro (f x)) H')
  end

  theorem approaches_ninfty_dest {f : X → Y} {F : filter X} (H : (f ⟶ -∞) F) (y : Y) :
    eventually (λ x, f x ≤ y) F :=
  have eventually (λ x, x ≤ y) [at -∞],
    from eventually_at_ninfty_intro (take x, suppose x ≤ y, this),
  show eventually (λ x, f x ≤ y) F, from tendsto_dest H this

  theorem approaches_ninfty_iff (f : X → Y) (F : filter X) :
    (f ⟶ -∞) F ↔ ∀ y, eventually (λ x, f x ≤ y) F :=
  iff.intro approaches_ninfty_dest approaches_ninfty_intro

  theorem approaches_ninfty_of_eventually_le {f g : X → Y} {F : filter X}
      (H : eventually (λ x, f x ≤ g x) F) (H' : (g ⟶ -∞) F) :
    (f ⟶ -∞) F :=
  approaches_ninfty_intro (take y,
    have eventually (λ x, g x ≤ y) F, from approaches_ninfty_dest H' y,
    show eventually (λ x, f x ≤ y) F,
      from eventually_mpr H (eventually_mpr this
        (eventually_of_forall _ (take x H₁ H₂, le.trans H₂ H₁))))

  theorem id_approaches_ninfty_at_ninfty : @id Y ⟶ -∞ [at -∞] := tendsto_id
end approaches_ninfty

/- the nhds filter -/

open topology

section nhds_filter
  variables [topology X] {P : X → Prop}

  definition nhds (x : X) : filter X := Inf (principal ' {s | Open s ∧ x ∈ s})

  proposition eventually_nhds_intro {x : X} {s : set X}
      (Os : Open s) (xs : x ∈ s) (H : ∀₀ x ∈ s, P x) :
    eventually P (nhds x) :=
  eventually_Inf (mem_image_of_mem _ (and.intro Os xs)) (eventually_principal H)

  proposition eventually_mem_nhds {x : X} {s : set X} (Os : Open s) (xs : x ∈ s) :
    eventually (λ x, x ∈ s) (nhds x) :=
  eventually_nhds_intro Os xs (λ x Hx, Hx)

  proposition eventually_nhds_dest {x : X} (H : eventually P (nhds x)) :
    ∃ s, Open s ∧ x ∈ s ∧ ∀₀ x ∈ s, P x :=
  let princS := principal ' {s | Open s ∧ x ∈ s} in
  have principal univ ∈ princS,
    from mem_image_of_mem principal (and.intro Open_univ !mem_univ),
  have ∃₀ F ∈ princS, eventually P F, from
    exists_eventually_of_eventually_Inf this H
     (λ F₁ (F₁mem : F₁ ∈ princS) F₂ (F₂mem : F₂ ∈ princS),
       obtain s₁ [[Os₁ xs₁] (F₁eq : principal s₁ = F₁)], from F₁mem,
       obtain s₂ [[Os₂ xs₂] (F₂eq : principal s₂ = F₂)], from F₂mem,
       have F₁ ⊓ F₂ ∈ princS,
         begin
          rewrite [-F₁eq, -F₂eq, principal_inf_principal],
          exact mem_image_of_mem _ (and.intro (Open_inter Os₁ Os₂) (mem_inter xs₁ xs₂))
         end,
       show ∃₀ F ∈ princS, F ≤ F₁ ⊓ F₂, from exists.intro _ (and.intro this !le.refl)),
  obtain F [Fmem ePF], from this,
  obtain s [[Os xs] (Feq : principal s = F)], from Fmem,
  exists.intro s (and.intro Os (and.intro xs
    (subset_of_eventually_principal (by rewrite Feq; exact ePF))))

  proposition eventually_nhds_iff (x : X) :
    eventually P (nhds x) ↔ ∃ s, Open s ∧ x ∈ s ∧ ∀₀ x ∈ s, P x :=
  iff.intro eventually_nhds_dest
    (assume H, obtain s [Os [xs Hs]], from H, eventually_nhds_intro Os xs Hs)
end nhds_filter

/- the at_within filter -/

section at_within
  variables [topology X] {P : X → Prop}

  definition at_within (x : X) (s : set X) : filter X := inf (nhds x) (principal (s \ '{x}))

  notation [at x ` within ` s] := at_within x s

  proposition at_within_le_nhds (x : X) (s : set X) : [at x within s] ≤ nhds x :=
  inf_le_left _ _

  proposition at_within_le_at_within (x : X) {s t : set X} (H : s ⊆ t) :
    [at x within s] ≤ [at x within t] :=
  have s \ '{x} ⊆ t \ '{x}, by rewrite diff_eq; apply inter_subset_inter_right _ H,
  le_inf (inf_le_left _ _) (le.trans !inf_le_right (principal_le_principal this))

  proposition eventually_at_within_intro {x : X} {s t : set X} (Os : Open s) (xs : x ∈ s)
      (Hs : ∀₀ y ∈ s, y ≠ x → y ∈ t → P y) :
    eventually P [at x within t] :=
  have H₁ : eventually (λ y, y ≠ x → y ∈ t → P y) (nhds x),
    from eventually_nhds_intro Os xs Hs,
  eventually_inf H₁ _ (mem_principal _)
    (take y, assume Hy,
      have H : y ∈ t \ '{x}, from and.right Hy,
      have H' : y ≠ x, from suppose y = x,
        have y ∈ '{x}, from mem_singleton_of_eq this,
        show false, from and.right H this,
      show P y, from and.left Hy `y ≠ x` (and.left H))

  proposition eventually_at_within_dest {x : X} {t : set X}
     (H : eventually P [at x within t]) :
    ∃ s, Open s ∧ x ∈ s ∧ ∀₀ y ∈ s, y ≠ x → y ∈ t → P y :=
  obtain P₁ [eP₁nhds [P₂ [eP₂princ (H' : P ⊇ P₁ ∩ P₂)]]], from exists_of_eventually_inf H,
  obtain s [Os [xs Hs]], from eventually_nhds_dest eP₁nhds,
  have Ht : ∀₀ y ∈ t \ '{x}, P₂ y, from subset_of_eventually_principal eP₂princ,
  exists.intro s (and.intro Os (and.intro xs
    (take y, assume ys ynex yt,
      have y ∉ '{x}, from assume ymem, ynex (eq_of_mem_singleton ymem),
      show P y, from H' (and.intro (Hs y ys) (Ht (mem_diff yt this))))))

  theorem eventually_at_within_iff (x : X) {s : set X} :
    eventually P [at x within s] ↔ ∃ t, Open t ∧ x ∈ t ∧ ∀₀ y ∈ t, y ≠ x → y ∈ s → P y :=
  iff.intro eventually_at_within_dest
    (assume H, obtain t [Ot [xt Ht]], from H, eventually_at_within_intro Ot xt Ht)

  theorem eventually_at_within_of_subset {x : X} {s t : set X} (ssubt : s ⊆ t)
      (H : eventually P [at x within t]) :
    eventually P [at x within s] :=
  eventually_of_le H (at_within_le_at_within x ssubt)

  abbreviation at_elt (x : X) : filter X := at_within x univ

  notation [at x] := at_elt x

  proposition eventually_at_intro {x : X} {s : set X} (Os : Open s) (xs : x ∈ s)
      (Hs : ∀₀ y ∈ s, y ≠ x → P y) :
    eventually P [at x] :=
  eventually_at_within_intro Os xs (take y, assume ys ynex yuniv, Hs ys ynex)

  proposition eventually_at_dest {x : X} (H : eventually P [at x]) :
    ∃ s, Open s ∧ x ∈ s ∧ ∀₀ y ∈ s, y ≠ x → P y :=
  obtain s [Os [xs Hs]], from eventually_at_within_dest H,
  exists.intro s (and.intro Os (and.intro xs (λ y ys ynex, Hs y ys ynex trivial)))

  proposition eventually_at_iff (x : X) :
    eventually P [at x] ↔ ∃ s, Open s ∧ x ∈ s ∧ ∀₀ y ∈ s, y ≠ x → P y :=
  iff.intro eventually_at_dest
    (assume H, obtain s [Os [xs Hs]], from H, eventually_at_intro Os xs Hs)

  proposition eventually_at_within_of_eventually_at {x : X} (s : set X) (H : eventually P [at x]) :
    eventually P [at x within s] :=
  eventually_at_within_of_subset (subset_univ s) H

  proposition at_within_eq_of_Open {x : X} {s : set X} (Os : Open s) (xs : x ∈ s) :
    [at x within s] = [at x] :=
  filter.eq (ext (take P, iff.intro
    (assume H,
      obtain t [Ot [xt Ht]], from eventually_at_within_dest H,
      eventually_at_intro (Open_inter Os Ot) (mem_inter xs xt)
        (λ y Hy yne, Ht _ (and.right Hy) yne (and.left Hy)))
    (assume H,
      obtain t [Ot [xt Ht]], from eventually_at_dest H,
      eventually_at_within_intro (Open_inter Os Ot) (mem_inter xs xt)
        (λ y Hy yne ys, Ht _ (and.right Hy) yne))))

  proposition tendsto_at_within_of_subset {f : X → Y} {F : filter Y} {x : X } {s t : set X}
      (ssubt : s ⊆ t) (H : tendsto f F [at x within t]) :
    tendsto f F [at x within s] :=
  tendsto_intro (take P eP,
    have eventually (λ x, P (f x)) [at x within t], from tendsto_dest H eP,
    show eventually (λ x, P (f x)) [at x within s], from eventually_at_within_of_subset ssubt this)
end at_within

/- at_left and at_right -/

section at_left_at_right
  variables [topology X] [linear_strong_order_pair X] {P : X → Prop}

  abbreviation at_left (x : X) : filter X := [at x within '(-∞, x)]
  abbreviation at_right (x : X) : filter X := [at x within '(x, ∞)]

  notation [at x`-]` := at_left x
  notation [at x`+]` := at_right x

  proposition eventually_at_left_intro {x : X} {s : set X} (Os : Open s) (xs : x ∈ s)
      (H : ∀₀ y ∈ s, y < x → P y) :
    eventually P [at x-] :=
  eventually_at_within_intro Os xs (take y, assume ys ynex yltx, H ys yltx)

  proposition eventually_at_left_dest {x : X} (H : eventually P [at x-]) :
    ∃ s, Open s ∧ x ∈ s ∧ ∀₀ y ∈ s, y < x → P y :=
  obtain s [Os [xs Hs]], from eventually_at_within_dest H,
  exists.intro s (and.intro Os (and.intro xs
    (take y, assume ys yltx,
      show P y, from Hs y ys (ne_of_lt yltx) yltx)))

  variable (P)
  proposition eventually_at_left_iff (x : X) :
    eventually P [at x-] ↔ ∃ s, Open s ∧ x ∈ s ∧ ∀₀ y ∈ s, y < x → P y :=
  iff.intro eventually_at_left_dest
    (take H, obtain s [Os [xs Hs]], from H, eventually_at_left_intro Os xs Hs)

  variable {P}
  proposition eventually_at_right_intro {x : X} {s : set X} (Os : Open s) (xs : x ∈ s)
      (H : ∀₀ y ∈ s, y > x → P y) :
    eventually P [at x+] :=
  eventually_at_within_intro Os xs (take y, assume ys ynex yltx, H ys yltx)

  proposition eventually_at_right_dest {x : X} (H : eventually P [at x+]) :
    ∃ s, Open s ∧ x ∈ s ∧ ∀₀ y ∈ s, y > x → P y :=
  obtain s [Os [xs Hs]], from eventually_at_within_dest H,
  exists.intro s (and.intro Os (and.intro xs
    (take y, assume ys yltx,
      show P y, from Hs y ys (ne_of_gt yltx) yltx)))

  variable (P)
  proposition eventually_at_right_iff (x : X) :
    eventually P [at x+] ↔ ∃ s, Open s ∧ x ∈ s ∧ ∀₀ y ∈ s, y > x → P y :=
  iff.intro eventually_at_right_dest
    (take H, obtain s [Os [xs Hs]], from H, eventually_at_right_intro Os xs Hs)
end at_left_at_right

/- approaches -/

section approaches
  variables [topology Y]
  variables {F : filter X} {f : X → Y} {y : Y}

  abbreviation approaches (f : X → Y) (y : Y) : filter X → Prop := tendsto f (nhds y)

  notation f ⟶ y := approaches f y

  proposition approaches_intro (H : ∀ s, Open s → y ∈ s → eventually (λ x, f x ∈ s) F) :
    (f ⟶ y) F :=
  tendsto_intro
    (take P, assume eventuallyP,
      obtain s [Os [(ys : y ∈ s) (H' : ∀₀ y' ∈ s, P y')]],
        from eventually_nhds_dest eventuallyP,
      show eventually (λ x, P (f x)) F, from eventually_mono (H s Os ys) (λ x Hx, H' Hx))

  proposition approaches_elim (H : (f ⟶ y) F) {s : set Y} (Os : Open s) (ys : y ∈ s) :
    eventually (λ x, f x ∈ s) F :=
  tendsto_dest H (eventually_mem_nhds Os ys)

  variables (F f y)
  proposition approaches_iff : (f ⟶ y) F ↔ (∀ s, Open s → y ∈ s → eventually (λ x, f x ∈ s) F) :=
  iff.intro approaches_elim approaches_intro

  proposition tendsto_comp_of_approaches_of_tendsto_at_within
      {f : X → Y} {g : Y → Z} {s : set Y} {y : Y} {F₁ : filter X} {F₃ : filter Z}
      (Hf₁ : (f ⟶ y) F₁) (Hf₂ : eventually (λ x, f x ∈ s ∧ f x ≠ y) F₁)
      (Hg : tendsto g F₃ [at y within s]) :
    tendsto (g ∘ f) F₃ F₁ :=
  have eventually (λ x, f x ∈ s \ '{y}) F₁,
    from eventually_congr (take x, by rewrite [mem_diff_iff, mem_singleton_iff]) Hf₂,
  have tendsto f [at y within s] F₁, from tendsto_inf Hf₁ (tendsto_principal this),
  tendsto_comp this Hg

  proposition tendsto_comp_of_approaches_of_tendsto_at
      {f : X → Y} {g : Y → Z} {y : Y} {F₁ : filter X} {F₃ : filter Z}
      (Hf₁ : (f ⟶ y) F₁) (Hf₂ : eventually (λ x, f x ≠ y) F₁)
      (Hg : tendsto g F₃ [at y]) :
    tendsto (g ∘ f) F₃ F₁ :=
  have eventually (λ x, f x ∈ univ ∧ f x ≠ y) F₁,
    from eventually_congr (take x, by rewrite [mem_univ_iff, true_and]) Hf₂,
  tendsto_comp_of_approaches_of_tendsto_at_within Hf₁ this Hg

  proposition approaches_constant : ((λ x, y) ⟶ y) F :=
  begin
    apply approaches_intro,
    intro s Hs Hys,
    have H : (λ x : X, y ∈ s) = (λ x : X, true), from funext (λ x, by rewrite classical.eq_true; exact Hys),
    rewrite H,
    apply eventually_true
  end

end approaches

/-
  Properties of convergence at infty on nat and real (and more generally ordered semigroups)
-/

section
  open nat

  proposition eventually_at_infty_of_eventually_succ_at_infty {P : ℕ → Prop}
    (H : eventually (λ n, P (succ n)) [at ∞]) : eventually P [at ∞] :=
  obtain x (Hx : ∀ y, y ≥ x → P (succ y)), from eventually_at_infty_dest H,
  eventually_at_infty_intro (take y, suppose y > x,
    have y ≥ succ x, from succ_le_of_lt this,
    have pred y ≥ pred (succ x), from pred_le_pred this,
    have pred y ≥ x, by rewrite pred_succ at this; assumption,
    have P (succ (pred y)), from Hx _ this,
    show P y,
      by rewrite (succ_pred_of_pos (lt_of_lt_of_le !zero_lt_succ `succ x ≤ y`)) at this; assumption)

  proposition eventually_succ_at_infty {P : ℕ → Prop}
    (H : eventually (λ n, P n) [at ∞]) : eventually (λ n, P (succ n)) [at ∞] :=
  obtain x (Hx : ∀ y, y ≥ x → P y), from eventually_at_infty_dest H,
  eventually_at_infty_intro (take y, suppose y > x,
    show P (succ y), from Hx _ (le_of_lt (lt.trans this !lt_succ_self)))

  proposition eventually_succ_at_infty_iff (P : ℕ → Prop) :
    (eventually (λ n, P (succ n)) [at ∞]) ↔ (eventually P [at ∞]) :=
  iff.intro eventually_at_infty_of_eventually_succ_at_infty eventually_succ_at_infty

  proposition tendsto_succ_at_infty {f : ℕ → Y} {F : filter Y} (H : tendsto f F [at ∞]) :
    tendsto (λ n, f (succ n)) F [at ∞] :=
  tendsto_intro (take P, suppose eventually P F,
    eventually_succ_at_infty (tendsto_dest H this))

  proposition tendsto_at_infty_of_tendsto_succ_at_infty {f : ℕ → Y} {F : filter Y}
      (H : tendsto (λ n, f (succ n)) F [at ∞]) :
    tendsto f F [at ∞] :=
  tendsto_intro (take P, suppose eventually P F,
    eventually_at_infty_of_eventually_succ_at_infty (tendsto_dest H this))

  proposition tendsto_succ_at_infty_iff (f : ℕ → Y) (F : filter Y) :
    (tendsto (λ n, f (succ n)) F [at ∞]) ↔ (tendsto f F [at ∞]) :=
  iff.intro tendsto_at_infty_of_tendsto_succ_at_infty tendsto_succ_at_infty

  proposition succ_approaches_infty_at_infty : (λ n, succ n) ⟶ ∞ [at ∞] :=
  tendsto_succ_at_infty id_approaches_infty_at_infty

  -- alterantive proof:
  --  approaches_infty_intro (take n,
  --    eventually_at_infty_intro (take y, suppose y ≥ n,
  --      show succ y ≥ n, from le.trans this (le_of_lt (lt_succ_self y))))

  -- another alternative proof:
  --  approaches_infty_of_eventually_ge
  --    (eventually_of_forall _ (λ x, le_of_lt (lt_succ_self x))
  --    id_approaches_infty_at_infty

  -- TODO: for these next proofs: we should unify nat and group cases, with a class
  -- with the axiom x ≤ y → y - x + x = y.
  -- in the meanwhile, put ' on these versions

  -- TODO: add_left versions

  proposition eventually_at_infty_of_eventually_add_right_at_infty' {P : ℕ → Prop} {k : ℕ}
    (H : eventually (λ n, P (n + k)) [at ∞]) : eventually P [at ∞] :=
  obtain x (Hx : ∀ y, y ≥ x → P (y + k)), from eventually_at_infty_dest H,
  eventually_at_infty_intro (take y, suppose y ≥ x + k,
    have y - k ≥ x, from nat.le_sub_of_add_le this,
    have H' : P (y - k + k), from Hx _ this,
    have y ≥ k, from le.trans !le_add_left `x + k ≤ y`,
    show P y, by rewrite [nat.sub_add_cancel this at H']; exact H')

  proposition eventually_add_right_at_infty' {P : ℕ → Prop} (k : ℕ)
    (H : eventually (λ n, P n) [at ∞]) : eventually (λ n, P (n + k)) [at ∞] :=
  obtain x (Hx : ∀ y, y ≥ x → P y), from eventually_at_infty_dest H,
  eventually_at_infty_intro (take y, suppose y ≥ x,
    have y + k ≥ x, from le.trans this !le_add_right,
    show P (y + k), from Hx _ this)

  proposition eventually_add_right_at_infty_iff' (k : ℕ) (P : ℕ → Prop) :
    (eventually (λ n, P (n + k)) [at ∞]) ↔ (eventually P [at ∞]) :=
  iff.intro eventually_at_infty_of_eventually_add_right_at_infty' (eventually_add_right_at_infty' k)

  proposition tendsto_add_right_at_infty' {f : ℕ → Y} {F : filter Y}
      (H : tendsto f F [at ∞]) (k : ℕ) :
    tendsto (λ n, f (n + k)) F [at ∞] :=
  tendsto_intro (take P, suppose eventually P F,
    eventually_add_right_at_infty' k (tendsto_dest H this))

  proposition tendsto_at_infty_of_tendsto_add_right_at_infty' {f : ℕ → Y} {F : filter Y} {k : ℕ}
      (H : tendsto (λ n, f (n + k)) F [at ∞]) :
    tendsto f F [at ∞] :=
  tendsto_intro (take P, suppose eventually P F,
    eventually_at_infty_of_eventually_add_right_at_infty' (tendsto_dest H this))

  proposition tendsto_add_right_at_infty_iff' (f : ℕ → Y) (F : filter Y) (k : ℕ) :
    (tendsto (λ n, f (n + k)) F [at ∞]) ↔ (tendsto f F [at ∞]) :=
  iff.intro tendsto_at_infty_of_tendsto_add_right_at_infty' (λ H, tendsto_add_right_at_infty' H k)
end

section
  -- TODO: move to algebra?
  private proposition inhabited_of_has_zero [trans_instance] (H : has_zero X) : inhabited X :=
  inhabited.mk 0

  variable [decidable_linear_ordered_comm_group X]

  proposition eventually_at_infty_of_eventually_add_right_at_infty {P : X → Prop} {k : X}
    (H : eventually (λ n, P (n + k)) [at ∞]) : eventually P [at ∞] :=
  obtain x (Hx : ∀ y, y ≥ x → P (y + k)), from eventually_at_infty_dest H,
  eventually_at_infty_intro (take y, suppose y ≥ x + k,
    have y - k ≥ x, from le_sub_right_of_add_le this,
    have H' : P (y - k + k), from Hx _ this,
    show P y, by rewrite [sub_add_cancel at H']; exact H')

  proposition eventually_add_right_at_infty {P : X → Prop} (k : X)
    (H : eventually (λ n, P n) [at ∞]) : eventually (λ n, P (n + k)) [at ∞] :=
  have eventually (λ n, P (n + -k + k)) [at ∞],
    from eventually_congr (take x, by rewrite [neg_add_cancel_right]) H,
  eventually_at_infty_of_eventually_add_right_at_infty this

  proposition eventually_add_right_at_infty_iff (k : X) (P : X → Prop) :
    (eventually (λ n, P (n + k)) [at ∞]) ↔ (eventually P [at ∞]) :=
  iff.intro eventually_at_infty_of_eventually_add_right_at_infty (eventually_add_right_at_infty k)

  proposition tendsto_add_right_at_infty {f : X → Y} {F : filter Y}
      (H : tendsto f F [at ∞]) (k : X) :
    tendsto (λ n, f (n + k)) F [at ∞] :=
  tendsto_intro (take P, suppose eventually P F,
    eventually_add_right_at_infty k (tendsto_dest H this))

  proposition tendsto_at_infty_of_tendsto_add_right_at_infty {f : X → Y} {F : filter Y} {k : X}
      (H : tendsto (λ n, f (n + k)) F [at ∞]) :
    tendsto f F [at ∞] :=
  tendsto_intro (take P, suppose eventually P F,
    eventually_at_infty_of_eventually_add_right_at_infty (tendsto_dest H this))

  proposition tendsto_add_right_at_infty_iff (f : X → Y) (F : filter Y) (k : X) :
    (tendsto (λ n, f (n + k)) F [at ∞]) ↔ (tendsto f F [at ∞]) :=
  iff.intro tendsto_at_infty_of_tendsto_add_right_at_infty (λ H, tendsto_add_right_at_infty H k)
end

end topology


import Sets.Basic
import Functions.Basic

open Set
open Func

variable (α β γ : Type)
variable (f : α → β) (g : β → γ)
variable (X Y : Set α) (U V : Set β)

theorem problem1 (h : U ⊆ V) : f ⁻¹ U ⊆ f ⁻¹ V := by
  intro a h'
  have : f a ∈ V := h (f a) h'
  exact this

theorem problem2 (h₁ : α ≅ β) (h₂ : β ≅ γ) : α ≅ γ := by
  have ⟨f,u⟩ := h₁
  have ⟨g,v⟩ := h₂
  have l : Bijective (g ∘ f) := by
    have (inj : Injective (g ∘ f)) := inj_comp u.left v.left
    have (surj : Surjective (g ∘ f)) := surj_comp u.right v.right
    exact ⟨inj,surj⟩
  exact ⟨g ∘ f,l⟩

theorem problem3 (h : Surjective f) : HasRightInv f := by
  let g : β → α := by
    intro b
    have : ∃ a, f a = b := h b
    have (a : α) := Classical.choose this
    exact a
  have (l : f ∘ g = id) := by
    apply funext
    intro b
    have u : g b = Classical.choose (h b) := by rfl
    have v : f (Classical.choose (h b)) = b := Classical.choose_spec (h b)
    calc
      f (g b) = f (Classical.choose (h b))  := by rw [u]
      _       = b                           := by rw [v]
  exact ⟨g,l⟩

theorem problem4 : sorry := sorry

theorem problem5 : sorry := sorry


/-
Copyright (c) 2022 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Bhavik Mehta
-/
import probability.conditional

/-!
# Classical probability

The classical formulation of probability states that the probability of an event occurring in a
finite probability space is the ratio of that event to all possible events.
This notion can be expressed with measure theory using
the counting measure. In particular, given the sets `s` and `t`, we define the probability of `t`
occuring in `s` to be `|s|⁻¹ * |s ∩ t|`. With this definition, we recover the the probability over
the entire sample space when `s = set.univ`.

Classical probability is often used in combinatorics and we prove some useful lemmas in this file
for that purpose.

## Main definition

* `probability_theory.cond_count`: given a set `s`, `cond_count s` is the counting measure
  conditioned on `s`. This is a probability measure when `s` is finite and nonempty.

## Notes

The original aim of this file is to provide a measure theoretic method of describing the
probability an element of a set `s` satisfies some predicate `P`. Our current formulation still
allow us to describe this by abusing the definitional equality of sets and predicates by simply
writing `cond_count s P`. We should avoid this however as none of the lemmas are written for
predicates.
-/

noncomputable theory

open_locale probability_theory

open measure_theory measurable_space

namespace probability_theory

variables {α : Type*} [measurable_space α]

/-- Given a set `s`, `cond_count s` is the counting measure conditioned on `s`. In particular,
`cond_count s t` is the proportion of `s` that is contained in `t`.

This is a probability measure when `s` is finite and nonempty and is given by
`probability_theory.cond_count_is_probability_measure`. -/
def cond_count (s : set α) : measure α := measure.count[|s]

@[simp] lemma cond_count_empty_meas : (cond_count ∅ : measure α) = 0 :=
by simp [cond_count]

lemma cond_count_empty {s : set α} : cond_count s ∅ = 0 :=
by simp

lemma finite_of_cond_count_ne_zero {s t : set α} (h : cond_count s t ≠ 0) :
  s.finite :=
begin
  by_contra hs',
  simpa [cond_count, cond, measure.count_apply_infinite hs'] using h,
end

variables [measurable_singleton_class α]

lemma cond_count_is_probability_measure {s : set α} (hs : s.finite) (hs' : s.nonempty) :
  is_probability_measure (cond_count s) :=
{ measure_univ :=
  begin
    rw [cond_count, cond_apply _ hs.measurable_set, set.inter_univ, ennreal.inv_mul_cancel],
    { exact λ h, hs'.ne_empty $ measure.empty_of_count_eq_zero h },
    { exact (measure.count_apply_lt_top.2 hs).ne }
  end }

lemma cond_count_singleton (a : α) (t : set α) [decidable (a ∈ t)] :
  cond_count {a} t = if a ∈ t then 1 else 0 :=
begin
  rw [cond_count, cond_apply _ (measurable_set_singleton a), measure.count_singleton,
    ennreal.inv_one, one_mul],
  split_ifs,
  { rw [(by simpa : ({a} : set α) ∩ t = {a}), measure.count_singleton] },
  { rw [(by simpa : ({a} : set α) ∩ t = ∅), measure.count_empty] },
end

variables {s t u : set α}

lemma cond_count_inter_self (hs : s.finite):
  cond_count s (s ∩ t) = cond_count s t :=
by rw [cond_count, cond_inter_self _ hs.measurable_set]

lemma cond_count_self (hs : s.finite) (hs' : s.nonempty) :
  cond_count s s = 1 :=
begin
  rw [cond_count, cond_apply _ hs.measurable_set, set.inter_self, ennreal.inv_mul_cancel],
  { exact λ h, hs'.ne_empty $ measure.empty_of_count_eq_zero h },
  { exact (measure.count_apply_lt_top.2 hs).ne }
end

lemma cond_count_eq_one_of (hs : s.finite) (hs' : s.nonempty) (ht : s ⊆ t) :
  cond_count s t = 1 :=
begin
  haveI := cond_count_is_probability_measure hs hs',
  refine eq_of_le_of_not_lt prob_le_one _,
  rw [not_lt, ← cond_count_self hs hs'],
  exact measure_mono ht,
end

lemma pred_true_of_cond_count_eq_one (h : cond_count s t = 1) :
  s ⊆ t :=
begin
  have hsf := finite_of_cond_count_ne_zero (by { rw h, exact one_ne_zero }),
  rw [cond_count, cond_apply _ hsf.measurable_set, mul_comm] at h,
  replace h := ennreal.eq_inv_of_mul_eq_one_left h,
  rw [inv_inv, measure.count_apply_finite _ hsf,
    measure.count_apply_finite _ (hsf.inter_of_left _), nat.cast_inj] at h,
  suffices : s ∩ t = s,
  { exact this ▸ λ x hx, hx.2 },
  rw ← @set.finite.to_finset_inj _ _ _ (hsf.inter_of_left _) hsf,
  exact finset.eq_of_subset_of_card_le
    (set.finite.to_finset_mono.2 (s.inter_subset_left t)) h.symm.le
end

lemma cond_count_eq_zero_iff (hs : s.finite) :
  cond_count s t = 0 ↔ s ∩ t = ∅ :=
by simp [cond_count, cond_apply _ hs.measurable_set, measure.count_apply_eq_top,
    set.not_infinite.2 hs, measure.count_apply_finite _ (hs.inter_of_left _)]

lemma cond_count_univ (hs : s.finite) (hs' : s.nonempty) :
  cond_count s set.univ = 1 :=
cond_count_eq_one_of hs hs' s.subset_univ

lemma cond_count_inter (hs : s.finite) :
  cond_count s (t ∩ u) = cond_count (s ∩ t) u * cond_count s t :=
begin
  by_cases hst : s ∩ t = ∅,
  { rw [hst, cond_count_empty_meas, measure.coe_zero, pi.zero_apply, zero_mul,
      cond_count_eq_zero_iff hs, ← set.inter_assoc, hst, set.empty_inter] },
  rw [cond_count, cond_count, cond_apply _ hs.measurable_set, cond_apply _ hs.measurable_set,
    cond_apply _ (hs.inter_of_left _).measurable_set,
    mul_comm _ (measure.count (s ∩ t)), ← mul_assoc, mul_comm _ (measure.count (s ∩ t)),
    ← mul_assoc, ennreal.mul_inv_cancel, one_mul, mul_comm, set.inter_assoc],
  { rwa ← measure.count_eq_zero_iff at hst },
  { exact (measure.count_apply_lt_top.2 $ hs.inter_of_left _).ne }
end

lemma cond_count_inter' (hs : s.finite) :
  cond_count s (t ∩ u) = cond_count (s ∩ u) t * cond_count s u :=
begin
  rw ← set.inter_comm,
  exact cond_count_inter hs,
end

lemma cond_count_union (hs : s.finite) (htu : disjoint t u) :
  cond_count s (t ∪ u) = cond_count s t + cond_count s u :=
begin
  rw [cond_count, cond_apply _ hs.measurable_set, cond_apply _ hs.measurable_set,
    cond_apply _ hs.measurable_set, set.inter_union_distrib_left, measure_union, mul_add],
  exacts [htu.mono inf_le_right inf_le_right, (hs.inter_of_left _).measurable_set],
end

lemma cond_count_compl (t : set α) (hs : s.finite) (hs' : s.nonempty) :
  cond_count s t + cond_count s tᶜ = 1 :=
begin
  rw [← cond_count_union hs disjoint_compl_right, set.union_compl_self,
    (cond_count_is_probability_measure hs hs').measure_univ],
end

lemma cond_count_disjoint_union (hs : s.finite) (ht : t.finite) (hst : disjoint s t) :
  cond_count s u * cond_count (s ∪ t) s + cond_count t u * cond_count (s ∪ t) t =
  cond_count (s ∪ t) u :=
begin
  rcases s.eq_empty_or_nonempty with (rfl | hs');
  rcases t.eq_empty_or_nonempty with (rfl | ht'),
  { simp },
  { simp [cond_count_self ht ht'] },
  { simp [cond_count_self hs hs'] },
  rw [cond_count, cond_count, cond_count, cond_apply _ hs.measurable_set,
    cond_apply _ ht.measurable_set, cond_apply _ (hs.union ht).measurable_set,
    cond_apply _ (hs.union ht).measurable_set, cond_apply _ (hs.union ht).measurable_set],
  conv_lhs { rw [set.union_inter_cancel_left, set.union_inter_cancel_right,
      mul_comm (measure.count (s ∪ t))⁻¹, mul_comm (measure.count (s ∪ t))⁻¹,
      ← mul_assoc, ← mul_assoc, mul_comm _ (measure.count s), mul_comm _ (measure.count t),
      ← mul_assoc, ← mul_assoc] },
  rw [ennreal.mul_inv_cancel, ennreal.mul_inv_cancel, one_mul, one_mul, ← add_mul,
    ← measure_union, set.union_inter_distrib_right, mul_comm],
  exacts [hst.mono inf_le_left inf_le_left, (ht.inter_of_left _).measurable_set,
    measure.count_ne_zero ht', (measure.count_apply_lt_top.2 ht).ne,
    measure.count_ne_zero hs', (measure.count_apply_lt_top.2 hs).ne],
end

/-- A version of the law of total probability for counting probabilites. -/
lemma cond_count_add_compl_eq (u t : set α) (hs : s.finite) :
  cond_count (s ∩ u) t * cond_count s u + cond_count (s ∩ uᶜ) t * cond_count s uᶜ =
  cond_count s t :=
begin
  conv_rhs { rw [(by simp : s = s ∩ u ∪ s ∩ uᶜ),
    ← cond_count_disjoint_union (hs.inter_of_left _) (hs.inter_of_left _)
    (disjoint_compl_right.mono inf_le_right inf_le_right)] },
  simp [cond_count_inter_self hs],
end

end probability_theory


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

Finite ordinal types.
-/
import data.list.basic data.finset.basic data.fintype.card algebra.group data.equiv
open eq.ops nat function list finset fintype

structure fin (n : nat) := (val : nat) (is_lt : val < n)

definition less_than [reducible] := fin

namespace fin

attribute fin.val [coercion]

section def_equal
variable {n : nat}

lemma eq_of_veq : ∀ {i j : fin n}, (val i) = j → i = j
| (mk iv ilt) (mk jv jlt) := assume (veq : iv = jv), begin congruence, assumption end

lemma veq_of_eq : ∀ {i j : fin n}, i = j → (val i) = j
| (mk iv ilt) (mk jv jlt) := assume Peq,
  show iv = jv, from fin.no_confusion Peq (λ Pe Pqe, Pe)

lemma eq_iff_veq {i j : fin n} : (val i) = j ↔ i = j :=
iff.intro eq_of_veq veq_of_eq

definition val_inj := @eq_of_veq n

end def_equal

section
open decidable
protected definition has_decidable_eq [instance] (n : nat) : ∀ (i j : fin n), decidable (i = j)
| (mk ival ilt) (mk jval jlt) :=
  decidable_of_decidable_of_iff (nat.has_decidable_eq ival jval) eq_iff_veq
end

lemma dinj_lt (n : nat) : dinj (λ i, i < n) fin.mk :=
take a1 a2 Pa1 Pa2 Pmkeq, fin.no_confusion Pmkeq (λ Pe Pqe, Pe)

lemma val_mk (n i : nat) (Plt : i < n) : fin.val (fin.mk i Plt) = i := rfl

definition upto [reducible] (n : nat) : list (fin n) :=
dmap (λ i, i < n) fin.mk (list.upto n)

lemma nodup_upto (n : nat) : nodup (upto n) :=
dmap_nodup_of_dinj (dinj_lt n) (list.nodup_upto n)

lemma mem_upto (n : nat) : ∀ (i : fin n), i ∈ upto n :=
take i, fin.destruct i
  (take ival Piltn,
    have ival ∈ list.upto n, from mem_upto_of_lt Piltn,
    mem_dmap Piltn this)

lemma upto_zero : upto 0 = [] :=
by rewrite [↑upto, list.upto_nil, dmap_nil]

lemma map_val_upto (n : nat) : map fin.val (upto n) = list.upto n :=
map_dmap_of_inv_of_pos (val_mk n) (@lt_of_mem_upto n)

lemma length_upto (n : nat) : length (upto n) = n :=
calc
  length (upto n) = length (list.upto n) : (map_val_upto n ▸ length_map fin.val (upto n))⁻¹
              ... = n                    : list.length_upto n

lemma upto_ne_nil_of_ne_zero (n : nat) (Hn : n ≠ 0) : upto n ≠ [] :=
begin
  intro Hup,
  apply Hn,
  rewrite [-(@length_nil (fin n)), -Hup],
  apply eq.symm !length_upto
end

definition is_fintype [instance] (n : nat) : fintype (fin n) :=
fintype.mk (upto n) (nodup_upto n) (mem_upto n)

section pigeonhole
open fintype

lemma card_fin (n : nat) : card (fin n) = n := length_upto n

theorem pigeonhole {n m : nat} (Pmltn : m < n) : ¬∃ f : fin n → fin m, injective f :=
assume Pex, absurd Pmltn (not_lt_of_ge
  (calc
       n = card (fin n) : card_fin
     ... ≤ card (fin m) : card_le_of_inj (fin n) (fin m) Pex
     ... = m : card_fin))

end pigeonhole

protected definition zero (n : nat) : fin (succ n) :=
mk 0 !zero_lt_succ

definition fin_has_zero [instance] (n : nat) : has_zero (fin (succ n)) :=
has_zero.mk (fin.zero n)

theorem val_zero (n : nat) : val (0 : fin (succ n)) = 0 := rfl

definition mk_mod [reducible] (n i : nat) : fin (succ n) :=
mk (i % (succ n)) (mod_lt _ !zero_lt_succ)

theorem mk_mod_zero_eq (n : nat) : mk_mod n 0 = 0 :=
rfl

variable {n : nat}

theorem val_lt : ∀ i : fin n, val i < n
| (mk v h) := h

lemma max_lt (i j : fin n) : max i j < n :=
max_lt (is_lt i) (is_lt j)

definition lift : fin n → Π m : nat, fin (n + m)
| (mk v h) m := mk v (lt_add_of_lt_right h m)

definition lift_succ (i : fin n) : fin (nat.succ n) :=
have r : fin (n+1), from lift i 1,
r

definition maxi [reducible] : fin (succ n) :=
mk n !lt_succ_self

theorem val_lift : ∀ (i : fin n) (m : nat), val i = val (lift i m)
| (mk v h) m := rfl

lemma mk_succ_ne_zero {i : nat} : ∀ {P}, mk (succ i) P ≠ (0 : fin (succ n)) :=
assume P Pe, absurd (veq_of_eq Pe) !succ_ne_zero

lemma mk_mod_eq {i : fin (succ n)} : i = mk_mod n i :=
eq_of_veq begin rewrite [↑mk_mod, mod_eq_of_lt !is_lt] end

lemma mk_mod_of_lt {i : nat} (Plt : i < succ n) : mk_mod n i = mk i Plt :=
begin esimp [mk_mod], congruence, exact mod_eq_of_lt Plt end

section lift_lower

lemma lift_zero : lift_succ (0 : fin (succ n)) = (0 : fin (succ (succ n))) := rfl

lemma ne_max_of_lt_max {i : fin (succ n)} : i < n → i ≠ maxi :=
by intro hlt he; substvars; exact absurd hlt (lt.irrefl n)

lemma lt_max_of_ne_max {i : fin (succ n)} : i ≠ maxi → i < n :=
assume hne  : i ≠ maxi,
have vne  : val i ≠ n, from
  assume he,
    have val (@maxi n) = n,   from rfl,
    have val i = val (@maxi n), from he ⬝ this⁻¹,
    absurd (eq_of_veq this) hne,
have val i < nat.succ n, from val_lt i,
lt_of_le_of_ne (le_of_lt_succ this) vne

lemma lift_succ_ne_max {i : fin n} : lift_succ i ≠ maxi :=
begin
  cases i with v hlt, esimp [lift_succ, lift, max], intro he,
  injection he, substvars,
  exact absurd hlt (lt.irrefl v)
end

lemma lift_succ_inj : injective (@lift_succ n) :=
take i j, destruct i (destruct j (take iv ilt jv jlt Pmkeq,
  begin congruence, apply fin.no_confusion Pmkeq, intros, assumption end))

lemma lt_of_inj_of_max (f : fin (succ n) → fin (succ n)) :
  injective f → (f maxi = maxi) → ∀ i : fin (succ n), i < n → f i < n :=
assume Pinj Peq, take i, assume Pilt,
have P1 : f i = f maxi → i = maxi, from assume Peq, Pinj i maxi Peq,
have f i ≠ maxi, from
     begin rewrite -Peq, intro P2, apply absurd (P1 P2) (ne_max_of_lt_max Pilt) end,
lt_max_of_ne_max this

definition lift_fun : (fin n → fin n) → (fin (succ n) → fin (succ n)) :=
λ f i, dite (i = maxi) (λ Pe, maxi) (λ Pne, lift_succ (f (mk i (lt_max_of_ne_max Pne))))

definition lower_inj (f : fin (succ n) → fin (succ n)) (inj : injective f) :
  f maxi = maxi → fin n → fin n :=
assume Peq, take i, mk (f (lift_succ i)) (lt_of_inj_of_max f inj Peq (lift_succ i) (lt_max_of_ne_max lift_succ_ne_max))

lemma lift_fun_max {f : fin n → fin n} : lift_fun f maxi = maxi :=
begin rewrite [↑lift_fun, dif_pos rfl] end

lemma lift_fun_of_ne_max {f : fin n → fin n} {i} (Pne : i ≠ maxi) :
  lift_fun f i = lift_succ (f (mk i (lt_max_of_ne_max Pne))) :=
begin rewrite [↑lift_fun, dif_neg Pne] end

lemma lift_fun_eq {f : fin n → fin n} {i : fin n} :
  lift_fun f (lift_succ i) = lift_succ (f i) :=
begin
rewrite [lift_fun_of_ne_max lift_succ_ne_max], congruence, congruence,
rewrite [-eq_iff_veq], esimp, rewrite [↑lift_succ, -val_lift]
end

lemma lift_fun_of_inj {f : fin n → fin n} : injective f → injective (lift_fun f) :=
assume Pinj, take i j,
have Pdi : decidable (i = maxi), from _, have Pdj : decidable (j = maxi), from _,
begin
  cases Pdi with Pimax Pinmax,
    cases Pdj with Pjmax Pjnmax,
      substvars, intros, exact rfl,
      substvars, rewrite [lift_fun_max, lift_fun_of_ne_max Pjnmax],
        intro Plmax, apply absurd Plmax⁻¹ lift_succ_ne_max,
    cases Pdj with Pjmax Pjnmax,
      substvars, rewrite [lift_fun_max, lift_fun_of_ne_max Pinmax],
        intro Plmax, apply absurd Plmax lift_succ_ne_max,
      rewrite [lift_fun_of_ne_max Pinmax, lift_fun_of_ne_max Pjnmax],
        intro Peq, rewrite [-eq_iff_veq],
        exact veq_of_eq (Pinj (lift_succ_inj Peq))
end

lemma lift_fun_inj : injective (@lift_fun n) :=
take f₁ f₂ Peq, funext (λ i,
have lift_fun f₁ (lift_succ i) = lift_fun f₂ (lift_succ i), from congr_fun Peq _,
begin revert this, rewrite [*lift_fun_eq], apply lift_succ_inj end)

lemma lower_inj_apply {f Pinj Pmax} (i : fin n) :
  val (lower_inj f Pinj Pmax i) = val (f (lift_succ i)) :=
by rewrite [↑lower_inj]

end lift_lower

section madd

definition madd (i j : fin (succ n)) : fin (succ n) :=
mk ((i + j) % (succ n)) (mod_lt _ !zero_lt_succ)

definition minv : ∀ i : fin (succ n), fin (succ n)
| (mk iv ilt) := mk ((succ n - iv) % succ n) (mod_lt _ !zero_lt_succ)

lemma val_madd : ∀ i j : fin (succ n), val (madd i j) = (i + j) % (succ n)
| (mk iv ilt) (mk jv jlt) := by esimp

lemma madd_inj : ∀ {i : fin (succ n)}, injective (madd i)
| (mk iv ilt) :=
take j₁ j₂, fin.destruct j₁ (fin.destruct j₂ (λ jv₁ jlt₁ jv₂ jlt₂, begin
  rewrite [↑madd, -eq_iff_veq],
  intro Peq, congruence,
  rewrite [-(mod_eq_of_lt jlt₁), -(mod_eq_of_lt jlt₂)],
  apply mod_eq_mod_of_add_mod_eq_add_mod_left Peq
end))

lemma madd_mk_mod {i j : nat} : madd (mk_mod n i) (mk_mod n j) = mk_mod n (i+j) :=
eq_of_veq begin esimp [madd, mk_mod], rewrite [ mod_add_mod, add_mod_mod ] end

lemma val_mod : ∀ i : fin (succ n), (val i) % (succ n) = val i
| (mk iv ilt) := by esimp; rewrite [(mod_eq_of_lt ilt)]

lemma madd_comm (i j : fin (succ n)) : madd i j = madd j i :=
by apply eq_of_veq; rewrite [*val_madd, add.comm (val i)]

lemma zero_madd (i : fin (succ n)) : madd 0 i = i :=
have H : madd (fin.zero n) i = i,
  by apply eq_of_veq; rewrite [val_madd, ↑fin.zero, nat.zero_add, mod_eq_of_lt (is_lt i)],
H

lemma madd_zero (i : fin (succ n)) : madd i (fin.zero n) = i :=
!madd_comm ▸ zero_madd i

lemma madd_assoc (i j k : fin (succ n)) : madd (madd i j) k = madd i (madd j k) :=
by apply eq_of_veq; rewrite [*val_madd, mod_add_mod, add_mod_mod, add.assoc (val i)]

lemma madd_left_inv : ∀ i : fin (succ n), madd (minv i) i = fin.zero n
| (mk iv ilt) := eq_of_veq (by
  rewrite [val_madd, ↑minv, ↑fin.zero, mod_add_mod, nat.sub_add_cancel (le_of_lt ilt), mod_self])

definition madd_is_comm_group [instance] : add_comm_group (fin (succ n)) :=
add_comm_group.mk madd madd_assoc (fin.zero n) zero_madd madd_zero minv madd_left_inv madd_comm

end madd

definition pred : fin n → fin n
| (mk v h) := mk (nat.pred v) (pre_lt_of_lt h)

lemma val_pred : ∀ (i : fin n), val (pred i) = nat.pred (val i)
| (mk v h) := rfl

lemma pred_zero : pred (fin.zero n) = fin.zero n :=
rfl

definition mk_pred (i : nat) (h : succ i < succ n) : fin n :=
mk i (lt_of_succ_lt_succ h)

definition succ : fin n → fin (succ n)
| (mk v h) := mk (nat.succ v) (succ_lt_succ h)

lemma val_succ : ∀ (i : fin n), val (succ i) = nat.succ (val i)
| (mk v h) := rfl

lemma succ_max : fin.succ maxi = (@maxi (nat.succ n)) := rfl

lemma lift_succ.comm : lift_succ ∘ (@succ n) = succ ∘ lift_succ :=
funext take i, eq_of_veq (begin rewrite [↑lift_succ, -val_lift, *val_succ, -val_lift] end)

definition elim0 {C : fin 0 → Type} : Π i : fin 0, C i
| (mk v h) := absurd h !not_lt_zero

definition zero_succ_cases {C : fin (nat.succ n) → Type} :
  C (fin.zero n) → (Π j : fin n, C (succ j)) → (Π k : fin (nat.succ n), C k) :=
begin
  intros CO CS k,
  induction k with [vk, pk],
  induction (nat.decidable_lt 0 vk) with [HT, HF],
  { show C (mk vk pk), from
    let vj := nat.pred vk in
    have vk = vj+1, from
      eq.symm (succ_pred_of_pos HT),
    have vj < n, from
      lt_of_succ_lt_succ (eq.subst `vk = vj+1` pk),
    have succ (mk vj `vj < n`) = mk vk pk, from
      val_inj (eq.symm `vk = vj+1`),
    eq.rec_on this (CS (mk vj `vj < n`)) },
  { show C (mk vk pk), from
    have vk = 0, from
      eq_zero_of_le_zero (le_of_not_gt HF),
    have fin.zero n = mk vk pk, from
      val_inj (eq.symm this),
    eq.rec_on this CO }
end

definition succ_maxi_cases {C : fin (nat.succ n) → Type} :
  (Π j : fin n, C (lift_succ j)) → C maxi → (Π k : fin (nat.succ n), C k) :=
begin
  intros CL CM k,
  induction k with [vk, pk],
  induction (nat.decidable_lt vk n) with [HT, HF],
  { show C (mk vk pk), from
    have HL : lift_succ (mk vk HT) = mk vk pk, from
      val_inj rfl,
    eq.rec_on HL (CL (mk vk HT)) },
  { show C (mk vk pk), from
    have HMv : vk = n, from
      le.antisymm (le_of_lt_succ pk) (le_of_not_gt HF),
    have HM : maxi = mk vk pk, from
      val_inj (eq.symm HMv),
    eq.rec_on HM CM }
end

definition foldr {A B : Type} (m : A → B → B) (b : B) : ∀ {n : nat}, (fin n → A) → B :=
  nat.rec (λ f, b) (λ n IH f, m (f (fin.zero n)) (IH (λ i : fin n, f (succ i))))

definition foldl {A B : Type} (m : B → A → B) (b : B) : ∀ {n : nat}, (fin n → A) → B :=
  nat.rec (λ f, b) (λ n IH f, m (IH (λ i : fin n, f (lift_succ i))) (f maxi))

theorem choice {C : fin n → Type} :
  (∀ i : fin n, nonempty (C i)) → nonempty (Π i : fin n, C i) :=
begin
  revert C,
  induction n with [n, IH],
  { intros C H,
    apply nonempty.intro,
    exact elim0 },
  { intros C H,
    fapply nonempty.elim (H (fin.zero n)),
    intro CO,
    fapply nonempty.elim (IH (λ i, C (succ i)) (λ i, H (succ i))),
    intro CS,
    apply nonempty.intro,
    exact zero_succ_cases CO CS }
end

section
open list
local postfix `+1`:100 := nat.succ

lemma dmap_map_lift {n : nat} : ∀ l : list nat, (∀ i, i ∈ l → i < n) → dmap (λ i, i < n +1) mk l = map lift_succ (dmap (λ i, i < n) mk l)
| []     := assume Plt, rfl
| (i::l) := assume Plt, begin
  rewrite [@dmap_cons_of_pos _ _ (λ i, i < n +1) _ _ _ (lt_succ_of_lt (Plt i !mem_cons)), @dmap_cons_of_pos _ _ (λ i, i < n) _ _ _ (Plt i !mem_cons), map_cons],
  congruence,
  apply dmap_map_lift,
  intro j Pjinl, apply Plt, apply mem_cons_of_mem, assumption end

lemma upto_succ (n : nat) : upto (n +1) = maxi :: map lift_succ (upto n) :=
begin
  rewrite [↑fin.upto, list.upto_succ, @dmap_cons_of_pos _ _ (λ i, i < n +1) _ _ _ (nat.self_lt_succ n)],
  congruence,
  apply dmap_map_lift, apply @list.lt_of_mem_upto
end

definition upto_step : ∀ {n : nat}, fin.upto (n +1) = (map succ (upto n))++[0]
| 0      := rfl
| (i +1) := begin rewrite [upto_succ i, map_cons, append_cons, succ_max, upto_succ, -lift_zero],
  congruence, rewrite [map_map, -lift_succ.comm, -map_map, -(map_singleton _ 0), -map_append, -upto_step] end
end

open sum equiv decidable

definition fin_zero_equiv_empty : fin 0 ≃ empty :=
⦃ equiv,
  to_fun    := λ f : (fin 0), elim0 f,
  inv_fun   := λ e : empty, empty.rec _ e,
  left_inv  := λ f : (fin 0), elim0 f,
  right_inv := λ e : empty, empty.rec _ e
⦄

theorem false_of_fin_zero (x : fin 0) : false :=
  have t : empty, from equiv.fn (fin.fin_zero_equiv_empty) x,
  empty.induction_on (λ c, false) t

definition fin_one_equiv_unit : fin 1 ≃ unit :=
⦃ equiv,
  to_fun  := λ f : (fin 1), unit.star,
  inv_fun := λ u : unit,    fin.zero 0,
  left_inv := begin
    intro f, change mk 0 !zero_lt_succ = f, cases f with v h, congruence,
    have v +1 ≤ 1, from succ_le_of_lt h,
    have v ≤ 0, from le_of_succ_le_succ this,
    have v = 0, from eq_zero_of_le_zero this,
    subst v
  end,
  right_inv := begin
    intro u, cases u, reflexivity
  end
⦄

theorem fin_one_eq_zero (x : fin 1) : x = !fin.zero :=
  begin
    induction x with [xv, xlt],
    unfold fin.zero,
    congruence,
    apply eq_zero_of_le_zero,
    apply le_of_lt_succ xlt
  end

definition fin_sum_equiv (n m : nat) : (fin n + fin m) ≃ fin (n+m) :=
have aux₁ : ∀ {v}, v < m → (v + n) < (n + m), from
  take v, suppose v < m, calc
     v + n < m + n   : add_lt_add_of_lt_of_le this !le.refl
       ... = n + m   : add.comm,
⦃ equiv,
  to_fun := λ s : sum (fin n) (fin m),
    match s with
    | sum.inl (mk v hlt) := mk v     (lt_add_of_lt_right hlt m)
    | sum.inr (mk v hlt) := mk (v+n) (aux₁ hlt)
    end,
  inv_fun := λ f : fin (n + m),
    match f with
    | mk v hlt := if h : v < n then sum.inl (mk v h) else sum.inr (mk (v-n) (nat.sub_lt_of_lt_add hlt (le_of_not_gt h)))
    end,
  left_inv := begin
    intro s, cases s with f₁ f₂,
    { cases f₁ with v hlt, esimp, rewrite [dif_pos hlt] },
    { cases f₂ with v hlt, esimp,
      have ¬ v + n < n, from
        suppose v + n < n,
        have v < n - n, from nat.lt_sub_of_add_lt this !le.refl,
        have v < 0, by rewrite [nat.sub_self at this]; exact this,
        absurd this !not_lt_zero,
      rewrite [dif_neg this], congruence, congruence, rewrite [nat.add_sub_cancel] }
  end,
  right_inv := begin
    intro f, cases f with v hlt, esimp, apply @by_cases (v < n),
    { intro h₁, rewrite [dif_pos h₁] },
    { intro h₁, rewrite [dif_neg h₁], esimp, congruence, rewrite [nat.sub_add_cancel (le_of_not_gt h₁)] }
  end
⦄

definition fin_prod_equiv_of_pos (n m : nat) : n > 0 → (fin n × fin m) ≃ fin (n*m) :=
suppose n > 0,
have aux₁ : ∀ {v₁ v₂}, v₁ < n → v₂ < m → v₁ + v₂ * n < n*m, from
  take v₁ v₂, assume h₁ h₂,
    have   nat.succ v₂ ≤ m, from succ_le_of_lt h₂,
    have nat.succ v₂ * n ≤ m * n,       from mul_le_mul_right _ this,
    have   v₂ * n + n ≤ n * m,            by rewrite [-add_one at this, right_distrib at this, one_mul at this, mul.comm m n at this]; exact this,
    have v₁ + (v₂ * n + n) < n + n * m, from add_lt_add_of_lt_of_le h₁ this,
    have   v₁ + v₂ * n + n < n * m + n,   by rewrite [add.assoc, add.comm (n*m) n]; exact this,
    lt_of_add_lt_add_right this,
have aux₂ : ∀ v, v % n < n, from
  take v, mod_lt _ `n > 0`,
have aux₃ : ∀ {v}, v < n * m → v / n < m, from
  take v, assume h, by rewrite mul.comm at h; exact nat.div_lt_of_lt_mul h,
⦃ equiv,
  to_fun   := λ p : (fin n × fin m), match p with (mk v₁ hlt₁, mk v₂ hlt₂) := mk (v₁ + v₂ * n) (aux₁ hlt₁ hlt₂) end,
  inv_fun  := λ f : fin (n*m), match f with (mk v hlt) := (mk (v % n) (aux₂ v), mk (v / n) (aux₃ hlt)) end,
  left_inv := begin
    intro p, cases p with f₁ f₂, cases f₁ with v₁ hlt₁, cases f₂ with v₂ hlt₂, esimp,
    congruence,
      {congruence, rewrite [add_mul_mod_self, mod_eq_of_lt hlt₁] },
      {congruence, rewrite [add_mul_div_self `n > 0`, div_eq_zero_of_lt hlt₁, zero_add]}
  end,
  right_inv := begin
    intro f, cases f with v hlt, esimp, congruence,
    rewrite [add.comm, -eq_div_mul_add_mod]
  end
⦄

definition fin_prod_equiv : Π (n m : nat), (fin n × fin m) ≃ fin (n*m)
| 0     b := calc
  (fin 0 × fin b) ≃ (empty × fin b) : prod_congr fin_zero_equiv_empty !equiv.refl
          ...     ≃ empty           : prod_empty_left
          ...     ≃ fin 0           : fin_zero_equiv_empty
          ...     ≃ fin (0 * b)     : by rewrite zero_mul
| (a+1) b := fin_prod_equiv_of_pos (a+1) b dec_trivial

definition fin_two_equiv_bool : fin 2 ≃ bool :=
calc
  fin 2 ≃ fin (1 + 1)   : equiv.refl
   ...  ≃ fin 1 + fin 1 : fin_sum_equiv
   ...  ≃ unit + unit   : sum_congr fin_one_equiv_unit fin_one_equiv_unit
   ...  ≃ bool          : bool_equiv_unit_sum_unit

definition fin_sum_unit_equiv (n : nat) : fin n + unit ≃ fin (n+1) :=
calc
  fin n + unit ≃ fin n + fin 1 : sum_congr !equiv.refl (equiv.symm fin_one_equiv_unit)
          ...  ≃ fin (n+1)     : fin_sum_equiv
end fin


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

import linear_algebra.finrank
import linear_algebra.free_module.rank
import linear_algebra.free_module.finite.basic

/-!

# Rank of finite free modules

This is a basic API for the rank of finite free modules.

-/

--TODO: `linear_algebra/finite_dimensional` should import this file, and a lot of results should
--be moved here.

universes u v w

variables (R : Type u) (M : Type v) (N : Type w)

open_locale tensor_product direct_sum big_operators cardinal

open cardinal finite_dimensional fintype

namespace module.free

section ring

variables [ring R] [strong_rank_condition R]
variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]

/-- The rank of a finite and free module is finite. -/
lemma rank_lt_aleph_0 : module.rank R M < ℵ₀ :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  rw [← (choose_basis R M).mk_eq_dim'', lt_aleph_0_iff_fintype],
  exact nonempty.intro infer_instance
end

/-- If `M` is finite and free, `finrank M = rank M`. -/
@[simp] lemma finrank_eq_rank : ↑(finrank R M) = module.rank R M :=
by { rw [finrank, cast_to_nat_of_lt_aleph_0 (rank_lt_aleph_0 R M)] }

/-- The finrank of a free module `M` over `R` is the cardinality of `choose_basis_index R M`. -/
lemma finrank_eq_card_choose_basis_index : finrank R M = @card (choose_basis_index R M)
  (@choose_basis_index.fintype R M _ _ _ _ (nontrivial_of_invariant_basis_number R) _) :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  simp [finrank, rank_eq_card_choose_basis_index]
end

/-- The finrank of `(ι →₀ R)` is `fintype.card ι`. -/
@[simp] lemma finrank_finsupp {ι : Type v} [fintype ι] : finrank R (ι →₀ R) = card ι :=
by { rw [finrank, rank_finsupp, ← mk_to_nat_eq_card, to_nat_lift] }

/-- The finrank of `(ι → R)` is `fintype.card ι`. -/
lemma finrank_pi {ι : Type v} [fintype ι] : finrank R (ι → R) = card ι :=
by simp [finrank]

/-- The finrank of the direct sum is the sum of the finranks. -/
@[simp] lemma finrank_direct_sum  {ι : Type v} [fintype ι] (M : ι → Type w)
  [Π (i : ι), add_comm_group (M i)] [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)]
  [Π (i : ι), module.finite R (M i)] : finrank R (⨁ i, M i) = ∑ i, finrank R (M i) :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  simp only [finrank, λ i, rank_eq_card_choose_basis_index R (M i), rank_direct_sum,
    ← mk_sigma, mk_to_nat_eq_card, card_sigma],
end

/-- The finrank of `M × N` is `(finrank R M) + (finrank R N)`. -/
@[simp] lemma finrank_prod : finrank R (M × N) = (finrank R M) + (finrank R N) :=
by { simp [finrank, rank_lt_aleph_0 R M, rank_lt_aleph_0 R N] }

/-- The finrank of a finite product is the sum of the finranks. -/
--TODO: this should follow from `linear_equiv.finrank_eq`, that is over a field.
lemma finrank_pi_fintype {ι : Type v} [fintype ι] {M : ι → Type w}
  [Π (i : ι), add_comm_group (M i)] [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)]
  [Π (i : ι), module.finite R (M i)] : finrank R (Π i, M i) = ∑ i, finrank R (M i) :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  simp only [finrank, λ i, rank_eq_card_choose_basis_index R (M i), rank_pi_finite,
    ← mk_sigma, mk_to_nat_eq_card, card_sigma],
end

/-- If `m` and `n` are `fintype`, the finrank of `m × n` matrices is
  `(fintype.card m) * (fintype.card n)`. -/
lemma finrank_matrix (m n : Type v) [fintype m] [fintype n] :
  finrank R (matrix m n R) = (card m) * (card n) :=
by { simp [finrank] }

end ring

section comm_ring

variables [comm_ring R] [strong_rank_condition R]
variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]

/-- The finrank of `M ⊗[R] N` is `(finrank R M) * (finrank R N)`. -/
@[simp] lemma finrank_tensor_product (M : Type v) (N : Type w) [add_comm_group M] [module R M]
  [module.free R M] [add_comm_group N] [module R N] [module.free R N] :
finrank R (M ⊗[R] N) = (finrank R M) * (finrank R N) :=
by { simp [finrank] }

end comm_ring

end module.free


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

! This file was ported from Lean 3 source module group_theory.subgroup.simple
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Subgroup.Actions

/-!
# Simple groups

This file defines `IsSimpleGroup G`, a class indicating that a group has exactly two normal
subgroups.

## Main definitions

- `IsSimpleGroup G`, a class indicating that a group has exactly two normal subgroups.

## Tags
subgroup, subgroups

-/

variable {G : Type _} [Group G]

variable {A : Type _} [AddGroup A]

section

variable (G) (A)

/-- A `Group` is simple when it has exactly two normal `Subgroup`s. -/
class IsSimpleGroup extends Nontrivial G : Prop where
  /-- Any normal subgroup is either `⊥` or `⊤` -/
  eq_bot_or_eq_top_of_normal : ∀ H : Subgroup G, H.Normal → H = ⊥ ∨ H = ⊤
#align is_simple_group IsSimpleGroup

/-- An `AddGroup` is simple when it has exactly two normal `AddSubgroup`s. -/
class IsSimpleAddGroup extends Nontrivial A : Prop where
  /-- Any normal additive subgroup is either `⊥` or `⊤` -/
  eq_bot_or_eq_top_of_normal : ∀ H : AddSubgroup A, H.Normal → H = ⊥ ∨ H = ⊤
#align is_simple_add_group IsSimpleAddGroup

attribute [to_additive] IsSimpleGroup

variable {G} {A}

@[to_additive]
theorem Subgroup.Normal.eq_bot_or_eq_top [IsSimpleGroup G] {H : Subgroup G} (Hn : H.Normal) :
    H = ⊥ ∨ H = ⊤ :=
  IsSimpleGroup.eq_bot_or_eq_top_of_normal H Hn
#align subgroup.normal.eq_bot_or_eq_top Subgroup.Normal.eq_bot_or_eq_top
#align add_subgroup.normal.eq_bot_or_eq_top AddSubgroup.Normal.eq_bot_or_eq_top

namespace IsSimpleGroup

@[to_additive]
instance {C : Type _} [CommGroup C] [IsSimpleGroup C] : IsSimpleOrder (Subgroup C) :=
  ⟨fun H => H.normal_of_comm.eq_bot_or_eq_top⟩

open Subgroup

@[to_additive]

end IsSimpleGroup

end


universe u v

def Slices (A : Type u) : Type u := Array $ Subarray A

def slice {A : Type u} (as : Array A) (ranges : Array ((Fin (as.size + 1)) × (Fin (as.size+1)))) : Slices A :=
  Array.map (fun (start, stop) =>
    as.toSubarray start.val stop.val
  ) ranges

/-
Bounded Nat
-/
-- def BNat (min max : Nat) (h : min ≤ max) := {n : Fin (max + 1) // GE.ge n.val min }
structure BNat (min max : Nat) (isMinMax : LE.le min max)where
  val  : Nat
  isLe : LE.le val max
  isGe : GE.ge val min

-- def BNat.mk {min max : Nat} {h : min ≤ max} (n : Nat) (h1 : LE.le n max) (h2 : GE.ge n min) : BNat min max h :=
--   let f : Fin (max + 1) := ⟨n, by
--     rw [Nat.add_one]
--     apply Nat.lt_succ_of_le
--     apply h1
--   ⟩
--   ⟨f, by apply h2⟩

@[simp] theorem ge_is_le (n m : Nat) : n ≥ m → m ≤ n := by
  intro h
  exact h

@[simp] theorem ge_refl (n : Nat) : n ≥ n := by apply ge_is_le; apply Nat.le_refl

instance {min max} {h : min ≤ max}: Inhabited (BNat min max h) := ⟨BNat.mk min h (by simp)⟩

instance Nat_toBNat {min max n : Nat} {h : min ≤ max} (h1 : LE.le n max ∧ GE.ge n min) : OfNat (BNat min max h) n := ⟨BNat.mk n h1.left h1.right⟩

theorem BNat.eq_of_val_eq {max min} {h : min ≤ max} : ∀ {i j : BNat min max h}, Eq i.val j.val → Eq i j
  | ⟨v, lt, gt⟩, ⟨_, _, _⟩, rfl => rfl

theorem BNat.val_eq_of_eq {max min} {h1 : min ≤ max} {i j : BNat min max h1} (h : Eq i j) : Eq i.val j.val :=
  h ▸ rfl

theorem BNat.ne_of_val_ne {max min} {h1 : min ≤ max} {i j : BNat min max h1} (h : Not (Eq i.val j.val)) : Not (Eq i j) :=
  fun h' => absurd (val_eq_of_eq h') h

@[simp] theorem BNat.succ_le {max min} {h1 : min ≤ max} (n : BNat min max h1) (h : n.val < max): Nat.succ n.val ≤ max := h

instance (max min : Nat) (h1 : min ≤ max): DecidableEq (BNat min max h1) :=
  fun i j =>
    match decEq i.val j.val with
    | isTrue h  => isTrue (BNat.eq_of_val_eq h)
    | isFalse h => isFalse (BNat.ne_of_val_ne h)

instance {min max} {h : min ≤ max} : LT (BNat min max h) where
  lt a b := LT.lt a.val b.val

instance {min max} {h : min ≤ max} : LE (BNat min max h) where
  le a b := LE.le a.val b.val

instance BNat.decLt {min max} {h : min ≤ max} (a b : BNat min max h) : Decidable (LT.lt a b) := Nat.decLt ..
instance BNat.decLe {min max} {h : min ≤ max} (a b : BNat min max h) : Decidable (LE.le a b) := Nat.decLe ..

theorem range_terminates {min max} {h : min ≤ max} (n : BNat min max h): max - Nat.succ n.val ≤ max - n.val := by sorry

@[inline] def BNat.range {min max} {h' : min ≤ max} : List $ BNat min max h' :=
  let rec @[specialize] it : BNat min max h' → (List $ BNat min max h') := (λ n =>
    if h : n.val < max then
      List.cons n $ it
        { val := Nat.succ n.val
        , isLe := (by apply h)
        , isGe := (by
          apply ge_is_le
          apply Nat.le_of_lt
          apply Nat.lt_succ_of_le
          apply n.isGe
        )
        }
    else
      [BNat.mk n.val (by apply n.isLe) n.isGe]
  )
  it (BNat.mk min h' (by apply ge_refl))
termination_by measure λ b => b.snd.fst - b.snd.snd.snd.val
decreasing_by exact ⟨range_terminates⟩

@[simp] theorem add_le_cancel_right (m n k: Nat) : m ≤ n → m + k ≤ n + k := by
  intro h'
  apply Nat.add_le_add_right
  apply h'

@[simp] theorem mul_ge_one_of_ge_one {a b c : Nat} (ha : a ≥ c ) (hb : b ≥ 1) : a * b ≥ c :=
  --have h1 := Nat.le_refl a ▸ apply ha
  -- inductive a hs
  -- induction a-1 with
  -- | zero =>

  --   apply ha
  -- | succ n =>
  --   apply ha
  -- calc
  --   ha
  --   ... = a * 1 : (mul_one a).symm
  --   ... ≤ a * b : mul_le_mul_left' hb a
  by sorry
  -- rw [Nat.mul_le_mul]

--   rw []
--   ) it
-- instance (b : BNat min max) : Sub Nat b :=

@[simp] theorem one_le_size {h w : Nat} (ax : h ≥ 1 ∧ w ≥ 1) : 1 ≤ h * w := by
  apply mul_ge_one_of_ge_one
  apply ax.left
  apply ax.right


import tactic
import order.galois_connection
import order.closure        -- for closure_operator
import ring_theory.ideal.basic
import algebra.big_operators.basic
import data.nat.choose.sum

universe u

def f: empty → empty := begin
  intro h,
  cases h,
end

-- ###################################
-- Aufgabe 2
-- Aufgabe 2a)
def exercise2a {A: Type u} {B : Type u} [partial_order A] [partial_order B]
  (f: A → B) (g : B → A) [galois_connection f g] :
  closure_operator A := {
    to_fun := g ∘ f,
    monotone' := begin
      apply monotone.comp,
      apply galois_connection.monotone_u,
      exact _inst_3,
      apply galois_connection.monotone_l,
      exact _inst_3,
    end,
    le_closure' := begin
      intro x,
      simp,
      apply galois_connection.le_u _inst_3,
      refl,
    end,
    idempotent' := begin
      simp,
      intro x,
      apply partial_order.le_antisymm,
      apply galois_connection.monotone_u _inst_3,
      apply galois_connection.l_le _inst_3,
      refl,
      apply galois_connection.le_u _inst_3,
      refl,
    end
    ,
  }
  -- Aufgabe 2b)
  -- --> analog zu 2a)

open_locale big_operators

-- Aufgabe 2c)
def ideal_of_subset {R : Type} [comm_semiring R] (S : set R) : ideal R :=
{
  --carrier := {lin_comb | ∃ n : ℕ, ∃ r : ℕ → R, ∃ s : ℕ → S, lin_comb = ∑ i in finset.range(n), r i * s i},
  carrier := {x : R | ∀ I : ideal R, S ⊆ I → x ∈ I},
  zero_mem' := begin
    intros I _,
    exact I.zero_mem',
  end,
  add_mem' := begin
    intros a b ha hb,
    intros I hSI,
    specialize ha I hSI,
    specialize hb I hSI,
    exact I.add_mem' ha hb,
  end,
  smul_mem' := begin
    intros c x hx,
    intros I hSI,
    specialize hx I hSI,
    exact I.smul_mem' c hx,
  end,
}

-- the unique map from the empty set (type) to any type:
def fempty (N : Type) : (empty → N) :=
begin
  intro h,
  cases h,
end

/-
def ideal_of_subset' {R : Type} [comm_semiring R] (S : set R) : ideal R :=
{
  carrier := {lin_comb | ∃ N : Type, ∃ r : N → R, ∃ s : N → S, ∃ n : finset N, lin_comb = ∑ i in n, r i * s i},
  zero_mem' := begin
    use empty,
    use fempty R,
    use fempty S,
    use ⊤,
    ring_nf,
  end,
  add_mem' := begin
    intros a b ha hb,
    cases ha with Na ha,
    cases ha with ra ha,
    cases ha with sa ha,
    cases ha with na ha,
    cases hb with Nb hb,
    cases hb with rb hb,
    cases hb with sb hb,
    cases hb with nb hb,
    use sum Na Nb,
    have r : sum Na Nb → R := {
      λ x,
      | sum.inl x = ra x
      | sum.inr x = rb x
    },
    use (λ x, r x ),
  end,
  smul_mem' := begin
    intros c x hx,
    intros I hSI,
    specialize hx I hSI,
    exact I.smul_mem' c hx,
  end,
}
-/

notation `⟨` S `⟩` := ideal_of_subset S

lemma mem_ideal_of_iff {R : Type} [comm_semiring R] {S : set R} {x : R} :
  x ∈ ⟨S⟩ ↔ ∃ N : Type, ∃ r : N → R, ∃ s : N → S, ∃ n : finset N, x = ∑ i in n, r i * s i :=
begin
  split,
  {
    sorry,
  },
  {
    intro h,
    intros I hSI,
    sorry
  }
end

lemma ideal_of_extensive {R : Type} [comm_semiring R] (S : set R) : S ⊆ ⟨S⟩ :=
begin
  intros s hs,
  intros I hSI,
  apply hSI,
  assumption,
end

lemma ideal_of_mono {R : Type} [comm_semiring R] {S : set R} {T : set R} : S ⊆ T → ⟨S⟩.carrier ⊆ ⟨T⟩.carrier :=
begin
  intro hST,
  intro x,
  intro hx,
  intros I hTI,
  have hSI : S ⊆ I := begin
    exact set.subset.trans hST hTI,
  end,
  specialize hx I hSI,
  assumption,
end

lemma ideal_of_ideal {R : Type} [comm_semiring R] {I : ideal R} : ⟨I.carrier⟩ = I :=
begin
  ext,
  split,
  {
    intro h,
    specialize h I,
    apply h,
    refl,
  },
  {
    intro h,
    intros J hIJ,
    apply hIJ,
    assumption,
  },
end

lemma ideal_of_idempotent {R : Type} [comm_semiring R] {S : set R} : ⟨S⟩ = ⟨⟨S⟩.carrier⟩ :=
begin
  rw ideal_of_ideal,
end

-- The previous three lemmas together show that ⟨_⟩ is a closure operator
--lemma ideal_of_is_clos_op {R : Type} [comm_semiring R] : (closure_operator (λ S, (ideal_of_subset S).carrier))

-- Aufgabe 2d)
def radical_of_ideal {R : Type} [comm_semiring R] (I : ideal R) : ideal R :=
{
  carrier := {r : R | ∃ n : ℕ, r^n ∈ I},
  zero_mem' := begin
    use 1,
    ring,
    exact I.zero_mem',
  end,
  add_mem' := begin
    intros a b ha hb,
    cases ha with k ha,
    cases hb with l hb,
    use k+l,
    rw add_pow,
    sorry
  end,
  smul_mem' := begin
    intros c x,
    intro h,
    cases h with n h,
    use n,
    dsimp,
    rw mul_pow,
    apply I.smul_mem,
    assumption,
  end,
}

notation `√` I := radical_of_ideal I

def is_radical {R : Type} [comm_semiring R] (I : ideal R) : Prop :=
  ∀x : R, (∃ n : ℕ, x^n ∈ I) → x ∈ I

lemma radical_of_ideal_is_radical {R : Type} [comm_semiring R] (I : ideal R) : (is_radical √I) :=
begin
  intros x h,
  cases h with n h,
  cases h with m h,
  use n*m,
  rwa pow_mul,
end

lemma radical_of_is_extensive {R : Type} [comm_semiring R] (I : ideal R) : I.carrier ⊆ √ I :=
begin
  intros x hxI,
  use 1,
  simp,
  assumption,
end

lemma radical_of_is_mono {R : Type} [comm_semiring R] {I : ideal R} {J : ideal R} :
  I.carrier ⊆ J → (√I).carrier ⊆ √J :=
begin
  intro hIJ,
  intros x hxRI,
  cases hxRI with n hxI,
  use n,
  apply hIJ,
  assumption,
end

lemma radical_of_radical {R : Type} [comm_semiring R] {I : ideal R}: (is_radical I) → (√I) = I :=
begin
  intro h,
  ext,
  split,
  {
    intro hxRI,
    apply h,
    exact hxRI,
  },
  {
    apply radical_of_is_extensive I,
  },
end

lemma radical_of_is_idempotent {R : Type} [comm_semiring R] {I : ideal R} : (√I) = √√I :=
begin
  rw radical_of_radical (radical_of_ideal_is_radical I),
end

-- The previous three lemmas together show that √_ is a closure operator
--lemma radical_is_closure_op {R : Type} [comm_semiring R] : (closure_operator (λ (I : ideal R), radical_of_ideal I))


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

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

/-!
# fintype instances for sigma types

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

open Function

open Nat

universe u v

variable {α β γ : Type _}

open Finset Function

instance {α : Type _} (β : α → Type _) [Fintype α] [∀ a, Fintype (β a)] : Fintype (Sigma β) :=
  ⟨univ.Sigma fun _ => univ, fun ⟨a, b⟩ => by simp⟩

/- warning: finset.univ_sigma_univ -> Finset.univ_sigma_univ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : forall (a : α), Fintype.{u2} (β a)], Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (i : α) => β i))) (Finset.sigma.{u1, u2} α (fun (a : α) => β a) (Finset.univ.{u1} α _inst_1) (fun (a : α) => Finset.univ.{u2} (β a) (_inst_2 a))) (Finset.univ.{max u1 u2} (Sigma.{u1, u2} α (fun (i : α) => β i)) (Sigma.fintype.{u1, u2} α (fun (i : α) => β i) _inst_1 (fun (a : α) => _inst_2 a)))
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : forall (a : α), Fintype.{u1} (β a)], Eq.{max (succ u2) (succ u1)} (Finset.{max u1 u2} (Sigma.{u2, u1} α (fun (i : α) => β i))) (Finset.sigma.{u2, u1} α (fun (a : α) => β a) (Finset.univ.{u2} α _inst_1) (fun (a : α) => Finset.univ.{u1} (β a) (_inst_2 a))) (Finset.univ.{max u2 u1} (Sigma.{u2, u1} α (fun (i : α) => β i)) (instFintypeSigma.{u2, u1} α (fun (i : α) => β i) _inst_1 (fun (a : α) => _inst_2 a)))
Case conversion may be inaccurate. Consider using '#align finset.univ_sigma_univ Finset.univ_sigma_univₓ'. -/
@[simp]
theorem Finset.univ_sigma_univ {α : Type _} {β : α → Type _} [Fintype α] [∀ a, Fintype (β a)] :
    ((univ : Finset α).Sigma fun a => (univ : Finset (β a))) = univ :=
  rfl
#align finset.univ_sigma_univ Finset.univ_sigma_univ

#print PSigma.fintype /-
instance PSigma.fintype {α : Type _} {β : α → Type _} [Fintype α] [∀ a, Fintype (β a)] :
    Fintype (Σ'a, β a) :=
  Fintype.ofEquiv _ (Equiv.psigmaEquivSigma _).symm
#align psigma.fintype PSigma.fintype
-/


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

import tactic.norm_num

/-!
# Tests for `norm_num` extensions
-/

constant real : Type
notation `ℝ` := real
@[instance] constant real.linear_ordered_ring : linear_ordered_field ℝ

constant complex : Type
notation `ℂ` := complex
@[instance] constant complex.field : field ℂ
@[instance] constant complex.char_zero : char_zero ℂ

example : 374 + (32 - (2 * 8123) : ℤ) - 61 * 50 = 86 + 32 * 32 - 4 * 5000
      ∧ 43 ≤ 74 + (33 : ℤ) := by norm_num

example : ¬ (7-2)/(2*3) ≥ (1:ℝ) + 2/(3^2) := by norm_num
example : (6:real) + 9 = 15 := by norm_num
example : (2:real)/4 + 4 = 3*3/2 := by norm_num
example : (((3:real)/4)-12)<6 := by norm_num
example : (5:real) ≠ 8 := by norm_num
example : (10:real) > 7 := by norm_num
example : (2:real) * 2 + 3 = 7 := by norm_num
example : (6:real) < 10 := by norm_num
example : (7:real)/2 > 3 := by norm_num
example : (4:real)⁻¹ < 1 := by norm_num
example : ((1:real) / 2)⁻¹ = 2 := by norm_num
example : 2 ^ 17 - 1 = 131071 :=
by {norm_num, tactic.try_for 200 (tactic.result >>= tactic.type_check)}

example : (1:complex) ≠ 2 := by norm_num
example : (1:complex) / 3 ≠ 2 / 7 := by norm_num

example {α} [semiring α] [char_zero α] : (1:α) ≠ 2 := by norm_num
example {α} [ring α] [char_zero α] : (-1:α) ≠ 2 := by norm_num
example {α} [division_ring α] [char_zero α] : (-1:α) ≠ 2 := by norm_num
example {α} [division_ring α] [char_zero α] : (1:α) / 3 ≠ 2 / 7 := by norm_num
example {α} [division_ring α] [char_zero α] : (1:α) / 3 ≠ 0 := by norm_num

example : (5 / 2:ℕ) = 2 := by norm_num
example : (5 / -2:ℤ) < -1 := by norm_num
example : (0 + 1) / 2 < 0 + 1 := by norm_num
example : nat.succ (nat.succ (2 ^ 3)) = 10 := by norm_num
example : 10 = (-1 : ℤ) % 11 := by norm_num
example : (12321 - 2 : ℤ) = 12319 := by norm_num

example (x : ℤ) (h : 1000 + 2000 < x) : 100 * 30 < x :=
by norm_num at *; try_for 100 {exact h}

example : (1103 : ℤ) ≤ (2102 : ℤ) := by norm_num
example : (110474 : ℤ) ≤ (210485 : ℤ) := by norm_num
example : (11047462383473829263 : ℤ) ≤ (21048574677772382462 : ℤ) := by norm_num
example : (210485742382937847263 : ℤ) ≤ (1104857462382937847262 : ℤ) := by norm_num
example : (210485987642382937847263 : ℕ) ≤ (11048512347462382937847262 : ℕ) := by norm_num
example : (210485987642382937847263 : ℚ) ≤ (11048512347462382937847262 : ℚ) := by norm_num
example : (2 * 12868 + 25705) * 11621 ^ 2 ≤ 23235 ^ 2 * 12868 := by norm_num

example (x : ℕ) : ℕ := begin
  let n : ℕ, {apply_normed (2^32 - 71)},
  exact n
end

example (a : ℚ) (h : 3⁻¹ * a = a) : true :=
begin
  norm_num at h,
  guard_hyp h : 1 / 3 * a = a,
  trivial
end

example (h : (5 : ℤ) ∣ 2) : false := by norm_num at h
example (h : false) : false := by norm_num at h
example : true := by norm_num
example : true ∧ true := by { split, norm_num, norm_num }

example : 10 + 2 = 1 + 11 := by norm_num

example : 10 - 1 = 9 := by norm_num
example : 12 - 5 = 3 + 4 := by norm_num
example : 5 - 20 = 0 := by norm_num
example : 0 - 2 = 0 := by norm_num
example : 4 - (5 - 10) = 2 + (3 - 1) := by norm_num
example : 0 - 0 = 0 := by norm_num
example : 100 - 100 = 0 := by norm_num
example : 5 * (2 - 3) = 0 := by norm_num
example : 10 - 5 * 5 + (7 - 3) * 6 = 27 - 3 := by norm_num

def foo : ℕ := 1

@[norm_num] meta def eval_foo : expr → tactic (expr × expr)
| `(foo) := pure (`(1:ℕ), `(eq.refl 1))
| _ := tactic.failed

example : foo = 1 := by norm_num

-- ordered field examples

variable {α : Type}
variable [linear_ordered_field α]

example : (-1 :α) * 1 = -1 := by norm_num
example : (-2 :α) * 1 = -2 := by norm_num
example : (-2 :α) * -1 = 2 := by norm_num
example : (-2 :α) * -2 = 4 := by norm_num
example : (1 : α) * 0 = 0 := by norm_num

example : ((1 : α) + 1) * 5 = 6 + 4 := by norm_num

example : (1 : α) = 0 + 1 := by norm_num
example : (1 : α) = 1 + 0 := by norm_num
example : (2 : α) = 1 + 1 := by norm_num
example : (2 : α) = 0 + 2 := by norm_num
example : (3 : α) = 1 + 2 := by norm_num
example : (3 : α) = 2 + 1 := by norm_num
example : (4 : α) = 3 + 1 := by norm_num
example : (4 : α) = 2 + 2 := by norm_num
example : (5 : α) = 4 + 1 := by norm_num
example : (5 : α) = 3 + 2 := by norm_num
example : (5 : α) = 2 + 3 := by norm_num
example : (6 : α) = 0 + 6 := by norm_num
example : (6 : α) = 3 + 3 := by norm_num
example : (6 : α) = 4 + 2 := by norm_num
example : (6 : α) = 5 + 1 := by norm_num
example : (7 : α) = 4 + 3 := by norm_num
example : (7 : α) = 1 + 6 := by norm_num
example : (7 : α) = 6 + 1 := by norm_num
example : 33 = 5 + (28 : α) := by norm_num

example : (12 : α) = 0 + (2 + 3) + 7 := by norm_num
example : (105 : α) = 70 + (33 + 2) := by norm_num

example : (45000000000 : α) = 23000000000 + 22000000000 := by norm_num

example : (0 : α) - 3 = -3 := by norm_num
example : (0 : α) - 2 = -2 := by norm_num
example : (1 : α) - 3 = -2 := by norm_num
example : (1 : α) - 1 = 0 := by norm_num
example : (0 : α) - 3 = -3 := by norm_num
example : (0 : α) - 3 = -3 := by norm_num

example : (12 : α) - 4 - (5 + -2) = 5 := by norm_num
example : (12 : α) - 4 - (5 + -2) - 20 = -15 := by norm_num

example : (0 : α) * 0 = 0 := by norm_num
example : (0 : α) * 1 = 0 := by norm_num
example : (0 : α) * 2 = 0 := by norm_num
example : (2 : α) * 0 = 0 := by norm_num
example : (1 : α) * 0 = 0 := by norm_num
example : (1 : α) * 1 = 1 := by norm_num
example : (2 : α) * 1 = 2 := by norm_num
example : (1 : α) * 2 = 2 := by norm_num
example : (2 : α) * 2 = 4 := by norm_num
example : (3 : α) * 2 = 6 := by norm_num
example : (2 : α) * 3 = 6 := by norm_num
example : (4 : α) * 1 = 4 := by norm_num
example : (1 : α) * 4 = 4 := by norm_num
example : (3 : α) * 3 = 9 := by norm_num
example : (3 : α) * 4 = 12 := by norm_num
example : (4 : α) * 4 = 16 := by norm_num
example : (11 : α) * 2 = 22 := by norm_num
example : (15 : α) * 6 = 90 := by norm_num
example : (123456 : α) * 123456 = 15241383936 := by norm_num

example : (4 : α) / 2 = 2 := by norm_num
example : (4 : α) / 1 = 4 := by norm_num
example : (4 : α) / 3 = 4 / 3 := by norm_num
example : (50 : α) / 5 = 10 := by norm_num
example : (1056 : α) / 1 = 1056 := by norm_num
example : (6 : α) / 4 = 3/2 := by norm_num
example : (0 : α) / 3 = 0 := by norm_num
example : (3 : α) / 0 = 0 := by norm_num
example : (9 * 9 * 9) * (12 : α) / 27 = 81 * (2 + 2) := by norm_num
example : (-2 : α) * 4 / 3 = -8 / 3 := by norm_num
example : - (-4 / 3) = 1 / (3 / (4 : α)) := by norm_num

-- auto gen tests
example : ((25 * (1 / 1)) + (30 - 16)) = (39 : α) := by norm_num
example : ((19 * (- 2 - 3)) / 6) = (-95/6 : α) := by norm_num
example : - (3 * 28) = (-84 : α) := by norm_num
example : - - (16 / ((11 / (- - (6 * 19) + 12)) * 21)) = (96/11 : α) := by norm_num
example : (- (- 21 + 24) - - (- - (28 + (- 21 / - (16 / ((1 * 26) * ((0 * - 11) + 13))))) * 21)) =
  (79209/8 : α) := by norm_num
example : (27 * (((16 + - (12 + 4)) + (22 - - 19)) - 23)) = (486 : α) := by norm_num
example : - (13 * (- 30 / ((7 / 24) + - 7))) = (-9360/161 : α) := by norm_num
example : - (0 + 20) = (-20 : α) := by norm_num
example : (- 2 - (27 + (((2 / 14) - (7 + 21)) + (16 - - - 14)))) = (-22/7 : α) := by norm_num
example : (25 + ((8 - 2) + 16)) = (47 : α) := by norm_num
example : (- - 26 / 27) = (26/27 : α) := by norm_num
example : ((((16 * (22 / 14)) - 18) / 11) + 30) = (2360/77 : α) := by norm_num
example : (((- 28 * 28) / (29 - 24)) * 24) = (-18816/5 : α) := by norm_num
example : ((- (18 - ((- - (10 + - 2) - - (23 / 5)) / 5)) - (21 * 22)) -
  (((20 / - ((((19 + 18) + 15) + 3) + - 22)) + 14) / 17)) = (-394571/825 : α) := by norm_num
example : ((3 + 25) - - 4) = (32 : α) := by norm_num
example : ((1 - 0) - 22) = (-21 : α) := by norm_num
example : (((- (8 / 7) / 14) + 20) + 22) = (2054/49 : α) := by norm_num
example : ((21 / 20) - 29) = (-559/20 : α) := by norm_num
example : - - 20 = (20 : α) := by norm_num
example : (24 - (- 9 / 4)) = (105/4 : α) := by norm_num
example : (((7 / ((23 * 19) + (27 * 10))) - ((28 - - 15) * 24)) + (9 / - (10 * - 3))) =
  (-1042007/1010 : α) := by norm_num
example : (26 - (- 29 + (12 / 25))) = (1363/25 : α) := by norm_num
example : ((11 * 27) / (4 - 5)) = (-297 : α) := by norm_num
example : (24 - (9 + 15)) = (0 : α) := by norm_num
example : (- 9 - - 0) = (-9 : α) := by norm_num
example : (- 10 / (30 + 10)) = (-1/4 : α) := by norm_num
example : (22 - (6 * (28 * - 8))) = (1366 : α) := by norm_num
example : ((- - 2 * (9 * - 3)) + (22 / 30)) = (-799/15 : α) := by norm_num
example : - (26 / ((3 + 7) / - (27 * (12 / - 16)))) = (-1053/20 : α) := by norm_num
example : ((- 29 / 1) + 28) = (-1 : α) := by norm_num
example : ((21 * ((10 - (((17 + 28) - - 0) + 20)) + 26)) + ((17 + - 16) * 7)) = (-602 : α) :=
by norm_num
example : (((- 5 - ((24 + - - 8) + 3)) + 20) + - 23) = (-43 : α) := by norm_num
example : ((- ((14 - 15) * (14 + 8)) + ((- (18 - 27) - 0) + 12)) - 11) = (32 : α) := by norm_num
example : (((15 / 17) * (26 / 27)) + 28) = (4414/153 : α) := by norm_num
example : (14 - ((- 16 - 3) * - (20 * 19))) = (-7206 : α) := by norm_num
example : (21 - - - (28 - (12 * 11))) = (125 : α) := by norm_num
example : ((0 + (7 + (25 + 8))) * - (11 * 27)) = (-11880 : α) := by norm_num
example : (19 * - 5) = (-95 : α) := by norm_num
example : (29 * - 8) = (-232 : α) := by norm_num
example : ((22 / 9) - 29) = (-239/9 : α) := by norm_num
example : (3 + (19 / 12)) = (55/12 : α) := by norm_num
example : - (13 + 30) = (-43 : α) := by norm_num
example : - - - (((21 * - - ((- 25 - (- (30 - 5) / (- 5 - 5))) /
  (((6 + ((25 * - 13) + 22)) - 3) / 2))) / (- 3 / 10)) * (- 8 - 0)) = (-308/3 : α) := by norm_num
example : - (2 * - (- 24 * 22)) = (-1056 : α) := by norm_num
example : - - (((28 / - ((- 13 * - 5) / - (((7 - 30) / 16) + 6))) * 0) - 24) = (-24 : α) :=
by norm_num
example : ((13 + 24) - (27 / (21 * 13))) = (3358/91 : α) := by norm_num
example : ((3 / - 21) * 25) = (-25/7 : α) := by norm_num
example : (17 - (29 - 18)) = (6 : α) := by norm_num
example : ((28 / 20) * 15) = (21 : α) := by norm_num
example : ((((26 * (- (23 - 13) - 3)) / 20) / (14 - (10 + 20))) / ((16 / 6) / (16 * - (3 / 28)))) =
(-1521/2240 : α) := by norm_num

example : (46 / (- ((- 17 * 28) - 77) + 87)) = (23/320 : α) := by norm_num
example : (73 * - (67 - (74 * - - 11))) = (54531 : α) := by norm_num
example : ((8 * (25 / 9)) + 59) = (731/9 : α) := by norm_num
example : - ((59 + 85) * - 70) = (10080 : α) := by norm_num
example : (66 + (70 * 58)) = (4126 : α) := by norm_num
example : (- - 49 * 0) = (0 : α) := by norm_num
example : ((- 78 - 69) * 9) = (-1323 : α) := by norm_num
example : - - (7 - - (50 * 79)) = (3957 : α) := by norm_num
example : - (85 * (((4 * 93) * 19) * - 31)) = (18624180 : α) := by norm_num
example : (21 + (- 5 / ((74 * 85) / 45))) = (26373/1258 : α) := by norm_num
example : (42 - ((27 + 64) + 26)) = (-75 : α) := by norm_num
example : (- ((38 - - 17) + 86) - (74 + 58)) = (-273 : α) := by norm_num
example : ((29 * - (75 + - 68)) + (- 41 / 28)) = (-5725/28 : α) := by norm_num
example : (- - (40 - 11) - (68 * 86)) = (-5819 : α) := by norm_num
example : (6 + ((65 - 14) + - 89)) = (-32 : α) := by norm_num
example : (97 * - (29 * 35)) = (-98455 : α) := by norm_num
example : - (66 / 33) = (-2 : α) := by norm_num
example : - ((94 * 89) + (79 - (23 - (((- 1 / 55) + 95) * (28 - (54 / - - - 22)))))) =
(-1369070/121 : α) := by norm_num
example : (- 23 + 61) = (38 : α) := by norm_num
example : - (93 / 69) = (-31/23 : α) := by norm_num
example : (- - ((68 / (39 + (((45 * - (59 - (37 + 35))) / (53 - 75)) -
 - (100 + - (50 / (- 30 - 59)))))) - (69 - (23 * 30))) / (57 + 17)) = (137496481/16368578 : α) :=
by norm_num
example : (- 19 * - - (75 * - - 41)) = (-58425 : α) := by norm_num
example : ((3 / ((- 28 * 45) * (19 + ((- (- 88 - (- (- 1 + 90) + 8)) + 87) * 48)))) + 1) =
  (1903019/1903020 : α) := by norm_num
example : ((- - (28 + 48) / 75) + ((- 59 - 14) - 0)) = (-5399/75 : α) := by norm_num
example : (- ((- (((66 - 86) - 36) / 94) - 3) / - - (77 / (56 - - - 79))) + 87) =
  (312254/3619 : α) := by norm_num