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

! This file was ported from Lean 3 source module measure_theory.group.prod
! leanprover-community/mathlib commit ec247d43814751ffceb33b758e8820df2372bf6f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Constructions.Prod
import Mathbin.MeasureTheory.Group.Measure

/-!
# Measure theory in the product of groups
In this file we show properties about measure theory in products of measurable groups
and properties of iterated integrals in measurable groups.

These lemmas show the uniqueness of left invariant measures on measurable groups, up to
scaling. In this file we follow the proof and refer to the book *Measure Theory* by Paul Halmos.

The idea of the proof is to use the translation invariance of measures to prove `μ(t) = c * μ(s)`
for two sets `s` and `t`, where `c` is a constant that does not depend on `μ`. Let `e` and `f` be
the characteristic functions of `s` and `t`.
Assume that `μ` and `ν` are left-invariant measures. Then the map `(x, y) ↦ (y * x, x⁻¹)`
preserves the measure `μ × ν`, which means that
```
  ∫ x, ∫ y, h x y ∂ν ∂μ = ∫ x, ∫ y, h (y * x) x⁻¹ ∂ν ∂μ
```
If we apply this to `h x y := e x * f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' s)`, we can rewrite the RHS to
`μ(t)`, and the LHS to `c * μ(s)`, where `c = c(ν)` does not depend on `μ`.
Applying this to `μ` and to `ν` gives `μ (t) / μ (s) = ν (t) / ν (s)`, which is the uniqueness up to
scalar multiplication.

The proof in [Halmos] seems to contain an omission in §60 Th. A, see
`measure_theory.measure_lintegral_div_measure`.

-/

noncomputable section

open Set hiding prod_eq

open Function MeasureTheory

open Filter hiding map

open Classical ENNReal Pointwise MeasureTheory

variable (G : Type _) [MeasurableSpace G]

variable [Group G] [HasMeasurableMul₂ G]

variable (μ ν : Measure G) [SigmaFinite ν] [SigmaFinite μ] {s : Set G}

/-- The map `(x, y) ↦ (x, xy)` as a `measurable_equiv`. -/
@[to_additive "The map `(x, y) ↦ (x, x + y)` as a `measurable_equiv`."]
protected def MeasurableEquiv.shearMulRight [HasMeasurableInv G] : G × G ≃ᵐ G × G :=
  {
    Equiv.prodShear (Equiv.refl _)
      Equiv.mulLeft with
    measurable_to_fun := measurable_fst.prod_mk measurable_mul
    measurable_inv_fun := measurable_fst.prod_mk <| measurable_fst.inv.mul measurable_snd }
#align measurable_equiv.shear_mul_right MeasurableEquiv.shearMulRight
#align measurable_equiv.shear_add_right MeasurableEquiv.shearAddRight

/-- The map `(x, y) ↦ (x, y / x)` as a `measurable_equiv` with as inverse `(x, y) ↦ (x, yx)` -/
@[to_additive
      "The map `(x, y) ↦ (x, y - x)` as a `measurable_equiv` with as inverse `(x, y) ↦ (x, y + x)`."]
protected def MeasurableEquiv.shearDivRight [HasMeasurableInv G] : G × G ≃ᵐ G × G :=
  {
    Equiv.prodShear (Equiv.refl _)
      Equiv.divRight with
    measurable_to_fun := measurable_fst.prod_mk <| measurable_snd.div measurable_fst
    measurable_inv_fun := measurable_fst.prod_mk <| measurable_snd.mul measurable_fst }
#align measurable_equiv.shear_div_right MeasurableEquiv.shearDivRight
#align measurable_equiv.shear_sub_right MeasurableEquiv.shearSubRight

variable {G}

namespace MeasureTheory

open Measure

section LeftInvariant

/-- The multiplicative shear mapping `(x, y) ↦ (x, xy)` preserves the measure `μ × ν`.
This condition is part of the definition of a measurable group in [Halmos, §59].
There, the map in this lemma is called `S`. -/
@[to_additive measure_preserving_prod_add
      " The shear mapping `(x, y) ↦ (x, x + y)` preserves the measure `μ × ν`. "]
theorem measurePreservingProdMul [IsMulLeftInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1, z.1 * z.2)) (μ.Prod ν) (μ.Prod ν) :=
  (MeasurePreserving.id μ).skewProduct measurable_mul <|
    Filter.eventually_of_forall <| map_mul_left_eq_self ν
#align measure_theory.measure_preserving_prod_mul MeasureTheory.measurePreservingProdMul
#align measure_theory.measure_preserving_prod_add MeasureTheory.measure_preserving_prod_add

/-- The map `(x, y) ↦ (y, yx)` sends the measure `μ × ν` to `ν × μ`.
This is the map `SR` in [Halmos, §59].
`S` is the map `(x, y) ↦ (x, xy)` and `R` is `prod.swap`. -/
@[to_additive measure_preserving_prod_add_swap
      " The map `(x, y) ↦ (y, y + x)` sends the measure `μ × ν` to `ν × μ`. "]
theorem measurePreservingProdMulSwap [IsMulLeftInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.2, z.2 * z.1)) (μ.Prod ν) (ν.Prod μ) :=
  (measurePreservingProdMul ν μ).comp measurePreservingSwap
#align measure_theory.measure_preserving_prod_mul_swap MeasureTheory.measurePreservingProdMulSwap
#align measure_theory.measure_preserving_prod_add_swap MeasureTheory.measure_preserving_prod_add_swap

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[to_additive]
theorem measurable_measure_mul_right (hs : MeasurableSet s) :
    Measurable fun x => μ ((fun y => y * x) ⁻¹' s) :=
  by
  suffices
    Measurable fun y =>
      μ ((fun x => (x, y)) ⁻¹' ((fun z : G × G => ((1 : G), z.1 * z.2)) ⁻¹' univ ×ˢ s))
    by
    convert this
    ext1 x
    congr 1 with y : 1
    simp
  apply measurable_measure_prod_mk_right
  exact measurable_const.prod_mk measurable_mul (measurable_set.univ.prod hs)
#align measure_theory.measurable_measure_mul_right MeasureTheory.measurable_measure_mul_right
#align measure_theory.measurable_measure_add_right MeasureTheory.measurable_measure_add_right

variable [HasMeasurableInv G]

/-- The map `(x, y) ↦ (x, x⁻¹y)` is measure-preserving.
This is the function `S⁻¹` in [Halmos, §59],
where `S` is the map `(x, y) ↦ (x, xy)`. -/
@[to_additive measure_preserving_prod_neg_add
      "The map `(x, y) ↦ (x, - x + y)` is measure-preserving."]
theorem measurePreservingProdInvMul [IsMulLeftInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1, z.1⁻¹ * z.2)) (μ.Prod ν) (μ.Prod ν) :=
  (measurePreservingProdMul μ ν).symm <| MeasurableEquiv.shearMulRight G
#align measure_theory.measure_preserving_prod_inv_mul MeasureTheory.measurePreservingProdInvMul
#align measure_theory.measure_preserving_prod_neg_add MeasureTheory.measure_preserving_prod_neg_add

variable [IsMulLeftInvariant μ]

/-- The map `(x, y) ↦ (y, y⁻¹x)` sends `μ × ν` to `ν × μ`.
This is the function `S⁻¹R` in [Halmos, §59],
where `S` is the map `(x, y) ↦ (x, xy)` and `R` is `prod.swap`. -/
@[to_additive measure_preserving_prod_neg_add_swap
      "The map `(x, y) ↦ (y, - y + x)` sends `μ × ν` to `ν × μ`."]
theorem measurePreservingProdInvMulSwap :
    MeasurePreserving (fun z : G × G => (z.2, z.2⁻¹ * z.1)) (μ.Prod ν) (ν.Prod μ) :=
  (measurePreservingProdInvMul ν μ).comp measurePreservingSwap
#align measure_theory.measure_preserving_prod_inv_mul_swap MeasureTheory.measurePreservingProdInvMulSwap
#align measure_theory.measure_preserving_prod_neg_add_swap MeasureTheory.measure_preserving_prod_neg_add_swap

/-- The map `(x, y) ↦ (yx, x⁻¹)` is measure-preserving.
This is the function `S⁻¹RSR` in [Halmos, §59],
where `S` is the map `(x, y) ↦ (x, xy)` and `R` is `prod.swap`. -/
@[to_additive measure_preserving_add_prod_neg
      "The map `(x, y) ↦ (y + x, - x)` is measure-preserving."]
theorem measurePreservingMulProdInv [IsMulLeftInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.2 * z.1, z.1⁻¹)) (μ.Prod ν) (μ.Prod ν) :=
  by
  convert(measure_preserving_prod_inv_mul_swap ν μ).comp (measure_preserving_prod_mul_swap μ ν)
  ext1 ⟨x, y⟩
  simp_rw [Function.comp_apply, mul_inv_rev, inv_mul_cancel_right]
#align measure_theory.measure_preserving_mul_prod_inv MeasureTheory.measurePreservingMulProdInv
#align measure_theory.measure_preserving_add_prod_neg MeasureTheory.measure_preserving_add_prod_neg

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[to_additive]
theorem quasiMeasurePreservingInv : QuasiMeasurePreserving (Inv.inv : G → G) μ μ :=
  by
  refine' ⟨measurable_inv, absolutely_continuous.mk fun s hsm hμs => _⟩
  rw [map_apply measurable_inv hsm, inv_preimage]
  have hf : Measurable fun z : G × G => (z.2 * z.1, z.1⁻¹) :=
    (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv
  suffices map (fun z : G × G => (z.2 * z.1, z.1⁻¹)) (μ.prod μ) (s⁻¹ ×ˢ s⁻¹) = 0 by
    simpa only [(measure_preserving_mul_prod_inv μ μ).map_eq, prod_prod, mul_eq_zero,
      or_self_iff] using this
  have hsm' : MeasurableSet (s⁻¹ ×ˢ s⁻¹) := hsm.inv.prod hsm.inv
  simp_rw [map_apply hf hsm', prod_apply_symm (hf hsm'), preimage_preimage, mk_preimage_prod,
    inv_preimage, inv_inv, measure_mono_null (inter_subset_right _ _) hμs, lintegral_zero]
#align measure_theory.quasi_measure_preserving_inv MeasureTheory.quasiMeasurePreservingInv
#align measure_theory.quasi_measure_preserving_neg MeasureTheory.quasi_measure_preserving_neg

@[to_additive]
theorem measure_inv_null : μ s⁻¹ = 0 ↔ μ s = 0 :=
  by
  refine' ⟨fun hs => _, (quasi_measure_preserving_inv μ).preimage_null⟩
  rw [← inv_inv s]
  exact (quasi_measure_preserving_inv μ).preimage_null hs
#align measure_theory.measure_inv_null MeasureTheory.measure_inv_null
#align measure_theory.measure_neg_null MeasureTheory.measure_neg_null

@[to_additive]
theorem invAbsolutelyContinuous : μ.inv ≪ μ :=
  (quasiMeasurePreservingInv μ).AbsolutelyContinuous
#align measure_theory.inv_absolutely_continuous MeasureTheory.invAbsolutelyContinuous
#align measure_theory.neg_absolutely_continuous MeasureTheory.neg_absolutely_continuous

@[to_additive]
theorem absolutelyContinuousInv : μ ≪ μ.inv :=
  by
  refine' absolutely_continuous.mk fun s hs => _
  simp_rw [inv_apply μ s, measure_inv_null, imp_self]
#align measure_theory.absolutely_continuous_inv MeasureTheory.absolutelyContinuousInv
#align measure_theory.absolutely_continuous_neg MeasureTheory.absolutely_continuous_neg

@[to_additive]
theorem lintegral_lintegral_mul_inv [IsMulLeftInvariant ν] (f : G → G → ℝ≥0∞)
    (hf : AeMeasurable (uncurry f) (μ.Prod ν)) :
    (∫⁻ x, ∫⁻ y, f (y * x) x⁻¹ ∂ν ∂μ) = ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ :=
  by
  have h : Measurable fun z : G × G => (z.2 * z.1, z.1⁻¹) :=
    (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv
  have h2f : AeMeasurable (uncurry fun x y => f (y * x) x⁻¹) (μ.prod ν) :=
    hf.comp_quasi_measure_preserving (measure_preserving_mul_prod_inv μ ν).QuasiMeasurePreserving
  simp_rw [lintegral_lintegral h2f, lintegral_lintegral hf]
  conv_rhs => rw [← (measure_preserving_mul_prod_inv μ ν).map_eq]
  symm
  exact
    lintegral_map' (hf.mono' (measure_preserving_mul_prod_inv μ ν).map_eq.AbsolutelyContinuous)
      h.ae_measurable
#align measure_theory.lintegral_lintegral_mul_inv MeasureTheory.lintegral_lintegral_mul_inv
#align measure_theory.lintegral_lintegral_add_neg MeasureTheory.lintegral_lintegral_add_neg

@[to_additive]
theorem measure_mul_right_null (y : G) : μ ((fun x => x * y) ⁻¹' s) = 0 ↔ μ s = 0 :=
  calc
    μ ((fun x => x * y) ⁻¹' s) = 0 ↔ μ ((fun x => y⁻¹ * x) ⁻¹' s⁻¹)⁻¹ = 0 := by
      simp_rw [← inv_preimage, preimage_preimage, mul_inv_rev, inv_inv]
    _ ↔ μ s = 0 := by simp only [measure_inv_null μ, measure_preimage_mul]

#align measure_theory.measure_mul_right_null MeasureTheory.measure_mul_right_null
#align measure_theory.measure_add_right_null MeasureTheory.measure_add_right_null

@[to_additive]
theorem measure_mul_right_ne_zero (h2s : μ s ≠ 0) (y : G) : μ ((fun x => x * y) ⁻¹' s) ≠ 0 :=
  (not_congr (measure_mul_right_null μ y)).mpr h2s
#align measure_theory.measure_mul_right_ne_zero MeasureTheory.measure_mul_right_ne_zero
#align measure_theory.measure_add_right_ne_zero MeasureTheory.measure_add_right_ne_zero

@[to_additive]
theorem absolutelyContinuousMapMulRight (g : G) : μ ≪ map (· * g) μ :=
  by
  refine' absolutely_continuous.mk fun s hs => _
  rw [map_apply (measurable_mul_const g) hs, measure_mul_right_null]; exact id
#align measure_theory.absolutely_continuous_map_mul_right MeasureTheory.absolutelyContinuousMapMulRight
#align measure_theory.absolutely_continuous_map_add_right MeasureTheory.absolutely_continuous_map_add_right

@[to_additive]
theorem absolutelyContinuousMapDivLeft (g : G) : μ ≪ map (fun h => g / h) μ :=
  by
  simp_rw [div_eq_mul_inv]
  rw [← map_map (measurable_const_mul g) measurable_inv]
  conv_lhs => rw [← map_mul_left_eq_self μ g]
  exact (absolutely_continuous_inv μ).map (measurable_const_mul g)
#align measure_theory.absolutely_continuous_map_div_left MeasureTheory.absolutelyContinuousMapDivLeft
#align measure_theory.absolutely_continuous_map_sub_left MeasureTheory.absolutely_continuous_map_sub_left

/-- This is the computation performed in the proof of [Halmos, §60 Th. A]. -/
@[to_additive "This is the computation performed in the proof of [Halmos, §60 Th. A]."]
theorem measure_mul_lintegral_eq [IsMulLeftInvariant ν] (sm : MeasurableSet s) (f : G → ℝ≥0∞)
    (hf : Measurable f) : (μ s * ∫⁻ y, f y ∂ν) = ∫⁻ x, ν ((fun z => z * x) ⁻¹' s) * f x⁻¹ ∂μ :=
  by
  rw [← set_lintegral_one, ← lintegral_indicator _ sm, ←
    lintegral_lintegral_mul (measurable_const.indicator sm).AeMeasurable hf.ae_measurable, ←
    lintegral_lintegral_mul_inv μ ν]
  swap
  ·
    exact
      (((measurable_const.indicator sm).comp measurable_fst).mul
          (hf.comp measurable_snd)).AeMeasurable
  have ms :
    ∀ x : G, Measurable fun y => ((fun z => z * x) ⁻¹' s).indicator (fun z => (1 : ℝ≥0∞)) y :=
    fun x => measurable_const.indicator (measurable_mul_const _ sm)
  have :
    ∀ x y,
      s.indicator (fun z : G => (1 : ℝ≥0∞)) (y * x) =
        ((fun z => z * x) ⁻¹' s).indicator (fun b : G => 1) y :=
    by
    intro x y
    symm
    convert indicator_comp_right fun y => y * x
    ext1 z
    rfl
  simp_rw [this, lintegral_mul_const _ (ms _), lintegral_indicator _ (measurable_mul_const _ sm),
    set_lintegral_one]
#align measure_theory.measure_mul_lintegral_eq MeasureTheory.measure_mul_lintegral_eq
#align measure_theory.measure_add_lintegral_eq MeasureTheory.measure_add_lintegral_eq

/-- Any two nonzero left-invariant measures are absolutely continuous w.r.t. each other. -/
@[to_additive
      " Any two nonzero left-invariant measures are absolutely continuous w.r.t. each\nother. "]
theorem absolutelyContinuousOfIsMulLeftInvariant [IsMulLeftInvariant ν] (hν : ν ≠ 0) : μ ≪ ν :=
  by
  refine' absolutely_continuous.mk fun s sm hνs => _
  have h1 := measure_mul_lintegral_eq μ ν sm 1 measurable_one
  simp_rw [Pi.one_apply, lintegral_one, mul_one, (measure_mul_right_null ν _).mpr hνs,
    lintegral_zero, mul_eq_zero, measure_univ_eq_zero.not.mpr hν, or_false_iff] at h1
  exact h1
#align measure_theory.absolutely_continuous_of_is_mul_left_invariant MeasureTheory.absolutelyContinuousOfIsMulLeftInvariant
#align measure_theory.absolutely_continuous_of_is_add_left_invariant MeasureTheory.absolutely_continuous_of_is_add_left_invariant

@[to_additive]
theorem ae_measure_preimage_mul_right_lt_top [IsMulLeftInvariant ν] (sm : MeasurableSet s)
    (hμs : μ s ≠ ∞) : ∀ᵐ x ∂μ, ν ((fun y => y * x) ⁻¹' s) < ∞ :=
  by
  refine' ae_of_forall_measure_lt_top_ae_restrict' ν.inv _ _
  intro A hA h2A h3A
  simp only [ν.inv_apply] at h3A
  apply ae_lt_top (measurable_measure_mul_right ν sm)
  have h1 := measure_mul_lintegral_eq μ ν sm (A⁻¹.indicator 1) (measurable_one.indicator hA.inv)
  rw [lintegral_indicator _ hA.inv] at h1
  simp_rw [Pi.one_apply, set_lintegral_one, ← image_inv, indicator_image inv_injective, image_inv, ←
    indicator_mul_right _ fun x => ν ((fun y => y * x) ⁻¹' s), Function.comp, Pi.one_apply,
    mul_one] at h1
  rw [← lintegral_indicator _ hA, ← h1]
  exact ENNReal.mul_ne_top hμs h3A.ne
#align measure_theory.ae_measure_preimage_mul_right_lt_top MeasureTheory.ae_measure_preimage_mul_right_lt_top
#align measure_theory.ae_measure_preimage_add_right_lt_top MeasureTheory.ae_measure_preimage_add_right_lt_top

@[to_additive]
theorem ae_measure_preimage_mul_right_lt_top_of_ne_zero [IsMulLeftInvariant ν]
    (sm : MeasurableSet s) (h2s : ν s ≠ 0) (h3s : ν s ≠ ∞) :
    ∀ᵐ x ∂μ, ν ((fun y => y * x) ⁻¹' s) < ∞ :=
  by
  refine' (ae_measure_preimage_mul_right_lt_top ν ν sm h3s).filter_mono _
  refine' (absolutely_continuous_of_is_mul_left_invariant μ ν _).ae_le
  refine' mt _ h2s
  intro hν
  rw [hν, measure.coe_zero, Pi.zero_apply]
#align measure_theory.ae_measure_preimage_mul_right_lt_top_of_ne_zero MeasureTheory.ae_measure_preimage_mul_right_lt_top_of_ne_zero
#align measure_theory.ae_measure_preimage_add_right_lt_top_of_ne_zero MeasureTheory.ae_measure_preimage_add_right_lt_top_of_ne_zero

/-- A technical lemma relating two different measures. This is basically [Halmos, §60 Th. A].
  Note that if `f` is the characteristic function of a measurable set `t` this states that
  `μ t = c * μ s` for a constant `c` that does not depend on `μ`.

  Note: There is a gap in the last step of the proof in [Halmos].
  In the last line, the equality `g(x⁻¹)ν(sx⁻¹) = f(x)` holds if we can prove that
  `0 < ν(sx⁻¹) < ∞`. The first inequality follows from §59, Th. D, but the second inequality is
  not justified. We prove this inequality for almost all `x` in
  `measure_theory.ae_measure_preimage_mul_right_lt_top_of_ne_zero`. -/
@[to_additive
      "A technical lemma relating two different measures. This is basically\n[Halmos, §60 Th. A]. Note that if `f` is the characteristic function of a measurable set `t` this\nstates that `μ t = c * μ s` for a constant `c` that does not depend on `μ`.\n\nNote: There is a gap in the last step of the proof in [Halmos]. In the last line, the equality\n`g(-x) + ν(s - x) = f(x)` holds if we can prove that `0 < ν(s - x) < ∞`. The first inequality\nfollows from §59, Th. D, but the second inequality is not justified. We prove this inequality for\nalmost all `x` in `measure_theory.ae_measure_preimage_add_right_lt_top_of_ne_zero`."]
theorem measure_lintegral_div_measure [IsMulLeftInvariant ν] (sm : MeasurableSet s) (h2s : ν s ≠ 0)
    (h3s : ν s ≠ ∞) (f : G → ℝ≥0∞) (hf : Measurable f) :
    (μ s * ∫⁻ y, f y⁻¹ / ν ((fun x => x * y⁻¹) ⁻¹' s) ∂ν) = ∫⁻ x, f x ∂μ :=
  by
  set g := fun y => f y⁻¹ / ν ((fun x => x * y⁻¹) ⁻¹' s)
  have hg : Measurable g :=
    (hf.comp measurable_inv).div ((measurable_measure_mul_right ν sm).comp measurable_inv)
  simp_rw [measure_mul_lintegral_eq μ ν sm g hg, g, inv_inv]
  refine' lintegral_congr_ae _
  refine' (ae_measure_preimage_mul_right_lt_top_of_ne_zero μ ν sm h2s h3s).mono fun x hx => _
  simp_rw [ENNReal.mul_div_cancel' (measure_mul_right_ne_zero ν h2s _) hx.ne]
#align measure_theory.measure_lintegral_div_measure MeasureTheory.measure_lintegral_div_measure
#align measure_theory.measure_lintegral_sub_measure MeasureTheory.measure_lintegral_sub_measure

@[to_additive]
theorem measure_mul_measure_eq [IsMulLeftInvariant ν] {s t : Set G} (hs : MeasurableSet s)
    (ht : MeasurableSet t) (h2s : ν s ≠ 0) (h3s : ν s ≠ ∞) : μ s * ν t = ν s * μ t :=
  by
  have h1 :=
    measure_lintegral_div_measure ν ν hs h2s h3s (t.indicator fun x => 1)
      (measurable_const.indicator ht)
  have h2 :=
    measure_lintegral_div_measure μ ν hs h2s h3s (t.indicator fun x => 1)
      (measurable_const.indicator ht)
  rw [lintegral_indicator _ ht, set_lintegral_one] at h1 h2
  rw [← h1, mul_left_comm, h2]
#align measure_theory.measure_mul_measure_eq MeasureTheory.measure_mul_measure_eq
#align measure_theory.measure_add_measure_eq MeasureTheory.measure_add_measure_eq

/-- Left invariant Borel measures on a measurable group are unique (up to a scalar). -/
@[to_additive
      " Left invariant Borel measures on an additive measurable group are unique\n  (up to a scalar). "]
theorem measure_eq_div_smul [IsMulLeftInvariant ν] (hs : MeasurableSet s) (h2s : ν s ≠ 0)
    (h3s : ν s ≠ ∞) : μ = (μ s / ν s) • ν := by
  ext1 t ht
  rw [smul_apply, smul_eq_mul, mul_comm, ← mul_div_assoc, mul_comm,
    measure_mul_measure_eq μ ν hs ht h2s h3s, mul_div_assoc, ENNReal.mul_div_cancel' h2s h3s]
#align measure_theory.measure_eq_div_smul MeasureTheory.measure_eq_div_smul
#align measure_theory.measure_eq_sub_vadd MeasureTheory.measure_eq_sub_vadd

end LeftInvariant

section RightInvariant

@[to_additive measure_preserving_prod_add_right]
theorem measurePreservingProdMulRight [IsMulRightInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1, z.2 * z.1)) (μ.Prod ν) (μ.Prod ν) :=
  (MeasurePreserving.id μ).skewProduct (measurable_snd.mul measurable_fst) <|
    Filter.eventually_of_forall <| map_mul_right_eq_self ν
#align measure_theory.measure_preserving_prod_mul_right MeasureTheory.measurePreservingProdMulRight
#align measure_theory.measure_preserving_prod_add_right MeasureTheory.measure_preserving_prod_add_right

/-- The map `(x, y) ↦ (y, xy)` sends the measure `μ × ν` to `ν × μ`. -/
@[to_additive measure_preserving_prod_add_swap_right
      " The map `(x, y) ↦ (y, x + y)` sends the measure `μ × ν` to `ν × μ`. "]
theorem measurePreservingProdMulSwapRight [IsMulRightInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.2, z.1 * z.2)) (μ.Prod ν) (ν.Prod μ) :=
  (measurePreservingProdMulRight ν μ).comp measurePreservingSwap
#align measure_theory.measure_preserving_prod_mul_swap_right MeasureTheory.measurePreservingProdMulSwapRight
#align measure_theory.measure_preserving_prod_add_swap_right MeasureTheory.measure_preserving_prod_add_swap_right

/-- The map `(x, y) ↦ (xy, y)` preserves the measure `μ × ν`. -/
@[to_additive measure_preserving_add_prod
      " The map `(x, y) ↦ (x + y, y)` preserves the measure `μ × ν`. "]
theorem measurePreservingMulProd [IsMulRightInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.1 * z.2, z.2)) (μ.Prod ν) (μ.Prod ν) :=
  measurePreservingSwap.comp <| by apply measure_preserving_prod_mul_swap_right μ ν
#align measure_theory.measure_preserving_mul_prod MeasureTheory.measurePreservingMulProd
#align measure_theory.measure_preserving_add_prod MeasureTheory.measure_preserving_add_prod

variable [HasMeasurableInv G]

/-- The map `(x, y) ↦ (x, y / x)` is measure-preserving. -/
@[to_additive measure_preserving_prod_sub "The map `(x, y) ↦ (x, y - x)` is measure-preserving."]
theorem measurePreservingProdDiv [IsMulRightInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1, z.2 / z.1)) (μ.Prod ν) (μ.Prod ν) :=
  (measurePreservingProdMulRight μ ν).symm (MeasurableEquiv.shearDivRight G).symm
#align measure_theory.measure_preserving_prod_div MeasureTheory.measurePreservingProdDiv
#align measure_theory.measure_preserving_prod_sub MeasureTheory.measure_preserving_prod_sub

/-- The map `(x, y) ↦ (y, x / y)` sends `μ × ν` to `ν × μ`. -/
@[to_additive measure_preserving_prod_sub_swap
      "The map `(x, y) ↦ (y, x - y)` sends `μ × ν` to `ν × μ`."]
theorem measurePreservingProdDivSwap [IsMulRightInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.2, z.1 / z.2)) (μ.Prod ν) (ν.Prod μ) :=
  (measurePreservingProdDiv ν μ).comp measurePreservingSwap
#align measure_theory.measure_preserving_prod_div_swap MeasureTheory.measurePreservingProdDivSwap
#align measure_theory.measure_preserving_prod_sub_swap MeasureTheory.measure_preserving_prod_sub_swap

/-- The map `(x, y) ↦ (x / y, y)` preserves the measure `μ × ν`. -/
@[to_additive measure_preserving_sub_prod
      " The map `(x, y) ↦ (x - y, y)` preserves the measure `μ × ν`. "]
theorem measurePreservingDivProd [IsMulRightInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.1 / z.2, z.2)) (μ.Prod ν) (μ.Prod ν) :=
  measurePreservingSwap.comp <| by apply measure_preserving_prod_div_swap μ ν
#align measure_theory.measure_preserving_div_prod MeasureTheory.measurePreservingDivProd
#align measure_theory.measure_preserving_sub_prod MeasureTheory.measure_preserving_sub_prod

/-- The map `(x, y) ↦ (xy, x⁻¹)` is measure-preserving. -/
@[to_additive measure_preserving_add_prod_neg_right
      "The map `(x, y) ↦ (x + y, - x)` is measure-preserving."]
theorem measurePreservingMulProdInvRight [IsMulRightInvariant μ] [IsMulRightInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1 * z.2, z.1⁻¹)) (μ.Prod ν) (μ.Prod ν) :=
  by
  convert(measure_preserving_prod_div_swap ν μ).comp (measure_preserving_prod_mul_swap_right μ ν)
  ext1 ⟨x, y⟩
  simp_rw [Function.comp_apply, div_mul_eq_div_div_swap, div_self', one_div]
#align measure_theory.measure_preserving_mul_prod_inv_right MeasureTheory.measurePreservingMulProdInvRight
#align measure_theory.measure_preserving_add_prod_neg_right MeasureTheory.measure_preserving_add_prod_neg_right

end RightInvariant

section QuasiMeasurePreserving

variable [HasMeasurableInv G]

@[to_additive]
theorem quasiMeasurePreservingInvOfRightInvariant [IsMulRightInvariant μ] :
    QuasiMeasurePreserving (Inv.inv : G → G) μ μ :=
  by
  rw [← μ.inv_inv]
  exact
    (quasi_measure_preserving_inv μ.inv).mono (inv_absolutely_continuous μ.inv)
      (absolutely_continuous_inv μ.inv)
#align measure_theory.quasi_measure_preserving_inv_of_right_invariant MeasureTheory.quasiMeasurePreservingInvOfRightInvariant
#align measure_theory.quasi_measure_preserving_neg_of_right_invariant MeasureTheory.quasi_measure_preserving_neg_of_right_invariant

@[to_additive]
theorem quasiMeasurePreservingDivLeft [IsMulLeftInvariant μ] (g : G) :
    QuasiMeasurePreserving (fun h : G => g / h) μ μ :=
  by
  simp_rw [div_eq_mul_inv]
  exact
    (measure_preserving_mul_left μ g).QuasiMeasurePreserving.comp (quasi_measure_preserving_inv μ)
#align measure_theory.quasi_measure_preserving_div_left MeasureTheory.quasiMeasurePreservingDivLeft
#align measure_theory.quasi_measure_preserving_sub_left MeasureTheory.quasi_measure_preserving_sub_left

@[to_additive]
theorem quasiMeasurePreservingDivLeftOfRightInvariant [IsMulRightInvariant μ] (g : G) :
    QuasiMeasurePreserving (fun h : G => g / h) μ μ :=
  by
  rw [← μ.inv_inv]
  exact
    (quasi_measure_preserving_div_left μ.inv g).mono (inv_absolutely_continuous μ.inv)
      (absolutely_continuous_inv μ.inv)
#align measure_theory.quasi_measure_preserving_div_left_of_right_invariant MeasureTheory.quasiMeasurePreservingDivLeftOfRightInvariant
#align measure_theory.quasi_measure_preserving_sub_left_of_right_invariant MeasureTheory.quasi_measure_preserving_sub_left_of_right_invariant

@[to_additive]
theorem quasiMeasurePreservingDivOfRightInvariant [IsMulRightInvariant μ] :
    QuasiMeasurePreserving (fun p : G × G => p.1 / p.2) (μ.Prod ν) μ :=
  by
  refine' quasi_measure_preserving.prod_of_left measurable_div (eventually_of_forall fun y => _)
  exact (measure_preserving_div_right μ y).QuasiMeasurePreserving
#align measure_theory.quasi_measure_preserving_div_of_right_invariant MeasureTheory.quasiMeasurePreservingDivOfRightInvariant
#align measure_theory.quasi_measure_preserving_sub_of_right_invariant MeasureTheory.quasi_measure_preserving_sub_of_right_invariant

@[to_additive]
theorem quasiMeasurePreservingDiv [IsMulLeftInvariant μ] :
    QuasiMeasurePreserving (fun p : G × G => p.1 / p.2) (μ.Prod ν) μ :=
  (quasiMeasurePreservingDivOfRightInvariant μ.inv ν).mono
    ((absolutelyContinuousInv μ).Prod AbsolutelyContinuous.rfl) (invAbsolutelyContinuous μ)
#align measure_theory.quasi_measure_preserving_div MeasureTheory.quasiMeasurePreservingDiv
#align measure_theory.quasi_measure_preserving_sub MeasureTheory.quasi_measure_preserving_sub

/-- A *left*-invariant measure is quasi-preserved by *right*-multiplication.
This should not be confused with `(measure_preserving_mul_right μ g).quasi_measure_preserving`. -/
@[to_additive
      "A *left*-invariant measure is quasi-preserved by *right*-addition.\nThis should not be confused with `(measure_preserving_add_right μ g).quasi_measure_preserving`. "]
theorem quasiMeasurePreservingMulRight [IsMulLeftInvariant μ] (g : G) :
    QuasiMeasurePreserving (fun h : G => h * g) μ μ :=
  by
  refine' ⟨measurable_mul_const g, absolutely_continuous.mk fun s hs => _⟩
  rw [map_apply (measurable_mul_const g) hs, measure_mul_right_null]; exact id
#align measure_theory.quasi_measure_preserving_mul_right MeasureTheory.quasiMeasurePreservingMulRight
#align measure_theory.quasi_measure_preserving_add_right MeasureTheory.quasi_measure_preserving_add_right

/-- A *right*-invariant measure is quasi-preserved by *left*-multiplication.
This should not be confused with `(measure_preserving_mul_left μ g).quasi_measure_preserving`. -/
@[to_additive
      "A *right*-invariant measure is quasi-preserved by *left*-addition.\nThis should not be confused with `(measure_preserving_add_left μ g).quasi_measure_preserving`. "]
theorem quasiMeasurePreservingMulLeft [IsMulRightInvariant μ] (g : G) :
    QuasiMeasurePreserving (fun h : G => g * h) μ μ :=
  by
  have :=
    (quasi_measure_preserving_mul_right μ.inv g⁻¹).mono (inv_absolutely_continuous μ.inv)
      (absolutely_continuous_inv μ.inv)
  rw [μ.inv_inv] at this
  have :=
    (quasi_measure_preserving_inv_of_right_invariant μ).comp
      (this.comp (quasi_measure_preserving_inv_of_right_invariant μ))
  simp_rw [Function.comp, mul_inv_rev, inv_inv] at this
  exact this
#align measure_theory.quasi_measure_preserving_mul_left MeasureTheory.quasiMeasurePreservingMulLeft
#align measure_theory.quasi_measure_preserving_add_left MeasureTheory.quasi_measure_preserving_add_left

end QuasiMeasurePreserving

end MeasureTheory


import data.real.basic

variables a b c d : ℝ

#check mul_comm d c
#check mul_assoc d c a
#check two_mul d
#check two_mul (a + d)

-- BEGIN
/- The rewrite tactic affects only the goal. The notation rw t at h
applies the rewrite t at hypothesis h. -/

example (a b c d : ℝ) (h : c = d * a + b) (h' : b = a * d) :
  c = 2 * a * d :=
begin
  rw h' at h,
  rw mul_comm d a at h,
  rw ← two_mul (a * d) at h,
  rw ← mul_assoc 2 a d at h,
  exact h,
end
-- END


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

import algebra.group.units
import algebra.ring.basic

/-!
# Invertible elements

This file defines a typeclass `invertible a` for elements `a` with a two-sided
multiplicative inverse.

The intent of the typeclass is to provide a way to write e.g. `⅟2` in a ring
like `ℤ[1/2]` where some inverses exist but there is no general `⁻¹` operator;
or to specify that a field has characteristic `≠ 2`.
It is the `Type`-valued analogue to the `Prop`-valued `is_unit`.

For constructions of the invertible element given a characteristic, see
`algebra/char_p/invertible` and other lemmas in that file.

## Notation

 * `⅟a` is `invertible.inv_of a`, the inverse of `a`

## Implementation notes

The `invertible` class lives in `Type`, not `Prop`, to make computation easier.
If multiplication is associative, `invertible` is a subsingleton anyway.

The `simp` normal form tries to normalize `⅟a` to `a ⁻¹`. Otherwise, it pushes
`⅟` inside the expression as much as possible.

## Tags

invertible, inverse element, inv_of, a half, one half, a third, one third, ½, ⅓

-/

universes u

variables {α : Type u}

/-- `invertible a` gives a two-sided multiplicative inverse of `a`. -/
class invertible [has_mul α] [has_one α] (a : α) : Type u :=
(inv_of : α) (inv_of_mul_self : inv_of * a = 1) (mul_inv_of_self : a * inv_of = 1)

-- This notation has the same precedence as `has_inv.inv`.
notation `⅟`:1034 := invertible.inv_of

@[simp]
lemma inv_of_mul_self [has_mul α] [has_one α] (a : α) [invertible a] : ⅟a * a = 1 :=
invertible.inv_of_mul_self

@[simp]
lemma mul_inv_of_self [has_mul α] [has_one α] (a : α) [invertible a] : a * ⅟a = 1 :=
invertible.mul_inv_of_self

@[simp]
lemma inv_of_mul_self_assoc [monoid α] (a b : α) [invertible a] : ⅟a * (a * b) = b :=
by rw [←mul_assoc, inv_of_mul_self, one_mul]

@[simp]
lemma mul_inv_of_self_assoc [monoid α] (a b : α) [invertible a] : a * (⅟a * b) = b :=
by rw [←mul_assoc, mul_inv_of_self, one_mul]

@[simp]
lemma mul_inv_of_mul_self_cancel [monoid α] (a b : α) [invertible b] : a * ⅟b * b = a :=
by simp [mul_assoc]

@[simp]
lemma mul_mul_inv_of_self_cancel [monoid α] (a b : α) [invertible b] : a * b * ⅟b = a :=
by simp [mul_assoc]

lemma inv_of_eq_right_inv [monoid α] {a b : α} [invertible a] (hac : a * b = 1) : ⅟a = b :=
left_inv_eq_right_inv (inv_of_mul_self _) hac

lemma invertible_unique {α : Type u} [monoid α] (a b : α) (h : a = b)
  [invertible a] [invertible b] :
  ⅟a = ⅟b :=
by { apply inv_of_eq_right_inv, rw [h, mul_inv_of_self], }

instance [monoid α] (a : α) : subsingleton (invertible a) :=
⟨ λ ⟨b, hba, hab⟩ ⟨c, hca, hac⟩, by { congr, exact left_inv_eq_right_inv hba hac } ⟩

/-- An `invertible` element is a unit. -/
def unit_of_invertible [monoid α] (a : α) [invertible a] : units α :=
{ val     := a,
  inv     := ⅟a,
  val_inv := by simp,
  inv_val := by simp, }

@[simp] lemma unit_of_invertible_val [monoid α] (a : α) [invertible a] :
  (unit_of_invertible a : α) = a := rfl

@[simp] lemma unit_of_invertible_inv [monoid α] (a : α) [invertible a] :
  (↑(unit_of_invertible a)⁻¹ : α) = ⅟a := rfl

lemma is_unit_of_invertible [monoid α] (a : α) [invertible a] : is_unit a :=
⟨unit_of_invertible a, rfl⟩

/-- Each element of a group is invertible. -/
def invertible_of_group [group α] (a : α) : invertible a :=
⟨a⁻¹, inv_mul_self a, mul_inv_self a⟩

@[simp] lemma inv_of_eq_group_inv [group α] (a : α) [invertible a] : ⅟a = a⁻¹ :=
inv_of_eq_right_inv (mul_inv_self a)

/-- `1` is the inverse of itself -/
def invertible_one [monoid α] : invertible (1 : α) :=
⟨ 1, mul_one _, one_mul _ ⟩

@[simp] lemma inv_of_one [monoid α] [invertible (1 : α)] : ⅟(1 : α) = 1 :=
inv_of_eq_right_inv (mul_one _)

/-- `-⅟a` is the inverse of `-a` -/
def invertible_neg [ring α] (a : α) [invertible a] : invertible (-a) :=
⟨ -⅟a, by simp, by simp ⟩

@[simp] lemma inv_of_neg [ring α] (a : α) [invertible a] [invertible (-a)] : ⅟(-a) = -⅟a :=
inv_of_eq_right_inv (by simp)

@[simp] lemma one_sub_inv_of_two [ring α] [invertible (2:α)] : 1 - (⅟2:α) = ⅟2 :=
(is_unit_of_invertible (2:α)).mul_right_inj.1 $
  by rw [mul_sub, mul_inv_of_self, mul_one, bit0, add_sub_cancel]

/-- `a` is the inverse of `⅟a`. -/
instance invertible_inv_of [has_one α] [has_mul α] {a : α} [invertible a] : invertible (⅟a) :=
⟨ a, mul_inv_of_self a, inv_of_mul_self a ⟩

@[simp] lemma inv_of_inv_of [monoid α] {a : α} [invertible a] [invertible (⅟a)] :
  ⅟(⅟a) = a :=
inv_of_eq_right_inv (inv_of_mul_self _)

/-- `⅟b * ⅟a` is the inverse of `a * b` -/
def invertible_mul [monoid α] (a b : α) [invertible a] [invertible b] : invertible (a * b) :=
⟨ ⅟b * ⅟a, by simp [←mul_assoc], by simp [←mul_assoc] ⟩

@[simp]
lemma inv_of_mul [monoid α] (a b : α) [invertible a] [invertible b] [invertible (a * b)] :
  ⅟(a * b) = ⅟b * ⅟a :=
inv_of_eq_right_inv (by simp [←mul_assoc])

/--
If `r` is invertible and `s = r`, then `s` is invertible.
-/
def invertible.copy [monoid α] {r : α} (hr : invertible r) (s : α) (hs : s = r) : invertible s :=
{ inv_of := ⅟r,
  inv_of_mul_self := by rw [hs, inv_of_mul_self],
  mul_inv_of_self := by rw [hs, mul_inv_of_self] }

theorem commute.inv_of_right [monoid α] {a b : α} [invertible b] (h : commute a b) :
  commute a (⅟b) :=
calc a * (⅟b) = (⅟b) * (b * a * (⅟b)) : by simp [mul_assoc]
... = (⅟b) * (a * b * ((⅟b))) : by rw h.eq
... = (⅟b) * a : by simp [mul_assoc]

theorem commute.inv_of_left [monoid α] {a b : α} [invertible b] (h : commute b a) :
  commute (⅟b) a :=
calc (⅟b) * a = (⅟b) * (a * b * (⅟b)) : by simp [mul_assoc]
... = (⅟b) * (b * a * (⅟b)) : by rw h.eq
... = a * (⅟b) : by simp [mul_assoc]

lemma commute_inv_of {M : Type*} [has_one M] [has_mul M] (m : M) [invertible m] :
  commute m (⅟m) :=
calc m * ⅟m = 1       : mul_inv_of_self m
        ... = ⅟ m * m : (inv_of_mul_self m).symm

section group_with_zero

variable [group_with_zero α]

lemma nonzero_of_invertible (a : α) [invertible a] : a ≠ 0 :=
λ ha, zero_ne_one $ calc   0 = ⅟a * a : by simp [ha]
                         ... = 1 : inv_of_mul_self a

/-- `a⁻¹` is an inverse of `a` if `a ≠ 0` -/
def invertible_of_nonzero {a : α} (h : a ≠ 0) : invertible a :=
⟨ a⁻¹, inv_mul_cancel h, mul_inv_cancel h ⟩

@[simp] lemma inv_of_eq_inv (a : α) [invertible a] : ⅟a = a⁻¹ :=
inv_of_eq_right_inv (mul_inv_cancel (nonzero_of_invertible a))

@[simp] lemma inv_mul_cancel_of_invertible (a : α) [invertible a] : a⁻¹ * a = 1 :=
inv_mul_cancel (nonzero_of_invertible a)

@[simp] lemma mul_inv_cancel_of_invertible (a : α) [invertible a] : a * a⁻¹ = 1 :=
mul_inv_cancel (nonzero_of_invertible a)

@[simp] lemma div_mul_cancel_of_invertible (a b : α) [invertible b] : a / b * b = a :=
div_mul_cancel a (nonzero_of_invertible b)

@[simp] lemma mul_div_cancel_of_invertible (a b : α) [invertible b] : a * b / b = a :=
mul_div_cancel a (nonzero_of_invertible b)

@[simp] lemma div_self_of_invertible (a : α) [invertible a] : a / a = 1 :=
div_self (nonzero_of_invertible a)

/-- `b / a` is the inverse of `a / b` -/
def invertible_div (a b : α) [invertible a] [invertible b] : invertible (a / b) :=
⟨b / a, by simp [←mul_div_assoc], by simp [←mul_div_assoc]⟩

@[simp] lemma inv_of_div (a b : α) [invertible a] [invertible b] [invertible (a / b)] :
  ⅟(a / b) = b / a :=
inv_of_eq_right_inv (by simp [←mul_div_assoc])

/-- `a` is the inverse of `a⁻¹` -/
def invertible_inv {a : α} [invertible a] : invertible (a⁻¹) :=
⟨ a, by simp, by simp ⟩

end group_with_zero

/--
Monoid homs preserve invertibility.
-/
def invertible.map {R : Type*} {S : Type*} [monoid R] [monoid S] (f : R →* S)
  (r : R) [invertible r] :
  invertible (f r) :=
{ inv_of := f (⅟r),
  inv_of_mul_self := by rw [← f.map_mul, inv_of_mul_self, f.map_one],
  mul_inv_of_self := by rw [← f.map_mul, mul_inv_of_self, f.map_one] }


def injective1 (f : nat -> nat) : Prop :=
  forall m n, f m = f n -> m = n.

def injective2 (f : nat -> nat) : Prop :=
  forall m n, m ≠ n -> f m ≠ f n.

example : ∀ f, injective1 f ↔ injective2 f :=
begin
  intro f,
  unfold injective1,
  unfold injective2,
  split; intros HI m n H,
    intros Hinv,
    apply H,
    apply HI,
    assumption,
  cases nat.decidable_eq m n,
    have Hcontra := HI m n h,
    contradiction,
  assumption,
end.


import game.series.L01defs

namespace xena

-- begin hide
-- if we want to use sigma notation, use
-- import algebra.big_operators
-- open_locale big_operators
-- https://leanprover-community.github.io/mathlib_docs/algebra/big_operators.html
-- end hide

/-
If $\sum a_n$ converges, then $a_n \to 0$.

We take the approach of showing that $(S_n) → M$ then $(S_{n+1}) → M$,
and then using the fact that $a_{n+1} = S_{n+1} - S_n$.
-/

def kth_partial_sum (a : ℕ → ℝ) (k : ℕ) := (finset.range (k+1)).sum a

def seq_partials_over (a : ℕ → ℝ ) : ℕ → ℝ := (λ (n : ℕ), kth_partial_sum a n )

def series_converges (a : ℕ → ℝ) := is_convergent (seq_partials_over a)

/- Lemma
If partial sum sequence of $a_n$ convergent, $a_n → 0$.
-/

lemma seqlim_0_if_sum_converges (a : ℕ → ℝ) :
      series_converges a → is_limit a 0 :=

begin

intro h,
cases h with M Mislimit,

-- shift_rule to show that shifted sequence of partial sums also tends to M
have fact := shift_rule (seq_partials_over a) 1 M,
have fact2 := iff.mp fact Mislimit,

-- express `a (m+1)` using partial sums, sum_range_succ seems best way
have fact3 : ∀ m : ℕ, kth_partial_sum a (m+1)
= a (m+1) +  kth_partial_sum a (m),
intro m, from finset.sum_range_succ a (m+1),

--we really want fact4, but sum_range_succ couldn't do it directly?
have fact4 : ∀ (m : ℕ), a (m + 1) = kth_partial_sum a (m+1) - kth_partial_sum a (m),
intro n,
specialize fact3 n,   -- do I need to do this to reorganise inside quantiifer?
linarith,

-- we can rewrite our goal in terms of `a` shifted by +1
have fact5 : is_limit a 0 ↔ is_limit (λ (m : ℕ), a (m+1)) 0,
     from shift_rule a 1 0,
rw fact5,

have fact6:
(λ (n : ℕ), a (n + 1)) = λ (n: ℕ), (kth_partial_sum a (n + 1) - kth_partial_sum a n),
exact funext fact4,  -- suggest gave me this!

rw fact6,

unfold seq_partials_over at Mislimit fact2, -- just for clarity

have fact7 := lim_linear
(λ (n : ℕ), kth_partial_sum a (n + 1))
(λ (n : ℕ), kth_partial_sum a n)
M M 1 (-1) fact2 Mislimit,

simp at fact7,
exact fact7,

end

end xena


import analysis.normed_space.basic

universe u

variables {E : Type u} [add_comm_group E] [vector_space ℝ E]

-- Definition of convex modified from Lean library analysis.convex

def contains_entire_segment (s: set E) (x y : E) :=
    ∀ (a b : ℝ),
    0 ≤ a →
    0 ≤ b →
    a + b = 1 →
    a • x + b • y ∈ s

def convex (s : set E) :=
    ∀ (x y : E),
    x ∈ s →
    y ∈ s →
    contains_entire_segment s x y

-- Lemma: Given sets s1 and s2 and x where x ∈ s1 ∩ s2,
--        x ∈ s1.
lemma intersection_left (s1 s2: set E) (x : E) : x ∈ s1 ∩ s2 → x ∈ s1 :=
begin
    intro h,
    cases h with hleft hright,
    exact hleft
end

-- Lemma: Given sets s1 and s2 and x where x ∈ s1 ∩ s2,
--        x ∈ s2.
lemma intersection_right (s1 s2: set E) (x : E) : x ∈ s1 ∩ s2 → x ∈ s2 :=
begin
    intro h,
    cases h with hleft hright,
    exact hright
end

-- Lemma: Given sets s1 and s2 and points x and y where
--        s1 contains the entire segment between x and y and
--        s2 contains the entire segment between x and y,
--        s1 ∩ s2 contains the entire segment between x and y.
lemma intersection_contains_entire_segment (s1 s2 : set E) (x y : E) :
    contains_entire_segment s1 x y ∧ contains_entire_segment s2 x y →
    contains_entire_segment (s1 ∩ s2) x y :=
begin
    intros h a b nna nnb ab1,
    cases h with h1 h2,
    split,
    {
        exact h1 a b nna nnb ab1,
    },
    {
        exact h2 a b nna nnb ab1,
    }
end

-- Theorem: Given sets s1 and s2 where s1 and s2 are convex,
--          s1 ∩ s2 is convex.
theorem intersection_convex (s1 s2 : set E) :
    convex s1 → convex s2 → convex (s1 ∩ s2) :=
begin
    -- Given convex sets s1 and s2,
    intros hs1 hs2,
    -- Given points p1 and p2 in s1 ∩ s2,
    intros p1 p2 p1inter p2inter,
    -- We want to show that every point on the path between p1 and p2 are
    -- in s1 ∩ s2.
    apply intersection_contains_entire_segment,
    split,
    -- First we show that every point on the path is in s1.
    {
        -- Since p1 is in s1 ∩ s2, p1 is in s1.
        have p1s1 := intersection_left s1 s2 p1 p1inter,
        -- Since p2 is in s1 ∩ s2, p2 is in s1.
        have p2s1 := intersection_left s1 s2 p2 p2inter,
        -- By the definition of convex, since s1 is convex,
        apply hs1,
        -- And p1 and p2 are in s1,
        exact p1s1,
        exact p2s1,
        -- We have that every point on the path between p1 and p2 are in s1.
    },
    {
        -- Since p1 is in s1 ∩ s2, p1 is in s2.
        have p1s2 := intersection_right s1 s2 p1 p1inter,
        -- Since p2 is in s1 ∩ s2, p2 is in s2.
        have p2s2 := intersection_right s1 s2 p2 p2inter,
        -- By the definition of convex, since s2 is convex,
        apply hs2,
        -- And p1 and p2 are in s2,
        exact p1s2,
        exact p2s2,
        -- We have that every point on the path between p1 and p2 are in s2.
    },
end


/-
  https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/barber.20paradox/near/206937100
-/

import tactic

variables (Man : Type) (shaves : Man → Man → Prop)

theorem NoSuchBarber ( h : ∃ barber : Man,  ∀ m : Man, shaves barber m ↔ ¬ shaves m m )
: false :=
begin
  -- from the existence of such a barber, we obtain a barber and the associated hypothesis
  obtain ⟨barber, barber_shaves_only_who_doesnt_self_shave⟩ := h,
  -- apply the associated hypothesis to the barber (as a customer)
  have self_shaving_dilemma := barber_shaves_only_who_doesnt_self_shave barber,
  -- apply `(a ↔ ¬a) → false` to `shaves barber barber` as `a`
  have dilemma_implies_false := (iff_not_self (shaves barber barber)).mp,
  -- -- apply the theorem "dilemma implies false" to the fact that
  -- -- we have proven the self-shaving dilemma
  exact dilemma_implies_false self_shaving_dilemma,
  -- solve_by_elim,
end


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : María Inés de Frutos-Fernández
-/

import topology.basic

noncomputable theory

/-!
# Espacios topológicos en Lean

Para cualquier tipo `α : Type`,una topología en `α` está definida en la clase `topological_space`.
El conjunto `univ` contiene todos los elementos de un tipo.

```
@[protect_proj] class topological_space (α : Type u) :=
(is_open        : set α → Prop) -- Qué conjuntos son abiertos en esta topología.
(is_open_univ   : is_open univ) -- univ es abierto.
(is_open_inter  : ∀s t, is_open s → is_open t → is_open (s ∩ t))
-- la intersección de dos abiertos es un conjunto abierto.
(is_open_sUnion : ∀s, (∀t∈s, is_open t) → is_open (⋃₀ s))
-- la unión arbitraria de abiertos es un abierto.
```
-/

universe u

namespace topological_space

open set

open_locale classical

variables (X : Type u)

/-- La topología discreta es aquella en la que todo subconjunto de `X` (es decir, todo término de
  tipo `set X`) es abierto. -/
def discreta : topological_space X :=
{ is_open        := λ _ , true ,
  is_open_univ   := trivial,
  is_open_inter  := λ _ _ _ _, trivial,
  is_open_sUnion := λ _ _, trivial }

/-- La topología indiscreta o trivial es aquella en la que los únicos abiertos son `X` y `∅`. -/
def indiscreta : topological_space X :=
{ is_open        := λ S, S = set.univ ∨ S = ∅,
  is_open_univ   := or.inl rfl,
  is_open_inter  := begin
    rintros S T hS hT,
    cases hS with hSu hSe,
    { cases hT with hTu hTe,
      { left,
        rw [hSu, hTu, univ_inter] },
      { right,
        rw [hSu, hTe, inter_empty ], }},
    { right,
      rw [hSe, empty_inter] }
  end,
  is_open_sUnion := λ F hF,
  begin
    by_cases h : univ ∈ F,
    { left,
      rw sUnion_eq_univ_iff,
      intros x,
      exact ⟨univ, h, mem_univ _⟩ },
    { right,
      rw sUnion_eq_empty,
      intros S hSF,
      cases hF S hSF with hSu hSe,
      { rw hSu at hSF,
        exact absurd hSF h },
      { exact hSe }}
  end }

/-- La función `id : (X, discreta) ----->  (X, indiscreta)` es continuais continuous . -/
example : @continuous X X (discreta X) (indiscreta X) id :=
{ is_open_preimage := λ _ _, trivial }

/-- Sin embargo, `id : (X, indiscreta) ------> (X, discreta)` no lo es. -/
example (x y : X) (h : x ≠ y) : ¬ @continuous X X (indiscreta X) (discreta X) id :=
begin
  rw [continuous_def, not_forall],
  use ({x} : set X) ,
  rw [not_imp, preimage_id_eq, id.def],
  refine ⟨trivial, _⟩,
  change ¬ ({x} = univ ∨ {x} = ∅),
  rw push_neg.not_or_eq,
  refine ⟨_, singleton_ne_empty _⟩,
  { rw [eq_univ_iff_forall, not_forall],
    use y,
    exact h.symm, },
end

end topological_space


import analysis.specific_limits
import data.int.parity
import algebra.ordered_group
attribute [instance] classical.prop_decidable

/-
Lemmas from that file were hidden in my course, or restating things which
were proved without name in previous files.
-/

notation `|`x`|` := abs x

-- The mathlib version is unusable because it is stated in terms of ≤
lemma ge_max_iff {α : Type*} [decidable_linear_order α] {p q r : α} : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q :=
max_le_iff

/- No idea why this is not in mathlib-/
lemma eq_of_abs_sub_le_all (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y :=
begin
  intro h,
  apply eq_of_abs_sub_nonpos,
  by_contradiction H,
  push_neg at H,
  specialize h ( |x-y|/2) (by linarith),
  linarith,
end

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

lemma unique_limit {u l l'} : seq_limit u l → seq_limit u l' → l = l' :=
begin
  intros hl hl',
  apply eq_of_abs_sub_le_all,
  intros ε ε_pos,
  specialize hl (ε/2) (by linarith),
  cases hl with N hN,
  specialize hl' (ε/2) (by linarith),
  cases hl' with N' hN',
  specialize hN (max N N') (le_max_left _ _),
  specialize hN' (max N N') (le_max_right _ _),
  calc |l - l'| = |(l-u (max N N')) + (u (max N N') -l')| : by ring
  ... ≤ |l - u (max N N')| + |u (max N N') - l'| : by apply abs_add
  ... =  |u (max N N') - l| + |u (max N N') - l'| : by rw abs_sub
  ... ≤ ε/2 + ε/2 : by linarith
  ... = ε : by ring,
end

def pair (n : ℤ) := ∃ k, n = 2*k

def int.odd (n : ℤ) := ∃ k, n = 2*k + 1

lemma int.not_even_iff_odd {n : ℤ} : ¬ int.even n ↔ int.odd n :=
begin
  rw int.not_even_iff,
  split ; intro h,
  use n/2,
  conv_rhs { rw add_comm, congr, rw ← h },
  exact (int.mod_add_div n 2).symm,
  rcases h with ⟨k, rfl⟩,
  simp [add_comm],
  refl,
end

lemma le_of_le_add_all {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split ; linarith,
end

def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

lemma lt_sup {A : set ℝ} {x : ℝ} (hx : is_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  intro y,
  contrapose!,
  exact hx.right y,
end

lemma squeeze {u v w : ℕ → ℝ} {l} (hu : seq_limit u l) (hw : seq_limit w l)
(h : ∀ n, u n ≤ v n)
(h' : ∀ n, v n ≤ w n) : seq_limit v l :=
begin
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  cases hw ε ε_pos with N' hN',
  use max N N',
  intros n hn,
  rw ge_max_iff at hn,
  specialize hN n (by linarith),
  specialize hN' n (by linarith),
  specialize h n,
  specialize h' n,
  rw abs_le at *,
  split ; linarith
end

def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m

def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

lemma lim_le {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  apply le_of_le_add_all,
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  specialize hN N (by linarith),
  specialize ineg N,
  rw abs_le at hN,
  linarith,
end

/-
lemma limite_infinie_pas_finie {u : ℕ → ℝ} :
  limite_infinie_suite u → ∀ x, ¬ seq_limit u x :=
begin
  -- sorry
  intros lim_infinie x lim_x,
  cases lim_x 1 (by linarith) with N hN,
  cases lim_infinie (x+2) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (inferieur_max_gauche _ _),
  specialize hN' N₀ (inferieur_max_droite _ _),
  rw abs_inferieur_ssi at hN,
  linarith',
  -- sorry
end -/

lemma inv_succ_le_all :  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  convert metric.tendsto_at_top.mp (tendsto_one_div_add_at_top_nhds_0_nat),
  apply propext,
  simp only [real.dist_eq, sub_zero],
  split,
    intros h ε ε_pos,
    cases h (ε/2) (by linarith) with N hN,
    use N,
    intros n hn,
    rw abs_of_pos (nat.one_div_pos_of_nat : 1/(n+1 : ℝ) > 0),
    specialize hN n hn,
    linarith,
  intros h ε ε_pos,
  cases h ε (by linarith) with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  rw abs_of_pos (@nat.one_div_pos_of_nat ℝ _ n) at hN,
  linarith,
end

lemma limit_const (x : ℝ) : seq_limit (λ n, x) x :=
λ ε ε_pos, ⟨0, λ _ _, by simp [le_of_lt ε_pos]⟩

lemma limit_of_sub_le_inv_succ {u : ℕ → ℝ} {x : ℝ} (h : ∀ n, |u n - x| ≤ 1/(n+1)) :
seq_limit u x :=
begin
  intros ε ε_pos,
  rcases inv_succ_le_all ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  specialize h n,
  specialize hN n hn,
  linarith,
end

lemma limit_const_add_inv_succ (x : ℝ) : seq_limit (λ n, x + 1/(n+1)) x :=
limit_of_sub_le_inv_succ (λ n, by rw abs_of_pos ; linarith [@nat.one_div_pos_of_nat ℝ _ n])

lemma limit_const_sub_inv_succ (x : ℝ) : seq_limit (λ n, x - 1/(n+1)) x :=
begin
  refine limit_of_sub_le_inv_succ (λ n, _),
  rw [show x - 1 / (n + 1) - x = -(1/(n+1)), by ring, abs_neg,  abs_of_pos],
  linarith [@nat.one_div_pos_of_nat ℝ _ n]
end

lemma id_le_extraction {φ}: extraction φ → ∀ n, n ≤ φ n :=
begin
  intros hyp n,
  induction n with n hn,
  { exact nat.zero_le _ },
  { exact nat.succ_le_of_lt (by linarith [hyp n (n+1) (by linarith)]) },
end

lemma seq_limit_id : tendsto_infinity (λ n, n) :=
begin
  intros A,
  cases exists_nat_gt A with N hN,
  use N,
  intros n hn,
  have : (n : ℝ) ≥ N, exact_mod_cast hn,
  linarith,
end

lemma extraction_machine (ψ : ℕ → ℕ) (hψ : ∀ n, ψ n ≥ n) : ∃ f : ℕ → ℕ, extraction (ψ ∘ f) ∧ ∀ n, f n ≥ n :=
begin
  refine ⟨λ n, nat.rec_on n 0 (λ n ih, ψ ih + 1), λ m n h, _, λ n, _⟩,
  { induction h; dsimp [(∘)],
    { exact hψ _ },
    { exact lt_trans h_ih (hψ _) } },
  { induction n, {apply le_refl},
    exact nat.succ_le_succ (le_trans n_ih (hψ _)) }
end

variables {u : ℕ → ℝ} {l : ℝ} {φ : ℕ → ℕ}

lemma limite_extraction_si_limite (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  -- sorry
  intros ε ε_pos,
  cases h ε ε_pos with N hN,
  use N,
  intros n hn,
  apply hN,
  calc N ≤ n   : hn
     ... ≤ φ n : id_le_extraction hφ n,
  -- sorry
end

def segment (a b : ℝ) := {x | a ≤ x ∧ x ≤ b}

open set filter

def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a

lemma bolzano_weierstrass {a b : ℝ} {u : ℕ → ℝ} (h : ∀ n, u n ∈ Icc a b) :
∃ c ∈ Icc a b, cluster_point u c :=
begin
  have cpct : compact (Icc a b),
    exact compact_Icc,
  have :  map u at_top ≤ principal (Icc a b),
  { change tendsto u _ _,
    rw tendsto_principal,
    filter_upwards [univ_mem_sets],
    intros n hn,
    exact h n },
  rcases cpct (map u at_top) (map_ne_bot at_top_ne_bot) this with ⟨c, h, h'⟩,
  clear this,
  use [c, h],
  unfold cluster_point,
  have : ∀ N, ∃ n ≥ N, |u n -c| ≤ 1/(N+1),
    intro N,
    rw ← forall_sets_nonempty_iff_ne_bot at h',
    specialize h' (u '' {n | n ≥ N} ∩ {x | |x-c| ≤ 1/(N+1)}) _,
    { simp only [set.nonempty,
                set.mem_image,
                set.mem_inter_eq,
                ne.def,
                set.mem_set_of_eq] at h',
      rcases h' with ⟨_, ⟨n, ⟨hn, rfl⟩⟩, ineg⟩,
      use [n, hn, ineg] },
    { apply inter_mem_inf_sets,
      { apply image_mem_map,
        apply mem_at_top },
      { have fact: (0 : ℝ) < 1/(N+2),
          exact_mod_cast (nat.one_div_pos_of_nat : 1/((N+1 : ℕ) + 1 : ℝ) > 0),
        apply mem_sets_of_superset (metric.ball_mem_nhds c fact),
        intros x x_in,
        rw [metric.mem_ball, real.dist_eq] at x_in,
        exact le_of_lt (
          calc |x - c| < 1 / (N + 2) : x_in
                   ... = 1/((N+1)+1) : by { congr' 1, norm_cast }
                   ... ≤ 1 / (N + 1) : nat.one_div_le_one_div (nat.le_succ N)),

       } },
  choose ψ hψ using this,
  cases forall_and_distrib.mp hψ with hψ_id hψ', clear hψ,
  rcases extraction_machine ψ hψ_id with ⟨f, hf, hf'⟩,
  use [ψ ∘ f, hf],
  apply limit_of_sub_le_inv_succ,
  intros n,
  transitivity 1/(f n + 1 : ℝ),
  apply hψ',
  exact nat.one_div_le_one_div (hf' n),
end

lemma not_seq_limit_of_tendstoinfinity {u : ℕ → ℝ} :
  tendsto_infinity u → ∀ x, ¬ seq_limit u x :=
begin
  intros lim_infinie x lim_x,
  cases lim_x 1 (by linarith) with N hN,
  cases lim_infinie (x+2) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (le_max_left _ _),
  specialize hN' N₀ (le_max_right _ _),
  rw abs_le at hN,
  linarith,
end

open real

lemma sup_segment {a b : ℝ} {A : set ℝ} (hnonvide : ∃ x, x ∈ A) (h : A ⊆ Icc a b) :
  ∃ x ∈ Icc a b, is_sup A x :=
begin
  have b_maj :  ∀ (y : ℝ), y ∈ A → y ≤ b,
    from λ y y_in, (h y_in).2,
  have Sup_maj : upper_bound A (Sup A),
  { intro x,
    apply real.le_Sup,
    use [b, b_maj] } ,
  refine ⟨Sup A, _, _⟩,
  { split,
    { cases hnonvide with x x_in,
      exact le_trans (h x_in).1 (Sup_maj _ x_in) },
    { apply Sup_le_ub A hnonvide b_maj } },
  { use Sup_maj,
    intros y y_in,
    rwa real.Sup_le _ hnonvide ⟨b, b_maj⟩ },
end

lemma subseq_tendsto_of_tendsto (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  intros ε ε_pos,
  cases h ε ε_pos with N hN,
  use N,
  intros n hn,
  apply hN,
  calc N ≤ n   : hn
     ... ≤ φ n : id_le_extraction hφ n,
end
namespace tactic.interactive
open tactic

meta def check_me : tactic unit :=
`[ { repeat { unfold seq_limit},
   repeat { unfold continue_en },
   push_neg,
   try { simp only [exists_prop] },
   try { exact iff.rfl },
   done } <|> fail "Ce n'est pas cela. Essayez encore." ]

end tactic.interactive


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

! This file was ported from Lean 3 source module data.int.associated
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Associated
import Mathlib.Data.Int.Units
import Mathlib.Data.Int.Basic
/-!
# Associated elements and the integers

This file contains some results on equality up to units in the integers.

## Main results

 * `Int.natAbs_eq_iff_associated`: the absolute value is equal iff integers are associated
-/

theorem Int.natAbs_eq_iff_associated {a b : ℤ} : a.natAbs = b.natAbs ↔ Associated a b := by
  refine' Int.natAbs_eq_natAbs_iff.trans _
  constructor
  · rintro (rfl | rfl)
    · rfl
    · exact ⟨-1, by simp⟩
  · rintro ⟨u, rfl⟩
    obtain rfl | rfl := Int.units_eq_one_or u
    · exact Or.inl (by simp)
    · exact Or.inr (by simp)
#align int.nat_abs_eq_iff_associated Int.natAbs_eq_iff_associated


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Tim Baanen
-/
import data.matrix.pequiv
import data.matrix.block
import data.matrix.notation
import data.fintype.big_operators
import group_theory.perm.fin
import group_theory.perm.sign
import algebra.algebra.basic
import tactic.ring
import linear_algebra.alternating
import linear_algebra.pi

/-!
# Determinant of a matrix

This file defines the determinant of a matrix, `matrix.det`, and its essential properties.

## Main definitions

 - `matrix.det`: the determinant of a square matrix, as a sum over permutations
 - `matrix.det_row_alternating`: the determinant, as an `alternating_map` in the rows of the matrix

## Main results

 - `det_mul`: the determinant of `A ⬝ B` is the product of determinants
 - `det_zero_of_row_eq`: the determinant is zero if there is a repeated row
 - `det_block_diagonal`: the determinant of a block diagonal matrix is a product
   of the blocks' determinants

## Implementation notes

It is possible to configure `simp` to compute determinants. See the file
`test/matrix.lean` for some examples.

-/

universes u v w z
open equiv equiv.perm finset function

namespace matrix
open_locale matrix big_operators

variables {m n : Type*} [decidable_eq n] [fintype n] [decidable_eq m] [fintype m]
variables {R : Type v} [comm_ring R]

local notation `ε ` σ:max := ((sign σ : ℤ) : R)

/-- `det` is an `alternating_map` in the rows of the matrix. -/
def det_row_alternating : alternating_map R (n → R) R n :=
((multilinear_map.mk_pi_algebra R n R).comp_linear_map (linear_map.proj)).alternatization

/-- The determinant of a matrix given by the Leibniz formula. -/
abbreviation det (M : matrix n n R) : R :=
det_row_alternating M

lemma det_apply (M : matrix n n R) :
  M.det = ∑ σ : perm n, σ.sign • ∏ i, M (σ i) i :=
multilinear_map.alternatization_apply _ M

-- This is what the old definition was. We use it to avoid having to change the old proofs below
lemma det_apply' (M : matrix n n R) :
  M.det = ∑ σ : perm n, ε σ * ∏ i, M (σ i) i :=
by simp [det_apply, units.smul_def]

@[simp] lemma det_diagonal {d : n → R} : det (diagonal d) = ∏ i, d i :=
begin
  rw det_apply',
  refine (finset.sum_eq_single 1 _ _).trans _,
  { intros σ h1 h2,
    cases not_forall.1 (mt equiv.ext h2) with x h3,
    convert mul_zero _,
    apply finset.prod_eq_zero,
    { change x ∈ _, simp },
    exact if_neg h3 },
  { simp },
  { simp }
end

@[simp] lemma det_zero (h : nonempty n) : det (0 : matrix n n R) = 0 :=
(det_row_alternating : alternating_map R (n → R) R n).map_zero

@[simp] lemma det_one : det (1 : matrix n n R) = 1 :=
by rw [← diagonal_one]; simp [-diagonal_one]

lemma det_is_empty [is_empty n] {A : matrix n n R} : det A = 1 :=
by simp [det_apply]

@[simp] lemma coe_det_is_empty [is_empty n] : (det : matrix n n R → R) = function.const _ 1 :=
by { ext, exact det_is_empty, }

lemma det_eq_one_of_card_eq_zero {A : matrix n n R} (h : fintype.card n = 0) : det A = 1 :=
begin
  haveI : is_empty n := fintype.card_eq_zero_iff.mp h,
  exact det_is_empty,
end

/-- If `n` has only one element, the determinant of an `n` by `n` matrix is just that element.
Although `unique` implies `decidable_eq` and `fintype`, the instances might
not be syntactically equal. Thus, we need to fill in the args explicitly. -/
@[simp]
lemma det_unique {n : Type*} [unique n] [decidable_eq n] [fintype n] (A : matrix n n R) :
  det A = A default default :=
by simp [det_apply, univ_unique]

lemma det_eq_elem_of_subsingleton [subsingleton n] (A : matrix n n R) (k : n) :
  det A = A k k :=
begin
  convert det_unique _,
  exact unique_of_subsingleton k
end

lemma det_eq_elem_of_card_eq_one {A : matrix n n R} (h : fintype.card n = 1) (k : n) :
  det A = A k k :=
begin
  haveI : subsingleton n := fintype.card_le_one_iff_subsingleton.mp h.le,
  exact det_eq_elem_of_subsingleton _ _
end

lemma det_mul_aux {M N : matrix n n R} {p : n → n} (H : ¬bijective p) :
  ∑ σ : perm n, (ε σ) * ∏ x, (M (σ x) (p x) * N (p x) x) = 0 :=
begin
  obtain ⟨i, j, hpij, hij⟩ : ∃ i j, p i = p j ∧ i ≠ j,
  { rw [← finite.injective_iff_bijective, injective] at H,
    push_neg at H,
    exact H },
  exact sum_involution
    (λ σ _, σ * swap i j)
    (λ σ _,
      have ∏ x, M (σ x) (p x) = ∏ x, M ((σ * swap i j) x) (p x),
        from fintype.prod_equiv (swap i j) _ _ (by simp [apply_swap_eq_self hpij]),
      by simp [this, sign_swap hij, prod_mul_distrib])
    (λ σ _ _, (not_congr mul_swap_eq_iff).mpr hij)
    (λ _ _, mem_univ _)
    (λ σ _, mul_swap_involutive i j σ)
end

@[simp] lemma det_mul (M N : matrix n n R) : det (M ⬝ N) = det M * det N :=
calc det (M ⬝ N) = ∑ p : n → n, ∑ σ : perm n, ε σ * ∏ i, (M (σ i) (p i) * N (p i) i) :
  by simp only [det_apply', mul_apply, prod_univ_sum, mul_sum,
    fintype.pi_finset_univ]; rw [finset.sum_comm]
... = ∑ p in (@univ (n → n) _).filter bijective, ∑ σ : perm n,
    ε σ * ∏ i, (M (σ i) (p i) * N (p i) i) :
  eq.symm $ sum_subset (filter_subset _ _)
    (λ f _ hbij, det_mul_aux $ by simpa only [true_and, mem_filter, mem_univ] using hbij)
... = ∑ τ : perm n, ∑ σ : perm n, ε σ * ∏ i, (M (σ i) (τ i) * N (τ i) i) :
  sum_bij (λ p h, equiv.of_bijective p (mem_filter.1 h).2) (λ _ _, mem_univ _)
    (λ _ _, rfl) (λ _ _ _ _ h, by injection h)
    (λ b _, ⟨b, mem_filter.2 ⟨mem_univ _, b.bijective⟩, coe_fn_injective rfl⟩)
... = ∑ σ : perm n, ∑ τ : perm n, (∏ i, N (σ i) i) * ε τ * (∏ j, M (τ j) (σ j)) :
  by simp only [mul_comm, mul_left_comm, prod_mul_distrib, mul_assoc]
... = ∑ σ : perm n, ∑ τ : perm n, (((∏ i, N (σ i) i) * (ε σ * ε τ)) * ∏ i, M (τ i) i) :
  sum_congr rfl (λ σ _, fintype.sum_equiv (equiv.mul_right σ⁻¹) _ _
    (λ τ,
      have ∏ j, M (τ j) (σ j) = ∏ j, M ((τ * σ⁻¹) j) j,
        by { rw ← (σ⁻¹ : _ ≃ _).prod_comp, simp only [equiv.perm.coe_mul, apply_inv_self] },
      have h : ε σ * ε (τ * σ⁻¹) = ε τ :=
        calc ε σ * ε (τ * σ⁻¹) = ε ((τ * σ⁻¹) * σ) :
          by { rw [mul_comm, sign_mul (τ * σ⁻¹)], simp only [int.cast_mul, units.coe_mul] }
        ... = ε τ : by simp only [inv_mul_cancel_right],
      by { simp_rw [equiv.coe_mul_right, h], simp only [this] }))
... = det M * det N : by simp only [det_apply', finset.mul_sum, mul_comm, mul_left_comm]

/-- The determinant of a matrix, as a monoid homomorphism. -/
def det_monoid_hom : matrix n n R →* R :=
{ to_fun := det,
  map_one' := det_one,
  map_mul' := det_mul }

@[simp] lemma coe_det_monoid_hom : (det_monoid_hom : matrix n n R → R) = det := rfl

/-- On square matrices, `mul_comm` applies under `det`. -/
lemma det_mul_comm (M N : matrix m m R) : det (M ⬝ N) = det (N ⬝ M) :=
by rw [det_mul, det_mul, mul_comm]

/-- On square matrices, `mul_left_comm` applies under `det`. -/
lemma det_mul_left_comm (M N P : matrix m m R) : det (M ⬝ (N ⬝ P)) = det (N ⬝ (M ⬝ P)) :=
by rw [←matrix.mul_assoc, ←matrix.mul_assoc, det_mul, det_mul_comm M N, ←det_mul]

/-- On square matrices, `mul_right_comm` applies under `det`. -/
lemma det_mul_right_comm (M N P : matrix m m R) :
  det (M ⬝ N ⬝ P) = det (M ⬝ P ⬝ N) :=
by rw [matrix.mul_assoc, matrix.mul_assoc, det_mul, det_mul_comm N P, ←det_mul]

lemma det_units_conj (M : (matrix m m R)ˣ) (N : matrix m m R) :
  det (↑M ⬝ N ⬝ ↑M⁻¹ : matrix m m R) = det N :=
by rw [det_mul_right_comm, ←mul_eq_mul, ←mul_eq_mul, units.mul_inv, one_mul]

lemma det_units_conj' (M : (matrix m m R)ˣ) (N : matrix m m R) :
  det (↑M⁻¹ ⬝ N ⬝ ↑M : matrix m m R) = det N := det_units_conj M⁻¹ N

/-- Transposing a matrix preserves the determinant. -/
@[simp] lemma det_transpose (M : matrix n n R) : Mᵀ.det = M.det :=
begin
  rw [det_apply', det_apply'],
  refine fintype.sum_bijective _ inv_involutive.bijective _ _ _,
  intros σ,
  rw sign_inv,
  congr' 1,
  apply fintype.prod_equiv σ,
  intros,
  simp
end

/-- Permuting the columns changes the sign of the determinant. -/
lemma det_permute (σ : perm n) (M : matrix n n R) : matrix.det (λ i, M (σ i)) = σ.sign * M.det :=
((det_row_alternating : alternating_map R (n → R) R n).map_perm M σ).trans
  (by simp [units.smul_def])

/-- Permuting rows and columns with the same equivalence has no effect. -/
@[simp]
lemma det_submatrix_equiv_self (e : n ≃ m) (A : matrix m m R) :
  det (A.submatrix e e) = det A :=
begin
  rw [det_apply', det_apply'],
  apply fintype.sum_equiv (equiv.perm_congr e),
  intro σ,
  rw equiv.perm.sign_perm_congr e σ,
  congr' 1,
  apply fintype.prod_equiv e,
  intro i,
  rw [equiv.perm_congr_apply, equiv.symm_apply_apply, submatrix_apply],
end

/-- Reindexing both indices along the same equivalence preserves the determinant.

For the `simp` version of this lemma, see `det_submatrix_equiv_self`; this one is unsuitable because
`matrix.reindex_apply` unfolds `reindex` first.
-/
lemma det_reindex_self (e : m ≃ n) (A : matrix m m R) : det (reindex e e A) = det A :=
det_submatrix_equiv_self e.symm A

/-- The determinant of a permutation matrix equals its sign. -/
@[simp] lemma det_permutation (σ : perm n) :
  matrix.det (σ.to_pequiv.to_matrix : matrix n n R) = σ.sign :=
by rw [←matrix.mul_one (σ.to_pequiv.to_matrix : matrix n n R), pequiv.to_pequiv_mul_matrix,
  det_permute, det_one, mul_one]

lemma det_smul (A : matrix n n R) (c : R) : det (c • A) = c ^ fintype.card n * det A :=
calc det (c • A) = det (matrix.mul (diagonal (λ _, c)) A) : by rw [smul_eq_diagonal_mul]
             ... = det (diagonal (λ _, c)) * det A        : det_mul _ _
             ... = c ^ fintype.card n * det A             : by simp [card_univ]

@[simp] lemma det_smul_of_tower {α} [monoid α] [distrib_mul_action α R] [is_scalar_tower α R R]
  [smul_comm_class α R R] (c : α) (A : matrix n n R) :
  det (c • A) = c ^ fintype.card n • det A :=
by rw [←smul_one_smul R c A, det_smul, smul_pow, one_pow, smul_mul_assoc, one_mul]

lemma det_neg (A : matrix n n R) : det (-A) = (-1) ^ fintype.card n * det A :=
by rw [←det_smul, neg_one_smul]

/-- A variant of `matrix.det_neg` with scalar multiplication by `units ℤ` instead of multiplication
by `R`. -/
lemma det_neg_eq_smul (A : matrix n n R) : det (-A) = (-1 : units ℤ) ^ fintype.card n • det A :=
by rw [←det_smul_of_tower, units.neg_smul, one_smul]

/-- Multiplying each row by a fixed `v i` multiplies the determinant by
the product of the `v`s. -/
lemma det_mul_row (v : n → R) (A : matrix n n R) :
  det (of $ λ i j, v j * A i j) = (∏ i, v i) * det A :=
calc  det (of $ λ i j, v j * A i j)
    = det (A ⬝ diagonal v) : congr_arg det $ by { ext, simp [mul_comm] }
... = (∏ i, v i) * det A : by rw [det_mul, det_diagonal, mul_comm]

/-- Multiplying each column by a fixed `v j` multiplies the determinant by
the product of the `v`s. -/
lemma det_mul_column (v : n → R) (A : matrix n n R) :
  det (of $ λ i j, v i * A i j) = (∏ i, v i) * det A :=
multilinear_map.map_smul_univ _ v A

@[simp]

section hom_map

variables {S : Type w} [comm_ring S]

lemma _root_.ring_hom.map_det (f : R →+* S) (M : matrix n n R) :
  f M.det = matrix.det (f.map_matrix M) :=
by simp [matrix.det_apply', f.map_sum, f.map_prod]

lemma _root_.ring_equiv.map_det (f : R ≃+* S) (M : matrix n n R) :
  f M.det = matrix.det (f.map_matrix M) :=
f.to_ring_hom.map_det _

lemma _root_.alg_hom.map_det [algebra R S] {T : Type z} [comm_ring T] [algebra R T]
  (f : S →ₐ[R] T) (M : matrix n n S) :
  f M.det = matrix.det (f.map_matrix M) :=
f.to_ring_hom.map_det _

lemma _root_.alg_equiv.map_det [algebra R S] {T : Type z} [comm_ring T] [algebra R T]
  (f : S ≃ₐ[R] T) (M : matrix n n S) :
  f M.det = matrix.det (f.map_matrix M) :=
f.to_alg_hom.map_det _

end hom_map

@[simp] lemma det_conj_transpose [star_ring R] (M : matrix m m R) : det (Mᴴ) = star (det M) :=
((star_ring_end R).map_det _).symm.trans $ congr_arg star M.det_transpose

section det_zero
/-!
### `det_zero` section

Prove that a matrix with a repeated column has determinant equal to zero.
-/

lemma det_eq_zero_of_row_eq_zero {A : matrix n n R} (i : n) (h : ∀ j, A i j = 0) : det A = 0 :=
(det_row_alternating : alternating_map R (n → R) R n).map_coord_zero i (funext h)

lemma det_eq_zero_of_column_eq_zero {A : matrix n n R} (j : n) (h : ∀ i, A i j = 0) : det A = 0 :=
by { rw ← det_transpose, exact det_eq_zero_of_row_eq_zero j h, }

variables {M : matrix n n R} {i j : n}

/-- If a matrix has a repeated row, the determinant will be zero. -/
theorem det_zero_of_row_eq (i_ne_j : i ≠ j) (hij : M i = M j) : M.det = 0 :=
(det_row_alternating : alternating_map R (n → R) R n).map_eq_zero_of_eq M hij i_ne_j

/-- If a matrix has a repeated column, the determinant will be zero. -/
theorem det_zero_of_column_eq (i_ne_j : i ≠ j) (hij : ∀ k, M k i = M k j) : M.det = 0 :=
by { rw [← det_transpose, det_zero_of_row_eq i_ne_j], exact funext hij }

end det_zero

lemma det_update_row_add (M : matrix n n R) (j : n) (u v : n → R) :
  det (update_row M j $ u + v) = det (update_row M j u) + det (update_row M j v) :=
(det_row_alternating : alternating_map R (n → R) R n).map_add M j u v

lemma det_update_column_add (M : matrix n n R) (j : n) (u v : n → R) :
  det (update_column M j $ u + v) = det (update_column M j u) + det (update_column M j v) :=
begin
  rw [← det_transpose, ← update_row_transpose, det_update_row_add],
  simp [update_row_transpose, det_transpose]
end

lemma det_update_row_smul (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_row M j $ s • u) = s * det (update_row M j u) :=
(det_row_alternating : alternating_map R (n → R) R n).map_smul M j s u

lemma det_update_column_smul (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_column M j $ s • u) = s * det (update_column M j u) :=
begin
  rw [← det_transpose, ← update_row_transpose, det_update_row_smul],
  simp [update_row_transpose, det_transpose]
end

lemma det_update_row_smul' (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_row (s • M) j u) = s ^ (fintype.card n - 1) * det (update_row M j u) :=
multilinear_map.map_update_smul _ M j s u

lemma det_update_column_smul' (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_column (s • M) j u) = s ^ (fintype.card n - 1) * det (update_column M j u) :=
begin
  rw [← det_transpose, ← update_row_transpose, transpose_smul, det_update_row_smul'],
  simp [update_row_transpose, det_transpose]
end

section det_eq

/-! ### `det_eq` section

Lemmas showing the determinant is invariant under a variety of operations.
-/
lemma det_eq_of_eq_mul_det_one {A B : matrix n n R}
  (C : matrix n n R) (hC : det C = 1) (hA : A = B ⬝ C) : det A = det B :=
calc det A = det (B ⬝ C) : congr_arg _ hA
       ... = det B * det C : det_mul _ _
       ... = det B : by rw [hC, mul_one]

lemma det_eq_of_eq_det_one_mul {A B : matrix n n R}
  (C : matrix n n R) (hC : det C = 1) (hA : A = C ⬝ B) : det A = det B :=
calc det A = det (C ⬝ B) : congr_arg _ hA
       ... = det C * det B : det_mul _ _
       ... = det B : by rw [hC, one_mul]

lemma det_update_row_add_self (A : matrix n n R) {i j : n} (hij : i ≠ j) :
  det (update_row A i (A i + A j)) = det A :=
by simp [det_update_row_add,
    det_zero_of_row_eq hij ((update_row_self).trans (update_row_ne hij.symm).symm)]

lemma det_update_column_add_self (A : matrix n n R) {i j : n} (hij : i ≠ j) :
  det (update_column A i (λ k, A k i + A k j)) = det A :=
by { rw [← det_transpose, ← update_row_transpose, ← det_transpose A],
     exact det_update_row_add_self Aᵀ hij }

lemma det_update_row_add_smul_self (A : matrix n n R) {i j : n} (hij : i ≠ j) (c : R) :
  det (update_row A i (A i + c • A j)) = det A :=
by simp [det_update_row_add, det_update_row_smul,
  det_zero_of_row_eq hij ((update_row_self).trans (update_row_ne hij.symm).symm)]

lemma det_update_column_add_smul_self (A : matrix n n R) {i j : n} (hij : i ≠ j) (c : R) :
  det (update_column A i (λ k, A k i + c • A k j)) = det A :=
by { rw [← det_transpose, ← update_row_transpose, ← det_transpose A],
      exact det_update_row_add_smul_self Aᵀ hij c }

lemma det_eq_of_forall_row_eq_smul_add_const_aux
  {A B : matrix n n R} {s : finset n} : ∀ (c : n → R) (hs : ∀ i, i ∉ s → c i = 0)
  (k : n) (hk : k ∉ s) (A_eq : ∀ i j, A i j = B i j + c i * B k j),
  det A = det B :=
begin
  revert B,
  refine s.induction_on _ _,
  { intros A c hs k hk A_eq,
    have : ∀ i, c i = 0,
    { intros i,
      specialize hs i,
      contrapose! hs,
      simp [hs] },
    congr,
    ext i j,
    rw [A_eq, this, zero_mul, add_zero], },
  { intros i s hi ih B c hs k hk A_eq,
    have hAi : A i = B i + c i • B k := funext (A_eq i),
    rw [@ih (update_row B i (A i)) (function.update c i 0), hAi,
        det_update_row_add_smul_self],
    { exact mt (λ h, show k ∈ insert i s, from h ▸ finset.mem_insert_self _ _) hk },
    { intros i' hi',
      rw function.update_apply,
      split_ifs with hi'i, { refl },
      { exact hs i' (λ h, hi' ((finset.mem_insert.mp h).resolve_left hi'i)) } },
    { exact λ h, hk (finset.mem_insert_of_mem h) },
    { intros i' j',
      rw [update_row_apply, function.update_apply],
      split_ifs with hi'i,
      { simp [hi'i] },
      rw [A_eq, update_row_ne (λ (h : k = i), hk $ h ▸ finset.mem_insert_self k s)] } }
end

/-- If you add multiples of row `B k` to other rows, the determinant doesn't change. -/
lemma det_eq_of_forall_row_eq_smul_add_const
  {A B : matrix n n R} (c : n → R) (k : n) (hk : c k = 0)
  (A_eq : ∀ i j, A i j = B i j + c i * B k j) :
  det A = det B :=
det_eq_of_forall_row_eq_smul_add_const_aux c
  (λ i, not_imp_comm.mp $ λ hi, finset.mem_erase.mpr
    ⟨mt (λ (h : i = k), show c i = 0, from h.symm ▸ hk) hi, finset.mem_univ i⟩)
  k (finset.not_mem_erase k finset.univ) A_eq

lemma det_eq_of_forall_row_eq_smul_add_pred_aux {n : ℕ} (k : fin (n + 1)) :
  ∀ (c : fin n → R) (hc : ∀ (i : fin n), k < i.succ → c i = 0)
    {M N : matrix (fin n.succ) (fin n.succ) R}
    (h0 : ∀ j, M 0 j = N 0 j)
    (hsucc : ∀ (i : fin n) j, M i.succ j = N i.succ j + c i * M i.cast_succ j),
    det M = det N :=
begin
  refine fin.induction _ (λ k ih, _) k;
    intros c hc M N h0 hsucc,
  { congr,
    ext i j,
    refine fin.cases (h0 j) (λ i, _) i,
    rw [hsucc, hc i (fin.succ_pos _), zero_mul, add_zero] },

  set M' := update_row M k.succ (N k.succ) with hM',
  have hM : M = update_row M' k.succ (M' k.succ + c k • M k.cast_succ),
  { ext i j,
    by_cases hi : i = k.succ,
    { simp [hi, hM', hsucc, update_row_self] },
    rw [update_row_ne hi, hM', update_row_ne hi] },

  have k_ne_succ : k.cast_succ ≠ k.succ := (fin.cast_succ_lt_succ k).ne,
  have M_k : M k.cast_succ = M' k.cast_succ := (update_row_ne k_ne_succ).symm,

  rw [hM, M_k, det_update_row_add_smul_self M' k_ne_succ.symm, ih (function.update c k 0)],
  { intros i hi,
    rw [fin.lt_iff_coe_lt_coe, fin.coe_cast_succ, fin.coe_succ, nat.lt_succ_iff] at hi,
    rw function.update_apply,
    split_ifs with hik, { refl },
    exact hc _ (fin.succ_lt_succ_iff.mpr (lt_of_le_of_ne hi (ne.symm hik))) },
  { rwa [hM', update_row_ne (fin.succ_ne_zero _).symm] },
  intros i j,
  rw function.update_apply,
  split_ifs with hik,
  { rw [zero_mul, add_zero, hM', hik, update_row_self] },
  rw [hM', update_row_ne ((fin.succ_injective _).ne hik), hsucc],
  by_cases hik2 : k < i,
  { simp [hc i (fin.succ_lt_succ_iff.mpr hik2)] },
  rw update_row_ne,
  apply ne_of_lt,
  rwa [fin.lt_iff_coe_lt_coe, fin.coe_cast_succ, fin.coe_succ, nat.lt_succ_iff, ← not_lt]
end

/-- If you add multiples of previous rows to the next row, the determinant doesn't change. -/
lemma det_eq_of_forall_row_eq_smul_add_pred {n : ℕ}
  {A B : matrix (fin (n + 1)) (fin (n + 1)) R} (c : fin n → R)
  (A_zero : ∀ j, A 0 j = B 0 j)
  (A_succ : ∀ (i : fin n) j, A i.succ j = B i.succ j + c i * A i.cast_succ j) :
  det A = det B :=
det_eq_of_forall_row_eq_smul_add_pred_aux (fin.last _) c
  (λ i hi, absurd hi (not_lt_of_ge (fin.le_last _)))
  A_zero A_succ

/-- If you add multiples of previous columns to the next columns, the determinant doesn't change. -/
lemma det_eq_of_forall_col_eq_smul_add_pred {n : ℕ}
  {A B : matrix (fin (n + 1)) (fin (n + 1)) R} (c : fin n → R)
  (A_zero : ∀ i, A i 0 = B i 0)
  (A_succ : ∀ i (j : fin n), A i j.succ = B i j.succ + c j * A i j.cast_succ) :
  det A = det B :=
by { rw [← det_transpose A, ← det_transpose B],
     exact det_eq_of_forall_row_eq_smul_add_pred c A_zero (λ i j, A_succ j i) }

end det_eq

@[simp] lemma det_block_diagonal {o : Type*} [fintype o] [decidable_eq o] (M : o → matrix n n R) :
  (block_diagonal M).det = ∏ k, (M k).det :=
begin
  -- Rewrite the determinants as a sum over permutations.
  simp_rw [det_apply'],
  -- The right hand side is a product of sums, rewrite it as a sum of products.
  rw finset.prod_sum,
  simp_rw [finset.mem_univ, finset.prod_attach_univ, finset.univ_pi_univ],
  -- We claim that the only permutations contributing to the sum are those that
  -- preserve their second component.
  let preserving_snd : finset (equiv.perm (n × o)) :=
    finset.univ.filter (λ σ, ∀ x, (σ x).snd = x.snd),
  have mem_preserving_snd : ∀ {σ : equiv.perm (n × o)},
    σ ∈ preserving_snd ↔ ∀ x, (σ x).snd = x.snd :=
    λ σ, finset.mem_filter.trans ⟨λ h, h.2, λ h, ⟨finset.mem_univ _, h⟩⟩,
  rw ← finset.sum_subset (finset.subset_univ preserving_snd) _,
  -- And that these are in bijection with `o → equiv.perm m`.
  rw (finset.sum_bij (λ (σ : ∀ (k : o), k ∈ finset.univ → equiv.perm n) _,
                        prod_congr_left (λ k, σ k (finset.mem_univ k))) _ _ _ _).symm,
  { intros σ _,
    rw mem_preserving_snd,
    rintros ⟨k, x⟩,
    simp only [prod_congr_left_apply] },
  { intros σ _,
    rw [finset.prod_mul_distrib, ←finset.univ_product_univ, finset.prod_product_right],
    simp only [sign_prod_congr_left, units.coe_prod, int.cast_prod, block_diagonal_apply_eq,
      prod_congr_left_apply] },
  { intros σ σ' _ _ eq,
    ext x hx k,
    simp only at eq,
    have : ∀ k x, prod_congr_left (λ k, σ k (finset.mem_univ _)) (k, x) =
                  prod_congr_left (λ k, σ' k (finset.mem_univ _)) (k, x) :=
      λ k x, by rw eq,
    simp only [prod_congr_left_apply, prod.mk.inj_iff] at this,
    exact (this k x).1 },
  { intros σ hσ,
    rw mem_preserving_snd at hσ,
    have hσ' : ∀ x, (σ⁻¹ x).snd = x.snd,
    { intro x, conv_rhs { rw [← perm.apply_inv_self σ x, hσ] } },
    have mk_apply_eq : ∀ k x, ((σ (x, k)).fst, k) = σ (x, k),
    { intros k x,
      ext,
      { simp only},
      { simp only [hσ] } },
    have mk_inv_apply_eq : ∀ k x, ((σ⁻¹ (x, k)).fst, k) = σ⁻¹ (x, k),
    { intros k x,
      conv_lhs { rw ← perm.apply_inv_self σ (x, k) },
      ext,
      { simp only [apply_inv_self] },
      { simp only [hσ'] } },
    refine ⟨λ k _, ⟨λ x, (σ (x, k)).fst, λ x, (σ⁻¹ (x, k)).fst, _, _⟩, _, _⟩,
    { intro x,
      simp only [mk_apply_eq, inv_apply_self] },
    { intro x,
      simp only [mk_inv_apply_eq, apply_inv_self] },
    { apply finset.mem_univ },
    { ext ⟨k, x⟩,
      { simp only [coe_fn_mk, prod_congr_left_apply] },
      { simp only [prod_congr_left_apply, hσ] } } },
  { intros σ _ hσ,
    rw mem_preserving_snd at hσ,
    obtain ⟨⟨k, x⟩, hkx⟩ := not_forall.mp hσ,
    rw [finset.prod_eq_zero (finset.mem_univ (k, x)), mul_zero],
    rw [← @prod.mk.eta _ _ (σ (k, x)), block_diagonal_apply_ne],
    exact hkx }
end

/-- The determinant of a 2×2 block matrix with the lower-left block equal to zero is the product of
the determinants of the diagonal blocks. For the generalization to any number of blocks, see
`matrix.det_of_upper_triangular`. -/
@[simp] lemma det_from_blocks_zero₂₁
  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) :
  (matrix.from_blocks A B 0 D).det = A.det * D.det :=
begin
  classical,
  simp_rw det_apply',
  convert
    (sum_subset (subset_univ ((sum_congr_hom m n).range : set (perm (m ⊕ n))).to_finset) _).symm,
  rw sum_mul_sum,
  simp_rw univ_product_univ,
  rw (sum_bij (λ (σ : perm m × perm n) _, equiv.sum_congr σ.fst σ.snd) _ _ _ _).symm,
  { intros σ₁₂ h,
    simp only [],
    erw [set.mem_to_finset, monoid_hom.mem_range],
    use σ₁₂,
    simp only [sum_congr_hom_apply] },
  { simp only [forall_prop_of_true, prod.forall, mem_univ],
    intros σ₁ σ₂,
    rw fintype.prod_sum_type,
    simp_rw [equiv.sum_congr_apply, sum.map_inr, sum.map_inl, from_blocks_apply₁₁,
      from_blocks_apply₂₂],
    rw mul_mul_mul_comm,
    congr,
    rw [sign_sum_congr, units.coe_mul, int.cast_mul] },
  { intros σ₁ σ₂ h₁ h₂,
    dsimp only [],
    intro h,
    have h2 : ∀ x, perm.sum_congr σ₁.fst σ₁.snd x = perm.sum_congr σ₂.fst σ₂.snd x,
    { intro x, exact congr_fun (congr_arg to_fun h) x },
    simp only [sum.map_inr, sum.map_inl, perm.sum_congr_apply, sum.forall] at h2,
    ext,
    { exact h2.left x },
    { exact h2.right x }},
  { intros σ hσ,
    erw [set.mem_to_finset, monoid_hom.mem_range] at hσ,
    obtain ⟨σ₁₂, hσ₁₂⟩ := hσ,
    use σ₁₂,
    rw ←hσ₁₂,
    simp },
  { intros σ hσ hσn,
    have h1 : ¬ (∀ x, ∃ y, sum.inl y = σ (sum.inl x)),
    { by_contradiction,
      rw set.mem_to_finset at hσn,
      apply absurd (mem_sum_congr_hom_range_of_perm_maps_to_inl _) hσn,
      rintros x ⟨a, ha⟩,
      rw [←ha], exact h a },
    obtain ⟨a, ha⟩ := not_forall.mp h1,
    cases hx : σ (sum.inl a) with a2 b,
    { have hn := (not_exists.mp ha) a2,
      exact absurd hx.symm hn },
    { rw [finset.prod_eq_zero (finset.mem_univ (sum.inl a)), mul_zero],
      rw [hx, from_blocks_apply₂₁], refl }}
end

/-- The determinant of a 2×2 block matrix with the upper-right block equal to zero is the product of
the determinants of the diagonal blocks. For the generalization to any number of blocks, see
`matrix.det_of_lower_triangular`. -/
@[simp] lemma det_from_blocks_zero₁₂
  (A : matrix m m R) (C : matrix n m R) (D : matrix n n R) :
  (matrix.from_blocks A 0 C D).det = A.det * D.det :=
by rw [←det_transpose, from_blocks_transpose, transpose_zero, det_from_blocks_zero₂₁,
  det_transpose, det_transpose]

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column 0. -/
lemma det_succ_column_zero {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) :
  det A = ∑ i : fin n.succ, (-1) ^ (i : ℕ) * A i 0 *
    det (A.submatrix i.succ_above fin.succ) :=
begin
  rw [matrix.det_apply, finset.univ_perm_fin_succ, ← finset.univ_product_univ],
  simp only [finset.sum_map, equiv.to_embedding_apply, finset.sum_product, matrix.submatrix],
  refine finset.sum_congr rfl (λ i _, fin.cases _ (λ i, _) i),
  { simp only [fin.prod_univ_succ, matrix.det_apply, finset.mul_sum,
        equiv.perm.decompose_fin_symm_apply_zero, fin.coe_zero, one_mul,
        equiv.perm.decompose_fin.symm_sign, equiv.swap_self, if_true, id.def, eq_self_iff_true,
        equiv.perm.decompose_fin_symm_apply_succ, fin.succ_above_zero, equiv.coe_refl, pow_zero,
        mul_smul_comm, of_apply] },
  -- `univ_perm_fin_succ` gives a different embedding of `perm (fin n)` into
  -- `perm (fin n.succ)` than the determinant of the submatrix we want,
  -- permute `A` so that we get the correct one.
  have : (-1 : R) ^ (i : ℕ) = i.cycle_range.sign,
  { simp [fin.sign_cycle_range] },
  rw [fin.coe_succ, pow_succ, this, mul_assoc, mul_assoc, mul_left_comm ↑(equiv.perm.sign _),
      ← det_permute, matrix.det_apply, finset.mul_sum, finset.mul_sum],
  -- now we just need to move the corresponding parts to the same place
  refine finset.sum_congr rfl (λ σ _, _),
  rw [equiv.perm.decompose_fin.symm_sign, if_neg (fin.succ_ne_zero i)],
  calc ((-1) * σ.sign : ℤ) • ∏ i', A (equiv.perm.decompose_fin.symm (fin.succ i, σ) i') i'
      = ((-1) * σ.sign : ℤ) • (A (fin.succ i) 0 *
        ∏ i', A (((fin.succ i).succ_above) (fin.cycle_range i (σ i'))) i'.succ) :
    by simp only [fin.prod_univ_succ, fin.succ_above_cycle_range,
      equiv.perm.decompose_fin_symm_apply_zero, equiv.perm.decompose_fin_symm_apply_succ]
  ... = (-1) * (A (fin.succ i) 0 * (σ.sign : ℤ) •
        ∏ i', A (((fin.succ i).succ_above) (fin.cycle_range i (σ i'))) i'.succ) :
    by simp only [mul_assoc, mul_comm, _root_.neg_mul, one_mul, zsmul_eq_mul, neg_inj,
      neg_smul, fin.succ_above_cycle_range],
end

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row 0. -/
lemma det_succ_row_zero {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) :
  det A = ∑ j : fin n.succ, (-1) ^ (j : ℕ) * A 0 j *
    det (A.submatrix fin.succ j.succ_above) :=
by { rw [← det_transpose A, det_succ_column_zero],
     refine finset.sum_congr rfl (λ i _, _),
     rw [← det_transpose],
     simp only [transpose_apply, transpose_submatrix, transpose_transpose] }

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row `i`. -/
lemma det_succ_row {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) (i : fin n.succ) :
  det A = ∑ j : fin n.succ, (-1) ^ (i + j : ℕ) * A i j *
    det (A.submatrix i.succ_above j.succ_above) :=
begin
  simp_rw [pow_add, mul_assoc, ← mul_sum],
  have : det A = (-1 : R) ^ (i : ℕ) * (i.cycle_range⁻¹).sign * det A,
  { calc det A = ↑((-1 : ℤˣ) ^ (i : ℕ) * (-1 : ℤˣ) ^ (i : ℕ) : ℤˣ) * det A :
             by simp
           ... = (-1 : R) ^ (i : ℕ) * (i.cycle_range⁻¹).sign * det A :
             by simp [-int.units_mul_self] },
  rw [this, mul_assoc],
  congr,
  rw [← det_permute, det_succ_row_zero],
  refine finset.sum_congr rfl (λ j _, _),
  rw [mul_assoc, matrix.submatrix, matrix.submatrix],
  congr,
  { rw [equiv.perm.inv_def, fin.cycle_range_symm_zero] },
  { ext i' j',
    rw [equiv.perm.inv_def, fin.cycle_range_symm_succ] },
end

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column `j`. -/
lemma det_succ_column {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) (j : fin n.succ) :
  det A = ∑ i : fin n.succ, (-1) ^ (i + j : ℕ) * A i j *
    det (A.submatrix i.succ_above j.succ_above) :=
by { rw [← det_transpose, det_succ_row _ j],
     refine finset.sum_congr rfl (λ i _, _),
     rw [add_comm, ← det_transpose, transpose_apply, transpose_submatrix, transpose_transpose] }

/-- Determinant of 0x0 matrix -/
@[simp] lemma det_fin_zero {A : matrix (fin 0) (fin 0) R} : det A = 1 :=
det_is_empty

/-- Determinant of 1x1 matrix -/
lemma det_fin_one (A : matrix (fin 1) (fin 1) R) : det A = A 0 0  := det_unique A

lemma det_fin_one_of (a : R) : det !![a] = a := det_fin_one _

/-- Determinant of 2x2 matrix -/
lemma det_fin_two (A : matrix (fin 2) (fin 2) R) :
  det A = A 0 0 * A 1 1 - A 0 1 * A 1 0 :=
begin
  simp [matrix.det_succ_row_zero, fin.sum_univ_succ],
  ring
end

@[simp] lemma det_fin_two_of (a b c d : R) :
  matrix.det !![a, b; c, d] = a * d - b * c :=
det_fin_two _

/-- Determinant of 3x3 matrix -/
lemma det_fin_three (A : matrix (fin 3) (fin 3) R) :
  det A = A 0 0 * A 1 1 * A 2 2 - A 0 0 * A 1 2 * A 2 1 - A 0 1 * A 1 0 * A 2 2
  + A 0 1 * A 1 2 * A 2 0 + A 0 2 * A 1 0 * A 2 1 - A 0 2 * A 1 1 * A 2 0 :=
begin
  simp [matrix.det_succ_row_zero, fin.sum_univ_succ],
  ring
end

end matrix


import interior_world.level5 --hide

/-

# Level 2: Second definition of the interior

Before we keep proving properties of the iterior of an arbitrary set, we will prove an alternative definition of it.

-/
variables {X : Type} -- hide
variables [topological_space X] (x : X)  (A : set X) -- hide
open set --hide
namespace topological_space -- hide

/- Lemma
The interior of a set A is the union of all the open sets that it contains:
$ \operatorname{int}(A) = \bigcup_{U \subseteq A, U\text{ open}} U$
-/
lemma open_iff_eq_closure : is_open A ↔ interior A = A :=
begin
  split; intro h,
  {
    apply subset.antisymm,
    {
      exact interior_is_subset A
    },
    {
      rw interior_def',
      intros x hx,
      exact ⟨A, ⟨h, rfl.subset⟩, hx⟩
    }
  },
  {
    rw ← h,
    exact interior_is_open A
  }

end

end topological_space -- hide


import data.int.basic data.nat.basic data.nat.prime tactic

open int nat

/-
## Definition 1.1
A prime number is a natural number p > 1, which is divisible only
by the natural numbers 1 and p.
-/

/-
## Definition 1.2
Let m, n ∈ ℤ.
Then n is divisible by m (m ∣ n) if there exists a ∈ ℤ such that n = ma.
-/

example : 7 ∣ 91 := begin use 13, tauto end
example : (-5 : ℤ) ∣ 45 := begin use -9, tauto end
example : ¬ (11 ∣ 87) := begin
  unfold has_dvd.dvd, push_neg,
  intro c,
  sorry
end
example : ∀ x : ℤ, 1 ∣ x := begin -- Every number is dvisible by 1.
  intro x,
  use x,
  simp,
end
example (x : ℤ) : 2 ∣ x ↔ even x := begin -- A number is divisible by 2 iff it is even.
  split,
   repeat {intro h,
           cases h with k hk,
           use k,
           exact hk},
end

/-
## Theorem 1.4
Let n : ℕ with n > 1.
Then n has a prime factor p.
-/

theorem prime_fact (n : ℕ) (H: 1 < n) : ∃ p, prime p → p ∣ n := begin
  sorry, -- # Add strong induction proof from notes
end

/-
## Theorem 1.5 - Euclid
There are infitely many primes.
-/

theorem Euclid : ∀ N, ∃ p ≥ N, prime p := begin
  intro N,

  let M := factorial N + 1,
  let p := min_fac M,

  have hp : prime p :=
    begin
      refine min_fac_prime _,
      have : factorial N > 0 := factorial_pos N,
      linarith,
  end,

  use p,
  split,
   {by_contradiction H,
    have h₁ : p ∣ factorial N + 1 := min_fac_dvd M,
    have h₂ : p ∣ factorial N :=
      begin
        refine hp.dvd_factorial.mpr _,
        exact le_of_not_ge H,
    end,
    have h : p ∣ 1 := (nat.dvd_add_right h₂).mp h₁,

    exact prime.not_dvd_one hp h},
   {exact hp},
end

/-
## Theorem 1.7
If n : ℕ, with n > 1, then either n is prime, or is a product of a
(finite) sequence of primes.
-/

theorem prime_or_product (n : ℕ) (H : n > 1) : prime n ∨ sorry /- finite sequence of primes -/ :=
begin
  sorry, -- # Add strong induction proof from notes
end

/-
## Theorem 1.8
Let n have the prime factorisations
      n = p₁ × ... × p_r = q₁ × ... × q_s
Then every prime occurs equally often in both factorisations (and so r = s)
-/

-- # No clue how to put this into code

github-repos/lean/amos578-Lean/Lean-30de0075bd0e7310604a574921b9f1a59cb60b14/src/1001 Term 2/101 Prime Numbers.lean


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic
import ring_theory.noetherian -- theory of Noetherian rings
/-

# Commutative algebra

I find this quite a joy to do in Lean.

Keith Conrad has some notes on Noetherian rings here:

https://kconrad.math.uconn.edu/blurbs/ringtheory/noetherian-ring.pdf

In this section I prove some of the results which he discusses.

## Noetherian rings

A commutative ring is Noetherian if every ideal is finitely-generated.
Noetherian-ness is a very weak finiteness condition which is satisfied by
many rings which show up naturally in algebra, number theory and and geometry.
Lean has several equivalent standard criteria for being Noetherian. Let's
use one of them to prove Theorem 3.2 in Conrad's notes: a surjective
map from a Noetherian ring to itself is injective (note that this
is a ring-theoretic analogue of the set-theoretic result that a surjective
map from a finite set to itself is injective.)

-/

open function

example (R : Type) [comm_ring R] [is_noetherian_ring R]
  (φ : R →+* R) (hφsurj : surjective φ) : injective φ :=
begin
  -- Here's the proof in Conrad's notes.
  -- For `n` a natural number, define `Kₙ` to be the kernel of `φ ∘ φ ∘ φ ∘ ⋯ φ : R →+* R`,
  -- where we iterate `φ` `n` times. Of course in Lean `K` is a function `ℕ → ideal R`.
  -- The ideals Kₙ satisfy Kₙ ⊆ Kₙ₊₁.
  -- (for if x ∈ Kₙ
  -- then φⁿ(x) = 0
  -- so φⁿ⁺¹(x) = φ(0)=0
  -- so x ∈ Kₙ₊₁)
  -- Hence K is a monotone function.
  -- So by Noetherian-ness of `R`, there exists `n` such that `Kₙ=Kₙ₊₁=Kₙ₊₂=…`
  -- It suffices to prove that every element of ker(φ) is 0
  -- so say r ∈ ker(φ)
  -- and let's prove r=0
  -- For all naturals m, The map φ^m is surjective
  -- (by an easy induction)
  -- so r = φ^n r' for some r' ∈ R
  -- Thus 0 = φ(r)=φ^{n+1}(r')
  -- Therefore r' ∈ ker(φ^{n+1})
  -- ...=ker(φ^n)
  -- and hence r=φ^n(r')=0 as required
end


import data.real.basic

/-
One of the earliest kind of proofs one encounters while learning mathematics is proving by
a calculation. It may not sound like a proof, but this is actually using lemmas expressing
properties of operations on numbers. It also uses the fundamental property of equality: if two
mathematical objects A and B are equal then, in any statement involving A, one can replace A
by B. This operation is called rewriting, and the Lean "tactic" for this is `rw`.

In the following exercises, we will use the following two lemmas:
  mul_assoc a b c : a * b * c = a * (b * c)
  mul_comm a b : a*b = b*a

Hence the command
  rw mul_assoc a b c,
will replace a*b*c by a*(b*c) in the current goal.

In order to replace backward, we use
  rw ← mul_assoc a b c,
replacing a*(b*c) by a*b*c in the current goal.

Of course we don't want to constantly invoke those lemmas, and we will eventually introduce
more powerful solutions.
-/

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  rw mul_assoc b a c,
end

-- 0001
example (a b c : ℝ) : (c * b) * a = b * (a * c) :=
begin
  rw mul_comm c b,
  rw mul_assoc b c a,
  rw mul_comm a c
end

-- 0002
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw <- mul_assoc a b c,
  rw mul_comm a b,
  rw mul_assoc b a c
end

/-
Now let's return to the preceding example to experiment with what happens
if we don't give arguments to mul_assoc or mul_comm.
For instance, you can start the next proof with
  rw ← mul_assoc,
Try to figure out what happens.
-/

-- 0003
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw <- mul_assoc,
  rw mul_comm a b,
  rw mul_assoc
end

/-
We can also perform rewriting in an assumption of the local context, using for instance
  rw mul_comm a b at hyp,
in order to replace a*b by b*a in assumption hyp.

The next example will use a third lemma:
  two_mul a : 2*a = a + a

Also we use the `exact` tactic, which allows to provide a direct proof term.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  rw hyp' at hyp,
  rw mul_comm d a at hyp,
  rw ← two_mul (a*d) at hyp,
  rw ← mul_assoc 2 a d at hyp,
  exact hyp, -- Our assumption hyp is now exactly what we have to prove
end

/-
And the next one can use:
  sub_self x : x - x = 0
-/

-- 0004
example (a b c d : ℝ) (hyp : c = b*a - d) (hyp' : d = a*b) : c = 0 :=
begin
  rw mul_comm a b at hyp',
  rw ← hyp' at hyp,
  rw sub_self d at hyp,
  exact hyp
end

/-
What is written in the two preceding example is very far away from what we would write on
paper. Let's now see how to get a more natural layout.
Inside each pair of curly braces below, the goal is to prove equality with the preceding line.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b    : by { rw hyp }
     ... = d*a + a*d  : by { rw hyp' }
     ... = a*d + a*d  : by { rw mul_comm d a }
     ... = 2*(a*d)    : by { rw two_mul }
     ... = 2*a*d      : by { rw mul_assoc },
end

/-
Let's note there is no comma at the end of each line of calculation. `calc` is really one
command, and the comma comes only after it's fully done.

From a practical point of view, when writing such a proof, it is convenient to:
* pause the tactic state view update in VScode by clicking the Pause icon button
  in the top right corner of the Lean Goal buffer
* write the full calculation, ending each line with ": by {}"
* resume tactic state update by clicking the Play icon button and fill in proofs between
  curly braces.

Let's return to the other example using this method.
-/

-- 0005
example (a b c d : ℝ) (hyp : c = b*a - d) (hyp' : d = a*b) : c = 0 :=
begin
  calc c = b*a - d : by {rw hyp}
      ... = b*a - a*b : by {rw hyp'}
      ... = b*a - b*a : by {rw mul_comm b a}
      ... = 0 : by {rw sub_self (b*a)}
end

/-
The preceding proofs have exhausted our supply of "mul_comm" patience. Now it's time
to get the computer to work harder. The `ring` tactic will prove any goal that follows by
applying only the axioms of commutative (semi-)rings, in particular commutativity and
associativity of addition and multiplication, as well as distributivity.

We also note that curly braces are not necessary when we write a single tactic proof, so
let's get rid of them.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b   : by rw hyp
     ... = d*a + a*d : by rw hyp'
     ... = 2*a*d     : by ring,
end

/-
Of course we can use `ring` outside of `calc`. Let's do the next one in one line.
-/

-- 0006
example (a b c : ℝ) : a * (b * c) = b * (a * c) := by ring

/-
This is too much fun. Let's do it again.
-/

-- 0007
example (a b : ℝ) : (a + b) + a = 2*a + b := by ring

/-
Maybe this is cheating. Let's try to do the next computation without ring.
We could use:
pow_two x : x^2 = x*x
mul_sub a b c : a*(b-c) = a*b - a*c
add_mul a b c : (a+b)*c = a*c + b*c
add_sub a b c : a + (b - c) = (a + b) - c
sub_sub a b c : a - b - c = a - (b + c)
add_zero a : a + 0 = a
-/

-- 0008
example (a b : ℝ) : (a + b)*(a - b) = a^2 - b^2 := by ring

/- Let's stick to ring in the end. -/