universe u v

namespace List
  def prop_contains {α : Type u} : List α → α → Prop
    | [], _ => False
    | (x :: xs), y => (x = y) ∨ (prop_contains xs y)

  def unique {α : Type u} : List α → Prop
    | [] => True
    | x :: xs => ¬(xs.prop_contains x) ∧ (unique xs)

  def constrain {α : Type u} :
    (xs : List α) →
    {constraint : α → Prop} →
    (∀ x:α, xs.prop_contains x → constraint x) →
    List {x : α // constraint x}
  | [], _, _ => []
  | (x :: xs), constraint, holds => (

    let holds_xs : (∀ y:α, xs.prop_contains y → constraint y) := (
      λ y xs_contains_y =>
      let xxs_contains_y : (x :: xs).prop_contains y := (
        Or.inr xs_contains_y
      )
      holds y xxs_contains_y
    )

    let holds_x : constraint x := (
      let xxs_contains_x : (x :: xs).prop_contains x := (
        Or.inl (Eq.refl x)
      )
      holds x xxs_contains_x
    )

    let tail_out := constrain xs holds_xs
    let head_out := ⟨ x , holds_x ⟩

    head_out :: tail_out
  )

  theorem length_constrain {α : Type u} :
    (xs : List α) →
    {constraint : α → Prop} →
    (holds : (∀ x:α, xs.prop_contains x → constraint x)) →
    length (constrain xs holds) = length xs
  | [], _, _ => Eq.refl 0
  | (x :: xs), constraint, holds => (

    let holds_xs : (∀ y:α, xs.prop_contains y → constraint y) := (
      λ y xs_contains_y =>
      let xxs_contains_y : (x :: xs).prop_contains y := (
        Or.inr xs_contains_y
      )
      holds y xxs_contains_y
    )

    congrArg (Nat.succ) (length_constrain xs holds_xs)
  )

  theorem contains_constrain {α : Type u} :
    (xs : List α) →
    {constraint : α → Prop} →
    (holds : (∀ x:α, xs.prop_contains x → constraint x)) →
    ∀ {y:α}, (holds_y : constraint y) →
    (
      (constrain xs holds).prop_contains ⟨y,holds_y⟩ ↔
      xs.prop_contains y
    )
    | xs, constraint, holds, y, holds_y => by
      induction xs
      case nil =>
        apply Iff.intro
        case mp =>
          intro contradiction
          exact contradiction
        case mpr =>
          intro contradiction
          exact contradiction
      case cons h =>
      apply Iff.intro
      case mp =>
        intro contains_after_constrain
        cases contains_after_constrain
        case inl is_head =>
          let x_eq_y : _ = y := congrArg Subtype.val is_head
          rw [x_eq_y.symm]
          apply Or.inl
          simp
        case inr in_tail =>
          apply Or.inr
          exact (h (
            λ x x_in_tail =>
            holds x (Or.inr x_in_tail)
          )).mp in_tail

      case mpr =>
        intro contains_before_constrain
        cases contains_before_constrain
        case inl is_head =>
          apply Or.inl
          exact Subtype.eq is_head
        case inr in_tail =>
          apply Or.inr
          exact (h (
            λ x x_in_tail =>
            holds x (Or.inr x_in_tail)
          )).mpr in_tail

  theorem unique_constrain {α : Type u} :
    (xs : List α) →
    {constraint : α → Prop} →
    (holds : (∀ x:α, xs.prop_contains x → constraint x)) →
    (
      unique (constrain xs holds) ↔
      unique xs
    )
  | [], _, _ => by
    constructor
    case mp =>
      intro _
      trivial
    case mpr =>
      intro _
      trivial
  | (x :: xs), constraint, holds => by

    let holds_xs : ∀ x0:α, xs.prop_contains x0 → constraint x0 := by
      intro x0
      intro xs_contains_x0
      exact holds x0 (Or.inr xs_contains_x0)
    let holds_x : constraint x := by
      apply holds x
      apply Or.inl
      exact Eq.refl x
    constructor
    case mp =>
      intro unique_xxs_constrained
      let unique_xs_constrained := unique_xxs_constrained.right
      let unique_xs := (xs.unique_constrain holds_xs).mp unique_xs_constrained
      let xs_lacks_x_constrained := unique_xxs_constrained.left
      constructor
      case left =>
        intro xs_contains_x
        let xs_contains_x_constrained := (xs.contains_constrain holds_xs holds_x).mpr xs_contains_x
        exact xs_lacks_x_constrained xs_contains_x_constrained
      case right =>
        exact unique_xs
    case mpr =>
      intro unique_xxs
      let unique_xs := unique_xxs.right
      let unique_xs_constrained := (xs.unique_constrain holds_xs).mpr unique_xs
      let xs_lacks_x := unique_xxs.left
      constructor
      case left =>
        intro xs_contains_x_constrained
        let xs_contains_x := (xs.contains_constrain holds_xs holds_x).mp xs_contains_x_constrained
        exact xs_lacks_x xs_contains_x
      case right =>
        exact unique_xs_constrained

  theorem unique_injection {α β : Type u} :
    (xs : List α) →
    {f : α → β} →
    (∀ x y, f x = f y → x = y) →
    xs.unique →
    (List.map f xs).unique
  | [], _, _, _ => trivial
  | (x::xs), f, injective, unique => by
    constructor
    case left =>
      intro fxs_contains_fx
      apply unique.left
      induction xs
      case nil =>
        trivial
      case cons y ys h =>
        cases fxs_contains_fx
        case inl fx_eq_fy =>
          apply Or.inl
          exact injective y x fx_eq_fy
        case inr fx_in_fys =>
          apply Or.inr
          let xys_unique : List.unique (x::ys) := by
            constructor
            case left =>
              intro x_in_ys
              apply unique.left
              apply Or.inr
              exact x_in_ys
            case right =>
              exact unique.right.right
          exact h xys_unique fx_in_fys
    case right =>
      exact xs.unique_injection injective unique.right

  theorem contains_injection {α β : Type u} :
    (xs : List α) →
    {f : α → β} →
    (∀ x y, f x = f y → x = y) →
    ∀ x:α,
    (List.map f xs).prop_contains (f x) →
    xs.prop_contains x
  | [], _, _, _, impossible => impossible
  | (x::xs), f, injective, y, image_contains => by
    cases image_contains
    case inl fx_eq_fy =>
      apply Or.inl
      exact injective x y fx_eq_fy
    case inr image_tail_contains_y =>
      apply Or.inr
      exact xs.contains_injection injective y image_tail_contains_y

  theorem get_set {α : Type u} :
    (xs : List α) →
    (i : Fin xs.length) →
    (val : α) →
    (xs.set i.val val).get ⟨i.val, by rw [xs.length_set i.val val]; exact i.isLt⟩ = val
  | x::xs, ⟨0, isLt⟩, val => by rfl
  | _::xs, ⟨i+1, lt_proof⟩, val => get_set xs ⟨i, (Nat.lt_of_succ_lt_succ lt_proof)⟩ val

  theorem get_set_ne {α : Type u} :
    (xs : List α) →
    (i j : Fin xs.length) →
    (val : α) →
    i ≠ j →
    xs.get j = (xs.set i.val val).get ⟨j.val, by rw [xs.length_set i.val val]; exact j.isLt⟩
  | x::xs, ⟨0, _⟩, ⟨_+1, _⟩, _, _ => by rfl
  | x::xs, ⟨_+1, _⟩, ⟨0, _⟩, _, _ => by rfl
  | _::xs, ⟨i+1, hi⟩, ⟨j+1, hj⟩, val, si_ne_sj => (
    get_set_ne xs ⟨i, Nat.lt_of_succ_lt_succ hi⟩ ⟨j, Nat.lt_of_succ_lt_succ hj⟩
      val (
        λ si_eq_sj => si_ne_sj (Fin.eq_of_val_eq (
          congrArg Nat.succ (Fin.val_eq_of_eq si_eq_sj)
        ))
      )
  )

end List

#print List.set

theorem unique_saturated :
  {n : Nat} →
  {xs : List (Fin n)} → xs.unique →
  xs.length = n →
  ∀ x:Fin n, xs.prop_contains x
| 0, [], _, _ => (λ x => x.elim0)
| n+1, (x :: xs), uniqueness, maximal => (
  let xs_maximal : xs.length = n :=
    congrArg Nat.pred
      ((List.length_cons x xs).symm.trans maximal)

  let xs_lacks_x := uniqueness.left

  let xs_ne_x : ∀ x0:Fin n.succ, xs.prop_contains x0 → x0 ≠ x := by
    intro x0 xs_contains_x0 x0_eq_x
    apply xs_lacks_x
    rw [x0_eq_x.symm]
    exact xs_contains_x0

  let n_to_x_with_decidable : (x0 : {a : Fin (n+1) // a ≠ x}) → Decidable (x0.val.val = n) →
    {a : Fin n // a.val = x0.val.val ∨ (a.val = x ∧ x0.val = n)}
  | ⟨x0, x0_ne_x⟩, isTrue x0_eq_n => (
      let x_ne_n : x.val ≠ n := by
        intro x_eq_n
        apply x0_ne_x
        apply Fin.eq_of_val_eq
        rw [x0_eq_n, x_eq_n]
      let x_at_most_n : x.val ≤ n := Nat.le_of_lt_succ x.isLt
      let x_under_n : x.val < n := Nat.lt_of_le_of_ne x_at_most_n (x_ne_n)
      ⟨⟨x, x_under_n⟩, Or.inr ⟨Eq.refl x.val, x0_eq_n⟩⟩
    )
  | ⟨x0, x0_ne_x⟩, isFalse x0_ne_n => (
      let x0_at_most_n : x0.val ≤ n := Nat.le_of_lt_succ x0.isLt
      let x0_under_n : x0.val < n := Nat.lt_of_le_of_ne x0_at_most_n (x0_ne_n)
      ⟨⟨x0, x0_under_n⟩, Or.inl (Eq.refl x0.val)⟩
    )

  let n_to_x : (x0 : {a : Fin (n+1) // a ≠ x}) → Fin n :=
    λ x0 => (n_to_x_with_decidable x0 (x0.val.val.decEq n)).val

  let n_to_x_injective : ∀ y1 y2, n_to_x y1 = n_to_x y2 → y1 = y2 := by
    intro y1 y2
    intro fy1_eq_fy2
    cases (n_to_x_with_decidable y1 (y1.val.val.decEq n)).property
    case inl fy1_eq_y1 =>
      cases (n_to_x_with_decidable y2 (y2.val.val.decEq n)).property
      case inl fy2_eq_y2 =>
        apply Subtype.eq
        apply Fin.eq_of_val_eq
        rw [fy2_eq_y2.symm, fy1_eq_y1.symm]
        exact Fin.val_eq_of_eq fy1_eq_fy2
      case inr conj =>
        cases conj
        case intro fy2_eq_x y2_eq_n =>
        let fy1_eq_x := (Fin.val_eq_of_eq fy1_eq_fy2).trans fy2_eq_x
        let y1_eq_x := Fin.eq_of_val_eq (fy1_eq_y1.symm.trans fy1_eq_x)
        let impossible := y1.property y1_eq_x
        contradiction
    case inr conj =>
      cases conj
      case intro fy1_eq_x y1_eq_n =>
      cases (n_to_x_with_decidable y2 (y2.val.val.decEq n)).property
      case inl fy2_eq_y2 =>
        let fy2_eq_x := (Fin.val_eq_of_eq fy1_eq_fy2).symm.trans fy1_eq_x
        let y2_eq_x := Fin.eq_of_val_eq (fy2_eq_y2.symm.trans fy2_eq_x)
        let impossible := y2.property y2_eq_x
        contradiction
      case inr conj =>
      cases conj
      case intro fy2_eq_x y2_eq_n =>
        apply Subtype.eq
        apply Fin.eq_of_val_eq
        exact y1_eq_n.trans y2_eq_n.symm

  let xs_constrained : List (Fin n) := List.map n_to_x (xs.constrain xs_ne_x)

  let xs_constrained_maximal : xs_constrained.length = n := by
    rw [(xs.constrain xs_ne_x).length_map n_to_x]
    rw [xs.length_constrain xs_ne_x]
    exact xs_maximal

  let xs_constrained_unique : xs_constrained.unique := by
    apply (xs.constrain xs_ne_x).unique_injection n_to_x_injective
    apply (xs.unique_constrain xs_ne_x).mpr
    exact uniqueness.right

  λ y =>

  (x.val.decEq y).byCases (
    λ x_eq_y =>
    Or.inl (Fin.eq_of_val_eq x_eq_y)
  ) (
    λ x_ne_y =>
    let y_with_proof : {a : Fin (n+1) // a ≠ x} := ⟨y, (λ y_eq_x => x_ne_y (Fin.val_eq_of_eq y_eq_x.symm))⟩
    let z : Fin n := n_to_x y_with_proof
    let z_in_xs_constrained := unique_saturated xs_constrained_unique xs_constrained_maximal z
    let y_in_xs_mapped := (xs.constrain xs_ne_x).contains_injection n_to_x_injective y_with_proof z_in_xs_constrained
    let y_in_xs : xs.prop_contains y := (xs.contains_constrain xs_ne_x y_with_proof.property).mp y_in_xs_mapped
    Or.inr y_in_xs
  )
)

theorem pigeonhole_principle :
  {n : Nat} →
  {xs : List (Fin n)} → xs.unique →
  xs.length > n →
  False
| n, (x::xs), unique, too_big => (
  let xs_at_least_saturated := Nat.le_of_lt_succ too_big
  (Nat.eq_or_lt_of_le xs_at_least_saturated).elim (
    λ xs_saturated =>
    let x_in_xs := unique_saturated unique.right xs_saturated.symm x
    unique.left x_in_xs
  ) (
    λ xs_too_big =>
    pigeonhole_principle unique.right xs_too_big
  )
)


theorem add_left_cancel (t a b : mynat) : t + a = t + b → a = b :=
begin
rw add_comm t,
rw add_comm t,
exact add_right_cancel a t b,
end


import tactic.tidy

universe u

section necessary

parameter entity : Type u
parameter situation : Type u
parameter exist : entity → Prop
parameter obtain : situation → Prop
parameter cause : entity → situation → Prop
parameter necessary : Prop → Prop

def possible (p : Prop) := ¬ necessary (¬ p)

local notation `⋄` := possible
local notation `□` := necessary

def necessary (e : entity) := □ (exist e)

-- #check ∃ e, ⋄ (necessary e)

def contingent₁ (e : entity) :=
    ¬ □ (exist e) ∧ ⋄ (exist e)

def contingent₂ (s : situation) :=
    ¬ □ (obtain s) ∧ ⋄ (obtain s)

def has_causal_powers (e : entity) :=
    ∃ s, ⋄ (cause e s)

def causable (s : situation) :=
    ∃ e, ⋄ (cause e s)

def necessary_being (e : entity) :=
    necessary e ∧ has_causal_powers e

def something_uncausable :=
    (∃ s, contingent₂ s ∧ obtain s) →
    (∃ s, contingent₂ s ∧ obtain s ∧ ¬ causable s)

parameter h₁ : ¬ □ something_uncausable

include h₁
lemma c₁ : ⋄ ¬ something_uncausable :=
    by simp [possible, classical.not_not]; exact h₁

-- lemma c₂ : ¬ something_uncausable →
--           ∀ s, contingent₂ s →
--           obtain s →
--           causable s :=
-- begin
--     intros h s con obt,
-- end

-- theorem God :
-- ∃ (w : world) g : entity,
--  (necessary g)  ∧ (has_causal_powers g) :=

-- sorry

end necessary


import order.order_iso
import .lists

open lattice

/-- A filtration is a list of (not-strictly) increasing elements of the lattice -/
structure filtration (α) [preorder α] := (modules : list α) (c : list.chain' (≤) modules)

namespace filtration
  def le_pair (α) [has_le α] := { p : α × α // p.1 ≤ p.2}

  instance (α) [preorder α]: has_coe (filtration α) (list α) := ⟨ λ F, F.modules ⟩

  def factors_up {α} [bounded_lattice α] : filtration α → list (le_pair α)
  | ⟨ [],        _ ⟩ := []
  | ⟨ [x],       _ ⟩ := [⟨(x, ⊤), by simp⟩]
  | ⟨ (x::y::l), h ⟩ := ⟨ (x, y) , list.chain'_of_first_two h⟩ ::
                      (factors_up ⟨ (y::l), (list.chain'_desc_left h)⟩)

  @[simp]
  def factors {α} [bounded_lattice α] : filtration α → list (le_pair α)
  | ⟨ [], _ ⟩ := [ ⟨ (⊥ , ⊤) , by simp ⟩ ]
  | ⟨ (x::l) , h ⟩ := ⟨ (⊥ , x), by simp ⟩ :: factors_up ⟨ (x::l) , h ⟩

  @[simp]
  lemma factors_not_empty {α} [bounded_lattice α]:  Π (F : filtration α), F.factors ≠ []
  | ⟨ [], _ ⟩     := by simp
  | ⟨ (x::l), h ⟩ := by simp

  def map {α} {β} [preorder α] [preorder β] (f : ((≤) : α → α → Prop) ≃o ((≤) : β → β → Prop)) :
    filtration α → filtration β := λ F, {
      modules := list.map f F.modules,
      c := list.chain'_map_of_chain' f (λ a b, iff.elim_left (@order_iso.ord _ _ _ _ f a b)) F.c
    }

  def descend {α} [q : preorder α] (F : filtration α) (h : F.modules ≠ []) : list {x : α // x ≤ F.modules.last h} :=
    (list.map₄ (λ x, x ≤ F.modules.last h) F.modules (λ a h2, (
      @list.chain'_trans_last _ (≤) F.modules q.le_refl q.le_trans F.c h a h2 )))

  def pop_back'' {α} [preorder α] (F : filtration α) (h : F.modules ≠ []) :
    filtration {x // x ≤ F.modules.last h} := {
    modules := descend F h,
    c := begin
      intros,
      cases F,
      cases F_modules,
      exact absurd rfl h,
      unfold descend,
      exact list.chain'_map₄ _ (F_modules_hd :: F_modules_tl) _ F_c
    end
  }

  def pop_back' {α} [preorder α] (F : filtration α) (h : F.modules ≠ []) :
    filtration α := {
    modules := list.init F.modules,
    c := list.chain'_init _ F.c
  }

  def pop_back {α} [preorder α] (F : filtration α) (h : F.modules ≠ []) :
    filtration {x // x ≤ F.modules.last h} := pop_back' (pop_back'' F h) (by cases F; cases F_modules; contradiction; finish)

end filtration


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro
-/

import data.mv_polynomial.rename
import data.polynomial.algebra_map
import data.polynomial.lifts
import data.mv_polynomial.variables
import data.finsupp.fin
import logic.equiv.fin
import algebra.big_operators.fin

/-!
# Equivalences between polynomial rings

This file establishes a number of equivalences between polynomial rings,
based on equivalences between the underlying types.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type*` (indexing the variables)

+ `R : Type*` `[comm_semiring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `a : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

## Tags

equivalence, isomorphism, morphism, ring hom, hom

-/

noncomputable theory

open_locale classical big_operators polynomial

open set function finsupp add_monoid_algebra

universes u v w x
variables {R : Type u} {S₁ : Type v} {S₂ : Type w} {S₃ : Type x}

namespace mv_polynomial
variables {σ : Type*} {a a' a₁ a₂ : R} {e : ℕ} {s : σ →₀ ℕ}

section equiv

variables (R) [comm_semiring R]

/--
The ring isomorphism between multivariable polynomials in a single variable and
polynomials over the ground ring.
-/
@[simps]
def punit_alg_equiv : mv_polynomial punit R ≃ₐ[R] R[X] :=
{ to_fun    := eval₂ polynomial.C (λu:punit, polynomial.X),
  inv_fun   := polynomial.eval₂ mv_polynomial.C (X punit.star),
  left_inv  :=
    begin
      let f : R[X] →+* mv_polynomial punit R :=
        (polynomial.eval₂_ring_hom mv_polynomial.C (X punit.star)),
      let g : mv_polynomial punit R →+* R[X] :=
        (eval₂_hom polynomial.C (λu:punit, polynomial.X)),
      show ∀ p, f.comp g p = p,
      apply is_id,
      { ext a, dsimp, rw [eval₂_C, polynomial.eval₂_C] },
      { rintros ⟨⟩, dsimp, rw [eval₂_X, polynomial.eval₂_X] }
    end,
  right_inv := assume p, polynomial.induction_on p
    (assume a, by rw [polynomial.eval₂_C, mv_polynomial.eval₂_C])
    (assume p q hp hq, by rw [polynomial.eval₂_add, mv_polynomial.eval₂_add, hp, hq])
    (assume p n hp,
      by rw [polynomial.eval₂_mul, polynomial.eval₂_pow, polynomial.eval₂_X, polynomial.eval₂_C,
        eval₂_mul, eval₂_C, eval₂_pow, eval₂_X]),
  map_mul'  := λ _ _, eval₂_mul _ _,
  map_add'  := λ _ _, eval₂_add _ _,
  commutes' := λ _, eval₂_C _ _ _}

section map
variables {R} (σ)

/-- If `e : A ≃+* B` is an isomorphism of rings, then so is `map e`. -/
@[simps apply]
def map_equiv [comm_semiring S₁] [comm_semiring S₂] (e : S₁ ≃+* S₂) :
  mv_polynomial σ S₁ ≃+* mv_polynomial σ S₂ :=
{ to_fun    := map (e : S₁ →+* S₂),
  inv_fun   := map (e.symm : S₂ →+* S₁),
  left_inv  := map_left_inverse e.left_inv,
  right_inv := map_right_inverse e.right_inv,
  ..map (e : S₁ →+* S₂) }

@[simp] lemma map_equiv_refl :
  map_equiv σ (ring_equiv.refl R) = ring_equiv.refl _ :=
ring_equiv.ext map_id

@[simp] lemma map_equiv_symm [comm_semiring S₁] [comm_semiring S₂] (e : S₁ ≃+* S₂) :
  (map_equiv σ e).symm = map_equiv σ e.symm := rfl

@[simp] lemma map_equiv_trans [comm_semiring S₁] [comm_semiring S₂] [comm_semiring S₃]
  (e : S₁ ≃+* S₂) (f : S₂ ≃+* S₃) :
  (map_equiv σ e).trans (map_equiv σ f) = map_equiv σ (e.trans f) :=
ring_equiv.ext (map_map e f)

variables {A₁ A₂ A₃ : Type*} [comm_semiring A₁] [comm_semiring A₂] [comm_semiring A₃]
variables [algebra R A₁] [algebra R A₂] [algebra R A₃]

/-- If `e : A ≃ₐ[R] B` is an isomorphism of `R`-algebras, then so is `map e`. -/
@[simps apply]
def map_alg_equiv (e : A₁ ≃ₐ[R] A₂) :
  mv_polynomial σ A₁ ≃ₐ[R] mv_polynomial σ A₂ :=
{ to_fun := map (e : A₁ →+* A₂),
  ..map_alg_hom (e : A₁ →ₐ[R] A₂),
  ..map_equiv σ (e : A₁ ≃+* A₂) }

@[simp] lemma map_alg_equiv_refl :
  map_alg_equiv σ (alg_equiv.refl : A₁ ≃ₐ[R] A₁) = alg_equiv.refl :=
alg_equiv.ext map_id

@[simp] lemma map_alg_equiv_symm (e : A₁ ≃ₐ[R] A₂) :
  (map_alg_equiv σ e).symm = map_alg_equiv σ e.symm := rfl

@[simp] lemma map_alg_equiv_trans (e : A₁ ≃ₐ[R] A₂) (f : A₂ ≃ₐ[R] A₃) :
  (map_alg_equiv σ e).trans (map_alg_equiv σ f) = map_alg_equiv σ (e.trans f) :=
alg_equiv.ext (map_map e f)

end map

section
variables (S₁ S₂ S₃)

/--
The function from multivariable polynomials in a sum of two types,
to multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.

See `sum_ring_equiv` for the ring isomorphism.
-/
def sum_to_iter : mv_polynomial (S₁ ⊕ S₂) R →+* mv_polynomial S₁ (mv_polynomial S₂ R) :=
eval₂_hom (C.comp C) (λbc, sum.rec_on bc X (C ∘ X))

@[simp]
lemma sum_to_iter_C (a : R) : sum_to_iter R S₁ S₂ (C a) = C (C a) :=
eval₂_C _ _ a

@[simp]
lemma sum_to_iter_Xl (b : S₁) : sum_to_iter R S₁ S₂ (X (sum.inl b)) = X b :=
eval₂_X _ _ (sum.inl b)

@[simp]
lemma sum_to_iter_Xr (c : S₂) : sum_to_iter R S₁ S₂ (X (sum.inr c)) = C (X c) :=
eval₂_X _ _ (sum.inr c)

/--
The function from multivariable polynomials in one type,
with coefficents in multivariable polynomials in another type,
to multivariable polynomials in the sum of the two types.

See `sum_ring_equiv` for the ring isomorphism.
-/
def iter_to_sum : mv_polynomial S₁ (mv_polynomial S₂ R) →+* mv_polynomial (S₁ ⊕ S₂) R :=
eval₂_hom (eval₂_hom C (X ∘ sum.inr)) (X ∘ sum.inl)

lemma iter_to_sum_C_C (a : R) : iter_to_sum R S₁ S₂ (C (C a)) = C a :=
eq.trans (eval₂_C _ _ (C a)) (eval₂_C _ _ _)

lemma iter_to_sum_X (b : S₁) : iter_to_sum R S₁ S₂ (X b) = X (sum.inl b) :=
eval₂_X _ _ _

lemma iter_to_sum_C_X (c : S₂) : iter_to_sum R S₁ S₂ (C (X c)) = X (sum.inr c) :=
eq.trans (eval₂_C _ _ (X c)) (eval₂_X _ _ _)

variable (σ)

/-- The algebra isomorphism between multivariable polynomials in no variables
and the ground ring. -/
@[simps] def is_empty_alg_equiv [he : is_empty σ] : mv_polynomial σ R ≃ₐ[R] R :=
alg_equiv.of_alg_hom
  (aeval (is_empty.elim he))
  (algebra.of_id _ _)
  (by { ext, simp [algebra.of_id_apply, algebra_map_eq] })
  (by { ext i m, exact is_empty.elim' he i })

/-- The ring isomorphism between multivariable polynomials in no variables
and the ground ring. -/
@[simps] def is_empty_ring_equiv [he : is_empty σ] : mv_polynomial σ R ≃+* R :=
(is_empty_alg_equiv R σ).to_ring_equiv

variable {σ}

/-- A helper function for `sum_ring_equiv`. -/
@[simps]
def mv_polynomial_equiv_mv_polynomial [comm_semiring S₃]
  (f : mv_polynomial S₁ R →+* mv_polynomial S₂ S₃)
  (g : mv_polynomial S₂ S₃ →+* mv_polynomial S₁ R)
  (hfgC : (f.comp g).comp C = C)
  (hfgX : ∀n, f (g (X n)) = X n)
  (hgfC : (g.comp f).comp C = C)
  (hgfX : ∀n, g (f (X n)) = X n) :
  mv_polynomial S₁ R ≃+* mv_polynomial S₂ S₃ :=
{ to_fun    := f, inv_fun := g,
  left_inv  := is_id (ring_hom.comp _ _) hgfC hgfX,
  right_inv := is_id (ring_hom.comp _ _) hfgC hfgX,
  map_mul'  := f.map_mul,
  map_add'  := f.map_add }

/--
The ring isomorphism between multivariable polynomials in a sum of two types,
and multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.
-/
def sum_ring_equiv : mv_polynomial (S₁ ⊕ S₂) R ≃+* mv_polynomial S₁ (mv_polynomial S₂ R) :=
begin
  apply @mv_polynomial_equiv_mv_polynomial R (S₁ ⊕ S₂) _ _ _ _
    (sum_to_iter R S₁ S₂) (iter_to_sum R S₁ S₂),
  { refine ring_hom.ext (λ p, _),
    rw [ring_hom.comp_apply],
    convert hom_eq_hom ((sum_to_iter R S₁ S₂).comp ((iter_to_sum R S₁ S₂).comp C)) C _ _ p,
    { ext1 a, dsimp, rw [iter_to_sum_C_C R S₁ S₂, sum_to_iter_C R S₁ S₂] },
    { assume c, dsimp, rw [iter_to_sum_C_X R S₁ S₂, sum_to_iter_Xr R S₁ S₂] } },
  { assume b, rw [iter_to_sum_X R S₁ S₂, sum_to_iter_Xl R S₁ S₂] },
  { ext1 a, rw [ring_hom.comp_apply, ring_hom.comp_apply,
      sum_to_iter_C R S₁ S₂, iter_to_sum_C_C R S₁ S₂] },
  { assume n, cases n with b c,
    { rw [sum_to_iter_Xl, iter_to_sum_X] },
    { rw [sum_to_iter_Xr, iter_to_sum_C_X] } },
end

/--
The algebra isomorphism between multivariable polynomials in a sum of two types,
and multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.
-/
def sum_alg_equiv : mv_polynomial (S₁ ⊕ S₂) R ≃ₐ[R]
  mv_polynomial S₁ (mv_polynomial S₂ R) :=
{ commutes' := begin
    intro r,
    have A : algebra_map R (mv_polynomial S₁ (mv_polynomial S₂ R)) r = (C (C r) : _), by refl,
    have B : algebra_map R (mv_polynomial (S₁ ⊕ S₂) R) r = C r, by refl,
    simp only [sum_ring_equiv, sum_to_iter_C, mv_polynomial_equiv_mv_polynomial_apply,
      ring_equiv.to_fun_eq_coe, A, B],
  end,
  ..sum_ring_equiv R S₁ S₂ }

section

-- this speeds up typeclass search in the lemma below
local attribute [instance, priority 2000] is_scalar_tower.right

/--
The algebra isomorphism between multivariable polynomials in `option S₁` and
polynomials with coefficients in `mv_polynomial S₁ R`.
-/
@[simps] def option_equiv_left :
  mv_polynomial (option S₁) R ≃ₐ[R] polynomial (mv_polynomial S₁ R) :=
alg_equiv.of_alg_hom
  (mv_polynomial.aeval (λ o, o.elim polynomial.X (λ s, polynomial.C (X s))))
  (polynomial.aeval_tower (mv_polynomial.rename some) (X none))
  (by ext : 2; simp [← polynomial.C_eq_algebra_map])
  (by ext i : 2; cases i; simp)

end

/--
The algebra isomorphism between multivariable polynomials in `option S₁` and
multivariable polynomials with coefficients in polynomials.
-/
def option_equiv_right : mv_polynomial (option S₁) R ≃ₐ[R] mv_polynomial S₁ R[X] :=
alg_equiv.of_alg_hom
  (mv_polynomial.aeval (λ o, o.elim (C polynomial.X) X))
  (mv_polynomial.aeval_tower (polynomial.aeval (X none)) (λ i, X (option.some i)))
  begin
    ext : 2;
    simp only [mv_polynomial.algebra_map_eq, option.elim, alg_hom.coe_comp, alg_hom.id_comp,
      is_scalar_tower.coe_to_alg_hom', comp_app, aeval_tower_C, polynomial.aeval_X, aeval_X,
      option.elim, aeval_tower_X, alg_hom.coe_id, id.def, eq_self_iff_true, implies_true_iff],
  end
  begin
    ext ⟨i⟩ : 2;
    simp only [option.elim, alg_hom.coe_comp, comp_app, aeval_X, aeval_tower_C,
      polynomial.aeval_X, alg_hom.coe_id, id.def, aeval_tower_X],
  end

variables (n : ℕ)

/--
The algebra isomorphism between multivariable polynomials in `fin (n + 1)` and
polynomials over multivariable polynomials in `fin n`.
-/
def fin_succ_equiv :
  mv_polynomial (fin (n + 1)) R ≃ₐ[R] polynomial (mv_polynomial (fin n) R) :=
(rename_equiv R (fin_succ_equiv n)).trans
  (option_equiv_left R (fin n))

lemma fin_succ_equiv_eq :
  (fin_succ_equiv R n : mv_polynomial (fin (n + 1)) R →+* polynomial (mv_polynomial (fin n) R)) =
  eval₂_hom (polynomial.C.comp (C : R →+* mv_polynomial (fin n) R))
    (λ i : fin (n+1), fin.cases polynomial.X (λ k, polynomial.C (X k)) i) :=
begin
  ext : 2,
  { simp only [fin_succ_equiv, option_equiv_left_apply, aeval_C, alg_equiv.coe_trans,
      ring_hom.coe_coe, coe_eval₂_hom, comp_app, rename_equiv_apply, eval₂_C, ring_hom.coe_comp,
      rename_C],
    refl },
  { intro i,
    refine fin.cases _ _ i;
    simp [fin_succ_equiv] }
end

@[simp] lemma fin_succ_equiv_apply (p : mv_polynomial (fin (n + 1)) R) :
  fin_succ_equiv R n p =
  eval₂_hom (polynomial.C.comp (C : R →+* mv_polynomial (fin n) R))
    (λ i : fin (n+1), fin.cases polynomial.X (λ k, polynomial.C (X k)) i) p :=
by { rw ← fin_succ_equiv_eq, refl }

lemma fin_succ_equiv_comp_C_eq_C {R : Type u} [comm_semiring R] (n : ℕ) :
  (↑(mv_polynomial.fin_succ_equiv R n).symm : polynomial (mv_polynomial (fin n) R) →+* _).comp
    ((polynomial.C).comp (mv_polynomial.C))
    = (mv_polynomial.C : R →+* mv_polynomial (fin n.succ) R) :=
begin
  refine ring_hom.ext (λ x, _),
  rw ring_hom.comp_apply,
  refine (mv_polynomial.fin_succ_equiv R n).injective
    (trans ((mv_polynomial.fin_succ_equiv R n).apply_symm_apply _) _),
  simp only [mv_polynomial.fin_succ_equiv_apply, mv_polynomial.eval₂_hom_C],
end

variables {n} {R}

lemma fin_succ_equiv_X_zero :
  fin_succ_equiv R n (X 0) = polynomial.X := by simp

lemma fin_succ_equiv_X_succ {j : fin n} :
  fin_succ_equiv R n (X j.succ) = polynomial.C (X j) := by simp

/-- The coefficient of `m` in the `i`-th coefficient of `fin_succ_equiv R n f` equals the
    coefficient of `finsupp.cons i m` in `f`. -/
lemma fin_succ_equiv_coeff_coeff (m : fin n →₀ ℕ)
  (f : mv_polynomial (fin (n + 1)) R) (i : ℕ) :
  coeff m (polynomial.coeff (fin_succ_equiv R n f) i) = coeff (m.cons i) f :=
begin
  induction f using mv_polynomial.induction_on' with j r p q hp hq generalizing i m,
  swap,
  { simp only [(fin_succ_equiv R n).map_add, polynomial.coeff_add, coeff_add, hp, hq] },
  simp only [fin_succ_equiv_apply, coe_eval₂_hom, eval₂_monomial, ring_hom.coe_comp, prod_pow,
    polynomial.coeff_C_mul, coeff_C_mul, coeff_monomial,
    fin.prod_univ_succ, fin.cases_zero, fin.cases_succ, ← ring_hom.map_prod, ← ring_hom.map_pow],
  rw [← mul_boole, mul_comm (polynomial.X ^ j 0), polynomial.coeff_C_mul_X_pow], congr' 1,
  obtain rfl | hjmi := eq_or_ne j (m.cons i),
  { simpa only [cons_zero, cons_succ, if_pos rfl, monomial_eq, C_1, one_mul, prod_pow]
      using coeff_monomial m m (1:R), },
  { simp only [hjmi, if_false],
    obtain hij | rfl := ne_or_eq i (j 0),
    { simp only [hij, if_false, coeff_zero] },
    simp only [eq_self_iff_true, if_true],
    have hmj : m ≠ j.tail, { rintro rfl, rw [cons_tail] at hjmi, contradiction },
    simpa only [monomial_eq, C_1, one_mul, prod_pow, finsupp.tail_apply, if_neg hmj.symm]
      using coeff_monomial m j.tail (1:R), }
end

lemma coeff_eval_eq_eval_coeff (s' : fin n → R) (f : polynomial (mv_polynomial (fin n) R))
  (i : ℕ) : polynomial.coeff (polynomial.map (eval s') f) i = eval s' (polynomial.coeff f i) :=
by simp only [polynomial.coeff_map]

lemma support_coeff_fin_succ_equiv {f : mv_polynomial (fin (n + 1)) R} {i : ℕ}
  {m : fin n →₀ ℕ } : m ∈ (polynomial.coeff ((fin_succ_equiv R n) f) i).support
   ↔ (finsupp.cons i m) ∈ f.support :=
begin
  apply iff.intro,
  { intro h,
    simpa [←fin_succ_equiv_coeff_coeff] using h },
  { intro h,
    simpa [mem_support_iff, ←fin_succ_equiv_coeff_coeff m f i] using h },
end

lemma fin_succ_equiv_support (f : mv_polynomial (fin (n + 1)) R) :
  (fin_succ_equiv R n f).support = finset.image (λ m : fin (n + 1)→₀ ℕ, m 0) f.support :=
begin
  ext i,
  rw [polynomial.mem_support_iff, finset.mem_image, nonzero_iff_exists],
  split,
  { rintro ⟨m, hm⟩,
    refine ⟨cons i m, _, cons_zero _ _⟩,
    rw ← support_coeff_fin_succ_equiv,
    simpa using hm, },
  { rintro ⟨m, h, rfl⟩,
    refine ⟨tail m, _⟩,
    rwa [← coeff, ← mem_support_iff, support_coeff_fin_succ_equiv, cons_tail] },
end

lemma fin_succ_equiv_support' {f : mv_polynomial (fin (n + 1)) R} {i : ℕ} :
  finset.image (finsupp.cons i) (polynomial.coeff ((fin_succ_equiv R n) f) i).support
   = f.support.filter(λ m, m 0 = i) :=
begin
  ext m,
  rw [finset.mem_filter, finset.mem_image, mem_support_iff],
  conv_lhs
  { congr,
    funext,
    rw [mem_support_iff, fin_succ_equiv_coeff_coeff, ne.def] },
  split,
  { rintros ⟨m',⟨h, hm'⟩⟩,
    simp only [←hm'],
    exact ⟨h, by rw cons_zero⟩ },
  { intro h,
    use tail m,
    rw [← h.2, cons_tail],
    simp [h.1] }
end

lemma support_fin_succ_equiv_nonempty {f : mv_polynomial (fin (n + 1)) R} (h : f ≠ 0) :
  (fin_succ_equiv R n f).support.nonempty :=
begin
  by_contradiction c,
  simp only [finset.not_nonempty_iff_eq_empty, polynomial.support_eq_empty] at c,
  have t'' : (fin_succ_equiv R n f) ≠ 0,
  { let ii := (fin_succ_equiv R n).symm,
    have h' : f = 0 :=
      calc f = ii (fin_succ_equiv R n f) : by simpa only [ii, ←alg_equiv.inv_fun_eq_symm]
                                             using ((fin_succ_equiv R n).left_inv f).symm
      ...    = ii 0 : by rw c
      ...    = 0 : by simp,
    simpa [h'] using h },
  simpa [c] using h,
end

lemma degree_fin_succ_equiv {f : mv_polynomial (fin (n + 1)) R} (h : f ≠ 0) :
  (fin_succ_equiv R n f).degree = degree_of 0 f :=
begin
  have h' : (fin_succ_equiv R n f).support.sup (λ x , x)  = degree_of 0 f,
  { rw [degree_of_eq_sup, fin_succ_equiv_support f, finset.sup_image] },
  rw [polynomial.degree, ← h', finset.coe_sup_of_nonempty (support_fin_succ_equiv_nonempty h)],
  congr,
end

lemma nat_degree_fin_succ_equiv (f : mv_polynomial (fin (n + 1)) R) :
  (fin_succ_equiv R n f).nat_degree = degree_of 0 f :=
begin
  by_cases c : f = 0,
  { rw [c, (fin_succ_equiv R n).map_zero, polynomial.nat_degree_zero, degree_of_zero] },
  { rw [polynomial.nat_degree, degree_fin_succ_equiv (by simpa only [ne.def]) ],
    simp },
end

lemma degree_of_coeff_fin_succ_equiv (p : mv_polynomial (fin (n + 1)) R) (j : fin n)
  (i : ℕ) : degree_of j (polynomial.coeff (fin_succ_equiv R n p) i) ≤ degree_of j.succ p :=
begin
  rw [degree_of_eq_sup, degree_of_eq_sup, finset.sup_le_iff],
  intros m hm,
  rw ← finsupp.cons_succ j i m,
  convert finset.le_sup (support_coeff_fin_succ_equiv.1 hm),
  refl,
end

end

end equiv

end mv_polynomial


import measure_theory.function.conditional_expectation
import probability_theory.notation

noncomputable theory
open_locale classical measure_theory nnreal ennreal topological_space probability_theory

namespace measure_theory

/-- A `filtration` on measurable space `α` with σ-algebra `m` is a monotone
sequence of of sub-σ-algebras of `m`. -/
structure filtration (α ι : Type*) [preorder ι] (m : measurable_space α) :=
(seq : ι → measurable_space α)
(mono : monotone seq) (le : ∀ i : ι, seq i ≤ m)

instance {α ι : Type*} [preorder ι] {m : measurable_space α} :
  has_coe_to_fun (filtration α ι m) (λ _, ι → measurable_space α) :=
⟨λ f, f.seq⟩

open topological_space

variables {α β ι : Type*} {m : measurable_space α} [measurable_space β]
variables {E : Type*} [normed_group E] [measurable_space E]
  [second_countable_topology E] [normed_space ℝ E] [complete_space E] [borel_space E]

section

variables [preorder ι]

lemma measurable_set_of_filtration {f : filtration α ι m} {s : set α} {i : ι}
  (hs : measurable_set[f i] s) : measurable_set[m] s :=
f.le i s hs

/-- A measure is σ-finite with respect to filtration if it is σ-finite with respect
to all the sub-σ-algebra of the filtration. -/
class sigma_finite_filtration (μ : measure α) (f : filtration α ι m) : Prop :=
(sigma_finite : ∀ ⦃i : ι⦄, @sigma_finite α (f i) (μ.trim (f.le i)))

instance sigma_finite_of_sigma_finite_filtration (μ : measure α) (f : filtration α ι m)
  [hf : sigma_finite_filtration μ f] (i : ι) :
  @sigma_finite α (f i) (μ.trim (f.le i)) :=
by apply hf.sigma_finite -- can't exact here

/-- A sequence of functions `u` is adapted to a filtration `f` if for all `i`,
`u i` is `f i`-measurable. -/
def adapted (f : filtration α ι m) (u : ι → α → β) : Prop :=
∀ ⦃i : ι⦄, measurable[f i] (u i)

namespace filtration

/-- Given a sequence of functions, the natural filtration is the smallest sequence
of σ-algebras such that that sequence of functions is measurable with respect to
the filtration. -/
def natural (u : ι → α → β) (hum : ∀ i, measurable (u i)) : filtration α ι m :=
{ seq := λ i, ⨆ j ≤ i, measurable_space.comap (u j) infer_instance,
  mono := λ i j hij, bsupr_le_bsupr' $ λ k hk, le_trans hk hij,
  le := λ i, bsupr_le (λ j hj s hs, let ⟨t, ht, ht'⟩ := hs in ht' ▸ hum j ht) }

-- move -- does this exist?
lemma measurable_le {m m0 : measurable_space α} (hm : m ≤ m0) {f : α → β}
  (hf : measurable[m] f) : measurable[m0] f :=
λ s hs, hm _ (hf hs)

lemma adapted_natural {u : ι → α → β} (hum : ∀ i, measurable[m] (u i)) :
  adapted (natural u hum) u :=
λ i, measurable_le (le_bsupr_of_le i (le_refl i) (le_refl _)) (λ s hs, ⟨s, hs, rfl⟩)

end filtration

def is_martingale (μ : measure α) (f : filtration α ι m) (u : ι → Lp E 1 μ) : Prop :=
∀ ⦃i j : ι⦄, i ≤ j → ∀ ⦃s : set α⦄, measurable_set[f i] s →
  ∫ x in s, u i x ∂μ = ∫ x in s, u j x ∂μ

def is_submartingale [has_le E]
  (μ : measure α) (f : filtration α ι m) (u : ι → Lp E 1 μ) : Prop :=
∀ ⦃i j : ι⦄, i ≤ j → ∀ ⦃s : set α⦄, measurable_set[f i] s →
  ∫ x in s, u i x ∂μ ≤ ∫ x in s, u j x ∂μ

def is_supermartingale [has_le E]
  (μ : measure α) (f : filtration α ι m) (u : ι → Lp E 1 μ) : Prop :=
∀ ⦃i j : ι⦄, i ≤ j → ∀ ⦃s : set α⦄, measurable_set[f i] s →
  ∫ x in s, u j x ∂μ ≤ ∫ x in s, u i x ∂μ

variables {μ : measure α} {f : filtration α ι m}

section

variables {u : ι → Lp E 1 μ}

lemma is_martingale.is_submartingale [preorder E] (hu : is_martingale μ f u) :
  is_submartingale μ f u :=
λ _ _ hij _ hs, (hu hij hs).le

lemma is_martingale.is_supermartingale [preorder E] (hu : is_martingale μ f u) :
  is_supermartingale μ f u :=
λ _ _ hij _ hs, (hu hij hs).ge

lemma is_martingale_iff [partial_order E] :
  is_martingale μ f u ↔ is_submartingale μ f u ∧ is_supermartingale μ f u :=
⟨λ hu, ⟨hu.is_submartingale, hu.is_supermartingale⟩,
 λ ⟨hsub, hsup⟩ _ _ hij _ hs, le_antisymm (hsub hij hs) (hsup hij hs)⟩

lemma condexp_eq_of_is_martingale
  [sigma_finite_filtration μ f] (hum : is_martingale μ f u)
  {i j : ι} (hij : i ≤ j) (huim : measurable[f i] (u i)) :
  u i =ᵐ[μ] μ[u j | f.le i] :=
begin
  have hui : ∀ i, integrable (u i) μ,
  { intro i,
    erw [← mem_ℒp_one_iff_integrable, ← Lp.mem_Lp_iff_mem_ℒp],
    exact set_like.coe_mem _ },
  refine ae_eq_condexp_of_forall_set_integral_eq _ (hui j) _ _ _,
  { exact λ s hs hlt, (hui i).integrable_on },
  { exact λ s hs hlt, hum hij hs },
  { exact measurable.ae_measurable' huim }
end

-- The following lemma compiles but crashes lean sometimes.

-- lemma is_submartingale.neg [preorder E] [covariant_class E E (+) (≤)]
--   (hu : is_submartingale μ f u) :
--   is_supermartingale μ f (-u) :=
-- begin
--   intros _ _ hij _ hs,
--   rw [(_ : ∫ x in s, (-u) j x ∂μ = ∫ x in s, -u j x ∂μ),
--       (_ : ∫ x in s, (-u) i x ∂μ = ∫ x in s, -u i x ∂μ),
--       integral_neg, integral_neg, neg_le_neg_iff],
--   { exact hu hij hs },
--   { rw set_integral_congr_ae (measurable_set_of_filtration hs),
--     filter_upwards [Lp.coe_fn_neg (u i)],
--     intros, assumption },
--   { rw set_integral_congr_ae (measurable_set_of_filtration hs),
--     filter_upwards [Lp.coe_fn_neg (u j)],
--     intros, assumption },
-- end

-- lemma is_supermartingale.neg [preorder E] [covariant_class E E (+) (≤)]
--   (hu : is_supermartingale μ f u) :
--   is_submartingale μ f (-u) :=
-- begin
--   intros _ _ hij _ hs,
--   rw [(_ : ∫ x in s, (-u) j x ∂μ = ∫ x in s, -u j x ∂μ),
--       (_ : ∫ x in s, (-u) i x ∂μ = ∫ x in s, -u i x ∂μ),
--       integral_neg, integral_neg, neg_le_neg_iff],
--   { exact hu hij hs },
--   { rw set_integral_congr_ae (measurable_set_of_filtration hs),
--     filter_upwards [Lp.coe_fn_neg (u i)],
--     intros, assumption },
--   { rw set_integral_congr_ae (measurable_set_of_filtration hs),
--     filter_upwards [Lp.coe_fn_neg (u j)],
--     intros, assumption },
-- end

end

/-- A stopping time with respect to some filtration `f` is a function
`τ` such that for all `i`, the preimage of `{j | j ≤ i}` along `τ` is measurable
with respect to `f i`.

Intuitively, the stopping time `τ` describes some stopping rule such that at time
`i`, we may determine it with the information we have at time `i`. -/
def is_stopping_time (f : filtration α ι m) (τ : α → ι) :=
∀ i : ι, measurable_set[f i] $ {x | τ x ≤ i}

section

lemma is_stopping_time.measurable_set_eq
  {f : filtration α ℕ m} {τ : α → ℕ} (hτ : is_stopping_time f τ) (i : ℕ) :
  measurable_set[f i] $ {x | τ x = i} :=
begin
  cases i,
  { convert (hτ 0),
    simp only [set.set_of_eq_eq_singleton, le_zero_iff] },
  { rw (_ : {x | τ x = i + 1} = {x | τ x ≤ i + 1} \ {x | τ x ≤ i}),
    { exact @measurable_set.diff _ (f (i + 1)) _ _ (hτ (i + 1))
        (f.mono (nat.le_succ _) _ (hτ i)) },
    { ext, simp only [set.mem_diff, not_le, set.mem_set_of_eq],
      split,
      { intro h, simp [h] },
      { rintro ⟨h₁, h₂⟩,
        linarith } } }
end

lemma is_stopping_time_of_measurable_set_eq
  {f : filtration α ℕ m} {τ : α → ℕ} (hτ : ∀ i, measurable_set[f i] $ {x | τ x = i}) :
  is_stopping_time f τ :=
begin
  intro i,
  rw show {x | τ x ≤ i} = ⋃ k ≤ i, {x | τ x = k}, by { ext, simp },
  refine @measurable_set.bUnion _ _ (f i) _ _ (set.countable_encodable _) (λ k hk, _),
  exact f.mono hk _ (hτ k),
end

end

lemma is_stopping_time_const {f : filtration α ι m} (i : ι) :
  is_stopping_time f (λ x, i) :=
λ j, by simp

end

lemma is_stopping_time.max [linear_order ι] {f : filtration α ι m} {τ π : α → ι}
  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
  is_stopping_time f (λ x, max (τ x) (π x)) :=
begin
  intro i,
  simp_rw [max_le_iff, set.set_of_and],
  exact @measurable_set.inter _ (f i) _ _ (hτ i) (hπ i),
end

lemma is_stopping_time.min [linear_order ι] {f : filtration α ι m} {τ π : α → ι}
  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
  is_stopping_time f (λ x, min (τ x) (π x)) :=
begin
  intro i,
  simp_rw [min_le_iff, set.set_of_or],
  exact @measurable_set.union _ (f i) _ _ (hτ i) (hπ i),
end

lemma is_stopping_time.add_const
  [add_group ι] [preorder ι] [covariant_class ι ι (function.swap (+)) (≤)]
  [covariant_class ι ι (+) (≤)]
  {f : filtration α ι m} {τ : α → ι} (hτ : is_stopping_time f τ) {i : ι} (hi : 0 ≤ i) :
  is_stopping_time f (λ x, τ x + i) :=
begin
  intro j,
  simp_rw [← le_sub_iff_add_le],
  exact f.mono (sub_le_self j hi) _ (hτ (j - i)),
end

section

variables [preorder ι] {f : filtration α ι m}

/-- Given a map `u : ι → α → E`, its stopped process with respect to the stopping
time `τ` is the map `(i, x) ↦ u (min i (τ x)) x`.

Intuitively, the stopped process stop evolving once the stopping time has occured. -/
def is_stopping_time.stopped_process {α ι : Type*} [linear_order ι]
  {m : measurable_space α} (f : filtration α ι m) (u : ι → α → E)
  {τ : α → ι} (hτ : is_stopping_time f τ) : ι → α → E :=
λ i x, u (min i (τ x)) x

def is_stopping_time.measurable_space (f : filtration α ι m)
  {τ : α → ι} (hτ : is_stopping_time f τ) : measurable_space α :=
{ measurable_set' := λ s, ∀ i : ι, measurable_set[f i] (s ∩ {x | τ x ≤ i}),
    measurable_set_empty :=
      λ i, (set.empty_inter {x | τ x ≤ i}).symm ▸ @measurable_set.empty _ (f i),
    measurable_set_compl := λ s hs i,
      begin
        rw (_ : sᶜ ∩ {x | τ x ≤ i} = (sᶜ ∪ {x | τ x ≤ i}ᶜ) ∩ {x | τ x ≤ i}),
        { refine @measurable_set.inter _ (f i) _ _ _ _,
          { rw ← set.compl_inter,
            exact @measurable_set.compl _ _ (f i) (hs i) },
          { exact hτ i} },
        { rw set.union_inter_distrib_right,
          simp only [set.compl_inter_self, set.union_empty] }
      end,
    measurable_set_Union := λ s hs i,
      begin
        rw forall_swap at hs,
        rw set.Union_inter,
        exact @measurable_set.Union _ _ (f i) _ _ (hs i),
      end }

lemma is_stopping_time.measurable_space_le [encodable ι] (f : filtration α ι m)
  {τ : α → ι} (hτ : is_stopping_time f τ) :
  hτ.measurable_space f ≤ m :=
begin
  intros s hs,
  change ∀ i, measurable_set[f i] (s ∩ {x | τ x ≤ i}) at hs,
  rw (_ : s = ⋃ i, s ∩ {x | τ x ≤ i}),
  { exact measurable_set.Union (λ i, f.le i _ (hs i)) },
  { ext x, split; rw set.mem_Union,
    { exact λ hx, ⟨τ x, hx, le_refl _⟩ },
    { rintro ⟨_, hx, _⟩,
      exact hx } }
end

-- instance is_stopping_time.sigma_finite
--   [encodable ι] {μ : measure α} [sigma_finite_filtration μ f]
--   (f : filtration α ι m) {τ : α → ι} (hτ : is_stopping_time f τ) (i : ι) :
--   @sigma_finite α (hτ.measurable_space f) (μ.trim (hτ.measurable_space_le f)) :=
-- begin
--   sorry
-- end

end

section

variables [encodable ι] [linear_order ι] {f : filtration α ι m} [has_le E]
  {μ : measure α} [sigma_finite_filtration μ f]

-- Is this the correct formulation
-- lemma foo {u : ι → Lp E 1 μ} (hu : is_supermartingale μ f u) {τ π : α → ι}
--   (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) (i : ι) :
--   μ[hτ.stopped_process f (λ i, u i) i | hπ.measurable_space_le f] =
--   (hτ.max hπ).stopped_process f (λ i, u i) i :=
-- begin
--   sorry
-- end

end

end measure_theory


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    assume (i j : ℤ) (h : i ≠ j),
    have h2 : α ≠ (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
      assume h3 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j),
      have h4 : α * ↑i = ↑(int.nat_abs (α * ↑i)) + int.fract (α * ↑i), from by {
        rw int.fract_eq_of_nat_abs_lt_one,
        have h5 : 0 < α * ↑i, from by {
          apply mul_pos,
          apply irrational.irrat_pos,
          exact hα_irrat,
          apply int.coe_nat_pos,
        },
        exact lt_of_le_of_lt (int.nat_abs_nonneg (α * ↑i)) h5,
      },
      have h6 : α * ↑j = ↑(int.nat_abs (α * ↑j)) + int.fract (α * ↑j), from by {
        rw int.fract_eq_of_nat_abs_lt_one,
        have h7 : 0 < α * ↑j, from by {
          apply mul_pos,
          apply irrational.irrat_pos,
          exact hα_irrat,
          apply int.coe_nat_pos,
        },
        exact lt_of_le_of_lt (int.nat_abs_nonneg (α * ↑j)) h7,
      },
      have h8 : (α * ↑i - α * ↑j) = (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) + (int.fract (α * ↑i) - int.fract (α * ↑j)), from by {
        rw [h4,h6],
        ring,
      },
      have h9 : (α * ↑i - α * ↑j) = (i - j) * α, from by {
        rw [← mul_sub,mul_comm,mul_comm ↑i α,mul_comm ↑j α],
      },
      have h10 : (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) = 0, from by {
        rw [← int.coe_nat_eq_coe_nat_iff,← int.coe_nat_eq_coe_nat_iff],
        rw [← int.nat_abs_of_nonneg,← int.nat_abs_of_nonneg],
        have h11 : 0 ≤ α * ↑i, from by {
          apply mul_nonneg,
          apply irrational.irrat_pos,
          exact hα_irrat,
          apply int.coe_nat_nonneg,
        },
        have h12 : 0 ≤ α * ↑j, from by {
          apply mul_nonneg,
          apply irrational.irrat_pos,
          exact hα_irrat,
          apply int.coe_nat_nonneg,
        },
        have h13 : 0 ≤ i, from by {
          apply int.coe_nat_nonneg,
        },
        have h14 : 0 ≤ j, from by {
          apply int.coe_nat_nonneg,
        },
        have h15 : 0 ≤ (i - j), from by {
          apply sub_nonneg,
          exact h13,
          exact h14,
        },
        have h16 : 0 ≤ (α * ↑i - α * ↑j), from by {
          apply sub_nonneg,
          exact h11,
          exact h12,
        },
        have h17 : (α * ↑i - α * ↑j) = (i - j) * α, from by {
          rw [← mul_sub,mul_comm,mul_comm ↑i α,mul_comm ↑j α],
        },
        have h18 : (α * ↑i - α * ↑j) = (i - j) * α, from by {
          rw [← mul_sub,mul_comm,mul_comm ↑i α,mul_comm ↑j α],
        },
        have h19 : (i - j) * α = 0, from by {
          rw [← h17,← h18],
          rw [← int.coe_nat_eq_coe_nat_iff,← int.coe_nat_eq_coe_nat_iff],
          rw [← int.nat_abs_of_nonneg,← int.nat_abs_of_nonneg],
          exact h16,
          exact h15,
        },
        have h20 : (i - j) = 0, from by {
          rw [← mul_eq_zero,mul_comm,mul_comm ↑i α,mul_comm ↑j α],
          exact h19,
          exact irrational.irrat_pos hα_irrat,
        },
        have h21 : i = j, from by {
          rw [← sub_eq_zero,← h20],
        },
        exact h21,
      },
      have h22 : (int.fract (α * ↑i) - int.fract (α * ↑j)) = 0, from by {
        rw [← int.coe_nat_eq_coe_nat_iff,← int.coe_nat_eq_coe_nat_iff],
        rw [← int.nat_abs_of_nonneg,← int.nat_abs_of_nonneg],
        have h23 : 0 ≤ α * ↑i, from by {
          apply mul_nonneg,
          apply irrational.irrat_pos,
          exact hα_irrat,
          apply int.coe_nat_nonneg,
        },
        have h24 : 0 ≤ α * ↑j, from by {
          apply mul_nonneg,
          apply irrational.irrat_pos,
          exact hα_irrat,
          apply int.coe_nat_nonneg,
        },
        have h25 : 0 ≤ (α * ↑i - α * ↑j), from by {
          apply sub_nonneg,
          exact h23,
          exact h24,
        },
        have h26 : (α * ↑i - α * ↑j) = (i - j) * α, from by {
          rw [← mul_sub,mul_comm,mul_comm ↑i α,mul_comm ↑j α],
        },
        have h27 : (α * ↑i - α * ↑j) = (i - j) * α, from by {
          rw [← mul_sub,mul_comm,mul_comm ↑i α,mul_comm ↑j α],
        },
        have h28 : (i - j) * α = 0, from by {
          rw [← h26,← h27],
          rw [← int.coe_nat_eq_coe_nat_iff,← int.coe_nat_eq_coe_nat_iff],
          rw [← int.nat_abs_of_nonneg,← int.nat_abs_of_nonneg],
          exact h25,
          exact h10,
        },
        have h29 : (i - j) = 0, from by {
          rw [← mul_eq_zero,mul_comm,mul_comm ↑i α,mul_comm ↑j α],
          exact h28,
          exact irrational.irrat_pos hα_irrat,
        },
        have h30 : i = j, from by {
          rw [← sub_eq_zero,← h29],
        },
        exact h30,
      },
      have h31 :
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α * ↑i - ↑(int.floor (α * ↑i)) = int.fract (α * ↑i), from by {rw ← h2, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (lt_add_one (α * ↑i)))),},
    have h4 : α * ↑j - ↑(int.floor (α * ↑j)) = int.fract (α * ↑j), from by {rw h2, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (lt_add_one (α * ↑j)))),},
    have h5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by {rw [h3,h4], ring,},
    have h6 : (i - j) ≠ 0, from by {intro h7, rw h7 at h, exact h rfl,},
    have h7 : (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j) ∈ ℚ, from by {rw h5, apply_instance,},
    have h8 : α ∈ ℚ, from by {rw h5, apply_instance,},
    exact hα_irrat h8,
  },

  --If this were not true, then
  --$$
  --i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
  --$$
  --which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  --Hence,
  --$$
  --S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  --$$
  --is an infinite subset of $\left[0,1\right]$.
  have h2 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α * ↑i - ↑(int.floor (α * ↑i)) = int.fract (α * ↑i), from by {rw ← h2, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (lt_add_one (α * ↑i)))),},
    have h4 : α * ↑j - ↑(int.floor (α * ↑j)) = int.fract (α * ↑j), from by {rw h2, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (lt_add_one (α * ↑j)))),},
    have h5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by {rw [h3,h4], ring,},
    have h6 : (i - j) ≠ 0, from by {intro h7, rw h7 at h, exact h rfl,},
    have h7 : (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j) ∈ ℚ, from by {rw h5, apply_instance,},
    have h8 : α ∈ ℚ, from by {rw h5, apply_instance,},
    exact hα_irrat h8,
  },
  have h3 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α * ↑i - ↑(int.floor (α * ↑i)) = int.fract (α * ↑i), from by {rw ← h2, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (lt_add_one (α * ↑i)))),},
    have h4 : α * ↑j - ↑(int.floor (α * ↑j)) = int.fract (α * ↑j), from by {rw h2, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (lt_add_one (α * ↑j)))),},
    have h5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by {rw [h3,h4], ring,},
    have h6 : (i - j) ≠ 0, from by {intro h7, rw h7 at h, exact h rfl,},
    have h7 : (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j) ∈ ℚ, from by {rw h5, apply_instance,},
    have h8 : α ∈ ℚ, from by {rw h5, apply_instance,},
    exact hα_irrat h8,
  },
  have h4 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α * ↑i - ↑(int.floor (α * ↑i)) = int.fract (α * ↑i), from by {rw ← h2, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (lt_add_one (α * ↑i)))),},
    have h4 : α * ↑j - ↑(int.floor (α * ↑j)) = int.fract (α * ↑j), from by {rw h2, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (lt_add_one (α * ↑j)))),},
    have h5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by {rw [h3,h4], ring,},
    have h6 : (i - j) ≠ 0, from by {intro h7, rw h7 at h, exact h rfl,},
    have h7 : (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j) ∈ ℚ, from by {rw h5, apply_instance,},
    have h8 : α ∈ ℚ, from by {rw h5, apply_instance,},
    exact hα_irrat h8,
  },
  have h5 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α * ↑
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  -- $$
  -- i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
  -- $$
  -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
  -- $$
  -- S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  -- $$
  -- is an infinite subset of $\left[0,1\right]$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j h,
    have h2 : α = (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) / (i - j), from by {
      have h3 : α * ↑i = (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.nat_abs (α * ↑i) * ↑i), from by {
        rw int.fract_eq_of_nat_abs_lt_one,
        have h4 : (0 : ℝ) < (1 : ℝ), from by {exact zero_lt_one},
        have h5 : (0 : ℝ) < (α * ↑i), from by {apply mul_pos h4, exact int.coe_nat_pos.mpr (int.coe_nat_ne_zero_iff_pos.mpr h)},
        have h6 : (0 : ℝ) < int.nat_abs (α * ↑i), from by {apply int.nat_abs_pos.mpr h5},
        have h7 : (0 : ℝ) < int.nat_abs (α * ↑i) * ↑i, from by {apply mul_pos h6, exact int.coe_nat_pos.mpr (int.coe_nat_ne_zero_iff_pos.mpr h)},
        have h8 : (0 : ℝ) < int.nat_abs (α * ↑i) + (int.nat_abs (α * ↑i) * ↑i), from by {apply add_pos h6 h7},
        have h9 : (0 : ℝ) < (α * ↑i) - (int.fract (α * ↑i) + int.nat_abs (α * ↑i)), from by {rw ← int.fract_eq_of_nat_abs_lt_one, exact h8},
        have h10 : (0 : ℝ) < (α * ↑i) - (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)), from by {apply add_pos h9 h8},
        have h11 : (0 : ℝ) < (α * ↑i) - (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.nat_abs (α * ↑i) * ↑i), from by {apply add_pos h10 h7},
        have h12 : (0 : ℝ) < (α * ↑i) - (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.nat_abs (α * ↑i) * ↑i) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)), from by {apply add_pos h11 h8},
        have h13 : (0 : ℝ) < (α * ↑i) - (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.nat_abs (α * ↑i) * ↑i) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)), from by {apply add_pos h12 h8},
        have h14 : (0 : ℝ) < (α * ↑i) - (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.nat_abs (α * ↑i) * ↑i) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)), from by {apply add_pos h13 h8},
        have h15 : (0 : ℝ) < (α * ↑i) - (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.nat_abs (α * ↑i) * ↑i) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)), from by {apply add_pos h14 h8},
        have h16 : (0 : ℝ) < (α * ↑i) - (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.nat_abs (α * ↑i) * ↑i) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)), from by {apply add_pos h15 h8},
        have h17 : (0 : ℝ) < (α * ↑i) - (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.nat_abs (α * ↑i) * ↑i) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) + (int.fract (α * ↑i) + int.nat_abs (α * ↑i)), from by {apply add_pos h16 h8},
        have h18 : (0 : ℝ) < (α * ↑i) - (int
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by
  {
    intro x0,
    have h6 : |x0 - l| < ε ↔ ((x0 - l) < ε) ∧ ((l - x0) < ε),
    from abs_sub_lt_iff, rw h6,
    split,
    rintro ⟨ S_1, S_2 ⟩,
    split; linarith,
    rintro ⟨ S_3, S_4 ⟩,
    split; linarith,
    },

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that $\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$
  cases h2 ε h7 with N1 h8,

  --As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that $\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by {
    assume n h,
    split,
    exact lt_of_le_of_lt (le_max_left N1 N2) h,
    exact lt_of_le_of_lt (le_max_right N1 N2) h,
  },

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by {
    intros n h12,
    split,
    {

      have h13 := (h8 n (h10 n h12).left), rw h5 (y n) at h13,
      split,
      exact h13.left,
      exact (h4 n).left,
    },
    {
      have h14 := (h9 n (h10 n h12).right),rw h5 (z n) at h14,
      split,
      exact (h4 n).right,
      exact h14.right,
    },

  },

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by {
    intros n1 h16, cases (h11 n1 h16);
    split; linarith,
  },

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by {
    intros n h17,
    cases h5 (x n) with h18 h19,
    apply h19, exact h15 n h17,
  },
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


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

import group_theory.subgroup.basic

/-!
# Actions by `subgroup`s

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

These are just copies of the definitions about `submonoid` starting from `submonoid.mul_action`.

## Tags
subgroup, subgroups

-/

namespace subgroup

variables {G : Type*} [group G]
variables {α β : Type*}

/-- The action by a subgroup is the action by the underlying group. -/
@[to_additive /-"The additive action by an add_subgroup is the action by the underlying
add_group. "-/]
instance [mul_action G α] (S : subgroup G) : mul_action S α :=
S.to_submonoid.mul_action

@[to_additive]
lemma smul_def [mul_action G α] {S : subgroup G} (g : S) (m : α) : g • m = (g : G) • m := rfl

@[to_additive]
instance smul_comm_class_left
  [mul_action G β] [has_smul α β] [smul_comm_class G α β] (S : subgroup G) :
  smul_comm_class S α β :=
S.to_submonoid.smul_comm_class_left

@[to_additive]
instance smul_comm_class_right
  [has_smul α β] [mul_action G β] [smul_comm_class α G β] (S : subgroup G) :
  smul_comm_class α S β :=
S.to_submonoid.smul_comm_class_right

/-- Note that this provides `is_scalar_tower S G G` which is needed by `smul_mul_assoc`. -/
instance
  [has_smul α β] [mul_action G α] [mul_action G β] [is_scalar_tower G α β] (S : subgroup G) :
  is_scalar_tower S α β :=
S.to_submonoid.is_scalar_tower

instance [mul_action G α] [has_faithful_smul G α] (S : subgroup G) :
  has_faithful_smul S α :=
S.to_submonoid.has_faithful_smul

/-- The action by a subgroup is the action by the underlying group. -/
instance [add_monoid α] [distrib_mul_action G α] (S : subgroup G) : distrib_mul_action S α :=
S.to_submonoid.distrib_mul_action

/-- The action by a subgroup is the action by the underlying group. -/
instance [monoid α] [mul_distrib_mul_action G α] (S : subgroup G) : mul_distrib_mul_action S α :=
S.to_submonoid.mul_distrib_mul_action

/-- The center of a group acts commutatively on that group. -/
instance center.smul_comm_class_left : smul_comm_class (center G) G G :=
submonoid.center.smul_comm_class_left

/-- The center of a group acts commutatively on that group. -/
instance center.smul_comm_class_right : smul_comm_class G (center G) G :=
submonoid.center.smul_comm_class_right

end subgroup


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

! This file was ported from Lean 3 source module linear_algebra.unitary_group
! leanprover-community/mathlib commit 2705404e701abc6b3127da906f40bae062a169c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.GeneralLinearGroup
import Mathbin.LinearAlgebra.Matrix.ToLin
import Mathbin.LinearAlgebra.Matrix.NonsingularInverse
import Mathbin.Algebra.Star.Unitary

/-!
# The Unitary Group

This file defines elements of the unitary group `unitary_group n α`, where `α` is a `star_ring`.
This consists of all `n` by `n` matrices with entries in `α` such that the star-transpose is its
inverse. In addition, we define the group structure on `unitary_group n α`, and the embedding into
the general linear group `general_linear_group α (n → α)`.

We also define the orthogonal group `orthogonal_group n β`, where `β` is a `comm_ring`.

## Main Definitions

 * `matrix.unitary_group` is the type of matrices where the star-transpose is the inverse
 * `matrix.unitary_group.group` is the group structure (under multiplication)
 * `matrix.unitary_group.embedding_GL` is the embedding `unitary_group n α → GLₙ(α)`
 * `matrix.orthogonal_group` is the type of matrices where the transpose is the inverse

## References

 * https://en.wikipedia.org/wiki/Unitary_group

## Tags

matrix group, group, unitary group, orthogonal group

-/

universe u v

namespace Matrix

open LinearMap

open Matrix

section

variable (n : Type u) [DecidableEq n] [Fintype n]

variable (α : Type v) [CommRing α] [StarRing α]

/-- `unitary_group n` is the group of `n` by `n` matrices where the star-transpose is the inverse.
-/
abbrev unitaryGroup :=
  unitary (Matrix n n α)
#align matrix.unitary_group Matrix.unitaryGroup

end

variable {n : Type u} [DecidableEq n] [Fintype n]

variable {α : Type v} [CommRing α] [StarRing α]

theorem mem_unitaryGroup_iff {A : Matrix n n α} : A ∈ Matrix.unitaryGroup n α ↔ A * star A = 1 :=
  by
  refine' ⟨And.right, fun hA => ⟨_, hA⟩⟩
  simpa only [mul_eq_mul, mul_eq_one_comm] using hA
#align matrix.mem_unitary_group_iff Matrix.mem_unitaryGroup_iff

theorem mem_unitaryGroup_iff' {A : Matrix n n α} : A ∈ Matrix.unitaryGroup n α ↔ star A * A = 1 :=
  by
  refine' ⟨And.left, fun hA => ⟨hA, _⟩⟩
  rwa [mul_eq_mul, mul_eq_one_comm] at hA
#align matrix.mem_unitary_group_iff' Matrix.mem_unitaryGroup_iff'

theorem det_of_mem_unitary {A : Matrix n n α} (hA : A ∈ Matrix.unitaryGroup n α) :
    A.det ∈ unitary α := by
  constructor
  · simpa [star, det_transpose] using congr_arg det hA.1
  · simpa [star, det_transpose] using congr_arg det hA.2
#align matrix.det_of_mem_unitary Matrix.det_of_mem_unitary

namespace UnitaryGroup

instance coeMatrix : Coe (unitaryGroup n α) (Matrix n n α) :=
  ⟨Subtype.val⟩
#align matrix.unitary_group.coe_matrix Matrix.unitaryGroup.coeMatrix

instance coeFun : CoeFun (unitaryGroup n α) fun _ => n → n → α where coe A := A.val
#align matrix.unitary_group.coe_fun Matrix.unitaryGroup.coeFun

/-- `to_lin' A` is matrix multiplication of vectors by `A`, as a linear map.

After the group structure on `unitary_group n` is defined,
we show in `to_linear_equiv` that this gives a linear equivalence.
-/
def toLin' (A : unitaryGroup n α) :=
  Matrix.toLin' A
#align matrix.unitary_group.to_lin' Matrix.unitaryGroup.toLin'

theorem ext_iff (A B : unitaryGroup n α) : A = B ↔ ∀ i j, A i j = B i j :=
  Subtype.ext_iff_val.trans ⟨fun h i j => congr_fun (congr_fun h i) j, Matrix.ext⟩
#align matrix.unitary_group.ext_iff Matrix.unitaryGroup.ext_iff

@[ext]
theorem ext (A B : unitaryGroup n α) : (∀ i j, A i j = B i j) → A = B :=
  (unitaryGroup.ext_iff A B).mpr
#align matrix.unitary_group.ext Matrix.unitaryGroup.ext

@[simp]
theorem star_mul_self (A : unitaryGroup n α) : star A ⬝ A = 1 :=
  A.2.1
#align matrix.unitary_group.star_mul_self Matrix.unitaryGroup.star_mul_self

section CoeLemmas

variable (A B : unitaryGroup n α)

@[simp]
theorem inv_val : ↑A⁻¹ = (star A : Matrix n n α) :=
  rfl
#align matrix.unitary_group.inv_val Matrix.unitaryGroup.inv_val

@[simp]
theorem inv_apply : ⇑A⁻¹ = (star A : Matrix n n α) :=
  rfl
#align matrix.unitary_group.inv_apply Matrix.unitaryGroup.inv_apply

@[simp]
theorem mul_val : ↑(A * B) = A ⬝ B :=
  rfl
#align matrix.unitary_group.mul_val Matrix.unitaryGroup.mul_val

@[simp]
theorem mul_apply : ⇑(A * B) = A ⬝ B :=
  rfl
#align matrix.unitary_group.mul_apply Matrix.unitaryGroup.mul_apply

@[simp]
theorem one_val : ↑(1 : unitaryGroup n α) = (1 : Matrix n n α) :=
  rfl
#align matrix.unitary_group.one_val Matrix.unitaryGroup.one_val

@[simp]
theorem one_apply : ⇑(1 : unitaryGroup n α) = (1 : Matrix n n α) :=
  rfl
#align matrix.unitary_group.one_apply Matrix.unitaryGroup.one_apply

@[simp]
theorem toLin'_mul : toLin' (A * B) = (toLin' A).comp (toLin' B) :=
  Matrix.toLin'_mul A B
#align matrix.unitary_group.to_lin'_mul Matrix.unitaryGroup.toLin'_mul

@[simp]
theorem toLin'_one : toLin' (1 : unitaryGroup n α) = LinearMap.id :=
  Matrix.toLin'_one
#align matrix.unitary_group.to_lin'_one Matrix.unitaryGroup.toLin'_one

end CoeLemmas

/-- `to_linear_equiv A` is matrix multiplication of vectors by `A`, as a linear equivalence. -/
def toLinearEquiv (A : unitaryGroup n α) : (n → α) ≃ₗ[α] n → α :=
  { Matrix.toLin' A with
    invFun := toLin' A⁻¹
    left_inv := fun x =>
      calc
        (toLin' A⁻¹).comp (toLin' A) x = (toLin' (A⁻¹ * A)) x := by rw [← to_lin'_mul]
        _ = x := by rw [mul_left_inv, to_lin'_one, id_apply]

    right_inv := fun x =>
      calc
        (toLin' A).comp (toLin' A⁻¹) x = toLin' (A * A⁻¹) x := by rw [← to_lin'_mul]
        _ = x := by rw [mul_right_inv, to_lin'_one, id_apply]
         }
#align matrix.unitary_group.to_linear_equiv Matrix.unitaryGroup.toLinearEquiv

/-- `to_GL` is the map from the unitary group to the general linear group -/
def toGL (A : unitaryGroup n α) : GeneralLinearGroup α (n → α) :=
  GeneralLinearGroup.ofLinearEquiv (toLinearEquiv A)
#align matrix.unitary_group.to_GL Matrix.unitaryGroup.toGL

theorem coe_toGL (A : unitaryGroup n α) : ↑(toGL A) = toLin' A :=
  rfl
#align matrix.unitary_group.coe_to_GL Matrix.unitaryGroup.coe_toGL

@[simp]
theorem toGL_one : toGL (1 : unitaryGroup n α) = 1 :=
  by
  ext1 v i
  rw [coe_to_GL, to_lin'_one]
  rfl
#align matrix.unitary_group.to_GL_one Matrix.unitaryGroup.toGL_one

@[simp]
theorem toGL_mul (A B : unitaryGroup n α) : toGL (A * B) = toGL A * toGL B :=
  by
  ext1 v i
  rw [coe_to_GL, to_lin'_mul]
  rfl
#align matrix.unitary_group.to_GL_mul Matrix.unitaryGroup.toGL_mul

/-- `unitary_group.embedding_GL` is the embedding from `unitary_group n α`
to `general_linear_group n α`. -/
def embeddingGL : unitaryGroup n α →* GeneralLinearGroup α (n → α) :=
  ⟨fun A => toGL A, by simp, by simp⟩
#align matrix.unitary_group.embedding_GL Matrix.unitaryGroup.embeddingGL

end UnitaryGroup

section OrthogonalGroup

variable (n) (β : Type v) [CommRing β]

attribute [local instance] starRingOfComm

/-- `orthogonal_group n` is the group of `n` by `n` matrices where the transpose is the inverse.
-/
abbrev orthogonalGroup :=
  unitaryGroup n β
#align matrix.orthogonal_group Matrix.orthogonalGroup

theorem mem_orthogonalGroup_iff {A : Matrix n n β} :
    A ∈ Matrix.orthogonalGroup n β ↔ A * star A = 1 :=
  by
  refine' ⟨And.right, fun hA => ⟨_, hA⟩⟩
  simpa only [mul_eq_mul, mul_eq_one_comm] using hA
#align matrix.mem_orthogonal_group_iff Matrix.mem_orthogonalGroup_iff

theorem mem_orthogonalGroup_iff' {A : Matrix n n β} :
    A ∈ Matrix.orthogonalGroup n β ↔ star A * A = 1 :=
  by
  refine' ⟨And.left, fun hA => ⟨hA, _⟩⟩
  rwa [mul_eq_mul, mul_eq_one_comm] at hA
#align matrix.mem_orthogonal_group_iff' Matrix.mem_orthogonalGroup_iff'

end OrthogonalGroup

end Matrix


import subgroup.lattice

/-!

Group homomorphisms

-/

-- We're always overwriting group theory here so we always work in
-- a namespace
namespace mygroup

/- homomorphisms of groups -/

/-- Bundled group homomorphisms -/
structure group_hom (G H : Type) [group G] [group H] :=
(to_fun : G → H)
(map_mul' : ∀ x y, to_fun (x * y) = to_fun x * to_fun y)

-- notation
infixr ` →* `:25 := group_hom

-- coercion to a function
instance {G H : Type} [group G] [group H] :
  has_coe_to_fun (G →* H) := ⟨_, group_hom.to_fun⟩

@[simp] lemma to_fun_eq_coe {G H : Type} [group G] [group H]
  (f : G →* H) : f.to_fun = f := rfl

@[ext] lemma ext_hom {G H : Type} [group G] [group H] (φ ψ : G →* H) :
  φ = ψ ↔ φ.to_fun = ψ.to_fun :=
begin
 split, { cc },
  { intro h,
    cases φ with φ1 φ2,
    cases ψ with ψ1 ψ2,
    simp * at * }
end

@[ext] lemma ext {G H : Type} [group G] [group H] (φ ψ : G →* H)
  (h : ∀ g : G, φ g = ψ g) : φ = ψ :=
begin
  rw ext_hom,
  ext g,
  exact h g,
end

-- the identity homomorphism
def id_hom {G : Type} [group G] : G →* G := ⟨id, λ x y, rfl⟩

/-- Group isomorphism as a bijective group homomorphism -/
structure group_iso (G H : Type) [group G] [group H] extends group_hom G H :=
(is_bijective : function.bijective to_fun)
notation G ` ≅ ` H := group_iso G H

-- Coercion from `group_iso` to `group_hom`
instance {G H : Type} [group G] [group H] :
  has_coe_t (G ≅ H) (G →* H) := ⟨group_iso.to_group_hom⟩

instance coe_iso_to_fun {G H : Type} [group G] [group H] :
  has_coe_to_fun (G ≅ H) := ⟨_, group_iso.to_group_hom⟩

-- Should we define it this way or as an extension of equiv that preserves mul?

/- Alternative definition
structure group_equiv (G H : Type) [group G] [group H] extends G ≃ H :=
(map_mul' : ∀ x y : G, to_fun (x * y) = to_fun x * to_fun y)

notation G ` ≅ ` H := group_equiv G H

-- Coercion from `group_equiv` to `group_hom`
instance {G H : Type} [group G] [group H] :
  has_coe (G ≅ H) (G →* H) := ⟨λ f, ⟨f.to_fun, f.map_mul'⟩⟩ -/

open set mygroup.subgroup function

namespace group_hom

variables {G H K : Type} [group G] [group H] [group K]

/-- If f is a group homomorphism then f (a * b) = f a * f b. -/
@[simp]
lemma map_mul (f : G →* H) (a b : G) : f (a * b) = f a * f b :=
f.map_mul' a b

/-- The composition of two group homomorphisms form a group homomorphism -/
def map_comp (f : G →* H) (g : H →* K) : G →* K :=
{ to_fun   := g ∘ f,
  map_mul' := λ x y, by simp }
notation g ` ∘* ` f := map_comp f g

@[simp] lemma coe_map_comp (f : G →* H) (g : H →* K) : ((g ∘* f) : G → K) =
  g ∘ f := rfl

/-- A group is isomorphic to itself by the identity homomorphism -/
def iso_refl : G ≅ G :=
{ is_bijective := function.bijective_id, .. id_hom }

/-- The composition of two group isomorphisms form a group isomorphism -/
def iso_comp (f : G ≅ H) (g : H ≅ K) : G ≅ K :=
{ is_bijective := function.bijective.comp g.is_bijective f.is_bijective,
  .. (g : group_hom H K) ∘* (f : group_hom G H) }

/-- An equiv between two groups that preserves multiplication forms an isomorphism -/
def iso_of_mul_equiv (f : G ≃* H) : G ≅ H :=
{ to_fun := f, map_mul' := f.map_mul',
  is_bijective := equiv.bijective f.to_equiv }

/-- An isomorphism between two groups from an mul_equiv -/
noncomputable def mul_equiv_of_iso (f : G ≅ H) : G ≃* H :=
{ map_mul' := map_mul f, .. equiv.of_bijective _ f.is_bijective }

/-- If the group `G` is isomorphic to the group `H`, then `H` is isomorphic to `G`-/
noncomputable def iso_symm (f : G ≅ H) : H ≅ G :=
  iso_of_mul_equiv $ mul_equiv.symm $ mul_equiv_of_iso f

def to_prod (H : subgroup G) (N : normal G) : H →* H ⨯ N :=
{ to_fun := λ h, ⟨h.1, h.1, h.2, 1, subgroup.one_mem N, (group.mul_one _).symm⟩,
  map_mul' := λ ⟨x, hx⟩ ⟨y, hy⟩, subtype.val_injective rfl }

@[simp] lemma to_prod_apply (H : subgroup G) (N : normal G) (h : H) :
  to_prod H N h = ⟨h.1, h.1, h.2, 1, subgroup.one_mem N, (group.mul_one _).symm⟩ :=
rfl

@[simp] lemma to_prod_mul {H : subgroup G} {K : normal G} (x y : H) :
  (to_prod H K x) * (to_prod H K y) = to_prod H K (x * y) := rfl

def to_prod' (H : subgroup G) (N : normal G) : N.to_subgroup →* H ⨯ N :=
{ to_fun := λ n, ⟨n.1, 1, H.one_mem, n.1, n.2, (group.one_mul _).symm⟩,
  map_mul' := λ ⟨x, hx⟩ ⟨y, hy⟩, subtype.val_injective rfl }

open_locale classical

/-
  The type of group homs G → H is
  denoted f : G →* H
  and the underlying function of types is ⇑f : G → H
  TODO: can we switch those arrows off?
  The axiom: if `f : G →* H` then `f.map_mul`
  is the assertion that for all a, b ∈ G
  we have f(a) = f(b).
  Our first job is to prove `f.map_one` and `f.map_inv`.

  `f.map_one : f 1 = 1`
  `f.map_inv {x : G} : f (x⁻¹) = f(x)⁻¹`

-/

/-- If f is a group homomorphism then f 1 = 1. -/
@[simp] -- it's a good simp lemma
lemma map_one (f : G →* H) : f 1 = 1 :=
begin
  have h : f 1 * f 1 = f 1,
    rw ←f.map_mul,
    rw group.one_mul, -- annoying but stops cheating
    -- TODO: can I kill one_mul somehow? I asked on Zulip
  rw group.mul_left_eq_self at h, -- annoying
  assumption
end

/-- If f is a group homomorphism then f(x⁻¹) = f(x)⁻¹ -/
@[simp] -- it's also a good simp lemma
lemma map_inv (f : G →* H) {x : G} : f (x⁻¹) = (f x)⁻¹ :=
begin
  apply group.eq_inv_of_mul_eq_one,
  rw ←f.map_mul,
  rw group.mul_left_inv,
  rw f.map_one,
  -- refl
end

-- Inclusion map as a homomorphism from a subgroup to the group
def 𝒾 (H : subgroup G) : H →* G :=
{ to_fun := λ h, (h : G),
  map_mul' := λ _ _, rfl }

@[simp] lemma 𝒾_def {H : subgroup G} {h} (hh : h ∈ H) : 𝒾 H ⟨h, hh⟩ = h := rfl

-- The inclusion map is injective
lemma injective_𝒾 {H : subgroup G} : injective $ 𝒾 H := λ _ _ hxy, subtype.eq hxy

-- We prove the theorems here (only);
-- definitions need to go elsewhere

-- Rather than defining the kernel as the preimage of {1}, I think defining it
-- as a subgroup of the domain is better

/-- The kernel of a homomorphism `f : G →* H` is the normal subgroup of `G` whos
  carrier is the preimage of `{1}`, i.e. `f ⁻¹' {1}` -/
def kernel (f : G →* H) : normal G :=
{ carrier := f ⁻¹' {1},
  one_mem' := map_one _,
  mul_mem' :=
    begin
      intros _ _ hx hy,
      rw [mem_preimage, mem_singleton_iff] at *,
      rw [map_mul f, hx, hy, group.mul_one]
    end,
  inv_mem' :=
    begin
      intros _ hx,
      rw [mem_preimage, mem_singleton_iff] at *,
      rw [map_inv f, hx, group.one_inv]
    end,
  conj_mem' :=
    begin
      intros _ hn _,
      rw [mem_preimage, mem_singleton_iff] at *,
      simp [hn],
    end }

/-- The image of a homomorphism `f : G →* H` is the subgroup of `H` whose carrier
  is the image of `univ : set G`, i.e. `f '' univ` -/
def image (f : G →* H) : subgroup H :=
{ carrier := range f,
  one_mem' := ⟨1, map_one _⟩,
  mul_mem' := λ _ _ ⟨x, hx₁⟩ ⟨y, hy₁⟩, ⟨x * y, by rw [map_mul f x y, hx₁, hy₁]⟩,
  inv_mem' := λ _ ⟨x, hx₁⟩, ⟨x⁻¹, by rw [←hx₁, map_inv]⟩ }

variables {f : G →* H}

lemma mem_kernel {g : G} : g ∈ kernel f ↔ f g = 1 :=
  ⟨λ h, mem_singleton_iff.1 $ mem_preimage.1 h, λ h, h⟩

lemma mem_kernel_of_eq {a b : G} (h : f a = f b) :
  b⁻¹ * a ∈ kernel f :=
begin
  rw [mem_kernel, map_mul, map_inv,
    ←group.mul_left_cancel_iff (f b)],
  simp [←mul_assoc, h]
end

lemma one_mem_kernel (f : G →* H) : (1 : G) ∈ kernel f := map_one f

lemma mem_image {h : H} : h ∈ image f ↔ ∃ g, f g = h := iff.rfl

attribute [simp] mem_kernel mem_image

-- We will prove the classic results about injective homomorphisms that a
-- homomorphism is injective if and only if it have the trivial kernel

/-- A homomorphism `f` is injective iff. `f` has kernel `{1}` -/
theorem injective_iff_kernel_eq_one :
  injective f ↔ (kernel f : set G) = {1} :=
begin
  split; intro hf,
    { show f ⁻¹' {1} = {1},
      ext, split; intro hx,
        { apply @hf x 1,
          rw map_one,
          exact mem_singleton_iff.1 hx },
        { rw [mem_preimage, mem_singleton_iff, mem_singleton_iff.1 hx],
          exact map_one _ } },
    { change f ⁻¹' {1} = {1} at hf,
      by_contra h, push_neg at h,
      rcases h with ⟨x, y, heq, hneq⟩,
      refine hneq (group.mul_right_cancel y⁻¹ _ _ _),
      have : x * y⁻¹ ∈ f ⁻¹' {1},
        apply group.mul_right_cancel (f y),
        rw [map_mul f, group.mul_assoc, map_inv, group.mul_left_inv,
            group.one_mul, group.mul_one, heq],
      rw [hf, mem_singleton_iff] at this,
      rw [this, group.mul_right_inv] }
end

theorem injective_iff_kernel_eq_one' :
  injective f ↔ ∀ a, f a = 1 → a = 1 :=
begin
  rw injective_iff_kernel_eq_one,
  simp_rw [←mem_kernel, set.ext_iff, mem_singleton_iff],
  split,
  { intros h a ha,
    rwa ←h },
  { intros h a,
    split, apply h,
    rintro rfl,
    apply one_mem }
end

/-- A homomorphism `f : G →* H` is surjective iff. the image of `f` is `H` -/
theorem surjective_iff_max_img :
  surjective f ↔ (image f : set H) = univ :=
begin
  split; intro hf,
    { ext y, exact ⟨λ _, mem_univ _, λ hy, hf y⟩ },
    { intro y,
      exact (show y ∈ (image f : set H), by rw hf; exact mem_univ _) }
end

end group_hom

namespace subgroup

-- pushforward and pullback of subgroups

variables {G : Type} [group G] {H : Type} [group H]

/-- The image of a subgroup under a group homomorphism is a subgroup -/
def map (f : G →* H) (K : subgroup G) : subgroup H :=
{ carrier := f '' K,
  one_mem' := by rw mem_image; exact ⟨1, K.one_mem, f.map_one⟩,
  mul_mem' := by rintros _ _ ⟨a, ha, rfl⟩ ⟨b, hb, rfl⟩;
    exact ⟨a * b, K.mul_mem ha hb, f.map_mul _ _⟩,
  inv_mem' := by rintros _ ⟨a, ha, rfl⟩; exact ⟨a⁻¹, K.inv_mem ha, f.map_inv⟩ }

lemma mem_map (f : G →* H) (K : subgroup G) (a : H) :
  a ∈ K.map f ↔ ∃ g : G, g ∈ K ∧ f g = a := iff.rfl

/-- The preimage of a subgroup under a group homomorphism is a subgroup -/
def comap (f : G →* H) (K : subgroup H) : subgroup G :=
{ carrier := f ⁻¹' K,
  one_mem' := show f 1 ∈ K, by rw f.map_one; exact one_mem K,
  mul_mem' := λ x y hx hy, show f (x * y) ∈ K,
    by rw f.map_mul; exact mul_mem K hx hy,
  inv_mem' := λ x hx, show f x⁻¹ ∈ K, by rw f.map_inv; exact inv_mem K hx }

lemma mem_comap' (f : G →* H) (M : subgroup H) (g : G) :
  g ∈ M.comap f ↔ f g ∈ M := iff.rfl

def gc (f : G →* H) : galois_connection (map f) (comap f) :=
begin
  rintros A B,
  show f.to_fun '' A.carrier ⊆ B.carrier ↔ A.carrier ⊆ f.to_fun ⁻¹' B.carrier,
  finish
end

theorem closure_image (f : G →* H) (S : set G) :
  closure (f '' S) = map f (closure S) :=
begin
  apply lattice.le_antisymm,
  { rw [closure_le, le_eq_subset, image_subset_iff],
    refine subset.trans (le_closure _) _,
    change closure S ≤ comap f (map f (closure S)),
    apply galois_connection.le_u_l (gc f) },
  { refine galois_connection.l_le (gc f) _,
    rw closure_le,
    have h : S ⊆ f ⁻¹' ( f '' S),
      intro x, finish,
    refine set.subset.trans h _,
    show f ⁻¹' _ ⊆ f ⁻¹' _,
    mono, apply le_closure }
end

theorem closure_singleton (f : G →* H) (g : G) :
  closure ({f g} : set H) = map f (closure ({g})) :=
by convert closure_image f ({g} : set G); finish

end subgroup

namespace normal

open group_hom mygroup.subgroup

variables {G H : Type} [group G] [group H]

/-- The preimage of a normal subgroup under a group homomorphism is normal -/
def comap (f : G →* H) (N : normal H) : normal G :=
{carrier := f ⁻¹' N,
 one_mem' := by rw [mem_preimage, map_one]; exact N.one_mem',
 mul_mem' := λ _ _ h₁ h₂, mem_preimage.2 (by rw map_mul; exact N.mul_mem' h₁ h₂),
 inv_mem' := λ _ h, mem_preimage.2 (by rw map_inv; exact N.inv_mem' h),
 conj_mem' :=
    begin
      intros n h t ,
      rw [mem_preimage, map_mul, map_mul],
      change _ ∈ N, convert N.conj_mem (f n) h (f t),
      apply f.map_inv
    end }

@[simp] lemma mem_comap {f : G →* H} {N : normal H} (x) :
  x ∈ comap f N ↔ f x ∈ N :=
show x ∈ f ⁻¹' N ↔ f x ∈ N, by exact mem_preimage

/-- The surjective image of a normal subgroup is normal -/
def nmap {f : G →* H} (hf : surjective f) (N : normal G) : normal H :=
{ carrier := f '' N,
  one_mem' := ⟨1, N.to_subgroup.one_mem, f.map_one⟩,
  mul_mem' := by rintros _ _ ⟨a, ha, rfl⟩ ⟨b, hb, rfl⟩;
      exact ⟨a * b, N.to_subgroup.mul_mem ha hb, f.map_mul a b⟩,
  inv_mem' := by rintros _ ⟨a, ha, rfl⟩;
      exact ⟨a⁻¹, N.to_subgroup.inv_mem ha, f.map_inv⟩,
  conj_mem' :=
    begin
      rintro _ ⟨b, hb, rfl⟩ h,
      rcases hf h with ⟨g, rfl⟩,
      exact ⟨g * b * g⁻¹, N.conj_mem b hb g, by simp [f.map_mul]⟩
    end }

@[simp] lemma mem_nmap {f : G →* H} (hf : surjective f) {N : normal G} (y) :
  y ∈ nmap hf N ↔ ∃ x ∈ N, f x = y :=
  show y ∈ f '' N ↔ _, by rw mem_image_iff_bex; refl

/-- Intersection of T and N is the pushforward to G of (the pullback to T of N)
along the natural map T → G -/
theorem subgroup_inf (N : normal G) (T : subgroup G) :
  (T ⊓ N) = map (𝒾 T) (comap (𝒾 T) N) :=
begin
  ext x, split,
  { exact λ h, let ⟨hxt, hxn⟩ := mem_inf.1 h in
      (mem_map _ _ _).1 ⟨⟨x, hxt⟩, hxn, rfl⟩ },
  { rintro ⟨⟨g, hgt⟩, ht1, rfl⟩, exact mem_inf.2 ⟨hgt, ht1⟩ }
end

end normal

end mygroup


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis, Yaël Dillies
-/
import algebra.module.pi
import algebra.module.prod
import algebra.order.pi
import algebra.order.smul
import data.set.pointwise

/-!
# Ordered module

In this file we provide lemmas about `ordered_smul` that hold once a module structure is present.

## References

* https://en.wikipedia.org/wiki/Ordered_module

## Tags

ordered module, ordered scalar, ordered smul, ordered action, ordered vector space
-/

open_locale pointwise

variables {k M N : Type*}

namespace order_dual

instance [semiring k] [ordered_add_comm_monoid M] [module k M] : module k (order_dual M) :=
{ add_smul := λ r s x, order_dual.rec (add_smul _ _) x,
  zero_smul := λ m, order_dual.rec (zero_smul _) m }

end order_dual

section semiring
variables [ordered_semiring k] [ordered_add_comm_group M] [module k M] [ordered_smul k M]
  {a b : M} {c : k}

/- can be generalized from `module k M` to `distrib_mul_action_with_zero k M` once it exists.
where `distrib_mul_action_with_zero k M`is the conjunction of `distrib_mul_action k M` and
`smul_with_zero k M`.-/
lemma smul_neg_iff_of_pos (hc : 0 < c) :
  c • a < 0 ↔ a < 0 :=
begin
  rw [←neg_neg a, smul_neg, neg_neg_iff_pos, neg_neg_iff_pos],
  exact smul_pos_iff_of_pos hc,
end

end semiring

section ring
variables [ordered_ring k] [ordered_add_comm_group M] [module k M] [ordered_smul k M]
  {a b : M} {c : k}

lemma smul_lt_smul_of_neg (h : a < b) (hc : c < 0) :
  c • b < c • a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_lt_neg_iff],
  exact smul_lt_smul_of_pos h (neg_pos_of_neg hc),
end

lemma smul_le_smul_of_nonpos (h : a ≤ b) (hc : c ≤ 0) :
  c • b ≤ c • a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_le_neg_iff],
  exact smul_le_smul_of_nonneg h (neg_nonneg_of_nonpos hc),
end

lemma eq_of_smul_eq_smul_of_neg_of_le (hab : c • a = c • b) (hc : c < 0) (h : a ≤ b) :
  a = b :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_inj] at hab,
  exact eq_of_smul_eq_smul_of_pos_of_le hab (neg_pos_of_neg hc) h,
end

lemma lt_of_smul_lt_smul_of_nonpos (h : c • a < c • b) (hc : c ≤ 0) :
  b < a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_lt_neg_iff] at h,
  exact lt_of_smul_lt_smul_of_nonneg h (neg_nonneg_of_nonpos hc),
end

lemma smul_lt_smul_iff_of_neg (hc : c < 0) :
  c • a < c • b ↔ b < a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_lt_neg_iff],
  exact smul_lt_smul_iff_of_pos (neg_pos_of_neg hc),
end

lemma smul_neg_iff_of_neg (hc : c < 0) :
  c • a < 0 ↔ 0 < a :=
begin
  rw [←neg_neg c, neg_smul, neg_neg_iff_pos],
  exact smul_pos_iff_of_pos (neg_pos_of_neg hc),
end

lemma smul_pos_iff_of_neg (hc : c < 0) :
  0 < c • a ↔ a < 0 :=
begin
  rw [←neg_neg c, neg_smul, neg_pos],
  exact smul_neg_iff_of_pos (neg_pos_of_neg hc),
end

lemma smul_nonpos_of_nonpos_of_nonneg (hc : c ≤ 0) (ha : 0 ≤ a) : c • a ≤ 0 :=
calc
  c • a ≤ c • 0 : smul_le_smul_of_nonpos ha hc
  ... = 0 : smul_zero' M c

lemma smul_nonneg_of_nonpos_of_nonpos (hc : c ≤ 0) (ha : a ≤ 0) : 0 ≤ c • a :=
@smul_nonpos_of_nonpos_of_nonneg k (order_dual M) _ _ _ _ _ _ hc ha

alias smul_pos_iff_of_neg ↔ _ smul_pos_of_neg_of_neg
alias smul_neg_iff_of_pos ↔ _ smul_neg_of_pos_of_neg
alias smul_neg_iff_of_neg ↔ _ smul_neg_of_neg_of_pos

lemma antitone_smul_left (hc : c ≤ 0) : antitone (has_scalar.smul c : M → M) :=
λ a b h, smul_le_smul_of_nonpos h hc

lemma strict_anti_smul_left (hc : c < 0) : strict_anti (has_scalar.smul c : M → M) :=
λ a b h, smul_lt_smul_of_neg h hc

end ring

section field
variables [linear_ordered_field k] [ordered_add_comm_group M] [module k M] [ordered_smul k M]
  {a b : M} {c : k}

lemma smul_le_smul_iff_of_neg (hc : c < 0) : c • a ≤ c • b ↔ b ≤ a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_le_neg_iff],
  exact smul_le_smul_iff_of_pos (neg_pos_of_neg hc),
end

lemma smul_lt_iff_of_neg (hc : c < 0) : c • a < b ↔ c⁻¹ • b < a :=
begin
  rw [←neg_neg c, ←neg_neg a, neg_smul_neg, inv_neg, neg_smul _ b, neg_lt_neg_iff],
  exact smul_lt_iff_of_pos (neg_pos_of_neg hc),
end

lemma lt_smul_iff_of_neg (hc : c < 0) : a < c • b ↔ b < c⁻¹ • a :=
begin
  rw [←neg_neg c, ←neg_neg b, neg_smul_neg, inv_neg, neg_smul _ a, neg_lt_neg_iff],
  exact lt_smul_iff_of_pos (neg_pos_of_neg hc),
end

variables (M)

/-- Left scalar multiplication as an order isomorphism. -/
@[simps] def order_iso.smul_left_dual {c : k} (hc : c < 0) : M ≃o order_dual M :=
{ to_fun := λ b, order_dual.to_dual (c • b),
  inv_fun := λ b, c⁻¹ • (order_dual.of_dual b),
  left_inv := inv_smul_smul₀ hc.ne,
  right_inv := smul_inv_smul₀ hc.ne,
  map_rel_iff' := λ b₁ b₂, smul_le_smul_iff_of_neg hc }

variables {M} [ordered_add_comm_group N] [module k N] [ordered_smul k N]

-- TODO: solve `prod.has_lt` and `prod.has_le` misalignment issue
instance prod.ordered_smul : ordered_smul k (M × N) :=
ordered_smul.mk' $ λ (v u : M × N) (c : k) h hc,
  ⟨smul_le_smul_of_nonneg h.1.1 hc.le, smul_le_smul_of_nonneg h.1.2 hc.le⟩

instance pi.ordered_smul {ι : Type*} {M : ι → Type*} [Π i, ordered_add_comm_group (M i)]
  [Π i, mul_action_with_zero k (M i)] [∀ i, ordered_smul k (M i)] :
  ordered_smul k (Π i : ι, M i) :=
begin
  refine (ordered_smul.mk' $ λ v u c h hc i, _),
  change c • v i ≤ c • u i,
  exact smul_le_smul_of_nonneg (h.le i) hc.le,
end

-- Sometimes Lean fails to apply the dependent version to non-dependent functions,
-- so we define another instance
instance pi.ordered_smul' {ι : Type*} {M : Type*} [ordered_add_comm_group M]
  [mul_action_with_zero k M] [ordered_smul k M] :
  ordered_smul k (ι → M) :=
pi.ordered_smul

end field

/-! ### Upper/lower bounds -/

section ordered_semiring
variables [ordered_semiring k] [ordered_add_comm_monoid M] [smul_with_zero k M] [ordered_smul k M]
  {s : set M} {c : k}

lemma smul_lower_bounds_subset_lower_bounds_smul (hc : 0 ≤ c) :
  c • lower_bounds s ⊆ lower_bounds (c • s) :=
(monotone_smul_left hc).image_lower_bounds_subset_lower_bounds_image

lemma smul_upper_bounds_subset_upper_bounds_smul (hc : 0 ≤ c) :
  c • upper_bounds s ⊆ upper_bounds (c • s) :=
(monotone_smul_left hc).image_upper_bounds_subset_upper_bounds_image

lemma bdd_below.smul_of_nonneg (hs : bdd_below s) (hc : 0 ≤ c) : bdd_below (c • s) :=
(monotone_smul_left hc).map_bdd_below hs

lemma bdd_above.smul_of_nonneg (hs : bdd_above s) (hc : 0 ≤ c) : bdd_above (c • s) :=
(monotone_smul_left hc).map_bdd_above hs

end ordered_semiring

section ordered_ring
variables [ordered_ring k] [ordered_add_comm_group M] [module k M] [ordered_smul k M]
  {s : set M} {c : k}

lemma smul_lower_bounds_subset_upper_bounds_smul (hc : c ≤ 0) :
  c • lower_bounds s ⊆ upper_bounds (c • s) :=
(antitone_smul_left hc).image_lower_bounds_subset_upper_bounds_image

lemma smul_upper_bounds_subset_lower_bounds_smul (hc : c ≤ 0) :
  c • upper_bounds s ⊆ lower_bounds (c • s) :=
(antitone_smul_left hc).image_upper_bounds_subset_lower_bounds_image

lemma bdd_below.smul_of_nonpos (hc : c ≤ 0) (hs : bdd_below s) : bdd_above (c • s) :=
(antitone_smul_left hc).map_bdd_below hs

lemma bdd_above.smul_of_nonpos (hc : c ≤ 0) (hs : bdd_above s) : bdd_below (c • s) :=
(antitone_smul_left hc).map_bdd_above hs

end ordered_ring

section linear_ordered_field
variables [linear_ordered_field k] [ordered_add_comm_group M]

section mul_action_with_zero
variables [mul_action_with_zero k M] [ordered_smul k M] {s t : set M} {c : k}

@[simp] lemma lower_bounds_smul_of_pos (hc : 0 < c) : lower_bounds (c • s) = c • lower_bounds s :=
(order_iso.smul_left _ hc).lower_bounds_image

@[simp] lemma upper_bounds_smul_of_pos (hc : 0 < c) : upper_bounds (c • s) = c • upper_bounds s :=
(order_iso.smul_left _ hc).upper_bounds_image

@[simp] lemma bdd_below_smul_iff_of_pos (hc : 0 < c) : bdd_below (c • s) ↔ bdd_below s :=
(order_iso.smul_left _ hc).bdd_below_image

@[simp] lemma bdd_above_smul_iff_of_pos (hc : 0 < c) : bdd_above (c • s) ↔ bdd_above s :=
(order_iso.smul_left _ hc).bdd_above_image

end mul_action_with_zero

section module
variables [module k M] [ordered_smul k M] {s t : set M} {c : k}

@[simp] lemma lower_bounds_smul_of_neg (hc : c < 0) : lower_bounds (c • s) = c • upper_bounds s :=
(order_iso.smul_left_dual M hc).upper_bounds_image

@[simp] lemma upper_bounds_smul_of_neg (hc : c < 0) : upper_bounds (c • s) = c • lower_bounds s :=
(order_iso.smul_left_dual M hc).lower_bounds_image

@[simp] lemma bdd_below_smul_iff_of_neg (hc : c < 0) : bdd_below (c • s) ↔ bdd_above s :=
(order_iso.smul_left_dual M hc).bdd_above_image

@[simp] lemma bdd_above_smul_iff_of_neg (hc : c < 0) : bdd_above (c • s) ↔ bdd_below s :=
(order_iso.smul_left_dual M hc).bdd_below_image

end module
end linear_ordered_field


import MyNat

open MyNat

def le (a b : ℕ) := ∃ (c : ℕ), b = a + c

instance : LE ℕ where
  le := le

theorem le_iff_exists_add (a b : ℕ) :
  a ≤ b ↔ ∃ (c : ℕ), b = a + c := Iff.rfl