/-
Copyright (c) 2019 Paul-Nicolas Madelaine. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner
-/

import Std.Tactic.NormCast.Ext
import Std.Tactic.CoeExt
import Mathlib.Tactic.SudoSetOption
import Mathlib.Lean.Meta.Simp
import Mathlib.Algebra.Group.Defs
import Mathlib.Data.Nat.Cast.Defs

open Lean Meta Simp
open Std.Tactic.NormCast
open Std.Tactic.Coe

namespace Tactic.NormCast

initialize registerTraceClass `Tactic.norm_cast

/-- Prove `a = b` using the given simp set. -/
def proveEqUsing (s : SimpTheorems) (a b : Expr) : MetaM (Option Simp.Result) := do
  let go : SimpM (Option Simp.Result) := do
    let methods := Simp.DefaultMethods.methods
    let a' ← Simp.simp a methods
    let b' ← Simp.simp b methods
    unless ← isDefEq a'.expr b'.expr do return none
    mkEqTrans a' (← mkEqSymm b b')
  withReducible do
    (go { simpTheorems := #[s], congrTheorems := ← Meta.getSimpCongrTheorems }).run' {}

/-- Prove `a = b` by simplifying using move and squash lemmas. -/
def proveEqUsingDown (a b : Expr) : MetaM (Option Simp.Result) := do
  withTraceNode `Tactic.norm_cast (return m!"{exceptOptionEmoji ·} proving: {← mkEq a b}") do
  proveEqUsing (← normCastExt.down.getTheorems) a b

def mkCoe (e : Expr) (ty : Expr) : MetaM Expr := do
  let .some e' ← coerce? e ty | failure
  return e'

def isCoeOf? (e : Expr) : MetaM (Option Expr) := do
  if let Expr.const fn .. := e.getAppFn then
    if let some info ← getCoeFnInfo? fn then
      if e.getAppNumArgs == info.numArgs then
        return e.getArg! info.coercee
  return none

def isNumeral? (e : Expr) : Option (Expr × Nat) :=
  if e.isConstOf ``Nat.zero then
    (mkConst ``Nat, 0)
  else if let Expr.app (Expr.app (Expr.app (Expr.const ``OfNat.ofNat ..) α ..)
      (Expr.lit (Literal.natVal n) ..) ..) .. := e then
    some (α, n)
  else
    none

/--
This is the main heuristic used alongside the elim and move lemmas.
The goal is to help casts move past operators by adding intermediate casts.
An expression of the shape: op (↑(x : α) : γ) (↑(y : β) : γ)
is rewritten to:            op (↑(↑(x : α) : β) : γ) (↑(y : β) : γ)
when (↑(↑(x : α) : β) : γ) = (↑(x : α) : γ) can be proven with a squash lemma
-/
def splittingProcedure (expr : Expr) : MetaM Simp.Result := do
  let Expr.app (Expr.app op x ..) y .. := expr | return {expr}

  let Expr.forallE _ γ (Expr.forallE _ γ' ty ..) .. ← inferType op | return {expr}
  if γ'.hasLooseBVars || ty.hasLooseBVars then return {expr}
  unless ← isDefEq γ γ' do return {expr}

  let msg := m!"splitting {expr}"
  let msg
    | .error _ => return m!"{bombEmoji} {msg}"
    | .ok r => return if r.expr == expr then m!"{crossEmoji} {msg}" else
      m!"{checkEmoji} {msg} to {r.expr}"
  withTraceNode `Tactic.norm_cast msg do

  try
    let some x' ← isCoeOf? x | failure
    let some y' ← isCoeOf? y | failure
    let α ← inferType x'
    let β ← inferType y'

    -- TODO: fast timeout
    (try
      let x2 ← mkCoe (← mkCoe x' β) γ
      let some x_x2 ← proveEqUsingDown x x2 | failure
      Simp.mkCongrFun (← Simp.mkCongr {expr := op} x_x2) y
    catch _ =>
      let y2 ← mkCoe (← mkCoe y' α) γ
      let some y_y2 ← proveEqUsingDown y y2 | failure
      Simp.mkCongr {expr := mkApp op x} y_y2)
  catch _ => try
    let some (_, n) := isNumeral? y | failure
    let some x' ← isCoeOf? x | failure
    let α ← inferType x'
    let y2 ← mkCoe (← mkNumeral α n) γ
    let some y_y2 ← proveEqUsingDown y y2 | failure
    Simp.mkCongr {expr := mkApp op x} y_y2
  catch _ => try
    let some (_, n) := isNumeral? x | failure
    let some y' ← isCoeOf? y | failure
    let β ← inferType y'
    let x2 ← mkCoe (← mkNumeral β n) γ
    let some x_x2 ← proveEqUsingDown x x2 | failure
    Simp.mkCongrFun (← Simp.mkCongr {expr := op} x_x2) y
  catch _ =>
    return {expr}

/--
Discharging function used during simplification in the "squash" step.

TODO: normCast takes a list of expressions to use as lemmas for the discharger
TODO: a tactic to print the results the discharger fails to proove
-/
def prove (e : Expr) : SimpM (Option Expr) := do
  withTraceNode `Tactic.norm_cast (return m!"{exceptOptionEmoji ·} discharging: {e}") do
  return (← findLocalDeclWithType? e).map mkFVar

/--
Core rewriting function used in the "squash" step, which moves casts upwards
and eliminates them.

It tries to rewrite an expression using the elim and move lemmas.
On failure, it calls the splitting procedure heuristic.
-/
partial def upwardAndElim (up : SimpTheorems) (e : Expr) : SimpM Simp.Step := do
  let r ← Simp.rewrite? e up.post up.erased prove (tag := "squash") (rflOnly := false)
  let r := r.getD { expr := e }
  let r ← mkEqTrans r <|← splittingProcedure r.expr
  if r.expr == e then return Simp.Step.done {expr := e}
  return Simp.Step.visit r

/--
If possible, rewrite `(n : α)` to `(Nat.cast n : α)` where `n` is a numeral and `α ≠ ℕ`.
Returns a pair of the new expression and proof that they are equal.
-/
def numeralToCoe (e : Expr) : MetaM Simp.Result := do
  let some (α, n) := isNumeral? e | failure
  if (← whnf α).isConstOf ``Nat then failure
  let newE ← mkAppOptM ``Nat.cast #[α, none, toExpr n]
  let some pr ← proveEqUsingDown e newE | failure
  return pr

/--
The core simplification routine of `normCast`.
-/
def derive (e : Expr) : MetaM Simp.Result := do
  withTraceNode `Tactic.norm_cast (fun _ => return m!"{e}") do
  let e ← instantiateMVars e

  let config : Simp.Config := {
    zeta := false
    beta := false
    eta  := false
    proj := false
    iota := false
  }
  let congrTheorems ← Meta.getSimpCongrTheorems

  let r := {expr := e}

  let withTrace phase := withTraceNode `Tactic.norm_cast fun
    | .ok r => return m!"{r.expr} (after {phase})"
    | .error _ => return m!"{bombEmoji} {phase}"

  -- step 1: pre-processing of numerals
  let r ← withTrace "pre-processing numerals" do
    let post e := return Simp.Step.done (← try numeralToCoe e catch _ => pure {expr := e})
    Simp.mkEqTrans r (← Simp.main r.expr { config, congrTheorems } (methods := { post })).1

  -- step 2: casts are moved upwards and eliminated
  let r ← withTrace "moving upward, splitting and eliminating" do
    let post := upwardAndElim (← normCastExt.up.getTheorems)
    Simp.mkEqTrans r (← Simp.main r.expr { config, congrTheorems } (methods := { post })).1

  -- step 3: casts are squashed
  let r ← withTrace "squashing" do
    let simpTheorems := #[← normCastExt.squash.getTheorems]
    mkEqTrans r (← simp r.expr { simpTheorems, config, congrTheorems }).1

  return r

open Elab.Term in
elab "mod_cast " e:term : term <= expectedType => do
  if (← instantiateMVars expectedType).hasExprMVar then tryPostpone
  let expectedType' ← derive expectedType
  let e ← elabTerm e expectedType'.expr
  synthesizeSyntheticMVars
  let eTy ← instantiateMVars (← inferType e)
  if eTy.hasExprMVar then tryPostpone
  let eTy' ← derive eTy
  unless ← isDefEq eTy'.expr expectedType'.expr do
    throwTypeMismatchError "mod_cast" expectedType'.expr eTy'.expr e
  let eTy_eq_expectedType ← mkEqTrans eTy' (← mkEqSymm expectedType expectedType')
  mkCast eTy_eq_expectedType e

open Tactic Parser.Tactic Elab.Tactic

def normCastTarget : TacticM Unit :=
  liftMetaTactic1 fun goal ↦ do
    let tgt ← instantiateMVars (← goal.getType)
    let prf ← derive tgt
    applySimpResultToTarget goal tgt prf

def normCastHyp (fvarId : FVarId) : TacticM Unit :=
  liftMetaTactic1 fun goal ↦ do
    let hyp ← instantiateMVars (← fvarId.getDecl).type
    let prf ← derive hyp
    return (← applySimpResultToLocalDecl goal fvarId prf false).map (·.snd)

elab "norm_cast0" loc:((ppSpace location)?) : tactic =>
  withMainContext do
    match expandOptLocation loc with
    | Location.targets hyps target =>
      if target then normCastTarget
      (← getFVarIds hyps).forM normCastHyp
    | Location.wildcard =>
      normCastTarget
      (← (← getMainGoal).getNondepPropHyps).forM normCastHyp

/-- `assumption_mod_cast` runs `norm_cast` on the goal. For each local hypothesis `h`, it also
normalizes `h` and tries to use that to close the goal. -/
macro "assumption_mod_cast" : tactic => `(tactic| norm_cast0 at * <;> assumption)

/--
Normalize casts at the given locations by moving them "upwards".
-/
macro "norm_cast" loc:(ppSpace location)? : tactic =>
  `(tactic| norm_cast0 $[$loc]? <;> try trivial)

/--
Rewrite with the given rules and normalize casts between steps.
-/
syntax "rw_mod_cast" (config)? rwRuleSeq (ppSpace location)? : tactic
macro_rules
  | `(tactic| rw_mod_cast $[$config]? [$rules,*] $[$loc]?) => do
    let tacs ← rules.getElems.mapM fun rule ↦
      `(tactic| (norm_cast at *; rw $[$config]? [$rule] $[$loc]?))
    `(tactic| ($[$tacs]*))

/--
Normalize the goal and the given expression, then close the goal with exact.
-/
macro "exact_mod_cast " e:term : tactic => `(tactic| exact mod_cast ($e : _))

/--
Normalize the goal and the given expression, then apply the expression to the goal.
-/
macro "apply_mod_cast " e:term : tactic => `(tactic| apply mod_cast ($e : _))

syntax (name := convNormCast) "norm_cast" : conv
@[tactic convNormCast] def evalConvNormCast : Tactic :=
  open Elab.Tactic.Conv in fun _ ↦ withMainContext do
    applySimpResult (← derive (← getLhs))

syntax (name := pushCast) "push_cast " (config)? (discharger)? (&"only ")?
  ("[" (simpStar <|> simpErase <|> simpLemma),* "]")? (location)? : tactic
@[tactic pushCast] def evalPushCast : Tactic := fun stx ↦ do
  let { ctx, dischargeWrapper, .. } ← withMainContext do
    mkSimpContext' (← pushCastExt.getTheorems) stx (eraseLocal := false)
  dischargeWrapper.with fun discharge? ↦
    discard <| simpLocation ctx discharge? (expandOptLocation stx[5])

-- add_hint_tactic "norm_cast at *"

/-
The `norm_cast` family of tactics is used to normalize casts inside expressions.
It is basically a simp tactic with a specific set of lemmas to move casts
upwards in the expression.
Therefore it can be used more safely as a non-terminating tactic.
It also has special handling of numerals.

For instance, given an assumption
```lean
a b : ℤ
h : ↑a + ↑b < (10 : ℚ)
```

writing `norm_cast at h` will turn `h` into
```lean
h : a + b < 10
```

You can also use `exact_mod_cast`, `apply_mod_cast`, `rw_mod_cast`
or `assumption_mod_cast`.
Writing `exact_mod_cast h` and `apply_mod_cast h` will normalize the goal and
`h` before using `exact h` or `apply h`.
Writing `assumption_mod_cast` will normalize the goal and for every
expression `h` in the context it will try to normalize `h` and use
`exact h`.
`rw_mod_cast` acts like the `rw` tactic but it applies `norm_cast` between steps.

`push_cast` rewrites the expression to move casts toward the leaf nodes.
This uses `norm_cast` lemmas in the forward direction.
For example, `↑(a + b)` will be written to `↑a + ↑b`.
It is equivalent to `simp only with push_cast`.
It can also be used at hypotheses with `push_cast at h`
and with extra simp lemmas with `push_cast [int.add_zero]`.

```lean
example (a b : ℕ) (h1 : ((a + b : ℕ) : ℤ) = 10) (h2 : ((a + b + 0 : ℕ) : ℤ) = 10) :
  ((a + b : ℕ) : ℤ) = 10 :=
begin
  push_cast,
  push_cast at h1,
  push_cast [int.add_zero] at h2,
end
```

The implementation and behavior of the `norm_cast` family is described in detail at
<https://lean-forward.github.io/norm_cast/norm_cast.pdf>.
-/
-- add_tactic_doc
-- { name := "norm_cast",
--   category   := doc_category.tactic,
--   decl_names := [``tactic.interactive.norm_cast, ``tactic.interactive.rw_mod_cast,
--                  ``tactic.interactive.apply_mod_cast, ``tactic.interactive.assumption_mod_cast,
--                  ``tactic.interactive.exact_mod_cast, ``tactic.interactive.push_cast],
--   tags       := ["coercions", "simplification"] }
-- TODO


/- Symbol :
∃ : \exists
∀ : \forall
∈ : \in
∉ : \notin
∪ : \cup
∩ : \cap
∅ : \emptyset
∨ : \or
∧ : \and
¬ : \not
→ : \rightarrow
↔ : \iff
-/

/- Tactic : refl

## Summary

`refl` is a tactic which proves goals of the form `A = A`.

## Details

The `refl` tactic will close any goal of the form `A = B`
where `A` and `B` are *exactly the same thing*.

### Example:
If it looks like this in the top right hand box:
```
A : Point
⊢ A = A
```

then

`refl,`

will close the goal and solve the level. Don't forget the comma.

-/

/-
# Tutorial World

## The setup

Welcome to the Tutorial World! In this world, you're going to prove some geometric facts by using **`tactics`**.
These `tactics` are just instructions that make progress in a mathematical proof.
During your proofs, your "goal" (i.e. what you're
supposed to be proving) will be displayed in front of a `⊢` symbol on the top
right hand box, so you will need to use `tactics` to close that goals. Once you close all the goals, the top
right hand box will report "Proof complete!", so that you
can move on to the next level in the world you're in.

## The language

The vast majority of mathematical fields are built up from **Set theory**, which is a branch of mathematical logic
that studies sets. In set theory, everything is a set. Even a point can be thought as a set. These sets can contain
elements, which are mathematical objects of any kind: numbers, points, lines, or even other sets. The set with no element
is the empty set. The problem with set theory, however, is that it does not consider mathematical proofs as sets or elements.
As a consequence, it makes the translation of mathematical propositions into programming languages more difficult.

To avoid this problem, the majority of proof assistants, such as Lean or Coq, use **Type Theory**.
In Type theory, there are `terms` and `types`. A term and its type are written together as `term` : `type`,
where the symbol : can be thought as "is an element of" (this is an analogy with set theory).
Then, if we find the expression Ω : Type , we should understand that Ω is a term of the type "Type".
Analogously, A : Ω  will translate into "A is a term of the type Ω", which makes us think that terms can also be types.
In this case, because we are talking about geometry, Ω must be interpreted as a plane, where A is a point that lies on
that plane. In addition to all this, there exists `Prop`, which refers to propositions. Each proposition (when interpreted as a type)
is either empty or has exactly one `term`. In this way, it can be used to introduce mathematical proofs. If we found h : A = B,
that should be read as "h is a proof of the fact that `A = B`". In Lean, the computer does not care about the content of a proof,
but if a proposition is either proved or not. This fact is known as **proof irrelevance**, and makes reasoning about dependent types easier
for computers. If you want to learn more about this, we encourage you to look for the **Curry–Howard correspondence** and **Homotopy Type Theory**.

## The symbols

In case you are not familiar with the symbology of mathematics, you will find a **Vocabulary Section** at the top left corner of
the screen. Next to each symbol, there is the instruction that you neeed to type in case you want it to appear on the screen.
Sooner or later, you will come across these symbols during the game, so try to save a space in your brain for them. They will be important!

## Level 1: the `refl` tactic.

Once we've mastered the language...Let's learn some tactics! Let's start with the `refl` tactic. `refl`
stands for "reflexivity", which is a fancy way of saying that it will prove any goal of the form `A = A`.
It doesn't matter how complicated `A` is, all that matters is that the left hand side is *exactly equal*
to the right hand side.

Each level in this game involves proving a theorem or a lemma (a lemma is just a baby theorem).
At the bottom of the text in this box, there's a lemma, which says that if $A$ is a point, then $A$ = $A$.
Locate this lemma (if you can't see the lemma and these instructions at the same time, make this box wider
by dragging the sides). Let's supply the proof. Click on the word `sorry` and then delete it.
When the system finishes being busy, you'll be able to see your goal in the box on the top right.
[If your system never finishes being busy, then your computer is not running the javascript
Lean which powers everything behind the scenes. Try Chrome? Try not using private browsing?]

This first level shows a pretty easy goal to prove -- you can just prove it with the `refl` tactic.
Where it used to say `sorry`, write `refl,`
**and don't forget the comma**. Then **hit enter** to go onto the next line.
If all is well, Lean should tell you "Proof complete!" in the top right box, and there
should be no errors in the bottom right box. You just did the first
level of the tutorial! And you also learnt how to avoid by *far* the most
common mistake that beginner users make -- **every line must end with a comma**.
At the end, the comma is important because it tells Lean you are done with one step of your proof!

For each level, the idea is to get Lean into this state: with the top right
box saying "Proof complete!" and the bottom right box empty (i.e. with no errors in).
If you want to be reminded about the `refl` tactic, you can click on the "Tactics" drop
down menu on the left. Resize the window if it's too small.
Now click on "Next Level" in the top right of your browser to go onto the second level of
Tutorial World, where we'll learn about the `rw` tactic.
-/

variables {Ω : Type} -- hide

/- Lemma : no-side-bar
If A is a point, then A = A.
-/
lemma refl_example (A : Ω) : A = A :=
begin
  refl,
end


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Reid Barton, Bhavik Mehta
-/
import category_theory.over
import category_theory.adjunction.opposites
import category_theory.limits.preserves.basic
import category_theory.limits.shapes.pullbacks
import category_theory.limits.creates
import category_theory.limits.comma

/-!
# Limits and colimits in the over and under categories

Show that the forgetful functor `forget X : over X ⥤ C` creates colimits, and hence `over X` has
any colimits that `C` has (as well as the dual that `forget X : under X ⟶ C` creates limits).

Note that the folder `category_theory.limits.shapes.constructions.over` further shows that
`forget X : over X ⥤ C` creates connected limits (so `over X` has connected limits), and that
`over X` has `J`-indexed products if `C` has `J`-indexed wide pullbacks.

TODO: If `C` has binary products, then `forget X : over X ⥤ C` has a right adjoint.
-/
noncomputable theory

universes v u -- morphism levels before object levels. See note [category_theory universes].

open category_theory category_theory.limits

variables {J : Type v} [small_category J]
variables {C : Type u} [category.{v} C]
variable {X : C}

namespace category_theory.over

instance has_colimit_of_has_colimit_comp_forget
  (F : J ⥤ over X) [i : has_colimit (F ⋙ forget X)] : has_colimit F :=
@@costructured_arrow.has_colimit _ _ _ _ i _

instance [has_colimits_of_shape J C] : has_colimits_of_shape J (over X) := {}
instance [has_colimits C] : has_colimits (over X) := ⟨infer_instance⟩

instance creates_colimits : creates_colimits (forget X) := costructured_arrow.creates_colimits

-- We can automatically infer that the forgetful functor preserves and reflects colimits.
example [has_colimits C] : preserves_colimits (forget X) := infer_instance
example : reflects_colimits (forget X) := infer_instance

lemma epi_left_of_epi [has_pushouts C] {f g : over X} (h : f ⟶ g) [epi h] : epi h.left :=
costructured_arrow.epi_left_of_epi _

lemma epi_iff_epi_left [has_pushouts C] {f g : over X} (h : f ⟶ g) : epi h ↔ epi h.left :=
costructured_arrow.epi_iff_epi_left _

section
variables [has_pullbacks C]

open tactic

/-- When `C` has pullbacks, a morphism `f : X ⟶ Y` induces a functor `over Y ⥤ over X`,
by pulling back a morphism along `f`. -/
@[simps]
def pullback {X Y : C} (f : X ⟶ Y) : over Y ⥤ over X :=
{ obj := λ g, over.mk (pullback.snd : pullback g.hom f ⟶ X),
  map := λ g h k,
    over.hom_mk
      (pullback.lift (pullback.fst ≫ k.left) pullback.snd (by simp [pullback.condition]))
      (by tidy) }

/-- `over.map f` is left adjoint to `over.pullback f`. -/
def map_pullback_adj {A B : C} (f : A ⟶ B) :
  over.map f ⊣ pullback f :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ g h,
  { to_fun := λ X, over.hom_mk (pullback.lift X.left g.hom (over.w X)) (pullback.lift_snd _ _ _),
    inv_fun := λ Y,
    begin
      refine over.hom_mk _ _,
      refine Y.left ≫ pullback.fst,
      dsimp,
      rw [← over.w Y, category.assoc, pullback.condition, category.assoc], refl,
    end,
    left_inv := λ X, by { ext, dsimp, simp, },
    right_inv := λ Y, begin
      ext, dsimp,
      simp only [pullback.lift_fst],
      dsimp,
      rw [pullback.lift_snd, ← over.w Y],
      refl,
    end } }

/-- pullback (𝟙 A) : over A ⥤ over A is the identity functor. -/
def pullback_id {A : C} : pullback (𝟙 A) ≅ 𝟭 _ :=
adjunction.right_adjoint_uniq
  (map_pullback_adj _)
  (adjunction.id.of_nat_iso_left over.map_id.symm)

/-- pullback commutes with composition (up to natural isomorphism). -/
def pullback_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  pullback (f ≫ g) ≅ pullback g ⋙ pullback f :=
adjunction.right_adjoint_uniq
  (map_pullback_adj _)
  (((map_pullback_adj _).comp (map_pullback_adj _)).of_nat_iso_left
    (over.map_comp _ _).symm)

instance pullback_is_right_adjoint {A B : C} (f : A ⟶ B) :
  is_right_adjoint (pullback f) :=
⟨_, map_pullback_adj f⟩

end

end category_theory.over

namespace category_theory.under

instance has_limit_of_has_limit_comp_forget
  (F : J ⥤ under X) [i : has_limit (F ⋙ forget X)] : has_limit F :=
@@structured_arrow.has_limit _ _ _ _ i _

instance [has_limits_of_shape J C] : has_limits_of_shape J (under X) := {}
instance [has_limits C] : has_limits (under X) := ⟨infer_instance⟩

lemma mono_right_of_mono [has_pullbacks C] {f g : under X} (h : f ⟶ g) [mono h] : mono h.right :=
structured_arrow.mono_right_of_mono _

instance creates_limits : creates_limits (forget X) := structured_arrow.creates_limits

-- We can automatically infer that the forgetful functor preserves and reflects limits.
example [has_limits C] : preserves_limits (forget X) := infer_instance
example : reflects_limits (forget X) := infer_instance

section
variables [has_pushouts C]

/-- When `C` has pushouts, a morphism `f : X ⟶ Y` induces a functor `under X ⥤ under Y`,
by pushing a morphism forward along `f`. -/
@[simps]
def pushout {X Y : C} (f : X ⟶ Y) : under X ⥤ under Y :=
{ obj := λ g, under.mk (pushout.inr : Y ⟶ pushout g.hom f),
  map := λ g h k,
    under.hom_mk
      (pushout.desc (k.right ≫ pushout.inl) pushout.inr (by { simp [←pushout.condition], }))
      (by tidy) }

end

end category_theory.under


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

! This file was ported from Lean 3 source module topology.tactic
! leanprover-community/mathlib commit ee05e9ce1322178f0c12004eb93c00d2c8c00ed2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.AutoCases
import Mathbin.Tactic.Tidy
import Mathbin.Tactic.WithLocalReducibility
import Mathbin.Tactic.ShowTerm
import Mathbin.Topology.Basic

/-!
# Tactics for topology

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

Currently we have one domain-specific tactic for topology: `continuity`.

-/

/-!
### `continuity` tactic

Automatically solve goals of the form `continuous f`.

Mark lemmas with `@[continuity]` to add them to the set of lemmas
used by `continuity`.
-/

/-- User attribute used to mark tactics used by `continuity`. -/
@[user_attribute]
unsafe def continuity : user_attribute
    where
  Name := `continuity
  descr := "lemmas usable to prove continuity"
#align continuity continuity

-- Mark some continuity lemmas already defined in `topology.basic`
attribute [continuity] continuous_id continuous_const

#print continuous_id' /-
-- As we will be using `apply_rules` with `md := semireducible`,
-- we need another version of `continuous_id`.
@[continuity]
theorem continuous_id' {α : Type _} [TopologicalSpace α] : Continuous fun a : α => a :=
  continuous_id
#align continuous_id' continuous_id'
-/

namespace Tactic

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Tactic to apply `continuous.comp` when appropriate.

Applying `continuous.comp` is not always a good idea, so we have some
extra logic here to try to avoid bad cases.

* If the function we're trying to prove continuous is actually
  constant, and that constant is a function application `f z`, then
  continuous.comp would produce new goals `continuous f`, `continuous
  (λ _, z)`, which is silly. We avoid this by failing if we could
  apply continuous_const.

* continuous.comp will always succeed on `continuous (λ x, f x)` and
  produce new goals `continuous (λ x, x)`, `continuous f`. We detect
  this by failing if a new goal can be closed by applying
  continuous_id.
-/
unsafe def apply_continuous.comp : tactic Unit :=
  sorry
#align tactic.apply_continuous.comp tactic.apply_continuous.comp

/-- List of tactics used by `continuity` internally. -/
unsafe def continuity_tactics (md : Transparency := reducible) : List (tactic String) :=
  [intros1 >>= fun ns => pure ("intros " ++ " ".intercalate (ns.map fun e => e.toString)),
    apply_rules [] [`` continuity] 50 { md } >> pure "apply_rules with continuity",
    apply_continuous.comp >> pure "refine continuous.comp _ _"]
#align tactic.continuity_tactics tactic.continuity_tactics

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- Solve goals of the form `continuous f`. `continuity?` reports back the proof term it found.
-/
unsafe def continuity (bang : parse <| optional (tk "!")) (trace : parse <| optional (tk "?"))
    (cfg : tidy.cfg := { }) : tactic Unit :=
  let md := if bang.isSome then semireducible else reducible
  let continuity_core := tactic.tidy { cfg with tactics := continuity_tactics md }
  let trace_fn := if trace.isSome then show_term else id
  trace_fn continuity_core
#align tactic.interactive.continuity tactic.interactive.continuity

/-- Version of `continuity` for use with auto_param. -/
unsafe def continuity' : tactic Unit :=
  continuity none none { }
#align tactic.interactive.continuity' tactic.interactive.continuity'

/-- `continuity` solves goals of the form `continuous f` by applying lemmas tagged with the
`continuity` user attribute.

```
example {X Y : Type*} [topological_space X] [topological_space Y]
  (f₁ f₂ : X → Y) (hf₁ : continuous f₁) (hf₂ : continuous f₂)
  (g : Y → ℝ) (hg : continuous g) : continuous (λ x, (max (g (f₁ x)) (g (f₂ x))) + 1) :=
by continuity
```
will discharge the goal, generating a proof term like
`((continuous.comp hg hf₁).max (continuous.comp hg hf₂)).add continuous_const`

You can also use `continuity!`, which applies lemmas with `{ md := semireducible }`.
The default behaviour is more conservative, and only unfolds `reducible` definitions
when attempting to match lemmas with the goal.

`continuity?` reports back the proof term it found.
-/
add_tactic_doc
  { Name := "continuity / continuity'"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.continuity, `tactic.interactive.continuity']
    tags := ["lemma application"] }

end Interactive

end Tactic


/-
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 tactic
import measure_theory.measurable_space
import measure_theory.integration
import measure_theory.bochner_integration
import measure_theory.borel_space
import topology.metric_space.basic
import topology.instances.real
import topology.instances.ennreal
import order.liminf_limsup
import portmanteau_limsup_lemmas
import portmanteau_definitions
import portmanteau_proba_lemmas
import analysis.seminorm

noncomputable theory
open set
open classical
open measure_theory
open measurable_space
open metric_space
open borel_space
open filter
open order
open_locale topological_space ennreal big_operators

namespace portmanteau

section portmanteau_integrals

variables {α : Type} [topological_space α]

abbreviation R_integrate (f : α → ℝ) (μ : borel_proba α) := @integral α ℝ (borel(α)) _ _ _ _ _ _ μ f
abbreviation R_abs_nn : ℝ → nnreal := λ x , nnnorm x
abbreviation R_abs_enn : ℝ → ennreal := λ x , ennreal.of_nnreal_hom (nnnorm x) --ennreal.of_real(abs(x))

lemma R_abs_enn_le_of_abs_le {x c : ℝ} (h : abs(x) ≤ c) : R_abs_enn(x) ≤ ennreal.of_real(c) :=
begin
  have c_nn : 0 ≤ c := le_trans (abs_nonneg x) h,
  have eq := real.coe_to_nnreal c c_nn ,
  set c' := c.to_nnreal with hc' ,
  have h₁ : R_abs_nn(x) ≤ c' := (real.le_to_nnreal_iff_coe_le c_nn).mpr h ,
  exact (with_top.le_coe rfl).mpr h₁ ,
end

-- TODO: Should state for finite measures?
lemma integrable_of_bdd_realval {β : Type*} {mβ : measurable_space β}
  (μ : measure β) [μ_fin : probability_measure μ]
  (f : β → ℝ) (f_bdd : bdd_Rval f) (f_mble : @ae_measurable β ℝ mβ _ f μ) :
     integrable f μ :=
begin
  cases f_bdd with c hc ,
  set f' := R_abs_enn ∘ f with hf' ,
  suffices : lintegral μ f' < ⊤ ,
  { rw hf' at this ,
    exact ⟨ f_mble , this ⟩ , } ,
  have bdd' : f' ≤ (λ b , ennreal.of_real(c)) ,
  { rw hf' ,
    intros b ,
    dsimp ,
    specialize hc b ,
    exact R_abs_enn_le_of_abs_le hc , } ,
  have integr_bdd := lintegral_mono bdd' ,
  set c' := ennreal.of_real(c) with hc' ,
  have const_integr : lintegral μ (λ b , c') = c' * (μ(univ)) ,
  { rw ← set_lintegral_const univ c' ,
    simp , } ,
  have total : c' * (μ(univ)) < ⊤ ,
  { rw (proba_muniv μ) ,
    simp , } ,
  rw ← const_integr at total ,
  exact lt_of_le_of_lt integr_bdd total ,
end

-- TODO: Should state for finite measures?
lemma bdd_integral_of_bdd_ennval {β : Type*} {mβ : measurable_space β}
  (μ : measure β) [μ_fin : probability_measure μ]
  (f : β → ennreal) (f_bdd : bdd_ennval f) :
     lintegral μ f < ⊤ :=
begin
  cases f_bdd with c hc ,
  have f_le_c : f ≤ λ x , c := hc ,
  have integr_f_le := @lintegral_mono β mβ μ _ _ f_le_c ,
  simp [proba_muniv] at integr_f_le ,
  exact lt_of_le_of_lt integr_f_le (@ennreal.coe_lt_top c) ,
end

lemma const_bdd_Rval {β : Type*} {c : ℝ} :
    bdd_Rval (λ (x : β) , c) :=
begin
  use abs(c) ,
  intros x ,
  refl ,
end

lemma const_bdd_ennval {β : Type*} {c : nnreal} :
    bdd_ennval (λ (x : β) , c) :=
begin
  use c ,
  intros x ,
  simp only [ennreal.coe_le_coe] ,
end

-- TODO: Should state for finite measures?
lemma const_integrable {β : Type*} {mβ : measurable_space β}
  (μ : measure β) (μ_fin : probability_measure μ) (c : ℝ) :
    integrable (λ (x : β) , c) μ :=
begin
  apply integrable_const_iff.mpr ,
  right ,
  exact proba_finite μ univ ,
end

lemma integral_cst {β : Type*} {mβ : measurable_space β}
  (μ : measure β) (μ_fin : probability_measure μ) (c : ℝ) :
    integral μ (λ (x : β) , c) = c :=
begin
  suffices : integral μ (λ (x : β) , c) = (μ(univ)).to_real * c,
  { simp [proba_muniv μ] , } ,
  apply integral_const c ,
end

lemma lintegral_cst {β : Type*} {mβ : measurable_space β}
  (μ : measure β) [μ_proba : probability_measure μ] (c : ennreal) :
    lintegral μ (λ (x : β) , c) = c :=
begin
  suffices : lintegral μ (λ (x : β) , c) = c * (μ(univ)) ,
  { simp [proba_muniv μ] , } ,
  apply lintegral_const c ,
end

lemma integral_add_cst {β : Type*} {mβ : measurable_space β} {c : ℝ}
  (μ : measure β) [μ_fin : probability_measure μ] (f : β → ℝ) (f_intble: integrable f μ) :
    integral μ ( f + (λ (x : β) , c)) = integral μ f + c :=
begin
  have key := @integral_add β ℝ mβ _ _ _ _ _ _ f (λ (x : β) , c) μ f_intble (const_integrable μ μ_fin c) ,
  rw integral_cst μ μ_fin c at key ,
  exact key ,
end

lemma lintegral_cst_sub {β : Type*} {mβ : measurable_space β} {c : ennreal}
  (μ : measure β) [μ_fin : probability_measure μ] (c_ne_top : c ≠ ⊤)
  (f : β → ennreal) (f_mble: measurable f) (f_le_c : f ≤ λ b , c) :
    lintegral μ ( (λ (x : β) , c) - f) = c - lintegral μ f :=
begin
  nth_rewrite 0 ←(lintegral_cst μ c) ,
  have f_intble := bdd_integral_of_bdd_ennval μ f (bdd_ennval_of_le_cst f_le_c c_ne_top) ,
  rw ← @lintegral_sub β mβ μ (λ (b : β) , c) f (measurable_const) f_mble f_intble (eventually_of_forall f_le_c) ,
  refl ,
end

lemma nnreal_integral_of_integrable_nonneg {β : Type*} {mβ : measurable_space β}
  (μ : measure β) (f : β → ℝ) (f_nn : 0 ≤ f)
  (f_intble : integrable f μ) :
     ennreal.of_real (integral μ f) = lintegral μ (ennreal.of_real ∘ f) :=
begin
  set g := λ (b : β) , (f(b)).to_nnreal with hg ,
  have key := @lintegral_coe_eq_integral β mβ μ g (integrable.max_zero f_intble) ,
  rw hg at key ,
  set ψ : (β → nnreal) → (β → ℝ) := coe with hψ ,
  have eq₀ : f = ψ(g) ,
  { funext b ,
    exact left_eq_sup.mpr (f_nn b) , } ,
  have eq₂ : ∫ (a : β), ↑((λ (b : β), (f b).to_nnreal) a) ∂μ = integral μ (ψ(g)) := by refl ,
  rw [eq₂ , ←eq₀] at key ,
  rw ← key ,
  refl ,
end

lemma nnreal_integral_of_integrable_nonneg' {β : Type*} {mβ : measurable_space β}
  (μ : measure β) (f : β → ℝ) (f_nn : 0 ≤ f)
  (f_intble : integrable f μ) :
     integral μ f = (lintegral μ (ennreal.of_real ∘ f)).to_real :=
begin
  have key := nnreal_integral_of_integrable_nonneg μ f f_nn f_intble ,
  have fin : lintegral μ (ennreal.of_real ∘ f) ≠ ⊤ ,
  { rw ←key ,
    exact ennreal.of_real_ne_top , } ,
  have nn : 0 ≤ integral μ f := integral_nonneg f_nn ,
  have eq := ennreal.to_real_of_real nn ,
  rw key at eq ,
  exact eq.symm ,
end

example (s : ℕ → ℝ) (l : ℝ) (hlim : tendsto s at_top (𝓝 l)) (c : ℝ) :
  tendsto (λ (n : ℕ) , s(n) + c) at_top (𝓝 (l+c)) :=
begin
  exact tendsto.add_const c hlim ,
end

lemma nonneg_of_add_abs_le (a c : ℝ) (h : abs(a) ≤ c) : 0 ≤ c + a :=
begin
  have key : c-abs(a) ≤ c+a := by linarith [neg_le.mp (neg_le_abs_self a)] ,
  exact le_trans (sub_nonneg.mpr h) key ,
end

private lemma portmanteau_continuous_equivalent_formulation'
  {μseq : ℕ → borel_proba α} {μ : borel_proba α} :
    portmanteau_continuous_ennval (λ n , (μseq(n) : @measure_theory.measure α (borel(α)))) μ
      → portmanteau_continuous_Rval (λ n , (μseq(n) : @measure_theory.measure α (borel(α)))) μ :=
begin
  intros cc_ennrealval ,
  intros g g_cont g_bdd ,
  have g_bdd' := g_bdd ,
  cases g_bdd' with c hc ,
  set h := (g + (λ x, c)) with hh ,
  set f := λ (x : α) , ennreal.of_real (h(x)) with hf ,
  have h_nn : 0 ≤ h ,
  { intros x ,
    rw hh ,
    have samediff := nonneg_of_add_abs_le (g(x)) c (hc x) ,
    rwa add_comm at samediff , } ,
  have f_eq_h : f = ennreal.of_real ∘ h := by refl ,
  have h_bdd : bdd_Rval h := bdd_Rval_add g_bdd const_bdd_Rval ,
  have h_cont : continuous h := continuous.add g_cont (@continuous_const α ℝ _ _ c ) ,
  have f_bdd : bdd_ennval f := bdd_ennval_of_bdd_Rval h_bdd ,
  have f_cont : continuous f := cont_enn_of_cont_R h h_cont ,
  specialize cc_ennrealval f f_cont f_bdd ,
  have g_mble := continuous.borel_measurable g_cont ,
  have h_mble := continuous.borel_measurable h_cont ,
  have g_ae_mble := @measurable.ae_measurable α ℝ (borel(α)) _ g μ g_mble ,
  have h_ae_mble := @measurable.ae_measurable α ℝ (borel(α)) _ h μ h_mble ,
  have g_ae_mble_seq := λ n , @measurable.ae_measurable α ℝ (borel(α)) _ g (μseq(n)) g_mble ,
  have h_ae_mble_seq := λ n , @measurable.ae_measurable α ℝ (borel(α)) _ h (μseq(n)) h_mble ,
  have g_intble := @integrable_of_bdd_realval _ _ μ.val μ.prop g g_bdd g_ae_mble ,
  have h_intble := @integrable_of_bdd_realval _ _ μ.val μ.prop h h_bdd h_ae_mble ,
  have g_intble_seq := λ n , @integrable_of_bdd_realval _ _ (μseq(n)).val (μseq(n)).prop g g_bdd (g_ae_mble_seq n) ,
  have h_intble_seq := λ n , @integrable_of_bdd_realval _ _ (μseq(n)).val (μseq(n)).prop h h_bdd (h_ae_mble_seq n) ,
  suffices : lim_R (λ n , (@integral α ℝ (borel(α)) _ _ _ _ _ _ (μseq(n)) h)) (@integral α ℝ (borel(α)) _ _ _ _ _ _ μ h) ,
  { have add_cst : (@integral α ℝ (borel(α)) _ _ _ _ _ _ μ h) = (@integral α ℝ (borel(α)) _ _ _ _ _ _ μ g) + c ,
    { rw hh ,
      apply @integral_add_cst _ _ _ μ.val μ.prop g g_intble , } ,
    have add_cst_seq : (λ n , (@integral α ℝ (borel(α)) _ _ _ _ _ _ (μseq n) h)) = (λ n , (@integral α ℝ (borel(α)) _ _ _ _ _ _ (μseq n) g) + c) ,
    { funext n ,
      rw hh ,
      apply @integral_add_cst _ _ _ (μseq(n)).val (μseq(n)).prop g (g_intble_seq n) , } ,
    rw [add_cst , add_cst_seq] at this ,
    have shift_lim := tendsto.add_const (-c) this ,
    simp at shift_lim ,
    exact shift_lim , } ,
  have eq := nnreal_integral_of_integrable_nonneg' μ.val h h_nn h_intble ,
  have eq_seq := λ n , nnreal_integral_of_integrable_nonneg' (μseq(n)).val h h_nn (h_intble_seq n) ,
  have eq' : @integral α ℝ (borel(α)) _ _ _ _ _ _ μ h = (@lintegral α (borel(α)) μ f).to_real := eq ,
  have eq_seq' : (λ n , @integral α ℝ (borel(α)) _ _ _ _ _ _ (μseq(n)).val h) = ennreal.to_real ∘ (λ n , (@lintegral α (borel(α)) (μseq(n)) f)) ,
  { funext n ,
    exact eq_seq n , } ,
  have fin : @lintegral α (borel(α)) μ f ≠ ⊤
    := ne_of_lt (@bdd_integral_of_bdd_ennval α (borel(α)) μ μ.prop f f_bdd) ,
  have key := lim_R_of_lim_enn _ _ cc_ennrealval fin ,
  rw ←eq' at key ,
  rw ←eq_seq' at key ,
  exact key ,
end

private lemma portmanteau_continuous_equivalent_formulation''
  {μseq : ℕ → (borel_proba α)} {μ : borel_proba α} :
    portmanteau_continuous_Rval (λ n , (μseq(n) : @measure_theory.measure α (borel(α)))) μ
       → portmanteau_continuous_ennval (λ n , (μseq(n) : @measure_theory.measure α (borel(α)))) μ :=
begin
  intros cc_Rval ,
  intros f f_cont f_bdd ,
  have f_fin_val : ∀ (x : α) , f(x) ≠ ⊤ := finval_of_bdd_ennval f_bdd ,
  set g := λ (x : α) , ennreal.to_real (f(x)) with hg ,
  have f_eq_g : f = ennreal.of_real ∘ g ,
  { funext x ,
    exact (ennreal.of_real_to_real (f_fin_val x)).symm , } ,
  have g_nn : 0 ≤ g ,
  { intros x ,
    simp only [pi.zero_apply, ennreal.to_real_nonneg] , } ,
  have g_bdd : bdd_Rval g ,
  { cases f_bdd with c hc ,
    use c ,
    intros x ,
    rw hg ,
    specialize hc x ,
    have abs_eq : (abs (f(x)).to_real) = g(x) := by simp only [ennreal.to_real_nonneg, abs_eq_self] ,
    rw hg at abs_eq ,
    dsimp at * ,
    rw abs_eq ,
    exact ennreal.to_real_le_coe_of_le_coe hc , } ,
  have g_cont : continuous g := cont_R_of_cont_bdd_enn f f_cont f_bdd ,
  have g_mble := continuous.borel_measurable g_cont ,
  have g_ae_mble := @measurable.ae_measurable α ℝ (borel(α)) _ g μ g_mble ,
  have g_ae_mble_seq := λ n , @measurable.ae_measurable α ℝ (borel(α)) _ g (μseq(n)) g_mble ,
  have g_intble := @integrable_of_bdd_realval _ _ μ.val μ.prop g g_bdd g_ae_mble ,
  have g_intble_seq := λ n , @integrable_of_bdd_realval _ _ (μseq(n)).val (μseq(n)).prop g g_bdd (g_ae_mble_seq n) ,
  have eq := nnreal_integral_of_integrable_nonneg μ.val g g_nn g_intble ,
  have eq_seq := λ n , nnreal_integral_of_integrable_nonneg (μseq(n)).val g g_nn (g_intble_seq n) ,
  rw ← f_eq_g at * ,
  have eq' : ennreal.of_real (@integral α ℝ (borel(α)) _ _ _ _ _ _ μ g) = @lintegral α (borel(α)) μ f := eq ,
  have eq_seq' : (λ n , ennreal.of_real (@integral α ℝ (borel(α)) _ _ _ _ _ _ (μseq n) g)) = (λ n , @lintegral α (borel(α)) (μseq n) f) , -- := by simp [eq_seq] ,
  { funext n ,
    exact eq_seq n , } ,
  rw ←eq' ,
  rw ←eq_seq' ,
  specialize cc_Rval g g_cont g_bdd ,
  exact lim_enn_of_lim_R cc_Rval ,
end

/-- The usual definition of weak convergence of probability measures is given in
terms of sequences of probability measures: it is the requirement that the integrals
of all continuous bounded functions against members of the sequence converge.
This characterization is shown in `weak_conv_seq_iff`. -/
theorem weak_conv_seq_iff {α : Type*} [topological_space α]
  {μseq : ℕ → borel_proba α} {μ : borel_proba α} :
    tendsto μseq at_top (𝓝 μ)
      ↔ ( ∀ (f : α → ℝ) , continuous f → bdd_Rval f →
          tendsto (λ n, (@integral α ℝ (borel(α)) _ _ _ _ _ _ (μseq(n)) f)) at_top (𝓝 (@integral α ℝ (borel(α)) _ _ _ _ _ _ μ f)) ) :=
begin
  split ,
  { intros weak_conv ,
    have key := weak_conv_seq_iff'.mp weak_conv ,
    have key' : portmanteau_continuous_ennval (λ n , (μseq(n) : @measure_theory.measure α (borel(α)))) μ ,
    { intros f f_cont f_bdd ,
      exact key ⟨ f , ⟨ f_cont , f_bdd ⟩ ⟩ , } ,
    exact portmanteau_continuous_equivalent_formulation' key' , } ,
  { intros h ,
    have key := portmanteau_continuous_equivalent_formulation'' h ,
    apply weak_conv_seq_iff'.mpr ,
    intros f ,
    exact key f.val f.prop.1 f.prop.2 , } ,
end

theorem weak_conv_seq_iff_portmanteau_continuous_Rval {α : Type*} [topological_space α]
  {μseq : ℕ → borel_proba α} {μ : borel_proba α} :
    tendsto μseq at_top (𝓝 μ)
      ↔ portmanteau_continuous_Rval (λ n , (μseq(n) : @measure_theory.measure α (borel(α)))) μ
        := weak_conv_seq_iff

theorem weak_conv_seq_iff_portmanteau_continuous_ennval {α : Type*} [topological_space α]
  {μseq : ℕ → borel_proba α} {μ : borel_proba α} :
    tendsto μseq at_top (𝓝 μ)
      ↔ portmanteau_continuous_ennval (λ n , (μseq(n) : @measure_theory.measure α (borel(α)))) μ :=
begin
  split ,
  { intros h ,
    exact portmanteau_continuous_equivalent_formulation'' (weak_conv_seq_iff_portmanteau_continuous_Rval.mp h) , } ,
  { intros h ,
    exact weak_conv_seq_iff_portmanteau_continuous_Rval.mpr (portmanteau_continuous_equivalent_formulation' h) , } ,
end

end portmanteau_integrals

end portmanteau


/-
Copyright (c) 2017 Daniel Selsam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Daniel Selsam

Dependently-typed vectors.

These are necessary to store multiple tensors of arbitrary shapes.
-/
import .util

inductive dvec {X : Type} (Y : X → Type) : list X → Type
| nil {}  : dvec []
| cons : Π {x : X}, Y x → Π {xs : list X}, dvec xs → dvec (x::xs)

namespace dvec
reserve infixr ` ::: `:67
notation h `:::` t  := cons h t

notation `⟦` l:(foldr `, ` (h t, cons h t) nil `⟧`) := l

def head {X : Type} {Y : X → Type} {x : X} {xs : list X} : dvec Y (x::xs) → Y x
| (cons y ys) := y

def tail {X : Type} {Y : X → Type} {x : X} {xs : list X} : dvec Y (x::xs) → dvec Y xs
| (cons y ys) := ys

def head2 {X : Type} {Y : X → Type} {x₁ x₂ : X} {xs : list X} : dvec Y (x₁::x₂::xs) → Y x₂
| (cons y₁ (cons y₂ ys)) := y₂

def head3 {X : Type} {Y : X → Type} {x₁ x₂ x₃ : X} {xs : list X} : dvec Y (x₁::x₂::x₃::xs) → Y x₃
| (cons y₁ (cons y₂ (cons y₃ ys))) := y₃

def get {X : Type} [decidable_eq X] {Y : X → Type} (x₀ : X) [inhabited (Y x₀)] : Π {xs : list X}, dvec Y xs → ℕ → Y x₀
| []      _           _     := default (Y x₀)
| (x::xs) (cons y ys) 0     := if H : x = x₀ then eq.rec_on H y else default (Y x₀)
| (x::xs) (cons y ys) (n+1) := get ys n

lemma singleton_congr {X : Type} {Y : X → Type} {x : X} (y₁ y₂ : Y x) : y₁ = y₂ → ⟦y₁⟧ = ⟦y₂⟧ := assume H, by rw H

lemma get₀_head {X : Type} [decidable_eq X] {Y : X → Type} (x₀ : X) [inhabited (Y x₀)] :
  ∀ {xs : list X} (ys : dvec Y (x₀::xs)), get x₀ ys 0 = head ys
| xs (y:::ys)   := begin dunfold head get, simp [dif_ctx_simp_congr, dif_pos] end

def update_at {X : Type} [decidable_eq X] {Y : X → Type} {x₀ : X} (y₀ : Y x₀) : Π {xs : list X} (ys : dvec Y xs) (idx : ℕ), dvec Y xs
| []      _                 _     := ⟦⟧
| (x::xs) (cons y ys) 0     := if H : x₀ = x then cons (eq.rec_on H y₀) ys else cons y ys
| (x::xs) (cons y ys) (n+1) := cons y (update_at ys n)

protected def to_string_aux {X : Type} {Y : X → Type} [∀ x, has_to_string (Y x)] : Π {xs : list X}, dvec Y xs → string
| [] _                  := "-------------"
| (x::xs) (cons y ys)  := to_string y ++ "\n" ++ to_string_aux ys

protected def to_string {X : Type} {Y : X → Type} [∀ x, has_to_string (Y x)] {xs : list X} (ys : dvec Y xs) : string :=
  "-------------\n" ++ dvec.to_string_aux ys

instance {X : Type} {Y : X → Type} [∀ x, has_to_string (Y x)] {xs : list X} : has_to_string (dvec Y xs) :=
⟨dvec.to_string⟩

attribute [simp] head tail head2 head3 get update_at

end dvec


/-
Copyright (c) 2020 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.dynamics.flow
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5

namespace Mathlib

/-!
# ω-limits

For a function `ϕ : τ → α → β` where `β` is a topological space, we
define the ω-limit under `ϕ` of a set `s` in `α` with respect to
filter `f` on `τ`: an element `y : β` is in the ω-limit of `s` if the
forward images of `s` intersect arbitrarily small neighbourhoods of
`y` frequently "in the direction of `f`".

In practice `ϕ` is often a continuous monoid-act, but the definition
requires only that `ϕ` has a coercion to the appropriate function
type. In the case where `τ` is `ℕ` or `ℝ` and `f` is `at_top`, we
recover the usual definition of the ω-limit set as the set of all `y`
such that there exist sequences `(tₙ)`, `(xₙ)` such that `ϕ tₙ xₙ ⟶ y`
as `n ⟶ ∞`.

## Notations

The `omega_limit` locale provides the localised notation `ω` for
`omega_limit`, as well as `ω⁺` and `ω⁻` for `omega_limit at_top` and
`omega_limit at_bot` respectively for when the acting monoid is
endowed with an order.
-/

/-!
### Definition and notation
-/

/-- The ω-limit of a set `s` under `ϕ` with respect to a filter `f` is
    ⋂ u ∈ f, cl (ϕ u s). -/
def omega_limit {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) : set β :=
  set.Inter fun (u : set τ) => set.Inter fun (H : u ∈ f) => closure (set.image2 ϕ u s)

/-!
### Elementary properties
-/

theorem omega_limit_def {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) : omega_limit f ϕ s = set.Inter fun (u : set τ) => set.Inter fun (H : u ∈ f) => closure (set.image2 ϕ u s) :=
  rfl

theorem omega_limit_subset_of_tendsto {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (ϕ : τ → α → β) (s : set α) {m : τ → τ} {f₁ : filter τ} {f₂ : filter τ} (hf : filter.tendsto m f₁ f₂) : omega_limit f₁ (fun (t : τ) (x : α) => ϕ (m t) x) s ⊆ omega_limit f₂ ϕ s := sorry

theorem omega_limit_mono_left {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (ϕ : τ → α → β) (s : set α) {f₁ : filter τ} {f₂ : filter τ} (hf : f₁ ≤ f₂) : omega_limit f₁ ϕ s ⊆ omega_limit f₂ ϕ s :=
  omega_limit_subset_of_tendsto ϕ s (filter.tendsto_id' hf)

theorem omega_limit_mono_right {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) {s₁ : set α} {s₂ : set α} (hs : s₁ ⊆ s₂) : omega_limit f ϕ s₁ ⊆ omega_limit f ϕ s₂ :=
  set.bInter_subset_bInter_right
    fun (u : set τ) (hu : u ∈ fun (u : set τ) => u ∈ filter.sets f) => closure_mono (set.image2_subset set.subset.rfl hs)

theorem is_closed_omega_limit {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) : is_closed (omega_limit f ϕ s) :=
  is_closed_Inter fun (u : set τ) => is_closed_Inter fun (hu : u ∈ f) => is_closed_closure

theorem maps_to_omega_limit' {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (s : set α) {α' : Type u_4} {β' : Type u_5} [topological_space β'] {f : filter τ} {ϕ : τ → α → β} {ϕ' : τ → α' → β'} {ga : α → α'} {s' : set α'} (hs : set.maps_to ga s s') {gb : β → β'} (hg : filter.eventually (fun (t : τ) => set.eq_on (gb ∘ ϕ t) (ϕ' t ∘ ga) s) f) (hgc : continuous gb) : set.maps_to gb (omega_limit f ϕ s) (omega_limit f ϕ' s') := sorry

theorem maps_to_omega_limit {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (s : set α) {α' : Type u_4} {β' : Type u_5} [topological_space β'] {f : filter τ} {ϕ : τ → α → β} {ϕ' : τ → α' → β'} {ga : α → α'} {s' : set α'} (hs : set.maps_to ga s s') {gb : β → β'} (hg : ∀ (t : τ) (x : α), gb (ϕ t x) = ϕ' t (ga x)) (hgc : continuous gb) : set.maps_to gb (omega_limit f ϕ s) (omega_limit f ϕ' s') :=
  maps_to_omega_limit' s hs (filter.eventually_of_forall fun (t : τ) (x : α) (hx : x ∈ s) => hg t x) hgc

theorem omega_limit_image_eq {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (s : set α) {α' : Type u_4} (ϕ : τ → α' → β) (f : filter τ) (g : α → α') : omega_limit f ϕ (g '' s) = omega_limit f (fun (t : τ) (x : α) => ϕ t (g x)) s := sorry

theorem omega_limit_preimage_subset {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] {α' : Type u_4} (ϕ : τ → α' → β) (s : set α') (f : filter τ) (g : α → α') : omega_limit f (fun (t : τ) (x : α) => ϕ t (g x)) (g ⁻¹' s) ⊆ omega_limit f ϕ s :=
  maps_to_omega_limit (g ⁻¹' s) (set.maps_to_preimage g s) (fun (t : τ) (x : α) => rfl) continuous_id

/-!
### Equivalent definitions of the omega limit

The next few lemmas are various versions of the property
characterising ω-limits:
-/

/-- An element `y` is in the ω-limit set of `s` w.r.t. `f` if the
    preimages of an arbitrary neighbourhood of `y` frequently
    (w.r.t. `f`) intersects of `s`. -/
theorem mem_omega_limit_iff_frequently {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) (y : β) : y ∈ omega_limit f ϕ s ↔ ∀ (n : set β), n ∈ nhds y → filter.frequently (fun (t : τ) => set.nonempty (s ∩ ϕ t ⁻¹' n)) f := sorry

/-- An element `y` is in the ω-limit set of `s` w.r.t. `f` if the
    forward images of `s` frequently (w.r.t. `f`) intersect arbitrary
    neighbourhoods of `y`. -/
theorem mem_omega_limit_iff_frequently₂ {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) (y : β) : y ∈ omega_limit f ϕ s ↔ ∀ (n : set β), n ∈ nhds y → filter.frequently (fun (t : τ) => set.nonempty (ϕ t '' s ∩ n)) f := sorry

/-- An element `y` is in the ω-limit of `x` w.r.t. `f` if the forward
    images of `x` frequently (w.r.t. `f`) falls within an arbitrary
    neighbourhood of `y`. -/
theorem mem_omega_limit_singleton_iff_map_cluster_point {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (x : α) (y : β) : y ∈ omega_limit f ϕ (singleton x) ↔ map_cluster_pt y f fun (t : τ) => ϕ t x := sorry

/-!
### Set operations and omega limits
-/

theorem omega_limit_inter {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s₁ : set α) (s₂ : set α) : omega_limit f ϕ (s₁ ∩ s₂) ⊆ omega_limit f ϕ s₁ ∩ omega_limit f ϕ s₂ :=
  set.subset_inter (omega_limit_mono_right f ϕ (set.inter_subset_left s₁ s₂))
    (omega_limit_mono_right f ϕ (set.inter_subset_right s₁ s₂))

theorem omega_limit_Inter {τ : Type u_1} {α : Type u_2} {β : Type u_3} {ι : Type u_4} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (p : ι → set α) : omega_limit f ϕ (set.Inter fun (i : ι) => p i) ⊆ set.Inter fun (i : ι) => omega_limit f ϕ (p i) :=
  set.subset_Inter fun (i : ι) => omega_limit_mono_right f ϕ (set.Inter_subset (fun (i : ι) => p i) i)

theorem omega_limit_union {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s₁ : set α) (s₂ : set α) : omega_limit f ϕ (s₁ ∪ s₂) = omega_limit f ϕ s₁ ∪ omega_limit f ϕ s₂ := sorry

theorem omega_limit_Union {τ : Type u_1} {α : Type u_2} {β : Type u_3} {ι : Type u_4} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (p : ι → set α) : (set.Union fun (i : ι) => omega_limit f ϕ (p i)) ⊆ omega_limit f ϕ (set.Union fun (i : ι) => p i) := sorry

/-!
Different expressions for omega limits, useful for rewrites. In
particular, one may restrict the intersection to sets in `f` which are
subsets of some set `v` also in `f`.
-/

theorem omega_limit_eq_Inter {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) : omega_limit f ϕ s = set.Inter fun (u : ↥(filter.sets f)) => closure (set.image2 ϕ (↑u) s) :=
  set.bInter_eq_Inter (fun (u : set τ) => u ∈ filter.sets f) fun (u : set τ) (H : u ∈ f) => closure (set.image2 ϕ u s)

theorem omega_limit_eq_bInter_inter {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) {v : set τ} (hv : v ∈ f) : omega_limit f ϕ s = set.Inter fun (u : set τ) => set.Inter fun (H : u ∈ f) => closure (set.image2 ϕ (u ∩ v) s) := sorry

theorem omega_limit_eq_Inter_inter {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) {v : set τ} (hv : v ∈ f) : omega_limit f ϕ s = set.Inter fun (u : ↥(filter.sets f)) => closure (set.image2 ϕ (↑u ∩ v) s) := sorry

theorem omega_limit_subset_closure_fw_image {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) {u : set τ} (hu : u ∈ f) : omega_limit f ϕ s ⊆ closure (set.image2 ϕ u s) := sorry

/-!
### `ω-limits and compactness
-/

/-- A set is eventually carried into any open neighbourhood of its ω-limit:
if `c` is a compact set such that `closure {ϕ t x | t ∈ v, x ∈ s} ⊆ c` for some `v ∈ f`
and `n` is an open neighbourhood of `ω f ϕ s`, then for some `u ∈ f` we have
`closure {ϕ t x | t ∈ u, x ∈ s} ⊆ n`. -/
theorem eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset' {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) {c : set β} (hc₁ : is_compact c) (hc₂ : ∃ (v : set τ), ∃ (H : v ∈ f), closure (set.image2 ϕ v s) ⊆ c) {n : set β} (hn₁ : is_open n) (hn₂ : omega_limit f ϕ s ⊆ n) : ∃ (u : set τ), ∃ (H : u ∈ f), closure (set.image2 ϕ u s) ⊆ n := sorry

/-- A set is eventually carried into any open neighbourhood of its ω-limit:
if `c` is a compact set such that `closure {ϕ t x | t ∈ v, x ∈ s} ⊆ c` for some `v ∈ f`
and `n` is an open neighbourhood of `ω f ϕ s`, then for some `u ∈ f` we have
`closure {ϕ t x | t ∈ u, x ∈ s} ⊆ n`. -/
theorem eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) [t2_space β] {c : set β} (hc₁ : is_compact c) (hc₂ : filter.eventually (fun (t : τ) => set.maps_to (ϕ t) s c) f) {n : set β} (hn₁ : is_open n) (hn₂ : omega_limit f ϕ s ⊆ n) : ∃ (u : set τ), ∃ (H : u ∈ f), closure (set.image2 ϕ u s) ⊆ n := sorry

theorem eventually_maps_to_of_is_compact_absorbing_of_is_open_of_omega_limit_subset {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) [t2_space β] {c : set β} (hc₁ : is_compact c) (hc₂ : filter.eventually (fun (t : τ) => set.maps_to (ϕ t) s c) f) {n : set β} (hn₁ : is_open n) (hn₂ : omega_limit f ϕ s ⊆ n) : filter.eventually (fun (t : τ) => set.maps_to (ϕ t) s n) f := sorry

theorem eventually_closure_subset_of_is_open_of_omega_limit_subset {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) [compact_space β] {v : set β} (hv₁ : is_open v) (hv₂ : omega_limit f ϕ s ⊆ v) : ∃ (u : set τ), ∃ (H : u ∈ f), closure (set.image2 ϕ u s) ⊆ v :=
  eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset' f ϕ s compact_univ
    (Exists.intro set.univ (Exists.intro filter.univ_mem_sets (set.subset_univ (closure (set.image2 ϕ set.univ s))))) hv₁
    hv₂

theorem eventually_maps_to_of_is_open_of_omega_limit_subset {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) [compact_space β] {v : set β} (hv₁ : is_open v) (hv₂ : omega_limit f ϕ s ⊆ v) : filter.eventually (fun (t : τ) => set.maps_to (ϕ t) s v) f := sorry

/-- The ω-limit of a nonempty set w.r.t. a nontrivial filter is nonempty. -/
theorem nonempty_omega_limit_of_is_compact_absorbing {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) [filter.ne_bot f] {c : set β} (hc₁ : is_compact c) (hc₂ : ∃ (v : set τ), ∃ (H : v ∈ f), closure (set.image2 ϕ v s) ⊆ c) (hs : set.nonempty s) : set.nonempty (omega_limit f ϕ s) := sorry

theorem nonempty_omega_limit {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) [compact_space β] [filter.ne_bot f] (hs : set.nonempty s) : set.nonempty (omega_limit f ϕ s) :=
  nonempty_omega_limit_of_is_compact_absorbing f ϕ s compact_univ
    (Exists.intro set.univ (Exists.intro filter.univ_mem_sets (set.subset_univ (closure (set.image2 ϕ set.univ s))))) hs

/-!
### ω-limits of Flows by a Monoid
-/

namespace flow

theorem is_invariant_omega_limit {τ : Type u_1} [topological_space τ] [add_monoid τ] [has_continuous_add τ] {α : Type u_2} [topological_space α] (f : filter τ) (ϕ : flow τ α) (s : set α) (hf : ∀ (t : τ), filter.tendsto (Add.add t) f f) : is_invariant (⇑ϕ) (omega_limit f (⇑ϕ) s) := sorry

theorem omega_limit_image_subset {τ : Type u_1} [topological_space τ] [add_monoid τ] [has_continuous_add τ] {α : Type u_2} [topological_space α] (f : filter τ) (ϕ : flow τ α) (s : set α) (t : τ) (ht : filter.tendsto (fun (_x : τ) => _x + t) f f) : omega_limit f (⇑ϕ) (coe_fn ϕ t '' s) ⊆ omega_limit f (⇑ϕ) s := sorry

end flow

/-!
### ω-limits of Flows by a Group
-/

namespace flow

/-- the ω-limit of a forward image of `s` is the same as the ω-limit of `s`. -/
@[simp] theorem omega_limit_image_eq {τ : Type u_1} [topological_space τ] [add_comm_group τ] [topological_add_group τ] {α : Type u_2} [topological_space α] (f : filter τ) (ϕ : flow τ α) (s : set α) (hf : ∀ (t : τ), filter.tendsto (fun (_x : τ) => _x + t) f f) (t : τ) : omega_limit f (⇑ϕ) (coe_fn ϕ t '' s) = omega_limit f (⇑ϕ) s := sorry

theorem omega_limit_omega_limit {τ : Type u_1} [topological_space τ] [add_comm_group τ] [topological_add_group τ] {α : Type u_2} [topological_space α] (f : filter τ) (ϕ : flow τ α) (s : set α) (hf : ∀ (t : τ), filter.tendsto (Add.add t) f f) : omega_limit f (⇑ϕ) (omega_limit f (⇑ϕ) s) ⊆ omega_limit f (⇑ϕ) s := sorry