import Mathlib.Init.Algebra.Order
import Mathlib.Tactic.LibrarySearch
import Mathlib.Data.Vector.Basic

import Diploma.Polynomials.PolynomialCommon
import Diploma.Polynomials.Polynomial

open Vector
open polynomial
open Classical
open Nat

namespace algebra

section monomials_lex_order

private def Order.ble_lex_impl (v₁ v₂ : Vector Nat n): Bool :=
  match v₁, v₂ with
    | ⟨[], _⟩  , ⟨[], _⟩   => true
    | ⟨x::_, _⟩, ⟨y::_, _⟩ => if x == y then ble_lex_impl v₁.tail v₂.tail
                              else x <= y

def Order.lex_impl (v₁ v₂ : Vector Nat n): Prop :=
  match v₁, v₂ with
    | ⟨[], _⟩  , ⟨[], _⟩   => True
    | ⟨x::_, _⟩, ⟨y::_, _⟩ => if x = y then lex_impl v₁.tail v₂.tail
                              else x <= y

def Order.lex (v₁ v₂ : Variables n): Prop := Order.lex_impl v₁ v₂

theorem lex_le_refl : ∀ (a : Variables n), Order.lex a a := by
  intro a
  let rec aux (m: Nat) (v: Variables m) : Order.lex_impl v v := by
    match v with
      | ⟨[], p⟩    => rw [Order.lex_impl]
                      split
                      simp at *
                      simp at p
                      simp at *
      | ⟨x::xs, _⟩ => rw [Order.lex_impl]
                      split
                      simp
                      simp at *
                      simp at *
                      simp [Nat.le_refl]
                      rename_i x₁ _ x₂ _ h₁ h₂
                      have h₃ := Eq.symm h₁.left
                      have h₄ := Eq.symm h₂.left
                      rw [h₃, h₄]
                      simp [Nat.le_refl]
                      apply aux (m-1) (tail ⟨x::xs, _⟩)
  exact aux n a

theorem lex_le_trans : ∀ (a b c : Variables n), Order.lex a b → Order.lex b c → Order.lex a c := by
  intros v₁ v₂ v₃ h₁ h₂
  let rec aux (m: Nat) (a b c: Variables m)
              (ab : Order.lex_impl a b) (bc : Order.lex_impl b c) : Order.lex_impl a c := by
    match a, b, c with
      | ⟨[], p⟩,    ⟨[], q⟩,    ⟨[], l⟩    => rw [Order.lex_impl]
                                              split
                                              simp
                                              simp at *
      | ⟨x::xs, p⟩, ⟨y::ys, q⟩, ⟨z::zs, l⟩ => rw [Order.lex_impl]
                                              rw [Order.lex_impl] at ab bc
                                              split at ab
                                              split at bc
                                              split <;> simp at *
                                              split at bc
                                              split
                                              repeat (first
                                                | rename_i heq₁ heq₂ _ _ _ _ _ _ _ _ heq₃ heq₄ _ _
                                                  rw [heq₂] at heq₃
                                                  simp at heq₃
                                                | split)
                                              split at ab
                                              split at bc
                                              rename_i heq₁ heq₂ _ _ _ _ _ _ heq₃ heq₄
                                              rw [heq₂] at heq₃
                                              simp at heq₃
                                              split at bc
                                              apply aux (m-1) (tail ⟨x::xs, p⟩) (tail ⟨y::ys, q⟩) (tail ⟨z::zs, l⟩) ab bc
                                              simp at *
                                              rename_i eq₁ eq₂ _ _ _ _ _  _ _ _ hneq heq₁ heq₂ heq₃ heq₄
                                              have x_cross_one_eq_x := Eq.symm (heq₁.left)
                                              have y_cross_one_eq_y := Eq.symm (heq₂.left)
                                              have x_cross_eq_x     := Eq.symm (heq₃.left)
                                              have y_cross_eq_x     := Eq.symm (heq₄.left)
                                              rw [x_cross_eq_x, y_cross_eq_x] at hneq
                                              rw [x_cross_one_eq_x, y_cross_one_eq_y] at eq₂
                                              rw [eq₂] at eq₁
                                              contradiction
                                              split at bc
                                              simp at *
                                              repeat (first | rename_i heq₁ heq₂ eq₁ neq₁ _ _ _ _ _ _ _ _ heq₃ heq₄ eq₂
                                                              simp at heq₁ heq₂ heq₃ heq₄
                                                              have x_cross_one_eq_x := Eq.symm (heq₁.left)
                                                              have y_cross_one_eq_y := Eq.symm (heq₂.left)
                                                              have x_cross_eq_x     := Eq.symm (heq₃.left)
                                                              have y_cross_eq_x     := Eq.symm (heq₄.left)
                                                              rw [x_cross_eq_x, y_cross_eq_x] at eq₂
                                                              rw [x_cross_one_eq_x, y_cross_one_eq_y] at neq₁
                                                              rw [eq₂] at neq₁
                                                              contradiction
                                                            | split at bc)
                                              rename_i heq₁ heq₂ eq₁ neq₁ _ _ _ _ _ _ _ _ heq₃ heq₄ neq₂
                                              simp at heq₁ heq₂ heq₃ heq₄
                                              have x_cross_one_eq_x := Eq.symm (heq₁.left)
                                              have y_cross_one_eq_y := Eq.symm (heq₂.left)
                                              have x_cross_eq_x     := Eq.symm (heq₃.left)
                                              have y_cross_eq_x     := Eq.symm (heq₄.left)
                                              rw [x_cross_eq_x, y_cross_eq_x] at neq₂ bc
                                              rw [x_cross_one_eq_x, y_cross_one_eq_y] at neq₁ ab
                                              rw [eq₁] at ab
                                              have eq_eq := Nat.le_antisymm bc ab
                                              contradiction
                                              split at ab
                                              split at bc
                                              simp at *
                                              split at bc
                                              simp at *
                                              rename_i neq₁ eq₁ _ _ _ _ _ _ _ _ eq₂ heq₁ heq₂ heq₃ heq₄
                                              have x_cross_one_eq_x := Eq.symm (heq₁.left)
                                              have y_cross_one_eq_y := Eq.symm (heq₂.left)
                                              have x_cross_eq_x     := Eq.symm (heq₃.left)
                                              have y_cross_eq_x     := Eq.symm (heq₄.left)
                                              rw [x_cross_one_eq_x, y_cross_one_eq_y] at eq₁
                                              rw [x_cross_eq_x, y_cross_eq_x] at eq₂
                                              rw [eq₂] at eq₁
                                              contradiction
                                              repeat (first | simp at *
                                                              rename_i neq₁ eq₁ _ _ _ _ _ _ _ _ eq₂ heq₁ heq₂ heq₃ heq₄
                                                              have x_cross_one_eq_x := Eq.symm (heq₁.left)
                                                              have y_cross_one_eq_y := Eq.symm (heq₂.left)
                                                              have x_cross_eq_x     := Eq.symm (heq₃.left)
                                                              have y_cross_eq_x     := Eq.symm (heq₄.left)
                                                              rw [x_cross_one_eq_x, y_cross_one_eq_y] at eq₁
                                                              rw [x_cross_eq_x, y_cross_eq_x] at bc
                                                              rw [eq₁]
                                                              exact bc
                                                            | split at bc)
                                              simp at *
                                              split at bc <;> (simp at *
                                                               rename_i neq₁ neq₂ _ _ _ _ _ _ _ _ _ heq₁ heq₂ heq₃ heq₄
                                                               have x_cross_one_eq_x := Eq.symm (heq₁.left)
                                                               have y_cross_one_eq_y := Eq.symm (heq₂.left)
                                                               have x_cross_eq_x     := Eq.symm (heq₃.left)
                                                               have y_cross_eq_x     := Eq.symm (heq₄.left))
                                              rename_i eq
                                              rw [x_cross_one_eq_x, y_cross_one_eq_y] at neq₂ ab
                                              rw [x_cross_eq_x, y_cross_eq_x] at eq
                                              rw [eq] at ab
                                              exact ab
                                              rename_i neq₃
                                              rw [x_cross_one_eq_x, y_cross_one_eq_y] at neq₂ ab
                                              rw [x_cross_eq_x, y_cross_eq_x] at neq₃ bc
                                              have le_le := Nat.le_trans ab bc
                                              exact le_le
  exact aux n v₁ v₂ v₃ h₁ h₂

theorem lex_le_antisymm : ∀ (a b : Variables n), Order.lex a b → Order.lex b a → a = b := by
  intros v₁ v₂ h₁ h₂
  let rec aux (m: Nat) (a b: Vector Nat m) (ab: Order.lex_impl a b) (ba: Order.lex_impl b a): a = b := by
    match a, b with
      | ⟨[], p⟩, ⟨[], q⟩       => simp
      | ⟨x::xs, p⟩, ⟨y::ys, q⟩ => rw [Order.lex_impl] at ab ba
                                  simp at *
                                  split at ab
                                  split at ba
                                  rename_i heq₁ heq₂
                                  simp [Vector]
                                  constructor
                                  exact heq₁
                                  have eq := aux (m-1) (tail ⟨x::xs, p⟩) (tail ⟨y::ys, q⟩) ab ba
                                  simp [tail, Vector] at eq
                                  exact eq
                                  rename_i eq neq
                                  have eq_symm := Eq.symm eq
                                  contradiction
                                  split at ba
                                  rename_i neq eq
                                  have eq_symm := Eq.symm eq
                                  contradiction
                                  rename_i neq₁ neq₂
                                  have eq := Nat.le_antisymm ab ba
                                  contradiction
  exact aux n v₁ v₂ h₁ h₂

theorem lex_le_total : ∀ (a b : Variables n), Order.lex a b ∨ Order.lex b a := by
  intros v₁ v₂
  let rec aux (m: Nat) (a b: Vector Nat m) : Order.lex_impl a b ∨ Order.lex_impl b a := by
    match a, b with
      | ⟨[], p⟩, ⟨[], q⟩       => rw [Order.lex_impl]
                                  split
                                  simp
                                  simp at *
      | ⟨x::xs, p⟩, ⟨y::ys, q⟩ => rw [Order.lex_impl]
                                  simp [Or.comm]
                                  rw [Order.lex_impl]
                                  split
                                  simp
                                  split
                                  split
                                  simp [Or.comm]
                                  apply aux (m-1) (tail ⟨x::xs, p⟩) (tail ⟨y::ys, q⟩)
                                  simp at *
                                  rename_i eq neq heq₁ heq₂
                                  have s_eq := Eq.symm eq
                                  have eq_1 := Eq.symm heq₁.left
                                  have eq_2 := Eq.symm heq₂.left
                                  rw [eq_1, eq_2] at s_eq
                                  contradiction
                                  split
                                  simp at *
                                  rename_i neq eq heq₁ heq₂
                                  have s_eq := Eq.symm eq
                                  have eq_1 := heq₁.left
                                  have eq_2 := heq₂.left
                                  rw [eq_1, eq_2] at s_eq
                                  contradiction
                                  simp at *
                                  rename_i heq₁ heq₂
                                  have eq_1 := heq₁.left
                                  have eq_2 := heq₂.left
                                  rw [eq_1, eq_2]
                                  simp [Nat.le_total]
  exact aux n v₁ v₂

theorem Order.lex_true_of_ble_lex_true (h: Eq (Order.ble_lex_impl v₁ v₂) true): Order.lex v₁ v₂ := by
  let rec aux (m: Nat) (a b: Vector Nat m) (h: Eq (Order.ble_lex_impl a b) true): Order.lex a b := by
    rw [Order.lex]
    rw [Order.lex_impl]
    match a, b with
      | ⟨[], _⟩  , ⟨[], _⟩     => simp
      | ⟨x::xs, _⟩, ⟨y::ys, _⟩ => split
                                  simp
                                  split
                                  rw [Order.ble_lex_impl] at h
                                  simp at h
                                  split at h
                                  exact aux (m-1) (tail ⟨x::xs, _⟩) (tail ⟨y::ys, _⟩) h
                                  simp at *
                                  rename_i heq₁ hneq heq₂ heq₃
                                  have eq₁ := heq₂.left
                                  have eq₂ := heq₃.left
                                  rw [eq₁, eq₂] at hneq
                                  contradiction
                                  rename_i heq₁ heq₂ hneq₁
                                  rw [Order.ble_lex_impl] at h
                                  split at h
                                  simp at *
                                  split at h
                                  rename_i heq₃ heq₄ hneq₂
                                  simp at heq₁ heq₂ heq₃ heq₄ hneq₂
                                  have eq₁ := heq₁.left
                                  have eq₂ := heq₂.left
                                  have eq₃ := heq₃.left
                                  have eq₄ := heq₄.left
                                  rw [eq₁] at eq₃
                                  rw [eq₂] at eq₄
                                  rw [eq₃, eq₄] at hneq₁
                                  contradiction
                                  simp at h
                                  rename_i heq₁ heq₂ _ _ _ _ _ _ _ _ _ _ _ heq₃ heq₄ _
                                  simp at heq₁ heq₂ heq₃ heq₄
                                  have eq₁ := heq₁.left
                                  have eq₂ := heq₂.left
                                  have eq₃ := heq₃.left
                                  have eq₄ := heq₄.left
                                  rw [eq₁] at eq₃
                                  rw [eq₂] at eq₄
                                  rw [eq₃, eq₄]
                                  exact h
  rename_i n
  exact aux n v₁ v₂ h

theorem Order.ble_eq_true_of_lex (h: Order.lex_impl v₁ v₂) : Eq (Order.ble_lex_impl v₁ v₂) true := by
  let rec aux (m: Nat) (a b: Vector Nat m) (h: Order.lex_impl a b): Eq (Order.ble_lex_impl a b) true := by
     match a, b with
      | ⟨[], _⟩, ⟨[], _⟩       => rw [Order.ble_lex_impl]
      | ⟨x::xs, _⟩, ⟨y::ys, _⟩ => rw [Order.ble_lex_impl]
                                  split;rfl
                                  split
                                  rw [lex_impl] at h
                                  simp at h
                                  split at h
                                  apply Order.ble_eq_true_of_lex h
                                  rename_i heq₁ heq₂ neq eq
                                  simp at heq₁ heq₂
                                  have eq₁ := heq₁.left
                                  have eq₂ := heq₂.left
                                  simp at neq
                                  rw [eq₁, eq₂] at eq
                                  contradiction
                                  rw [lex_impl] at h
                                  simp at h
                                  split at h
                                  rename_i heq₁ heq₂ neq eq
                                  simp at heq₁ heq₂
                                  have eq₁ := heq₁.left
                                  have eq₂ := heq₂.left
                                  simp at neq
                                  rw [eq₁, eq₂] at eq
                                  contradiction
                                  simp
                                  rename_i heq₁ heq₂ _ _
                                  simp at heq₁ heq₂
                                  have eq₁ := Eq.symm heq₁.left
                                  have eq₂ := Eq.symm heq₂.left
                                  rwa [eq₁, eq₂]
  rename_i n
  exact aux n v₁ v₂ h

theorem Order.lex_false_of_ble_lex_false (h: Not (Eq (Order.ble_lex_impl v₁ v₂) true)): Not (Order.lex v₁ v₂) :=
  fun h' => absurd (Order.ble_eq_true_of_lex h') h

instance Order.lex_decidable (v₁ v₂: Variables n): Decidable (Order.lex v₁ v₂) :=
  dite (Eq (Order.ble_lex_impl v₁ v₂) true) (fun h => isTrue (Order.lex_true_of_ble_lex_true h))
                                            (fun h => isFalse (Order.lex_false_of_ble_lex_false h))

instance LexOrder: LinearOrder (Variables n) where
  le           := Order.lex
  le_refl      := lex_le_refl
  le_trans     := lex_le_trans
  le_antisymm  := lex_le_antisymm
  le_total     := lex_le_total
  decidable_le := Order.lex_decidable

def Ordering.lex (m₁ m₂: Monomial n): Ordering :=
  if m₁.snd = m₂.snd then Ordering.eq
  else if Order.lex m₁.snd m₂.snd then Ordering.gt
  else Ordering.lt

end monomials_lex_order

section monomials_grlex_order

private def Order.bgrlex (vs₁ vs₂: Variables n): Bool :=
  let sum₁ := elem_sum vs₁
  let sum₂ := elem_sum vs₂
  if sum₁ < sum₂ then true
  else if sum₁ = sum₂ then Order.lex vs₁ vs₂
  else false
  where
    elem_sum (vs: Variables n): Nat :=
      List.foldl (fun x y => x + y) 0 vs.toList

def Order.grlex (vs₁ vs₂: Variables n): Prop :=
  let sum₁ := elem_sum vs₁
  let sum₂ := elem_sum vs₂
  if sum₁ < sum₂ then True
  else if sum₁ = sum₂ then Order.lex vs₁ vs₂
  else False
  where
    elem_sum (vs: Variables n): Nat :=
      List.foldl (fun x y => x + y) 0 vs.toList

theorem grlex_le_refl: ∀ (a : Variables n), Order.grlex a a := by
  intros a
  simp [Order.grlex]
  apply lex_le_refl

theorem grlex_le_trans : ∀ (a b c : Variables n), Order.grlex a b → Order.grlex b c → Order.grlex a c := by
  intros a b c ab bc
  simp [Order.grlex]
  simp [Order.grlex] at ab bc
  split <;> simp
  split at ab
  split at bc <;> split
  rename_i nleq leq₁ leq₂ eq
  rw [eq] at leq₁
  simp at *
  have asymm_leq₁ := Nat.lt_asymm leq₁
  contradiction
  rename_i nleq leq₁ leq₂ neq
  have contr := Nat.lt_trans leq₁ leq₂
  contradiction
  split at bc
  rename_i nleq₁ leq₁ nleq₂ eq₁ eq₂
  rw [eq₂] at leq₁
  repeat contradiction
  split at bc
  rename_i nleq₁ leq₁ nleq₂ neq₁ eq₂
  rw [eq₂] at leq₁
  repeat contradiction
  split <;> (split at ab; split at bc)
  rename_i nleq₁ nleq₂ eq₁ eq₂ leq
  have seq := Eq.symm eq₂
  rw [seq] at leq
  contradiction
  split at bc
  rename_i nleq₁ nleq₂ eq₁ eq₂ neq₁ eq₃
  simp at *
  apply lex_le_trans
  exact ab
  exact bc
  repeat contradiction
  rename_i nleq₁ nleq₂ neq₁ eq leq
  rw [eq] at nleq₁
  contradiction
  split at bc
  rename_i nleq₁ nleq₂ neq eq₁ nleq₃ eq₂
  rw [eq₁] at neq
  repeat contradiction

theorem grlex_le_antisymm : ∀ (a b : Variables n), Order.grlex a b → Order.grlex b a → a = b := by
  intros a b ab ba
  simp [Order.grlex] at ab ba
  split at ab
  split at ba
  rename_i leq₁ leq₂
  have asymm_leq₁ := Nat.lt_asymm leq₁
  contradiction
  split at ba
  rename_i leq nleq eq
  rw [eq] at leq
  simp at leq
  contradiction
  split at ab
  split at ba
  rename_i nleq eq leq
  have symm := Eq.symm eq
  rw [symm] at leq
  simp at leq
  split at ba
  apply lex_le_antisymm
  exact ab
  exact ba
  repeat contradiction

theorem grlex_le_total : ∀ (a b : Variables n), Order.grlex a b ∨ Order.grlex b a := by
  intros a b
  simp [Order.grlex]
  split <;> simp
  split <;> repeat (first | split | simp)
  simp [lex_le_total]
  rename_i nleq₁ eq nleq₂ neq
  have contr := Eq.symm eq
  contradiction
  rename_i nleq₁ neq nleq₂ eq
  have contr := Eq.symm eq
  contradiction
  simp
  rename_i nleq₁ neq nleq₂ eq
  simp at *
  have contr := Nat.le_antisymm nleq₁ nleq₂
  contradiction

theorem grlex_true_of_ble_grlex_true (h: Eq (Order.bgrlex v₁ v₂) true): Order.grlex v₁ v₂ := by
  simp [Order.grlex]
  split
  simp
  split
  simp [algebra.Order.bgrlex] at h
  split at h
  simp at h
  simp at *
  rw [Order.grlex.elem_sum, Order.grlex.elem_sum] at *
  rw [algebra.Order.bgrlex.elem_sum, algebra.Order.bgrlex.elem_sum] at *
  rename_i hh
  simp [hh] at h
  exact h
  rename_i nleq eq _
  contradiction
  simp [algebra.Order.bgrlex] at h
  split at h
  contradiction
  rename_i nleq neq₁ neq₂
  have leq := Nat.le_of_not_lt nleq
  exact h leq

theorem grble_eq_true_of_grlex (h: Order.grlex v₁ v₂): Eq (Order.bgrlex v₁ v₂) true := by
  simp [Order.grlex] at h
  split at h
  simp [algebra.Order.bgrlex]
  split
  rename_i h
  have le := Nat.le_of_eq h
  simp [h]
  rename_i hle _
  rw [Order.grlex.elem_sum, Order.grlex.elem_sum] at hle
  rw [algebra.Order.bgrlex.elem_sum, algebra.Order.bgrlex.elem_sum] at h
  rw [h] at hle
  simp at hle
  rename_i le neq
  intros nleq
  have le_contr := Nat.not_lt_of_le nleq
  rw [Order.grlex.elem_sum, Order.grlex.elem_sum] at le
  rw [algebra.Order.bgrlex.elem_sum, algebra.Order.bgrlex.elem_sum] at le_contr
  contradiction
  split at h
  simp [algebra.Order.bgrlex]
  intros le
  split
  exact h
  rename_i nlt eq neq
  rw [Order.grlex.elem_sum, Order.grlex.elem_sum] at nlt eq
  rw [algebra.Order.bgrlex.elem_sum, algebra.Order.bgrlex.elem_sum] at le neq
  repeat contradiction

theorem grlex_false_of_ble_grlex_false (h: Not (Eq (Order.bgrlex v₁ v₂) true)): Not (Order.grlex v₁ v₂) :=
  fun h' => absurd (grble_eq_true_of_grlex h') h

instance Order.grlex_decidable (v₁ v₂: Variables n): Decidable (Order.grlex v₁ v₂) :=
  dite (Eq (Order.bgrlex v₁ v₂) true) (fun h => isTrue (grlex_true_of_ble_grlex_true h))
                                      (fun h => isFalse (grlex_false_of_ble_grlex_false h))

-- instance GrlexOrder: LinearOrder (Variables n) where
--   le           := Order.grlex
--   le_refl      := grlex_le_refl
--   le_trans     := grlex_le_trans
--   le_antisymm  := grlex_le_antisymm
--   le_total     := grlex_le_total
--   decidable_le := Order.grlex_decidable

def Ordering.grlex (m₁ m₂: Monomial n): Ordering :=
  if m₁.snd = m₂.snd then Ordering.eq
  else if Order.grlex m₁.snd m₂.snd then Ordering.gt
  else Ordering.lt

end monomials_grlex_order

end algebra


/-
Copyright (c) 2022 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Heather Macbeth
-/

import field_theory.is_alg_closed.basic
import ring_theory.witt_vector.discrete_valuation_ring

/-!
# Solving equations about the Frobenius map on the field of fractions of `𝕎 k`

The goal of this file is to prove `witt_vector.exists_frobenius_solution_fraction_ring`,
which says that for an algebraically closed field `k` of characteristic `p` and `a, b` in the
field of fractions of Witt vectors over `k`,
there is a solution `b` to the equation `φ b * a = p ^ m * b`, where `φ` is the Frobenius map.

Most of this file builds up the equivalent theorem over `𝕎 k` directly,
moving to the field of fractions at the end.
See `witt_vector.frobenius_rotation` and its specification.

The construction proceeds by recursively defining a sequence of coefficients as solutions to a
polynomial equation in `k`. We must define these as generic polynomials using Witt vector API
(`witt_vector.witt_mul`, `witt_polynomial`) to show that they satisfy the desired equation.

Preliminary work is done in the dependency `ring_theory.witt_vector.mul_coeff`
to isolate the `n+1`st coefficients of `x` and `y` in the `n+1`st coefficient of `x*y`.

This construction is described in Dupuis, Lewis, and Macbeth,
[Formalized functional analysis via semilinear maps][dupuis-lewis-macbeth2022].
We approximately follow an approach sketched on MathOverflow:
<https://mathoverflow.net/questions/62468/about-frobenius-of-witt-vectors>

The result is a dependency for the proof of `witt_vector.isocrystal_classification`,
the classification of one-dimensional isocrystals over an algebraically closed field.
-/

noncomputable theory

namespace witt_vector

variables (p : ℕ) [hp : fact p.prime]
local notation `𝕎` := witt_vector p

namespace recursion_main

/-!

## The recursive case of the vector coefficients

The first coefficient of our solution vector is easy to define below.
In this section we focus on the recursive case.
The goal is to turn `witt_poly_prod n` into a univariate polynomial
whose variable represents the `n`th coefficient of `x` in `x * a`.

-/

section comm_ring
include hp
variables {k : Type*} [comm_ring k] [char_p k p]
open polynomial

/-- The root of this polynomial determines the `n+1`st coefficient of our solution. -/
def succ_nth_defining_poly (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : fin (n+1) → k) : polynomial k :=
X^p * C (a₁.coeff 0 ^ (p^(n+1))) - X * C (a₂.coeff 0 ^ (p^(n+1)))
  + C (a₁.coeff (n+1) * ((bs 0)^p)^(p^(n+1)) +
      nth_remainder p n (λ v, (bs v)^p) (truncate_fun (n+1) a₁) -
      a₂.coeff (n+1) * (bs 0)^p^(n+1) - nth_remainder p n bs (truncate_fun (n+1) a₂))

lemma succ_nth_defining_poly_degree [is_domain k] (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : fin (n+1) → k)
  (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
  (succ_nth_defining_poly p n a₁ a₂ bs).degree = p :=
begin
  have : (X ^ p * C (a₁.coeff 0 ^ p ^ (n+1))).degree = p,
  { rw [degree_mul, degree_C],
    { simp only [nat.cast_with_bot, add_zero, degree_X, degree_pow, nat.smul_one_eq_coe] },
    { exact pow_ne_zero _ ha₁ } },
  have : (X ^ p * C (a₁.coeff 0 ^ p ^ (n+1)) - X * C (a₂.coeff 0 ^ p ^ (n+1))).degree = p,
  { rw [degree_sub_eq_left_of_degree_lt, this],
    rw [this, degree_mul, degree_C, degree_X, add_zero],
    { exact_mod_cast hp.out.one_lt },
    { exact pow_ne_zero _ ha₂ } },
  rw [succ_nth_defining_poly, degree_add_eq_left_of_degree_lt, this],
  apply lt_of_le_of_lt (degree_C_le),
  rw [this],
  exact_mod_cast hp.out.pos
end

end comm_ring

section is_alg_closed
include hp
variables {k : Type*} [field k] [char_p k p] [is_alg_closed k]

lemma root_exists (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : fin (n+1) → k)
  (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
  ∃ b : k, (succ_nth_defining_poly p n a₁ a₂ bs).is_root b :=
is_alg_closed.exists_root _ $
  by simp [(succ_nth_defining_poly_degree p n a₁ a₂ bs ha₁ ha₂), hp.out.ne_zero]

/-- This is the `n+1`st coefficient of our solution, projected from `root_exists`. -/
def succ_nth_val (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : fin (n+1) → k)
  (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) : k :=
classical.some (root_exists p n a₁ a₂ bs ha₁ ha₂)

lemma succ_nth_val_spec (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : fin (n+1) → k)
  (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
  (succ_nth_defining_poly p n a₁ a₂ bs).is_root (succ_nth_val p n a₁ a₂ bs ha₁ ha₂) :=
classical.some_spec (root_exists p n a₁ a₂ bs ha₁ ha₂)

lemma succ_nth_val_spec' (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : fin (n+1) → k)
  (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
  (succ_nth_val p n a₁ a₂ bs ha₁ ha₂)^p * a₁.coeff 0 ^ (p^(n+1)) +
    a₁.coeff (n+1) * ((bs 0)^p)^(p^(n+1)) +
    nth_remainder p n (λ v, (bs v)^p) (truncate_fun (n+1) a₁)
   = (succ_nth_val p n a₁ a₂ bs ha₁ ha₂) * a₂.coeff 0 ^ (p^(n+1)) +
     a₂.coeff (n+1) * (bs 0)^(p^(n+1)) + nth_remainder p n bs (truncate_fun (n+1) a₂) :=
begin
  rw ← sub_eq_zero,
  have := succ_nth_val_spec p n a₁ a₂ bs ha₁ ha₂,
  simp only [polynomial.map_add, polynomial.eval_X, polynomial.map_pow, polynomial.eval_C,
    polynomial.eval_pow, succ_nth_defining_poly, polynomial.eval_mul, polynomial.eval_add,
    polynomial.eval_sub, polynomial.map_mul, polynomial.map_sub, polynomial.is_root.def] at this,
  convert this using 1,
  ring
end

end is_alg_closed
end recursion_main

namespace recursion_base
include hp
variables {k : Type*} [field k] [is_alg_closed k]

lemma solution_pow (a₁ a₂ : 𝕎 k) :
  ∃ x : k, x^(p-1) = a₂.coeff 0 / a₁.coeff 0 :=
is_alg_closed.exists_pow_nat_eq _ $ by linarith [hp.out.one_lt, le_of_lt hp.out.one_lt]

/-- The base case (0th coefficient) of our solution vector. -/
def solution (a₁ a₂ : 𝕎 k) : k :=
classical.some $ solution_pow p a₁ a₂

lemma solution_spec (a₁ a₂ : 𝕎 k) :
  (solution p a₁ a₂)^(p-1) = a₂.coeff 0 / a₁.coeff 0 :=
classical.some_spec $ solution_pow p a₁ a₂

lemma solution_nonzero {a₁ a₂ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
  solution p a₁ a₂ ≠ 0 :=
begin
  intro h,
  have := solution_spec p a₁ a₂,
  rw [h, zero_pow] at this,
  { simpa [ha₁, ha₂] using _root_.div_eq_zero_iff.mp this.symm },
  { linarith [hp.out.one_lt, le_of_lt hp.out.one_lt] }
end

lemma solution_spec' {a₁ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (a₂ : 𝕎 k) :
  (solution p a₁ a₂)^p * a₁.coeff 0 = (solution p a₁ a₂) * a₂.coeff 0 :=
begin
  have := solution_spec p a₁ a₂,
  cases nat.exists_eq_succ_of_ne_zero hp.out.ne_zero with q hq,
  have hq' : q = p - 1 := by simp only [hq, tsub_zero, nat.succ_sub_succ_eq_sub],
  conv_lhs {congr, congr, skip, rw hq},
  rw [pow_succ', hq', this],
  field_simp [ha₁, mul_comm],
end

end recursion_base

open recursion_main recursion_base

section frobenius_rotation

section is_alg_closed
include hp
variables {k : Type*} [field k] [char_p k p] [is_alg_closed k]

/--
Recursively defines the sequence of coefficients for `witt_vector.frobenius_rotation`.
-/
noncomputable def frobenius_rotation_coeff {a₁ a₂ : 𝕎 k}
  (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) : ℕ → k
| 0       := solution p a₁ a₂
| (n + 1) := succ_nth_val p n a₁ a₂ (λ i, frobenius_rotation_coeff i.val) ha₁ ha₂
using_well_founded { dec_tac := `[apply fin.is_lt] }

/--
For nonzero `a₁` and `a₂`, `frobenius_rotation a₁ a₂` is a Witt vector that satisfies the
equation `frobenius (frobenius_rotation a₁ a₂) * a₁ = (frobenius_rotation a₁ a₂) * a₂`.
-/
def frobenius_rotation {a₁ a₂ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) : 𝕎 k :=
witt_vector.mk p (frobenius_rotation_coeff p ha₁ ha₂)

lemma frobenius_rotation_nonzero {a₁ a₂ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
  frobenius_rotation p ha₁ ha₂ ≠ 0 :=
begin
  intro h,
  apply solution_nonzero p ha₁ ha₂,
  simpa [← h, frobenius_rotation, frobenius_rotation_coeff] using witt_vector.zero_coeff p k 0
end

lemma frobenius_frobenius_rotation {a₁ a₂ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
  frobenius (frobenius_rotation p ha₁ ha₂) * a₁ = (frobenius_rotation p ha₁ ha₂) * a₂ :=
begin
  ext n,
  induction n with n ih,
  { simp only [witt_vector.mul_coeff_zero, witt_vector.coeff_frobenius_char_p,
      frobenius_rotation, frobenius_rotation_coeff],
    apply solution_spec' _ ha₁ },
  { simp only [nth_remainder_spec, witt_vector.coeff_frobenius_char_p, frobenius_rotation_coeff,
      frobenius_rotation, fin.val_eq_coe],
    have := succ_nth_val_spec' p n a₁ a₂
      (λ (i : fin (n + 1)), frobenius_rotation_coeff p ha₁ ha₂ i.val) ha₁ ha₂,
    simp only [frobenius_rotation_coeff, fin.val_eq_coe, fin.val_zero] at this,
    convert this using 4,
    apply truncated_witt_vector.ext,
    intro i,
    simp only [fin.val_eq_coe, witt_vector.coeff_truncate_fun, witt_vector.coeff_frobenius_char_p],
    refl }
end

local notation `φ` := is_fraction_ring.field_equiv_of_ring_equiv
  (ring_equiv.of_bijective _ (frobenius_bijective p k))

end is_alg_closed

end frobenius_rotation

end witt_vector


open set

/-
alunos:
    - Lucas Machado Moschen
-/

-- ex 1

section
    variable U : Type
    variables A B C : set U

    example : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
    assume x,
    assume h: x ∈ A ∩ C,
    show x ∈ A ∪ B, from or.inl h.left

    example : ∀ x, x ∈ -(A ∪ B) → x ∈ -A :=
    assume x,
    assume : x ∈ -(A ∪ B),
    have ¬ x ∈ (A ∪ B), from this,
    assume : x ∈ A,
    show false, from ‹¬ x ∈ (A ∪ B)› (or.inl this)
end

-- ex 2

section
    variable {U : Type}

    /- defining "disjoint" -/

    def disj (A B : set U) : Prop := ∀ ⦃x⦄, x ∈ A → x ∈ B → false

    example (A B : set U) (h : ∀ x, ¬ (x ∈ A ∧ x ∈ B)) :
    disj A B :=
    assume x,
    assume h1 : x ∈ A,
    assume h2 : x ∈ B,
    have h3 : x ∈ A ∧ x ∈ B, from and.intro h1 h2,
    show false, from h x h3

    -- notice that we do not have to mention x when applying
    --   h : disj A B
    example (A B : set U) (h1 : disj A B) (x : U)
        (h2 : x ∈ A) (h3 : x ∈ B) :
    false :=
    h1 h2 h3

    -- the same is true of ⊆
    example (A B : set U) (x : U) (h : A ⊆ B) (h1 : x ∈ A) :
    x ∈ B :=
    h h1

    example (A B C D : set U) (h1 : disj A B) (h2 : C ⊆ A)
        (h3 : D ⊆ B) :
    disj C D :=
    assume x,
    assume g1: x ∈ C,
    assume g2: x ∈ D,
    have g3: x ∈ A, from h2 g1,
    have g4: x ∈ B, from h3 g2,
    show false, from h1 g3 g4
end

-- ex 3

section
    variables {I U : Type}
    variables {A : I → set U} {B : I → set U} {C : set U}

    def Union (A : I → set U) : set U := { x | ∃ i : I, x ∈ A i }
    def Inter (A : I → set U) : set U := { x | ∀ i : I, x ∈ A i }

    notation `⋃` binders `, ` r:(scoped f, Union f) := r
    notation `⋂` binders `, ` r:(scoped f, Inter f) := r

    theorem Inter.intro {x : U} (h : ∀ i, x ∈ A i) : x ∈ ⋂ i, A i :=
        by simp; assumption

    @[elab_simple]
    theorem Inter.elim {x : U} (h : x ∈ ⋂ i, A i) (i : I) : x ∈ A i :=
        by simp at h; apply h

    theorem Union.intro {x : U} (i : I) (h : x ∈ A i) :
    x ∈ ⋃ i, A i :=
        by {simp, existsi i, exact h}

    theorem Union.elim {b : Prop} {x : U}
    (h₁ : x ∈ ⋃ i, A i) (h₂ : ∀ (i : I), x ∈ A i → b) : b :=
        by {simp at h₁, cases h₁ with i h, exact h₂ i h}

    example : (⋂ i, A i) ∩ (⋂ i, B i) ⊆ (⋂ i, A i ∩ B i) :=
        assume x,
        assume h: x ∈ (⋂ i, A i) ∩ (⋂ i, B i),
        show x ∈ (⋂ i, A i ∩ B i), from
            Inter.intro
            (assume i: I,
            have h1: x ∈ A i, from Inter.elim h.left i,
            have h2: x ∈ B i, from Inter.elim h.right i,
            show x ∈ A i ∩ B i, from and.intro h1 h2)

    example : C ∩ (⋃i, A i) ⊆ ⋃i, C ∩ A i :=
        assume x : U,
        assume h : x ∈ C ∩ (⋃i, A i),
        show x ∈ ⋃ i, C ∩ A i, from
            Union.elim h.right
            (assume i : I,
            assume h1: x ∈ A i,
            show  x ∈ ⋃ i, C ∩ A i, from
                Union.intro i (and.intro h.left h1))
end

-- ex 4

section
    variable  {U : Type}
    variables A B C : set U

    @[refl] theorem subset.refl (a : set U) : a ⊆ a := assume x, id

    @[trans] theorem subset.trans {a b c : set U} (ab : a ⊆ b) (bc : b ⊆ c) : a ⊆ c :=
        assume x h, bc (ab h)

    example (h1 : A ⊆ B) (h2 : B ⊆ C) : A ⊆ C :=
        subset.trans h1 h2

    example : A ⊆ A :=
        subset.refl A

    example (h : A ⊆ B) : powerset A ⊆ powerset B :=
        assume X : set U,
        assume h1 : X ∈ powerset A,
        show X ∈ powerset B, from subset.trans h1 h

    example (h : powerset A ⊆ powerset B) : A ⊆ B :=
        assume x: U,
        assume h1 : x ∈ A,
        have h2: {y|x = y} ∈ powerset A, from
            assume z,
            assume : z ∈ {y| x = y},
            have x = z, from this,
            show z ∈ A, from eq.subst this h1,
        have h3: {y| x = y} ∈ powerset B, from h h2,
        have h4: x ∈ {y| x = y}, from eq.refl x,
        show x ∈ B, from h3 h4
end


import tactic --hide

/-
This level proves that `∧` is a commutative operator.
-/

/-Lemma
Let $P,Q$ be logical statements, then $P ∧ Q$ is true iff $Q ∧ P$ is true.
-/
lemma and_commutative (P Q : Prop) : P ∧ Q ↔ Q ∧ P :=
begin
  split,
  intro h,
  cases h,
  split,
  exact h_right,
  exact h_left,
  intro h,
  split,
  exact h.2,
  exact h.1,

end


import GMLInit.Data.Equiv
import GMLInit.Data.Nat.Basic
import GMLInit.Data.Nat.Order

namespace Nat

def tri : Nat → Nat
| 0 => 0
| n+1 => tri n + n + 1

theorem tri_zero : tri 0 = 0 := rfl

theorem tri_succ (n) : tri (n+1) = tri n + n + 1 := rfl

theorem tri_mono {m n : Nat} : m ≤ n → tri m ≤ tri n := by
  induction m, n using Nat.recDiag with
  | zero_zero => intro; reflexivity
  | zero_succ n => intro; exact Nat.zero_le ..
  | succ_zero m => intro; contradiction
  | succ_succ m n H =>
    intro h
    rw [tri_succ, tri_succ]
    apply Nat.add_le_add_right
    apply Nat.add_le_add
    · apply H
      exact Nat.le_of_succ_le_succ h
    · exact Nat.le_of_succ_le_succ h

theorem two_tri_eq (n : Nat) : 2 * tri n = n * (n + 1) := by
  induction n with
  | zero => rfl
  | succ n ih =>
    calc
    _ = 2 * (tri n + (n + 1)) := by rfl
    _ = 2 * tri n + 2 * (n + 1) := by rw [Nat.mul_add]
    _ = n * (n + 1) + 2 * (n + 1) := by rw [ih]
    _ = (n + 2) * (n + 1) := by rw [Nat.add_mul]
    _ = (n + 1) * (n + 1 + 1) := by rw [Nat.mul_comm]

private theorem tri_add_self_lt_tri_of_lt {m n : Nat} : m < n → tri m + m < tri n := by
  intro h
  transitivity (tri (m+1)) using LT.lt, LE.le
  · exact Nat.lt_succ_self ..
  · apply Nat.tri_mono
    exact Nat.succ_le_of_lt h

theorem tri_add_inj {m₁ n₁ m₂ n₂} : m₁ ≤ n₁ → m₂ ≤ n₂ → tri n₁ + m₁ = tri n₂ + m₂ → n₁ = n₂ := by
  intro h₁ h₂ h
  by_cases n₁ ≤ n₂, n₁ ≥ n₂ with
  | isTrue hle, isTrue hge =>
    antisymmetry using LE.le
    · exact hle
    · exact hge
  | _, isFalse hlt =>
    absurd h
    apply Nat.ne_of_lt
    transitivity (tri n₁ + n₁) using LE.le, LT.lt
    · apply Nat.add_le_add_left
      exact h₁
    · transitivity (tri n₂) using LT.lt, LE.le
      · apply Nat.tri_add_self_lt_tri_of_lt
        exact Nat.lt_of_not_ge hlt
      · exact Nat.le_add_right ..
  | isFalse hgt, _ =>
    absurd h
    symmetry using (.≠.)
    apply Nat.ne_of_lt
    transitivity (tri n₂ + n₂) using LE.le, LT.lt
    · apply Nat.add_le_add_left
      exact h₂
    · transitivity (tri n₁) using LT.lt, LE.le
      · apply Nat.tri_add_self_lt_tri_of_lt
        exact Nat.gt_of_not_le hgt
      · exact Nat.le_add_right ..

abbrev pair (x y : Nat) : Nat := tri (x + y) + x

theorem pair_zero_right (x : Nat) : pair x 0 = tri x + x := rfl

theorem pair_succ_right (x y : Nat) : pair x (y+1) = pair x y + (x + y) + 1 :=
  calc
  _ = (tri (x + y) + (x + y) + 1) + x := by rfl
  _ = ((tri (x + y) + (x + y)) + x) + 1 := by rw [Nat.add_right_comm _ x 1]
  _ = ((tri (x + y) + x) + (x + y)) + 1 := by rw [Nat.add_right_comm _ (x+y) x]

theorem pair_zero_left (y : Nat) : pair 0 y = tri y :=
  calc
  _ = tri (0 + y) := by rfl
  _ = tri y := by rw [Nat.zero_add]

theorem pair_succ_left (x y : Nat) : pair (x+1) y = pair x y + (x + y) + 2 :=
  calc
  _ = (tri (x + 1 + y)) + (x + 1) := by rfl
  _ = (tri (x + y + 1)) + (x + 1) := by rw [Nat.add_right_comm _ y 1]
  _ = (tri (x + y) + (x + y) + 1) + (x + 1) := by rfl
  _ = (tri (x + y) + x + y + 1) + (x + 1) := by rw [Nat.add_assoc _ x y]
  _ = (pair x y + y + 1) + (x + 1) := by rfl
  _ = (pair x y + y) + (x + 1) + 1 := by rw [Nat.add_right_comm _ (x+1) 1]
  _ = (pair x y + y) + x + 1 + 1 := by rw [Nat.add_assoc _ x 1]
  _ = pair x y + (y + x) + 1 + 1 := by rw [Nat.add_assoc _ y x]
  _ = pair x y + (x + y) + 1 + 1 := by rw [Nat.add_comm x y]

def split : Nat → (t : Nat) × Fin (t+1)
| 0 => ⟨0,0⟩
| n+1 =>
  match split n with
  | ⟨t,s,_⟩ =>
    if h : s < t
    then ⟨t, s+1, Nat.succ_lt_succ h⟩
    else ⟨t+1, 0, Nat.zero_lt_succ (t+1)⟩

theorem split_eq (n : Nat) : tri (split n).fst + (split n).snd = n := by
  induction n with
  | zero => rfl
  | succ n H =>
    symmetry
    transitivity (tri (split n).fst + ((split n).snd + 1))
    · rw [←Nat.add_assoc (tri (split n).fst) (split n).snd 1, H]
    · symmetry
      simp only [split]
      split
      next h =>
        dsimp only [Nat.add_eq] at h ⊢
        rw [Nat.add_zero n] at h ⊢
        rw [dif_pos h]
      next h =>
        have h : ¬((split n).snd.val < (split n).fst) := h
        have heq : (split n).snd.val = (split n).fst := by
          apply Nat.le_antisymm
          · exact Nat.le_of_lt_succ (split n).snd.isLt
          · exact Nat.le_of_not_gt h
        rw [dif_neg h, ←Nat.add_assoc, heq]; rfl

protected abbrev fst (n : Nat) : Nat := (split n).snd

protected abbrev snd (n : Nat) : Nat := (split n).fst - (split n).snd

private theorem split_pair_fst (x y) : (split (pair x y)).fst = x + y := by
  match h : split (pair x y) with
  | ⟨t,⟨s,hs⟩⟩ =>
    apply Nat.tri_add_inj (Nat.le_of_lt_succ hs) (Nat.le_add_right x y)
    transitivity (tri (split (pair x y)).fst + (split (pair x y)).snd)
    · rw [h]
    · rw [split_eq, pair]

private theorem split_pair_snd (x y) : (split (pair x y)).snd = x := by
  apply Nat.add_left_cancel (n:=tri (split (pair x y)).fst)
  rw [split_eq, split_pair_fst, pair]

theorem fst_pair (x y) : (pair x y).fst = x := split_pair_snd x y

theorem snd_pair (x y) : (pair x y).snd = y := by
  unfold Nat.snd
  rw [Nat.split_pair_snd]
  rw [Nat.split_pair_fst]
  rw [Nat.add_sub_cancel_left]

theorem pair_fst_snd (n) : pair n.fst n.snd = n := by
  unfold pair Nat.fst Nat.snd
  match h : split n with
  | ⟨t,⟨s,hs⟩⟩ =>
    rw [Nat.add_comm s, Nat.sub_add_cancel (Nat.le_of_lt_succ hs)]
    rw [←split_eq n, h]

def encodeProd (a : Nat × Nat) : Nat := pair a.fst a.snd

def decodeProd (n : Nat) : Nat × Nat := (n.fst, n.snd)

def prodEquiv : Equiv Nat (Nat × Nat) where
  fwd n := (n.fst, n.snd)
  rev p := pair p.fst p.snd
  spec := by intro
    | n, (n₁,n₂) =>
      clean
      constr
      · intro h
        cases h
        rw [pair_fst_snd]
      · intro h
        cases h
        rw [fst_pair, snd_pair]

end Nat


import linear_algebra.basis
import linear_algebra.dual

noncomputable theory

universe u

open function set submodule
open_locale classical big_operators

section
variables {R : Type*} [semiring R]
          {M : Type*} [add_comm_monoid M] [module R M]

/-- The span of the first `n` elements of an ordered basis. -/
def basis.flag {n : ℕ} (b : basis (fin n) R M) : fin (n + 1) → submodule R M :=
λ k, span R (b '' {j | (j : fin $ n + 1) < k })

@[simp] lemma basis.flag_zero {n : ℕ} (b : basis (fin n) R M) : b.flag 0 = ⊥ :=
begin
  simp only [basis.flag, fin.coe_eq_cast_succ],
  suffices : {j : fin n | fin.cast_succ j < 0} = ∅, by simp [this],
  ext l,
  simp [l.cast_succ.zero_le]
end

@[simp] lemma basis.flag_last {n : ℕ} (b : basis (fin n) R M) : b.flag (fin.last n) = ⊤  :=
begin
  have : {j : fin n | (j : fin $ n+1) < fin.last n} = univ,
  { ext l,
    simp [fin.cast_succ_lt_last l] },
  simp_rw [basis.flag, this],
  simp [b.span_eq]
end

attribute [mono] submodule.span_mono

@[simp] lemma basis.flag_mono {n : ℕ} (b : basis (fin n) R M) : monotone b.flag :=
begin
  intros j k h,
  dsimp [basis.flag],
  mono*,
  rintros l (hl : ↑↑l < j),
  exact hl.trans_le h
end

lemma fin.coe_succ_le_iff_le {n : ℕ} {j k : fin n} : (j : fin $ n+1) ≤ k ↔ j ≤ k :=
begin
  cases j,
  cases k,
  simp
end

lemma fin.coe_succ_lt_iff_lt {n : ℕ} {j k : fin n} : (j : fin $ n+1) < k ↔ j < k :=
begin
  cases j,
  cases k,
  simp
end

lemma fin.coe_lt_succ {n : ℕ} (k : fin n) : (k : fin $ n+1) < k.succ :=
begin
  cases k,
  simp
end

lemma basis.flag_span_succ {n : ℕ} (b : basis (fin n) R M) (k : fin n) :
  b.flag k ⊔ span R {b k} = b.flag k.succ :=
begin
  rw [basis.flag, ← span_union, ← image_singleton, ← image_union],
  congr,
  ext j,
  have : j = k ∨ j < k ↔ ↑j < k.succ,
  { cases j,
    cases k,
    simp [← le_iff_eq_or_lt, nat.lt_succ_iff.symm] },
  simp [this]
end
end

section
variables {R : Type*} [comm_ring R]
          {M : Type*} [add_comm_group M] [module R M]

variables {n : ℕ} (b : basis (fin n) R M)

lemma basis.flag_le_ker_dual (k : fin n) : b.flag k ≤ (b.dual_basis k).ker :=
begin
  erw span_le,
  rintros _ ⟨j, hj : (j : fin $ n+1) < k, rfl⟩,
  simp [(fin.coe_succ_lt_iff_lt.mp hj).ne]
end
end


import hahn

/-
This file contains the definition of mutually singular measures,
the Jordan decomposition theorem and the Lebesgue decomposition theorem.
-/

noncomputable theory
open_locale classical big_operators nnreal ennreal

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

open measure_theory

def measure.singular (μ ν : measure α) : Prop :=
∃ (i : set α) (hi₁ : measurable_set i), μ i = 0 ∧ ν iᶜ = 0

namespace signed_measure

infix ` ⊥ `:60 := measure.singular

variables {μ ν : measure α}

lemma singular_comm (h : μ ⊥ ν) : ν ⊥ μ :=
let ⟨i, hi, his, hit⟩ := h in
  ⟨iᶜ, measurable_set.compl hi, hit, (compl_compl i).symm ▸ his⟩

/-- The Jordan decomposition theorem: Given a signed measure `s`, there exists
a pair of mutually singular measures `μ` and `ν` such that `s = μ - ν`. -/
theorem exists_sigular_sub (s : signed_measure α) :
  ∃ (μ ν : measure α) [hμ : finite_measure μ] [hν : finite_measure ν],
    μ ⊥ ν ∧ s = @of_sub_measure _ _ μ ν hμ hν :=
begin
  obtain ⟨i, hi₁, hi₂, hi₃⟩ := s.exists_compl_positive_negative,
  have hi₄ := measurable_set.compl hi₁,
  refine ⟨s.positive_to_measure i hi₁ hi₂, s.negative_to_measure iᶜ hi₄ hi₃, _⟩,
  refine ⟨positive_to_measure_finite hi₁ hi₂, negative_to_measure_finite hi₄ hi₃, _, _⟩,
  { refine ⟨iᶜ, hi₄, _, _⟩,
    { simp_rw [positive_to_measure_apply _ _ hi₄,
               set.inter_compl_self, s.measure_of_empty], refl },
    { simp_rw [negative_to_measure_apply _ _ (measurable_set.compl hi₄),
               set.inter_compl_self, s.measure_of_empty, neg_zero], refl } },
  { ext k hk,
    rw [of_sub_measure_apply hk, positive_to_measure_apply hi₁ hi₂ hk,
        negative_to_measure_apply hi₄ hi₃ hk],
    simp only [ennreal.coe_to_real, subtype.coe_mk, ennreal.some_eq_coe, sub_neg_eq_add],
    rw [← measure_of_union _ (measurable_set.inter hi₁ hk) (measurable_set.inter hi₄ hk),
        set.inter_comm i, set.inter_comm iᶜ, set.inter_union_compl _ _],
    rintro x ⟨⟨hx₁, _⟩, hx₂, _⟩,
    exact false.elim (hx₂ hx₁) }
end

/-- A Jordan decomposition provides a Hahn decomposition. -/
lemma exists_compl_positive_negative_of_exists_sigular_sub
  {s : signed_measure α} {μ ν : measure α}
  [hμ : finite_measure μ] [hν : finite_measure ν]
  (h : μ ⊥ ν ∧ s = @of_sub_measure _ _ μ ν hμ hν) :
  ∃ S (hS₁ : measurable_set S) (hS₄: s.negative S) (hS₅: s.positive Sᶜ),
  μ S = 0 ∧ ν Sᶜ = 0 :=
begin
  obtain ⟨⟨S, hS₁, hS₂, hS₃⟩, h₁⟩ := h,
  refine ⟨S, hS₁, _, _, hS₂, hS₃⟩,
  { intros A hA hA₁,
    rw [h₁, of_sub_measure_apply hA₁,
        show μ A = 0, by exact nonpos_iff_eq_zero.1 (hS₂ ▸ measure_mono hA),
        ennreal.zero_to_real, zero_sub, neg_le, neg_zero],
    exact ennreal.to_real_nonneg },
  { intros A hA hA₁,
    rw [h₁, of_sub_measure_apply hA₁,
        show ν A = 0, by exact nonpos_iff_eq_zero.1 (hS₃ ▸ measure_mono hA),
        ennreal.zero_to_real, sub_zero],
    exact ennreal.to_real_nonneg },
end

lemma subset_positive_null_set {s : signed_measure α} {u w t : set α}
  (hw : measurable_set w) (ht : measurable_set t)
  (hsu : s.positive u) (ht₁ : s t = 0) (ht₂ : t ⊆ u) (hwt : w ⊆ t) : s w = 0 :=
begin
  have : s w + s (t \ w) = 0,
  { rw [← ht₁, ← measure_of_union set.disjoint_diff hw (ht.diff hw),
        set.union_diff_self, set.union_eq_self_of_subset_left hwt] },
  rw add_eq_zero_iff' at this,
  exacts [this.1, hsu _ (hwt.trans ht₂) hw, hsu _ ((t.diff_subset w).trans ht₂) (ht.diff hw)],
end

lemma subset_negative_null_set {s : signed_measure α} {u w t : set α}
  (hw : measurable_set w) (ht : measurable_set t)
  (hsu : s.negative u) (ht₁ : s t = 0) (ht₂ : t ⊆ u) (hwt : w ⊆ t) : s w = 0 :=
begin
  have : s w + s (t \ w) = 0,
  { rw [← ht₁, ← measure_of_union set.disjoint_diff hw (ht.diff hw),
        set.union_diff_self, set.union_eq_self_of_subset_left hwt] },
  linarith [hsu _ (hwt.trans ht₂) hw, hsu _ ((t.diff_subset w).trans ht₂) (ht.diff hw)]
end

lemma set.diff_disjoint_diff (u v : set α) : disjoint (u \ v) (v \ u) :=
set.disjoint_of_subset_left (u.diff_subset v) set.disjoint_diff

lemma of_diff_eq_zero_of_symm_diff_eq_zero_positive {s : signed_measure α} {u v : set α}
  (hu : measurable_set u) (hv : measurable_set v)
  (hsu : s.positive u) (hsv : s.positive v) (hs : s (u Δ v) = 0) :
  s (u \ v) = 0 ∧ s (v \ u) = 0 :=
begin
  rwa [← add_eq_zero_iff' (hsu _ (u.diff_subset v) (hu.diff hv))
           (hsv _ (v.diff_subset u) (hv.diff hu)),
       ← measure_of_union (set.diff_disjoint_diff u v) (hu.diff hv) (hv.diff hu)]
end

lemma of_diff_eq_zero_of_symm_diff_eq_zero_negative {s : signed_measure α} {u v : set α}
  (hu : measurable_set u) (hv : measurable_set v)
  (hsu : s.negative u) (hsv : s.negative v) (hs : s (u Δ v) = 0) :
  s (u \ v) = 0 ∧ s (v \ u) = 0 :=
begin
  have a := hsu _ (u.diff_subset v) (hu.diff hv),
  have b := hsv _ (v.diff_subset u) (hv.diff hu),
  erw [measure_of_union (set.diff_disjoint_diff u v) (hu.diff hv) (hv.diff hu)] at hs,
  split; linarith,
end

lemma of_diff_of_symm_diff_eq_zero {s : signed_measure α} {u v : set α}
  (hu : measurable_set u) (hv : measurable_set v)
  (h : s (u Δ v) = 0) (h' : s (v \ u) = 0) : s (u \ v) + s v = s u :=
begin
  symmetry,
  calc s u = s (u \ v ∪ u ∩ v) : by simp only [set.diff_union_inter]
       ... = s (u \ v) + s (u ∩ v) :
  by { rw measure_of_union,
       { rw disjoint.comm,
         exact set.disjoint_of_subset_left (u.inter_subset_right v) set.disjoint_diff },
       { exact hu.diff hv },
       { exact hu.inter hv } }
       ... = s (u \ v) + s (u ∩ v ∪ v \ u) :
  by { rw [measure_of_union, h', add_zero],
       { exact set.disjoint_of_subset_left (u.inter_subset_left v) set.disjoint_diff },
       { exact hu.inter hv },
       { exact hv.diff hu } }
       ... = s (u \ v) + s v :
  by { rw [set.union_comm, set.inter_comm, set.diff_union_inter] }
end

lemma of_inter_eq_of_symm_diff_eq_zero_positive {s : signed_measure α} {u v w : set α}
  (hu : measurable_set u) (hv : measurable_set v) (hw : measurable_set w)
  (hsu : s.positive u) (hsv : s.positive v) (hs : s (u Δ v) = 0) :
  s (w ∩ u) = s (w ∩ v) :=
begin
  have hwuv : s ((w ∩ u) Δ (w ∩ v)) = 0,
  { refine subset_positive_null_set _ _ (positive_union_positive hu hsu hv hsv) hs _ _,
    { exact (hw.inter hu).symm_diff (hw.inter hv) },
    { exact hu.symm_diff hv },
    { exact symm_diff_le_sup u v },
    { rintro x (⟨⟨hxw, hxu⟩, hx⟩ | ⟨⟨hxw, hxv⟩, hx⟩);
      rw [set.mem_inter_eq, not_and] at hx,
      { exact or.inl ⟨hxu, hx hxw⟩ },
      { exact or.inr ⟨hxv, hx hxw⟩ } } },
  obtain ⟨huv, hvu⟩ := of_diff_eq_zero_of_symm_diff_eq_zero_positive
    (hw.inter hu) (hw.inter hv)
    (positive_subset_positive hsu (w.inter_subset_right u))
    (positive_subset_positive hsv (w.inter_subset_right v)) hwuv,
  rw [← of_diff_of_symm_diff_eq_zero (hw.inter hu) (hw.inter hv) hwuv hvu, huv, zero_add]
end

lemma of_inter_eq_of_symm_diff_eq_zero_negative {s : signed_measure α} {u v w : set α}
  (hu : measurable_set u) (hv : measurable_set v) (hw : measurable_set w)
  (hsu : s.negative u) (hsv : s.negative v) (hs : s (u Δ v) = 0) :
  s (w ∩ u) = s (w ∩ v) :=
begin
  have hwuv : s ((w ∩ u) Δ (w ∩ v)) = 0,
  { refine subset_negative_null_set _ _ (negative_union_negative hu hsu hv hsv) hs _ _,
    { exact (hw.inter hu).symm_diff (hw.inter hv) },
    { exact hu.symm_diff hv },
    { exact symm_diff_le_sup u v },
    { rintro x (⟨⟨hxw, hxu⟩, hx⟩ | ⟨⟨hxw, hxv⟩, hx⟩);
      rw [set.mem_inter_eq, not_and] at hx,
      { exact or.inl ⟨hxu, hx hxw⟩ },
      { exact or.inr ⟨hxv, hx hxw⟩ } } },
  obtain ⟨huv, hvu⟩ := of_diff_eq_zero_of_symm_diff_eq_zero_negative
    (hw.inter hu) (hw.inter hv)
    (negative_subset_negative hsu (w.inter_subset_right u))
    (negative_subset_negative hsv (w.inter_subset_right v)) hwuv,
  rw [← of_diff_of_symm_diff_eq_zero (hw.inter hu) (hw.inter hv) hwuv hvu, huv, zero_add]
end

/-- The Jordan decomposition of a signed measure is unique. -/
theorem singular_sub_unique {s : signed_measure α} {μ₁ ν₁ μ₂ ν₂ : measure α}
  [hμ₁ : finite_measure μ₁] [hν₁ : finite_measure ν₁]
  [hμ₂ : finite_measure μ₂] [hν₂ : finite_measure ν₂]
  (h₁ : μ₁ ⊥ ν₁ ∧ s = @of_sub_measure _ _ μ₁ ν₁ hμ₁ hν₁)
  (h₂ : μ₂ ⊥ ν₂ ∧ s = @of_sub_measure _ _ μ₂ ν₂ hμ₂ hν₂) :
  μ₁ = μ₂ ∧ ν₁ = ν₂ :=
begin
  obtain ⟨S, hS₁, hS₂, hS₃, hS₄, hS₅⟩ :=
    exists_compl_positive_negative_of_exists_sigular_sub h₁,
  obtain ⟨T, hT₁, hT₂, hT₃, hT₄, hT₅⟩ :=
    exists_compl_positive_negative_of_exists_sigular_sub h₂,
  obtain ⟨hST₁, hST₂⟩ := of_symm_diff_compl_positive_negative hS₁.compl hT₁.compl
    ⟨hS₃, (compl_compl S).symm ▸ hS₂⟩ ⟨hT₃, (compl_compl T).symm ▸ hT₂⟩,

  rw [compl_compl, compl_compl] at hST₂,
  split,
  { refine measure_theory.measure.ext (λ i hi, _),
    have hμ₁ : (μ₁ i).to_real = s (i ∩ Sᶜ),
    { rw [h₁.2, of_sub_measure_apply (hi.inter hS₁.compl),
          show ν₁ (i ∩ Sᶜ) = 0, by exact nonpos_iff_eq_zero.1
            (hS₅ ▸ measure_mono (set.inter_subset_right _ _)),
          ennreal.zero_to_real, sub_zero],
      conv_lhs { rw ← set.inter_union_compl i S },
      rw [measure_union, show μ₁ (i ∩ S) = 0, by exact nonpos_iff_eq_zero.1
            (hS₄ ▸ 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 _ _) S.disjoint_compl) },
      { exact hi.inter hS₁ },
      { exact hi.inter hS₁.compl } },
    have hμ₂ : (μ₂ i).to_real = s (i ∩ Tᶜ),
    { rw [h₂.2, of_sub_measure_apply (hi.inter hT₁.compl),
          show ν₂ (i ∩ Tᶜ) = 0, by exact nonpos_iff_eq_zero.1
            (hT₅ ▸ measure_mono (set.inter_subset_right _ _)),
          ennreal.zero_to_real, sub_zero],
      conv_lhs { rw ← set.inter_union_compl i T },
      rw [measure_union, show μ₂ (i ∩ T) = 0, by exact 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 _ _) T.disjoint_compl) },
      { exact hi.inter hT₁ },
      { exact hi.inter hT₁.compl } },
    rw [← ennreal.to_real_eq_to_real (measure_lt_top _ _) (measure_lt_top _ _),
        hμ₁, hμ₂],
    exact of_inter_eq_of_symm_diff_eq_zero_positive hS₁.compl hT₁.compl hi hS₃ hT₃ hST₁,
    all_goals { apply_instance } },

  { refine measure_theory.measure.ext (λ i hi, _),
    have hν₁ : (ν₁ i).to_real = - s (i ∩ S),
    { rw [h₁.2, of_sub_measure_apply (hi.inter hS₁),
          show μ₁ (i ∩ S) = 0, by exact nonpos_iff_eq_zero.1
            (hS₄ ▸ measure_mono (set.inter_subset_right _ _)),
          ennreal.zero_to_real, zero_sub],
      conv_lhs { rw ← set.inter_union_compl i S },
      rw [measure_union, show ν₁ (i ∩ Sᶜ) = 0, by exact nonpos_iff_eq_zero.1
            (hS₅ ▸ measure_mono (set.inter_subset_right _ _)), add_zero, neg_neg],
      { exact set.disjoint_of_subset_left (set.inter_subset_right _ _)
          (set.disjoint_of_subset_right (set.inter_subset_right _ _) S.disjoint_compl) },
      { exact hi.inter hS₁ },
      { exact hi.inter hS₁.compl } },
    have hν₂ : (ν₂ i).to_real = - s (i ∩ T),
    { rw [h₂.2, of_sub_measure_apply (hi.inter hT₁),
          show μ₂ (i ∩ T) = 0, by exact nonpos_iff_eq_zero.1
            (hT₄ ▸ measure_mono (set.inter_subset_right _ _)),
          ennreal.zero_to_real, zero_sub],
      conv_lhs { rw ← set.inter_union_compl i T },
      rw [measure_union, show ν₂ (i ∩ Tᶜ) = 0, by exact nonpos_iff_eq_zero.1
            (hT₅ ▸ measure_mono (set.inter_subset_right _ _)), add_zero, neg_neg],
      { exact set.disjoint_of_subset_left (set.inter_subset_right _ _)
          (set.disjoint_of_subset_right (set.inter_subset_right _ _) T.disjoint_compl) },
      { exact hi.inter hT₁ },
      { exact hi.inter hT₁.compl } },
    rw [← ennreal.to_real_eq_to_real (measure_lt_top _ _) (measure_lt_top _ _),
        hν₁, hν₂, neg_eq_iff_neg_eq, neg_neg],
    exact eq.symm (of_inter_eq_of_symm_diff_eq_zero_negative hS₁ hT₁ hi hS₂ hT₂ hST₂),
    all_goals { apply_instance } }
end

lemma measure.exists_measure_pos_of_measure_Union_pos (μ : measure α)
  (f : ℕ → set α) (hf : 0 < μ (⋃ n, f n)) :
  ∃ n, 0 < μ (f n) :=
begin
  by_contra, push_neg at h,
  simp_rw nonpos_iff_eq_zero at h,
  refine pos_iff_ne_zero.1 hf _,
  rw ← nonpos_iff_eq_zero,
  refine le_trans (measure_Union_le (λ (i : ℕ), f i)) _,
  rw nonpos_iff_eq_zero,
  convert tsum_zero,
  { ext1 n, exact h n },
  { apply_instance },
end

lemma exists_positive_of_sub_measure
  (μ ν : measure α) [finite_measure μ] [finite_measure ν] (h : ¬ μ ⊥ ν) :
  ∃ (ε : ℝ≥0) (hε : 0 < ε), ∃ (E : set α) (hE : measurable_set E) (hνE : 0 < ν E),
  (of_sub_measure μ (ε • ν)).positive E :=
begin
  have : ∀ n : ℕ, ∃ (i : set α) (hi₁ : measurable_set i),
    (of_sub_measure μ ((1 / (n + 1) : ℝ≥0) • ν)).positive i ∧
    (of_sub_measure μ ((1 / (n + 1) : ℝ≥0) • ν)).negative iᶜ,
  { intro, exact exists_compl_positive_negative _ },

  choose f hf₁ hf₂ hf₃ using this,
  set A := ⋂ n, (f n)ᶜ with hA₁,

  have hAmeas : measurable_set A,
  { exact measurable_set.Inter (λ n, measurable_set.compl (hf₁ n)) },
  have hA₂ : ∀ n : ℕ, (of_sub_measure μ ((1 / (n + 1) : ℝ≥0) • ν)).negative A,
  { intro n, exact negative_subset_negative (hf₃ n) (set.Inter_subset _ _) },
  have hA₃ : ∀ n : ℕ, μ A ≤ (1 / (n + 1) : ℝ≥0) * ν A,
  { intro n,
    have := negative_nonpos_measure hAmeas (hA₂ n),
    rwa [of_sub_measure_apply hAmeas, sub_nonpos, ennreal.to_real_le_to_real] at this,
    exacts [ne_of_lt (measure_lt_top _ _), ne_of_lt (measure_lt_top _ _)] },
  have hμ : μ A = 0,
  { apply @ennreal.eq_zero_of_le_one_div_nat_plus_one (μ A) (ν A) _ _,
    { intro n, convert hA₃ n, simp },
    { exact ne_of_lt (measure_lt_top _ _) },
    { exact ne_of_lt (measure_lt_top _ _) } },

  rw measure.singular at h,
  push_neg at h,
  have := h _ hAmeas hμ,
  simp_rw [hA₁, set.compl_Inter, compl_compl] at this,
  obtain ⟨n, hn⟩ := measure.exists_measure_pos_of_measure_Union_pos ν _
    (pos_iff_ne_zero.mpr this),
  exact ⟨1 / (n + 1), by simp, f n, hf₁ n, hn, hf₂ n⟩,
end

/-- Given two measures `μ` and `ν`, `measurable_le μ ν` is the set of measurable
functions `f`, such that, for all measurable sets `A`, `∫⁻ x in A, f x ∂μ ≤ ν A`.

This is useful for the Lebesgue decomposition theorem. -/
def measurable_le (μ ν : measure α) : set (α → ℝ≥0∞) :=
{ f | measurable f ∧ ∀ (A : set α) (hA : measurable_set A), ∫⁻ x in A, f x ∂μ ≤ ν A }

lemma zero_mem_measurable_le : (0 : α → ℝ≥0∞) ∈ measurable_le μ ν :=
⟨measurable_zero, λ A hA, by simp⟩

lemma min_mem_measurable_le (f g : α → ℝ≥0∞)
  (hf : f ∈ measurable_le μ ν) (hg : measurable g) :
  (λ a, min (f a) (g a)) ∈ measurable_le μ ν :=
⟨measurable.min hf.1 hg,
  λ A hA, le_trans (lintegral_mono (λ _, min_le_left _ _)) (hf.2 A hA)⟩

lemma min_mem_measurable_le' (f g : α → ℝ≥0∞)
  (hf : f ∈ measurable_le μ ν) (hg : g ∈ measurable_le μ ν) :
  (λ a, min (f a) (g a)) ∈ measurable_le μ ν :=
min_mem_measurable_le f g hf hg.1

lemma max_mem_measurable_le (f g : α → ℝ≥0∞)
  (hf : f ∈ measurable_le μ ν) (hg : g ∈ measurable_le μ ν)
  (A : set α) (hA : measurable_set A):
  ∫⁻ a in A, max (f a) (g a) ∂μ
    ≤ ∫⁻ a in A ∩ { a | f a ≤ g a }, g a ∂μ
    + ∫⁻ a in A ∩ { a | g a < f a }, f a ∂μ :=
begin
  rw [← lintegral_indicator _ hA, ← lintegral_indicator f,
      ← lintegral_indicator g, ← lintegral_add],
  { refine lintegral_mono (λ a, _),
    by_cases haA : a ∈ A,
    { by_cases f a ≤ g a,
      { simp only,
        rw [set.indicator_of_mem haA, set.indicator_of_mem, set.indicator_of_not_mem, add_zero],
        simp only [le_refl, max_le_iff, and_true, h],
        { rintro ⟨_, hc⟩,
          exact false.elim ((not_lt.2 h) hc) },
        { exact ⟨haA, h⟩ } },
      { simp only,
        rw [set.indicator_of_mem haA, set.indicator_of_mem _ f,
            set.indicator_of_not_mem, zero_add],
        simp only [true_and, le_refl, max_le_iff, le_of_lt (not_le.1 h)],
        { rintro ⟨_, hc⟩,
          exact false.elim (h hc) },
        { exact ⟨haA, not_le.1 h⟩ } } },
    { simp [set.indicator_of_not_mem haA] } },
  { exact measurable.indicator hg.1 (measurable_set.inter hA (measurable_set_le hf.1 hg.1)) },
  { exact measurable.indicator hf.1 (measurable_set.inter hA (measurable_set_lt hg.1 hf.1)) },
  { exact measurable_set.inter hA (measurable_set_le hf.1 hg.1) },
  { exact measurable_set.inter hA (measurable_set_lt hg.1 hf.1) },
end

lemma sup_mem_measurable_le {f g : α → ℝ≥0∞}
  (hf : f ∈ measurable_le μ ν) (hg : g ∈ measurable_le μ ν) :
  (λ a, f a ⊔ g a) ∈ measurable_le μ ν :=
begin
  simp_rw ennreal.sup_eq_max,
  refine ⟨measurable.max hf.1 hg.1, λ A hA, _⟩,
  have h₁ := measurable_set.inter hA (measurable_set_le hf.1 hg.1),
  have h₂ := measurable_set.inter hA (measurable_set_lt hg.1 hf.1),
  refine le_trans (max_mem_measurable_le f g hf hg A hA) _,
  refine le_trans (add_le_add (hg.2 _ h₁) (hf.2 _ h₂)) _,
  { rw [← measure_union _ h₁ h₂],
    { refine le_of_eq _,
      congr, convert set.inter_union_compl A _,
      ext a, simpa },
    rintro x ⟨⟨-, hx₁⟩, -, hx₂⟩,
    exact (not_le.2 hx₂) hx₁ }
end

lemma supr_succ_eq_sup {α} (f : ℕ → α → ℝ≥0∞) (m : ℕ) (a : α) :
  (⨆ (k : ℕ) (hk : k ≤ m + 1), f k a) = f m.succ a ⊔ ⨆ (k : ℕ) (hk : k ≤ m), f k a :=
begin
  ext x,
  simp only [option.mem_def, ennreal.some_eq_coe],
  split; intro h; rw ← h, symmetry,
  all_goals {
    set c := (⨆ (k : ℕ) (hk : k ≤ m + 1), f k a) with hc, -- What is going on?
    set d := (f m.succ a ⊔ ⨆ (k : ℕ) (hk : k ≤ m), f k a) with hd,
    suffices : c ≤ d ∧ d ≤ c,
    { change c = d, -- commenting this breaks?
      exact le_antisymm this.1 this.2 },
    rw [hc, hd],
    refine ⟨_, _⟩,
    { refine bsupr_le (λ n hn, _),
      rcases nat.of_le_succ hn with (h | h),
      { exact le_sup_of_le_right (le_bsupr n h) },
      { exact h ▸ le_sup_left } },
    { refine sup_le _ _,
      { convert @le_bsupr _ _ _ (λ i, i ≤ m + 1) _ m.succ (le_refl _), refl },
      { refine bsupr_le (λ n hn, _),
        have := (le_trans hn (nat.le_succ m)), -- repacing this breaks?
        exact (le_bsupr n this) } } },
end

lemma supr_mem_measurable_le
  (f : ℕ → α → ℝ≥0∞) (hf : ∀ n, f n ∈ measurable_le μ ν) (n : ℕ) :
  (λ x, ⨆ k (hk : k ≤ n), f k x) ∈ measurable_le μ ν :=
begin
  induction n with m hm,
  { refine ⟨_, _⟩,
    { simp [(hf 0).1] },
    { intros A hA, simp [(hf 0).2 A hA] } },
  { have : (λ (a : α), ⨆ (k : ℕ) (hk : k ≤ m + 1), f k a) =
      (λ a, f m.succ a ⊔ ⨆ (k : ℕ) (hk : k ≤ m), f k a),
    { exact funext (λ _, supr_succ_eq_sup _ _ _) },
    refine ⟨measurable_supr (λ n, measurable.supr_Prop _ (hf n).1), λ A hA, _⟩,
    rw this, exact (sup_mem_measurable_le (hf m.succ) hm).2 A hA }
end

lemma supr_mem_measurable_le'
  (f : ℕ → α → ℝ≥0∞) (hf : ∀ n, f n ∈ measurable_le μ ν) (n : ℕ) :
  (⨆ k (hk : k ≤ n), f k) ∈ measurable_le μ ν :=
begin
  convert supr_mem_measurable_le f hf n,
  ext, simp
end

lemma supr_monotone (f : ℕ → α → ℝ≥0∞) :
  monotone (λ n x, ⨆ k (hk : k ≤ n), f k x) :=
begin
  intros n m hnm x,
  simp only,
  refine bsupr_le (λ k hk, _),
  have : k ≤ m, exact le_trans hk hnm, -- same problem here
  exact le_bsupr k this,
end

lemma supr_monotone' (f : ℕ → α → ℝ≥0∞) (x : α) :
  monotone (λ n, ⨆ k (hk : k ≤ n), f k x) :=
λ n m hnm, supr_monotone f hnm x

lemma supr_le_le (f : ℕ → α → ℝ≥0∞) (n k : ℕ) (hk : k ≤ n) :
  f k ≤ λ x, ⨆ k (hk : k ≤ n), f k x :=
λ x, le_bsupr k hk

def M (μ ν : measure α) := (λ f : α → ℝ≥0∞, ∫⁻ x, f x ∂μ) '' measurable_le μ ν

lemma M_bdd_above : Sup (M μ ν) ≤ ν set.univ :=
begin
  refine Sup_le _,
  rintro _ ⟨f, ⟨hf₁, hf₂⟩, rfl⟩,
  simp only,
  rw ← lintegral_univ_eq,
  exact hf₂ set.univ measurable_set.univ,
end

variables [finite_measure μ] [finite_measure ν]

local infix ` . `:max := measure.with_density

section

open filter

lemma tendsto_supr_le (f : ℕ → α → ℝ≥0∞) (x : α) :
  tendsto (λ n, ⨆ k (hk : k ≤ n), f k x) at_top (nhds  ⨆ n k (hk : k ≤ n), f k x) :=
tendsto_at_top_supr (supr_monotone' f x)

end

lemma finite_measure_of_finite_lintegral
  {f : α → ℝ≥0∞} (hf : ∫⁻ a, f a ∂μ < ∞) : finite_measure (μ . f) :=
{ measure_univ_lt_top := by rwa [with_density_apply _ measurable_set.univ, lintegral_univ_eq] }

lemma ennreal.to_real_sub_of_le {a b : ℝ≥0∞} (h : b ≤ a) (ha : a ≠ ∞):
  (a - b).to_real = a.to_real - b.to_real :=
begin
  lift b to ℝ≥0 using ne_top_of_le_ne_top ha h,
  lift a to ℝ≥0 using ha,
  simp only [← ennreal.coe_sub, ennreal.coe_to_real, nnreal.coe_sub (ennreal.coe_le_coe.mp h)],
end

example (a b c : ℝ) (h : b = c) : b + a = c + a :=
begin
  exact congr_fun (congr_arg has_add.add h) a,
end

lemma ennreal.lt_add_of_pos_right {a b : ℝ≥0∞} (hb : 0 < b) (ha : a ≠ ⊤): a < a + b :=
begin
  lift a to ℝ≥0 using ha,
  by_cases b = ⊤,
  { rw [h, ennreal.add_top],
    exact ennreal.coe_lt_top },
  { lift b to ℝ≥0 using h,
    rw [← ennreal.coe_add, ennreal.coe_lt_coe],
    refine lt_add_of_pos_right a (ennreal.coe_pos.mp hb) }
end

/-- The Lebesgue decomposition theorem: Given finite measures `μ` and `ν`, there exists
measures `ν₁`, `ν₂` such that `ν₁` is mutually singular to `μ` and there exists some
`f : α → ℝ≥0∞` such that `ν₂ = μ.with_density f`. -/
theorem exists_singular_with_density (μ ν : measure α) [finite_measure μ] [finite_measure ν] :
  ∃ (ν₁ ν₂ : measure α) [finite_measure ν₁] [finite_measure ν₂] (hν : ν = ν₁ + ν₂),
  ν₁ ⊥ μ ∧ ∃ (f : α → ℝ≥0∞) (hf : measurable f), ν₂ = μ . f :=
begin
  have h := @ennreal.exists_tendsto_Sup (M μ ν) _,
  { choose g hg₁ hg₂ using h,
    choose f hf₁ hf₂ using hg₁,

    set ζ := ⨆ n k (hk : k ≤ n), f k with hζ,
    have hζ₁ : Sup (M μ ν) = ∫⁻ a, ζ a ∂μ,
    { have := @lintegral_tendsto_of_tendsto_of_monotone _ _ μ
        (λ n, ⨆ k (hk : k ≤ n), f k) (⨆ n k (hk : k ≤ n), f k) _ _ _,
      { refine tendsto_nhds_unique _ this,
        refine tendsto_of_tendsto_of_tendsto_of_le_of_le hg₂ tendsto_const_nhds _ _,
        { intro n, rw ← hf₂ n,
          apply lintegral_mono,
          simp only [supr_apply, supr_le_le f n n (le_refl _)] },
        { intro n,
          exact le_Sup ⟨⨆ (k : ℕ) (hk : k ≤ n), f k, supr_mem_measurable_le' _ hf₁ _, rfl⟩ } },
      { intro n,
        refine measurable.ae_measurable _,
        convert (supr_mem_measurable_le _ hf₁ n).1,
        ext, simp },
      { refine filter.eventually_of_forall (λ a, _),
        simp [supr_monotone' f _] },
      { refine filter.eventually_of_forall (λ a, _),
        simp [tendsto_supr_le _ _] } },
    have hζm : measurable ζ,
      { convert measurable_supr (λ n, (supr_mem_measurable_le _ hf₁ n).1),
        ext, simp [hζ] },

    set ν₁ := ν - μ . ζ with hν₁,

    have hle : μ . ζ ≤ ν,
      { intros B hB,
        rw [hζ, with_density_apply _ hB],
        simp_rw [supr_apply],
        rw lintegral_supr (λ i, (supr_mem_measurable_le _ hf₁ i).1) (supr_monotone _),
        exact supr_le (λ i, (supr_mem_measurable_le _ hf₁ i).2 B hB) },
    haveI : finite_measure (μ . ζ) := by
      { refine finite_measure_of_finite_lintegral _,
        have hle' := hle set.univ measurable_set.univ,
        rw [with_density_apply _ measurable_set.univ, lintegral_univ_eq] at hle',
        exact lt_of_le_of_lt hle' (measure_lt_top _ _) },

    refine ⟨ν₁, μ . ζ, infer_instance, infer_instance, _, _, ζ, hζm, rfl⟩,
    { rw hν₁, ext1 A hA,
      rw [measure.coe_add, pi.add_apply, measure.sub_apply hA hle,
          add_comm, ennreal.add_sub_cancel_of_le (hle A hA)] },

    { by_contra,
      have hle : μ . ζ ≤ ν,
      { intros B hB,
        rw [hζ, with_density_apply _ hB],
        simp_rw [supr_apply],
        rw lintegral_supr (λ i, (supr_mem_measurable_le _ hf₁ i).1) (supr_monotone _),
        exact supr_le (λ i, (supr_mem_measurable_le _ hf₁ i).2 B hB) },
      haveI : finite_measure (μ . ζ) := by
      { refine finite_measure_of_finite_lintegral _,
        have hle' := hle set.univ measurable_set.univ,
        rw [with_density_apply _ measurable_set.univ, lintegral_univ_eq] at hle',
        exact lt_of_le_of_lt hle' (measure_lt_top _ _) },

      obtain ⟨ε, hε₁, E, hE₁, hE₂, hE₃⟩ := exists_positive_of_sub_measure ν₁ μ h,
      simp_rw hν₁ at hE₃,

      have hζle : ∀ A, measurable_set A → ∫⁻ a in A, ζ a ∂μ ≤ ν A,
      { intros A hA, rw hζ,
        simp_rw [supr_apply],
        rw lintegral_supr (λ n, (supr_mem_measurable_le _ hf₁ n).1) (supr_monotone _),
        exact supr_le (λ n, (supr_mem_measurable_le _ hf₁ n).2 A hA) },

      have hε₂ : ∀ A : set α, measurable_set A →
        ∫⁻ a in A ∩ E, ε + ζ a ∂μ ≤ ν (A ∩ E),
      { intros A hA,
        have := hE₃ (A ∩ E) (set.inter_subset_right _ _) (measurable_set.inter hA hE₁),
        rwa [of_sub_measure_apply (measurable_set.inter hA hE₁),
            measure.sub_apply (measurable_set.inter hA hE₁) hle,
            ennreal.to_real_sub_of_le _ (ne_of_lt (measure_lt_top _ _)), sub_nonneg,
            le_sub_iff_add_le, ← ennreal.to_real_add, ennreal.to_real_le_to_real,
            measure.coe_nnreal_smul, pi.smul_apply, with_density_apply,
            show ε • μ (A ∩ E) = (ε : ℝ≥0∞) * μ (A ∩ E), by refl,
            ← set_lintegral_const, ← lintegral_add measurable_const hζm] at this,
        { exact measurable_set.inter hA hE₁ },
        { rw [ne.def, ennreal.add_eq_top, not_or_distrib],
          exact ⟨ne_of_lt (measure_lt_top _ _), ne_of_lt (measure_lt_top _ _)⟩ },
        { exact ne_of_lt (measure_lt_top _ _) },
        { exact ne_of_lt (measure_lt_top _ _) },
        { exact ne_of_lt (measure_lt_top _ _) },
        { rw with_density_apply _ (measurable_set.inter hA hE₁),
          exact hζle (A ∩ E) (measurable_set.inter hA hE₁) },
        { apply_instance } },

      have hζε : ζ + E.indicator (λ _, ε) ∈ measurable_le μ ν,
      { refine ⟨measurable.add hζm (measurable.indicator measurable_const hE₁), λ A hA, _⟩,
        have : ∫⁻ a in A, (ζ + E.indicator (λ _, ε)) a ∂μ =
              ∫⁻ a in A ∩ E, ε + ζ a ∂μ + ∫⁻ a in A ∩ Eᶜ, ζ a ∂μ,
        { rw [lintegral_add measurable_const hζm, add_assoc,
              ← lintegral_union (measurable_set.inter hA hE₁)
                (measurable_set.inter hA (measurable_set.compl hE₁))
                (disjoint.mono (set.inter_subset_right _ _) (set.inter_subset_right _ _)
                E.disjoint_compl), set.inter_union_compl],
          simp_rw [pi.add_apply],
          rw [lintegral_add hζm (measurable.indicator measurable_const hE₁), add_comm],
          refine congr_fun (congr_arg has_add.add _) _,
          rw [set_lintegral_const, lintegral_indicator _ hE₁, set_lintegral_const,
              measure.restrict_apply hE₁, set.inter_comm] },
        conv_rhs { rw ← set.inter_union_compl A E },
        rw [this, measure_union (set.disjoint_inter_compl _ _) (measurable_set.inter hA hE₁)
          (measurable_set.inter hA (measurable_set.compl hE₁))],
        exact add_le_add (hε₂ A hA)
          (hζle (A ∩ Eᶜ) (measurable_set.inter hA (measurable_set.compl hE₁))) },

      have : ∫⁻ a, ζ a + E.indicator (λ _, ε) a ∂μ ≤ Sup (M μ ν),
      { exact le_Sup ⟨ζ + E.indicator (λ _, ε), hζε, rfl⟩ },

      refine not_lt.2 this _,
      rw [hζ₁, lintegral_add hζm (measurable.indicator (measurable_const) hE₁),
          lintegral_indicator _ hE₁, set_lintegral_const],
      refine ennreal.lt_add_of_pos_right (ennreal.mul_pos.2 ⟨ennreal.coe_pos.2 hε₁, hE₂⟩) _,
      rw [← lintegral_univ_eq, ← with_density_apply _ measurable_set.univ],
      exact ne_of_lt (measure_lt_top _ _) } },
  { exact ⟨0, 0, zero_mem_measurable_le, by simp⟩ },
end

lemma measure.eq_of_sub_measure_eq_zero (μ ν : measure α) [finite_measure μ] [finite_measure ν]
  (h : of_sub_measure μ ν = 0) : μ = ν :=
begin
  refine measure_theory.measure.ext (λ i hi, _),
  rw [← ennreal.to_real_eq_to_real (measure_lt_top _ _) (measure_lt_top _ _),
      ← sub_eq_zero, ← of_sub_measure_apply hi, h, zero_apply],
  all_goals { apply_instance }
end

-- duplicated `measure.with_density_absolutely_continuous` in `conditional`
lemma with_density.absolutely_continuous (f : α → ℝ≥0∞) : μ . f ≪ μ :=
begin
  refine measure.absolutely_continuous.mk (λ A hA h, _),
  rw with_density_apply _ hA,
  exact (measure.restrict_eq_zero.2 h).symm ▸ lintegral_zero_measure _,
end

/-- The Lebesgue decomposition is unique. -/
theorem singular_with_density_unique
  (ν₁ ν₂ μ₁ μ₂ : measure α)
  [finite_measure ν₁] [finite_measure ν₂] [finite_measure μ₁] [finite_measure μ₂]
  (hν : ν = ν₁ + ν₂) (hμ : ν = μ₁ + μ₂)
  (h₁ : ν₁ ⊥ μ ∧ ∃ (f : α → ℝ≥0∞) (hf : measurable f), ν₂ = μ . f)
  (h₂ : μ₁ ⊥ μ ∧ ∃ (f : α → ℝ≥0∞) (hf : measurable f), μ₂ = μ . f) :
  ν₁ = μ₁ ∧ ν₂ = μ₂ :=
begin
  obtain ⟨S, hS₁, hS₂, hS₃⟩ := h₁.1,
  obtain ⟨T, hT₁, hT₂, hT₃⟩ := h₂.1,

  have hsub : of_sub_measure ν₁ μ₁ = of_sub_measure μ₂ ν₂,
  { ext i hi,
    rw [of_sub_measure_apply hi, of_sub_measure_apply hi],
    suffices : (ν₁ i).to_real + (ν₂ i).to_real = (μ₁ i).to_real + (μ₂ i).to_real,
    { linarith },
    rw [← ennreal.to_real_add, ← ennreal.to_real_add, ennreal.to_real_eq_to_real,
        ← measure.add_apply, ← measure.add_apply, ← hν, ← hμ],
    { exact (ennreal.add_lt_top.2 ⟨measure_lt_top _ _, measure_lt_top _ _⟩) },
    { exact (ennreal.add_lt_top.2 ⟨measure_lt_top _ _, measure_lt_top _ _⟩) },
    all_goals { exact ne_of_lt (measure_lt_top _ _) } },
  have heq : ∀ A (hA : measurable_set A),
    of_sub_measure ν₁ μ₁ A = of_sub_measure ν₁ μ₁ (A ∩ (S ∩ T)ᶜ),
  { intros A hA,
    have : A = (A ∩ (S ∩ T)ᶜ) ∪ (A ∩ (S ∩ T)),
    { rw [← set.inter_union_distrib_left, set.compl_union_self, set.inter_univ] },
    conv_lhs { rw this },
    rw measure_of_union (disjoint.comm.1 (set.disjoint_inter_compl A (S ∩ T))),
    suffices : (of_sub_measure ν₁ μ₁) (A ∩ (S ∩ T)) = 0,
    { rw [this, add_zero] },
    rw [of_sub_measure_apply, sub_eq_zero, ennreal.to_real_eq_to_real],
    refine eq.trans (nonpos_iff_eq_zero.1 (hS₂ ▸ measure_mono _))
      (eq.symm ((nonpos_iff_eq_zero.1 (hT₂ ▸ measure_mono _)))),
    { rw [set.inter_comm, set.inter_assoc],
      exact set.inter_subset_left _ _ },
    { rw ← set.inter_assoc, exact set.inter_subset_right _ _ },
    { exact measure_lt_top _ _ },
    { exact measure_lt_top _ _ },
    measurability },
  have hν₂ : ν₂ ≪ μ,
  { obtain ⟨-, f, -, hf⟩ := h₁, rw hf,
    exact with_density.absolutely_continuous _ },
  have hμ₂ : μ₂ ≪ μ,
  { obtain ⟨-, f, -, hf⟩ := h₂, rw hf,
    exact with_density.absolutely_continuous _ },
  have hμinter : μ (S ∩ T)ᶜ = 0,
    { rw set.compl_inter,
      refine nonpos_iff_eq_zero.1 (le_trans (measure_union_le _ _) _),
      rw [hS₃, hT₃, add_zero],
      exact le_refl _ },

  suffices : of_sub_measure ν₁ μ₁ = 0,
  { refine ⟨measure.eq_of_sub_measure_eq_zero _ _ this,
            eq.symm (measure.eq_of_sub_measure_eq_zero _ _ _)⟩,
    rwa ← hsub },

  ext A hA,
  rw [heq A hA, hsub, of_sub_measure_apply, hν₂, hμ₂, ennreal.zero_to_real,
      sub_zero, zero_apply],
  { exact nonpos_iff_eq_zero.1 (hμinter ▸ measure_mono (set.inter_subset_right _ _)) },
  { exact nonpos_iff_eq_zero.1 (hμinter ▸ measure_mono (set.inter_subset_right _ _)) },
  { measurability }
end

/-- The Radon-Nikodym theorem: Given two finite measures `μ` and `ν`, if `ν` is absolutely
continuous with respect to `μ`, then there exists a measurable function `f` such that
`f` is the derivative of `ν` with respect to `μ`. -/
theorem exists_with_density_of_absolute_continuous
  (μ ν : measure α) [finite_measure μ] [finite_measure ν] (h : ν ≪ μ) :
  ∃ (f : α → ℝ≥0∞) (hf : measurable f), ν = μ . f :=
begin
  obtain ⟨ν₁, ν₂, _, _, hν, ⟨E, hE₁, hE₂, hE₃⟩, f, hf₁, hf₂⟩ :=
    exists_singular_with_density μ ν,
  have : ν₁ = 0,
  { apply le_antisymm,
    { intros A hA,
      suffices : ν₁ set.univ = 0,
      { rw [measure.coe_zero, pi.zero_apply, ← this],
        exact measure_mono (set.subset_univ _) },
      rw [← set.union_compl_self E, measure_union (set.disjoint_compl E) hE₁
            (measurable_set.compl hE₁), hE₂, zero_add],
      have : (ν₁ + ν₂) Eᶜ = ν Eᶜ, { rw hν },
      rw [measure.coe_add, pi.add_apply, h hE₃] at this,
      exact (add_eq_zero_iff.1 this).1 },
    { exact measure.zero_le _} },
  rw [this, zero_add] at hν,
  exact ⟨f, hf₁, hν.symm ▸ hf₂⟩,
end

end signed_measure


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

! This file was ported from Lean 3 source module number_theory.frobenius_number
! leanprover-community/mathlib commit 1126441d6bccf98c81214a0780c73d499f6721fe
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.ModEq
import Mathlib.GroupTheory.Submonoid.Basic
import Mathlib.GroupTheory.Submonoid.Membership
import Mathlib.Tactic.Ring
import Mathlib.Tactic.Zify

/-!
# Frobenius Number in Two Variables

In this file we first define a predicate for Frobenius numbers, then solve the 2-variable variant
of this problem.

## Theorem Statement

Given a finite set of relatively prime integers all greater than 1, their Frobenius number is the
largest positive integer that cannot be expressed as a sum of nonnegative multiples of these
integers. Here we show the Frobenius number of two relatively prime integers `m` and `n` greater
than 1 is `m * n - m - n`. This result is also known as the Chicken McNugget Theorem.

## Implementation Notes

First we define Frobenius numbers in general using `IsGreatest` and `AddSubmonoid.closure`. Then
we proceed to compute the Frobenius number of `m` and `n`.

For the upper bound, we begin with an auxiliary lemma showing `m * n` is not attainable, then show
`m * n - m - n` is not attainable. Then for the construction, we create a `k_1` which is `k mod n`
and `0 mod m`, then show it is at most `k`. Then `k_1` is a multiple of `m`, so `(k-k_1)`
is a multiple of n, and we're done.

## Tags

frobenius number, chicken mcnugget, chinese remainder theorem, add_submonoid.closure
-/

open Nat

/-- A natural number `n` is the **Frobenius number** of a set of natural numbers `s` if it is an
upper bound on the complement of the additive submonoid generated by `s`.
In other words, it is the largest number that can not be expressed as a sum of numbers in `s`. -/
def FrobeniusNumber (n : ℕ) (s : Set ℕ) : Prop :=
  IsGreatest { k | k ∉ AddSubmonoid.closure s } n
#align is_frobenius_number FrobeniusNumber

variable {m n : ℕ}

/-- The **Chicken Mcnugget theorem** stating that the Frobenius number
  of positive numbers `m` and `n` is `m * n - m - n`. -/
theorem frobeniusNumber_pair (cop : coprime m n) (hm : 1 < m) (hn : 1 < n) :
    FrobeniusNumber (m * n - m - n) {m, n} := by
  simp_rw [FrobeniusNumber, AddSubmonoid.mem_closure_pair]
  have hmn : m + n ≤ m * n := add_le_mul hm hn
  constructor
  · push_neg
    intro a b h
    apply cop.mul_add_mul_ne_mul (add_one_ne_zero a) (add_one_ne_zero b)
    simp only [Nat.sub_sub, smul_eq_mul] at h
    zify [hmn] at h ⊢
    rw [← sub_eq_zero] at h ⊢
    rw [← h]
    ring
  · intro k hk
    dsimp at hk
    contrapose! hk
    let x := chineseRemainder cop 0 k
    have hx : x.val < m * n := chineseRemainder_lt_mul cop 0 k (ne_bot_of_gt hm) (ne_bot_of_gt hn)
    suffices key : x.1 ≤ k
    · obtain ⟨a, ha⟩ := modEq_zero_iff_dvd.mp x.2.1
      obtain ⟨b, hb⟩ := (modEq_iff_dvd' key).mp x.2.2
      exact ⟨a, b, by rw [mul_comm, ← ha, mul_comm, ← hb, Nat.add_sub_of_le key]⟩
    refine' ModEq.le_of_lt_add x.2.2 (lt_of_le_of_lt _ (add_lt_add_right hk n))
    rw [Nat.sub_add_cancel (le_tsub_of_add_le_left hmn)]
    exact
      ModEq.le_of_lt_add
        (x.2.1.trans (modEq_zero_iff_dvd.mpr (Nat.dvd_sub' (dvd_mul_right m n) dvd_rfl)).symm)
        (lt_of_lt_of_le hx le_tsub_add)
#align is_frobenius_number_pair frobeniusNumber_pair


theorem Ex006(a b c : Prop): a ∨ b → a ∨ c → a ∨ (b ∧ c) :=
assume H1:a ∨ b,
  assume H2:a ∨ c,
  show a ∨ (b ∧ c), from or.elim H1
    (
      assume H :a,
      show a ∨ (b ∧ c), from or.inl H
    )
    (
      assume H: b,
      show a ∨ (b ∧ c), from or.elim H2
        (
          assume HH:a,
          show a ∨ (b ∧ c), from or.inl HH
        )
        (
          assume HH:c,
          have H3:b ∧ c, from and.intro H HH,
          show a ∨ (b ∧ c), from or.inr H3
        )
    )


import data.real.basic

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

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

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

def cauchy_sequence (u : ℕ → ℝ) := ∀ ε > 0, ∃ N, ∀ p q, p ≥ N → q ≥ N → |u p - u q| ≤ ε

example : (∃ l, seq_limit u l) → cauchy_sequence u :=
begin
  intros h eps eps_pos,
  cases h with l hl,
  rw seq_limit at hl,
  cases hl (eps/2) (by linarith) with N hN,
  use N,
  intros p q hp hq,
  calc |u p - u q| = |(u p - l)+(l - u q)| : by ring
              ... ≤ |u p - l| + |l - u q|  : by apply abs_add
              ... = |u p - l| + |u q - l|  : by rw abs_sub l (u q)
              ... ≤ eps/2 + eps/2          : by linarith [hN p hp, hN q hq]
              ... = eps                    : by ring,
end


-- absoluto_resta.lean
-- Si a, b ∈ ℝ, entonces |a| - |b| ≤ |a - b|
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 5-octubre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Sean a y b números reales. Demostrar que
--    |a| - |b| ≤ |a - b|
-- ----------------------------------------------------------------------

import data.real.basic

variables a b : ℝ

example : |a| - |b| ≤ |a - b| :=
calc |a| - |b|
     = |a - b + b| - |b|     : by simp
 ... ≤ (|a - b| + |b|) - |b| : sub_le_sub_right (abs_add (a - b) b) (|b|)
 ... = |a - b|               : add_sub_cancel (|a - b|) (|b|)


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import topology.local_extr
import topology.order.basic

/-!
# Maximum/minimum on the closure of a set

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

In this file we prove several versions of the following statement: if `f : X → Y` has a (local or
not) maximum (or minimum) on a set `s` at a point `a` and is continuous on the closure of `s`, then
`f` has an extremum of the same type on `closure s` at `a`.
-/

open filter set
open_locale topology

variables {X Y : Type*} [topological_space X] [topological_space Y] [preorder Y]
  [order_closed_topology Y] {f g : X → Y} {s : set X} {a : X}

protected lemma is_max_on.closure (h : is_max_on f s a) (hc : continuous_on f (closure s)) :
  is_max_on f (closure s) a :=
λ x hx, continuous_within_at.closure_le hx ((hc x hx).mono subset_closure)
  continuous_within_at_const h

protected lemma is_min_on.closure (h : is_min_on f s a) (hc : continuous_on f (closure s)) :
  is_min_on f (closure s) a :=
h.dual.closure hc

protected lemma is_extr_on.closure (h : is_extr_on f s a) (hc : continuous_on f (closure s)) :
  is_extr_on f (closure s) a :=
h.elim (λ h, or.inl $ h.closure hc) (λ h, or.inr $ h.closure hc)

protected lemma is_local_max_on.closure (h : is_local_max_on f s a)
  (hc : continuous_on f (closure s)) :
  is_local_max_on f (closure s) a :=
begin
  rcases mem_nhds_within.1 h with ⟨U, Uo, aU, hU⟩,
  refine mem_nhds_within.2 ⟨U, Uo, aU, _⟩,
  rintro x ⟨hxU, hxs⟩,
  refine continuous_within_at.closure_le _ _ continuous_within_at_const hU,
  { rwa [mem_closure_iff_nhds_within_ne_bot, nhds_within_inter_of_mem,
      ← mem_closure_iff_nhds_within_ne_bot],
    exact nhds_within_le_nhds (Uo.mem_nhds hxU) },
  { exact (hc _ hxs).mono ((inter_subset_right _ _).trans subset_closure) }
end

protected lemma is_local_min_on.closure (h : is_local_min_on f s a)
  (hc : continuous_on f (closure s)) :
  is_local_min_on f (closure s) a :=
is_local_max_on.closure h.dual hc

protected lemma is_local_extr_on.closure (h : is_local_extr_on f s a)
  (hc : continuous_on f (closure s)) :
  is_local_extr_on f (closure s) a :=
h.elim (λ h, or.inl $ h.closure hc) (λ h, or.inr $ h.closure hc)