/-
Copyright (c) 2015 Haitao Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Author : Haitao Zhang
-/
import data

open nat function eq.ops

namespace list
-- this is in preparation for counting the number of finite functions
section list_of_lists
open prod
variable {A : Type}

definition cons_pair (pr : A × list A) := (pr1 pr) :: (pr2 pr)

definition cons_all_of (elts : list A) (ls : list (list A)) : list (list A) :=
           map cons_pair (product elts ls)

lemma pair_of_cons {a} {l} {pr : A × list A} : cons_pair pr = a::l → pr = (a, l) :=
      prod.destruct pr (λ p1 p2, assume Peq, list.no_confusion Peq (by intros; substvars))

lemma cons_pair_inj : injective (@cons_pair A) :=
      take p1 p2, assume Pl,
      prod.eq (list.no_confusion Pl (λ P1 P2, P1)) (list.no_confusion Pl (λ P1 P2, P2))

lemma nodup_of_cons_all {elts : list A} {ls : list (list A)}
      : nodup elts → nodup ls → nodup (cons_all_of elts ls) :=
      assume Pelts Pls,
      nodup_map cons_pair_inj (nodup_product Pelts Pls)

lemma length_cons_all {elts : list A} {ls : list (list A)} :
      length (cons_all_of elts ls) = length elts * length ls := calc
      length (cons_all_of elts ls) = length (product elts ls) : length_map
                               ... = length elts * length ls : length_product

variable [finA : fintype A]
include finA

definition all_lists_of_len : ∀ (n : nat), list (list A)
| 0        := [[]]
| (succ n) := cons_all_of (elements_of A) (all_lists_of_len n)

definition all_nodups_of_len [deceqA : decidable_eq A] (n : nat) : list (list A) :=
           filter nodup (all_lists_of_len n)

lemma nodup_all_lists : ∀ {n : nat}, nodup (@all_lists_of_len A _ n)
| 0                   := nodup_singleton []
| (succ n)            := nodup_of_cons_all (fintype.unique A) nodup_all_lists

lemma nodup_all_nodups [deceqA : decidable_eq A] {n : nat} :
      nodup (@all_nodups_of_len A _ _ n) :=
      nodup_filter nodup nodup_all_lists

lemma mem_all_lists : ∀ {n : nat} {l : list A}, length l = n → l ∈ all_lists_of_len n
| 0 []              := assume P, mem_cons [] []
| 0 (a::l)          := assume Peq, by contradiction
| (succ n) []       := assume Peq, by contradiction
| (succ n) (a::l)   := assume Peq, begin
                    apply mem_map, apply mem_product,
                      exact fintype.complete a,
                      exact mem_all_lists (succ.inj Peq)
                    end

lemma mem_all_nodups [deceqA : decidable_eq A] (n : nat) (l : list A) :
      length l = n → nodup l → l ∈ all_nodups_of_len n :=
      assume Pl Pn, mem_filter_of_mem (mem_all_lists Pl) Pn

lemma nodup_mem_all_nodups [deceqA : decidable_eq A] {n : nat} ⦃l : list A⦄ :
      l ∈ all_nodups_of_len n → nodup l :=
      assume Pl, of_mem_filter Pl

lemma length_mem_all_lists : ∀ {n : nat} ⦃l : list A⦄,
                           l ∈ all_lists_of_len n → length l = n
| 0 []             := assume P, rfl
| 0 (a::l)         := assume Pin, have Peq : (a::l) = [], from mem_singleton Pin,
                   by contradiction
| (succ n) []      := assume Pin, obtain pr Pprin Ppr, from exists_of_mem_map Pin,
                   by contradiction
| (succ n) (a::l)  := assume Pin, obtain pr Pprin Ppr, from exists_of_mem_map Pin,
                   have Pl : l ∈ all_lists_of_len n,
                     from mem_of_mem_product_right ((pair_of_cons Ppr) ▸ Pprin),
                   by rewrite [length_cons, length_mem_all_lists Pl]

lemma length_mem_all_nodups [deceqA : decidable_eq A] {n : nat} ⦃l : list A⦄ :
      l ∈ all_nodups_of_len n → length l = n :=
      assume Pl, length_mem_all_lists (mem_of_mem_filter Pl)

open fintype
lemma length_all_lists : ∀ {n : nat}, length (@all_lists_of_len A _ n) = (card A) ^ n
| 0         := calc length [[]] = 1 : length_cons
| (succ n)  := calc length _ = card A * length (all_lists_of_len n) : length_cons_all
                         ... = card A * (card A ^ n) : length_all_lists
                         ... = (card A ^ n) * card A : mul.comm
                         ... = (card A) ^ (succ n) : pow_succ'

end list_of_lists

section kth

variable {A : Type}

definition kth : ∀ k (l : list A), k < length l → A
| k []        := begin rewrite length_nil, intro Pltz, exact absurd Pltz !not_lt_zero end
| 0 (a::l)    := λ P, a
| (k+1) (a::l):= by rewrite length_cons; intro Plt; exact kth k l (lt_of_succ_lt_succ Plt)

lemma kth_zero_of_cons {a} (l : list A) (P : 0 < length (a::l)) : kth 0 (a::l) P = a :=
      rfl
lemma kth_succ_of_cons {a} k (l : list A) (P : k+1 < length (a::l)) :
      kth (succ k) (a::l) P = kth k l (lt_of_succ_lt_succ P) :=
      rfl

lemma kth_mem : ∀ {k : nat} {l : list A} P, kth k l P ∈ l
| k []            := assume P, absurd P !not_lt_zero
| 0 (a::l)        := assume P, by rewrite kth_zero_of_cons; apply mem_cons
| (succ k) (a::l) := assume P, by
                  rewrite [kth_succ_of_cons]; apply mem_cons_of_mem a; apply kth_mem

-- Leo provided the following proof.
lemma eq_of_kth_eq [deceqA : decidable_eq A]
      : ∀ {l1 l2 : list A} (Pleq : length l1 = length l2),
          (∀ (k : nat) (Plt1 : k < length l1) (Plt2 : k < length l2), kth k l1 Plt1 = kth k l2 Plt2) → l1 = l2
| []       []       h₁ h₂ := rfl
| (a₁::l₁) []       h₁ h₂ := by contradiction
| []       (a₂::l₂) h₁ h₂ := by contradiction
| (a₁::l₁) (a₂::l₂) h₁ h₂ :=
  have ih₁ : length l₁ = length l₂, by injection h₁; eassumption,
  have ih₂ : ∀ (k : nat) (plt₁ : k < length l₁) (plt₂ : k < length l₂), kth k l₁ plt₁ = kth k l₂ plt₂,
    begin
      intro k plt₁ plt₂,
      have splt₁ : succ k < length l₁ + 1, from succ_le_succ plt₁,
      have splt₂ : succ k < length l₂ + 1, from succ_le_succ plt₂,
      have keq   : kth (succ k) (a₁::l₁) splt₁ = kth (succ k) (a₂::l₂) splt₂, from h₂ (succ k) splt₁ splt₂,
      rewrite *kth_succ_of_cons at keq,
      exact keq
    end,
  have ih  : l₁ = l₂, from eq_of_kth_eq ih₁ ih₂,
  have k₁  : a₁ = a₂,
    begin
      have lt₁ : 0 < length (a₁::l₁), from !zero_lt_succ,
      have lt₂ : 0 < length (a₂::l₂), from !zero_lt_succ,
      have e₁  : kth 0 (a₁::l₁) lt₁ = kth 0 (a₂::l₂) lt₂, from h₂ 0 lt₁ lt₂,
      rewrite *kth_zero_of_cons at e₁,
      assumption
    end,
  by subst l₁; subst a₁

lemma kth_of_map {B : Type} {f : A → B} :
      ∀ {k : nat} {l : list A} Plt Pmlt, kth k (map f l) Pmlt = f (kth k l Plt)
| k []            := assume P, absurd P !not_lt_zero
| 0 (a::l)        := assume Plt, by
                  rewrite [map_cons]; intro Pmlt; rewrite [kth_zero_of_cons]
| (succ k) (a::l) := assume P, begin
                  rewrite [map_cons], intro Pmlt, rewrite [*kth_succ_of_cons],
                  apply kth_of_map
                  end

lemma kth_find [deceqA : decidable_eq A] :
      ∀ {l : list A} {a} P, kth (find a l) l P = a
| []            := take a, assume P, absurd P !not_lt_zero
| (x::l)        := take a, begin
                have Pd : decidable (a = x), begin apply deceqA end,
                cases Pd with Pe Pne,
                  rewrite [find_cons_of_eq l Pe], intro P, rewrite [kth_zero_of_cons, Pe],
                  rewrite [find_cons_of_ne l Pne], intro P, rewrite [kth_succ_of_cons],
                  apply kth_find
                end

lemma find_kth [deceqA : decidable_eq A] :
      ∀ {k : nat} {l : list A} P, find (kth k l P) l < length l
| k []            := assume P, absurd P !not_lt_zero
| 0 (a::l)        := assume P, begin
                  rewrite [kth_zero_of_cons, find_cons_of_eq l rfl, length_cons],
                  exact !zero_lt_succ
                  end
| (succ k) (a::l) := assume P, begin
                  rewrite [kth_succ_of_cons],
                  have Pd : decidable ((kth k l (lt_of_succ_lt_succ P)) = a),
                    begin apply deceqA end,
                  cases Pd with Pe Pne,
                    rewrite [find_cons_of_eq l Pe], apply zero_lt_succ,
                    rewrite [find_cons_of_ne l Pne], apply succ_lt_succ, apply find_kth
                  end

lemma find_kth_of_nodup [deceqA : decidable_eq A] :
      ∀ {k : nat} {l : list A} P, nodup l → find (kth k l P) l = k
| k []            := assume P, absurd P !not_lt_zero
| 0 (a::l)        := assume Plt Pnodup,
                  by rewrite [kth_zero_of_cons, find_cons_of_eq l rfl]
| (succ k) (a::l) := assume Plt Pnodup, begin
                  rewrite [kth_succ_of_cons],
                  have Pd : decidable ((kth k l (lt_of_succ_lt_succ Plt)) = a),
                    begin apply deceqA end,
                  cases Pd with Pe Pne,
                    have Pin : a ∈ l, begin rewrite -Pe, apply kth_mem end,
                    exact absurd Pin (not_mem_of_nodup_cons Pnodup),
                    rewrite [find_cons_of_ne l Pne], apply congr (eq.refl succ),
                    apply find_kth_of_nodup (lt_of_succ_lt_succ Plt) (nodup_of_nodup_cons Pnodup)
                  end

end kth

end list

namespace fintype
open list

section found

variables {A B : Type}
variable [finA : fintype A]
include finA

lemma find_in_range [deceqB : decidable_eq B] {f : A → B} (b : B) :
    ∀ (l : list A) P, f (kth (find b (map f l)) l P) = b
| []       := assume P, begin exact absurd P !not_lt_zero end
| (a::l)   := decidable.rec_on (deceqB b (f a))
              (assume Peq, begin
              rewrite [map_cons f a l, find_cons_of_eq _ Peq],
              intro P, rewrite [kth_zero_of_cons], exact (Peq⁻¹)
              end)
              (assume Pne, begin
              rewrite [map_cons f a l, find_cons_of_ne _ Pne],
              intro P,
              rewrite [kth_succ_of_cons (find b (map f l)) l P],
              exact find_in_range l (lt_of_succ_lt_succ P)
              end)

end found

section list_to_fun
variables {A B : Type}
variable [finA : fintype A]
include finA

definition fun_to_list (f : A → B) : list B := map f (elems A)

lemma length_map_of_fintype (f : A → B) : length (map f (elems A)) = card A :=
      by apply length_map

variable [deceqA : decidable_eq A]
include deceqA

lemma fintype_find (a : A) : find a (elems A) < card A :=
      find_lt_length (complete a)

definition list_to_fun (l : list B) (leq : length l = card A) : A → B :=
           take x,
           kth _ _ (leq⁻¹ ▸ fintype_find x)

definition all_funs [finB : fintype B] : list (A → B) :=
           dmap (λ l, length l = card A) list_to_fun (all_lists_of_len (card A))

lemma list_to_fun_apply (l : list B) (leq : length l = card A) (a : A) :
      ∀ P, list_to_fun l leq a = kth (find a (elems A)) l P :=
      assume P, rfl

variable [deceqB : decidable_eq B]
include deceqB

lemma fun_eq_list_to_fun_map (f : A → B) : ∀ P, f = list_to_fun (map f (elems A)) P :=
      assume Pleq, funext (take a,
      have Plt : _, from Pleq⁻¹ ▸ find_lt_length (complete a), begin
      rewrite [list_to_fun_apply _ Pleq a (Pleq⁻¹ ▸ find_lt_length (complete a))],
      have Pmlt : find a (elems A) < length (map f (elems A)),
        begin rewrite length_map, exact Plt end,
      rewrite [@kth_of_map A B f (find a (elems A)) (elems A) Plt _, kth_find]
      end)

lemma list_eq_map_list_to_fun  (l : list B) (leq : length l = card A)
                    : l = map (list_to_fun l leq) (elems A) :=
      begin
      apply eq_of_kth_eq, rewrite length_map, apply leq,
        intro k Plt Plt2,
        have Plt1 : k < length (elems A), begin apply leq ▸ Plt end,
        have Plt3 : find (kth k (elems A) Plt1) (elems A) < length l,
           begin rewrite leq, apply find_kth end,
        rewrite [kth_of_map Plt1 Plt2, list_to_fun_apply l leq _ Plt3],
        congruence,
        rewrite [find_kth_of_nodup Plt1 (unique A)]
      end

lemma fun_to_list_to_fun (f : A → B) : ∀ P, list_to_fun (fun_to_list f) P = f :=
      assume P, (fun_eq_list_to_fun_map f P)⁻¹

lemma list_to_fun_to_list (l : list B) (leq : length l = card A) :
      fun_to_list (list_to_fun l leq) = l
      := (list_eq_map_list_to_fun l leq)⁻¹

lemma dinj_list_to_fun : dinj (λ (l : list B), length l = card A) list_to_fun :=
      take l1 l2 Pl1 Pl2 Peq,
      by rewrite [list_eq_map_list_to_fun l1 Pl1, list_eq_map_list_to_fun l2 Pl2, Peq]

variable [finB : fintype B]
include finB

lemma nodup_all_funs : nodup (@all_funs A B _ _ _) :=
      dmap_nodup_of_dinj dinj_list_to_fun nodup_all_lists

lemma all_funs_complete (f : A → B) : f ∈ all_funs :=
      have Plin : map f (elems A) ∈ all_lists_of_len (card A),
        from mem_all_lists (by rewrite length_map),
      have Plfin : list_to_fun (map f (elems A)) (length_map_of_fintype f) ∈ all_funs,
        from mem_dmap _ Plin,
      begin rewrite [fun_eq_list_to_fun_map f (length_map_of_fintype f)], apply Plfin end

lemma all_funs_to_all_lists :
      map fun_to_list (@all_funs A B _ _ _) = all_lists_of_len (card A) :=
      map_dmap_of_inv_of_pos list_to_fun_to_list length_mem_all_lists

lemma length_all_funs : length (@all_funs A B _ _ _) = (card B) ^ (card A) := calc
      length _ = length (map fun_to_list all_funs) : length_map
           ... = length (all_lists_of_len (card A)) : all_funs_to_all_lists
           ... = (card B) ^ (card A) : length_all_lists

definition fun_is_fintype [instance] : fintype (A → B) :=
           fintype.mk all_funs nodup_all_funs all_funs_complete

lemma card_funs : card (A → B) = (card B) ^ (card A) := length_all_funs

end list_to_fun

section surj_inv
variables {A B : Type}
variable [finA : fintype A]
include finA

-- surj from fintype domain implies fintype range
lemma mem_map_of_surj {f : A → B} (surj : surjective f) : ∀ b, b ∈ map f (elems A) :=
      take b, obtain a Peq, from surj b,
      Peq ▸ mem_map f (complete a)

variable [deceqB : decidable_eq B]
include deceqB

lemma found_of_surj {f : A → B} (surj : surjective f) :
      ∀ b, let elts := elems A, k := find b (map f elts) in k < length elts :=
      λ b, let elts := elems A, img := map f elts, k := find b img in
           have Pin : b ∈ img, from mem_map_of_surj surj b,
           have Pfound : k < length img, from find_lt_length (mem_map_of_surj surj b),
           length_map f elts ▸ Pfound

definition right_inv {f : A → B} (surj : surjective f) : B → A :=
           λ b, let elts := elems A, k := find b (map f elts) in
           kth k elts (found_of_surj surj b)

lemma right_inv_of_surj {f : A → B} (surj : surjective f) : f ∘ (right_inv surj) = id :=
      funext (λ b, find_in_range b (elems A) (found_of_surj surj b))
end surj_inv

-- inj functions for equal card types are also surj and therefore bij
-- the right inv (since it is surj) is also the left inv
section inj
open finset

variables {A B : Type}
variable [finA : fintype A]
include finA
variable [deceqA : decidable_eq A]
include deceqA

lemma inj_of_card_image_eq [deceqB : decidable_eq B] {f : A → B} :
      finset.card (image f univ) = card A → injective f :=
      assume Peq, by
      rewrite [set.injective_iff_inj_on_univ, -to_set_univ];
      apply inj_on_of_card_image_eq Peq

variable [deceqB : decidable_eq B]
include deceqB

lemma nodup_of_inj {f : A → B} : injective f → nodup (map f (elems A)) :=
      assume Pinj, nodup_map Pinj (unique A)

lemma inj_of_nodup {f : A → B} :
      nodup (map f (elems A)) → injective f :=
      assume Pnodup, inj_of_card_image_eq (calc
        finset.card (image f univ) = finset.card (to_finset (map f (elems A))) : rfl
                               ... = finset.card (to_finset_of_nodup (map f (elems A)) Pnodup) : {(to_finset_eq_of_nodup Pnodup)⁻¹}
                               ... = length (map f (elems A)) : rfl
                               ... = length (elems A) : length_map
                               ... = card A : rfl)

variable [finB : fintype B]
include finB

lemma surj_of_inj_eq_card : card A = card B → ∀ {f : A → B}, injective f → surjective f :=
assume Peqcard, take f, assume Pinj,
decidable.rec_on decidable_forall_finite
  (assume P : surjective f, P)
  (assume Pnsurj : ¬surjective f,
   obtain b Pne, from exists_not_of_not_forall Pnsurj,
   have Pall : ∀ a, f a ≠ b, from forall_not_of_not_exists Pne,
   have Pbnin : b ∉ image f univ, from λ Pin,
   obtain a Pa, from exists_of_mem_image Pin, absurd (and.right Pa) (Pall a),
   have Puniv : finset.card (image f univ) = card A, from card_eq_card_image_of_inj Pinj,
   have Punivb : finset.card (image f univ) = card B, from eq.trans Puniv Peqcard,
   have P : image f univ = univ, from univ_of_card_eq_univ Punivb,
   absurd (P⁻¹▸ mem_univ b) Pbnin)

end inj

section perm

definition all_injs (A : Type) [finA : fintype A] [deceqA : decidable_eq A] : list (A → A) :=
           dmap (λ l, length l = card A) list_to_fun (all_nodups_of_len (card A))

variable {A : Type}
variable [finA : fintype A]
include finA
variable [deceqA : decidable_eq A]
include deceqA

lemma nodup_all_injs : nodup (all_injs A) :=
      dmap_nodup_of_dinj dinj_list_to_fun nodup_all_nodups

lemma all_injs_complete {f : A → A} : injective f → f ∈ (all_injs A) :=
      assume Pinj,
      have Plin : map f (elems A) ∈ all_nodups_of_len (card A),
        from begin apply mem_all_nodups, apply length_map, apply nodup_of_inj Pinj end,
      have Plfin : list_to_fun (map f (elems A)) (length_map_of_fintype f) ∈ !all_injs,
        from mem_dmap _ Plin,
      begin rewrite [fun_eq_list_to_fun_map f (length_map_of_fintype f)], apply Plfin end

open finset

lemma univ_of_leq_univ_of_nodup {l : list A} (n : nodup l) (leq : length l = card A) :
      to_finset_of_nodup l n = univ :=
       univ_of_card_eq_univ (calc
        finset.card (to_finset_of_nodup l n) = length l : rfl
                                         ... = card A : leq)

lemma inj_of_mem_all_injs {f : A → A} : f ∈ (all_injs A) → injective f :=
      assume Pfin, obtain l Pex, from exists_of_mem_dmap Pfin,
      obtain leq Pin Peq, from Pex,
      have Pmap : map f (elems A) = l, from Peq⁻¹ ▸ list_to_fun_to_list l leq,
      begin apply inj_of_nodup, rewrite Pmap, apply nodup_mem_all_nodups Pin end

lemma perm_of_inj {f : A → A} : injective f → perm (map f (elems A)) (elems A) :=
      assume Pinj,
      have P1 : univ = to_finset_of_nodup (elems A) (unique A), from rfl,
      have P2 : to_finset_of_nodup (map f (elems A)) (nodup_of_inj Pinj) = univ,
        from univ_of_leq_univ_of_nodup _ !length_map,
      quot.exact (P1 ▸ P2)

end perm

end fintype


mutual
  @[simp] def isEven : Nat → Bool
    | 0 => true
    | n+1 => isOdd n
  @[simp] def isOdd : Nat → Bool
    | 0 => false
    | n+1 => isEven n
end
termination_by' measure fun
  | PSum.inl n => n
  | PSum.inr n => n
decreasing_by apply Nat.lt_succ_self

theorem isEven_double (x : Nat) : isEven (2 * x) = true := by
  induction x with
  | zero => simp
  | succ x ih => simp [Nat.mul_succ, Nat.add_succ, ih]

def f (x : Nat) : Nat :=
  match x with
  | 0 => 1
  | x + 1 => f x * 2
termination_by' measure id
decreasing_by apply Nat.lt_succ_self

attribute [simp] f

theorem f_succ (x : Nat) : f (x+1) = f x * 2 := by
  simp

theorem f_succ₂ (x : Nat) : f (x+1) = f x * 2 := by
  simp [-f]
  simp

attribute [-simp] f

theorem f_succ₃ (x : Nat) : f (x+1) = f x * 2 := by
  simp
  simp [f]


/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Johannes Hölzl, Rémy Degenne
-/
import order.filter.cofinite

/-!
# liminfs and limsups of functions and filters

Defines the Liminf/Limsup of a function taking values in a conditionally complete lattice, with
respect to an arbitrary filter.

We define `f.Limsup` (`f.Liminf`) where `f` is a filter taking values in a conditionally complete
lattice. `f.Limsup` is the smallest element `a` such that, eventually, `u ≤ a` (and vice versa for
`f.Liminf`). To work with the Limsup along a function `u` use `(f.map u).Limsup`.

Usually, one defines the Limsup as `Inf (Sup s)` where the Inf is taken over all sets in the filter.
For instance, in ℕ along a function `u`, this is `Inf_n (Sup_{k ≥ n} u k)` (and the latter quantity
decreases with `n`, so this is in fact a limit.). There is however a difficulty: it is well possible
that `u` is not bounded on the whole space, only eventually (think of `Limsup (λx, 1/x)` on ℝ. Then
there is no guarantee that the quantity above really decreases (the value of the `Sup` beforehand is
not really well defined, as one can not use ∞), so that the Inf could be anything. So one can not
use this `Inf Sup ...` definition in conditionally complete lattices, and one has to use a less
tractable definition.

In conditionally complete lattices, the definition is only useful for filters which are eventually
bounded above (otherwise, the Limsup would morally be +∞, which does not belong to the space) and
which are frequently bounded below (otherwise, the Limsup would morally be -∞, which is not in the
space either). We start with definitions of these concepts for arbitrary filters, before turning to
the definitions of Limsup and Liminf.

In complete lattices, however, it coincides with the `Inf Sup` definition.
-/

open filter set
open_locale filter

variables {α β γ ι : Type*}
namespace filter

section relation

/-- `f.is_bounded (≺)`: the filter `f` is eventually bounded w.r.t. the relation `≺`, i.e.
eventually, it is bounded by some uniform bound.
`r` will be usually instantiated with `≤` or `≥`. -/
def is_bounded (r : α → α → Prop) (f : filter α) := ∃ b, ∀ᶠ x in f, r x b

/-- `f.is_bounded_under (≺) u`: the image of the filter `f` under `u` is eventually bounded w.r.t.
the relation `≺`, i.e. eventually, it is bounded by some uniform bound. -/
def is_bounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (f.map u).is_bounded r

variables {r : α → α → Prop} {f g : filter α}

/-- `f` is eventually bounded if and only if, there exists an admissible set on which it is
bounded. -/
lemma is_bounded_iff : f.is_bounded r ↔ (∃s∈f.sets, ∃b, s ⊆ {x | r x b}) :=
iff.intro
  (assume ⟨b, hb⟩, ⟨{a | r a b}, hb, b, subset.refl _⟩)
  (assume ⟨s, hs, b, hb⟩, ⟨b, mem_of_superset hs hb⟩)

/-- A bounded function `u` is in particular eventually bounded. -/
lemma is_bounded_under_of {f : filter β} {u : β → α} :
  (∃b, ∀x, r (u x) b) → f.is_bounded_under r u
| ⟨b, hb⟩ := ⟨b, show ∀ᶠ x in f, r (u x) b, from eventually_of_forall hb⟩

lemma is_bounded_bot : is_bounded r ⊥ ↔ nonempty α :=
by simp [is_bounded, exists_true_iff_nonempty]

lemma is_bounded_top : is_bounded r ⊤ ↔ (∃t, ∀x, r x t) :=
by simp [is_bounded, eq_univ_iff_forall]

lemma is_bounded_principal (s : set α) : is_bounded r (𝓟 s) ↔ (∃t, ∀x∈s, r x t) :=
by simp [is_bounded, subset_def]

lemma is_bounded_sup [is_trans α r] (hr : ∀b₁ b₂, ∃b, r b₁ b ∧ r b₂ b) :
  is_bounded r f → is_bounded r g → is_bounded r (f ⊔ g)
| ⟨b₁, h₁⟩ ⟨b₂, h₂⟩ := let ⟨b, rb₁b, rb₂b⟩ := hr b₁ b₂ in
  ⟨b, eventually_sup.mpr ⟨h₁.mono (λ x h, trans h rb₁b), h₂.mono (λ x h, trans h rb₂b)⟩⟩

lemma is_bounded.mono (h : f ≤ g) : is_bounded r g → is_bounded r f
| ⟨b, hb⟩ := ⟨b, h hb⟩

lemma is_bounded_under.mono {f g : filter β} {u : β → α} (h : f ≤ g) :
  g.is_bounded_under r u → f.is_bounded_under r u :=
λ hg, hg.mono (map_mono h)

lemma is_bounded_under.mono_le [preorder β] {l : filter α} {u v : α → β}
  (hu : is_bounded_under (≤) l u) (hv : v ≤ᶠ[l] u) : is_bounded_under (≤) l v :=
hu.imp $ λ b hb, (eventually_map.1 hb).mp $ hv.mono $ λ x, le_trans

lemma is_bounded_under.mono_ge [preorder β] {l : filter α} {u v : α → β}
  (hu : is_bounded_under (≥) l u) (hv : u ≤ᶠ[l] v) : is_bounded_under (≥) l v :=
@is_bounded_under.mono_le α βᵒᵈ _ _ _ _ hu hv

lemma is_bounded.is_bounded_under {q : β → β → Prop} {u : α → β}
  (hf : ∀a₀ a₁, r a₀ a₁ → q (u a₀) (u a₁)) : f.is_bounded r → f.is_bounded_under q u
| ⟨b, h⟩ := ⟨u b, show ∀ᶠ x in f, q (u x) (u b), from h.mono (λ x, hf x b)⟩

lemma not_is_bounded_under_of_tendsto_at_top [preorder β] [no_max_order β] {f : α → β}
  {l : filter α} [l.ne_bot] (hf : tendsto f l at_top) :
  ¬ is_bounded_under (≤) l f :=
begin
  rintro ⟨b, hb⟩,
  rw eventually_map at hb,
  obtain ⟨b', h⟩ := exists_gt b,
  have hb' := (tendsto_at_top.mp hf) b',
  have : {x : α | f x ≤ b} ∩ {x : α | b' ≤ f x} = ∅ :=
    eq_empty_of_subset_empty (λ x hx, (not_le_of_lt h) (le_trans hx.2 hx.1)),
  exact (nonempty_of_mem (hb.and hb')).ne_empty this
end

lemma not_is_bounded_under_of_tendsto_at_bot [preorder β] [no_min_order β] {f : α → β}
  {l : filter α} [l.ne_bot](hf : tendsto f l at_bot) :
  ¬ is_bounded_under (≥) l f :=
@not_is_bounded_under_of_tendsto_at_top α βᵒᵈ _ _ _ _ _ hf

lemma is_bounded_under.bdd_above_range_of_cofinite [semilattice_sup β] {f : α → β}
  (hf : is_bounded_under (≤) cofinite f) : bdd_above (range f) :=
begin
  rcases hf with ⟨b, hb⟩,
  haveI : nonempty β := ⟨b⟩,
  rw [← image_univ, ← union_compl_self {x | f x ≤ b}, image_union, bdd_above_union],
  exact ⟨⟨b, ball_image_iff.2 $ λ x, id⟩, (hb.image f).bdd_above⟩
end

lemma is_bounded_under.bdd_below_range_of_cofinite [semilattice_inf β] {f : α → β}
  (hf : is_bounded_under (≥) cofinite f) : bdd_below (range f) :=
@is_bounded_under.bdd_above_range_of_cofinite α βᵒᵈ _ _ hf

lemma is_bounded_under.bdd_above_range [semilattice_sup β] {f : ℕ → β}
  (hf : is_bounded_under (≤) at_top f) : bdd_above (range f) :=
by { rw ← nat.cofinite_eq_at_top at hf, exact hf.bdd_above_range_of_cofinite }

lemma is_bounded_under.bdd_below_range [semilattice_inf β] {f : ℕ → β}
  (hf : is_bounded_under (≥) at_top f) : bdd_below (range f) :=
@is_bounded_under.bdd_above_range βᵒᵈ _ _ hf

/-- `is_cobounded (≺) f` states that the filter `f` does not tend to infinity w.r.t. `≺`. This is
also called frequently bounded. Will be usually instantiated with `≤` or `≥`.

There is a subtlety in this definition: we want `f.is_cobounded` to hold for any `f` in the case of
complete lattices. This will be relevant to deduce theorems on complete lattices from their
versions on conditionally complete lattices with additional assumptions. We have to be careful in
the edge case of the trivial filter containing the empty set: the other natural definition
  `¬ ∀ a, ∀ᶠ n in f, a ≤ n`
would not work as well in this case.
-/
def is_cobounded (r : α → α → Prop) (f : filter α) := ∃b, ∀a, (∀ᶠ x in f, r x a) → r b a

/-- `is_cobounded_under (≺) f u` states that the image of the filter `f` under the map `u` does not
tend to infinity w.r.t. `≺`. This is also called frequently bounded. Will be usually instantiated
with `≤` or `≥`. -/
def is_cobounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (f.map u).is_cobounded r

/-- To check that a filter is frequently bounded, it suffices to have a witness
which bounds `f` at some point for every admissible set.

This is only an implication, as the other direction is wrong for the trivial filter.-/
lemma is_cobounded.mk [is_trans α r] (a : α) (h : ∀s∈f, ∃x∈s, r a x) : f.is_cobounded r :=
⟨a, assume y s, let ⟨x, h₁, h₂⟩ := h _ s in trans h₂ h₁⟩

/-- A filter which is eventually bounded is in particular frequently bounded (in the opposite
direction). At least if the filter is not trivial. -/
lemma is_bounded.is_cobounded_flip [is_trans α r] [ne_bot f] :
  f.is_bounded r → f.is_cobounded (flip r)
| ⟨a, ha⟩ := ⟨a, assume b hb,
  let ⟨x, rxa, rbx⟩ := (ha.and hb).exists in
  show r b a, from trans rbx rxa⟩

lemma is_bounded.is_cobounded_ge [preorder α] [ne_bot f] (h : f.is_bounded (≤)) :
  f.is_cobounded (≥) :=
h.is_cobounded_flip

lemma is_bounded.is_cobounded_le [preorder α] [ne_bot f] (h : f.is_bounded (≥)) :
  f.is_cobounded (≤) :=
h.is_cobounded_flip

lemma is_cobounded_bot : is_cobounded r ⊥ ↔ (∃b, ∀x, r b x) :=
by simp [is_cobounded]

lemma is_cobounded_top : is_cobounded r ⊤ ↔ nonempty α :=
by simp [is_cobounded, eq_univ_iff_forall, exists_true_iff_nonempty] {contextual := tt}

lemma is_cobounded_principal (s : set α) :
  (𝓟 s).is_cobounded r ↔ (∃b, ∀a, (∀x∈s, r x a) → r b a) :=
by simp [is_cobounded, subset_def]

lemma is_cobounded.mono (h : f ≤ g) : f.is_cobounded r → g.is_cobounded r
| ⟨b, hb⟩ := ⟨b, assume a ha, hb a (h ha)⟩

end relation

lemma is_cobounded_le_of_bot [preorder α] [order_bot α] {f : filter α} : f.is_cobounded (≤) :=
⟨⊥, assume a h, bot_le⟩

lemma is_cobounded_ge_of_top [preorder α] [order_top α] {f : filter α} : f.is_cobounded (≥) :=
⟨⊤, assume a h, le_top⟩

lemma is_bounded_le_of_top [preorder α] [order_top α] {f : filter α} : f.is_bounded (≤) :=
⟨⊤, eventually_of_forall $ λ _, le_top⟩

lemma is_bounded_ge_of_bot [preorder α] [order_bot α] {f : filter α} : f.is_bounded (≥) :=
⟨⊥, eventually_of_forall $ λ _, bot_le⟩

@[simp] lemma _root_.order_iso.is_bounded_under_le_comp [preorder α] [preorder β] (e : α ≃o β)
  {l : filter γ} {u : γ → α} :
  is_bounded_under (≤) l (λ x, e (u x)) ↔ is_bounded_under (≤) l u :=
e.surjective.exists.trans $ exists_congr $ λ a, by simp only [eventually_map, e.le_iff_le]

@[simp] lemma _root_.order_iso.is_bounded_under_ge_comp [preorder α] [preorder β] (e : α ≃o β)
  {l : filter γ} {u : γ → α} :
  is_bounded_under (≥) l (λ x, e (u x)) ↔ is_bounded_under (≥) l u :=
e.dual.is_bounded_under_le_comp

@[simp, to_additive]
lemma is_bounded_under_le_inv [ordered_comm_group α] {l : filter β} {u : β → α} :
  is_bounded_under (≤) l (λ x, (u x)⁻¹) ↔ is_bounded_under (≥) l u :=
(order_iso.inv α).is_bounded_under_ge_comp

@[simp, to_additive]
lemma is_bounded_under_ge_inv [ordered_comm_group α] {l : filter β} {u : β → α} :
  is_bounded_under (≥) l (λ x, (u x)⁻¹) ↔ is_bounded_under (≤) l u :=
(order_iso.inv α).is_bounded_under_le_comp

lemma is_bounded_under.sup [semilattice_sup α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≤) u → f.is_bounded_under (≤) v → f.is_bounded_under (≤) (λa, u a ⊔ v a)
| ⟨bu, (hu : ∀ᶠ x in f, u x ≤ bu)⟩ ⟨bv, (hv : ∀ᶠ x in f, v x ≤ bv)⟩ :=
  ⟨bu ⊔ bv, show ∀ᶠ x in f, u x ⊔ v x ≤ bu ⊔ bv,
    by filter_upwards [hu, hv] with _ using sup_le_sup⟩

@[simp] lemma is_bounded_under_le_sup [semilattice_sup α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≤) (λ a, u a ⊔ v a) ↔ f.is_bounded_under (≤) u ∧ f.is_bounded_under (≤) v :=
⟨λ h, ⟨h.mono_le $ eventually_of_forall $ λ _, le_sup_left,
  h.mono_le $ eventually_of_forall $ λ _, le_sup_right⟩, λ h, h.1.sup h.2⟩

lemma is_bounded_under.inf [semilattice_inf α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≥) u → f.is_bounded_under (≥) v → f.is_bounded_under (≥) (λa, u a ⊓ v a) :=
@is_bounded_under.sup αᵒᵈ β _ _ _ _

@[simp] lemma is_bounded_under_ge_inf [semilattice_inf α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≥) (λ a, u a ⊓ v a) ↔ f.is_bounded_under (≥) u ∧ f.is_bounded_under (≥) v :=
@is_bounded_under_le_sup αᵒᵈ _ _ _ _ _

lemma is_bounded_under_le_abs [linear_ordered_add_comm_group α] {f : filter β} {u : β → α} :
  f.is_bounded_under (≤) (λ a, |u a|) ↔ f.is_bounded_under (≤) u ∧ f.is_bounded_under (≥) u :=
is_bounded_under_le_sup.trans $ and_congr iff.rfl is_bounded_under_le_neg

/-- Filters are automatically bounded or cobounded in complete lattices. To use the same statements
in complete and conditionally complete lattices but let automation fill automatically the
boundedness proofs in complete lattices, we use the tactic `is_bounded_default` in the statements,
in the form `(hf : f.is_bounded (≥) . is_bounded_default)`. -/
meta def is_bounded_default : tactic unit :=
tactic.applyc ``is_cobounded_le_of_bot <|>
tactic.applyc ``is_cobounded_ge_of_top <|>
tactic.applyc ``is_bounded_le_of_top <|>
tactic.applyc ``is_bounded_ge_of_bot

section conditionally_complete_lattice
variables [conditionally_complete_lattice α]

/-- The `Limsup` of a filter `f` is the infimum of the `a` such that, eventually for `f`,
holds `x ≤ a`. -/
def Limsup (f : filter α) : α := Inf { a | ∀ᶠ n in f, n ≤ a }

/-- The `Liminf` of a filter `f` is the supremum of the `a` such that, eventually for `f`,
holds `x ≥ a`. -/
def Liminf (f : filter α) : α := Sup { a | ∀ᶠ n in f, a ≤ n }

/-- The `limsup` of a function `u` along a filter `f` is the infimum of the `a` such that,
eventually for `f`, holds `u x ≤ a`. -/
def limsup (f : filter β) (u : β → α) : α := (f.map u).Limsup

/-- The `liminf` of a function `u` along a filter `f` is the supremum of the `a` such that,
eventually for `f`, holds `u x ≥ a`. -/
def liminf (f : filter β) (u : β → α) : α := (f.map u).Liminf

section
variables {f : filter β} {u : β → α}
theorem limsup_eq : f.limsup u = Inf { a | ∀ᶠ n in f, u n ≤ a } := rfl
theorem liminf_eq : f.liminf u = Sup { a | ∀ᶠ n in f, a ≤ u n } := rfl
end

theorem Limsup_le_of_le {f : filter α} {a}
  (hf : f.is_cobounded (≤) . is_bounded_default) (h : ∀ᶠ n in f, n ≤ a) : f.Limsup ≤ a :=
cInf_le hf h

theorem le_Liminf_of_le {f : filter α} {a}
  (hf : f.is_cobounded (≥) . is_bounded_default) (h : ∀ᶠ n in f, a ≤ n) : a ≤ f.Liminf :=
le_cSup hf h

theorem le_Limsup_of_le {f : filter α} {a}
  (hf : f.is_bounded (≤) . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, n ≤ b) → a ≤ b) :
  a ≤ f.Limsup :=
le_cInf hf h

theorem Liminf_le_of_le {f : filter α} {a}
  (hf : f.is_bounded (≥) . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, b ≤ n) → b ≤ a) :
  f.Liminf ≤ a :=
cSup_le hf h

theorem Liminf_le_Limsup {f : filter α} [ne_bot f]
  (h₁ : f.is_bounded (≤) . is_bounded_default) (h₂ : f.is_bounded (≥) . is_bounded_default) :
  f.Liminf ≤ f.Limsup :=
Liminf_le_of_le h₂ $ assume a₀ ha₀, le_Limsup_of_le h₁ $ assume a₁ ha₁,
  show a₀ ≤ a₁, from let ⟨b, hb₀, hb₁⟩ := (ha₀.and ha₁).exists in le_trans hb₀ hb₁

lemma Liminf_le_Liminf {f g : filter α}
  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default)
  (h : ∀ a, (∀ᶠ n in f, a ≤ n) → ∀ᶠ n in g, a ≤ n) : f.Liminf ≤ g.Liminf :=
cSup_le_cSup hg hf h

lemma Limsup_le_Limsup {f g : filter α}
  (hf : f.is_cobounded (≤) . is_bounded_default) (hg : g.is_bounded (≤) . is_bounded_default)
  (h : ∀ a, (∀ᶠ n in g, n ≤ a) → ∀ᶠ n in f, n ≤ a) : f.Limsup ≤ g.Limsup :=
cInf_le_cInf hf hg h

lemma Limsup_le_Limsup_of_le {f g : filter α} (h : f ≤ g)
  (hf : f.is_cobounded (≤) . is_bounded_default) (hg : g.is_bounded (≤) . is_bounded_default) :
  f.Limsup ≤ g.Limsup :=
Limsup_le_Limsup hf hg (assume a ha, h ha)

lemma Liminf_le_Liminf_of_le {f g : filter α} (h : g ≤ f)
  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default) :
  f.Liminf ≤ g.Liminf :=
Liminf_le_Liminf hf hg (assume a ha, h ha)

lemma limsup_le_limsup {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : u ≤ᶠ[f] v)
  (hu : f.is_cobounded_under (≤) u . is_bounded_default)
  (hv : f.is_bounded_under (≤) v . is_bounded_default) :
  f.limsup u ≤ f.limsup v :=
Limsup_le_Limsup hu hv $ assume b, h.trans

lemma liminf_le_liminf {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : ∀ᶠ a in f, u a ≤ v a)
  (hu : f.is_bounded_under (≥) u . is_bounded_default)
  (hv : f.is_cobounded_under (≥) v . is_bounded_default) :
  f.liminf u ≤ f.liminf v :=
@limsup_le_limsup βᵒᵈ α _ _ _ _ h hv hu

lemma limsup_le_limsup_of_le {α β} [conditionally_complete_lattice β] {f g : filter α} (h : f ≤ g)
  {u : α → β} (hf : f.is_cobounded_under (≤) u . is_bounded_default)
  (hg : g.is_bounded_under (≤) u . is_bounded_default) :
  f.limsup u ≤ g.limsup u :=
Limsup_le_Limsup_of_le (map_mono h) hf hg

lemma liminf_le_liminf_of_le {α β} [conditionally_complete_lattice β] {f g : filter α} (h : g ≤ f)
  {u : α → β} (hf : f.is_bounded_under (≥) u . is_bounded_default)
  (hg : g.is_cobounded_under (≥) u . is_bounded_default) :
  f.liminf u ≤ g.liminf u :=
Liminf_le_Liminf_of_le (map_mono h) hf hg

theorem Limsup_principal {s : set α} (h : bdd_above s) (hs : s.nonempty) :
  (𝓟 s).Limsup = Sup s :=
by simp [Limsup]; exact cInf_upper_bounds_eq_cSup h hs

theorem Liminf_principal {s : set α} (h : bdd_below s) (hs : s.nonempty) :
  (𝓟 s).Liminf = Inf s :=
@Limsup_principal αᵒᵈ _ s h hs

lemma limsup_congr {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : ∀ᶠ a in f, u a = v a) : limsup f u = limsup f v :=
begin
  rw limsup_eq,
  congr' with b,
  exact eventually_congr (h.mono $ λ x hx, by simp [hx])
end

lemma liminf_congr {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : ∀ᶠ a in f, u a = v a) : liminf f u = liminf f v :=
@limsup_congr βᵒᵈ _ _ _ _ _ h

lemma limsup_const {α : Type*} [conditionally_complete_lattice β] {f : filter α} [ne_bot f]
  (b : β) : limsup f (λ x, b) = b :=
by simpa only [limsup_eq, eventually_const] using cInf_Ici

lemma liminf_const {α : Type*} [conditionally_complete_lattice β] {f : filter α} [ne_bot f]
  (b : β) : liminf f (λ x, b) = b :=
@limsup_const βᵒᵈ α _ f _ b

lemma liminf_le_limsup {f : filter β} [ne_bot f] {u : β → α}
  (h : f.is_bounded_under (≤) u . is_bounded_default)
  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
  liminf f u ≤ limsup f u :=
Liminf_le_Limsup h h'

end conditionally_complete_lattice

section complete_lattice
variables [complete_lattice α]

@[simp] theorem Limsup_bot : (⊥ : filter α).Limsup = ⊥ :=
bot_unique $ Inf_le $ by simp

@[simp] theorem Liminf_bot : (⊥ : filter α).Liminf = ⊤ :=
top_unique $ le_Sup $ by simp

@[simp] theorem Limsup_top : (⊤ : filter α).Limsup = ⊤ :=
top_unique $ le_Inf $
  by simp [eq_univ_iff_forall]; exact assume b hb, (top_unique $ hb _)

@[simp] theorem Liminf_top : (⊤ : filter α).Liminf = ⊥ :=
bot_unique $ Sup_le $
  by simp [eq_univ_iff_forall]; exact assume b hb, (bot_unique $ hb _)

/-- Same as limsup_const applied to `⊥` but without the `ne_bot f` assumption -/
lemma limsup_const_bot {f : filter β} : limsup f (λ x : β, (⊥ : α)) = (⊥ : α) :=
begin
  rw [limsup_eq, eq_bot_iff],
  exact Inf_le (eventually_of_forall (λ x, le_rfl)),
end

/-- Same as limsup_const applied to `⊤` but without the `ne_bot f` assumption -/
lemma liminf_const_top {f : filter β} : liminf f (λ x : β, (⊤ : α)) = (⊤ : α) :=
@limsup_const_bot αᵒᵈ β _ _

theorem has_basis.Limsup_eq_infi_Sup {ι} {p : ι → Prop} {s} {f : filter α} (h : f.has_basis p s) :
  f.Limsup = ⨅ i (hi : p i), Sup (s i) :=
le_antisymm
  (le_infi₂ $ λ i hi, Inf_le $ h.eventually_iff.2 ⟨i, hi, λ x, le_Sup⟩)
  (le_Inf $ assume a ha, let ⟨i, hi, ha⟩ := h.eventually_iff.1 ha in
    infi₂_le_of_le _ hi $ Sup_le ha)

theorem has_basis.Liminf_eq_supr_Inf {p : ι → Prop} {s : ι → set α} {f : filter α}
  (h : f.has_basis p s) : f.Liminf = ⨆ i (hi : p i), Inf (s i) :=
@has_basis.Limsup_eq_infi_Sup αᵒᵈ _ _ _ _ _ h

theorem Limsup_eq_infi_Sup {f : filter α} : f.Limsup = ⨅ s ∈ f, Sup s :=
f.basis_sets.Limsup_eq_infi_Sup

theorem Liminf_eq_supr_Inf {f : filter α} : f.Liminf = ⨆ s ∈ f, Inf s :=
@Limsup_eq_infi_Sup αᵒᵈ _ _

/-- In a complete lattice, the limsup of a function is the infimum over sets `s` in the filter
of the supremum of the function over `s` -/
theorem limsup_eq_infi_supr {f : filter β} {u : β → α} : f.limsup u = ⨅ s ∈ f, ⨆ a ∈ s, u a :=
(f.basis_sets.map u).Limsup_eq_infi_Sup.trans $
  by simp only [Sup_image, id]

lemma limsup_eq_infi_supr_of_nat {u : ℕ → α} : limsup at_top u = ⨅ n : ℕ, ⨆ i ≥ n, u i :=
(at_top_basis.map u).Limsup_eq_infi_Sup.trans $
  by simp only [Sup_image, infi_const]; refl

lemma limsup_eq_infi_supr_of_nat' {u : ℕ → α} : limsup at_top u = ⨅ n : ℕ, ⨆ i : ℕ, u (i + n) :=
by simp only [limsup_eq_infi_supr_of_nat, supr_ge_eq_supr_nat_add]

theorem has_basis.limsup_eq_infi_supr {p : ι → Prop} {s : ι → set β} {f : filter β} {u : β → α}
  (h : f.has_basis p s) : f.limsup u = ⨅ i (hi : p i), ⨆ a ∈ s i, u a :=
(h.map u).Limsup_eq_infi_Sup.trans $ by simp only [Sup_image, id]

/-- In a complete lattice, the liminf of a function is the infimum over sets `s` in the filter
of the supremum of the function over `s` -/
theorem liminf_eq_supr_infi {f : filter β} {u : β → α} : f.liminf u = ⨆ s ∈ f, ⨅ a ∈ s, u a :=
@limsup_eq_infi_supr αᵒᵈ β _ _ _

lemma liminf_eq_supr_infi_of_nat {u : ℕ → α} : liminf at_top u = ⨆ n : ℕ, ⨅ i ≥ n, u i :=
@limsup_eq_infi_supr_of_nat αᵒᵈ _ u

lemma liminf_eq_supr_infi_of_nat' {u : ℕ → α} : liminf at_top u = ⨆ n : ℕ, ⨅ i : ℕ, u (i + n) :=
@limsup_eq_infi_supr_of_nat' αᵒᵈ _ _

theorem has_basis.liminf_eq_supr_infi {p : ι → Prop} {s : ι → set β} {f : filter β} {u : β → α}
  (h : f.has_basis p s) : f.liminf u = ⨆ i (hi : p i), ⨅ a ∈ s i, u a :=
@has_basis.limsup_eq_infi_supr αᵒᵈ _ _ _ _ _ _ _ h

@[simp] lemma liminf_nat_add (f : ℕ → α) (k : ℕ) :
  at_top.liminf (λ i, f (i + k)) = at_top.liminf f :=
by { simp_rw liminf_eq_supr_infi_of_nat, exact supr_infi_ge_nat_add f k }

@[simp] lemma limsup_nat_add (f : ℕ → α) (k : ℕ) :
  at_top.limsup (λ i, f (i + k)) = at_top.limsup f :=
@liminf_nat_add αᵒᵈ _ f k

lemma liminf_le_of_frequently_le' {α β} [complete_lattice β]
  {f : filter α} {u : α → β} {x : β} (h : ∃ᶠ a in f, u a ≤ x) :
  f.liminf u ≤ x :=
begin
  rw liminf_eq,
  refine Sup_le (λ b hb, _),
  have hbx : ∃ᶠ a in f, b ≤ x,
  { revert h,
    rw [←not_imp_not, not_frequently, not_frequently],
    exact λ h, hb.mp (h.mono (λ a hbx hba hax, hbx (hba.trans hax))), },
  exact hbx.exists.some_spec,
end

lemma le_limsup_of_frequently_le' {α β} [complete_lattice β]
  {f : filter α} {u : α → β} {x : β} (h : ∃ᶠ a in f, x ≤ u a) :
  x ≤ f.limsup u :=
@liminf_le_of_frequently_le' _ βᵒᵈ _ _ _ _ h

end complete_lattice

section conditionally_complete_linear_order

lemma eventually_lt_of_lt_liminf {f : filter α} [conditionally_complete_linear_order β]
  {u : α → β} {b : β} (h : b < liminf f u) (hu : f.is_bounded_under (≥) u . is_bounded_default) :
  ∀ᶠ a in f, b < u a :=
begin
  obtain ⟨c, hc, hbc⟩ : ∃ (c : β) (hc : c ∈ {c : β | ∀ᶠ (n : α) in f, c ≤ u n}), b < c :=
    exists_lt_of_lt_cSup hu h,
  exact hc.mono (λ x hx, lt_of_lt_of_le hbc hx)
end

lemma eventually_lt_of_limsup_lt {f : filter α} [conditionally_complete_linear_order β]
  {u : α → β} {b : β} (h : limsup f u < b) (hu : f.is_bounded_under (≤) u . is_bounded_default) :
  ∀ᶠ a in f, u a < b :=
@eventually_lt_of_lt_liminf _ βᵒᵈ _ _ _ _ h hu

lemma liminf_le_of_frequently_le  {α β} [conditionally_complete_linear_order β] {f : filter α}
  {u : α → β}  {b : β} (hu_le : ∃ᶠ x in f, u x ≤ b)
  (hu : f.is_bounded_under (≥) u . is_bounded_default) :
  f.liminf u ≤ b :=
@le_limsup_of_frequently_le _ βᵒᵈ _ f u b hu_le hu

lemma frequently_lt_of_lt_limsup {α β} [conditionally_complete_linear_order β] {f : filter α}
  {u : α → β}  {b : β}
  (hu : f.is_cobounded_under (≤) u . is_bounded_default) (h : b < f.limsup u) :
  ∃ᶠ x in f, b < u x :=
begin
  contrapose! h,
  apply Limsup_le_of_le hu,
  simpa using h,
end

lemma frequently_lt_of_liminf_lt {α β} [conditionally_complete_linear_order β] {f : filter α}
  {u : α → β}  {b : β}
  (hu : f.is_cobounded_under (≥) u . is_bounded_default) (h : f.liminf u < b) :
  ∃ᶠ x in f, u x < b :=
@frequently_lt_of_lt_limsup _ βᵒᵈ _ f u b hu h

end conditionally_complete_linear_order

end filter

section order
open filter

lemma monotone.is_bounded_under_le_comp [nonempty β] [linear_order β] [preorder γ]
  [no_max_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : monotone g)
  (hg' : tendsto g at_top at_top) :
  is_bounded_under (≤) l (g ∘ f) ↔ is_bounded_under (≤) l f :=
begin
  refine ⟨_, λ h, h.is_bounded_under hg⟩,
  rintro ⟨c, hc⟩, rw eventually_map at hc,
  obtain ⟨b, hb⟩ : ∃ b, ∀ a ≥ b, c < g a := eventually_at_top.1 (hg'.eventually_gt_at_top c),
  exact ⟨b, hc.mono $ λ x hx, not_lt.1 (λ h, (hb _ h.le).not_le hx)⟩
end

lemma monotone.is_bounded_under_ge_comp [nonempty β] [linear_order β] [preorder γ]
  [no_min_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : monotone g)
  (hg' : tendsto g at_bot at_bot) :
  is_bounded_under (≥) l (g ∘ f) ↔ is_bounded_under (≥) l f :=
hg.dual.is_bounded_under_le_comp hg'

lemma antitone.is_bounded_under_le_comp [nonempty β] [linear_order β] [preorder γ]
  [no_max_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : antitone g)
  (hg' : tendsto g at_bot at_top) :
  is_bounded_under (≤) l (g ∘ f) ↔ is_bounded_under (≥) l f :=
hg.dual_right.is_bounded_under_ge_comp hg'

lemma antitone.is_bounded_under_ge_comp [nonempty β] [linear_order β] [preorder γ]
  [no_min_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : antitone g)
  (hg' : tendsto g at_top at_bot) :
  is_bounded_under (≥) l (g ∘ f) ↔ is_bounded_under (≤) l f :=
hg.dual_right.is_bounded_under_le_comp hg'

lemma galois_connection.l_limsup_le [conditionally_complete_lattice β]
  [conditionally_complete_lattice γ] {f : filter α} {v : α → β}
  {l : β → γ} {u : γ → β} (gc : galois_connection l u)
  (hlv : f.is_bounded_under (≤) (λ x, l (v x)) . is_bounded_default)
  (hv_co : f.is_cobounded_under (≤) v . is_bounded_default) :
  l (f.limsup v) ≤ f.limsup (λ x, l (v x)) :=
begin
  refine le_Limsup_of_le hlv (λ c hc, _),
  rw filter.eventually_map at hc,
  simp_rw (gc _ _) at hc ⊢,
  exact Limsup_le_of_le hv_co hc,
end

lemma order_iso.limsup_apply {γ} [conditionally_complete_lattice β]
  [conditionally_complete_lattice γ] {f : filter α} {u : α → β} (g : β ≃o γ)
  (hu : f.is_bounded_under (≤) u . is_bounded_default)
  (hu_co : f.is_cobounded_under (≤) u . is_bounded_default)
  (hgu : f.is_bounded_under (≤) (λ x, g (u x)) . is_bounded_default)
  (hgu_co : f.is_cobounded_under (≤) (λ x, g (u x)) . is_bounded_default) :
  g (f.limsup u) = f.limsup (λ x, g (u x)) :=
begin
  refine le_antisymm (g.to_galois_connection.l_limsup_le hgu hu_co) _,
  rw [←(g.symm.symm_apply_apply (f.limsup (λ (x : α), g (u x)))), g.symm_symm],
  refine g.monotone _,
  have hf : u = λ i, g.symm (g (u i)), from funext (λ i, (g.symm_apply_apply (u i)).symm),
  nth_rewrite 0 hf,
  refine g.symm.to_galois_connection.l_limsup_le _ hgu_co,
  simp_rw g.symm_apply_apply,
  exact hu,
end

lemma order_iso.liminf_apply {γ} [conditionally_complete_lattice β]
  [conditionally_complete_lattice γ] {f : filter α} {u : α → β} (g : β ≃o γ)
  (hu : f.is_bounded_under (≥) u . is_bounded_default)
  (hu_co : f.is_cobounded_under (≥) u . is_bounded_default)
  (hgu : f.is_bounded_under (≥) (λ x, g (u x)) . is_bounded_default)
  (hgu_co : f.is_cobounded_under (≥) (λ x, g (u x)) . is_bounded_default) :
  g (f.liminf u) = f.liminf (λ x, g (u x)) :=
@order_iso.limsup_apply α βᵒᵈ γᵒᵈ _ _ f u g.dual hu hu_co hgu hgu_co

end order


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import analysis.convex.basic

/-!
# Star-convex sets

This files defines star-convex sets (aka star domains, star-shaped set, radially convex set).

A set is star-convex at `x` if every segment from `x` to a point in the set is contained in the set.

This is the prototypical example of a contractible set in homotopy theory (by scaling every point
towards `x`), but has wider uses.

Note that this has nothing to do with star rings, `has_star` and co.

## Main declarations

* `star_convex 𝕜 x s`: `s` is star-convex at `x` with scalars `𝕜`.

## Implementation notes

Instead of saying that a set is star-convex, we say a set is star-convex *at a point*. This has the
advantage of allowing us to talk about convexity as being "everywhere star-convexity" and of making
the union of star-convex sets be star-convex.

Incidentally, this choice means we don't need to assume a set is nonempty for it to be star-convex.
Concretely, the empty set is star-convex at every point.

## TODO

Balanced sets are star-convex.

The closure of a star-convex set is star-convex.

Star-convex sets are contractible.

A nonempty open star-convex set in `ℝ^n` is diffeomorphic to the entire space.
-/

open set
open_locale convex pointwise

variables {𝕜 E F β : Type*}

section ordered_semiring
variables [ordered_semiring 𝕜]

section add_comm_monoid
variables [add_comm_monoid E] [add_comm_monoid F]

section has_scalar
variables (𝕜) [has_scalar 𝕜 E] [has_scalar 𝕜 F] (x : E) (s : set E)

/-- Star-convexity of sets. `s` is star-convex at `x` if every segment from `x` to a point in `s` is
contained in `s`. -/
def star_convex : Prop :=
∀ ⦃y : E⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → a • x + b • y ∈ s

variables {𝕜 x s} {t : set E}

lemma convex_iff_forall_star_convex : convex 𝕜 s ↔ ∀ x ∈ s, star_convex 𝕜 x s :=
forall_congr $ λ x, forall_swap

alias convex_iff_forall_star_convex ↔ convex.star_convex _

lemma star_convex_iff_segment_subset : star_convex 𝕜 x s ↔ ∀ ⦃y⦄, y ∈ s → [x -[𝕜] y] ⊆ s :=
begin
  split,
  { rintro h y hy z ⟨a, b, ha, hb, hab, rfl⟩,
    exact h hy ha hb hab },
  { rintro h y hy a b ha hb hab,
    exact h hy ⟨a, b, ha, hb, hab, rfl⟩ }
end

lemma star_convex.segment_subset (h : star_convex 𝕜 x s) {y : E} (hy : y ∈ s) : [x -[𝕜] y] ⊆ s :=
star_convex_iff_segment_subset.1 h hy

lemma star_convex.open_segment_subset (h : star_convex 𝕜 x s) {y : E} (hy : y ∈ s) :
  open_segment 𝕜 x y ⊆ s :=
(open_segment_subset_segment 𝕜 x y).trans (h.segment_subset hy)

/-- Alternative definition of star-convexity, in terms of pointwise set operations. -/
lemma star_convex_iff_pointwise_add_subset :
  star_convex 𝕜 x s ↔ ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → a • {x} + b • s ⊆ s :=
begin
  split,
  { rintro hA a b ha hb hab w ⟨au, bv, ⟨u, (rfl : u = x), rfl⟩, ⟨v, hv, rfl⟩, rfl⟩,
    exact hA hv ha hb hab },
  { rintro h y hy a b ha hb hab,
    refine h ha hb hab (add_mem_add _ ⟨_, hy, rfl⟩),
    rw smul_singleton,
    exact mem_singleton _ }
end

lemma star_convex_empty (x : E) : star_convex 𝕜 x ∅ := λ y hy, hy.elim

lemma star_convex_univ (x : E) : star_convex 𝕜 x univ := λ _ _ _ _ _ _ _, trivial

lemma star_convex.inter (hs : star_convex 𝕜 x s) (ht : star_convex 𝕜 x t) :
  star_convex 𝕜 x (s ∩ t) :=
λ y hy a b ha hb hab, ⟨hs hy.left ha hb hab, ht hy.right ha hb hab⟩

lemma star_convex_sInter {S : set (set E)} (h : ∀ s ∈ S, star_convex 𝕜 x s) :
  star_convex 𝕜 x (⋂₀ S) :=
λ y hy a b ha hb hab s hs, h s hs (hy s hs) ha hb hab

lemma star_convex_Inter {ι : Sort*} {s : ι → set E} (h : ∀ i, star_convex 𝕜 x (s i)) :
  star_convex 𝕜 x (⋂ i, s i) :=
(sInter_range s) ▸ star_convex_sInter $ forall_range_iff.2 h

lemma star_convex.union (hs : star_convex 𝕜 x s) (ht : star_convex 𝕜 x t) :
  star_convex 𝕜 x (s ∪ t) :=
begin
  rintro y (hy | hy) a b ha hb hab,
  { exact or.inl (hs hy ha hb hab) },
  { exact or.inr (ht hy ha hb hab) }
end

lemma star_convex_Union {ι : Sort*} {s : ι → set E} (hs : ∀ i, star_convex 𝕜 x (s i)) :
  star_convex 𝕜 x (⋃ i, s i) :=
begin
  rintro y hy a b ha hb hab,
  rw mem_Union at ⊢ hy,
  obtain ⟨i, hy⟩ := hy,
  exact ⟨i, hs i hy ha hb hab⟩,
end

lemma star_convex_sUnion {S : set (set E)} (hS : ∀ s ∈ S, star_convex 𝕜 x s) :
  star_convex 𝕜 x (⋃₀ S) :=
begin
  rw sUnion_eq_Union,
  exact star_convex_Union (λ s, hS _ s.2),
end

lemma star_convex.prod {y : F} {s : set E} {t : set F} (hs : star_convex 𝕜 x s)
  (ht : star_convex 𝕜 y t) :
  star_convex 𝕜 (x, y) (s.prod t) :=
λ y hy a b ha hb hab, ⟨hs hy.1 ha hb hab, ht hy.2 ha hb hab⟩

lemma star_convex_pi {ι : Type*} {E : ι → Type*} [Π i, add_comm_monoid (E i)]
  [Π i, has_scalar 𝕜 (E i)] {x : Π i, E i} {s : set ι} {t : Π i, set (E i)}
  (ht : ∀ i, star_convex 𝕜 (x i) (t i)) :
  star_convex 𝕜 x (s.pi t) :=
λ y hy a b ha hb hab i hi, ht i (hy i hi) ha hb hab

end has_scalar

section module
variables [module 𝕜 E] [module 𝕜 F] {x y z : E} {s : set E}

lemma star_convex.mem (hs : star_convex 𝕜 x s) (h : s.nonempty) : x ∈ s :=
begin
  obtain ⟨y, hy⟩ := h,
  convert hs hy zero_le_one le_rfl (add_zero 1),
  rw [one_smul, zero_smul, add_zero],
end

lemma convex.star_convex_iff (hs : convex 𝕜 s) (h : s.nonempty) : star_convex 𝕜 x s ↔ x ∈ s :=
⟨λ hxs, hxs.mem h, hs.star_convex _⟩

lemma star_convex_iff_forall_pos (hx : x ∈ s) :
  star_convex 𝕜 x s ↔ ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ s :=
begin
  refine ⟨λ h y hy a b ha hb hab, h hy ha.le hb.le hab, _⟩,
  intros h y hy a b ha hb hab,
  obtain rfl | ha := ha.eq_or_lt,
  { rw zero_add at hab,
    rwa [hab, one_smul, zero_smul, zero_add] },
  obtain rfl | hb := hb.eq_or_lt,
  { rw add_zero at hab,
    rwa [hab, one_smul, zero_smul, add_zero] },
  exact h hy ha hb hab,
end

lemma star_convex_iff_forall_ne_pos (hx : x ∈ s) :
  star_convex 𝕜 x s ↔ ∀ ⦃y⦄, y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 →
    a • x + b • y ∈ s :=
begin
  refine ⟨λ h y hy _ a b ha hb hab, h hy ha.le hb.le hab, _⟩,
  intros h y hy a b ha hb hab,
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_add] at hab, rwa [hab, zero_smul, one_smul, zero_add] },
  obtain rfl | hb' := hb.eq_or_lt,
  { rw [add_zero] at hab, rwa [hab, zero_smul, one_smul, add_zero] },
  obtain rfl | hxy := eq_or_ne x y,
  { rwa convex.combo_self hab },
  exact h hy hxy ha' hb' hab,
end

lemma star_convex_iff_open_segment_subset (hx : x ∈ s) :
  star_convex 𝕜 x s ↔ ∀ ⦃y⦄, y ∈ s → open_segment 𝕜 x y ⊆ s :=
star_convex_iff_segment_subset.trans $ forall_congr $ λ y, forall_congr $ λ hy,
  (open_segment_subset_iff_segment_subset hx hy).symm

lemma star_convex_singleton (x : E) : star_convex 𝕜 x {x} :=
begin
  rintro y (rfl : y = x) a b ha hb hab,
  exact convex.combo_self hab _,
end

lemma star_convex.linear_image (hs : star_convex 𝕜 x s) (f : E →ₗ[𝕜] F) :
  star_convex 𝕜 (f x) (s.image f) :=
begin
  intros y hy a b ha hb hab,
  obtain ⟨y', hy', rfl⟩ := hy,
  exact ⟨a • x + b • y', hs hy' ha hb hab, by rw [f.map_add, f.map_smul, f.map_smul]⟩,
end

lemma star_convex.is_linear_image (hs : star_convex 𝕜 x s) {f : E → F} (hf : is_linear_map 𝕜 f) :
  star_convex 𝕜 (f x) (f '' s) :=
hs.linear_image $ hf.mk' f

lemma star_convex.linear_preimage {s : set F} (f : E →ₗ[𝕜] F) (hs : star_convex 𝕜 (f x) s) :
  star_convex 𝕜 x (s.preimage f) :=
begin
  intros y hy a b ha hb hab,
  rw [mem_preimage, f.map_add, f.map_smul, f.map_smul],
  exact hs hy ha hb hab,
end

lemma star_convex.is_linear_preimage {s : set F} {f : E → F} (hs : star_convex 𝕜 (f x) s)
  (hf : is_linear_map 𝕜 f) :
  star_convex 𝕜 x (preimage f s) :=
hs.linear_preimage $ hf.mk' f

lemma star_convex.add {t : set E} (hs : star_convex 𝕜 x s) (ht : star_convex 𝕜 y t) :
  star_convex 𝕜 (x + y) (s + t) :=
by { rw ←add_image_prod, exact (hs.prod ht).is_linear_image is_linear_map.is_linear_map_add }

lemma star_convex.add_left (hs : star_convex 𝕜 x s) (z : E) :
  star_convex 𝕜 (z + x) ((λ x, z + x) '' s) :=
begin
  intros y hy a b ha hb hab,
  obtain ⟨y', hy', rfl⟩ := hy,
  refine ⟨a • x + b • y', hs hy' ha hb hab, _⟩,
  rw [smul_add, smul_add, add_add_add_comm, ←add_smul, hab, one_smul],
end

lemma star_convex.add_right (hs : star_convex 𝕜 x s) (z : E) :
  star_convex 𝕜 (x + z) ((λ x, x + z) '' s) :=
begin
  intros y hy a b ha hb hab,
  obtain ⟨y', hy', rfl⟩ := hy,
  refine ⟨a • x + b • y', hs hy' ha hb hab, _⟩,
  rw [smul_add, smul_add, add_add_add_comm, ←add_smul, hab, one_smul],
end

/-- The translation of a star-convex set is also star-convex. -/
lemma star_convex.preimage_add_right (hs : star_convex 𝕜 (z + x) s) :
  star_convex 𝕜 x ((λ x, z + x) ⁻¹' s) :=
begin
  intros y hy a b ha hb hab,
  have h := hs hy ha hb hab,
  rwa [smul_add, smul_add, add_add_add_comm, ←add_smul, hab, one_smul] at h,
end

/-- The translation of a star-convex set is also star-convex. -/
lemma star_convex.preimage_add_left (hs : star_convex 𝕜 (x + z) s) :
  star_convex 𝕜 x ((λ x, x + z) ⁻¹' s) :=
begin
  rw add_comm at hs,
  simpa only [add_comm] using hs.preimage_add_right,
end

end module
end add_comm_monoid

section add_comm_group
variables [add_comm_group E] [module 𝕜 E] {x y : E}

lemma star_convex.sub {s : set (E × E)} (hs : star_convex 𝕜 (x, y) s) :
  star_convex 𝕜 (x - y) ((λ x : E × E, x.1 - x.2) '' s) :=
hs.is_linear_image is_linear_map.is_linear_map_sub

end add_comm_group
end ordered_semiring

section ordered_comm_semiring
variables [ordered_comm_semiring 𝕜]

section add_comm_monoid
variables [add_comm_monoid E] [add_comm_monoid F] [module 𝕜 E] [module 𝕜 F] {x : E} {s : set E}

lemma star_convex.smul (hs : star_convex 𝕜 x s) (c : 𝕜) : star_convex 𝕜 (c • x) (c • s) :=
hs.linear_image $ linear_map.lsmul _ _ c

lemma star_convex.preimage_smul {c : 𝕜} (hs : star_convex 𝕜 (c • x) s) :
  star_convex 𝕜 x ((λ z, c • z) ⁻¹' s) :=
hs.linear_preimage (linear_map.lsmul _ _ c)

lemma star_convex.affinity (hs : star_convex 𝕜 x s) (z : E) (c : 𝕜) :
  star_convex 𝕜 (z + c • x) ((λ x, z + c • x) '' s) :=
begin
  have h := (hs.smul c).add_left z,
  rwa [←image_smul, image_image] at h,
end

end add_comm_monoid
end ordered_comm_semiring

section ordered_ring
variables [ordered_ring 𝕜]

section add_comm_group
variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {x y : E} {s : set E}

lemma star_convex.add_smul_mem (hs : star_convex 𝕜 x s) (hy : x + y ∈ s) {t : 𝕜} (ht₀ : 0 ≤ t)
  (ht₁ : t ≤ 1) :
  x + t • y ∈ s :=
begin
  have h : x + t • y = (1 - t) • x + t • (x + y),
  { rw [smul_add, ←add_assoc, ←add_smul, sub_add_cancel, one_smul] },
  rw h,
  exact hs hy (sub_nonneg_of_le ht₁) ht₀ (sub_add_cancel _ _),
end

lemma star_convex.smul_mem (hs : star_convex 𝕜 0 s) (hx : x ∈ s) {t : 𝕜} (ht₀ : 0 ≤ t)
  (ht₁ : t ≤ 1) :
  t • x ∈ s :=
by simpa using hs.add_smul_mem (by simpa using hx) ht₀ ht₁

lemma star_convex.add_smul_sub_mem (hs : star_convex 𝕜 x s) (hy : y ∈ s) {t : 𝕜} (ht₀ : 0 ≤ t)
  (ht₁ : t ≤ 1) :
  x + t • (y - x) ∈ s :=
begin
  apply hs.segment_subset hy,
  rw segment_eq_image',
  exact mem_image_of_mem _ ⟨ht₀, ht₁⟩,
end

/-- The preimage of a star-convex set under an affine map is star-convex. -/
lemma star_convex.affine_preimage (f : E →ᵃ[𝕜] F) {s : set F} (hs : star_convex 𝕜 (f x) s) :
  star_convex 𝕜 x (f ⁻¹' s) :=
begin
  intros y hy a b ha hb hab,
  rw [mem_preimage, convex.combo_affine_apply hab],
  exact hs hy ha hb hab,
end

/-- The image of a star-convex set under an affine map is star-convex. -/
lemma star_convex.affine_image (f : E →ᵃ[𝕜] F) {s : set E} (hs : star_convex 𝕜 x s) :
  star_convex 𝕜 (f x) (f '' s) :=
begin
  rintro y ⟨y', ⟨hy', hy'f⟩⟩ a b ha hb hab,
  refine ⟨a • x + b • y', ⟨hs hy' ha hb hab, _⟩⟩,
  rw [convex.combo_affine_apply hab, hy'f],
end

lemma star_convex.neg (hs : star_convex 𝕜 x s) : star_convex 𝕜 (-x) ((λ z, -z) '' s) :=
hs.is_linear_image is_linear_map.is_linear_map_neg

lemma star_convex.neg_preimage (hs : star_convex 𝕜 (-x) s) : star_convex 𝕜 x ((λ z, -z) ⁻¹' s) :=
hs.is_linear_preimage is_linear_map.is_linear_map_neg

end add_comm_group
end ordered_ring

section linear_ordered_field
variables [linear_ordered_field 𝕜]

section add_comm_group
variables [add_comm_group E] [module 𝕜 E] {x : E} {s : set E}

/-- Alternative definition of star-convexity, using division. -/
lemma star_convex_iff_div :
  star_convex 𝕜 x s ↔ ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → 0 < a + b →
    (a / (a + b)) • x + (b / (a + b)) • y ∈ s :=
⟨λ h y hy a b ha hb hab, begin
  apply h hy,
  { have ha', from mul_le_mul_of_nonneg_left ha (inv_pos.2 hab).le,
    rwa [mul_zero, ←div_eq_inv_mul] at ha' },
  { have hb', from mul_le_mul_of_nonneg_left hb (inv_pos.2 hab).le,
    rwa [mul_zero, ←div_eq_inv_mul] at hb' },
  { rw ←add_div,
    exact div_self hab.ne' }
end, λ h y hy a b ha hb hab,
begin
  have h', from h hy ha hb,
  rw [hab, div_one, div_one] at h',
  exact h' zero_lt_one
end⟩

lemma star_convex.mem_smul (hs : star_convex 𝕜 0 s) (hx : x ∈ s) {t : 𝕜} (ht : 1 ≤ t) :
  x ∈ t • s :=
begin
  rw mem_smul_set_iff_inv_smul_mem₀ (zero_lt_one.trans_le ht).ne',
  exact hs.smul_mem hx (inv_nonneg.2 $ zero_le_one.trans ht) (inv_le_one ht),
end

end add_comm_group
end linear_ordered_field

/-!
#### Star-convex sets in an ordered space

Relates `star_convex` and `set.ord_connected`.
-/

section ord_connected

lemma set.ord_connected.star_convex [ordered_semiring 𝕜] [ordered_add_comm_monoid E]
  [module 𝕜 E] [ordered_smul 𝕜 E] {x : E} {s : set E} (hs : s.ord_connected) (hx : x ∈ s)
  (h : ∀ y ∈ s, x ≤ y ∨ y ≤ x) :
  star_convex 𝕜 x s :=
begin
  intros y hy a b ha hb hab,
  obtain hxy | hyx := h _ hy,
  { refine hs.out hx hy (mem_Icc.2 ⟨_, _⟩),
    calc
      x   = a • x + b • x : (convex.combo_self hab _).symm
      ... ≤ a • x + b • y : add_le_add_left (smul_le_smul_of_nonneg hxy hb) _,
    calc
      a • x + b • y
          ≤ a • y + b • y : add_le_add_right (smul_le_smul_of_nonneg hxy ha) _
      ... = y             : convex.combo_self hab _ },
  { refine hs.out hy hx (mem_Icc.2 ⟨_, _⟩),
    calc
      y   = a • y + b • y : (convex.combo_self hab _).symm
      ... ≤ a • x + b • y : add_le_add_right (smul_le_smul_of_nonneg hyx ha) _,
    calc
      a • x + b • y
          ≤ a • x + b • x : add_le_add_left (smul_le_smul_of_nonneg hyx hb) _
      ... = x             : convex.combo_self hab _ }
end

lemma star_convex_iff_ord_connected [linear_ordered_field 𝕜] {x : 𝕜} {s : set 𝕜} (hx : x ∈ s) :
  star_convex 𝕜 x s ↔ s.ord_connected :=
by simp_rw [ord_connected_iff_interval_subset_left hx, star_convex_iff_segment_subset,
  segment_eq_interval]

alias star_convex_iff_ord_connected ↔ star_convex.ord_connected _

end ord_connected

/-! #### Star-convexity of submodules/subspaces -/

section submodule
open submodule

lemma submodule.star_convex [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E]
  (K : submodule 𝕜 E) :
  star_convex 𝕜 (0 : E) K :=
 K.convex.star_convex _ K.zero_mem

lemma subspace.star_convex [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E]
  (K : subspace 𝕜 E) :
  star_convex 𝕜 (0 : E) K :=
 K.convex.star_convex _ K.zero_mem

end submodule


/-
Copyright (c) 2021 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import measure_theory.integral.interval_integral
import order.filter.at_top_bot

/-!
# Links between an integral and its "improper" version

In its current state, mathlib only knows how to talk about definite ("proper") integrals,
in the sense that it treats integrals over `[x, +∞)` the same as it treats integrals over
`[y, z]`. For example, the integral over `[1, +∞)` is **not** defined to be the limit of
the integral over `[1, x]` as `x` tends to `+∞`, which is known as an **improper integral**.

Indeed, the "proper" definition is stronger than the "improper" one. The usual counterexample
is `x ↦ sin(x)/x`, which has an improper integral over `[1, +∞)` but no definite integral.

Although definite integrals have better properties, they are hardly usable when it comes to
computing integrals on unbounded sets, which is much easier using limits. Thus, in this file,
we prove various ways of studying the proper integral by studying the improper one.

## Definitions

The main definition of this file is `measure_theory.ae_cover`. It is a rather technical
definition whose sole purpose is generalizing and factoring proofs. Given an index type `ι`, a
countably generated filter `l` over `ι`, and an `ι`-indexed family `φ` of subsets of a measurable
space `α` equipped with a measure `μ`, one should think of a hypothesis `hφ : ae_cover μ l φ` as
a sufficient condition for being able to interpret `∫ x, f x ∂μ` (if it exists) as the limit
of `∫ x in φ i, f x ∂μ` as `i` tends to `l`.

When using this definition with a measure restricted to a set `s`, which happens fairly often,
one should not try too hard to use a `ae_cover` of subsets of `s`, as it often makes proofs
more complicated than necessary. See for example the proof of
`measure_theory.integrable_on_Iic_of_interval_integral_norm_tendsto` where we use `(λ x, Ioi x)`
as an `ae_cover` w.r.t. `μ.restrict (Iic b)`, instead of using `(λ x, Ioc x b)`.

## Main statements

- `measure_theory.ae_cover.lintegral_tendsto_of_countably_generated` : if `φ` is a `ae_cover μ l`,
  where `l` is a countably generated filter, and if `f` is a measurable `ennreal`-valued function,
  then `∫⁻ x in φ n, f x ∂μ` tends to `∫⁻ x, f x ∂μ` as `n` tends to `l`
- `measure_theory.ae_cover.integrable_of_integral_norm_tendsto` : if `φ` is a `ae_cover μ l`,
  where `l` is a countably generated filter, if `f` is measurable and integrable on each `φ n`,
  and if `∫ x in φ n, ∥f x∥ ∂μ` tends to some `I : ℝ` as n tends to `l`, then `f` is integrable
- `measure_theory.ae_cover.integral_tendsto_of_countably_generated` : if `φ` is a `ae_cover μ l`,
  where `l` is a countably generated filter, and if `f` is measurable and integrable (globally),
  then `∫ x in φ n, f x ∂μ` tends to `∫ x, f x ∂μ` as `n` tends to `+∞`.

We then specialize these lemmas to various use cases involving intervals, which are frequent
in analysis.
-/

open measure_theory filter set topological_space
open_locale ennreal nnreal topological_space

namespace measure_theory

section ae_cover

variables {α ι : Type*} [measurable_space α] (μ : measure α) (l : filter ι)

/-- A sequence `φ` of subsets of `α` is a `ae_cover` w.r.t. a measure `μ` and a filter `l`
    if almost every point (w.r.t. `μ`) of `α` eventually belongs to `φ n` (w.r.t. `l`), and if
    each `φ n` is measurable.
    This definition is a technical way to avoid duplicating a lot of proofs.
    It should be thought of as a sufficient condition for being able to interpret
    `∫ x, f x ∂μ` (if it exists) as the limit of `∫ x in φ n, f x ∂μ` as `n` tends to `l`.

    See for example `measure_theory.ae_cover.lintegral_tendsto_of_countably_generated`,
    `measure_theory.ae_cover.integrable_of_integral_norm_tendsto` and
    `measure_theory.ae_cover.integral_tendsto_of_countably_generated`. -/
structure ae_cover (φ : ι → set α) : Prop :=
(ae_eventually_mem : ∀ᵐ x ∂μ, ∀ᶠ i in l, x ∈ φ i)
(measurable : ∀ i, measurable_set $ φ i)

variables {μ} {l}

section preorder_α

variables [preorder α] [topological_space α] [order_closed_topology α]
  [opens_measurable_space α] {a b : ι → α}
  (ha : tendsto a l at_bot) (hb : tendsto b l at_top)

lemma ae_cover_Icc :
  ae_cover μ l (λ i, Icc (a i) (b i)) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha.eventually $ eventually_le_at_bot x).mp $
    (hb.eventually $ eventually_ge_at_top x).mono $
    λ i hbi hai, ⟨hai, hbi⟩ ),
  measurable := λ i, measurable_set_Icc }

lemma ae_cover_Ici :
  ae_cover μ l (λ i, Ici $ a i) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha.eventually $ eventually_le_at_bot x).mono $
    λ i hai, hai ),
  measurable := λ i, measurable_set_Ici }

lemma ae_cover_Iic :
  ae_cover μ l (λ i, Iic $ b i) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (hb.eventually $ eventually_ge_at_top x).mono $
    λ i hbi, hbi ),
  measurable := λ i, measurable_set_Iic }

end preorder_α

section linear_order_α

variables [linear_order α] [topological_space α] [order_closed_topology α]
  [opens_measurable_space α] {a b : ι → α}
  (ha : tendsto a l at_bot) (hb : tendsto b l at_top)

lemma ae_cover_Ioo [no_bot_order α] [no_top_order α] :
  ae_cover μ l (λ i, Ioo (a i) (b i)) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha.eventually $ eventually_lt_at_bot x).mp $
    (hb.eventually $ eventually_gt_at_top x).mono $
    λ i hbi hai, ⟨hai, hbi⟩ ),
  measurable := λ i, measurable_set_Ioo }

lemma ae_cover_Ioc [no_bot_order α] : ae_cover μ l (λ i, Ioc (a i) (b i)) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha.eventually $ eventually_lt_at_bot x).mp $
    (hb.eventually $ eventually_ge_at_top x).mono $
    λ i hbi hai, ⟨hai, hbi⟩ ),
  measurable := λ i, measurable_set_Ioc }

lemma ae_cover_Ico [no_top_order α] : ae_cover μ l (λ i, Ico (a i) (b i)) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha.eventually $ eventually_le_at_bot x).mp $
    (hb.eventually $ eventually_gt_at_top x).mono $
    λ i hbi hai, ⟨hai, hbi⟩ ),
  measurable := λ i, measurable_set_Ico }

lemma ae_cover_Ioi [no_bot_order α] :
  ae_cover μ l (λ i, Ioi $ a i) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (ha.eventually $ eventually_lt_at_bot x).mono $
    λ i hai, hai ),
  measurable := λ i, measurable_set_Ioi }

lemma ae_cover_Iio [no_top_order α] :
  ae_cover μ l (λ i, Iio $ b i) :=
{ ae_eventually_mem := ae_of_all μ (λ x,
    (hb.eventually $ eventually_gt_at_top x).mono $
    λ i hbi, hbi ),
  measurable := λ i, measurable_set_Iio }

end linear_order_α

lemma ae_cover.restrict {φ : ι → set α} (hφ : ae_cover μ l φ) {s : set α} :
  ae_cover (μ.restrict s) l φ :=
{ ae_eventually_mem := ae_restrict_of_ae hφ.ae_eventually_mem,
  measurable := hφ.measurable }

lemma ae_cover_restrict_of_ae_imp {s : set α} {φ : ι → set α}
  (hs : measurable_set s) (ae_eventually_mem : ∀ᵐ x ∂μ, x ∈ s → ∀ᶠ n in l, x ∈ φ n)
  (measurable : ∀ n, measurable_set $ φ n) :
  ae_cover (μ.restrict s) l φ :=
{ ae_eventually_mem := by rwa ae_restrict_iff' hs,
  measurable := measurable }

lemma ae_cover.inter_restrict {φ : ι → set α} (hφ : ae_cover μ l φ)
  {s : set α} (hs : measurable_set s) :
  ae_cover (μ.restrict s) l (λ i, φ i ∩ s) :=
ae_cover_restrict_of_ae_imp hs
  (hφ.ae_eventually_mem.mono (λ x hx hxs, hx.mono $ λ i hi, ⟨hi, hxs⟩))
  (λ i, (hφ.measurable i).inter hs)

lemma ae_cover.ae_tendsto_indicator {β : Type*} [has_zero β] [topological_space β]
  (f : α → β) {φ : ι → set α} (hφ : ae_cover μ l φ) :
  ∀ᵐ x ∂μ, tendsto (λ i, (φ i).indicator f x) l (𝓝 $ f x) :=
hφ.ae_eventually_mem.mono (λ x hx, tendsto_const_nhds.congr' $
  hx.mono $ λ n hn, (indicator_of_mem hn _).symm)

lemma ae_cover.ae_measurable {β : Type*} [measurable_space β] [l.is_countably_generated] [l.ne_bot]
  {f : α → β} {φ : ι → set α} (hφ : ae_cover μ l φ)
  (hfm : ∀ i, ae_measurable f (μ.restrict $ φ i)) : ae_measurable f μ :=
begin
  obtain ⟨u, hu⟩ := l.exists_seq_tendsto,
  have := ae_measurable_Union_iff.mpr (λ (n : ℕ), hfm (u n)),
  rwa measure.restrict_eq_self_of_ae_mem at this,
  filter_upwards [hφ.ae_eventually_mem]
    (λ x hx, let ⟨i, hi⟩ := (hu.eventually hx).exists in mem_Union.mpr ⟨i, hi⟩)
end

end ae_cover

lemma ae_cover.comp_tendsto {α ι ι' : Type*} [measurable_space α] {μ : measure α} {l : filter ι}
  {l' : filter ι'} {φ : ι → set α} (hφ : ae_cover μ l φ)
  {u : ι' → ι} (hu : tendsto u l' l) :
  ae_cover μ l' (φ ∘ u) :=
{ ae_eventually_mem := hφ.ae_eventually_mem.mono (λ x hx, hu.eventually hx),
  measurable := λ i, hφ.measurable (u i) }

section ae_cover_Union_Inter_encodable

variables {α ι : Type*} [encodable ι]
  [measurable_space α] {μ : measure α}

lemma ae_cover.bInter_Ici_ae_cover [semilattice_sup ι] [nonempty ι] {φ : ι → set α}
  (hφ : ae_cover μ at_top φ) : ae_cover μ at_top (λ (n : ι), ⋂ k (h : k ∈ Ici n), φ k) :=
{ ae_eventually_mem := hφ.ae_eventually_mem.mono
    begin
      intros x h,
      rw eventually_at_top at *,
      rcases h with ⟨i, hi⟩,
      use i,
      intros j hj,
      exact mem_bInter (λ k hk, hi k (le_trans hj hk)),
    end,
  measurable := λ i, measurable_set.bInter (countable_encodable _) (λ n _, hφ.measurable n) }

end ae_cover_Union_Inter_encodable

section lintegral

variables {α ι : Type*} [measurable_space α] {μ : measure α} {l : filter ι}

private lemma lintegral_tendsto_of_monotone_of_nat {φ : ℕ → set α}
  (hφ : ae_cover μ at_top φ) (hmono : monotone φ) {f : α → ℝ≥0∞} (hfm : ae_measurable f μ) :
  tendsto (λ i, ∫⁻ x in φ i, f x ∂μ) at_top (𝓝 $ ∫⁻ x, f x ∂μ) :=
let F := λ n, (φ n).indicator f in
have key₁ : ∀ n, ae_measurable (F n) μ, from λ n, hfm.indicator (hφ.measurable n),
have key₂ : ∀ᵐ (x : α) ∂μ, monotone (λ n, F n x), from ae_of_all _
  (λ x i j hij, indicator_le_indicator_of_subset (hmono hij) (λ x, zero_le $ f x) x),
have key₃ : ∀ᵐ (x : α) ∂μ, tendsto (λ n, F n x) at_top (𝓝 (f x)), from hφ.ae_tendsto_indicator f,
(lintegral_tendsto_of_tendsto_of_monotone key₁ key₂ key₃).congr
  (λ n, lintegral_indicator f (hφ.measurable n))

lemma ae_cover.lintegral_tendsto_of_nat {φ : ℕ → set α} (hφ : ae_cover μ at_top φ)
  {f : α → ℝ≥0∞} (hfm : ae_measurable f μ) :
  tendsto (λ i, ∫⁻ x in φ i, f x ∂μ) at_top (𝓝 $ ∫⁻ x, f x ∂μ) :=
begin
  have lim₁ := lintegral_tendsto_of_monotone_of_nat (hφ.bInter_Ici_ae_cover)
    (λ i j hij, bInter_subset_bInter_left (Ici_subset_Ici.mpr hij)) hfm,
  have lim₂ := lintegral_tendsto_of_monotone_of_nat (hφ.bUnion_Iic_ae_cover)
    (λ i j hij, bUnion_subset_bUnion_left (Iic_subset_Iic.mpr hij)) hfm,
  have le₁ := λ n, lintegral_mono_set (bInter_subset_of_mem left_mem_Ici),
  have le₂ := λ n, lintegral_mono_set (subset_bUnion_of_mem right_mem_Iic),
  exact tendsto_of_tendsto_of_tendsto_of_le_of_le lim₁ lim₂ le₁ le₂
end

lemma ae_cover.lintegral_tendsto_of_countably_generated [l.is_countably_generated]
  {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → ℝ≥0∞}
  (hfm : ae_measurable f μ) : tendsto (λ i, ∫⁻ x in φ i, f x ∂μ) l (𝓝 $ ∫⁻ x, f x ∂μ) :=
tendsto_of_seq_tendsto (λ u hu, (hφ.comp_tendsto hu).lintegral_tendsto_of_nat hfm)

lemma ae_cover.lintegral_eq_of_tendsto [l.ne_bot] [l.is_countably_generated]
  {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → ℝ≥0∞} (I : ℝ≥0∞)
  (hfm : ae_measurable f μ) (htendsto : tendsto (λ i, ∫⁻ x in φ i, f x ∂μ) l (𝓝 I)) :
  ∫⁻ x, f x ∂μ = I :=
tendsto_nhds_unique (hφ.lintegral_tendsto_of_countably_generated hfm) htendsto

lemma ae_cover.supr_lintegral_eq_of_countably_generated [nonempty ι] [l.ne_bot]
  [l.is_countably_generated] {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → ℝ≥0∞}
  (hfm : ae_measurable f μ) : (⨆ (i : ι), ∫⁻ x in φ i, f x ∂μ) = ∫⁻ x, f x ∂μ :=
begin
  have := hφ.lintegral_tendsto_of_countably_generated hfm,
  refine csupr_eq_of_forall_le_of_forall_lt_exists_gt
    (λ i, lintegral_mono' measure.restrict_le_self (le_refl _)) (λ w hw, _),
  rcases exists_between hw with ⟨m, hm₁, hm₂⟩,
  rcases (eventually_ge_of_tendsto_gt hm₂ this).exists with ⟨i, hi⟩,
  exact ⟨i, lt_of_lt_of_le hm₁ hi⟩,
end

end lintegral

section integrable

variables {α ι E : Type*} [measurable_space α] {μ : measure α} {l : filter ι}
  [normed_group E] [measurable_space E] [opens_measurable_space E]

lemma ae_cover.integrable_of_lintegral_nnnorm_tendsto [l.ne_bot] [l.is_countably_generated]
  {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E} (I : ℝ)
  (hfm : ae_measurable f μ)
  (htendsto : tendsto (λ i, ∫⁻ x in φ i, nnnorm (f x) ∂μ) l (𝓝 $ ennreal.of_real I)) :
  integrable f μ :=
begin
  refine ⟨hfm, _⟩,
  unfold has_finite_integral,
  rw hφ.lintegral_eq_of_tendsto _ (measurable_nnnorm.comp_ae_measurable hfm).coe_nnreal_ennreal
    htendsto,
  exact ennreal.of_real_lt_top
end

lemma ae_cover.integrable_of_lintegral_nnnorm_tendsto' [l.ne_bot] [l.is_countably_generated]
  {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E} (I : ℝ≥0)
  (hfm : ae_measurable f μ)
  (htendsto : tendsto (λ i, ∫⁻ x in φ i, nnnorm (f x) ∂μ) l (𝓝 $ ennreal.of_real I)) :
  integrable f μ :=
hφ.integrable_of_lintegral_nnnorm_tendsto I hfm htendsto

lemma ae_cover.integrable_of_integral_norm_tendsto [l.ne_bot] [l.is_countably_generated]
  {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E}
  (I : ℝ) (hfi : ∀ i, integrable_on f (φ i) μ)
  (htendsto : tendsto (λ i, ∫ x in φ i, ∥f x∥ ∂μ) l (𝓝 I)) :
  integrable f μ :=
begin
  have hfm : ae_measurable f μ := hφ.ae_measurable (λ i, (hfi i).ae_measurable),
  refine hφ.integrable_of_lintegral_nnnorm_tendsto I hfm _,
  conv at htendsto in (integral _ _)
  { rw integral_eq_lintegral_of_nonneg_ae (ae_of_all _ (λ x, @norm_nonneg E _ (f x)))
    hfm.norm.restrict },
  conv at htendsto in (ennreal.of_real _) { dsimp, rw ← coe_nnnorm, rw ennreal.of_real_coe_nnreal },
  convert ennreal.tendsto_of_real htendsto,
  ext i : 1,
  rw ennreal.of_real_to_real _,
  exact ne_top_of_lt (hfi i).2
end

lemma ae_cover.integrable_of_integral_tendsto_of_nonneg_ae [l.ne_bot] [l.is_countably_generated]
  {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → ℝ} (I : ℝ)
  (hfi : ∀ i, integrable_on f (φ i) μ) (hnng : ∀ᵐ x ∂μ, 0 ≤ f x)
  (htendsto : tendsto (λ i, ∫ x in φ i, f x ∂μ) l (𝓝 I)) :
  integrable f μ :=
hφ.integrable_of_integral_norm_tendsto I hfi
  (htendsto.congr $ λ i, integral_congr_ae $ ae_restrict_of_ae $ hnng.mono $
    λ x hx, (real.norm_of_nonneg hx).symm)

end integrable

section integral

variables {α ι E : Type*} [measurable_space α] {μ : measure α} {l : filter ι}
  [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
  [complete_space E] [second_countable_topology E]

lemma ae_cover.integral_tendsto_of_countably_generated [l.is_countably_generated]
  {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E} (hfi : integrable f μ) :
  tendsto (λ i, ∫ x in φ i, f x ∂μ) l (𝓝 $ ∫ x, f x ∂μ) :=
suffices h : tendsto (λ i, ∫ (x : α), (φ i).indicator f x ∂μ) l (𝓝 (∫ (x : α), f x ∂μ)),
by { convert h, ext n, rw integral_indicator (hφ.measurable n) },
tendsto_integral_filter_of_dominated_convergence (λ x, ∥f x∥)
  (eventually_of_forall $ λ i, hfi.ae_measurable.indicator $ hφ.measurable i)
  (eventually_of_forall $ λ i, ae_of_all _ $ λ x, norm_indicator_le_norm_self _ _)
  hfi.norm (hφ.ae_tendsto_indicator f)

/-- Slight reformulation of
    `measure_theory.ae_cover.integral_tendsto_of_countably_generated`. -/
lemma ae_cover.integral_eq_of_tendsto [l.ne_bot] [l.is_countably_generated]
  {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E}
  (I : E) (hfi : integrable f μ)
  (h : tendsto (λ n, ∫ x in φ n, f x ∂μ) l (𝓝 I)) :
  ∫ x, f x ∂μ = I :=
tendsto_nhds_unique (hφ.integral_tendsto_of_countably_generated hfi) h

lemma ae_cover.integral_eq_of_tendsto_of_nonneg_ae [l.ne_bot] [l.is_countably_generated]
  {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → ℝ} (I : ℝ)
  (hnng : 0 ≤ᵐ[μ] f) (hfi : ∀ n, integrable_on f (φ n) μ)
  (htendsto : tendsto (λ n, ∫ x in φ n, f x ∂μ) l (𝓝 I)) :
  ∫ x, f x ∂μ = I :=
have hfi' : integrable f μ,
  from hφ.integrable_of_integral_tendsto_of_nonneg_ae I hfi hnng htendsto,
hφ.integral_eq_of_tendsto I hfi' htendsto

end integral

section integrable_of_interval_integral

variables {α ι E : Type*}
          [topological_space α] [linear_order α] [order_closed_topology α]
          [measurable_space α] [opens_measurable_space α] {μ : measure α}
          {l : filter ι} [filter.ne_bot l] [is_countably_generated l]
          [measurable_space E] [normed_group E] [borel_space E]
          {a b : ι → α} {f : α → E}

lemma integrable_of_interval_integral_norm_tendsto [no_bot_order α] [nonempty α]
  (I : ℝ) (hfi : ∀ i, integrable_on f (Ioc (a i) (b i)) μ)
  (ha : tendsto a l at_bot) (hb : tendsto b l at_top)
  (h : tendsto (λ i, ∫ x in a i .. b i, ∥f x∥ ∂μ) l (𝓝 $ I)) :
  integrable f μ :=
begin
  let φ := λ n, Ioc (a n) (b n),
  let c : α := classical.choice ‹_›,
  have hφ : ae_cover μ l φ := ae_cover_Ioc ha hb,
  refine hφ.integrable_of_integral_norm_tendsto _ hfi (h.congr' _),
  filter_upwards [ha.eventually (eventually_le_at_bot c), hb.eventually (eventually_ge_at_top c)],
  intros i hai hbi,
  exact interval_integral.integral_of_le (hai.trans hbi)
end

lemma integrable_on_Iic_of_interval_integral_norm_tendsto [no_bot_order α] (I : ℝ) (b : α)
  (hfi : ∀ i, integrable_on f (Ioc (a i) b) μ) (ha : tendsto a l at_bot)
  (h : tendsto (λ i, ∫ x in a i .. b, ∥f x∥ ∂μ) l (𝓝 $ I)) :
  integrable_on f (Iic b) μ :=
begin
  let φ := λ i, Ioi (a i),
  have hφ : ae_cover (μ.restrict $ Iic b) l φ := ae_cover_Ioi ha,
  have hfi : ∀ i, integrable_on f (φ i) (μ.restrict $ Iic b),
  { intro i,
    rw [integrable_on, measure.restrict_restrict (hφ.measurable i)],
    exact hfi i },
  refine hφ.integrable_of_integral_norm_tendsto _ hfi (h.congr' _),
  filter_upwards [ha.eventually (eventually_le_at_bot b)],
  intros i hai,
  rw [interval_integral.integral_of_le hai, measure.restrict_restrict (hφ.measurable i)],
  refl
end

lemma integrable_on_Ioi_of_interval_integral_norm_tendsto (I : ℝ) (a : α)
  (hfi : ∀ i, integrable_on f (Ioc a (b i)) μ) (hb : tendsto b l at_top)
  (h : tendsto (λ i, ∫ x in a .. b i, ∥f x∥ ∂μ) l (𝓝 $ I)) :
  integrable_on f (Ioi a) μ :=
begin
  let φ := λ i, Iic (b i),
  have hφ : ae_cover (μ.restrict $ Ioi a) l φ := ae_cover_Iic hb,
  have hfi : ∀ i, integrable_on f (φ i) (μ.restrict $ Ioi a),
  { intro i,
    rw [integrable_on, measure.restrict_restrict (hφ.measurable i), inter_comm],
    exact hfi i },
  refine hφ.integrable_of_integral_norm_tendsto _ hfi (h.congr' _),
  filter_upwards [hb.eventually (eventually_ge_at_top $ a)],
  intros i hbi,
  rw [interval_integral.integral_of_le hbi, measure.restrict_restrict (hφ.measurable i),
      inter_comm],
  refl
end

end integrable_of_interval_integral

section integral_of_interval_integral

variables {α ι E : Type*}
          [topological_space α] [linear_order α] [order_closed_topology α]
          [measurable_space α] [opens_measurable_space α] {μ : measure α}
          {l : filter ι} [is_countably_generated l]
          [measurable_space E] [normed_group E] [normed_space ℝ E] [borel_space E]
          [complete_space E] [second_countable_topology E]
          {a b : ι → α} {f : α → E}

lemma interval_integral_tendsto_integral [no_bot_order α] [nonempty α]
  (hfi : integrable f μ) (ha : tendsto a l at_bot) (hb : tendsto b l at_top) :
  tendsto (λ i, ∫ x in a i .. b i, f x ∂μ) l (𝓝 $ ∫ x, f x ∂μ) :=
begin
  let φ := λ i, Ioc (a i) (b i),
  let c : α := classical.choice ‹_›,
  have hφ : ae_cover μ l φ := ae_cover_Ioc ha hb,
  refine (hφ.integral_tendsto_of_countably_generated hfi).congr' _,
  filter_upwards [ha.eventually (eventually_le_at_bot c), hb.eventually (eventually_ge_at_top c)],
  intros i hai hbi,
  exact (interval_integral.integral_of_le (hai.trans hbi)).symm
end

lemma interval_integral_tendsto_integral_Iic [no_bot_order α] (b : α)
  (hfi : integrable_on f (Iic b) μ) (ha : tendsto a l at_bot) :
  tendsto (λ i, ∫ x in a i .. b, f x ∂μ) l (𝓝 $ ∫ x in Iic b, f x ∂μ) :=
begin
  let φ := λ i, Ioi (a i),
  have hφ : ae_cover (μ.restrict $ Iic b) l φ := ae_cover_Ioi ha,
  refine (hφ.integral_tendsto_of_countably_generated hfi).congr' _,
  filter_upwards [ha.eventually (eventually_le_at_bot $ b)],
  intros i hai,
  rw [interval_integral.integral_of_le hai, measure.restrict_restrict (hφ.measurable i)],
  refl
end

lemma interval_integral_tendsto_integral_Ioi (a : α)
  (hfi : integrable_on f (Ioi a) μ) (hb : tendsto b l at_top) :
  tendsto (λ i, ∫ x in a .. b i, f x ∂μ) l (𝓝 $ ∫ x in Ioi a, f x ∂μ) :=
begin
  let φ := λ i, Iic (b i),
  have hφ : ae_cover (μ.restrict $ Ioi a) l φ := ae_cover_Iic hb,
  refine (hφ.integral_tendsto_of_countably_generated hfi).congr' _,
  filter_upwards [hb.eventually (eventually_ge_at_top $ a)],
  intros i hbi,
  rw [interval_integral.integral_of_le hbi, measure.restrict_restrict (hφ.measurable i),
      inter_comm],
  refl
end

end integral_of_interval_integral

end measure_theory


import data.real.basic

theorem USAMO_Problem_4_2002 (f : ℝ → ℝ) :
(∀ x y : ℝ, f(x^2 - y^2) = x*f(x) - y * f(y)) → ∃ l : ℝ, ∀ x  : ℝ, f(x) = l*x := sorry


import data.stream.defs
import data.bool.all_any
import data.lazy_list
import tactic

open expr tactic widget

def collatz_one_step (n : ℕ) : ℕ :=
  if n % 2 = 0 then n / 2
  else 3 * n + 1

def collatz : ℕ → stream ℕ
  | n 0 := n
  | n (k + 1) := collatz_one_step (collatz n k)

variable (n : ℕ)

def collatz_conjecture : Prop := ∃ k : ℕ, collatz n k = 1

-----------------------------------------------------------------

meta def prove_even_aux : ℕ → tactic unit
| n :=
do {
  `(even %%p) ← target,
  tp ← infer_type p,
  guard (tp = `(ℕ)),
  to_expr ``(%%(reflect n)) >>= existsi,
  exact_dec_trivial,
  trace $ (to_string n) ++ " works!" }
<|> (do
  trace $ (to_string n) ++ " doesn't work.",
  (prove_even_aux n.succ)
)

meta def prove_even : tactic unit := prove_even_aux 4

-----------------------------------------------------------------

meta def prove_collatz_aux : Π n : ℕ, tactic unit
| n :=
do {
  `(collatz_conjecture %%p) ← target,
  tp ← infer_type p,
  guard (tp = `(ℕ)),
  to_expr ``(%%(reflect n)) >>= existsi,
  exact_dec_trivial,
  trace $ (to_string n) ++ " works!!"
}
<|> (do
  trace $ (to_string n) ++ " doesn't work.",
  (prove_collatz_aux n.succ)
)

meta def prove_collatz : tactic unit := prove_collatz_aux 0

example : even 8 := by prove_even
example : even 8 := by use 4
example : even 8 := Exists.intro 4 (id (eq.refl 8))

example : collatz_conjecture 13 := by prove_collatz
example : collatz_conjecture 13 := by { use 9, dsimp [collatz, collatz_one_step], norm_num, }

set_option profiler true

theorem small_collatz : ∀ n (h : 1 ≤ n ∧ n ≤ 10), collatz_conjecture n :=
begin
  rintro n ⟨ln, hn⟩,
  replace hn := nat.lt_succ_of_le hn,
  interval_cases using ln hn;
  -- prove_collatz,
end

-- This requires 110 iterations, won't work -- it literally times out
theorem collatz_27 : collatz_conjecture 27 := by prove_collatz

-- However, if I compute the collatz list directly, it works?
#eval (collatz 27).take 112
#eval ((list.range 501).filter (λ n, collatz 27 n = 1)).nth 0

-- The following takes 238 iterations
#eval (collatz 3711).take 238
#eval ((list.range 500).filter (λ n, collatz 3711 n = 1)).nth 0

-- Large numbers (1242 iterations)
def N := 128202387348288784730229060763884567453
#eval (collatz N).nth 5
#eval ((list.range 2000).filter (λ n, collatz N n = 1)).nth 0


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.basic
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Univariate monomials

Preparatory lemmas for degree_basic.
-/

namespace polynomial

/--
`C a` is the constant polynomial `a`.
`C` is provided as a ring homomorphism.
-/
def C {R : Type u} [semiring R] : R →+* polynomial R :=
  add_monoid_algebra.single_zero_ring_hom

@[simp] theorem monomial_zero_left {R : Type u} [semiring R] (a : R) : coe_fn (monomial 0) a = coe_fn C a :=
  rfl

theorem C_0 {R : Type u} [semiring R] : coe_fn C 0 = 0 :=
  finsupp.single_zero

theorem C_1 {R : Type u} [semiring R] : coe_fn C 1 = 1 :=
  rfl

theorem C_mul {R : Type u} {a : R} {b : R} [semiring R] : coe_fn C (a * b) = coe_fn C a * coe_fn C b :=
  ring_hom.map_mul C a b

theorem C_add {R : Type u} {a : R} {b : R} [semiring R] : coe_fn C (a + b) = coe_fn C a + coe_fn C b :=
  ring_hom.map_add C a b

@[simp] theorem C_bit0 {R : Type u} {a : R} [semiring R] : coe_fn C (bit0 a) = bit0 (coe_fn C a) :=
  C_add

@[simp] theorem C_bit1 {R : Type u} {a : R} [semiring R] : coe_fn C (bit1 a) = bit1 (coe_fn C a) := sorry

theorem C_pow {R : Type u} {a : R} {n : ℕ} [semiring R] : coe_fn C (a ^ n) = coe_fn C a ^ n :=
  ring_hom.map_pow C a n

@[simp] theorem C_eq_nat_cast {R : Type u} [semiring R] (n : ℕ) : coe_fn C ↑n = ↑n :=
  ring_hom.map_nat_cast C n

@[simp] theorem sum_C_index {R : Type u} [semiring R] {a : R} {β : Type u_1} [add_comm_monoid β] {f : ℕ → R → β} (h : f 0 0 = 0) : finsupp.sum (coe_fn C a) f = f 0 a :=
  finsupp.sum_single_index h

theorem coeff_C {R : Type u} {a : R} {n : ℕ} [semiring R] : coeff (coe_fn C a) n = ite (n = 0) a 0 := sorry

@[simp] theorem coeff_C_zero {R : Type u} {a : R} [semiring R] : coeff (coe_fn C a) 0 = a :=
  coeff_monomial

theorem nontrivial.of_polynomial_ne {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} (h : p ≠ q) : nontrivial R := sorry

theorem single_eq_C_mul_X {R : Type u} {a : R} [semiring R] {n : ℕ} : coe_fn (monomial n) a = coe_fn C a * X ^ n := sorry

@[simp] theorem C_inj {R : Type u} {a : R} {b : R} [semiring R] : coe_fn C a = coe_fn C b ↔ a = b :=
  { mp := fun (h : coe_fn C a = coe_fn C b) => Eq.trans (Eq.symm coeff_C_zero) (Eq.symm h ▸ coeff_C_zero),
    mpr := congr_arg ⇑C }

@[simp] theorem C_eq_zero {R : Type u} {a : R} [semiring R] : coe_fn C a = 0 ↔ a = 0 :=
  iff.trans
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn C a = 0 ↔ coe_fn C a = coe_fn C 0)) C_0)) (iff.refl (coe_fn C a = 0))) C_inj

protected instance infinite {R : Type u} [semiring R] [nontrivial R] : infinite (polynomial R) := sorry

theorem monomial_eq_smul_X {R : Type u} {a : R} [semiring R] {n : ℕ} : coe_fn (monomial n) a = a • X ^ n := sorry

theorem ring_hom_ext {R : Type u} [semiring R] {S : Type u_1} [semiring S] {f : polynomial R →+* S} {g : polynomial R →+* S} (h₁ : ∀ (a : R), coe_fn f (coe_fn C a) = coe_fn g (coe_fn C a)) (h₂ : coe_fn f X = coe_fn g X) : f = g :=
  add_monoid_algebra.ring_hom_ext' (ring_hom.ext fun (x : R) => h₁ x) (monoid_hom.ext_mnat h₂)

theorem ring_hom_ext' {R : Type u} [semiring R] {S : Type u_1} [semiring S] {f : polynomial R →+* S} {g : polynomial R →+* S} (h₁ : ring_hom.comp f C = ring_hom.comp g C) (h₂ : coe_fn f X = coe_fn g X) : f = g :=
  ring_hom_ext (ring_hom.congr_fun h₁) h₂


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

! This file was ported from Lean 3 source module data.sigma.lex
! leanprover-community/mathlib commit 41cf0cc2f528dd40a8f2db167ea4fb37b8fde7f3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Sigma.Basic
import Mathlib.Order.RelClasses

/-!
# Lexicographic order on a sigma type

This defines the lexicographical order of two arbitrary relations on a sigma type and proves some
lemmas about `PSigma.Lex`, which is defined in core Lean.

Given a relation in the index type and a relation on each summand, the lexicographical order on the
sigma type relates `a` and `b` if their summands are related or they are in the same summand and
related by the summand's relation.

## See also

Related files are:
* `Combinatorics.CoLex`: Colexicographic order on finite sets.
* `Data.List.Lex`: Lexicographic order on lists.
* `Data.Sigma.Order`: Lexicographic order on `Σ i, α i` per say.
* `Data.PSigma.Order`: Lexicographic order on `Σ' i, α i`.
* `Data.Prod.Lex`: Lexicographic order on `α × β`. Can be thought of as the special case of
  `Sigma.Lex` where all summands are the same
-/

namespace Sigma

variable {ι : Type _} {α : ι → Type _} {r r₁ r₂ : ι → ι → Prop} {s s₁ s₂ : ∀ i, α i → α i → Prop}
  {a b : Σ i, α i}

/-- The lexicographical order on a sigma type. It takes in a relation on the index type and a
relation for each summand. `a` is related to `b` iff their summands are related or they are in the
same summand and are related through the summand's relation. -/
inductive Lex (r : ι → ι → Prop) (s : ∀ i, α i → α i → Prop) : ∀ _ _ : Σ i, α i, Prop
  | left {i j : ι} (a : α i) (b : α j) : r i j → Lex r s ⟨i, a⟩ ⟨j, b⟩
  | right {i : ι} (a b : α i) : s i a b → Lex r s ⟨i, a⟩ ⟨i, b⟩
#align sigma.lex Sigma.Lex

theorem lex_iff : Lex r s a b ↔ r a.1 b.1 ∨ ∃ h : a.1 = b.1, s b.1 (h.rec a.2) b.2 := by
  constructor
  · rintro (⟨a, b, hij⟩ | ⟨a, b, hab⟩)
    · exact Or.inl hij
    · exact Or.inr ⟨rfl, hab⟩
  · obtain ⟨i, a⟩ := a
    obtain ⟨j, b⟩ := b
    dsimp only
    rintro (h | ⟨rfl, h⟩)
    · exact Lex.left _ _ h
    · exact Lex.right _ _ h
#align sigma.lex_iff Sigma.lex_iff

instance Lex.decidable (r : ι → ι → Prop) (s : ∀ i, α i → α i → Prop) [DecidableEq ι]
    [DecidableRel r] [∀ i, DecidableRel (s i)] : DecidableRel (Lex r s) := fun _ _ =>
  decidable_of_decidable_of_iff lex_iff.symm
#align sigma.lex.decidable Sigma.Lex.decidable

theorem Lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ i, α i}
    (h : Lex r₁ s₁ a b) : Lex r₂ s₂ a b := by
  obtain ⟨a, b, hij⟩ | ⟨a, b, hab⟩ := h
  · exact Lex.left _ _ (hr _ _ hij)
  · exact Lex.right _ _ (hs _ _ _ hab)
#align sigma.lex.mono Sigma.Lex.mono

theorem Lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) {a b : Σ i, α i} (h : Lex r₁ s a b) :
    Lex r₂ s a b :=
  h.mono hr $ fun _ _ _ => id
#align sigma.lex.mono_left Sigma.Lex.mono_left

theorem Lex.mono_right (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ i, α i} (h : Lex r s₁ a b) :
    Lex r s₂ a b :=
  h.mono (fun _ _ => id) hs
#align sigma.lex.mono_right Sigma.Lex.mono_right

theorem lex_swap : Lex (Function.swap r) s a b ↔ Lex r (fun i => Function.swap (s i)) b a := by
  constructor <;>
    · rintro (⟨a, b, h⟩ | ⟨a, b, h⟩)
      exacts [Lex.left _ _ h, Lex.right _ _ h]
#align sigma.lex_swap Sigma.lex_swap

instance [∀ i, IsRefl (α i) (s i)] : IsRefl _ (Lex r s) :=
  ⟨fun ⟨_, _⟩ => Lex.right _ _ $ refl _⟩

instance [IsIrrefl ι r] [∀ i, IsIrrefl (α i) (s i)] : IsIrrefl _ (Lex r s) :=
  ⟨by
    rintro _ (⟨a, b, hi⟩ | ⟨a, b, ha⟩)
    · exact irrefl _ hi
    · exact irrefl _ ha
      ⟩

instance [IsTrans ι r] [∀ i, IsTrans (α i) (s i)] : IsTrans _ (Lex r s) :=
  ⟨by
    rintro _ _ _ (⟨a, b, hij⟩ | ⟨a, b, hab⟩) (⟨_, c, hk⟩ | ⟨_, c, hc⟩)
    · exact Lex.left _ _ (_root_.trans hij hk)
    · exact Lex.left _ _ hij
    · exact Lex.left _ _ hk
    · exact Lex.right _ _ (_root_.trans hab hc)⟩

instance [IsSymm ι r] [∀ i, IsSymm (α i) (s i)] : IsSymm _ (Lex r s) :=
  ⟨by
    rintro _ _ (⟨a, b, hij⟩ | ⟨a, b, hab⟩)
    · exact Lex.left _ _ (symm hij)
    · exact Lex.right _ _ (symm hab)
      ⟩

attribute [local instance] IsAsymm.isIrrefl

instance [IsAsymm ι r] [∀ i, IsAntisymm (α i) (s i)] : IsAntisymm _ (Lex r s) :=
  ⟨by
    rintro _ _ (⟨a, b, hij⟩ | ⟨a, b, hab⟩) (⟨_, _, hji⟩ | ⟨_, _, hba⟩)
    · exact (asymm hij hji).elim
    · exact (irrefl _ hij).elim
    · exact (irrefl _ hji).elim
    · exact ext rfl (heq_of_eq $ antisymm hab hba)⟩

instance [IsTrichotomous ι r] [∀ i, IsTotal (α i) (s i)] : IsTotal _ (Lex r s) :=
  ⟨by
    rintro ⟨i, a⟩ ⟨j, b⟩
    obtain hij | rfl | hji := trichotomous_of r i j
    · exact Or.inl (Lex.left _ _ hij)
    · obtain hab | hba := total_of (s i) a b
      · exact Or.inl (Lex.right _ _ hab)
      · exact Or.inr (Lex.right _ _ hba)
    · exact Or.inr (Lex.left _ _ hji)⟩

instance [IsTrichotomous ι r] [∀ i, IsTrichotomous (α i) (s i)] : IsTrichotomous _ (Lex r s) :=
  ⟨by
    rintro ⟨i, a⟩ ⟨j, b⟩
    obtain hij | rfl | hji := trichotomous_of r i j
    · exact Or.inl (Lex.left _ _ hij)
    · obtain hab | rfl | hba := trichotomous_of (s i) a b
      · exact Or.inl (Lex.right _ _ hab)
      · exact Or.inr (Or.inl rfl)
      · exact Or.inr (Or.inr $ Lex.right _ _ hba)
    · exact Or.inr (Or.inr $ Lex.left _ _ hji)⟩

end Sigma

/-! ### `PSigma` -/

namespace PSigma

variable {ι : Sort _} {α : ι → Sort _} {r r₁ r₂ : ι → ι → Prop} {s s₁ s₂ : ∀ i, α i → α i → Prop}

theorem lex_iff {a b : Σ' i, α i} :
    Lex r s a b ↔ r a.1 b.1 ∨ ∃ h : a.1 = b.1, s b.1 (h.rec a.2) b.2 := by
  constructor
  · rintro (⟨a, b, hij⟩ | ⟨i, hab⟩)
    · exact Or.inl hij
    · exact Or.inr ⟨rfl, hab⟩
  · obtain ⟨i, a⟩ := a
    obtain ⟨j, b⟩ := b
    dsimp only
    rintro (h | ⟨rfl, h⟩)
    · exact Lex.left _ _ h
    · exact Lex.right _ h

#align psigma.lex_iff PSigma.lex_iff

instance Lex.decidable (r : ι → ι → Prop) (s : ∀ i, α i → α i → Prop) [DecidableEq ι]
    [DecidableRel r] [∀ i, DecidableRel (s i)] : DecidableRel (Lex r s) := fun _ _ =>
  decidable_of_decidable_of_iff lex_iff.symm
#align psigma.lex.decidable PSigma.Lex.decidable

theorem Lex.mono {r₁ r₂ : ι → ι → Prop} {s₁ s₂ : ∀ i, α i → α i → Prop}
  (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ' i, α i}
    (h : Lex r₁ s₁ a b) : Lex r₂ s₂ a b := by
  obtain ⟨a, b, hij⟩ | ⟨i, hab⟩ := h
  · exact Lex.left _ _ (hr _ _ hij)
  · exact Lex.right _ (hs _ _ _ hab)
#align psigma.lex.mono PSigma.Lex.mono

theorem Lex.mono_left {r₁ r₂ : ι → ι → Prop} {s : ∀ i, α i → α i → Prop}
    (hr : ∀ a b, r₁ a b → r₂ a b) {a b : Σ' i, α i} (h : Lex r₁ s a b) : Lex r₂ s a b :=
  h.mono hr $ fun _ _ _ => id
#align psigma.lex.mono_left PSigma.Lex.mono_left

theorem Lex.mono_right {r : ι → ι → Prop} {s₁ s₂ : ∀ i, α i → α i → Prop}
    (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ' i, α i} (h : Lex r s₁ a b) : Lex r s₂ a b :=
  h.mono (fun _ _ => id) hs
#align psigma.lex.mono_right PSigma.Lex.mono_right

end PSigma


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

import algebra.algebra.tower
import data.polynomial.algebra_map

/-!
# Algebra towers for polynomial

This file proves some basic results about the algebra tower structure for the type `polynomial R`.

This structure itself is provided elsewhere as `polynomial.is_scalar_tower`
-/

universes u v w u₁

variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)

namespace is_scalar_tower

section semiring
variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B] [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

variables (R S A) {B}
theorem aeval_apply (x : A) (p : polynomial R) : polynomial.aeval x p =
  polynomial.aeval x (polynomial.map (algebra_map R S) p) :=
by rw [polynomial.aeval_def, polynomial.aeval_def, polynomial.eval₂_map, algebra_map_eq R S A]

end semiring

section comm_semiring
variables [comm_semiring R] [comm_semiring A] [semiring B]
variables [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]

lemma algebra_map_aeval (x : A) (p : polynomial R) :
  algebra_map A B (polynomial.aeval x p) = polynomial.aeval (algebra_map A B x) p :=
by rw [polynomial.aeval_def, polynomial.aeval_def, polynomial.hom_eval₂,
  ←is_scalar_tower.algebra_map_eq]

lemma aeval_eq_zero_of_aeval_algebra_map_eq_zero {x : A} {p : polynomial R}
  (h : function.injective (algebra_map A B)) (hp : polynomial.aeval (algebra_map A B x) p = 0) :
  polynomial.aeval x p = 0 :=
begin
  rw [← algebra_map_aeval, ← (algebra_map A B).map_zero] at hp,
  exact h hp,
end

lemma aeval_eq_zero_of_aeval_algebra_map_eq_zero_field {R A B : Type*} [comm_semiring R] [field A]
  [comm_semiring B] [nontrivial B] [algebra R A] [algebra R B] [algebra A B] [is_scalar_tower R A B]
  {x : A} {p : polynomial R} (h : polynomial.aeval (algebra_map A B x) p = 0) :
  polynomial.aeval x p = 0 :=
aeval_eq_zero_of_aeval_algebra_map_eq_zero R A B (algebra_map A B).injective h

end comm_semiring

end is_scalar_tower

namespace subalgebra

open is_scalar_tower

section comm_semiring

variables (R) {S A} [comm_semiring R] [comm_semiring S] [comm_semiring A]
variables [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]

@[simp]

end comm_semiring

end subalgebra


structure dlist (α : Type*) :=
(apply : list α → list α) -- λ l, d ++ l
(thm : ∀ l, apply l = apply [] ++ l)

variable {α : Type*}

def dlist.to_list (d : dlist α) : list α := d.apply []

@[simp] theorem apply_def (d : dlist α) (l : list α) : d.apply l = d.to_list ++ l:=
by {rw d.thm, refl}

def dlist.nil (α : Type*) : dlist α :=
{ apply := λ l, l,
  thm := λ l, (list.nil_append l)}

def dlist.append (d e : dlist α) : dlist α :=
{ apply := λ l, e.apply (d.apply l),
  thm := by simp}

instance : has_add (dlist α) := ⟨dlist.append⟩

instance : has_zero (dlist α) := ⟨dlist.nil α⟩

example (c d e : dlist α) : (c + d) + e = c + (d + e) := rfl

example (d : dlist α) : d + 0 = d := by {cases d, refl}

example (d : dlist α) : 0 + d = d := by {cases d, refl}

example (d : dlist α) : 0 + d = d + 0 := rfl

structure dint : Type :=
(apply : ℤ → ℤ)
(commutes : ∀ i, apply i = i + apply 0)

instance : has_add dint :=
⟨λ s t, ⟨λ i, s.1 (t.1 i), λ i, by rw [s.2, t.2, s.2 (t.apply 0), add_assoc]⟩⟩

instance : is_associative dint (+) :=
⟨λ x y z, rfl⟩

instance : has_zero dint :=
⟨{ apply := λ x, x,
  commutes := λ i, (add_zero _).symm}⟩

example (d : dint) : d + 0 = 0 + d := rfl

#print quotient_group.comm_group