/-
Copyright (c) 2022 Yaël Dillies, Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Violeta Hernández Palacios, Grayson Burton, Vladimir Ivanov

! This file was ported from Lean 3 source module order.grade
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Basic
import Mathlib.Data.Int.SuccPred

/-!
# Graded orders

This file defines graded orders, also known as ranked orders.

A `𝕆`-graded order is an order `α` equipped with a distinguished "grade" function `α → 𝕆` which
should be understood as giving the "height" of the elements. Usual graded orders are `ℕ`-graded,
cograded orders are `ℕᵒᵈ`-graded, but we can also grade by `ℤ`, and polytopes are naturally
`Fin n`-graded.

Visually, `grade ℕ a` is the height of `a` in the Hasse diagram of `α`.

## Main declarations

* `GradeOrder`: Graded order.
* `GradeMinOrder`: Graded order where minimal elements have minimal grades.
* `GradeMaxOrder`: Graded order where maximal elements have maximal grades.
* `GradeBoundedOrder`: Graded order where minimal elements have minimal grades and maximal
  elements have maximal grades.
* `grade`: The grade of an element. Because an order can admit several gradings, the first argument
  is the order we grade by.

## How to grade your order

Here are the translations between common references and our `GradeOrder`:
* [Stanley][stanley2012] defines a graded order of rank `n` as an order where all maximal chains
  have "length" `n` (so the number of elements of a chain is `n + 1`). This corresponds to
  `GradeBoundedOrder (Fin (n + 1)) α`.
* [Engel][engel1997]'s ranked orders are somewhere between `GradeOrder ℕ α` and
  `GradeMinOrder ℕ α`, in that he requires `∃ a, IsMin a ∧ grade ℕ a = 0` rather than
  `∀ a, IsMin a → grade ℕ a = 0`. He defines a graded order as an order where all minimal elements
  have grade `0` and all maximal elements have the same grade. This is roughly a less bundled
  version of `GradeBoundedOrder (Fin n) α`, assuming we discard orders with infinite chains.

## Implementation notes

One possible definition of graded orders is as the bounded orders whose flags (maximal chains)
all have the same finite length (see Stanley p. 99). However, this means that all graded orders must
have minimal and maximal elements and that the grade is not data.

Instead, we define graded orders by their grade function, without talking about flags yet.

## References

* [Konrad Engel, *Sperner Theory*][engel1997]
* [Richard Stanley, *Enumerative Combinatorics*][stanley2012]
-/

open Finset Nat OrderDual

variable {𝕆 ℙ α β : Type _}

/-- An `𝕆`-graded order is an order `α` equipped with a strictly monotone function
`grade 𝕆 : α → 𝕆` which preserves order covering (`Covby`). -/
class GradeOrder (𝕆 α : Type _) [Preorder 𝕆] [Preorder α] where
  /-- The grading function. -/
  grade : α → 𝕆
  /-- `grade` is strictly monotonic. -/
  grade_strictMono : StrictMono grade
  /-- `grade` preserves `Covby`. -/
  covby_grade ⦃a b : α⦄ : a ⋖ b → grade a ⋖ grade b
#align grade_order GradeOrder

/-- A `𝕆`-graded order where minimal elements have minimal grades. -/
class GradeMinOrder (𝕆 α : Type _) [Preorder 𝕆] [Preorder α] extends GradeOrder 𝕆 α where
  /-- Minimal elements have minimal grades. -/
  is_min_grade ⦃a : α⦄ : IsMin a → IsMin (grade a)
#align grade_min_order GradeMinOrder

/-- A `𝕆`-graded order where maximal elements have maximal grades. -/
class GradeMaxOrder (𝕆 α : Type _) [Preorder 𝕆] [Preorder α] extends GradeOrder 𝕆 α where
  /-- Maximal elements have maximal grades. -/
  is_max_grade ⦃a : α⦄ : IsMax a → IsMax (grade a)
#align grade_max_order GradeMaxOrder

/-- A `𝕆`-graded order where minimal elements have minimal grades and maximal elements have maximal
grades. -/
class GradeBoundedOrder (𝕆 α : Type _) [Preorder 𝕆] [Preorder α] extends GradeMinOrder 𝕆 α,
  GradeMaxOrder 𝕆 α
#align grade_bounded_order GradeBoundedOrder

section Preorder -- grading
-- PORTING NOTE: this `variable [Preorder 𝕆]` for the whole section seems to not work in Lean4
-- variable [Preorder 𝕆]

section Preorder -- graded order
variable [Preorder α]

section GradeOrder
variable (𝕆) [Preorder 𝕆] [GradeOrder 𝕆 α] {a b : α}

/-- The grade of an element in a graded order. Morally, this is the number of elements you need to
go down by to get to `⊥`. -/
def grade : α → 𝕆 :=
  GradeOrder.grade
#align grade grade

protected theorem Covby.grade (h : a ⋖ b) : grade 𝕆 a ⋖ grade 𝕆 b :=
  GradeOrder.covby_grade h
#align covby.grade Covby.grade

variable {𝕆}

theorem grade_strictMono : StrictMono (grade 𝕆 : α → 𝕆) :=
  GradeOrder.grade_strictMono
#align grade_strict_mono grade_strictMono

theorem covby_iff_lt_covby_grade : a ⋖ b ↔ a < b ∧ grade 𝕆 a ⋖ grade 𝕆 b :=
  ⟨fun h => ⟨h.1, h.grade _⟩,
    And.imp_right fun h _ ha hb => h.2 (grade_strictMono ha) <| grade_strictMono hb⟩
#align covby_iff_lt_covby_grade covby_iff_lt_covby_grade

end GradeOrder

section GradeMinOrder

variable (𝕆) [Preorder 𝕆] [GradeMinOrder 𝕆 α] {a : α}

protected theorem IsMin.grade (h : IsMin a) : IsMin (grade 𝕆 a) :=
  GradeMinOrder.is_min_grade h
#align is_min.grade IsMin.grade

variable {𝕆}

@[simp]
theorem isMin_grade_iff : IsMin (grade 𝕆 a) ↔ IsMin a :=
  ⟨grade_strictMono.isMin_of_apply, IsMin.grade _⟩
#align is_min_grade_iff isMin_grade_iff

end GradeMinOrder

section GradeMaxOrder

variable (𝕆) [Preorder 𝕆] [GradeMaxOrder 𝕆 α] {a : α}

protected theorem IsMax.grade (h : IsMax a) : IsMax (grade 𝕆 a) :=
  GradeMaxOrder.is_max_grade h
#align is_max.grade IsMax.grade

variable {𝕆}

@[simp]
theorem isMax_grade_iff : IsMax (grade 𝕆 a) ↔ IsMax a :=
  ⟨grade_strictMono.isMax_of_apply, IsMax.grade _⟩
#align is_max_grade_iff isMax_grade_iff

end GradeMaxOrder

end Preorder

-- graded order
theorem grade_mono [PartialOrder α] [Preorder 𝕆] [GradeOrder 𝕆 α] : Monotone (grade 𝕆 : α → 𝕆) :=
  grade_strictMono.monotone
#align grade_mono grade_mono

section LinearOrder

-- graded order
variable [LinearOrder α] [Preorder 𝕆] [GradeOrder 𝕆 α] {a b : α}

theorem grade_injective : Function.Injective (grade 𝕆 : α → 𝕆) :=
  grade_strictMono.injective
#align grade_injective grade_injective

@[simp]
theorem grade_le_grade_iff : grade 𝕆 a ≤ grade 𝕆 b ↔ a ≤ b :=
  grade_strictMono.le_iff_le
#align grade_le_grade_iff grade_le_grade_iff

@[simp]
theorem grade_lt_grade_iff : grade 𝕆 a < grade 𝕆 b ↔ a < b :=
  grade_strictMono.lt_iff_lt
#align grade_lt_grade_iff grade_lt_grade_iff

@[simp]
theorem grade_eq_grade_iff : grade 𝕆 a = grade 𝕆 b ↔ a = b :=
  grade_injective.eq_iff
#align grade_eq_grade_iff grade_eq_grade_iff

theorem grade_ne_grade_iff : grade 𝕆 a ≠ grade 𝕆 b ↔ a ≠ b :=
  grade_injective.ne_iff
#align grade_ne_grade_iff grade_ne_grade_iff

theorem grade_covby_grade_iff : grade 𝕆 a ⋖ grade 𝕆 b ↔ a ⋖ b :=
  (covby_iff_lt_covby_grade.trans <| and_iff_right_of_imp fun h => grade_lt_grade_iff.1 h.1).symm
#align grade_covby_grade_iff grade_covby_grade_iff

end LinearOrder

-- graded order
end Preorder

-- grading
section PartialOrder

variable [PartialOrder 𝕆] [Preorder α]

@[simp]
theorem grade_bot [OrderBot 𝕆] [OrderBot α] [GradeMinOrder 𝕆 α] : grade 𝕆 (⊥ : α) = ⊥ :=
  (isMin_bot.grade _).eq_bot
#align grade_bot grade_bot

@[simp]
theorem grade_top [OrderTop 𝕆] [OrderTop α] [GradeMaxOrder 𝕆 α] : grade 𝕆 (⊤ : α) = ⊤ :=
  (isMax_top.grade _).eq_top
#align grade_top grade_top

end PartialOrder

/-! ### Instances -/

variable [Preorder 𝕆] [Preorder ℙ] [Preorder α] [Preorder β]

instance Preorder.toGradeBoundedOrder : GradeBoundedOrder α α
    where
  grade := id
  is_min_grade _ := id
  is_max_grade _ := id
  grade_strictMono := strictMono_id
  covby_grade _ _ := id
#align preorder.to_grade_bounded_order Preorder.toGradeBoundedOrder

@[simp]
theorem grade_self (a : α) : grade α a = a :=
  rfl
#align grade_self grade_self

/-! #### Dual -/

instance OrderDual.gradeOrder [GradeOrder 𝕆 α] : GradeOrder 𝕆ᵒᵈ αᵒᵈ
    where
  grade := toDual ∘ grade 𝕆 ∘ ofDual
  grade_strictMono := grade_strictMono.dual
  covby_grade _ _ h := (h.ofDual.grade _).toDual

instance OrderDual.gradeMinOrder [GradeMaxOrder 𝕆 α] : GradeMinOrder 𝕆ᵒᵈ αᵒᵈ :=
  { OrderDual.gradeOrder with is_min_grade := fun _ => IsMax.grade (α := α) 𝕆 }

instance OrderDual.gradeMaxOrder [GradeMinOrder 𝕆 α] : GradeMaxOrder 𝕆ᵒᵈ αᵒᵈ :=
  { OrderDual.gradeOrder with is_max_grade := fun _ => IsMin.grade (α := α) 𝕆 }

instance [GradeBoundedOrder 𝕆 α] : GradeBoundedOrder 𝕆ᵒᵈ αᵒᵈ :=
  { OrderDual.gradeMinOrder, OrderDual.gradeMaxOrder with }

@[simp]
theorem grade_toDual [GradeOrder 𝕆 α] (a : α) : grade 𝕆ᵒᵈ (toDual a) = toDual (grade 𝕆 a) :=
  rfl
#align grade_to_dual grade_toDual

@[simp]
theorem grade_ofDual [GradeOrder 𝕆 α] (a : αᵒᵈ) : grade 𝕆 (ofDual a) = ofDual (grade 𝕆ᵒᵈ a) :=
  rfl
#align grade_of_dual grade_ofDual

/-! #### Lifting a graded order -/

-- See note [reducible non-instances]
/-- Lifts a graded order along a strictly monotone function. -/
@[reducible]
def GradeOrder.liftLeft [GradeOrder 𝕆 α] (f : 𝕆 → ℙ) (hf : StrictMono f)
    (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) : GradeOrder ℙ α
    where
  grade := f ∘ (@grade 𝕆 _ _ _ _) -- porting note - what the hell?! used to be `grade 𝕆`
  grade_strictMono := hf.comp grade_strictMono
  covby_grade _ _ h := hcovby _ _ <| h.grade _
#align grade_order.lift_left GradeOrder.liftLeft

-- See note [reducible non-instances]
/-- Lifts a graded order along a strictly monotone function. -/
@[reducible]
def GradeMinOrder.liftLeft [GradeMinOrder 𝕆 α] (f : 𝕆 → ℙ) (hf : StrictMono f)
    (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmin : ∀ a, IsMin a → IsMin (f a)) : GradeMinOrder ℙ α :=
  { GradeOrder.liftLeft f hf hcovby with is_min_grade := fun _ ha => hmin _ <| ha.grade _ }
#align grade_min_order.lift_left GradeMinOrder.liftLeft

-- See note [reducible non-instances]
/-- Lifts a graded order along a strictly monotone function. -/
@[reducible]
def GradeMaxOrder.liftLeft [GradeMaxOrder 𝕆 α] (f : 𝕆 → ℙ) (hf : StrictMono f)
    (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmax : ∀ a, IsMax a → IsMax (f a)) : GradeMaxOrder ℙ α :=
  { GradeOrder.liftLeft f hf hcovby with is_max_grade := fun _ ha => hmax _ <| ha.grade _ }
#align grade_max_order.lift_left GradeMaxOrder.liftLeft

-- See note [reducible non-instances]
/-- Lifts a graded order along a strictly monotone function. -/
@[reducible]
def GradeBoundedOrder.liftLeft [GradeBoundedOrder 𝕆 α] (f : 𝕆 → ℙ) (hf : StrictMono f)
    (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmin : ∀ a, IsMin a → IsMin (f a))
    (hmax : ∀ a, IsMax a → IsMax (f a)) : GradeBoundedOrder ℙ α :=
  { GradeMinOrder.liftLeft f hf hcovby hmin, GradeMaxOrder.liftLeft f hf hcovby hmax with }
#align grade_bounded_order.lift_left GradeBoundedOrder.liftLeft

-- See note [reducible non-instances]
/-- Lifts a graded order along a strictly monotone function. -/
@[reducible]
def GradeOrder.liftRight [GradeOrder 𝕆 β] (f : α → β) (hf : StrictMono f)
    (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) : GradeOrder 𝕆 α
    where
  grade := (@grade 𝕆 _ _ _ _) ∘ f -- porting note: again, weird
  grade_strictMono := grade_strictMono.comp hf
  covby_grade _ _ h := (hcovby _ _ h).grade _
#align grade_order.lift_right GradeOrder.liftRight

-- See note [reducible non-instances]
/-- Lifts a graded order along a strictly monotone function. -/
@[reducible]
def GradeMinOrder.liftRight [GradeMinOrder 𝕆 β] (f : α → β) (hf : StrictMono f)
    (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmin : ∀ a, IsMin a → IsMin (f a)) : GradeMinOrder 𝕆 α :=
  { GradeOrder.liftRight f hf hcovby with is_min_grade := fun _ ha => (hmin _ ha).grade _ }
#align grade_min_order.lift_right GradeMinOrder.liftRight

-- See note [reducible non-instances]
/-- Lifts a graded order along a strictly monotone function. -/
@[reducible]
def GradeMaxOrder.liftRight [GradeMaxOrder 𝕆 β] (f : α → β) (hf : StrictMono f)
    (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmax : ∀ a, IsMax a → IsMax (f a)) : GradeMaxOrder 𝕆 α :=
  { GradeOrder.liftRight f hf hcovby with is_max_grade := fun _ ha => (hmax _ ha).grade _ }
#align grade_max_order.lift_right GradeMaxOrder.liftRight

-- See note [reducible non-instances]
/-- Lifts a graded order along a strictly monotone function. -/
@[reducible]
def GradeBoundedOrder.liftRight [GradeBoundedOrder 𝕆 β] (f : α → β) (hf : StrictMono f)
    (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmin : ∀ a, IsMin a → IsMin (f a))
    (hmax : ∀ a, IsMax a → IsMax (f a)) : GradeBoundedOrder 𝕆 α :=
  { GradeMinOrder.liftRight f hf hcovby hmin, GradeMaxOrder.liftRight f hf hcovby hmax with }
#align grade_bounded_order.lift_right GradeBoundedOrder.liftRight

/-! #### `fin n`-graded to `ℕ`-graded to `ℤ`-graded -/

-- See note [reducible non-instances]
/-- A `Fin n`-graded order is also `ℕ`-graded. We do not mark this an instance because `n` is not
inferrable. -/
@[reducible]
def GradeOrder.finToNat (n : ℕ) [GradeOrder (Fin n) α] : GradeOrder ℕ α :=
  (GradeOrder.liftLeft (_ : Fin n → ℕ) Fin.val_strictMono) fun _ _ => Covby.coe_fin
#align grade_order.fin_to_nat GradeOrder.finToNat

-- See note [reducible non-instances]
/-- A `Fin n`-graded order is also `ℕ`-graded. We do not mark this an instance because `n` is not
inferrable. -/
@[reducible]
def GradeMinOrder.finToNat (n : ℕ) [GradeMinOrder (Fin n) α] : GradeMinOrder ℕ α :=
  (GradeMinOrder.liftLeft (_ : Fin n → ℕ) Fin.val_strictMono fun _ _ => Covby.coe_fin) fun a h =>
    by
    cases n
    · exact a.elim0
    rw [h.eq_bot, Fin.bot_eq_zero]
    exact isMin_bot
#align grade_min_order.fin_to_nat GradeMinOrder.finToNat

instance GradeOrder.natToInt [GradeOrder ℕ α] : GradeOrder ℤ α :=
  (GradeOrder.liftLeft _ Int.coe_nat_strictMono) fun _ _ => Covby.cast_int
#align grade_order.nat_to_int GradeOrder.natToInt


import .preds

universes u

namespace list

inductive member {A : Type u} : list A → Type u
| here : ∀ {x : A} {xs : list A}, member (x :: xs)
| there : ∀ {x : A} {xs : list A}, member xs → member (x :: xs)

namespace member

section
parameter {α : Type u}

def value
  : ∀ {xs : list α}, member xs -> α
| (x :: xs) member.here := x
| (x :: xs) (member.there m) := value m

-- Given a member of the append of two lists, this returns a member
-- of one or the other depending on which list is referenced.
def case_append :
 Π {l1 l2 : list α}, member (l1 ++ l2) →  member l1 ⊕ member l2
| (h::r) _ member.here := sum.inl member.here
| (h::r) l2 (member.there m) :=
  match @case_append r l2 m with
  | sum.inr z := sum.inr z
  | sum.inl z := sum.inl (member.there z)
  end
| [] l2  m :=
  let q := congr_arg member (list.nil_append l2) in
  sum.inr (cast q m)

end
end member

definition remove_member {A : Type u}
  : ∀ (xs : list A), member xs → list A
| (x :: xs) member.here := xs
| (x :: xs) (member.there m) := x :: remove_member xs m

definition update_member {A : Type u} (y : A)
  : ∀ (xs : list A), member xs → list A
| (x :: xs) member.here := y :: xs
| (x :: xs) (member.there m) := x :: update_member xs m

inductive member_st {A : Type u} (P : A → Prop) : list A → Type u
| here {} : ∀ {x : A} {xs : list A}, P x → member_st (x :: xs)
| there {} : ∀ {x : A} {xs : list A}, member_st xs → member_st (x :: xs)

inductive el_member {A : Type u} : A → list A → Type u
| here : ∀ {x : A} {xs : list A}, el_member x (x :: xs)
| there : ∀ {y x : A} {xs : list A}, el_member y xs → el_member y (x :: xs)

namespace member
def to_el_member {A : Type u}
  : ∀ {xs : list A} (m : member xs), el_member m.value xs
| (x :: xs) here := el_member.here
| (x :: xs) (there m) := el_member.there (to_el_member m)

def to_member_st {A : Type u}
  : ∀ {xs : list A} (m : member xs) (P : A → Prop) (Pm : P m.value), member_st P xs
| (x :: xs) here _ Px := member_st.here Px
| (x :: xs) (there m) _ Px := member_st.there (to_member_st m _ Px)
end member

namespace member_st
def to_member {A : Type u} {P : A → Prop}
  : ∀ {xs : list A}, member_st P xs → member xs
| ._ (@here ._ ._ x xs H) := member.here
| ._ (@there ._ ._ _ _ m) := member.there (to_member m)
end member_st

namespace el_member
def to_member {A : Type u}
  : ∀ {x : A} {xs : list A}, el_member x xs → member xs
| ._ .(x :: xs) (@here ._ x xs) := member.here
| ._ ._ (@there ._ _ _ _ m) := member.there (to_member m)
end el_member

inductive void : Type

def member_st_decide' {A : Type u}
  (P : A → Prop) [decidable_pred P]
  (xs : list A)
  : member_st P xs ⊕ (member_st P xs → void)
:= begin
induction xs,
{ right,
  intros H, cases H },
{ induction ih_1,
  { left,
    apply member_st.there, assumption
  },
  { apply (@decidable.by_cases (P a)); intros,
    { left, apply member_st.here, assumption },
    { right, intros contra, cases contra,
      contradiction, apply a_2, assumption
    }
  }
}
end

def member_st_decide {A : Type u}
  (P : A → Prop) [decidable_pred P]
  : ∀ (xs : list A)
  , member_st P xs ⊕ (member_st P xs → void)
| [] := begin right, intros x, cases x end
| (x :: xs) := if H : P x
    then sum.inl (@member_st.here _ _ x xs H)
    else match member_st_decide xs with
      | (sum.inr f) := sum.inr
        begin
          intros contra, cases contra,
          contradiction, apply f, assumption
        end
      | (sum.inl m) := sum.inl (member_st.there m)
      end

def check_member_st {A : Type u}
  (P : A → Prop) [decidable_pred P]
  (xs : list A) : option (member_st P xs)
  := match member_st_decide P xs with
  | sum.inl r := some r
  | sum.inr contra := none
  end

lemma member_st_decide_present {A : Type u}
  {P : A → Prop} [decP : decidable_pred P]
  {xs : list A}
  (m : member_st P xs)
  : psigma (λ m' : member_st P xs,
     member_st_decide P xs = sum.inl m')
:= begin
induction m; clear xs; rename xs_1 xs,
{ constructor, unfold member_st_decide,
    rw (dif_pos a),
},
{ have H := decP x, induction H,
  { induction ih_1 with mxs Pmxs,
    constructor,
    unfold member_st_decide,
    rw (dif_neg a_1), rw Pmxs,
    dsimp [member_st_decide], reflexivity,
  },
  { constructor,
    unfold member_st_decide,
    rw (dif_pos a_1),
  }
}
end

def el_member_decide {A : Type u} [decidable_eq A]
  (z : A) : ∀ (xs : list A)
  , el_member z xs ⊕ (el_member z xs → void)
| [] := begin right, intros x, cases x end
| (x :: xs) := if H : z = x
    then begin induction H, exact sum.inl el_member.here end
    else match el_member_decide xs with
      | (sum.inr f) := sum.inr
        begin
          intros contra, clear _match, cases contra,
          contradiction, apply f, assumption
        end
      | (sum.inl m) := sum.inl (el_member.there m)
      end

lemma el_member_decide_present {A : Type u} [deceqA : decidable_eq A]
  {z : A} {xs : list A}
  (m : el_member z xs)
  : psigma (λ m', el_member_decide z xs = sum.inl m')
:= begin
induction m; clear z xs; rename xs_1 xs,
{ constructor, unfold el_member_decide,
    rw (dif_pos (eq.refl x)),
},
{ have H := deceqA y x, induction H,
  { induction ih_1 with mxs Pmxs,
    constructor,
    unfold el_member_decide,
    rw (dif_neg a_1), rw Pmxs,
    dsimp [el_member_decide], reflexivity,
  },
  { induction a_1, constructor,
    unfold el_member_decide,
    rw (dif_pos (eq.refl _)),
  }
}
end

def check_member {A : Type u} [decidable_eq A]
  (x : A) (xs : list A)
  : option (member xs)
  := match el_member_decide x xs with
  | (sum.inl m) := some m.to_member
  | (sum.inr _) := none
  end

lemma el_member_value {A : Type u}
  (x : A) (xs : list A) (m : el_member x xs)
  : m.to_member.value = x
:= begin
induction m; simp [member.value, el_member.to_member],
assumption
end

lemma member_st_P_value {A : Type u}
  {P : A → Prop} {xs : list A}
  (m : member_st P xs)
  : P m.to_member.value
:= begin
induction m; simp [member_st.to_member, member.value];
assumption,
end

lemma check_member_ok {A : Type u} [decidable_eq A]
  (x : A) (xs : list A)
  (m : xs.member)
  (H : check_member x xs = some m)
  : m.value = x
:= begin
unfold check_member at H,
cases (el_member_decide x xs);
  dsimp [check_member] at H;
  try {contradiction},
injection H with H', clear H,subst m,
apply el_member_value,
end

lemma check_member_present {A : Type u} [decidable_eq A]
  (xs : list A)
  (m : xs.member)
  : psigma (λ m', check_member m.value xs = some m')
:= begin
have m' := m.to_el_member,
have H := el_member_decide_present m',
unfold check_member,
induction H with m'' Hm'',
rw Hm'', dsimp [check_member],
constructor, reflexivity
end

end list


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import portmanteau_definitions
import portmanteau_topological_lemmas
import portmanteau_proba_lemmas
import portmanteau_open_equiv_closed
import portmanteau_integrals
import measure_theory.measurable_space
import measure_theory.integration
import measure_theory.borel_space
import measure_theory.lebesgue_measure

noncomputable theory
open set
open topological_space
open measure_theory
open real
open ennreal

namespace portmanteau

section portmanteau_open_implies_continuous

variables {α : Type} [topological_space α]

-- Why define `real_lt_ennreal`?
-- Note that `ennreal.of_real ((-42 : ℝ)) = (0 : ennreal)` but we want `(-42 : ℝ) < (0 : ennreal)`
-- and `(37 : ℝ) > (∞ : ennreal).to_real` but we want `(37 : ℝ) < (∞ : ennreal)`.
abbreviation real_lt_ennreal (x : ℝ) (z : ennreal) : Prop :=
  (z = ⊤) ∨ (x < ennreal.to_real(z))

lemma real_lt_ennreal_of_le {x y : ℝ} {z : ennreal} (hxy : x ≤ y) (hyz : real_lt_ennreal y z) :
  real_lt_ennreal x z :=
begin
  cases hyz ,
  { left ,
    exact hyz , } ,
  { right ,
    exact lt_of_le_of_lt hxy hyz , } ,
end

lemma real_lt_ennreal_ne_top_iff (x : ℝ) (z : ennreal) (hz : z ≠ ⊤) :
  real_lt_ennreal x z ↔ x < ennreal.to_real(z) :=
begin
  split ,
  { intros h ,
    cases h ,
    { contradiction , } ,
    { exact h , } ,
  } ,
  { intros h ,
    right ,
    exact h , } ,
end

lemma real_lt_ennreal_ne_top_iff' (x : ℝ) (z : ennreal) (hx : 0 ≤ x) (hz : z ≠ ⊤) :
  real_lt_ennreal x z ↔ ennreal.of_real x < z :=
begin
  rw real_lt_ennreal_ne_top_iff x z hz ,
  exact (of_real_lt_iff_lt_to_real hx hz).symm ,
end

-- Remark: It would feel more mathematically natural to define, for `g : β → ennreal`,
-- the set `below_graph_ennval g` as a subset of `β × nnreal`, but since there was
-- no Lebesgue measure on `nnreal`, I ended up using
-- `(volume.restrict {t : ℝ | 0 < t} : measure ℝ)` instead, and therefore the following...
def below_graph_ennval {β : Type*} (g : β → ennreal) := { bt : β × ℝ | real_lt_ennreal (bt.2) (g(bt.1)) }

lemma mble_piece_below_graph {β : Type*} [measurable_space β] (g : β → ennreal) [hg : measurable g] :
  ∀ (r : ℝ) , measurable_set { bt : β × ℝ | bt.2 ≤ r ∧ real_lt_ennreal r (g(bt.1)) } :=
begin
  intro r ,
  have asprod : { bt : β × ℝ | bt.2 ≤ r ∧ real_lt_ennreal r (g(bt.1)) } = set.prod {b : β | real_lt_ennreal r (g b) } (Iic r) ,
  { ext bt ,
    simp only [mem_set_of_eq, mem_prod, mem_Iic] ,
    exact and.comm , } ,
  have interval_mble : measurable_set (Iic r) := measurable_set_Iic ,
  have preimage_mble : measurable_set { b : β | real_lt_ennreal r (g b) } ,
  { by_cases hr : 0 ≤ r ,
    { have as_preim : { b : β | real_lt_ennreal r (g b) } = g⁻¹' (Ioi (ennreal.of_real r)) ,
      { ext b ,
        simp only [mem_set_of_eq, mem_Ioi, mem_preimage] ,
        by_cases gb_top : g b = ⊤ ,
        { have h₁ : real_lt_ennreal r (g b) := by {left , exact gb_top , } ,
          have h₂ : ennreal.of_real r < (g b) := by { rw gb_top , exact of_real_lt_top , } ,
          simp only [h₁, h₂] , } ,
        { exact real_lt_ennreal_ne_top_iff' _ _ hr gb_top , } ,
      } ,
      rw as_preim ,
      apply hg ,
      exact measurable_set_Ioi , } ,
    { have eq_all : { b : β | real_lt_ennreal r (g b) } = univ ,
      { ext b ,
        simp only [mem_univ, mem_set_of_eq, iff_true] ,
        right ,
        exact lt_of_lt_of_le (not_le.mp hr) (@ennreal.to_real_nonneg (g(b))) , } ,
      rw eq_all ,
      exact measurable_set.univ , } ,
  } ,
  have mble_prod := measurable_set.prod preimage_mble interval_mble ,
  exact measurable_set.congr mble_prod (eq.symm asprod) ,
end

lemma below_graph_ennval_union {β : Type*} [measurable_space β]
  (g : β → ennreal) [hg : measurable g] (S : set ℝ) (hSdense : dense S):
  below_graph_ennval g = ( ⋃ (r : S) , { bt : β × ℝ | bt.2 ≤ r ∧ real_lt_ennreal r (g(bt.1)) } ) :=
begin
  ext bt ,
  rw mem_Union ,
  split ,
  { intro hbt ,
    have midpt : ∃ (t : S) , (bt.snd < t) ∧ real_lt_ennreal t (g(bt.fst)) ,
    { have opn₁ : is_open {t' : ℝ | bt.snd < t'} := is_open_lt' bt.snd ,
      have opn₂ : is_open {t' : ℝ | real_lt_ennreal t' (g(bt.fst)) } ,
      { by_cases g_val_top : g(bt.fst) = ⊤ ,
        { have eq_all : {t' : ℝ | real_lt_ennreal t' (g(bt.fst)) } = univ ,
          { apply le_antisymm ,
            { intros s hs , exact dec_trivial , } ,
            { intros s hs , left , exact g_val_top , } ,
          } ,
          rw eq_all ,
          exact is_open_univ ,
        } ,
        { have setsimp : {t' : ℝ | real_lt_ennreal t' (g bt.fst)} = {t' : ℝ | t' < (g bt.fst).to_real } ,
          { ext t ,
            simp only [mem_set_of_eq] ,
            exact real_lt_ennreal_ne_top_iff t (g bt.fst) g_val_top , } ,
          lift g(bt.fst) to nnreal using g_val_top with gval hgval ,
          rw setsimp ,
          exact is_open_gt' (gval : ℝ) , } ,
        } ,
      have opn : is_open {t' : ℝ | bt.snd < t' ∧ real_lt_ennreal t' (g(bt.fst))} := is_open.and opn₁ opn₂ ,
      have nonemp : {t' : ℝ | bt.snd < t' ∧ real_lt_ennreal t' (g(bt.fst))}.nonempty ,
      { by_cases g(bt.fst) = ⊤ ,
        { use (bt.snd + 1) ,
          simp only [lt_add_iff_pos_right, mem_set_of_eq] ,
          rw h ,
          split ,
          { exact zero_lt_one , } ,
          { exact dec_trivial , } ,
        } ,
        { have hbt' := (real_lt_ennreal_ne_top_iff bt.snd _ h).mp hbt ,
          have exmid := exists_between hbt' ,
          cases exmid with c hc ,
          use c ,
          simp only [hc, true_and, mem_set_of_eq] ,
          right ,
          exact hc.2 , } ,
        } ,
      have hereitis := dense_iff_inter_open.mp hSdense _ opn nonemp ,
      rcases hereitis with ⟨ t₀ , ht₀ , hSt₀ ⟩ ,
      use [t₀ , hSt₀ , ht₀] , } ,
    cases midpt with t ht ,
    use t ,
    simp ,
    split ,
    { exact le_of_lt ht.1 , } ,
    { exact ht.2 , } ,
    } ,
  { intros hexs ,
    rcases hexs with ⟨ s , hts , hsg ⟩ ,
    apply real_lt_ennreal_of_le hts hsg , } ,
end

lemma below_graph_ennval_union' {β : Type*} [measurable_space β]
  (g : β → ennreal) [hg : measurable g] (seq : ℕ → ℝ) (hseqdense : dense (range seq)):
  below_graph_ennval g = ( ⋃ (n : ℕ) , { bt : β × ℝ | bt.2 ≤ (seq(n)) ∧ real_lt_ennreal (seq(n)) (g(bt.1)) } ) :=
begin
  have key := @below_graph_ennval_union β _ g hg (range seq) hseqdense ,
  rw key ,
  ext bt ,
  cases bt ,
  simp only [exists_prop, mem_Union, set_coe.exists, mem_range, exists_exists_eq_and, subtype.coe_mk] ,
end

lemma measurable_below_graph_ennval {β : Type*} [measurable_space β] (g : β → ennreal) [hg : measurable g] :
  measurable_set (below_graph_ennval g) :=
begin
  have key_mble := @mble_piece_below_graph β _ g hg ,
  have ex_dense_seq := topological_space.exists_dense_seq ℝ ,
  rcases ex_dense_seq with ⟨ seq , range_seq_dense ⟩ ,
  have key_mble_seq := (λ (n : ℕ) , key_mble (seq(n))) ,
  have key_union := @below_graph_ennval_union' β _ g hg seq range_seq_dense ,
  rw key_union ,
  apply measurable_set.Union key_mble_seq ,
end

lemma measurable_indicator_below_graph_ennval {β : Type*} [measurable_space β] (g : β → ennreal) [hg : measurable g] :
  measurable ( indic (below_graph_ennval g) ) :=
begin
  have key := (indic_mble_iff (below_graph_ennval g)).mpr ,
  exact key (@measurable_below_graph_ennval β _ g hg) ,
end

lemma integral_one_from_zero_to_ennreal (c : ennreal) :
  lintegral (volume : measure ℝ) (λ (t : ℝ) , indic {t : ℝ | 0 < t ∧ real_lt_ennreal t c} t ) = c :=
begin
  by_cases c_infty : c = ⊤ ,
  { have eq₀ : {t : ℝ | 0 < t ∧ real_lt_ennreal t c} = Ioi 0 ,
    { rw c_infty ,
      ext t ,
      simp only [mem_set_of_eq, mem_Ioi, and_iff_left_iff_imp] ,
      intros t ,
      exact dec_trivial , } ,
    rw [eq₀ , c_infty] ,
    simp only [lintegral_one, measurable_set.univ, lintegral_indicator, measurable_set_Ioi, measure.restrict_apply, volume_Ioi,
  univ_inter] , } ,
  { have eq₀ : {t : ℝ | 0 < t ∧ real_lt_ennreal t c} = Ioo 0 c.to_real ,
    { ext t ,
      simp ,
      intros t_pos c_eq_top ,
      contradiction , } ,
    rw eq₀ ,
    simp ,
    exact ennreal.of_real_to_real c_infty , } ,
end

lemma crossection_one_of_below_graph_ennval {β : Type*} (g : β → ennreal) (b : β) :
  { t : ℝ | (⟨b , t⟩ : β × ℝ ) ∈ (below_graph_ennval g) } = {t : ℝ | real_lt_ennreal t (g(b))} := by refl

lemma marginal_one_of_below_graph_ennval {β : Type*} (g : β → ennreal) (b : β) :
  lintegral (volume.restrict { t : ℝ | 0 < t} : measure ℝ) (λ t , indic (below_graph_ennval g) (⟨b,t⟩ : β × ℝ)) = g(b) :=
begin
  have crosssec := crossection_one_of_below_graph_ennval g b ,
  have eq : (λ (t : ℝ) , indic (below_graph_ennval g) (⟨b,t⟩ : β × ℝ)) = indic {t : ℝ | real_lt_ennreal t (g(b))} ,
  { rw ← (crossection_one_of_below_graph_ennval g b) ,
    refl , } ,
  rw eq ,
  by_cases h_gval : g(b) = ⊤ ,
  { rw h_gval ,
    have eq₁ : {t : ℝ | real_lt_ennreal t ⊤} = univ ,
    { ext t ,
      simp only [mem_univ, mem_set_of_eq, iff_true] ,
      left ,
      refl , } ,
    rw eq₁ ,
    rw indic_univ ,
    have vol_infty : (volume : measure ℝ) {t : ℝ | 0 < t} = ⊤ := volume_Ioi ,
    simp only [vol_infty, lintegral_one, measurable_set.univ, measure.restrict_apply, univ_inter] , } ,
  { have eq₂ : {t : ℝ | real_lt_ennreal t (g(b))} = (Iio (ennreal.to_real (g(b)))) ,
    { ext t ,
      simp only [mem_Iio, mem_set_of_eq, or_iff_right_iff_imp] ,
      intro h ,
      contradiction , } ,
    rw eq₂ ,
    have key := integral_indic (volume.restrict { t : ℝ | 0 < t} : measure ℝ) (Iio (ennreal.to_real (g(b)))) (measurable_set_Iio) ,
    rw key ,
    have set_eq : Iio (ennreal.to_real (g(b))) ∩ {t : ℝ | 0 < t} = Ioo 0 (ennreal.to_real (g(b))) ,
    { ext t ,
      simp only [mem_inter_eq, mem_Iio, mem_Ioo, mem_set_of_eq] ,
      tauto , } ,
    simp [set_eq] ,
    exact ennreal.of_real_to_real h_gval , } ,
end

lemma crossection_two_of_below_graph_ennval {β : Type*} (g : β → ennreal) (t : ℝ) (t_nn : 0 ≤ t) :
  { b : β | (⟨b , t⟩ : β × ℝ ) ∈ (below_graph_ennval g) } = g⁻¹' (Ioi (ennreal.of_real t)) :=
begin
  ext b ,
  by_cases h_gval : g b = ⊤ ,
  { simp only [h_gval, of_real_lt_top, mem_set_of_eq, mem_Ioi, iff_true, mem_preimage] ,
    left ,
    exact h_gval , } ,
  exact real_lt_ennreal_ne_top_iff' t (g(b)) t_nn h_gval ,
end

lemma crossection_two_of_below_graph_ennval' {β : Type*} (g : β → ennreal) (t : ℝ) (t_neg : t < 0 ) :
  { b : β | (⟨b , t⟩ : β × ℝ ) ∈ (below_graph_ennval g) } = univ :=
begin
  ext b ,
  simp only [mem_univ, mem_set_of_eq, iff_true] ,
  right ,
  exact lt_of_lt_of_le t_neg (to_real_nonneg) ,
end

lemma measurable_marginal_two_of_below_graph_ennval {β : Type*} [measurable_space β] (μ : measure β) [hμ : sigma_finite μ]
  (g : β → ennreal) [hg : measurable g] :
  measurable (λ (t : ℝ) , lintegral μ (λ b , indic (below_graph_ennval g) (⟨b,t⟩ : β × ℝ))) :=
begin
  have mble_fun := @measurable_indicator_below_graph_ennval _ _ g hg ,
  exact @measurable.lintegral_prod_left' β ℝ _ _ μ _ _ mble_fun ,
end

lemma marginal_two_of_below_graph_ennval {β : Type*} [measurable_space β] (μ : measure β) [hμ : sigma_finite μ]
  (g : β → ennreal) [hg : measurable g] (t : ℝ) (t_nn : 0 ≤ t) :
  lintegral μ (λ b , indic (below_graph_ennval g) (⟨b,t⟩ : β × ℝ)) = μ (g⁻¹' (Ioi (ennreal.of_real t))) :=
begin
  have crosssec := crossection_two_of_below_graph_ennval g t t_nn ,
  have eq : (λ b , indic (below_graph_ennval g) (⟨b,t⟩ : β × ℝ)) = indic (g⁻¹' (Ioi (ennreal.of_real t))) ,
  { rw ← (crossection_two_of_below_graph_ennval g t t_nn) ,
    refl , } ,
  rw eq ,
  apply integral_indic ,
  exact hg (measurable_set_Ioi) ,
end

lemma lintegral_eq_lintegral_ccdf {β : Type*} [measurable_space β]
  (μ : measure β) [hμ : sigma_finite μ] (g : β → ennreal) [hg : measurable g] :
    lintegral μ g = lintegral (volume.restrict { t : ℝ | 0 < t } : measure ℝ) (λ (t : ℝ) , μ (g ⁻¹' Ioi (ennreal.of_real t)) ) :=
begin
  set P := { t : ℝ | 0 < t } with hP ,
  set Leb_P := (volume.restrict { t : ℝ | 0 < t } : measure ℝ) with h_Leb_P ,
  have pi_mble := @measurable_indicator_below_graph_ennval β _ g hg ,
  set f := (λ (b : β) , (λ (t : ℝ) , (indic (below_graph_ennval g) (⟨b, t⟩ : β × ℝ)))) with hf ,
  have swap := @lintegral_lintegral_swap β ℝ _ _ μ Leb_P _ hμ f (measurable.ae_measurable pi_mble) ,
  have key₁ : ( λ (b : β) , lintegral (volume.restrict { t : ℝ | 0 < t } : measure ℝ) (λ (t : ℝ) , f b t)) = g ,
  { funext b ,
    exact marginal_one_of_below_graph_ennval g b , } ,
  rw key₁ at swap ,
  have key₂ : ( λ (t : ℝ) , lintegral μ (λ (b : β) , f b t)) =ᵐ[Leb_P] (λ t , (μ (g ⁻¹' (Ioi (ennreal.of_real t))))) ,
  { suffices : P ⊆ {t : ℝ | ( λ (t : ℝ) , lintegral μ (λ (b : β) , f b t)) t = (λ t , (μ (g ⁻¹' (Ioi (ennreal.of_real t))))) t} ,
    { have Pc_null : Leb_P (Pᶜ) = 0 ,
      { have Pc_eq : Pᶜ = Iic 0 ,
        { ext t ,
          dsimp ,
          simp only [not_lt, mem_Iic] , } ,
        rw [Pc_eq, h_Leb_P] ,
        have inter : Iic 0 ∩ P = ∅ ,
        { ext t ,
          dsimp ,
          simp only [imp_self, not_and, not_lt, mem_Iic, iff_false] , } ,
        simp [inter] , } ,
      exact @filter.mem_sets_of_superset ℝ (measure.ae Leb_P) P _ Pc_null this , } ,
    intros t ht ,
    exact @marginal_two_of_below_graph_ennval β _ μ hμ g hg t (le_of_lt ht) , } ,
  rwa ← (lintegral_congr_ae key₂) ,
end

lemma portmanteau_open_fatou {β : Type*} [measurable_space β] (vol : measure β)
  {Gfun : β → set α} (G_opens : ∀ b , is_open (Gfun b))
  (μseq : ℕ → @measure_theory.measure α (borel α))
  (μseq_fin : ∀ (n : ℕ) , @probability_measure α (borel(α)) (μseq(n)))
  (μ : @measure_theory.measure α (borel α)) (μ_fin : @probability_measure α (borel(α)) μ)
  (mble : ∀ (n : ℕ) , measurable (λ (b : β) , (μseq(n)) (Gfun(b)) )) :
    portmanteau_open μseq μ →
      ( lintegral vol (λ b , μ (Gfun b)) ≤ liminf_enn (λ n , lintegral vol (λ b , (μseq(n)) (Gfun b)) )) :=
begin
  intros hopcond ,
  set f := (λ (n : ℕ) , (λ (b : β) , (μseq(n)) (Gfun(b)) ) ) with hf ,
  have fatou := @measure_theory.lintegral_liminf_le _ _ vol f mble ,
  rw hf at fatou ,
  have le_liminf : (λ (b : β) , μ (Gfun b) ) ≤ (λ (b : β) , liminf_enn (λ (n : ℕ ), (μseq(n)) (Gfun b) )) ,
  { intros b ,
    exact hopcond _ (G_opens b) , } ,
  have int_mono := @lintegral_mono β _ vol _ _ le_liminf ,
  exact le_trans int_mono fatou ,
end

lemma portmanteau_open_imp_cont_liminf
  (μseq : ℕ → @measure_theory.measure α (borel α))
  (μseq_fin : ∀ (n : ℕ) , @probability_measure α (borel(α)) (μseq(n)))
  (μ : @measure_theory.measure α (borel α)) (μ_fin : @probability_measure α (borel(α)) μ) :
    portmanteau_open μseq μ →
      ( ∀ (f : α → ennreal) , continuous f → bdd_ennval f →
        @lintegral α (borel(α)) μ f ≤ liminf_enn (λ n , @lintegral α (borel(α)) (μseq(n)) f ) ) :=
begin
  intros hopcond f f_cont f_bdd ,
  have f_mble := continuous.borel_measurable f_cont ,
  have preim_open : ∀ (t : ℝ) , is_open (f⁻¹' Ioi (ennreal.of_real t)) ,
  { intros t ,
    exact continuous_def.mp f_cont (Ioi (ennreal.of_real t)) (is_open_Ioi) , } ,
  have rwkey := @lintegral_eq_lintegral_ccdf α (borel α) μ _ f f_mble ,
  have rwkeyseq : (λ n , @lintegral α (borel(α)) (μseq(n)) f ) = (λ n , lintegral (volume.restrict {t : ℝ | 0 < t} : measure ℝ) (λ (t : ℝ) , (μseq(n)) (f ⁻¹' Ioi (ennreal.of_real t)) ) ) ,
  { exact funext (λ n , @lintegral_eq_lintegral_ccdf α (borel α) (μseq(n)) _ f f_mble) , } ,
  have mble_meas : ∀ n , measurable (λ t , (μseq(n)) (f⁻¹' Ioi (ennreal.of_real t)) ) ,
  { intros n ,
    have key := @measurable_marginal_two_of_below_graph_ennval α (borel(α)) (μseq(n)) _ f f_mble ,
    set P := { t : ℝ | 0 ≤ t } with hP ,
    have P_mble : measurable_set P := measurable_set_Ici ,
    set f₀ := (λ t , (μseq(n)) (f⁻¹' Ioi (ennreal.of_real t)) ) with hf₀ ,
    set f₁ := ( λ t , @lintegral α (borel(α)) (μseq(n)) (λ b , indic (below_graph_ennval f) (⟨b,t⟩ : α × ℝ))) with hf₁ ,
    set c := (μseq(n)) (f⁻¹'(Ioi (0:ennreal))) with hc ,
    set cfun := (λ (t:ℝ) , c) with hcfun ,
    have eq : f₀ = (indic P) * f₁ + (indic Pᶜ) * cfun ,
    { funext t ,
      dsimp ,
      by_cases ht : t ∈ P ,
      { rw [(indic_val_one_iff P t).mpr ht , (indic_val_zero_iff (Pᶜ) t).mpr (not_not.mpr ht)] ,
        simp only [add_zero, one_mul, zero_mul] ,
        exact (@marginal_two_of_below_graph_ennval α (borel(α)) (μseq(n)) _ f f_mble t ht).symm , } ,
      { rw [(indic_val_zero_iff P t).mpr ht , (indic_val_one_iff (Pᶜ) t).mpr (mem_compl ht)] ,
        simp only [one_mul, zero_mul, zero_add] ,
        rw [hf₀ , hcfun] ,
        dsimp ,
        rw hc ,
        have eq_Ioi : Ioi (0:ennreal) = Ioi (ennreal.of_real t) ,
        { have eq_val := ennreal.of_real_eq_zero.mpr (le_of_lt (not_le.mp ht)) ,
          exact congr_arg Ioi eq_val.symm , } ,
        rw eq_Ioi , } ,
    } ,
    rw eq ,
    have mble_indic_P : measurable (indic P) := (indic_mble_iff P).mpr P_mble ,
    have mble_indic_Pc : measurable (indic Pᶜ) := (indic_mble_iff Pᶜ).mpr (measurable_set.compl P_mble) ,
    have mble_term₁ : measurable ((indic P) * f₁) := measurable.mul mble_indic_P key ,
    have mble_term₂ : measurable ((indic Pᶜ) * cfun) := measurable.mul mble_indic_Pc (measurable_const) ,
    exact measurable.add mble_term₁ mble_term₂ , } ,
  rw [rwkey, rwkeyseq] ,
  exact portmanteau_open_fatou (volume.restrict {t : ℝ | 0 < t} : measure ℝ) preim_open μseq μseq_fin μ μ_fin mble_meas hopcond ,
end

lemma portmanteau_open_imp_cont
  (μseq : ℕ → @measure_theory.measure α (borel α))
  (μseq_fin : ∀ (n : ℕ) , @probability_measure α (borel(α)) (μseq(n)))
  (μ : @measure_theory.measure α (borel α)) (μ_fin : @probability_measure α (borel(α)) μ) :
    portmanteau_open μseq μ → portmanteau_continuous_ennval μseq μ :=
begin
  intros hopcond f f_cont f_bdd ,
  suffices : limsup_enn ( λ (n : ℕ) , @lintegral α (borel(α)) (μseq(n)) f ) ≤ @lintegral α (borel(α)) μ f ,
  { have liminf_ge := portmanteau_open_imp_cont_liminf μseq μseq_fin μ μ_fin hopcond f f_cont f_bdd ,
    exact tendsto_of_le_liminf_of_limsup_le liminf_ge this , } ,
  cases f_bdd with c hc ,
  have ne_top : (c : ennreal) ≠ ⊤ := coe_ne_top ,
  set g := (( λ (a : α) , (c : ennreal)) - f) with hg ,
  have g_cont : continuous g ,
  { set φ := (λ (x : ennreal) , (c:ennreal) - x) with hφ ,
    have cts : continuous φ := continuous_const_sub_ennreal _ ne_top ,
    have g_eq : g = φ ∘ f := by refl ,
    apply continuous.comp cts f_cont , } ,
  have g_bdd : bdd_ennval g ,
  { use c ,
    intros a,
    rw hg ,
    exact ennreal.sub_le_self c (f(a)) , } ,
  have key := portmanteau_open_imp_cont_liminf μseq μseq_fin μ μ_fin hopcond g g_cont g_bdd ,
  rw hg at key ,
  have eq := lintegral_cst_sub μ ne_top f (continuous.borel_measurable f_cont) hc ,
  have eq_seq' := λ n , lintegral_cst_sub (μseq(n)) ne_top f (continuous.borel_measurable f_cont) hc ,
  have eq_seq : (λ n , @lintegral α (borel(α)) (μseq(n)) g) = (λ n , (c:ennreal) - @lintegral α (borel(α)) (μseq(n)) f)
    := funext eq_seq' ,
  rw [eq , eq_seq , liminf_enn_rw] at key ,
  rw (liminf_const_sub c ne_top (λ n , @lintegral α (borel(α)) (μseq(n)) f)) at key ,
  have le₁ : @lintegral α (borel(α)) μ f ≤ c ,
  { have le := @lintegral_mono α (borel(α)) μ f _ hc ,
    rwa lintegral_cst μ c at le , } ,
  have le₂ : limsup_enn (λ n , @lintegral α (borel(α)) (μseq(n)) f) ≤ c ,
  { suffices : ∀ n , @lintegral α (borel(α)) (μseq(n)) f ≤ c ,
    { exact limsup_le_of_le_ennreal this , } ,
    intros n ,
    have le := @lintegral_mono α (borel(α)) (μseq(n)) f _ hc ,
    rwa lintegral_cst (μseq(n)) c at le , } ,
  exact le_of_self_sub_le_self_sub_ennreal c _ _ ne_top le₁ le₂ key ,
end

end portmanteau_open_implies_continuous

end portmanteau


import SciLean.Data.PowType
import SciLean.Core.Hom.SmoothMap
import SciLean.Core.Hom.LinMap

namespace SciLean

  -- #check Set

  -- class HasIntegral {X} (X : Type) [Vec X] where
  --   intDom : Set (Set X) -- integrable domains
  --   isIntegrable {Y} [Vec Y] (f : X → Y) : Prop
  --   integral (f : X → Y) (h : isIntegrable f) (Ω ∈ intDom)

  -- The argument are most likely:
  --  Fun    = X → Y or X ⟿ Y or X ⊸ Y
  --  Dom    = open sets of X
  --  Result = Y

  -- class Integral (Fun : Type) (Dom : outParam Type) (Result : outParam Type) /- (Integrable : outParam $ Fun → Dom → Prop) -/ where
  --   integral : Fun → Dom → Result
  -- class HasVarDual {Fun Dom Result} [SemiHilbert Fun] [Integral Fun Dom Result] (f : Fun → Dom → Result) : Prop where
  --   has_var_dual : ∃ f' : Fun, ∀ (g : Fun) (r : Result) (Ω : Dom) (h : TestFunctionOn g Ω) (hr : TestFunction r),
  --     ⟪f g Ω, r⟫[hr] = ⟪⟪f',g⟫[h], r⟫[hr]

  class IntegrableDomain (X : Type) where
    Dom : Type

  noncomputable
  def indicatorFunction {α} (Ω : α → Prop) (a : α) : ℝ :=
    match Classical.propDecidable (Ω a) with
      | isTrue  _ => 1
      | isFalse _ => 0

  -- prefix:max "𝟙" => indicatorFunction

  variable {ι} [Enumtype ι]

  def IsOpen {X} [FinVec X ι] (Ω : Set X) : Prop := sorry
  def IsBounded {X} [FinVec X ι] (Ω : Set X) : Prop := sorry

  def IntDom (X : Type) [FinVec X ι] : Type := {Ω : Set X // IsOpen Ω}

  -- TODO: LocIntDom should form an Abelian group, so we can write
  --   1. ∫ x ∈ [1,-1], f x         -- usefull for the differentiation under the integral sign
  --   1. ∫ x ∈ 3*Ω₁ - Ω₂, f x      -- usefull for working with chains and cochains
  -- def LocIntDom (X : Type) [FinVec X ι] : Type := {Ω : Set X // IsOpen Ω ∧ IsBounded Ω}

  inductive LocIntDom.Repr(X : Type) [FinVec X ι] where
  | set (Ω : Set X) : IsOpen Ω → IsBounded Ω → LocIntDom.Repr X
  | sum (Ω₁ Ω₂ : LocIntDom.Repr X) : LocIntDom.Repr X
  | smul (s : ℝ) (Ω : LocIntDom.Repr X) : LocIntDom.Repr X

  noncomputable
  def LocIntDom.Repr.indicatorFun {X} [FinVec X ι] (Ω : LocIntDom.Repr X) : X → ℝ :=
  match Ω with
  | set Ω' _ _ => indicatorFunction Ω'
  | sum Ω₁ Ω₂  => Ω₁.indicatorFun + Ω₂.indicatorFun
  | smul s Ω   => s * Ω.indicatorFun

  def LocIntDom.Repr.Eq {X} [FinVec X ι] (Ω₁ Ω₂ : LocIntDom.Repr X) : Prop :=
    (Ω₁.indicatorFun = Ω₂.indicatorFun)

  def LocIntDom (X : Type) [FinVec X ι] : Type := Quot (LocIntDom.Repr.Eq (X:=X))

  instance {X} [FinVec X ι] : Add (LocIntDom X) :=
    ⟨(λ Ω₁ => (λ Ω₂ => Quot.mk _ (.sum Ω₁ Ω₂)) |> (Quot.lift · sorry)) |> (Quot.lift · sorry)⟩

  instance {X} [FinVec X ι] : HMul ℝ (LocIntDom X) (LocIntDom X) :=
    ⟨λ s => (λ Ω => Quot.mk _ (.smul s Ω)) |> (Quot.lift · sorry)⟩

  -- Empty set
  instance {X} [FinVec X ι] : Zero (LocIntDom X) :=
    ⟨Quot.mk _ (.set (λ _ => False) sorry sorry)⟩

  -- Probably Riemann integrability on domain Ω
  class IsIntegrable [FinVec X ι] [Vec Y] (f : X → Y) (Ω : IntDom X) : Prop
  class IsLocIntegrable [FinVec X ι] [Vec Y] (f : X → Y) : Prop where
    is_loc_integrable : ∀ Ω : LocIntDom X, IsIntegrable f sorry -- ⟨Ω.1, Ω.2.1⟩

  -- If `f` is integrable on `Ω` return integral otherwise return zero
  -- IMPORTANT: We choose to integrate only over **bounded** domains.
  --            This way the function `λ (f : X⟿Y) => ∫ x, f x` can be linear.
  -- QUESTION: Do we need Y to be complete? For example smooth function
  --   with compact support do not form closed subspace in `ℝ ⟿ ℝ`.
  --   Can we have `γ : ℝ ⟿ {f : ℝ ⟿ ℝ // TestFun f}` such that
  --   `∫ t ∈ [0,1], γ.1` is not a `TestFun`?
  def integral {X Y : Type} [FinVec X ι] [Vec Y] (f : X → Y) (Ω : LocIntDom X) : Y := sorry

  class Integral (Fun : Type) (R : outParam Type) where
    integral : Fun → R

  attribute [reducible] Integral.integral

  @[reducible, defaultInstance, inferTCGoalsRL]
  instance {X Y : Type} [FinVec X ι] [Vec Y] : Integral (X → Y) (LocIntDom X → Y) where
    integral f := integral f

  @[reducible]
  instance {X Y : Type} [FinVec X ι] [Vec Y] : Integral (X ⟿ Y) (LocIntDom X → Y) where
    integral f := integral f

   -- some basic properties about linearity, domain and relation to derivative

  -- class HasVarDual {X Y : Type} {P : (X → Y) → Prop} [FinVec X ι] [Hilbert Y] (F : {g : X → Y // P g} → IntDom X → ℝ) where
  --   has_var_dual : ∃ f' : X → Y, ∀ g,
  --     F g = integral λ x => ⟪f' x, g.1 x⟫

    -- some continuity condition on smooth or integrable functions or something like that
    -- F should be trivial on non-smooth/non-integrable functions
    -- Effectivelly functions like F = λ f => ∫ x, (f x)

  -- export Integral (integral)

  -- abbrev integral {Fun : Type} {Dom Result : outParam Type} [outParam $ Integral Fun Dom Result] (f : Fun) (Ω : Dom) : Result := Integral.integral f Ω

  --- Notation
  --  - ∫ f          -- shorthand for the next
  --  - ∫ x, f x     -- Return function from subset to integral over that subset
  --  - ∫ x ∈ Ω, f x -- Integrate over particular subset
  --  - ∫ x : X, f x -- Integrate over the whole set

  --  The paper 'I♥LA: compilable markdown for linear algebra' https://doi.org/10.1145/3478513.3480506
  --  claims on page 5 that conservative sum is more common then greedy
  --  We addopt this for integral too, hence the priority `fx:term:66`

  macro "∫" f:term:66 : term => `(Integral.integral $f)
  macro "∫" x:Lean.Parser.Term.funBinder "," fx:term:66 : term => `(∫ λ $x => $fx)
  -- ∫ (x,y), f x y  -- does not work :(

  -- We should probably require for `R` to be of the form `... → ℝ`
  -- Otherwise it does not make sense
  -- Unfortunatelly I do not know how to nest integrals :(
  -- class HasVarDual {Fun R} [SemiHilbert Fun] [One Fun] [Integral Fun R] (F : Fun → R) : Prop where
  --   hasVarDual : ∃ A : Fun → Fun, HasAdjoint A ∧ (∀ f, F f = ∫ (A f))
    -- There is something magical about the type `R` that ensures uniqueness of A
    -- Ohh yeah `R` is really big ...
    --   for example for `Fun = ℝ^{n}` the `R` would be `(Fin n → Bool) → ℝ`
    --   i.e. we have to provide `Fin n → Bool` to specify over which indices to sum over
    --   the `(Fin n → Bool) → ℝ` is waaay bigger then `ℝ^{n}`

  class FullIntegral (Fun : Type) (R : outParam Type) where
    integral : Fun → R           -- R plays a bit similar role of ℝ

  instance {X ι} [Enumtype ι] [FinVec X ι] : FullIntegral (X ⟿ ℝ) (LocIntDom X → ℝ) where
    integral f := ∫ f

  instance {X ι} [Enumtype ι] [FinVec X ι] [SemiHilbert Y] [FullIntegral Y R] [Vec R]
    : FullIntegral (X ⟿ Y) (LocIntDom X → R) where
    integral f := ∫ x, FullIntegral.integral (f x)

  def HasVarDual {Fun R} [SemiHilbert Fun] [FullIntegral Fun R] (F : Fun → R) : Prop :=
    ∃ A : Fun → Fun, HasAdjoint A ∧ (∀ f, F f = FullIntegral.integral (A f))

  noncomputable
  def varDual {Fun R} [SemiHilbert Fun] [One Fun] [FullIntegral Fun R] (F : Fun → R) : Fun :=
    match Classical.propDecidable (HasVarDual F) with
    | isTrue h =>
      let A := Classical.choose h
      A† 1
    | isFalse _ => 0

  #check Vec

  -- This should be immediate from the definition
  @[simp]
  theorem varDual_smooth_fun {X Y ι} [Enumtype ι] [FinVec X ι] [Hilbert Y]
    (F : (X ⟿ ℝ) → (X ⟿ ℝ)) [HasAdjoint F]
    : varDual (λ f => ∫ F f) = F† 1 := sorry

  -- instance {X ι} [Enumtype ι] [FinVec X ι] : VarDual (X ⟿ ℝ) (LocIntDom X → ℝ) where
  --   -- hasVarDual F := ∃ A : (X ⟿ ℝ) → (X ⟿ ℝ), HasAdjoint A ∧ (∀ f, F f = ∫ (A f))
  --   integral f := ∫ f
  --   varDual := sorry

  -- instance {X ι} [Enumtype ι] [FinVec X ι] [SemiHilbert Y] [VarDual Y R] : VarDual (X ⟿ Y) (LocIntDom X → R) where
  --   hasVarDual F := ∃ A : (X ⟿ Y) → (X ⟿ Y), HasAdjoint A ∧ (∀ f, F f = ∫ (A f))
  --   varDual := sorry

  -- instance VarDual (X → ℝ) (LocIntDom X → ℝ) where
  --   varDual := sorry

  -- noncomputable
  -- def varDual {Fun R} [SemiHilbert Fun] [One Fun] [Integral Fun R] (F : Fun → R) : Fun :=
  --   match Classical.propDecidable (HasVarDual F) with
  --   | isTrue h =>
  --     let A := Classical.choose h.hasVarDual
  --     A† 1
  --   | isFalse _ => 0

  variable {X Y Z} [FinVec X ι] [Vec Y] [Vec Z]

  #check varDual λ (f : X ⟿ ℝ) => ∫ x, f x
  #check_failure varDual λ (f : X ⟿ X ⟿ ℝ) => ∫ x, f x  -- this should not typecheck fail
  #check varDual λ (f : X ⟿ X ⟿ ℝ) => ∫ x, ∫ y, f x y -- this shoud typecheck

  -- instance SmoothMap.val.arg_f.isLin : IsLin (λ f : X⟿Y => f.1) := by infer_instance
  -- instance SmoothMap.val.arg_f.isSmooth : IsSmooth (λ f : X⟿Y => f.1) := by infer_instance

  -- We can't prove linearity of differential directly
  -- instance (F : (X⟿Y) → (X → Y)) [IsLin F] [∀ f, IsSmooth (F f)]
  --   : IsLin λ (f : X⟿Y) => ∂ (F f) := by infer_instance
  -- instance (F : (X⟿Y) → (X → Y)) [IsSmooth F] [∀ f, IsSmooth (F f)]
  --   : IsSmooth λ (f : X⟿Y) => ∂ (F f) := by infer_instance

  instance (F : Z → X → Y) [IsLin F] [∀ f, IsSmooth (F f)]
    : IsLin λ (z : Z) => ∫ x, F z x := sorry
  instance (F : Z → X → Y) [IsSmooth F] [∀ f, IsSmooth (F f)]
    : IsSmooth λ (z : Z) => ∫ x, F z x := sorry

  -- IMPORTANT: This is true only when we integrate over bounded domains!
  --            Double check this is really true
  @[simp]
  theorem diff_integral (F : Z → X → Y) [IsSmooth F] [∀ f, IsSmooth (F f)]
    : ∂ (λ z => ∫ x, F z x) = λ z dz => ∫ x, ∂ F z dz x := sorry

  -- instance (f : X → Y → Z) [IsSmooth F] [∀ f, IsSmooth (F f)]
  --   (g : X → Y) [IsSmooth
  --   : IsSmooth λ (z : Z) => ∫ x, F z x := sorry
  example : IsSmooth fun (f : X ⟿ Y) x => (2 : ℝ) * f x := by infer_instance

  example : IsSmooth λ f : ℝ⟿ℝ => λ x => differential f.1 x 1 := by infer_instance

  instance diff.arg_x.comp.isSmooth' {X Y Z} [Vec X] [Vec Y] [Vec Z] [Vec W]
    (f : Y → Z → W) [IsSmooth f] [∀ y, IsSmooth (f y)]
    (g : X → Y) [IsSmooth g]
    : IsSmooth (λ x => ∂ (f (g x))) := sorry

  example (f : ℝ⟿ℝ) : IsSmooth λ x => ∂ f x 1 := by infer_instance

  instance : IsSmooth fun (f : ℝ⟿ℝ) => ∂ f := sorry

  -- set_option trace.Meta.synthInstance true in
  -- TODO: Simplify
  instance {X Y} [Vec X] [Vec Y] : IsSmooth fun (f : X⟿Y) x dx  => ∂ f x dx := sorry
  instance {X Y} [Vec X] [Vec Y] (x : X) : IsSmooth fun (f : X⟿Y) => ∂ f x := sorry
  instance {X Y} [Vec X] [Vec Y] (x dx : X) : IsSmooth fun (f : X⟿Y) => (∂ f) x dx := sorry
  instance {X Y} [Vec X] [Vec Y] : IsLin fun (f : X⟿Y) x dx  => ∂ f x dx := sorry
  instance {X Y} [Vec X] [Vec Y] (x : X) : IsLin fun (f : X⟿Y) => ∂ f x := sorry
  instance {X Y} [Vec X] [Vec Y] (x dx : X) : IsLin fun (f : X⟿Y) => (∂ f) x dx := sorry
  instance {X Y} [SemiHilbert X] [SemiHilbert Y] : IsSmooth fun (f : X⟿Y) x dy  => ∂† f.1 x dy := sorry
  instance {X Y} [SemiHilbert X] [SemiHilbert Y] (x : X) : IsSmooth fun (f : X⟿Y) => ∂† f.1 x := sorry
  instance {X Y} [SemiHilbert X] [SemiHilbert Y] (x : X) (dy : Y) : IsSmooth fun (f : X⟿Y) => (∂† f.1) x dy := sorry

  instance {X Y} [SemiHilbert X] [SemiHilbert Y] (f : X → Y) [HasAdjDiff f] : IsSmooth fun x dy => ∂† f x dy := sorry
  instance {X Y} [SemiHilbert X] [SemiHilbert Y] (f : X → Y) [HasAdjDiff f] (x : X) : IsSmooth fun dy => ∂† f x dy := sorry
  instance {X Y} [SemiHilbert X] [SemiHilbert Y] (f : X → Y) [HasAdjDiff f] (x : X) : IsLin fun dy => ∂† f x dy := sorry

  example (Ω : LocIntDom ℝ) : IsSmooth λ (f : ℝ ⟿ ℝ) => (∫ x, f x) Ω := by infer_instance

  set_option synthInstance.maxSize 2048 in
  example : ∀ (Ω : LocIntDom ℝ), IsSmooth λ (f : ℝ ⟿ ℝ) => (∫ x, ∥∂ f x 1∥²) Ω := by infer_instance
  example: IsSmooth fun (f : ℝ ⟿ ℝ) => (fun x => ∥Subtype.val (Subtype.val (∂f) x ) 1∥²) := by infer_instance
  example (i : LocIntDom ℝ) : IsSmooth fun (f : ℝ ⟿ ℝ) => Integral.integral (fun x => ∥Subtype.val (Subtype.val (∂f) x ) 1∥²) i := by infer_instance
  set_option synthInstance.maxSize 2048 in
  example : ∀ (i : LocIntDom ℝ), IsSmooth fun (f : ℝ ⟿ ℝ) => Integral.integral (fun x => ∥Subtype.val (Subtype.val (∂f) x ) 1∥²) i := by infer_instance

  variable (f  : X⟿ℝ) (g : X→ℝ)
  #check Integral.integral f

  #check ∫ x, f x
  #check ∫ x, g x

  example : ∂ (λ f : X⟿ℝ => ∫ x, f x) = λ (f df : X⟿ℝ) => ∫ x, df x := by simp
  example : ∂ (λ f : X⟿ℝ => ∫ x, ∥f x∥²) = λ (f df : X⟿ℝ) => ∫ x, 2 * df x * f x := by simp

  -- set_option trace.Meta.Tactic.simp.discharge true in
  example : ∂ (λ f : ℝ⟿ℝ => ∫ x, ∂ f x 1) = λ (f df : ℝ⟿ℝ) => ∫ x, ∂ df x 1 := by simp; done
  set_option synthInstance.maxSize 2048 in
  example : ∂ (λ f : ℝ⟿ℝ => ∫ x, ∥∂ f x 1∥²) = λ (f df : ℝ⟿ℝ) => ∫ x, 2 *  ∂ df x 1 * ∂ f x 1 := by simp; done

  -- class HasVarDual {Y} [Hilbert Y] (F : (X ⟿ Y) → LocIntDom X → ℝ) where
  --   has_var_dual : ∃ (f : X ⟿ Y), ∀ (g : X ⟿ Y), F g = ∫ x, ⟪f x, g x⟫ -- maybe g true only for domains Ω on which g is a test function

  -- -- Defined only if it has variational dual otherwise zero function
  -- def varDual : ((X ⟿ Y) → LocIntDom X → ℝ) → (X ⟿ Y) := sorry

  -- instance {X Y ι} [Enumtype ι] [FinVec X ι] [SemiHilbert Y] : VarDual (X ⟿ Y) (LocIntDom X → ℝ) where
  --   varDual := varDual

  -- instance hoho {X Y R} [FinVec X ι] [SemiHilbert Y] [VarDual Y R] : VarDual (X ⟿ Y) (LocIntDom X → R) where
  --   varDual := sorry

  -- example : VarDual (ℤ → ℝ) (LocIntDom ℤ → ℝ) := by infer_instance
  -- example : VarDual (X ⟿ ℤ → ℝ) (LocIntDom X → LocIntDom ℤ → ℝ) := by infer_instance
  -- example : VarDual (ℤ → X ⟿ ℝ) (LocIntDom ℤ → LocIntDom X → ℝ) := by infer_instance

  -- example {Y Z} [FinVec Y ι] [SemiHilbert Z] : VarDual (Y ⟿ Z) (LocIntDom Y → ℝ) := by infer_instance
  -- example {X Y Z} [FinVec X ι] [FinVec Y ι] [SemiHilbert Z] : VarDual (X ⟿ Y ⟿ Z) (LocIntDom X → LocIntDom Y → ℝ) := by infer_instance
  -- example {X Y Z} [FinVec X ι] [FinVec Y ι] [SemiHilbert Z] : VarDual (X×Y ⟿ Z) (LocIntDom (X × Y) → ℝ) := by infer_instance

  @[simp]
  theorem varDual_fun {Y} [Hilbert Y] (F : (X ⟿ Y) → (X ⟿ ℝ)) [HasAdjoint F]
    : varDual (λ f : X ⟿ Y => ∫ x, F f x) = F† (λ _ ⟿ 1) := by simp

  -- @[simp]
  -- theorem integral_normalize_to_smooth (f : X → Y) [IsSmooth f]
  --   : (∫ x, f x) = ∫ x, (λ x' ⟿ f x') x := sorry

  instance pointwise_has_adjoint {Y Z} [Hilbert Y] [Hilbert Z] (A : X → Y → Z) [∀ x, HasAdjoint (A x)] [IsSmooth A] [∀ x, IsSmooth (A x)]
    : HasAdjoint (λ f : X ⟿ Y => λ x ⟿ A x (f x)) := sorry

  instance pointwise_has_adjoint' {Y Z} [Hilbert Y] [Hilbert Z] (A : Y → X → Z) [∀ x, HasAdjoint (λ y => A y x)] [IsSmooth A] [∀ y, IsSmooth (A y)]
    : HasAdjoint (λ f : X ⟿ Y => λ x ⟿ A (f x) x) := sorry

  -- instance comp_adjoint {A B C} [Hilbert A] [Hilbert B] [Hilbert C]
  --   (F : (X → B) → X → (X → C)) [∀ (f : X -> B) y, IsSmooth (λ x => F f y x)] --[HasAdjoint (λ f : X ⟿ B => λ x ⟿ F f.1 x)] [IsSmooth λ f : X->B => F f]
  --   (G : (X → A) → X → (X → B)) [∀ (f : X -> A) y, IsSmooth (λ x => G f y x)] --[HasAdjoint (λ f : X ⟿ A => λ x ⟿ G f.1 x)] [IsSmooth λ f : X->A => G f]
  --   : HasAdjoint (λ f : X ⟿ A => λ x ⟿ F (G f.1 x) x x) := sorry

  example {Y} [Hilbert Y] (c : ℝ)
    : HasAdjoint (λ f : X ⟿ Y => λ x ⟿ c * f x) := by infer_instance

  def smoothEval {X Y} [Vec X] [Vec Y] (x : X) (f : X ⟿ Y) : Y  := f x

  theorem smooth_eval {X Y} [Vec X] [Vec Y] (x : X) (f : X ⟿ Y)
    : Subtype.val f x = smoothEval x f := by simp[smoothEval]

  -- @[simp]
  -- theorem hihih {A B C} [Hilbert A] [Hilbert B] [Hilbert C]
  --   (G : X → (X → A) → (X → B)) [∀ f, IsSmooth (G f)]
  --   (F : X → (X → B) → (X → C)) [∀ f, IsSmooth (F f)]
  --   [∀ f, IsSmooth (λ x => F x (G x f) x)]
  --   [∀ f, IsSmooth (λ x => F x f x)]
  --   [∀ f, IsSmooth (λ x => G x f x)]
  --   : (λ f : X ⟿ A => λ x ⟿ F x (G x f) x)
  --     =
  --     (λ f : X ⟿ B => λ x ⟿ F x f x) ∘ (λ f : X ⟿ A => λ x ⟿ G x f x)
  --   := by funext f; ext x; simp[Compose.compose]; done

  example : HasAdjoint (λ f : ℝ ⟿ ℝ => λ x ⟿ x * f x) := by infer_instance
  example : HasAdjoint (λ f : ℝ ⟿ ℝ => λ x ⟿ f x * x) := by infer_instance

  @[simp]
  theorem smooth_mul_norm {X} [Vec X] (f g : X → ℝ) [IsSmooth f] [IsSmooth g]
    : (λ x ⟿ f x * g x) = (λ x ⟿ f x) * (λ x ⟿ g x) := by ext x; simp[HMul.hMul, Mul.mul]

  @[simp]
  theorem smooth_smul_norm_v1 {X} [Vec X] (f : X → Y) [IsSmooth f] (c : ℝ)
    : (λ x ⟿ c * f x) = c * (λ x ⟿ f x) := by ext x; simp[HMul.hMul, Mul.mul]

  theorem smooth_smul_norm_v1_id {X} [Vec X] (c : ℝ)
    : (λ (x : X) ⟿ c * x) = c * (λ (x : X) ⟿ x) := by ext x; simp[HMul.hMul, Mul.mul]

  @[simp]
  theorem pointwise_smul_smooth_map {X Y} [Vec X] [Vec Y] (f : X ⟿ Y) (c : ℝ) (x : X)
    : (c * f) x = c * f x := by simp only [HMul.hMul, Mul.mul]

  -- instance {X Y} [Vec X] [Vec Y] : HMul (X ⟿ ℝ) (X ⟿ Y) (X ⟿ Y) := ⟨λ f g => λ x ⟿ f x * g x⟩

  instance {W X Y Z} [Vec W] [Vec X] [Vec Y] [Vec Z]
    [HMul X Y Z] [IsSmooth λ (x : X) (y : Y) => x * y] [∀ x : X, IsSmooth (λ (y : Y) => x * y)]
    : HMul (W ⟿ X) (W ⟿ Y) (W ⟿ Z) := ⟨λ f g => λ x ⟿ f x * g x⟩

  @[simp]
  theorem pointwise_mul_smooth_map {W X Y Z} [Vec W] [Vec X] [Vec Y] [Vec Z]
    [HMul X Y Z] [IsSmooth λ (x : X) (y : Y) => x * y] [∀ x : X, IsSmooth (λ (y : Y) => x * y)]
    (f : W ⟿ X) (g : W ⟿ Y) (w : W)
    : (f * g) w = f w * g w := by simp[HMul.hMul, Mul.mul]; done

  @[simp]
  theorem pointwise_add_smooth_map {X Y} [Vec X] [Vec Y]
    (f g : X ⟿ Y) (x : X)
    : (f + g) x = f x + g x := by simp[HAdd.hAdd, Add.add]; done

  instance {W X Y Z} [Vec W] [Vec X] [Vec Y] [Vec Z]
    [HMul X Y Z] [IsSmooth λ (x : X) (y : Y) => x * y] [∀ x : X, IsSmooth (λ (y : Y) => x * y)]
    : IsSmooth (λ (f : W ⟿ X) (g : W ⟿ Y) => f * g) := by simp[HMul.hMul, Mul.mul]; infer_instance; done

  instance {W X Y Z} [Vec W] [Vec X] [Vec Y] [Vec Z]
    [HMul X Y Z] [IsSmooth λ (x : X) (y : Y) => x * y] [∀ x : X, IsSmooth (λ (y : Y) => x * y)]
    (f : W ⟿ X)
    : IsSmooth (λ (g : W ⟿ Y) => f * g) := by simp[HMul.hMul, Mul.mul]; infer_instance; done

  -- theorem smooth_smul_norm_v2 (y : Y)
  --   : (λ (x : ℝ) ⟿ x * y) = (λ (x : ℝ) ⟿ x) * (λ (_ : ℝ) ⟿ y) := by ext x; simp[HMul.hMul, Mul.mul]

  theorem smooth_hmul_norm {W X Y Z} [Vec W] [Vec X] [Vec Y] [Vec Z]
    [HMul X Y Z] [IsSmooth λ (x : X) (y : Y) => x * y] [∀ x : X, IsSmooth (λ (y : Y) => x * y)]
    (f : W → X) [IsSmooth f]
    (g : W → Y) [IsSmooth g]
    : (λ (w : W) ⟿ f w * g w) = (λ (w : W) ⟿ f w) * (λ (w : W) ⟿ g w) := by ext x; simp[HMul.hMul, Mul.mul]

  @[simp]
  theorem smooth_comp {X} [Vec X] (f : Y → Z) [IsSmooth f] (g : X → Y) [IsSmooth g]
    : (λ x ⟿ f (g x)) = (λ y ⟿ f y) ∘ (λ x ⟿ g x) := by ext x; simp[Compose.compose]

  -- def Smooth.scomb {X} [Vec X] (f : X ⟿ Y ⟿ Z) (g : X ⟿ Y) : X ⟿ Z := λ x ⟿ f x (g x)

  -- @[simp]
  -- theorem smooth_scomb {X} [Vec X] (f : X → Y → Z) [IsSmooth f] [∀ x, IsSmooth (f x)] (g : X → Y) [IsSmooth g]
  --   : (λ x ⟿ f x (g x)) = Smooth.scomb (λ x y ⟿ f x y) (λ x ⟿ g x) := by ext x; simp[Smooth.scomb]

  def Smooth.comp {X Y Z} [Vec X] [Vec Y] [Vec Z] (f : Y ⟿ Z) (g : X ⟿ Y) := λ x ⟿ f (g x)

  def smooth_mor_comp {X Y Z} [Vec X] [Vec Y] [Vec Z] (f : Y → Z) [IsSmooth f] (g : X → Y) [IsSmooth g]
    : (λ x ⟿ f (g x)) = Smooth.comp (λ y ⟿ f y) (λ x ⟿ g x) := by simp[Smooth.comp]

  def Smooth.diag {X Y₁ Y₂} [Vec X] [Vec Y₁] [Vec Y₂] (f : Y₁ ⟿ Y₂ ⟿ Z) (g₁ : X ⟿ Y₁) (g₂ : X ⟿ Y₂) : X ⟿ Z := λ x ⟿ f (g₁ x) (g₂ x)

  instance {X Y₁ Y₂} [Vec X] [Vec Y₁] [Vec Y₂]
    : IsSmooth λ (f : Y₁ ⟿ Y₂ ⟿ Z) (g₁ : X ⟿ Y₁) (g₂ : X ⟿ Y₂) => Smooth.diag f g₁ g₂ := sorry

  instance {X Y₁ Y₂} [Vec X] [Vec Y₁] [Vec Y₂] (f : Y₁ ⟿ Y₂ ⟿ Z)
    : IsSmooth λ (g₁ : X ⟿ Y₁) (g₂ : X ⟿ Y₂) => Smooth.diag f g₁ g₂ := sorry

  instance {X Y₁ Y₂} [Vec X] [Vec Y₁] [Vec Y₂] (f : Y₁ ⟿ Y₂ ⟿ Z) (g₁ : X ⟿ Y₁)
    : IsSmooth λ (g₂ : X ⟿ Y₂) => Smooth.diag f g₁ g₂ := sorry

  @[simp]
  theorem smooth_diag {X Y₁ Y₂} [Vec X] [Vec Y₁] [Vec Y₂]
    (f : Y₁ → Y₂ → Z)  [IsSmooth f] [∀ y₁, IsSmooth (f y₁)]
    (g₁ : X → Y₁) [IsSmooth g₁]
    (g₂ : X → Y₂) [IsSmooth g₂]
    : (λ x ⟿ f (g₁ x) (g₂ x)) = Smooth.diag (λ y₁ y₂ ⟿ f y₁ y₂) (λ x ⟿ g₁ x) (λ x ⟿ g₂ x) := by simp[Smooth.diag]

  -- this is causing some issues
  -- @[simp mid-1]
  theorem smooth_diag_parm1 {X Y₁ Y₂} [Vec X] [Vec Y₁] [Vec Y₂] (a : α)
    (f : Y₁ → Y₂ → α → Z)  [IsSmooth λ y₁ y₂ => f y₁ y₂ a] [∀ y₁, IsSmooth (λ y₂ => f y₁ y₂ a)]
    (g₁ : X → Y₁) [IsSmooth g₁]
    (g₂ : X → Y₂) [IsSmooth g₂]
    : (λ x ⟿ f (g₁ x) (g₂ x) a) = Smooth.diag (λ y₁ y₂ ⟿ f y₁ y₂ a) (λ x ⟿ g₁ x) (λ x ⟿ g₂ x) := by simp[Smooth.diag]

  -- @[simp mid-1]
  theorem smooth_diag_inner {X Y} [Vec X] [Hilbert Y]
    (g₁ : X → Y) [IsSmooth g₁]
    (g₂ : X → Y) [IsSmooth g₂]
    : (λ x ⟿ ⟪g₁ x, g₂ x⟫) = Smooth.diag (λ y₁ y₂ ⟿ ⟪y₁, y₂⟫) (λ x ⟿ g₁ x) (λ x ⟿ g₂ x) := by simp[Smooth.diag]

  /- point wise inner product -/
  def Smooth.pw_inner {X Y ι} [Enumtype ι] [FinVec X ι] [Hilbert Y] (f g : X ⟿ Y) : X ⟿ ℝ := λ x ⟿ ⟪f x, g x⟫
  argument f
    isLin := sorry,
    isSmooth, diff_simp,
    hasAdjoint := sorry,
    adj_simp := f' * g by sorry,
    hasAdjDiff := by constructor; infer_instance; simp; infer_instance,
    adjDiff_simp
  argument g
    isLin := sorry,
    isSmooth, diff_simp,
    hasAdjoint := sorry,
    adj_simp := g' * f by sorry,
    hasAdjDiff := by constructor; infer_instance; simp; infer_instance,
    adjDiff_simp

  @[simp]
  theorem smooth_diag_pw_inner {Y} [Hilbert Y]
    (g₁ : X → Y) [IsSmooth g₁]
    (g₂ : X → Y) [IsSmooth g₂]
    : (λ x ⟿ ⟪g₁ x, g₂ x⟫) = Smooth.pw_inner (λ x ⟿ g₁ x) (λ x ⟿ g₂ x) := by simp[Smooth.pw_inner]

  @[simp]
  theorem smooth_diag_pw_inner_alt {Y} [Hilbert Y]
    (g₁ : X → Y) [IsSmooth g₁]
    (g₂ : X → Y) [IsSmooth g₂]
    : (λ x => ⟪g₁ x, g₂ x⟫) = (Smooth.pw_inner (λ x ⟿ g₁ x) (λ x ⟿ g₂ x)).1 := by unfold Smooth.pw_inner; simp

  @[simp]
  theorem smooth_diag_eval {X Y₁ Y₂} [Vec X] [Vec Y₁] [Vec Y₂]
    (f : Y₁ ⟿ Y₂ ⟿ Z) (g₁ : X ⟿ Y₁) (g₂ : X ⟿ Y₂) (x : X)
    : (Smooth.diag f g₁ g₂ x) = f (g₁ x) (g₂ x) := by unfold Smooth.diag; simp

  @[simp]
  theorem smooth_diag_hmul  {W X Y Z} [Vec W] [Vec X] [Vec Y] [Vec Z]
    [HMul X Y Z] [IsSmooth λ (x : X) (y : Y) => x * y] [∀ x : X, IsSmooth (λ (y : Y) => x * y)]
    (f : W ⟿ X) (g : W ⟿ Y)
    : Smooth.diag (λ (x : X) (y : Y) ⟿ x * y) f g = f * g := by ext x; simp[Smooth.diag, HMul.hMul, Mul.mul]; done

  @[simp]
  theorem smooth_diag_add  {X Y} [Vec X] [Vec Y] (f g : X ⟿ Y)
    : Smooth.diag (λ (x y : Y) ⟿ x + y) f g = f + g := by ext x; simp[Smooth.diag, HAdd.hAdd, Add.add]; done

  def Smooth.id {X} [Vec X] := λ (x : X) ⟿ x
  @[simp]
  theorem smooth_id_norm {X} [Vec X] : (λ (x : X) ⟿ x) = Smooth.id := by rfl
  @[simp]
  theorem smooth_id_eval {X} [Vec X] (x : X) : Smooth.id x = x := by unfold Smooth.id; simp

  def Smooth.const {X Y} [Vec X] [Vec Y] := λ (x : X) (_ : Y) ⟿ x
  @[simp]
  theorem smooth_const_norm_v1 {X Y} [Vec X] [Vec Y] : (λ (x : X) (_ : Y) ⟿ x) = Smooth.const := by rfl
  @[simp]
  theorem smooth_const_norm_v2 {X Y} [Vec X] [Vec Y] (x : X) : (λ (_ : Y) ⟿ x) = Smooth.const x := by rfl
  @[simp]
  theorem smooth_const_eval {X Y} [Vec X] [Vec Y] (x : X) (y : Y) : Smooth.const x y = x := by rfl

  -- example : (λ (x y : ℝ) ⟿ x * y * x) = 0 :=
  -- by
  --   simp
  --   simp only [smooth_smul_norm_v1_id]
  --   simp only [smooth_hmul_norm]
  --   simp
  --   -- simp only[smooth_smul_norm_v2]
  --   done

  instance {Y₁ Y₂ Z} [Vec Y₁] [SemiHilbert Y₂] [SemiHilbert Z]
    (f : Y₁ ⟿ Y₂ ⟿ Z) [∀ y₁, HasAdjoint (λ y₂ => f y₁ y₂)]
    (g₁ : X ⟿ Y₁)
    : HasAdjoint (fun (g₂ : X ⟿ Y₂) => Smooth.diag f g₁ g₂) := by sorry

  @[simp]
  theorem diag_adj_arg2 {Y₁ Y₂ Z} [Vec Y₁] [SemiHilbert Y₂] [SemiHilbert Z]
    (f : Y₁ ⟿ Y₂ ⟿ Z) [∀ y₁, HasAdjoint (λ y₂ => f y₁ y₂)]
    (g₁ : X ⟿ Y₁)
    : (fun (g₂ : X ⟿ Y₂) => Smooth.diag f g₁ g₂)†
      =
      (fun (g₂' : X ⟿ Z) => Smooth.diag (λ y₁ y₂' ⟿ (f y₁)† y₂') g₁ g₂')
    := sorry

  @[simp]
  theorem diag_adj_arg1 {Y₁ Y₂ Z} [SemiHilbert Y₁] [Vec Y₂] [SemiHilbert Z]
    (f : Y₁ ⟿ Y₂ ⟿ Z) [∀ y₂, HasAdjoint (λ y₁ => f y₁ y₂)]
    (g₂ : X ⟿ Y₂)
    : (fun (g₁ : X ⟿ Y₁) => Smooth.diag f g₁ g₂)†
      =
      (fun (g₁' : X ⟿ Z) => Smooth.diag (λ y₁' y₂ ⟿ (λ y₁ => f y₁ y₂)† y₁') g₁' g₂)
    := sorry

  @[simp]
  theorem diag_adj_arg_uncurry {W Y₁ Y₂ Z} [SemiHilbert W] [SemiHilbert Y₁] [SemiHilbert Y₂] [SemiHilbert Z]
    (f : Y₁ ⟿ Y₂ ⟿ Z) [HasAdjoint (λ (y₁,y₂) => f y₁ y₂)]
    (g₁ : W → (X ⟿ Y₁)) [HasAdjoint g₁]
    (g₂ : W → (X ⟿ Y₂)) [HasAdjoint g₂]
    : (fun (w : W) => Smooth.diag f (g₁ w) (g₂ w))†
      =
      let F := (λ (y₁,y₂) => f y₁ y₂)†
      let G₁ := g₁†
      let G₂ := g₂†
      let G₁₂ := λ (f : X ⟿ Y₁ × Y₂) => (G₁ (λ x ⟿ (f x).1) + G₂ (λ x ⟿ (f x).2))
      (fun (w' : X ⟿ Z) => G₁₂ (λ x ⟿ F (w' x)))
    := sorry

  /- not true, it is missing jacobian !!! -/
  theorem comp_adj_arg1 {Y Z} {κ} [Enumtype κ] [FinVec Y κ] [SemiHilbert Z]
    (g : X ⟿ Y) [IsInv (λ x => g x)] [IsSmooth (λ y => g.1⁻¹ y)]
    : (fun (f : Y ⟿ Z) => Smooth.comp f g)†
      =
      (fun (f' : X ⟿ Z) => Smooth.comp f' (λ y ⟿ g.1⁻¹ y)) /- missing jacobian -/
    := sorry

  @[simp]
  theorem comp_adj_arg2 {Y Z} [SemiHilbert Y] [SemiHilbert Z]
    (f : Y ⟿ Z) [HasAdjoint (λ y => f y)]
    : (fun (g : X ⟿ Y) => Smooth.comp f g)†
      =
      (fun (g' : X ⟿ Z) => Smooth.comp (λ z ⟿ f.1† z) g')
    := sorry

  example (f : ℝ ⟿ ℝ) : (λ x ⟿ x * f x) = Smooth.id * f := by simp

  instance {Y} [SemiHilbert Y] (g : X ⟿ ℝ)
    : HasAdjoint (λ (f : X ⟿ Y) => g * f) := sorry

  @[simp]
  theorem mor_mul_adj_left {Y} [SemiHilbert Y] (g : X ⟿ ℝ)
    : (λ (f : X ⟿ Y) => g * f)† = (λ (f' : X ⟿ Y) => g * f') := sorry

  instance (g : X ⟿ ℝ)
    : HasAdjoint (λ (f : X ⟿ ℝ) => f * g) := sorry

  @[simp]
  theorem mor_mul_adj_right_general {Y} [Hilbert Y] (g : X ⟿ Y)
    : (λ (f : X ⟿ ℝ) => f * g)† = (λ (f' : X ⟿ Y) => Smooth.diag (λ x y ⟿ ⟪x,y⟫) f' g) := sorry

  -- @[simp]
  -- theorem mor_mul_adj_right (g : X ⟿ ℝ)
  --   : (λ (f : X ⟿ ℝ) => f * g)† = (λ (f' : X ⟿ ℝ) => f' * g) := sorry

  example : (λ (f : ℝ ⟿ ℝ) => (λ x ⟿ x * f x))† = λ f' => Smooth.id * f' := by simp
  example (g : ℝ ⟿ ℝ)
    : (λ (f : ℝ ⟿ ℝ) => (λ x ⟿ g x * f x * x))†
      =
      λ f' => λ x ⟿ g x * f' x * x :=
  by
    simp[hold]; funext f'; ext x; simp

  example : (λ (f : ℝ ⟿ ℝ) => (λ x ⟿ f x + f x * x))† = λ (f' : ℝ ⟿ ℝ) (x : ℝ) ⟿ f' x + f' x * x:= by simp[hold]

  -- example (f : ℝ ⟿ ℝ) : (λ x ⟿ x * f x * x) = Smooth.id * f * Smooth.id := by simp
  -- example (c : ℝ) : (λ x ⟿ c * x) = c * Smooth.id := by simp

  example
    : let G := (λ f : ℝ ⟿ ℝ => f * (λ x ⟿ x))
      (λ f : ℝ ⟿ ℝ => G f)
      =
      (λ f : ℝ ⟿ ℝ => λ x ⟿ f x * x) :=
  by
    simp only[]; simp only[smooth_mul_norm]; done

  -- set_option trace.Meta.synthInstance true in
  example {Y} [Hilbert Y]
    : HasAdjoint (λ f : ℝ ⟿ ℝ => λ x ⟿ x * f x * x) :=
  by
    simp; infer_instance

  example
    : SciLean.HasAdjoint fun (f : X ⟿ ℝ) => λ x ⟿ f x := by simp; infer_instance

  example (c : ℝ)
    : SciLean.HasAdjoint fun (f : X ⟿ ℝ) => λ x ⟿ c * f x := by simp; infer_instance

  example (c : ℝ)
    : SciLean.HasAdjoint fun (f : X ⟿ ℝ) => λ x ⟿ f x * c := by simp; infer_instance

  example (g : X ⟿ ℝ)
    : SciLean.HasAdjoint fun (f : X ⟿ ℝ) => λ x ⟿ (g x * f x) := by simp; infer_instance

  example (g : X ⟿ ℝ) (c : ℝ)
    : SciLean.HasAdjoint fun (f : X ⟿ ℝ) => λ x ⟿ c * (g x * f x) := by simp; infer_instance

  example {X} [Hilbert X] (x : X)
    : HasAdjoint (λ (y : X) ⟿ ⟪x, y⟫).1 := by infer_instance

  example {X} [Hilbert X] (y : X)
    : HasAdjoint (λ (x : X) ⟿ ⟪x, y⟫).1 := by infer_instance

  set_option pp.funBinderTypes true in
  -- set_option trace.Meta.Tactic.simp.rewrite true in
  example {Y} [Hilbert Y] (g : X ⟿ Y)
    : SciLean.HasAdjoint fun (f : X ⟿ Y) => λ x ⟿ ⟪g x, f x⟫ :=
  by
    simp; infer_instance

  example (g : X ⟿ ℝ)
    : SciLean.HasAdjoint fun (f : X ⟿ ℝ) => λ x ⟿ ⟪f x, g x⟫ := by infer_instance

  example : IsSmooth fun x y : ℝ => y * (2 * x) := by infer_instance

  example (g : X ⟿ ℝ)
    : SciLean.HasAdjoint fun (f : X ⟿ ℝ) => λ x ⟿ (g x * ((2 : ℝ) * f x)) := by simp; infer_instance

  example (g : X ⟿ ℝ)
    : SciLean.HasAdjoint fun (f : X ⟿ ℝ) => λ x ⟿ f x * g x := by infer_instance

  -- set_option trace.Meta.Tactic.simp.discharge true in
  -- set_option trace.Meta.Tactic.simp.rewrite true in
  example (g : X ⟿ ℝ)
    : varDual (λ f : X ⟿ ℝ => ∫ λ x ⟿ g x * f x) = g :=
  by
    simp; ext x; simp; done

  example {Y} [Hilbert Y] (g : X ⟿ Y) :
      SciLean.HasAdjoint fun f : X ⟿ Y => fun x' ⟿ ⟪f x', g x'⟫ :=
  by
    simp; infer_instance

  example {X Y ι} [Enumtype ι] [FinVec X ι] [Hilbert Y] (g : X ⟿ Y)
    : varDual (λ f : X ⟿ Y => ∫ λ x ⟿ ⟪f x, g x⟫) = g :=
  by
    simp; ext x; simp; done

  example {X Y ι} [Enumtype ι] [FinVec X ι] [Hilbert Y] (g : X ⟿ Y) (c : ℝ)
    : varDual (λ f : X ⟿ Y => ∫ λ x ⟿ c * ⟪f x, g x⟫) = c * g :=
  by
    simp; ext x; simp; done

  class Divergence (Fun : Type) (Diff : outParam Type) where
    divergence : Fun → Diff

  export Divergence (divergence)

  @[defaultInstance]
  noncomputable
  instance divergence_of_differential_mor {X Y ι} [Enumtype ι] [FinVec X ι] [SemiHilbert Y]
    : Divergence (X ⟿ X ⊸ Y) (X ⟿ Y) where
    divergence f := λ x ⟿ ∑ i, ∂ f x (𝔼 i) (𝔼 i)

  noncomputable
  instance divergence_of_differential {X Y ι} [Enumtype ι] [FinVec X ι] [SemiHilbert Y]
    : Divergence (X → X → Y) (X → Y) where
    divergence f := λ x => ∑ i, ∂ f x (𝔼 i) (𝔼 i)

  noncomputable
  instance divergence_of_endomorphism_mor {X ι} [Enumtype ι] [FinVec X ι]
    : Divergence (X ⟿ X) (X ⟿ ℝ) where
    divergence f := λ x ⟿ ∑ i, ⟪∂ f x (𝔼 i), 𝔼 i⟫

  noncomputable
  instance divergence_of_endomorphism {X ι} [Enumtype ι] [FinVec X ι]
    : Divergence (X → X) (X → ℝ) where
    divergence f := λ x => ∑ i, ⟪∂ f x (𝔼 i), 𝔼 i⟫

  prefix:max "∇·" => divergence

  syntax "∇·" diffBinder "," term:66 : term
  syntax "∇·" "(" diffBinder ")" "," term:66 : term
  macro_rules
  | `(∇· $x:ident, $f) =>
    `(∇· λ $x => $f)
  | `(∇· $x:ident : $type:term, $f) =>
    `(∇· λ $x : $type => $f)
  | `(∇· $x:ident := $val:term, $f) =>
    `((∇· λ $x => $f) $val)
  | `(∇· ($b:diffBinder), $f) =>
    `(∇· $b, $f)

  instance {Y} [SemiHilbert Y]
    : HasAdjoint (λ f : X ⟿ Y => ∂ f) := sorry

  @[simp]
  theorem diff_adjoint {Y} [SemiHilbert Y]
    : (λ f : X ⟿ Y => ∂ f)† = λ f' : X ⟿ X ⊸ Y => - ∇· f' := sorry

  @[simp]
  theorem divergence_adjoint {Y} [SemiHilbert Y]
    : (λ f : X ⟿ X ⊸ Y => ∇· f)† = λ f' : X ⟿ Y => - ∂ f' := sorry

  theorem linear_has_adjoint_on_finvec {X Y ι κ} [Enumtype ι] [Enumtype κ] [FinVec X ι] [FinVec Y κ] (f : X → Y) [IsLin f] : HasAdjoint f := sorry
  theorem smooth_has_adjdiff_on_finvec {X Y ι κ} [Enumtype ι] [Enumtype κ] [FinVec X ι] [FinVec Y κ] (f : X → Y) [IsSmooth f] : HasAdjDiff f :=
    ⟨by infer_instance, by intro x; apply linear_has_adjoint_on_finvec⟩

  -- On finite dimensional vector spaces, every linear map has adjoint
  -- Therefore we can prove these theorems
  instance {X Y ι κ} [Enumtype ι] [Enumtype κ] [FinVec X ι] [FinVec Y κ] (f : X → Y) [IsSmooth f] : IsSmooth λ x dy => ∂† f x dy := sorry
  instance {X Y ι κ} [Enumtype ι] [Enumtype κ] [FinVec X ι] [FinVec Y κ] (f : X → Y) [IsSmooth f] (x : X) : IsSmooth λ dy => ∂† f x dy := sorry
  instance {X Y ι κ} [Enumtype ι] [Enumtype κ] [FinVec X ι] [FinVec Y κ] (f : X → Y) [IsSmooth f] (x : X) : IsLin λ dy => ∂† f x dy := sorry

  instance {X Y} [SemiHilbert X] [SemiHilbert Y] (f : X → Y) [HasAdjDiff f] : IsSmooth λ x dy => ∂† f x dy := sorry
  instance {X Y} [SemiHilbert X] [SemiHilbert Y] (f : X → Y) [HasAdjDiff f] (x : X) : IsSmooth λ dy => ∂† f x dy := sorry
  instance {X Y} [SemiHilbert X] [SemiHilbert Y] (f : X → Y) [HasAdjDiff f] (x : X) : IsLin λ dy => ∂† f x dy := sorry

  -- This can be meaningfully defined only on finitely dimensional vector spaces for now
  -- Otherwise I would need special notation for `{f : X → Y // HasAdjDiff f}` that that is just getting too complicated
  noncomputable
  instance adjoint_differential_mor {X Y ι κ} [Enumtype ι] [Enumtype κ] [FinVec X ι] [FinVec Y κ]
    : AdjointDifferential (X ⟿ Y) (X ⟿ Y ⊸ X) where
    adjointDifferential f := λ x ⟿ λ dy ⊸ ∂† f.1 x dy

  -- fails to prove linearity on rhs
  -- @[simp]
  -- theorem adjDiff_adjoint {Y κ} [Enumtype κ] [FinVec Y κ]
  --   : (λ f : X ⟿ Y => ∂† f)† = λ f' : X ⟿ Y ⊸ X => - ∇· (λ x ⟿ λ dx ⊸ ((f' x).1)† dx) := sorry

  example {Y} [Hilbert Y] (g : X ⟿ Y) (c : X)
    : IsSmooth (λ (x : X) => ∂ g c) := by infer_instance

  -- Why does this fail????
  -- #check (λ {Y} [Hilbert Y] (g : X ⟿ Y) (f : X ⟿ Y) => λ x ⟿ ⟪∂ f x, ∂ g x⟫)

  set_option pp.funBinderTypes true in
  set_option synthInstance.maxSize 2048 in
  -- set_option synthInstance.maxHeartbeats 200000 in
  example {Y} [Hilbert Y] (g : X ⟿ Y)
    : HasAdjoint (λ (f : X ⟿ Y) => λ x ⟿ ⟪∂ f x, ∂ g x⟫) := by simp; infer_instance; done

  set_option synthInstance.maxSize 2048 in
  example {Y} [Hilbert Y] (g : X ⟿ Y)
    : (λ (f : X ⟿ Y) => λ x ⟿ ⟪∂ f x, ∂ g x⟫)† = λ g' => - divergence (g' * ∂ g) := by simp; unfold hold; simp done

  -- noncomputable
  -- def dd {X} [Vec X] (f : ℝ ⟿ X) : ℝ ⟿ X := λ t ⟿ ∂ f t 1

  noncomputable
  instance {X} [Vec X] : Derivative (ℝ ⟿ X) (ℝ ⟿ X) where
    derivative f := λ t ⟿ ∂ f t 1

  instance {X} [SemiHilbert X] : HasAdjoint (λ f : ℝ ⟿ X => ⅆ f) := sorry
  @[simp]
  theorem dd_adjoint {X} [SemiHilbert X] : (λ f : ℝ ⟿ X => ⅆ f)† = λ f' => - ⅆ f' := sorry

  instance {X Y} [SemiHilbert X] [SemiHilbert Y] (f : X → Y) [HasAdjDiff f] (x) : HasAdjoint (∂ f x) := sorry
  @[simp]
  theorem adj_of_differential {X Y} [SemiHilbert X] [SemiHilbert Y] (f : X → Y) [HasAdjDiff f] (x) : (∂ f x)† = ∂† f x := sorry

  example {X} [Hilbert X] (y : ℝ ⟿ X) (L : X → ℝ) [HasAdjDiff L] [IsSmooth L] : IsSmooth λ t => ∂† L (ⅆ y t) := by infer_instance

  macro (priority := high) "ⅆ" x:Lean.explicitBinders ";" f:term:66 : term => `(ⅆ (λ $x ⟿ $f))

  -- set_option synthInstance.maxSize 2048 in
  example {X} [Hilbert X] (y : ℝ ⟿ X) (L : X → ℝ) [HasAdjDiff L] [IsSmooth L]
    : (λ (dy : ℝ ⟿ X) => λ t ⟿ ∂ L (ⅆ y t) (ⅆ dy t))† 1
      =
      - ⅆ t; ∇ L (ⅆ y t)
  :=
  by
    simp[One.one, OfNat.ofNat, gradient]
    done

  example (L : X → ℝ) [HasAdjDiff L] [IsSmooth L]
    : (∇ (y : ℝ ⟿ X), λ t ⟿ L (ⅆ y t))
      =
      λ y => - ⅆ t; ∇ L (ⅆ y t)
      -- λ y => λ t ⟿ - ∂ (∇ L) (ⅆ y t) (ⅆ (ⅆ y) t) -- can't prove smoothness right now
  :=
  by
    conv =>
      lhs
      simp[One.one, OfNat.ofNat, gradient]
      simp only [adjointDifferential]
      simp
    done

  example {X} [Hilbert X] (y : ℝ ⟿ X) (L : X → ℝ) [HasAdjDiff L] [IsSmooth L]
    : (λ (dy : ℝ ⟿ X) => λ t ⟿ ∂ L (y t) (dy t))† 1
      =
      λ t ⟿ ∇ L (y t)
  :=
  by
    simp[One.one, OfNat.ofNat, gradient]
    done

  example {X} [Hilbert X] (y : ℝ ⟿ X) (L : X → ℝ) [HasAdjDiff L] [IsSmooth L]
    : (∇ (y' : ℝ ⟿ X), λ t ⟿ L (y' t)) y
      =
      λ t ⟿ ∇ L (y t)
  :=
  by
    simp[One.one, OfNat.ofNat, gradient]
    done

  variable {X : Type} [SemiHilbert X] (L : X → X → ℝ) [IsSmooth L] [∀ x, IsSmooth (L x)] [∀ x, HasAdjDiff λ v => L x v] [∀ v, HasAdjDiff λ x => L x v] (y  : ℝ ⟿ X)

  -- Euler Lagrange equations
  #check λ t => ⅆ (s := t), ∇ (v := ⅆ y s), L (y s) v + ∇ (x := y t), L x (ⅆ y t)
  #check λ s ⟿ (∇ v, L (y s) v) (ⅆ y s)

  #check λ s ⟿ (∇ v, L (y s) v)
  #check λ s ⟿ (∇ (v := ⅆ y s), L (y s) v)

  #check HAdd

  variable (f f' : ℝ → ℝ → ℝ) (s t dt : ℝ) (c : ℝ) (g h : ℝ → ℝ) (ϕ) [IsSmooth g] [IsSmooth h]

  --- ∂ x, f x  vs  ∂ λ x => f x
  --- ∑ i, f i  vs  ∑ λ i => f i
  --- ∫ x, f x  vs  ∫ λ x => f x

  #check ((ⅆ x, g (h x)) rewrite_by (simp))

  #check ∂ t', f t' s
  #check ⅆ t', g t'
  #check ⅆ g
  #check (∂† t', f t' s) t dt
  #check (∇ t', g t')
  #check ∇ g

  -- symbolic differentiation:
  -- ∂  : (X→Y) → (X→X→Y)      -- differential
  -- ∂† : (X→Y) → (X→Y→X)      -- adjoint differential

  -- ⅆ  : (ℝ→X) → (ℝ→X)        -- derivative  (sugar for (∂  · · 1))
  -- ∇  : (X→ℝ) → (X→X)        -- gradient    (sugar for (∂† · · 1))

  -- automatic differentiation
  -- 𝓣 : (X→Y) → (X→X×(X→Y))  -- forward mode AD
  -- 𝓑 : (X→Y) → (X→X×(Y→X))  -- reverse mode AD

  -- ?? : (X→Y) → (X×X→Y×Y)     -- dual number AD

  -- #check (differential · · (1 : ℝ))
  -- #check (∂† · · (1 : ℝ))

  #exit

  -- λ t => - (ⅆ t', (∇ ẋ, L ẋ (y t')) (ⅆ y t)) + (∇ x, L (ⅆ y t) x) (y t)

  example (f df : X ⟿ Y) : IsLin (λ x => ∂ (fun (f : X ⟿ Y) => ∂ f) f df x) :=
  by
    simp[Differential.differential]; infer_instance

  -- This should fail fast !!!
  -- set_option trace.Meta.synthInstance true in
  -- set_option trace.Meta.synthInstance.resume false in
  -- set_option trace.Meta.synthInstance.tryResolve false in
  example (f df : X ⟿ Y) : IsLin λ x => (∂ (fun (f' : X ⟿ Y) => ∂ f') f df) x :=
  by
    admit -- infer_instance

  #exit

  set_option synthInstance.maxSize 2048 in
  example : ∀ (x : X), IsSmooth fun (f : X ⟿ Y) => (2 : ℝ) * f x := by infer_instance

  @[simp]
  theorem integral_diff (F : Z → X → Y) [IsSmooth F] [∀ f, IsSmooth (F f)]
    : (∂ λ (z : Z) => ∫ x, F z x) = λ z dz => ∫ x, ∂ F z dz x := sorry

  #check λ f : X⟿Y => ∫ f
  #check λ f : X⟿Y => ∫ λ x => f x

  example : IsLin λ (f : X⟿Y) => ∫ f := by infer_instance
  example : IsLin λ (f : X⟿Y) => ∫ x, f x := by infer_instance
  example : IsLin λ (f : X⟿Y) => ∫ x, (2 : ℝ) * f x := by infer_instance
  example : IsSmooth λ (f : X⟿Y) => ∫ x, f x := by infer_instance
  -- set_option trace.Meta.synthInstance true in
  set_option synthInstance.maxSize 2048 in
  example : IsSmooth λ (f : X⟿Y) => ∫ x, (2 : ℝ) * f x := by infer_instance
  example : (∂ λ (f : X⟿Y) => ∫ x, f x) = (λ _ df : X⟿Y => ∫ x, df x) := by simp

  example (u : X) : IsSmooth λ (f : X⟿Y) (x : X) => ∂ f.1 x u := by infer_instance
  example (u : X) : IsSmooth (λ (f : X⟿Y) => ∫ x, ∂ f.1 x u) := by infer_instance
  set_option synthInstance.maxSize 2048 in
  example (u : X) : (∂ λ (f : X⟿Y) => ∫ x, ∂ f.1 x u) = λ _ df : X⟿Y => ∫ x, ∂ df.1 x u := by simp

  example [Hilbert Y] : IsSmooth λ (f : X⟿Y) (x : X) => ∂† f.1 x := sorry
  -- example (u : X) : IsSmooth λ (f : X⟿ℝ) (x : X) => ∂⁻¹ f.1 x := by infer_instance

  #check λ (f : X⟿ℝ) => ∇ f.1
  example : (∂ λ (f : X⟿ℝ) => ∫ x, ∥∂† f.1 x 1∥²) = λ (f df : X⟿ℝ) => ∫ x, (2:ℝ)*⟪∇ df.1 x, ∇ f.1 x⟫ := sorry
  example : (∂ λ (f : X⟿ℝ) => ∫ x, ∥∇ f.1 x∥²) = λ (f df : X⟿ℝ) => ∫ x, (2:ℝ)*⟪∇ df.1 x, ∇ f.1 x⟫ := sorry
  -- example : (δ λ (f : X⟿ℝ) => ∫ x, ∥∇ f.1 x∥²) = λ (f : X⟿ℝ) => 2 * f := by simp

  -- example (L : X → X → ℝ) [IsSmooth L] [∀ x, IsSmooth (L x)]
  --   : ∂ (λ (x : ℝ ⟿ X) => ∫ t, L (x t) (∂ x.1 t 1))
  --     =
  --     λ x dx => ∫ t, ∂ L (x t) (dx t) (∂ x.1 t 1) +
  --                    ∂ (L (x t)) (∂ x.1 t 1) (∂ dx.1 t 1) := sorry


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.game.short
import Mathlib.PostPort

universes u l

namespace Mathlib

/-!
# Games described via "the state of the board".

We provide a simple mechanism for constructing combinatorial (pre-)games, by describing
"the state of the board", and providing an upper bound on the number of turns remaining.

## Implementation notes

We're very careful to produce a computable definition, so small games can be evaluated
using `dec_trivial`. To achieve this, I've had to rely solely on induction on natural numbers:
relying on general well-foundedness seems to be poisonous to computation?

See `set_theory/game/domineering` for an example using this construction.
-/

namespace pgame

/--
`pgame_state S` describes how to interpret `s : S` as a state of a combinatorial game.
Use `pgame.of s` or `game.of s` to construct the game.

`pgame_state.L : S → finset S` and `pgame_state.R : S → finset S` describe the states reachable
by a move by Left or Right. `pgame_state.turn_bound : S → ℕ` gives an upper bound on the number of
possible turns remaining from this state.
-/
class state (S : Type u) where
  turn_bound : S → ℕ
  L : S → finset S
  R : S → finset S
  left_bound : ∀ {s t : S}, t ∈ L s → turn_bound t < turn_bound s
  right_bound : ∀ {s t : S}, t ∈ R s → turn_bound t < turn_bound s

theorem turn_bound_ne_zero_of_left_move {S : Type u} [state S] {s : S} {t : S} (m : t ∈ state.L s) :
    state.turn_bound s ≠ 0 :=
  sorry

theorem turn_bound_ne_zero_of_right_move {S : Type u} [state S] {s : S} {t : S}
    (m : t ∈ state.R s) : state.turn_bound s ≠ 0 :=
  sorry

theorem turn_bound_of_left {S : Type u} [state S] {s : S} {t : S} (m : t ∈ state.L s) (n : ℕ)
    (h : state.turn_bound s ≤ n + 1) : state.turn_bound t ≤ n :=
  nat.le_of_lt_succ (nat.lt_of_lt_of_le (state.left_bound m) h)

theorem turn_bound_of_right {S : Type u} [state S] {s : S} {t : S} (m : t ∈ state.R s) (n : ℕ)
    (h : state.turn_bound s ≤ n + 1) : state.turn_bound t ≤ n :=
  nat.le_of_lt_succ (nat.lt_of_lt_of_le (state.right_bound m) h)

/--
Construct a `pgame` from a state and a (not necessarily optimal) bound on the number of
turns remaining.
-/
def of_aux {S : Type u} [state S] (n : ℕ) (s : S) (h : state.turn_bound s ≤ n) : pgame := sorry

/-- Two different (valid) turn bounds give equivalent games. -/
def of_aux_relabelling {S : Type u} [state S] (s : S) (n : ℕ) (m : ℕ) (hn : state.turn_bound s ≤ n)
    (hm : state.turn_bound s ≤ m) : relabelling (of_aux n s hn) (of_aux m s hm) :=
  sorry

/-- Construct a combinatorial `pgame` from a state. -/
def of {S : Type u} [state S] (s : S) : pgame := of_aux (state.turn_bound s) s sorry

/--
The equivalence between `left_moves` for a `pgame` constructed using `of_aux _ s _`, and `L s`.
-/
def left_moves_of_aux {S : Type u} [state S] (n : ℕ) {s : S} (h : state.turn_bound s ≤ n) :
    left_moves (of_aux n s h) ≃ Subtype fun (t : S) => t ∈ state.L s :=
  Nat.rec (fun (h : state.turn_bound s ≤ 0) => equiv.refl (left_moves (of_aux 0 s h)))
    (fun (n_n : ℕ)
      (n_ih :
      (h : state.turn_bound s ≤ n_n) →
        left_moves (of_aux n_n s h) ≃ Subtype fun (t : S) => t ∈ state.L s)
      (h : state.turn_bound s ≤ Nat.succ n_n) =>
      equiv.refl (left_moves (of_aux (Nat.succ n_n) s h)))
    n h

/--
The equivalence between `left_moves` for a `pgame` constructed using `of s`, and `L s`.
-/
def left_moves_of {S : Type u} [state S] (s : S) :
    left_moves (of s) ≃ Subtype fun (t : S) => t ∈ state.L s :=
  left_moves_of_aux (state.turn_bound s) (of._proof_1 s)

/--
The equivalence between `right_moves` for a `pgame` constructed using `of_aux _ s _`, and `R s`.
-/
def right_moves_of_aux {S : Type u} [state S] (n : ℕ) {s : S} (h : state.turn_bound s ≤ n) :
    right_moves (of_aux n s h) ≃ Subtype fun (t : S) => t ∈ state.R s :=
  Nat.rec (fun (h : state.turn_bound s ≤ 0) => equiv.refl (right_moves (of_aux 0 s h)))
    (fun (n_n : ℕ)
      (n_ih :
      (h : state.turn_bound s ≤ n_n) →
        right_moves (of_aux n_n s h) ≃ Subtype fun (t : S) => t ∈ state.R s)
      (h : state.turn_bound s ≤ Nat.succ n_n) =>
      equiv.refl (right_moves (of_aux (Nat.succ n_n) s h)))
    n h

/-- The equivalence between `right_moves` for a `pgame` constructed using `of s`, and `R s`. -/
def right_moves_of {S : Type u} [state S] (s : S) :
    right_moves (of s) ≃ Subtype fun (t : S) => t ∈ state.R s :=
  right_moves_of_aux (state.turn_bound s) (of._proof_1 s)

/--
The relabelling showing `move_left` applied to a game constructed using `of_aux`
has itself been constructed using `of_aux`.
-/
def relabelling_move_left_aux {S : Type u} [state S] (n : ℕ) {s : S} (h : state.turn_bound s ≤ n)
    (t : left_moves (of_aux n s h)) :
    relabelling (move_left (of_aux n s h) t)
        (of_aux (n - 1) (↑(coe_fn (left_moves_of_aux n h) t))
          (relabelling_move_left_aux._proof_1 n h t)) :=
  Nat.rec (fun (h : state.turn_bound s ≤ 0) (t : left_moves (of_aux 0 s h)) => False._oldrec sorry)
    (fun (n_n : ℕ)
      (n_ih :
      (h : state.turn_bound s ≤ n_n) →
        (t : left_moves (of_aux n_n s h)) →
          relabelling (move_left (of_aux n_n s h) t)
            (of_aux (n_n - 1) ↑(coe_fn (left_moves_of_aux n_n h) t) sorry))
      (h : state.turn_bound s ≤ Nat.succ n_n) (t : left_moves (of_aux (Nat.succ n_n) s h)) =>
      relabelling.refl (move_left (of_aux (Nat.succ n_n) s h) t))
    n h t

/--
The relabelling showing `move_left` applied to a game constructed using `of`
has itself been constructed using `of`.
-/
def relabelling_move_left {S : Type u} [state S] (s : S) (t : left_moves (of s)) :
    relabelling (move_left (of s) t) (of ↑(equiv.to_fun (left_moves_of s) t)) :=
  relabelling.trans (relabelling_move_left_aux (state.turn_bound s) (of._proof_1 s) t)
    (of_aux_relabelling (↑(coe_fn (left_moves_of_aux (state.turn_bound s) (of._proof_1 s)) t))
      (state.turn_bound s - 1) (state.turn_bound ↑(equiv.to_fun (left_moves_of s) t)) sorry sorry)

/--
The relabelling showing `move_right` applied to a game constructed using `of_aux`
has itself been constructed using `of_aux`.
-/
def relabelling_move_right_aux {S : Type u} [state S] (n : ℕ) {s : S} (h : state.turn_bound s ≤ n)
    (t : right_moves (of_aux n s h)) :
    relabelling (move_right (of_aux n s h) t)
        (of_aux (n - 1) (↑(coe_fn (right_moves_of_aux n h) t))
          (relabelling_move_right_aux._proof_1 n h t)) :=
  Nat.rec (fun (h : state.turn_bound s ≤ 0) (t : right_moves (of_aux 0 s h)) => False._oldrec sorry)
    (fun (n_n : ℕ)
      (n_ih :
      (h : state.turn_bound s ≤ n_n) →
        (t : right_moves (of_aux n_n s h)) →
          relabelling (move_right (of_aux n_n s h) t)
            (of_aux (n_n - 1) ↑(coe_fn (right_moves_of_aux n_n h) t) sorry))
      (h : state.turn_bound s ≤ Nat.succ n_n) (t : right_moves (of_aux (Nat.succ n_n) s h)) =>
      relabelling.refl (move_right (of_aux (Nat.succ n_n) s h) t))
    n h t

/--
The relabelling showing `move_right` applied to a game constructed using `of`
has itself been constructed using `of`.
-/
def relabelling_move_right {S : Type u} [state S] (s : S) (t : right_moves (of s)) :
    relabelling (move_right (of s) t) (of ↑(equiv.to_fun (right_moves_of s) t)) :=
  relabelling.trans (relabelling_move_right_aux (state.turn_bound s) (of._proof_1 s) t)
    (of_aux_relabelling (↑(coe_fn (right_moves_of_aux (state.turn_bound s) (of._proof_1 s)) t))
      (state.turn_bound s - 1) (state.turn_bound ↑(equiv.to_fun (right_moves_of s) t)) sorry sorry)

protected instance fintype_left_moves_of_aux {S : Type u} [state S] (n : ℕ) (s : S)
    (h : state.turn_bound s ≤ n) : fintype (left_moves (of_aux n s h)) :=
  fintype.of_equiv (Subtype fun (t : S) => t ∈ state.L s) (equiv.symm (left_moves_of_aux n h))

protected instance fintype_right_moves_of_aux {S : Type u} [state S] (n : ℕ) (s : S)
    (h : state.turn_bound s ≤ n) : fintype (right_moves (of_aux n s h)) :=
  fintype.of_equiv (Subtype fun (t : S) => t ∈ state.R s) (equiv.symm (right_moves_of_aux n h))

protected instance short_of_aux {S : Type u} [state S] (n : ℕ) {s : S}
    (h : state.turn_bound s ≤ n) : short (of_aux n s h) :=
  sorry

protected instance short_of {S : Type u} [state S] (s : S) : short (of s) :=
  id (pgame.short_of_aux (state.turn_bound s) (of._proof_1 s))

end pgame

namespace game

/-- Construct a combinatorial `game` from a state. -/
def of {S : Type u} [pgame.state S] (s : S) : game := quotient.mk (pgame.of s)

end Mathlib


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import algebra.char_p.invertible
import order.filter.at_top_bot
import tactic.linarith
import tactic.field_simp
import tactic.linear_combination

/-!
# Quadratic discriminants and roots of a quadratic

This file defines the discriminant of a quadratic and gives the solution to a quadratic equation.

## Main definition

- `discrim a b c`: the discriminant of a quadratic `a * x * x + b * x + c` is `b * b - 4 * a * c`.

## Main statements

- `quadratic_eq_zero_iff`: roots of a quadratic can be written as
  `(-b + s) / (2 * a)` or `(-b - s) / (2 * a)`, where `s` is a square root of the discriminant.
- `quadratic_ne_zero_of_discrim_ne_sq`: if the discriminant has no square root,
  then the corresponding quadratic has no root.
- `discrim_le_zero`: if a quadratic is always non-negative, then its discriminant is non-positive.

## Tags

polynomial, quadratic, discriminant, root
-/

open filter

section ring
variables {R : Type*}

/-- Discriminant of a quadratic -/
def discrim [ring R] (a b c : R) : R := b^2 - 4 * a * c

variables [comm_ring R] [is_domain R] {a b c : R}

/--
A quadratic has roots if and only if its discriminant equals some square.
-/
lemma quadratic_eq_zero_iff_discrim_eq_sq (h2 : (2 : R) ≠ 0) (ha : a ≠ 0) (x : R) :
  a * x * x + b * x + c = 0 ↔ discrim a b c = (2 * a * x + b) ^ 2 :=
begin
  dsimp [discrim] at *,
  split,
  { assume h,
    linear_combination (h, -4 * a) },
  { assume h,
    have ha : 2 * 2 * a ≠ 0 := mul_ne_zero (mul_ne_zero h2 h2) ha,
    apply mul_left_cancel₀ ha,
    linear_combination (h, -1) }
end

/-- A quadratic has no root if its discriminant has no square root. -/
lemma quadratic_ne_zero_of_discrim_ne_sq (h2 : (2 : R) ≠ 0) (ha : a ≠ 0)
  (h : ∀ s : R, discrim a b c ≠ s * s) (x : R) :
  a * x * x + b * x + c ≠ 0 :=
begin
  assume h',
  rw [quadratic_eq_zero_iff_discrim_eq_sq h2 ha, sq] at h',
  exact h _ h'
end

end ring

section field
variables {K : Type*} [field K] [invertible (2 : K)] {a b c x : K}

/-- Roots of a quadratic -/
lemma quadratic_eq_zero_iff (ha : a ≠ 0) {s : K} (h : discrim a b c = s * s) (x : K) :
  a * x * x + b * x + c = 0 ↔ x = (-b + s) / (2 * a) ∨ x = (-b - s) / (2 * a) :=
begin
  have h2 : (2 : K) ≠ 0 := nonzero_of_invertible 2,
  rw [quadratic_eq_zero_iff_discrim_eq_sq h2 ha, h, sq, mul_self_eq_mul_self_iff],
  have ne : 2 * a ≠ 0 := mul_ne_zero h2 ha,
  field_simp,
  apply or_congr,
  { split; intro h'; linear_combination (h', -1) },
  { split; intro h'; linear_combination h' },
end

/-- A quadratic has roots if its discriminant has square roots -/
lemma exists_quadratic_eq_zero (ha : a ≠ 0) (h : ∃ s, discrim a b c = s * s) :
  ∃ x, a * x * x + b * x + c = 0 :=
begin
  rcases h with ⟨s, hs⟩,
  use (-b + s) / (2 * a),
  rw quadratic_eq_zero_iff ha hs,
  simp
end

/-- Root of a quadratic when its discriminant equals zero -/
lemma quadratic_eq_zero_iff_of_discrim_eq_zero (ha : a ≠ 0) (h : discrim a b c = 0) (x : K) :
  a * x * x + b * x + c = 0 ↔ x = -b / (2 * a) :=
begin
  have : discrim a b c = 0 * 0, by rw [h, mul_zero],
  rw [quadratic_eq_zero_iff ha this, add_zero, sub_zero, or_self]
end

end field

section linear_ordered_field
variables {K : Type*} [linear_ordered_field K] {a b c : K}

/-- If a polynomial of degree 2 is always nonnegative, then its discriminant is nonpositive -/
lemma discrim_le_zero (h : ∀ x : K, 0 ≤ a * x * x + b * x + c) : discrim a b c ≤ 0 :=
begin
  rw [discrim, sq],
  obtain ha|rfl|ha : a < 0 ∨ a = 0 ∨ 0 < a := lt_trichotomy a 0,
  -- if a < 0
  { have : tendsto (λ x, (a * x + b) * x + c) at_top at_bot :=
     tendsto_at_bot_add_const_right _ c ((tendsto_at_bot_add_const_right _ b
       (tendsto_id.neg_const_mul_at_top ha)).at_bot_mul_at_top tendsto_id),
    rcases (this.eventually (eventually_lt_at_bot 0)).exists with ⟨x, hx⟩,
    exact false.elim ((h x).not_lt $ by rwa ← add_mul) },
  -- if a = 0
  { rcases em (b = 0) with (rfl|hb),
    { simp },
    { have := h ((-c - 1) / b), rw [mul_div_cancel' _ hb] at this, linarith } },
  -- if a > 0
  { have := calc
      4 * a * (a * (-(b / a) * (1 / 2)) * (-(b / a) * (1 / 2)) + b * (-(b / a) * (1 / 2)) + c)
          = (a * (b / a)) * (a * (b / a)) - 2 * (a * (b / a)) * b + 4 * a * c : by ring
      ... = -(b * b - 4 * a * c) : by { simp only [mul_div_cancel' b (ne_of_gt ha)], ring },
    have ha' : 0 ≤ 4 * a, by linarith,
    have h := (mul_nonneg ha' (h (-(b / a) * (1 / 2)))),
    rw this at h, rwa ← neg_nonneg }
end

/--
If a polynomial of degree 2 is always positive, then its discriminant is negative,
at least when the coefficient of the quadratic term is nonzero.
-/
lemma discrim_lt_zero (ha : a ≠ 0) (h : ∀ x : K, 0 < a * x * x + b * x + c) : discrim a b c < 0 :=
begin
  have : ∀ x : K, 0 ≤ a*x*x + b*x + c := assume x, le_of_lt (h x),
  refine lt_of_le_of_ne (discrim_le_zero this) _,
  assume h',
  have := h (-b / (2 * a)),
  have : a * (-b / (2 * a)) * (-b / (2 * a)) + b * (-b / (2 * a)) + c = 0,
  { rw [quadratic_eq_zero_iff_of_discrim_eq_zero ha h' (-b / (2 * a))] },
  linarith
end

end linear_ordered_field


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Heather Macbeth
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.intervals.basic
import Mathlib.data.set.function
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Monotone surjective functions are surjective on intervals

A monotone surjective function sends any interval in the domain onto the interval with corresponding
endpoints in the range.  This is expressed in this file using `set.surj_on`, and provided for all
permutations of interval endpoints.
-/

theorem surj_on_Ioo_of_monotone_surjective {α : Type u_1} {β : Type u_2} [linear_order α]
    [partial_order β] {f : α → β} (h_mono : monotone f) (h_surj : function.surjective f) (a : α)
    (b : α) : set.surj_on f (set.Ioo a b) (set.Ioo (f a) (f b)) :=
  sorry

theorem surj_on_Ico_of_monotone_surjective {α : Type u_1} {β : Type u_2} [linear_order α]
    [partial_order β] {f : α → β} (h_mono : monotone f) (h_surj : function.surjective f) (a : α)
    (b : α) : set.surj_on f (set.Ico a b) (set.Ico (f a) (f b)) :=
  sorry

theorem surj_on_Ioc_of_monotone_surjective {α : Type u_1} {β : Type u_2} [linear_order α]
    [partial_order β] {f : α → β} (h_mono : monotone f) (h_surj : function.surjective f) (a : α)
    (b : α) : set.surj_on f (set.Ioc a b) (set.Ioc (f a) (f b)) :=
  sorry

-- to see that the hypothesis `a ≤ b` is necessary, consider a constant function

theorem surj_on_Icc_of_monotone_surjective {α : Type u_1} {β : Type u_2} [linear_order α]
    [partial_order β] {f : α → β} (h_mono : monotone f) (h_surj : function.surjective f) {a : α}
    {b : α} (hab : a ≤ b) : set.surj_on f (set.Icc a b) (set.Icc (f a) (f b)) :=
  sorry

theorem surj_on_Ioi_of_monotone_surjective {α : Type u_1} {β : Type u_2} [linear_order α]
    [partial_order β] {f : α → β} (h_mono : monotone f) (h_surj : function.surjective f) (a : α) :
    set.surj_on f (set.Ioi a) (set.Ioi (f a)) :=
  sorry

theorem surj_on_Iio_of_monotone_surjective {α : Type u_1} {β : Type u_2} [linear_order α]
    [partial_order β] {f : α → β} (h_mono : monotone f) (h_surj : function.surjective f) (a : α) :
    set.surj_on f (set.Iio a) (set.Iio (f a)) :=
  surj_on_Ioi_of_monotone_surjective (monotone.order_dual h_mono) h_surj a

theorem surj_on_Ici_of_monotone_surjective {α : Type u_1} {β : Type u_2} [linear_order α]
    [partial_order β] {f : α → β} (h_mono : monotone f) (h_surj : function.surjective f) (a : α) :
    set.surj_on f (set.Ici a) (set.Ici (f a)) :=
  sorry

theorem surj_on_Iic_of_monotone_surjective {α : Type u_1} {β : Type u_2} [linear_order α]
    [partial_order β] {f : α → β} (h_mono : monotone f) (h_surj : function.surjective f) (a : α) :
    set.surj_on f (set.Iic a) (set.Iic (f a)) :=
  surj_on_Ici_of_monotone_surjective (monotone.order_dual h_mono) h_surj a

end Mathlib