/-
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 closed 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.

### 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_second_countable_of_locally_finite`
  is an instance registering that a locally finite measure on a second countable 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 topology 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, _) (supr₂_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_right (or.inl hμU) hrK⟩ }
end

lemma map {α β} [measurable_space α] [measurable_space β] {μ : measure α} {pa qa : set α → Prop}
  (H : inner_regular μ pa qa) (f : α ≃ β) (hf : ae_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_of_ae_measurable 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_of_ae_measurable 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, smul_eq_mul] 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 is_finite_measure_on_compacts μ, outer_regular μ : Prop :=
(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_infi₂ $ λ 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 eq_or_ne (μ A) ∞ with H|H,
  { exact ⟨univ, subset_univ _, is_open_univ, by simp only [H, _root_.top_add, le_top]⟩ },
  { rcases A.exists_is_open_lt_add H hε with ⟨U, AU, U_open, hU⟩,
    exact ⟨U, AU, U_open, hU.le⟩ }
end

lemma _root_.measurable_set.exists_is_open_diff_lt [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 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, smul_eq_mul] 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_countable' (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_mono 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 [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_countable' ε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_mono $ λ k, Union_subset $ λ _, hFs _,
      ⋃ n, U n, Union_mono 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 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] (μ : 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 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]
  [sigma_compact_space X] [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],
    exact 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 α) :=
⟨λ 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 [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
  [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 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 μ] ⦃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 [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 μ,
  haveI := is_finite_measure_on_compacts.map μ f,
  exact ⟨regular.inner_regular.map f.to_equiv f.measurable.ae_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,
  haveI := is_finite_measure_on_compacts.smul μ hx,
  exact ⟨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, (is_compact_compact_covering α n).measure_lt_top,
  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 [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 μ] {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 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 μ]
  ⦃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 [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 second countable metric space (or even a pseudo emetric space)
is weakly regular. -/
@[priority 100] -- see Note [lower instance priority]
instance of_pseudo_emetric_second_countable_of_locally_finite {X : Type*} [pseudo_emetric_space X]
  [topological_space.second_countable_topology 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

local attribute [instance] emetric.second_countable_of_sigma_compact

/-- 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


open classical
variable A : Prop
example : ¬ (¬ ( A ∨ ¬ A)) :=
(assume h1 :  ¬ (A ∨ ¬ A),
    have h2 : ¬ A, from
        assume h3 : A,
        have h4 : A ∨ ¬ A, from or.inl h3,
        show false, from h1 h4,
    have h5 : A ∨ ¬ A, from or.inr h2,
    show false, from h1 h5)


import standard

meta def blast : tactic unit :=
using_smt $ return ()

structure Category :=
  (Obj : Type)
  (Hom : Obj -> Obj -> Type)
  (identity : Π A : Obj, Hom A A)
  (compose  : Π ⦃A B C : Obj⦄, Hom A B → Hom B C → Hom A C)

  (left_identity  : Π ⦃A B : Obj⦄ (f : Hom A B), compose (identity _) f = f)
  (right_identity : Π ⦃A B : Obj⦄ (f : Hom A B), compose f (identity _) = f)
  (associativity  : Π ⦃A B C D : Obj⦄ (f : Hom A B) (g : Hom B C) (h : Hom C D),
    compose (compose f g) h = compose f (compose g h))

attribute [class] Category

structure Functor (C : Category) (D : Category) :=
  (onObjects   : C^.Obj → D^.Obj)
  (onMorphisms : Π ⦃A B : C^.Obj⦄,
                C^.Hom A B → D^.Hom (onObjects A) (onObjects B))
  (identities : Π (A : C^.Obj),
    onMorphisms (C^.identity A) = D^.identity (onObjects A))
  (functoriality : Π ⦃X Y Z : C^.Obj⦄ (f : C^.Hom X Y) (g : C^.Hom Y Z),
    onMorphisms (C^.compose f g) = D^.compose (onMorphisms f) (onMorphisms g))

attribute [class] Functor

instance Functor_to_onObjects { C D : Category }: has_coe_to_fun (Functor C D) :=
{ F   := λ f, C^.Obj -> D^.Obj,
  coe := Functor.onObjects }

namespace Functor
  infix `<$>`:50 := λ {C : Category} {D : Category}
                      (F : Functor C D) {A B : C^.Obj} (f : C^.Hom A B),
                      onMorphisms F f
end Functor

structure NaturalTransformation { C D : Category } ( F G : Functor C D ) :=
  (components: Π A : C^.Obj, D^.Hom (F A) (G A))
  (naturality: Π { A B : C^.Obj }, Π f : C^.Hom A B, D^.compose (F <$> f) (components B) = D^.compose (components A) (G <$> f))

instance NaturalTransformation_to_components { C D : Category } { F G : Functor C D } : has_coe_to_fun (NaturalTransformation F G) :=
{ F   := λ f, Π A : C^.Obj, D^.Hom (F A) (G A),
  coe := NaturalTransformation.components }

-- We'll want to be able to prove that two natural transformations are equal if they are componentwise equal.
lemma NaturalTransformations_componentwise_equal
  { C D : Category }
  { F G : Functor C D }
  ( α β : NaturalTransformation F G )
  ( w: Π X : C^.Obj, α X = β X ) : α = β :=
  begin
    induction α,
    induction β,
    -- Argh, how to complete this proof?
    exact sorry
  end


/-
M1F 2017-18 Sheet 1 Question 2 to 4 solutions.
Author : Kevin Buzzard
This file should work with any version of lean -- whether you installed it yourself
or are running the version on https://leanprover.github.io/live/latest/
-/
-- We probably need the "law of the excluded middle" for this question -- every
-- proposition is either true or false! Don't even ask me to explain what the
-- other options are, but Lean does not come with this axiom by default (blame
-- the computer scientists) and mathematicians have to add it themselves.
-- It's easy to add though. "em" for excluded middle.

axiom em (X : Prop) : X ∨ ¬ X

variables P Q R S : Prop -- A "Prop" is a proposition, that is, a true/false statement.

-- Sheet 1 Q2 is true.

theorem m1f_sheet01_q02_is_T (HQP : Q → P) (HnQnR : ¬ Q → ¬ R) : R → P :=
begin
intro HR, -- hypothesis R
cases em Q with HQ HnQ, -- Q is either true or false.
  -- Q is true in this branch.
  exact HQP HQ, -- HPQ HQ is a proof of P.

  -- Q is false in this branch
  -- HnQ is the hypothesis "not Q"
  -- HnQnR is "not Q implies not R"
  -- so HnQnR HnQ is a proof of "not R"
      -- i.e. a proof of "R implies false"
  -- but HR is a proof of R
  -- and that's enough for a contradiction.
  have HnR : ¬ R,
  exact HnQnR HnQ,
  contradiction,
end


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

Basic operations on the natural numbers.
-/
import logic.basic algebra.ordered_ring data.option.basic

universes u v

namespace nat
variables {m n k : ℕ}

-- Sometimes a bare `nat.add` or similar appears as a consequence of unfolding
-- during pattern matching. These lemmas package them back up as typeclass
-- mediated operations.
@[simp] theorem add_def {a b : ℕ} : nat.add a b = a + b := rfl
@[simp] theorem mul_def {a b : ℕ} : nat.mul a b = a * b := rfl

attribute [simp] nat.add_sub_cancel nat.add_sub_cancel_left
attribute [simp] nat.sub_self

theorem succ_inj' {n m : ℕ} : succ n = succ m ↔ n = m :=
⟨succ_inj, congr_arg _⟩

theorem succ_le_succ_iff {m n : ℕ} : succ m ≤ succ n ↔ m ≤ n :=
⟨le_of_succ_le_succ, succ_le_succ⟩

theorem lt_succ_iff {m n : ℕ} : m < succ n ↔ m ≤ n :=
succ_le_succ_iff

lemma succ_le_iff {m n : ℕ} : succ m ≤ n ↔ m < n :=
⟨lt_of_succ_le, succ_le_of_lt⟩

theorem pred_eq_of_eq_succ {m n : ℕ} (H : m = n.succ) : m.pred = n := by simp [H]

theorem pred_sub (n m : ℕ) : pred n - m = pred (n - m) :=
by rw [← sub_one, nat.sub_sub, one_add]; refl

lemma pred_eq_sub_one (n : ℕ) : pred n = n - 1 := rfl

lemma one_le_of_lt {n m : ℕ} (h : n < m) : 1 ≤ m :=
lt_of_le_of_lt (nat.zero_le _) h

lemma le_pred_of_lt {n m : ℕ} (h : m < n) : m ≤ n - 1 :=
nat.sub_le_sub_right h 1

/-- This ensures that `simp` succeeds on `pred (n + 1) = n`. -/
@[simp] lemma pred_one_add (n : ℕ) : pred (1 + n) = n :=
by rw [add_comm, add_one, pred_succ]

theorem pos_iff_ne_zero : n > 0 ↔ n ≠ 0 :=
⟨ne_of_gt, nat.pos_of_ne_zero⟩

theorem pos_iff_ne_zero' : 0 < n ↔ n ≠ 0 := pos_iff_ne_zero

lemma one_lt_iff_ne_zero_and_ne_one : ∀ {n : ℕ}, 1 < n ↔ n ≠ 0 ∧ n ≠ 1
| 0     := dec_trivial
| 1     := dec_trivial
| (n+2) := dec_trivial

theorem eq_of_lt_succ_of_not_lt {a b : ℕ} (h1 : a < b + 1) (h2 : ¬ a < b) : a = b :=
have h3 : a ≤ b, from le_of_lt_succ h1,
or.elim (eq_or_lt_of_not_lt h2) (λ h, h) (λ h, absurd h (not_lt_of_ge h3))

protected theorem le_sub_add (n m : ℕ) : n ≤ n - m + m :=
or.elim (le_total n m)
  (assume : n ≤ m, begin rw [sub_eq_zero_of_le this, zero_add], exact this end)
  (assume : m ≤ n, begin rw (nat.sub_add_cancel this) end)

theorem sub_add_eq_max (n m : ℕ) : n - m + m = max n m :=
eq_max (nat.le_sub_add _ _) (le_add_left _ _) $ λ k h₁ h₂,
by rw ← nat.sub_add_cancel h₂; exact
add_le_add_right (nat.sub_le_sub_right h₁ _) _

theorem sub_add_min (n m : ℕ) : n - m + min n m = n :=
(le_total n m).elim
  (λ h, by rw [min_eq_left h, sub_eq_zero_of_le h, zero_add])
  (λ h, by rw [min_eq_right h, nat.sub_add_cancel h])

protected theorem add_sub_cancel' {n m : ℕ} (h : n ≥ m) : m + (n - m) = n :=
by rw [add_comm, nat.sub_add_cancel h]

protected theorem sub_eq_of_eq_add (h : k = m + n) : k - m = n :=
begin rw [h, nat.add_sub_cancel_left] end

lemma sub_sub_sub_cancel_right {a b c : ℕ} (h₂ : c ≤ b) : (a - c) - (b - c) = a - b :=
by rw [nat.sub_sub, ←nat.add_sub_assoc h₂, nat.add_sub_cancel_left]

theorem sub_min (n m : ℕ) : n - min n m = n - m :=
nat.sub_eq_of_eq_add $ by rw [add_comm, sub_add_min]

protected theorem lt_of_sub_pos (h : n - m > 0) : m < n :=
lt_of_not_ge
  (assume : m ≥ n,
    have n - m = 0, from sub_eq_zero_of_le this,
    begin rw this at h, exact lt_irrefl _ h end)

protected theorem lt_of_sub_lt_sub_right : m - k < n - k → m < n :=
lt_imp_lt_of_le_imp_le (λ h, nat.sub_le_sub_right h _)

protected theorem lt_of_sub_lt_sub_left : m - n < m - k → k < n :=
lt_imp_lt_of_le_imp_le (nat.sub_le_sub_left _)

protected theorem sub_lt_self (h₁ : m > 0) (h₂ : n > 0) : m - n < m :=
calc
  m - n = succ (pred m) - succ (pred n) : by rw [succ_pred_eq_of_pos h₁, succ_pred_eq_of_pos h₂]
    ... = pred m - pred n               : by rw succ_sub_succ
    ... ≤ pred m                        : sub_le _ _
    ... < succ (pred m)                 : lt_succ_self _
    ... = m                             : succ_pred_eq_of_pos h₁

protected theorem le_sub_right_of_add_le (h : m + k ≤ n) : m ≤ n - k :=
by rw ← nat.add_sub_cancel m k; exact nat.sub_le_sub_right h k

protected theorem le_sub_left_of_add_le (h : k + m ≤ n) : m ≤ n - k :=
nat.le_sub_right_of_add_le (by rwa add_comm at h)

protected theorem lt_sub_right_of_add_lt (h : m + k < n) : m < n - k :=
lt_of_succ_le $ nat.le_sub_right_of_add_le $
by rw succ_add; exact succ_le_of_lt h

protected theorem lt_sub_left_of_add_lt (h : k + m < n) : m < n - k :=
nat.lt_sub_right_of_add_lt (by rwa add_comm at h)

protected theorem add_lt_of_lt_sub_right (h : m < n - k) : m + k < n :=
@nat.lt_of_sub_lt_sub_right _ _ k (by rwa nat.add_sub_cancel)

protected theorem add_lt_of_lt_sub_left (h : m < n - k) : k + m < n :=
by rw add_comm; exact nat.add_lt_of_lt_sub_right h

protected theorem le_add_of_sub_le_right : n - k ≤ m → n ≤ m + k :=
le_imp_le_of_lt_imp_lt nat.lt_sub_right_of_add_lt

protected theorem le_add_of_sub_le_left : n - k ≤ m → n ≤ k + m :=
le_imp_le_of_lt_imp_lt nat.lt_sub_left_of_add_lt

protected theorem lt_add_of_sub_lt_right : n - k < m → n < m + k :=
lt_imp_lt_of_le_imp_le nat.le_sub_right_of_add_le

protected theorem lt_add_of_sub_lt_left : n - k < m → n < k + m :=
lt_imp_lt_of_le_imp_le nat.le_sub_left_of_add_le

protected theorem sub_le_left_of_le_add : n ≤ k + m → n - k ≤ m :=
le_imp_le_of_lt_imp_lt nat.add_lt_of_lt_sub_left

protected theorem sub_le_right_of_le_add : n ≤ m + k → n - k ≤ m :=
le_imp_le_of_lt_imp_lt nat.add_lt_of_lt_sub_right

protected theorem sub_lt_left_iff_lt_add (H : n ≤ k) : k - n < m ↔ k < n + m :=
⟨nat.lt_add_of_sub_lt_left,
 λ h₁,
  have succ k ≤ n + m,   from succ_le_of_lt h₁,
  have succ (k - n) ≤ m, from
    calc succ (k - n) = succ k - n : by rw (succ_sub H)
          ...     ≤ n + m - n      : nat.sub_le_sub_right this n
          ...     = m              : by rw nat.add_sub_cancel_left,
  lt_of_succ_le this⟩

protected theorem le_sub_left_iff_add_le (H : m ≤ k) : n ≤ k - m ↔ m + n ≤ k :=
le_iff_le_iff_lt_iff_lt.2 (nat.sub_lt_left_iff_lt_add H)

protected theorem le_sub_right_iff_add_le (H : n ≤ k) : m ≤ k - n ↔ m + n ≤ k :=
by rw [nat.le_sub_left_iff_add_le H, add_comm]

protected theorem lt_sub_left_iff_add_lt : n < k - m ↔ m + n < k :=
⟨nat.add_lt_of_lt_sub_left, nat.lt_sub_left_of_add_lt⟩

protected theorem lt_sub_right_iff_add_lt : m < k - n ↔ m + n < k :=
by rw [nat.lt_sub_left_iff_add_lt, add_comm]

theorem sub_le_left_iff_le_add : m - n ≤ k ↔ m ≤ n + k :=
le_iff_le_iff_lt_iff_lt.2 nat.lt_sub_left_iff_add_lt

theorem sub_le_right_iff_le_add : m - k ≤ n ↔ m ≤ n + k :=
by rw [nat.sub_le_left_iff_le_add, add_comm]

protected theorem sub_lt_right_iff_lt_add (H : k ≤ m) : m - k < n ↔ m < n + k :=
by rw [nat.sub_lt_left_iff_lt_add H, add_comm]

protected theorem sub_le_sub_left_iff (H : k ≤ m) : m - n ≤ m - k ↔ k ≤ n :=
⟨λ h,
  have k + (m - k) - n ≤ m - k, by rwa nat.add_sub_cancel' H,
  nat.le_of_add_le_add_right (nat.le_add_of_sub_le_left this),
nat.sub_le_sub_left _⟩

protected theorem sub_lt_sub_right_iff (H : k ≤ m) : m - k < n - k ↔ m < n :=
lt_iff_lt_of_le_iff_le (nat.sub_le_sub_right_iff _ _ _ H)

protected theorem sub_lt_sub_left_iff (H : n ≤ m) : m - n < m - k ↔ k < n :=
lt_iff_lt_of_le_iff_le (nat.sub_le_sub_left_iff H)

protected theorem sub_le_iff : m - n ≤ k ↔ m - k ≤ n :=
nat.sub_le_left_iff_le_add.trans nat.sub_le_right_iff_le_add.symm

protected lemma sub_le_self (n m : ℕ) : n - m ≤ n :=
nat.sub_le_left_of_le_add (nat.le_add_left _ _)

protected theorem sub_lt_iff (h₁ : n ≤ m) (h₂ : k ≤ m) : m - n < k ↔ m - k < n :=
(nat.sub_lt_left_iff_lt_add h₁).trans (nat.sub_lt_right_iff_lt_add h₂).symm

lemma pred_le_iff {n m : ℕ} : pred n ≤ m ↔ n ≤ succ m :=
@nat.sub_le_right_iff_le_add n m 1

lemma lt_pred_iff {n m : ℕ} : n < pred m ↔ succ n < m :=
@nat.lt_sub_right_iff_add_lt n 1 m

protected theorem mul_ne_zero {n m : ℕ} (n0 : n ≠ 0) (m0 : m ≠ 0) : n * m ≠ 0
| nm := (eq_zero_of_mul_eq_zero nm).elim n0 m0

@[simp] protected theorem mul_eq_zero {a b : ℕ} : a * b = 0 ↔ a = 0 ∨ b = 0 :=
iff.intro eq_zero_of_mul_eq_zero (by simp [or_imp_distrib] {contextual := tt})

@[simp] protected theorem zero_eq_mul {a b : ℕ} : 0 = a * b ↔ a = 0 ∨ b = 0 :=
by rw [eq_comm, nat.mul_eq_zero]

@[elab_as_eliminator]
protected def strong_rec' {p : ℕ → Sort u} (H : ∀ n, (∀ m, m < n → p m) → p n) : ∀ (n : ℕ), p n
| n := H n (λ m hm, strong_rec' m)

attribute [simp] nat.div_self

protected lemma div_le_of_le_mul' {m n : ℕ} {k} (h : m ≤ k * n) : m / k ≤ n :=
(eq_zero_or_pos k).elim
  (λ k0, by rw [k0, nat.div_zero]; apply zero_le)
  (λ k0, (decidable.mul_le_mul_left k0).1 $
    calc k * (m / k)
        ≤ m % k + k * (m / k) : le_add_left _ _
    ... = m                   : mod_add_div _ _
    ... ≤ k * n               : h)

protected lemma div_le_self' (m n : ℕ) : m / n ≤ m :=
(eq_zero_or_pos n).elim
  (λ n0, by rw [n0, nat.div_zero]; apply zero_le)
  (λ n0, nat.div_le_of_le_mul' $ calc
      m = 1 * m : (one_mul _).symm
    ... ≤ n * m : mul_le_mul_right _ n0)

theorem le_div_iff_mul_le' {x y : ℕ} {k : ℕ} (k0 : 0 < k) : x ≤ y / k ↔ x * k ≤ y :=
begin
  revert x, refine nat.strong_rec' _ y,
  clear y, intros y IH x,
  cases decidable.lt_or_le y k with h h,
  { rw [div_eq_of_lt h],
    cases x with x,
    { simp [zero_mul, zero_le] },
    { rw succ_mul,
      exact iff_of_false (not_succ_le_zero _)
        (not_le_of_lt $ lt_of_lt_of_le h (le_add_left _ _)) } },
  { rw [div_eq_sub_div k0 h],
    cases x with x,
    { simp [zero_mul, zero_le] },
    { rw [← add_one, nat.add_le_add_iff_le_right, succ_mul,
        IH _ (sub_lt_of_pos_le _ _ k0 h), add_le_to_le_sub _ h] } }
end

theorem div_mul_le_self' (m n : ℕ) : m / n * n ≤ m :=
(nat.eq_zero_or_pos n).elim (λ n0, by simp [n0, zero_le]) $ λ n0,
(le_div_iff_mul_le' n0).1 (le_refl _)

theorem div_lt_iff_lt_mul' {x y : ℕ} {k : ℕ} (k0 : 0 < k) : x / k < y ↔ x < y * k :=
lt_iff_lt_of_le_iff_le $ le_div_iff_mul_le' k0

protected theorem div_le_div_right {n m : ℕ} (h : n ≤ m) {k : ℕ} : n / k ≤ m / k :=
(nat.eq_zero_or_pos k).elim (λ k0, by simp [k0]) $ λ hk,
(le_div_iff_mul_le' hk).2 $ le_trans (nat.div_mul_le_self' _ _) h

protected theorem eq_mul_of_div_eq_right {a b c : ℕ} (H1 : b ∣ a) (H2 : a / b = c) :
  a = b * c :=
by rw [← H2, nat.mul_div_cancel' H1]

protected theorem div_eq_iff_eq_mul_right {a b c : ℕ} (H : b > 0) (H' : b ∣ a) :
  a / b = c ↔ a = b * c :=
⟨nat.eq_mul_of_div_eq_right H', nat.div_eq_of_eq_mul_right H⟩

protected theorem div_eq_iff_eq_mul_left {a b c : ℕ} (H : b > 0) (H' : b ∣ a) :
  a / b = c ↔ a = c * b :=
by rw mul_comm; exact nat.div_eq_iff_eq_mul_right H H'

protected theorem eq_mul_of_div_eq_left {a b c : ℕ} (H1 : b ∣ a) (H2 : a / b = c) :
  a = c * b :=
by rw [mul_comm, nat.eq_mul_of_div_eq_right H1 H2]

protected theorem mul_div_cancel_left' {a b : ℕ} (Hd :  a ∣ b) : a * (b / a) = b :=
by rw [mul_comm,nat.div_mul_cancel Hd]

protected theorem div_mod_unique {n k m d : ℕ} (h : 0 < k) :
  n / k = d ∧ n % k = m ↔ m + k * d = n ∧ m < k :=
⟨λ ⟨e₁, e₂⟩, e₁ ▸ e₂ ▸ ⟨mod_add_div _ _, mod_lt _ h⟩,
 λ ⟨h₁, h₂⟩, h₁ ▸ by rw [add_mul_div_left _ _ h, add_mul_mod_self_left];
   simp [div_eq_of_lt, mod_eq_of_lt, h₂]⟩

lemma two_mul_odd_div_two {n : ℕ} (hn : n % 2 = 1) : 2 * (n / 2) = n - 1 :=
by conv {to_rhs, rw [← nat.mod_add_div n 2, hn, nat.add_sub_cancel_left]}

lemma div_dvd_of_dvd {a b : ℕ} (h : b ∣ a) : (a / b) ∣ a :=
⟨b, (nat.div_mul_cancel h).symm⟩

protected lemma div_pos {a b : ℕ} (hba : b ≤ a) (hb : 0 < b) : 0 < a / b :=
nat.pos_of_ne_zero (λ h, lt_irrefl a
  (calc a = a % b : by simpa [h] using (mod_add_div a b).symm
      ... < b : nat.mod_lt a hb
      ... ≤ a : hba))

protected theorem mul_right_inj {a b c : ℕ} (ha : a > 0) : b * a = c * a ↔ b = c :=
⟨nat.eq_of_mul_eq_mul_right ha, λ e, e ▸ rfl⟩

protected theorem mul_left_inj {a b c : ℕ} (ha : a > 0) : a * b = a * c ↔ b = c :=
⟨nat.eq_of_mul_eq_mul_left ha, λ e, e ▸ rfl⟩

protected lemma div_div_self : ∀ {a b : ℕ}, b ∣ a → 0 < a → a / (a / b) = b
| a     0     h₁ h₂ := by rw eq_zero_of_zero_dvd h₁; refl
| 0     b     h₁ h₂ := absurd h₂ dec_trivial
| (a+1) (b+1) h₁ h₂ :=
(nat.mul_right_inj (nat.div_pos (le_of_dvd (succ_pos a) h₁) (succ_pos b))).1 $
  by rw [nat.div_mul_cancel (div_dvd_of_dvd h₁), nat.mul_div_cancel' h₁]

protected lemma div_lt_of_lt_mul {m n k : ℕ} (h : m < n * k) : m / n < k :=
lt_of_mul_lt_mul_left
  (calc n * (m / n) ≤ m % n + n * (m / n) : nat.le_add_left _ _
    ... = m : mod_add_div _ _
    ... < n * k : h)
  (nat.zero_le n)

protected lemma div_eq_zero_iff {a b : ℕ} (hb : 0 < b) : a / b = 0 ↔ a < b :=
⟨λ h, by rw [← mod_add_div a b, h, mul_zero, add_zero]; exact mod_lt _ hb,
  λ h, by rw [← nat.mul_left_inj hb, ← @add_left_cancel_iff _ _ (a % b), mod_add_div,
    mod_eq_of_lt h, mul_zero, add_zero]⟩

lemma mod_mul_right_div_self (a b c : ℕ) : a % (b * c) / b = (a / b) % c :=
if hb : b = 0 then by simp [hb] else if hc : c = 0 then by simp [hc]
else by conv {to_rhs, rw ← mod_add_div a (b * c)};
rw [mul_assoc, nat.add_mul_div_left _ _ (nat.pos_of_ne_zero hb), add_mul_mod_self_left,
  mod_eq_of_lt (nat.div_lt_of_lt_mul (mod_lt _ (mul_pos (nat.pos_of_ne_zero hb) (nat.pos_of_ne_zero hc))))]

lemma mod_mul_left_div_self (a b c : ℕ) : a % (c * b) / b = (a / b) % c :=
by rw [mul_comm c, mod_mul_right_div_self]

@[simp] protected theorem dvd_one {n : ℕ} : n ∣ 1 ↔ n = 1 :=
⟨eq_one_of_dvd_one, λ e, e.symm ▸ dvd_refl _⟩

protected theorem dvd_add_left {k m n : ℕ} (h : k ∣ n) : k ∣ m + n ↔ k ∣ m :=
(nat.dvd_add_iff_left h).symm

protected theorem dvd_add_right {k m n : ℕ} (h : k ∣ m) : k ∣ m + n ↔ k ∣ n :=
(nat.dvd_add_iff_right h).symm

protected theorem mul_dvd_mul_iff_left {a b c : ℕ} (ha : a > 0) : a * b ∣ a * c ↔ b ∣ c :=
exists_congr $ λ d, by rw [mul_assoc, nat.mul_left_inj ha]

protected theorem mul_dvd_mul_iff_right {a b c : ℕ} (hc : c > 0) : a * c ∣ b * c ↔ a ∣ b :=
exists_congr $ λ d, by rw [mul_right_comm, nat.mul_right_inj hc]

@[simp] theorem mod_mod (a n : ℕ) : (a % n) % n = a % n :=
(eq_zero_or_pos n).elim
  (λ n0, by simp [n0])
  (λ npos, mod_eq_of_lt (mod_lt _ npos))

theorem add_pos_left {m : ℕ} (h : m > 0) (n : ℕ) : m + n > 0 :=
calc
  m + n > 0 + n : nat.add_lt_add_right h n
    ... = n     : nat.zero_add n
    ... ≥ 0     : zero_le n

theorem add_pos_right (m : ℕ) {n : ℕ} (h : n > 0) : m + n > 0 :=
begin rw add_comm, exact add_pos_left h m end

theorem add_pos_iff_pos_or_pos (m n : ℕ) : m + n > 0 ↔ m > 0 ∨ n > 0 :=
iff.intro
  begin
    intro h,
    cases m with m,
    {simp [zero_add] at h, exact or.inr h},
    exact or.inl (succ_pos _)
  end
  begin
    intro h, cases h with mpos npos,
    { apply add_pos_left mpos },
    apply add_pos_right _ npos
  end

lemma add_eq_one_iff : ∀ {a b : ℕ}, a + b = 1 ↔ (a = 0 ∧ b = 1) ∨ (a = 1 ∧ b = 0)
| 0     0     := dec_trivial
| 0     1     := dec_trivial
| 1     0     := dec_trivial
| 1     1     := dec_trivial
| (a+2) _     := by rw add_right_comm; exact dec_trivial
| _     (b+2) := by rw [← add_assoc]; simp only [nat.succ_inj', nat.succ_ne_zero]; simp

lemma mul_eq_one_iff : ∀ {a b : ℕ}, a * b = 1 ↔ a = 1 ∧ b = 1
| 0     0     := dec_trivial
| 0     1     := dec_trivial
| 1     0     := dec_trivial
| (a+2) 0     := by simp
| 0     (b+2) := by simp
| (a+1) (b+1) := ⟨λ h, by simp only [add_mul, mul_add, mul_add, one_mul, mul_one,
    (add_assoc _ _ _).symm, nat.succ_inj', add_eq_zero_iff] at h; simp [h.1.2, h.2],
  by clear_aux_decl; finish⟩

lemma mul_right_eq_self_iff {a b : ℕ} (ha : 0 < a): a * b = a ↔ b = 1 :=
suffices a * b = a * 1 ↔ b = 1, by rwa mul_one at this,
nat.mul_left_inj ha

lemma mul_left_eq_self_iff {a b : ℕ} (hb : 0 < b): a * b = b ↔ a = 1 :=
by rw [mul_comm, nat.mul_right_eq_self_iff hb]

lemma lt_succ_iff_lt_or_eq {n i : ℕ} : n < i.succ ↔ (n < i ∨ n = i) :=
lt_succ_iff.trans le_iff_lt_or_eq

theorem le_zero_iff {i : ℕ} : i ≤ 0 ↔ i = 0 :=
⟨nat.eq_zero_of_le_zero, assume h, h ▸ le_refl i⟩

theorem le_add_one_iff {i j : ℕ} : i ≤ j + 1 ↔ (i ≤ j ∨ i = j + 1) :=
⟨assume h,
  match nat.eq_or_lt_of_le h with
  | or.inl h := or.inr h
  | or.inr h := or.inl $ nat.le_of_succ_le_succ h
  end,
  or.rec (assume h, le_trans h $ nat.le_add_right _ _) le_of_eq⟩

theorem mul_self_inj {n m : ℕ} : n * n = m * m ↔ n = m :=
le_antisymm_iff.trans (le_antisymm_iff.trans
  (and_congr mul_self_le_mul_self_iff mul_self_le_mul_self_iff)).symm

instance decidable_ball_lt (n : nat) (P : Π k < n, Prop) :
  ∀ [H : ∀ n h, decidable (P n h)], decidable (∀ n h, P n h) :=
begin
  induction n with n IH; intro; resetI,
  { exact is_true (λ n, dec_trivial) },
  cases IH (λ k h, P k (lt_succ_of_lt h)) with h,
  { refine is_false (mt _ h), intros hn k h, apply hn },
  by_cases p : P n (lt_succ_self n),
  { exact is_true (λ k h',
     (lt_or_eq_of_le $ le_of_lt_succ h').elim (h _)
       (λ e, match k, e, h' with _, rfl, h := p end)) },
  { exact is_false (mt (λ hn, hn _ _) p) }
end

instance decidable_forall_fin {n : ℕ} (P : fin n → Prop)
  [H : decidable_pred P] : decidable (∀ i, P i) :=
decidable_of_iff (∀ k h, P ⟨k, h⟩) ⟨λ a ⟨k, h⟩, a k h, λ a k h, a ⟨k, h⟩⟩

instance decidable_ball_le (n : ℕ) (P : Π k ≤ n, Prop)
  [H : ∀ n h, decidable (P n h)] : decidable (∀ n h, P n h) :=
decidable_of_iff (∀ k (h : k < succ n), P k (le_of_lt_succ h))
⟨λ a k h, a k (lt_succ_of_le h), λ a k h, a k _⟩

instance decidable_lo_hi (lo hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] : decidable (∀x, lo ≤ x → x < hi → P x) :=
decidable_of_iff (∀ x < hi - lo, P (lo + x))
⟨λal x hl hh, by have := al (x - lo) (lt_of_not_ge $
  (not_congr (nat.sub_le_sub_right_iff _ _ _ hl)).2 $ not_le_of_gt hh);
  rwa [nat.add_sub_of_le hl] at this,
λal x h, al _ (nat.le_add_right _ _) (nat.add_lt_of_lt_sub_left h)⟩

instance decidable_lo_hi_le (lo hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] : decidable (∀x, lo ≤ x → x ≤ hi → P x) :=
decidable_of_iff (∀x, lo ≤ x → x < hi + 1 → P x) $
ball_congr $ λ x hl, imp_congr lt_succ_iff iff.rfl

protected theorem bit0_le {n m : ℕ} (h : n ≤ m) : bit0 n ≤ bit0 m :=
add_le_add h h

protected theorem bit1_le {n m : ℕ} (h : n ≤ m) : bit1 n ≤ bit1 m :=
succ_le_succ (add_le_add h h)

theorem bit_le : ∀ (b : bool) {n m : ℕ}, n ≤ m → bit b n ≤ bit b m
| tt n m h := nat.bit1_le h
| ff n m h := nat.bit0_le h

theorem bit_ne_zero (b) {n} (h : n ≠ 0) : bit b n ≠ 0 :=
by cases b; [exact nat.bit0_ne_zero h, exact nat.bit1_ne_zero _]

theorem bit0_le_bit : ∀ (b) {m n : ℕ}, m ≤ n → bit0 m ≤ bit b n
| tt m n h := le_of_lt $ nat.bit0_lt_bit1 h
| ff m n h := nat.bit0_le h

theorem bit_le_bit1 : ∀ (b) {m n : ℕ}, m ≤ n → bit b m ≤ bit1 n
| ff m n h := le_of_lt $ nat.bit0_lt_bit1 h
| tt m n h := nat.bit1_le h

theorem bit_lt_bit0 : ∀ (b) {n m : ℕ}, n < m → bit b n < bit0 m
| tt n m h := nat.bit1_lt_bit0 h
| ff n m h := nat.bit0_lt h

theorem bit_lt_bit (a b) {n m : ℕ} (h : n < m) : bit a n < bit b m :=
lt_of_lt_of_le (bit_lt_bit0 _ h) (bit0_le_bit _ (le_refl _))

/- partial subtraction -/

/-- Partial predecessor operation. Returns `ppred n = some m`
  if `n = m + 1`, otherwise `none`. -/
@[simp] def ppred : ℕ → option ℕ
| 0     := none
| (n+1) := some n

/-- Partial subtraction operation. Returns `psub m n = some k`
  if `m = n + k`, otherwise `none`. -/
@[simp] def psub (m : ℕ) : ℕ → option ℕ
| 0     := some m
| (n+1) := psub n >>= ppred

theorem pred_eq_ppred (n : ℕ) : pred n = (ppred n).get_or_else 0 :=
by cases n; refl

theorem sub_eq_psub (m : ℕ) : ∀ n, m - n = (psub m n).get_or_else 0
| 0     := rfl
| (n+1) := (pred_eq_ppred (m-n)).trans $
  by rw [sub_eq_psub, psub]; cases psub m n; refl

@[simp] theorem ppred_eq_some {m : ℕ} : ∀ {n}, ppred n = some m ↔ succ m = n
| 0     := by split; intro h; contradiction
| (n+1) := by dsimp; split; intro h; injection h; subst n

@[simp] theorem ppred_eq_none : ∀ {n : ℕ}, ppred n = none ↔ n = 0
| 0     := by simp
| (n+1) := by dsimp; split; contradiction

theorem psub_eq_some {m : ℕ} : ∀ {n k}, psub m n = some k ↔ k + n = m
| 0     k := by simp [eq_comm]
| (n+1) k := by dsimp; apply option.bind_eq_some.trans; simp [psub_eq_some]

theorem psub_eq_none (m n : ℕ) : psub m n = none ↔ m < n :=
begin
  cases s : psub m n; simp [eq_comm],
  { show m < n, refine lt_of_not_ge (λ h, _),
    cases le.dest h with k e,
    injection s.symm.trans (psub_eq_some.2 $ (add_comm _ _).trans e) },
  { show n ≤ m, rw ← psub_eq_some.1 s, apply le_add_left }
end

theorem ppred_eq_pred {n} (h : 0 < n) : ppred n = some (pred n) :=
ppred_eq_some.2 $ succ_pred_eq_of_pos h

theorem psub_eq_sub {m n} (h : n ≤ m) : psub m n = some (m - n) :=
psub_eq_some.2 $ nat.sub_add_cancel h

theorem psub_add (m n k) : psub m (n + k) = do x ← psub m n, psub x k :=
by induction k; simp [*, add_succ, bind_assoc]

/- pow -/

attribute [simp] nat.pow_zero nat.pow_one

@[simp] lemma one_pow : ∀ n : ℕ, 1 ^ n = 1
| 0 := rfl
| (k+1) := show 1^k * 1 = 1, by rw [mul_one, one_pow]

theorem pow_add (a m n : ℕ) : a^(m + n) = a^m * a^n :=
by induction n; simp [*, pow_succ, mul_assoc]

theorem pow_two (a : ℕ) : a ^ 2 = a * a := show (1 * a) * a = _, by rw one_mul

theorem pow_dvd_pow (a : ℕ) {m n : ℕ} (h : m ≤ n) : a^m ∣ a^n :=
by rw [← nat.add_sub_cancel' h, pow_add]; apply dvd_mul_right

theorem pow_dvd_pow_of_dvd {a b : ℕ} (h : a ∣ b) : ∀ n:ℕ, a^n ∣ b^n
| 0     := dvd_refl _
| (n+1) := mul_dvd_mul (pow_dvd_pow_of_dvd n) h

theorem mul_pow (a b n : ℕ) : (a * b) ^ n = a ^ n * b ^ n :=
by induction n; simp [*, nat.pow_succ, mul_comm, mul_assoc, mul_left_comm]

protected theorem pow_mul (a b n : ℕ) : n ^ (a * b) = (n ^ a) ^ b :=
by induction b; simp [*, nat.succ_eq_add_one, nat.pow_add, mul_add, mul_comm]

theorem pow_pos {p : ℕ} (hp : p > 0) : ∀ n : ℕ, p ^ n > 0
| 0 := by simpa using zero_lt_one
| (k+1) := mul_pos (pow_pos _) hp

lemma pow_eq_mul_pow_sub (p : ℕ) {m n : ℕ} (h : m ≤ n) : p ^ m * p ^ (n - m)  = p ^ n :=
by rw [←nat.pow_add, nat.add_sub_cancel' h]

lemma pow_lt_pow_succ {p : ℕ} (h : p > 1) (n : ℕ) : p^n < p^(n+1) :=
suffices p^n*1 < p^n*p, by simpa,
nat.mul_lt_mul_of_pos_left h (nat.pow_pos (lt_of_succ_lt h) n)

lemma lt_pow_self {p : ℕ} (h : p > 1) : ∀ n : ℕ, n < p ^ n
| 0 := by simp [zero_lt_one]
| (n+1) := calc
  n + 1 < p^n + 1 : nat.add_lt_add_right (lt_pow_self _) _
    ... ≤ p ^ (n+1) : pow_lt_pow_succ h _

lemma not_pos_pow_dvd : ∀ {p k : ℕ} (hp : p > 1) (hk : k > 1), ¬ p^k ∣ p
| (succ p) (succ k) hp hk h :=
  have (succ p)^k * succ p ∣ 1 * succ p, by simpa,
  have (succ p) ^ k ∣ 1, from dvd_of_mul_dvd_mul_right (succ_pos _) this,
  have he : (succ p) ^ k = 1, from eq_one_of_dvd_one this,
  have k < (succ p) ^ k, from lt_pow_self hp k,
  have k < 1, by rwa [he] at this,
  have k = 0, from eq_zero_of_le_zero $ le_of_lt_succ this,
  have 1 > 1, by rwa [this] at hk,
  absurd this dec_trivial

@[simp] theorem bodd_div2_eq (n : ℕ) : bodd_div2 n = (bodd n, div2 n) :=
by unfold bodd div2; cases bodd_div2 n; refl

@[simp] lemma bodd_bit0 (n) : bodd (bit0 n) = ff := bodd_bit ff n
@[simp] lemma bodd_bit1 (n) : bodd (bit1 n) = tt := bodd_bit tt n

@[simp] lemma div2_bit0 (n) : div2 (bit0 n) = n := div2_bit ff n
@[simp] lemma div2_bit1 (n) : div2 (bit1 n) = n := div2_bit tt n

/- iterate -/

section
variables {α : Sort*} (op : α → α)

@[simp] theorem iterate_zero (a : α) : op^[0] a = a := rfl

@[simp] theorem iterate_succ (n : ℕ) (a : α) : op^[succ n] a = (op^[n]) (op a) := rfl

theorem iterate_add : ∀ (m n : ℕ) (a : α), op^[m + n] a = (op^[m]) (op^[n] a)
| m 0 a := rfl
| m (succ n) a := iterate_add m n _

theorem iterate_succ' (n : ℕ) (a : α) : op^[succ n] a = op (op^[n] a) :=
by rw [← one_add, iterate_add]; refl

theorem iterate₀ {α : Type u} {op : α → α} {x : α} (H : op x = x) {n : ℕ} :
  op^[n] x = x :=
by induction n; [simp only [iterate_zero], simp only [iterate_succ', H, *]]

theorem iterate₁ {α : Type u} {β : Type v} {op : α → α} {op' : β → β} {op'' : α → β}
  (H : ∀ x, op' (op'' x) = op'' (op x)) {n : ℕ} {x : α} :
  op'^[n] (op'' x) = op'' (op^[n] x) :=
by induction n; [simp only [iterate_zero], simp only [iterate_succ', H, *]]

theorem iterate₂ {α : Type u} {op : α → α} {op' : α → α → α} (H : ∀ x y, op (op' x y) = op' (op x) (op y)) {n : ℕ} {x y : α} :
  op^[n] (op' x y) = op' (op^[n] x) (op^[n] y) :=
by induction n; [simp only [iterate_zero], simp only [iterate_succ', H, *]]

theorem iterate_cancel {α : Type u} {op op' : α → α} (H : ∀ x, op (op' x) = x) {n : ℕ} {x : α} : op^[n] (op'^[n] x) = x :=
by induction n; [refl, rwa [iterate_succ, iterate_succ', H]]

theorem iterate_inj {α : Type u} {op : α → α} (Hinj : function.injective op) (n : ℕ) (x y : α)
  (H : (op^[n] x) = (op^[n] y)) : x = y :=
by induction n with n ih; simp only [iterate_zero, iterate_succ'] at H;
[exact H, exact ih (Hinj H)]

end

/- size and shift -/

theorem shiftl'_ne_zero_left (b) {m} (h : m ≠ 0) (n) : shiftl' b m n ≠ 0 :=
by induction n; simp [shiftl', bit_ne_zero, *]

theorem shiftl'_tt_ne_zero (m) : ∀ {n} (h : n ≠ 0), shiftl' tt m n ≠ 0
| 0        h := absurd rfl h
| (succ n) _ := nat.bit1_ne_zero _

@[simp] theorem size_zero : size 0 = 0 := rfl

@[simp] theorem size_bit {b n} (h : bit b n ≠ 0) : size (bit b n) = succ (size n) :=
begin
  rw size,
  conv { to_lhs, rw [binary_rec], simp [h] },
  rw div2_bit, refl
end

@[simp] theorem size_bit0 {n} (h : n ≠ 0) : size (bit0 n) = succ (size n) :=
@size_bit ff n (nat.bit0_ne_zero h)

@[simp] theorem size_bit1 (n) : size (bit1 n) = succ (size n) :=
@size_bit tt n (nat.bit1_ne_zero n)

@[simp] theorem size_one : size 1 = 1 := by apply size_bit1 0

@[simp] theorem size_shiftl' {b m n} (h : shiftl' b m n ≠ 0) :
  size (shiftl' b m n) = size m + n :=
begin
  induction n with n IH; simp [shiftl'] at h ⊢,
  rw [size_bit h, nat.add_succ],
  by_cases s0 : shiftl' b m n = 0; [skip, rw [IH s0]],
  rw s0 at h ⊢,
  cases b, {exact absurd rfl h},
  have : shiftl' tt m n + 1 = 1 := congr_arg (+1) s0,
  rw [shiftl'_tt_eq_mul_pow] at this,
  have m0 := succ_inj (eq_one_of_dvd_one ⟨_, this.symm⟩),
  subst m0,
  simp at this,
  have : n = 0 := eq_zero_of_le_zero (le_of_not_gt $ λ hn,
    ne_of_gt (pow_lt_pow_of_lt_right dec_trivial hn) this),
  subst n, refl
end

@[simp] theorem size_shiftl {m} (h : m ≠ 0) (n) :
  size (shiftl m n) = size m + n :=
size_shiftl' (shiftl'_ne_zero_left _ h _)

theorem lt_size_self (n : ℕ) : n < 2^size n :=
begin
  rw [← one_shiftl],
  have : ∀ {n}, n = 0 → n < shiftl 1 (size n) :=
    λ n e, by subst e; exact dec_trivial,
  apply binary_rec _ _ n, {apply this rfl},
  intros b n IH,
  by_cases bit b n = 0, {apply this h},
  rw [size_bit h, shiftl_succ],
  exact bit_lt_bit0 _ IH
end

theorem size_le {m n : ℕ} : size m ≤ n ↔ m < 2^n :=
⟨λ h, lt_of_lt_of_le (lt_size_self _) (pow_le_pow_of_le_right dec_trivial h),
begin
  rw [← one_shiftl], revert n,
  apply binary_rec _ _ m,
  { intros n h, apply zero_le },
  { intros b m IH n h,
    by_cases e : bit b m = 0, { rw e, apply zero_le },
    rw [size_bit e],
    cases n with n,
    { exact e.elim (eq_zero_of_le_zero (le_of_lt_succ h)) },
    { apply succ_le_succ (IH _),
      apply lt_imp_lt_of_le_imp_le (λ h', bit0_le_bit _ h') h } }
end⟩

theorem lt_size {m n : ℕ} : m < size n ↔ 2^m ≤ n :=
by rw [← not_lt, iff_not_comm, not_lt, size_le]

theorem size_pos {n : ℕ} : 0 < size n ↔ 0 < n :=
by rw lt_size; refl

theorem size_eq_zero {n : ℕ} : size n = 0 ↔ n = 0 :=
by have := @size_pos n; simp [pos_iff_ne_zero'] at this;
   exact not_iff_not.1 this

theorem size_pow {n : ℕ} : size (2^n) = n+1 :=
le_antisymm
  (size_le.2 $ pow_lt_pow_of_lt_right dec_trivial (lt_succ_self _))
  (lt_size.2 $ le_refl _)

theorem size_le_size {m n : ℕ} (h : m ≤ n) : size m ≤ size n :=
size_le.2 $ lt_of_le_of_lt h (lt_size_self _)

/- factorial -/

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

@[simp] theorem fact_zero : fact 0 = 1 := rfl

@[simp] theorem fact_one : fact 1 = 1 := rfl

@[simp] theorem fact_succ (n) : fact (succ n) = succ n * fact n := rfl

theorem fact_pos : ∀ n, fact n > 0
| 0        := zero_lt_one
| (succ n) := mul_pos (succ_pos _) (fact_pos n)

theorem fact_ne_zero (n : ℕ) : fact n ≠ 0 := ne_of_gt (fact_pos _)

theorem fact_dvd_fact {m n} (h : m ≤ n) : fact m ∣ fact n :=
begin
  induction n with n IH; simp,
  { have := eq_zero_of_le_zero h, subst m, simp },
  { cases eq_or_lt_of_le h with he hl,
    { subst m, simp },
    { apply dvd_mul_of_dvd_right (IH (le_of_lt_succ hl)) } }
end

theorem dvd_fact : ∀ {m n}, m > 0 → m ≤ n → m ∣ fact n
| (succ m) n _ h := dvd_of_mul_right_dvd (fact_dvd_fact h)

theorem fact_le {m n} (h : m ≤ n) : fact m ≤ fact n :=
le_of_dvd (fact_pos _) (fact_dvd_fact h)

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

section find_greatest

/-- `find_greatest P b` is the largest `i ≤ bound` such that `P i` holds, or `0` if no such `i`
exists -/
protected def find_greatest (P : ℕ → Prop) [decidable_pred P] : ℕ → ℕ
| 0       := 0
| (n + 1) := if P (n + 1) then n + 1 else find_greatest n

variables {P : ℕ → Prop} [decidable_pred P]

@[simp] lemma find_greatest_zero : nat.find_greatest P 0 = 0 := rfl

@[simp] lemma find_greatest_eq : ∀{b}, P b → nat.find_greatest P b = b
| 0       h := rfl
| (n + 1) h := by simp [nat.find_greatest, h]

@[simp] lemma find_greatest_of_not {b} (h : ¬ P (b + 1)) :
  nat.find_greatest P (b + 1) = nat.find_greatest P b :=
by simp [nat.find_greatest, h]

lemma find_greatest_spec_and_le :
  ∀{b m}, m ≤ b → P m → P (nat.find_greatest P b) ∧ m ≤ nat.find_greatest P b
| 0       m hm hP :=
  have m = 0, from le_antisymm hm (nat.zero_le _),
  show P 0 ∧ m ≤ 0, from this ▸ ⟨hP, le_refl _⟩
| (b + 1) m hm hP :=
  begin
    by_cases h : P (b + 1),
    { simp [h, hm] },
    { have : m ≠ b + 1 := assume this, h $ this ▸ hP,
      have : m ≤ b := (le_of_not_gt $ assume h : b + 1 ≤ m, this $ le_antisymm hm h),
      have : P (nat.find_greatest P b) ∧ m ≤ nat.find_greatest P b :=
        find_greatest_spec_and_le this hP,
      simp [h, this] }
  end

lemma find_greatest_spec {b} : (∃m, m ≤ b ∧ P m) → P (nat.find_greatest P b)
| ⟨m, hmb, hm⟩ := (find_greatest_spec_and_le hmb hm).1

lemma find_greatest_le : ∀ {b}, nat.find_greatest P b ≤ b
| 0       := le_refl _
| (b + 1) :=
  have nat.find_greatest P b ≤ b + 1, from le_trans find_greatest_le (nat.le_succ b),
  by by_cases P (b + 1); simp [h, this]

lemma le_find_greatest {b m} (hmb : m ≤ b) (hm : P m) : m ≤ nat.find_greatest P b :=
(find_greatest_spec_and_le hmb hm).2

lemma find_greatest_is_greatest {P : ℕ → Prop} [decidable_pred P] {b} :
  (∃ m, m ≤ b ∧ P m) → ∀ k, nat.find_greatest P b < k ∧ k ≤ b → ¬ P k
| ⟨m, hmb, hP⟩ k ⟨hk, hkb⟩ hPk := lt_irrefl k $ lt_of_le_of_lt (le_find_greatest hkb hPk) hk

end find_greatest

section div
lemma dvd_div_of_mul_dvd {a b c : ℕ} (h : a * b ∣ c) : b ∣ c / a :=
if ha : a = 0 then
  by simp [ha]
else
  have ha : a > 0, from nat.pos_of_ne_zero ha,
  have h1 : ∃ d, c = a * b * d, from h,
  let ⟨d, hd⟩ := h1 in
  have hac : a ∣ c, from dvd_of_mul_right_dvd h,
  have h2 : c / a = b * d, from nat.div_eq_of_eq_mul_right ha (by simpa [mul_assoc] using hd),
  show ∃ d, c / a = b * d, from ⟨d, h2⟩

lemma mul_dvd_of_dvd_div {a b c : ℕ} (hab : c ∣ b) (h : a ∣ b / c) : c * a ∣ b :=
have h1 : ∃ d, b / c = a * d, from h,
have h2 : ∃ e, b = c * e, from hab,
let ⟨d, hd⟩ := h1, ⟨e, he⟩ := h2 in
have h3 : b = a * d * c, from
  nat.eq_mul_of_div_eq_left hab hd,
show ∃ d, b = c * a * d, from ⟨d, by cc⟩

lemma div_mul_div {a b c d : ℕ} (hab : b ∣ a) (hcd : d ∣ c) :
      (a / b) * (c / d) = (a * c) / (b * d) :=
have exi1 : ∃ x, a = b * x, from hab,
have exi2 : ∃ y, c = d * y, from hcd,
if hb : b = 0 then by simp [hb]
else have b > 0, from nat.pos_of_ne_zero hb,
if hd : d = 0 then by simp [hd]
else have d > 0, from nat.pos_of_ne_zero hd,
begin
  cases exi1 with x hx, cases exi2 with y hy,
  rw [hx, hy, nat.mul_div_cancel_left, nat.mul_div_cancel_left],
  symmetry,
  apply nat.div_eq_of_eq_mul_left,
  apply mul_pos,
  repeat {assumption},
  cc
end

lemma pow_dvd_of_le_of_pow_dvd {p m n k : ℕ} (hmn : m ≤ n) (hdiv : p ^ n ∣ k) : p ^ m ∣ k :=
have p ^ m ∣ p ^ n, from pow_dvd_pow _ hmn,
dvd_trans this hdiv

lemma dvd_of_pow_dvd {p k m : ℕ} (hk : 1 ≤ k) (hpk : p^k ∣ m) : p ∣ m :=
by rw ←nat.pow_one p; exact pow_dvd_of_le_of_pow_dvd hk hpk

end div

lemma exists_eq_add_of_le : ∀ {m n : ℕ}, m ≤ n → ∃ k : ℕ, n = m + k
| 0 0 h := ⟨0, by simp⟩
| 0 (n+1) h := ⟨n+1, by simp⟩
| (m+1) (n+1) h := let ⟨k, hk⟩ := exists_eq_add_of_le (nat.le_of_succ_le_succ h) in ⟨k, by simp [hk]⟩

lemma exists_eq_add_of_lt : ∀ {m n : ℕ}, m < n → ∃ k : ℕ, n = m + k + 1
| 0 0 h := false.elim $ lt_irrefl _ h
| 0 (n+1) h := ⟨n, by simp⟩
| (m+1) (n+1) h := let ⟨k, hk⟩ := exists_eq_add_of_le (nat.le_of_succ_le_succ h) in ⟨k, by simp [hk]⟩

lemma with_bot.add_eq_zero_iff : ∀ {n m : with_bot ℕ}, n + m = 0 ↔ n = 0 ∧ m = 0
| none     m        := iff_of_false dec_trivial (λ h, absurd h.1 dec_trivial)
| n        none     := iff_of_false (by cases n; exact dec_trivial)
  (λ h, absurd h.2 dec_trivial)
| (some n) (some m) := show (n + m : with_bot ℕ) = (0 : ℕ) ↔ (n : with_bot ℕ) = (0 : ℕ) ∧
    (m : with_bot ℕ) = (0 : ℕ),
  by rw [← with_bot.coe_add, with_bot.coe_eq_coe, with_bot.coe_eq_coe,
    with_bot.coe_eq_coe, add_eq_zero_iff' (nat.zero_le _) (nat.zero_le _)]

lemma with_bot.add_eq_one_iff : ∀ {n m : with_bot ℕ}, n + m = 1 ↔ (n = 0 ∧ m = 1) ∨ (n = 1 ∧ m = 0)
| none     none     := dec_trivial
| none     (some m) := dec_trivial
| (some n) none     := iff_of_false dec_trivial (λ h, h.elim (λ h, absurd h.2 dec_trivial)
  (λ h, absurd h.2 dec_trivial))
| (some n) (some 0) := by erw [with_bot.coe_eq_coe, with_bot.coe_eq_coe, with_bot.coe_eq_coe,
    with_bot.coe_eq_coe]; simp
| (some n) (some (m + 1)) := by erw [with_bot.coe_eq_coe, with_bot.coe_eq_coe, with_bot.coe_eq_coe,
    with_bot.coe_eq_coe, with_bot.coe_eq_coe]; simp [nat.add_succ, nat.succ_inj', nat.succ_ne_zero]

-- induction

@[elab_as_eliminator] lemma le_induction {P : nat → Prop} {m} (h0 : P m) (h1 : ∀ n ≥ m, P n → P (n + 1)) :
  ∀ n ≥ m, P n :=
by apply nat.less_than_or_equal.rec h0; exact h1

end nat


import data.real.basic

variables (a b c d e : ℝ)
#check (min_le_left a b : min a b ≤ a)
#check (min_le_right a b : min a b ≤ b)
#check (le_min : c ≤ a → c ≤ b → c ≤ min a b)

example : min a b = min b a :=
begin
  apply le_antisymm,
  { show min a b ≤ min b a,
    apply le_min,
    apply min_le_right,
    apply min_le_left,},
  { show min b a ≤ min a b,
    apply le_min,
    apply min_le_right,
    apply min_le_left,},
end

#check min

example : min a b = min b a :=
begin
  apply le_antisymm,
  repeat {
    apply le_min,
    apply min_le_right,
    apply min_le_left }
end

example : max a b = max b a :=
begin
  have h : ∀ (x y : ℝ), max x y ≤ max y x := by
  { intros,
    apply max_le,
    apply le_max_right,
    apply le_max_left,},
  apply ge_antisymm,
  repeat {apply h},
end

example : min (min a b) c = min a (min b c) :=
begin
  apply le_antisymm,
  { apply le_min,
    { have h : min a b ≤ a := by apply min_le_left,
      have : min (min a b) c ≤ min a b := by apply min_le_left,
      show min (min a b) c ≤ a,
      apply le_trans this h,},
    { show min (min a b) c ≤ min b c,
      apply le_min,
      { have h : min a b ≤ b := by apply min_le_right,
        have : min (min a b) c ≤ min a b := by apply min_le_left,
        show min (min a b) c ≤ b,
        apply le_trans this h,},
      { show min (min a b) c ≤ c,
        apply min_le_right,},},
    },
  { apply le_min,
    { show min a (min b c) ≤ min a b,
      apply le_min,
      { show min a (min b c) ≤ a,
        apply min_le_left,},
      { show min a (min b c) ≤ b,
        have h : min b c ≤ b := by apply min_le_left,
        have : min a (min b c) ≤ min b c := by apply min_le_right,
        apply le_trans this h,},
      },
    { show min a (min b c) ≤ c,
      have h : min b c ≤ c := by apply min_le_right,
      have : min a (min b c) ≤ min b c := by apply min_le_right,
      apply le_trans this h,},
  },
end

lemma aux : min a b + c ≤ min (a + c) (b + c) :=
begin
  apply le_min,
  { show min a b + c ≤ a + c,
    apply add_le_add_right,
    apply min_le_left,},
  { show min a b + c ≤ b + c,
    apply add_le_add_right,
    apply min_le_right,},
end

example : min a b + c = min (a + c) (b + c) :=
begin
  apply le_antisymm,
  { show min a b + c ≤ min (a + c) (b + c),
    apply aux,},
  { show min (a + c) (b + c) ≤ min a b + c,
    have : min (a + c) (b + c) + -c ≤ min (a + c + -c) (b + c + -c) :=
      by apply aux,
    rw [add_neg_cancel_right a c] at this,
    rw add_neg_cancel_right b at this,
    have : min (a + c) (b + c) + -c + c ≤ min a b + c :=
      by apply add_le_add_right this,
    rw [add_assoc, add_comm (-c) c, ←add_assoc, add_neg_cancel_right] at this,
    exact this,
},
end

#check (abs_add : ∀ a b : ℝ, abs (a + b) ≤ abs a + abs b)

example : |a| - |b| ≤ |a - b| :=
begin
  have : |a| ≤ |a - b| + |b|,
    calc
      |a| = |a - b + b| : by ring_nf
      ... ≤ |a - b| + |b| : by apply abs_add,
  linarith,
end

variables (x y z w : ℕ)

example (h₀ : x ∣ y) (h₁ : y ∣ z) : x ∣ z :=
dvd_trans h₀ h₁

example : x ∣ y * x * z :=
begin
  apply dvd_mul_of_dvd_left,
  apply dvd_mul_left
end

example : x ∣ x^2 :=
by apply dvd_mul_right

example (h : x ∣ w) : x ∣ y * (x * z) + x^2 + w^2 :=
begin
  repeat {apply dvd_add},
  { show x ∣ y * (x * z),
    have : x ∣ (x * z) := by apply dvd_mul_right,
    apply dvd_trans,
    apply dvd_mul_right,
    exact z,
    apply dvd_mul_left,},
  { show x ∣ x^2,
    apply dvd_mul_right,},
  { show x ∣ w^2,
    apply dvd_trans h,
    apply dvd_mul_right,},
end

#check @dvd_trans

variables m n : ℕ
open nat

#check (gcd_zero_right n : gcd n 0 = n)
#check (gcd_zero_left n  : gcd 0 n = n)
#check (lcm_zero_right n : lcm n 0 = 0)
#check (lcm_zero_left n  : lcm 0 n = 0)

example : gcd m n = gcd n m :=
begin
  apply gcd_greatest,
  apply gcd_dvd_right,
  apply gcd_dvd_left,
  { show ∀ e, e ∣ n → e ∣ m → e ∣ gcd m n,
    intros e hn hm,
    apply dvd_gcd hm hn,
  },
end

#check gcd_greatest


import topology.metric_space.basic

namespace playground

class my_add_semigroup (α : Type) :=
(add : α → α → α)
(add_assoc' : ∀ a b c, add (add a b) c = add a (add b c))
(add_comm' : ∀ a b, add a b = add b a)

section
open my_add_semigroup

theorem comm_assoc' {α : Type} [my_add_semigroup α] (a b c : α) :
  add (add a b) c = add c (add b a) :=
begin rw [add_comm' _ c, add_comm' b] end

--set_option old_structure_cmd true
class my_add_group (α : Type) extends my_add_semigroup α :=
(zero : α)
(add_zero' : ∀ a, add a zero = a)

#print my_add_group

open my_add_group

theorem zero_add' {α : Type} [my_add_group α] (a : α) :
  add (zero α) a = a :=
begin rw [add_comm', add_zero'] end

instance : my_add_semigroup ℕ :=
{ add := (+),
  add_assoc' := by intros; simp,
  add_comm' := by intros; simp }

theorem nat_comm_assoc (a b c : ℕ) : (a + b) + c = c + (b + a) :=
comm_assoc' a b c

set_option pp.all true
#print nat_comm_assoc
set_option pp.all false

theorem new_thm {α : Type} [my_add_group α] (a : α) :
  add a a = a :=
sorry

example (α : Type) [my_add_semigroup α] (a : α) : add a a = a :=
begin
  rw new_thm
end

end

#check topological_space
#check @continuous
#check metric_space

example (α : Type) [metric_space α] : continuous (λ x : α, x) :=
continuous_id

class t1 (α : Type) :=
(val1 : α)

class t2 (α : Type) :=
(val2 : ℕ)

class t3 (α : Type) :=
(val3 : α) (val4 : ℕ)

instance inst_t1_of_t3 (α : Type) [t3 α] : t1 α :=
{ val1 := t3.val3 α }

instance inst_t2_of_t3 (α : Type) [t3 α] : t2 α :=
{ val2 := t3.val4 α }

instance t3_int : t3 ℤ :=
{ val3 := -1, val4 := 100 }

#eval t1.val1 ℤ

/- instance inst_t3_of_t1_t2 (α : Type) [t1 α] [t2 α] : t3 α :=
{ val3 := t1.val1 α, val4 := t2.val2 α } -/

example (α : Type) [t1 α] [t2 α] : ℕ := t3.val4 α

set_option trace.class_instances true
example (α : Type) : ℕ := t3.val4 α
set_option trace.class_instances false

instance bad_instance (α β : Type) [has_add β] : t2 α :=
{ val2 := 5 }

set_option trace.class_instances true
#check t2.val2 ℕ
set_option trace.class_instances false

end playground

#check group
#check comm_group
#check ordered_comm_group
#check ring
#check field
#check discrete_field

#check fintype

#check decidable_eq

/-
  Exercise:
  Define a type class for your favorite kind of structure.
  Suggestions: monoids, groups, additive groups, rings, fields

  Define instances of your type class.
-/


-- M40002 (Analysis I) Chapter 6. Differentiation

import M40002.M40002_C5

namespace M40002

-- Definition of a function being differntiable at a point
def is_derivative (f : ℝ → ℝ) (a l : ℝ) := func_converges_to (λ x : ℝ, (f x - f a) / (x - a)) a l
def differentiable_at (f : ℝ → ℝ) (a : ℝ) := ∃ l : ℝ, is_derivative f a l
def differentiable (f : ℝ → ℝ) := ∀ a : ℝ, differentiable_at f a

-- Differentiable at a point implies continuity at a point
theorem diff_at_to_contin_at (f : ℝ → ℝ) (a : ℝ) : differentiable_at f a → func_continuous_at f a :=
begin
  rw func_continuous_at_to_pos,
  rintros ⟨l, hl⟩ ε hε,
  rcases (hl ε hε) with ⟨δ, ⟨hδ₁, hδ₂⟩⟩,
  let ε' : ℝ := ε / (ε + abs(l)),
  have hε' : 0 < ε' := show 0 < ε / (ε + abs l),
    by {apply (lt_div_iff' _).mpr, linarith,
    from lt_add_of_lt_of_nonneg hε (abs_nonneg l)
    },
  let δ' : ℝ := min δ ε',
  have hδ' : 0 < δ' := show 0 < min δ ε',
    by {rw lt_min_iff, from ⟨hδ₁, hε'⟩},
  use δ', use hδ',
  intros x hx,
  suffices : abs (f x - f a) ≤ abs (f x - f a - (x - a) * l) + abs ((x - a) * l),
  swap, have : abs (f x - f a - (x - a) * l + (x - a) * l) = abs (f x - f a) := by simp,
  rw ←this,
  apply abs_add,
    apply lt_of_le_of_lt this,
    have hlt : abs (f x - f a - (x - a) * l) < abs (x - a) * ε :=
      by {rw ←div_lt_iff' hx.left,
      rw ←abs_div,
      convert hδ₂ x (lt_of_lt_of_le hx.right (min_le_left δ ε')),
      show (f x - f a - (x - a) * l) / (x - a) = (f x - f a) / (x - a) - l,
      rw sub_div,
      repeat {rw sub_eq_add_neg <|> rw add_left_inj ((f x + -f a) / (x + -a))},
      rw mul_div_cancel_left, from abs_pos_iff.mp hx.left
      },
    apply lt_of_lt_of_le ((add_lt_add_iff_right (abs ((x - a) * l))).mpr hlt),
    rw [abs_mul, tactic.ring_exp.add_overlap_pf (abs (x - a)) rfl],
    apply le_trans (le_of_lt ((mul_lt_mul_right (lt_add_of_lt_of_nonneg hε (abs_nonneg l))).mpr hx.right)),
    have hδle : δ' * (ε + abs l) ≤ (ε / (ε + abs(l))) * (ε + abs l) :=
      by {rw mul_le_mul_right (lt_add_of_lt_of_nonneg hε (abs_nonneg l)), from min_le_right δ ε'},
    apply le_trans hδle,
    rwa [div_eq_mul_inv, mul_assoc, inv_mul_cancel _], linarith,
    suffices : 0 < ε + abs l, linarith,
    from lt_add_of_lt_of_nonneg hε (abs_nonneg l)
end

-- Cor. Differentiable implies continuity
theorem diff_to_contin (f : ℝ → ℝ) : differentiable f → func_continuous f :=
begin
  intros hdiff a,
  apply diff_at_to_contin_at, from hdiff a
end

-- If f and g are both differentiable then so is f + g
theorem diff_sum_diff_func (f g : ℝ → ℝ)  (hf : differentiable f) (hg : differentiable g) :
differentiable (f + g) :=
begin
  intro a,
  cases hf a with l hl,
  cases hg a with k hk,
  use l + k, unfold is_derivative,
  simp [(show ∀ (x : ℝ), (f x + g x - (f a + g a)) / (x - a) =
    (f x - f a) / (x - a) + (g x - g a) / (x - a), by intro x; ring)],
  exact func_add_func_conv _ _ a l k ⟨hl, hk⟩,
end

-- Local and global maximums and minimums
def local_max (f : ℝ → ℝ) (x₀ : ℝ) := ∃ δ > 0, ∀ x ∈ open_interval (x₀ - δ) (x₀ + δ), f x₀ < f x
def local_min (f : ℝ → ℝ) (x₀ : ℝ) := ∃ δ > 0, ∀ x ∈ open_interval (x₀ - δ) (x₀ + δ), f x < f x₀

def global_max (f : ℝ → ℝ) (x₀ : ℝ) := ∀ x : ℝ, f x₀ < f x
def global_min (f : ℝ → ℝ) (x₀ : ℝ) := ∀ x : ℝ, f x < f x₀

theorem global_max_is_local_max {f : ℝ → ℝ} {x₀ : ℝ} : global_max f x₀ → local_max f x₀ :=
begin
  intro hgmax,
  use 1,
  split, norm_num,
  intros x hx,
  from hgmax x
end

theorem global_min_is_local_min {f : ℝ → ℝ} {x₀ : ℝ} : global_min f x₀ → local_min f x₀ :=
begin
  intro hgmix,
  use 1,
  split, norm_num,
  intros x hx,
  from hgmix x
end

-- Fermat's theorem
theorem local_min_diff_zero {f : ℝ → ℝ} {x₀ : ℝ} (h : local_min f x₀) :
differentiable_at f x₀ → is_derivative f x₀ 0 := sorry

end M40002


theorem T1_1 {A B : Prop} (ha : A ) (hb : B ) : (B /\ A) /\ B :=
 and.intro (and.intro hb ha) hb

theorem T1_2 {A : Prop} (ha : A )  : A /\ A :=
 and.intro ha ha

theorem T2_1 {A B : Prop} (h : A /\ B)  : B /\ A :=
  and.intro (and.right h) (and.left h)

theorem T3_1 {A B C: Prop} (h : A )  : C \/  (A \/ B) :=
   or.inr (or.inl h)

theorem T4_1 {A : Prop}  : A ->  ( A /\ A) :=
 assume (h : A), and.intro h h

theorem T5_1 {A B C : Prop}  : ((A /\ B) \/ C) -> ((A /\ B) \/ C)   :=
 assume (h : ((A /\ B) \/ C) ), h

 theorem T5_2 {A B : Prop}  : B -> (A -> A)   :=
 assume (hb :B), assume (ha :A), ha

 theorem T6_1 {A : Prop}  : A -> A   :=
 assume (ha :A), ha

theorem T7_1 {A B : Prop}  : A -> (B -> A)  :=
  assume (ha : A), assume (hb : B), ha

theorem T8_1 {A B : Prop} (h1 : A)  (h2 : (A -> B) ) : B:=
  h2 h1

theorem T9_1 {A B : Prop} (h: A \/  B) : B \/  A :=
  or.elim
    h
    (assume (h1 : A ), or.inr h1)
    (assume (h1 : B ), or.inl h1)

theorem T9_2 {A : Prop} (h: A \/  A) : A :=
  or.elim
    h
    (assume (h1 : A ), h1)
    (assume (h1 : A ), h1)

theorem T10_1 {A B: Prop} (h1: A) (h2: A <-> B): B :=
  iff.elim_left h2 h1

theorem T11_1 {A B: Prop} (h: A /\ not A ) : B :=
  show B, from false.elim ((and.right h) (and.left h))


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import data.nat.sqrt
import data.set.lattice
import algebra.group.prod
import algebra.order.monoid.min_max

/-!
#  Naturals pairing function

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

This file defines a pairing function for the naturals as follows:
```text
 0  1  4  9 16
 2  3  5 10 17
 6  7  8 11 18
12 13 14 15 19
20 21 22 23 24
```

It has the advantage of being monotone in both directions and sending `⟦0, n^2 - 1⟧` to
`⟦0, n - 1⟧²`.
-/

open prod decidable function

namespace nat

/-- Pairing function for the natural numbers. -/
@[pp_nodot] def mkpair (a b : ℕ) : ℕ :=
if a < b then b*b + a else a*a + a + b

/-- Unpairing function for the natural numbers. -/
@[pp_nodot] def unpair (n : ℕ) : ℕ × ℕ :=
let s := sqrt n in
if n - s*s < s then (n - s*s, s) else (s, n - s*s - s)

@[simp] theorem mkpair_unpair (n : ℕ) : mkpair (unpair n).1 (unpair n).2 = n :=
begin
  dsimp only [unpair], set s := sqrt n,
  have sm : s * s + (n - s * s) = n := add_tsub_cancel_of_le (sqrt_le _),
  split_ifs,
  { simp [mkpair, h, sm] },
  { have hl : n - s*s - s ≤ s :=
      tsub_le_iff_left.mpr (tsub_le_iff_left.mpr $
      by rw ← add_assoc; apply sqrt_le_add),
    simp [mkpair, hl.not_lt, add_assoc, add_tsub_cancel_of_le (le_of_not_gt h), sm] }
end

theorem mkpair_unpair' {n a b} (H : unpair n = (a, b)) : mkpair a b = n :=
by simpa [H] using mkpair_unpair n

@[simp] theorem unpair_mkpair (a b : ℕ) : unpair (mkpair a b) = (a, b) :=
begin
  dunfold mkpair, split_ifs,
  { show unpair (b * b + a) = (a, b),
    have be : sqrt (b * b + a) = b,
      from sqrt_add_eq _ (le_trans (le_of_lt h) (nat.le_add_left _ _)),
    simp [unpair, be, add_tsub_cancel_right, h] },
  { show unpair (a * a + a + b) = (a, b),
    have ae : sqrt (a * a + (a + b)) = a,
    { rw sqrt_add_eq, exact add_le_add_left (le_of_not_gt h) _ },
    simp [unpair, ae, nat.not_lt_zero, add_assoc] }
end

/-- An equivalence between `ℕ × ℕ` and `ℕ`. -/
@[simps { fully_applied := ff }] def mkpair_equiv : ℕ × ℕ ≃ ℕ :=
⟨uncurry mkpair, unpair, λ ⟨a, b⟩, unpair_mkpair a b, mkpair_unpair⟩

lemma surjective_unpair : surjective unpair :=
mkpair_equiv.symm.surjective

@[simp] lemma mkpair_eq_mkpair {a b c d : ℕ} : mkpair a b = mkpair c d ↔ a = c ∧ b = d :=
mkpair_equiv.injective.eq_iff.trans (@prod.ext_iff ℕ ℕ (a, b) (c, d))

theorem unpair_lt {n : ℕ} (n1 : 1 ≤ n) : (unpair n).1 < n :=
let s := sqrt n in begin
  simp [unpair], change sqrt n with s,
  by_cases h : n - s * s < s; simp [h],
  { exact lt_of_lt_of_le h (sqrt_le_self _) },
  { simp at h,
    have s0 : 0 < s := sqrt_pos.2 n1,
    exact lt_of_le_of_lt h (tsub_lt_self n1 (mul_pos s0 s0)) }
end

@[simp] lemma unpair_zero : unpair 0 = 0 :=
by { rw unpair, simp }

theorem unpair_left_le : ∀ (n : ℕ), (unpair n).1 ≤ n
| 0     := by simp
| (n+1) := le_of_lt (unpair_lt (nat.succ_pos _))

theorem left_le_mkpair (a b : ℕ) : a ≤ mkpair a b :=
by simpa using unpair_left_le (mkpair a b)

theorem right_le_mkpair (a b : ℕ) : b ≤ mkpair a b :=
begin
  by_cases h : a < b; simp [mkpair, h],
  exact le_trans (le_mul_self _) (nat.le_add_right _ _)
end

theorem unpair_right_le (n : ℕ) : (unpair n).2 ≤ n :=
by simpa using right_le_mkpair n.unpair.1 n.unpair.2

theorem mkpair_lt_mkpair_left {a₁ a₂} (b) (h : a₁ < a₂) : mkpair a₁ b < mkpair a₂ b :=
begin
  by_cases h₁ : a₁ < b; simp [mkpair, h₁, add_assoc],
  { by_cases h₂ : a₂ < b; simp [mkpair, h₂, h],
    simp at h₂,
    apply add_lt_add_of_le_of_lt,
    exact mul_self_le_mul_self h₂,
    exact lt_add_right _ _ _ h },
  { simp at h₁,
    simp [not_lt_of_gt (lt_of_le_of_lt h₁ h)],
    apply add_lt_add,
    exact mul_self_lt_mul_self h,
    apply add_lt_add_right; assumption }
end

theorem mkpair_lt_mkpair_right (a) {b₁ b₂} (h : b₁ < b₂) : mkpair a b₁ < mkpair a b₂ :=
begin
  by_cases h₁ : a < b₁; simp [mkpair, h₁, add_assoc],
  { simp [mkpair, lt_trans h₁ h, h],
    exact mul_self_lt_mul_self h },
  { by_cases h₂ : a < b₂; simp [mkpair, h₂, h],
    simp at h₁,
    rw [add_comm, add_comm _ a, add_assoc, add_lt_add_iff_left],
    rwa [add_comm, ← sqrt_lt, sqrt_add_eq],
    exact le_trans h₁ (nat.le_add_left _ _) }
end

theorem mkpair_lt_max_add_one_sq (m n : ℕ) : mkpair m n < (max m n + 1) ^ 2 :=
begin
  rw [mkpair, add_sq, mul_one, two_mul, sq, add_assoc, add_assoc],
  cases lt_or_le m n,
  { rw [if_pos h, max_eq_right h.le, add_lt_add_iff_left, add_assoc],
    exact h.trans_le (self_le_add_right n _) },
  { rw [if_neg h.not_lt, max_eq_left h, add_lt_add_iff_left, add_assoc, add_lt_add_iff_left],
    exact lt_succ_of_le h }
end

theorem max_sq_add_min_le_mkpair (m n : ℕ) : max m n ^ 2 + min m n ≤ mkpair m n :=
begin
  rw mkpair,
  cases lt_or_le m n,
  { rw [if_pos h, max_eq_right h.le, min_eq_left h.le, sq], },
  { rw [if_neg h.not_lt, max_eq_left h, min_eq_right h, sq, add_assoc, add_le_add_iff_left],
    exact le_add_self }
end

theorem add_le_mkpair (m n : ℕ) : m + n ≤ mkpair m n :=
(max_sq_add_min_le_mkpair _ _).trans' $
  by { rw [sq, ←min_add_max, add_comm, add_le_add_iff_right], exact le_mul_self _ }

theorem unpair_add_le (n : ℕ) : (unpair n).1 + (unpair n).2 ≤ n :=
(add_le_mkpair _ _).trans_eq (mkpair_unpair _)

end nat
open nat

section complete_lattice

lemma supr_unpair {α} [complete_lattice α] (f : ℕ → ℕ → α) :
  (⨆ n : ℕ, f n.unpair.1 n.unpair.2) = ⨆ i j : ℕ, f i j :=
by rw [← (supr_prod : (⨆ i : ℕ × ℕ, f i.1 i.2) = _), ← nat.surjective_unpair.supr_comp]

lemma infi_unpair {α} [complete_lattice α] (f : ℕ → ℕ → α) :
  (⨅ n : ℕ, f n.unpair.1 n.unpair.2) = ⨅ i j : ℕ, f i j :=
supr_unpair (show ℕ → ℕ → αᵒᵈ, from f)

end complete_lattice

namespace set

lemma Union_unpair_prod {α β} {s : ℕ → set α} {t : ℕ → set β} :
  (⋃ n : ℕ, s n.unpair.fst ×ˢ t n.unpair.snd) = (⋃ n, s n) ×ˢ (⋃ n, t n) :=
by { rw [← Union_prod], convert surjective_unpair.Union_comp _, refl }

lemma Union_unpair {α} (f : ℕ → ℕ → set α) :
  (⋃ n : ℕ, f n.unpair.1 n.unpair.2) = ⋃ i j : ℕ, f i j :=
supr_unpair f

lemma Inter_unpair {α} (f : ℕ → ℕ → set α) :
  (⋂ n : ℕ, f n.unpair.1 n.unpair.2) = ⋂ i j : ℕ, f i j :=
infi_unpair f

end set


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.eval
import tactic.interval_cases

/-!
# Theory of degrees of polynomials

Some of the main results include
- `nat_degree_comp_le` : The degree of the composition is at most the product of degrees

-/

noncomputable theory
open_locale classical

open finsupp finset

namespace polynomial
universes u v w
variables {R : Type u} {S : Type v} { ι : Type w} {a b : R} {m n : ℕ}

section semiring
variables [semiring R] {p q r : polynomial R}

section degree

lemma nat_degree_comp_le : nat_degree (p.comp q) ≤ nat_degree p * nat_degree q :=
if h0 : p.comp q = 0 then by rw [h0, nat_degree_zero]; exact nat.zero_le _
else with_bot.coe_le_coe.1 $
  calc ↑(nat_degree (p.comp q)) = degree (p.comp q) : (degree_eq_nat_degree h0).symm
  ... = _ : congr_arg degree comp_eq_sum_left
  ... ≤ _ : degree_sum_le _ _
  ... ≤ _ : sup_le (λ n hn,
    calc degree (C (coeff p n) * q ^ n)
        ≤ degree (C (coeff p n)) + degree (q ^ n) : degree_mul_le _ _
    ... ≤ nat_degree (C (coeff p n)) + n • (degree q) :
      add_le_add degree_le_nat_degree (degree_pow_le _ _)
    ... ≤ nat_degree (C (coeff p n)) + n • (nat_degree q) :
      add_le_add_left (nsmul_le_nsmul_of_le_right (@degree_le_nat_degree _ _ q) n) _
    ... = (n * nat_degree q : ℕ) :
     by rw [nat_degree_C, with_bot.coe_zero, zero_add, ← with_bot.coe_nsmul,
       nsmul_eq_mul]; simp
    ... ≤ (nat_degree p * nat_degree q : ℕ) : with_bot.coe_le_coe.2 $
      mul_le_mul_of_nonneg_right
        (le_nat_degree_of_ne_zero (mem_support_iff.1 hn))
        (nat.zero_le _))

lemma degree_pos_of_root {p : polynomial R} (hp : p ≠ 0) (h : is_root p a) : 0 < degree p :=
lt_of_not_ge $ λ hlt, begin
  have := eq_C_of_degree_le_zero hlt,
  rw [is_root, this, eval_C] at h,
  simp only [h, ring_hom.map_zero] at this,
  exact hp this,
end

lemma nat_degree_le_iff_coeff_eq_zero :
  p.nat_degree ≤ n ↔ ∀ N : ℕ, n < N → p.coeff N = 0 :=
by simp_rw [nat_degree_le_iff_degree_le, degree_le_iff_coeff_zero, with_bot.coe_lt_coe]

lemma nat_degree_C_mul_le (a : R) (f : polynomial R) :
  (C a * f).nat_degree ≤ f.nat_degree :=
calc
  (C a * f).nat_degree ≤ (C a).nat_degree + f.nat_degree : nat_degree_mul_le
  ... = 0 + f.nat_degree : by rw nat_degree_C a
  ... = f.nat_degree : zero_add _

lemma nat_degree_mul_C_le (f : polynomial R) (a : R) :
  (f * C a).nat_degree ≤ f.nat_degree :=
calc
  (f * C a).nat_degree ≤ f.nat_degree + (C a).nat_degree : nat_degree_mul_le
  ... = f.nat_degree + 0 : by rw nat_degree_C a
  ... = f.nat_degree : add_zero _

lemma eq_nat_degree_of_le_mem_support (pn : p.nat_degree ≤ n) (ns : n ∈ p.support) :
  p.nat_degree = n :=
le_antisymm pn (le_nat_degree_of_mem_supp _ ns)

lemma nat_degree_C_mul_eq_of_mul_eq_one {ai : R} (au : ai * a = 1) :
  (C a * p).nat_degree = p.nat_degree :=
le_antisymm (nat_degree_C_mul_le a p) (calc
  p.nat_degree = (1 * p).nat_degree : by nth_rewrite 0 [← one_mul p]
  ... = (C ai * (C a * p)).nat_degree : by rw [← C_1, ← au, ring_hom.map_mul, ← mul_assoc]
  ... ≤ (C a * p).nat_degree : nat_degree_C_mul_le ai (C a * p))

lemma nat_degree_mul_C_eq_of_mul_eq_one {ai : R} (au : a * ai = 1) :
  (p * C a).nat_degree = p.nat_degree :=
le_antisymm (nat_degree_mul_C_le p a) (calc
  p.nat_degree = (p * 1).nat_degree : by nth_rewrite 0 [← mul_one p]
  ... = ((p * C a) * C ai).nat_degree : by rw [← C_1, ← au, ring_hom.map_mul, ← mul_assoc]
  ... ≤ (p * C a).nat_degree : nat_degree_mul_C_le (p * C a) ai)

/-- Although not explicitly stated, the assumptions of lemma `nat_degree_mul_C_eq_of_mul_ne_zero`
force the polynomial `p` to be non-zero, via `p.leading_coeff ≠ 0`.
Lemma `nat_degree_mul_C_eq_of_no_zero_divisors` below separates cases, in order to overcome this
hurdle.
-/
lemma nat_degree_mul_C_eq_of_mul_ne_zero (h : p.leading_coeff * a ≠ 0) :
  (p * C a).nat_degree = p.nat_degree :=
begin
  refine eq_nat_degree_of_le_mem_support (nat_degree_mul_C_le p a) _,
  refine mem_support_iff.mpr _,
  rwa coeff_mul_C,
end

/-- Although not explicitly stated, the assumptions of lemma `nat_degree_C_mul_eq_of_mul_ne_zero`
force the polynomial `p` to be non-zero, via `p.leading_coeff ≠ 0`.
Lemma `nat_degree_C_mul_eq_of_no_zero_divisors` below separates cases, in order to overcome this
hurdle.
-/
lemma nat_degree_C_mul_eq_of_mul_ne_zero (h : a * p.leading_coeff ≠ 0) :
  (C a * p).nat_degree = p.nat_degree :=
begin
  refine eq_nat_degree_of_le_mem_support (nat_degree_C_mul_le a p) _,
  refine mem_support_iff.mpr _,
  rwa coeff_C_mul,
end

lemma nat_degree_add_coeff_mul (f g : polynomial R) :
  (f * g).coeff (f.nat_degree + g.nat_degree) = f.coeff f.nat_degree * g.coeff g.nat_degree :=
by simp only [coeff_nat_degree, coeff_mul_degree_add_degree]

lemma nat_degree_lt_coeff_mul (h : p.nat_degree + q.nat_degree < m + n) :
  (p * q).coeff (m + n) = 0 :=
coeff_eq_zero_of_nat_degree_lt (nat_degree_mul_le.trans_lt h)

variables [semiring S]

lemma nat_degree_pos_of_eval₂_root {p : polynomial R} (hp : p ≠ 0) (f : R →+* S)
  {z : S} (hz : eval₂ f z p = 0) (inj : ∀ (x : R), f x = 0 → x = 0) :
  0 < nat_degree p :=
lt_of_not_ge $ λ hlt, begin
  have A : p = C (p.coeff 0) := eq_C_of_nat_degree_le_zero hlt,
  rw [A, eval₂_C] at hz,
  simp only [inj (p.coeff 0) hz, ring_hom.map_zero] at A,
  exact hp A
end

lemma degree_pos_of_eval₂_root {p : polynomial R} (hp : p ≠ 0) (f : R →+* S)
  {z : S} (hz : eval₂ f z p = 0) (inj : ∀ (x : R), f x = 0 → x = 0) :
  0 < degree p :=
nat_degree_pos_iff_degree_pos.mp (nat_degree_pos_of_eval₂_root hp f hz inj)

@[simp] lemma coe_lt_degree {p : polynomial R} {n : ℕ} :
  ((n : with_bot ℕ) < degree p) ↔ n < nat_degree p :=
begin
  by_cases h : p = 0,
  { simp [h] },
  rw [degree_eq_nat_degree h, with_bot.coe_lt_coe],
end

end degree
end semiring

section no_zero_divisors
variables [semiring R] [no_zero_divisors R] {p q : polynomial R}

lemma nat_degree_mul_C_eq_of_no_zero_divisors (a0 : a ≠ 0) :
  (p * C a).nat_degree = p.nat_degree :=
begin
  by_cases p0 : p = 0,
  { rw [p0, zero_mul] },
  { exact nat_degree_mul_C_eq_of_mul_ne_zero (mul_ne_zero (leading_coeff_ne_zero.mpr p0) a0) }
end

lemma nat_degree_C_mul_eq_of_no_zero_divisors (a0 : a ≠ 0) :
  (C a * p).nat_degree = p.nat_degree :=
begin
  by_cases p0 : p = 0,
  { rw [p0, mul_zero] },
  { exact nat_degree_C_mul_eq_of_mul_ne_zero (mul_ne_zero a0 (leading_coeff_ne_zero.mpr p0)) }
end

end no_zero_divisors

end polynomial