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

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

/-!
# Iterations of a function

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

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

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

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

* `LeftInverse.iterate`, `RightInverse.iterate`, `Commute.iterate_left`, `Commute.iterate_right`,
  `Commute.iterate_iterate`:
  some properties of pairs of functions survive under iterations

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

-/

universe u v

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

namespace Function

variable (f : α → α)

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

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

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

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

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

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

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

@[simp]
theorem iterate_one : f^[1] = f :=
  funext fun _ ↦ rfl
#align function.iterate_one Function.iterate_one

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

variable {f}

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

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

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

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

namespace Semiconj

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

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

end Semiconj

namespace Commute

variable {g : α → α}

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

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

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

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

variable (f)

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

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

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

end Commute

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

variable (f)

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

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

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

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

/-- A recursor for the iterate of a function. -/
def Iterate.rec (p : α → Sort _) {f : α → α} (h : ∀ a, p a → p (f a)) {a : α} (ha : p a) (n : ℕ) :
    p ((f^[n]) a) :=
  match n with
  | 0 => ha
  | m+1 => Iterate.rec p h (h _ ha) m
#align function.iterate.rec Function.Iterate.rec

theorem Iterate.rec_zero (p : α → Sort _) {f : α → α} (h : ∀ a, p a → p (f a)) {a : α} (ha : p a) :
    Iterate.rec p h ha 0 = ha :=
  rfl
#align function.iterate.rec_zero Function.Iterate.rec_zero

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

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

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

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

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

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

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

lemma iterate_cancel (hf : Injective f) (ha : (f^[m]) a = (f^[n]) a) : (f^[m - n]) a = a := by
  obtain h | h := le_total m n
  { simp [Nat.sub_eq_zero_of_le h] }
  { exact iterate_cancel_of_add hf (by rwa [Nat.sub_add_cancel h]) }
#align function.iterate_cancel Function.iterate_cancel

end Function

namespace List

open Function

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

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

end List


/-

Some goals:
  - Define matroid.
  - Define duality.
  - Define minors, deletion, contraction.
  - Prove that disjoint deletions and contractions commute.
  - Prove that dual of a minor is a minor of the dual.

Some things that are needed:
  - Finite sets, size.
  - Union, intersection, complement of finite subsets.

Paying special attention to:
  - When are things (propositionally) equal.

-/

import tactic.ext
import tactic.linarith

-- The API I would like to use for various basic objects.
section API

structure fin_bool_alg :=
  (subset : Type)
  (contained : subset → subset → Prop)
  (bot top : subset)
  (inter union : subset → subset → subset)
  (compl : subset → subset)
  (size : subset → ℤ)

  -- The structure axioms have a trailing underscore because they can't (yet) be written using the nice notation defined below.
  (refl_ (X : subset) : contained X X)
  (antisymm_ (X Y : subset) : (contained X Y) → (contained Y X) → X = Y)
  (trans_ (X Y Z : subset) : (contained X Y) → (contained Y Z) → (contained X Z))

  (bot_subset_ (X : subset) : contained bot X)
  (subset_top_ (X : subset) : contained X top)

  (inter_subset_left_ (X Y : subset) : contained (inter X Y) X)
  (inter_subset_right_ (X Y : subset) : contained (inter X Y) Y)
  (inter_maximal_ (X Y Z : subset) : (contained Z X) → (contained Z Y) → contained Z (inter X Y))

  (left_subset_union_ (X Y : subset) : contained X (union X Y))
  (right_subset_union_ (X Y : subset) : contained Y (union X Y))
  (union_minimal_ (X Y Z : subset) : (contained X Z) → (contained Y Z) → contained (union X Y) Z)

  (inter_distrib_union_ (X Y Z : subset) : (inter X (union Y Z)) = union (inter X Y) (inter X Z))
--  (union_distrib_inter_ (X Y Z : subset) : (union X (inter Y Z)) = inter (union X Y) (union X Z))

  (self_inter_compl_ (X : subset) : (inter X (compl X) = bot))
  (self_union_compl_ (X : subset) : (union X (compl X) = top))

  (size_bot_ : size bot = 0)
  (size_monotone_ (X Y : subset) : (contained X Y) → size X ≤ size Y)
  (size_antisymm_ (X Y : subset) : (contained X Y) → size X = size Y → X = Y)
  (size_atom_ (X : subset) : (forall (Y Z : subset), (contained X (union Y Z)) → (contained X Y) ∨ (contained X Z)) → size X = 1)
  (size_modular_ (X Y: subset) : size (union X Y) + size (inter X Y) = size X + size Y)

/-
Various instances to allow nice notations:
(X : A), ⊥, ⊤, (X ∩ Y), (X ∪ Y), Xᶜ, (X ⊆ Y)
-/
instance empty_indep : has_coe_to_sort fin_bool_alg := {S := Type, coe := fin_bool_alg.subset}
instance indep_of_subset_indep {A : fin_bool_alg} : has_bot A := {bot := A.bot}
instance i3 {A : fin_bool_alg} : has_top A := {top := A.top}
instance i4 {A : fin_bool_alg} : has_inter A := {inter := A.inter}
instance i5 {A : fin_bool_alg} : has_union A := {union := A.union}
instance i6 {A : fin_bool_alg} : has_compl A := {compl := A.compl}
instance i7 {A : fin_bool_alg} : has_subset A := {subset := A.contained}

abbreviation size {A : fin_bool_alg} (X : A) : ℤ := A.size X

def atom {A : fin_bool_alg} (X : A) : Prop :=
  ∀ (Y Z : A), (X ⊆ Y ∪ Z) → (X ⊆ Y) ∨ (X ⊆ Z)

/-
The axiom versions below, without a trailing underscore, are written using the notation instances above,
so that they can be used directly by the tactics rw and linarith.
-/
namespace fin_bool_alg
variables (A : fin_bool_alg) {X Y Z : A}
-- Note: inside the namespace, the structure field 'size' shadows the abbreviation 'size', so we have to write 'A.size'.

lemma refl : X ⊆ X := A.refl_ X
lemma antisymm : (X ⊆ Y) → (Y ⊆ X) → (X = Y) := A.antisymm_ X Y
lemma trans : (X ⊆ Y) → (Y ⊆ Z) → (X ⊆ Z) := A.trans_ X Y Z
lemma bot_subset : ⊥ ⊆ X := A.bot_subset_ X
lemma subset_top : X ⊆ ⊤ := A.subset_top_ X
lemma inter_subset_left : (X ∩ Y) ⊆ X := A.inter_subset_left_ X Y
lemma inter_subset_right : (X ∩ Y) ⊆ Y := A.inter_subset_right_ X Y
lemma inter_maximal : (Z ⊆ X) → (Z ⊆ Y) → (Z ⊆ X ∩ Y) := A.inter_maximal_ X Y Z
lemma left_subset_union : X ⊆ (X ∪ Y) := A.left_subset_union_ X Y
lemma right_subset_union : Y ⊆ (X ∪ Y) := A.right_subset_union_ X Y
lemma union_minimal : (X ⊆ Z) → (Y ⊆ Z) → ((X ∪ Y) ⊆ Z) := A.union_minimal_ X Y Z
lemma self_inter_compl_self : (X ∩ Xᶜ) = ⊥ := A.self_inter_compl_ X
lemma self_union_compl_self : (X ∪ Xᶜ) = ⊤ := A.self_union_compl_ X
lemma size_bot : A.size ⊥ = 0 := A.size_bot_
lemma size_monotone : (X ⊆ Y) → A.size X ≤ A.size Y := A.size_monotone_ X Y
lemma size_antisymm : (X ⊆ Y) → A.size X = A.size Y → X = Y := A.size_antisymm_ X Y
lemma size_atom : (atom X) → (A.size X = 1) := A.size_atom_ X
lemma size_modular : A.size (X ∪ Y) + A.size (X ∩ Y) = A.size X + A.size Y := A.size_modular_ X Y

/-
Because union and intersection are defined in terms of their universal property,
we can deduce associativity, commutativity, etc.
-/

lemma inter_comm : (X ∩ Y) = (Y ∩ X) :=
  by apply A.antisymm; { apply A.inter_maximal, apply A.inter_subset_right, apply A.inter_subset_left }

lemma inter_assoc : (X ∩ Y) ∩ Z = X ∩ (Y ∩ Z) := begin
  apply A.antisymm, repeat {apply A.inter_maximal},
  {apply A.trans, apply A.inter_subset_left, apply A.inter_subset_left},
  {apply A.trans, apply A.inter_subset_left, apply A.inter_subset_right},
  {apply A.inter_subset_right},
  {apply A.inter_subset_left},
  {apply A.trans, apply A.inter_subset_right, apply A.inter_subset_left},
  {apply A.trans, apply A.inter_subset_right, apply A.inter_subset_right},
end

lemma inter_left_comm : X ∩ (Y ∩ Z) = Y ∩ (X ∩ Z) := calc
  X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z : A.inter_assoc.symm
  ...         = (Y ∩ X) ∩ Z : by rw (@inter_comm A X Y)
  ...         = Y ∩ (X ∩ Z) : A.inter_assoc

lemma inter_bot : (X ∩ ⊥) = ⊥ := A.antisymm A.inter_subset_right A.bot_subset
lemma bot_inter : (⊥ ∩ X) = ⊥ := A.antisymm A.inter_subset_left A.bot_subset
lemma inter_top : (X ∩ ⊤) = X := A.antisymm A.inter_subset_left (A.inter_maximal A.refl A.subset_top)
lemma top_inter : (⊤ ∩ X) = X := A.antisymm A.inter_subset_right (A.inter_maximal A.subset_top A.refl)
lemma inter_self : (X ∩ X) = X := A.antisymm A.inter_subset_left (A.inter_maximal A.refl A.refl)

lemma inter_eq_left : (X ⊆ Y) → (X ∩ Y = X) := fun h, A.antisymm A.inter_subset_left (A.inter_maximal A.refl h)
lemma inter_eq_right : (X ⊆ Y) → (Y ∩ X = X) := fun h, A.antisymm A.inter_subset_right (A.inter_maximal h A.refl)

lemma union_comm : (X ∪ Y) = (Y ∪ X) :=
  by apply A.antisymm; { apply A.union_minimal, apply A.right_subset_union, apply A.left_subset_union }

lemma union_assoc : (X ∪ Y) ∪ Z = X ∪ (Y ∪ Z) := begin
  apply A.antisymm, repeat {apply A.union_minimal},
  {apply A.left_subset_union},
  {apply A.trans, apply A.left_subset_union, swap, apply A.right_subset_union},
  {apply A.trans, apply A.right_subset_union, swap, apply A.right_subset_union},
  {apply A.trans, apply A.left_subset_union, swap, apply A.left_subset_union},
  {apply A.trans, apply A.right_subset_union, swap, apply A.left_subset_union},
  {apply A.right_subset_union},
end

lemma union_left_comm : X ∪ (Y ∪ Z) = Y ∪ (X ∪ Z) := calc
  X ∪ (Y ∪ Z) = (X ∪ Y) ∪ Z : A.union_assoc.symm
  ...         = (Y ∪ X) ∪ Z : by rw (@union_comm A X Y)
  ...         = Y ∪ (X ∪ Z) : A.union_assoc

lemma union_bot : (X ∪ ⊥) = X := A.antisymm (A.union_minimal A.refl A.bot_subset) A.left_subset_union
lemma bot_union : (⊥ ∪ X) = X := A.antisymm (A.union_minimal A.bot_subset A.refl) A.right_subset_union
lemma union_top : (X ∪ ⊤) = ⊤ := A.antisymm A.subset_top A.right_subset_union
lemma top_union : (⊤ ∪ X) = ⊤ := A.antisymm A.subset_top A.left_subset_union
lemma union_self : (X ∪ X) = X := A.antisymm (A.union_minimal A.refl A.refl) A.left_subset_union

lemma union_eq_left : (X ⊆ Y) → (Y ∪ X = Y) := fun h, A.antisymm (A.union_minimal A.refl h) A.left_subset_union
lemma union_eq_right : (X ⊆ Y) → (X ∪ Y = Y) := fun h, A.antisymm (A.union_minimal h A.refl) A.right_subset_union

lemma inter_distrib_union_left : X ∩ (Y ∪ Z) = (X ∩ Y) ∪ (X ∩ Z) := A.inter_distrib_union_ X Y Z
lemma inter_distrib_union_right : (X ∪ Y) ∩ Z = (X ∩ Z) ∪ (Y ∩ Z) := calc
  (X ∪ Y) ∩ Z = Z ∩ (X ∪ Y)       : A.inter_comm
  ...         = (Z ∩ X) ∪ (Z ∩ Y) : A.inter_distrib_union_left
  ...         = (X ∩ Z) ∪ (Y ∩ Z) : by rw [@inter_comm A X Z, @inter_comm A Y Z]
lemma union_distrib_inter_left : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z) := A.antisymm
  (A.inter_maximal
    (A.union_minimal
      A.left_subset_union
      (A.trans A.inter_subset_left A.right_subset_union))
    (A.union_minimal
      A.left_subset_union
      (A.trans A.inter_subset_right A.right_subset_union)))
  (calc
    (X ∪ Y) ∩ (X ∪ Z) = ((X ∪ Y) ∩ X) ∪ ((X ∪ Y) ∩ Z)             : A.inter_distrib_union_left
    ...               = ((X ∩ X) ∪ (Y ∩ X)) ∪ ((X ∩ Z) ∪ (Y ∩ Z)) : by rw [@inter_distrib_union_right A X Y X, @inter_distrib_union_right A X Y Z]
    ...               ⊆ X ∪ (Y ∩ Z)                               : begin
      repeat {apply A.union_minimal},
      show (X ∩ X) ⊆ X ∪ (Y ∩ Z), {exact A.trans A.inter_subset_left A.left_subset_union},
      show (Y ∩ X) ⊆ X ∪ (Y ∩ Z), {exact A.trans A.inter_subset_right A.left_subset_union},
      show (X ∩ Z) ⊆ X ∪ (Y ∩ Z), {exact A.trans A.inter_subset_left A.left_subset_union},
      show (Y ∩ Z) ⊆ X ∪ (Y ∩ Z), {exact A.right_subset_union},
    end)
lemma union_distrib_inter_right : (X ∩ Y) ∪ Z = (X ∪ Z) ∩ (Y ∪ Z) := calc
  (X ∩ Y) ∪ Z = Z ∪ (X ∩ Y)       : A.union_comm
  ...         = (Z ∪ X) ∩ (Z ∪ Y) : A.union_distrib_inter_left
  ...         = (X ∪ Z) ∩ (Y ∪ Z) : by rw [@union_comm A X Z, @union_comm A Y Z]

-- TODO: complement
lemma compl_contained : (X ⊆ Y) → (Yᶜ ⊆ Xᶜ) := sorry
lemma compl_bot : (⊥ : A)ᶜ = ⊤ := sorry
lemma compl_top : (⊤ : A)ᶜ = ⊥ := sorry
lemma compl_inter : (X ∩ Y)ᶜ = (Xᶜ ∪ Yᶜ) := sorry
lemma compl_union : (X ∪ Y)ᶜ = (Xᶜ ∩ Yᶜ) := sorry
lemma compl_compl : Xᶜᶜ = X := sorry

end /- namespace -/ fin_bool_alg

lemma fin_bool_alg.size_diff (A : fin_bool_alg) {X Y : A} :
  (X ⊆ Y) → size (Xᶜ ∩ Y) = size Y - size X := sorry

-- Notionally, the boolean algebra of subsets of {1, 2, ..., n}.
def fin_bool_alg.canonical (size : ℤ) :
  (0 ≤ size) → fin_bool_alg := sorry

/-
The opposite poset of a fin_bool_alg is also a fin_bool_alg,
almost trivially, with various operations and arguments swapped around
(bot ↔ top, intersection ↔ union).
-/
def fin_bool_alg.opposite (A : fin_bool_alg) : fin_bool_alg := {
  subset := A.subset,
  contained := (fun X Y, A.contained Y X), -- swapped arguments
  bot := A.top,
  top := A.bot,
  inter := A.union,
  union := A.inter,
  compl := A.compl,
  size := (fun X, A.size A.top - A.size X),

  refl_ := A.refl_,
  antisymm_ := (fun X Y h₁ h₂, A.antisymm_ X Y h₂ h₁),
  trans_ := (fun X Y Z h₁ h₂, A.trans_ Z Y X h₂ h₁),
  bot_subset_ := A.subset_top_,
  subset_top_ := A.bot_subset_,
  inter_subset_left_ := A.left_subset_union_,
  inter_subset_right_ := A.right_subset_union_,
  inter_maximal_ := A.union_minimal_,
  left_subset_union_ := A.inter_subset_left_,
  right_subset_union_ := A.inter_subset_right_,
  union_minimal_ := A.inter_maximal_,
  inter_distrib_union_ := (fun X Y Z, A.union_distrib_inter_left), -- not completely trivial
  self_inter_compl_ := A.self_union_compl_,
  self_union_compl_ := A.self_inter_compl_,
  size_nonneg_ := (fun X, by linarith [A.size_monotone_ _ _ (A.subset_top_ X)]),
  size_monotone_ := (fun X Y h, by linarith [A.size_monotone_ Y X h]),
  size_modular_ := (fun X Y, by linarith [A.size_modular_ X Y]),
  size_bot_ := (by linarith),
}

def fin_bool_alg.interval (A : fin_bool_alg) (small big : A) : (small ⊆ big) → fin_bool_alg := fun H, {
  subset := {X : A // (small ⊆ X) ∧ (X ⊆ big)}, -- there is unfortunately a coercion from this to A
  contained := (fun X Y, X.val ⊆ Y.val),
  bot := ⟨small, A.refl, H⟩,
  top := ⟨big, H, A.refl⟩,
  inter := (fun X Y, ⟨X.val ∩ Y.val, A.inter_maximal X.prop.left Y.prop.left, A.trans A.inter_subset_left X.prop.right⟩),
  union := (fun X Y, ⟨X.val ∪ Y.val, A.trans X.prop.left A.left_subset_union, A.union_minimal X.prop.right Y.prop.right⟩),
  compl := (fun X, ⟨(X.valᶜ ∪ small) ∩ big, A.inter_maximal A.right_subset_union H, A.inter_subset_right⟩),
  size := (fun X, A.size X.val - A.size small),

  refl_ := (fun X, A.refl),
  antisymm_ := (fun X Y h₁ h₂, subtype.ext (A.antisymm h₁ h₂)),
  trans_ := (fun X Y Z, A.trans),
  bot_subset_ := (fun X, X.prop.left),
  subset_top_ := (fun X, X.prop.right),
  inter_subset_left_ := (fun X Y, A.inter_subset_left),
  inter_subset_right_ := (fun X Y, A.inter_subset_right),
  inter_maximal_ := (fun X Y Z, A.inter_maximal),
  left_subset_union_ := (fun X Y, A.left_subset_union),
  right_subset_union_ := (fun X Y, A.right_subset_union),
  union_minimal_ := (fun X Y Z, A.union_minimal),
  inter_distrib_union_ := (fun X Y Z, subtype.ext A.inter_distrib_union_left),
  self_inter_compl_ := (fun X, subtype.ext (calc
      X.val ∩ ((X.valᶜ ∪ small) ∩ big)
    = (X.val ∩ X.valᶜ ∩ big) ∪ (X.val ∩ small ∩ big) : by simp only [fin_bool_alg.inter_distrib_union_left, fin_bool_alg.inter_distrib_union_right, fin_bool_alg.inter_assoc]
... =                          (X.val ∩ small ∩ big) : by rw [fin_bool_alg.self_inter_compl_self, fin_bool_alg.bot_inter, fin_bool_alg.bot_union]
... = small                                          : let h₁ : X.val ∩ small = small := A.inter_eq_right X.prop.left, h₂ : small ∩ big = small := A.inter_eq_left H in by rw [h₁, h₂]
  )),
  self_union_compl_ := (fun X, subtype.ext (calc
      X.val ∪ ((X.valᶜ ∪ small) ∩ big)
    = (X.val ∪ X.valᶜ ∪ small) ∩ (X.val ∪ big) : by simp only [fin_bool_alg.union_distrib_inter_left, fin_bool_alg.union_assoc]
... =                            (X.val ∪ big) : by rw [fin_bool_alg.self_union_compl_self, fin_bool_alg.top_union, fin_bool_alg.top_inter]
... = big                                      : A.union_eq_right X.prop.right
  )),
  size_nonneg_ := (fun X, by linarith [A.size_monotone_ small X.val X.prop.left]),
  size_monotone_ := (fun X Y h, by linarith [A.size_monotone h]),
  size_modular_ := (fun X Y, by linarith [@fin_bool_alg.size_modular A X.val Y.val]),
  size_bot_ := (by linarith),
}

-- TODO: isomorphisms of fin_bool_alg

example (A : fin_bool_alg) (small X big : A) :
  X ∩ ((Xᶜ ∪ small) ∩ big) = (X ∩ Xᶜ ∩ big) ∪ (X ∩ small ∩ big) :=
begin
  simp only [fin_bool_alg.inter_distrib_union_left, fin_bool_alg.inter_distrib_union_right, fin_bool_alg.inter_assoc],

end

end API

-- The rank-function definition of a matroid, as a packed structure.
@[ext] structure matroid :=
  (subset : fin_bool_alg)
  (rank : subset → ℤ)

  (R0 : forall (X : subset),
    0 ≤ rank X)
  (R1 : forall (X : subset),
    rank X ≤ size X)
  (R2 : forall {X Y : subset},
    X ⊆ Y → rank X ≤ rank Y)
  (R3 : forall (X Y : subset),
    rank (X ∩ Y) + rank (X ∪ Y) ≤ rank X + rank Y)

-- An example: uniform matroids, with rank `k` and size `n`.
def uniform_matroid (k n : ℤ) : (0 ≤ k) → (k ≤ n) → matroid :=
  fun (h0k : 0 ≤ k) (hkn : k ≤ n), let
    A : fin_bool_alg := fin_bool_alg.canonical n (le_trans h0k hkn)
  in {
    subset := A,
    rank := (fun (X : A), min k (size X)),

    R0 := (fun X, le_min h0k A.size_nonneg),
    R1 := (fun X, min_le_right _ _),
    R2 := (fun X Y (h : X ⊆ Y), le_min (min_le_left k _) (le_trans (min_le_right _ (size X)) (A.size_monotone h))),
    R3 := (fun X Y, or.elim (le_total k (size X))
      (fun (hkX : k ≤ size X), or.elim (le_total k (size Y))
        (fun (hkY : k ≤ (size Y)), let
          term1 : (min k (size (X ∩ Y)) ) ≤ k := min_le_left _ _,
          term2 : (min k (size (X ∪ Y)) ) ≤ k := min_le_left _ _,
          term3 : (min k (size X)) = k := min_eq_left hkX,
          term4 : (min k (size Y)) = k := min_eq_left hkY
          in by linarith)
        (fun (hYk : (size Y) ≤ k), let
          term1 : (min k (size (X ∩ Y))) ≤ (size Y) := le_trans (min_le_right _ _) (A.size_monotone A.inter_subset_right),
          term2 : (min k (size (X ∪ Y))) ≤ k := min_le_left _ _,
          term3 : (min k (size X)) = k := min_eq_left hkX,
          term4 : (min k (size Y)) = (size Y) := min_eq_right hYk
          in by linarith))
      (fun (hXk : (size X) ≤ k), or.elim (le_total k (size Y))
        (fun (hkY : k ≤ (size Y)), let
          term1 : (min k (size (X ∩ Y))) ≤ (size X) := le_trans (min_le_right _ _) (A.size_monotone A.inter_subset_left),
          term2 : (min k (size (X ∪ Y))) ≤ k := min_le_left _ _,
          term3 : (min k (size X)) = (size X) := min_eq_right hXk,
          term4 : (min k (size Y)) = k := min_eq_left hkY
          in by linarith)
        (fun (hYk : size Y ≤ k), let
          term1 : (min k (size (X ∩ Y))) ≤ size (X ∩ Y) := min_le_right _ _,
          term2 : (min k (size (X ∪ Y))) ≤ size (X ∪ Y) := min_le_right _ _,
          term3 : (min k (size X)) = size X := min_eq_right hXk,
          term4 : (min k (size Y)) = size Y := min_eq_right hYk
          in by linarith [@fin_bool_alg.size_modular A X Y]))),
  }

-- The empty set always has rank zero.
lemma matroid.rank_empty (M : matroid) :
  M.rank ⊥ = 0
    := le_antisymm (calc M.rank ⊥ ≤ size ⊥ : M.R1 ⊥ ... = 0 : M.subset.size_bot) (M.R0 ⊥)

-- The definition of the dual matroid. R2 is the trickier axiom to prove.
def matroid.dual : matroid → matroid := fun M, {
  subset := M.subset,
  rank := (fun (X : M.subset), M.rank Xᶜ + size X - M.rank ⊤),

  R0 := (fun X, calc
    0   ≤ M.rank Xᶜ + M.rank X - M.rank (X ∪ Xᶜ) - M.rank (X ∩ Xᶜ) : by linarith [M.R3 X Xᶜ]
    ... ≤ M.rank Xᶜ + M.rank X - M.rank ⊤        - M.rank ⊥        : by rw [@fin_bool_alg.self_inter_compl_self _ X, @fin_bool_alg.self_union_compl_self _ X]
    ... ≤ M.rank Xᶜ + size X   - M.rank ⊤                          : by linarith [M.R1 X, M.rank_empty]),
  R1 := (fun X, by linarith [M.R2 (@fin_bool_alg.subset_top _ Xᶜ)]),
  R2 := (fun X Y (hXY : X ⊆ Y), let
    h₁ : (Xᶜ ∩ Y) ∩ Yᶜ = ⊥ := calc
      (Xᶜ ∩ Y) ∩ Yᶜ = Xᶜ ∩ (Y ∩ Yᶜ) : M.subset.inter_assoc
      ...           = Xᶜ ∩ ⊥        : by rw [@fin_bool_alg.self_inter_compl_self _ Y]
      ...           = ⊥             : M.subset.inter_bot,
    h₂ : (Xᶜ ∪ Yᶜ) = Xᶜ := calc
      (Xᶜ ∪ Yᶜ) = (X ∩ Y)ᶜ : M.subset.compl_inter.symm
      ...       = Xᶜ       : by rw [M.subset.inter_eq_left hXY],
    h₃ : (Xᶜ ∩ Y) ∪ Yᶜ = Xᶜ := calc
      (Xᶜ ∩ Y) ∪ Yᶜ = (Xᶜ ∪ Yᶜ) ∩ (Y ∪ Yᶜ) : M.subset.union_distrib_inter_right
      ...           = Xᶜ ∩ ⊤               : by rw [h₂, @fin_bool_alg.self_union_compl_self _ Y]
      ...           = Xᶜ                   : M.subset.inter_top,
    h₄ : M.rank Xᶜ ≤ size Y - size X + M.rank Yᶜ := calc
      M.rank Xᶜ = M.rank ⊥ + M.rank Xᶜ                            : by linarith [M.rank_empty]
      ...       = M.rank ((Xᶜ ∩ Y) ∩ Yᶜ) + M.rank ((Xᶜ ∩ Y) ∪ Yᶜ) : by rw [h₁, h₃]
      ...       ≤ M.rank (Xᶜ ∩ Y) + M.rank Yᶜ                     : M.R3 _ _
      ...       ≤ size (Xᶜ ∩ Y) + M.rank Yᶜ                       : by linarith [M.R1 (Xᶜ ∩ Y)]
      ...       = size Y - size X + M.rank Yᶜ                     : by rw [M.subset.size_diff hXY]
    in by linarith),
  R3 := (fun X Y, calc
      (M.rank (X ∩ Y)ᶜ  + size (X ∩ Y) - M.rank ⊤) + (M.rank (X ∪ Y)ᶜ  + size (X ∪ Y) - M.rank ⊤)
    = (M.rank (Xᶜ ∪ Yᶜ) + size (X ∩ Y) - M.rank ⊤) + (M.rank (Xᶜ ∩ Yᶜ) + size (X ∪ Y) - M.rank ⊤) : by rw [@fin_bool_alg.compl_inter _ X Y, @fin_bool_alg.compl_union _ X Y]
... ≤ (M.rank Xᶜ        + size X       - M.rank ⊤) + (M.rank Yᶜ        + size Y       - M.rank ⊤) : by linarith [M.R3 Xᶜ Yᶜ, @fin_bool_alg.size_modular _ X Y]),
}

/-
-- The definition of a minor is weird-looking, but should correctly capture the notion of equality of minors.
@[ext] structure minor (major : matroid) :=
  (ground : major.ground.subset)
  (rank   : {X : major.ground.subset // X ⊆ ground} → ℤ)
  (kernel : exists (C : major.ground.subset),
    (ground ∩ C = ⊥) ∧
    (forall X, rank X = major.rank (X.val ∪ C) - major.rank C))

-- A matroid minor is a matroid in its own right.
def minor.as_matroid {M : matroid} (m : minor M) : matroid := {
  ground := m.ground.as_finite_set,
  rank := (fun (X : m.ground.as_finite_set.subset),
    m.rank (m.ground.embed X) (m.ground.embed_subset X)),

  R0 := (exists.elim m.kernel (fun C h mX, let
    X := m.ground.embed mX,
    h₁ : m.rank X _ = M.rank (X ∪ C) - M.rank C := h.2 _ (m.ground.embed_subset _),
    h₂ : M.rank C ≤ M.rank (X ∪ C) := M.R2 (X.right_subset_union C)
    in by linarith)),
  R1 := (exists.elim m.kernel (fun C h mX, let
    X := m.ground.embed mX,
    h₁ : m.rank X _ = M.rank (X ∪ C) - M.rank C := h.2 _ (m.ground.embed_subset _)
    in _)),
  R2 := sorry,
  R3 := sorry,
}

-- Is this possible to prove? Mathematically it should be.
lemma minor.as_matroid.injective {M : matroid} (m₁ m₂ : minor M) :
  (m₁.as_matroid = m₂.as_matroid) → m₁ = m₂ :=
    sorry

def minor.delete {M : matroid} (m : minor M) (D : M.ground.subset) :
  (D ⊆ m.ground) → (minor M) := fun h, {
    ground := (Dᶜ ∩ m.ground),
    rank := sorry,
    kernel := sorry,
  }

def minor.contract {M : matroid} (m : minor M) (C : M.ground.subset) :
  (C ⊆ m.ground) → (minor M) := fun h, {
    ground := (Cᶜ ∩ m.ground),
    rank := sorry,
    kernel := sorry,
  }
-/

/-

def finite_set : Type := sorry
def finite_set.subset : finite_set → Type := sorry
def finite_set.subset.size {γ : finite_set} : γ.subset → ℤ := sorry
instance has_subset_finite_set_subset {γ : finite_set} : has_subset γ.subset := sorry
instance has_inter_finite_set_subset {γ : finite_set} : has_inter γ.subset := sorry
instance has_union_finite_set_subset {γ : finite_set} : has_union γ.subset := sorry
instance has_compl_finite_set_subset {γ : finite_set} : has_compl γ.subset := sorry
instance has_top_finite_set_subset {γ : finite_set} : has_top γ.subset := sorry
instance has_bot_finite_set_subset {γ : finite_set} : has_bot γ.subset := sorry

@[trans] lemma finite_set.subset.trans {γ : finite_set} {X Y Z : γ.subset} :
  (X ⊆ Y) → (Y ⊆ Z) → (X ⊆ Z) := sorry

def finite_set.canonical (size : ℤ) :
  (0 ≤ size) → finite_set := sorry

def finite_set.subset.as_finite_set {γ : finite_set} :
  γ.subset → finite_set := sorry

def finite_set.subset.as_finite_set.injective {γ : finite_set} {X Y : γ.subset} :
  (X.as_finite_set = Y.as_finite_set) → (X = Y) := sorry

def finite_set.subset.embed {γ : finite_set} (X : γ.subset) :
  X.as_finite_set.subset → γ.subset := sorry

def finite_set.subset.restrict {γ : finite_set} (X Y : γ.subset) :
  (X ⊆ Y) → Y.as_finite_set.subset := sorry

lemma finite_set.subset.embed_subset {γ : finite_set} (X : γ.subset) (Y : X.as_finite_set.subset) :
  (X.embed Y) ⊆ X := sorry

lemma finite_set.subset.subset_embed {γ : finite_set} (X : γ.subset) (Y Z : X.as_finite_set.subset) :
  (Y ⊆ Z) → (X.embed Y) ⊆ (X.embed Z) := sorry

lemma finite_set.subset.inter_embed {γ : finite_set} (X : γ.subset) (Y Z : X.as_finite_set.subset) :
  (X.embed (Y ∩ Z)) = (X.embed Y) ∩ (X.embed Z) := sorry

lemma finite_set.subset.union_embed {γ : finite_set} (X : γ.subset) (Y Z : X.as_finite_set.subset) :
  (X.embed (Y ∪ Z)) = (X.embed Y) ∪ (X.embed Z) := sorry

lemma finite_set.subset.embed_size {γ : finite_set} (X : γ.subset) (Y : X.as_finite_set.subset) :
  (X.embed Y).size = Y.size := sorry

lemma finite_set.subset.size_empty {γ : finite_set} :
  (⊥ : γ.subset).size = 0 := sorry

lemma finite_set.subset.size_nonneg {γ : finite_set} (X : γ.subset) :
  0 ≤ X.size := sorry

lemma finite_set.subset.size_monotone {γ : finite_set} (X Y : γ.subset) :
  (X ⊆ Y) → X.size ≤ Y.size := sorry

lemma finite_set.subset.size_modular {γ : finite_set} (X Y : γ.subset) :
  (X ∩ Y).size + (X ∪ Y).size = X.size + Y.size := sorry

lemma finite_set.subset.inter_subset_left {γ : finite_set} (X Y : γ.subset) :
  (X ∩ Y) ⊆ X := sorry

lemma finite_set.subset.inter_subset_right {γ : finite_set} (X Y : γ.subset) :
  (X ∩ Y) ⊆ Y := sorry

lemma finite_set.subset.left_subset_union {γ : finite_set} (X Y : γ.subset) :
  X ⊆ (X ∪ Y) := sorry

lemma finite_set.subset.right_subset_union {γ : finite_set} (X Y : γ.subset) :
  Y ⊆ (X ∪ Y) := sorry

lemma finite_set.subset.inter_compl_self {γ : finite_set} (X : γ.subset) :
  (X ∩ Xᶜ) = ⊥ := sorry

lemma finite_set.subset.union_compl_self {γ : finite_set} (X : γ.subset) :
  (X ∪ Xᶜ) = ⊤ := sorry

lemma finite_set.subset.subset_top {γ : finite_set} (X : γ.subset) :
  X ⊆ ⊤ := calc X ⊆ (X ∪ Xᶜ) : X.left_subset_union Xᶜ ... = ⊤ : X.union_compl

lemma finite_set.subset.compl_inter {γ : finite_set} (X Y : γ.subset) :
  (X ∩ Y)ᶜ = Xᶜ ∪ Yᶜ := sorry

lemma finite_set.subset.compl_union {γ : finite_set} (X Y : γ.subset) :
  (X ∪ Y)ᶜ = Xᶜ ∩ Yᶜ := sorry

lemma finite_set.subset.inter_assoc {γ : finite_set} (X Y Z : γ.subset) :
  (X ∩ Y) ∩ Z = X ∩ (Y ∩ Z) := sorry

lemma finite_set.subset.inter_bot {γ : finite_set} (X : γ.subset) :
  (X ∩ ⊥) = ⊥ := sorry

lemma finite_set.subset.inter_top {γ : finite_set} (X : γ.subset) :
  (X ∩ ⊤) = X := sorry

lemma finite_set.subset.union_distrib_inter_left {γ : finite_set} (X Y Z : γ.subset) :
  (X ∩ Y) ∪ Z = (X ∪ Z) ∩ (Y ∪ Z) := sorry

lemma finite_set.subset.union_distrib_union_left {γ : finite_set} (X Y Z : γ.subset) :
  (X ∪ Y) ∪ Z = (X ∪ Z) ∪ (Y ∪ Z) := sorry

lemma finite_set.subset.inter_eq_left {γ : finite_set} (X Y : γ.subset) :
  (X ⊆ Y) → (X ∩ Y) = X := sorry

lemma finite_set.subset.diff_size {γ : finite_set} (X Y : γ.subset) :
  (X ⊆ Y) → (Xᶜ ∩ Y).size = Y.size - X.size := sorry

lemma finite_set.subset.subset_inter_subset_left {γ : finite_set} (X Y Z : γ.subset) :
  (X ⊆ Y) → (X ∩ Z) ⊆ (Y ∩ Z) := sorry

lemma finite_set.subset.subset_union_subset_left {γ : finite_set} (X Y Z : γ.subset) :
  (X ⊆ Y) → (X ∪ Z) ⊆ (Y ∪ Z) := sorry

lemma finite_set.subset.subset_bot {γ : finite_set} (X : γ.subset) :
  (X ⊆ ⊥) → (X = ⊥) := sorry
-/


/-
Copyright © 2019, Oracle and/or its affiliates. All rights reserved.
-/

import .setup_definition .setup_measurable
import .algorithm_definition .algorithm_measurable
import .sample_complexity
import .stump_pac_lemmas
import .to_epsilon

open set nat

local attribute [instance] classical.prop_decidable

namespace stump

variables (μ: probability_measure ℍ) (target: ℍ) (n: ℕ)

noncomputable
def denot: probability_measure ℍ :=
    let η := vec.prob_measure n μ  in
    let ν := map (label_sample target n) η in
    let γ := map (choose n) ν in
    γ

lemma pullback:
    ∀ P: nnreal → Prop,
    is_measurable {h: ℍ | P(@error μ target h)} →
    is_measurable {S: vec (ℍ × bool) n | P(error μ target (choose n S))} →
    (denot μ target n) {h: ℍ | P(@error μ target h)} = (vec.prob_measure n μ) {S: vec ℍ n | P(error μ target (choose n (label_sample target n S)))} :=
begin
    intros,
    dunfold denot,
    rw map_apply,
    rw map_apply,
    repeat {simp},
    repeat {assumption},
end

theorem choose_PAC:
    ∀ ε: nnreal, ∀ δ: nnreal, ∀ n: ℕ,
    ε > 0 → ε < 1 → δ > 0 → δ < 1 → (n: ℝ) > (complexity ε δ) →
    (denot μ target n) {h: ℍ | @error μ target h ≤ ε} ≥ 1 - δ :=
begin
    introv eps_0 eps_1 delta_0 delta_1 n_gt,
    by_cases((μ (Ioc 0 target)) > ε),
    {
        rw ← probability_measure.neq_prob_set,
        rw pullback μ target n (λ x, x > ε) _ _; try {simp},
        transitivity ((1 - ε)^(n+1)),
        {
            have EPS := extend_to_epsilon_1 μ target ε eps_0 h, cases EPS with θ θ_prop, cases θ_prop,
            have TZ: θ > 0,
            {
                by_contradiction h_contra,
                simp at h_contra, rw h_contra at *,
                have CONTRA: ¬ (μ (Ioc 0 target) ≤ ε), simp, assumption,
                contradiction,
            },
            transitivity ((vec.prob_measure n μ) {S: vec ℍ n |  ∀ (i: dfin (nat.succ n)), ∀ p = label target (kth_projn S i), (if p.snd then p.fst else 0) < θ}),
            {
                apply probability_measure.prob_mono,
                refine all_missed _ _ _ _ _ θ_prop_right,
            },
            {
                have INDEP := @prob_independence ℍ _ n _ (λ x, ∀ p = label target x, (if p.snd then p.fst else 0) < θ) μ (is_meas_one target θ TZ) (is_meas_forall target θ TZ),
                rw INDEP, clear INDEP,
                simp,
                apply pow_preserves_order (n+1),
                refine miss_prob _ _ _ _ TZ θ_prop_left,
            },
        },
        {
            apply complexity_enough ε δ n; assumption,
        },
        exact le_of_lt delta_1,
        simp,
    },
    {
        simp at h,
        rw pullback μ target n (λ x, x ≤ ε) _ _; try {simp},
        have DC: (vec.prob_measure n μ) {S: vec ℍ n | error μ target (choose n (label_sample target n S)) ≤ ε} = 1,
        {
            have AS := always_succeed μ target ε eps_0 n h,
            refine probability_measure.prob_trivial _ _ AS,
        },
        rw DC; try {assumption},
        apply super_dumb, assumption,
    },
end

end stump


--- TODO :
--  - retirer des simps et optimiser
--  - retirer les derniers sorry (nommer les hypothèses dans ite)

import topology.basic
import topology.algebra.continuous_functions
import topology.continuous_on
import topology.algebra.ordered
import topology.constructions
import topology.algebra.ordered
import data.set.function
import topology.constructions
import tactic.split_ifs
import tactics

import misc

open set topological_space
open classical

set_option pp.beta true

/- Typeclass définissant un type pointé -/
class pointed (α : Type) :=
(point : α)

/- Prends un type pointé et lui renvoit son point base-/
def point (α : Type) [s : pointed α] : α :=
@pointed.point α s

-- On considère par la suite un espace topologique X pointé
variable X:Type
variable [topological_space X]
variable [pointed X]

-- Dans la suite du fichier, on pointe ℝ en 0
instance : pointed ℝ := pointed.mk 0

--Définitions par soustype d'un chemin et d'une boucle
/-- Chemin sur un type X -/
def path := {f: I → X // continuous f}
/-- Boucle sur un type X -/
def loop := {f: I → X // continuous f ∧ f(0)=f(1) ∧ f(0) = point X  }

/-- Homotopie de lacets -/
def loop_homotopy (f : loop X) (g : loop X) : Prop :=
    ∃ (H : I × I -> X),  (∀ t, H(0,t) = f.val(t) ∧  H(1,t)=g.val(t)) ∧ (continuous H)

/-- Compostition de lacets -/
noncomputable def loop_comp : (loop X ) -> (loop X) -> (loop X) :=
    λ f g, ⟨λ t, ite (t.val≤0.5) (f.val(⟨2*t.val, sorry⟩) )
        (g.val (⟨ 2*t.val-1, sorry⟩)),
    begin
    split,

    -- on doit montrer que la compositions de lacets est un lacet
    -- on commence par la continuité
    apply continuous_if,
    rotate, -- on relègue la preuve de la frontière à la fin
    apply continuous.comp,
    exact f.property.1,
    apply continuous_subtype_mk,
    apply continuous.mul,
    exact continuous_const,
    apply continuous_subtype_val,
    apply continuous.comp,
    exact g.property.1,
    apply continuous_subtype_mk,
    apply continuous.add,
    apply continuous.mul,
    exact continuous_const,
    apply continuous_subtype_val,
    exact continuous_const,

    -- le lacet vaut bien x₀ aux extrémités
    split_ifs,
    simp at h_1,
    exfalso,
    sorry,

    split,
    simp,
    rw f.property.2.2,
    conv {to_lhs,   -- conv permet de travailler dans le membre de gauche
    rw <- g.property.2.2,
    rw g.property.2.1,},
    congr,
    apply subtype.eq', -- on "relève" l'égalité dans le type ambiant
    simp,
    ring, -- découle des propriétés dans un anneau

    simp,
    rw f.property.2.2,

    exfalso,
    simp at h,
    linarith,

    exfalso,
    simp at h,
    linarith,

    intros a ha,
    have a_def : a.val=1/2, -- il faut montrer que la frontière = {1/2}
    rw frontieronI' at ha,
    exact ha,
    rw a_def,
    rw invtwo,
    simp,
    rw g.property.2.2,
    rw <- f.property.2.1,
    rw f.property.2.2,
end⟩

/- Lacet inverse -/
def loop_inv : loop X -> loop X := λ f, ⟨λ x:I, f.val(⟨1-x.val, oneminus x⟩ ),
    begin
    split,
        apply continuous.comp,
        exact f.property.left,
        apply continuous_subtype_mk,
        apply continuous.sub,
        apply continuous_const,
        apply continuous_subtype_val,,
    split,
      simp,
      symmetry,
      exact f.property.2.1,
      simp,
      rw <- f.property.2.1,
      exact f.property.2.2,
    end
 ⟩

/-- L'homotopie est reflexive -/
theorem loop_homotopy_refl : reflexive (loop_homotopy X) :=
begin
    intro f,
    -- on utilise l'homotopie H(t,s) = f(s)
    let H : I × I -> X := λ x, f.val (x.2),
    use H,
    split,

    -- l'homotopie vaut f aux extremités
    intros,
    split,
        simp *,

    -- l'homotopie est continue
    apply continuous.comp, -- on déplit la composition
    exact f.property.left, -- f est continue
    exact continuous_snd, -- la projection sur le deuxième élément est continue
end

/-- L'homotopie est symmétrique -/
theorem loop_homotopy_symm : symmetric (loop_homotopy X) :=
begin
    intros f g,
    intro h1,
    cases h1 with H hH,
    -- on utilise l'homotopie H_2(t,s) = H(1-t,s)
    let H2 : I × I -> X := λ x, H(⟨1-x.1.val, oneminus x.1⟩, x.2),
    use H2,
    split,

     -- l'homotopie vaut g et f aux extremités
    intros,
    split,
    simp *, -- on déplit la définition de H_2
    simp [ coe_of_0],
    rw (hH.1 t).2, -- on réécrit g en H(1,t)
    simp *, -- on déplit la définition de H_2
    simp [one_minus_one_coe],
    rw  (hH.1 t).1, -- on réécrit f en H(0,t)

    -- l'homotopie est continue
    apply continuous.comp, -- on déplit la composition
    exact hH.2, -- H est continue par hypothèse
    apply continuous.prod_mk, -- on déplit le produit
    apply continuous_subtype_mk, -- on déplit le passage au sous-type
    apply continuous.sub, -- on déplit la soustraction
    apply continuous_const, -- une fonction constante est continue
    apply continuous.comp, -- on déplit la composition
    exact continuous_subtype_val, -- le "relèvement" de sous-type est continu
    exact continuous_fst, -- la projection sur le premier élément est continue
    exact continuous_snd, -- la projection sur le deuxième élément est continue

end

/-- L'homotopie est transitive -/
theorem loop_homotopy_trans : transitive (loop_homotopy X) :=
begin
    intros f g h,
    intros h1 h2,
    cases h1 with h1func h1hyp,
    cases h2 with h2func h2hyp,
    -- on utilise l'homotopie H₃(t,s) = H₁(2t,s) si t ≤ 0.5
    --                                  H₂(2t-1,s) sinon
    let H : I × I -> X := λ x, ite (x.1.val≤0.5) (h1func( ⟨ 2*x.1.val, sorry ⟩, x.2))
         (h2func(⟨2*x.1.val-1, sorry⟩, x.2 )),
    use H,
    split,

    -- l'homotopie vaut f et h aux extremités
    intros,
    split,
    simp *,
    split_ifs, -- on déplit la définition d'une condition
        rw <- (h1hyp.1 t).1, -- soit 0≤1/2
        congr,
        simp [coe_of_0], -- auquel cas les deux arguments sont égaux
    simp at h_1, -- soit 2<0
    exfalso,
    exact not_2_lt_0 h_1, -- auquel cas on obtient une absurdité

    simp *,
    split_ifs, -- on déplit la définition d'une condition
        simp at h_1, -- soit 1<1/2
        exfalso,
        exact not_1_lt_half h_1, -- auquel cas on obtient une absurdité
    rw <- (h2hyp.1 t).2, -- soit 1>0
    congr,
    rw <- oneisone,
    simp,
    ring,

    -- continuité
    simp *,
    apply continuous_if,
    rotate,
    -- partie 1
    apply continuous.comp,
    exact h1hyp.2,
    apply continuous.prod_mk,
    apply continuous_subtype_mk,
    apply continuous.mul,
    exact continuous_const,
    apply continuous.comp,
    exact continuous_subtype_val, -- le "relèvement" de sous-type est continu
    exact continuous_fst,
    exact continuous_snd,
    -- partie 2
    apply continuous.comp,
    exact h2hyp.2,
    apply continuous.prod_mk,
    apply continuous_subtype_mk,
    apply continuous.sub,
    apply continuous.mul,
    exact continuous_const,
    apply continuous.comp,
    exact continuous_subtype_val, -- le "relèvement" de sous-type est continu
    exact continuous_fst,
    exact continuous_const,
    exact continuous_snd,
    --frontière
    intros a ha,
    have a_def : a.fst.val=1/2, -- il faut montrer que la frontière = {1/2, -}
    rw frontieronI at ha,
    exact ha,
    rw a_def,
    rw invtwo,
    simp,
    rw (h1hyp.1 a.snd).2,
    rw (h2hyp.1 a.snd).1,

end

/-- L'homotopie est une relation d'équivalence -/
theorem loop_homotopy_equiv : equivalence (loop_homotopy X) :=
    ⟨ loop_homotopy_refl X, loop_homotopy_symm X, loop_homotopy_trans X⟩

/-- Sétoïde (X, homotopies de X) -/
definition homotopy.setoid : setoid (loop X) := { r := loop_homotopy X, iseqv := loop_homotopy_equiv X}

/-- Ensemble des classes d'homotopie -/
definition homotopy_classes := quotient (homotopy.setoid X)

/-- Réduction à classe d'équivalence près -/
definition reduce_homotopy: (loop X) → homotopy_classes X := quot.mk (loop_homotopy X)

-- notation à améliorer (inférer le type automatiquement)
notation `[` f `|` X `]` := reduce_homotopy X f


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

! This file was ported from Lean 3 source module measure_theory.decomposition.jordan
! leanprover-community/mathlib commit 70a4f2197832bceab57d7f41379b2592d1110570
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Decomposition.SignedHahn
import Mathbin.MeasureTheory.Measure.MutuallySingular

/-!
# Jordan decomposition

This file proves the existence and uniqueness of the Jordan decomposition for signed measures.
The Jordan decomposition theorem states that, given a signed measure `s`, there exists a
unique pair of mutually singular measures `μ` and `ν`, such that `s = μ - ν`.

The Jordan decomposition theorem for measures is a corollary of the Hahn decomposition theorem and
is useful for the Lebesgue decomposition theorem.

## Main definitions

* `measure_theory.jordan_decomposition`: a Jordan decomposition of a measurable space is a
  pair of mutually singular finite measures. We say `j` is a Jordan decomposition of a signed
  measure `s` if `s = j.pos_part - j.neg_part`.
* `measure_theory.signed_measure.to_jordan_decomposition`: the Jordan decomposition of a
  signed measure.
* `measure_theory.signed_measure.to_jordan_decomposition_equiv`: is the `equiv` between
  `measure_theory.signed_measure` and `measure_theory.jordan_decomposition` formed by
  `measure_theory.signed_measure.to_jordan_decomposition`.

## Main results

* `measure_theory.signed_measure.to_signed_measure_to_jordan_decomposition` : the Jordan
  decomposition theorem.
* `measure_theory.jordan_decomposition.to_signed_measure_injective` : the Jordan decomposition of a
  signed measure is unique.

## Tags

Jordan decomposition theorem
-/

noncomputable section

open Classical MeasureTheory ENNReal NNReal

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

namespace MeasureTheory

/-- A Jordan decomposition of a measurable space is a pair of mutually singular,
finite measures. -/
@[ext]
structure JordanDecomposition (α : Type _) [MeasurableSpace α] where
  (posPart negPart : Measure α)
  [posPartFinite : IsFiniteMeasure pos_part]
  [negPartFinite : IsFiniteMeasure neg_part]
  MutuallySingular : pos_part ⟂ₘ neg_part
#align measure_theory.jordan_decomposition MeasureTheory.JordanDecomposition

attribute [instance] jordan_decomposition.pos_part_finite

attribute [instance] jordan_decomposition.neg_part_finite

namespace JordanDecomposition

open Measure VectorMeasure

variable (j : JordanDecomposition α)

instance : Zero (JordanDecomposition α) where zero := ⟨0, 0, MutuallySingular.zeroRight⟩

instance : Inhabited (JordanDecomposition α) where default := 0

instance : InvolutiveNeg (JordanDecomposition α)
    where
  neg j := ⟨j.negPart, j.posPart, j.MutuallySingular.symm⟩
  neg_neg j := JordanDecomposition.ext _ _ rfl rfl

instance : SMul ℝ≥0 (JordanDecomposition α)
    where smul r j :=
    ⟨r • j.posPart, r • j.negPart,
      MutuallySingular.smul _ (MutuallySingular.smul _ j.MutuallySingular.symm).symm⟩

instance hasSmulReal : SMul ℝ (JordanDecomposition α)
    where smul r j := if hr : 0 ≤ r then r.toNNReal • j else -((-r).toNNReal • j)
#align measure_theory.jordan_decomposition.has_smul_real MeasureTheory.JordanDecomposition.hasSmulReal

@[simp]
theorem zero_posPart : (0 : JordanDecomposition α).posPart = 0 :=
  rfl
#align measure_theory.jordan_decomposition.zero_pos_part MeasureTheory.JordanDecomposition.zero_posPart

@[simp]
theorem zero_negPart : (0 : JordanDecomposition α).negPart = 0 :=
  rfl
#align measure_theory.jordan_decomposition.zero_neg_part MeasureTheory.JordanDecomposition.zero_negPart

@[simp]
theorem neg_posPart : (-j).posPart = j.negPart :=
  rfl
#align measure_theory.jordan_decomposition.neg_pos_part MeasureTheory.JordanDecomposition.neg_posPart

@[simp]
theorem neg_negPart : (-j).negPart = j.posPart :=
  rfl
#align measure_theory.jordan_decomposition.neg_neg_part MeasureTheory.JordanDecomposition.neg_negPart

@[simp]
theorem smul_posPart (r : ℝ≥0) : (r • j).posPart = r • j.posPart :=
  rfl
#align measure_theory.jordan_decomposition.smul_pos_part MeasureTheory.JordanDecomposition.smul_posPart

@[simp]
theorem smul_negPart (r : ℝ≥0) : (r • j).negPart = r • j.negPart :=
  rfl
#align measure_theory.jordan_decomposition.smul_neg_part MeasureTheory.JordanDecomposition.smul_negPart

theorem real_smul_def (r : ℝ) (j : JordanDecomposition α) :
    r • j = if hr : 0 ≤ r then r.toNNReal • j else -((-r).toNNReal • j) :=
  rfl
#align measure_theory.jordan_decomposition.real_smul_def MeasureTheory.JordanDecomposition.real_smul_def

@[simp]
theorem coe_smul (r : ℝ≥0) : (r : ℝ) • j = r • j :=
  show dite _ _ _ = _ by rw [dif_pos (NNReal.coe_nonneg r), Real.toNNReal_coe]
#align measure_theory.jordan_decomposition.coe_smul MeasureTheory.JordanDecomposition.coe_smul

theorem real_smul_nonneg (r : ℝ) (hr : 0 ≤ r) : r • j = r.toNNReal • j :=
  dif_pos hr
#align measure_theory.jordan_decomposition.real_smul_nonneg MeasureTheory.JordanDecomposition.real_smul_nonneg

theorem real_smul_neg (r : ℝ) (hr : r < 0) : r • j = -((-r).toNNReal • j) :=
  dif_neg (not_le.2 hr)
#align measure_theory.jordan_decomposition.real_smul_neg MeasureTheory.JordanDecomposition.real_smul_neg

theorem real_smul_posPart_nonneg (r : ℝ) (hr : 0 ≤ r) : (r • j).posPart = r.toNNReal • j.posPart :=
  by rw [real_smul_def, ← smul_pos_part, dif_pos hr]
#align measure_theory.jordan_decomposition.real_smul_pos_part_nonneg MeasureTheory.JordanDecomposition.real_smul_posPart_nonneg

theorem real_smul_negPart_nonneg (r : ℝ) (hr : 0 ≤ r) : (r • j).negPart = r.toNNReal • j.negPart :=
  by rw [real_smul_def, ← smul_neg_part, dif_pos hr]
#align measure_theory.jordan_decomposition.real_smul_neg_part_nonneg MeasureTheory.JordanDecomposition.real_smul_negPart_nonneg

theorem real_smul_posPart_neg (r : ℝ) (hr : r < 0) : (r • j).posPart = (-r).toNNReal • j.negPart :=
  by rw [real_smul_def, ← smul_neg_part, dif_neg (not_le.2 hr), neg_pos_part]
#align measure_theory.jordan_decomposition.real_smul_pos_part_neg MeasureTheory.JordanDecomposition.real_smul_posPart_neg

theorem real_smul_negPart_neg (r : ℝ) (hr : r < 0) : (r • j).negPart = (-r).toNNReal • j.posPart :=
  by rw [real_smul_def, ← smul_pos_part, dif_neg (not_le.2 hr), neg_neg_part]
#align measure_theory.jordan_decomposition.real_smul_neg_part_neg MeasureTheory.JordanDecomposition.real_smul_negPart_neg

/-- The signed measure associated with a Jordan decomposition. -/
def toSignedMeasure : SignedMeasure α :=
  j.posPart.toSignedMeasure - j.negPart.toSignedMeasure
#align measure_theory.jordan_decomposition.to_signed_measure MeasureTheory.JordanDecomposition.toSignedMeasure

theorem toSignedMeasure_zero : (0 : JordanDecomposition α).toSignedMeasure = 0 :=
  by
  ext1 i hi
  erw [to_signed_measure, to_signed_measure_sub_apply hi, sub_self, zero_apply]
#align measure_theory.jordan_decomposition.to_signed_measure_zero MeasureTheory.JordanDecomposition.toSignedMeasure_zero

theorem toSignedMeasure_neg : (-j).toSignedMeasure = -j.toSignedMeasure :=
  by
  ext1 i hi
  rw [neg_apply, to_signed_measure, to_signed_measure, to_signed_measure_sub_apply hi,
    to_signed_measure_sub_apply hi, neg_sub]
  rfl
#align measure_theory.jordan_decomposition.to_signed_measure_neg MeasureTheory.JordanDecomposition.toSignedMeasure_neg

theorem toSignedMeasure_smul (r : ℝ≥0) : (r • j).toSignedMeasure = r • j.toSignedMeasure :=
  by
  ext1 i hi
  rw [vector_measure.smul_apply, to_signed_measure, to_signed_measure,
    to_signed_measure_sub_apply hi, to_signed_measure_sub_apply hi, smul_sub, smul_pos_part,
    smul_neg_part, ← ENNReal.toReal_smul, ← ENNReal.toReal_smul]
  rfl
#align measure_theory.jordan_decomposition.to_signed_measure_smul MeasureTheory.JordanDecomposition.toSignedMeasure_smul

/-- A Jordan decomposition provides a Hahn decomposition. -/
theorem exists_compl_positive_negative :
    ∃ S : Set α,
      MeasurableSet S ∧
        j.toSignedMeasure ≤[S] 0 ∧
          0 ≤[Sᶜ] j.toSignedMeasure ∧ j.posPart S = 0 ∧ j.negPart (Sᶜ) = 0 :=
  by
  obtain ⟨S, hS₁, hS₂, hS₃⟩ := j.mutually_singular
  refine' ⟨S, hS₁, _, _, hS₂, hS₃⟩
  · refine' restrict_le_restrict_of_subset_le _ _ fun A hA hA₁ => _
    rw [to_signed_measure, to_signed_measure_sub_apply hA,
      show j.pos_part A = 0 from nonpos_iff_eq_zero.1 (hS₂ ▸ measure_mono hA₁), ENNReal.zero_toReal,
      zero_sub, neg_le, zero_apply, neg_zero]
    exact ENNReal.toReal_nonneg
  · refine' restrict_le_restrict_of_subset_le _ _ fun A hA hA₁ => _
    rw [to_signed_measure, to_signed_measure_sub_apply hA,
      show j.neg_part A = 0 from nonpos_iff_eq_zero.1 (hS₃ ▸ measure_mono hA₁), ENNReal.zero_toReal,
      sub_zero]
    exact ENNReal.toReal_nonneg
#align measure_theory.jordan_decomposition.exists_compl_positive_negative MeasureTheory.JordanDecomposition.exists_compl_positive_negative

end JordanDecomposition

namespace SignedMeasure

open Classical JordanDecomposition Measure Set VectorMeasure

variable {s : SignedMeasure α} {μ ν : Measure α} [IsFiniteMeasure μ] [IsFiniteMeasure ν]

/-- Given a signed measure `s`, `s.to_jordan_decomposition` is the Jordan decomposition `j`,
such that `s = j.to_signed_measure`. This property is known as the Jordan decomposition
theorem, and is shown by
`measure_theory.signed_measure.to_signed_measure_to_jordan_decomposition`. -/
def toJordanDecomposition (s : SignedMeasure α) : JordanDecomposition α :=
  let i := choose s.exists_compl_positive_negative
  let hi := choose_spec s.exists_compl_positive_negative
  { posPart := s.toMeasureOfZeroLe i hi.1 hi.2.1
    negPart := s.toMeasureOfLeZero (iᶜ) hi.1.compl hi.2.2
    posPartFinite := inferInstance
    negPartFinite := inferInstance
    MutuallySingular := by
      refine' ⟨iᶜ, hi.1.compl, _, _⟩
      · rw [to_measure_of_zero_le_apply _ _ hi.1 hi.1.compl]
        simp
      · rw [to_measure_of_le_zero_apply _ _ hi.1.compl hi.1.compl.compl]
        simp }
#align measure_theory.signed_measure.to_jordan_decomposition MeasureTheory.SignedMeasure.toJordanDecomposition

theorem toJordanDecomposition_spec (s : SignedMeasure α) :
    ∃ (i : Set α)(hi₁ : MeasurableSet i)(hi₂ : 0 ≤[i] s)(hi₃ : s ≤[iᶜ] 0),
      s.toJordanDecomposition.posPart = s.toMeasureOfZeroLe i hi₁ hi₂ ∧
        s.toJordanDecomposition.negPart = s.toMeasureOfLeZero (iᶜ) hi₁.compl hi₃ :=
  by
  set i := some s.exists_compl_positive_negative
  obtain ⟨hi₁, hi₂, hi₃⟩ := some_spec s.exists_compl_positive_negative
  exact ⟨i, hi₁, hi₂, hi₃, rfl, rfl⟩
#align measure_theory.signed_measure.to_jordan_decomposition_spec MeasureTheory.SignedMeasure.toJordanDecomposition_spec

/-- **The Jordan decomposition theorem**: Given a signed measure `s`, there exists a pair of
mutually singular measures `μ` and `ν` such that `s = μ - ν`. In this case, the measures `μ`
and `ν` are given by `s.to_jordan_decomposition.pos_part` and
`s.to_jordan_decomposition.neg_part` respectively.

Note that we use `measure_theory.jordan_decomposition.to_signed_measure` to represent the
signed measure corresponding to
`s.to_jordan_decomposition.pos_part - s.to_jordan_decomposition.neg_part`. -/
@[simp]
theorem toSignedMeasure_toJordanDecomposition (s : SignedMeasure α) :
    s.toJordanDecomposition.toSignedMeasure = s :=
  by
  obtain ⟨i, hi₁, hi₂, hi₃, hμ, hν⟩ := s.to_jordan_decomposition_spec
  simp only [jordan_decomposition.to_signed_measure, hμ, hν]
  ext (k hk)
  rw [to_signed_measure_sub_apply hk, to_measure_of_zero_le_apply _ hi₂ hi₁ hk,
    to_measure_of_le_zero_apply _ hi₃ hi₁.compl hk]
  simp only [ENNReal.coe_toReal, Subtype.coe_mk, ENNReal.some_eq_coe, sub_neg_eq_add]
  rw [← of_union _ (MeasurableSet.inter hi₁ hk) (MeasurableSet.inter hi₁.compl hk),
    Set.inter_comm i, Set.inter_comm (iᶜ), Set.inter_union_compl _ _]
  · infer_instance
  · exact (disjoint_compl_right.inf_left _).inf_right _
#align measure_theory.signed_measure.to_signed_measure_to_jordan_decomposition MeasureTheory.SignedMeasure.toSignedMeasure_toJordanDecomposition

section

variable {u v w : Set α}

/-- A subset `v` of a null-set `w` has zero measure if `w` is a subset of a positive set `u`. -/
theorem subset_positive_null_set (hu : MeasurableSet u) (hv : MeasurableSet v)
    (hw : MeasurableSet w) (hsu : 0 ≤[u] s) (hw₁ : s w = 0) (hw₂ : w ⊆ u) (hwt : v ⊆ w) : s v = 0 :=
  by
  have : s v + s (w \ v) = 0 :=
    by
    rw [← hw₁, ← of_union Set.disjoint_sdiff_right hv (hw.diff hv), Set.union_diff_self,
      Set.union_eq_self_of_subset_left hwt]
    infer_instance
  have h₁ := nonneg_of_zero_le_restrict _ (restrict_le_restrict_subset _ _ hu hsu (hwt.trans hw₂))
  have h₂ :=
    nonneg_of_zero_le_restrict _
      (restrict_le_restrict_subset _ _ hu hsu ((w.diff_subset v).trans hw₂))
  linarith
#align measure_theory.signed_measure.subset_positive_null_set MeasureTheory.SignedMeasure.subset_positive_null_set

/-- A subset `v` of a null-set `w` has zero measure if `w` is a subset of a negative set `u`. -/
theorem subset_negative_null_set (hu : MeasurableSet u) (hv : MeasurableSet v)
    (hw : MeasurableSet w) (hsu : s ≤[u] 0) (hw₁ : s w = 0) (hw₂ : w ⊆ u) (hwt : v ⊆ w) : s v = 0 :=
  by
  rw [← s.neg_le_neg_iff _ hu, neg_zero] at hsu
  have := subset_positive_null_set hu hv hw hsu
  simp only [Pi.neg_apply, neg_eq_zero, coe_neg] at this
  exact this hw₁ hw₂ hwt
#align measure_theory.signed_measure.subset_negative_null_set MeasureTheory.SignedMeasure.subset_negative_null_set

/-- If the symmetric difference of two positive sets is a null-set, then so are the differences
between the two sets. -/
theorem of_diff_eq_zero_of_symmDiff_eq_zero_positive (hu : MeasurableSet u) (hv : MeasurableSet v)
    (hsu : 0 ≤[u] s) (hsv : 0 ≤[v] s) (hs : s (u ∆ v) = 0) : s (u \ v) = 0 ∧ s (v \ u) = 0 :=
  by
  rw [restrict_le_restrict_iff] at hsu hsv
  have a := hsu (hu.diff hv) (u.diff_subset v)
  have b := hsv (hv.diff hu) (v.diff_subset u)
  erw [of_union (Set.disjoint_of_subset_left (u.diff_subset v) disjoint_sdiff_self_right)
      (hu.diff hv) (hv.diff hu)] at
    hs
  rw [zero_apply] at a b
  constructor
  all_goals first |linarith|infer_instance|assumption
#align measure_theory.signed_measure.of_diff_eq_zero_of_symm_diff_eq_zero_positive MeasureTheory.SignedMeasure.of_diff_eq_zero_of_symmDiff_eq_zero_positive

/-- If the symmetric difference of two negative sets is a null-set, then so are the differences
between the two sets. -/
theorem of_diff_eq_zero_of_symmDiff_eq_zero_negative (hu : MeasurableSet u) (hv : MeasurableSet v)
    (hsu : s ≤[u] 0) (hsv : s ≤[v] 0) (hs : s (u ∆ v) = 0) : s (u \ v) = 0 ∧ s (v \ u) = 0 :=
  by
  rw [← s.neg_le_neg_iff _ hu, neg_zero] at hsu
  rw [← s.neg_le_neg_iff _ hv, neg_zero] at hsv
  have := of_diff_eq_zero_of_symm_diff_eq_zero_positive hu hv hsu hsv
  simp only [Pi.neg_apply, neg_eq_zero, coe_neg] at this
  exact this hs
#align measure_theory.signed_measure.of_diff_eq_zero_of_symm_diff_eq_zero_negative MeasureTheory.SignedMeasure.of_diff_eq_zero_of_symmDiff_eq_zero_negative

theorem of_inter_eq_of_symmDiff_eq_zero_positive (hu : MeasurableSet u) (hv : MeasurableSet v)
    (hw : MeasurableSet w) (hsu : 0 ≤[u] s) (hsv : 0 ≤[v] s) (hs : s (u ∆ v) = 0) :
    s (w ∩ u) = s (w ∩ v) :=
  by
  have hwuv : s ((w ∩ u) ∆ (w ∩ v)) = 0 :=
    by
    refine'
      subset_positive_null_set (hu.union hv) ((hw.inter hu).symmDiff (hw.inter hv))
        (hu.symm_diff hv) (restrict_le_restrict_union _ _ hu hsu hv hsv) hs symm_diff_subset_union _
    rw [← inter_symm_diff_distrib_left]
    exact inter_subset_right _ _
  obtain ⟨huv, hvu⟩ :=
    of_diff_eq_zero_of_symm_diff_eq_zero_positive (hw.inter hu) (hw.inter hv)
      (restrict_le_restrict_subset _ _ hu hsu (w.inter_subset_right u))
      (restrict_le_restrict_subset _ _ hv hsv (w.inter_subset_right v)) hwuv
  rw [← of_diff_of_diff_eq_zero (hw.inter hu) (hw.inter hv) hvu, huv, zero_add]
#align measure_theory.signed_measure.of_inter_eq_of_symm_diff_eq_zero_positive MeasureTheory.SignedMeasure.of_inter_eq_of_symmDiff_eq_zero_positive

theorem of_inter_eq_of_symmDiff_eq_zero_negative (hu : MeasurableSet u) (hv : MeasurableSet v)
    (hw : MeasurableSet w) (hsu : s ≤[u] 0) (hsv : s ≤[v] 0) (hs : s (u ∆ v) = 0) :
    s (w ∩ u) = s (w ∩ v) :=
  by
  rw [← s.neg_le_neg_iff _ hu, neg_zero] at hsu
  rw [← s.neg_le_neg_iff _ hv, neg_zero] at hsv
  have := of_inter_eq_of_symm_diff_eq_zero_positive hu hv hw hsu hsv
  simp only [Pi.neg_apply, neg_inj, neg_eq_zero, coe_neg] at this
  exact this hs
#align measure_theory.signed_measure.of_inter_eq_of_symm_diff_eq_zero_negative MeasureTheory.SignedMeasure.of_inter_eq_of_symmDiff_eq_zero_negative

end

end SignedMeasure

namespace JordanDecomposition

open Measure VectorMeasure SignedMeasure Function

private theorem eq_of_pos_part_eq_pos_part {j₁ j₂ : JordanDecomposition α}
    (hj : j₁.posPart = j₂.posPart) (hj' : j₁.toSignedMeasure = j₂.toSignedMeasure) : j₁ = j₂ :=
  by
  ext1
  · exact hj
  · rw [← to_signed_measure_eq_to_signed_measure_iff]
    suffices
      j₁.pos_part.to_signed_measure - j₁.neg_part.to_signed_measure =
        j₁.pos_part.to_signed_measure - j₂.neg_part.to_signed_measure
      by exact sub_right_inj.mp this
    convert hj'
#align measure_theory.jordan_decomposition.eq_of_pos_part_eq_pos_part measure_theory.jordan_decomposition.eq_of_pos_part_eq_pos_part

/-- The Jordan decomposition of a signed measure is unique. -/
theorem toSignedMeasure_injective : Injective <| @JordanDecomposition.toSignedMeasure α _ :=
  by
  /- The main idea is that two Jordan decompositions of a signed measure provide two
    Hahn decompositions for that measure. Then, from `of_symm_diff_compl_positive_negative`,
    the symmetric difference of the two Hahn decompositions has measure zero, thus, allowing us to
    show the equality of the underlying measures of the Jordan decompositions. -/
  intro j₁ j₂ hj
  -- obtain the two Hahn decompositions from the Jordan decompositions
  obtain ⟨S, hS₁, hS₂, hS₃, hS₄, hS₅⟩ := j₁.exists_compl_positive_negative
  obtain ⟨T, hT₁, hT₂, hT₃, hT₄, hT₅⟩ := j₂.exists_compl_positive_negative
  rw [← hj] at hT₂ hT₃
  -- the symmetric differences of the two Hahn decompositions have measure zero
  obtain ⟨hST₁, -⟩ :=
    of_symm_diff_compl_positive_negative hS₁.compl hT₁.compl ⟨hS₃, (compl_compl S).symm ▸ hS₂⟩
      ⟨hT₃, (compl_compl T).symm ▸ hT₂⟩
  -- it suffices to show the Jordan decompositions have the same positive parts
  refine' eq_of_pos_part_eq_pos_part _ hj
  ext1 i hi
  -- we see that the positive parts of the two Jordan decompositions are equal to their
  -- associated signed measures restricted on their associated Hahn decompositions
  have hμ₁ : (j₁.pos_part i).toReal = j₁.to_signed_measure (i ∩ Sᶜ) :=
    by
    rw [to_signed_measure, to_signed_measure_sub_apply (hi.inter hS₁.compl),
      show j₁.neg_part (i ∩ Sᶜ) = 0 from
        nonpos_iff_eq_zero.1 (hS₅ ▸ measure_mono (Set.inter_subset_right _ _)),
      ENNReal.zero_toReal, sub_zero]
    conv_lhs => rw [← Set.inter_union_compl i S]
    rw [measure_union,
      show j₁.pos_part (i ∩ S) = 0 from
        nonpos_iff_eq_zero.1 (hS₄ ▸ measure_mono (Set.inter_subset_right _ _)),
      zero_add]
    ·
      refine'
        Set.disjoint_of_subset_left (Set.inter_subset_right _ _)
          (Set.disjoint_of_subset_right (Set.inter_subset_right _ _) disjoint_compl_right)
    · exact hi.inter hS₁.compl
  have hμ₂ : (j₂.pos_part i).toReal = j₂.to_signed_measure (i ∩ Tᶜ) :=
    by
    rw [to_signed_measure, to_signed_measure_sub_apply (hi.inter hT₁.compl),
      show j₂.neg_part (i ∩ Tᶜ) = 0 from
        nonpos_iff_eq_zero.1 (hT₅ ▸ measure_mono (Set.inter_subset_right _ _)),
      ENNReal.zero_toReal, sub_zero]
    conv_lhs => rw [← Set.inter_union_compl i T]
    rw [measure_union,
      show j₂.pos_part (i ∩ T) = 0 from
        nonpos_iff_eq_zero.1 (hT₄ ▸ measure_mono (Set.inter_subset_right _ _)),
      zero_add]
    ·
      exact
        Set.disjoint_of_subset_left (Set.inter_subset_right _ _)
          (Set.disjoint_of_subset_right (Set.inter_subset_right _ _) disjoint_compl_right)
    · exact hi.inter hT₁.compl
  -- since the two signed measures associated with the Jordan decompositions are the same,
  -- and the symmetric difference of the Hahn decompositions have measure zero, the result follows
  rw [← ENNReal.toReal_eq_toReal (measure_ne_top _ _) (measure_ne_top _ _), hμ₁, hμ₂, ← hj]
  exact of_inter_eq_of_symm_diff_eq_zero_positive hS₁.compl hT₁.compl hi hS₃ hT₃ hST₁
  all_goals infer_instance
#align measure_theory.jordan_decomposition.to_signed_measure_injective MeasureTheory.JordanDecomposition.toSignedMeasure_injective

@[simp]
theorem toJordanDecomposition_toSignedMeasure (j : JordanDecomposition α) :
    j.toSignedMeasure.toJordanDecomposition = j :=
  (@toSignedMeasure_injective _ _ j j.toSignedMeasure.toJordanDecomposition (by simp)).symm
#align measure_theory.jordan_decomposition.to_jordan_decomposition_to_signed_measure MeasureTheory.JordanDecomposition.toJordanDecomposition_toSignedMeasure

end JordanDecomposition

namespace SignedMeasure

open JordanDecomposition

/-- `measure_theory.signed_measure.to_jordan_decomposition` and
`measure_theory.jordan_decomposition.to_signed_measure` form a `equiv`. -/
@[simps apply symm_apply]
def toJordanDecompositionEquiv (α : Type _) [MeasurableSpace α] :
    SignedMeasure α ≃ JordanDecomposition α
    where
  toFun := toJordanDecomposition
  invFun := toSignedMeasure
  left_inv := toSignedMeasure_toJordanDecomposition
  right_inv := toJordanDecomposition_toSignedMeasure
#align measure_theory.signed_measure.to_jordan_decomposition_equiv MeasureTheory.SignedMeasure.toJordanDecompositionEquiv

theorem toJordanDecomposition_zero : (0 : SignedMeasure α).toJordanDecomposition = 0 :=
  by
  apply to_signed_measure_injective
  simp [to_signed_measure_zero]
#align measure_theory.signed_measure.to_jordan_decomposition_zero MeasureTheory.SignedMeasure.toJordanDecomposition_zero

theorem toJordanDecomposition_neg (s : SignedMeasure α) :
    (-s).toJordanDecomposition = -s.toJordanDecomposition :=
  by
  apply to_signed_measure_injective
  simp [to_signed_measure_neg]
#align measure_theory.signed_measure.to_jordan_decomposition_neg MeasureTheory.SignedMeasure.toJordanDecomposition_neg

theorem toJordanDecomposition_smul (s : SignedMeasure α) (r : ℝ≥0) :
    (r • s).toJordanDecomposition = r • s.toJordanDecomposition :=
  by
  apply to_signed_measure_injective
  simp [to_signed_measure_smul]
#align measure_theory.signed_measure.to_jordan_decomposition_smul MeasureTheory.SignedMeasure.toJordanDecomposition_smul

private theorem to_jordan_decomposition_smul_real_nonneg (s : SignedMeasure α) (r : ℝ)
    (hr : 0 ≤ r) : (r • s).toJordanDecomposition = r • s.toJordanDecomposition :=
  by
  lift r to ℝ≥0 using hr
  rw [jordan_decomposition.coe_smul, ← to_jordan_decomposition_smul]
  rfl
#align measure_theory.signed_measure.to_jordan_decomposition_smul_real_nonneg measure_theory.signed_measure.to_jordan_decomposition_smul_real_nonneg

theorem toJordanDecomposition_smul_real (s : SignedMeasure α) (r : ℝ) :
    (r • s).toJordanDecomposition = r • s.toJordanDecomposition :=
  by
  by_cases hr : 0 ≤ r
  · exact to_jordan_decomposition_smul_real_nonneg s r hr
  · ext1
    · rw [real_smul_pos_part_neg _ _ (not_le.1 hr),
        show r • s = -(-r • s) by rw [neg_smul, neg_neg], to_jordan_decomposition_neg, neg_pos_part,
        to_jordan_decomposition_smul_real_nonneg, ← smul_neg_part, real_smul_nonneg]
      all_goals exact Left.nonneg_neg_iff.2 (le_of_lt (not_le.1 hr))
    · rw [real_smul_neg_part_neg _ _ (not_le.1 hr),
        show r • s = -(-r • s) by rw [neg_smul, neg_neg], to_jordan_decomposition_neg, neg_neg_part,
        to_jordan_decomposition_smul_real_nonneg, ← smul_pos_part, real_smul_nonneg]
      all_goals exact Left.nonneg_neg_iff.2 (le_of_lt (not_le.1 hr))
#align measure_theory.signed_measure.to_jordan_decomposition_smul_real MeasureTheory.SignedMeasure.toJordanDecomposition_smul_real

theorem toJordanDecomposition_eq {s : SignedMeasure α} {j : JordanDecomposition α}
    (h : s = j.toSignedMeasure) : s.toJordanDecomposition = j := by
  rw [h, to_jordan_decomposition_to_signed_measure]
#align measure_theory.signed_measure.to_jordan_decomposition_eq MeasureTheory.SignedMeasure.toJordanDecomposition_eq

/-- The total variation of a signed measure. -/
def totalVariation (s : SignedMeasure α) : Measure α :=
  s.toJordanDecomposition.posPart + s.toJordanDecomposition.negPart
#align measure_theory.signed_measure.total_variation MeasureTheory.SignedMeasure.totalVariation

theorem totalVariation_zero : (0 : SignedMeasure α).totalVariation = 0 := by
  simp [total_variation, to_jordan_decomposition_zero]
#align measure_theory.signed_measure.total_variation_zero MeasureTheory.SignedMeasure.totalVariation_zero

theorem totalVariation_neg (s : SignedMeasure α) : (-s).totalVariation = s.totalVariation := by
  simp [total_variation, to_jordan_decomposition_neg, add_comm]
#align measure_theory.signed_measure.total_variation_neg MeasureTheory.SignedMeasure.totalVariation_neg

theorem null_of_totalVariation_zero (s : SignedMeasure α) {i : Set α}
    (hs : s.totalVariation i = 0) : s i = 0 :=
  by
  rw [total_variation, measure.coe_add, Pi.add_apply, add_eq_zero_iff] at hs
  rw [← to_signed_measure_to_jordan_decomposition s, to_signed_measure, vector_measure.coe_sub,
    Pi.sub_apply, measure.to_signed_measure_apply, measure.to_signed_measure_apply]
  by_cases hi : MeasurableSet i
  · rw [if_pos hi, if_pos hi]
    simp [hs.1, hs.2]
  · simp [if_neg hi]
#align measure_theory.signed_measure.null_of_total_variation_zero MeasureTheory.SignedMeasure.null_of_totalVariation_zero

theorem absolutelyContinuous_eNNReal_iff (s : SignedMeasure α) (μ : VectorMeasure α ℝ≥0∞) :
    s ≪ᵥ μ ↔ s.totalVariation ≪ μ.ennrealToMeasure :=
  by
  constructor <;> intro h
  · refine' measure.absolutely_continuous.mk fun S hS₁ hS₂ => _
    obtain ⟨i, hi₁, hi₂, hi₃, hpos, hneg⟩ := s.to_jordan_decomposition_spec
    rw [total_variation, measure.add_apply, hpos, hneg, to_measure_of_zero_le_apply _ _ _ hS₁,
      to_measure_of_le_zero_apply _ _ _ hS₁]
    rw [← vector_measure.absolutely_continuous.ennreal_to_measure] at h
    simp [h (measure_mono_null (i.inter_subset_right S) hS₂),
      h (measure_mono_null (iᶜ.inter_subset_right S) hS₂)]
  · refine' vector_measure.absolutely_continuous.mk fun S hS₁ hS₂ => _
    rw [← vector_measure.ennreal_to_measure_apply hS₁] at hS₂
    exact null_of_total_variation_zero s (h hS₂)
#align measure_theory.signed_measure.absolutely_continuous_ennreal_iff MeasureTheory.SignedMeasure.absolutelyContinuous_eNNReal_iff

theorem totalVariation_absolutelyContinuous_iff (s : SignedMeasure α) (μ : Measure α) :
    s.totalVariation ≪ μ ↔
      s.toJordanDecomposition.posPart ≪ μ ∧ s.toJordanDecomposition.negPart ≪ μ :=
  by
  constructor <;> intro h
  · constructor
    all_goals
      refine' measure.absolutely_continuous.mk fun S hS₁ hS₂ => _
      have := h hS₂
      rw [total_variation, measure.add_apply, add_eq_zero_iff] at this
    exacts[this.1, this.2]
  · refine' measure.absolutely_continuous.mk fun S hS₁ hS₂ => _
    rw [total_variation, measure.add_apply, h.1 hS₂, h.2 hS₂, add_zero]
#align measure_theory.signed_measure.total_variation_absolutely_continuous_iff MeasureTheory.SignedMeasure.totalVariation_absolutelyContinuous_iff

-- TODO: Generalize to vector measures once total variation on vector measures is defined
theorem mutuallySingular_iff (s t : SignedMeasure α) :
    s ⟂ᵥ t ↔ s.totalVariation ⟂ₘ t.totalVariation :=
  by
  constructor
  · rintro ⟨u, hmeas, hu₁, hu₂⟩
    obtain ⟨i, hi₁, hi₂, hi₃, hipos, hineg⟩ := s.to_jordan_decomposition_spec
    obtain ⟨j, hj₁, hj₂, hj₃, hjpos, hjneg⟩ := t.to_jordan_decomposition_spec
    refine' ⟨u, hmeas, _, _⟩
    · rw [total_variation, measure.add_apply, hipos, hineg, to_measure_of_zero_le_apply _ _ _ hmeas,
        to_measure_of_le_zero_apply _ _ _ hmeas]
      simp [hu₁ _ (Set.inter_subset_right _ _)]
    · rw [total_variation, measure.add_apply, hjpos, hjneg,
        to_measure_of_zero_le_apply _ _ _ hmeas.compl,
        to_measure_of_le_zero_apply _ _ _ hmeas.compl]
      simp [hu₂ _ (Set.inter_subset_right _ _)]
  · rintro ⟨u, hmeas, hu₁, hu₂⟩
    exact
      ⟨u, hmeas, fun t htu => null_of_total_variation_zero _ (measure_mono_null htu hu₁),
        fun t htv => null_of_total_variation_zero _ (measure_mono_null htv hu₂)⟩
#align measure_theory.signed_measure.mutually_singular_iff MeasureTheory.SignedMeasure.mutuallySingular_iff

theorem mutuallySingular_eNNReal_iff (s : SignedMeasure α) (μ : VectorMeasure α ℝ≥0∞) :
    s ⟂ᵥ μ ↔ s.totalVariation ⟂ₘ μ.ennrealToMeasure :=
  by
  constructor
  · rintro ⟨u, hmeas, hu₁, hu₂⟩
    obtain ⟨i, hi₁, hi₂, hi₃, hpos, hneg⟩ := s.to_jordan_decomposition_spec
    refine' ⟨u, hmeas, _, _⟩
    · rw [total_variation, measure.add_apply, hpos, hneg, to_measure_of_zero_le_apply _ _ _ hmeas,
        to_measure_of_le_zero_apply _ _ _ hmeas]
      simp [hu₁ _ (Set.inter_subset_right _ _)]
    · rw [vector_measure.ennreal_to_measure_apply hmeas.compl]
      exact hu₂ _ (Set.Subset.refl _)
  · rintro ⟨u, hmeas, hu₁, hu₂⟩
    refine'
      vector_measure.mutually_singular.mk u hmeas
        (fun t htu _ => null_of_total_variation_zero _ (measure_mono_null htu hu₁)) fun t htv hmt =>
        _
    rw [← vector_measure.ennreal_to_measure_apply hmt]
    exact measure_mono_null htv hu₂
#align measure_theory.signed_measure.mutually_singular_ennreal_iff MeasureTheory.SignedMeasure.mutuallySingular_eNNReal_iff

theorem totalVariation_mutuallySingular_iff (s : SignedMeasure α) (μ : Measure α) :
    s.totalVariation ⟂ₘ μ ↔
      s.toJordanDecomposition.posPart ⟂ₘ μ ∧ s.toJordanDecomposition.negPart ⟂ₘ μ :=
  Measure.MutuallySingular.add_left_iff
#align measure_theory.signed_measure.total_variation_mutually_singular_iff MeasureTheory.SignedMeasure.totalVariation_mutuallySingular_iff

end SignedMeasure

end MeasureTheory


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.int.basic
import data.nat.cast
import tactic.pi_instances

/-!
# Cast of integers (additional theorems)

This file proves additional properties about the *canonical* homomorphism from
the integers into an additive group with a one (`int.cast`).

## Main declarations

* `cast_add_hom`: `cast` bundled as an `add_monoid_hom`.
* `cast_ring_hom`: `cast` bundled as a `ring_hom`.
-/

open nat

namespace int

/-- Coercion `ℕ → ℤ` as a `ring_hom`. -/
def of_nat_hom : ℕ →+* ℤ := ⟨coe, rfl, int.of_nat_mul, rfl, int.of_nat_add⟩

section cast
variables {α : Type*}

@[simp, norm_cast] theorem cast_mul [non_assoc_ring α] : ∀ m n, ((m * n : ℤ) : α) = m * n :=
λ m, int.induction_on' m 0 (by simp) (λ k _ ih n, by simp [add_mul, ih])
  (λ k _ ih n, by simp [sub_mul, ih])

@[simp, norm_cast] theorem cast_ite [add_group_with_one α] (P : Prop) [decidable P] (m n : ℤ) :
  ((ite P m n : ℤ) : α) = ite P m n :=
apply_ite _ _ _ _

/-- `coe : ℤ → α` as an `add_monoid_hom`. -/
def cast_add_hom (α : Type*) [add_group_with_one α] : ℤ →+ α := ⟨coe, cast_zero, cast_add⟩

@[simp] lemma coe_cast_add_hom [add_group_with_one α] : ⇑(cast_add_hom α) = coe := rfl

/-- `coe : ℤ → α` as a `ring_hom`. -/
def cast_ring_hom (α : Type*) [non_assoc_ring α] : ℤ →+* α :=
⟨coe, cast_one, cast_mul, cast_zero, cast_add⟩

@[simp] lemma coe_cast_ring_hom [non_assoc_ring α] : ⇑(cast_ring_hom α) = coe := rfl

lemma cast_commute [non_assoc_ring α] : ∀ (m : ℤ) (x : α), commute ↑m x
| (n : ℕ) x := by simpa using n.cast_commute x
| -[1+ n] x := by simpa only [cast_neg_succ_of_nat, commute.neg_left_iff, commute.neg_right_iff]
  using (n + 1).cast_commute (-x)

lemma cast_comm [non_assoc_ring α] (m : ℤ) (x : α) : (m : α) * x = x * m :=
(cast_commute m x).eq

lemma commute_cast [non_assoc_ring α] (x : α) (m : ℤ) : commute x m :=
(m.cast_commute x).symm

theorem cast_mono [ordered_ring α] : monotone (coe : ℤ → α) :=
begin
  intros m n h,
  rw ← sub_nonneg at h,
  lift n - m to ℕ using h with k,
  rw [← sub_nonneg, ← cast_sub, ← h_1, cast_coe_nat],
  exact k.cast_nonneg
end

@[simp] theorem cast_nonneg [ordered_ring α] [nontrivial α] : ∀ {n : ℤ}, (0 : α) ≤ n ↔ 0 ≤ n
| (n : ℕ) := by simp
| -[1+ n] := have -(n:α) < 1, from lt_of_le_of_lt (by simp) zero_lt_one,
             by simpa [(neg_succ_lt_zero n).not_le, ← sub_eq_add_neg, le_neg] using this.not_le

@[simp, norm_cast] theorem cast_le [ordered_ring α] [nontrivial α] {m n : ℤ} :
  (m : α) ≤ n ↔ m ≤ n :=
by rw [← sub_nonneg, ← cast_sub, cast_nonneg, sub_nonneg]

theorem cast_strict_mono [ordered_ring α] [nontrivial α] : strict_mono (coe : ℤ → α) :=
strict_mono_of_le_iff_le $ λ m n, cast_le.symm

@[simp, norm_cast] theorem cast_lt [ordered_ring α] [nontrivial α] {m n : ℤ} :
  (m : α) < n ↔ m < n :=
cast_strict_mono.lt_iff_lt

@[simp] theorem cast_nonpos [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) ≤ 0 ↔ n ≤ 0 :=
by rw [← cast_zero, cast_le]

@[simp] theorem cast_pos [ordered_ring α] [nontrivial α] {n : ℤ} : (0 : α) < n ↔ 0 < n :=
by rw [← cast_zero, cast_lt]

@[simp] theorem cast_lt_zero [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) < 0 ↔ n < 0 :=
by rw [← cast_zero, cast_lt]

section linear_ordered_ring

variables [linear_ordered_ring α] {a b : ℤ} (n : ℤ)

@[simp, norm_cast] theorem cast_min : (↑(min a b) : α) = min a b :=
monotone.map_min cast_mono

@[simp, norm_cast] theorem cast_max : (↑(max a b) : α) = max a b :=
monotone.map_max cast_mono

@[simp, norm_cast] theorem cast_abs : ((|a| : ℤ) : α) = |a| :=
by simp [abs_eq_max_neg]

lemma cast_one_le_of_pos (h : 0 < a) : (1 : α) ≤ a :=
by exact_mod_cast int.add_one_le_of_lt h

lemma cast_le_neg_one_of_neg (h : a < 0) : (a : α) ≤ -1 :=
begin
  rw [← int.cast_one, ← int.cast_neg, cast_le],
  exact int.le_sub_one_of_lt h,
end

lemma nneg_mul_add_sq_of_abs_le_one {x : α} (hx : |x| ≤ 1) :
  (0 : α) ≤ n * x + n * n :=
begin
  have hnx : 0 < n → 0 ≤ x + n := λ hn, by
  { convert add_le_add (neg_le_of_abs_le hx) (cast_one_le_of_pos hn),
    rw add_left_neg, },
  have hnx' : n < 0 → x + n ≤ 0 := λ hn, by
  { convert add_le_add (le_of_abs_le hx) (cast_le_neg_one_of_neg hn),
    rw add_right_neg, },
  rw [← mul_add, mul_nonneg_iff],
  rcases lt_trichotomy n 0 with h | rfl | h,
  { exact or.inr ⟨by exact_mod_cast h.le, hnx' h⟩, },
  { simp [le_total 0 x], },
  { exact or.inl ⟨by exact_mod_cast h.le, hnx h⟩, },
end

lemma cast_nat_abs : (n.nat_abs : α) = |n| :=
begin
  cases n,
  { simp, },
  { simp only [int.nat_abs, int.cast_neg_succ_of_nat, abs_neg, ← nat.cast_succ, nat.abs_cast], },
end

end linear_ordered_ring

lemma coe_int_dvd [comm_ring α] (m n : ℤ) (h : m ∣ n) :
  (m : α) ∣ (n : α) :=
ring_hom.map_dvd (int.cast_ring_hom α) h

end cast

end int

namespace prod

variables {α : Type*} {β : Type*} [add_group_with_one α] [add_group_with_one β]

instance : add_group_with_one (α × β) :=
{ int_cast := λ n, (n, n),
  int_cast_of_nat := λ _, by simp; refl,
  int_cast_neg_succ_of_nat := λ _, by simp; refl,
  .. prod.add_monoid_with_one, .. prod.add_group }

@[simp] lemma fst_int_cast (n : ℤ) : (n : α × β).fst = n := rfl

@[simp] lemma snd_int_cast (n : ℤ) : (n : α × β).snd = n := rfl

end prod

open int

namespace add_monoid_hom

variables {A : Type*}

/-- Two additive monoid homomorphisms `f`, `g` from `ℤ` to an additive monoid are equal
if `f 1 = g 1`. -/
@[ext] theorem ext_int [add_monoid A] {f g : ℤ →+ A} (h1 : f 1 = g 1) : f = g :=
have f.comp (int.of_nat_hom : ℕ →+ ℤ) = g.comp (int.of_nat_hom : ℕ →+ ℤ) := ext_nat' _ _ h1,
have ∀ n : ℕ, f n = g n := ext_iff.1 this,
ext $ λ n, int.cases_on n this $ λ n, eq_on_neg (this $ n + 1)

variables [add_group_with_one A]

theorem eq_int_cast_hom (f : ℤ →+ A) (h1 : f 1 = 1) : f = int.cast_add_hom A :=
ext_int $ by simp [h1]

theorem eq_int_cast (f : ℤ →+ A) (h1 : f 1 = 1) : ∀ n : ℤ, f n = n :=
ext_iff.1 (f.eq_int_cast_hom h1)

end add_monoid_hom

@[simp] lemma int.cast_add_hom_int : int.cast_add_hom ℤ = add_monoid_hom.id ℤ :=
((add_monoid_hom.id ℤ).eq_int_cast_hom rfl).symm

namespace monoid_hom
variables {M : Type*} [monoid M]
open multiplicative

@[ext] theorem ext_mint {f g : multiplicative ℤ →* M} (h1 : f (of_add 1) = g (of_add 1)) : f = g :=
monoid_hom.ext $ add_monoid_hom.ext_iff.mp $
  @add_monoid_hom.ext_int _ _ f.to_additive g.to_additive h1

/-- If two `monoid_hom`s agree on `-1` and the naturals then they are equal. -/
@[ext] theorem ext_int {f g : ℤ →* M}
  (h_neg_one : f (-1) = g (-1))
  (h_nat : f.comp int.of_nat_hom.to_monoid_hom = g.comp int.of_nat_hom.to_monoid_hom) :
  f = g :=
begin
  ext (x | x),
  { exact (monoid_hom.congr_fun h_nat x : _), },
  { rw [int.neg_succ_of_nat_eq, ← neg_one_mul, f.map_mul, g.map_mul],
    congr' 1,
    exact_mod_cast (monoid_hom.congr_fun h_nat (x + 1) : _), }
end

end monoid_hom

namespace monoid_with_zero_hom

variables {M : Type*} [monoid_with_zero M]

/-- If two `monoid_with_zero_hom`s agree on `-1` and the naturals then they are equal. -/
@[ext] lemma ext_int {f g : ℤ →*₀ M} (h_neg_one : f (-1) = g (-1))
  (h_nat : f.comp int.of_nat_hom.to_monoid_with_zero_hom =
           g.comp int.of_nat_hom.to_monoid_with_zero_hom) :
  f = g :=
to_monoid_hom_injective $ monoid_hom.ext_int h_neg_one $ monoid_hom.ext (congr_fun h_nat : _)

/-- If two `monoid_with_zero_hom`s agree on `-1` and the _positive_ naturals then they are equal. -/
lemma ext_int' {φ₁ φ₂ : ℤ →*₀ M} (h_neg_one : φ₁ (-1) = φ₂ (-1))
  (h_pos : ∀ n : ℕ, 0 < n → φ₁ n = φ₂ n) : φ₁ = φ₂ :=
ext_int h_neg_one $ ext_nat h_pos

end monoid_with_zero_hom

namespace ring_hom

variables {α : Type*} {β : Type*} [non_assoc_ring α] [non_assoc_ring β]

@[simp] lemma eq_int_cast (f : ℤ →+* α) (n : ℤ) : f n  = n :=
f.to_add_monoid_hom.eq_int_cast f.map_one n

lemma eq_int_cast' (f : ℤ →+* α) : f = int.cast_ring_hom α :=
ring_hom.ext f.eq_int_cast

@[simp] lemma map_int_cast (f : α →+* β) (n : ℤ) : f n = n :=
(f.comp (int.cast_ring_hom α)).eq_int_cast n

lemma ext_int {R : Type*} [non_assoc_semiring R] (f g : ℤ →+* R) : f = g :=
coe_add_monoid_hom_injective $ add_monoid_hom.ext_int $ f.map_one.trans g.map_one.symm

instance int.subsingleton_ring_hom {R : Type*} [non_assoc_semiring R] : subsingleton (ℤ →+* R) :=
⟨ring_hom.ext_int⟩

end ring_hom

@[simp, norm_cast] theorem int.cast_id (n : ℤ) : ↑n = n :=
((ring_hom.id ℤ).eq_int_cast n).symm

@[simp] lemma int.cast_ring_hom_int : int.cast_ring_hom ℤ = ring_hom.id ℤ :=
(ring_hom.id ℤ).eq_int_cast'.symm

namespace pi
variables {α : Type*} {β : α → Type*} [∀ a, has_int_cast (β a)]

instance : has_int_cast (∀ a, β a) :=
by refine_struct { .. }; tactic.pi_instance_derive_field

lemma int_apply (n : ℤ) (a : α) : (n : ∀ a, β a) a = n := rfl

@[simp] lemma coe_int (n : ℤ) : (n : ∀ a, β a) = λ _, n := rfl

end pi

namespace pi
variables {α : Type*} {β : α → Type*} [∀ a, add_group_with_one (β a)]

instance : add_group_with_one (∀ a, β a) :=
by refine_struct { .. }; tactic.pi_instance_derive_field

end pi

namespace mul_opposite

variables {α : Type*} [add_group_with_one α]

@[simp, norm_cast] lemma op_int_cast (z : ℤ) : op (z : α) = z := rfl

@[simp, norm_cast] lemma unop_int_cast (n : ℤ) : unop (n : αᵐᵒᵖ) = n := rfl

end mul_opposite


--

#print "---- h1"

def h1 (b : Bool) : Nat :=
match b with
| true  => 0
| false => 10

#eval h1 false

#print "---- h2"

def h2 (x : List Nat) : Nat :=
match x with
| [x1, x2] => x1 + x2
| x::xs    => x
| _        => 0

#eval h2 [1, 2]
#eval h2 [10, 4, 5]
#eval h2 []

#print "---- h3"

def h3 (x : Array Nat) : Nat :=
match x with
| #[x]    => x
| #[x, y] => x + y
| xs      => xs.size

#eval h3 #[10]
#eval h3 #[10, 20]
#eval h3 #[10, 20, 30, 40]

#print "---- inv"

inductive Image {α β : Type} (f : α → β) : β → Type
| mk (a : α) : Image f (f a)

def mkImage {α β : Type} (f : α → β) (a : α) : Image f (f a) :=
Image.mk a

def inv {α β : Type} {f : α → β} {b : β} (t : Image f b) : α :=
match b, t with
| _, Image.mk a => a

#eval inv (mkImage Nat.succ 10)

theorem foo {p q} (h : p ∨ q) : q ∨ p :=
match h with
| Or.inl h => Or.inr h
| Or.inr h => Or.inl h

def f (x : Nat × Nat) : Bool × Bool × Bool → Nat :=
match x with
| (a, b) => fun _ => a

structure S :=
(x y z : Nat := 0)

def f1 : S → S :=
fun { x := x, ..} => { y := x }

theorem ex2 : f1 { x := 10 } = { y := 10 } :=
rfl

universe u

inductive Vec (α : Type u) : Nat → Type u
| nil : Vec α 0
| cons {n} (head : α) (tail : Vec α n) : Vec α (n+1)

inductive VecPred {α : Type u} (P : α → Prop) : {n : Nat} → Vec α n → Prop
| nil   : VecPred P Vec.nil
| cons  {n : Nat} {head : α} {tail : Vec α n} : P head → VecPred P tail → VecPred P (Vec.cons head tail)

theorem ex3 {α : Type u} (P : α → Prop) : {n : Nat} → (v : Vec α (n+1)) → VecPred P v → Exists P
| _, Vec.cons head _, VecPred.cons h _ => ⟨head, h⟩

theorem ex4 {α : Type u} (P : α → Prop) : {n : Nat} → (v : Vec α (n+1)) → VecPred P v → Exists P
| _, Vec.cons head _, VecPred.cons h (w : VecPred P Vec.nil) => ⟨head, h⟩  -- ERROR

axiom someNat : Nat

noncomputable def f2 (x : Nat) := -- must mark as noncomputable since it uses axiom `someNat`
x + someNat

inductive Parity : Nat -> Type
| even (n) : Parity (n + n)
| odd  (n) : Parity (Nat.succ (n + n))

axiom nDiv2 (n : Nat)     : n % 2 = 0 → n = n/2 + n/2
axiom nDiv2Succ (n : Nat) : n % 2 ≠ 0 → n = Nat.succ (n/2 + n/2)

def parity (n : Nat) : Parity n :=
if h : n % 2 = 0 then
  Eq.ndrec (Parity.even (n/2)) (nDiv2 n h).symm
else
  Eq.ndrec (Parity.odd (n/2)) (nDiv2Succ n h).symm

partial def natToBin : (n : Nat) → List Bool
| 0 => []
| n => match n, parity n with
  | _, Parity.even j => false :: natToBin j
  | _, Parity.odd  j => true  :: natToBin j

#eval natToBin 6

partial def natToBin' : (n : Nat) → List Bool
| 0 => []
| n => match parity n with
  | Parity.even j => false :: natToBin j
  | Parity.odd  j => true  :: natToBin j

partial def natToBinBad (n : Nat) : List Bool :=
match n, parity n with
| 0, _             => []
| _, Parity.even j => false :: natToBin j
| _, Parity.odd  j => true  :: natToBin j

partial def natToBin2 (n : Nat) : List Bool :=
match n, parity n with
| _, Parity.even 0 => []
| _, Parity.even j => false :: natToBin j
| _, Parity.odd  j => true  :: natToBin j

#eval natToBin2 6

partial def natToBin2' (n : Nat) : List Bool :=
match parity n with
| Parity.even 0 => []
| Parity.even j => false :: natToBin j
| Parity.odd  j => true  :: natToBin j

#check fun (a, b) => a -- Error type of pattern variable contains metavariables

#check fun (a, b) => (a:Nat) + b

#check fun (a, b) => a && b

#check fun ((a : Nat), (b : Nat)) => a + b

#check fun
  | some a, some b => some (a + b : Nat)
  | _,      _      => none

-- overapplied matcher
#check fun x => (match x with | 0 => id | x+1 => id) x

#check fun
  | #[1, 2]    => 2
  | #[]        => 0
  | #[3, 4, 5] => 3
  | _          => 4

-- underapplied matcher
def g {α} : List α → Nat
  | [a] => 1
  | _   => 0

#check g.match_1

#check fun (e : Empty) => (nomatch e : False)


/-
Copyright (c) 2018 Louis Carlin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Louis Carlin, Mario Carneiro
-/
import algebra.euclidean_domain.defs
import algebra.ring.divisibility
import algebra.ring.regular
import algebra.group_with_zero.divisibility
import algebra.ring.basic

/-!
# Lemmas about Euclidean domains

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

## Main statements

* `gcd_eq_gcd_ab`: states Bézout's lemma for Euclidean domains.

-/

universe u

namespace euclidean_domain
variable {R : Type u}
variables [euclidean_domain R]

local infix ` ≺ `:50 := euclidean_domain.r

lemma mul_div_cancel_left {a : R} (b) (a0 : a ≠ 0) : a * b / a = b :=
eq.symm $ eq_of_sub_eq_zero $ classical.by_contradiction $ λ h,
begin
  have := mul_left_not_lt a h,
  rw [mul_sub, sub_eq_iff_eq_add'.2 (div_add_mod (a*b) a).symm] at this,
  exact this (mod_lt _ a0)
end

lemma mul_div_cancel (a) {b : R} (b0 : b ≠ 0) : a * b / b = a :=
by { rw mul_comm, exact mul_div_cancel_left a b0 }

@[simp] lemma mod_eq_zero {a b : R} : a % b = 0 ↔ b ∣ a :=
⟨λ h, by { rw [← div_add_mod a b, h, add_zero], exact dvd_mul_right _ _ },
 λ ⟨c, e⟩, begin
  rw [e, ← add_left_cancel_iff, div_add_mod, add_zero],
  haveI := classical.dec,
  by_cases b0 : b = 0,
  { simp only [b0, zero_mul] },
  { rw [mul_div_cancel_left _ b0] }
 end⟩

@[simp] lemma mod_self (a : R) : a % a = 0 :=
mod_eq_zero.2 dvd_rfl

lemma dvd_mod_iff {a b c : R} (h : c ∣ b) : c ∣ a % b ↔ c ∣ a :=
by rw [dvd_add_iff_right (h.mul_right _), div_add_mod]

@[simp] lemma mod_one (a : R) : a % 1 = 0 :=
mod_eq_zero.2 (one_dvd _)

@[simp] lemma zero_mod (b : R) : 0 % b = 0 :=
mod_eq_zero.2 (dvd_zero _)

@[simp, priority 900] lemma zero_div {a : R} : 0 / a = 0 :=
classical.by_cases
  (λ a0 : a = 0, a0.symm ▸ div_zero 0)
  (λ a0, by simpa only [zero_mul] using mul_div_cancel 0 a0)

@[simp, priority 900] lemma div_self {a : R} (a0 : a ≠ 0) : a / a = 1 :=
by simpa only [one_mul] using mul_div_cancel 1 a0

lemma eq_div_of_mul_eq_left {a b c : R} (hb : b ≠ 0) (h : a * b = c) : a = c / b :=
by rw [← h, mul_div_cancel _ hb]

lemma eq_div_of_mul_eq_right {a b c : R} (ha : a ≠ 0) (h : a * b = c) : b = c / a :=
by rw [← h, mul_div_cancel_left _ ha]

theorem mul_div_assoc (x : R) {y z : R} (h : z ∣ y) : x * y / z = x * (y / z) :=
begin
  classical, by_cases hz : z = 0,
  { subst hz, rw [div_zero, div_zero, mul_zero] },
  rcases h with ⟨p, rfl⟩,
  rw [mul_div_cancel_left _ hz, mul_left_comm, mul_div_cancel_left _ hz]
end

@[simp, priority 900] -- This generalizes `int.div_one`, see note [simp-normal form]
lemma div_one (p : R) : p / 1 = p :=
(euclidean_domain.eq_div_of_mul_eq_left (one_ne_zero' R) (mul_one p)).symm

lemma div_dvd_of_dvd {p q : R} (hpq : q ∣ p) :
  p / q ∣ p :=
begin
  by_cases hq : q = 0,
  { rw [hq, zero_dvd_iff] at hpq,
    rw hpq,
    exact dvd_zero _ },
  use q,
  rw [mul_comm, ← euclidean_domain.mul_div_assoc _ hpq, mul_comm,
      euclidean_domain.mul_div_cancel _ hq]
end

lemma dvd_div_of_mul_dvd {a b c : R} (h : a * b ∣ c) : b ∣ c / a :=
begin
  rcases eq_or_ne a 0 with rfl | ha,
  { simp only [div_zero, dvd_zero] },
  rcases h with ⟨d, rfl⟩,
  refine ⟨d, _⟩,
  rw [mul_assoc, mul_div_cancel_left _ ha]
end

section gcd
variable [decidable_eq R]

@[simp] theorem gcd_zero_right (a : R) : gcd a 0 = a :=
by { rw gcd, split_ifs; simp only [h, zero_mod, gcd_zero_left] }

theorem gcd_val (a b : R) : gcd a b = gcd (b % a) a :=
by { rw gcd, split_ifs; [simp only [h, mod_zero, gcd_zero_right], refl]}

theorem gcd_dvd (a b : R) : gcd a b ∣ a ∧ gcd a b ∣ b :=
gcd.induction a b
  (λ b, by { rw gcd_zero_left, exact ⟨dvd_zero _, dvd_rfl⟩ })
  (λ a b aneq ⟨IH₁, IH₂⟩, by { rw gcd_val,
    exact ⟨IH₂, (dvd_mod_iff IH₂).1 IH₁⟩ })

theorem gcd_dvd_left (a b : R) : gcd a b ∣ a := (gcd_dvd a b).left

theorem gcd_dvd_right (a b : R) : gcd a b ∣ b := (gcd_dvd a b).right

protected theorem gcd_eq_zero_iff {a b : R} :
  gcd a b = 0 ↔ a = 0 ∧ b = 0 :=
⟨λ h, by simpa [h] using gcd_dvd a b,
 by { rintro ⟨rfl, rfl⟩, exact gcd_zero_right _ }⟩

theorem dvd_gcd {a b c : R} : c ∣ a → c ∣ b → c ∣ gcd a b :=
gcd.induction a b
  (λ _ _ H, by simpa only [gcd_zero_left] using H)
  (λ a b a0 IH ca cb, by { rw gcd_val,
    exact IH ((dvd_mod_iff ca).2 cb) ca })

theorem gcd_eq_left {a b : R} : gcd a b = a ↔ a ∣ b :=
⟨λ h, by {rw ← h, apply gcd_dvd_right },
 λ h, by rw [gcd_val, mod_eq_zero.2 h, gcd_zero_left]⟩

@[simp]

@[simp] theorem gcd_self (a : R) : gcd a a = a :=
gcd_eq_left.2 dvd_rfl

@[simp] theorem xgcd_aux_fst (x y : R) : ∀ s t s' t',
  (xgcd_aux x s t y s' t').1 = gcd x y :=
gcd.induction x y (by { intros, rw [xgcd_zero_left, gcd_zero_left] })
(λ x y h IH s t s' t', by { simp only [xgcd_aux_rec h, if_neg h, IH], rw ← gcd_val })

theorem xgcd_aux_val (x y : R) : xgcd_aux x 1 0 y 0 1 = (gcd x y, xgcd x y) :=
by rw [xgcd, ← xgcd_aux_fst x y 1 0 0 1, prod.mk.eta]

private def P (a b : R) : R × R × R → Prop | (r, s, t) := (r : R) = a * s + b * t

theorem xgcd_aux_P (a b : R) {r r' : R} : ∀ {s t s' t'}, P a b (r, s, t) →
  P a b (r', s', t') → P a b (xgcd_aux r s t r' s' t') :=
gcd.induction r r' (by { intros, simpa only [xgcd_zero_left] }) $ λ x y h IH s t s' t' p p', begin
  rw [xgcd_aux_rec h], refine IH _ p, unfold P at p p' ⊢,
  rw [mul_sub, mul_sub, add_sub, sub_add_eq_add_sub, ← p', sub_sub,
    mul_comm _ s, ← mul_assoc, mul_comm _ t, ← mul_assoc, ← add_mul, ← p,
    mod_eq_sub_mul_div]
end

/-- An explicit version of **Bézout's lemma** for Euclidean domains. -/
theorem gcd_eq_gcd_ab (a b : R) : (gcd a b : R) = a * gcd_a a b + b * gcd_b a b :=
by { have := @xgcd_aux_P _ _ _ a b a b 1 0 0 1
  (by rw [P, mul_one, mul_zero, add_zero]) (by rw [P, mul_one, mul_zero, zero_add]),
rwa [xgcd_aux_val, xgcd_val] at this }

@[priority 70] -- see Note [lower instance priority]
instance (R : Type*) [e : euclidean_domain R] : no_zero_divisors R :=
by { haveI := classical.dec_eq R, exact
{ eq_zero_or_eq_zero_of_mul_eq_zero :=
    λ a b h, (or_iff_not_and_not.2 $ λ h0,
      h0.1 $ by rw [← mul_div_cancel a h0.2, h, zero_div]) }}

@[priority 70] -- see Note [lower instance priority]
instance (R : Type*) [e : euclidean_domain R] : is_domain R :=
{ .. e, .. no_zero_divisors.to_is_domain R }

end gcd

section lcm
variables [decidable_eq R]

theorem dvd_lcm_left (x y : R) : x ∣ lcm x y :=
classical.by_cases
  (assume hxy : gcd x y = 0, by { rw [lcm, hxy, div_zero], exact dvd_zero _ })
  (λ hxy, let ⟨z, hz⟩ := (gcd_dvd x y).2 in ⟨z, eq.symm $ eq_div_of_mul_eq_left hxy $
    by rw [mul_right_comm, mul_assoc, ← hz]⟩)

theorem dvd_lcm_right (x y : R) : y ∣ lcm x y :=
classical.by_cases
  (assume hxy : gcd x y = 0, by { rw [lcm, hxy, div_zero], exact dvd_zero _ })
  (λ hxy, let ⟨z, hz⟩ := (gcd_dvd x y).1 in ⟨z, eq.symm $ eq_div_of_mul_eq_right hxy $
    by rw [← mul_assoc, mul_right_comm, ← hz]⟩)

theorem lcm_dvd {x y z : R} (hxz : x ∣ z) (hyz : y ∣ z) : lcm x y ∣ z :=
begin
  rw lcm, by_cases hxy : gcd x y = 0,
  { rw [hxy, div_zero], rw euclidean_domain.gcd_eq_zero_iff at hxy, rwa hxy.1 at hxz },
  rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩,
  suffices : x * y ∣ z * gcd x y,
  { cases this with p hp, use p,
    generalize_hyp : gcd x y = g at hxy hs hp ⊢, subst hs,
    rw [mul_left_comm, mul_div_cancel_left _ hxy, ← mul_left_inj' hxy, hp],
    rw [← mul_assoc], simp only [mul_right_comm] },
  rw [gcd_eq_gcd_ab, mul_add], apply dvd_add,
  { rw mul_left_comm, exact mul_dvd_mul_left _ (hyz.mul_right _) },
  { rw [mul_left_comm, mul_comm], exact mul_dvd_mul_left _ (hxz.mul_right _) }
end

@[simp] lemma lcm_dvd_iff {x y z : R} : lcm x y ∣ z ↔ x ∣ z ∧ y ∣ z :=
⟨λ hz, ⟨(dvd_lcm_left _ _).trans hz, (dvd_lcm_right _ _).trans hz⟩,
λ ⟨hxz, hyz⟩, lcm_dvd hxz hyz⟩

@[simp] lemma lcm_zero_left (x : R) : lcm 0 x = 0 :=
by rw [lcm, zero_mul, zero_div]

@[simp] lemma lcm_zero_right (x : R) : lcm x 0 = 0 :=
by rw [lcm, mul_zero, zero_div]

@[simp] lemma lcm_eq_zero_iff {x y : R} : lcm x y = 0 ↔ x = 0 ∨ y = 0 :=
begin
  split,
  { intro hxy, rw [lcm, mul_div_assoc _ (gcd_dvd_right _ _), mul_eq_zero] at hxy,
    apply or_of_or_of_imp_right hxy, intro hy,
    by_cases hgxy : gcd x y = 0,
    { rw euclidean_domain.gcd_eq_zero_iff at hgxy, exact hgxy.2 },
    { rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩,
      generalize_hyp : gcd x y = g at hr hs hy hgxy ⊢, subst hs,
      rw [mul_div_cancel_left _ hgxy] at hy, rw [hy, mul_zero] } },
  rintro (hx | hy),
  { rw [hx, lcm_zero_left] },
  { rw [hy, lcm_zero_right] }
end

@[simp] lemma gcd_mul_lcm (x y : R) : gcd x y * lcm x y = x * y :=
begin
  rw lcm, by_cases h : gcd x y = 0,
  { rw [h, zero_mul], rw euclidean_domain.gcd_eq_zero_iff at h, rw [h.1, zero_mul] },
  rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩,
  generalize_hyp : gcd x y = g at h hr ⊢, subst hr,
  rw [mul_assoc, mul_div_cancel_left _ h]
end

end lcm

section div

lemma mul_div_mul_cancel {a b c : R} (ha : a ≠ 0) (hcb : c ∣ b) :
  a * b / (a * c) = b / c :=
begin
  by_cases hc : c = 0, { simp [hc] },
  refine eq_div_of_mul_eq_right hc (mul_left_cancel₀ ha _),
  rw [← mul_assoc, ← mul_div_assoc _ (mul_dvd_mul_left a hcb),
         mul_div_cancel_left _ (mul_ne_zero ha hc)]
end

lemma mul_div_mul_comm_of_dvd_dvd {a b c d : R} (hac : c ∣ a) (hbd : d ∣ b) :
  a * b / (c * d) = a / c * (b / d) :=
begin
  rcases eq_or_ne c 0 with rfl | hc0, { simp },
  rcases eq_or_ne d 0 with rfl | hd0, { simp },
  obtain ⟨k1, rfl⟩ := hac,
  obtain ⟨k2, rfl⟩ := hbd,
  rw [mul_div_cancel_left _ hc0, mul_div_cancel_left _ hd0, mul_mul_mul_comm,
    mul_div_cancel_left _ (mul_ne_zero hc0 hd0)],
end

end div

end euclidean_domain