/-
Copyright (c) 2020 Heather Macbeth, Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Patrick Massot
-/
import algebra.order.archimedean
import group_theory.subgroup.basic

/-!
# Archimedean groups

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

This file proves a few facts about ordered groups which satisfy the `archimedean` property, that is:
`class archimedean (α) [ordered_add_comm_monoid α] : Prop :=`
`(arch : ∀ (x : α) {y}, 0 < y → ∃ n : ℕ, x ≤ n • y)`

They are placed here in a separate file (rather than incorporated as a continuation of
`algebra.order.archimedean`) because they rely on some imports from `group_theory` -- bundled
subgroups in particular.

The main result is `add_subgroup.cyclic_of_min`:  a subgroup of a decidable archimedean abelian
group is cyclic, if its set of positive elements has a minimal element.

This result is used in this file to deduce `int.subgroup_cyclic`, proving that every subgroup of `ℤ`
is cyclic.  (There are several other methods one could use to prove this fact, including more purely
algebraic methods, but none seem to exist in mathlib as of writing.  The closest is
`subgroup.is_cyclic`, but that has not been transferred to `add_subgroup`.)

The result is also used in `topology.instances.real` as an ingredient in the classification of
subgroups of `ℝ`.
-/

variables {G : Type*} [linear_ordered_add_comm_group G] [archimedean G]
open linear_ordered_add_comm_group

/-- Given a subgroup `H` of a decidable linearly ordered archimedean abelian group `G`, if there
exists a minimal element `a` of `H ∩ G_{>0}` then `H` is generated by `a`. -/
lemma add_subgroup.cyclic_of_min {H : add_subgroup G} {a : G}
  (ha : is_least {g : G | g ∈ H ∧ 0 < g} a) : H = add_subgroup.closure {a} :=
begin
  obtain ⟨⟨a_in, a_pos⟩, a_min⟩ := ha,
  refine le_antisymm _ (H.closure_le.mpr $ by simp [a_in]),
  intros g g_in,
  obtain ⟨k, ⟨nonneg, lt⟩, _⟩ : ∃! k, 0 ≤ g - k • a ∧ g - k • a < a :=
    exists_unique_zsmul_near_of_pos' a_pos g,
  have h_zero : g - k • a = 0,
  { by_contra h,
    have h : a ≤ g - k • a,
    { refine a_min ⟨_, _⟩,
      { exact add_subgroup.sub_mem H g_in (add_subgroup.zsmul_mem H a_in k) },
      { exact lt_of_le_of_ne nonneg (ne.symm h) } },
    have h' : ¬ (a ≤ g - k • a) := not_le.mpr lt,
    contradiction },
  simp [sub_eq_zero.mp h_zero, add_subgroup.mem_closure_singleton],
end

/-- Every subgroup of `ℤ` is cyclic. -/
lemma int.subgroup_cyclic (H : add_subgroup ℤ) : ∃ a, H = add_subgroup.closure {a} :=
begin
  cases add_subgroup.bot_or_exists_ne_zero H with h h,
  { use 0,
    rw h,
    exact add_subgroup.closure_singleton_zero.symm },
  let s := {g : ℤ | g ∈ H ∧ 0 < g},
  have h_bdd : ∀ g ∈ s, (0 : ℤ) ≤ g := λ _ h, le_of_lt h.2,
  obtain ⟨g₀, g₀_in, g₀_ne⟩ := h,
  obtain ⟨g₁, g₁_in, g₁_pos⟩ : ∃ g₁ : ℤ, g₁ ∈ H ∧ 0 < g₁,
  { cases lt_or_gt_of_ne g₀_ne with Hg₀ Hg₀,
    { exact ⟨-g₀, H.neg_mem g₀_in, neg_pos.mpr Hg₀⟩ },
    { exact ⟨g₀, g₀_in, Hg₀⟩ } },
  obtain ⟨a, ha, ha'⟩ := int.exists_least_of_bdd ⟨(0 : ℤ), h_bdd⟩ ⟨g₁, g₁_in, g₁_pos⟩,
  exact ⟨a, add_subgroup.cyclic_of_min ⟨ha, ha'⟩⟩,
end


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris Van Doorn, Yury Kudryashov
-/

import measure_theory.constructions.borel_space

/-!
# Regular measures

A measure is `outer_regular` if the measure of any measurable set `A` is the infimum of `μ U` over
all open sets `U` containing `A`.

A measure is `regular` if it satisfies the following properties:
* it is finite on compact sets;
* it is outer regular;
* it is inner regular for open sets with respect to compacts sets: the measure of any open set `U`
  is the supremum of `μ K` over all compact sets `K` contained in `U`.

A measure is `weakly_regular` if it satisfies the following properties:
* it is outer regular;
* it is inner regular for open sets with respect to closed sets: the measure of any open set `U`
  is the supremum of `μ F` over all compact sets `F` contained in `U`.

In a Hausdorff topological space, regularity implies weak regularity. These three conditions are
registered as typeclasses for a measure `μ`, and this implication is recorded as an instance.

In order to avoid code duplication, we also define a measure `μ` to be `inner_regular` for sets
satisfying a predicate `q` with respect to sets satisfying a predicate `p` if for any set
`U ∈ {U | q U}` and a number `r < μ U` there exists `F ⊆ U` such that `p F` and `r < μ F`.

We prove that inner regularity for open sets with respect to compact sets or closed sets implies
inner regularity for all measurable sets of finite measure (with respect to
compact sets or closed sets respectively), and register some corollaries for (weakly) regular
measures.

Note that a similar statement for measurable sets of infinite mass can fail. For a counterexample,
consider the group `ℝ × ℝ` where the first factor has the discrete topology and the second one the
usual topology. It is a locally compact Hausdorff topological group, with Haar measure equal to
Lebesgue measure on each vertical fiber. The set `ℝ × {0}` has infinite measure (by outer
regularity), but any compact set it contains has zero measure (as it is finite).

Several authors require as a definition of regularity that all measurable sets are inner regular.
We have opted for the slightly weaker definition above as it holds for all Haar measures, it is
enough for essentially all applications, and it is equivalent to the other definition when the
measure is finite.

The interest of the notion of weak regularity is that it is enough for many applications, and it
is automatically satisfied by any finite measure on a metric space.

## Main definitions

* `measure_theory.measure.outer_regular μ`: a typeclass registering that a measure `μ` on a
  topological space is outer regular.
* `measure_theory.measure.regular μ`: a typeclass registering that a measure `μ` on a topological
  space is regular.
* `measure_theory.measure.weakly_regular μ`: a typeclass registering that a measure `μ` on a
  topological space is weakly regular.
* `measure_theory.measure.inner_regular μ p q`: a non-typeclass predicate saying that a measure `μ`
  is inner regular for sets satisfying `q` with respect to sets satisfying `p`.

## Main results

### Outer regular measures

* `set.measure_eq_infi_is_open` asserts that, when `μ` is outer regular, the measure of a
  set is the infimum of the measure of open sets containing it.
* `set.exists_is_open_lt_of_lt'` asserts that, when `μ` is outer regular, for every set `s`
  and `r > μ s` there exists an open superset `U ⊇ s` of measure less than `r`.
* push forward of an outer regular measure is outer regular, and scalar multiplication of a regular
  measure by a finite number is outer regular.
* `measure_theory.measure.outer_regular.of_sigma_compact_space_of_is_locally_finite_measure`:
  a locally finite measure on a `σ`-compact metric (or even pseudo emetric) space is outer regular.

### Weakly regular measures

* `is_open.measure_eq_supr_is_closed` asserts that the measure of an open set is the supremum of
  the measure of closed sets it contains.
* `is_open.exists_lt_is_closed`: for an open set `U` and `r < μ U`, there exists a closed `F ⊆ U`
  of measure greater than `r`;
* `measurable_set.measure_eq_supr_is_closed_of_ne_top` asserts that the measure of a measurable set
  of finite measure is the supremum of the measure of closed sets it contains.
*  `measurable_set.exists_lt_is_closed_of_ne_top` and `measurable_set.exists_is_closed_lt_add`:
  a measurable set of finite measure can be approximated by a closed subset (stated as
  `r < μ F` and `μ s < μ F + ε`, respectively).
* `measure_theory.measure.weakly_regular.of_pseudo_emetric_space_of_is_finite_measure` is an
  instance registering that a finite measure on a metric space is weakly regular (in fact, a pseudo
  emetric space is enough);
* `measure_theory.measure.weakly_regular.of_pseudo_emetric_sigma_compact_space_of_locally_finite`
  is an instance registering that a locally finite measure on a `σ`-compact metric space (or even
  a pseudo emetric space) is weakly regular.

### Regular measures

* `is_open.measure_eq_supr_is_compact` asserts that the measure of an open set is the supremum of
  the measure of compact sets it contains.
* `is_open.exists_lt_is_compact`: for an open set `U` and `r < μ U`, there exists a compact `K ⊆ U`
  of measure greater than `r`;
* `measurable_set.measure_eq_supr_is_compact_of_ne_top` asserts that the measure of a measurable set
  of finite measure is the supremum of the measure of compact sets it contains.
*  `measurable_set.exists_lt_is_compact_of_ne_top` and `measurable_set.exists_is_compact_lt_add`:
  a measurable set of finite measure can be approximated by a compact subset (stated as
  `r < μ K` and `μ s < μ K + ε`, respectively).
* `measure_theory.measure.regular.of_sigma_compact_space_of_is_locally_finite_measure` is an
  instance registering that a locally finite measure on a `σ`-compact metric space is regular (in
  fact, an emetric space is enough).

## Implementation notes

The main nontrivial statement is `measure_theory.measure.inner_regular.weakly_regular_of_finite`,
expressing that in a finite measure space, if every open set can be approximated from inside by
closed sets, then the measure is in fact weakly regular. To prove that we show that any measurable
set can be approximated from inside by closed sets and from outside by open sets. This statement is
proved by measurable induction, starting from open sets and checking that it is stable by taking
complements (this is the point of this condition, being symmetrical between inside and outside) and
countable disjoint unions.

Once this statement is proved, one deduces results for `σ`-finite measures from this statement, by
restricting them to finite measure sets (and proving that this restriction is weakly regular, using
again the same statement).

## References

[Halmos, Measure Theory, §52][halmos1950measure]. Note that Halmos uses an unusual definition of
Borel sets (for him, they are elements of the `σ`-algebra generated by compact sets!), so his
proofs or statements do not apply directly.

[Billingsley, Convergence of Probability Measures][billingsley1999]
-/

open set filter
open_locale ennreal topological_space nnreal big_operators

namespace measure_theory
namespace measure

/-- We say that a measure `μ` is *inner regular* with respect to predicates `p q : set α → Prop`,
if for every `U` such that `q U` and `r < μ U`, there exists a subset `K ⊆ U` satisfying `p K`
of measure greater than `r`.

This definition is used to prove some facts about regular and weakly regular measures without
repeating the proofs. -/
def inner_regular {α} {m : measurable_space α} (μ : measure α) (p q : set α → Prop) :=
∀ ⦃U⦄, q U → ∀ r < μ U, ∃ K ⊆ U, p K ∧ r < μ K

namespace inner_regular

variables {α : Type*} {m : measurable_space α} {μ : measure α} {p q : set α → Prop}
  {U : set α} {ε : ℝ≥0∞}

lemma measure_eq_supr (H : inner_regular μ p q) (hU : q U) : μ U = ⨆ (K ⊆ U) (hK : p K), μ K :=
begin
  refine le_antisymm (le_of_forall_lt (λ r hr, _)) (bsupr_le $ λ K hK, supr_le $ λ _, μ.mono hK),
  simpa only [lt_supr_iff, exists_prop] using H hU r hr
end

lemma exists_subset_lt_add (H : inner_regular μ p q) (h0 : p ∅) (hU : q U) (hμU : μ U ≠ ∞)
  (hε : ε ≠ 0) :
  ∃ K ⊆ U, p K ∧ μ U < μ K + ε :=
begin
  cases eq_or_ne (μ U) 0 with h₀ h₀,
  { refine ⟨∅, empty_subset _, h0, _⟩,
    rwa [measure_empty, h₀, zero_add, pos_iff_ne_zero] },
  { rcases H hU _ (ennreal.sub_lt_self hμU h₀ hε) with ⟨K, hKU, hKc, hrK⟩,
    exact ⟨K, hKU, hKc, ennreal.lt_add_of_sub_lt (or.inl hμU) hrK⟩ }
end

lemma map {α β} [measurable_space α] [measurable_space β] {μ : measure α} {pa qa : set α → Prop}
  (H : inner_regular μ pa qa) (f : α ≃ β) (hf : measurable f)
  {pb qb : set β → Prop} (hAB : ∀ U, qb U → qa (f ⁻¹' U)) (hAB' : ∀ K, pa K → pb (f '' K))
  (hB₁ : ∀ K, pb K → measurable_set K) (hB₂ : ∀ U, qb U → measurable_set U) :
  inner_regular (map f μ) pb qb :=
begin
  intros U hU r hr,
  rw [map_apply hf (hB₂ _ hU)] at hr,
  rcases H (hAB U hU) r hr with ⟨K, hKU, hKc, hK⟩,
  refine ⟨f '' K, image_subset_iff.2 hKU, hAB' _ hKc, _⟩,
  rwa [map_apply hf (hB₁ _ $ hAB' _ hKc), f.preimage_image]
end

lemma smul (H : inner_regular μ p q) (c : ℝ≥0∞) : inner_regular (c • μ) p q :=
begin
  intros U hU r hr,
  rw [smul_apply, H.measure_eq_supr hU] at hr,
  simpa only [ennreal.mul_supr, lt_supr_iff, exists_prop] using hr
end

lemma trans {q' : set α → Prop} (H : inner_regular μ p q) (H' : inner_regular μ q q') :
  inner_regular μ p q' :=
begin
  intros U hU r hr,
  rcases H' hU r hr with ⟨F, hFU, hqF, hF⟩, rcases H hqF _ hF with ⟨K, hKF, hpK, hrK⟩,
  exact ⟨K, hKF.trans hFU, hpK, hrK⟩
end

end inner_regular

variables {α β : Type*} [measurable_space α] [topological_space α] {μ : measure α}

/-- A measure `μ` is outer regular if `μ(A) = inf {μ(U) | A ⊆ U open}` for a measurable set `A`.

This definition implies the same equality for any (not necessarily measurable) set, see
`set.measure_eq_infi_is_open`. -/
@[protect_proj] class outer_regular (μ : measure α) : Prop :=
(outer_regular : ∀ ⦃A : set α⦄, measurable_set A → ∀ r > μ A, ∃ U ⊇ A, is_open U ∧ μ U < r)

/-- A measure `μ` is regular if
  - it is finite on all compact sets;
  - it is outer regular: `μ(A) = inf {μ(U) | A ⊆ U open}` for `A` measurable;
  - it is inner regular for open sets, using compact sets:
    `μ(U) = sup {μ(K) | K ⊆ U compact}` for `U` open. -/
@[protect_proj] class regular (μ : measure α) extends outer_regular μ : Prop :=
(lt_top_of_is_compact : ∀ ⦃K : set α⦄, is_compact K → μ K < ∞)
(inner_regular : inner_regular μ is_compact is_open)

/-- A measure `μ` is weakly regular if
  - it is outer regular: `μ(A) = inf { μ(U) | A ⊆ U open }` for `A` measurable;
  - it is inner regular for open sets, using closed sets:
    `μ(U) = sup {μ(F) | F ⊆ U compact}` for `U` open. -/
@[protect_proj] class weakly_regular (μ : measure α) extends outer_regular μ : Prop :=
(inner_regular : inner_regular μ is_closed is_open)

/-- A regular measure is weakly regular. -/
@[priority 100] -- see Note [lower instance priority]
instance regular.weakly_regular [t2_space α] [regular μ] : weakly_regular μ :=
{ inner_regular := λ U hU r hr, let ⟨K, hKU, hcK, hK⟩ := regular.inner_regular hU r hr
  in ⟨K, hKU, hcK.is_closed, hK⟩ }

namespace outer_regular

instance zero : outer_regular (0 : measure α) :=
⟨λ A hA r hr, ⟨univ, subset_univ A, is_open_univ, hr⟩⟩

/-- Given `r` larger than the measure of a set `A`, there exists an open superset of `A` with
measure less than `r`. -/
lemma _root_.set.exists_is_open_lt_of_lt [outer_regular μ] (A : set α) (r : ℝ≥0∞) (hr : μ A < r) :
  ∃ U ⊇ A, is_open U ∧ μ U < r :=
begin
  rcases outer_regular.outer_regular (measurable_set_to_measurable μ A) r
    (by rwa measure_to_measurable) with ⟨U, hAU, hUo, hU⟩,
  exact ⟨U, (subset_to_measurable _ _).trans hAU, hUo, hU⟩
end

/-- For an outer regular measure, the measure of a set is the infimum of the measures of open sets
containing it. -/
lemma _root_.set.measure_eq_infi_is_open (A : set α) (μ : measure α) [outer_regular μ] :
  μ A = (⨅ (U : set α) (h : A ⊆ U) (h2 : is_open U), μ U) :=
begin
  refine le_antisymm (le_binfi $ λ s hs, le_infi $ λ h2s, μ.mono hs) _,
  refine le_of_forall_lt' (λ r hr, _),
  simpa only [infi_lt_iff, exists_prop] using A.exists_is_open_lt_of_lt r hr
end

lemma _root_.set.exists_is_open_lt_add [outer_regular μ] (A : set α) (hA : μ A ≠ ∞)
  {ε : ℝ≥0∞} (hε : ε ≠ 0) :
  ∃ U ⊇ A, is_open U ∧ μ U < μ A + ε :=
A.exists_is_open_lt_of_lt _ (ennreal.lt_add_right hA hε)

lemma _root_.set.exists_is_open_le_add (A : set α) (μ : measure α) [outer_regular μ]
  {ε : ℝ≥0∞} (hε : ε ≠ 0) :
  ∃ U ⊇ A, is_open U ∧ μ U ≤ μ A + ε :=
begin
  rcases le_or_lt ∞ (μ A) with H|H,
  { exact ⟨univ, subset_univ _, is_open_univ,
      by simp only [top_le_iff.mp H, ennreal.top_add, le_top]⟩ },
  { rcases A.exists_is_open_lt_add H.ne hε with ⟨U, AU, U_open, hU⟩,
    exact ⟨U, AU, U_open, hU.le⟩ }
end

lemma _root_.measurable_set.exists_is_open_diff_lt [opens_measurable_space α]
  [outer_regular μ] {A : set α} (hA : measurable_set A)
  (hA' : μ A ≠ ∞) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
  ∃ U ⊇ A, is_open U ∧ μ U < ∞ ∧ μ (U \ A) < ε :=
begin
  rcases A.exists_is_open_lt_add hA' hε with ⟨U, hAU, hUo, hU⟩,
  use [U, hAU, hUo, hU.trans_le le_top],
  exact measure_diff_lt_of_lt_add hA hUo.measurable_set hAU hA' hU,
end

protected lemma map [opens_measurable_space α] [measurable_space β] [topological_space β]
  [borel_space β] (f : α ≃ₜ β) (μ : measure α) [outer_regular μ] :
  (measure.map f μ).outer_regular :=
begin
  refine ⟨λ A hA r hr, _⟩,
  rw [map_apply f.measurable hA, ← f.image_symm] at hr,
  rcases set.exists_is_open_lt_of_lt _ r hr with ⟨U, hAU, hUo, hU⟩,
  have : is_open (f.symm ⁻¹' U), from hUo.preimage f.symm.continuous,
  refine ⟨f.symm ⁻¹' U, image_subset_iff.1 hAU, this, _⟩,
  rwa [map_apply f.measurable this.measurable_set, f.preimage_symm, f.preimage_image],
end

protected lemma smul (μ : measure α) [outer_regular μ] {x : ℝ≥0∞} (hx : x ≠ ∞) :
  (x • μ).outer_regular :=
begin
  rcases eq_or_ne x 0 with rfl|h0,
  { rw zero_smul, exact outer_regular.zero },
  { refine ⟨λ A hA r hr, _⟩,
    rw [smul_apply, A.measure_eq_infi_is_open] at hr,
    simpa only [ennreal.mul_infi_of_ne h0 hx, gt_iff_lt, infi_lt_iff, exists_prop] using hr }
end

end outer_regular

/-- If a measure `μ` admits finite spanning open sets such that the restriction of `μ` to each set
is outer regular, then the original measure is outer regular as well. -/
protected lemma finite_spanning_sets_in.outer_regular [opens_measurable_space α] {μ : measure α}
  (s : μ.finite_spanning_sets_in {U | is_open U ∧ outer_regular (μ.restrict U)}) :
  outer_regular μ :=
begin
  refine ⟨λ A hA r hr, _⟩,
  have hm : ∀ n, measurable_set (s.set n), from λ n, (s.set_mem n).1.measurable_set,
  haveI : ∀ n, outer_regular (μ.restrict (s.set n)) := λ n, (s.set_mem n).2,
  -- Note that `A = ⋃ n, A ∩ disjointed s n`. We replace `A` with this sequence.
  obtain ⟨A, hAm, hAs, hAd, rfl⟩ : ∃ A' : ℕ → set α, (∀ n, measurable_set (A' n)) ∧
    (∀ n, A' n ⊆ s.set n) ∧ pairwise (disjoint on A') ∧ A = ⋃ n, A' n,
  { refine ⟨λ n, A ∩ disjointed s.set n, λ n, hA.inter (measurable_set.disjointed hm _),
      λ n, (inter_subset_right _ _).trans (disjointed_subset _ _),
      (disjoint_disjointed s.set).mono (λ k l hkl, hkl.mono inf_le_right inf_le_right), _⟩,
    rw [← inter_Union, Union_disjointed, s.spanning, inter_univ] },
  rcases ennreal.exists_pos_sum_of_encodable' (tsub_pos_iff_lt.2 hr).ne' ℕ with ⟨δ, δ0, hδε⟩,
  rw [lt_tsub_iff_right, add_comm] at hδε,
  have : ∀ n, ∃ U ⊇ A n, is_open U ∧ μ U < μ (A n) + δ n,
  { intro n,
    have H₁ : ∀ t, μ.restrict (s.set n) t = μ (t ∩ s.set n), from λ t, restrict_apply' (hm n),
    have Ht : μ.restrict (s.set n) (A n) ≠ ⊤,
    { rw H₁, exact ((measure_mono $ inter_subset_right _ _).trans_lt (s.finite n)).ne },
    rcases (A n).exists_is_open_lt_add Ht (δ0 n).ne' with ⟨U, hAU, hUo, hU⟩,
    rw [H₁, H₁, inter_eq_self_of_subset_left (hAs _)] at hU,
    exact ⟨U ∩ s.set n, subset_inter hAU (hAs _), hUo.inter (s.set_mem n).1, hU⟩ },
  choose U hAU hUo hU,
  refine ⟨⋃ n, U n, Union_subset_Union hAU, is_open_Union hUo, _⟩,
  calc μ (⋃ n, U n) ≤ ∑' n, μ (U n)             : measure_Union_le _
                ... ≤ ∑' n, (μ (A n) + δ n)     : ennreal.tsum_le_tsum (λ n, (hU n).le)
                ... = ∑' n, μ (A n) + ∑' n, δ n : ennreal.tsum_add
                ... = μ (⋃ n, A n) + ∑' n, δ n  : congr_arg2 (+) (measure_Union hAd hAm).symm rfl
                ... < r                         : hδε
end

namespace inner_regular

variables {p q : set α → Prop} {U s : set α} {ε r : ℝ≥0∞}

/-- If a measure is inner regular (using closed or compact sets), then every measurable set of
finite measure can by approximated by a (closed or compact) subset. -/
lemma measurable_set_of_open [opens_measurable_space α] [outer_regular μ]
  (H : inner_regular μ p is_open) (h0 : p ∅) (hd : ∀ ⦃s U⦄, p s → is_open U → p (s \ U)) :
  inner_regular μ p (λ s, measurable_set s ∧ μ s ≠ ∞) :=
begin
  rintros s ⟨hs, hμs⟩ r hr,
  obtain ⟨ε, hε, hεs, rfl⟩ : ∃ ε ≠ 0, ε + ε ≤ μ s ∧ r = μ s - (ε + ε),
  { use (μ s - r) / 2, simp [*, hr.le, ennreal.add_halves, ennreal.sub_sub_cancel, le_add_right] },
  rcases hs.exists_is_open_diff_lt hμs hε with ⟨U, hsU, hUo, hUt, hμU⟩,
  rcases (U \ s).exists_is_open_lt_of_lt _ hμU with ⟨U', hsU', hU'o, hμU'⟩,
  replace hsU' := diff_subset_comm.1 hsU',
  rcases H.exists_subset_lt_add h0 hUo hUt.ne hε with ⟨K, hKU, hKc, hKr⟩,
  refine ⟨K \ U', λ x hx, hsU' ⟨hKU hx.1, hx.2⟩, hd hKc hU'o, ennreal.sub_lt_of_lt_add hεs _⟩,
  calc μ s ≤ μ U                   : μ.mono hsU
       ... < μ K + ε               : hKr
       ... ≤ μ (K \ U') + μ U' + ε :
    add_le_add_right (tsub_le_iff_right.1 le_measure_diff) _
       ... ≤ μ (K \ U') + ε + ε    : by { mono*, exacts [hμU'.le, le_rfl] }
       ... = μ (K \ U') + (ε + ε)  : add_assoc _ _ _
end

open finset

/-- In a finite measure space, assume that any open set can be approximated from inside by closed
sets. Then the measure is weakly regular. -/
lemma weakly_regular_of_finite [borel_space α] (μ : measure α) [is_finite_measure μ]
  (H : inner_regular μ is_closed is_open) : weakly_regular μ :=
begin
  have hfin : ∀ {s}, μ s ≠ ⊤ := measure_ne_top μ,
  suffices : ∀ s, measurable_set s → ∀ ε ≠ 0,
    ∃ (F ⊆ s) (U ⊇ s), is_closed F ∧ is_open U ∧ μ s ≤ μ F + ε ∧ μ U ≤ μ s + ε,
  { refine { outer_regular := λ s hs r hr, _, inner_regular := H },
    rcases exists_between hr with ⟨r', hsr', hr'r⟩,
    rcases this s hs _ (tsub_pos_iff_lt.2 hsr').ne' with ⟨-, -, U, hsU, -, hUo, -, H⟩,
    refine ⟨U, hsU, hUo, _⟩,
    rw [add_tsub_cancel_of_le hsr'.le] at H, exact H.trans_lt hr'r },
  refine measurable_set.induction_on_open _ _ _,
  /- The proof is by measurable induction: we should check that the property is true for the empty
  set, for open sets, and is stable by taking the complement and by taking countable disjoint
  unions. The point of the property we are proving is that it is stable by taking complements
  (exchanging the roles of closed and open sets and thanks to the finiteness of the measure). -/
  -- check for open set
  { intros U hU ε hε,
    rcases H.exists_subset_lt_add is_closed_empty hU hfin hε with ⟨F, hsF, hFc, hF⟩,
    exact ⟨F, hsF, U, subset.rfl, hFc, hU, hF.le, le_self_add⟩ },
  -- check for complements
  { rintros s hs H ε hε,
    rcases H ε hε with ⟨F, hFs, U, hsU, hFc, hUo, hF, hU⟩,
    refine ⟨Uᶜ, compl_subset_compl.2 hsU, Fᶜ, compl_subset_compl.2 hFs,
      hUo.is_closed_compl, hFc.is_open_compl, _⟩,
    simp only [measure_compl_le_add_iff, *, hUo.measurable_set, hFc.measurable_set, true_and] },
  -- check for disjoint unions
  { intros s hsd hsm H ε ε0, have ε0' : ε / 2 ≠ 0, from (ennreal.half_pos ε0).ne',
    rcases ennreal.exists_pos_sum_of_encodable' ε0' ℕ with ⟨δ, δ0, hδε⟩,
    choose F hFs U hsU hFc hUo hF hU using λ n, H n (δ n) (δ0 n).ne',
    -- the approximating closed set is constructed by considering finitely many sets `s i`, which
    -- cover all the measure up to `ε/2`, approximating each of these by a closed set `F i`, and
    -- taking the union of these (finitely many) `F i`.
    have : tendsto (λ t, ∑ k in t, μ (s k) + ε / 2) at_top (𝓝 $ μ (⋃ n, s n) + ε / 2),
    { rw measure_Union hsd hsm, exact tendsto.add ennreal.summable.has_sum tendsto_const_nhds },
    rcases (this.eventually $ lt_mem_nhds $ ennreal.lt_add_right hfin ε0').exists with ⟨t, ht⟩,
    -- the approximating open set is constructed by taking for each `s n` an approximating open set
    -- `U n` with measure at most `μ (s n) + δ n` for a summable `δ`, and taking the union of these.
    refine ⟨⋃ k ∈ t, F k, Union_subset_Union $ λ k, Union_subset $ λ _, hFs _,
      ⋃ n, U n, Union_subset_Union hsU, is_closed_bUnion t.finite_to_set $ λ k _, hFc k,
      is_open_Union hUo, ht.le.trans _, _⟩,
    { calc ∑ k in t, μ (s k) + ε / 2 ≤ ∑ k in t, μ (F k) + ∑ k in t, δ k + ε / 2 :
        by { rw ← sum_add_distrib, exact add_le_add_right (sum_le_sum $ λ k hk, hF k) _ }
      ... ≤ ∑ k in t, μ (F k) + ε / 2 + ε / 2 :
        add_le_add_right (add_le_add_left ((ennreal.sum_le_tsum _).trans hδε.le) _) _
      ... = μ (⋃ k ∈ t, F k) + ε : _,
      rw [measure_bUnion_finset, add_assoc, ennreal.add_halves],
      exacts [λ k _ n _ hkn, (hsd k n hkn).mono (hFs k) (hFs n), λ k hk, (hFc k).measurable_set] },
    { calc μ (⋃ n, U n) ≤ ∑' n, μ (U n) : measure_Union_le _
      ... ≤ ∑' n, (μ (s n) + δ n) : ennreal.tsum_le_tsum hU
      ... = μ (⋃ n, s n) + ∑' n, δ n : by rw [measure_Union hsd hsm, ennreal.tsum_add]
      ... ≤ μ (⋃ n, s n) + ε : add_le_add_left (hδε.le.trans ennreal.half_le_self) _ } }
end

/-- In a metric space (or even a pseudo emetric space), an open set can be approximated from inside
by closed sets. -/
lemma of_pseudo_emetric_space {X : Type*} [pseudo_emetric_space X] [measurable_space X]
  [opens_measurable_space X] (μ : measure X) :
  inner_regular μ is_closed is_open :=
begin
  intros U hU r hr,
  rcases hU.exists_Union_is_closed with ⟨F, F_closed, -, rfl, F_mono⟩,
  rw measure_Union_eq_supr (λ n, (F_closed n).measurable_set) F_mono.directed_le at hr,
  rcases lt_supr_iff.1 hr with ⟨n, hn⟩,
  exact ⟨F n, subset_Union _ _, F_closed n, hn⟩
end

/-- In a `σ`-compact space, any closed set can be approximated by a compact subset. -/
lemma is_compact_is_closed {X : Type*} [topological_space X] [t2_space X]
  [sigma_compact_space X] [measurable_space X] [opens_measurable_space X] (μ : measure X) :
  inner_regular μ is_compact is_closed :=
begin
  intros F hF r hr,
  set B : ℕ → set X := compact_covering X,
  have hBc : ∀ n, is_compact (F ∩ B n), from λ n, (is_compact_compact_covering X n).inter_left hF,
  have hBU : (⋃ n, F ∩ B n) = F, by rw [← inter_Union, Union_compact_covering, set.inter_univ],
  have : μ F = ⨆ n, μ (F ∩ B n),
  { rw [← measure_Union_eq_supr, hBU],
    exacts [λ n, (hBc n).measurable_set, monotone.directed_le $
      λ m n h, inter_subset_inter_right _ (compact_covering_subset _ h)] },
  rw this at hr, rcases lt_supr_iff.1 hr with ⟨n, hn⟩,
  exact ⟨_, inter_subset_left _ _, hBc n, hn⟩
end

end inner_regular

namespace regular

instance zero : regular (0 : measure α) :=
⟨λ K hK, ennreal.coe_lt_top, λ U hU r hr, ⟨∅, empty_subset _, is_compact_empty, hr⟩⟩

/-- If `μ` is a regular measure, then any open set can be approximated by a compact subset. -/
lemma _root_.is_open.exists_lt_is_compact [regular μ] ⦃U : set α⦄ (hU : is_open U)
  {r : ℝ≥0∞} (hr : r < μ U) :
  ∃ K ⊆ U, is_compact K ∧ r < μ K :=
regular.inner_regular hU r hr

/-- The measure of an open set is the supremum of the measures of compact sets it contains. -/
lemma _root_.is_open.measure_eq_supr_is_compact ⦃U : set α⦄ (hU : is_open U)
  (μ : measure α) [regular μ] :
  μ U = (⨆ (K : set α) (h : K ⊆ U) (h2 : is_compact K), μ K) :=
regular.inner_regular.measure_eq_supr hU

lemma exists_compact_not_null [regular μ] : (∃ K, is_compact K ∧ μ K ≠ 0) ↔ μ ≠ 0 :=
by simp_rw [ne.def, ← measure_univ_eq_zero, is_open_univ.measure_eq_supr_is_compact,
    ennreal.supr_eq_zero, not_forall, exists_prop, subset_univ, true_and]

/-- If `μ` is a regular measure, then any measurable set of finite measure can be approximated by a
compact subset. See also `measurable_set.exists_is_compact_lt_add` and
`measurable_set.exists_lt_is_compact_of_ne_top`. -/
lemma inner_regular_measurable [opens_measurable_space α] [regular μ] :
  inner_regular μ is_compact (λ s, measurable_set s ∧ μ s ≠ ∞) :=
regular.inner_regular.measurable_set_of_open is_compact_empty (λ _ _, is_compact.diff)

/-- If `μ` is a regular measure, then any measurable set of finite measure can be approximated by a
compact subset. See also `measurable_set.exists_lt_is_compact_of_ne_top`. -/
lemma _root_.measurable_set.exists_is_compact_lt_add [opens_measurable_space α]
  [regular μ] ⦃A : set α⦄ (hA : measurable_set A) (h'A : μ A ≠ ∞) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
  ∃ K ⊆ A, is_compact K ∧ μ A < μ K + ε :=
regular.inner_regular_measurable.exists_subset_lt_add is_compact_empty ⟨hA, h'A⟩ h'A hε

/-- If `μ` is a regular measure, then any measurable set of finite measure can be approximated by a
compact subset. See also `measurable_set.exists_is_compact_lt_add` and
`measurable_set.exists_lt_is_compact_of_ne_top`. -/
lemma _root_.measurable_set.exists_is_compact_diff_lt [opens_measurable_space α] [t2_space α]
  [regular μ] ⦃A : set α⦄ (hA : measurable_set A) (h'A : μ A ≠ ∞) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
  ∃ K ⊆ A, is_compact K ∧ μ (A \ K) < ε :=
begin
  rcases hA.exists_is_compact_lt_add h'A hε with ⟨K, hKA, hKc, hK⟩,
  exact ⟨K, hKA, hKc, measure_diff_lt_of_lt_add hKc.measurable_set hA hKA
    (ne_top_of_le_ne_top h'A $ measure_mono hKA) hK⟩
end

/-- If `μ` is a regular measure, then any measurable set of finite measure can be approximated by a
compact subset. See also `measurable_set.exists_is_compact_lt_add`. -/
lemma _root_.measurable_set.exists_lt_is_compact_of_ne_top [regular μ]
  [opens_measurable_space α] ⦃A : set α⦄ (hA : measurable_set A) (h'A : μ A ≠ ∞)
  {r : ℝ≥0∞} (hr : r < μ A) :
  ∃ K ⊆ A, is_compact K ∧ r < μ K :=
regular.inner_regular_measurable ⟨hA, h'A⟩ _ hr

/-- Given a regular measure, any measurable set of finite mass can be approximated from
inside by compact sets. -/
lemma _root_.measurable_set.measure_eq_supr_is_compact_of_ne_top
  [opens_measurable_space α] [regular μ]
  ⦃A : set α⦄ (hA : measurable_set A) (h'A : μ A ≠ ∞) :
  μ A = (⨆ (K ⊆ A) (h : is_compact K), μ K) :=
regular.inner_regular_measurable.measure_eq_supr ⟨hA, h'A⟩

protected lemma map [opens_measurable_space α] [measurable_space β] [topological_space β]
  [t2_space β] [borel_space β] [regular μ] (f : α ≃ₜ β) :
  (measure.map f μ).regular :=
begin
  haveI := outer_regular.map f μ,
  split,
  { intros K hK, rw [map_apply f.measurable hK.measurable_set],
    apply regular.lt_top_of_is_compact,
    rwa f.compact_preimage },
  { exact regular.inner_regular.map f.to_equiv f.measurable (λ U hU, hU.preimage f.continuous)
      (λ K hK, hK.image f.continuous) (λ K hK, hK.measurable_set) (λ U hU, hU.measurable_set) }
end

protected lemma smul [regular μ] {x : ℝ≥0∞} (hx : x ≠ ∞) :
  (x • μ).regular :=
begin
  haveI := outer_regular.smul μ hx,
  exact ⟨λ K hK, ennreal.mul_lt_top hx (regular.lt_top_of_is_compact hK).ne,
    regular.inner_regular.smul x⟩
end

/-- A regular measure in a σ-compact space is σ-finite. -/
@[priority 100] -- see Note [lower instance priority]
instance sigma_finite [sigma_compact_space α] [regular μ] : sigma_finite μ :=
⟨⟨{ set := compact_covering α,
  set_mem := λ n, trivial,
  finite := λ n, regular.lt_top_of_is_compact $ is_compact_compact_covering α n,
  spanning := Union_compact_covering α }⟩⟩

end regular

namespace weakly_regular

/-- If `μ` is a weakly regular measure, then any open set can be approximated by a closed subset. -/
lemma _root_.is_open.exists_lt_is_closed [weakly_regular μ] ⦃U : set α⦄ (hU : is_open U)
  {r : ℝ≥0∞} (hr : r < μ U) :
  ∃ F ⊆ U, is_closed F ∧ r < μ F :=
weakly_regular.inner_regular hU r hr

/-- If `μ` is a weakly regular measure, then any open set can be approximated by a closed subset. -/
lemma _root_.is_open.measure_eq_supr_is_closed ⦃U : set α⦄ (hU : is_open U)
  (μ : measure α) [weakly_regular μ] :
  μ U = (⨆ (F ⊆ U) (h : is_closed F), μ F) :=
weakly_regular.inner_regular.measure_eq_supr hU

lemma inner_regular_measurable [opens_measurable_space α] [weakly_regular μ] :
  inner_regular μ is_closed (λ s, measurable_set s ∧ μ s ≠ ∞) :=
weakly_regular.inner_regular.measurable_set_of_open is_closed_empty
  (λ _ _ h₁ h₂, h₁.inter h₂.is_closed_compl)

/-- If `s` is a measurable set, a weakly regular measure `μ` is finite on `s`, and `ε` is a positive
number, then there exist a closed set `K ⊆ s` such that `μ s < μ K + ε`. -/
lemma _root_.measurable_set.exists_is_closed_lt_add [weakly_regular μ]
  [opens_measurable_space α] {s : set α} (hs : measurable_set s) (hμs : μ s ≠ ∞)
  {ε : ℝ≥0∞} (hε : ε ≠ 0) :
  ∃ K ⊆ s, is_closed K ∧ μ s < μ K + ε :=
inner_regular_measurable.exists_subset_lt_add is_closed_empty ⟨hs, hμs⟩ hμs hε

lemma _root_.measurable_set.exists_is_closed_diff_lt [opens_measurable_space α]
  [weakly_regular μ] ⦃A : set α⦄ (hA : measurable_set A) (h'A : μ A ≠ ∞) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
  ∃ F ⊆ A, is_closed F ∧ μ (A \ F) < ε :=
begin
  rcases hA.exists_is_closed_lt_add h'A hε with ⟨F, hFA, hFc, hF⟩,
  exact ⟨F, hFA, hFc, measure_diff_lt_of_lt_add hFc.measurable_set hA hFA
    (ne_top_of_le_ne_top h'A $ measure_mono hFA) hF⟩
end

/-- Given a weakly regular measure, any measurable set of finite mass can be approximated from
inside by closed sets. -/
lemma _root_.measurable_set.exists_lt_is_closed_of_ne_top [weakly_regular μ]
  [opens_measurable_space α] ⦃A : set α⦄ (hA : measurable_set A) (h'A : μ A ≠ ∞)
  {r : ℝ≥0∞} (hr : r < μ A) :
  ∃ K ⊆ A, is_closed K ∧ r < μ K :=
inner_regular_measurable ⟨hA, h'A⟩ _ hr

/-- Given a weakly regular measure, any measurable set of finite mass can be approximated from
inside by closed sets. -/
lemma _root_.measurable_set.measure_eq_supr_is_closed_of_ne_top [opens_measurable_space α]
  [weakly_regular μ] ⦃A : set α⦄ (hA : measurable_set A) (h'A : μ A ≠ ∞) :
  μ A = (⨆ (K ⊆ A) (h : is_closed K), μ K) :=
inner_regular_measurable.measure_eq_supr ⟨hA, h'A⟩

/-- The restriction of a weakly regular measure to a measurable set of finite measure is
weakly regular. -/
lemma restrict_of_measurable_set [borel_space α] [weakly_regular μ] (A : set α)
  (hA : measurable_set A) (h'A : μ A ≠ ∞) : weakly_regular (μ.restrict A) :=
begin
  haveI : fact (μ A < ∞) := ⟨h'A.lt_top⟩,
  refine inner_regular.weakly_regular_of_finite _ (λ V V_open, _),
  simp only [restrict_apply' hA], intros r hr,
  have : μ (V ∩ A) ≠ ∞, from ne_top_of_le_ne_top h'A (measure_mono $ inter_subset_right _ _),
  rcases (V_open.measurable_set.inter hA).exists_lt_is_closed_of_ne_top this hr
    with ⟨F, hFVA, hFc, hF⟩,
  refine ⟨F, hFVA.trans (inter_subset_left _ _), hFc, _⟩,
  rwa inter_eq_self_of_subset_left (hFVA.trans $ inter_subset_right _ _)
end

/-- Any finite measure on a metric space (or even a pseudo emetric space) is weakly regular. -/
@[priority 100] -- see Note [lower instance priority]
instance of_pseudo_emetric_space_of_is_finite_measure {X : Type*} [pseudo_emetric_space X]
  [measurable_space X] [borel_space X] (μ : measure X) [is_finite_measure μ] :
  weakly_regular μ :=
(inner_regular.of_pseudo_emetric_space μ).weakly_regular_of_finite μ

/-- Any locally finite measure on a `σ`-compact metric space (or even a pseudo emetric space) is
weakly regular. -/
@[priority 100] -- see Note [lower instance priority]
instance of_pseudo_emetric_sigma_compact_space_of_locally_finite {X : Type*}
  [pseudo_emetric_space X] [sigma_compact_space X] [measurable_space X] [borel_space X]
  (μ : measure X) [is_locally_finite_measure μ] :
  weakly_regular μ :=
begin
  haveI : outer_regular μ,
  { refine (μ.finite_spanning_sets_in_open.mono' $ λ U hU, _).outer_regular,
    haveI : fact (μ U < ∞), from ⟨hU.2⟩,
    exact ⟨hU.1, infer_instance⟩ },
  exact ⟨inner_regular.of_pseudo_emetric_space μ⟩
end

end weakly_regular

/-- Any locally finite measure on a `σ`-compact (e)metric space is regular. -/
@[priority 100] -- see Note [lower instance priority]
instance regular.of_sigma_compact_space_of_is_locally_finite_measure {X : Type*}
  [emetric_space X] [sigma_compact_space X] [measurable_space X] [borel_space X] (μ : measure X)
  [is_locally_finite_measure μ] : regular μ :=
{ lt_top_of_is_compact := λ K hK, hK.measure_lt_top,
  inner_regular := (inner_regular.is_compact_is_closed μ).trans
    (inner_regular.of_pseudo_emetric_space μ) }

end measure
end measure_theory


import analysis.real tactic.norm_num algebra.group_power

lemma avg_lt_max {mn mx: ℝ} (H : mn < mx) : (mn+mx) / 2 < mx :=
begin
  apply (mul_lt_mul_right (show (0:ℝ)<2, by norm_num)).1,
  rw [div_mul_cancel _ (two_ne_zero)],
  simp [H,mul_two],
end

lemma min_lt_avg {mn mx: ℝ} (H : mn < mx) : mn < (mn+mx) / 2 :=
begin
  apply (mul_lt_mul_right (show (0:ℝ)<2, by norm_num)).1,
  rw [div_mul_cancel _ (two_ne_zero)],
  simp [H,mul_two],
end

lemma lub_open (y : ℝ) : is_lub {x : ℝ | x < y} y :=
begin
split,
{ intro a,
  exact le_of_lt },
unfold lower_bounds,
intro b,
intro Hb,
refine le_of_not_gt _,
intro Hnb,
let c:=(b+y)/2,
unfold upper_bounds at Hb,
have H2 := Hb c,
clear Hb,
have H : c ∈ {x : ℝ | x < y},
{ exact avg_lt_max Hnb,
},
have Hcleb := H2 H,
have Hbltc : b < c := min_lt_avg Hnb,
exact not_lt.2 Hcleb Hbltc,
end

def S3a : set ℝ := {x : ℝ | x<0}

theorem Q3a : is_lub (S3a) 0 := lub_open 0

def S3b : set ℝ := {x : ℝ | ∃ y : ℚ, x = ↑y}

theorem Q3b : ∀ b : ℝ, ¬ (is_lub (S3b) b) :=
begin
intros b Hlub,
have Hbub : b ∈ upper_bounds S3b := Hlub.left,
have H : b < (b+1) := calc b = b+0 : (add_zero _).symm
                         ... < b+1 : add_lt_add_left zero_lt_one _,
--have H2 := exists_rat_btwn H,
--cases H2 with q Hq,
cases (exists_rat_btwn H) with q Hq,
have Hwrong := Hbub ↑q,
have Hqin : ↑q ∈ S3b := ⟨q,rfl⟩,
exact not_lt.2 (Hwrong Hqin) (Hq.left),
end

lemma pow_two_eq_mul_self {x : ℝ} : x^2=x*x :=
begin
unfold monoid.pow,simp,
end

def S3c : set ℝ := {x : ℝ | (x+1)^2 < x^2} -- x<-0.5

theorem Q3c : is_lub (S3c) (-1/2) :=
begin
have : S3c = {x : ℝ | x < -1/2},
{ apply set.ext,
  intro x,
  show (x+1)^2 < x^2 ↔ x < -1/2,
  rw [←add_zero (x^2),pow_two_eq_mul_self,mul_add,add_mul,add_mul,pow_two_eq_mul_self,mul_one,one_mul],
  rw [add_assoc],
  -- ask Mario why I can't do this -- I only want
  -- to change one thing
  exact calc
    x * x + (x + (x + 1 * 1)) < x * x + 0 ↔ (x + (x + 1 * 1)) < 0 : add_lt_add_iff_left (x*x)
    ... ↔ x * 2 + 1 < 0 : by rw [mul_one,←add_assoc,←mul_two]
    ... ↔ x * 2 < -1 : by rw[←lt_sub_right_iff_add_lt,zero_sub]
    ... ↔ x < (-1) / 2 : (lt_div_iff (show (0:ℝ) < 2, by norm_num)).symm },
rw this,
exact lub_open ((-1)/2),
end

def S3d : set ℝ := {x : ℝ | (∃ q : ℚ, x=↑q) ∧ 1 < x ∧ x < 2}

theorem Q3d : is_lub S3d 2 :=
begin
split,
{ intros z Hz,
  exact le_of_lt Hz.right.right },
intros y Hy,
refine le_of_not_gt _,
intro Hylt2,
have onelt2 : (1:ℝ) < 2 := by norm_num,
have := max_lt onelt2 Hylt2,
cases (exists_rat_btwn this) with q Hq,
have := Hy ↑q,
have Hq_in : ↑q ∈ S3d,
{ split,
  { existsi q,refl},
  split,
  { exact lt_of_le_of_lt (le_max_left _ _) Hq.left },
  exact Hq.right,
},
have this2 := this Hq_in,

unfold upper_bounds at Hy,
apply (not_lt.2 this2),
exact lt_of_le_of_lt (le_max_right 1 y) Hq.left,
end

theorem Q4 (S : set ℝ) (x : ℝ) (H1 : x ∈ upper_bounds S) (H2 : x ∈ S) : is_lub S x :=
begin
split,exact H1,
intro y,
intro H,
have := H x,
exact this H2,
end


-- begin header
import M40001.M40001_C1
import data.real.basic

namespace M40001

open function
universe u
-- end header

/- Section
Functions
-/

/- Sub-section
2.2.1 Function Composition
-/

/- Definition
Given two functions $f : A → B$, $g : B → C$ where $A, B, C$ are sets, then $(g ∘ f)(x)$ (the composition of $g$ and $f$) is $g(f(x))$.
-/
def my_composition {A B C : Type u} (f : A → B) (g : B → C) := λ x : A, g (f x)

/-
Remark. Here, to define $\tt{my\\_composition}$ we used something called lambda abstraction $\tt{λ x : A, g (f x)}$.
This is essentially saying we are mapping $\tt{x}$ with type $\tt{A}$ to $\tt{g(f(x))}$.
Read more about lambda abstraction here or here.
-/

/- Sub-section
2.3 Injectivity, Surjectivity and Bijectivity
-/

/- Definition
A function $f : X → Y$ is called injective if distinct elements of $X$ get mapped to distinct elements of $Y$. More formally, $f$ is injective if $∀ a, b ∈ X, f(a) = f(b) ⇒ a = b$.
-/
def my_injective {X Y : Type u} (f : X → Y) := ∀ a b : X, f(a) = f(b) → a = b

/- Definition
A function $f : X → Y$ is called surjective if every element of $Y$ gets "hit" by $f$. More formally, $f$ is surjective if $∀ y ∈ Y, ∃ x ∈ X$ such that $f(x) = y$.
-/
def my_surjective {X Y : Type u} (f : X → Y) := ∀ y : Y, ∃ x : X, f(x) = y

/- Definition
A function $f : X → Y$ is called bijective if it is both injective and surjective.
-/
def my_bijective {X Y : Type u} (f : X → Y) := injective f ∧ surjective f

/-
Remark. Although we have defined some lovely properties for our functions, it turns out that these definitions are already defined in the LEAN maths library.
So while our effort might be wasted, we can now use some theorems already written without going through them ourselves!
-/

/- Section
Bijectivity and Composition
-/

/-Theorem
Let $f : X → Y$ and $g : Y → Z$ be functions, then if $f$ and $g$ are both injective, then so is $g ∘ f$.
-/
theorem both_injective
    (X Y Z : Type u) (f : X → Y) (g : Y → Z) : injective f ∧ injective g → injective (g ∘ f) :=
begin
    -- Suppose that $f$ and $g$ are injective functions, we need to show that $g ∘ f$ is also injective, i.e. if $(g ∘ f)(a) = (g ∘ f)(b)$, then $a = b$.
    intros h a b ha,
    -- Since $g$ is injective, we have $f(a) = f(b)$.
    apply h.left,
    -- Similarly, since $f$ is injective, $a = b$, which is exactly what we wanted!
    apply h.right,
    assumption
end

/-
Remark. Notice that in step 2, LEAN knew that by definition, $(g ∘ f)(x) = g(f(x))$, so we have $g (f(a)) = g (f(b))$, how smart is that!
-/

/-Theorem
Let $f : X → Y$ and $g : Y → Z$ be functions, then if $f$ and $g$ are both surjective, then so is $g ∘ f$.
-/
theorem both_surjective
    (X Y Z : Type u) (f : X → Y) (g : Y → Z) : surjective f ∧ surjective g → surjective (g ∘ f) :=
begin
    -- Suppose that $f$ and $g$ are surjective functions, we need to show that $g ∘ f$ is also surjective, i.e. $∀ z ∈ Z, ∃ x ∈ X, (g ∘ f)(x) = z$.
    intros h z,
    -- Since $g$ is surjective, there is a $y ∈ Y$ such that $g(y) = z$.
    have ha : ∃ y : Y, g(y) = z, apply h.right,
    cases ha with y hy,
    -- Similarly, as $f$ is surjective, there is a $x ∈ X$ such that $f(x) = y$.
    have hb : ∃ x : X, f(x) = y, apply h.left,
    cases hb with x hx,
    -- But by definition, $(g ∘ f)(x) = g(f(x)) = g(y) = z$ So we are done!
    existsi x,
    rwa [←hy, ←hx]
end

/-Theorem
Let $f : X → Y$ and $g : Y → Z$ be functions, then if $f$ and $g$ are both bijective, then so is $g ∘ f$.
-/
theorem both_bijective
    (X Y Z : Type u) (f : X → Y) (g : Y → Z) : bijective f ∧ bijective g → bijective (g ∘ f) :=
begin
    -- Since $f$ and $g$ are bijective, they are also injective and surjective.
    rintro ⟨⟨hfi, hfs⟩, hgi, hgs⟩,
    split,
    -- But since $f$ and $g$ are injective, $g ∘ f$ is injective by our previous theorem.
    apply both_injective,
    split,
    repeat {assumption},
    -- Similarly, since $f$ and $g$ surjective, $g ∘ f$ is surjective.
    apply both_surjective,
    split,
    -- Hence, since $g ∘ f$ is injective and surjective, $g ∘ f$ is bijective.
    repeat {assumption}
end

/-Sub-section
2.4 Inverses
-/

/- Definition
By digging through $\tt{functions}$, it turns out that the brilliant people of LEAN has not yet defined two sided inverse as the time of writting this.
So let's define $g : Y → X$ to be the two sided inverse of $f : X → Y$ if and only if $∀ x ∈ X, (g ∘ f)(x) = x$ and $∀ y ∈ Y, (f ∘ g)(y) = y$.
-/
def two_sided_inverse {X Y : Type u} (f : X → Y) (g : Y → X) := (∀ x : X, (g ∘ f)(x) = x) ∧ (∀ y : Y, (f ∘ g)(y) = y)

/-Theorem
A function $f : X → Y$ has a two-sided inverse if and only if it is a bijection.
-/
theorem exist_two_sided_inverse
    (X Y : Type u) (f : X → Y) : (∃ g : Y → X, two_sided_inverse f g) ↔ bijective f :=
begin
    -- Again, since the question is in the form of 'if and only if', we need to prove both sides of the implications.
    split,
    -- $(⇒)$ Suppose the function $f : X → Y$ has a two sided inverse $g$, we need to show that $f$ is bijective, i.e. it is injective and surjective.
    rintro ⟨g, ⟨hlinv, hrinv⟩⟩,
    -- So lets first show that $f$ is injective.
    have hfinj : injective f,
    -- Suppose we have $f(p) = f(q)$ for some $p q ∈ X$, then $f$ is injective if $p = q$.
        intros p q hf,
    -- Since $f(p) = f(q)$, we have $g(f(p)) = g(f(q))$.
        replace hf : g (f p) = g (f q), rw hf,
    -- But since $g$ is a double sided inverse of $f$, $∀ x ∈ X, g(f(x)) = x$, hence $p = g(f(p))= g(f(q)) = q$ which is exactly what we need!
        have ha : g (f p) = p := hlinv p,
        have hb : g (f q) = q := hlinv q,
        rw [ha, hb] at hf,
        assumption,
    -- Now we need to show that $f$ is surjective, i.e. $∀ y ∈ Y, ∃ x ∈ X, f(x) = y$.
    have hfbsur : surjective f,
        intro y,
    -- Since we have $g(y) ∈ X$, suppose we choose $x$ to be $g(y)$.
        existsi g y,
    -- But, as $g$ is a double inverse of $f$, $f(g(y)) = y$ which is exactly what we need!
        exact hrinv y,
    -- Thus, as $f$ is both injective and surjective, $f$ is bijective!
    split,
    all_goals {try {assumption}},
    -- $(⇐)$ Now lets prove the reverse implication, i.e. if $f$ is bijective, then $f$ has a two-sided inverse.
    rintro ⟨hfinj, hfsur⟩,
    -- Since $f$ is surjective, $∀ y ∈ Y, ∃ x ∈ X$ such that $f(x) = y$, lets choose this $x$ to be our output of $g(y)$.
    choose g hg using hfsur,
    existsi g,
    -- Now we need to show that $g$ is a double sided inverse of $f$ so let's first show that $g$ is a left inverse of $f$.
    split,
    intro a,
    -- Consider that since, by definition of $g$, $∀ y ∈ Y, f(g(y)) = y$ we have $f(g(f(a))) = f(a)$,
    have ha : f (g (f a)) = f a,
        rw hg (f a),
    -- therefore, as $f$ is injective, we have $f(g(f(a))) = f(a) ⇒ g(f(a)) = f(a)$. Thus, $g$ is a left inverse of $f$.
    exact hfinj ha,
    -- Now, all we have left to prove is that $g$ is a right inverse of $f$. But that is true by definition, so we are done!
    assumption
end

/-Sub-section
2.5 Binary Relations
-/
variables {X V : Type u}

/- Definition
A binary relation $R$ on a set $X$ is a function $R : X^2 → \tt{Prop}$.
-/
def bin_rel (X) := X → X → Prop

/- Sub-section
2.6 Common Predicates on Binary Relations
-/

/- Definition
A binary relation $R$ on $X$ is called relfexive if $∀ x ∈ X, R(x, x)$.
-/
def reflexive (r : bin_rel X) := ∀ x : X, r x x

/- Theorem
$≤$ is reflexive on $ℝ$.
-/
@[simp] theorem le_refl : reflexive ((≤) : ℝ → ℝ → Prop) :=
begin
    -- To prove that the binary relation $≤$ on $ℝ$ is reflexive, we need to show given arbitary $x ∈ ℝ$, $x ≤ x$.
    intro,
    -- But this obviously true, so we're done!
    refl
end

/- Definition
A binary relation $R$ on $X$ is called symmetric if $∀a, b ∈ X, R(a, b) ⇒ R(b, a)$.
-/
def symmetric (r : bin_rel X) := ∀ x y : X, r x y → r y x

/- Theorem
$=$ is symmetric on $ℝ$.
-/
theorem eq_symm : symmetric ((=) : ℝ → ℝ → Prop) :=
begin
    -- To prove that $=$ is a symmetric binary relation on $ℝ$, we need to show that given $x = y$, $y = x$.
    intros x y h,
    -- But if $x = y$, then we can re-write $y$ as $x$ and $x$ as $y$, thus, $y = x$.
    rwa h
end

/- Definition
A binary relation $R$ on $X$ is called antisymmetric if $∀ a, b ∈ X, R(a, b) ∧ R(b, a) ⇒ a = b$.
-/
def antisymmetric (r : bin_rel X) := ∀ x y : X, r x y ∧ r y x → x = y

/- Theorem
$≤$ is anti-symmetric on $R$.
-/
@[simp] theorem le_antisymm : antisymmetric ((≤) : ℝ → ℝ → Prop) :=
begin
-- Suppose we have $x, y ∈ ℝ$ where $x ≤ y$ and $y ≤ x$, then we need to show that $x = y$.
    intros x y h,
    have h0 : (x < y ∨ x = y) ∧ (y < x ∨ y = x),
        repeat {rw ←le_iff_lt_or_eq}, assumption,
-- By the trichotomy axioms, either $x < y$, $y < x$ or $x = y$.
    cases lt_trichotomy x y with ha hb,
-- Let's first suppose that $x < y$, then obviously $¬ (y < x)$. But since we have $y ≤ x$, $x$ must therefore equal to $y$!
    {suffices : ¬ (y < x),
        cases h0.right with hc hd, contradiction, rwa hd,
    simp, from h.left},
    {cases hb with he hf,
-- Let's now consider the other two cases. If $x = y$ then there is nothing left to prove so lets suppose $y < x$.
    {assumption},
-- Similar to before, $(y < x) ⇒ ¬ (x < y)$. But $(x ≤ y)$, therefore $x = y$!
    {suffices : ¬ (x < y),
        cases h0.left with hc hd, contradiction, rwa hd,
    simp, from h.right}
    }
end

/-
Remark. Notice that in the above proof I used a lot of curly bracket. This will limit the tactic state to only show the the goal within the brackets and thus also limit clutter.
Read more about how to structure LEAN proofs nicely here.
-/

/- Definition
A binary relation $R$ on $X$ is called transitive if $∀ a, b, c ∈ X, R(a, b) ∧ R(b, c) ⇒ R(a, c)$.
-/
def transitive (r : bin_rel X) := ∀ x y z : X, r x y ∧ r y z → r x z

/- Theorem
$⇒$ is transitive on the set of propositions.
-/
theorem imply_trans : transitive ((→) : Prop → Prop → Prop) :=
begin
    -- Let $P, Q, R$ be propositions such that $P ⇒ Q$ and $Q ⇒ R$. We then need to prove that $P ⇒ R$. Suppose $P$ is true.
    intros P Q R h hp,
    -- Then as $P ⇒ Q$, $Q$ must also be true. And again as $Q ⇒ R$, $R$ must also be true. Thus $P ⇒ R$, and we are done!
    from h.right (h.left hp)
end

/- Theorem
$≤$ is transitive on $ℝ$.
-/
@[simp] theorem le_trans : transitive ((≤) : ℝ → ℝ → Prop) :=
begin
    -- This one is a bit tricky and require us to delve into how ordering is defined on the reals in LEAN.
    intros x y z h,
    -- However, with the power that is mathlib, we see that there is something called $\tt{le_trans}$, so why don't we just steal that for our use here!
    from le_trans h.left h.right
end

/- Sub-section
2.7 Partial and Total Orders
-/

/-
Let $R$ be a binary relation on the set $X$.
-/

/- Definition
We call $R$ a partial order if it is reflexive, antisymmetric, and transitive.
-/
def partial_order (r : bin_rel X) := reflexive r ∧ antisymmetric r ∧ transitive r

/- Definition
We call $R$ total if $∀ a, b ∈ X, R(a, b) ∨ R(b, a)$.
-/
def total (r : bin_rel X) := ∀ x y : X, r x y ∨ r y x

/- Definition
We call $R$ a total order if it is total and a partial order.
-/
def total_order (r : bin_rel X) := partial_order r ∧ total r

/-
Let's now prove that $≤$ is a total order. As we already have already proven that $≤$ is reflexive, symmetric, and transitive, i.e. its a partial order, we only need to show $≤$ is total to prove that $≤$ is a total order.
-/

/- Lemma
$≤$ is total on $ℝ$.
-/
@[simp] theorem le_total : total ((≤) : ℝ → ℝ → Prop) :=
begin
    -- Suppose we have $x, y ∈ ℝ$, by the trichotomy axiom, either $x < y$, $y < x$ or $x = y$.
    intros x y,
    cases lt_trichotomy x y,
    -- If $x < y$ then $x ≤ y$.
    repeat {rw le_iff_lt_or_eq},
    {left, left, assumption},
    -- If $x = y$ then also $x ≤ y$. However, if $y > x$, then we have $y ≤ x$. Thus, by considering all the cases, we see either $x ≤ y$ or $y ≤ x$.
    {cases h, repeat { {left, assumption} <|> right <|> assumption }, rwa h}
end

/-
Remark. The last line of this LEAN proof uses something called $\tt{tactic combinators}$. Read about is here.
-/

/- Theorem
$≤$ is a total order on $ℝ$.
-/
theorem le_total_order : total_order ((≤) : ℝ → ℝ → Prop) :=
begin
    -- As $≤$ is a partial order and is total, it is a total order!
    repeat {split},
    repeat {simp}
end

/-
Remark. Notice how I tagged some of the theorems above with $\tt{@[simp]}$? This tells LEAN to try to uses theses theorems whenever I use the tactive $\tt{simp}$. Read more about it here.
-/

/- Sub-section
2.7 Equivalence Relations
-/

/- Definition
A binary relation $R$ on the set $X$ is called an equivalence relation if it is reflexive, symmetric, and transitive.
-/
def equivalence (r : bin_rel X) := reflexive r ∧ symmetric r ∧ transitive r

/-
We'll present some examples of equivalence relations below.
-/

/- Definition
Suppose we define a binary relation $R(m, n)$, $m, n ∈ ℤ$, where $R(m, n)$ is true if and only if $m - n$ is even.
-/
def R (m n : ℤ) := 2 ∣ (m - n)

/- Lemma
(1) $R$ is reflexive.
-/
lemma R_refl : reflexive R :=
begin
    -- We have for any $m ∈ ℝ$, $m - m = 0$.
    intro,
    unfold R,
    -- As $2 ∣ 0$, we have $R(m, m)$ is true!
    simp,
end

/- Lemma
(2) $R$ is symmetric.
-/
lemma R_symm : symmetric R :=
begin
    -- Suppose we have $m, n ∈ ℝ$ such that $R(m, n)$ is true.
    intros m n,
    -- As $R(m, n)$ implies $2 ∣ m - n$, $∃ x ∈ ℤ, 2 x = m - n$.
    rintro ⟨x, hx⟩,
    existsi -x,
    -- But this means $2 (-x) = n - m$, i.e. $2 ∣ n - m$, thus $R(n, m)$ is also true!
    simp, rw ←hx, ring,
end

/- Lemma
(3) $R$ is transitive.
-/
lemma R_trans : transitive R :=
begin
    -- Suppose we have $l, m, n ∈ ℝ$ such that $R(m, l)$ and $R(l, n)$, we need to show $R(m, n)$ is true.
    intros l m n,
    -- Since $R(m, l)$ and $R(l, n)$ implies $2 ∣ m - l$ and $2 ∣ l - n$, $∃ x, y ∈ ℤ, 2 x = m - l, 2 y = l - n$.
    rintro ⟨⟨x, hx⟩, ⟨y, hy⟩⟩,
    existsi x + y,
    -- But then $2 (x + y) = 2 x + 2 y = m - l + l - n = m - n$. Thus $2 ∣ m - n$, i.e. $R(m, n)$.
    ring, rw [←hx, ←hy], ring,
end

/- Theorem
$R$ is an equivalence relation.
-/
theorem R_equiv : equivalence R :=
begin
    -- This follows directly from lemma (1), (2), and (3).
    repeat {split},
    {from R_refl},
    {from R_symm},
    {from R_trans}
end

/- Definition
Let $X$ be a set of sets, where $A, B ∈ X$. Let's define $<\mathtt{\sim}$ such that $A <~ B$ if an only if $∃ g: A → B$, $g$ is an injection.
-/
def brel (A B : Type*) := ∃ g : A → B, function.bijective g
infix ` <~ `: 50 := brel

/- Lemma
$<\mathtt{\sim}$ is reflexive.
-/
@[simp] lemma brel_refl : reflexive (<~) :=
begin
    -- To prove $<\mathtt{\sim}$ is reflexive we need to show there exists a bijection between a set $X$ and itself.
    intro X,
    -- Luckily, we can simply choose the identity function!
    let g : X → X := id,
    existsi g,
    -- Since the identity function is bijective, $<\mathtt{\sim}$ is reflexive as required.
    from function.bijective_id
end

/- Lemma
$<\mathtt{\sim}$ is symmetric.
-/
@[simp] lemma brel_symm : symmetric (<~) :=
begin
    -- To prove $<\mathtt{\sim}$ is symmetric we need to show that, for sets $X, Y$, $X <~ Y ⇒ Y <~ X$.
    intros X Y,
    -- Suppose $X <~ Y$, then by definition, $∃ f : X → Y$, where $f$ is bijective.
    rintro ⟨f, hf⟩,
    -- As proven ealier, $f$ is bijective implies $f$ has a two sided inverse $g$, let's choose that as our function.
    have hg : ∃ g : Y → X, two_sided_inverse f g,
        {rwa exist_two_sided_inverse
    },
    {cases hg with g hg,
    existsi g,
    -- Since $g$ is bijective if and only if $g$ has a two sided inverse, it suffices to prove that such an inverse exist.
    rw ←exist_two_sided_inverse,
    -- But as $g$ is the two sided inverse of $f$ by construction, we have $f$ is the two sided inverse of $g$ by definition, thus such an inverse does exist!
    existsi f,
    split,
    {from hg.right},
    {from hg.left}
    }
end

/- Lemma
$<\mathtt{\sim}$ is transitive.
-/
@[simp] lemma brel_trans : transitive (<~) :=
begin
    -- Given three sets $X, Y, Z$ where $X <~ Y$ and $Y <~ Z$ we need to show that $X <~ Z$.
    intros X Y Z,
    -- Since $X <~ Y$ and $Y <~ Z$ there exists bijective functions $f : X → Y$ and $g : Y → Z$.
    rintro ⟨⟨f, hf⟩, g, hg⟩,
    -- But as proven ealier, the composition of two bijective functions is also bijective. Thus, $g ∘ f : X → Z$ is a bijective function which is exactly what we need!
    existsi (g ∘ f),
    apply both_bijective,
    split, repeat {assumption}
end

/-
With that, we can conclude that $<\mathtt{\sim}$ is an equivalence relation!
-/

/- Theorem
$<\mathtt{\sim}$ is an equivalence relation
-/
theorem brel_equiv : equivalence (<~) :=
begin
    -- This follows as $<\mathtt{\sim}$ is reflexive, symmetric and transitive!
    repeat {split},
    repeat {simp}
end

/-
Exercise. I have defined one more binary relation $\mathtt{\sim}>$. Can you try to prove it here?
-/

/- Sub-section
2.9 Quotients and Equivalence Classes
-/

/- Sub-section
2.9.1 Equivalence Classes
-/

/- Definition
Let $X$ be a set and let $\mathtt{\sim}$ be an equivalence relation on $X$. Let $s ∈ X$ be an arbitrary element. We define the equivalence class of $s$, written $cl(s)$ as $cl(s) = \{x ∈ X ∣ s \mathtt{\sim} x\}.
-/
def cls (r : bin_rel X) (s : X) := {x : X | r s x}

/- Lemma
(1) Let $X$ be a set and let $R$ be an equivalence relation on $X$. Then, for $s, t ∈ X$, $R(s, t) ⇒ cl(t) ⊆ cl(s)$.
-/
lemma class_relate_lem_a
    (s t : X) (R : bin_rel X) (h : equivalence R) : R s t → cls R t ⊆ cls R s :=
begin
    -- Given that $R$ is an equivalence relation, we know that it is reflexive, symmetric and transitive.
    rcases h with ⟨href, ⟨hsym, htrans⟩⟩,
    -- Thus, given an element $x$ in $cl(t)$ (i.e. $R(t, x)$ is true), we have, by transitivit, $R(s, x)$.
    intros ha x hb,
    have hc : R t x := hb,
    replace hc : R s t ∧ R t x, by {split, repeat {assumption}},
    replace hc : R s x := htrans s t x hc,
    -- Hence $x ∈ cl(s)$ by definition.
    from hc
end

/-
With lemma (1) in place, it is quite easy to see that, not only is $cl(t) ⊆ cl(s)$, in fact, $cl(t) = cl(s)$.
-/

/- Lemma
(2) Let $X$ be a set and let $R$ be an equivalence relation on $X$. Then, for $s, t ∈ X$, $R(s, t) ⇒ cl(t) = cl(s)$.
-/
lemma class_relate_lem_b
    (s t : X) (R : bin_rel X) (h : equivalence R) : R s t → cls R t = cls R s :=
begin
    -- By lemma (1), $cl(t) ⊆ cl(s), and thus, we only need to prove that $cl(s) ⊆ cl(t)$ in order for $cl(t) = cl(s)$.
    intro h0,
    rw le_antisymm_iff,
    split,
        all_goals {apply class_relate_lem_a,
        repeat {assumption}
        },
    -- But, since $R$ is and equivalence relation, it is symmetric.
        {rcases h with ⟨href, ⟨hsym, htrans⟩⟩,
    -- Hence, $R(s, t) ↔ R(t, s)$ which by lemma (1) implies $cl(s) ⊆ cl(t)$ as required.
        from hsym s t h0
    }
end

/- Lemma
(3) Let $X$ be a set and let $R$ be an equivalence relation on $X$. Then, for $s, t ∈ X$, $¬ R(s, t) ⇒ cl(t) ∩ cl(s) = ∅$.
-/
lemma class_not_relate
    (s t : X) (R : bin_rel X) (h : equivalence R) : ¬ R s t → cls R t ∩ cls R s = ∅ :=
begin
    have : (cls R t ∩ cls R s = ∅) ↔ ¬ ¬ (cls R t ∩ cls R s = ∅), rwa classical.not_not, rw this,
    -- We prove by contradiction. Suppose $cl(t) ∩ cl(s) ≠ ∅$.
    intros ha hb,
    -- Then, there must be some $x$ in $cl(t) ∩ cl(s)$.
    have hx : ∃ x, x ∈ cls R t ∩ cls R s := set.ne_empty_iff_nonempty.1 hb,
    rcases hx with ⟨x, ⟨hα, hβ⟩⟩,
    -- Thus, by definition, $R(t, x)$ and $R(s, t)$ must both be true!
    rcases h with ⟨href, ⟨hsym, htrans⟩⟩,
    have hc : R s x ∧ R x t, by {split,
        from hβ,
        apply hsym, from hα},
    -- But this means $R(s, t)$ must also be true by transitivity, a contradiction to $¬ R(s, t)$!
    have hd : R s t, by {from htrans s x t hc},
    contradiction,
end

/-
We now formally define a partition of a set $X$
-/

/-
Partition of a set $X$ is a set $A$ of non-empty subsets of $X$ with the property that each element of $X$ is in exacctly one of the subsets.
-/
def partition (A : set (set X)) : Prop := (∀ x : X, (∃ B ∈ A, x ∈ B ∧ ∀ C ∈ A, x ∈ C → B = C)) ∧ ∅ ∉ A

lemma equiv_refl (R : bin_rel X) (h : equivalence R) (x : X): R x x :=
by {rcases h with ⟨href, ⟨hsym, htrans⟩⟩, from href x}

lemma equiv_symm (R : bin_rel X) (h : equivalence R) (x y : X): R x y ↔ R y x :=
by {rcases h with ⟨href, ⟨hsym, htrans⟩⟩, split, from hsym x y, from hsym y x}

lemma equiv_trans (R : bin_rel X) (h : equivalence R) (x y z : X): R x y ∧ R y z → R x z :=
by {rcases h with ⟨href, ⟨hsym, htrans⟩⟩, from htrans x y z}

lemma itself_in_cls (R : bin_rel X) (h : equivalence R) (x : X) : x ∈ cls R x :=
by {unfold cls, rw set.mem_set_of_eq, from equiv_refl R h x}

/- Theorem
Let $X$ be a set and let $R$ be an equivalence relation on $X$. Then the set $V$ of equivalence classes $\{cl(s) | s ∈ X\}$ for $R$ is a partition of $X$.
-/
theorem equiv_relation_partition -- or replace the set with (set.range (cls R))
    (R : bin_rel X) (h : equivalence R) : partition {a : set X | ∃ s : X, a = cls R s} :=
begin
    -- To show that the equivalence classes of $R$ form a partition of $X$, we need to show that every $x ∈ X$ is in exactly one equivalence class of $R$, AND, none of the equivalence classes are empty.
    split,
    -- So let's first show that every $x ∈ X$ is in exactly one equivalence class of $R$. Let $y$ be and element of $X$.
    {simp, intro y,
    existsi cls R y,
    split,
    -- Then obviously $y ∈ cl(y)$ since $R(y, y)$ is true by reflexivity.
    {use y},
        {split,
            {from itself_in_cls R h y},
    -- Okay. So now we need to prove uniqueness. Suppose there is a $x ∈ X$, $x ∈ cl(y)$, we then need to show $cl(y) = cl(x)$.
            {intros C x hC hy_in_C, rw hC,
    -- But this is true by lemma (2)!
            apply class_relate_lem_b, assumption,
            have : y ∈ cls R x, rwa ←hC,
            unfold cls at this,
            rwa set.mem_set_of_eq at this}
            }
        },
    -- Now we have to prove that none of the equivalence classes are empty. But this is quite simple. Suppose there is an equivalence class $cl(x)$ where $x ∈ X$ that is empty.
    {simp, intros x hx,
    -- But then $x ∈ cl(x)$ as $R(x, x)$ is true by reflexivity. Ah ha! Contradiction! Hence, such empty equivalence class does not in fact exist! And we are done.
    rw set.empty_def at hx,
    have : x ∈ {x : X | false}, by {rw hx, from itself_in_cls R h x},
    rwa set.mem_set_of_eq at this
    }
end

def rs (A : set (set(X))) (s t : X) := ∃ B ∈ A, s ∈ B ∧ t ∈ B

/-
Bonus Exercise. Furthermore, it turns out that if $X$ is a set and $R$ an equivalence relation on $X$. Then any partition of $X$ can form a equivalence relation. Try to prove it here and if you get stuck, here are the solutions.
-/

end M40001


import linear_algebra.finite_dimensional
import missing_mathlib.linear_algebra.dimension

universes u v v' w
open_locale classical

open vector_space cardinal submodule module function

variables {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V]
{V₂ : Type v'} [add_comm_group V₂] [vector_space K V₂]

namespace finite_dimensional

lemma findim_bot [finite_dimensional K V] :
  findim K (⊥ : submodule K V) = 0 :=
begin
  apply cardinal.nat_cast_inj.1,
  rw findim_eq_dim,
  rw dim_bot,
  refl,
end

lemma bot_of_findim_zero [finite_dimensional K V]
  (s : submodule K V) (h : findim K s = 0) : s = ⊥ :=
begin
  apply submodule.bot_of_dim_zero,
  rw ←findim_eq_dim,
  apply cardinal.nat_cast_inj.2 h,
end

@[simp] lemma findim_top [finite_dimensional K V] :
  findim K (⊤ : submodule K V) = findim K V :=
begin
  apply cardinal.nat_cast_inj.1,
  rw [findim_eq_dim, findim_eq_dim, dim_top]
end

lemma exists_mem_ne_zero_of_findim_pos
  [finite_dimensional K V] (h_dim : 0 < findim K V) : ∃ x : V, x ≠ 0 :=
begin
  apply @exists_mem_ne_zero_of_dim_pos' K V (by apply_instance),
  rw ←findim_eq_dim,
  rw ←cardinal.nat_cast_lt at h_dim,
  apply h_dim
end

lemma findim_sup_add_findim_inf_eq [finite_dimensional K V] (s t : submodule K V) :
  findim K (s ⊔ t : submodule K V) + findim K (s ⊓ t : submodule K V)
    = findim K s + findim K t :=
begin
  have := s.dim_sup_add_dim_inf_eq t,
  repeat { rw ←findim_eq_dim at this },
  exact this,
end

lemma eq_top_of_disjoint [finite_dimensional K V] (s t : submodule K V)
  (hdim : findim K s + findim K t = findim K V)
  (hdisjoint : disjoint s t) : s ⊔ t = ⊤ :=
begin
  have h_findim_inf : findim K ↥(s ⊓ t) = 0,
  { rw [disjoint, le_bot_iff] at hdisjoint,
    rw [hdisjoint, findim_bot] },
  apply eq_top_of_findim_eq,
  rw ←hdim,
  convert findim_sup_add_findim_inf_eq s t,
  rw h_findim_inf,
  refl,
end

lemma lt_omega_of_linear_independent {ι : Type w} [finite_dimensional K V]
  {v : ι → V} (h : linear_independent K v) :
  cardinal.mk ι < cardinal.omega :=
begin
  apply cardinal.lift_lt.1,
  apply lt_of_le_of_lt,
  apply linear_independent_le_dim h,
  rw [←findim_eq_dim, cardinal.lift_omega, cardinal.lift_nat_cast],
  apply cardinal.nat_lt_omega,
end

end finite_dimensional


namespace fol_17

-- Facts useful for calculation proofs:
#check @add_assoc
#check @add_comm
#check @add_zero
#check @zero_add
#check @mul_assoc
#check @mul_comm
#check @mul_one
#check @one_mul
#check @left_distrib
#check @right_distrib
#check @add_left_neg
#check @add_right_neg
#check @sub_eq_add_neg

variables x y z : int

-- Sub-example 1:
theorem t1 : x - x = 0 :=
calc
x - x   = x + -x : by rw sub_eq_add_neg
    ... = 0      : by rw add_right_neg

-- Sub-example 2:
theorem t2 (h : x + y = x + z) : y = z :=
calc
y       = 0 + y        : by rw zero_add
    ... = (-x + x) + y : by rw add_left_neg
    ... = -x + (x + y) : by rw add_assoc
    ... = -x + (x + z) : by rw h
    ... = (-x + x) + z : by rw add_assoc
    ... = 0 + z        : by rw add_left_neg
    ... = z            : by rw zero_add

theorem fol_17 (h : x + y = z + y) : x = z :=
calc
x       = x + 0        : by rw add_zero
    ... = x + (y + -y) : by rw add_right_neg
    ... = (x + y) + -y : by rw add_assoc
    ... = (z + y) + -y : by rw h
    ... = z + (y + -y) : by rw add_assoc
    ... = z + 0        : by rw add_right_neg
    ... = z            : by rw add_zero

end fol_17


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

! This file was ported from Lean 3 source module data.nat.gcd.big_operators
! leanprover-community/mathlib commit 008205aa645b3f194c1da47025c5f110c8406eab
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.GCD.Basic
import Mathlib.Algebra.BigOperators.Basic

/-! # Lemmas about coprimality with big products.

These lemmas are kept separate from `Data.Nat.GCD.Basic` in order to minimize imports.
-/

namespace Nat

open BigOperators

/-- See `IsCoprime.prod_left` for the corresponding lemma about `IsCoprime` -/
theorem coprime_prod_left {ι : Type _} {x : ℕ} {s : ι → ℕ} {t : Finset ι} :
    (∀ i : ι, i ∈ t → coprime (s i) x) → coprime (∏ i : ι in t, s i) x :=
  Finset.prod_induction s (fun y ↦ y.coprime x) (fun a b ↦ coprime.mul) (by simp)
#align nat.coprime_prod_left Nat.coprime_prod_left

/-- See `IsCoprime.prod_right` for the corresponding lemma about `IsCoprime` -/
theorem coprime_prod_right {ι : Type _} {x : ℕ} {s : ι → ℕ} {t : Finset ι} :
    (∀ i : ι, i ∈ t → coprime x (s i)) → coprime x (∏ i : ι in t, s i) :=
  Finset.prod_induction s (fun y ↦ x.coprime y) (fun a b ↦ coprime.mul_right) (by simp)
#align nat.coprime_prod_right Nat.coprime_prod_right

end Nat


import data.nat.basic
import tactic

def fibo : ℕ → ℕ
| 0 := 0
| 1 := 1
| (n+2) := (fibo (n+1)) + (fibo n)

#eval fibo 5

def ff : ℕ → (ℕ × ℕ)
| 0 := (0, 1)
| (n+1) := let a := (ff n) in (a.2, a.1 + a.2)

def fibo_fast : ℕ → ℕ
| 0 := 0
| (n+1) := (ff n).2

#eval fibo_fast 5

private lemma fibo_ff_aux (n : ℕ) : (ff n) = (fibo n, fibo n.succ)
  :=
begin
  induction n with n ih,
    refl,

    unfold fibo,
    have unfolding_ff: (ff n.succ) = ((ff n).2, (ff n).1 + (ff n).2),
      refl,
    rw unfolding_ff,
    rw ih,
    simp,
    apply add_comm,
end

lemma fibo_eq : ∀ n : ℕ, fibo n = fibo_fast n
  :=
begin
  intro n,
  cases n,
    refl,

    unfold fibo_fast,
    rw fibo_ff_aux,
end


import data.real.basic

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

variables {s t : ℕ → ℝ} {a b c: ℝ}

theorem converges_to_ze
  (cs : converges_to (abs s) 0): converges_to (λ n, s n ) (0) :=
begin
intros ε εpos, --Introduce the hypotheses ε:ℝ and εpos:ε>0
dsimp,
cases cs _ εpos with h₁ h₂,
use h₁,
intros n h₃,
specialize @h₂ n h₃,
rw sub_zero,
rw sub_zero at h₂,
apply lt_of_abs_lt h₂,
end

theorem squeeze (cs :converges_to s 0)
(h₁: ∀ (e:ℕ), (abs t e) < s e ): converges_to (λ n, t n) (0):=
begin
intros ε εpos,
dsimp,
cases cs ε εpos with h₂ h₃,
use h₂,
intros n h₄,
specialize @h₃ n h₄,
rw sub_zero,
rw sub_zero at h₃,
specialize @h₁ n,
have h₅: s n ≤  |s n|,
exact le_abs_self (s n),
apply lt_trans (lt_of_lt_of_le h₁ h₆) h₃,
end

theorem conv_inv (cs : converges_to s a) (h₁: a ≠ 0) (h₂: ∀(m:ℕ), s m ≠ 0) : converges_to(λ n, 1/(s n))(1/a):=
begin
intros ε εpos,
have inv_εpos: 1/ε > 0,
finish,
dsimp,
cases cs (1/ε) inv_εpos with N h₃,
use N,
intro n,
intro h₄,
specialize @h₃ n h₄,
sorry,

end


/-
This file contains the definition of the "explode" operation, which
creates a "powerset" of literals from a list of variables. Associated
theorems dealing with the contents of explode are also included.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import cnf.literal
import cnf.clause
import cnf.cnf

import data.nat.basic
import data.nat.pow

-- Represents the parametric type of the variable stored in the literal
variables {V : Type*}

open literal clause
open list function

namespace explode

variables {v : V} {l : list V} {c : clause V}

/-! # Explode -/

-- Produces a list of all possible polarities on a list of variables, maintaining order
def explode : list V → list (clause V)
| []        := [[]]
| (v :: l) := (explode l).map (cons (Pos v)) ++ (explode l).map (cons (Neg v))

@[simp] theorem explode_nil : explode ([] : list V) = [[]] := rfl

@[simp] theorem explode_singleton (v : V) : explode [v] = [[Pos v], [Neg v]] := rfl

theorem length_explode (l : list V) : length (explode l) = 2^(length l) :=
begin
  induction l with v vs ih,
  { refl },
  { simp only [explode, length_cons, length_append, length_map, pow_succ, two_mul, ih] }
end

theorem length_explode_pos (l : list V) : length (explode l) > 0 :=
by { rw length_explode, exact pow_pos zero_lt_two _ }

theorem exists_mem_explode (l : list V) : ∃ (c : clause V), c ∈ explode l :=
exists_mem_of_length_pos (length_explode_pos _)

theorem length_eq_of_mem_explode : c ∈ explode l → length c = length l :=
begin
  induction l with v vs ih generalizing c,
  { rw [explode_nil, mem_singleton],
    rintro rfl, refl },
  { simp only [explode, mem_append, mem_map],
    rintros (⟨c, hc, rfl⟩ | ⟨c, hc, rfl⟩);
    { simp [ih hc, length_cons] } }
end

theorem cons_mem_explode_cons_of_mem_explode (lit : literal V) :
  c ∈ explode l → (lit :: c) ∈ explode (lit.var :: l) :=
assume hc, by { cases lit; simp [explode, literal.var, hc] }

variable [decidable_eq V]

theorem mem_of_mem_explode_of_mem_vars : c ∈ explode l → v ∈ c.vars → v ∈ l :=
begin
  induction l with v vs ih generalizing c,
  { rw [explode_nil, mem_singleton],
    rintros rfl hv,
    rw clause.vars_nil at hv,
    exact absurd hv (finset.not_mem_empty _) },
  { simp only [explode, mem_append, mem_map],
    rintros (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩);
    { rw [clause.vars, finset.mem_union, mem_cons_iff],
      rintros (hv | hv),
      { rw [var, finset.mem_singleton] at hv,
        exact or.inl hv },
      { exact or.inr (ih ha hv) } } }
end

theorem mem_vars_of_mem_explode_of_mem : c ∈ explode l → v ∈ l → v ∈ c.vars :=
begin
  induction l with v vs ih generalizing c,
  { intros _ hv, exact absurd hv (not_mem_nil v) } ,
  { simp only [explode, mem_append, mem_map],
    rintros (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) hv;
    { unfold clause.vars var,
      rcases eq_or_mem_of_mem_cons hv with rfl | hv,
      { exact finset.mem_union.mpr (or.inl (mem_singleton_self _)) },
      { exact finset.mem_union.mpr (or.inr (ih ha hv)) } } }
end

theorem not_mem_vars_of_mem_explode_of_not_mem : c ∈ explode l → v ∉ l → v ∉ c.vars :=
λ h hv, mt (mem_of_mem_explode_of_mem_vars h) hv

theorem not_mem_of_mem_explode_of_not_mem_vars : c ∈ explode l → v ∉ c.vars → v ∉ l :=
λ h hv, mt (mem_vars_of_mem_explode_of_mem h) hv

theorem pos_or_neg_of_mem_explode_of_mem : c ∈ explode l → v ∈ l → Pos v ∈ c ∨ Neg v ∈ c :=
λ h hv, mem_vars_iff_pos_or_neg_mem_clause.mp (mem_vars_of_mem_explode_of_mem h hv)

theorem pos_and_neg_not_mem_of_mem_explode_of_not_mem : c ∈ explode l → v ∉ l → Pos v ∉ c ∧ Neg v ∉ c :=
begin
  intro h,
  contrapose,
  rw not_and_distrib,
  simp only [not_not],
  intro hv,
  exact mem_of_mem_explode_of_mem_vars h
    (mem_vars_iff_pos_or_neg_mem_clause.mpr hv)
end

-- If the variables in a clause match the input to explode, then it's in explode
theorem map_var_eq_iff_mem_explode : c.map var = l ↔ c ∈ explode l :=
begin
  induction l with v vs ih generalizing c,
  { simp only [map_eq_nil, explode_nil, mem_singleton] },
  { split,
    { intro h,
      rcases exists_cons_of_map_cons h with ⟨l, ls, rfl, hl, hls⟩,
      cases l; simp only [explode, mem_append, mem_map],
      { rw var at hl, subst hl, left, use [ls, ih.mp hls] },
      { rw var at hl, subst hl, right, use [ls, ih.mp hls] } },
    { simp only [explode, mem_map, mem_append],
      rintros (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩);
      { simp only [ih.mpr ha, var, map, eq_self_iff_true, and_self] } } }
end

/-! # nodup properties of explode -/

theorem explode_nodup (l : list V) : nodup (explode l) :=
begin
  induction l with v vs ih,
  { rw explode_nil, exact nodup_singleton nil },
  { simp only [explode, nodup_cons, nodup_append, (nodup_map_iff (cons_injective)).mpr ih, true_and],
    intros x hxp hxn,
    rcases mem_map.mp hxp with ⟨c, _, rfl⟩,
    rcases mem_map.mp hxn with ⟨d, _, h⟩,
    have := head_eq_of_cons_eq h,
    contradiction }
end

theorem nodup_of_nodup_of_mem (h : nodup l) : c ∈ explode l → nodup c :=
begin
  induction l with n ns ih generalizing c,
  { rw [explode_nil, mem_singleton], rintro rfl, exact nodup_nil },
  { simp only [explode, mem_append, mem_map],
    rintro (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩);
    rw nodup_cons;
    have := pos_and_neg_not_mem_of_mem_explode_of_not_mem ha ((nodup_cons.mp h).1),
    { exact ⟨this.1, ih (nodup_cons.mp h).2 ha⟩ },
    { exact ⟨this.2, ih (nodup_cons.mp h).2 ha⟩ } }
end

theorem xor_pos_neg_mem_clause_of_nodup_of_mem_explode_of_mem (h : nodup l) :
  c ∈ explode l → v ∈ l → xor (Pos v ∈ c) (Neg v ∈ c) :=
begin
  induction l with v vs ih generalizing c,
  { intros _ h, exact absurd h (not_mem_nil _) },
  { simp only [explode, mem_append, mem_map],
    rintros (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) hc;
    { rcases eq_or_mem_of_mem_cons hc with (rfl | hv),
      { simp [pos_and_neg_not_mem_of_mem_explode_of_not_mem ha (nodup_cons.mp h).1] },
      { rcases ih (nodup_cons.mp h).2 ha hv with ⟨hp, hn⟩ | ⟨hp, hn⟩;
        { simp [hp, hn, ne_of_mem_of_not_mem hv (nodup_cons.mp h).1] } } } }
end

end explode


-- Conectivas y desigualdades
-- ==========================

-- En esta relación se formulan algunas de las
-- anteriores propiedades de las desigualdades de los
-- números reales formuladas con conectivas.

import data.real.basic

variables (a b c : ℝ)

-- Ej1. Demostrar que
--    0 ≤ a → b ≤ a + b

-- 1ª demostración
-- ===============

example : 0 ≤ a → b ≤ a + b :=
begin
  intro ha,
  exact le_add_of_nonneg_left ha,
end

-- 2ª demostración
-- ===============

example : 0 ≤ a → b ≤ a + b :=
le_add_of_nonneg_left

-- 3ª demostración
-- ===============

example : 0 ≤ a → b ≤ a + b :=
by finish

-- Ej2. Demostrar que
--    0 ≤ b → a ≤ a + b

-- 1ª demostración
-- ===============

example: 0 ≤ b → a ≤ a + b :=
begin
  intro hb,
  exact le_add_of_nonneg_right hb,
end

-- 2ª demostración
-- ===============

example: 0 ≤ b → a ≤ a + b :=
le_add_of_nonneg_right

-- 3ª demostración
-- ===============

example: 0 ≤ b → a ≤ a + b :=
by finish

-- Ej3. Demostrar que
--    (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b

-- 1ª demostración
-- ===============

example : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b :=
begin
  intros hab,
  cases hab with ha hb,
  exact add_nonneg ha hb,
end

-- 2ª demostración
-- ===============

example : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b :=
begin
  rintros ⟨ha, hb⟩,
  exact add_nonneg ha hb,
end

-- 3ª demostración
-- ===============

example : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b :=
λ ⟨ha, hb⟩, add_nonneg ha hb

-- Ej4. Demostrar que
--    0 ≤ a → (0 ≤ b → 0 ≤ a + b)

-- 1ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intro ha,
  intro hb,
  exact add_nonneg ha hb,
end

-- 2ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha hb,
  exact add_nonneg ha hb,
end

-- 3ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
λ ha hb, add_nonneg ha hb

-- 4ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
add_nonneg

-- 5ª demostración
-- ===============

example : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
by intros ; linarith

-- Ej5. Demostrar que si
--   (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b
-- entonces
--   0 ≤ a → (0 ≤ b → 0 ≤ a + b)

-- 1ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intro ha,
  intro hb,
  apply H,
  split,
  { exact ha, },
  { exact hb, },
end

-- 2ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha hb,
  apply H,
  split,
  { exact ha, },
  { exact hb, },
end

-- 3ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha hb,
  exact H ⟨ha, hb⟩,
end

-- 4ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
λ ha hb, H ⟨ha, hb⟩

-- 5ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
by tauto

-- 6ª demostración
-- ===============

example
  (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b)
  : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
by finish


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Chris Hughes, Floris van Doorn, Yaël Dillies
-/
import data.nat.basic
import data.nat.pow

/-!
# Factorial and variants

This file defines the factorial, along with the ascending and descending variants.

## Main declarations

* `nat.factorial`: The factorial.
* `nat.asc_factorial`: The ascending factorial. Note that it runs from `n + 1` to `n + k`
  and *not* from `n` to `n + k - 1`. We might want to change that in the future.
* `nat.desc_factorial`: The descending factorial. It runs from `n - k` to `n`.
-/

namespace nat

/-- `nat.factorial n` is the factorial of `n`. -/
@[simp] def factorial : ℕ → ℕ
| 0        := 1
| (succ n) := succ n * factorial n

localized "notation n `!`:10000 := nat.factorial n" in nat

section factorial

variables {m n : ℕ}

@[simp] theorem factorial_zero : 0! = 1 := rfl

@[simp] theorem factorial_succ (n : ℕ) : n.succ! = (n + 1) * n! := rfl

@[simp] theorem factorial_one : 1! = 1 := rfl

@[simp] theorem factorial_two : 2! = 2 := rfl

theorem mul_factorial_pred (hn : 0 < n) : n * (n - 1)! = n! :=
tsub_add_cancel_of_le (nat.succ_le_of_lt hn) ▸ rfl

theorem factorial_pos : ∀ n, 0 < n!
| 0        := zero_lt_one
| (succ n) := mul_pos (succ_pos _) (factorial_pos n)

theorem factorial_ne_zero (n : ℕ) : n! ≠ 0 := ne_of_gt (factorial_pos _)

theorem factorial_dvd_factorial {m n} (h : m ≤ n) : m! ∣ n! :=
begin
  induction n with n IH,
  { simp [nat.eq_zero_of_le_zero h] },
  obtain rfl | hl := h.eq_or_lt,
  { simp },
  exact (IH (le_of_lt_succ hl)).mul_left _,
end

theorem dvd_factorial : ∀ {m n}, 0 < m → m ≤ n → m ∣ n!
| (succ m) n _ h := dvd_of_mul_right_dvd (factorial_dvd_factorial h)

@[mono] theorem factorial_le {m n} (h : m ≤ n) : m! ≤ n! :=
le_of_dvd (factorial_pos _) (factorial_dvd_factorial h)

lemma factorial_mul_pow_le_factorial : ∀ {m n : ℕ}, m! * m.succ ^ n ≤ (m + n)!
| m 0     := by simp
| m (n+1) :=
by  rw [← add_assoc, nat.factorial_succ, mul_comm (nat.succ _), pow_succ', ← mul_assoc];
  exact mul_le_mul factorial_mul_pow_le_factorial
    (nat.succ_le_succ (nat.le_add_right _ _)) (nat.zero_le _) (nat.zero_le _)

lemma monotone_factorial : monotone factorial := λ n m, factorial_le

lemma one_lt_factorial : 1 < n! ↔ 1 < n :=
factorial_lt one_pos

lemma factorial_eq_one : n! = 1 ↔ n ≤ 1 :=
begin
  refine ⟨λ h, _, by rintro (_ | ⟨_, _ | _⟩); refl⟩,
  rw [← not_lt, ← one_lt_factorial, h],
  apply lt_irrefl
end

lemma factorial_inj (hn : 1 < n!) : n! = m! ↔ n = m :=
begin
  refine ⟨λ h, _, congr_arg _⟩,
  obtain hnm | rfl | hnm := lt_trichotomy n m,
  { rw [← factorial_lt $ pos_of_gt $ one_lt_factorial.mp hn, h] at hnm,
    cases lt_irrefl _ hnm },
  { refl },
  rw [h, one_lt_factorial] at hn,
  rw [←factorial_lt (lt_trans one_pos hn), h] at hnm,
  cases lt_irrefl _ hnm
end

lemma self_le_factorial : ∀ n : ℕ, n ≤ n!
| 0       := zero_le_one
| (k + 1) := le_mul_of_one_le_right k.zero_lt_succ.le (nat.one_le_of_lt $ nat.factorial_pos _)

lemma lt_factorial_self {n : ℕ} (hi : 3 ≤ n) : n < n! :=
begin
  rw [← succ_pred_eq_of_pos ((zero_lt_two.trans (lt.base 2)).trans_le hi), factorial_succ],
  exact lt_mul_of_one_lt_right ((pred n).succ_pos) ((one_lt_two.trans_le
    (le_pred_of_lt (succ_le_iff.mp hi))).trans_le (self_le_factorial _)),
end

lemma add_factorial_succ_lt_factorial_add_succ {i : ℕ} (n : ℕ) (hi : 2 ≤ i) :
  i + (n + 1)! < (i + n + 1)! :=
begin
  rw [factorial_succ (i + _), add_mul, one_mul],
  have : i ≤ i + n := le.intro rfl,
  exact add_lt_add_of_lt_of_le (this.trans_lt ((lt_mul_iff_one_lt_right (zero_lt_two.trans_le
    (hi.trans this))).mpr (lt_iff_le_and_ne.mpr ⟨(i + n).factorial_pos, λ g,
    nat.not_succ_le_self 1 ((hi.trans this).trans (factorial_eq_one.mp g.symm))⟩))) (factorial_le
    ((le_of_eq (add_comm n 1)).trans ((add_le_add_iff_right n).mpr (one_le_two.trans hi)))),
end

lemma add_factorial_lt_factorial_add {i n : ℕ} (hi : 2 ≤ i) (hn : 1 ≤ n) :
  i + n! < (i + n)! :=
begin
  cases hn,
  { rw factorial_one,
    exact lt_factorial_self (succ_le_succ hi) },
  exact add_factorial_succ_lt_factorial_add_succ _ hi,
end

lemma add_factorial_succ_le_factorial_add_succ (i : ℕ) (n : ℕ) :
  i + (n + 1)! ≤ (i + (n + 1))! :=
begin
  obtain i2 | (_ | ⟨_, i0⟩) := le_or_lt 2 i,
  { exact (n.add_factorial_succ_lt_factorial_add_succ i2).le },
  { rw [←add_assoc, factorial_succ (1 + n), add_mul, one_mul, add_comm 1 n],
    exact (add_le_add_iff_right _).mpr (one_le_mul (nat.le_add_left 1 n) (n + 1).factorial_pos) },
  rw [nat.le_zero_iff.mp (nat.succ_le_succ_iff.mp i0), zero_add, zero_add]
end

lemma add_factorial_le_factorial_add (i : ℕ) {n : ℕ} (n1 : 1 ≤ n) :
  i + n! ≤ (i + n)! :=
begin
  cases n1 with h,
  { exact self_le_factorial _ },
  exact add_factorial_succ_le_factorial_add_succ i h,
end

lemma factorial_mul_pow_sub_le_factorial {n m : ℕ} (hnm : n ≤ m) : n! * n ^ (m - n) ≤ m! :=
begin
  suffices : n! * (n + 1) ^ (m - n) ≤ m!,
  { apply trans _ this,
    rw mul_le_mul_left,
    apply pow_le_pow_of_le_left (zero_le n) (le_succ n),
    exact factorial_pos n },
  convert nat.factorial_mul_pow_le_factorial,
  exact (add_tsub_cancel_of_le hnm).symm,
end

end factorial

/-! ### Ascending and descending factorials -/

section asc_factorial

/-- `n.asc_factorial k = (n + k)! / n!` (as seen in `nat.asc_factorial_eq_div`), but implemented
recursively to allow for "quick" computation when using `norm_num`. This is closely related to
`pochhammer`, but much less general. -/
def asc_factorial (n : ℕ) : ℕ → ℕ
| 0 := 1
| (k + 1) := (n + k + 1) * asc_factorial k

@[simp] lemma asc_factorial_zero (n : ℕ) : n.asc_factorial 0 = 1 := rfl

@[simp] lemma zero_asc_factorial (k : ℕ) : (0 : ℕ).asc_factorial k = k! :=
begin
  induction k with t ht,
  { refl },
  rw [asc_factorial, ht, zero_add, nat.factorial_succ],
end

lemma asc_factorial_succ {n k : ℕ} : n.asc_factorial k.succ = (n + k + 1) * n.asc_factorial k := rfl

lemma succ_asc_factorial (n : ℕ) :
  ∀ k, (n + 1) * n.succ.asc_factorial k = (n + k + 1) * n.asc_factorial k
| 0 := by rw [add_zero, asc_factorial_zero, asc_factorial_zero]
| (k + 1) := by rw [asc_factorial, mul_left_comm, succ_asc_factorial, asc_factorial, succ_add,
  ←add_assoc]

/-- `n.asc_factorial k = (n + k)! / n!` but without ℕ-division. See `nat.asc_factorial_eq_div` for
the version with ℕ-division. -/
theorem factorial_mul_asc_factorial (n : ℕ) : ∀ k, n! * n.asc_factorial k = (n + k)!
| 0 := by rw [asc_factorial, add_zero, mul_one]
| (k + 1) := by rw [asc_factorial_succ, mul_left_comm, factorial_mul_asc_factorial, ← add_assoc,
  factorial]

/-- Avoid in favor of `nat.factorial_mul_asc_factorial` if you can. ℕ-division isn't worth it. -/
lemma asc_factorial_eq_div (n k : ℕ) : n.asc_factorial k = (n + k)! / n! :=
begin
  apply mul_left_cancel₀ n.factorial_ne_zero,
  rw factorial_mul_asc_factorial,
  exact (nat.mul_div_cancel' $ factorial_dvd_factorial $ le.intro rfl).symm
end

lemma asc_factorial_of_sub {n k : ℕ} (h : k < n) :
  (n - k) * (n - k).asc_factorial k = (n - (k + 1)).asc_factorial (k + 1) :=
begin
  set t := n - k.succ with ht,
  suffices h' : n - k = t.succ, by rw [←ht, h', succ_asc_factorial, asc_factorial_succ],
  rw [ht, succ_eq_add_one, ←tsub_tsub_assoc (succ_le_of_lt h) (succ_pos _), succ_sub_one],
end

lemma pow_succ_le_asc_factorial (n : ℕ) : ∀ (k : ℕ), (n + 1)^k ≤ n.asc_factorial k
| 0 := by rw [asc_factorial_zero, pow_zero]
| (k + 1) := begin
  rw pow_succ,
  exact nat.mul_le_mul (nat.add_le_add_right le_self_add _) (pow_succ_le_asc_factorial k),
end

lemma pow_lt_asc_factorial' (n k : ℕ) : (n + 1)^(k + 2) < n.asc_factorial (k + 2) :=
begin
  rw pow_succ,
  exact nat.mul_lt_mul (nat.add_lt_add_right (nat.lt_add_of_pos_right succ_pos') 1)
    (pow_succ_le_asc_factorial n _) (pow_pos succ_pos' _),
end

lemma pow_lt_asc_factorial (n : ℕ) : ∀ {k : ℕ}, 2 ≤ k → (n + 1)^k < n.asc_factorial k
| 0 := by rintro ⟨⟩
| 1 := by rintro (_ | ⟨_, ⟨⟩⟩)
| (k + 2) := λ _, pow_lt_asc_factorial' n k

lemma asc_factorial_le_pow_add (n : ℕ) : ∀ (k : ℕ), n.asc_factorial k ≤ (n + k)^k
| 0 := by rw [asc_factorial_zero, pow_zero]
| (k + 1) := begin
  rw [asc_factorial_succ, pow_succ],
  exact nat.mul_le_mul_of_nonneg_left ((asc_factorial_le_pow_add k).trans (nat.pow_le_pow_of_le_left
  (le_succ _) _)),
end

lemma asc_factorial_lt_pow_add (n : ℕ) : ∀ {k : ℕ}, 2 ≤ k → n.asc_factorial k < (n + k)^k
| 0 := by rintro ⟨⟩
| 1 := by rintro (_ | ⟨_, ⟨⟩⟩)
| (k + 2) := λ _, begin
  rw [asc_factorial_succ, pow_succ],
  refine nat.mul_lt_mul' le_rfl ((asc_factorial_le_pow_add n _).trans_lt
    (pow_lt_pow_of_lt_left (lt_add_one _) (succ_pos _))) (succ_pos _),
end

lemma asc_factorial_pos (n k : ℕ) : 0 < n.asc_factorial k :=
(pow_pos (succ_pos n) k).trans_le (pow_succ_le_asc_factorial n k)

end asc_factorial

section desc_factorial

/-- `n.desc_factorial k = n! / (n - k)!` (as seen in `nat.desc_factorial_eq_div`), but
implemented recursively to allow for "quick" computation when using `norm_num`. This is closely
related to `pochhammer`, but much less general. -/
def desc_factorial (n : ℕ) : ℕ → ℕ
| 0 := 1
| (k + 1) := (n - k) * desc_factorial k

@[simp] lemma desc_factorial_zero (n : ℕ) : n.desc_factorial 0 = 1 := rfl

@[simp] lemma desc_factorial_succ (n k : ℕ) :
  n.desc_factorial k.succ = (n - k) * n.desc_factorial k := rfl

lemma zero_desc_factorial_succ (k : ℕ) :
  (0 : ℕ).desc_factorial k.succ = 0 :=
by rw [desc_factorial_succ, zero_tsub, zero_mul]

@[simp] lemma desc_factorial_one (n : ℕ) :
  n.desc_factorial 1 = n :=
by rw [desc_factorial_succ, desc_factorial_zero, mul_one, tsub_zero]

@[simp] lemma succ_desc_factorial_succ (n : ℕ) :
  ∀ k : ℕ, (n + 1).desc_factorial (k + 1) = (n + 1) * n.desc_factorial k
| 0        := by rw [desc_factorial_zero, desc_factorial_one, mul_one]
| (succ k) := by rw [desc_factorial_succ, succ_desc_factorial_succ, desc_factorial_succ,
  succ_sub_succ, mul_left_comm]

lemma succ_desc_factorial (n : ℕ) :
  ∀ k, (n + 1 - k) * (n + 1).desc_factorial k = (n + 1) * n.desc_factorial k
| 0 := by rw [tsub_zero, desc_factorial_zero, desc_factorial_zero]
| (k + 1) := by rw [desc_factorial, succ_desc_factorial, desc_factorial_succ, succ_sub_succ,
  mul_left_comm]

lemma desc_factorial_self : ∀ n : ℕ, n.desc_factorial n = n!
| 0        := by rw [desc_factorial_zero, factorial_zero]
| (succ n) := by rw [succ_desc_factorial_succ, desc_factorial_self, factorial_succ]

@[simp] lemma desc_factorial_eq_zero_iff_lt {n : ℕ} : ∀ {k : ℕ}, n.desc_factorial k = 0 ↔ n < k
| 0        := by simp only [desc_factorial_zero, nat.one_ne_zero, nat.not_lt_zero]
| (succ k) := begin
  rw [desc_factorial_succ, mul_eq_zero, desc_factorial_eq_zero_iff_lt, lt_succ_iff,
    tsub_eq_zero_iff_le, lt_iff_le_and_ne, or_iff_left_iff_imp, and_imp],
  exact λ h _, h,
end

alias nat.desc_factorial_eq_zero_iff_lt ↔ _ nat.desc_factorial_of_lt

lemma add_desc_factorial_eq_asc_factorial (n : ℕ) :
  ∀ k : ℕ, (n + k).desc_factorial k = n.asc_factorial k
| 0        := by rw [asc_factorial_zero, desc_factorial_zero]
| (succ k) := by rw [nat.add_succ, succ_desc_factorial_succ, asc_factorial_succ,
  add_desc_factorial_eq_asc_factorial]

/-- `n.desc_factorial k = n! / (n - k)!` but without ℕ-division. See `nat.desc_factorial_eq_div`
for the version using ℕ-division. -/
theorem factorial_mul_desc_factorial : ∀ {n k : ℕ}, k ≤ n → (n - k)! * n.desc_factorial k = n!
| n        0        := λ _, by rw [desc_factorial_zero, mul_one, tsub_zero]
| 0        (succ k) := λ h, by { exfalso, exact not_succ_le_zero k h }
| (succ n) (succ k) := λ h, by rw [succ_desc_factorial_succ, succ_sub_succ, ←mul_assoc,
  mul_comm (n - k)!, mul_assoc, factorial_mul_desc_factorial (nat.succ_le_succ_iff.1 h),
    factorial_succ]

/-- Avoid in favor of `nat.factorial_mul_desc_factorial` if you can. ℕ-division isn't worth it. -/
lemma desc_factorial_eq_div {n k : ℕ} (h : k ≤ n) : n.desc_factorial k = n! / (n - k)! :=
begin
  apply mul_left_cancel₀ (factorial_ne_zero (n - k)),
  rw factorial_mul_desc_factorial h,
  exact (nat.mul_div_cancel' $ factorial_dvd_factorial $ nat.sub_le n k).symm,
end

lemma pow_sub_le_desc_factorial (n : ℕ) : ∀ (k : ℕ), (n + 1 - k)^k ≤ n.desc_factorial k
| 0 := by rw [desc_factorial_zero, pow_zero]
| (k + 1) := begin
  rw [desc_factorial_succ, pow_succ, succ_sub_succ],
  exact nat.mul_le_mul_of_nonneg_left (le_trans (nat.pow_le_pow_of_le_left
    (tsub_le_tsub_right (le_succ _) _) k) (pow_sub_le_desc_factorial k)),
end

lemma pow_sub_lt_desc_factorial' {n : ℕ} :
  ∀ {k : ℕ}, k + 2 ≤ n → (n - (k + 1))^(k + 2) < n.desc_factorial (k + 2)
| 0 := λ h, begin
  rw [desc_factorial_succ, pow_succ, pow_one, desc_factorial_one],
  exact nat.mul_lt_mul_of_pos_left (tsub_lt_self (lt_of_lt_of_le zero_lt_two h) zero_lt_one)
    (tsub_pos_of_lt h),
end
| (k + 1) := λ h, begin
  rw [desc_factorial_succ, pow_succ],
  refine nat.mul_lt_mul_of_pos_left ((nat.pow_le_pow_of_le_left (tsub_le_tsub_right
    (le_succ n) _) _).trans_lt _) (tsub_pos_of_lt h),
  rw succ_sub_succ,
  exact (pow_sub_lt_desc_factorial' ((le_succ _).trans h)),
end

lemma pow_sub_lt_desc_factorial {n : ℕ} :
  ∀ {k : ℕ}, 2 ≤ k → k ≤ n → (n + 1 - k)^k < n.desc_factorial k
| 0 := by rintro ⟨⟩
| 1 := by rintro (_ | ⟨_, ⟨⟩⟩)
| (k + 2) := λ _ h, by { rw succ_sub_succ, exact pow_sub_lt_desc_factorial' h }

lemma desc_factorial_le_pow (n : ℕ) : ∀ (k : ℕ), n.desc_factorial k ≤ n^k
| 0 := by rw [desc_factorial_zero, pow_zero]
| (k + 1) := begin
  rw [desc_factorial_succ, pow_succ],
  exact nat.mul_le_mul (nat.sub_le _ _) (desc_factorial_le_pow k),
end

lemma desc_factorial_lt_pow {n : ℕ} (hn : 1 ≤ n) : ∀ {k : ℕ}, 2 ≤ k → n.desc_factorial k < n^k
| 0 := by rintro ⟨⟩
| 1 := by rintro (_ | ⟨_, ⟨⟩⟩)
| (k + 2) := λ _, begin
  rw [desc_factorial_succ, pow_succ', mul_comm],
  exact nat.mul_lt_mul' (desc_factorial_le_pow _ _) (tsub_lt_self hn k.zero_lt_succ)
    (pow_pos hn _),
end

end desc_factorial

end nat


import .love06_monads_demo

/-! # LoVe Homework 6: Monads

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (6 points): Better Exceptions

The __error monad__ is a monad stores either a value of type `α` or an error of
type `ε`. This corresponds to the following type: -/

inductive error (ε α : Type) : Type
| good : α → error
| bad  : ε → error

/-! The error monad generalizes the option monad seen in the lecture. The `good`
constructor, corresponding to `option.some`, stores the current result of the
computation. But instead of having a single bad state `option.none`, the error
monad has many bad states of the form `bad e`, where `e` is an "exception" of
type `ε`.

1.1 (1 point). Implement a variant of `list.nth` that returns an error
message of the form "index _i_ out of range" instead of `option.none` on
failure.

Hint: For this, you will only need pattern matching (no `do` syntax). -/

#check list.nth

def list.nth_error {α : Type} (as : list α) (i : ℕ) : error string α :=
match list.nth as i with
| option.none     := error.bad ("index " ++ nat.repr i ++ " out of range")
| (option.some a) := error.good a
end

/-! 1.2 (1 point). Complete the definitions of the `pure` and `bind` operations
on the error monad: -/

def error.pure {ε α : Type} : α → error ε α :=
error.good

def error.bind {ε α β : Type} : error ε α → (α → error ε β) → error ε β
| (error.good a) f := f a
| (error.bad e)  f := error.bad e

/-! The following type class instance makes it possible to use `>>=` and `do`
notations in conjunction with error monads: -/

@[instance] def error.monad {ε : Type} : monad (error ε) :=
{ pure := @error.pure ε,
  bind := @error.bind ε }

/-! 1.3 (2 point). Prove the three laws for the error monad. -/

lemma error.pure_bind {ε α β : Type} (a : α) (f : α → error ε β) :
  (pure a >>= f) = f a :=
by refl

lemma error.bind_pure {ε α : Type} (ma : error ε α) :
  (ma >>= pure) = ma :=
begin
  cases' ma with a e,
  { refl },
  { refl }
end

lemma error.bind_assoc {ε α β γ : Type} (f : α → error ε β) (g : β → error ε γ)
    (ma : error ε α) :
  ((ma >>= f) >>= g) = (ma >>= (λa, f a >>= g)) :=
begin
  cases' ma with a e,
  { refl },
  { refl }
end

/-! 1.4 (1 point). Define the following two operations on the error monad.

The `throw` operation raises an exception `e`, leaving the monad in a bad state
storing `e`.

The `catch` operation can be used to recover from an earlier exception. If the
monad is currently in a bad state storing `e`, `catch` invokes some
exception-handling code (the second argument to `catch`), passing `e` as
argument; this code might in turn raise a new exception. If `catch` is applied
to a good state, nothing happens—the monad remains in the good state. As a
convenient alternative to `error.catch ma g`, Lean lets us write
`ma.catch g`. -/

def error.throw {ε α : Type} : ε → error ε α :=
error.bad

def error.catch {ε α : Type} : error ε α → (ε → error ε α) → error ε α
| (error.good a) g := error.good a
| (error.bad e)  g := g e

/-! 1.5 (1 point). Using `list.nth_error`, the monad operations on `error`, and
the special `error.catch` operation, write a `do` program that swaps the values
at indexes `i` and `j` in the input list `as`. If either index is out of range,
return `as` unchanged. -/

def list.swap {α : Type} (as : list α) (i j : ℕ) : error string (list α) :=
do {
  a ← list.nth_error as i,
  b ← list.nth_error as j,
  pure (list.update_nth (list.update_nth as j a) i b) }
.catch (λe,
  pure as)

#reduce list.swap [3, 1, 4, 1] 0 2   -- expected: error.good [4, 1, 3, 1]
#reduce list.swap [3, 1, 4, 1] 0 7   -- expected: error.good [3, 1, 4, 1]

/-! ## Question 2 (3 points + 1 bonus point): Properties of `mmap`

We will prove some properties of the `mmap` function introduced in the
lecture's demo. -/

#check mmap

/-! 2.1 (1 point). Prove the following identity law about `mmap` for an
arbitrary monad `m`.

Hint: You will need the lemma `lawful_monad.pure_bind` in the induction step. -/

lemma mmap_pure {m : Type → Type} [lawful_monad m] {α : Type} (as : list α) :
  mmap (@pure m _ _) as = pure as :=
begin
  induction' as,
  { refl },
  { simp [mmap, ih, lawful_monad.pure_bind] }
end

/-! Commutative monads are monads for which we can reorder actions that do not
depend on each others. Formally: -/

@[class] structure comm_lawful_monad (m : Type → Type)
  extends lawful_monad m : Type 1 :=
(bind_comm {α β γ δ : Type} (ma : m α) (f : α → m β) (g : α → m γ)
     (h : α → β → γ → m δ) :
   (ma >>= (λa, f a >>= (λb, g a >>= (λc, h a b c)))) =
   (ma >>= (λa, g a >>= (λc, f a >>= (λb, h a b c)))))

/-! 2.2 (1 point). Prove that `option` is a commutative monad. -/

lemma option.bind_comm {α β γ δ : Type} (ma : option α) (f : α → option β)
    (g : α → option γ) (h : α → β → γ → option δ) :
  (ma >>= λa, f a >>= λb, g a >>= λc, h a b c) =
  (ma >>= λa, g a >>= λc, f a >>= λb, h a b c) :=
begin
  cases' ma with a,
  { refl },
  { simp [bind, option.bind],
    cases' f a,
    { cases' g a,
      { refl },
      { refl } },
    { refl } }
end

/-! 2.3 (1 point). Explain why `error` is not a commutative monad. -/

/-! Consider the two `do` programs given in the statement of the `bind_comm`
property. Suppose that `f` throws exception 42 and `g` throws exception 999.
Then the first program below will throw 42, whereas the second program will
throw 999.

Let us try it out: -/

def prog1 (n : ℕ) : error ℕ ℕ :=
do
  a ← pure n,
  b ← @error.throw _ ℕ 42,
  c ← @error.throw _ ℕ 999,
  pure (a + b + c)

def prog2 (n : ℕ) : error ℕ ℕ :=
do
  a ← pure n,
  c ← @error.throw _ ℕ 999,
  b ← @error.throw _ ℕ 42,
  pure (a + b + c)

#reduce prog1 0   -- result: error.bad 42
#reduce prog2 0   -- result: error.bad 999

/-! 2.4 (1 bonus point). Prove the following composition law for `mmap`, which
holds for commutative monads.

Hint: You will need structural induction. -/

lemma mmap_mmap {m : Type → Type} [comm_lawful_monad m]
    {α β γ : Type} (f : α → m β) (g : β → m γ) (as : list α) :
  (mmap f as >>= mmap g) = mmap (λa, f a >>= g) as :=
begin
  induction' as,
  case nil {
    simp [mmap, lawful_monad.pure_bind] },
  case cons : a as ih {
    simp [mmap],
    rw ←ih,
    simp [lawful_monad.pure_bind, lawful_monad.bind_assoc],
    apply comm_lawful_monad.bind_comm }
end

end LoVe