import tactic.ring data.int.modeq data.fintype group_theory.sylow
universe u
local attribute [instance, priority 0] classical.prop_decidable

open fintype finset nat

private def S (p : ℕ) : finset (ℕ × ℕ × ℕ) :=
((range p).product ((range p).product (range p))).filter
  (λ v, v.1 ^ 2 + 4 * v.2.1 * v.2.2 = p)

lemma mem_S (p : ℕ) (v : ℕ × ℕ × ℕ) : v.1 ^ 2 + 4 * v.2.1 * v.2.2 = p → v ∈ S p :=
begin
  rcases v with ⟨x, y, z⟩,
  suffices : x ^ 2 + 4 * y * z = p → (x < p ∧ y < p ∧ z < p),
  { simp [S], tauto },
  assume h,
  refine ⟨_, _, _⟩,
  { calc x ≤ x ^ 2 : by rw pow_two; exact le_mul_self x
    ... ≤ x ^ 2 + 4 * y * z : _
    ... < _ : sorry },

end

lemma nat.not_prime_mul_self (n : ℕ) : ¬prime (n * n) :=
λ h, or.by_cases (h.2 _ $ dvd_mul_right n n)
  (λ h₁, (dec_trivial : ¬ 1 ≥ 2) (h₁ ▸ h : prime (1 * 1)).1)
  (λ h₁,
    have h₂ : n * 1 = n * n := by rwa mul_one,
    have h₃ : 1 = n := (@nat.mul_left_inj n 1 n (prime.pos (h₁.symm ▸ h))).1 h₂,
    (dec_trivial : ¬ 1 ≥ 2) (h₃.symm ▸ h : prime (1 * 1)).1)

@[reducible] private def f₁ (v : ℕ × ℕ × ℕ) : ℕ × ℕ × ℕ := (v.1, v.2.2, v.2.1)

@[reducible] private def f₂ (v : ℕ × ℕ × ℕ) : ℕ × ℕ × ℕ :=
if v.1 + v.2.2 < v.2.1
  then (v.1 + 2 * v.2.2, v.2.2, v.2.1 - v.1 - v.2.2)
  else if 2 * v.2.1 < v.1
    then (v.1 - 2 * v.2.1, v.1 - v.2.1 + v.2.2, v.2.1)
    else (2 * v.2.1 - v.1, v.2.1, v.1 - v.2.1 + v.2.2)

variables {p : ℕ} (hp : prime p) (hp₁ : p % 4 = 1)
include hp hp₁

private lemma f₁_mem_S : ∀ v : ℕ × ℕ × ℕ, v ∈ S p → f₁ v ∈ S p :=
λ ⟨x, y, z⟩, by simp [S, mul_comm, *, mul_assoc, mul_left_comm, *, f₁] {contextual := tt}

private lemma f₁_involution : ∀ v : ℕ × ℕ × ℕ, f₁ (f₁ v) = v := λ ⟨x, y, z⟩, rfl

private lemma f₂_mem_S₁ {x y z : ℕ} (hxp : x < p) (hyp : y < p) (hzp : z < p)
  (hxyz : x + z < y) :

∀ v : ℕ × ℕ × ℕ, v ∈ S p → f₂ v ∈ S p

private lemma f₂_S : ∀ v : ℕ × ℕ × ℕ, v ∈ S p → f₂ v ∈ S p :=
λ ⟨x, y, z⟩, begin
  clear_aux_decl,
  simp [S, f₂] at *,
  split_ifs; simp *,
end

private lemma f₂_invo_on_S : ∀ v : ℤ × ℤ × ℤ, v ∈ S p → f₂ (f₂ v) = v :=
λ ⟨x, y, z⟩ hv,
have xp : 0 < x := x_pos hp hp₁ (x, y, z) hv,
have yzp : 0 < y ∧ 0 < z :=  yz_pos hp hp₁ (x, y, z) hv,
 or.by_cases (decidable.em (x + z < y)) (λ h,
have h₁ : ¬ x + (y + (2 * z + (-x + -z))) < z :=
  have h₁ : x + (y + (2 * z + (-x + -z))) = y + z := by ring,
  not_lt_of_ge (h₁.symm ▸ le_add_of_nonneg_left hv.2.2.1),
by simp[f₂, h, h₁, xp]; ring) $
λ h, or.by_cases (decidable.em (2 * y < x))
(λ h₁, have h₂ : y + -(2 * y) < z + -y :=
  have h₂ : y + -(2 * y) = -y := by ring,
  h₂.symm ▸ lt_add_of_pos_left _ yzp.2,
by simp[f₂, h, h₁, h₂]; ring) $
λ h₁, have h₂ : ¬ x + (z + (2 * y + (-x + -y))) < y :=
  have h₁ : x + (z + (2 * y + (-x + -y))) = z + y := by ring,
  not_lt_of_ge (h₁.symm ▸ le_add_of_nonneg_left hv.2.2.2),
have h₃ : ¬ 0 < -x := not_lt_of_ge $ le_of_lt $ neg_neg_of_pos xp,
by simp [f₂, h, h₁, h₂, h₃]; ring

private lemma f₂_fixed_point : ∃! v : S p, f₂ v = v :=
have hp4 : (0 : ℤ) ≤ p / 4 := int.div_nonneg (int.coe_nat_nonneg _) dec_trivial,
have h : ¬ (1 : ℤ) + p / 4 < 1 := not_lt_of_ge $ le_add_of_nonneg_right hp4,
⟨⟨(1, 1, (p / 4 : ℤ)),
⟨show (1 : ℤ) + 4 * (p / 4) = p,
from have h : (p : ℤ) % 4 = 1 := (int.coe_nat_eq_coe_nat_iff _ _).2 hp₁,
have h₁ : (p : ℤ) = p % 4 + 4 * (p / 4) := (int.mod_add_div _ _).symm,
by rw [h₁] {occs := occurrences.pos [2]}; rw h,
dec_trivial, dec_trivial, hp4 ⟩⟩,
⟨by simp [f₂, h, (dec_trivial : ¬ (2 : ℤ) < 1)]; refl,
λ ⟨⟨x, y, z⟩, ⟨hv, hx, hy, hz⟩ ⟩ hf,
have xp : 0 < x := x_pos hp hp₁ (x, y, z) ⟨hv, hx, hy, hz⟩,
have yzp : 0 < y ∧ 0 < z := yz_pos hp hp₁ (x, y, z) ⟨hv, hx, hy, hz⟩,
or.by_cases (decidable.em (x + z < y))
(λ h₁,
have h₂ : x + 2 * z ≠ x := λ h₃,
  have h₄ : x + 2 * z = x + 0 := by rwa add_zero,
  not_or dec_trivial (ne_of_lt yzp.2).symm (mul_eq_zero.1 ((add_left_inj _).1 h₄)),
by simpa [f₂, h₁, h₂] using hf) $ λ h₁,
or.by_cases (decidable.em (2 * y < x))
(λ h₂,
have h₃ : x + -(2 * y) ≠ x := λ h₄,
  have h₅ : x + -2 * y = x + 0 := by rwa [← neg_mul_eq_neg_mul, add_zero],
  not_or dec_trivial (ne_of_lt yzp.1).symm (mul_eq_zero.1 ((add_left_inj _).1 h₅)),
by simp [f₂, h₁, h₂, h₃] at hf; trivial) $ λ h₂,
have hf₁ : 2 * y - x = x ∧ x + (z + -y) = z := by simp [f₂, h₁, h₂] at hf; assumption,
have hxy : y = x := by rw [sub_eq_iff_eq_add, ← two_mul] at hf₁;
  exact eq_of_mul_eq_mul_left dec_trivial hf₁.1,
subtype.eq $ show (x, y, z) = (1, 1, p / 4), from
begin
  rw [hxy, mul_comm (4 : ℤ), mul_assoc] at hv,
  have hxp : int.nat_abs x ∣ p := int.coe_nat_dvd.1 (int.nat_abs_dvd.2 (hv ▸ dvd_add (dvd_mul_right _ _) (dvd_mul_right _ _))),
  have h4 : ((4 : ℕ) : ℤ) = 4 := rfl,
  cases hp.2 _ (hxp) with h₃ h₃,
  { have h₄ : x = 1 := by rwa [← int.coe_nat_eq_coe_nat_iff, int.nat_abs_of_nonneg hx] at h₃,
    rw [← mod_add_div p 4, hp₁, h₄, int.coe_nat_add, int.coe_nat_one, mul_one, one_mul, add_left_cancel_iff,
        int.coe_nat_mul] at hv,
    have : z = p / 4 := eq_of_mul_eq_mul_left_of_ne_zero dec_trivial hv,
    rw [hxy, h₄, this] },
  { have h4 : ((4 : ℕ) : ℤ) = 4 := rfl,
    rw [← int.nat_abs_of_nonneg hx, ← int.nat_abs_of_nonneg hz, h₃, ← mul_add] at hv,
    have := int.eq_one_of_mul_eq_self_right (int.coe_nat_ne_zero.2 (ne_of_lt (prime.pos hp)).symm) hv,
    rw [← h4, ← int.coe_nat_mul, ← int.coe_nat_add, ← int.coe_nat_one, int.coe_nat_eq_coe_nat_iff] at this,
    have : p ≤ 1 := this ▸ (le_add_right p (4 * int.nat_abs z)),
    exact absurd (prime.gt_one hp) (not_lt_of_ge this) }
end ⟩ ⟩

theorem fermat_sum_two_squares : ∃ a b : ℕ, a^2 + b^2 = p :=
have fS : fintype (S p) := fintype_S hp hp₁,
let f₁' : S p → S p := λ ⟨v, hv⟩, ⟨f₁ v, f₁_S hp hp₁ _ hv⟩ in
let f₂' : S p → S p := λ ⟨v, hv⟩, ⟨f₂ v, f₂_S hp hp₁ _ hv⟩ in
have hf₁ : ∀ v, f₁' (f₁' v) = v := λ ⟨v, hv⟩, subtype.eq $ f₁_invo_on_S hp hp₁ v,
have hf₂ : ∀ v, f₂' (f₂' v) = v := λ ⟨v, hv⟩, subtype.eq $ f₂_invo_on_S hp hp₁ v hv,
have hf₂u : ∃! v : S p, f₂' v = v :=
  let ⟨⟨v, vS⟩, ⟨hv₁, hv₂⟩⟩ := f₂_fixed_point hp hp₁ in
  ⟨⟨v, vS⟩, ⟨subtype.eq hv₁, λ ⟨w, wS⟩ hw, hv₂ ⟨w, wS⟩ (subtype.mk.inj hw) ⟩ ⟩,
let h := @odd_card_of_involution_of_unique_fixed_point _ _ fS hf₂ hf₂u in
let ⟨⟨⟨x, y, z⟩, hvp, ⟨hx, hy, hz⟩⟩, h⟩ := @exists_fixed_point_of_involution_of_odd_card _ _ fS h hf₁ in
have h : y = z := (prod.eq_iff_fst_eq_snd_eq.1 (prod.eq_iff_fst_eq_snd_eq.1 (subtype.mk.inj h)).2).2,
⟨int.nat_abs x, 2 * int.nat_abs y,
begin
  simp only [nat.pow_succ, nat.pow_zero, one_mul],
  rw [mul_right_comm 2, mul_assoc, mul_assoc, ← int.coe_nat_eq_coe_nat_iff, int.coe_nat_add,
      int.nat_abs_mul_self, int.coe_nat_mul, int.coe_nat_mul, int.nat_abs_mul_self, ← hvp, h],
  simp,
  ring,
end⟩
#print axioms fermat_sum_two_squares


/-
Copyright (c) 2018 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

Tactics based on the strongly connected components (SCC) of a graph where
the vertices are propositions and the edges are implications found
in the context.

They are used for finding the sets of equivalent propositions in a set
of implications.
-/
import tactic.tauto
import data.sum

/-!
# Strongly Connected Components

This file defines tactics to construct proofs of equivalences between a set of mutually equivalent
propositions. The tactics use implications transitively to find sets of equivalent propositions.

## Implementation notes

The tactics use a strongly connected components algorithm on a graph where propositions are
vertices and edges are proofs that the source implies the target. The strongly connected components
are therefore sets of propositions that are pairwise equivalent to each other.

The resulting strongly connected components are encoded in a disjoint set data structure to
facilitate the construction of equivalence proofs between two arbitrary members of an equivalence
class.

## Possible generalizations

Instead of reasoning about implications and equivalence, we could generalize the machinery to
reason about arbitrary partial orders.

## References

 * Tarjan, R. E. (1972), "Depth-first search and linear graph algorithms",
   SIAM Journal on Computing, 1 (2): 146–160, doi:10.1137/0201010
 * Dijkstra, Edsger (1976), A Discipline of Programming, NJ: Prentice Hall, Ch. 25.
 * <https://en.wikipedia.org/wiki/Disjoint-set_data_structure>

## Tags

graphs, tactic, strongly connected components, disjoint sets
-/

namespace tactic

/--
`closure` implements a disjoint set data structure using path compression
optimization. For the sake of the scc algorithm, it also stores the preorder
numbering of the equivalence graph of the local assumptions.

The `expr_map` encodes a directed forest by storing for every non-root
node, a reference to its parent and a proof of equivalence between
that node's expression and its parent's expression. Given that data
structure, checking that two nodes belong to the same tree is easy and
fast by repeatedly following the parent references until a root is reached.
If both nodes have the same root, they belong to the same tree, i.e. their
expressions are equivalent. The proof of equivalence can be formed by
composing the proofs along the edges of the paths to the root.

More concretely, if we ignore preorder numbering, the set
`{ {e₀,e₁,e₂,e₃}, {e₄,e₅} }` is represented as:

```
e₀ → ⊥      -- no parent, i.e. e₀ is a root
e₁ → e₀, p₁ -- with p₁ : e₁ ↔ e₀
e₂ → e₁, p₂ -- with p₂ : e₂ ↔ e₁
e₃ → e₀, p₃ -- with p₃ : e₃ ↔ e₀
e₄ → ⊥      -- no parent, i.e. e₄ is a root
e₅ → e₄, p₅ -- with p₅ : e₅ ↔ e₄
```

We can check that `e₂` and `e₃` are equivalent by seeking the root of
the tree of each. The parent of `e₂` is `e₁`, the parent of `e₁` is
`e₀` and `e₀` does not have a parent, and thus, this is the root of its tree.
The parent of `e₃` is `e₀` and it's also the root, the same as for `e₂` and
they are therefore equivalent. We can build a proof of that equivalence by using
transitivity on `p₂`, `p₁` and `p₃.symm` in that order.

Similarly, we can discover that `e₂` and `e₅` aren't equivalent.

A description of the path compression optimization can be found at:
<https://en.wikipedia.org/wiki/Disjoint-set_data_structure#Path_compression>

-/
meta def closure := ref (expr_map (ℕ ⊕ (expr × expr)))

namespace closure

/-- `with_new_closure f` creates an empty `closure` `c`, executes `f` on `c`, and then deletes `c`,
returning the output of `f`. -/
meta def with_new_closure {α} : (closure → tactic α) → tactic α :=
using_new_ref (expr_map.mk _)

/-- `to_tactic_format cl` pretty-prints the `closure` `cl` as a list. Assuming `cl` was built by
`dfs_at`, each element corresponds to a node `pᵢ : expr` and is one of the folllowing:
- if `pᵢ` is a root: `"pᵢ ⇐ i"`, where `i` is the preorder number of `pᵢ`,
- otherwise: `"(pᵢ, pⱼ) : P"`, where `P` is `pᵢ ↔ pⱼ`.
Useful for debugging. -/
meta def to_tactic_format (cl : closure) : tactic format :=
do m ← read_ref cl,
   let l := m.to_list,
   fmt ← l.mmap $ λ ⟨x,y⟩, match y with
                           | sum.inl y := pformat!"{x} ⇐ {y}"
                           | sum.inr ⟨y,p⟩ := pformat!"({x}, {y}) : {infer_type p}"
                           end,
   pure $ to_fmt fmt

meta instance : has_to_tactic_format closure := ⟨ to_tactic_format ⟩

/-- `(n,r,p) ← root cl e` returns `r` the root of the tree that `e` is a part of (which might be
itself) along with `p` a proof of `e ↔ r` and `n`, the preorder numbering of the root. -/
meta def root (cl : closure) : expr → tactic (ℕ × expr × expr) | e :=
do m ← read_ref cl,
   match m.find e with
   | none :=
     do p ← mk_app ``iff.refl [e],
        pure (0,e,p)
   | (some (sum.inl n)) :=
     do p ← mk_app ``iff.refl [e],
        pure (n,e,p)
   | (some (sum.inr (e₀,p₀))) :=
     do (n,e₁,p₁) ← root e₀,
        p ← mk_app ``iff.trans [p₀,p₁],
        modify_ref cl $ λ m, m.insert e (sum.inr (e₁,p)),
        pure (n,e₁,p)
   end

/-- (Implementation of `merge`.) -/
meta def merge_intl (cl : closure) (p e₀ p₀ e₁ p₁ : expr) : tactic unit :=
do p₂ ← mk_app ``iff.symm [p₀],
   p ← mk_app ``iff.trans [p₂,p],
   p ← mk_app ``iff.trans [p,p₁],
   modify_ref cl $ λ m, m.insert e₀ $ sum.inr (e₁,p)

/-- `merge cl p`, with `p` a proof of `e₀ ↔ e₁` for some `e₀` and `e₁`,
merges the trees of `e₀` and `e₁` and keeps the root with the smallest preorder
number as the root. This ensures that, in the depth-first traversal of the graph,
when encountering an edge going into a vertex whose equivalence class includes
a vertex that originated the current search, that vertex will be the root of
the corresponding tree. -/
meta def merge (cl : closure) (p : expr) : tactic unit :=
do `(%%e₀ ↔ %%e₁) ← infer_type p >>= instantiate_mvars,
   (n₂,e₂,p₂) ← root cl e₀,
   (n₃,e₃,p₃) ← root cl e₁,
   if e₂ ≠ e₃ then do
     if n₂ < n₃ then do p ← mk_app ``iff.symm [p],
                        cl.merge_intl p e₃ p₃ e₂ p₂
                else cl.merge_intl p e₂ p₂ e₃ p₃
   else pure ()

/-- Sequentially assign numbers to the nodes of the graph as they are being visited. -/
meta def assign_preorder (cl : closure) (e : expr) : tactic unit :=
modify_ref cl $ λ m, m.insert e (sum.inl m.size)

/-- `prove_eqv cl e₀ e₁` constructs a proof of equivalence of `e₀` and `e₁` if
they are equivalent. -/
meta def prove_eqv (cl : closure) (e₀ e₁ : expr) : tactic expr :=
do (_,r,p₀) ← root cl e₀,
   (_,r',p₁) ← root cl e₁,
   guard (r = r') <|> fail!"{e₀} and {e₁} are not equivalent",
   p₁ ← mk_app ``iff.symm [p₁],
   mk_app ``iff.trans [p₀,p₁]

/-- `prove_impl cl e₀ e₁` constructs a proof of `e₀ -> e₁` if they are equivalent. -/
meta def prove_impl (cl : closure) (e₀ e₁ : expr) : tactic expr :=
cl.prove_eqv e₀ e₁ >>= iff_mp

/-- `is_eqv cl e₀ e₁` checks whether `e₀` and `e₁` are equivalent without building a proof. -/
meta def is_eqv (cl : closure) (e₀ e₁ : expr) : tactic bool :=
do (_,r,p₀) ← root cl e₀,
   (_,r',p₁) ← root cl e₁,
   return $ r = r'

end closure

/-- mutable graphs between local propositions that imply each other with the proof of implication -/
@[reducible]
meta def impl_graph := ref (expr_map (list $ expr × expr))

/-- `with_impl_graph f` creates an empty `impl_graph` `g`, executes `f` on `g`, and then deletes
`g`, returning the output of `f`. -/
meta def with_impl_graph {α} : (impl_graph → tactic α) → tactic α :=
using_new_ref (expr_map.mk (list $ expr × expr))

namespace impl_graph

/-- `add_edge g p`, with `p` a proof of `v₀ → v₁` or `v₀ ↔ v₁`, adds an edge to the implication
graph `g`. -/
meta def add_edge (g : impl_graph) : expr → tactic unit | p :=
do t ← infer_type p,
   match t with
   | `(%%v₀ → %%v₁) :=
     do is_prop v₀ >>= guardb,
        is_prop v₁ >>= guardb,
        m ← read_ref g,
        let xs := (m.find v₀).get_or_else [],
        let xs' := (m.find v₁).get_or_else [],
        modify_ref g $ λ m, (m.insert v₀ ((v₁,p) :: xs)).insert v₁ xs'
   | `(%%v₀ ↔ %%v₁) :=
     do p₀ ← mk_mapp ``iff.mp [none,none,p],
        p₁ ← mk_mapp ``iff.mpr [none,none,p],
        add_edge p₀, add_edge p₁
   | _ := failed
   end

section scc
open list
parameter g : expr_map (list $ expr × expr)
parameter visit : ref $ expr_map bool
parameter cl : closure

/-- `merge_path path e`, where `path` and `e` forms a cycle with proofs of implication between
consecutive vertices. The proofs are compiled into proofs of equivalences and added to the closure
structure. `e` and the first vertex of `path` do not have to be the same but they have to be
in the same equivalence class. -/
meta def merge_path (path : list (expr × expr)) (e : expr) : tactic unit :=
do p₁ ← cl.prove_impl e path.head.fst,
   p₂ ← mk_mapp ``id [e],
   let path := (e,p₁) :: path,

   (_,ls) ← path.mmap_accuml (λ p p',
     prod.mk <$> mk_mapp ``implies.trans [none,p'.1,none,p,p'.2] <*> pure p) p₂,
   (_,rs) ← path.mmap_accumr (λ p p',
     prod.mk <$> mk_mapp ``implies.trans [none,none,none,p.2,p'] <*> pure p') p₂,
   ps ← mzip_with (λ p₀ p₁, mk_app ``iff.intro [p₀,p₁]) ls.tail rs.init,
   ps.mmap' cl.merge

/-- (implementation of `collapse`) -/
meta def collapse' : list (expr × expr) → list (expr × expr) → expr → tactic unit
| acc [] v := merge_path acc v
| acc ((x,pr) :: xs) v :=
  do b ← cl.is_eqv x v,
     let acc' := (x,pr)::acc,
     if b
       then merge_path acc' v
       else collapse' acc' xs v

/-- `collapse path v`, where `v` is a vertex that originated the current search
(or a vertex in the same equivalence class as the one that originated the current search).
It or its equivalent should be found in `path`. Since the vertices following `v` in the path
form a cycle with `v`, they can all be added to an equivalence class. -/
meta def collapse : list (expr × expr) → expr → tactic unit :=
collapse' []

/--
Strongly connected component algorithm inspired by Tarjan's and
Dijkstra's scc algorithm. Whereas they return strongly connected
components by enumerating them, this algorithm returns a disjoint set
data structure using path compression. This is a compact
representation that allows us, after the fact, to construct a proof of
equivalence between any two members of an equivalence class.

 * Tarjan, R. E. (1972), "Depth-first search and linear graph algorithms",
   SIAM Journal on Computing, 1 (2): 146–160, doi:10.1137/0201010
 * Dijkstra, Edsger (1976), A Discipline of Programming, NJ: Prentice Hall, Ch. 25.
-/
meta def dfs_at :
  list (expr × expr) → expr → tactic unit
| vs v :=
do m ← read_ref visit,
   (_,v',_) ← cl.root v,
   match m.find v' with
   | (some tt) :=
        pure ()
   | (some ff) :=
        collapse vs v
   | none :=
     do cl.assign_preorder v,
        modify_ref visit $ λ m, m.insert v ff,
        ns ← g.find v,
        ns.mmap' $ λ ⟨w,e⟩, dfs_at ((v,e) :: vs) w,
        modify_ref visit $ λ m, m.insert v tt,
        pure ()
   end

end scc

/-- Use the local assumptions to create a set of equivalence classes. -/
meta def mk_scc (cl : closure) : tactic (expr_map (list (expr × expr))) :=
with_impl_graph $ λ g,
using_new_ref (expr_map.mk bool) $ λ visit,
do ls ← local_context,
   ls.mmap' $ λ l, try (g.add_edge l),
   m ← read_ref g,
   m.to_list.mmap $ λ ⟨v,_⟩, impl_graph.dfs_at m visit cl [] v,
   pure m

end impl_graph

meta def prove_eqv_target (cl : closure) : tactic unit :=
do `(%%p ↔ %%q) ← target >>= whnf,
   cl.prove_eqv p q >>= exact

/--
`scc` uses the available equivalences and implications to prove
a goal of the form `p ↔ q`.

```lean
example (p q r : Prop) (hpq : p → q) (hqr : q ↔ r) (hrp : r → p) : p ↔ r :=
by scc
```
-/
meta def interactive.scc : tactic unit :=
closure.with_new_closure $ λ cl,
do impl_graph.mk_scc cl,
   `(%%p ↔ %%q) ← target,
   cl.prove_eqv p q >>= exact

/-- Collect all the available equivalences and implications and
add assumptions for every equivalence that can be proven using the
strongly connected components technique. Mostly useful for testing. -/
meta def interactive.scc' : tactic unit :=
closure.with_new_closure $ λ cl,
do m ← impl_graph.mk_scc cl,
   let ls := m.to_list.map prod.fst,
   let ls' := prod.mk <$> ls <*> ls,
   ls'.mmap' $ λ x,
     do { h ← get_unused_name `h,
          try $ closure.prove_eqv cl x.1 x.2 >>= note h none }

/--
`scc` uses the available equivalences and implications to prove
a goal of the form `p ↔ q`.

```lean
example (p q r : Prop) (hpq : p → q) (hqr : q ↔ r) (hrp : r → p) : p ↔ r :=
by scc
```

The variant `scc'` populates the local context with all equivalences that `scc` is able to prove.
This is mostly useful for testing purposes.
-/
add_tactic_doc
{ name := "scc",
  category := doc_category.tactic,
  decl_names := [``interactive.scc, ``interactive.scc'],
  tags := ["logic"] }

end tactic


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.rcases
import Mathlib.PostPort

universes u v l w

namespace Mathlib

/-!
# lift tactic

This file defines the `lift` tactic, allowing the user to lift elements from one type to another
under a specified condition.

## Tags

lift, tactic
-/

/-- A class specifying that you can lift elements from `α` to `β` assuming `cond` is true.
  Used by the tactic `lift`. -/
class can_lift (α : Type u) (β : Type v) where
  coe : β → α
  cond : α → Prop
  prf : ∀ (x : α), cond x → ∃ (y : β), coe y = x

/--
A user attribute used internally by the `lift` tactic.
This should not be applied by hand.
-/
protected instance nat.can_lift : can_lift ℤ ℕ := can_lift.mk coe (fun (n : ℤ) => 0 ≤ n) sorry

/-- Enable automatic handling of pi types in `can_lift`. -/
protected instance pi.can_lift (ι : Type u) (α : ι → Type v) (β : ι → Type w)
    [(i : ι) → can_lift (α i) (β i)] : can_lift ((i : ι) → α i) ((i : ι) → β i) :=
  can_lift.mk (fun (f : (i : ι) → β i) (i : ι) => can_lift.coe (f i))
    (fun (f : (i : ι) → α i) => ∀ (i : ι), can_lift.cond (β i) (f i)) sorry

namespace tactic

/--
Construct the proof of `cond x` in the lift tactic.
*  `e` is the expression being lifted and `h` is the specified proof of `can_lift.cond e`.
*  `old_tp` and `new_tp` are the arguments to `can_lift` and `inst` is the `can_lift`-instance.
*  `s` and `to_unfold` contain the information of the simp set used to simplify.

If the proof was specified, we check whether it has the correct type.
If it doesn't have the correct type, we display an error message
(but first call dsimp on the expression in the message).

If the proof was not specified, we create assert it as a local constant.
(The name of this local constant doesn't matter, since `lift` will remove it from the context.)
-/
/-- Lift the expression `p` to the type `t`, with proof obligation given by `h`.
  The list `n` is used for the two newly generated names, and to specify whether `h` should
  remain in the local context. See the doc string of `tactic.interactive.lift` for more information.
  -/
/-- Parses an optional token "using" followed by a trailing `pexpr`. -/
/-- Parses a token "to" followed by a trailing `pexpr`. -/
namespace interactive

/--
Lift an expression to another type.
* Usage: `'lift' expr 'to' expr ('using' expr)? ('with' id (id id?)?)?`.
* If `n : ℤ` and `hn : n ≥ 0` then the tactic `lift n to ℕ using hn` creates a new
  constant of type `ℕ`, also named `n` and replaces all occurrences of the old variable `(n : ℤ)`
  with `↑n` (where `n` in the new variable). It will remove `n` and `hn` from the context.
  + So for example the tactic `lift n to ℕ using hn` transforms the goal
    `n : ℤ, hn : n ≥ 0, h : P n ⊢ n = 3` to `n : ℕ, h : P ↑n ⊢ ↑n = 3`
    (here `P` is some term of type `ℤ → Prop`).
* The argument `using hn` is optional, the tactic `lift n to ℕ` does the same, but also creates a
  new subgoal that `n ≥ 0` (where `n` is the old variable).
  + So for example the tactic `lift n to ℕ` transforms the goal
    `n : ℤ, h : P n ⊢ n = 3` to two goals
    `n : ℕ, h : P ↑n ⊢ ↑n = 3` and `n : ℤ, h : P n ⊢ n ≥ 0`.
* You can also use `lift n to ℕ using e` where `e` is any expression of type `n ≥ 0`.
* Use `lift n to ℕ with k` to specify the name of the new variable.
* Use `lift n to ℕ with k hk` to also specify the name of the equality `↑k = n`. In this case, `n`
  will remain in the context. You can use `rfl` for the name of `hk` to substitute `n` away
  (i.e. the default behavior).
* You can also use `lift e to ℕ with k hk` where `e` is any expression of type `ℤ`.
  In this case, the `hk` will always stay in the context, but it will be used to rewrite `e` in
  all hypotheses and the target.
  + So for example the tactic `lift n + 3 to ℕ using hn with k hk` transforms the goal
    `n : ℤ, hn : n + 3 ≥ 0, h : P (n + 3) ⊢ n + 3 = 2 * n` to the goal
    `n : ℤ, k : ℕ, hk : ↑k = n + 3, h : P ↑k ⊢ ↑k = 2 * n`.
* The tactic `lift n to ℕ using h` will remove `h` from the context. If you want to keep it,
  specify it again as the third argument to `with`, like this: `lift n to ℕ using h with n rfl h`.
* More generally, this can lift an expression from `α` to `β` assuming that there is an instance
  of `can_lift α β`. In this case the proof obligation is specified by `can_lift.cond`.
* Given an instance `can_lift β γ`, it can also lift `α → β` to `α → γ`; more generally, given
  `β : Π a : α, Type*`, `γ : Π a : α, Type*`, and `[Π a : α, can_lift (β a) (γ a)]`, it
  automatically generates an instance `can_lift (Π a, β a) (Π a, γ a)`.

`lift` is in some sense dual to the `zify` tactic. `lift (z : ℤ) to ℕ` will change the type of an
integer `z` (in the supertype) to `ℕ` (the subtype), given a proof that `z ≥ 0`;
propositions concerning `z` will still be over `ℤ`. `zify` changes propositions about `ℕ` (the
subtype) to propositions about `ℤ` (the supertype), without changing the type of any variable.
-/
end Mathlib


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import tactic
import measure_theory.measurable_space
import measure_theory.integration
import measure_theory.borel_space
import topology.metric_space.basic
import topology.instances.real
import topology.instances.ennreal
import order.liminf_limsup
import order.complete_lattice
import portmanteau_limsup_lemmas

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

namespace portmanteau

section portmanteau_probability_lemmas

lemma proba_muniv {β : Type*} {mβ : measurable_space β}
  (Pr : measure β) [hPr : probability_measure Pr] :
    Pr univ = 1 := measure_univ

lemma proba_le_one {β : Type*} {mβ : measurable_space β}
  (Pr : measure β) [hPr : probability_measure Pr] (A : set β) :
    Pr A ≤ 1 :=
begin
  have le_univ : Pr A ≤ Pr univ := Pr.to_outer_measure.mono (subset_univ A) ,
  rwa (proba_muniv Pr) at le_univ ,
end

lemma proba_finite {β : Type*} {mβ : measurable_space β}
  (Pr : measure β) [hPr : probability_measure Pr] (A : set β) :
    Pr A < ⊤ :=
begin
  exact lt_of_le_of_lt (proba_le_one Pr A) ennreal.one_lt_top ,
end

lemma proba_compl {β : Type*} {mβ : measurable_space β}
  {A : set β} (Pr : measure β) [hPr : probability_measure Pr]
  (mble_A : measurable_set A) :
    Pr Aᶜ = 1 - Pr (A) :=
begin
  have key := measure_compl mble_A (proba_finite Pr A) ,
  rwa proba_muniv Pr at key ,
end

lemma finite_integral_of_bdd_ennrealval {β : Type*} {mβ : measurable_space β}
  (μ : measure β) [μ_fin : probability_measure μ]
  (f : β → ennreal) (f_bdd : bdd_ennval f) :
     lintegral μ f < ⊤ :=
begin
  cases f_bdd with c hc ,
  have bdd' : f ≤ (λ b , c) := hc ,
  have integr_bdd := @lintegral_mono _ _ μ _ _ bdd' ,
  have const_integr : lintegral μ (λ b , c) = c * (μ(univ)) ,
  { rw ← set_lintegral_const univ c ,
    simp only [measure.restrict_univ] , } ,
  have total : (c : ennreal) * (μ(univ)) < ⊤ ,
  { rw (proba_muniv μ) ,
    simp only [mul_one, ennreal.coe_lt_top] , } ,
  rw ← const_integr at total ,
  exact lt_of_le_of_lt integr_bdd total ,
end

abbreviation indic {β : Type*} (A : set β) : β → ennreal :=
  indicator A (λ (b : β) , (1 : ennreal))

def indic' {β : Type*} (A : set β) : β → ennreal :=
  indicator A (λ (b : β) , (1 : ennreal))

lemma indic_rw {β : Type*} (A : set β) :
  indic A = set.indicator A (λ b , (1 : ennreal))
    := by refl

lemma indic_val_zero_or_one {β : Type*} (A : set β) (x : β):
  indic A x = 0 ∨ indic A x = 1 :=
begin
  by_cases x ∈ A ; simp [h] ,
end

lemma indic_le_one {β : Type*} (A : set β) (x : β):
  indic A x ≤ 1 :=
begin
  cases (indic_val_zero_or_one A x) with hval hval ,
  { simp only [hval, zero_le] , } ,
  { rw hval ,
    tidy , } ,
end

lemma integral_indic {β : Type*}
  {mβ : measurable_space β} (ν : measure β)
  (E : set β) (mble_E : measurable_set E) :
    lintegral ν (indic E) = ν(E) :=
begin
  rw [indic_rw , ← @set_lintegral_one β mβ ν E , lintegral_indicator ] ,
  exact mble_E ,
end

lemma indic_val_one_iff {β : Type*} (A : set β) (x : β):
  indic A x = 1 ↔ x ∈ A :=
begin
  by_cases x ∈ A ; simp [h] ,
end

lemma indic_val_zero_iff {β : Type*} (A : set β) (x : β):
  indic A x = 0 ↔ x ∉ A :=
begin
  by_cases x ∈ A ; simp [h] ,
end

lemma indic_univ {β : Type*} :
  indic (univ : set β) = (λ b , 1) :=
begin
  funext x ,
  exact (indic_val_one_iff (univ : set β) x).mpr (mem_univ x) ,
end

lemma indic_preim_one_subset {β : Type*} [measurable_space β] (A : set β) :
  ∀ (S : set ennreal) , ((1:ennreal) ∈ S) → A ⊆ (indic A)⁻¹' S :=
begin
  intros S hSone a ha ,
  rw [mem_preimage , (indic_val_one_iff A a).mpr ha] ,
  exact hSone ,
end

lemma indic_preim_one_no_zero_subset {β : Type*} [measurable_space β] (A : set β) :
  ∀ (S : set ennreal) , ((1:ennreal) ∈ S) → ((0:ennreal) ∉ S) → A = (indic A)⁻¹' S :=
begin
  intros S hSone hSnozero ,
  have sub := indic_preim_one_subset A S hSone ,
  apply le_antisymm ,
  { exact sub , } ,
  intros a ha ,
  rw ← indic_val_one_iff ,
  rw mem_preimage at ha ,
  cases indic_val_zero_or_one A a with opt opt' ,
  { rw opt at ha ,
    contradiction , } ,
  { assumption , } ,
end

lemma indic_preim_one_and_zero_subset {β : Type*} [measurable_space β] (A : set β) :
  ∀ (S : set ennreal) , ((1:ennreal) ∈ S) → ((0:ennreal) ∈ S) → univ = (indic A)⁻¹' S :=
begin
  intros S hSone hSnozero ,
  apply le_antisymm ,
  swap ,
  { simp only [le_eq_subset, subset_univ], } ,
  intros x hx ,
  rw mem_preimage ,
  cases indic_val_zero_or_one A x with opt opt ;
  { rw opt at * ,
    assumption , } ,
end

lemma indic_mble_iff {β : Type*} [measurable_space β] (A : set β) :
  measurable (indic A) ↔ measurable_set A :=
begin
  split ,
  { have preim : (indic A)⁻¹' {1} = A ,
    { ext x ,
      exact indic_val_one_iff A x , } ,
    have sing_meas : measurable_set ({1} : set ennreal) := measurable_set_singleton 1 ,
    intro hmeas ,
    specialize hmeas sing_meas ,
    rwa preim at hmeas , } ,
  intros mble_A ,
  suffices : ∀ (B : set ennreal) , (1:ennreal) ∈ B → measurable_set B → measurable_set ((indic A)⁻¹' B) ,
  { intros B hB ,
    by_cases Hone : (1:ennreal) ∈ B ,
    { exact this B Hone hB , } ,
    have mblecompl := this Bᶜ (mem_compl Hone) (by simp [hB]) ,
    tidy , } ,
  intros B one_B mble_B ,
  by_cases hzero : (0:ennreal) ∈ B ,
  { rw ← indic_preim_one_and_zero_subset A B one_B hzero ,
    exact measurable_set.univ , } ,
  { rw ← indic_preim_one_no_zero_subset A B one_B hzero ,
    assumption , } ,
end

lemma indic_mono {β : Type*} (A B : set β) (hAB : A ⊆ B):
  indic A ≤ indic B :=
begin
  intro x ,
  by_cases x ∈ A ,
  { have indvalA := (indic_val_one_iff A x).mpr h ,
    have indvalB := (indic_val_one_iff B x).mpr (hAB h) ,
    rw [indvalA , indvalB] ,
    exact ennreal.coe_to_nnreal_le_self , } ,
  { have indval := (indic_val_zero_iff A x).mpr h ,
    rw indval ,
    have val_opt := indic_val_zero_or_one B x ,
    cases val_opt ; { rw val_opt , simp , } , } ,
end

abbreviation is_decreasing_seq {τ : Type*} [preorder τ] (s : ℕ → τ) :=
  @monotone ℕ (order_dual τ) _ _ s

abbreviation is_decreasing_seq' {τ : Type*} [has_le τ] (s : ℕ → τ) :=
  ∀ (n m : ℕ) , n ≤ m → s(m) ≤ s(n)

lemma is_decreasing_seq_iff {τ : Type*} [preorder τ] {s : ℕ → τ} :
  is_decreasing_seq s ↔ ∀ (n m : ℕ) , n ≤ m → s(m) ≤ s(n) := by refl

lemma lim_le_of_decr {τ : Type*} [ord : linear_order τ] [topo : topological_space τ]
  [ord_topo : order_topology τ] (s : ℕ → τ) (l : τ)
  (h_decr : @monotone ℕ (order_dual τ) _ _ s) (h_lim : tendsto s at_top (𝓝 l)) :
    ∀ n , l ≤ s(n) :=
begin
  intros m₀ ,
  by_contra under_lim ,
  simp at under_lim ,
  set U := Ioi (s(m₀)) with hU ,
  have hU_nbhd : U ∈ 𝓝 l := Ioi_mem_nhds under_lim ,
  have too_low : ∀ (n : ℕ) , n ≥ m₀ → s(n) ∉ U ,
  { intros n hn ,
    simp ,
    exact h_decr hn , } ,
  have key := filter.tendsto_at_top'.mp h_lim U hU_nbhd ,
  cases key with n₀ hn₀ ,
  set k := max n₀ m₀ with hk ,
  have k_ge_n₀ : n₀ ≤ k := le_max_left n₀ m₀ ,
  have k_ge_m₀ : m₀ ≤ k := le_max_right n₀ m₀ ,
  specialize hn₀ k k_ge_n₀ ,
  specialize too_low k k_ge_m₀ ,
  contradiction ,
end

structure ptwise_decr_lim_ennreal {β : Type*} (f : β → ennreal) :=
  (funseq : ℕ → (β → ennreal) )
  (decr : is_decreasing_seq funseq )
  (limit : ∀ (b : β) , lim_enn (λ n , (funseq n b)) (f(b)) )

lemma ptwise_decr_lim_ennreal_lim_le {β : Type*} {f : β → ennreal} (fseq : ptwise_decr_lim_ennreal f) :
  ∀ n , f ≤ fseq.funseq(n) :=
begin
  intros n x ,
  have decr_at_x : is_decreasing_seq (λ (n : ℕ) , ((fseq.funseq(n))(x)) ) ,
  { intros n m hnm ,
    dsimp ,
    exact fseq.decr hnm x , } ,
  exact lim_le_of_decr (λ (n : ℕ) , ((fseq.funseq(n))(x)) ) (f(x)) decr_at_x (fseq.limit x) n ,
end

structure ptwise_decr_mble_lim_ennreal {β : Type*}
  (msβ : measurable_space β) (f : β → ennreal)
    extends (ptwise_decr_lim_ennreal f) :=
  (mble : ∀ (n : ℕ) , @measurable β ennreal msβ _ (funseq(n)) )

def ptwise_decr_lim_ennreal' {β : Type*}
  (fseq : ℕ → (β → ennreal)) (f : β → ennreal) :=
    is_decreasing_seq (λ n , (fseq n)) ∧
    ( ∀ (b : β) , lim_enn (λ n , (fseq n b)) (f(b)) )

lemma measure_of_mble_decr_approx_indicator {β : Type*}
  {msβ : measurable_space β} (ν : measure β)
  (E : set β) (mble_E : measurable_set E)
  (fseq : ptwise_decr_mble_lim_ennreal msβ (indic E) )
  (finite_integral : lintegral ν (fseq.funseq(0)) < ⊤) :
    lim_enn ( λ n , lintegral ν (fseq.funseq(n)) ) (ν(E)) :=
begin
  have indicator_inf : (λ (b : β), ⨅ (n : ℕ), fseq.funseq n b) = indic E ,
  { funext b ,
    have ptwise_decr : ∀ (n m : ℕ) , n ≤ m → fseq.funseq m b ≤ fseq.funseq n b  ,
    { intros n m hnm ,
      exact fseq.decr hnm b , } ,
    exact infi_eq_of_tendsto ptwise_decr (fseq.limit b) , } ,
  rw ← integral_indic ν E mble_E ,
  have integr_decr : ∀ (n m : ℕ) , n ≤ m →
      lintegral ν (fseq.funseq(m)) ≤ lintegral ν (fseq.funseq(n)) ,
  { intros n m hnm ,
    exact lintegral_mono (fseq.decr hnm) , } ,
  have key := lintegral_infi fseq.mble fseq.decr finite_integral ,
  dsimp at key ,
  rw indicator_inf at key ,
  rw key ,
  exact tendsto_at_top_infi integr_decr ,
end

lemma inv_nat_ennreal_antimono {n m : ℕ} :
  n ≤ m → (m : ennreal)⁻¹ ≤ (n : ennreal)⁻¹ :=
begin
  by_cases hn : (n = 0) ,
  { have infty : (n : ennreal)⁻¹ = ⊤ ,
    { rw hn ,
      simp only [ennreal.inv_zero, nat.cast_zero] , } ,
    rw infty ,
    simp only [implies_true_iff, le_top] , } ,
  { intros hnm ,
    have ineq : 1/m ≤ 1/n := nat.div_le_div_left hnm (zero_lt_iff.mpr hn) ,
    simp [ineq , hnm] , } ,
end

lemma exists_nat_one_div_lt_ennreal {z : ennreal} (zpos : 0 < z) :
  ∃ (n : ℕ) , (1/(n+1) : ennreal) < z :=
begin
  have key := ennreal.exists_inv_nat_lt (ne_of_gt zpos),
  cases key with n hn ,
  use n ,
  have le := inv_nat_ennreal_antimono (nat.le_succ n) ,
  have key := lt_of_le_of_lt le hn,
  have eq : (1/(n+1) : ennreal) = (n+1 : ennreal)⁻¹ := by simp only [one_div] ,
  rwa eq ,
end

lemma positive_levels_countable_union {γ : Type*} (g : γ → ennreal) :
  { y : γ | g y > 0} = (⋃ n , (λ (n : ℕ), { y : γ | g y > 1/(n+1)}) n) :=
begin
  suffices : { y : γ | g y > 0} ⊆ (⋃ n , (λ (n : ℕ), { y : γ | g y > 1/(n+1)}) n) ,
  { apply le_antisymm ,
    { exact this , } ,
    { intros x hx ,
      simp at * ,
      cases hx with n hn ,
      exact lt_of_le_of_lt (by simp) hn , } ,
    } ,
  intros x hx ,
  simp at * ,
  cases (exists_nat_one_div_lt_ennreal hx) with n hn ,
  use n ,
  have eq : (1/(n+1) : ennreal) = (n+1 : ennreal)⁻¹ := by simp only [one_div] ,
  rwa ← eq ,
end

lemma finitely_many_substantial_members_disjoint_union_finmeas {β ι : Type*}
  [mβ : measurable_space β] {ν : measure β}
  (B : set β) (B_mble : measurable_set B) (B_fin : ν(B) < ⊤)
  (ε : ennreal) (ε_pos : 0 < ε)
  (A : ι → set β) (hAB : ∀ i , A(i) ⊆ B)
  (A_mble : ∀ (i : ι), measurable_set (A i)) (h_disj : pairwise (disjoint on A))
  : set.finite {i : ι | ε ≤ ν(A(i))} :=
begin
  set substantial := {i : ι | ε ≤ ν(A(i))} with h_substantial ,
  by_contradiction hcontra ,
  have pickseq := set.infinite.nat_embedding _ hcontra ,
  set seq := (λ i, (pickseq.to_fun (i)).val ) with hseq ,
  have seq_inj : function.injective seq ,
  { intros i j hij ,
    simp only [hseq, function.embedding.to_fun_eq_coe, subtype.val_eq_coe] at hij,
    have eq : pickseq.to_fun(i) = pickseq.to_fun(j) ,
    { ext , exact hij , } ,
    exact pickseq.injective eq , } ,
  have seq_ran : ∀ i , seq(i) ∈ substantial ,
  { intros i ,
    have itoldyaso : (pickseq.to_fun(i)).val = seq(i) := by simp only [hseq] ,
    rw ← itoldyaso ,
    exact (pickseq.to_fun(i)).property , } ,
  have mbles : ∀ (i : ℕ) , measurable_set ( A (seq(i)) ) ,
  { intros i ,
    apply A_mble , } ,
  have disj : pairwise ( disjoint on (λ (i : ℕ) , A(seq(i)))) ,
  { intros i j hij b hb ,
    have hij' : (seq(i)) ≠ (seq(j)) := function.injective.ne seq_inj hij ,
    exact h_disj (seq i) (seq j) hij' hb , } ,
  have massive := @measure_Union β ℕ mβ ν _ _ disj mbles ,
  clear disj mbles ,
  dsimp at massive ,
  have large_terms : ∀ i , ε ≤ ν (A (seq(i))) := seq_ran ,
  have diverges : ∑' (i : ℕ), ν (A(seq(i))) = ⊤ ,
  { have le : ∑' (i : ℕ), ε ≤ ∑' (i : ℕ), ν (A(seq(i))) ,
    { exact ennreal.tsum_le_tsum large_terms , } ,
    have cst_sum := sum_infinitely_many_pos_const_ennreal ε ε_pos ,
    rw cst_sum at le ,
    exact eq_top_iff.mpr le , } ,
  rw diverges at massive ,
  have sub_mem : ∀ (i : ℕ) , A (seq(i)) ⊆ B := by simp only [hAB, forall_const] ,
  have sub : (⋃ (i : ℕ) , A (seq(i))) ⊆ B := Union_subset sub_mem ,
  have shouldnot' : ν (⋃ (i : ℕ) , A (seq(i))) ≤ ν (B) := measure_mono sub ,
  have shouldnot := lt_of_le_of_lt shouldnot' B_fin ,
  rw massive at shouldnot ,
  exact ennreal.not_lt_top.mpr rfl shouldnot ,
end

lemma pos_ennreal_union_ge_inv_nat_succ :
  {z : ennreal | 0 < z} = ⋃ (n : ℕ) , {z : ennreal | z ≥ 1/(n+1)} :=
begin
  apply le_antisymm ,
  { intros z hz ,
    rw mem_set_of_eq at hz ,
    simp_rw [mem_Union , mem_set_of_eq] ,
    cases (exists_nat_one_div_lt_ennreal hz) with n hn ,
    use n ,
    exact le_of_lt hn , } ,
  { intros z hz ,
    rw mem_Union at hz ,
    cases hz with n hn ,
    rw mem_set_of_eq at hn ,
    have lt : (0 : ennreal) < (1/(n+1) :ennreal)
      := by simp only [one_div, ennreal.add_eq_top, ennreal.nat_ne_top, ne.def, ennreal.one_ne_top, not_false_iff, ennreal.inv_pos, or_self],
    exact lt_of_lt_of_le lt hn , } ,
end

lemma pos_ennreal_union_ge_inv_nat :
  {z : ennreal | 0 < z} = ⋃ (n : ℕ) , {z : ennreal | z ≥ 1/n} :=
begin
  apply le_antisymm ,
  { intros z hz ,
    rw mem_set_of_eq at hz ,
    simp_rw [mem_Union , mem_set_of_eq] ,
    cases (exists_nat_one_div_lt_ennreal hz) with n hn ,
    use n+1 ,
    exact le_of_lt hn , } ,
  { intros z hz ,
    rw mem_Union at hz ,
    cases hz with n hn ,
    rw mem_set_of_eq at hn ,
    have lt : (0 : ennreal) < (1/n :ennreal)
      := by simp only [one_div, ennreal.add_eq_top, ennreal.nat_ne_top, ne.def, ennreal.one_ne_top, not_false_iff, ennreal.inv_pos, or_self],
    exact lt_of_lt_of_le lt hn , } ,
end

lemma ennval_pos_union_ge_inv_nat_succ {γ : Type*} (f : γ → ennreal) :
  {x : γ | 0 < f x} = ⋃ (n : ℕ) , {x : γ | f x ≥ 1/(n+1)} :=
begin
  have lhs_preim : {x : γ | 0 < f x} = f⁻¹' {z : ennreal | 0 < z} := by refl ,
  rw [ lhs_preim , pos_ennreal_union_ge_inv_nat_succ , preimage_Union ] ,
  simp only [preimage_set_of_eq] ,
end

lemma ennval_pos_union_ge_inv_nat {γ : Type*} (f : γ → ennreal) :
  {x : γ | 0 < f x} = ⋃ (n : ℕ) , {x : γ | f x ≥ 1/n} :=
begin
  have lhs_preim : {x : γ | 0 < f x} = f⁻¹' {z : ennreal | 0 < z} := by refl ,
  rw [ lhs_preim , pos_ennreal_union_ge_inv_nat , preimage_Union ] ,
  simp only [preimage_set_of_eq] ,
end

lemma countably_many_positive_measure_members_disjoint_union {β ι : Type*}
  [mβ : measurable_space β] (ν : measure β)
  (B : set β) (B_mble : measurable_set B) (B_fin : ν(B) < ⊤)
  (A : ι → set β) (hAB : ∀ i , A(i) ⊆ B)
  (A_mble : ∀ (i : ι), measurable_set (A i)) (h_disj : pairwise (disjoint on A)) :
    set.countable { i : ι | ν (A i) > 0} :=
begin
  set posmeas := { i : ι | ν (A i) > 0} with h_posmeas ,
  set fairmeas := λ (n : ℕ) , { i : ι | ν (A i) ≥ 1/n} with h_fairmeas ,
  have countable_union : posmeas = (⋃ n , fairmeas(n)) ,
  { exact ennval_pos_union_ge_inv_nat (λ (i : ι) , ν (A(i))) , } ,
  have countable_pieces : ∀ (n : ℕ) , set.countable (fairmeas(n)) ,
  { intros n ,
    suffices : set.finite (fairmeas(n)) ,
    { exact finite.countable this , } ,
    have pos : (0 : ennreal) < (1/n : ennreal)
      := by simp only [one_div, ennreal.add_eq_top, ennreal.nat_ne_top, ne.def, ennreal.one_ne_top, not_false_iff, ennreal.inv_pos, or_self] ,
    apply finitely_many_substantial_members_disjoint_union_finmeas
      B B_mble B_fin (1/n : ennreal) pos A hAB A_mble h_disj , } ,
  rw countable_union ,
  exact countable_Union countable_pieces ,
end

lemma countably_many_positive_measure_members_disjoint_union' {β ι : Type*}
  [mβ : measurable_space β] (ν : measure β) [hfin : probability_measure ν]
  (A : ι → set β) (h_mble : ∀ i , measurable_set (A i)) (h_disj : pairwise (disjoint on A)) :
  set.countable { i : ι | ν (A i) > 0} :=
begin
  set posmeas := { i : ι | ν (A i) > 0} with h_posmeas ,
  set fairmeas := λ (n : ℕ) , { i : ι | ν (A i) ≥ 1/n} with h_fairmeas ,
  have countable_union : posmeas = (⋃ n , fairmeas(n)) ,
  { exact ennval_pos_union_ge_inv_nat (λ (i : ι) , ν (A(i))) , } ,
  have countable_pieces : ∀ (n : ℕ) , set.countable (fairmeas(n)) ,
  { intros n ,
    suffices : set.finite (fairmeas(n)) ,
    { exact finite.countable this , } ,
    have pos : (0 : ennreal) < (1/n : ennreal)
      := by simp only [one_div, ennreal.add_eq_top, ennreal.nat_ne_top, ne.def, ennreal.one_ne_top, not_false_iff, ennreal.inv_pos, or_self] ,
    exact finitely_many_substantial_members_disjoint_union_finmeas
      (univ : set β) (measurable_set.univ) (proba_finite ν _)
      (1/n : ennreal) pos A (by simp only [subset_univ, implies_true_iff])
      h_mble h_disj , } ,
  rw countable_union ,
  exact countable_Union countable_pieces ,
end

lemma countably_many_level_sets_of_positive_measure {β γ : Type*}
  {mβ : measurable_space β} {mγ : measurable_space γ} (f : β → γ)
  [measurable_singleton_class γ]
  (mble_f : measurable f) (ν : measure β) (hfin : probability_measure ν) :
  set.countable { y : γ | ν (f⁻¹' {y}) > 0} :=
begin
  set posmeas := { y : γ | ν (f⁻¹' {y}) > 0} with hposmeas ,
  set fairmeas := λ (n : ℕ) , { y : γ | ν (f⁻¹' {y}) ≥ 1/n} with hfairmeas ,
  have countable_union' := ennval_pos_union_ge_inv_nat (λ y , ν (f⁻¹' {y})) ,
  have mbles : ∀ y , measurable_set (f⁻¹'{y}) ,
  { intros y ,
    apply mble_f ,
    exact measurable_set_eq , } ,
  have disjoints : pairwise (disjoint on (λ (y : γ) , (f⁻¹'{y}))) ,
  { intros y₁ y₂ hy x hx ,
    have fx_eq₁ : f x = y₁ := hx.1 ,
    have fx_eq₂ : f x = y₂ := hx.2 ,
    rw [←fx_eq₁ , ←fx_eq₂] at hy ,
    contradiction , } ,
  exact countably_many_positive_measure_members_disjoint_union
        ν (univ : set β) (measurable_set.univ) (proba_finite ν _)
        (λ (y : γ) , f⁻¹' {y}) (by simp only [subset_univ, implies_true_iff])
        mbles disjoints ,
end

end portmanteau_probability_lemmas

end portmanteau