/-
This file captures the notion of a statement being reckless
Meaning: A statement that cannot be proven, and whose negation also cannot be proven

The most important example of recklessness is the law of exluded middle: ∀ P : Prop, P ∨ ¬ P,
also called "the principle of omniscience"
-/

import ..Intuitionism.nat_seq
import ..Intuitionism.real
import data.nat.basic
import data.nat.parity

variables P Q : Prop

namespace reckless

/--
The principle of omniscience, also called the law of the excluded middle
-/
def PO : Prop := ∀ Q : Prop, Q ∨ ¬Q

/--
The limited principle of omniscience
This is the example Brouwer initially used to justify the idea of statements being reckless,
though it is slightly weaker than PO
Using the relations = and #, we could also have defined LPO as:
∀ a : 𝒩, a = nat_seq.zero ∨ a # nat_seq.zero
Note: for such a : 𝒩 it could still be the case that we can prove a ≠ nat_seq.zero
This is because (∃ n : ℕ, a n ≠ 0) is stronger than (¬ ∀ n : ℕ, a = 0)
-/
def LPO : Prop := ∀ a : 𝒩, (∀ n : ℕ, a n = 0) ∨ (∃ n : ℕ, a n ≠ 0)

def reckless_LPO : Prop → Prop := λ P : Prop, (PO → P) ∧ (P → LPO)

/--
The lesser limited principle of omniscience
In words, it says that:
Before knowing when a sequence of natural numbers will stop being 0,
the person who claims LLPO is true, can already say it will happen at an even index or an odd index
It's important that the binding of ∨ is outside the binding of ∀ k : ℕ,
because the statement ∀ k : ℕ, k % 2 = 0 ∨ k % 2 = 1, is always true
-/
def LLPO : Prop := ∀ a : 𝒩,
    (∀ k : ℕ, (∀ i : ℕ, i < k → a i = 0) ∧ a k ≠ 0 → k % 2 = 0) ∨
    (∀ k : ℕ, (∀ i : ℕ, i < k → a i = 0) ∧ a k ≠ 0 → k % 2 = 1)

def reckless_LLPO : Prop → Prop :=
    λ P : Prop, (PO → P) ∧ (P → LLPO)

theorem PO_implies_LPO : PO → LPO :=
begin
    intro po,
    intro a,
    cases po (∃ n : ℕ, a n ≠ 0) with h₁ h₂,
    {-- case: ∃ n : ℕ, a n ≠ 0
        right,
        exact h₁,
    },
    {-- case: ¬∃ n : ℕ, a n ≠ 0
        left,
        have h₃ := forall_not_of_not_exists h₂,
        simp at h₃,
        exact h₃,
    }
end

-- A simple lemma to show a reckless statement exists: PO itself is reckless
lemma exists_reckless : ∃ P : Prop, reckless_LPO P :=
begin
    use PO,
    split,
    {-- need to prove: PO → PO
        tauto,
    },
    {-- need to prove: PO → LPO
        exact PO_implies_LPO,
    }
end

theorem LPO_implies_LLPO : LPO → LLPO :=
begin
    intro lpo,
    intro a,
    cases lpo a with faeq eneq,
    {-- case: ∀ n : ℕ, a n = 0, the conclusion is vacuously true
        left,
        intros k hk,
        exfalso,
        apply and.elim_right hk,
        exact faeq k,
    },
    {-- case: ∃ n : ℕ, a n ≠ 0
        cases eneq with n hn,
        cases nat_seq.all_eq_or_exists_neq a nat_seq.zero n with alleq exneq,
        {-- case: ∀ i < n: a i = 0
            cases nat.mod_two_eq_zero_or_one n with neven nodd,
            {-- case: n is even
                left,
                intros k hk,
                have keqn : k = n, by {
                    have hkn := nat_seq.lt_eq_ne_le a nat_seq.zero k n hk.elim_left hn,
                    have hnk := nat_seq.lt_eq_ne_le a nat_seq.zero n k alleq hk.elim_right,
                    exact le_antisymm hkn hnk,
                },
                rw keqn,
                exact neven,
            },
            {-- case: n is odd
                right,
                intros k hk,
                have keqn : k = n, by {
                    have hkn := nat_seq.lt_eq_ne_le a nat_seq.zero k n hk.elim_left hn,
                    have hnk := nat_seq.lt_eq_ne_le a nat_seq.zero n k alleq hk.elim_right,
                    exact le_antisymm hkn hnk,
                },
                rw keqn,
                exact nodd,
            }
        },
        {-- case: ∃ i < n, (∀ j < i, a j = 0) ∧ a i ≠ 0
            cases exneq with i hi,
            cases nat.mod_two_eq_zero_or_one i with ieven iodd,
            {-- case: i is even
                left,
                intros k hk,
                have keqi : k = i, by {
                    have hki := nat_seq.lt_eq_ne_le a nat_seq.zero k i hk.elim_left hi.elim_right.elim_right,
                    have hik := nat_seq.lt_eq_ne_le a nat_seq.zero i k hi.elim_right.elim_left hk.elim_right,
                    exact le_antisymm hki hik,
                },
                rw keqi,
                exact ieven,
            },
            {-- case: i is odd
                right,
                intros k hk,
                have keqi : k = i, by {
                    have hki := nat_seq.lt_eq_ne_le a nat_seq.zero k i hk.elim_left hi.elim_right.elim_right,
                    have hik := nat_seq.lt_eq_ne_le a nat_seq.zero i k hi.elim_right.elim_left hk.elim_right,
                    exact le_antisymm hki hik,
                },
                rw keqi,
                exact iodd,
            }
        }
    }
end

/--
Double negation cannot simply be eliminated for all propositions P
Also shows that proof by contradiction cannot always be applied
-/
theorem reckless_not_not_implies : reckless_LPO (∀ P : Prop, ¬¬P → P) :=
begin
    split,
    {-- need to prove: PO → ∀ P : Prop, ¬¬P → P
        intros po P nnp,
        cases po P with hp np,
        {-- case: P
            exact hp,
        },
        {-- case: ¬P
            exfalso,
            exact nnp np,
        }
    },
    {-- need to prove: (∀ P : Prop, ¬¬P → P) → LPO, we prove that it even implies PO
        intro h,
        apply PO_implies_LPO,
        intro P,
        apply h,
        exact not_not_em P,
    }
end

theorem reckless_implies_not_or : reckless_LPO (∀ P Q : Prop, (P → Q) → (Q ∨ ¬P)) :=
begin
    split,
    {
        intros po P Q h,
        cases po P with hp np,
        {-- case: P
            left,
            exact h hp,
        },
        {-- case: ¬P
            right,
            exact np,
        }
    },
    {-- need to prove: (∀ (P Q : Prop), (P → Q) → Q ∨ ¬P) → LPO, we prove that it even implies PO
        intros h,
        apply PO_implies_LPO,
        intro Q,
        apply h Q Q,
        tauto,
    }
end

/--
Given a b : 𝒩, we already know that a < b → a ≤ b, and that a = b → a ≤ b
However, this theorem shows that the opposite is not true
One might expect a ≤ b → (a < b ∨ a = b),
but this statement actually implies LPO, and is therefore reckless
-/
theorem reckless_LPO_le_implies_lt_or_eq :
    reckless_LPO (∀ a b : 𝒩, a ≤ b → a < b ∨ a =' b) :=
begin
    split,
    {-- need to prove: PO → (∀ a b : 𝒩, a ≤ b → a < b ∨ a =' b)
        intros po a b hab,
        cases po (a < b) with hl hnl,
        {-- case: a < b
            left,
            exact hl,
        },
        {-- case: ¬(a < b), we prove: a =' b
            right,
            rw ← nat_seq.le_iff_not_lt at hnl,
            exact nat_seq.eq_of_le_le hab hnl,
        }
    },
    {-- need to prove: (∀ a b : 𝒩, a ≤ b → a < b ∨ a =' b) → LPO
        intros h₁ a,
        cases h₁ nat_seq.zero a (nat_seq.zero_le a) with zlt zeq,
        {-- case: 0 < a
            right,
            have h₂ := or.intro_left (a < nat_seq.zero) zlt,
            rw ← nat_seq.apart_iff_lt_or_lt at h₂,
            rw nat_seq.apart_symm at h₂,
            exact h₂,
        },
        {-- case: 0 = a
            left,
            exact nat_seq.eq_symm.mp zeq,
        }
    },
end

-- The two following theorems look funny together
theorem implies_not_implies_not : ∀ P Q : Prop, (P ∨ ¬P → ¬Q) → ¬Q :=
begin
    intros P Q h hq,
    have h₁ := mt h,
    have h₂ := h₁ (not_not_intro hq),
    exact (not_not_em P) h₂,
end

theorem reckless_LPO_implies_implies : reckless_LPO (∀ P Q : Prop, (P ∨ ¬P → Q) → Q) :=
begin
    split,
    {
        intros po P Q hpq,
        exact hpq (po P),
    },
    {
        intro h,
        apply PO_implies_LPO,
        intro P,
        have hp := h P (P ∨ ¬P),
        apply hp,
        intro pop,
        exact pop,
    }
end

instance start_le_not_zero_decidable (a : 𝒩) (n : ℕ) : decidable (∃ i : ℕ, i ≤ n ∧ a i ≠ 0) :=
begin
    induction n with d hd,
    {
        simp only [nat.nat_zero_eq_zero, le_zero_iff_eq, exists_eq_left, ne.def],
        exact ne.decidable _ _,
    },
    {
        have hds : decidable (a (nat.succ d) ≠ 0) := ne.decidable _ _,
        have hdt : decidable ((∃ (i : ℕ), i ≤ d ∧ a i ≠ 0) ∨ a (nat.succ d) ≠ 0), by
        {
            exact @or.decidable (∃ (i : ℕ), i ≤ d ∧ a i ≠ 0) (a (nat.succ d) ≠ 0) hd hds,
        },
        have hiff : ((∃ (i : ℕ), i ≤ d ∧ a i ≠ 0) ∨ a (nat.succ d) ≠ 0) ↔ (∃ (i : ℕ), i ≤ nat.succ d ∧ a i ≠ 0), by
        {
            split,
            {-- need to prove: →
                intro h,
                cases h with ilt ieq,
                {-- case: ∃ (i : ℕ), i ≤ d ∧ a i ≠ 0
                    cases ilt with i hi,
                    use i,
                    split,
                    {-- need to prove: i ≤ nat.succ d
                        exact le_trans hi.elim_left (nat.le_succ d),
                    },
                    {-- need to prove: a i ≠ 0
                        exact hi.elim_right,
                    }
                },
                {-- case: a (nat.succ d) ≠ 0
                    use nat.succ d,
                    split,
                    {-- need to prove: nat.succ d ≤ nat.succ d
                        refl,
                    },
                    {-- need to prove: a (nat.succ d) ≠ 0
                        exact ieq,
                    }
                }
            },
            {-- need to prove: ←
                intro h,
                cases h with i hi,
                cases lt_or_eq_of_le hi.elim_left with ilt ieq,
                {-- case: i < nat.succ d
                    left,
                    use i,
                    split,
                    {-- need to prove: i ≤ d
                        exact nat.le_of_lt_succ ilt,
                    },
                    {-- need to prove: a i ≠ 0
                        exact hi.elim_right,
                    }
                },
                {-- case: i = nat.succ d
                    right,
                    rw ← ieq,
                    exact hi.elim_right,
                }
            },
        },
        apply decidable_of_decidable_of_iff hdt hiff,
    }
end

instance start_lt_not_zero_decidable (a : 𝒩) (n : ℕ) : decidable (∃ i : ℕ, i < n ∧ a i ≠ 0) :=
begin
    induction n with d hd,
    {
        apply is_false,
        intro h,
        cases h with i hi,
        exact (nat.not_lt_zero i) hi.elim_left,
    },
    {
        cases hd with hdfalse hdtrue,
        {-- case: ¬∃ (i : ℕ), i < d ∧ a i ≠ 0
            have hds : decidable (a d ≠ 0) := ne.decidable _ _,
            cases hds with hdsfalse hdstrue,
            {-- case: ¬a d ≠ 0
                apply is_false,
                intro h,
                cases h with i hi,
                cases lt_or_eq_of_le (nat.le_of_lt_succ hi.elim_left) with iltd ieqd,
                {-- case: i < d
                    apply hdfalse,
                    use i,
                    exact and.intro iltd hi.elim_right,
                },
                {-- case: i = d
                    rw ieqd at hi,
                    exact hdsfalse hi.elim_right,
                }
            },
            {-- case: a d ≠ 0
                apply is_true,
                use d,
                exact and.intro (lt_add_one d) hdstrue,
            }
        },
        {-- case: ∃ (i : ℕ), i < d ∧ a i ≠ 0
            apply is_true,
            cases hdtrue with i hi,
            use i,
            split,
            {-- need to prove: i < nat.succ d
                exact lt_trans hi.elim_left (lt_add_one d),
            },
            {-- need to prove: a i ≠ 0
                exact hi.elim_right,
            }
        }
    }
end

def snap (a : 𝒩) : ℛ := subtype.mk (λ n : ℕ, if h : (∃ i : ℕ, i ≤ n ∧ a i ≠ 0)
    then segment.inclusion (1 / nat.succ (nat.find h))
    else segment.two_sided_inclusion (1 / nat.succ n)
        begin
        -- need to prove: 1/n > 0
            simp [nat.zero_lt_succ, nat.cast_add_one_pos],
        end)
    begin
    -- need to prove: The function defined above is a real number: It shrinks and it dwindles
        split,
        {-- need to prove: shrinking
            rw shrinking,
            intro n,
            split_ifs with h₁ h₂,
            {-- case: (∃ i ≤ n+1, a i ≠ 0) ∧ (∃ i ≤ n, a i ≠ 0)
                suffices hh : nat.find h₁ = nat.find h₂,
                {-- need to prove: nat.find h₁ = nat.find h₂ → shrinking
                    rw hh,
                },
                {-- need to prove: nat.find h₁ = nat.find h₂
                    have hh₁ := nat.find_spec h₁,
                    have hh₂ := nat.find_spec h₂,
                    cases lt_trichotomy (nat.find h₁) (nat.find h₂) with hlt hge,
                    {-- case: nat.find h₁ < nat.find h₂
                        exfalso,
                        apply nat.find_min h₂ hlt,
                        split,
                        {-- need to prove: nat.find h₁ ≤ n
                            transitivity (nat.find h₂),
                            exact (le_of_lt hlt),
                            exact hh₂.elim_left,
                        },
                        {-- need to prove: a (nat.find h₁) ≠ 0
                            exact hh₁.elim_right,
                        }
                    },
                    {
                        cases hge with heq hgt,
                        {-- case: nat.find h₁ = nat.find h₂
                            exact heq,
                        },
                        {-- case: nat.find h₂ > nat.find h₁
                            exfalso,
                            apply nat.find_min h₁ hgt,
                            split,
                            {-- need to prove: nat.find h₂ ≤ n + 1
                                transitivity n,
                                exact hh₂.elim_left,
                                exact nat.le_succ n,
                            },
                            {-- need to prove: a (nat.find h₂) ≠ 0
                                exact hh₂.elim_right,
                            }
                        }
                    }
                }
            },
            {-- case: (∃ i ≤ n+1, a i ≠ 0) ∧ ¬(∃ i ≤ n, a i ≠ 0)
                dsimp [segment.inclusion, segment.two_sided_inclusion, segment.contained, segment.fst, segment.snd],
                split,
                {-- need to prove: -(1/(↑n+1)) ≤ 1/(↑(nat.find h₁) + 1)
                    transitivity (rat.mk 0 1),
                    repeat {
                        rw rat.zero_mk 1,
                        simp [le_of_lt, nat.cast_add_one_pos],
                    },
                },
                {-- need to prove: 1/(↑(nat.find h₁) + 1) ≤ (1/(↑n+1))
                    cases lt_or_eq_of_le (nat.find_spec h₁).elim_left with hlt heq,
                    {-- case: nat.find h₁ < n + 1
                        exfalso,
                        apply h₂,
                        use nat.find h₁,
                        split,
                        {-- need to prove: nat.find h₁ ≤ n
                            exact nat.lt_succ_iff.mp hlt,
                        },
                        {-- need to prove: a (nat.find h₁) ≠ 0
                            exact (nat.find_spec h₁).elim_right,
                        }
                    },
                    {-- case: nat.find h₁ = n + 1
                        rw heq,
                        rw one_div_le_one_div,
                        {-- need to prove: n + 1 ≤ n + 1 + 1
                            simp,
                        },
                        {-- need to prove: 0 ≤ n + 1
                            exact nat.cast_add_one_pos _,
                        },
                        {-- need to prove: 0 ≤ n + 1 + 1
                            exact nat.cast_add_one_pos _,
                        }
                    }
                }
            },
            {-- case: ¬(∃ i ≤ n+1, a i ≠ 0) ∧ (∃ i ≤ n, a i ≠ 0)
                exfalso,
                cases h with i hi,
                apply h₁,
                use i,
                split,
                {-- need to prove: i < n + 1
                    transitivity n,
                    exact hi.elim_left,
                    exact nat.le_succ n,
                },
                {-- need to prove: a i ≠ 0
                    exact hi.elim_right,
                }
            },
            {-- case: ¬(∃ i ≤ n+1, a i ≠ 0) ∧ ¬(∃ i ≤ n, a i ≠ 0)
                apply segment.two_sided_inclusion_contained,
                rw one_div_le_one_div,
                {-- need to prove: ↑(nat.succ n) ≤ ↑(nat.succ (n + 1))
                    simp,
                },
                {-- need to prove: 0 < ↑(nat.succ (n+1))
                    transitivity (↑n + 1 : ℚ),
                    exact nat.cast_add_one_pos n,
                    simp [zero_lt_one],
                },
                {-- need to prove: 0 < ↑(nat.succ n)
                    exact nat.cast_add_one_pos n,
                }
            }
        },
        {-- need to prove: Dwindling
            rw dwindling,
            intros q hq,
            dsimp [segment.inclusion, segment.two_sided_inclusion, segment.snd, segment.fst],
            sorry,
        }
    end

theorem reckless_LPO_real_lt_eq_gt : reckless_LPO (∀ x y : ℛ, x < y ∨ x =' y ∨ y < x) :=
begin
    split,
    {
        intros po x y,
        cases po (x < y) with xlt nxlt,
        {-- case: x < y
            left,
            exact xlt,
        },
        {-- case: ¬x < y
            right,
            cases po (y < x) with xgt nxgt,
            {-- case: y < x
                right,
                exact xgt,
            },
            {-- case: ¬y < x
                left,
                rw ← real_seq.le_iff_not_lt at *,
                exact real_seq.eq_of_le_of_le _ _ nxgt nxlt,
            }
        }
    },
    {-- need to prove: (∀ x : ℛ, x < y ∨ x =' y ∨ y < x) → LPO
        intros h a,
        have hsnap := h (snap a) (real_seq.inclusion_const 0),
        cases hsnap with hlt hge,
        {-- case: snap a < 0
            exfalso,
            cases hlt with n hn,
            simp [real_seq.seq, real_seq.inclusion_const, segment.inclusion, snap,
                segment.two_sided_inclusion, segment.lt, segment.fst, segment.snd] at hn,
            split_ifs at hn,
            {-- case: ∃ i : ℕ, i ≤ n ∧ a i ≠ 0
                apply not_le_of_lt hn,
                simp [le_of_lt, nat.cast_add_one_pos],
            },
            {-- case: ¬∃ i : ℕ, i ≤ n ∧ a i ≠ 0
                apply not_le_of_lt hn,
                simp [le_of_lt, nat.cast_add_one_pos],
            }
        },
        {
            cases hge with heq hgt,
            {-- case: snap a = 0
                left,
                intro n,
                have hn := heq n,
                simp [real_seq.seq, segment.touches, segment.le, segment.fst, segment.snd,
                    real_seq.seq, real_seq.inclusion_const, segment.inclusion, snap, segment.two_sided_inclusion] at hn,
                cases hn with hn₁ hn₂,
                split_ifs at hn₁,
                {-- case: ∃ i : ℕ, i ≤ n ∧ a i ≠ 0
                    exfalso,
                    apply not_lt_of_le hn₁,
                    simp [nat.cast_add_one_pos],
                },
                {-- case: ¬∃ i : ℕ, i ≤ n ∧ a i ≠ 0
                    have han := (forall_not_of_not_exists h_1) n,
                    simp at han,
                    exact han,
                }
            },
            {-- case: snap a > 0
                right,
                cases hgt with n hn,
                simp [real_seq.seq, real_seq.inclusion_const, segment.inclusion, snap,
                    segment.two_sided_inclusion, segment.lt, segment.fst, segment.snd] at hn,
                split_ifs at hn,
                {-- case: ∃ i : ℕ, i ≤ n ∧ a i ≠ 0
                    cases h_1 with i hi,
                    use i,
                    exact hi.elim_right,
                },
                {-- case: ¬∃ i : ℕ, i ≤ n ∧ a i ≠ 0
                    exfalso,
                    rwa [lt_neg, neg_zero] at hn,
                    apply not_le_of_lt hn,
                    simp [le_of_lt, nat.cast_add_one_pos],
                }
            }
        }
    }
end

def WLEM : Prop := ∀ P : Prop, ¬P ∨ ¬¬P

def WLPO : Prop := ∀ a : 𝒩, (∀ n : ℕ, a n = 0) ∨ (¬∀ n : ℕ, a n = 0)

theorem PO_implies_WLEM : PO → WLEM :=
begin
    intros po P,
    cases po P with hp np,
    {-- case: P
        right, -- need to prove: ¬¬P
        intro np,
        exact np hp,
    },
    {-- case: ¬P
        left, -- need to prove: ¬P
        exact np,
    }
end

theorem LPO_implies_WLPO : LPO → WLPO :=
begin
    intros lpo a,
    cases lpo a with aeq ane,
    {-- case: ∀ n : ℕ, a n = 0
        left, -- need to prove: ∀ n : ℕ, a n = 0
        exact aeq,
    },
    {-- case: ∃ n : ℕ, a n ≠ 0
        right, -- need to prove: ¬∀ n : ℕ, a n = 0
        intro aeq,
        cases ane with n hn,
        exact hn (aeq n),
    }
end

theorem weak_LEM_implies_weak_LPO : WLEM → WLPO :=
begin
    intros wlem a,
    cases wlem (∃ n : ℕ, a n ≠ 0) with nh nnh,
    {-- case: ¬∃ (n : ℕ), a n ≠ 0
        left,
        have h : ∀ n : ℕ, ¬ a n ≠ 0 := forall_not_of_not_exists nh,
        intro n,
        have hn := h n,
        rwa [ne.def, not_not] at hn,
    },
    {-- case: ¬¬∃ (n : ℕ), a n = 0
        right,
        intro h,
        apply nnh,
        intro nex,
        cases nex with n nhn,
        exact nhn (h n),
    }
end

theorem weak_LPO_implies_LLPO : WLPO → LLPO :=
begin
    intros wlpo a,
    set d : 𝒩 := λ n, if n % 2 = 0 then if (∃ i : ℕ, i < n ∧ a i ≠ 0) then 0 else a n else 0 with ddef,
    cases wlpo d with deq nd,
    {-- case: ∀ n : ℕ, d n = 0
        right,
        intros k hk, -- need to prove: k % 2 = 1
        have hdk := deq k,
        rw ddef at hdk,
        simp at hdk,
        rw ← nat.mod_two_ne_zero,
        intro hkm,
        split_ifs at hdk,
        {-- case: ∃ i : ℕ, i < k ∧ a i ≠ 0
            cases h with i hi,
            apply hi.elim_right,
            exact hk.elim_left i hi.elim_left,
        },
        {-- case: ¬∃ i : ℕ, i < k ∧ a i ≠ 0 and a k = 0
            exact hk.elim_right hdk,
        }
    },
    {-- case: ¬∀ n : ℕ, d n = 0
        left,
        intros k hk, -- need to prove: k % 2 = 0
        rw ← nat.mod_two_ne_one,
        intro hkm,
        apply nd,
        intro n,
        rw ddef,
        simp,
        split_ifs,
        {-- need to prove: 0 = 0
            refl,
        },
        {-- need to prove: a n = 0, using n % 2 = 0 and ∀ x : ℕ, x < n → a x = 0
            simp at h_1,
            cases nat.lt_trichotomy n k with nlt nge,
            {-- case: n < k
                exact hk.elim_left n nlt,
            },
            {-- case: n ≥ k
                cases nge with neq ngt,
                {-- case: n = k
                    exfalso,
                    rwa [← nat.mod_two_ne_one, neq] at h,
                    exact h hkm,
                },
                {-- case: n > k
                    exfalso,
                    apply hk.elim_right,
                    exact h_1 k ngt,
                }
            }
        },
        {-- need to prove: 0 = 0
            refl,
        }
    }
end

theorem weak_LEM_implies_LLPO : WLEM → LLPO :=
begin
    intro wlem,
    apply weak_LPO_implies_LLPO,
    exact weak_LEM_implies_weak_LPO wlem,
end

-- We can also prove the above statement directly
theorem weak_LEM_implies_LLPO' : WLEM → LLPO :=
begin
    intros wlem b,
    cases wlem (∀ (k : ℕ), (∀ (i : ℕ), i < k → b i = 0) ∧ b k ≠ 0 → k % 2 = 0) with nh nnh,
    {-- case: ¬∀ (k : ℕ), (∀ (i : ℕ), i < k → b i = 0) ∧ b k ≠ 0 → k % 2 = 0
        right, -- need to prove: ∀ (k : ℕ), (∀ (i : ℕ), i < k → b i = 0) ∧ b k ≠ 0 → k % 2 = 1
        intros k hk,
        rw ← nat.mod_two_ne_zero,
        intro h,
        apply nh,
        intros j hj,
        have hjk : j = k := nat_seq.first_zero_eq b j k hj.elim_left hj.elim_right hk.elim_left hk.elim_right,
        rw hjk,
        exact h,
    },
    {-- case: ¬¬∀ (k : ℕ), (∀ (i : ℕ), i < k → b i = 0) ∧ b k ≠ 0 → k % 2 = 0
        left, -- need to prove: ∀ (k : ℕ), (∀ (i : ℕ), i < k → b i = 0) ∧ b k ≠ 0 → k % 2 = 0
        intros k hk,
        rw ← nat.mod_two_ne_one,
        rw ← nat.mod_two_ne_zero,
        intro h0,
        apply nnh,
        intro h,
        exact h0 (h k hk),
    }
end

theorem reckless_LLPO_not_not_or : reckless_LLPO (∀ P Q : Prop, ¬¬(P ∨ Q) → (¬¬P ∨ ¬¬Q)) :=
begin
    split,
    {-- need to prove: PO → ∀ (P Q : Prop), ¬¬(P ∨ Q) → ¬¬P ∨ ¬¬Q
        intros po P Q h,
        cases po P with hp np,
        {-- case: P
            left,
            intro np,
            exact np hp,
        },
        {-- case: ¬P
            cases po Q with hq nq,
            {-- case: Q
                right,
                intro nq,
                exact nq hq,
            },
            {-- case: ¬Q
                exfalso,
                apply h,
                intro pq,
                cases pq with hp hq,
                {-- case: P
                    exact np hp,
                },
                {-- case: Q
                    exact nq hq,
                }
            }
        }
    },
    {-- need to prove: (∀ (P Q : Prop), ¬¬(P ∨ Q) → ¬¬P ∨ ¬¬Q) → LPO
        intro h₁,
        apply weak_LEM_implies_LLPO,
        intro P,
        have h₂ := h₁ P (¬P) (not_not_em P),
        cases h₂ with nn nnn,
        {-- case: ¬¬P
            right,
            exact nn
        },
        {-- case: ¬¬¬P
            left,
            exact (not_not_not_iff P).mp nnn,
        }
    }
end

theorem reckless_LLPO_not_and_implies_not_or_not : reckless_LLPO (∀ P Q : Prop, ¬(P ∧ Q) → (¬P ∨ ¬Q)) :=
begin
    split,
    {-- need to prove: PO → ∀ (P Q : Prop), ¬(P ∧ Q) → ¬P ∨ ¬Q
        intros po P Q h,
        cases po P with hp np,
        {-- case: P
            cases po Q with hq nq,
            {-- case: Q
                exfalso,
                exact h (and.intro hp hq),
            },
            {-- case: ¬Q
                right,
                exact nq,
            }
        },
        {-- case: ¬P
            left,
            exact np,
        }
    },
    {-- need to prove: (∀ (P Q : Prop), ¬(P ∧ Q) → ¬P ∨ ¬Q) → LLPO
        intro h,
        apply weak_LEM_implies_LLPO,
        intro P,
        exact h P (¬P) (and_not_self P).mp,
    }
end

/--
If P ∨ ¬P holds for some proposition P, then eliminating double negation is allowed for P
-/
lemma or_not_implies_not_not_implies (h : P ∨ ¬P) : ¬¬P → P :=
begin
    intro hp,
    cases h with p np,
    exact p,
    exfalso,
    exact hp np,
end

theorem reckless_LLPO_not_not_implies_or : reckless_LLPO (∀ P : Prop, (¬¬P → P) → P ∨ ¬P) :=
begin
    split,
    {-- need to prove: PO → ∀ (P : Prop), (¬¬P → P) → P ∨ ¬P
        intros po P h,
        exact po P,
    },
    {-- need to prove: (∀ (P : Prop), (¬¬P → P) → P ∨ ¬P) → LLPO
        intro h,
        apply weak_LEM_implies_LLPO,
        intro P,
        have hp := h (¬P),
        exact hp (not_not_not_iff P).mp,
    }
end

-- A reminder that brackets are important
example : (∀ P : Prop, ¬¬P → P) → (∀ P : Prop, P ∨ ¬P) :=
begin
    intros h P,
    exact h (P ∨ ¬P) (not_not_em P),
end

end reckless


import data.nat.totient data.nat.prime_norm_num

/-!
# Bounds on the totient function

This file proves some bound on the totient function.
The main interest is to solve 2020 N4 by characterizing all `n : ℕ` such that `φ(n) ≤ 2`.
-/

namespace IMOSL
namespace extra

open finset

lemma totient_big_prime_div {p : ℕ} (hp : p.prime) (h : 3 < p) {n : ℕ} (h0 : 0 < n) (h1 : p ∣ n) :
  2 < n.totient :=
begin
  refine lt_of_lt_of_le _ (nat.le_of_dvd (nat.totient_pos h0) (nat.totient_dvd_of_dvd h1)),
  rwa [nat.totient_prime hp, lt_tsub_iff_right, ← bit1]
end

lemma totient_le_two_eq_two_pow_times_three_pow {n : ℕ} (h : 0 < n) (h0 : n.totient ≤ 2) :
  ∃ a b : ℕ, n = 2 ^ a * 3 ^ b :=
begin
  refine ⟨n.factorization 2, n.factorization 3, _⟩,
  suffices : n.factorization.support ⊆ {2, 3},
  { nth_rewrite 0 ← nat.factorization_prod_pow_eq_self (ne_of_gt h),
    rw [finsupp.prod_of_support_subset _ this, finset.prod_insert, finset.prod_singleton],
    rw finset.mem_singleton; exact nat.bit0_ne_bit1 _ _,
    rintros p -; exact pow_zero p },
  intros p h1; contrapose! h0,
  have h2 : p.prime := nat.prime_of_mem_factorization h1,
  replace h1 := nat.dvd_of_mem_factorization h1,
  refine totient_big_prime_div h2 _ h h1,
  contrapose! h0; rw [finset.mem_insert, finset.mem_singleton],
  rw [le_iff_lt_or_eq, nat.lt_succ_iff, le_iff_lt_or_eq, nat.lt_succ_iff, or_assoc] at h0,
  cases h0 with h0 h0,
  rw [le_iff_lt_or_eq, nat.lt_one_iff] at h0,
  exfalso; rcases h0 with rfl | rfl,
  exacts [nat.not_prime_zero h2, nat.not_prime_one h2, h0]
end

lemma big_two_lt_totient {n : ℕ} (h : 6 < n) : 2 < n.totient :=
begin
  rw ← not_le; intros h0,
  obtain ⟨a, b, rfl⟩ := totient_le_two_eq_two_pow_times_three_pow (pos_of_gt h) h0,
  revert h; rw [imp_false, not_lt],
  replace h0 := le_trans (nat.totient_super_multiplicative _ _) h0,
  have h := nat.totient_prime_pow_succ nat.prime_two,
  rw [bit0, nat.add_sub_cancel, ← bit0] at h; simp only [mul_one] at h,
  cases b with _ b,
  { rw [pow_zero, nat.totient_one, mul_one] at h0,
    rw [pow_zero, mul_one],
    cases a with _ a,
    rw pow_zero; norm_num,
    rw h at h0; rw pow_succ,
    refine le_trans (nat.mul_le_mul_left 2 h0) _,
    norm_num },
  { rw [nat.totient_prime_pow_succ nat.prime_three, bit1, nat.add_sub_cancel, ← bit1,
        ← mul_assoc, mul_le_iff_le_one_left (two_pos : 0 < 2), le_iff_eq_or_lt,
        nat.mul_eq_one_iff, nat.lt_one_iff, mul_eq_zero, nat.totient_eq_one_iff] at h0,
    clear h; rcases h0 with ⟨h | h, h0⟩ | h | h,
    rw [h, one_mul, pow_succ, h0, mul_one]; norm_num,
    rw [h, pow_succ, h0, mul_one]; norm_num,
    exfalso; exact ne_of_gt (nat.totient_pos (pow_pos two_pos a)) h,
    exfalso; refine ne_of_gt (pow_pos _ b) h; exact three_pos }
end

lemma big_two_lt_totient' {n : ℕ} (h : 5 ≤ n) (h0 : n ≠ 6) : 2 < n.totient :=
begin
  rw [le_iff_eq_or_lt, ← nat.succ_le_iff, le_iff_eq_or_lt] at h,
  rcases h with rfl | rfl | h,
  rw nat.totient_prime; norm_num,
  exfalso; exact h0 rfl,
  exact big_two_lt_totient h
end

lemma exists_nontrivial_coprime {n : ℕ} (h : 5 ≤ n) (h0 : n ≠ 6) :
  ∃ k m : ℕ, 1 < k ∧ 1 < m ∧ k.coprime m ∧ k + m = n :=
begin
  replace h0 : 0 < (filter n.coprime (range n) \ {1, n - 1}).card :=
  begin
    refine lt_of_lt_of_le _ (le_card_sdiff _ _),
    rw tsub_pos_iff_lt; refine lt_of_le_of_lt (card_insert_le _ _) _,
    rw card_singleton; exact big_two_lt_totient' h h0
  end,

  rw card_pos at h0,
  cases h0 with k h0,
  rw [mem_sdiff, mem_filter, mem_range, mem_insert, mem_singleton, not_or_distrib] at h0,
  rcases h0 with ⟨⟨h0, h1⟩, h2, h3⟩,
  rw lt_iff_exists_add at h0,
  rcases h0 with ⟨m, h0, rfl⟩,
  rw nat.coprime_self_add_left at h1,
  rw [← ne.def, ne_iff_lt_or_gt, gt_iff_lt, nat.lt_one_iff] at h2,
  replace h : 1 ≤ k + m := le_trans (by norm_num : 1 ≤ 5) h,
  rw [eq_comm, nat.sub_eq_iff_eq_add h, add_right_inj, ← ne.def, ne_iff_lt_or_gt,
      gt_iff_lt, nat.lt_one_iff, or_iff_right (ne_of_gt h0)] at h3,
  rcases h2 with rfl | h2,
  rw nat.coprime_zero_right at h1,
  exfalso; exact ne_of_gt h3 h1,
  exact ⟨k, m, h2, h3, h1.symm, rfl⟩
end

end extra
end IMOSL


/-
Probability theory generalities.
Some parts of this file are originally from
https://github.com/johoelzl/mathlib/blob/c9507242274ac18defbceb917f30d6afb8b839a5/src/probability_theory/basic.lean

Authors: Johannes Holzl, Koundinya Vajjha
-/
import measure_theory.measure_space tactic.tidy measure_theory.giry_monad

local attribute [instance] classical.prop_decidable

noncomputable theory
open measure_theory ennreal lattice  measure_theory  measure_theory.measure set

universe u

section
variables (α : Type*) [measurable_space α]

structure probability_measure extends measure_theory.measure α :=
(measure_univ : to_measure univ = 1)

instance : measurable_space (probability_measure α) :=
measure.measurable_space.comap probability_measure.to_measure

lemma measurable_to_measure :
  measurable (@probability_measure.to_measure α _) :=
measurable_space.le_map_comap

instance prob_measure_coe : has_coe (probability_measure α) (measure α) :=
⟨probability_measure.to_measure⟩

instance : has_coe_to_fun (probability_measure α) :=
⟨λ_, set α → nnreal, λp s, ennreal.to_nnreal (p.to_measure s)⟩
end

namespace probability_measure
section
parameters {α : Type*} [measurable_space α] (p : probability_measure α)

lemma to_measure_lt_top (s : set α) : p.to_measure s < ⊤ :=
lt_of_le_of_lt (measure_mono $ subset_univ s) $ p.measure_univ.symm ▸ coe_lt_top

lemma to_measure_ne_top (s : set α) : p.to_measure s ≠ ⊤ :=
lt_top_iff_ne_top.1 (to_measure_lt_top s)

lemma coe_eq_to_measure (s : set α) : (p s : ennreal) = p.to_measure s :=
coe_to_nnreal (to_measure_ne_top s)

@[simp] lemma prob_apply {α : Type u} [measurable_space α] {s : set α}(hs : is_measurable s) (p : probability_measure α) :
(p : probability_measure α) s = ennreal.to_nnreal (p.to_measure s)
:= rfl

@[extensionality] lemma prob.ext {α} [measurable_space α] :
  ∀ {μ₁ μ₂ : probability_measure α}, (∀s, is_measurable s → μ₁ s = μ₂ s) → μ₁ = μ₂
| ⟨m₁, u₁⟩ ⟨m₂, u₂⟩ H := begin
  congr, refine measure.ext (λ s hs, _),
  have : (ennreal.to_nnreal (m₁ s) : ennreal) = ennreal.to_nnreal (m₂ s) :=
  congr_arg coe (H s hs),
  rwa [coe_to_nnreal, coe_to_nnreal] at this,
  apply lt_top_iff_ne_top.1 (lt_of_le_of_lt (measure_mono $ subset_univ s) $ by rw u₂ ; exact ennreal.lt_top_iff_ne_top.2 one_ne_top),
  apply lt_top_iff_ne_top.1 (lt_of_le_of_lt (measure_mono $ subset_univ s) $ by rw u₁ ; exact ennreal.lt_top_iff_ne_top.2 one_ne_top)
end

@[simp] lemma prob_empty : p ∅ = 0 :=
by rw [← coe_eq_coe, coe_eq_to_measure, measure_empty, coe_zero]

@[simp] lemma prob_univ : p univ = 1 :=
by rw [← coe_eq_coe, coe_eq_to_measure]; exact p.measure_univ

@[simp] lemma prob_mono {s t} (h : s ⊆ t) : p s ≤ p t :=
by rw [← coe_le_coe, coe_eq_to_measure, coe_eq_to_measure]; exact measure_mono h

lemma prob_le_1 (a : set α):
 p a ≤ (1:nnreal) :=
begin
  intros,
  rewrite ← prob_univ p,
  apply prob_mono,
  apply subset_univ,
end

lemma prob_mono_null {s t} (h : t ⊆ s) (h₂ : p s = 0) : p t = 0 :=
by rw [← le_zero_iff_eq, ← h₂]; exact prob_mono p h

lemma prob_Union_null {β} [encodable β] {s : β → set α} (h : ∀ i, p (s i) = 0) : p (⋃i, s i) = 0 :=
begin
  rw [← coe_eq_coe, coe_eq_to_measure, measure_Union_null, coe_zero],
  assume i, specialize h i, rwa [← coe_eq_coe, coe_eq_to_measure] at h
end

theorem prob_union_le (s₁ s₂ : set α) : p (s₁ ∪ s₂) ≤ p s₁ + p s₂ :=
by simp only [coe_le_coe.symm, coe_add, coe_eq_to_measure]; exact measure_union_le _ _

lemma prob_union {s₁ s₂ : set α}
  (hd : disjoint s₁ s₂) (h₁ : is_measurable s₁) (h₂ : is_measurable s₂) :
  p (s₁ ∪ s₂) = p s₁ + p s₂ :=
by simp only [coe_eq_coe.symm, coe_add, coe_eq_to_measure]; exact measure_union hd h₁ h₂

lemma prob_diff {s₁ s₂ : set α} (h : s₂ ⊆ s₁) (h₁ : is_measurable s₁) (h₂ : is_measurable s₂) :
  p (s₁ \ s₂) = p s₁ - p s₂ :=
by simp only [coe_eq_coe.symm, coe_sub, coe_eq_to_measure];
  exact measure_diff h h₁ h₂ (to_measure_lt_top _ _)

lemma prob_diff_inter
{a b : set α} (h₁ : is_measurable a) (h₂ : is_measurable b) :
p(b ∩ -a) + p(b ∩ a) = p(b) :=
begin
  have h :p(b) = p(b ∩ univ),
  by rewrite inter_univ b,
  rewrite [h,← compl_union_self a,set.inter_distrib_left,prob_union],
  have g : (b ∩ -a) ∩ (b ∩ a) = ∅, by rw [inter_left_comm,set.inter_assoc, compl_inter_self,inter_empty,inter_empty],
  apply disjoint_iff.2 g,
  {
  rewrite ← diff_eq,
  apply is_measurable.diff h₂ h₁,
  },
  apply is_measurable.inter h₂ h₁,
end

lemma prob_union_inter
(a b : set α) (g₁ : is_measurable a) (g₂ : is_measurable b) :
p(a ∪ b) + p(a ∩ b) = p(a) + p(b) :=
begin
  have h₁ : a ∪ b = a ∪ (b ∩ -a),by
  rw [set.union_distrib_left, union_compl_self a,inter_univ],
  have h₂ : is_measurable(b ∩ -a), by exact is_measurable.diff g₂ g₁,
  have h₃ : a ∩ (b ∩ -a) = ∅, by tidy,
  rw h₁,
  rw [prob_union p (disjoint_iff.2 h₃) g₁ h₂],
  rw [←prob_diff_inter p g₁ g₂],
  simp,
  rw [inter_comm],
end

lemma prob_comp (a : set α) (h: is_measurable a) : p(-a) + p(a) = 1 :=
begin
  intros, rw ← prob_univ p, rw [←prob_union], simp,
  exact disjoint_iff.2 (@compl_inter_self _ a),
  apply is_measurable.compl h,
  assumption,
end

/-- The Bonnferroni inequality. -/
lemma prob_add_le_inter_add_one
(a b : set α) (h_1 : is_measurable a) (h_2 : is_measurable b) :
p(a) + p(b) ≤ p(a ∩ b) + 1 :=
begin
  rw [← prob_union_inter p a b h_1 h_2, ← add_comm],
  exact add_le_add_left' (prob_le_1 p (a ∪ b)),
end

protected lemma nonempty : nonempty α :=
classical.by_contradiction $ assume h,
  have 0 = p univ, by rw [univ_eq_empty_iff.2 h]; exact p.prob_empty.symm,
  @zero_ne_one nnreal _ $ by rwa [p.prob_univ] at this

@[simp] lemma integral_const (r : ennreal) : integral p.to_measure (λa, r) = r :=
suffices integral p.to_measure (λa, ⨆ (h : a ∈ (univ : set α)), r) =
  r * p.to_measure univ, by rw [← coe_eq_to_measure] at this; simpa,
@lintegral_supr_const α { μ := p.to_measure } r _ is_measurable.univ

lemma integral_univ : integral p.to_measure (λ a, 1) = 1 := by simp

-- somehow we need δ ≤ 1 o/w coercion hell.
lemma neq_prob_set {α : Type} [measurable_space α] (f : α → nnreal) (μ : probability_measure α) (ε δ : nnreal) (hd : δ ≤ 1) (hS : is_measurable ({x : α | f x > ε})) : μ({x : α | f x > ε}) ≤ δ ↔ μ ({x : α | f x ≤ ε}) ≥ 1 - δ :=
begin
  rw nnreal.coe_le,
  have h₀ : {x : α | f x > ε} = - {x : α | f x ≤ ε},by tidy,
  have h₁ : - {x : α | f x > ε} = {x : α | f x ≤ ε}, by tidy,
  have h₃ : (μ ({x : α | f x > ε}) : ℝ) + μ{x : α | f x ≤ ε} = 1, {
  rw ←nnreal.coe_add, rw h₀, rw prob_comp, simp, rw ←h₁,
  apply is_measurable.compl hS,
  },
  have h₅ : (μ ({x : α | f x > ε}) : ℝ) = 1 - μ ({x : α | f x ≤ ε}),
  {
  rw ←h₃, symmetry, rw add_sub_cancel,
  },
  rw h₅, rw sub_le_iff_le_add',
  rw add_comm, rw ←sub_le_iff_le_add', rw ←nnreal.coe_one,
  rw ←nnreal.coe_sub _ _ hd, rw ←nnreal.coe_le,
end

lemma neq_prob_set' {α : Type} [measurable_space α] (f : α → nnreal) (μ : probability_measure α) (ε δ : nnreal) (hd : δ ≤ 1) (hS : is_measurable ({x : α | f x > ε})) : μ({x : α | f x > ε}) ≤ δ ↔ μ ({x : α | f x ≤ ε}) + δ ≥ 1 :=
begin
  have h₀ : {x : α | f x > ε} = - {x : α | f x ≤ ε},by tidy,
  have h₁ : - {x : α | f x > ε} = {x : α | f x ≤ ε}, by tidy,
  have h₃ : (μ ({x : α | f x > ε})) + μ{x : α | f x ≤ ε} = 1, {
  rw h₀, rw prob_comp, rw ←h₁, apply is_measurable.compl hS,
  },
  symmetry, rw ← h₃, rw add_comm,
  rw ←add_le_add_iff_right,
end

lemma prob_trivial {α: Type} [measurable_space α]:
  ∀ P: α → Prop, ∀ μ: probability_measure α,
  (∀ x, P x) → μ {x: α | P x} = 1 :=
begin
  intros,
  have UNIV : {x: α | P x} = univ,
  {
    apply eq_univ_of_forall,
    intro,
    rw mem_set_of_eq,
    apply a,
  },
  rw UNIV,
  apply prob_univ,
end

end

end probability_measure

section giry_monad

variables {α : Type*} {β : Type*} {γ : Type*}
variables [measurable_space α] [measurable_space β] [measurable_space γ]

def pure (a : α) : probability_measure α :=
⟨measure.dirac a, by rw [measure_theory.measure.dirac_apply a is_measurable.univ]; simp⟩

def map (f : α → β) (p : probability_measure α) : probability_measure β :=
if h : measurable f then
  ⟨measure.map f p, by rw [measure_theory.measure.map_apply h is_measurable.univ, preimage_univ]; exact p.measure_univ⟩
else
  pure (f $ classical.choice p.nonempty)

def join (m : probability_measure (probability_measure α)) : probability_measure α :=
⟨measure_theory.measure.bind m.to_measure probability_measure.to_measure,
  by rw [measure_theory.measure.bind_apply is_measurable.univ (measurable_to_measure α)];
  simp [probability_measure.measure_univ]⟩

def bind (m : probability_measure α) (f : α → probability_measure β) : probability_measure β :=
join (map f m)

def dirac (a : α) : probability_measure α :=
⟨ measure.dirac a , by rw [dirac_apply _ is_measurable.univ]; simp ⟩

@[simp] theorem map_apply {f : α → β} (μ : probability_measure α) (hf : measurable f)
  {s : set β} (hs : is_measurable s) :
  (map f μ : probability_measure β) s = μ (f ⁻¹' s) :=
begin
  rw _root_.map, rw dif_pos hf, unfold_coes, congr, simp, apply measure_theory.measure.map_apply hf hs,
end

@[simp] lemma join_apply {m : probability_measure (probability_measure α)} :
  ∀{s : set α}, is_measurable s → (join m : probability_measure α) s = (integral m.to_measure (λμ, μ s)).to_nnreal :=
begin
  intros s hs,
  rw _root_.join,
  transitivity,
  unfold_coes, congr, simp, transitivity,
  refine measure_theory.measure.bind_apply hs (measurable_to_measure _),
  congr, funext, symmetry, transitivity,
  apply coe_to_nnreal, apply probability_measure.to_measure_ne_top, refl,
end

lemma prob.measurable_coe {s : set α} (hs : is_measurable s) : measurable (λμ : probability_measure α, μ s) :=
begin
  have h : (λ (μ : probability_measure α), μ s) =
  (λ μ:measure α, (μ s).to_nnreal) ∘ (λ μ:probability_measure α, μ.to_measure),by refl,
  rw h,
  refine measurable.comp _ (measurable_to_measure _),
  refine measurable.comp _ (measurable_coe hs),
  refine measurable_of_measurable_nnreal _, simp,
  exact measurable_id,
end

-- TODO(Kody) : Get rid of the tidy part at the end. (Makes it slow!)
lemma prob.measurable_coe_iff_measurable_to_measure (f : β → probability_measure α) :
measurable f ↔ measurable ((λ μ:probability_measure α, μ.to_measure) ∘ f ) :=
begin
  fsplit,
  {intro hf, exact measurable.comp (measurable_to_measure _) hf},
  {intros hf s hs,
  refine measurable_space.comap_le_iff_le_map.1 _ _ _,
  exact measure.measurable_space.comap probability_measure.to_measure
  ,
  simp, tidy,}
end

lemma prob.measurable_measure_kernel [measurable_space α] [measurable_space β] {f : α → probability_measure β} {A : set β} (hf : measurable f) (hA : is_measurable A) : measurable (λ a, f a A) :=
 measurable.comp (prob.measurable_coe hA) hf

-- Rethink and rename these.
instance (β : Type u): measurable_space (set β) := ⊤

lemma prob_super [measurable_space α] [measurable_space β] {f: α → set β} (hf : measurable f) (μ : probability_measure β) :
measurable (λ x, μ (f x)) :=
begin
refine measurable.comp _ hf,
intros i a, fsplit,
end

lemma measurable_to_nnreal : measurable (ennreal.to_nnreal) := measurable_of_measurable_nnreal measurable_id

lemma measurable_to_nnreal_comp_of_measurable  (f: α → ennreal) : (measurable f) → measurable (λ x, ennreal.to_nnreal (f x)) :=
assume h, measurable.comp measurable_to_nnreal h

lemma measurable_of_ne_top (f : α → ennreal) (h : ∀ x, (f x) ≠ ⊤) (hf : measurable(λ x, ennreal.to_nnreal (f x))): measurable (λ x, f x)  :=
begin
  have h₀ : ∀ x, ↑((f x).to_nnreal) = f x, assume x, rw coe_to_nnreal (h x),
  conv{congr,funext, rw ←h₀,},
  apply measurable.comp measurable_coe hf,
end

lemma prob.measurable_of_measurable_coe (f : β → probability_measure α)
  (h : ∀(s : set α) (hs : is_measurable s), measurable (λb, f b s)) :
  measurable f :=
begin
  rw prob.measurable_coe_iff_measurable_to_measure,
  apply measurable_of_measurable_coe,
  intros s hs,
  conv{congr,funext,rw function.comp_apply,},
  refine measurable_of_ne_top _ _ _,
  intro x, refine probability_measure.to_measure_ne_top _ _,
  exact h _ hs,
 end

@[simp] lemma bind_apply {m : probability_measure α} {f : α → probability_measure β} {s : set β}
  (hs : is_measurable s) (hf : measurable f) : (bind m f : probability_measure β) s = (integral m.to_measure (λa, f a s)).to_nnreal :=
begin
  rw _root_.bind, rw _root_.join_apply hs, congr,
  have h : (_root_.map f m).to_measure = map f m.to_measure,{
  apply measure.ext, intros s hs, rw measure_theory.measure.map_apply hf hs,
  rw _root_.map, rw dif_pos hf,unfold_coes, simp, apply measure_theory.measure.map_apply hf hs,
  },
  rw h, rw integral_map _ hf,
  refine measurable.comp measurable_coe _,
  exact prob.measurable_coe hs,
end

attribute [irreducible] pure map join bind

infixl ` >>=ₚ `:55 :=  _root_.bind
infixl ` <$>ₚ `:55 := _root_.map

notation `doₚ` binders ` ←ₚ ` m ` ; ` t:(scoped p, m >>=ₚ p) := t

notation `retₚ` := _root_.dirac

lemma ret_to_measure {γ : Type u} [measurable_space γ] : ∀  (x:γ), (retₚ x).to_measure = measure.dirac x := assume x, rfl

def prod.prob_measure [measurable_space α][measurable_space β] (μ : probability_measure α) (ν : probability_measure β) : probability_measure (α × β) :=
doₚ x ←ₚ μ ;
doₚ y ←ₚ ν ;
  retₚ (x, y)

infixl ` ⊗ₚ `:55 :=  prod.prob_measure

/- TODO(Kody) :
   1) shorten these proofs by using the ones proven for measures.
   2) Make a simp lemma to get rid of the conv block.
-/
lemma prob_inl_measurable_dirac [measurable_space α][measurable_space β]  : ∀ y : β,  measurable (λ (x : α), retₚ (x, y)) := assume y,
begin
  rw prob.measurable_coe_iff_measurable_to_measure,
  apply measurable_of_measurable_coe, intros s hs,
  conv{congr,funext,rw function.comp_apply, rw _root_.dirac,},
  simp [hs,mem_prod_eq,lattice.supr_eq_if],
  apply measurable_const.if _ measurable_const,
  apply measurable.preimage _ hs,
  apply measurable.prod, dsimp, exact measurable_id,
  dsimp, exact measurable_const,
end

lemma prob_inr_measurable_dirac [measurable_space β][measurable_space α] : ∀ x : α,  measurable (λ (y : β), retₚ (x, y)) := assume x, begin
  rw prob.measurable_coe_iff_measurable_to_measure,
  apply measurable_of_measurable_coe, intros s hs,
  conv{congr,funext,rw function.comp_apply, rw _root_.dirac,},
  simp [hs,mem_prod_eq,lattice.supr_eq_if],
  apply measurable_const.if _ measurable_const,
  apply measurable.preimage _ hs,
  apply measurable.prod, dsimp,  exact measurable_const,
  dsimp, exact measurable_id,
end

/- TODO(Kody): Duplication of proofs.
  Why do I need to manually `change` the goal?
-/
@[simp] lemma prob.dirac_apply {A : set α} {B : set β} (hA : is_measurable A) (hB : is_measurable B) (a : α) (b : β) :
 (retₚ (a,b) : measure (α × β)) (A.prod B) = ((retₚ a : measure α) A) * ((retₚ b : measure β) B) :=
begin
  rw _root_.dirac, rw _root_.dirac,rw _root_.dirac,
  unfold_coes, simp,
  change ((( measure.dirac (a,b) : measure (α × β)) (A.prod B)) = (measure.dirac a : measure α) A * (measure.dirac b : measure β) B),
  rw [dirac_apply, dirac_apply, dirac_apply, mem_prod_eq],
  dsimp,
  by_cases Ha: (a ∈ A); by_cases Hb: (b ∈ B),
  repeat {simp [Ha, Hb]},
  repeat {assumption},
  exact is_measurable_set_prod hA hB,
end

@[simp] lemma prob.dirac_apply' {A : set α} {B : set β} (hA : is_measurable A) (hB : is_measurable B) (a : α) (b : β) :
 ((retₚ(a,b)).to_measure : measure (α × β)) (A.prod B) = (((retₚ a).to_measure : measure α) A) * (((retₚ b).to_measure : measure β) B)
:=
begin
rw _root_.dirac,rw _root_.dirac,rw _root_.dirac,
unfold_coes, simp,
 change ((( measure.dirac (a,b) : measure (α × β)) (A.prod B)) = (measure.dirac a : measure α) A * (measure.dirac b : measure β) B),
  rw [dirac_apply, dirac_apply, dirac_apply, mem_prod_eq],
  dsimp,
  by_cases Ha: (a ∈ A); by_cases Hb: (b ∈ B),
  repeat {simp [Ha, Hb]},
  repeat {assumption},
  exact is_measurable_set_prod hA hB,
end

end giry_monad

section cond_prob

noncomputable def cond_prob {α : Type*} [measurable_space α] (p : probability_measure α) (a b : set α) := p(a ∩ b)/p(b)

notation `ℙ^`:95 p `[[`:95 a ` | `:95 b `]]`:0 := cond_prob p a b

parameters {α : Type*} [measurable_space α] (p : probability_measure α)

lemma cond_prob_rw
(a b : set α) (h₁ : p(b) ≠ 0):
p(a ∩ b) = ℙ^p [[ a | b ]] * p(b) :=
begin
  unfold cond_prob,
  rw [nnreal.div_def,mul_assoc],
  have g₁ : (1 : ennreal) < ⊤,
  {
  rw lattice.lt_top_iff_ne_top,
  apply ennreal.one_ne_top,
  },
  have g₂ : ∀ a, (p(a) ≠ 0) → (p(a))⁻¹ * p(a) = 1,
  {
  intros a k,
  rw mul_comm,
  apply nnreal.mul_inv_cancel, exact k,
  },
  rw g₂ b h₁, simp,
end

/-- Bayes theorem for two sets. -/
theorem cond_prob_swap
{a b : set α} (h₁ : p a ≠ 0) (h₂ : p b ≠ 0) :
ℙ^p [[ b | a ]] * p(a) =  ℙ^p [[ a | b ]] * p(b) :=
begin
  unfold cond_prob,
  rw [nnreal.div_def,mul_assoc],
  have g₁ : (1 : ennreal) < ⊤,
  {
  rw lattice.lt_top_iff_ne_top,
  apply ennreal.one_ne_top,
  },
  have g₂ : ∀ a, (p(a) ≠ 0) → (p(a))⁻¹ * p(a) = 1,
  {
  intros a k,
  rw mul_comm,
  apply nnreal.mul_inv_cancel, exact k,
  },
  rw [g₂ a,nnreal.div_def,mul_assoc,g₂ b, mul_one],
  symmetry, rw [mul_one,set.inter_comm],
  assumption, assumption,
end

end cond_prob

section giry_prod

end giry_prod