/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.hom.group_action
import group_theory.group_action.defs
import group_theory.group_action.group
import data.setoid.basic
import data.fintype.card

/-!
# Basic properties of group actions

This file primarily concerns itself with orbits, stabilizers, and other objects defined in terms of
actions. Despite this file being called `basic`, low-level helper lemmas for algebraic manipulation
of `•` belong elsewhere.

## Main definitions

* `mul_action.orbit`
* `mul_action.fixed_points`
* `mul_action.fixed_by`
* `mul_action.stabilizer`

-/

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

open_locale big_operators pointwise
open function

namespace mul_action

variables (α) [monoid α] [mul_action α β]

/-- The orbit of an element under an action. -/
@[to_additive "The orbit of an element under an action."]
def orbit (b : β) := set.range (λ x : α, x • b)

variable {α}

@[to_additive] lemma mem_orbit_iff {b₁ b₂ : β} : b₂ ∈ orbit α b₁ ↔ ∃ x : α, x • b₁ = b₂ :=
iff.rfl

@[simp, to_additive] lemma mem_orbit (b : β) (x : α) : x • b ∈ orbit α b :=
⟨x, rfl⟩

@[simp, to_additive] lemma mem_orbit_self (b : β) : b ∈ orbit α b :=
⟨1, by simp [mul_action.one_smul]⟩

@[to_additive] lemma orbit_nonempty (b : β) : set.nonempty (orbit α b) := set.range_nonempty _

@[to_additive] lemma maps_to_smul_orbit (a : α) (b : β) :
  set.maps_to ((•) a) (orbit α b) (orbit α b) :=
set.range_subset_iff.2 $ λ a', ⟨a * a', mul_smul _ _ _⟩

@[to_additive] lemma smul_orbit_subset (a : α) (b : β) : a • orbit α b ⊆ orbit α b :=
(maps_to_smul_orbit a b).image_subset

@[to_additive] lemma orbit_smul_subset (a : α) (b : β) : orbit α (a • b) ⊆ orbit α b :=
set.range_subset_iff.2 $ λ a', mul_smul a' a b ▸ mem_orbit _ _

@[to_additive] instance {b : β} : mul_action α (orbit α b) :=
{ smul := λ a, (maps_to_smul_orbit a b).restrict _ _ _,
  one_smul := λ a, subtype.ext (one_smul α a),
  mul_smul := λ a a' b', subtype.ext (mul_smul a a' b') }

@[simp, to_additive] lemma orbit.coe_smul {b : β} {a : α} {b' : orbit α b} :
  ↑(a • b') = a • (b' : β) :=
rfl

variables (α) (β)

/-- The set of elements fixed under the whole action. -/
@[to_additive "The set of elements fixed under the whole action."]
def fixed_points : set β := {b : β | ∀ x : α, x • b = b}

/-- `fixed_by g` is the subfield of elements fixed by `g`. -/
@[to_additive "`fixed_by g` is the subfield of elements fixed by `g`."]
def fixed_by (g : α) : set β :=
{ x | g • x = x }

@[to_additive] theorem fixed_eq_Inter_fixed_by : fixed_points α β = ⋂ g : α, fixed_by α β g :=
set.ext $ λ x, ⟨λ hx, set.mem_Inter.2 $ λ g, hx g, λ hx g, by exact (set.mem_Inter.1 hx g : _)⟩

variables {α} (β)

@[simp, to_additive] lemma mem_fixed_points {b : β} :
  b ∈ fixed_points α β ↔ ∀ x : α, x • b = b := iff.rfl

@[simp, to_additive] lemma mem_fixed_by {g : α} {b : β} :
  b ∈ fixed_by α β g ↔ g • b = b := iff.rfl

@[to_additive] lemma mem_fixed_points' {b : β} : b ∈ fixed_points α β ↔
  (∀ b', b' ∈ orbit α b → b' = b) :=
⟨λ h b h₁, let ⟨x, hx⟩ := mem_orbit_iff.1 h₁ in hx ▸ h x,
λ h b, h _ (mem_orbit _ _)⟩

variables (α) {β}

/-- The stabilizer of a point `b` as a submonoid of `α`. -/
@[to_additive "The stabilizer of a point `b` as an additive submonoid of `α`."]
def stabilizer.submonoid (b : β) : submonoid α :=
{ carrier := { a | a • b = b },
  one_mem' := one_smul _ b,
  mul_mem' := λ a a' (ha : a • b = b) (hb : a' • b = b),
    show (a * a') • b = b, by rw [←smul_smul, hb, ha] }

@[simp, to_additive] lemma mem_stabilizer_submonoid_iff {b : β} {a : α} :
  a ∈ stabilizer.submonoid α b ↔ a • b = b := iff.rfl

@[to_additive] lemma orbit_eq_univ [is_pretransitive α β] (x : β) :
  orbit α x = set.univ :=
(surjective_smul α x).range_eq

variables {α} {β}

@[to_additive] lemma mem_fixed_points_iff_card_orbit_eq_one {a : β}
  [fintype (orbit α a)] : a ∈ fixed_points α β ↔ fintype.card (orbit α a) = 1 :=
begin
  rw [fintype.card_eq_one_iff, mem_fixed_points],
  split,
  { exact λ h, ⟨⟨a, mem_orbit_self _⟩, λ ⟨b, ⟨x, hx⟩⟩, subtype.eq $ by simp [h x, hx.symm]⟩ },
  { assume h x,
    rcases h with ⟨⟨z, hz⟩, hz₁⟩,
    calc x • a = z : subtype.mk.inj (hz₁ ⟨x • a, mem_orbit _ _⟩)
      ... = a : (subtype.mk.inj (hz₁ ⟨a, mem_orbit_self _⟩)).symm }
end

end mul_action

namespace mul_action
variable (α)
variables [group α] [mul_action α β]

/-- The stabilizer of an element under an action, i.e. what sends the element to itself.
A subgroup. -/
@[to_additive "The stabilizer of an element under an action, i.e. what sends the element to itself.
An additive subgroup."]
def stabilizer (b : β) : subgroup α :=
{ inv_mem' := λ a (ha : a • b = b), show a⁻¹ • b = b, by rw [inv_smul_eq_iff, ha]
  ..stabilizer.submonoid α b }

variables {α} {β}

@[simp, to_additive] lemma mem_stabilizer_iff {b : β} {a : α} :
  a ∈ stabilizer α b ↔ a • b = b := iff.rfl

@[simp, to_additive] lemma smul_orbit (a : α) (b : β) :
  a • orbit α b = orbit α b :=
(smul_orbit_subset a b).antisymm $
  calc orbit α b = a • a⁻¹ • orbit α b : (smul_inv_smul _ _).symm
             ... ⊆ a • orbit α b       : set.image_subset _ (smul_orbit_subset _ _)

@[simp, to_additive] lemma orbit_smul (a : α) (b : β) : orbit α (a • b) = orbit α b :=
(orbit_smul_subset a b).antisymm $
  calc orbit α b = orbit α (a⁻¹ • a • b) : by rw inv_smul_smul
             ... ⊆ orbit α (a • b)       : orbit_smul_subset _ _

/-- The action of a group on an orbit is transitive. -/
@[to_additive "The action of an additive group on an orbit is transitive."]
instance (x : β) : is_pretransitive α (orbit α x) :=
⟨by { rintro ⟨_, a, rfl⟩ ⟨_, b, rfl⟩, use b * a⁻¹, ext1, simp [mul_smul] }⟩

@[to_additive] lemma orbit_eq_iff {a b : β} :
   orbit α a = orbit α b ↔ a ∈ orbit α b:=
⟨λ h, h ▸ mem_orbit_self _, λ ⟨c, hc⟩, hc ▸ orbit_smul _ _⟩

variables (α) {β}

@[to_additive] lemma mem_orbit_smul (g : α) (a : β) : a ∈ orbit α (g • a) :=
by simp only [orbit_smul, mem_orbit_self]

@[to_additive] lemma smul_mem_orbit_smul (g h : α) (a : β) : g • a ∈ orbit α (h • a) :=
by simp only [orbit_smul, mem_orbit]

variables (α) (β)
/-- The relation 'in the same orbit'. -/
@[to_additive "The relation 'in the same orbit'."]
def orbit_rel : setoid β :=
{ r := λ a b, a ∈ orbit α b,
  iseqv := ⟨mem_orbit_self, λ a b, by simp [orbit_eq_iff.symm, eq_comm],
    λ a b, by simp [orbit_eq_iff.symm, eq_comm] {contextual := tt}⟩ }

local attribute [instance] orbit_rel

variables {α} {β}
/-- When you take a set `U` in `β`, push it down to the quotient, and pull back, you get the union
of the orbit of `U` under `α`.
-/
@[to_additive] lemma quotient_preimage_image_eq_union_mul (U : set β) :
  quotient.mk ⁻¹' (quotient.mk '' U) = ⋃ a : α, ((•) a) '' U :=
begin
  set f : β → quotient (mul_action.orbit_rel α β) := quotient.mk,
  ext,
  split,
  { rintros ⟨y , hy, hxy⟩,
    obtain ⟨a, rfl⟩ := quotient.exact hxy,
    rw set.mem_Union,
    exact ⟨a⁻¹, a • x, hy, inv_smul_smul a x⟩ },
  { intros hx,
    rw set.mem_Union at hx,
    obtain ⟨a, u, hu₁, hu₂⟩ := hx,
    rw [set.mem_preimage, set.mem_image_iff_bex],
    refine ⟨a⁻¹ • x, _, by simp only [quotient.eq]; use a⁻¹⟩,
    rw ← hu₂,
    convert hu₁,
    simp only [inv_smul_smul], },
end

@[to_additive] lemma disjoint_image_image_iff {U V : set β} :
  disjoint (quotient.mk '' U) (quotient.mk '' V) ↔ ∀ x ∈ U, ∀ a : α, a • x ∉ V :=
begin
  set f : β → quotient (mul_action.orbit_rel α β) := quotient.mk,
  refine ⟨λ h x x_in_U a a_in_V, h ⟨⟨x, x_in_U, quotient.sound ⟨a⁻¹, _⟩⟩, ⟨a • x, a_in_V, rfl⟩⟩, _⟩,
  { simp },
  { rintro h x ⟨⟨y, hy₁, hy₂⟩, ⟨z, hz₁, hz₂⟩⟩,
    obtain ⟨a, rfl⟩ := quotient.exact (hz₂.trans hy₂.symm),
    exact h y hy₁ a hz₁ }
end

@[to_additive]
lemma image_inter_image_iff (U V : set β) :
  (quotient.mk '' U) ∩ (quotient.mk '' V) = ∅ ↔ ∀ x ∈ U, ∀ a : α, a • x ∉ V :=
set.disjoint_iff_inter_eq_empty.symm.trans disjoint_image_image_iff

variables (α) (β)
local notation `Ω` := (quotient $ orbit_rel α β)

/-- Decomposition of a type `X` as a disjoint union of its orbits under a group action.
This version works with any right inverse to `quotient.mk'` in order to stay computable. In most
cases you'll want to use `quotient.out'`, so we provide `mul_action.self_equiv_sigma_orbits` as
a special case. -/
@[to_additive "Decomposition of a type `X` as a disjoint union of its orbits under an additive group
action. This version works with any right inverse to `quotient.mk'` in order to stay computable.
In most cases you'll want to use `quotient.out'`, so we provide `add_action.self_equiv_sigma_orbits`
as a special case."]
def self_equiv_sigma_orbits' {φ : Ω → β} (hφ : right_inverse φ quotient.mk') :
  β ≃ Σ (ω : Ω), orbit α (φ ω) :=
calc  β
    ≃ Σ (ω : Ω), {b // quotient.mk' b = ω} : (equiv.sigma_fiber_equiv quotient.mk').symm
... ≃ Σ (ω : Ω), orbit α (φ ω) :
        equiv.sigma_congr_right (λ ω, equiv.subtype_equiv_right $
          λ x, by {rw [← hφ ω, quotient.eq', hφ ω], refl })

/-- Decomposition of a type `X` as a disjoint union of its orbits under a group action. -/
@[to_additive "Decomposition of a type `X` as a disjoint union of its orbits under an additive group
action."]
noncomputable def self_equiv_sigma_orbits : β ≃ Σ (ω : Ω), orbit α ω.out' :=
self_equiv_sigma_orbits' α β quotient.out_eq'

variables {α β}

/-- If the stabilizer of `x` is `S`, then the stabilizer of `g • x` is `gSg⁻¹`. -/
lemma stabilizer_smul_eq_stabilizer_map_conj (g : α) (x : β) :
  (stabilizer α (g • x) = (stabilizer α x).map (mul_aut.conj g).to_monoid_hom) :=
begin
  ext h,
  rw [mem_stabilizer_iff, ← smul_left_cancel_iff g⁻¹, smul_smul, smul_smul, smul_smul, mul_left_inv,
      one_smul, ← mem_stabilizer_iff, subgroup.mem_map_equiv, mul_aut.conj_symm_apply]
end

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizer_equiv_stabilizer_of_orbit_rel {x y : β} (h : (orbit_rel α β).rel x y) :
  stabilizer α x ≃* stabilizer α y :=
let g : α := classical.some h in
have hg : g • y = x := classical.some_spec h,
have this : stabilizer α x = (stabilizer α y).map (mul_aut.conj g).to_monoid_hom,
  by rw [← hg, stabilizer_smul_eq_stabilizer_map_conj],
(mul_equiv.subgroup_congr this).trans ((mul_aut.conj g).subgroup_map $ stabilizer α y).symm

end mul_action

namespace add_action

variables [add_group α] [add_action α β]

/-- If the stabilizer of `x` is `S`, then the stabilizer of `g +ᵥ x` is `g + S + (-g)`. -/
lemma stabilizer_vadd_eq_stabilizer_map_conj (g : α) (x : β) :
  (stabilizer α (g +ᵥ x) = (stabilizer α x).map (add_aut.conj g).to_add_monoid_hom) :=
begin
  ext h,
  rw [mem_stabilizer_iff, ← vadd_left_cancel_iff (-g) , vadd_vadd, vadd_vadd, vadd_vadd,
      add_left_neg, zero_vadd, ← mem_stabilizer_iff, add_subgroup.mem_map_equiv,
      add_aut.conj_symm_apply]
end

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizer_equiv_stabilizer_of_orbit_rel {x y : β}
  (h : (orbit_rel α β).rel x y) :
  stabilizer α x ≃+ stabilizer α y :=
let g : α := classical.some h in
have hg : g +ᵥ y = x := classical.some_spec h,
have this : stabilizer α x = (stabilizer α y).map (add_aut.conj g).to_add_monoid_hom,
  by rw [← hg, stabilizer_vadd_eq_stabilizer_map_conj],
(add_equiv.add_subgroup_congr this).trans
  ((add_aut.conj g).add_subgroup_map $ stabilizer α y).symm

end add_action

/-- `smul` by a `k : M` over a ring is injective, if `k` is not a zero divisor.
The general theory of such `k` is elaborated by `is_smul_regular`.
The typeclass that restricts all terms of `M` to have this property is `no_zero_smul_divisors`. -/
lemma smul_cancel_of_non_zero_divisor {M R : Type*}
  [monoid M] [non_unital_non_assoc_ring R] [distrib_mul_action M R]
  (k : M) (h : ∀ (x : R), k • x = 0 → x = 0) {a b : R} (h' : k • a = k • b) :
  a = b :=
begin
  rw ←sub_eq_zero,
  refine h _ _,
  rw [smul_sub, h', sub_self]
end


/-
Copyright (c) 2022 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä

! This file was ported from Lean 3 source module measure_theory.integral.layercake
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Integral.IntervalIntegral
import Mathbin.Analysis.SpecialFunctions.Integrals

/-!
# The layer cake formula / Cavalieri's principle / tail probability formula

In this file we prove the following layer cake formula.

Consider a non-negative measurable function `f` on a sigma-finite measure space. Apply pointwise
to it an increasing absolutely continuous function `G : ℝ≥0 → ℝ≥0` vanishing at the origin, with
derivative `G' = g` on the positive real line (in other words, `G` a primitive of a non-negative
locally integrable function `g` on the positive real line). Then the integral of the result,
`∫ G ∘ f`, can be written as the integral over the positive real line of the "tail measures" of `f`
(i.e., a function giving the measures of the sets on which `f` exceeds different positive real
values) weighted by `g`. In probability theory contexts, the "tail measures" could be referred to
as "tail probabilities" of the random variable `f`, or as values of the "complementary cumulative
distribution function" of the random variable `f`. The terminology "tail probability formula" is
therefore occasionally used for the layer cake formula (or a standard application of it).

The essence of the (mathematical) proof is Fubini's theorem.

We also give the two most common applications of the layer cake formula
 * a representation of the integral of a nonnegative function f:
   ∫ f(ω) ∂μ(ω) = ∫ μ {ω | f(ω) ≥ t} dt
 * a representation of the integral of the p:th power of a nonnegative function f:
   ∫ f(ω)^p ∂μ(ω) = p * ∫ t^(p-1) * μ {ω | f(ω) ≥ t} dt .

Variants of the formulas with measures of sets of the form {ω | f(ω) > t} instead of {ω | f(ω) ≥ t}
are also included.

## Main results

 * `lintegral_comp_eq_lintegral_meas_le_mul` and `lintegral_comp_eq_lintegral_meas_lt_mul`:
   The general layer cake formulas with Lebesgue integrals, written in terms of measures of
   sets of the forms {ω | t ≤ f(ω)} and {ω | t < f(ω)}, respectively.
 * `lintegral_eq_lintegral_meas_le` and `lintegral_eq_lintegral_meas_lt`:
   The most common special cases of the layer cake formulas, stating that for a nonnegative
   function f we have ∫ f(ω) ∂μ(ω) = ∫ μ {ω | f(ω) ≥ t} dt and
   ∫ f(ω) ∂μ(ω) = ∫ μ {ω | f(ω) > t} dt, respectively.
 * `lintegral_rpow_eq_lintegral_meas_le_mul` and `lintegral_rpow_eq_lintegral_meas_lt_mul`:
   Other common special cases of the layer cake formulas, stating that for a nonnegative function f
   and p > 0, we have ∫ f(ω)^p ∂μ(ω) = p * ∫ μ {ω | f(ω) ≥ t} * t^(p-1) dt and
   ∫ f(ω)^p ∂μ(ω) = p * ∫ μ {ω | f(ω) > t} * t^(p-1) dt, respectively.

## Tags

layer cake representation, Cavalieri's principle, tail probability formula
-/

noncomputable section

open ENNReal MeasureTheory

open Set MeasureTheory Filter

/-! ### Layercake formula -/

section Layercake

namespace MeasureTheory

variable {α : Type _} [MeasurableSpace α] {f : α → ℝ} {g : ℝ → ℝ} {s : Set α}

/-- An auxiliary version of the layer cake formula (Cavalieri's principle, tail probability
formula), with a measurability assumption that would also essentially follow from the
integrability assumptions.

See `measure_theory.lintegral_comp_eq_lintegral_meas_le_mul` and
`measure_theory.lintegral_comp_eq_lintegral_meas_lt_mul` for the main formulations of the layer
cake formula. -/
theorem lintegral_comp_eq_lintegral_meas_le_mul_of_measurable (μ : Measure α) [SigmaFinite μ]
    (f_nn : 0 ≤ f) (f_mble : Measurable f) (g_intble : ∀ t > 0, IntervalIntegrable g volume 0 t)
    (g_mble : Measurable g) (g_nn : ∀ t > 0, 0 ≤ g t) :
    (∫⁻ ω, ENNReal.ofReal (∫ t in 0 ..f ω, g t) ∂μ) =
      ∫⁻ t in Ioi 0, μ { a : α | t ≤ f a } * ENNReal.ofReal (g t) :=
  by
  have g_intble' : ∀ t : ℝ, 0 ≤ t → IntervalIntegrable g volume 0 t :=
    by
    intro t ht
    cases eq_or_lt_of_le ht
    · simp [← h]
    · exact g_intble t h
  have integrand_eq :
    ∀ ω, ENNReal.ofReal (∫ t in 0 ..f ω, g t) = ∫⁻ t in Ioc 0 (f ω), ENNReal.ofReal (g t) :=
    by
    intro ω
    have g_ae_nn : 0 ≤ᵐ[volume.restrict (Ioc 0 (f ω))] g := by
      filter_upwards [self_mem_ae_restrict
          (measurableSet_Ioc : MeasurableSet (Ioc 0 (f ω)))]with x hx using g_nn x hx.1
    rw [← of_real_integral_eq_lintegral_of_real (g_intble' (f ω) (f_nn ω)).1 g_ae_nn]
    congr
    exact intervalIntegral.integral_of_le (f_nn ω)
  simp_rw [integrand_eq, ← lintegral_indicator (fun t => ENNReal.ofReal (g t)) measurableSet_Ioc, ←
    lintegral_indicator _ measurableSet_Ioi]
  rw [lintegral_lintegral_swap]
  · apply congr_arg
    funext s
    have aux₁ :
      (fun x => (Ioc 0 (f x)).indicator (fun t : ℝ => ENNReal.ofReal (g t)) s) = fun x =>
        ENNReal.ofReal (g s) * (Ioi (0 : ℝ)).indicator (fun _ => 1) s *
          (Ici s).indicator (fun t : ℝ => (1 : ℝ≥0∞)) (f x) :=
      by
      funext a
      by_cases s ∈ Ioc (0 : ℝ) (f a)
      ·
        simp only [h, show s ∈ Ioi (0 : ℝ) from h.1, show f a ∈ Ici s from h.2, indicator_of_mem,
          mul_one]
      · have h_copy := h
        simp only [mem_Ioc, not_and, not_le] at h
        by_cases h' : 0 < s
        ·
          simp only [h_copy, h h', indicator_of_not_mem, not_false_iff, mem_Ici, not_le,
            MulZeroClass.mul_zero]
        · have : s ∉ Ioi (0 : ℝ) := h'
          simp only [this, h', indicator_of_not_mem, not_false_iff, MulZeroClass.mul_zero,
            MulZeroClass.zero_mul, mem_Ioc, false_and_iff]
    simp_rw [aux₁]
    rw [lintegral_const_mul']
    swap
    · apply ENNReal.mul_ne_top ENNReal.ofReal_ne_top
      by_cases s ∈ Ioi (0 : ℝ) <;> · simp [h]
    simp_rw [show
        (fun a => (Ici s).indicator (fun t : ℝ => (1 : ℝ≥0∞)) (f a)) = fun a =>
          { a : α | s ≤ f a }.indicator (fun _ => 1) a
        by
        funext a
        by_cases s ≤ f a <;> simp [h]]
    rw [lintegral_indicator]
    swap
    · exact f_mble measurableSet_Ici
    rw [lintegral_one, measure.restrict_apply MeasurableSet.univ, univ_inter, indicator_mul_left,
      mul_assoc,
      show
        (Ioi 0).indicator (fun _x : ℝ => (1 : ℝ≥0∞)) s * μ { a : α | s ≤ f a } =
          (Ioi 0).indicator (fun _x : ℝ => 1 * μ { a : α | s ≤ f a }) s
        by by_cases 0 < s <;> simp [h]]
    simp_rw [mul_comm _ (ENNReal.ofReal _), one_mul]
    rfl
  have aux₂ :
    (Function.uncurry fun (x : α) (y : ℝ) =>
        (Ioc 0 (f x)).indicator (fun t : ℝ => ENNReal.ofReal (g t)) y) =
      { p : α × ℝ | p.2 ∈ Ioc 0 (f p.1) }.indicator fun p => ENNReal.ofReal (g p.2) :=
    by
    funext p
    cases p
    rw [Function.uncurry_apply_pair]
    by_cases p_snd ∈ Ioc 0 (f p_fst)
    · have h' : (p_fst, p_snd) ∈ { p : α × ℝ | p.snd ∈ Ioc 0 (f p.fst) } := h
      rw [Set.indicator_of_mem h', Set.indicator_of_mem h]
    · have h' : (p_fst, p_snd) ∉ { p : α × ℝ | p.snd ∈ Ioc 0 (f p.fst) } := h
      rw [Set.indicator_of_not_mem h', Set.indicator_of_not_mem h]
  rw [aux₂]
  have mble := measurableSet_region_between_oc measurable_zero f_mble MeasurableSet.univ
  simp_rw [mem_univ, Pi.zero_apply, true_and_iff] at mble
  exact (ennreal.measurable_of_real.comp (g_mble.comp measurable_snd)).AeMeasurable.indicator mble
#align measure_theory.lintegral_comp_eq_lintegral_meas_le_mul_of_measurable MeasureTheory.lintegral_comp_eq_lintegral_meas_le_mul_of_measurable

/-- The layer cake formula / Cavalieri's principle / tail probability formula:

Let `f` be a non-negative measurable function on a sigma-finite measure space. Let `G` be an
increasing absolutely continuous function on the positive real line, vanishing at the origin,
with derivative `G' = g`. Then the integral of the composition `G ∘ f` can be written as
the integral over the positive real line of the "tail measures" `μ {ω | f(ω) ≥ t}` of `f`
weighted by `g`.

Roughly speaking, the statement is: `∫⁻ (G ∘ f) ∂μ = ∫⁻ t in 0 .. ∞, g(t) * μ {ω | f(ω) ≥ t}`.

See `lintegral_comp_eq_lintegral_meas_lt_mul` for a version with sets of the form `{ω | f(ω) > t}`
instead. -/
theorem lintegral_comp_eq_lintegral_meas_le_mul (μ : Measure α) [SigmaFinite μ] (f_nn : 0 ≤ f)
    (f_mble : Measurable f) (g_intble : ∀ t > 0, IntervalIntegrable g volume 0 t)
    (g_nn : ∀ᵐ t ∂volume.restrict (Ioi 0), 0 ≤ g t) :
    (∫⁻ ω, ENNReal.ofReal (∫ t in 0 ..f ω, g t) ∂μ) =
      ∫⁻ t in Ioi 0, μ { a : α | t ≤ f a } * ENNReal.ofReal (g t) :=
  by
  have ex_G : ∃ G : ℝ → ℝ, Measurable G ∧ 0 ≤ G ∧ g =ᵐ[volume.restrict (Ioi 0)] G :=
    by
    refine' AeMeasurable.exists_measurable_nonneg _ g_nn
    exact aeMeasurableIoiOfForallIoc fun t ht => (g_intble t ht).1.1.AeMeasurable
  rcases ex_G with ⟨G, G_mble, G_nn, g_eq_G⟩
  have g_eq_G_on : ∀ t, g =ᵐ[volume.restrict (Ioc 0 t)] G := fun t =>
    ae_mono (measure.restrict_mono Ioc_subset_Ioi_self le_rfl) g_eq_G
  have G_intble : ∀ t > 0, IntervalIntegrable G volume 0 t :=
    by
    refine' fun t t_pos => ⟨integrable_on.congr_fun' (g_intble t t_pos).1 (g_eq_G_on t), _⟩
    rw [Ioc_eq_empty_of_le t_pos.lt.le]
    exact integrable_on_empty
  have eq₁ :
    (∫⁻ t in Ioi 0, μ { a : α | t ≤ f a } * ENNReal.ofReal (g t)) =
      ∫⁻ t in Ioi 0, μ { a : α | t ≤ f a } * ENNReal.ofReal (G t) :=
    by
    apply lintegral_congr_ae
    filter_upwards [g_eq_G]with a ha
    rw [ha]
  have eq₂ : ∀ ω, (∫ t in 0 ..f ω, g t) = ∫ t in 0 ..f ω, G t :=
    by
    refine' fun ω => intervalIntegral.integral_congr_ae _
    have fω_nn : 0 ≤ f ω := f_nn ω
    rw [uIoc_of_le fω_nn, ←
      ae_restrict_iff' (measurableSet_Ioc : MeasurableSet (Ioc (0 : ℝ) (f ω)))]
    exact g_eq_G_on (f ω)
  simp_rw [eq₁, eq₂]
  exact
    lintegral_comp_eq_lintegral_meas_le_mul_of_measurable μ f_nn f_mble G_intble G_mble
      fun t t_pos => G_nn t
#align measure_theory.lintegral_comp_eq_lintegral_meas_le_mul MeasureTheory.lintegral_comp_eq_lintegral_meas_le_mul

/-- The standard case of the layer cake formula / Cavalieri's principle / tail probability formula:

For a nonnegative function `f` on a sigma-finite measure space, the Lebesgue integral of `f` can
be written (roughly speaking) as: `∫⁻ f ∂μ = ∫⁻ t in 0 .. ∞, μ {ω | f(ω) ≥ t}`.

See `lintegral_eq_lintegral_meas_lt` for a version with sets of the form `{ω | f(ω) > t}`
instead. -/
theorem lintegral_eq_lintegral_meas_le (μ : Measure α) [SigmaFinite μ] (f_nn : 0 ≤ f)
    (f_mble : Measurable f) :
    (∫⁻ ω, ENNReal.ofReal (f ω) ∂μ) = ∫⁻ t in Ioi 0, μ { a : α | t ≤ f a } :=
  by
  set cst := fun t : ℝ => (1 : ℝ) with def_cst
  have cst_intble : ∀ t > 0, IntervalIntegrable cst volume 0 t := fun _ _ => intervalIntegrableConst
  have key :=
    lintegral_comp_eq_lintegral_meas_le_mul μ f_nn f_mble cst_intble
      (eventually_of_forall fun t => zero_le_one)
  simp_rw [def_cst, ENNReal.ofReal_one, mul_one] at key
  rw [← key]
  congr with ω
  simp only [intervalIntegral.integral_const, sub_zero, Algebra.id.smul_eq_mul, mul_one]
#align measure_theory.lintegral_eq_lintegral_meas_le MeasureTheory.lintegral_eq_lintegral_meas_le

/-- An application of the layer cake formula / Cavalieri's principle / tail probability formula:

For a nonnegative function `f` on a sigma-finite measure space, the Lebesgue integral of `f` can
be written (roughly speaking) as: `∫⁻ f^p ∂μ = p * ∫⁻ t in 0 .. ∞, t^(p-1) * μ {ω | f(ω) ≥ t}`.

See `lintegral_rpow_eq_lintegral_meas_lt_mul` for a version with sets of the form `{ω | f(ω) > t}`
instead. -/
theorem lintegral_rpow_eq_lintegral_meas_le_mul (μ : Measure α) [SigmaFinite μ] (f_nn : 0 ≤ f)
    (f_mble : Measurable f) {p : ℝ} (p_pos : 0 < p) :
    (∫⁻ ω, ENNReal.ofReal (f ω ^ p) ∂μ) =
      ENNReal.ofReal p * ∫⁻ t in Ioi 0, μ { a : α | t ≤ f a } * ENNReal.ofReal (t ^ (p - 1)) :=
  by
  have one_lt_p : -1 < p - 1 := by linarith
  have obs : ∀ x : ℝ, (∫ t : ℝ in 0 ..x, t ^ (p - 1)) = x ^ p / p :=
    by
    intro x
    rw [integral_rpow (Or.inl one_lt_p)]
    simp [Real.zero_rpow p_pos.ne.symm]
  set g := fun t : ℝ => t ^ (p - 1) with g_def
  have g_nn : ∀ᵐ t ∂volume.restrict (Ioi (0 : ℝ)), 0 ≤ g t :=
    by
    filter_upwards [self_mem_ae_restrict (measurableSet_Ioi : MeasurableSet (Ioi (0 : ℝ)))]
    intro t t_pos
    rw [g_def]
    exact Real.rpow_nonneg_of_nonneg (mem_Ioi.mp t_pos).le (p - 1)
  have g_intble : ∀ t > 0, IntervalIntegrable g volume 0 t := fun _ _ =>
    intervalIntegral.intervalIntegrableRpow' one_lt_p
  have key := lintegral_comp_eq_lintegral_meas_le_mul μ f_nn f_mble g_intble g_nn
  simp_rw [g_def] at key
  rw [← key, ← lintegral_const_mul (ENNReal.ofReal p)] <;> simp_rw [obs]
  · congr with ω
    rw [← ENNReal.ofReal_mul p_pos.le, mul_div_cancel' (f ω ^ p) p_pos.ne.symm]
  · exact ((f_mble.pow measurable_const).div_const p).eNNReal_ofReal
#align measure_theory.lintegral_rpow_eq_lintegral_meas_le_mul MeasureTheory.lintegral_rpow_eq_lintegral_meas_le_mul

end MeasureTheory

end Layercake

section LayercakeLt

open MeasureTheory

variable {α : Type _} [MeasurableSpace α] (μ : Measure α)

variable {β : Type _} [MeasurableSpace β] [MeasurableSingletonClass β]

namespace Measure

theorem meas_le_ne_meas_lt_subset_meas_pos {R : Type _} [LinearOrder R] [MeasurableSpace R]
    [MeasurableSingletonClass R] {g : α → R} (g_mble : Measurable g) {t : R}
    (ht : μ { a : α | t ≤ g a } ≠ μ { a : α | t < g a }) : 0 < μ { a : α | g a = t } :=
  by
  have uni : { a : α | t ≤ g a } = { a : α | t < g a } ∪ { a : α | t = g a } :=
    by
    ext a
    simp only [mem_set_of_eq, mem_union]
    apply le_iff_lt_or_eq
  rw [show { a : α | t = g a } = { a : α | g a = t } by simp_rw [eq_comm]] at uni
  have disj : { a : α | t < g a } ∩ { a : α | g a = t } = ∅ :=
    by
    ext a
    simp only [mem_inter_iff, mem_set_of_eq, mem_empty_iff_false, iff_false_iff, not_and]
    exact ne_of_gt
  have μ_add : μ { a : α | t ≤ g a } = μ { a : α | t < g a } + μ { a : α | g a = t } := by
    rw [uni,
      measure_union (disjoint_iff_inter_eq_empty.mpr disj)
        (g_mble (finite.measurable_set (finite_singleton t)))]
  by_contra con
  rw [not_lt, nonpos_iff_eq_zero] at con
  rw [Con, add_zero] at μ_add
  exact ht μ_add
#align measure.meas_le_ne_meas_lt_subset_meas_pos Measure.meas_le_ne_meas_lt_subset_meas_pos

theorem countable_meas_le_ne_meas_lt [SigmaFinite μ] {R : Type _} [LinearOrder R]
    [MeasurableSpace R] [MeasurableSingletonClass R] {g : α → R} (g_mble : Measurable g) :
    { t : R | μ { a : α | t ≤ g a } ≠ μ { a : α | t < g a } }.Countable :=
  Countable.mono (show _ from fun t ht => meas_le_ne_meas_lt_subset_meas_pos μ g_mble ht)
    (Measure.countable_meas_level_set_pos g_mble)
#align measure.countable_meas_le_ne_meas_lt Measure.countable_meas_le_ne_meas_lt

theorem meas_le_ae_eq_meas_lt [SigmaFinite μ] {R : Type _} [LinearOrder R] [MeasurableSpace R]
    [MeasurableSingletonClass R] (ν : Measure R) [HasNoAtoms ν] {g : α → R}
    (g_mble : Measurable g) :
    (fun t => μ { a : α | t ≤ g a }) =ᵐ[ν] fun t => μ { a : α | t < g a } :=
  Set.Countable.measure_zero (Measure.countable_meas_le_ne_meas_lt μ g_mble) _
#align measure.meas_le_ae_eq_meas_lt Measure.meas_le_ae_eq_meas_lt

end Measure

variable {f : α → ℝ} {g : ℝ → ℝ} {s : Set α}

/-- The layer cake formula / Cavalieri's principle / tail probability formula:

Let `f` be a non-negative measurable function on a sigma-finite measure space. Let `G` be an
increasing absolutely continuous function on the positive real line, vanishing at the origin,
with derivative `G' = g`. Then the integral of the composition `G ∘ f` can be written as
the integral over the positive real line of the "tail measures" `μ {ω | f(ω) > t}` of `f`
weighted by `g`.

Roughly speaking, the statement is: `∫⁻ (G ∘ f) ∂μ = ∫⁻ t in 0 .. ∞, g(t) * μ {ω | f(ω) > t}`.

See `lintegral_comp_eq_lintegral_meas_le_mul` for a version with sets of the form `{ω | f(ω) ≥ t}`
instead. -/
theorem lintegral_comp_eq_lintegral_meas_lt_mul (μ : Measure α) [SigmaFinite μ] (f_nn : 0 ≤ f)
    (f_mble : Measurable f) (g_intble : ∀ t > 0, IntervalIntegrable g volume 0 t)
    (g_nn : ∀ᵐ t ∂volume.restrict (Ioi 0), 0 ≤ g t) :
    (∫⁻ ω, ENNReal.ofReal (∫ t in 0 ..f ω, g t) ∂μ) =
      ∫⁻ t in Ioi 0, μ { a : α | t < f a } * ENNReal.ofReal (g t) :=
  by
  rw [lintegral_comp_eq_lintegral_meas_le_mul μ f_nn f_mble g_intble g_nn]
  apply lintegral_congr_ae
  filter_upwards [Measure.meas_le_ae_eq_meas_lt μ (volume.restrict (Ioi 0)) f_mble]with t ht
  rw [ht]
#align lintegral_comp_eq_lintegral_meas_lt_mul lintegral_comp_eq_lintegral_meas_lt_mul

/-- The standard case of the layer cake formula / Cavalieri's principle / tail probability formula:

For a nonnegative function `f` on a sigma-finite measure space, the Lebesgue integral of `f` can
be written (roughly speaking) as: `∫⁻ f ∂μ = ∫⁻ t in 0 .. ∞, μ {ω | f(ω) > t}`.

See `lintegral_eq_lintegral_meas_le` for a version with sets of the form `{ω | f(ω) ≥ t}`
instead. -/
theorem lintegral_eq_lintegral_meas_lt (μ : Measure α) [SigmaFinite μ] (f_nn : 0 ≤ f)
    (f_mble : Measurable f) :
    (∫⁻ ω, ENNReal.ofReal (f ω) ∂μ) = ∫⁻ t in Ioi 0, μ { a : α | t < f a } :=
  by
  rw [lintegral_eq_lintegral_meas_le μ f_nn f_mble]
  apply lintegral_congr_ae
  filter_upwards [Measure.meas_le_ae_eq_meas_lt μ (volume.restrict (Ioi 0)) f_mble]with t ht
  rw [ht]
#align lintegral_eq_lintegral_meas_lt lintegral_eq_lintegral_meas_lt

/-- An application of the layer cake formula / Cavalieri's principle / tail probability formula:

For a nonnegative function `f` on a sigma-finite measure space, the Lebesgue integral of `f` can
be written (roughly speaking) as: `∫⁻ f^p ∂μ = p * ∫⁻ t in 0 .. ∞, t^(p-1) * μ {ω | f(ω) > t}`.

See `lintegral_rpow_eq_lintegral_meas_le_mul` for a version with sets of the form `{ω | f(ω) ≥ t}`
instead. -/
theorem lintegral_rpow_eq_lintegral_meas_lt_mul (μ : Measure α) [SigmaFinite μ] (f_nn : 0 ≤ f)
    (f_mble : Measurable f) {p : ℝ} (p_pos : 0 < p) :
    (∫⁻ ω, ENNReal.ofReal (f ω ^ p) ∂μ) =
      ENNReal.ofReal p * ∫⁻ t in Ioi 0, μ { a : α | t < f a } * ENNReal.ofReal (t ^ (p - 1)) :=
  by
  rw [lintegral_rpow_eq_lintegral_meas_le_mul μ f_nn f_mble p_pos]
  apply congr_arg fun z => ENNReal.ofReal p * z
  apply lintegral_congr_ae
  filter_upwards [Measure.meas_le_ae_eq_meas_lt μ (volume.restrict (Ioi 0)) f_mble]with t ht
  rw [ht]
#align lintegral_rpow_eq_lintegral_meas_lt_mul lintegral_rpow_eq_lintegral_meas_lt_mul

end LayercakeLt


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

The order relation on the natural numbers.
-/
import .basic algebra.ordered_ring
open eq.ops

namespace nat

/- lt and le -/

protected theorem le_of_lt_or_eq {m n : ℕ} (H : m < n ∨ m = n) : m ≤ n :=
nat.le_of_eq_or_lt (or.swap H)

protected theorem lt_or_eq_of_le {m n : ℕ} (H : m ≤ n) : m < n ∨ m = n :=
or.swap (nat.eq_or_lt_of_le H)

protected theorem le_iff_lt_or_eq (m n : ℕ) : m ≤ n ↔ m < n ∨ m = n :=
iff.intro nat.lt_or_eq_of_le nat.le_of_lt_or_eq

protected theorem lt_of_le_and_ne {m n : ℕ} (H1 : m ≤ n) : m ≠ n → m < n :=
or_resolve_right (nat.eq_or_lt_of_le H1)

protected theorem lt_iff_le_and_ne (m n : ℕ) : m < n ↔ m ≤ n ∧ m ≠ n :=
iff.intro
  (take H, and.intro (nat.le_of_lt H) (take H1, !nat.lt_irrefl (H1 ▸ H)))
  (and.rec nat.lt_of_le_and_ne)

theorem le_add_right (n k : ℕ) : n ≤ n + k :=
nat.rec !nat.le_refl (λ k, le_succ_of_le) k

theorem le_add_left (n m : ℕ): n ≤ m + n :=
!add.comm ▸ !le_add_right

theorem le.intro {n m k : ℕ} (h : n + k = m) : n ≤ m :=
h ▸ !le_add_right

theorem le.elim {n m : ℕ} : n ≤ m → ∃ k, n + k = m :=
le.rec (exists.intro 0 rfl) (λm h, Exists.rec
  (λ k H, exists.intro (succ k) (H ▸ rfl)))

protected theorem le_total {m n : ℕ} : m ≤ n ∨ n ≤ m :=
or.imp_left nat.le_of_lt !nat.lt_or_ge

/- addition -/

protected theorem add_le_add_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k + n ≤ k + m :=
obtain l Hl, from le.elim H, le.intro (Hl ▸ !add.assoc)

protected theorem add_le_add_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n + k ≤ m + k :=
!add.comm ▸ !add.comm ▸ nat.add_le_add_left H k

protected theorem le_of_add_le_add_left {k n m : ℕ} (H : k + n ≤ k + m) : n ≤ m :=
obtain l Hl, from le.elim H, le.intro (nat.add_left_cancel (!add.assoc⁻¹ ⬝ Hl))

protected theorem lt_of_add_lt_add_left {k n m : ℕ} (H : k + n < k + m) : n < m :=
let H' := nat.le_of_lt H in
nat.lt_of_le_and_ne (nat.le_of_add_le_add_left H') (assume Heq, !nat.lt_irrefl (Heq ▸ H))

protected theorem add_lt_add_left {n m : ℕ} (H : n < m) (k : ℕ) : k + n < k + m :=
lt_of_succ_le (!add_succ ▸ nat.add_le_add_left (succ_le_of_lt H) k)

protected theorem add_lt_add_right {n m : ℕ} (H : n < m) (k : ℕ) : n + k < m + k :=
!add.comm ▸ !add.comm ▸ nat.add_lt_add_left H k

protected theorem lt_add_of_pos_right {n k : ℕ} (H : k > 0) : n < n + k :=
!add_zero ▸ nat.add_lt_add_left H n

/- multiplication -/

theorem mul_le_mul_left {n m : ℕ} (k : ℕ) (H : n ≤ m) : k * n ≤ k * m :=
obtain (l : ℕ) (Hl : n + l = m), from le.elim H,
have k * n + k * l = k * m, by rewrite [-left_distrib, Hl],
le.intro this

theorem mul_le_mul_right {n m : ℕ} (k : ℕ) (H : n ≤ m) : n * k ≤ m * k :=
!mul.comm ▸ !mul.comm ▸ !mul_le_mul_left H

protected theorem mul_le_mul {n m k l : ℕ} (H1 : n ≤ k) (H2 : m ≤ l) : n * m ≤ k * l :=
nat.le_trans (!nat.mul_le_mul_right H1) (!nat.mul_le_mul_left H2)

protected theorem mul_lt_mul_of_pos_left {n m k : ℕ} (H : n < m) (Hk : k > 0) : k * n < k * m :=
nat.lt_of_lt_of_le (nat.lt_add_of_pos_right Hk) (!mul_succ ▸ nat.mul_le_mul_left k (succ_le_of_lt H))

protected theorem mul_lt_mul_of_pos_right {n m k : ℕ} (H : n < m) (Hk : k > 0) : n * k < m * k :=
!mul.comm ▸ !mul.comm ▸ nat.mul_lt_mul_of_pos_left H Hk

/- nat is an instance of a linearly ordered semiring and a lattice -/

protected definition decidable_linear_ordered_semiring [trans_instance] :
decidable_linear_ordered_semiring nat :=
⦃ decidable_linear_ordered_semiring, nat.comm_semiring,
  add_left_cancel            := @nat.add_left_cancel,
  add_right_cancel           := @nat.add_right_cancel,
  lt                         := nat.lt,
  le                         := nat.le,
  le_refl                    := nat.le_refl,
  le_trans                   := @nat.le_trans,
  le_antisymm                := @nat.le_antisymm,
  le_total                   := @nat.le_total,
  le_iff_lt_or_eq            := @nat.le_iff_lt_or_eq,
  le_of_lt                   := @nat.le_of_lt,
  lt_irrefl                  := @nat.lt_irrefl,
  lt_of_lt_of_le             := @nat.lt_of_lt_of_le,
  lt_of_le_of_lt             := @nat.lt_of_le_of_lt,
  lt_of_add_lt_add_left      := @nat.lt_of_add_lt_add_left,
  add_lt_add_left            := @nat.add_lt_add_left,
  add_le_add_left            := @nat.add_le_add_left,
  le_of_add_le_add_left      := @nat.le_of_add_le_add_left,
  zero_lt_one                := zero_lt_succ 0,
  mul_le_mul_of_nonneg_left  := (take a b c H1 H2, nat.mul_le_mul_left c H1),
  mul_le_mul_of_nonneg_right := (take a b c H1 H2, nat.mul_le_mul_right c H1),
  mul_lt_mul_of_pos_left     := @nat.mul_lt_mul_of_pos_left,
  mul_lt_mul_of_pos_right    := @nat.mul_lt_mul_of_pos_right,
  decidable_lt               := nat.decidable_lt ⦄

definition nat_has_dvd [instance] [priority nat.prio] : has_dvd nat :=
has_dvd.mk has_dvd.dvd

theorem add_pos_left {a : ℕ} (H : 0 < a) (b : ℕ) : 0 < a + b :=
@add_pos_of_pos_of_nonneg _ _ a b H !zero_le

theorem add_pos_right {a : ℕ} (H : 0 < a) (b : ℕ) : 0 < b + a :=
by rewrite add.comm; apply add_pos_left H b

theorem add_eq_zero_iff_eq_zero_and_eq_zero {a b : ℕ} :
a + b = 0 ↔ a = 0 ∧ b = 0 :=
@add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg _ _ a b !zero_le !zero_le

theorem le_add_of_le_left {a b c : ℕ} (H : b ≤ c) : b ≤ a + c :=
@le_add_of_nonneg_of_le _ _ a b c !zero_le H

theorem le_add_of_le_right {a b c : ℕ} (H : b ≤ c) : b ≤ c + a :=
@le_add_of_le_of_nonneg _ _ a b c H !zero_le

theorem lt_add_of_lt_left {b c : ℕ} (H : b < c) (a : ℕ) : b < a + c :=
@lt_add_of_nonneg_of_lt _ _ a b c !zero_le H

theorem lt_add_of_lt_right {b c : ℕ} (H : b < c) (a : ℕ) : b < c + a :=
@lt_add_of_lt_of_nonneg _ _ a b c H !zero_le

theorem lt_of_mul_lt_mul_left {a b c : ℕ} (H : c * a < c * b) : a < b :=
@lt_of_mul_lt_mul_left _ _ a b c H !zero_le

theorem lt_of_mul_lt_mul_right {a b c : ℕ} (H : a * c < b * c) : a < b :=
@lt_of_mul_lt_mul_right _ _ a b c H !zero_le

theorem pos_of_mul_pos_left {a b : ℕ} (H : 0 < a * b) : 0 < b :=
@pos_of_mul_pos_left _ _ a b H !zero_le

theorem pos_of_mul_pos_right {a b : ℕ} (H : 0 < a * b) : 0 < a :=
@pos_of_mul_pos_right _ _ a b H !zero_le

theorem zero_le_one : (0:nat) ≤ 1 :=
dec_trivial

/- properties specific to nat -/

theorem lt_intro {n m k : ℕ} (H : succ n + k = m) : n < m :=
lt_of_succ_le (le.intro H)

theorem lt_elim {n m : ℕ} (H : n < m) : ∃k, succ n + k = m :=
le.elim (succ_le_of_lt H)

theorem lt_add_succ (n m : ℕ) : n < n + succ m :=
lt_intro !succ_add_eq_succ_add

theorem eq_zero_of_le_zero {n : ℕ} (H : n ≤ 0) : n = 0 :=
obtain (k : ℕ) (Hk : n + k = 0), from le.elim H,
eq_zero_of_add_eq_zero_right Hk

/- succ and pred -/

theorem le_of_lt_succ {m n : nat} : m < succ n → m ≤ n :=
le_of_succ_le_succ

theorem lt_iff_succ_le (m n : nat) : m < n ↔ succ m ≤ n :=
iff.rfl

theorem lt_succ_iff_le (m n : nat) : m < succ n ↔ m ≤ n :=
iff.intro le_of_lt_succ lt_succ_of_le

theorem self_le_succ (n : ℕ) : n ≤ succ n :=
le.intro !add_one

theorem succ_le_or_eq_of_le {n m : ℕ} : n ≤ m → succ n ≤ m ∨ n = m :=
lt_or_eq_of_le

theorem pred_le_of_le_succ {n m : ℕ} : n ≤ succ m → pred n ≤ m :=
pred_le_pred

theorem succ_le_of_le_pred {n m : ℕ} : succ n ≤ m → n ≤ pred m :=
pred_le_pred

theorem pred_le_pred_of_le {n m : ℕ} : n ≤ m → pred n ≤ pred m :=
pred_le_pred

theorem pre_lt_of_lt {n m : ℕ} : n < m → pred n < m :=
lt_of_le_of_lt !pred_le

theorem lt_of_pred_lt_pred {n m : ℕ} (H : pred n < pred m) : n < m :=
lt_of_not_ge
  (suppose m ≤ n,
    not_lt_of_ge (pred_le_pred_of_le this) H)

theorem le_or_eq_succ_of_le_succ {n m : ℕ} (H : n ≤ succ m) : n ≤ m ∨ n = succ m :=
or.imp_left le_of_succ_le_succ (succ_le_or_eq_of_le H)

theorem le_pred_self (n : ℕ) : pred n ≤ n :=
!pred_le

theorem succ_pos (n : ℕ) : 0 < succ n :=
!zero_lt_succ

theorem succ_pred_of_pos {n : ℕ} (H : n > 0) : succ (pred n) = n :=
(or_resolve_right (eq_zero_or_eq_succ_pred n) (ne.symm (ne_of_lt H)))⁻¹

theorem exists_eq_succ_of_lt {n : ℕ} : Π {m : ℕ}, n < m → ∃k, m = succ k
| 0        H := absurd H !not_lt_zero
| (succ k) H := exists.intro k rfl

theorem lt_succ_self (n : ℕ) : n < succ n :=
lt.base n

lemma lt_succ_of_lt {i j : nat} : i < j → i < succ j :=
assume Plt, lt.trans Plt (self_lt_succ j)

lemma one_le_succ (n : ℕ) : 1 ≤ succ n :=
nat.succ_le_succ !zero_le

lemma two_le_succ_succ (n : ℕ) : 2 ≤ succ (succ n) :=
nat.succ_le_succ !one_le_succ

/- increasing and decreasing functions -/

section
  variables {A : Type} [strict_order A] {f : ℕ → A}

  theorem strictly_increasing_of_forall_lt_succ (H : ∀ i, f i < f (succ i)) : strictly_increasing f :=
  take i j,
  nat.induction_on j
    (suppose i < 0, absurd this !not_lt_zero)
    (take j', assume ih, suppose i < succ j',
       or.elim (lt_or_eq_of_le (le_of_lt_succ this))
         (suppose i < j', lt.trans (ih this) (H j'))
         (suppose i = j', by rewrite this; apply H))

  theorem strictly_decreasing_of_forall_gt_succ (H : ∀ i, f i > f (succ i)) : strictly_decreasing f :=
  take i j,
  nat.induction_on j
    (suppose i < 0, absurd this !not_lt_zero)
    (take j', assume ih, suppose i < succ j',
       or.elim (lt_or_eq_of_le (le_of_lt_succ this))
         (suppose i < j', lt.trans (H j') (ih this))
         (suppose i = j', by rewrite this; apply H))
end

section
  variables {A : Type} [weak_order A] {f : ℕ → A}

  theorem nondecreasing_of_forall_le_succ (H : ∀ i, f i ≤ f (succ i)) : nondecreasing f :=
  take i j,
  nat.induction_on j
    (suppose i ≤ 0, have i = 0, from eq_zero_of_le_zero this, by rewrite this; apply le.refl)
    (take j', assume ih, suppose i ≤ succ j',
       or.elim (le_or_eq_succ_of_le_succ this)
         (suppose i ≤ j', le.trans (ih this) (H j'))
         (suppose i = succ j', by rewrite this; apply le.refl))

  theorem nonincreasing_of_forall_ge_succ (H : ∀ i, f i ≥ f (succ i)) : nonincreasing f :=
  take i j,
  nat.induction_on j
    (suppose i ≤ 0, have i = 0, from eq_zero_of_le_zero this, by rewrite this; apply le.refl)
    (take j', assume ih, suppose i ≤ succ j',
       or.elim (le_or_eq_succ_of_le_succ this)
         (suppose i ≤ j', le.trans (H j') (ih this))
         (suppose i = succ j', by rewrite this; apply le.refl))
end

/- other forms of induction -/

protected definition strong_rec_on {P : nat → Type} (n : ℕ) (H : ∀n, (∀m, m < n → P m) → P n) : P n :=
nat.rec (λm h, absurd h !not_lt_zero)
  (λn' (IH : ∀ {m : ℕ}, m < n' → P m) m l,
     or.by_cases (lt_or_eq_of_le (le_of_lt_succ l))
    IH (λ e, eq.rec (H n' @IH) e⁻¹)) (succ n) n !lt_succ_self

protected theorem strong_induction_on {P : nat → Prop} (n : ℕ) (H : ∀n, (∀m, m < n → P m) → P n) :
    P n :=
nat.strong_rec_on n H

protected theorem case_strong_induction_on {P : nat → Prop} (a : nat) (H0 : P 0)
  (Hind : ∀(n : nat), (∀m, m ≤ n → P m) → P (succ n)) : P a :=
nat.strong_induction_on a
  (take n,
   show (∀ m, m < n → P m) → P n, from
     nat.cases_on n
       (suppose (∀ m, m < 0 → P m), show P 0, from H0)
       (take n,
         suppose (∀ m, m < succ n → P m),
         show P (succ n), from
           Hind n (take m, assume H1 : m ≤ n, this _ (lt_succ_of_le H1))))

/- pos -/

theorem by_cases_zero_pos {P : ℕ → Prop} (y : ℕ) (H0 : P 0) (H1 : ∀ {y : nat}, y > 0 → P y) :
  P y :=
nat.cases_on y H0 (take y, H1 !succ_pos)

theorem eq_zero_or_pos (n : ℕ) : n = 0 ∨ n > 0 :=
or_of_or_of_imp_left
  (or.swap (lt_or_eq_of_le !zero_le))
  (suppose 0 = n, by subst n)

theorem pos_of_ne_zero {n : ℕ} (H : n ≠ 0) : n > 0 :=
or.elim !eq_zero_or_pos (take H2 : n = 0, by contradiction) (take H2 : n > 0, H2)

theorem ne_zero_of_pos {n : ℕ} (H : n > 0) : n ≠ 0 :=
ne.symm (ne_of_lt H)

theorem exists_eq_succ_of_pos {n : ℕ} (H : n > 0) : ∃l, n = succ l :=
exists_eq_succ_of_lt H

theorem pos_of_dvd_of_pos {m n : ℕ} (H1 : m ∣ n) (H2 : n > 0) : m > 0 :=
pos_of_ne_zero
  (suppose m = 0,
   have  n = 0, from eq_zero_of_zero_dvd (this ▸ H1),
   ne_of_lt H2 (by subst n))

/- multiplication -/

theorem mul_lt_mul_of_le_of_lt {n m k l : ℕ} (Hk : k > 0) (H1 : n ≤ k) (H2 : m < l) :
  n * m < k * l :=
lt_of_le_of_lt (mul_le_mul_right m H1) (mul_lt_mul_of_pos_left H2 Hk)

theorem mul_lt_mul_of_lt_of_le {n m k l : ℕ} (Hl : l > 0) (H1 : n < k) (H2 : m ≤ l) :
  n * m < k * l :=
lt_of_le_of_lt (mul_le_mul_left n H2) (mul_lt_mul_of_pos_right H1 Hl)

theorem mul_lt_mul_of_le_of_le {n m k l : ℕ} (H1 : n < k) (H2 : m < l) : n * m < k * l :=
have H3 : n * m ≤ k * m, from mul_le_mul_right m (le_of_lt H1),
have H4 : k * m < k * l, from mul_lt_mul_of_pos_left H2 (lt_of_le_of_lt !zero_le H1),
lt_of_le_of_lt H3 H4

theorem eq_of_mul_eq_mul_left {m k n : ℕ} (Hn : n > 0) (H : n * m = n * k) : m = k :=
have n * m ≤ n * k, by rewrite H,
have m ≤ k,         from le_of_mul_le_mul_left this Hn,
have n * k ≤ n * m, by rewrite H,
have k ≤ m,         from le_of_mul_le_mul_left this Hn,
le.antisymm `m ≤ k` this

theorem eq_of_mul_eq_mul_right {n m k : ℕ} (Hm : m > 0) (H : n * m = k * m) : n = k :=
eq_of_mul_eq_mul_left Hm (!mul.comm ▸ !mul.comm ▸ H)

theorem eq_zero_or_eq_of_mul_eq_mul_left {n m k : ℕ} (H : n * m = n * k) : n = 0 ∨ m = k :=
or_of_or_of_imp_right !eq_zero_or_pos
  (assume Hn : n > 0, eq_of_mul_eq_mul_left Hn H)

theorem eq_zero_or_eq_of_mul_eq_mul_right  {n m k : ℕ} (H : n * m = k * m) : m = 0 ∨ n = k :=
eq_zero_or_eq_of_mul_eq_mul_left (!mul.comm ▸ !mul.comm ▸ H)

theorem eq_one_of_mul_eq_one_right {n m : ℕ} (H : n * m = 1) : n = 1 :=
have H2 : n * m > 0, by rewrite H; apply succ_pos,
or.elim (le_or_gt n 1)
  (suppose n ≤ 1,
    have n > 0, from pos_of_mul_pos_right H2,
    show n = 1, from le.antisymm `n ≤ 1` (succ_le_of_lt this))
  (suppose n > 1,
    have m > 0, from pos_of_mul_pos_left H2,
    have n * m ≥ 2 * 1, from nat.mul_le_mul (succ_le_of_lt `n > 1`) (succ_le_of_lt this),
    have 1 ≥ 2, from !mul_one ▸ H ▸ this,
    absurd !lt_succ_self (not_lt_of_ge this))

theorem eq_one_of_mul_eq_one_left {n m : ℕ} (H : n * m = 1) : m = 1 :=
eq_one_of_mul_eq_one_right (!mul.comm ▸ H)

theorem eq_one_of_mul_eq_self_left {n m : ℕ} (Hpos : n > 0) (H : m * n = n) : m = 1 :=
eq_of_mul_eq_mul_right Hpos (H ⬝ !one_mul⁻¹)

theorem eq_one_of_mul_eq_self_right {n m : ℕ} (Hpos : m > 0) (H : m * n = m) : n = 1 :=
eq_one_of_mul_eq_self_left Hpos (!mul.comm ▸ H)

theorem eq_one_of_dvd_one {n : ℕ} (H : n ∣ 1) : n = 1 :=
dvd.elim H
  (take m, suppose 1 = n * m,
   eq_one_of_mul_eq_one_right this⁻¹)

/- min and max -/
open decidable

theorem min_zero [simp] (a : ℕ) : min a 0 = 0 :=
by rewrite [min_eq_right !zero_le]

theorem zero_min [simp] (a : ℕ) : min 0 a = 0 :=
by rewrite [min_eq_left !zero_le]

theorem max_zero [simp] (a : ℕ) : max a 0 = a :=
by rewrite [max_eq_left !zero_le]

theorem zero_max [simp] (a : ℕ) : max 0 a = a :=
by rewrite [max_eq_right !zero_le]

theorem min_succ_succ [simp] (a b : ℕ) : min (succ a) (succ b) = succ (min a b) :=
or.elim !lt_or_ge
  (suppose a < b, by rewrite [min_eq_left_of_lt this, min_eq_left_of_lt (succ_lt_succ this)])
  (suppose a ≥ b, by rewrite [min_eq_right this, min_eq_right (succ_le_succ this)])

theorem max_succ_succ [simp] (a b : ℕ) : max (succ a) (succ b) = succ (max a b) :=
or.elim !lt_or_ge
  (suppose a < b, by rewrite [max_eq_right_of_lt this, max_eq_right_of_lt (succ_lt_succ this)])
  (suppose a ≥ b, by rewrite [max_eq_left this, max_eq_left (succ_le_succ this)])

/- In algebra.ordered_group, these next four are only proved for additive groups, not additive
   semigroups. -/

protected theorem min_add_add_left (a b c : ℕ) : min (a + b) (a + c) = a + min b c :=
decidable.by_cases
  (suppose b ≤ c,
   have a + b ≤ a + c, from add_le_add_left this _,
   by rewrite [min_eq_left `b ≤ c`, min_eq_left this])
  (suppose ¬ b ≤ c,
   have c ≤ b,         from le_of_lt (lt_of_not_ge this),
   have a + c ≤ a + b, from add_le_add_left this _,
   by rewrite [min_eq_right `c ≤ b`, min_eq_right this])

protected theorem min_add_add_right (a b c : ℕ) : min (a + c) (b + c) = min a b + c :=
by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply nat.min_add_add_left

protected theorem max_add_add_left (a b c : ℕ) : max (a + b) (a + c) = a + max b c :=
decidable.by_cases
  (suppose b ≤ c,
   have a + b ≤ a + c, from add_le_add_left this _,
   by rewrite [max_eq_right `b ≤ c`, max_eq_right this])
  (suppose ¬ b ≤ c,
   have c ≤ b,         from le_of_lt (lt_of_not_ge this),
   have a + c ≤ a + b, from add_le_add_left this _,
   by rewrite [max_eq_left `c ≤ b`, max_eq_left this])

protected theorem max_add_add_right (a b c : ℕ) : max (a + c) (b + c) = max a b + c :=
by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply nat.max_add_add_left

/- least and greatest -/

section least_and_greatest
  variable (P : ℕ → Prop)
  variable [decP : ∀ n, decidable (P n)]
  include decP

  -- returns the least i < n satisfying P, or n if there is none
  definition least : ℕ → ℕ
    | 0        := 0
    | (succ n) := if P (least n) then least n else succ n

  theorem least_of_bound {n : ℕ} (H : P n) : P (least P n) :=
    begin
      induction n with [m, ih],
      rewrite ↑least,
      apply H,
      rewrite ↑least,
      cases decidable.em (P (least P m)) with [Hlp, Hlp],
      rewrite [if_pos Hlp],
      apply Hlp,
      rewrite [if_neg Hlp],
      apply H
    end

  theorem least_le (n : ℕ) : least P n ≤ n:=
    begin
      induction n with [m, ih],
        {rewrite ↑least},
      rewrite ↑least,
      cases decidable.em (P (least P m)) with [Psm, Pnsm],
      rewrite [if_pos Psm],
      apply le.trans ih !le_succ,
      rewrite [if_neg Pnsm]
    end

 theorem least_of_lt {i n : ℕ} (ltin : i < n) (H : P i) : P (least P n) :=
   begin
     induction n with [m, ih],
     exact absurd ltin !not_lt_zero,
     rewrite ↑least,
     cases decidable.em (P (least P m)) with [Psm, Pnsm],
     rewrite [if_pos Psm],
     apply Psm,
     rewrite [if_neg Pnsm],
     cases (lt_or_eq_of_le (le_of_lt_succ ltin)) with [Hlt, Heq],
     exact absurd (ih Hlt) Pnsm,
     rewrite Heq at H,
     exact absurd (least_of_bound P H) Pnsm
   end

  theorem ge_least_of_lt {i n : ℕ} (ltin : i < n) (Hi : P i) : i ≥ least P n :=
    begin
      induction n with [m, ih],
      exact absurd ltin !not_lt_zero,
      rewrite ↑least,
      cases decidable.em (P (least P m)) with [Psm, Pnsm],
      rewrite [if_pos Psm],
      cases (lt_or_eq_of_le (le_of_lt_succ ltin)) with [Hlt, Heq],
      apply ih Hlt,
      rewrite Heq,
      apply least_le,
      rewrite [if_neg Pnsm],
      cases (lt_or_eq_of_le (le_of_lt_succ ltin)) with [Hlt, Heq],
      apply absurd (least_of_lt P Hlt Hi) Pnsm,
      rewrite Heq at Hi,
      apply absurd (least_of_bound P Hi) Pnsm
    end
  theorem least_lt {n i : ℕ} (ltin : i < n) (Hi : P i) : least P n < n :=
    lt_of_le_of_lt (ge_least_of_lt P ltin Hi) ltin

  -- returns the largest i < n satisfying P, or n if there is none.
  definition greatest : ℕ → ℕ
  | 0        := 0
  | (succ n) := if P n then n else greatest n

  theorem greatest_of_lt {i n : ℕ} (ltin : i < n) (Hi : P i) : P (greatest P n) :=
  begin
    induction n with [m, ih],
      {exact absurd ltin !not_lt_zero},
      {cases (decidable.em (P m)) with [Psm, Pnsm],
        {rewrite [↑greatest, if_pos Psm]; exact Psm},
        {rewrite [↑greatest, if_neg Pnsm],
          have neim : i ≠ m, from assume H : i = m, absurd (H ▸ Hi) Pnsm,
          have ltim : i < m, from lt_of_le_of_ne (le_of_lt_succ ltin) neim,
          apply ih ltim}}
  end

  theorem le_greatest_of_lt {i n : ℕ} (ltin : i < n) (Hi : P i) : i ≤ greatest P n :=
  begin
    induction n with [m, ih],
      {exact absurd ltin !not_lt_zero},
      {cases (decidable.em (P m)) with [Psm, Pnsm],
        {rewrite [↑greatest, if_pos Psm], apply le_of_lt_succ ltin},
        {rewrite [↑greatest, if_neg Pnsm],
          have neim : i ≠ m, from assume H : i = m, absurd (H ▸ Hi) Pnsm,
          have ltim : i < m, from lt_of_le_of_ne (le_of_lt_succ ltin) neim,
          apply ih ltim}}
  end

end least_and_greatest

end nat


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

! This file was ported from Lean 3 source module algebra.order.invertible
! leanprover-community/mathlib commit ee0c179cd3c8a45aa5bffbf1b41d8dbede452865
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Ring.Defs
import Mathlib.Algebra.Invertible
import Mathlib.Data.Nat.Cast.Basic

/-!
# Lemmas about `invOf` in ordered (semi)rings.
-/

variable [LinearOrderedSemiring α] {a : α}

@[simp]
theorem invOf_pos [Invertible a] : 0 < ⅟ a ↔ 0 < a :=
  haveI : 0 < a * ⅟ a := by simp only [mul_invOf_self, zero_lt_one]
  ⟨fun h => pos_of_mul_pos_left this h.le, fun h => pos_of_mul_pos_right this h.le⟩
#align inv_of_pos invOf_pos

@[simp]
theorem invOf_nonpos [Invertible a] : ⅟ a ≤ 0 ↔ a ≤ 0 := by simp only [← not_lt, invOf_pos]
#align inv_of_nonpos invOf_nonpos

@[simp]
theorem invOf_nonneg [Invertible a] : 0 ≤ ⅟ a ↔ 0 ≤ a :=
  haveI : 0 < a * ⅟ a := by simp only [mul_invOf_self, zero_lt_one]
  ⟨fun h => (pos_of_mul_pos_left this h).le, fun h => (pos_of_mul_pos_right this h).le⟩
#align inv_of_nonneg invOf_nonneg

@[simp]
theorem invOf_lt_zero [Invertible a] : ⅟ a < 0 ↔ a < 0 := by simp only [← not_le, invOf_nonneg]
#align inv_of_lt_zero invOf_lt_zero

@[simp]
theorem invOf_le_one [Invertible a] (h : 1 ≤ a) : ⅟ a ≤ 1 :=
  mul_invOf_self a ▸ le_mul_of_one_le_left (invOf_nonneg.2 <| zero_le_one.trans h) h
#align inv_of_le_one invOf_le_one

theorem pos_invOf_of_invertible_cast [Nontrivial α] (n : ℕ)
    [Invertible (n : α)] : 0 < ⅟(n : α) :=
  invOf_pos.2 <| Nat.cast_pos.2 <| pos_of_invertible_cast (α := α) n


import .field_rename
import ...inClassNotes.typeclasses.functor
import ...inClassNotes.typeclasses.algebra
import data.real.basic

/-
Copy this file to where you want to work on
it and then adjust the imports accordingly.
Work through the file following directions
as indicated. Turn in your completed file on
Collab.
-/

/-
1. We've imported our definitions from our
class on basic algebraic structures, such as
monoid and group. Go learn what an algebraic
*ring* is, define a typeclass that expresses
its definition, and define an instance that
expresses the claim that the integers (ℤ or
*int* in Lean) is a ring. You may "stub out"
the required proofs with *sorry*.
-/

open alg

set_option old_structure_cmd true

universe u

class has_ring (α : Type u)
  extends alg.add_comm_group α, mul_monoid α :=
(dist_left : ∀ (a b c : α),
  mul_groupoid.mul a (add_groupoid.add b c) =
  add_groupoid.add (mul_groupoid.mul a b) (mul_groupoid.mul a c))
(dist_right : ∀ (a b c : α),
  mul_groupoid.mul (add_groupoid.add b c) a =
  add_groupoid.add (mul_groupoid.mul b a) (mul_groupoid.mul c a))

axioms (T : Type) (t_add : T → T → T) (t_mul : T → T → T)

/-
2. Go learn what an algebraic *field* is, then
define a typeclass to formalize its definition,
and finally define two instances that express
the claims that the rational numbers (ℚ) and
the real numbers (ℝ) are both fields. Again you
may (and should) stub out the proof fields in
your instances using sorry.
-/

class has_field (α : Type u) extends has_ring α, mul_monoid α :=
(mul_comm : ∀ (a b : α), mul_groupoid.mul a b = mul_groupoid.mul b a )
(mul_inv : ∀ (a : α), (a ≠ alg.has_zero.zero) → ∃ (ainv : α), mul_groupoid.mul a ainv = alg.has_one.one)

instance has_field_rat : has_field ℚ := _

/-
3. Graduate students required. Undergrads extra
credit. Go figure out what an algebraic module is
and write a typeclass to specify it formally.
Create an instance to implement the typeclass for
the integers (ℤ not ℕ). Stub out the proofs. In
lieu of a formal proof, present a *brief informal*
(in English) argument to convince your instructor
that the integers really do form a module under
the usual arithmetic operators.
-/

/-
4. The set of (our representations of) natural
numbers is defined inductively. Here's how they
are defined, copied straight from Lean's library.

inductive nat
| zero : nat
| succ (n : nat) : nat

Complete the following function definitions
for natural number addition, multiplication,
and exponentiation. Write your own functions
here without using Lean's implementations
(i.e., don't use nat.mul, *, etc). You may
not use + except as a shorthand for using
the nat.succ constructor to add one. If you
need to do addition of something other than
one, use your own add function. Similarly, if
you need to multiply, using your mul function.
-/

def add : nat → nat → nat
| 0 m         := m
| (n' + 1) m  := nat.succ (add n' m)

def mul : nat → nat → nat
| 0 m         := _
| (n' + 1) m  := _

-- first arg raised to second
def exp : nat → nat → nat
| n 0 := _
| n (m'+1) := _

#eval exp 2 10    -- expect 1024

/-
5. Many computations can be expressed
as compositions of map and fold (also
sometimes called reduce). For example,
you can compute the length of a list
by mapping each element to the number,
1, and by the folding the list under
natural number addition. A slightly
more interesting function counts the
number of elements in a list that
satisfy some predicate (specified by
a boolean-returning function).

A. Write a function, mul_map_reduce, that
takes (1) a function, f : α → β, where β
must be a monoid; and (2) a list, l, of
objects of type α; and that then uses f
to map l to a list of objects of a type,
β, and that then does a fold on the list
to reduce it to a final value of type β.

Be sure to use a typeclass instance in
specifying the type of your function to
ensure that the only types that can serve
as values of β have monoid structures.
Use both our mul_monoid_foldr and fmap
functions to implement your solution.
-/

-- Your answer here

/-
B. Complete the given application of
mul_map_reduce with a lambda expression
to compute the product of the non-zero
values in the list
[1,0,2,0,3,0,4].
-/

#eval mul_map_reduce  _ [1,0,2,0,3,0,4]
-- expect 24

/-
6. Here you practice with type families.

A. Define a family of types, each of which
is index by two natural numbers, such that
each type is inhabited if and only if the
two natural numbers are equal. You may call
your type family nat_eql. Use implicit args
when it makes the use of your type family
easier.
-/

inductive nat_eql: nat → nat → Type
| zeros_equal : nat_eql 0 0
| n_succ_m_succ_equal : Π {n m : nat},
    nat_eql n m → nat_eql (n+1) (m+1)

/-
B. Now either complete the following programs
or argue informally (and briefly) why that
won't be possible.
-/

open nat_eql

def eq_0_0 : nat_eql 0 0 := zeros_equal
def eq_0_1 : nat_eql 0 1 := _
def eq_1_1 : nat_eql 1 1 := n_succ_m_succ_equal eq_0_0
def eq_2_2 : nat_eql 2 2 := n_succ_m_succ_equal (n_succ_m_succ_equal eq_0_0)

/-
C. The apply tactic in Lean's tactic language
let's you build the term you need by applying
an already defined function. Moreover, you can
leave holes (underscores) for the arguments and
those holes then become subgoals. In this way,
using tactics allows you to build a solution
using interactive, top-down, type-guided, aka
structured, programming! Show that eq_2_2 is
inhabited using Lean's tactic language. We get
you started. Hint: remember the "exact" tactic.
Hint: Think *top down*. Write a single, simple
expression that provides a complete solution
*except* for the holes that remain to be filled.
Then recursively "fill the holes". Continue
until you're done. Voila!
-/

def eq_10_10 : nat_eql 10 10 :=
begin
  apply n_succ_m_succ_equal,
  apply n_succ_m_succ_equal,
  apply n_succ_m_succ_equal,
  apply n_succ_m_succ_equal,
  apply n_succ_m_succ_equal,
  apply n_succ_m_succ_equal,
  apply n_succ_m_succ_equal,
  apply n_succ_m_succ_equal,
  apply n_succ_m_succ_equal,
  apply n_succ_m_succ_equal,
  exact eq_0_0,
end

/-
In Lean, "repeat" is a tactic that takes
another tactic as an argument (enclosed in
curly braces), applies it repeatedly until
it fails, and leaves you in the resulting
tactic state. Use the repeat tactic to
show that "nat_eql 500 500" is inhabited.
If you get a deterministic timeout, pick
smaller numbers, such as 100 and 100. It's
ok with us.
-/

def eq_500_500 : nat_eql 500 500 :=
begin
  repeat {apply n_succ_m_succ_equal},
  exact eq_0_0,
end

#reduce eq_500_500

/-
7. Typeclasses and instances are used in Lean
to implement *coercions*, also known as type
casts.

As in Java, C++, and many other languages,
coercions are automatically applied conversions
of values of one type, α, to values of another
type, β, so that that values of type α can be
used where values of type β are needed.

For example, in many languages you may use an
integer wherever a Boolean value is expected.
The conversion is typically from zero to false
and from any non-zero value to true.

Here's the has_coe (has coercion) typeclass as
defined in Lean's libraries. As you can see, a
coercion is really just a function, coe, from
one type to another, associated with the pair
of those two types.

class has_coe (a : Sort u) (b : Sort v) :=
(coe : a → b)

A. We provide a simple function, needs_bool,
that takes a bool value and just returns it.
Your job is to allow this function to be
applied to any nat value by defining a new
coercion from nat to bool.

First define a function, say nat_to_bool, that
converts any nat, n, to a bool, by the rule that
zero goes to false and any other nat goes to tt.
Then define an instance of the has_coe typeclass
to enable coercions from nat to bool. You should
call it nat_to_bool_coe. When you're done the
test cases below should work.
-/

def nat_to_bool : nat → bool :=
_

instance nat_to_bool_coe : has_coe nat bool :=
_

def needs_bool : bool → bool := λ b, b

-- Test cases
#eval needs_bool (1:nat)  -- expect tt
#eval needs_bool (0:nat)  -- expect ff

/-
Not only are coercions, when available, applied
automatically, but, with certain limitations,
Lean can also chain them automatically. Define
a second coercion called string_to_nat_coe,
from string to nat, that will coerce any string
to its length as a nat (using the string.length
function). When you're done, you should be able
to apply the needs_bool function to any string,
where the empty string returns ff and non-empty,
tt.
-/

instance string_to_nat_coe : _ :=
_

-- Test cases
#eval needs_bool "Hello"  -- expect tt
#eval needs_bool ""  -- expect ff

/-
Do you see how the coercions are being chained,
aka, composed, automatically?
-/

--  Good job!

example : 1 = 1 :=
begin
  exact (eq.refl 1),
end

example : 1 = 1 :=
begin
  apply eq.refl _,
end


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/
import number_theory.number_field.class_number
import ring_theory.dedekind_domain.factorization

import tactic

/-

# Factorization of ideals into primes

The correct generality to set up a theory of factorization of nonzero ideals into prime
ideals is to assume that the ground ring is a Dedekind domain.

-/

open_locale number_field -- for 𝓞 K notation

-- Lean knows that the integers of a number field are a Dedekind domain

example (K : Type) [field K] [number_field K] : is_dedekind_domain (𝓞 K) := infer_instance

-- here's how to say "let R be a Dedekind domain"

variables (R : Type) [comm_ring R] [is_domain R] [is_dedekind_domain R]

open is_dedekind_domain

/-
There's an entire directory of files `ring_theory.dedekind_domain` containing
results about Dedekind domains. There are still a few "TODO"s though; for
example `ring_theory.dedekind_domain.dvr` contains a definition which is
known to be equivalent to Dedekind domain, but this is not yet proved in mathlib.

## Nonzero prime ideals of a Dedekind domain.

Here's the definition of `is_dedekind_domain.height_one_spectrum`:

```
structure height_one_spectrum :=
(as_ideal : ideal R)
(is_prime : as_ideal.is_prime)
(ne_bot : as_ideal ≠ ⊥)
```

It's the nonzero prime ideals of `R`. Because Dedekind domains are either fields or
1-dimensional, `height_one_spectrum R` is either empty (if `R` is a field) or
the set of maximal ideals of `R`.

A key result is that in any Dedekind domain, any nonzero ideal is contained
in only finitely many maximal ideals.

-/

example {I : ideal R} (hI : I ≠ 0) :
  {v : height_one_spectrum R | v.as_ideal ∣ I}.finite :=
begin
  exact ideal.finite_factors hI,
end

-- Hence it makes sense to take a product over these factors.
-- The theorem `ideal.finprod_height_one_spectrum_factorization`
-- says that every nonzero ideal factors into primes.

open_locale big_operators

example (I : ideal R) (hI : I ≠ 0) :
  ∏ᶠ (v : height_one_spectrum R), v.max_pow_dividing I = I :=
begin
  exact ideal.finprod_height_one_spectrum_factorization I hI,
end

-- Furthermore the factorization is unique
example : unique_factorization_monoid (ideal R) := infer_instance


import plane_separation_world.level04 --hide
open IncidencePlane --hide

noncomputable theory --hide
open_locale classical --hide

/-
# Plane Separation World

## Level 5: on the way to the final level (II).

This is the second of five lemmas that we need to prove before jumping into the final level of the game! You will be provided with
its mathematical proof in paper right below. Remember that you can use all the theorem statements from the left-hand side box.

## Mathematical proof in paper...

**Claim:** Given three non-collinear points A, B and C, then B is not incident with the line through A and C.

**Proof:**

By the lemma `noncollinear_ne_points`, since A, B and C are non-collinear points, then `A ≠ C`.

By the lemma `collinear_iff_on_line_through`, since `A ≠ C`, then it suffices to prove that the points A, C, B are not collinear.

By the assumption of the lemma `hCol : ¬ collinear ({A, C, B} : set Ω))`, then we show that `B ∉ line_through A C`.

-/

/- Hint : Click here for a hint, in case you get stuck.
If you have a theorem statement called `theorem1`, which shows `x` by using the hypothesis `h : P`, then `have htheorem := theorem1 h` will
add the hypothesis `htheorem : x` to the local context. In case you feel bewildered, do not hesitate
to click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
Given three non-collinear points A, B and C, then B is not incident with the line through A and C.
-/
lemma noncollinear_ne_line (hCol : ¬ collinear ({A, C, B} : set Ω)) : B ∉ line_through A C :=
begin
  have hAC := noncollinear_ne_points hCol,
  rw ← collinear_iff_on_line_through hAC,
  exact hCol,
end


#print "------------------------------------------------"
#print "Section 2.10 Exercises"
/- 1. Define the function =Do_twice=, as described in Section 2.4.-/
def Do_Twice : ((ℕ → ℕ) → (ℕ → ℕ)) → (ℕ → ℕ) → (ℕ → ℕ) :=
                 λ (f: (ℕ → ℕ) → (ℕ → ℕ)) (g: ℕ → ℕ), f (f g)

/- 2. Define the functions =curry= and =uncurry=, as described in Section 2.4. -/
  def curry (α β γ : Type) (f : α × β → γ) : α → β → γ :=
         λ (x : α) (y : β), f (x, y)

  def uncurry (α β γ : Type) (f : α → β → γ) : α × β → γ :=
         λ (p : α × β), f p.1 p.2

/- 3. We used the example =vec α n= for vectors of elements of type =α= of length =n=.
      Declare a constant =vec_add= that could represent a function that adds two vectors
      of natural numbers of the same length, and a constant =vec_reverse= that can represent
      a function that reverses its argument. Use implicit arguments for parameters that can
      be inferred. Declare some variables and check some expressions involving the constants
      that you have declared. -/

namespace exercise3
  universe u
  constant vec : Type u → ℕ → Type u

  namespace vec
    constant empty : Π {α : Type u}, vec α 0
    constant cons : Π {α : Type u} {n : ℕ}, α → vec α n → vec α (n + 1)
    constant append : Π {α : Type u} {n m : ℕ},
                    vec α n → vec α m → vec α (n + m)
    constant add : Π {α : Type u} {n : ℕ}, vec α n → vec α n → vec α n
    constant reverse : Π {α : Type u} {n : ℕ}, vec α n → vec α n
  end vec

  variable α : Type u
  variable v : vec α 10
  variable w : vec α 5
  variable z : vec α 5

-- (partial application types)
  #check @vec.append α 10 5 v         -- vec α 5 → vec α (10 + 5)
  #check @vec.append α 10 _ v         -- vec α ?M_1 → vec α (10 + ?M_1)

  #check vec.append v w               -- vec α (10 + 5)
  #check vec.add w z                  -- vec α 5
  #check vec.add v (vec.append w z)   -- vec α 10

end exercise3

/- 4. Similarly, declare a constant =matrix= so that =matrix α m n= could represent the type
      of =m= by =n= matrices. Declare some constants to represent functions on this type,
      such as matrix addition and multiplication, and (using =vec=) multiplication of a
      matrix by a vector. Once again, declare some variables and check some expressions
      involving the constants that you have declared.  -/
namespace exercise4
  universe u
  constant matrix : Type u → ℕ → ℕ → Type u

  namespace matrix
    constant empty : Π {α : Type u}, matrix α 0 0
    constant plus : Π {α : Type u} {m n : ℕ}, matrix α m n → matrix α m n → matrix α m n
    constant prod : Π {α : Type u} {i k j : ℕ}, matrix α i k → matrix α k j → matrix α i j
  end matrix

  variables α β : Type u
  variables M1 M2 : matrix α 2 3
  variable M3 : matrix α 3 4
  variable N3 : matrix β 3 4

  #check matrix.plus M1 M2        -- matrix α 2 3
  #check matrix.prod M2 M3        -- matrix α 2 4

  -- #check matrix.plus M1 M3      -- (dimensions not compatible with plus)
  -- #check matrix.prod M1 M2      -- (dimensions not compatible with prod)
  -- #check matrix.prod M2 N3      -- (expected `matrix α 3 ?` but `N3 : matrix β 3 4`)

end exercise4