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

Properties of the power operation in various structures, including ordered rings and fields.
-/
import .group_power .ordered_field
open nat

variable {A : Type}

section semiring
variable [s : semiring A]
include s

definition semiring_has_pow_nat [instance] : has_pow_nat A :=
monoid_has_pow_nat

theorem zero_pow {m : ℕ} (mpos : m > 0) : 0^m = (0 : A) :=
have h₁ : ∀ m : nat, (0 : A)^(succ m) = (0 : A),
  begin
    intro m, induction m,
      krewrite pow_one,
      apply zero_mul
  end,
obtain m' (h₂ : m = succ m'), from exists_eq_succ_of_pos mpos,
show 0^m = 0, by rewrite h₂; apply h₁

end semiring

section integral_domain
variable [s : integral_domain A]
include s

definition integral_domain_has_pow_nat [instance] : has_pow_nat A :=
monoid_has_pow_nat

theorem eq_zero_of_pow_eq_zero {a : A} {m : ℕ} (H : a^m = 0) : a = 0 :=
or.elim (eq_zero_or_pos m)
  (suppose m = 0,
    by rewrite [`m = 0` at H, pow_zero at H]; apply absurd H (ne.symm zero_ne_one))
  (suppose m > 0,
    have h₁ : ∀ m, a^succ m = 0 → a = 0,
      begin
        intro m,
        induction m with m ih,
          {krewrite pow_one; intros; assumption},
        rewrite pow_succ,
        intro H,
        cases eq_zero_or_eq_zero_of_mul_eq_zero H with h₃ h₄,
          assumption,
        exact ih h₄
      end,
    obtain m' (h₂ : m = succ m'), from exists_eq_succ_of_pos `m > 0`,
    show a = 0, by rewrite h₂ at H; apply h₁ m' H)

theorem pow_ne_zero_of_ne_zero {a : A} {m : ℕ} (H : a ≠ 0) : a^m ≠ 0 :=
assume H', H (eq_zero_of_pow_eq_zero H')

end integral_domain

section division_ring
variable [s : division_ring A]
include s

theorem division_ring.pow_ne_zero_of_ne_zero {a : A} {m : ℕ} (H : a ≠ 0) : a^m ≠ 0 :=
or.elim (eq_zero_or_pos m)
  (suppose m = 0,
    by rewrite [`m = 0`, pow_zero]; exact (ne.symm zero_ne_one))
  (suppose m > 0,
    have h₁ : ∀ m, a^succ m ≠ 0,
      begin
        intro m,
        induction m with m ih,
          { krewrite pow_one; assumption },
        rewrite pow_succ,
        apply division_ring.mul_ne_zero H ih
      end,
    obtain m' (h₂ : m = succ m'), from exists_eq_succ_of_pos `m > 0`,
    show a^m ≠ 0, by rewrite h₂; apply h₁ m')

end division_ring

section linear_ordered_semiring
variable [s : linear_ordered_semiring A]
include s

theorem pow_pos_of_pos {x : A} (i : ℕ) (H : x > 0) : x^i > 0 :=
begin
  induction i with [j, ih],
    {show (1 : A) > 0, from zero_lt_one},
    {show x^(succ j) > 0, from mul_pos H ih}
end

theorem pow_nonneg_of_nonneg {x : A} (i : ℕ) (H : x ≥ 0) : x^i ≥ 0 :=
begin
  induction i with j ih,
    {show (1 : A) ≥ 0, from le_of_lt zero_lt_one},
    {show x^(succ j) ≥ 0, from mul_nonneg H ih}
end

theorem pow_le_pow_of_le {x y : A} (i : ℕ) (H₁ : 0 ≤ x) (H₂ : x ≤ y) : x^i ≤ y^i :=
begin
  induction i with i ih,
    {rewrite *pow_zero, apply le.refl},
  rewrite *pow_succ,
  have H : 0 ≤ x^i, from pow_nonneg_of_nonneg i H₁,
  apply mul_le_mul H₂ ih H (le.trans H₁ H₂)
end

theorem pow_ge_one {x : A} (i : ℕ) (xge1 : x ≥ 1) : x^i ≥ 1 :=
have H : x^i ≥ 1^i, from pow_le_pow_of_le i (le_of_lt zero_lt_one) xge1,
by rewrite one_pow at H; exact H

theorem pow_gt_one {x : A} {i : ℕ} (xgt1 : x > 1) (ipos : i > 0) : x^i > 1 :=
have xpos : x > 0, from lt.trans zero_lt_one xgt1,
begin
  induction i with [i, ih],
    {exfalso, exact !lt.irrefl ipos},
  have xige1 : x^i ≥ 1, from pow_ge_one _ (le_of_lt xgt1),
  rewrite [pow_succ, -mul_one 1],
  apply mul_lt_mul xgt1 xige1 zero_lt_one,
  apply le_of_lt xpos
end

theorem squared_lt_squared {x y : A} (H1 : 0 ≤ x) (H2 : x < y) : x^2 < y^2 :=
by rewrite [*pow_two]; apply mul_self_lt_mul_self H1 H2

theorem squared_le_squared {x y : A} (H1 : 0 ≤ x) (H2 : x ≤ y) : x^2 ≤ y^2 :=
or.elim (lt_or_eq_of_le H2)
  (assume xlty, le_of_lt (squared_lt_squared H1 xlty))
  (assume xeqy, by rewrite xeqy; apply le.refl)

theorem lt_of_squared_lt_squared {x y : A} (H1 : y ≥ 0) (H2 : x^2 < y^2) : x < y :=
lt_of_not_ge (assume H : x ≥ y, not_le_of_gt H2 (squared_le_squared H1 H))

theorem le_of_squared_le_squared {x y : A} (H1 : y ≥ 0) (H2 : x^2 ≤ y^2) : x ≤ y :=
le_of_not_gt (assume H : x > y, not_lt_of_ge H2 (squared_lt_squared H1 H))

theorem eq_of_squared_eq_squared_of_nonneg {x y : A} (H1 : x ≥ 0) (H2 : y ≥ 0) (H3 : x^2 = y^2) :
  x = y :=
lt.by_cases
  (suppose x < y, absurd (eq.subst H3 (squared_lt_squared H1 this)) !lt.irrefl)
  (suppose x = y, this)
  (suppose x > y, absurd (eq.subst H3 (squared_lt_squared H2 this)) !lt.irrefl)

end linear_ordered_semiring

section decidable_linear_ordered_comm_ring
variable [s : decidable_linear_ordered_comm_ring A]
include s

definition decidable_linear_ordered_comm_ring_has_pow_nat [instance] : has_pow_nat A :=
monoid_has_pow_nat

theorem abs_pow (a : A) (n : ℕ) : abs (a^n) = abs a^n :=
begin
  induction n with n ih,
    krewrite [*pow_zero, (abs_of_nonneg zero_le_one : abs (1 : A) = 1)],
  rewrite [*pow_succ, abs_mul, ih]
end

theorem squared_nonneg (x : A) : x^2 ≥ 0 := by rewrite [pow_two]; apply mul_self_nonneg

theorem eq_zero_of_squared_eq_zero {x : A} (H : x^2 = 0) : x = 0 :=
by rewrite [pow_two at H]; exact eq_zero_of_mul_self_eq_zero H

theorem abs_eq_abs_of_squared_eq_squared {x y : A} (H : x^2 = y^2) : abs x = abs y :=
have (abs x)^2 = (abs y)^2, by rewrite [-+abs_pow, H],
eq_of_squared_eq_squared_of_nonneg (abs_nonneg x) (abs_nonneg y) this

end decidable_linear_ordered_comm_ring

section field
variable [s : field A]
include s

theorem field.div_pow (a : A) {b : A} {n : ℕ} (bnz : b ≠ 0) : (a / b)^n = a^n / b^n :=
begin
  induction n with n ih,
    krewrite [*pow_zero, div_one],
  have bnnz : b^n ≠ 0, from division_ring.pow_ne_zero_of_ne_zero bnz,
  rewrite [*pow_succ, ih, !field.div_mul_div bnz bnnz]
end

end field

section discrete_field
variable [s : discrete_field A]
include s

theorem div_pow (a : A) {b : A} {n : ℕ} : (a / b)^n = a^n / b^n :=
begin
  induction n with n ih,
    krewrite [*pow_zero, div_one],
  rewrite [*pow_succ, ih, div_mul_div]
end

end discrete_field


/-
Copyright (c) 2022 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne

! This file was ported from Lean 3 source module measure_theory.function.conditional_expectation.indicator
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Function.ConditionalExpectation.Basic

/-!

# Conditional expectation of indicator functions

This file proves some results about the conditional expectation of an indicator function and
as a corollary, also proves several results about the behaviour of the conditional expectation on
a restricted measure.

## Main result

* `measure_theory.condexp_indicator`: If `s` is a `m`-measurable set, then the conditional
  expectation of the indicator function of `s` is almost everywhere equal to the indicator
  of `s` of the conditional expectation. Namely, `𝔼[s.indicator f | m] = s.indicator 𝔼[f | m]` a.e.

-/

noncomputable section

open TopologicalSpace MeasureTheory.lp Filter ContinuousLinearMap

open NNReal ENNReal Topology BigOperators MeasureTheory

namespace MeasureTheory

variable {α 𝕜 E : Type _} {m m0 : MeasurableSpace α} [NormedAddCommGroup E] [NormedSpace ℝ E]
  [CompleteSpace E] {μ : Measure α} {f : α → E} {s : Set α}

theorem condexp_ae_eq_restrict_zero (hs : measurable_set[m] s) (hf : f =ᵐ[μ.restrict s] 0) :
    μ[f|m] =ᵐ[μ.restrict s] 0 := by
  by_cases hm : m ≤ m0
  swap
  · simp_rw [condexp_of_not_le hm]
  by_cases hμm : sigma_finite (μ.trim hm)
  swap
  · simp_rw [condexp_of_not_sigma_finite hm hμm]
  haveI : sigma_finite (μ.trim hm) := hμm
  have : sigma_finite ((μ.restrict s).trim hm) :=
    by
    rw [← restrict_trim hm _ hs]
    exact restrict.sigma_finite _ s
  by_cases hf_int : integrable f μ
  swap
  · rw [condexp_undef hf_int]
  refine' ae_eq_of_forall_set_integral_eq_of_sigma_finite' hm _ _ _ _ _
  · exact fun t ht hμt => integrable_condexp.integrable_on.integrable_on
  · exact fun t ht hμt => (integrable_zero _ _ _).IntegrableOn
  · intro t ht hμt
    rw [measure.restrict_restrict (hm _ ht), set_integral_condexp hm hf_int (ht.inter hs), ←
      measure.restrict_restrict (hm _ ht)]
    refine' set_integral_congr_ae (hm _ ht) _
    filter_upwards [hf]with x hx h using hx
  · exact strongly_measurable_condexp.ae_strongly_measurable'
  · exact strongly_measurable_zero.ae_strongly_measurable'
#align measure_theory.condexp_ae_eq_restrict_zero MeasureTheory.condexp_ae_eq_restrict_zero

/-- Auxiliary lemma for `condexp_indicator`. -/
theorem condexp_indicator_aux (hs : measurable_set[m] s) (hf : f =ᵐ[μ.restrict (sᶜ)] 0) :
    μ[s.indicator f|m] =ᵐ[μ] s.indicator (μ[f|m]) :=
  by
  by_cases hm : m ≤ m0
  swap
  · simp_rw [condexp_of_not_le hm, Set.indicator_zero']
  have hsf_zero : ∀ g : α → E, g =ᵐ[μ.restrict (sᶜ)] 0 → s.indicator g =ᵐ[μ] g := fun g =>
    indicator_ae_eq_of_restrict_compl_ae_eq_zero (hm _ hs)
  refine' ((hsf_zero (μ[f|m]) (condexp_ae_eq_restrict_zero hs.compl hf)).trans _).symm
  exact condexp_congr_ae (hsf_zero f hf).symm
#align measure_theory.condexp_indicator_aux MeasureTheory.condexp_indicator_aux

/-- The conditional expectation of the indicator of a function over an `m`-measurable set with
respect to the σ-algebra `m` is a.e. equal to the indicator of the conditional expectation. -/
theorem condexp_indicator (hf_int : Integrable f μ) (hs : measurable_set[m] s) :
    μ[s.indicator f|m] =ᵐ[μ] s.indicator (μ[f|m]) :=
  by
  by_cases hm : m ≤ m0
  swap
  · simp_rw [condexp_of_not_le hm, Set.indicator_zero']
  by_cases hμm : sigma_finite (μ.trim hm)
  swap
  · simp_rw [condexp_of_not_sigma_finite hm hμm, Set.indicator_zero']
  haveI : sigma_finite (μ.trim hm) := hμm
  -- use `have` to perform what should be the first calc step because of an error I don't
  -- understand
  have : s.indicator (μ[f|m]) =ᵐ[μ] s.indicator (μ[s.indicator f + sᶜ.indicator f|m]) := by
    rw [Set.indicator_self_add_compl s f]
  refine' (this.trans _).symm
  calc
    s.indicator (μ[s.indicator f + sᶜ.indicator f|m]) =ᵐ[μ]
        s.indicator (μ[s.indicator f|m] + μ[sᶜ.indicator f|m]) :=
      by
      have : μ[s.indicator f + sᶜ.indicator f|m] =ᵐ[μ] μ[s.indicator f|m] + μ[sᶜ.indicator f|m] :=
        condexp_add (hf_int.indicator (hm _ hs)) (hf_int.indicator (hm _ hs.compl))
      filter_upwards [this]with x hx
      classical rw [Set.indicator_apply, Set.indicator_apply, hx]
    _ = s.indicator (μ[s.indicator f|m]) + s.indicator (μ[sᶜ.indicator f|m]) :=
      (s.indicator_add' _ _)
    _ =ᵐ[μ] s.indicator (μ[s.indicator f|m]) + s.indicator (sᶜ.indicator (μ[sᶜ.indicator f|m])) :=
      by
      refine' filter.eventually_eq.rfl.add _
      have : sᶜ.indicator (μ[sᶜ.indicator f|m]) =ᵐ[μ] μ[sᶜ.indicator f|m] :=
        by
        refine' (condexp_indicator_aux hs.compl _).symm.trans _
        · exact indicator_ae_eq_restrict_compl (hm _ hs.compl)
        · rw [Set.indicator_indicator, Set.inter_self]
      filter_upwards [this]with x hx
      by_cases hxs : x ∈ s
      · simp only [hx, hxs, Set.indicator_of_mem]
      · simp only [hxs, Set.indicator_of_not_mem, not_false_iff]
    _ =ᵐ[μ] s.indicator (μ[s.indicator f|m]) := by
      rw [Set.indicator_indicator, Set.inter_compl_self, Set.indicator_empty', add_zero]
    _ =ᵐ[μ] μ[s.indicator f|m] :=
      by
      refine' (condexp_indicator_aux hs _).symm.trans _
      · exact indicator_ae_eq_restrict_compl (hm _ hs)
      · rw [Set.indicator_indicator, Set.inter_self]

#align measure_theory.condexp_indicator MeasureTheory.condexp_indicator

theorem condexp_restrict_ae_eq_restrict (hm : m ≤ m0) [SigmaFinite (μ.trim hm)]
    (hs_m : measurable_set[m] s) (hf_int : Integrable f μ) :
    μ.restrict s[f|m] =ᵐ[μ.restrict s] μ[f|m] :=
  by
  have : sigma_finite ((μ.restrict s).trim hm) :=
    by
    rw [← restrict_trim hm _ hs_m]
    infer_instance
  rw [ae_eq_restrict_iff_indicator_ae_eq (hm _ hs_m)]
  swap
  · infer_instance
  refine' eventually_eq.trans _ (condexp_indicator hf_int hs_m)
  refine' ae_eq_condexp_of_forall_set_integral_eq hm (hf_int.indicator (hm _ hs_m)) _ _ _
  · intro t ht hμt
    rw [← integrable_indicator_iff (hm _ ht), Set.indicator_indicator, Set.inter_comm, ←
      Set.indicator_indicator]
    suffices h_int_restrict : integrable (t.indicator (μ.restrict s[f|m])) (μ.restrict s)
    · rw [integrable_indicator_iff (hm _ hs_m), integrable_on]
      rw [integrable_indicator_iff (hm _ ht), integrable_on] at h_int_restrict⊢
      exact h_int_restrict
    exact integrable_condexp.indicator (hm _ ht)
  · intro t ht hμt
    calc
      (∫ x in t, s.indicator (μ.restrict s[f|m]) x ∂μ) =
          ∫ x in t, (μ.restrict s[f|m]) x ∂μ.restrict s :=
        by
        rw [integral_indicator (hm _ hs_m), measure.restrict_restrict (hm _ hs_m),
          measure.restrict_restrict (hm _ ht), Set.inter_comm]
      _ = ∫ x in t, f x ∂μ.restrict s := (set_integral_condexp hm hf_int.integrable_on ht)
      _ = ∫ x in t, s.indicator f x ∂μ := by
        rw [integral_indicator (hm _ hs_m), measure.restrict_restrict (hm _ hs_m),
          measure.restrict_restrict (hm _ ht), Set.inter_comm]

  · exact (strongly_measurable_condexp.indicator hs_m).aeStronglyMeasurable'
#align measure_theory.condexp_restrict_ae_eq_restrict MeasureTheory.condexp_restrict_ae_eq_restrict

/-- If the restriction to a `m`-measurable set `s` of a σ-algebra `m` is equal to the restriction
to `s` of another σ-algebra `m₂` (hypothesis `hs`), then `μ[f | m] =ᵐ[μ.restrict s] μ[f | m₂]`. -/
theorem condexp_ae_eq_restrict_of_measurableSpace_eq_on {m m₂ m0 : MeasurableSpace α}
    {μ : Measure α} (hm : m ≤ m0) (hm₂ : m₂ ≤ m0) [SigmaFinite (μ.trim hm)]
    [SigmaFinite (μ.trim hm₂)] (hs_m : measurable_set[m] s)
    (hs : ∀ t, measurable_set[m] (s ∩ t) ↔ measurable_set[m₂] (s ∩ t)) :
    μ[f|m] =ᵐ[μ.restrict s] μ[f|m₂] :=
  by
  rw [ae_eq_restrict_iff_indicator_ae_eq (hm _ hs_m)]
  have hs_m₂ : measurable_set[m₂] s := by rwa [← Set.inter_univ s, ← hs Set.univ, Set.inter_univ]
  by_cases hf_int : integrable f μ
  swap
  · simp_rw [condexp_undef hf_int]
  refine' ((condexp_indicator hf_int hs_m).symm.trans _).trans (condexp_indicator hf_int hs_m₂)
  refine'
    ae_eq_of_forall_set_integral_eq_of_sigma_finite' hm₂
      (fun s hs hμs => integrable_condexp.integrable_on)
      (fun s hs hμs => integrable_condexp.integrable_on) _ _
      strongly_measurable_condexp.ae_strongly_measurable'
  swap
  · have : strongly_measurable[m] (μ[s.indicator f|m]) := strongly_measurable_condexp
    refine'
      this.ae_strongly_measurable'.ae_strongly_measurable'_of_measurable_space_le_on hm hs_m
        (fun t => (hs t).mp) _
    exact condexp_ae_eq_restrict_zero hs_m.compl (indicator_ae_eq_restrict_compl (hm _ hs_m))
  intro t ht hμt
  have : (∫ x in t, (μ[s.indicator f|m]) x ∂μ) = ∫ x in s ∩ t, (μ[s.indicator f|m]) x ∂μ :=
    by
    rw [← integral_add_compl (hm _ hs_m) integrable_condexp.integrable_on]
    suffices (∫ x in sᶜ, (μ[s.indicator f|m]) x ∂μ.restrict t) = 0 by
      rw [this, add_zero, measure.restrict_restrict (hm _ hs_m)]
    rw [measure.restrict_restrict (MeasurableSet.compl (hm _ hs_m))]
    suffices μ[s.indicator f|m] =ᵐ[μ.restrict (sᶜ)] 0
      by
      rw [Set.inter_comm, ← measure.restrict_restrict (hm₂ _ ht)]
      calc
        (∫ x : α in t, (μ[s.indicator f|m]) x ∂μ.restrict (sᶜ)) =
            ∫ x : α in t, 0 ∂μ.restrict (sᶜ) :=
          by
          refine' set_integral_congr_ae (hm₂ _ ht) _
          filter_upwards [this]with x hx h using hx
        _ = 0 := integral_zero _ _

    refine' condexp_ae_eq_restrict_zero hs_m.compl _
    exact indicator_ae_eq_restrict_compl (hm _ hs_m)
  have hst_m : measurable_set[m] (s ∩ t) := (hs _).mpr (hs_m₂.inter ht)
  simp_rw [this, set_integral_condexp hm₂ (hf_int.indicator (hm _ hs_m)) ht,
    set_integral_condexp hm (hf_int.indicator (hm _ hs_m)) hst_m, integral_indicator (hm _ hs_m),
    measure.restrict_restrict (hm _ hs_m), ← Set.inter_assoc, Set.inter_self]
#align measure_theory.condexp_ae_eq_restrict_of_measurable_space_eq_on MeasureTheory.condexp_ae_eq_restrict_of_measurableSpace_eq_on

end MeasureTheory


/-
Copyright (c) 2022 Yaël Dillies, Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Junyan Xu

! This file was ported from Lean 3 source module order.extension.well
! leanprover-community/mathlib commit 740acc0e6f9adf4423f92a485d0456fc271482da
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Prod.Lex
import Mathlib.SetTheory.Ordinal.Arithmetic

/-!
# Extend a well-founded order to a well-order

This file constructs a well-order (linear well-founded order) which is an extension of a given
well-founded order.

## Proof idea

We can map our order into two well-orders:
* the first map respects the order but isn't necessarily injective. Namely, this is the *rank*
  function `WellFounded.rank : α → Ordinal`.
* the second map is injective but doesn't necessarily respect the order. This is an arbitrary
  embedding into `Cardinal` given by `embeddingToCardinal`.

Then their lexicographic product is a well-founded linear order which our original order injects in.

## Porting notes

The definition in `mathlib` 3 used an auxiliary well-founded order on `α` lifted from `Cardinal`
instead of `Cardinal`. The new definition is definitionally equal to the `mathlib` 3 version but
avoids non-standard instances.

## Tags

well founded relation, well order, extension
-/

universe u

variable {α : Type u} {r : α → α → Prop}

namespace WellFounded

variable (hwf : WellFounded r)

/-- An arbitrary well order on `α` that extends `r`.

The construction maps `r` into two well-orders: the first map is `WellFounded.rank`, which is not
necessarily injective but respects the order `r`; the other map is the identity (with an arbitrarily
chosen well-order on `α`), which is injective but doesn't respect `r`.

By taking the lexicographic product of the two, we get both properties, so we can pull it back and
get an well-order that extend our original order `r`. Another way to view this is that we choose an
arbitrary well-order to serve as a tiebreak between two elements of same rank.
-/
noncomputable def wellOrderExtension : LinearOrder α :=
  @LinearOrder.lift' α (Ordinal ×ₗ Cardinal) _ (fun a : α => (hwf.rank a, embeddingToCardinal a))
    fun _ _ h => embeddingToCardinal.injective <| congr_arg Prod.snd h
#align well_founded.well_order_extension WellFounded.wellOrderExtension

instance wellOrderExtension.isWellFounded_lt : IsWellFounded α hwf.wellOrderExtension.lt :=
  ⟨InvImage.wf (fun a : α => (hwf.rank a, embeddingToCardinal a)) <|
    Ordinal.lt_wf.prod_lex Cardinal.lt_wf⟩
#align well_founded.well_order_extension.is_well_founded_lt WellFounded.wellOrderExtension.isWellFounded_lt

/-- Any well-founded relation can be extended to a well-ordering on that type. -/
theorem exists_well_order_ge : ∃ s, r ≤ s ∧ IsWellOrder α s :=
  ⟨hwf.wellOrderExtension.lt, fun _ _ h => Prod.Lex.left _ _ (hwf.rank_lt_of_rel h), ⟨⟩⟩
#align well_founded.exists_well_order_ge WellFounded.exists_well_order_ge

end WellFounded

/-- A type alias for `α`, intended to extend a well-founded order on `α` to a well-order. -/
def WellOrderExtension (α : Type _) : Type _ := α
#align well_order_extension WellOrderExtension

instance [Inhabited α] : Inhabited (WellOrderExtension α) := ‹_›

/-- "Identity" equivalence between a well-founded order and its well-order extension. -/
def toWellOrderExtension : α ≃ WellOrderExtension α :=
  Equiv.refl _
#align to_well_order_extension toWellOrderExtension

noncomputable instance [LT α] [WellFoundedLT α] : LinearOrder (WellOrderExtension α) :=
  (IsWellFounded.wf : @WellFounded α (· < ·)).wellOrderExtension

instance WellOrderExtension.wellFoundedLT [LT α] [WellFoundedLT α] :
    WellFoundedLT (WellOrderExtension α) :=
  WellFounded.wellOrderExtension.isWellFounded_lt _
#align well_order_extension.well_founded_lt WellOrderExtension.wellFoundedLT

theorem toWellOrderExtension_strictMono [Preorder α] [WellFoundedLT α] :
    StrictMono (toWellOrderExtension : α → WellOrderExtension α) := fun _ _ h =>
  Prod.Lex.left _ _ <| WellFounded.rank_lt_of_rel _ h
#align to_well_order_extension_strict_mono toWellOrderExtension_strictMono


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/
import algebra.category.Group.equivalence_Group_AddGroup
import group_theory.quotient_group

/-!
# Monomorphisms and epimorphisms in `Group`
In this file, we prove monomorphisms in category of group are injective homomorphisms and
epimorphisms are surjective homomorphisms.
-/

noncomputable theory

universes u v

namespace monoid_hom

open quotient_group

variables {A : Type u} {B : Type v}

section
variables [group A] [group B]

@[to_additive add_monoid_hom.ker_eq_bot_of_cancel]
lemma ker_eq_bot_of_cancel {f : A →* B} (h : ∀ (u v : f.ker →* A), f.comp u = f.comp v → u = v) :
  f.ker = ⊥ :=
by simpa using _root_.congr_arg range (h f.ker.subtype 1 (by tidy))

end

section
variables [comm_group A] [comm_group B]

@[to_additive add_monoid_hom.range_eq_top_of_cancel]
lemma range_eq_top_of_cancel {f : A →* B}
  (h : ∀ (u v : B →* B ⧸ f.range), u.comp f = v.comp f → u = v) :
  f.range = ⊤ :=
begin
  specialize h 1 (quotient_group.mk' _) _,
  { ext1,
    simp only [one_apply, coe_comp, coe_mk', function.comp_app],
    rw [show (1 : B ⧸ f.range) = (1 : B), from quotient_group.coe_one _, quotient_group.eq,
     inv_one, one_mul],
    exact ⟨x, rfl⟩, },
  replace h : (quotient_group.mk' _).ker = (1 : B →* B ⧸ f.range).ker := by rw h,
  rwa [ker_one, quotient_group.ker_mk] at h,
end

end

end monoid_hom

section

open category_theory

namespace Group

variables {A B : Group.{u}} (f : A ⟶ B)

@[to_additive AddGroup.ker_eq_bot_of_mono]
lemma ker_eq_bot_of_mono [mono f] : f.ker = ⊥ :=
monoid_hom.ker_eq_bot_of_cancel $ λ u v,
  (@cancel_mono _ _ _ _ _ f _ (show Group.of f.ker ⟶ A, from u) _).1

@[to_additive AddGroup.mono_iff_ker_eq_bot]
lemma mono_iff_ker_eq_bot : mono f ↔ f.ker = ⊥ :=
⟨λ h, @@ker_eq_bot_of_mono f h,
 λ h, concrete_category.mono_of_injective _ $ (monoid_hom.ker_eq_bot_iff f).1 h⟩

@[to_additive AddGroup.mono_iff_injective]
lemma mono_iff_injective : mono f ↔ function.injective f :=
iff.trans (mono_iff_ker_eq_bot f) $ monoid_hom.ker_eq_bot_iff f

namespace surjective_of_epi_auxs

local notation `X` := set.range (function.swap left_coset f.range.carrier)

/--
Define `X'` to be the set of all left cosets with an extra point at "infinity".
-/
@[nolint has_nonempty_instance]
inductive X_with_infinity
| from_coset : set.range (function.swap left_coset f.range.carrier) → X_with_infinity
| infinity : X_with_infinity

open X_with_infinity equiv.perm
open_locale coset

local notation `X'` := X_with_infinity f
local notation `∞` := X_with_infinity.infinity
local notation `SX'` := equiv.perm X'

instance : has_smul B X' :=
{ smul := λ b x, match x with
  | from_coset y := from_coset ⟨b *l y,
    begin
      rw [←subtype.val_eq_coe, ←y.2.some_spec, left_coset_assoc],
      use b * y.2.some,
    end⟩
  | ∞ := ∞
  end }

lemma mul_smul (b b' : B) (x : X') : (b * b') • x = b • b' • x :=
match x with
| from_coset y :=
  begin
    change from_coset _ = from_coset _,
    simp only [←subtype.val_eq_coe, left_coset_assoc],
  end
| ∞ := rfl
end

lemma one_smul (x : X') : (1 : B) • x = x :=
match x with
| from_coset y :=
  begin
    change from_coset _ = from_coset _,
    simp only [←subtype.val_eq_coe, one_left_coset, subtype.ext_iff_val],
  end
| ∞ := rfl
end

lemma from_coset_eq_of_mem_range {b : B} (hb : b ∈ f.range) :
  from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ =
  from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ :=
begin
  congr,
  change b *l f.range = f.range,
  nth_rewrite 1 [show (f.range : set B) = 1 *l f.range, from (one_left_coset _).symm],
  rw [left_coset_eq_iff, mul_one],
  exact subgroup.inv_mem _ hb,
end

lemma from_coset_ne_of_nin_range {b : B} (hb : b ∉ f.range) :
  from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ ≠
  from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ :=
begin
  intros r,
  simp only [subtype.mk_eq_mk] at r,
  change b *l f.range = f.range at r,
  nth_rewrite 1 [show (f.range : set B) = 1 *l f.range, from (one_left_coset _).symm] at r,
  rw [left_coset_eq_iff, mul_one] at r,
  exact hb (inv_inv b ▸ (subgroup.inv_mem _ r)),
end

instance : decidable_eq X' := classical.dec_eq _

/--
Let `τ` be the permutation on `X'` exchanging `f.range` and the point at infinity.
-/
noncomputable def tau : SX' :=
equiv.swap (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) ∞

local notation `τ` := tau f

lemma τ_apply_infinity :
  τ ∞ = from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ :=
equiv.swap_apply_right _ _

lemma τ_apply_from_coset :
  τ (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) = ∞ :=
equiv.swap_apply_left _ _

lemma τ_apply_from_coset' (x : B) (hx : x ∈ f.range) :
  τ (from_coset ⟨x *l f.range.carrier, ⟨x, rfl⟩⟩) = ∞ :=
(from_coset_eq_of_mem_range _ hx).symm ▸ τ_apply_from_coset _

lemma τ_symm_apply_from_coset :
  (equiv.symm τ) (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) = ∞ :=
by rw [tau, equiv.symm_swap, equiv.swap_apply_left]

lemma τ_symm_apply_infinity :
  (equiv.symm τ) ∞ = from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ :=
by rw [tau, equiv.symm_swap, equiv.swap_apply_right]

/--
Let `g : B ⟶ S(X')` be defined as such that, for any `β : B`, `g(β)` is the function sending
point at infinity to point at infinity and sending coset `y` to `β *l y`.
-/
def G : B →* SX' :=
{ to_fun := λ β,
  { to_fun := λ x, β • x,
    inv_fun := λ x, β⁻¹ • x,
    left_inv := λ x, by { dsimp only, rw [←mul_smul, mul_left_inv, one_smul] },
    right_inv := λ x, by { dsimp only, rw [←mul_smul, mul_right_inv, one_smul] } },
  map_one' := by { ext, simp [one_smul] },
  map_mul' := λ b1 b2, by { ext, simp [mul_smul] } }

local notation `g` := G f

/--
Define `h : B ⟶ S(X')` to be `τ g τ⁻¹`
-/
def H : B →* SX':=
{ to_fun := λ β, ((τ).symm.trans (g β)).trans τ,
  map_one' := by { ext, simp },
  map_mul' := λ b1 b2, by { ext, simp } }

local notation `h` := H f

/-!
The strategy is the following: assuming `epi f`
* prove that `f.range = {x | h x = g x}`;
* thus `f ≫ h = f ≫ g` so that `h = g`;
* but if `f` is not surjective, then some `x ∉ f.range`, then `h x ≠ g x` at the coset `f.range`.
-/

lemma g_apply_infinity (x : B) : (g x) ∞ = ∞ := rfl

lemma h_apply_infinity (x : B) (hx : x ∈ f.range) : (h x) ∞ = ∞ :=
begin
  simp only [H, monoid_hom.coe_mk, equiv.to_fun_as_coe, equiv.coe_trans, function.comp_app],
  rw [τ_symm_apply_infinity, g_apply_from_coset],
  simpa only [←subtype.val_eq_coe] using τ_apply_from_coset' f x hx,
end

lemma h_apply_from_coset (x : B) :
  (h x) (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) =
  from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ :=
by simp [H, τ_symm_apply_from_coset, g_apply_infinity, τ_apply_infinity]

lemma h_apply_from_coset' (x : B) (b : B) (hb : b ∈ f.range):
  (h x) (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) =
  from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ :=
(from_coset_eq_of_mem_range _ hb).symm ▸ h_apply_from_coset f x

lemma h_apply_from_coset_nin_range (x : B) (hx : x ∈ f.range) (b : B) (hb : b ∉ f.range) :
  (h x) (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) =
  from_coset ⟨(x * b) *l f.range.carrier, ⟨x * b, rfl⟩⟩ :=
begin
  simp only [H, tau, monoid_hom.coe_mk, equiv.to_fun_as_coe, equiv.coe_trans, function.comp_app],
  rw [equiv.symm_swap, @equiv.swap_apply_of_ne_of_ne X' _
    (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) ∞
    (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) (from_coset_ne_of_nin_range _ hb) (by simp)],
  simp only [g_apply_from_coset, ←subtype.val_eq_coe, left_coset_assoc],
  refine equiv.swap_apply_of_ne_of_ne (from_coset_ne_of_nin_range _ (λ r, hb _)) (by simp),
  convert subgroup.mul_mem _ (subgroup.inv_mem _ hx) r,
  rw [←mul_assoc, mul_left_inv, one_mul],
end

lemma agree : f.range.carrier = {x | h x = g x} :=
begin
  refine set.ext (λ b, ⟨_, λ (hb : h b = g b), classical.by_contradiction (λ r, _)⟩),
  { rintros ⟨a, rfl⟩,
    change h (f a) = g (f a),
    ext ⟨⟨_, ⟨y, rfl⟩⟩⟩,
    { rw [g_apply_from_coset],
      by_cases m : y ∈ f.range,
      { rw [h_apply_from_coset' _ _ _ m, from_coset_eq_of_mem_range _ m],
        change from_coset _ = from_coset ⟨f a *l (y *l _), _⟩,
        simpa only [←from_coset_eq_of_mem_range _ (subgroup.mul_mem _ ⟨a, rfl⟩ m),
          left_coset_assoc] },
      { rw [h_apply_from_coset_nin_range _ _ ⟨_, rfl⟩ _ m],
        simpa only [←subtype.val_eq_coe, left_coset_assoc], }, },
    { rw [g_apply_infinity, h_apply_infinity _ _ ⟨_, rfl⟩], } },
  { have eq1 : (h b) (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) =
      (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) := by simp [H, tau, g_apply_infinity],
    have eq2 : (g b) (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) =
      (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) := rfl,
    exact (from_coset_ne_of_nin_range _ r).symm (by rw [←eq1, ←eq2, fun_like.congr_fun hb]) }
end

lemma comp_eq : f ≫ (show B ⟶ Group.of SX', from g) = f ≫ h :=
fun_like.ext _ _ $ λ a,
  by simp only [comp_apply, show h (f a) = _, from (by simp [←agree] : f a ∈ {b | h b = g b})]

lemma g_ne_h (x : B) (hx : x ∉ f.range) : g ≠ h :=
begin
  intros r,
  replace r := fun_like.congr_fun (fun_like.congr_fun r x)
    ((from_coset ⟨f.range, ⟨1, one_left_coset _⟩⟩)),
  rw [H, g_apply_from_coset, monoid_hom.coe_mk, tau] at r,
  simp only [monoid_hom.coe_range, subtype.coe_mk, equiv.symm_swap,
    equiv.to_fun_as_coe, equiv.coe_trans, function.comp_app] at r,
  erw [equiv.swap_apply_left, g_apply_infinity, equiv.swap_apply_right] at r,
  exact from_coset_ne_of_nin_range _ hx r,
end

end surjective_of_epi_auxs

lemma surjective_of_epi [epi f] : function.surjective f :=
begin
  by_contra r,
  push_neg at r,
  rcases r with ⟨b, hb⟩,
  exact surjective_of_epi_auxs.g_ne_h f b (λ ⟨c, hc⟩, hb _ hc)
    ((cancel_epi f).1 (surjective_of_epi_auxs.comp_eq f)),
end

lemma epi_iff_surjective : epi f ↔ function.surjective f :=
⟨λ h, @@surjective_of_epi f h, concrete_category.epi_of_surjective _⟩

lemma epi_iff_range_eq_top : epi f ↔ f.range = ⊤ :=
iff.trans (epi_iff_surjective _) (subgroup.eq_top_iff' f.range).symm

end Group

namespace AddGroup
variables {A B : AddGroup.{u}} (f : A ⟶ B)

lemma epi_iff_surjective : epi f ↔ function.surjective f :=
begin
  have i1 : epi f ↔ epi (Group_AddGroup_equivalence.inverse.map f),
  { refine ⟨_, Group_AddGroup_equivalence.inverse.epi_of_epi_map⟩,
    introsI e',
    apply Group_AddGroup_equivalence.inverse.map_epi },
  rwa Group.epi_iff_surjective at i1,
end

lemma epi_iff_range_eq_top : epi f ↔ f.range = ⊤ :=
iff.trans (epi_iff_surjective _) (add_subgroup.eq_top_iff' f.range).symm

end AddGroup

namespace Group
variables {A B : Group.{u}} (f : A ⟶ B)

@[to_additive]
instance forget_Group_preserves_mono : (forget Group).preserves_monomorphisms :=
{ preserves := λ X Y f e, by rwa [mono_iff_injective, ←category_theory.mono_iff_injective] at e }

@[to_additive]
instance forget_Group_preserves_epi : (forget Group).preserves_epimorphisms :=
{ preserves := λ X Y f e, by rwa [epi_iff_surjective, ←category_theory.epi_iff_surjective] at e }

end Group

namespace CommGroup
variables {A B : CommGroup.{u}} (f : A ⟶ B)

@[to_additive AddCommGroup.ker_eq_bot_of_mono]
lemma ker_eq_bot_of_mono [mono f] : f.ker = ⊥ :=
monoid_hom.ker_eq_bot_of_cancel $ λ u v,
  (@cancel_mono _ _ _ _ _ f _ (show CommGroup.of f.ker ⟶ A, from u) _).1

@[to_additive AddCommGroup.mono_iff_ker_eq_bot]
lemma mono_iff_ker_eq_bot : mono f ↔ f.ker = ⊥ :=
⟨λ h, @@ker_eq_bot_of_mono f h,
 λ h, concrete_category.mono_of_injective _ $ (monoid_hom.ker_eq_bot_iff f).1 h⟩

@[to_additive AddCommGroup.mono_iff_injective]
lemma mono_iff_injective : mono f ↔ function.injective f :=
iff.trans (mono_iff_ker_eq_bot f) $ monoid_hom.ker_eq_bot_iff f

@[to_additive]
lemma range_eq_top_of_epi [epi f] : f.range = ⊤ :=
monoid_hom.range_eq_top_of_cancel $ λ u v h,
  (@cancel_epi _ _ _ _ _ f _ (show B ⟶ ⟨B ⧸ monoid_hom.range f⟩, from u) v).1 h

@[to_additive]
lemma epi_iff_range_eq_top : epi f ↔ f.range = ⊤ :=
⟨λ hf, by exactI range_eq_top_of_epi _,
 λ hf, concrete_category.epi_of_surjective _ $ monoid_hom.range_top_iff_surjective.mp hf⟩

@[to_additive]
lemma epi_iff_surjective : epi f ↔ function.surjective f :=
by rw [epi_iff_range_eq_top, monoid_hom.range_top_iff_surjective]

@[to_additive]
instance forget_CommGroup_preserves_mono : (forget CommGroup).preserves_monomorphisms :=
{ preserves := λ X Y f e, by rwa [mono_iff_injective, ←category_theory.mono_iff_injective] at e }

@[to_additive]
instance forget_CommGroup_preserves_epi : (forget CommGroup).preserves_epimorphisms :=
{ preserves := λ X Y f e, by rwa [epi_iff_surjective, ←category_theory.epi_iff_surjective] at e }

end CommGroup

end


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

Disjointed sets
-/
import data.set.lattice data.nat.basic tactic.wlog
open set classical lattice
local attribute [instance] prop_decidable

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}
  {s t u : set α}

/-- A relation `p` holds pairwise if `p i j` for all `i ≠ j`. -/
def pairwise {α : Type*} (p : α → α → Prop) := ∀i j, i ≠ j → p i j

theorem pairwise_on_bool {r} (hr : symmetric r) {a b : α} :
  pairwise (r on (λ c, cond c a b)) ↔ r a b :=
by simp [pairwise, bool.forall_bool, function.on_fun];
   exact and_iff_right_of_imp (@hr _ _)

theorem pairwise_disjoint_on_bool [semilattice_inf_bot α] {a b : α} :
  pairwise (disjoint on (λ c, cond c a b)) ↔ disjoint a b :=
pairwise_on_bool $ λ _ _, disjoint.symm

namespace set

/-- If `f : ℕ → set α` is a sequence of sets, then `disjointed f` is
  the sequence formed with each set subtracted from the later ones
  in the sequence, to form a disjoint sequence. -/
def disjointed (f : ℕ → set α) (n : ℕ) : set α := f n ∩ (⋂i<n, - f i)

lemma disjoint_disjointed {f : ℕ → set α} : pairwise (disjoint on disjointed f) :=
λ i j h, begin
  wlog h' : i ≤ j; [skip, {revert a, exact (this h.symm).symm}],
  rintro a ⟨⟨h₁, _⟩, h₂, h₃⟩, simp at h₃,
  exact h₃ _ (lt_of_le_of_ne h' h) h₁
end

lemma Union_lt_succ {f : ℕ → set α} {n} : (⋃i < nat.succ n, f i) = f n ∪ (⋃i < n, f i) :=
ext $ λ a, by simp [nat.lt_succ_iff_lt_or_eq, or_and_distrib_right, exists_or_distrib, or_comm]

lemma Inter_lt_succ {f : ℕ → set α} {n} : (⋂i < nat.succ n, f i) = f n ∩ (⋂i < n, f i) :=
ext $ λ a, by simp [nat.lt_succ_iff_lt_or_eq, or_imp_distrib, forall_and_distrib, and_comm]

lemma Union_disjointed {f : ℕ → set α} : (⋃n, disjointed f n) = (⋃n, f n) :=
subset.antisymm (Union_subset_Union $ assume i, inter_subset_left _ _) $
  assume x h,
  have ∃n, x ∈ f n, from mem_Union.mp h,
  have hn : ∀ (i : ℕ), i < nat.find this → x ∉ f i,
    from assume i, nat.find_min this,
  mem_Union.mpr ⟨nat.find this, nat.find_spec this, by simp; assumption⟩

lemma disjointed_induct {f : ℕ → set α} {n : ℕ} {p : set α → Prop}
  (h₁ : p (f n)) (h₂ : ∀t i, p t → p (t \ f i)) :
  p (disjointed f n) :=
begin
  rw disjointed,
  generalize_hyp : f n = t at h₁ ⊢,
  induction n,
  case nat.zero { simp [nat.not_lt_zero, h₁] },
  case nat.succ : n ih {
    rw [Inter_lt_succ, inter_comm (-f n), ← inter_assoc],
    exact h₂ _ n ih }
end

lemma disjointed_of_mono {f : ℕ → set α} {n : ℕ} (hf : monotone f) :
  disjointed f (n + 1) = f (n + 1) \ f n :=
have (⋂i (h : i < n + 1), -f i) = - f n,
  from le_antisymm
    (infi_le_of_le n $ infi_le_of_le (nat.lt_succ_self _) $ subset.refl _)
    (le_infi $ assume i, le_infi $ assume hi, neg_le_neg $ hf $ nat.le_of_succ_le_succ hi),
by simp [disjointed, this, diff_eq]

lemma Union_disjointed_of_mono {f : ℕ → set α} (hf : monotone f) :
  ∀ n : ℕ, (⋃i<n.succ, disjointed f i) = f n
| 0 := by rw [Union_lt_succ]; simp [disjointed, nat.not_lt_zero]
| (n+1) := by rw [Union_lt_succ,
  disjointed_of_mono hf, Union_disjointed_of_mono n,
  diff_union_self, union_eq_self_of_subset_right (hf (nat.le_succ _))]

end set


open classical

variables (α : Type) (p q : α → Prop)
variable a : α
variable r : Prop

example : (∃ x : α, r) → r :=
    assume h: ∃ x: α, r,
    exists.elim h
        (
            assume w: α,
            assume hw: r,
            hw
        )
example : r → (∃ x : α, r) :=
    assume h: r,
    exists.intro a  h

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
    iff.intro
        (
            assume h: ∃ x, p x ∧ r,
            exists.elim h
                (
                    assume w: α,
                    assume hw: p w ∧ r,
                    and.intro (exists.intro w hw.left) hw.right
                )
        )
        (
            assume h: (∃ x, p x) ∧ r,
            exists.elim h.left
                (
                    assume w: α,
                    assume hw: p w,
                    ⟨ w, (and.intro hw h.right)⟩
                )
        )

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
    iff.intro
        (
            assume h: ∃ x, p x ∨ q x,
            exists.elim h
                (
                    assume w: α,
                    assume hw: p w ∨ q w,
                    or.elim hw
                        (
                            assume hwl: p w,
                            have ∃ x, p x, from exists.intro w hwl,
                            or.intro_left (∃ x, q x) this
                        )
                        (
                            assume hwr: q w,
                            have ∃ x, q x, from exists.intro w hwr,
                            or.intro_right (∃ x, p x) this
                        )
                )
        )
        (
            assume h: (∃ x, p x) ∨ (∃ x, q x),
            or.elim h
                (
                    assume hl: ∃ x, p x,
                    exists.elim hl
                        (
                            assume w: α,
                            assume he: p w,
                            ⟨ w, or.intro_left (q w) he ⟩
                        )
                )
                (
                    assume hr: ∃ x, q x,
                    exists.elim hr
                        (
                            assume w: α,
                            assume he: q w,
                            ⟨ w, or.intro_right (p w) he ⟩
                        )
                )
        )

-- right-to-left requires classical logic?
example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
  iff.intro
    (
      assume h: ∀ x, p x,
      assume hn: ∃ x, ¬ p x,
      match hn with ⟨ w, hnw ⟩ :=
        absurd (h w) hnw
      end
    )
    (
      assume h: ¬ (∃ x, ¬ p x),
      assume y: α,
      show p y, from (
        by_contradiction (
          assume hy: ¬ p y,
          have ∃ x, ¬ p x, from exists.intro y hy,
          absurd this h
        )
      )
    )

-- right-to-left requires classical logic?
example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
  iff.intro
    (
      assume h: ∃ x, p x,
      assume hq: ∀ x, ¬ p x,
      match h with ⟨w, hw⟩ :=
        absurd hw (hq w)
      end
    )
    (
      assume h: ¬ (∀ x, ¬ p x),
      by_contradiction (
        assume hnp: ¬ (∃ x, p x),
        have ∀ x, ¬ p x, from (
          assume y: α,
          show ¬ p y, from (
            assume hy: p y,
            absurd (exists.intro y hy) hnp
          )
        ),
        absurd this h
      )
    )

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
  iff.intro
    (
      assume h: ¬ ∃ x, p x,
      assume y: α,
      assume hpy: p y,
      have ∃ x, p x, from exists.intro y hpy,
      absurd this h
    )
    (
      assume h: ∀ x, ¬ p x,
      assume he: ∃ x, p x,
      match he with ⟨w, hw⟩ :=
        absurd hw (h w)
      end
    )

-- left to right uses classical logic. But, it could be better...?
theorem not_forall_exists_not : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
  iff.intro
    (
      assume h: ¬ ∀ x, p x,
      by_contradiction (
        assume hn: ¬ ∃ x, ¬ p x,
        have ∀ x, p x, from (
          assume y: α,
          show p y, from by_contradiction (
            assume hp: ¬ p y,
            have ∃ x, ¬ p x, from exists.intro y hp,
            absurd this hn
          )
        ),
        absurd this h
      )
    )
    (
      assume h: ∃ x, ¬ p x,
      assume hp: ∀ x, p x,
      match h with ⟨w, hw⟩ :=
        absurd (hp w) hw
      end
    )

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
  iff.intro
  (
    assume h: ∀ x, p x → r,
    assume he: ∃ x, p x,
    match he with ⟨w, hw⟩ :=
      h w hw
    end
  )
  (
    assume h: (∃ x, p x) → r,
    assume y: α,
    assume hpy: p y,
    show r, from h (exists.intro y hpy)
  )

-- right-to-left requires classical logic?
example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
  iff.intro
    (
      assume h1: ∃ x, p x → r,
      assume h2: ∀ x, p x,
      match h1 with ⟨w, hw⟩ :=
        hw (h2 w)
      end
    )
    (
      assume h: (∀ x, p x) → r,
        by_cases
          (
            assume hp: ∀ x, p x,
            have r, from h hp,
            have p a → r, from (assume hp: p a, ‹ r › ),
            exists.intro a this
          )
          (
            assume hnp: ¬ ∀ x, p x,
            have ∃ x, ¬ p x, from (not_forall_exists_not α p).mp hnp,
            match this with ⟨w, hnw⟩ :=
              have p w → r, from (
                assume hw: p w,
                absurd hw hnw
              ),
              exists.intro w this
            end
          )
    )

-- right-to-left requires classical logic?
example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
  iff.intro
    (
      assume h: ∃ x, r → p x,
      assume hr: r,
      match h with ⟨w, hw⟩ :=
        exists.intro w (hw hr)
      end
    )
    (
      assume h: (r → ∃ x, p x),
      by_cases
        (
          assume hr: r,
          have ∃ x, p x, from h hr,
          match this with ⟨ w, hw ⟩ :=
            exists.intro w
              (
                assume hr2: r,
                show p w, from hw
              )
          end
        )
        (
          assume hnr: ¬ r,
          have r → p a, from (
            assume hr: r,
            absurd hr hnr
          ),
          exists.intro a this
        )
    )


/-
Copyright (c) 2022 Bolton Bailey. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bolton Bailey, Patrick Stevens, Thomas Browning

! This file was ported from Lean 3 source module data.nat.choose.factorization
! leanprover-community/mathlib commit dc9db541168768af03fe228703e758e649afdbfc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Choose.Central
import Mathbin.Data.Nat.Factorization.Basic
import Mathbin.Data.Nat.Multiplicity

/-!
# Factorization of Binomial Coefficients

This file contains a few results on the multiplicity of prime factors within certain size
bounds in binomial coefficients. These include:

* `nat.factorization_choose_le_log`: a logarithmic upper bound on the multiplicity of a prime in
  a binomial coefficient.
* `nat.factorization_choose_le_one`: Primes above `sqrt n` appear at most once
  in the factorization of `n` choose `k`.
* `nat.factorization_central_binom_of_two_mul_self_lt_three_mul`: Primes from `2 * n / 3` to `n`
do not appear in the factorization of the `n`th central binomial coefficient.
* `nat.factorization_choose_eq_zero_of_lt`: Primes greater than `n` do not
  appear in the factorization of `n` choose `k`.

These results appear in the [Erdős proof of Bertrand's postulate](aigner1999proofs).
-/

open BigOperators

namespace Nat

variable {p n k : ℕ}

#print Nat.factorization_choose_le_log /-
/-- A logarithmic upper bound on the multiplicity of a prime in a binomial coefficient.
-/
theorem factorization_choose_le_log : (choose n k).factorization p ≤ log p n :=
  by
  by_cases h : (choose n k).factorization p = 0
  · simp [h]
  have hp : p.prime := Not.imp_symm (choose n k).factorization_eq_zero_of_non_prime h
  have hkn : k ≤ n := by
    refine' le_of_not_lt fun hnk => h _
    simp [choose_eq_zero_of_lt hnk]
  rw [factorization_def _ hp, @padicValNat_def _ ⟨hp⟩ _ (choose_pos hkn)]
  simp only [hp.multiplicity_choose hkn (lt_add_one _), PartENat.get_natCast]
  refine' (Finset.card_filter_le _ _).trans (le_of_eq (Nat.card_Ico _ _))
#align nat.factorization_choose_le_log Nat.factorization_choose_le_log
-/

#print Nat.pow_factorization_choose_le /-
/-- A `pow` form of `nat.factorization_choose_le`
-/
theorem pow_factorization_choose_le (hn : 0 < n) : p ^ (choose n k).factorization p ≤ n :=
  pow_le_of_le_log hn.ne' factorization_choose_le_log
#align nat.pow_factorization_choose_le Nat.pow_factorization_choose_le
-/

#print Nat.factorization_choose_le_one /-
/--
Primes greater than about `sqrt n` appear only to multiplicity 0 or 1 in the binomial coefficient.
-/
theorem factorization_choose_le_one (p_large : n < p ^ 2) : (choose n k).factorization p ≤ 1 :=
  by
  apply factorization_choose_le_log.trans
  rcases eq_or_ne n 0 with (rfl | hn0); · simp
  exact lt_succ_iff.1 (log_lt_of_lt_pow hn0 p_large)
#align nat.factorization_choose_le_one Nat.factorization_choose_le_one
-/

#print Nat.factorization_choose_of_lt_three_mul /-
theorem factorization_choose_of_lt_three_mul (hp' : p ≠ 2) (hk : p ≤ k) (hk' : p ≤ n - k)
    (hn : n < 3 * p) : (choose n k).factorization p = 0 :=
  by
  cases' em' p.prime with hp hp
  · exact factorization_eq_zero_of_non_prime (choose n k) hp
  cases' lt_or_le n k with hnk hkn
  · simp [choose_eq_zero_of_lt hnk]
  rw [factorization_def _ hp, @padicValNat_def _ ⟨hp⟩ _ (choose_pos hkn)]
  simp only [hp.multiplicity_choose hkn (lt_add_one _), PartENat.get_natCast, Finset.card_eq_zero,
    Finset.filter_eq_empty_iff, not_le]
  intro i hi
  rcases eq_or_lt_of_le (finset.mem_Ico.mp hi).1 with (rfl | hi)
  · rw [pow_one, ← add_lt_add_iff_left (2 * p), ← succ_mul, two_mul, add_add_add_comm]
    exact
      lt_of_le_of_lt
        (add_le_add
          (add_le_add_right (le_mul_of_one_le_right' ((one_le_div_iff hp.pos).mpr hk)) (k % p))
          (add_le_add_right (le_mul_of_one_le_right' ((one_le_div_iff hp.pos).mpr hk'))
            ((n - k) % p)))
        (by rwa [div_add_mod, div_add_mod, add_tsub_cancel_of_le hkn])
  · replace hn : n < p ^ i
    ·
      calc
        n < 3 * p := hn
        _ ≤ p * p := (mul_le_mul_right' (lt_of_le_of_ne hp.two_le hp'.symm) p)
        _ = p ^ 2 := (sq p).symm
        _ ≤ p ^ i := pow_le_pow hp.one_lt.le hi

    rwa [mod_eq_of_lt (lt_of_le_of_lt hkn hn), mod_eq_of_lt (lt_of_le_of_lt tsub_le_self hn),
      add_tsub_cancel_of_le hkn]
#align nat.factorization_choose_of_lt_three_mul Nat.factorization_choose_of_lt_three_mul
-/

#print Nat.factorization_centralBinom_of_two_mul_self_lt_three_mul /-
/-- Primes greater than about `2 * n / 3` and less than `n` do not appear in the factorization of
`central_binom n`.
-/
theorem factorization_centralBinom_of_two_mul_self_lt_three_mul (n_big : 2 < n) (p_le_n : p ≤ n)
    (big : 2 * n < 3 * p) : (centralBinom n).factorization p = 0 :=
  by
  refine' factorization_choose_of_lt_three_mul _ p_le_n (p_le_n.trans _) big
  · rintro rfl
    linarith
  · rw [two_mul, add_tsub_cancel_left]
#align nat.factorization_central_binom_of_two_mul_self_lt_three_mul Nat.factorization_centralBinom_of_two_mul_self_lt_three_mul
-/

#print Nat.factorization_factorial_eq_zero_of_lt /-
theorem factorization_factorial_eq_zero_of_lt (h : n < p) : (factorial n).factorization p = 0 :=
  by
  induction' n with n hn; · simp
  rw [factorial_succ, factorization_mul n.succ_ne_zero n.factorial_ne_zero, Finsupp.coe_add,
    Pi.add_apply, hn (lt_of_succ_lt h), add_zero, factorization_eq_zero_of_lt h]
#align nat.factorization_factorial_eq_zero_of_lt Nat.factorization_factorial_eq_zero_of_lt
-/

#print Nat.factorization_choose_eq_zero_of_lt /-
theorem factorization_choose_eq_zero_of_lt (h : n < p) : (choose n k).factorization p = 0 :=
  by
  by_cases hnk : n < k; · simp [choose_eq_zero_of_lt hnk]
  rw [choose_eq_factorial_div_factorial (le_of_not_lt hnk),
    factorization_div (factorial_mul_factorial_dvd_factorial (le_of_not_lt hnk)), Finsupp.coe_tsub,
    Pi.sub_apply, factorization_factorial_eq_zero_of_lt h, zero_tsub]
#align nat.factorization_choose_eq_zero_of_lt Nat.factorization_choose_eq_zero_of_lt
-/

#print Nat.factorization_centralBinom_eq_zero_of_two_mul_lt /-
/-- If a prime `p` has positive multiplicity in the `n`th central binomial coefficient,
`p` is no more than `2 * n`
-/
theorem factorization_centralBinom_eq_zero_of_two_mul_lt (h : 2 * n < p) :
    (centralBinom n).factorization p = 0 :=
  factorization_choose_eq_zero_of_lt h
#align nat.factorization_central_binom_eq_zero_of_two_mul_lt Nat.factorization_centralBinom_eq_zero_of_two_mul_lt
-/

#print Nat.le_two_mul_of_factorization_centralBinom_pos /-
/-- Contrapositive form of `nat.factorization_central_binom_eq_zero_of_two_mul_lt`
-/
theorem le_two_mul_of_factorization_centralBinom_pos
    (h_pos : 0 < (centralBinom n).factorization p) : p ≤ 2 * n :=
  le_of_not_lt (pos_iff_ne_zero.mp h_pos ∘ factorization_centralBinom_eq_zero_of_two_mul_lt)
#align nat.le_two_mul_of_factorization_central_binom_pos Nat.le_two_mul_of_factorization_centralBinom_pos
-/

#print Nat.prod_pow_factorization_choose /-
/-- A binomial coefficient is the product of its prime factors, which are at most `n`. -/
theorem prod_pow_factorization_choose (n k : ℕ) (hkn : k ≤ n) :
    (∏ p in Finset.range (n + 1), p ^ (Nat.choose n k).factorization p) = choose n k :=
  by
  nth_rw_rhs 1 [← factorization_prod_pow_eq_self (choose_pos hkn).ne']
  rw [eq_comm]
  apply Finset.prod_subset
  · intro p hp
    rw [Finset.mem_range]
    contrapose! hp
    rw [Finsupp.mem_support_iff, Classical.not_not, factorization_choose_eq_zero_of_lt hp]
  · intro p _ h2
    simp [Classical.not_not.1 (mt Finsupp.mem_support_iff.2 h2)]
#align nat.prod_pow_factorization_choose Nat.prod_pow_factorization_choose
-/

#print Nat.prod_pow_factorization_centralBinom /-
/-- The `n`th central binomial coefficient is the product of its prime factors, which are
at most `2n`. -/
theorem prod_pow_factorization_centralBinom (n : ℕ) :
    (∏ p in Finset.range (2 * n + 1), p ^ (centralBinom n).factorization p) = centralBinom n :=
  by
  apply prod_pow_factorization_choose
  linarith
#align nat.prod_pow_factorization_central_binom Nat.prod_pow_factorization_centralBinom
-/

end Nat


import data.mv_polynomial.basic
import data.polynomial.div
import data.polynomial.field_division

section

universes u

variables {R : Type u}
variables {σ : Type*}

variables [comm_semiring R]

open mv_polynomial

/-- Converting a single variable polynomial to a multivariable polynomial and back yields the same polynomial -/
lemma mv_polynomial.monomial_pow {s : σ →₀ ℕ} {a : R} {n : ℕ} :
  monomial s a ^ n = monomial (n • s) (a ^ n) :=
begin
  induction n,
  simp,
  rw monomial_eq,
  simp,
  -- rw nat.succ_eq_add_one,
  simp [pow_succ, succ_nsmul],
  rw n_ih,
  rw monomial_mul,
  -- library_search,

end

-- TODO this function is general purpose enough that it might be submitted to mathlib

end


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

! This file was ported from Lean 3 source module logic.function.iterate
! leanprover-community/mathlib commit 792a2a264169d64986541c6f8f7e3bbb6acb6295
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Function.Conjugate
import Mathbin.Tactic.Alias

/-!
# Iterations of a function

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

In this file we prove simple properties of `nat.iterate f n` a.k.a. `f^[n]`:

* `iterate_zero`, `iterate_succ`, `iterate_succ'`, `iterate_add`, `iterate_mul`:
  formulas for `f^[0]`, `f^[n+1]` (two versions), `f^[n+m]`, and `f^[n*m]`;

* `iterate_id` : `id^[n]=id`;

* `injective.iterate`, `surjective.iterate`, `bijective.iterate` :
  iterates of an injective/surjective/bijective function belong to the same class;

* `left_inverse.iterate`, `right_inverse.iterate`, `commute.iterate_left`, `commute.iterate_right`,
  `commute.iterate_iterate`:
  some properties of pairs of functions survive under iterations

* `iterate_fixed`, `semiconj.iterate_*`, `semiconj₂.iterate`:
  if `f` fixes a point (resp., semiconjugates unary/binary operarations), then so does `f^[n]`.

-/

universe u v

variable {α : Type u} {β : Type v}

namespace Function

variable (f : α → α)

#print Function.iterate_zero /-
@[simp]
theorem iterate_zero : f^[0] = id :=
  rfl
#align function.iterate_zero Function.iterate_zero
-/

#print Function.iterate_zero_apply /-
theorem iterate_zero_apply (x : α) : (f^[0]) x = x :=
  rfl
#align function.iterate_zero_apply Function.iterate_zero_apply
-/

#print Function.iterate_succ /-
@[simp]
theorem iterate_succ (n : ℕ) : f^[n.succ] = f^[n] ∘ f :=
  rfl
#align function.iterate_succ Function.iterate_succ
-/

#print Function.iterate_succ_apply /-
theorem iterate_succ_apply (n : ℕ) (x : α) : (f^[n.succ]) x = (f^[n]) (f x) :=
  rfl
#align function.iterate_succ_apply Function.iterate_succ_apply
-/

#print Function.iterate_id /-
@[simp]
theorem iterate_id (n : ℕ) : (id : α → α)^[n] = id :=
  Nat.recOn n rfl fun n ihn => by rw [iterate_succ, ihn, comp.left_id]
#align function.iterate_id Function.iterate_id
-/

#print Function.iterate_add /-
theorem iterate_add : ∀ m n : ℕ, f^[m + n] = f^[m] ∘ f^[n]
  | m, 0 => rfl
  | m, Nat.succ n => by rw [Nat.add_succ, iterate_succ, iterate_succ, iterate_add]
#align function.iterate_add Function.iterate_add
-/

#print Function.iterate_add_apply /-
theorem iterate_add_apply (m n : ℕ) (x : α) : (f^[m + n]) x = (f^[m]) ((f^[n]) x) := by
  rw [iterate_add]
#align function.iterate_add_apply Function.iterate_add_apply
-/

#print Function.iterate_one /-
@[simp]
theorem iterate_one : f^[1] = f :=
  funext fun a => rfl
#align function.iterate_one Function.iterate_one
-/

#print Function.iterate_mul /-
theorem iterate_mul (m : ℕ) : ∀ n, f^[m * n] = f^[m]^[n]
  | 0 => by simp only [Nat.mul_zero, iterate_zero]
  | n + 1 => by simp only [Nat.mul_succ, Nat.mul_one, iterate_one, iterate_add, iterate_mul n]
#align function.iterate_mul Function.iterate_mul
-/

variable {f}

#print Function.iterate_fixed /-
theorem iterate_fixed {x} (h : f x = x) (n : ℕ) : (f^[n]) x = x :=
  Nat.recOn n rfl fun n ihn => by rw [iterate_succ_apply, h, ihn]
#align function.iterate_fixed Function.iterate_fixed
-/

#print Function.Injective.iterate /-
theorem Injective.iterate (Hinj : Injective f) (n : ℕ) : Injective (f^[n]) :=
  Nat.recOn n injective_id fun n ihn => ihn.comp Hinj
#align function.injective.iterate Function.Injective.iterate
-/

#print Function.Surjective.iterate /-
theorem Surjective.iterate (Hsurj : Surjective f) (n : ℕ) : Surjective (f^[n]) :=
  Nat.recOn n surjective_id fun n ihn => ihn.comp Hsurj
#align function.surjective.iterate Function.Surjective.iterate
-/

#print Function.Bijective.iterate /-
theorem Bijective.iterate (Hbij : Bijective f) (n : ℕ) : Bijective (f^[n]) :=
  ⟨Hbij.1.iterate n, Hbij.2.iterate n⟩
#align function.bijective.iterate Function.Bijective.iterate
-/

namespace Semiconj

#print Function.Semiconj.iterate_right /-
theorem iterate_right {f : α → β} {ga : α → α} {gb : β → β} (h : Semiconj f ga gb) (n : ℕ) :
    Semiconj f (ga^[n]) (gb^[n]) :=
  Nat.recOn n id_right fun n ihn => ihn.compRight h
#align function.semiconj.iterate_right Function.Semiconj.iterate_right
-/

#print Function.Semiconj.iterate_left /-
theorem iterate_left {g : ℕ → α → α} (H : ∀ n, Semiconj f (g n) (g <| n + 1)) (n k : ℕ) :
    Semiconj (f^[n]) (g k) (g <| n + k) :=
  by
  induction' n with n ihn generalizing k
  · rw [Nat.zero_add]
    exact id_left
  · rw [Nat.succ_eq_add_one, Nat.add_right_comm, Nat.add_assoc]
    exact (H k).compLeft (ihn (k + 1))
#align function.semiconj.iterate_left Function.Semiconj.iterate_left
-/

end Semiconj

namespace Commute

variable {g : α → α}

#print Function.Commute.iterate_right /-
theorem iterate_right (h : Commute f g) (n : ℕ) : Commute f (g^[n]) :=
  h.iterate_right n
#align function.commute.iterate_right Function.Commute.iterate_right
-/

#print Function.Commute.iterate_left /-
theorem iterate_left (h : Commute f g) (n : ℕ) : Commute (f^[n]) g :=
  (h.symm.iterate_right n).symm
#align function.commute.iterate_left Function.Commute.iterate_left
-/

#print Function.Commute.iterate_iterate /-
theorem iterate_iterate (h : Commute f g) (m n : ℕ) : Commute (f^[m]) (g^[n]) :=
  (h.iterate_left m).iterate_right n
#align function.commute.iterate_iterate Function.Commute.iterate_iterate
-/

#print Function.Commute.iterate_eq_of_map_eq /-
theorem iterate_eq_of_map_eq (h : Commute f g) (n : ℕ) {x} (hx : f x = g x) :
    (f^[n]) x = (g^[n]) x :=
  Nat.recOn n rfl fun n ihn => by
    simp only [iterate_succ_apply, hx, (h.iterate_left n).Eq, ihn, ((refl g).iterate_right n).Eq]
#align function.commute.iterate_eq_of_map_eq Function.Commute.iterate_eq_of_map_eq
-/

#print Function.Commute.comp_iterate /-
theorem comp_iterate (h : Commute f g) (n : ℕ) : (f ∘ g)^[n] = f^[n] ∘ g^[n] :=
  by
  induction' n with n ihn; · rfl
  funext x
  simp only [ihn, (h.iterate_right n).Eq, iterate_succ, comp_app]
#align function.commute.comp_iterate Function.Commute.comp_iterate
-/

variable (f)

#print Function.Commute.iterate_self /-
theorem iterate_self (n : ℕ) : Commute (f^[n]) f :=
  (refl f).iterate_left n
#align function.commute.iterate_self Function.Commute.iterate_self
-/

#print Function.Commute.self_iterate /-
theorem self_iterate (n : ℕ) : Commute f (f^[n]) :=
  (refl f).iterate_right n
#align function.commute.self_iterate Function.Commute.self_iterate
-/

#print Function.Commute.iterate_iterate_self /-
theorem iterate_iterate_self (m n : ℕ) : Commute (f^[m]) (f^[n]) :=
  (refl f).iterate_iterate m n
#align function.commute.iterate_iterate_self Function.Commute.iterate_iterate_self
-/

end Commute

#print Function.Semiconj₂.iterate /-
theorem Semiconj₂.iterate {f : α → α} {op : α → α → α} (hf : Semiconj₂ f op op) (n : ℕ) :
    Semiconj₂ (f^[n]) op op :=
  Nat.recOn n (Semiconj₂.id_left op) fun n ihn => ihn.comp hf
#align function.semiconj₂.iterate Function.Semiconj₂.iterate
-/

variable (f)

#print Function.iterate_succ' /-
theorem iterate_succ' (n : ℕ) : f^[n.succ] = f ∘ f^[n] := by
  rw [iterate_succ, (commute.self_iterate f n).comp_eq]
#align function.iterate_succ' Function.iterate_succ'
-/

#print Function.iterate_succ_apply' /-
theorem iterate_succ_apply' (n : ℕ) (x : α) : (f^[n.succ]) x = f ((f^[n]) x) := by
  rw [iterate_succ']
#align function.iterate_succ_apply' Function.iterate_succ_apply'
-/

#print Function.iterate_pred_comp_of_pos /-
theorem iterate_pred_comp_of_pos {n : ℕ} (hn : 0 < n) : f^[n.pred] ∘ f = f^[n] := by
  rw [← iterate_succ, Nat.succ_pred_eq_of_pos hn]
#align function.iterate_pred_comp_of_pos Function.iterate_pred_comp_of_pos
-/

#print Function.comp_iterate_pred_of_pos /-
theorem comp_iterate_pred_of_pos {n : ℕ} (hn : 0 < n) : f ∘ f^[n.pred] = f^[n] := by
  rw [← iterate_succ', Nat.succ_pred_eq_of_pos hn]
#align function.comp_iterate_pred_of_pos Function.comp_iterate_pred_of_pos
-/

#print Function.Iterate.rec /-
/-- A recursor for the iterate of a function. -/
def Iterate.rec (p : α → Sort _) {f : α → α} (h : ∀ a, p a → p (f a)) {a : α} (ha : p a) (n : ℕ) :
    p ((f^[n]) a) :=
  Nat.rec ha
    (fun m => by
      rw [iterate_succ']
      exact h _)
    n
#align function.iterate.rec Function.Iterate.rec
-/

/- warning: function.iterate.rec_zero -> Function.Iterate.rec_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Sort.{u2}) {f : α -> α} (h : forall (a : α), (p a) -> (p (f a))) {a : α} (ha : p a), Eq.{u2} (p (Nat.iterate.{succ u1} α (fun (a : α) => f a) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) a)) (Function.Iterate.rec.{u1, u2} α p (fun (a : α) => f a) h a ha (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) ha
but is expected to have type
  forall {α : Type.{u2}} (p : α -> Sort.{u1}) {f : α -> α} (h : forall (a : α), (p a) -> (p (f a))) {a : α} (ha : p a), Eq.{u1} (p (Nat.iterate.{succ u2} α (fun (a : α) => f a) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) a)) (Function.Iterate.rec.{u2, u1} α p (fun (a : α) => f a) h a ha (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) ha
Case conversion may be inaccurate. Consider using '#align function.iterate.rec_zero Function.Iterate.rec_zeroₓ'. -/
theorem Iterate.rec_zero (p : α → Sort _) {f : α → α} (h : ∀ a, p a → p (f a)) {a : α} (ha : p a) :
    Iterate.rec p h ha 0 = ha :=
  rfl
#align function.iterate.rec_zero Function.Iterate.rec_zero

variable {f} {m n : ℕ} {a : α}

#print Function.LeftInverse.iterate /-
theorem LeftInverse.iterate {g : α → α} (hg : LeftInverse g f) (n : ℕ) :
    LeftInverse (g^[n]) (f^[n]) :=
  Nat.recOn n (fun _ => rfl) fun n ihn =>
    by
    rw [iterate_succ', iterate_succ]
    exact ihn.comp hg
#align function.left_inverse.iterate Function.LeftInverse.iterate
-/

#print Function.RightInverse.iterate /-
theorem RightInverse.iterate {g : α → α} (hg : RightInverse g f) (n : ℕ) :
    RightInverse (g^[n]) (f^[n]) :=
  hg.iterate n
#align function.right_inverse.iterate Function.RightInverse.iterate
-/

#print Function.iterate_comm /-
theorem iterate_comm (f : α → α) (m n : ℕ) : f^[n]^[m] = f^[m]^[n] :=
  (iterate_mul _ _ _).symm.trans (Eq.trans (by rw [Nat.mul_comm]) (iterate_mul _ _ _))
#align function.iterate_comm Function.iterate_comm
-/

#print Function.iterate_commute /-
theorem iterate_commute (m n : ℕ) : Commute (fun f : α → α => f^[m]) fun f => f^[n] := fun f =>
  iterate_comm f m n
#align function.iterate_commute Function.iterate_commute
-/

#print Function.iterate_add_eq_iterate /-
theorem iterate_add_eq_iterate (hf : Injective f) : (f^[m + n]) a = (f^[n]) a ↔ (f^[m]) a = a :=
  Iff.trans (by rw [← iterate_add_apply, Nat.add_comm]) (hf.iterate n).eq_iff
#align function.iterate_add_eq_iterate Function.iterate_add_eq_iterate
-/

alias iterate_add_eq_iterate ↔ iterate_cancel_of_add _
#align function.iterate_cancel_of_add Function.iterate_cancel_of_add

#print Function.iterate_cancel /-
theorem iterate_cancel (hf : Injective f) (ha : (f^[m]) a = (f^[n]) a) : (f^[m - n]) a = a :=
  by
  cases le_total m n
  · simp [Nat.sub_eq_zero_of_le h]
  · exact iterate_cancel_of_add hf (by rwa [Nat.sub_add_cancel h])
#align function.iterate_cancel Function.iterate_cancel
-/

end Function

namespace List

open Function

#print List.foldl_const /-
theorem foldl_const (f : α → α) (a : α) (l : List β) :
    l.foldl (fun b _ => f b) a = (f^[l.length]) a :=
  by
  induction' l with b l H generalizing a
  · rfl
  · rw [length_cons, foldl, iterate_succ_apply, H]
#align list.foldl_const List.foldl_const
-/

#print List.foldr_const /-
theorem foldr_const (f : β → β) (b : β) : ∀ l : List α, l.foldr (fun _ => f) b = (f^[l.length]) b
  | [] => rfl
  | a :: l => by rw [length_cons, foldr, foldr_const l, iterate_succ_apply']
#align list.foldr_const List.foldr_const
-/

end List


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

import data.complex.exponential
import analysis.special_functions.exp_log
import algebra.continued_fractions.computation.approximation_corollaries

/-!
# Bounds on specific values of the exponential
-/
namespace real

local notation `abs'` := _root_.abs
open is_absolute_value finset cau_seq complex

lemma exp_one_near_10 : abs' (exp 1 - 2244083/825552) ≤ 1/10^10 :=
begin
  apply exp_approx_start,
  iterate 13 { refine exp_1_approx_succ_eq (by norm_num1; refl) (by norm_cast; refl) _ },
  norm_num1,
  refine exp_approx_end' _ (by norm_num1; refl) _ (by norm_cast; refl) (by simp) _,
  rw [_root_.abs_one, abs_of_pos]; norm_num1,
end

lemma exp_one_near_20 : abs' (exp 1 - 363916618873/133877442384) ≤ 1/10^20 :=
begin
  apply exp_approx_start,
  iterate 21 { refine exp_1_approx_succ_eq (by norm_num1; refl) (by norm_cast; refl) _ },
  norm_num1,
  refine exp_approx_end' _ (by norm_num1; refl) _ (by norm_cast; refl) (by simp) _,
  rw [_root_.abs_one, abs_of_pos]; norm_num1,
end

lemma exp_one_gt_d9 : 2.7182818283 < exp 1 :=
lt_of_lt_of_le (by norm_num) (sub_le.1 (abs_sub_le_iff.1 exp_one_near_10).2)

lemma exp_one_lt_d9 : exp 1 < 2.7182818286 :=
lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 exp_one_near_10).1) (by norm_num)

lemma exp_neg_one_gt_d9 : 0.36787944116 < exp (-1) :=
begin
  rw [exp_neg, lt_inv _ (exp_pos _)],
  refine lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 exp_one_near_10).1) _,
  all_goals {norm_num},
end

lemma exp_neg_one_lt_d9 : exp (-1) < 0.36787944120 :=
begin
  rw [exp_neg, inv_lt (exp_pos _)],
  refine lt_of_lt_of_le _ (sub_le.1 (abs_sub_le_iff.1 exp_one_near_10).2),
  all_goals {norm_num},
end

lemma log_two_near_10 : abs' (log 2 - 287209 / 414355) ≤ 1/10^10 :=
begin
  suffices : abs' (log 2 - 287209 / 414355) ≤ 1/17179869184 + (1/10^10 - 1/2^34),
  { norm_num1 at *,
    assumption },
  have t : abs' (2⁻¹ : ℝ) = 2⁻¹,
  { rw abs_of_pos, norm_num },
  have z := real.abs_log_sub_add_sum_range_le (show abs' (2⁻¹ : ℝ) < 1, by { rw t, norm_num }) 34,
  rw t at z,
  norm_num1 at z,
  rw [one_div (2:ℝ), log_inv, ←sub_eq_add_neg, _root_.abs_sub] at z,
  apply le_trans (_root_.abs_sub_le _ _ _) (add_le_add z _),
  simp_rw [sum_range_succ],
  norm_num,
  rw abs_of_pos;
  norm_num
end

lemma log_two_gt_d9 : 0.6931471803 < log 2 :=
lt_of_lt_of_le (by norm_num1) (sub_le.1 (abs_sub_le_iff.1 log_two_near_10).2)

lemma log_two_lt_d9 : log 2 < 0.6931471808 :=
lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 log_two_near_10).1) (by norm_num)

end real


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import data.set.countable
import logic.encodable.lattice
import order.conditionally_complete_lattice
import order.disjointed
import order.symm_diff

/-!
# Measurable spaces and measurable functions

This file defines measurable spaces and measurable functions.

A measurable space is a set equipped with a σ-algebra, a collection of
subsets closed under complementation and countable union. A function
between measurable spaces is measurable if the preimage of each
measurable subset is measurable.

σ-algebras on a fixed set `α` form a complete lattice. Here we order
σ-algebras by writing `m₁ ≤ m₂` if every set which is `m₁`-measurable is
also `m₂`-measurable (that is, `m₁` is a subset of `m₂`). In particular, any
collection of subsets of `α` generates a smallest σ-algebra which
contains all of them.

Do not add measurability lemmas (which could be tagged with
@[measurability]) to this file, since the measurability tactic is downstream
from here. Use `measure_theory.measurable_space` instead.

## References

* <https://en.wikipedia.org/wiki/Measurable_space>
* <https://en.wikipedia.org/wiki/Sigma-algebra>
* <https://en.wikipedia.org/wiki/Dynkin_system>

## Tags

measurable space, σ-algebra, measurable function
-/

open set encodable function equiv
open_locale classical

variables {α β γ δ δ' : Type*} {ι : Sort*} {s t u : set α}

/-- A measurable space is a space equipped with a σ-algebra. -/
structure measurable_space (α : Type*) :=
(measurable_set' : set α → Prop)
(measurable_set_empty : measurable_set' ∅)
(measurable_set_compl : ∀ s, measurable_set' s → measurable_set' sᶜ)
(measurable_set_Union : ∀ f : ℕ → set α, (∀ i, measurable_set' (f i)) → measurable_set' (⋃ i, f i))

attribute [class] measurable_space

instance [h : measurable_space α] : measurable_space αᵒᵈ := h

section

/-- `measurable_set s` means that `s` is measurable (in the ambient measure space on `α`) -/
def measurable_set [measurable_space α] : set α → Prop := ‹measurable_space α›.measurable_set'

localized "notation `measurable_set[` m `]` := @measurable_set _ m" in measure_theory

@[simp] lemma measurable_set.empty [measurable_space α] : measurable_set (∅ : set α) :=
‹measurable_space α›.measurable_set_empty

variable {m : measurable_space α}

include m

lemma measurable_set.compl : measurable_set s → measurable_set sᶜ :=
‹measurable_space α›.measurable_set_compl s

lemma measurable_set.of_compl (h : measurable_set sᶜ) : measurable_set s :=
compl_compl s ▸ h.compl

@[simp] lemma measurable_set.compl_iff : measurable_set sᶜ ↔ measurable_set s :=
⟨measurable_set.of_compl, measurable_set.compl⟩

@[simp] lemma measurable_set.univ : measurable_set (univ : set α) :=
by simpa using (@measurable_set.empty α _).compl

@[nontriviality] lemma subsingleton.measurable_set [subsingleton α] {s : set α} :
  measurable_set s :=
subsingleton.set_cases measurable_set.empty measurable_set.univ s

lemma measurable_set.congr {s t : set α} (hs : measurable_set s) (h : s = t) :
  measurable_set t :=
by rwa ← h

lemma measurable_set.bUnion_decode₂ [encodable β] ⦃f : β → set α⦄ (h : ∀ b, measurable_set (f b))
  (n : ℕ) : measurable_set (⋃ b ∈ decode₂ β n, f b) :=
encodable.Union_decode₂_cases measurable_set.empty h

lemma measurable_set.Union [encodable β] ⦃f : β → set α⦄ (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋃ b, f b) :=
begin
  rw ← encodable.Union_decode₂,
  exact ‹measurable_space α›.measurable_set_Union _ (measurable_set.bUnion_decode₂ h)
end

lemma measurable_set.bUnion {f : β → set α} {s : set β} (hs : s.countable)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋃ b ∈ s, f b) :=
begin
  rw bUnion_eq_Union,
  haveI := hs.to_encodable,
  exact measurable_set.Union (by simpa using h)
end

lemma set.finite.measurable_set_bUnion {f : β → set α} {s : set β} (hs : s.finite)
  (h : ∀ b ∈ s, measurable_set (f b)) :
  measurable_set (⋃ b ∈ s, f b) :=
measurable_set.bUnion hs.countable h

lemma finset.measurable_set_bUnion {f : β → set α} (s : finset β)
  (h : ∀ b ∈ s, measurable_set (f b)) :
  measurable_set (⋃ b ∈ s, f b) :=
s.finite_to_set.measurable_set_bUnion h

lemma measurable_set.sUnion {s : set (set α)} (hs : s.countable) (h : ∀ t ∈ s, measurable_set t) :
  measurable_set (⋃₀ s) :=
by { rw sUnion_eq_bUnion, exact measurable_set.bUnion hs h }

lemma set.finite.measurable_set_sUnion {s : set (set α)} (hs : s.finite)
  (h : ∀ t ∈ s, measurable_set t) :
  measurable_set (⋃₀ s) :=
measurable_set.sUnion hs.countable h

lemma measurable_set.Union_Prop {p : Prop} {f : p → set α} (hf : ∀ b, measurable_set (f b)) :
  measurable_set (⋃ b, f b) :=
by { by_cases p; simp [h, hf, measurable_set.empty] }

lemma measurable_set.Inter [encodable β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋂ b, f b) :=
measurable_set.compl_iff.1 $
by { rw compl_Inter, exact measurable_set.Union (λ b, (h b).compl) }

section fintype

local attribute [instance] fintype.to_encodable

lemma measurable_set.Union_fintype [fintype β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋃ b, f b) :=
measurable_set.Union h

lemma measurable_set.Inter_fintype [fintype β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
  measurable_set (⋂ b, f b) :=
measurable_set.Inter h

end fintype

lemma measurable_set.bInter {f : β → set α} {s : set β} (hs : s.countable)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
measurable_set.compl_iff.1 $
by { rw compl_Inter₂, exact measurable_set.bUnion hs (λ b hb, (h b hb).compl) }

lemma set.finite.measurable_set_bInter {f : β → set α} {s : set β} (hs : s.finite)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
measurable_set.bInter hs.countable h

lemma finset.measurable_set_bInter {f : β → set α} (s : finset β)
  (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
s.finite_to_set.measurable_set_bInter h

lemma measurable_set.sInter {s : set (set α)} (hs : s.countable) (h : ∀ t ∈ s, measurable_set t) :
  measurable_set (⋂₀ s) :=
by { rw sInter_eq_bInter, exact measurable_set.bInter hs h }

lemma set.finite.measurable_set_sInter {s : set (set α)} (hs : s.finite)
  (h : ∀ t ∈ s, measurable_set t) : measurable_set (⋂₀ s) :=
measurable_set.sInter hs.countable h

lemma measurable_set.Inter_Prop {p : Prop} {f : p → set α} (hf : ∀ b, measurable_set (f b)) :
  measurable_set (⋂ b, f b) :=
by { by_cases p; simp [h, hf, measurable_set.univ] }

@[simp] lemma measurable_set.union {s₁ s₂ : set α} (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (s₁ ∪ s₂) :=
by { rw union_eq_Union, exact measurable_set.Union (bool.forall_bool.2 ⟨h₂, h₁⟩) }

@[simp] lemma measurable_set.inter {s₁ s₂ : set α} (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (s₁ ∩ s₂) :=
by { rw inter_eq_compl_compl_union_compl, exact (h₁.compl.union h₂.compl).compl }

@[simp] lemma measurable_set.diff {s₁ s₂ : set α} (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (s₁ \ s₂) :=
h₁.inter h₂.compl

@[simp] lemma measurable_set.symm_diff {s₁ s₂ : set α}
  (h₁ : measurable_set s₁) (h₂ : measurable_set s₂) :
  measurable_set (s₁ ∆ s₂) :=
(h₁.diff h₂).union (h₂.diff h₁)

@[simp] lemma measurable_set.ite {t s₁ s₂ : set α} (ht : measurable_set t) (h₁ : measurable_set s₁)
  (h₂ : measurable_set s₂) :
  measurable_set (t.ite s₁ s₂) :=
(h₁.inter ht).union (h₂.diff ht)

@[simp] lemma measurable_set.cond {s₁ s₂ : set α} (h₁ : measurable_set s₁) (h₂ : measurable_set s₂)
  {i : bool} : measurable_set (cond i s₁ s₂) :=
by { cases i, exacts [h₂, h₁] }

@[simp] lemma measurable_set.disjointed {f : ℕ → set α} (h : ∀ i, measurable_set (f i)) (n) :
  measurable_set (disjointed f n) :=
disjointed_rec (λ t i ht, measurable_set.diff ht $ h _) (h n)

@[simp] lemma measurable_set.const (p : Prop) : measurable_set {a : α | p} :=
by { by_cases p; simp [h, measurable_set.empty]; apply measurable_set.univ }

/-- Every set has a measurable superset. Declare this as local instance as needed. -/
lemma nonempty_measurable_superset (s : set α) : nonempty { t // s ⊆ t ∧ measurable_set t} :=
⟨⟨univ, subset_univ s, measurable_set.univ⟩⟩

end

open_locale measure_theory

@[ext] lemma measurable_space.ext : ∀ {m₁ m₂ : measurable_space α},
  (∀ s : set α, measurable_set[m₁] s ↔ measurable_set[m₂] s) → m₁ = m₂
| ⟨s₁, _, _, _⟩ ⟨s₂, _, _, _⟩ h :=
  have s₁ = s₂, from funext $ assume x, propext $ h x,
  by subst this

@[ext] lemma measurable_space.ext_iff {m₁ m₂ : measurable_space α} :
  m₁ = m₂ ↔ (∀ s : set α, measurable_set[m₁] s ↔ measurable_set[m₂] s) :=
⟨by { unfreezingI {rintro rfl}, intro s, refl }, measurable_space.ext⟩

/-- A typeclass mixin for `measurable_space`s such that each singleton is measurable. -/
class measurable_singleton_class (α : Type*) [measurable_space α] : Prop :=
(measurable_set_singleton : ∀ x, measurable_set ({x} : set α))

export measurable_singleton_class (measurable_set_singleton)

attribute [simp] measurable_set_singleton

section measurable_singleton_class

variables [measurable_space α] [measurable_singleton_class α]

lemma measurable_set_eq {a : α} : measurable_set {x | x = a} :=
measurable_set_singleton a

lemma measurable_set.insert {s : set α} (hs : measurable_set s) (a : α) :
  measurable_set (insert a s) :=
(measurable_set_singleton a).union hs

@[simp] lemma measurable_set_insert {a : α} {s : set α} :
  measurable_set (insert a s) ↔ measurable_set s :=
⟨λ h, if ha : a ∈ s then by rwa ← insert_eq_of_mem ha
  else insert_diff_self_of_not_mem ha ▸ h.diff (measurable_set_singleton _),
  λ h, h.insert a⟩

lemma set.subsingleton.measurable_set {s : set α} (hs : s.subsingleton) : measurable_set s :=
hs.induction_on measurable_set.empty measurable_set_singleton

lemma set.finite.measurable_set {s : set α} (hs : s.finite) : measurable_set s :=
finite.induction_on hs measurable_set.empty $ λ a s ha hsf hsm, hsm.insert _

protected lemma finset.measurable_set (s : finset α) : measurable_set (↑s : set α) :=
s.finite_to_set.measurable_set

lemma set.countable.measurable_set {s : set α} (hs : s.countable) : measurable_set s :=
begin
  rw [← bUnion_of_singleton s],
  exact measurable_set.bUnion hs (λ b hb, measurable_set_singleton b)
end

end measurable_singleton_class

namespace measurable_space

section complete_lattice

instance : has_le (measurable_space α) :=
{ le          := λ m₁ m₂, ∀ s, measurable_set[m₁] s → measurable_set[m₂] s }

lemma le_def {α} {a b : measurable_space α} :
  a ≤ b ↔ a.measurable_set' ≤ b.measurable_set' := iff.rfl

instance : partial_order (measurable_space α) :=
{ lt := λ m₁ m₂, m₁ ≤ m₂ ∧ ¬m₂ ≤ m₁,
  .. measurable_space.has_le,
  .. partial_order.lift (@measurable_set α) (λ m₁ m₂ h, ext $ λ s, h ▸ iff.rfl) }

/-- The smallest σ-algebra containing a collection `s` of basic sets -/
inductive generate_measurable (s : set (set α)) : set α → Prop
| basic : ∀ u ∈ s, generate_measurable u
| empty : generate_measurable ∅
| compl : ∀ s, generate_measurable s → generate_measurable sᶜ
| union : ∀ f : ℕ → set α, (∀ n, generate_measurable (f n)) → generate_measurable (⋃ i, f i)

/-- Construct the smallest measure space containing a collection of basic sets -/
def generate_from (s : set (set α)) : measurable_space α :=
{ measurable_set'      := generate_measurable s,
  measurable_set_empty := generate_measurable.empty,
  measurable_set_compl := generate_measurable.compl,
  measurable_set_Union := generate_measurable.union }

lemma measurable_set_generate_from {s : set (set α)} {t : set α} (ht : t ∈ s) :
  @measurable_set _ (generate_from s) t :=
generate_measurable.basic t ht

lemma generate_from_le {s : set (set α)} {m : measurable_space α}
  (h : ∀ t ∈ s, measurable_set[m] t) : generate_from s ≤ m :=
assume t (ht : generate_measurable s t), ht.rec_on h
  (measurable_set_empty m)
  (assume s _ hs, measurable_set_compl m s hs)
  (assume f _ hf, measurable_set_Union m f hf)

lemma generate_from_le_iff {s : set (set α)} (m : measurable_space α) :
  generate_from s ≤ m ↔ s ⊆ {t | measurable_set[m] t} :=
iff.intro
  (assume h u hu, h _ $ measurable_set_generate_from hu)
  (assume h, generate_from_le h)

@[simp] lemma generate_from_measurable_set [measurable_space α] :
  generate_from {s : set α | measurable_set s} = ‹_› :=
le_antisymm (generate_from_le $ λ _, id) $ λ s, measurable_set_generate_from

/-- If `g` is a collection of subsets of `α` such that the `σ`-algebra generated from `g` contains
the same sets as `g`, then `g` was already a `σ`-algebra. -/
protected def mk_of_closure (g : set (set α)) (hg : {t | measurable_set[generate_from g] t} = g) :
  measurable_space α :=
{ measurable_set'      := λ s, s ∈ g,
  measurable_set_empty := hg ▸ measurable_set_empty _,
  measurable_set_compl := hg ▸ measurable_set_compl _,
  measurable_set_Union := hg ▸ measurable_set_Union _ }

lemma mk_of_closure_sets {s : set (set α)}
  {hs : {t | measurable_set[generate_from s] t} = s} :
  measurable_space.mk_of_closure s hs = generate_from s :=
measurable_space.ext $ assume t, show t ∈ s ↔ _, by { conv_lhs { rw [← hs] }, refl }

/-- We get a Galois insertion between `σ`-algebras on `α` and `set (set α)` by using `generate_from`
  on one side and the collection of measurable sets on the other side. -/
def gi_generate_from : galois_insertion (@generate_from α) (λ m, {t | @measurable_set α m t}) :=
{ gc        := assume s, generate_from_le_iff,
  le_l_u    := assume m s, measurable_set_generate_from,
  choice    :=
    λ g hg, measurable_space.mk_of_closure g $ le_antisymm hg $ (generate_from_le_iff _).1 le_rfl,
  choice_eq := assume g hg, mk_of_closure_sets }

instance : complete_lattice (measurable_space α) :=
gi_generate_from.lift_complete_lattice

instance : inhabited (measurable_space α) := ⟨⊤⟩

lemma measurable_set_bot_iff {s : set α} : @measurable_set α ⊥ s ↔ (s = ∅ ∨ s = univ) :=
let b : measurable_space α :=
{ measurable_set'      := λ s, s = ∅ ∨ s = univ,
  measurable_set_empty := or.inl rfl,
  measurable_set_compl := by simp [or_imp_distrib] {contextual := tt},
  measurable_set_Union := assume f hf, classical.by_cases
    (assume h : ∃i, f i = univ,
      let ⟨i, hi⟩ := h in
      or.inr $ eq_univ_of_univ_subset $ hi ▸ le_supr f i)
    (assume h : ¬ ∃i, f i = univ,
      or.inl $ eq_empty_of_subset_empty $ Union_subset $ assume i,
        (hf i).elim (by simp {contextual := tt}) (assume hi, false.elim $ h ⟨i, hi⟩)) } in
have b = ⊥, from bot_unique $ assume s hs,
  hs.elim (λ s, s.symm ▸ @measurable_set_empty _ ⊥) (λ s, s.symm ▸ @measurable_set.univ _ ⊥),
this ▸ iff.rfl

@[simp] theorem measurable_set_top {s : set α} : @measurable_set _ ⊤ s := trivial

@[simp] theorem measurable_set_inf {m₁ m₂ : measurable_space α} {s : set α} :
  @measurable_set _ (m₁ ⊓ m₂) s ↔ @measurable_set _ m₁ s ∧ @measurable_set _ m₂ s :=
iff.rfl

@[simp] theorem measurable_set_Inf {ms : set (measurable_space α)} {s : set α} :
  @measurable_set _ (Inf ms) s ↔ ∀ m ∈ ms, @measurable_set _ m s :=
show s ∈ (⋂₀ _) ↔ _, by simp

@[simp] theorem measurable_set_infi {ι} {m : ι → measurable_space α} {s : set α} :
  @measurable_set _ (infi m) s ↔ ∀ i, @measurable_set _ (m i) s :=
by rw [infi, measurable_set_Inf, forall_range_iff]

theorem measurable_set_sup {m₁ m₂ : measurable_space α} {s : set α} :
  measurable_set[m₁ ⊔ m₂] s ↔ generate_measurable (measurable_set[m₁] ∪ measurable_set[m₂]) s :=
iff.refl _

theorem measurable_set_Sup {ms : set (measurable_space α)} {s : set α} :
  measurable_set[Sup ms] s ↔
    generate_measurable {s : set α | ∃ m ∈ ms, measurable_set[m] s} s :=
begin
  change @measurable_set' _ (generate_from $ ⋃₀ _) _ ↔ _,
  simp [generate_from, ← set_of_exists]
end

theorem measurable_set_supr {ι} {m : ι → measurable_space α} {s : set α} :
  @measurable_set _ (supr m) s ↔
    generate_measurable {s : set α | ∃ i, measurable_set[m i] s} s :=
by simp only [supr, measurable_set_Sup, exists_range_iff]

end complete_lattice

end measurable_space

section measurable_functions
open measurable_space

/-- A function `f` between measurable spaces is measurable if the preimage of every
  measurable set is measurable. -/
def measurable [measurable_space α] [measurable_space β] (f : α → β) : Prop :=
∀ ⦃t : set β⦄, measurable_set t → measurable_set (f ⁻¹' t)

localized "notation `measurable[` m `]` := @measurable _ _ m _" in measure_theory

lemma measurable_id {ma : measurable_space α} : measurable (@id α) := λ t, id

lemma measurable_id' {ma : measurable_space α} : measurable (λ a : α, a) := measurable_id

lemma measurable.comp {mα : measurable_space α} {mβ : measurable_space β}
  {mγ : measurable_space γ} {g : β → γ} {f : α → β} (hg : measurable g) (hf : measurable f) :
  measurable (g ∘ f) :=
λ t ht, hf (hg ht)

@[simp] lemma measurable_const {ma : measurable_space α} {mb : measurable_space β} {a : α} :
  measurable (λ b : β, a) :=
assume s hs, measurable_set.const (a ∈ s)

lemma measurable.le {α} {m m0 : measurable_space α} {mb : measurable_space β} (hm : m ≤ m0)
  {f : α → β}
  (hf : measurable[m] f) : measurable[m0] f :=
λ s hs, hm _ (hf hs)

end measurable_functions


/-
Problema dos Vestidos

Três irmãs - Ana, Maria e Cláudia - foram a uma festa com vestidos de
cores diferentes. Uma vestia azul, a outra branco e a Terceira
preto. Chegando à festa, o anfitrião perguntou quem era cada uma
delas. As respostas foram:
- A de azul respondeu: “Ana é a que está de branco”
- A de branco falou: “Eu sou Maria”
- A de preto disse:  “Cláudia é quem está de branco”
O anfitrião foi capaz de identificar corretamente quem era cada pessoa
considerando que:
- Ana sempre diz a verdade
- Maria às vezes diz a verdade
- Cláudia nunca diz a verdade
Pensando um pouco sobre o problema, pode-se concluir que a Ana estava
com o vestido preto, a Cláudia com o branco e a Maria com o
azul.
Formalizar o problema e usar algum método dedutivo para construir um
argumento formal a favor da conclusão.
Dica: A tabela verdade teria 512 linhas! Existem várias possiveis
formalizações, na que estamos interesados, todos os simbolos
proposicionais necessários estão declarados abaixo.
Vc deve interpretar as respostas e conclusões do anfitrião
considerando as possibilidades de quem poderia ter falado o que.
-/

variables AA AB AP MA MB MP CA CB CP : Prop

open classical

/- Vamos trabalhar as possibilidades de quem disse cada resposta para
concluirmos algumas hipóteses.
Se supormos que Ana estava de azul, encontramos que Ana estava de
branco, pois ela não mente. -/
variable h1 : AA → AB
/-Se supormos que Maria estava de branco, não concluimos nada. Na
verdade, não concluimos nada supondo que Maria estava usando alguma
cor, pois não temos certeza se ela mente ou fala a verdade.
Se supormos que Cláudia está vestindo azul, temos, pela sua resposta,
que Ana não está usando branco! -/
variable h2 : CA → ¬ AB
/- Suponhamos que Ana esteja de branco: então quem está de branco fala
sempre a verdade, de modo que Maria está de branco.-/
variable h3 : AB → MB
/- Se Cládia estava de branco, então a pessoa que estava de branco não
é a Maria, pois sempre mente. Porém, isso não significa que Maria não
estava de branco.
Suponhamos que Ana esteja de preto: então Cláudia está de branco:-/
variable h4 : AP → CB
/- Suponhamos que Cláudia esteja vestindo preto: a pessoa que está
vestindo preto está mentindo, logo Cláudia não está de branco:-/
variable h48 : CP -> ¬ CB
--Além disso, temos que: Ana está vestindo azul, branco ou preto:
variable h5 : AA ∨ AB ∨ AP
variable h6 : MA ∨ MB ∨ MP
variable h7 : CA ∨ CB ∨ CP
-- Ainda mais: cada vestido é realmente vestido por alguém:
variable h8 : AA ∨ MA ∨ CA
variable h9 : AB ∨ MB ∨ CB
variable h10 : AP ∨ MP ∨ CP
/- Sabemos também que uma pessoa vestir uma cor a impede de vestir
outras cores:-/
variable h20 : AA → (¬ AB ∧ ¬ AP)
variable h21 : AB → (¬ AA ∧ ¬ AP)
variable h22 : AP → (¬ AA ∧ ¬ AB)
variable h23 : MA → (¬ MB ∧ ¬ MP)
variable h24 : MB → (¬ MA ∧ ¬ MP)
variable h25 : MP → (¬ MA ∧ ¬ MB)
variable h26 : CA → (¬ CB ∧ ¬ CP)
variable h27 : CB → (¬ CA ∧ ¬ CP)
variable h28 : CP → (¬ CA ∧ ¬ CB)
/- Também é razoável assumir que apenas uma pessoa pode vestir uma
cor de vestido:-/
variable h38 : AA → (¬ MA ∧ ¬ CA)
variable h39 : AB → (¬ MB ∧ ¬ CB)
variable h40 : AP → (¬ MP ∧ ¬ CP)
variable h41 : MA → (¬ AA ∧ ¬ CA)
variable h42 : MB → (¬ AB ∧ ¬ CB)
variable h43 : MP → (¬ AP ∧ ¬ CP)
variable h44 : CA → (¬ AA ∧ ¬ MA)
variable h45 : CB → (¬ AB ∧ ¬ MB)
variable h46 : CP → (¬ AP ∧ ¬ MP)

example : AP ∧ MA ∧ CB :=
  have h11 : AP, from
    by_contradiction
    (assume h13 : ¬ AP,
    show false, from
      or.elim h5
        (assume h14 : AA,
        have h36 : AA → false, from
          (assume h37 : AA,
          show false, from
            (show ¬ AB, from and.left (h20 h37))
            (show AB, from h1 h37)),
        show false, from h36 h14)
        (assume h15 : AB ∨ AP,
        show false, from
          or.elim h15
            (assume h16 : AB,
            have h37 : AB → false, from
              (assume h47 : AB,
                (show ¬ MB, from and.left (h39 h47))
                (show MB, from h3 h47)),
            show false, from h37 h16)
            (assume h17 : AP,
            show false, from h13 h17))),
  have h19 : CB, from h4 h11,
  have h18 : MA, from
    by_contradiction
    (assume h29: ¬ MA,
    have h30 : ¬ AA, from and.left (h22 h11),
    have h31 : ¬ CA, from and.left (h27 h19),
    show false, from
    or.elim h8
      (assume h32 : AA, h30 h32)
      (assume h33 : MA ∨ CA,
      show false, from
        or.elim h33
          (assume h34 : MA, h29 h34)
          (assume h35 : CA, h31 h35))),
  have h12 : MA ∧ CB, from and.intro h18 h19,
  and.intro h11 h12


import tactic data.nat.prime

/--------------------------------------------------------------------------

``norm_num``

  Useful for arithmetic of natural numbers.

``ring_nf``

  Useful for basic algebra with + and *.

``linarith``

  Useful for inequalities.

Delete the ``sorry,`` below and replace them with a legitimate proof.

--------------------------------------------------------------------------/

example : 1 > 0 :=
begin
  sorry,
end

example : 101 ∣ 2020 :=
begin
  sorry,
end

example : nat.prime 101 :=
begin
  sorry,
end

example (m a b : ℕ) :  m^2 + (a + b) * m + a * b = (m + a) * (m + b) :=
begin
  sorry,
end

example (a b c : ℕ) : a < b → b ≤ c → a < c :=
begin
  sorry,
end

example (m a b : ℕ) :  m + a ∣ m^2 + (a + b) * m + a * b :=
begin
  sorry,
end

-- try ``rw nat.prime_def_lt'' at hp,`` to get started
example (p : ℕ) (hp : nat.prime p) : ¬ (p = 1) :=
begin
  sorry,
end

example (a b : ℕ) : ¬ a ≤ b → b < a :=
begin
  sorry,
end