import data.fintype.basic
import data.equiv.basic
import data.real.basic
import algebra.group.defs
import tactic

-- https://en.wikipedia.org/wiki/The_Prisoner_of_Benda#The_theorem

-- Perhaps this could be improved by using more from:
 --https://leanprover-community.github.io/mathlib_docs/group_theory/perm/sign.html#equiv.perm.is_cycle

-- Though this (more general) permutation infrastucture is often not decidable
namespace futurama

open equiv -- "perm x" is "equiv x x" AKA "x ≃ x"
open nat
open list

/-
1. Abbreviations (could add more if needed)
-/
@[reducible] def finpairs (n:ℕ) : Type := list (fin n × fin n)
notation `S[` n `]`  := perm (fin n) -- symmetric group on n elements

/-
2. Defining a predicate for a permutation on a finite set to be a k-cycle
Start at 0, and take k steps (which don't bring you to 0 until the last one)
-/
def cyclicrec : Π{n:ℕ}, ℕ → fin n → perm (fin n) → bool
 | n 0 curr p := (p.to_fun curr).val = 0
 | n (succ m) curr  p := ((p.to_fun curr).val > 0 )
                         ∧ cyclicrec m (p.to_fun curr) p

def cyclic : Π{n:ℕ}, perm (fin n) → bool
 | 0        _ := ff -- exclude 0-cycles
 | (succ m) p := cyclicrec m ⟨0, succ_pos'⟩ p

/-
3. Proposed sequence of switches to solve futurama problem for a single cycle

For an arbitrary simple cycle of length k, the sequence of switches is (specializing 'i' from the wikipedia proof to '1'):
    (x, 1) (y, 2) ... (y, k) (x k) (y 1)
or, for any simple cycle with an element 'a':
    (x, a) (y p¹a) ... (y pᵏ⁻¹ a)  (x pᵏ⁻¹ a) (y a)

The two additional elements x and y are represented as n and n+1 respectively
(elements within the set are 0,1,...,n-1).
-/

def construction_rec : Π{n:ℕ} , ℕ → fin n → S[n] → finpairs (n+2)
 | n (succ counter) curr p := (n+1,p.to_fun curr)
                              :: construction_rec counter (p.to_fun curr) p
 | n 0              _    _ := (n,1)::(n+1,0)::(n,n+1)::nil

def construction : Π{n : ℕ}, S[n] → finpairs (n+2)
 | 0        _ := nil
 | (succ m) p := (succ m, 0) :: construction_rec m ⟨0, succ_pos'⟩ p

def construction_rec' : Π{n:ℕ} , ℕ → fin n → S[n] → finpairs (n+2)
 | n (succ counter) curr p := (n+1,p.to_fun curr)
                              :: construction_rec counter (p.to_fun curr) p
 | n 0              _    _ := (n,1)::(n+1,0)::(n,n+1)::nil

def construction' : Π{n : ℕ}, S[n] → finpairs (n+2)
 | 0        _ := nil
 | (succ m) p := (succ m, 0) :: construction_rec m ⟨0, succ_pos'⟩ p

/-
4. For a perm σ, equiv.swap σ x y means:
    If a→x in σ, then a→y in the result (and vice versa)
    If x→b in σ, then y→b in the result (and vice versa)

Defining the application of a list of swaps in sequence
-/

--
def swaps {α : Type*} [decidable_eq α] : list (α×α) → perm α
    | ((a1, a2) :: b) := (equiv.swap a1 a2) * swaps b
    | nil             := 1

/-
5. Defining a predicate on a list of swaps to judge whether they
   satisfy the constraints of The Prisoner of Benda

   If we have the swap (x,y) at any position in the list, we fail
   iff (x,y) or (y,x) appears at any other point in the list.

   This is done by iterating through the list, accumulating a set of
   (ordered) pairs. For each swap we check if it (or its reverse)
   is in the seen set.
-/

def valid_swaps_rec  {α : Type*} [decidable_eq α]:
    list (α×α) → finset (α×α) → bool
| list.nil      _    := tt
| ((ha,hb)::tl) seen := ¬((ha,hb) ∈ seen ∨ (hb,ha) ∈ seen)
                        ∧ (valid_swaps_rec tl (insert (ha,hb) seen))

def valid_swaps {α : Type*} [decidable_eq α] (s : list (α×α)) : bool :=
    valid_swaps_rec s ∅

/-
6. Two extra elems in the set being permuted needed for the construction to work.
This function takes a permutation on n elements and extends it to a
permutation on n+2 elements.
-/

def add_two_to_perm_forward {n: ℕ} (p : S[n]) : fin (n+2) → fin(n+2) :=
    λ m : fin (n+2),
        if h: m.val < n
        then have x : fin n, from p.to_fun (fin.mk m.val h),
            (fin.mk x.val (lt.trans x.is_lt (by simp only [succ_pos', lt_add_iff_pos_right])))
        else m
def add_two_to_perm_reverse {n: ℕ} (p : perm (fin n)) : fin (n+2) → fin(n+2) :=
    λ m : fin (n+2),
        if h: m.val < n
        then have x: fin n, from p.inv_fun (fin.mk m.val h),
            (fin.mk x.val (lt.trans x.is_lt (by simp only [succ_pos', lt_add_iff_pos_right])))
        else m

-- The result is still a permutation after adding
lemma a2finv {n : ℕ} (p : perm (fin n)) :
    function.left_inverse (add_two_to_perm_reverse p) (add_two_to_perm_forward p) :=
    begin
        unfold function.left_inverse,
        intros m,
        rw add_two_to_perm_forward,
        dsimp,
        cases (decidable.em (m.val < n)) with hl hg,
            {
                rw dif_pos hl,
                rw add_two_to_perm_reverse,
                dsimp,
                have t1: coe_fn (equiv.symm p) = p.inv_fun , by refl,
                have t2: coe_fn p = p.to_fun , by refl,
                rw t1, rw t2,
                rw dif_pos (p.to_fun ⟨m.val, hl⟩).is_lt,
                simp only [symm_apply_apply, fin.eta, to_fun_as_coe, inv_fun_as_coe]
            },
            {
                rw add_two_to_perm_reverse, dsimp,
                rw dif_neg hg,
                rw dif_neg hg,
            }
end
lemma a2rinv {n : ℕ} (p : perm (fin n)):
    function.right_inverse (add_two_to_perm_reverse p) (add_two_to_perm_forward p)
    :=  begin
        unfold function.right_inverse,
        intros m,
        rw add_two_to_perm_forward,
        dsimp,
        cases (decidable.em (m.val < n)) with hl hg,
            {
                rw add_two_to_perm_reverse,
                dsimp,
                rw dif_pos hl,
                have t1: coe_fn (equiv.symm p) = p.inv_fun , by refl,
                have t2: coe_fn p = p.to_fun , by refl,
                rw t1, rw t2,
                rw dif_pos (p.inv_fun ⟨m.val, hl⟩).is_lt,
                simp only [apply_symm_apply, fin.eta, to_fun_as_coe, inv_fun_as_coe],
            },
            {
                rw add_two_to_perm_reverse, dsimp,
                rw dif_neg hg,
                rw dif_neg hg,
            }
end
-- Combine the four above ingredients
def add_two {n :ℕ} (p : perm (fin n)) : perm (fin (n+2)) :=
    ⟨add_two_to_perm_forward p, add_two_to_perm_reverse p,
     a2finv p, a2rinv p⟩

/-
7. The main theorem:

Test that
    1.) the construction above returns everyone to their original bodies
        (yields the identity permutation)
and 2.) it has no repeat swaps
-/

def futurama_correct  {n: ℕ} {p: S[n]} (h: cyclic p) :
    (add_two p) * swaps (construction p) = 1:= begin
    induction n with k ih,
    { --trivial n=0 case
        unfold construction,
        unfold swaps,
        apply one_mul
    },
    {--n>0
        ext,
        rw perm.one_apply,
        rw perm.mul_apply,
        unfold construction,
        rw cast_succ,
        induction x with k2 ih2,
        simp only [],

        --cases (decidable.em (k2 < k)) with hl hg,

        --squeeze_simp,
        --unfold swaps,
        --unfold add_two,
        --unfold add_two_to_perm_forward,
        --unfold add_two_to_perm_reverse,
        sorry,
    },
end

def futurama_valid  {n: ℕ} {p: S[n]} (h: cyclic p) :
    valid_swaps (construction p) := begin
    induction n with k ih,
    { -- trivial n=0 case
         unfold construction,
         unfold valid_swaps,
         unfold valid_swaps_rec,
         trivial

    },
    {
        unfold construction,
        unfold valid_swaps,
        induction p,

        sorry}
end

theorem futurama_thm {n: ℕ} {p: S[n]} (h: cyclic p) :
    (add_two p) * swaps (construction p) = 1
    ∧ valid_swaps (construction p)
    := ⟨futurama_correct h, futurama_valid h⟩

/-
8. Constructing+printing permutations for testing
-/
-- Make a simple cycle from a list, e.g. [2, 1, 3, 0]
def ss_rec  : Π {n:ℕ}, list (fin n) → perm (fin n)
| _ nil         := 1
| _ (h::nil)    := 1 -- Actually, this case is never encountered
| _ (h::h2::t)  := (swap h h2) * (ss_rec (h2::t))

def mk_cyclic {n:ℕ} (l : list (fin n)) : S[n] := ss_rec l

-- Show where each permuted element goes to
def pp_rec : Π{n:ℕ}, ℕ → S[n] → string
 | _ 0 _ := "|"
 | n (succ m) p := if h: m < n
                   then (pp_rec m p) ++ to_string m ++"→"++
                        (to_string (p.to_fun ⟨m, h⟩)) ++ "|"
                   else "ERROR"

def print_perm {n:ℕ} (p: S[n]) : string := pp_rec n p

-- Convert the (fin n) pairs to something that Lean can represent
def print_finpairs :  Π {n:ℕ}, list (fin n × fin n) → list (ℕ×ℕ)
  | _ nil    := nil
  | n (h::t) := (h.1.val,h.2.val)::(print_finpairs t)

end futurama


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro hp,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro hp,
  by_contra destructionandtears,
  apply hp,
  exact destructionandtears,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  intro hp,
  by_contra destructionandtears,
  apply hp,
  exact destructionandtears,
  intro hp,
  contradiction,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro blood,
  cases blood with sweat tears,
  right,
  exact sweat,
  left,
  exact tears,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro hp,
  split,
  cases hp with h1 h2,
  exact h2,
  cases hp with h1 h2,
  exact h1,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro verge,
  intro hp2,
  cases verge with of tears,
  contradiction,
  exact tears,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro the,
  intro skip,
  cases the with good part,
  contradiction,
  exact part,
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro thehouse,
  intro ajr,
  intro down,
  have burn : Q := thehouse down,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro bummer,
  intro pop,
  by_contra land,
  have ajr : ¬P := bummer land,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  intro hp,
  intro hp2,
  intro hp3,
  have hp4 : Q := hp hp3,
  contradiction,
  intro bummer,
  intro pop,
  by_contra land,
  have ajr : ¬P := bummer land,
  contradiction,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro hp,
  have h : P∨¬P,
  right,
  intro hp2,
  have i : P∨¬P,
  left,
  exact hp2,
  contradiction,
  contradiction,
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro hp,
  intro hp2,
  have hp3 : ¬P∨Q,
  left,
  exact hp2,
  have hp4 : P→Q,
  intro hp5,
  contradiction,
  have hp6 : P := hp hp4,
  contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro way,
  intro the,
  cases way with less sad,
  cases the with good part,
  contradiction,
  cases the with entertainment ishere,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro Christmas,
  intro Bang,
  cases Christmas with In June,
  cases Bang with I won't,
  contradiction,
  contradiction,
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro Netflix,
  split,
  intro Trip,
  have Karma : P∨Q,
  left,
  exact Trip,
  contradiction,
  intro Trip,
  have Joe : P∨Q,
  right,
  exact Trip,
  contradiction,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro Indie,
  intro next,
  cases Indie with my play,
  cases next with up forever,
  contradiction,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro hp,
  by_cases hp2 : P,
  left,
  intro hp3,
  have hp4 : P∧Q,
  split,
  exact hp2,
  exact hp3,
  contradiction,
  right,
  exact hp2,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro Ok,
  intro Orchestra,
  cases Orchestra with Sober Up,
  cases Ok with Birthday Party,
  contradiction,
  contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  intro hp,
  by_cases hp2 : P,
  left,
  intro hp3,
  have hp4 : P∧Q,
  split,
  exact hp2,
  exact hp3,
  contradiction,
  right,
  exact hp2,
  intro Ok,
  intro Orchestra,
  cases Orchestra with Sober Up,
  cases Ok with Birthday Party,
  contradiction,
  contradiction,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  intro Netflix,
  split,
  intro Trip,
  have Karma : P∨Q,
  left,
  exact Trip,
  contradiction,
  intro Trip,
  have Joe : P∨Q,
  right,
  exact Trip,
  contradiction,
  intro Indie,
  intro next,
  cases Indie with my play,
  cases next with up forever,
  contradiction,
  contradiction,
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro Adventure,
  cases Adventure with isOut There,
  cases There with Ordinaryish People,
  left,
  split,
  exact isOut,
  exact Ordinaryish,
  right,
  split,
  exact isOut,
  exact People,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro Don't,
  cases Don't with Throw Out,
  cases Throw with My Legos,
  split,
  exact My,
  left,
  exact Legos,
  cases Out with Normal Drama,
  split,
  exact Normal,
  right,
  exact Drama,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro Weak,
  split,
  cases Weak with Thirty Three,
  left,
  exact Thirty,
  right,
  cases Three with O'clock Things,
  exact O'clock,
  cases Weak with Trick The,
  left,
  exact Trick,
  right,
  cases The with Good Part,
  exact Part,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro Wow,
  cases Wow with I'm NotCrazy,
  cases I'm with a Believer,
  left,
  exact a,
  cases NotCrazy with Pitchfork Kids,
  left,
  exact Pitchfork,
  right,
  split,
  exact Believer,
  exact Kids,
end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro hp,
  intro hp2,
  intro hp3,
  have hp4: P∧Q,
  split,
  exact hp2,
  exact hp3,
  have hp5: R := hp hp4,
  exact hp5,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro hp,
  intro hp2,
  cases hp2 with hp3 hp4,
  have hp5 : Q→R := hp hp3,
  have hp6 : R := hp5 hp4,
  exact hp6,
end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro h,
  exact h,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro hp,
  left,
  exact hp,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro hp,
  right,
  exact hp,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro world's,
  cases world's with smallest violin,
  exact smallest,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro h,
  cases h with hp hq,
  exact hq,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro ajr,
  cases ajr with bummer land,
  exact bummer,
  intro pop,
  split,
  exact pop,
  exact pop,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro come,
  cases come with hang out,
  exact hang,
  exact out,
  intro ajr,
  left,
  exact ajr,
end

end propositional

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

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro hp,
  intro a,
  intro boom,
  apply hp,
  existsi a,
  exact boom,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro hp,
  intro hp2,
  cases hp2 with a ha,
  apply hp,
  exact ha,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro hp,
  by_contra cry,
  have more: ∀x, P x,
  intro a,
  by_contra boom,
  have hp2 : ∃x, ¬P x,
  existsi a,
  exact boom,
  contradiction,
  contradiction,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro hp,
  intro hp2,
  cases hp with a ha,
  have hp3 : P a := hp2 a,
  contradiction,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  intro hp,
  by_contra cry,
  have more: ∀x, P x,
  intro a,
  by_contra boom,
  have hp2 : ∃x, ¬P x,
  existsi a,
  exact boom,
  contradiction,
  contradiction,
  intro hp,
  intro hp2,
  cases hp with a ha,
  have hp3 : P a := hp2 a,
  contradiction,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  intro hp,
  intro a,
  intro hp2,
  apply hp,
  existsi a,
  exact hp2,
  intro hp,
  intro hp2,
  cases hp2 with a ha,
  apply hp,
  exact ha,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro hp,
  intro hp2,
  cases hp with a ha,
  apply hp2,
  exact ha,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro hp,
  intro hp2,
  cases hp2 with a ha,
  have hp3 : P a := hp a,
  contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro hp,
  intro a,
  by_contra boom,
  have hp1 : ∃x, ¬P x,
  existsi a,
  exact boom,
  contradiction,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro hp,
  by_contra boom,
  have hp1 : ∀ (x : U), ¬P x,
  intro a,
  intro ha,
  have hp2 : ∃ (x : U), P x,
  existsi a,
  exact ha,
  contradiction,
  contradiction,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  intro hp,
  intro hp2,
  cases hp2 with a ha,
  have hp3 : P a := hp a,
  contradiction,
  intro hp,
  intro a,
  by_contra boom,
  have hp1 : ∃x, ¬P x,
  existsi a,
  exact boom,
  contradiction,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  intro hp,
  intro hp2,
  cases hp with a ha,
  apply hp2,
  exact ha,
  intro hp,
  by_contra boom,
  have hp1 : ∀ (x : U), ¬P x,
  intro a,
  intro ha,
  have hp2 : ∃ (x : U), P x,
  existsi a,
  exact ha,
  contradiction,
  contradiction,
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro hp,
  cases hp with a ha,
  cases ha with hp1 hp2,
  split,
  existsi a,
  exact hp1,
  existsi a,
  exact hp2,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro hp,
  cases hp with a ha,
  cases ha with hp1 hp2,
  left,
  existsi a,
  exact hp1,
  right,
  existsi a,
  exact hp2,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro hp,
  cases hp with hp1 hp2,
  cases hp1 with a ha,
  existsi a,
  left,
  exact ha,
  cases hp2 with b hb,
  existsi b,
  right,
  exact hb,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro hp,
  split,
  intro a,
  have hp1 : P a ∧ Q a := hp a,
  cases hp1 with ha hb,
  exact ha,
  intro b,
  have hp2 : P b ∧ Q b := hp b,
  cases hp2 with ha hb,
  exact hb,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro hp,
  cases hp with hp1 hp2,
  intro a,
  split,
  have ha : P a := hp1 a,
  exact ha,
  have hb : Q a := hp2 a,
  exact hb,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro hp,
  cases hp with hp1 hp2,
  intro a,
  left,
  have ha: P a := hp1 a,
  exact ha,
  intro b,
  right,
  have hb : Q b := hp2 b,
  exact hb,
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

/--
Given the two functions $f(x)=x^3+2x+1$ and $g(x)=x-1$, find $f(g(1))$.
Answer: $1$.
--/
theorem mathd_algebra_616
  (f g : ℝ → ℝ)
  (h₀ : ∀ x, f x = x^3 + 2 * x + 1)
  (h₁ : ∀ x, g x = x - 1) :
  f (g 1) = 1 :=
begin
  simp [h₁, h₀],
end


import algebra.big_operators.order
import tactic.ring

open_locale big_operators

theorem finset.mem_le_pos_sum {α : Type*} {β : Type*} [linear_ordered_add_comm_group β] (f : α → β) (s : finset α) (h1 : ∀ x, x ∈ s → 0 < f x)
:  ∀ y (H : y ∈ s), f y ≤ ∑ x in s, f x :=
begin
  apply finset.single_le_sum,
  intros x h,
  apply le_of_lt (h1 x h),

end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_327
  (a : ℝ)
  (h₀ : 1 / 5 * abs (9 + 2 * a) < 1) :
  -7 < a ∧ a < -2 :=
begin
  have h₁ := (mul_lt_mul_left (show 0 < (5:ℝ), by linarith)).mpr h₀,
  have h₂ : abs (9 + 2 * a) < 5, linarith,
  have h₃ := abs_lt.mp h₂,
  cases h₃ with h₃ h₄,
  split; nlinarith,
end


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Alistair Tucker
-/
import topology.algebra.ordered.basic

/-!
# Intermediate Value Theorem

In this file we prove the Intermediate Value Theorem: if `f : α → β` is a function defined on a
connected set `s` that takes both values `≤ a` and values `≥ a` on `s`, then it is equal to `a` at
some point of `s`. We also prove that intervals in a dense conditionally complete order are
preconnected and any preconnected set is an interval. Then we specialize IVT to functions continuous
on intervals.

## Main results

* `is_preconnected_I??` : all intervals `I??` are preconnected,
* `is_preconnected.intermediate_value`, `intermediate_value_univ` : Intermediate Value Theorem for
  connected sets and connected spaces, respectively;
* `intermediate_value_Icc`, `intermediate_value_Icc'`: Intermediate Value Theorem for functions
  on closed intervals.

### Miscellaneous facts

* `is_closed.Icc_subset_of_forall_mem_nhds_within` : “Continuous induction” principle;
  if `s ∩ [a, b]` is closed, `a ∈ s`, and for each `x ∈ [a, b) ∩ s` some of its right neighborhoods
  is included `s`, then `[a, b] ⊆ s`.
* `is_closed.Icc_subset_of_forall_exists_gt`, `is_closed.mem_of_ge_of_forall_exists_gt` : two
  other versions of the “continuous induction” principle.

## Tags

intermediate value theorem, connected space, connected set
-/

open filter order_dual topological_space function set
open_locale topological_space filter

universes u v w

/-!
### Intermediate value theorem on a (pre)connected space

In this section we prove the following theorem (see `is_preconnected.intermediate_value₂`): if `f`
and `g` are two functions continuous on a preconnected set `s`, `f a ≤ g a` at some `a ∈ s` and
`g b ≤ f b` at some `b ∈ s`, then `f c = g c` at some `c ∈ s`. We prove several versions of this
statement, including the classical IVT that corresponds to a constant function `g`.
-/

section

variables {X : Type u} {α : Type v} [topological_space X]
  [linear_order α] [topological_space α] [order_closed_topology α]

/-- Intermediate value theorem for two functions: if `f` and `g` are two continuous functions
on a preconnected space and `f a ≤ g a` and `g b ≤ f b`, then for some `x` we have `f x = g x`. -/
lemma intermediate_value_univ₂ [preconnected_space X] {a b : X} {f g : X → α} (hf : continuous f)
  (hg : continuous g) (ha : f a ≤ g a) (hb : g b ≤ f b) :
  ∃ x, f x = g x :=
begin
  obtain ⟨x, h, hfg, hgf⟩ : (univ ∩ {x | f x ≤ g x ∧ g x ≤ f x}).nonempty,
    from is_preconnected_closed_iff.1 preconnected_space.is_preconnected_univ _ _
      (is_closed_le hf hg) (is_closed_le hg hf) (λ x hx, le_total _ _) ⟨a, trivial, ha⟩
      ⟨b, trivial, hb⟩,
  exact ⟨x, le_antisymm hfg hgf⟩
end

lemma intermediate_value_univ₂_eventually₁ [preconnected_space X] {a : X} {l : filter X} [ne_bot l]
  {f g : X → α} (hf : continuous f) (hg : continuous g) (ha : f a ≤ g a) (he : g ≤ᶠ[l] f) :
  ∃ x, f x = g x :=
let ⟨c, hc⟩ := he.frequently.exists in intermediate_value_univ₂ hf hg ha hc

lemma intermediate_value_univ₂_eventually₂ [preconnected_space X] {l₁ l₂ : filter X}
  [ne_bot l₁] [ne_bot l₂] {f g : X → α} (hf : continuous f) (hg : continuous g)
  (he₁ : f ≤ᶠ[l₁] g ) (he₂ : g ≤ᶠ[l₂] f) :
  ∃ x, f x = g x :=
let ⟨c₁, hc₁⟩ := he₁.frequently.exists, ⟨c₂, hc₂⟩ := he₂.frequently.exists in
intermediate_value_univ₂ hf hg hc₁ hc₂

/-- Intermediate value theorem for two functions: if `f` and `g` are two functions continuous
on a preconnected set `s` and for some `a b ∈ s` we have `f a ≤ g a` and `g b ≤ f b`,
then for some `x ∈ s` we have `f x = g x`. -/
lemma is_preconnected.intermediate_value₂ {s : set X} (hs : is_preconnected s)
  {a b : X} (ha : a ∈ s) (hb : b ∈ s) {f g : X → α}
  (hf : continuous_on f s) (hg : continuous_on g s) (ha' : f a ≤ g a) (hb' : g b ≤ f b) :
  ∃ x ∈ s, f x = g x :=
let ⟨x, hx⟩ := @intermediate_value_univ₂ s α _ _ _ _ (subtype.preconnected_space hs) ⟨a, ha⟩ ⟨b, hb⟩
  _ _ (continuous_on_iff_continuous_restrict.1 hf) (continuous_on_iff_continuous_restrict.1 hg)
  ha' hb'
in ⟨x, x.2, hx⟩

lemma is_preconnected.intermediate_value₂_eventually₁ {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f g : X → α}
  (hf : continuous_on f s) (hg : continuous_on g s) (ha' : f a ≤ g a) (he : g ≤ᶠ[l] f) :
  ∃ x ∈ s, f x = g x :=
begin
  rw continuous_on_iff_continuous_restrict at hf hg,
  obtain ⟨b, h⟩ := @intermediate_value_univ₂_eventually₁ _ _ _ _ _ _ (subtype.preconnected_space hs)
    ⟨a, ha⟩ _ (comap_coe_ne_bot_of_le_principal hl) _ _ hf hg ha' (eventually_comap' he),
  exact ⟨b, b.prop, h⟩,
end

lemma is_preconnected.intermediate_value₂_eventually₂ {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f g : X → α}
  (hf : continuous_on f s) (hg : continuous_on g s) (he₁ : f ≤ᶠ[l₁] g) (he₂ : g ≤ᶠ[l₂] f) :
  ∃ x ∈ s, f x = g x :=
begin
  rw continuous_on_iff_continuous_restrict at hf hg,
  obtain ⟨b, h⟩ := @intermediate_value_univ₂_eventually₂ _ _ _ _ _ _ (subtype.preconnected_space hs)
    _ _ (comap_coe_ne_bot_of_le_principal hl₁) (comap_coe_ne_bot_of_le_principal hl₂)
    _ _ hf hg (eventually_comap' he₁) (eventually_comap' he₂),
  exact ⟨b, b.prop, h⟩,
end

/-- **Intermediate Value Theorem** for continuous functions on connected sets. -/
lemma is_preconnected.intermediate_value {s : set X} (hs : is_preconnected s)
  {a b : X} (ha : a ∈ s) (hb : b ∈ s) {f : X → α} (hf : continuous_on f s) :
  Icc (f a) (f b) ⊆ f '' s :=
λ x hx, mem_image_iff_bex.2 $ hs.intermediate_value₂ ha hb hf continuous_on_const hx.1 hx.2

lemma is_preconnected.intermediate_value_Ico {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v : α} (ht : tendsto f l (𝓝 v)) :
  Ico (f a) v ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₁ ha hl
  hf continuous_on_const h.1 (eventually_ge_of_tendsto_gt h.2 ht)

lemma is_preconnected.intermediate_value_Ioc {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v : α} (ht : tendsto f l (𝓝 v)) :
  Ioc v (f a) ⊆ f '' s :=
λ y h, bex_def.1 $ bex.imp_right (λ x _, eq.symm) $ hs.intermediate_value₂_eventually₁ ha hl
  continuous_on_const hf h.2 (eventually_le_of_tendsto_lt h.1 ht)

lemma is_preconnected.intermediate_value_Ioo {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v₁ v₂ : α} (ht₁ : tendsto f l₁ (𝓝 v₁)) (ht₂ : tendsto f l₂ (𝓝 v₂)) :
  Ioo v₁ v₂ ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₂ hl₁ hl₂
  hf continuous_on_const (eventually_le_of_tendsto_lt h.1 ht₁) (eventually_ge_of_tendsto_gt h.2 ht₂)

lemma is_preconnected.intermediate_value_Ici {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) (ht : tendsto f l at_top) :
  Ici (f a) ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₁ ha hl
  hf continuous_on_const h (tendsto_at_top.1 ht y)

lemma is_preconnected.intermediate_value_Iic {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) (ht : tendsto f l at_bot) :
  Iic (f a) ⊆ f '' s :=
λ y h, bex_def.1 $ bex.imp_right (λ x _, eq.symm) $ hs.intermediate_value₂_eventually₁ ha hl
  continuous_on_const hf h (tendsto_at_bot.1 ht y)

lemma is_preconnected.intermediate_value_Ioi {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v : α} (ht₁ : tendsto f l₁ (𝓝 v)) (ht₂ : tendsto f l₂ at_top) :
  Ioi v ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₂ hl₁ hl₂
  hf continuous_on_const (eventually_le_of_tendsto_lt h ht₁) (tendsto_at_top.1 ht₂ y)

lemma is_preconnected.intermediate_value_Iio {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v : α} (ht₁ : tendsto f l₁ at_bot) (ht₂ : tendsto f l₂ (𝓝 v)) :
  Iio v ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₂ hl₁ hl₂
  hf continuous_on_const (tendsto_at_bot.1 ht₁ y) (eventually_ge_of_tendsto_gt h ht₂)

lemma is_preconnected.intermediate_value_Iii {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) (ht₁ : tendsto f l₁ at_bot) (ht₂ : tendsto f l₂ at_top) :
  univ ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₂ hl₁ hl₂
  hf continuous_on_const (tendsto_at_bot.1 ht₁ y) (tendsto_at_top.1 ht₂ y)

/-- **Intermediate Value Theorem** for continuous functions on connected spaces. -/
lemma intermediate_value_univ [preconnected_space X] (a b : X) {f : X → α} (hf : continuous f) :
  Icc (f a) (f b) ⊆ range f :=
λ x hx, intermediate_value_univ₂ hf continuous_const hx.1 hx.2

/-- **Intermediate Value Theorem** for continuous functions on connected spaces. -/
lemma mem_range_of_exists_le_of_exists_ge [preconnected_space X] {c : α} {f : X → α}
  (hf : continuous f) (h₁ : ∃ a, f a ≤ c) (h₂ : ∃ b, c ≤ f b) :
  c ∈ range f :=
let ⟨a, ha⟩ := h₁, ⟨b, hb⟩ := h₂ in intermediate_value_univ a b hf ⟨ha, hb⟩

/-!
### (Pre)connected sets in a linear order

In this section we prove the following results:

* `is_preconnected.ord_connected`: any preconnected set `s` in a linear order is `ord_connected`,
  i.e. `a ∈ s` and `b ∈ s` imply `Icc a b ⊆ s`;

* `is_preconnected.mem_intervals`: any preconnected set `s` in a conditionally complete linear order
  is one of the intervals `set.Icc`, `set.`Ico`, `set.Ioc`, `set.Ioo`, ``set.Ici`, `set.Iic`,
  `set.Ioi`, `set.Iio`; note that this is false for non-complete orders: e.g., in `ℝ \ {0}`, the set
  of positive numbers cannot be represented as `set.Ioi _`.

-/

/-- If a preconnected set contains endpoints of an interval, then it includes the whole interval. -/
lemma is_preconnected.Icc_subset {s : set α} (hs : is_preconnected s)
  {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  Icc a b ⊆ s :=
by simpa only [image_id] using hs.intermediate_value ha hb continuous_on_id

lemma is_preconnected.ord_connected {s : set α} (h : is_preconnected s) :
  ord_connected s :=
⟨λ x hx y hy, h.Icc_subset hx hy⟩

/-- If a preconnected set contains endpoints of an interval, then it includes the whole interval. -/
lemma is_connected.Icc_subset {s : set α} (hs : is_connected s)
  {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  Icc a b ⊆ s :=
hs.2.Icc_subset ha hb

/-- If preconnected set in a linear order space is unbounded below and above, then it is the whole
space. -/
lemma is_preconnected.eq_univ_of_unbounded {s : set α} (hs : is_preconnected s) (hb : ¬bdd_below s)
  (ha : ¬bdd_above s) :
  s = univ :=
begin
  refine eq_univ_of_forall (λ x, _),
  obtain ⟨y, ys, hy⟩ : ∃ y ∈ s, y < x := not_bdd_below_iff.1 hb x,
  obtain ⟨z, zs, hz⟩ : ∃ z ∈ s, x < z := not_bdd_above_iff.1 ha x,
  exact hs.Icc_subset ys zs ⟨le_of_lt hy, le_of_lt hz⟩
end

end

variables {α : Type u} {β : Type v} {γ : Type w}
  [conditionally_complete_linear_order α] [topological_space α] [order_topology α]
  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
  [nonempty γ]

/-- A bounded connected subset of a conditionally complete linear order includes the open interval
`(Inf s, Sup s)`. -/
lemma is_connected.Ioo_cInf_cSup_subset {s : set α} (hs : is_connected s) (hb : bdd_below s)
  (ha : bdd_above s) :
  Ioo (Inf s) (Sup s) ⊆ s :=
λ x hx, let ⟨y, ys, hy⟩ := (is_glb_lt_iff (is_glb_cInf hs.nonempty hb)).1 hx.1 in
let ⟨z, zs, hz⟩ := (lt_is_lub_iff (is_lub_cSup hs.nonempty ha)).1 hx.2 in
hs.Icc_subset ys zs ⟨le_of_lt hy, le_of_lt hz⟩

lemma eq_Icc_cInf_cSup_of_connected_bdd_closed {s : set α} (hc : is_connected s) (hb : bdd_below s)
  (ha : bdd_above s) (hcl : is_closed s) :
  s = Icc (Inf s) (Sup s) :=
subset.antisymm (subset_Icc_cInf_cSup hb ha) $
  hc.Icc_subset (hcl.cInf_mem hc.nonempty hb) (hcl.cSup_mem hc.nonempty ha)

lemma is_preconnected.Ioi_cInf_subset {s : set α} (hs : is_preconnected s) (hb : bdd_below s)
  (ha : ¬bdd_above s) :
  Ioi (Inf s) ⊆ s :=
begin
  have sne : s.nonempty := @nonempty_of_not_bdd_above α _ s ⟨Inf ∅⟩ ha,
  intros x hx,
  obtain ⟨y, ys, hy⟩ : ∃ y ∈ s, y < x := (is_glb_lt_iff (is_glb_cInf sne hb)).1 hx,
  obtain ⟨z, zs, hz⟩ : ∃ z ∈ s, x < z := not_bdd_above_iff.1 ha x,
  exact hs.Icc_subset ys zs ⟨le_of_lt hy, le_of_lt hz⟩
end

lemma is_preconnected.Iio_cSup_subset {s : set α} (hs : is_preconnected s) (hb : ¬bdd_below s)
  (ha : bdd_above s) :
  Iio (Sup s) ⊆ s :=
@is_preconnected.Ioi_cInf_subset (order_dual α) _ _ _ s hs ha hb

/-- A preconnected set in a conditionally complete linear order is either one of the intervals
`[Inf s, Sup s]`, `[Inf s, Sup s)`, `(Inf s, Sup s]`, `(Inf s, Sup s)`, `[Inf s, +∞)`,
`(Inf s, +∞)`, `(-∞, Sup s]`, `(-∞, Sup s)`, `(-∞, +∞)`, or `∅`. The converse statement requires
`α` to be densely ordererd. -/
lemma is_preconnected.mem_intervals {s : set α} (hs : is_preconnected s) :
  s ∈ ({Icc (Inf s) (Sup s), Ico (Inf s) (Sup s), Ioc (Inf s) (Sup s), Ioo (Inf s) (Sup s),
    Ici (Inf s), Ioi (Inf s), Iic (Sup s), Iio (Sup s), univ, ∅} : set (set α)) :=
begin
  rcases s.eq_empty_or_nonempty with rfl|hne,
  { apply_rules [or.inr, mem_singleton] },
  have hs' : is_connected s := ⟨hne, hs⟩,
  by_cases hb : bdd_below s; by_cases ha : bdd_above s,
  { rcases mem_Icc_Ico_Ioc_Ioo_of_subset_of_subset (hs'.Ioo_cInf_cSup_subset hb ha)
      (subset_Icc_cInf_cSup hb ha) with hs|hs|hs|hs,
    { exact (or.inl hs) },
    { exact (or.inr $ or.inl hs) },
    { exact (or.inr $ or.inr $ or.inl hs) },
    { exact (or.inr $ or.inr $ or.inr $ or.inl hs) } },
  { refine (or.inr $ or.inr $ or.inr $ or.inr _),
    cases mem_Ici_Ioi_of_subset_of_subset (hs.Ioi_cInf_subset hb ha) (λ x hx, cInf_le hb hx)
      with hs hs,
    { exact or.inl hs },
    { exact or.inr (or.inl hs) } },
  { iterate 6 { apply or.inr },
    cases mem_Iic_Iio_of_subset_of_subset (hs.Iio_cSup_subset hb ha) (λ x hx, le_cSup ha hx)
      with hs hs,
    { exact or.inl hs },
    { exact or.inr (or.inl hs) } },
  { iterate 8 { apply or.inr },
    exact or.inl (hs.eq_univ_of_unbounded hb ha) }
end

/-- A preconnected set is either one of the intervals `Icc`, `Ico`, `Ioc`, `Ioo`, `Ici`, `Ioi`,
`Iic`, `Iio`, or `univ`, or `∅`. The converse statement requires `α` to be densely ordered. Though
one can represent `∅` as `(Inf s, Inf s)`, we include it into the list of possible cases to improve
readability. -/
lemma set_of_is_preconnected_subset_of_ordered :
  {s : set α | is_preconnected s} ⊆
    -- bounded intervals
    (range (uncurry Icc) ∪ range (uncurry Ico) ∪ range (uncurry Ioc) ∪ range (uncurry Ioo)) ∪
    -- unbounded intervals and `univ`
    (range Ici ∪ range Ioi ∪ range Iic ∪ range Iio ∪ {univ, ∅}) :=
begin
  intros s hs,
  rcases hs.mem_intervals with hs|hs|hs|hs|hs|hs|hs|hs|hs|hs,
  { exact (or.inl $ or.inl $ or.inl $ or.inl ⟨(Inf s, Sup s), hs.symm⟩) },
  { exact (or.inl $ or.inl $ or.inl $ or.inr ⟨(Inf s, Sup s), hs.symm⟩) },
  { exact (or.inl $ or.inl $ or.inr ⟨(Inf s, Sup s), hs.symm⟩) },
  { exact (or.inl $ or.inr ⟨(Inf s, Sup s), hs.symm⟩) },
  { exact (or.inr $ or.inl $ or.inl $ or.inl $ or.inl ⟨Inf s, hs.symm⟩) },
  { exact (or.inr $ or.inl $ or.inl $ or.inl $ or.inr ⟨Inf s, hs.symm⟩) },
  { exact (or.inr $ or.inl $ or.inl  $ or.inr ⟨Sup s, hs.symm⟩) },
  { exact (or.inr $ or.inl $  or.inr ⟨Sup s, hs.symm⟩) },
  { exact (or.inr $ or.inr $ or.inl hs) },
  { exact (or.inr $ or.inr $ or.inr hs) }
end

/-!
### Intervals are connected

In this section we prove that a closed interval (hence, any `ord_connected` set) in a dense
conditionally complete linear order is preconnected.
-/

/-- A "continuous induction principle" for a closed interval: if a set `s` meets `[a, b]`
on a closed subset, contains `a`, and the set `s ∩ [a, b)` has no maximal point, then `b ∈ s`. -/
lemma is_closed.mem_of_ge_of_forall_exists_gt {a b : α} {s : set α} (hs : is_closed (s ∩ Icc a b))
  (ha : a ∈ s) (hab : a ≤ b) (hgt : ∀ x ∈ s ∩ Ico a b, (s ∩ Ioc x b).nonempty) :
  b ∈ s :=
begin
  let S := s ∩ Icc a b,
  replace ha : a ∈ S, from ⟨ha, left_mem_Icc.2 hab⟩,
  have Sbd : bdd_above S, from ⟨b, λ z hz, hz.2.2⟩,
  let c := Sup (s ∩ Icc a b),
  have c_mem : c ∈ S, from hs.cSup_mem ⟨_, ha⟩ Sbd,
  have c_le : c ≤ b, from cSup_le ⟨_, ha⟩ (λ x hx, hx.2.2),
  cases eq_or_lt_of_le c_le with hc hc, from hc ▸ c_mem.1,
  exfalso,
  rcases hgt c ⟨c_mem.1, c_mem.2.1, hc⟩ with ⟨x, xs, cx, xb⟩,
  exact not_lt_of_le (le_cSup Sbd ⟨xs, le_trans (le_cSup Sbd ha) (le_of_lt cx), xb⟩) cx
end

/-- A "continuous induction principle" for a closed interval: if a set `s` meets `[a, b]`
on a closed subset, contains `a`, and for any `a ≤ x < y ≤ b`, `x ∈ s`, the set `s ∩ (x, y]`
is not empty, then `[a, b] ⊆ s`. -/
lemma is_closed.Icc_subset_of_forall_exists_gt {a b : α} {s : set α} (hs : is_closed (s ∩ Icc a b))
  (ha : a ∈ s) (hgt : ∀ x ∈ s ∩ Ico a b, ∀ y ∈ Ioi x, (s ∩ Ioc x y).nonempty) :
  Icc a b ⊆ s :=
begin
  assume y hy,
  have : is_closed (s ∩ Icc a y),
  { suffices : s ∩ Icc a y = s ∩ Icc a b ∩ Icc a y,
    { rw this, exact is_closed.inter hs is_closed_Icc },
    rw [inter_assoc],
    congr,
    exact (inter_eq_self_of_subset_right $ Icc_subset_Icc_right hy.2).symm },
  exact is_closed.mem_of_ge_of_forall_exists_gt this ha hy.1
    (λ x hx, hgt x ⟨hx.1, Ico_subset_Ico_right hy.2 hx.2⟩ y hx.2.2)
end

variables [densely_ordered α] {a b : α}

/-- A "continuous induction principle" for a closed interval: if a set `s` meets `[a, b]`
on a closed subset, contains `a`, and for any `x ∈ s ∩ [a, b)` the set `s` includes some open
neighborhood of `x` within `(x, +∞)`, then `[a, b] ⊆ s`. -/
lemma is_closed.Icc_subset_of_forall_mem_nhds_within {a b : α} {s : set α}
  (hs : is_closed (s ∩ Icc a b)) (ha : a ∈ s)
  (hgt : ∀ x ∈ s ∩ Ico a b, s ∈ 𝓝[Ioi x] x) :
  Icc a b ⊆ s :=
begin
  apply hs.Icc_subset_of_forall_exists_gt ha,
  rintros x ⟨hxs, hxab⟩ y hyxb,
  have : s ∩ Ioc x y ∈ 𝓝[Ioi x] x,
    from inter_mem (hgt x ⟨hxs, hxab⟩) (Ioc_mem_nhds_within_Ioi ⟨le_refl _, hyxb⟩),
  exact (nhds_within_Ioi_self_ne_bot' hxab.2).nonempty_of_mem this
end

/-- A closed interval in a densely ordered conditionally complete linear order is preconnected. -/
lemma is_preconnected_Icc : is_preconnected (Icc a b) :=
is_preconnected_closed_iff.2
begin
  rintros s t hs ht hab ⟨x, hx⟩ ⟨y, hy⟩,
  wlog hxy : x ≤ y := le_total x y using [x y s t, y x t s],
  have xyab : Icc x y ⊆ Icc a b := Icc_subset_Icc hx.1.1 hy.1.2,
  by_contradiction hst,
  suffices : Icc x y ⊆ s,
    from hst ⟨y, xyab $ right_mem_Icc.2 hxy, this $ right_mem_Icc.2 hxy, hy.2⟩,
  apply (is_closed.inter hs is_closed_Icc).Icc_subset_of_forall_mem_nhds_within hx.2,
  rintros z ⟨zs, hz⟩,
  have zt : z ∈ tᶜ, from λ zt, hst ⟨z, xyab $ Ico_subset_Icc_self hz, zs, zt⟩,
  have : tᶜ ∩ Ioc z y ∈ 𝓝[Ioi z] z,
  { rw [← nhds_within_Ioc_eq_nhds_within_Ioi hz.2],
    exact mem_nhds_within.2 ⟨tᶜ, ht.is_open_compl, zt, subset.refl _⟩},
  apply mem_of_superset this,
  have : Ioc z y ⊆ s ∪ t, from λ w hw, hab (xyab ⟨le_trans hz.1 (le_of_lt hw.1), hw.2⟩),
  exact λ w ⟨wt, wzy⟩, (this wzy).elim id (λ h, (wt h).elim)
end

lemma is_preconnected_interval : is_preconnected (interval a b) := is_preconnected_Icc

lemma set.ord_connected.is_preconnected {s : set α} (h : s.ord_connected) :
  is_preconnected s :=
is_preconnected_of_forall_pair $ λ x y hx hy, ⟨interval x y, h.interval_subset hx hy,
  left_mem_interval, right_mem_interval, is_preconnected_interval⟩

lemma is_preconnected_iff_ord_connected {s : set α} :
  is_preconnected s ↔ ord_connected s :=
⟨is_preconnected.ord_connected, set.ord_connected.is_preconnected⟩

lemma is_preconnected_Ici : is_preconnected (Ici a) := ord_connected_Ici.is_preconnected
lemma is_preconnected_Iic : is_preconnected (Iic a) := ord_connected_Iic.is_preconnected
lemma is_preconnected_Iio : is_preconnected (Iio a) := ord_connected_Iio.is_preconnected
lemma is_preconnected_Ioi : is_preconnected (Ioi a) := ord_connected_Ioi.is_preconnected
lemma is_preconnected_Ioo : is_preconnected (Ioo a b) := ord_connected_Ioo.is_preconnected
lemma is_preconnected_Ioc : is_preconnected (Ioc a b) := ord_connected_Ioc.is_preconnected
lemma is_preconnected_Ico : is_preconnected (Ico a b) := ord_connected_Ico.is_preconnected

@[priority 100]
instance ordered_connected_space : preconnected_space α :=
⟨ord_connected_univ.is_preconnected⟩

/-- In a dense conditionally complete linear order, the set of preconnected sets is exactly
the set of the intervals `Icc`, `Ico`, `Ioc`, `Ioo`, `Ici`, `Ioi`, `Iic`, `Iio`, `(-∞, +∞)`,
or `∅`. Though one can represent `∅` as `(Inf s, Inf s)`, we include it into the list of
possible cases to improve readability. -/
lemma set_of_is_preconnected_eq_of_ordered :
  {s : set α | is_preconnected s} =
    -- bounded intervals
    (range (uncurry Icc) ∪ range (uncurry Ico) ∪ range (uncurry Ioc) ∪ range (uncurry Ioo)) ∪
    -- unbounded intervals and `univ`
    (range Ici ∪ range Ioi ∪ range Iic ∪ range Iio ∪ {univ, ∅}) :=
begin
  refine subset.antisymm set_of_is_preconnected_subset_of_ordered _,
  simp only [subset_def, -mem_range, forall_range_iff, uncurry, or_imp_distrib, forall_and_distrib,
    mem_union, mem_set_of_eq, insert_eq, mem_singleton_iff, forall_eq, forall_true_iff, and_true,
    is_preconnected_Icc, is_preconnected_Ico, is_preconnected_Ioc,
    is_preconnected_Ioo, is_preconnected_Ioi, is_preconnected_Iio, is_preconnected_Ici,
    is_preconnected_Iic, is_preconnected_univ, is_preconnected_empty],
end

/-!
### Intermediate Value Theorem on an interval

In this section we prove several versions of the Intermediate Value Theorem for a function
continuous on an interval.
-/

variables {δ : Type*} [linear_order δ] [topological_space δ] [order_closed_topology δ]

/-- **Intermediate Value Theorem** for continuous functions on closed intervals, case
`f a ≤ t ≤ f b`.-/
lemma intermediate_value_Icc {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Icc (f a) (f b) ⊆ f '' (Icc a b) :=
is_preconnected_Icc.intermediate_value (left_mem_Icc.2 hab) (right_mem_Icc.2 hab) hf

/-- **Intermediate Value Theorem** for continuous functions on closed intervals, case
`f a ≥ t ≥ f b`.-/
lemma intermediate_value_Icc' {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Icc (f b) (f a) ⊆ f '' (Icc a b) :=
is_preconnected_Icc.intermediate_value (right_mem_Icc.2 hab) (left_mem_Icc.2 hab) hf

/-- **Intermediate Value Theorem** for continuous functions on closed intervals, unordered case. -/
lemma intermediate_value_interval {a b : α} {f : α → δ} (hf : continuous_on f (interval a b)) :
  interval (f a) (f b) ⊆ f '' interval a b :=
by cases le_total (f a) (f b); simp [*, is_preconnected_interval.intermediate_value]

lemma intermediate_value_Ico {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ico (f a) (f b) ⊆ f '' (Ico a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.2 (not_lt_of_le (he ▸ h.1)))
(λ hlt, @is_preconnected.intermediate_value_Ico _ _ _ _ _ _ _ (is_preconnected_Ico)
  _ _ ⟨refl a, hlt⟩ (right_nhds_within_Ico_ne_bot hlt) inf_le_right _ (hf.mono Ico_subset_Icc_self)
  _ ((hf.continuous_within_at ⟨hab, refl b⟩).mono Ico_subset_Icc_self))

lemma intermediate_value_Ico' {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ioc (f b) (f a) ⊆ f '' (Ico a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.1 (not_lt_of_le (he ▸ h.2)))
(λ hlt, @is_preconnected.intermediate_value_Ioc _ _ _ _ _ _ _ (is_preconnected_Ico)
  _ _ ⟨refl a, hlt⟩ (right_nhds_within_Ico_ne_bot hlt) inf_le_right _ (hf.mono Ico_subset_Icc_self)
  _ ((hf.continuous_within_at ⟨hab, refl b⟩).mono Ico_subset_Icc_self))

lemma intermediate_value_Ioc {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ioc (f a) (f b) ⊆ f '' (Ioc a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.2 (not_le_of_lt (he ▸ h.1)))
(λ hlt, @is_preconnected.intermediate_value_Ioc _ _ _ _ _ _ _ (is_preconnected_Ioc)
  _ _ ⟨hlt, refl b⟩ (left_nhds_within_Ioc_ne_bot hlt) inf_le_right _ (hf.mono Ioc_subset_Icc_self)
  _ ((hf.continuous_within_at ⟨refl a, hab⟩).mono Ioc_subset_Icc_self))

lemma intermediate_value_Ioc' {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ico (f b) (f a) ⊆ f '' (Ioc a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.1 (not_le_of_lt (he ▸ h.2)))
(λ hlt, @is_preconnected.intermediate_value_Ico _ _ _ _ _ _ _ (is_preconnected_Ioc)
  _ _ ⟨hlt, refl b⟩ (left_nhds_within_Ioc_ne_bot hlt) inf_le_right _ (hf.mono Ioc_subset_Icc_self)
  _ ((hf.continuous_within_at ⟨refl a, hab⟩).mono Ioc_subset_Icc_self))

lemma intermediate_value_Ioo {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ioo (f a) (f b) ⊆ f '' (Ioo a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.2 (not_lt_of_lt (he ▸ h.1)))
(λ hlt, @is_preconnected.intermediate_value_Ioo _ _ _ _ _ _ _ (is_preconnected_Ioo)
  _ _ (left_nhds_within_Ioo_ne_bot hlt) (right_nhds_within_Ioo_ne_bot hlt)
  inf_le_right inf_le_right _ (hf.mono Ioo_subset_Icc_self)
  _ _ ((hf.continuous_within_at ⟨refl a, hab⟩).mono Ioo_subset_Icc_self)
  ((hf.continuous_within_at ⟨hab, refl b⟩).mono Ioo_subset_Icc_self))

lemma intermediate_value_Ioo' {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ioo (f b) (f a) ⊆ f '' (Ioo a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.1 (not_lt_of_lt (he ▸ h.2)))
(λ hlt, @is_preconnected.intermediate_value_Ioo _ _ _ _ _ _ _ (is_preconnected_Ioo)
  _ _ (right_nhds_within_Ioo_ne_bot hlt) (left_nhds_within_Ioo_ne_bot hlt)
  inf_le_right inf_le_right _ (hf.mono Ioo_subset_Icc_self)
  _ _ ((hf.continuous_within_at ⟨hab, refl b⟩).mono Ioo_subset_Icc_self)
  ((hf.continuous_within_at ⟨refl a, hab⟩).mono Ioo_subset_Icc_self))

/-- **Intermediate value theorem**: if `f` is continuous on an order-connected set `s` and `a`,
`b` are two points of this set, then `f` sends `s` to a superset of `Icc (f x) (f y)`. -/
lemma continuous_on.surj_on_Icc {s : set α} [hs : ord_connected s] {f : α → δ}
  (hf : continuous_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  surj_on f s (Icc (f a) (f b)) :=
hs.is_preconnected.intermediate_value ha hb hf

/-- **Intermediate value theorem**: if `f` is continuous on an order-connected set `s` and `a`,
`b` are two points of this set, then `f` sends `s` to a superset of `[f x, f y]`. -/
lemma continuous_on.surj_on_interval {s : set α} [hs : ord_connected s] {f : α → δ}
  (hf : continuous_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  surj_on f s (interval (f a) (f b)) :=
by cases le_total (f a) (f b) with hab hab; simp [hf.surj_on_Icc, *]

/-- A continuous function which tendsto `at_top` `at_top` and to `at_bot` `at_bot` is surjective. -/
lemma continuous.surjective {f : α → δ} (hf : continuous f) (h_top : tendsto f at_top at_top)
  (h_bot : tendsto f at_bot at_bot) :
  function.surjective f :=
λ p, mem_range_of_exists_le_of_exists_ge hf
  (h_bot.eventually (eventually_le_at_bot p)).exists
  (h_top.eventually (eventually_ge_at_top p)).exists

/-- A continuous function which tendsto `at_bot` `at_top` and to `at_top` `at_bot` is surjective. -/
lemma continuous.surjective' {f : α → δ} (hf : continuous f) (h_top : tendsto f at_bot at_top)
  (h_bot : tendsto f at_top at_bot) :
  function.surjective f :=
@continuous.surjective (order_dual α) _ _ _ _ _ _ _ _ _ hf h_top h_bot

/-- If a function `f : α → β` is continuous on a nonempty interval `s`, its restriction to `s`
tends to `at_bot : filter β` along `at_bot : filter ↥s` and tends to `at_top : filter β` along
`at_top : filter ↥s`, then the restriction of `f` to `s` is surjective. We formulate the
conclusion as `surj_on f s univ`. -/
lemma continuous_on.surj_on_of_tendsto {f : α → δ} {s : set α} [ord_connected s]
  (hs : s.nonempty) (hf : continuous_on f s) (hbot : tendsto (λ x : s, f x) at_bot at_bot)
  (htop : tendsto (λ x : s, f x) at_top at_top) :
  surj_on f s univ :=
by haveI := classical.inhabited_of_nonempty hs.to_subtype;
  exact (surj_on_iff_surjective.2 $
    (continuous_on_iff_continuous_restrict.1 hf).surjective htop hbot)

/-- If a function `f : α → β` is continuous on a nonempty interval `s`, its restriction to `s`
tends to `at_top : filter β` along `at_bot : filter ↥s` and tends to `at_bot : filter β` along
`at_top : filter ↥s`, then the restriction of `f` to `s` is surjective. We formulate the
conclusion as `surj_on f s univ`. -/
lemma continuous_on.surj_on_of_tendsto' {f : α → δ} {s : set α} [ord_connected s]
  (hs : s.nonempty) (hf : continuous_on f s) (hbot : tendsto (λ x : s, f x) at_bot at_top)
  (htop : tendsto (λ x : s, f x) at_top at_bot) :
  surj_on f s univ :=
@continuous_on.surj_on_of_tendsto α _ _ _ _ (order_dual δ) _ _ _ _ _ _ hs hf hbot htop


import data.list
import data.finset
import tactic
import myoption

open list

namespace list

universe u

lemma init_length_is_pred {A : Type u} {xs : list A} (h : xs ≠ [])
: xs.init.length = xs.length - 1 :=
begin
  induction xs with x₀ xs ih, refl,
  cases xs with x₁ xs, refl,
  simp [init] at ⊢ ih,
  exact ih,
end

lemma init_nth {A : Type u} {xs : list A} (i : ℕ) (h : i + 1 < xs.length)
: xs.init.nth i = xs.nth i :=
begin
  induction xs with x₀ xs ih generalizing i, refl,
  simp at h,
  cases xs with x₁ xs, dsimp at h, exfalso, linarith only [h],
  cases i, refl,
  dsimp [init] at ⊢,
  exact ih i h,
end

lemma init_rep_nth {A : Type u} (f : ℕ → list A)
(sys : ∀ k, f k = (f k.succ).init) (lens : ∀ k, (f k).length = k)
(i a b : ℕ) (h₁ : i < a) (h₂ : a ≤ b)
: list.nth (f a) i = list.nth (f b) i :=
begin
  induction b with b ihb generalizing a,
  exfalso, linarith only [h₁, h₂],
  change a ≤ b + 1 at h₂,
  cases nat.eq_or_lt_of_le h₂ with h₃ h₃, rw h₃,
  rw ← init_nth i (_ : i + 1 < (f b.succ).length),
  rw ← sys,
  exact ihb a h₁ (by linarith),
  rw lens,
  change _ < _ + 1, linarith,
end

@[norm_cast]
lemma coe_nth {A B} [has_lift_t A B] (xs : list A) (i : ℕ)
: (↑xs : list B).nth i = (↑(xs.nth i) : option B) :=
begin
  unfold_coes, simp,
end

-- Produces a function ℕ → A starting with the given list, then a constant value after that.
def as_fn {A : Type u} : list A → A → ℕ → A
| xs a i := option.get_or_else (xs.nth i) a

lemma as_fn_inrange {A : Type u} {a : A} {xs : list A} {i : ℕ} (h : i < xs.init.length)
: xs.init.as_fn a i = xs.as_fn a i :=
begin
  dsimp only [as_fn, nth],
  have h' : i + 1 < xs.length, {
    cases xs with x₀ xs, dsimp [init] at h, linarith only [h],
    have neq : (list.cons x₀ xs) ≠ [], tauto,
    rw init_length_is_pred neq at h, simp at h ⊢, exact h,
  },
  rw init_nth i h',
end

-- range2 a n is the list [a, a+1, a+2, ..., a+n-1]
@[simp] def range2 : ℕ → ℕ → list ℕ
| _ 0 := []
| a (b+1) := a :: range2 (a + 1) b

protected
lemma range2_red_nth (a b i : ℕ)
: (range2 a (b + i)).nth i = (range2 (a+i) b).nth 0 :=
begin
  induction i with i ih generalizing a b,
  refl,
  change (range2 (a + 1) (b + i)).nth i = _,
  rw ih,
  ring,
end

@[simp] lemma range2_nth (a b i : ℕ) (h : i < b)
: (range2 a b).nth i = some (a + i) :=
begin
  have eq : b = (b - i) + i, omega,
  rw eq,
  rw list.range2_red_nth,
  cases (b - i), exfalso, linarith,
  refl,
end

@[simp] lemma range2_length (a b : ℕ) : (range2 a b).length = b :=
begin
  induction b with b ihb generalizing a,
  refl, simp, rw ihb,
end

end list


import MyNat.Power
import AdditionWorld.Level5 -- one_eq_succ_zero
import MultiplicationWorld.Level3 -- one_mul
namespace MyNat
open MyNat

/-!

# Power World

## Level 3: `pow_one`

## Lemma
For all naturals `a`, `a ^ 1 = a`.
-/
lemma pow_one (a : MyNat) : a ^ (1 : MyNat) = a := by
  rw [one_eq_succ_zero]
  rw [pow_succ]
  rw [pow_zero]
  rw [one_mul]

/-!
Next up [Level 4](./Level4.lean.md)
-/


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro

! This file was ported from Lean 3 source module logic.encodable.basic
! leanprover-community/mathlib commit 7c523cb78f4153682c2929e3006c863bfef463d0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Equiv.Nat
import Mathlib.Data.PNat.Basic
import Mathlib.Order.Directed
import Mathlib.Data.Countable.Defs
import Mathlib.Order.RelIso.Basic
import Mathlib.Data.Fin.Basic

/-!
# Encodable types

This file defines encodable (constructively countable) types as a typeclass.
This is used to provide explicit encode/decode functions from and to `ℕ`, with the information that
those functions are inverses of each other.
The difference with `Denumerable` is that finite types are encodable. For infinite types,
`Encodable` and `Denumerable` agree.

## Main declarations

* `Encodable α`: States that there exists an explicit encoding function `encode : α → ℕ` with a
  partial inverse `decode : ℕ → Option α`.
* `decode₂`: Version of `decode` that is equal to `none` outside of the range of `encode`. Useful as
  we do not require this in the definition of `decode`.
* `ulower α`: Any encodable type has an equivalent type living in the lowest universe, namely a
  subtype of `ℕ`. `ulower α` finds it.

## Implementation notes

The point of asking for an explicit partial inverse `decode : ℕ → Option α` to `encode : α → ℕ` is
to make the range of `encode` decidable even when the finiteness of `α` is not.
-/

open Option List Nat Function

/-- Constructively countable type. Made from an explicit injection `encode : α → ℕ` and a partial
inverse `decode : ℕ → Option α`. Note that finite types *are* countable. See `Denumerable` if you
wish to enforce infiniteness. -/
class Encodable (α : Type _) where
  /-- Encoding from Type α to ℕ -/
  encode : α → ℕ
  --Porting note: was `decode [] : ℕ → Option α`. This means that `decode` does not take the type
  --explicitly in Lean4
  /-- Decoding from ℕ to Option α-/
  decode : ℕ → Option α
  /-- Invariant relationship between encoding and decoding-/
  encodek : ∀ a, decode (encode a) = some a
#align encodable Encodable

attribute [simp] Encodable.encodek

namespace Encodable

variable {α : Type _} {β : Type _}

universe u

theorem encode_injective [Encodable α] : Function.Injective (@encode α _)
  | x, y, e => Option.some.inj <| by rw [← encodek, e, encodek]
#align encodable.encode_injective Encodable.encode_injective

@[simp]
theorem encode_inj [Encodable α] {a b : α} : encode a = encode b ↔ a = b :=
  encode_injective.eq_iff
#align encodable.encode_inj Encodable.encode_inj

-- The priority of the instance below is less than the priorities of `Subtype.Countable`
-- and `Quotient.Countable`
instance (priority := 400) countable [Encodable α] : Countable α where
  exists_injective_nat' := ⟨_,encode_injective⟩

theorem surjective_decode_iget (α : Type _) [Encodable α] [Inhabited α] :
    Surjective fun n => ((Encodable.decode n).iget : α) := fun x =>
  ⟨Encodable.encode x, by simp_rw [Encodable.encodek]⟩
#align encodable.surjective_decode_iget Encodable.surjective_decode_iget

/-- An encodable type has decidable equality. Not set as an instance because this is usually not the
best way to infer decidability. -/
def decidableEqOfEncodable (α) [Encodable α] : DecidableEq α
  | _, _ => decidable_of_iff _ encode_inj
#align encodable.decidable_eq_of_encodable Encodable.decidableEqOfEncodable

/-- If `α` is encodable and there is an injection `f : β → α`, then `β` is encodable as well. -/
def ofLeftInjection [Encodable α] (f : β → α) (finv : α → Option β)
    (linv : ∀ b, finv (f b) = some b) : Encodable β :=
  ⟨fun b => encode (f b), fun n => (decode n).bind finv, fun b => by
    simp [Encodable.encodek, linv]⟩
#align encodable.of_left_injection Encodable.ofLeftInjection

/-- If `α` is encodable and `f : β → α` is invertible, then `β` is encodable as well. -/
def ofLeftInverse [Encodable α] (f : β → α) (finv : α → β) (linv : ∀ b, finv (f b) = b) :
    Encodable β :=
  ofLeftInjection f (some ∘ finv) fun b => congr_arg some (linv b)
#align encodable.of_left_inverse Encodable.ofLeftInverse

/-- Encodability is preserved by equivalence. -/
def ofEquiv (α) [Encodable α] (e : β ≃ α) : Encodable β :=
  ofLeftInverse e e.symm e.left_inv
#align encodable.of_equiv Encodable.ofEquiv

-- Porting note: removing @[simp], too powerful
theorem encode_ofEquiv {α β} [Encodable α] (e : β ≃ α) (b : β) :
    @encode _ (ofEquiv _ e) b = encode (e b) :=
  rfl
#align encodable.encode_of_equiv Encodable.encode_ofEquiv

-- Porting note: removing @[simp], too powerful
theorem decode_ofEquiv {α β} [Encodable α] (e : β ≃ α) (n : ℕ) :
    @decode _ (ofEquiv _ e) n = (decode n).map e.symm :=
  show Option.bind _ _ = Option.map _ _
  by rw [Option.map_eq_bind]
#align encodable.decode_of_equiv Encodable.decode_ofEquiv

instance Nat.encodable : Encodable ℕ :=
  ⟨id, some, fun _ => rfl⟩
#align nat.encodable Encodable.Nat.encodable

@[simp]
theorem encode_nat (n : ℕ) : encode n = n :=
  rfl
#align encodable.encode_nat Encodable.encode_nat

@[simp 1100]
theorem decode_nat (n : ℕ) : decode n = some n :=
  rfl
#align encodable.decode_nat Encodable.decode_nat

instance (priority := 100) IsEmpty.toEncodable [IsEmpty α] : Encodable α :=
  ⟨isEmptyElim, fun _ => none, isEmptyElim⟩
#align is_empty.to_encodable Encodable.IsEmpty.toEncodable

instance PUnit.encodable : Encodable PUnit :=
  ⟨fun _ => 0, fun n => Nat.casesOn n (some PUnit.unit) fun _ => none, fun _ => by simp⟩
#align punit.encodable Encodable.PUnit.encodable

@[simp]
theorem encode_star : encode PUnit.unit = 0 :=
  rfl
#align encodable.encode_star Encodable.encode_star

@[simp]
theorem decode_unit_zero : decode 0 = some PUnit.unit :=
  rfl
#align encodable.decode_unit_zero Encodable.decode_unit_zero

@[simp]
theorem decode_unit_succ (n) : decode (succ n) = (none : Option PUnit) :=
  rfl
#align encodable.decode_unit_succ Encodable.decode_unit_succ

/-- If `α` is encodable, then so is `Option α`. -/
instance _root_.Option.encodable {α : Type _} [h : Encodable α] : Encodable (Option α) :=
  ⟨fun o => Option.casesOn o Nat.zero fun a => succ (encode a), fun n =>
    Nat.casesOn n (some none) fun m => (decode m).map some, fun o => by
    cases o <;> dsimp ; simp [encodek, Nat.succ_ne_zero]⟩
#align option.encodable Option.encodable

@[simp]
theorem encode_none [Encodable α] : encode (@none α) = 0 :=
  rfl
#align encodable.encode_none Encodable.encode_none

@[simp]
theorem encode_some [Encodable α] (a : α) : encode (some a) = succ (encode a) :=
  rfl
#align encodable.encode_some Encodable.encode_some

@[simp]
theorem decode_option_zero [Encodable α] : (decode 0 : Option (Option α))= some none :=
  rfl
#align encodable.decode_option_zero Encodable.decode_option_zero

@[simp]
theorem decode_option_succ [Encodable α] (n) :
    (decode (succ n) : Option (Option α)) = (decode n).map some :=
  rfl
#align encodable.decode_option_succ Encodable.decode_option_succ

/-- Failsafe variant of `decode`. `decode₂ α n` returns the preimage of `n` under `encode` if it
exists, and returns `none` if it doesn't. This requirement could be imposed directly on `decode` but
is not to help make the definition easier to use. -/
def decode₂ (α) [Encodable α] (n : ℕ) : Option α :=
  (decode n).bind (Option.guard fun a => encode a = n)
#align encodable.decode₂ Encodable.decode₂

theorem mem_decode₂' [Encodable α] {n : ℕ} {a : α} :
    a ∈ decode₂ α n ↔ a ∈ decode n ∧ encode a = n := by
  simp [decode₂] ; exact ⟨fun ⟨_, h₁, rfl, h₂⟩ => ⟨h₁, h₂⟩, fun ⟨h₁, h₂⟩ => ⟨_, h₁, rfl, h₂⟩⟩
#align encodable.mem_decode₂' Encodable.mem_decode₂'

theorem mem_decode₂ [Encodable α] {n : ℕ} {a : α} : a ∈ decode₂ α n ↔ encode a = n :=
  mem_decode₂'.trans (and_iff_right_of_imp fun e => e ▸ encodek _)
#align encodable.mem_decode₂ Encodable.mem_decode₂

theorem decode₂_eq_some [Encodable α] {n : ℕ} {a : α} : decode₂ α n = some a ↔ encode a = n :=
  mem_decode₂
#align encodable.decode₂_eq_some Encodable.decode₂_eq_some

@[simp]
theorem decode₂_encode [Encodable α] (a : α) : decode₂ α (encode a) = some a :=
  by
  ext
  simp [mem_decode₂, eq_comm, decode₂_eq_some]
#align encodable.decode₂_encode Encodable.decode₂_encode

theorem decode₂_ne_none_iff [Encodable α] {n : ℕ} :
    decode₂ α n ≠ none ↔ n ∈ Set.range (encode : α → ℕ) := by
  simp_rw [Set.range, Set.mem_setOf_eq, Ne.def, Option.eq_none_iff_forall_not_mem,
    Encodable.mem_decode₂, not_forall, not_not]
#align encodable.decode₂_ne_none_iff Encodable.decode₂_ne_none_iff

theorem decode₂_inj [Encodable α] {n : ℕ} {a₁ a₂ : α} (h₁ : a₁ ∈ decode₂ α n)
    (h₂ : a₂ ∈ decode₂ α n) : a₁ = a₂ :=
  encode_injective <| (mem_decode₂.1 h₁).trans (mem_decode₂.1 h₂).symm
#align encodable.decode₂_inj Encodable.decode₂_inj

theorem encodek₂ [Encodable α] (a : α) : decode₂ α (encode a) = some a :=
  mem_decode₂.2 rfl
#align encodable.encodek₂ Encodable.encodek₂

/-- The encoding function has decidable range. -/
def decidableRangeEncode (α : Type _) [Encodable α] : DecidablePred (· ∈ Set.range (@encode α _)) :=
  fun x =>
  decidable_of_iff (Option.isSome (decode₂ α x))
    ⟨fun h => ⟨Option.get _ h, by rw [← decode₂_is_partial_inv (Option.get _ h), Option.some_get]⟩,
      fun ⟨n, hn⟩ => by rw [← hn, encodek₂] ; exact rfl⟩
#align encodable.decidable_range_encode Encodable.decidableRangeEncode

/-- An encodable type is equivalent to the range of its encoding function. -/
def equivRangeEncode (α : Type _) [Encodable α] : α ≃ Set.range (@encode α _)
    where
  toFun := fun a : α => ⟨encode a, Set.mem_range_self _⟩
  invFun n :=
    Option.get _
      (show isSome (decode₂ α n.1) by cases' n.2 with x hx ; rw [← hx, encodek₂] ; exact rfl)
  left_inv a := by dsimp ; rw [← Option.some_inj, Option.some_get, encodek₂]
  right_inv := fun ⟨n, x, hx⟩ => by
    apply Subtype.eq
    dsimp
    conv =>
      rhs
      rw [← hx]
    rw [encode_injective.eq_iff, ← Option.some_inj, Option.some_get, ← hx, encodek₂]
#align encodable.equiv_range_encode Encodable.equivRangeEncode

/-- A type with unique element is encodable. This is not an instance to avoid diamonds. -/
def Unique.encodable [Unique α] : Encodable α :=
  ⟨fun _ => 0, fun _ => some default, Unique.forall_iff.2 rfl⟩
#align unique.encodable Encodable.Unique.encodable

section Sum

variable [Encodable α] [Encodable β]

--Porting note: removing bit0 and bit1
/-- Explicit encoding function for the sum of two encodable types. -/
def encodeSum : Sum α β → ℕ
  | Sum.inl a => 2 * encode a
  | Sum.inr b => 2 * encode b + 1
#align encodable.encode_sum Encodable.encodeSum

/-- Explicit decoding function for the sum of two encodable types. -/
def decodeSum (n : ℕ) : Option (Sum α β) :=
  match boddDiv2 n with
  | (false, m) => (decode m : Option α).map Sum.inl
  | (_, m) => (decode m : Option β).map Sum.inr
#align encodable.decode_sum Encodable.decodeSum

/-- If `α` and `β` are encodable, then so is their sum. -/
instance Sum.encodable : Encodable (Sum α β) :=
  ⟨encodeSum, decodeSum, fun s => by cases s <;> simp [encodeSum, div2_val, decodeSum, encodek]⟩
#align sum.encodable Encodable.Sum.encodable

--Porting note: removing bit0 and bit1 from statement
@[simp]
theorem encode_inl (a : α) : @encode (Sum α β) _ (Sum.inl a) = 2 * (encode a) :=
  rfl
#align encodable.encode_inl Encodable.encode_inlₓ

--Porting note: removing bit0 and bit1 from statement
@[simp]
theorem encode_inr (b : β) : @encode (Sum α β) _ (Sum.inr b) = 2 * (encode b) + 1 :=
  rfl
#align encodable.encode_inr Encodable.encode_inrₓ

@[simp]
theorem decode_sum_val (n : ℕ) : (decode n : Option (Sum α β)) = decodeSum n :=
  rfl
#align encodable.decode_sum_val Encodable.decode_sum_val

end Sum

instance Bool.encodable : Encodable Bool :=
  ofEquiv (Sum Unit Unit) Equiv.boolEquivPUnitSumPUnit
#align bool.encodable Encodable.Bool.encodable

@[simp]
theorem encode_true : encode true = 1 :=
  rfl
#align encodable.encode_tt Encodable.encode_true

@[simp]
theorem encode_false : encode false = 0 :=
  rfl
#align encodable.encode_ff Encodable.encode_false

@[simp]
theorem decode_zero : (decode 0 : Option Bool) = some false :=
  rfl
#align encodable.decode_zero Encodable.decode_zero

@[simp]
theorem decode_one : (decode 1: Option Bool) = some true :=
  rfl
#align encodable.decode_one Encodable.decode_one

theorem decode_ge_two (n) (h : 2 ≤ n) : (decode n : Option Bool) = none :=
  by
  suffices decodeSum n = none by
    change (decodeSum n).bind _ = none
    rw [this]
    rfl
  have : 1 ≤ n / 2 := by
    rw [Nat.le_div_iff_mul_le]
    exacts[h, by decide]
  cases' exists_eq_succ_of_ne_zero (_root_.ne_of_gt this) with m e
  simp [decodeSum, div2_val]; cases bodd n <;> simp [e]
#align encodable.decode_ge_two Encodable.decode_ge_two

noncomputable instance Prop.encodable : Encodable Prop :=
  ofEquiv Bool Equiv.propEquivBool
#align Prop.encodable Encodable.Prop.encodable

section Sigma

variable {γ : α → Type _} [Encodable α] [∀ a, Encodable (γ a)]

/-- Explicit encoding function for `Sigma γ` -/
def encodeSigma : Sigma γ → ℕ
  | ⟨a, b⟩ => pair (encode a) (encode b)
#align encodable.encode_sigma Encodable.encodeSigma

/-- Explicit decoding function for `Sigma γ` -/
def decodeSigma (n : ℕ) : Option (Sigma γ) :=
  let (n₁, n₂) := unpair n
  (decode n₁).bind fun a => (decode n₂).map <| Sigma.mk a
#align encodable.decode_sigma Encodable.decodeSigma

instance Sigma.encodable : Encodable (Sigma γ) :=
  ⟨encodeSigma, decodeSigma, fun ⟨a, b⟩ => by
    simp [encodeSigma, decodeSigma, unpair_pair, encodek]⟩
#align sigma.encodable Encodable.Sigma.encodable

@[simp]
theorem decode_sigma_val (n : ℕ) :
    (decode n : Option (Sigma γ)) =
      (decode n.unpair.1).bind fun a => (decode n.unpair.2).map <| Sigma.mk a :=
  rfl
#align encodable.decode_sigma_val Encodable.decode_sigma_val

@[simp]
theorem encode_sigma_val (a b) : @encode (Sigma γ) _ ⟨a, b⟩ = pair (encode a) (encode b) :=
  rfl
#align encodable.encode_sigma_val Encodable.encode_sigma_val

end Sigma

section Prod

variable [Encodable α] [Encodable β]

/-- If `α` and `β` are encodable, then so is their product. -/
instance Prod.encodable : Encodable (α × β) :=
  ofEquiv _ (Equiv.sigmaEquivProd α β).symm

@[simp]
theorem decode_prod_val [i : Encodable α] (n : ℕ) :
    (@decode (α × β) _ n : Option (α × β))
      = (decode n.unpair.1).bind fun a => (decode n.unpair.2).map <| Prod.mk a := by
  simp only [decode_ofEquiv, Equiv.symm_symm, decode_sigma_val]
  cases (decode n.unpair.1 : Option α) <;> cases (decode n.unpair.2 : Option β)
  <;> rfl
#align encodable.decode_prod_val Encodable.decode_prod_val

@[simp]
theorem encode_prod_val (a b) : @encode (α × β) _ (a, b) = pair (encode a) (encode b) :=
  rfl
#align encodable.encode_prod_val Encodable.encode_prod_val

end Prod

section Subtype

open Subtype Decidable

variable {P : α → Prop} [encA : Encodable α] [decP : DecidablePred P]

--include encA

/-- Explicit encoding function for a decidable subtype of an encodable type -/
def encodeSubtype : { a : α // P a } → ℕ
  | ⟨v,_⟩ => encode v
#align encodable.encode_subtype Encodable.encodeSubtype

--include decP

/-- Explicit decoding function for a decidable subtype of an encodable type -/
def decodeSubtype (v : ℕ) : Option { a : α // P a } :=
  (decode v).bind fun a => if h : P a then some ⟨a, h⟩ else none
#align encodable.decode_subtype Encodable.decodeSubtype

/-- A decidable subtype of an encodable type is encodable. -/
instance Subtype.encodable : Encodable { a : α // P a } :=
  ⟨encodeSubtype, decodeSubtype, fun ⟨v, h⟩ => by simp [encodeSubtype, decodeSubtype, encodek, h]⟩
#align subtype.encodable Encodable.Subtype.encodable

theorem Subtype.encode_eq (a : Subtype P) : encode a = encode a.val := by cases a ; rfl
#align encodable.subtype.encode_eq Encodable.Subtype.encode_eq

end Subtype

instance Fin.encodable (n) : Encodable (Fin n) :=
  ofEquiv _ Fin.equivSubtype
#align fin.encodable Encodable.Fin.encodable

instance Int.encodable : Encodable ℤ :=
  ofEquiv _ Equiv.intEquivNat
#align int.encodable Encodable.Int.encodable

instance PNat.encodable : Encodable ℕ+ :=
  ofEquiv _ Equiv.pnatEquivNat
#align pnat.encodable Encodable.PNat.encodable

/-- The lift of an encodable type is encodable. -/
instance ULift.encodable [Encodable α] : Encodable (ULift α) :=
  ofEquiv _ Equiv.ulift
#align ulift.encodable Encodable.ULift.encodable

/-- The lift of an encodable type is encodable. -/
instance PLift.encodable [Encodable α] : Encodable (PLift α) :=
  ofEquiv _ Equiv.plift
#align plift.encodable Encodable.PLift.encodable

/-- If `β` is encodable and there is an injection `f : α → β`, then `α` is encodable as well. -/
noncomputable def ofInj [Encodable β] (f : α → β) (hf : Injective f) : Encodable α :=
  ofLeftInjection f (partialInv f) fun _ => (partialInv_of_injective hf _ _).2 rfl
#align encodable.of_inj Encodable.ofInj

/-- If `α` is countable, then it has a (non-canonical) `Encodable` structure. -/
noncomputable def ofCountable (α : Type _) [Countable α] : Encodable α :=
  Nonempty.some <|
    let ⟨f, hf⟩ := exists_injective_nat α
    ⟨ofInj f hf⟩
#align encodable.of_countable Encodable.ofCountable

@[simp]
theorem nonempty_encodable : Nonempty (Encodable α) ↔ Countable α :=
  ⟨fun ⟨h⟩ => @Encodable.countable α h, fun h => ⟨@ofCountable _ h⟩⟩
#align encodable.nonempty_encodable Encodable.nonempty_encodable

end Encodable

/-- See also `nonempty_fintype`, `nonempty_denumerable`. -/
theorem nonempty_encodable (α : Type _) [Countable α] : Nonempty (Encodable α) :=
  ⟨Encodable.ofCountable _⟩
#align nonempty_encodable nonempty_encodable

instance : Countable ℕ+ := by delta PNat; infer_instance

-- short-circuit instance search
section Ulower

attribute [local instance] Encodable.decidableRangeEncode

/-- `ULower α : Type` is an equivalent type in the lowest universe, given `Encodable α`. -/
def Ulower (α : Type _) [Encodable α] : Type :=
  Set.range (Encodable.encode : α → ℕ)
#align ulower Ulower

instance {α : Type _} [Encodable α] : DecidableEq (Ulower α) :=
  by delta Ulower; exact Encodable.decidableEqOfEncodable _

instance {α : Type _} [Encodable α] : Encodable (Ulower α) :=
  by delta Ulower; infer_instance

end Ulower

namespace Ulower

variable (α : Type _) [Encodable α]

/-- The equivalence between the encodable type `α` and `Ulower α : Type`. -/
def equiv : α ≃ Ulower α :=
  Encodable.equivRangeEncode α
#align ulower.equiv Ulower.equiv

variable {α}

/-- Lowers an `a : α` into `Ulower α`. -/
def down (a : α) : Ulower α :=
  equiv α a
#align ulower.down Ulower.down

instance [Inhabited α] : Inhabited (Ulower α) :=
  ⟨down default⟩

/-- Lifts an `a : Ulower α` into `α`. -/
def up (a : Ulower α) : α :=
  (equiv α).symm a
#align ulower.up Ulower.up

@[simp]
theorem down_up {a : Ulower α} : down a.up = a :=
  Equiv.right_inv _ _
#align ulower.down_up Ulower.down_up

@[simp]
theorem up_down {a : α} : (down a).up = a := by
  simp [up, down,Equiv.left_inv _ _, Equiv.symm_apply_apply]
#align ulower.up_down Ulower.up_down

@[simp]
theorem up_eq_up {a b : Ulower α} : a.up = b.up ↔ a = b :=
  Equiv.apply_eq_iff_eq _
#align ulower.up_eq_up Ulower.up_eq_up

@[simp]
theorem down_eq_down {a b : α} : down a = down b ↔ a = b :=
  Equiv.apply_eq_iff_eq _
#align ulower.down_eq_down Ulower.down_eq_down

@[ext]
protected theorem ext {a b : Ulower α} : a.up = b.up → a = b :=
  up_eq_up.1
#align ulower.ext Ulower.ext

end Ulower

/-
Choice function for encodable types and decidable predicates.
We provide the following API

choose      {α : Type _} {p : α → Prop} [c : encodable α] [d : decidable_pred p] : (∃ x, p x) → α :=
choose_spec {α : Type _} {p : α → Prop} [c : encodable α] [d : decidable_pred p] (ex : ∃ x, p x) :
  p (choose ex) :=
-/
namespace Encodable

section FindA

variable {α : Type _} (p : α → Prop) [Encodable α] [DecidablePred p]

private def good : Option α → Prop
  | some a => p a
  | none => False

private def decidable_good : DecidablePred (good p) :=
  fun n => by
    cases n <;> unfold good <;> dsimp <;> infer_instance
attribute [local instance] decidable_good

open Encodable

variable {p}

/-- Constructive choice function for a decidable subtype of an encodable type. -/
def chooseX (h : ∃ x, p x) : { a : α // p a } :=
  have : ∃ n, good p (decode n) :=
    let ⟨w, pw⟩ := h
    ⟨encode w, by simp [good, encodek, pw]⟩
  match (motive := ∀ o, good p o → { a // p a }) _, Nat.find_spec this with
  | some a, h => ⟨a, h⟩
#align encodable.choose_x Encodable.chooseX

/-- Constructive choice function for a decidable predicate over an encodable type. -/
def choose (h : ∃ x, p x) : α :=
  (chooseX h).1
#align encodable.choose Encodable.choose

theorem choose_spec (h : ∃ x, p x) : p (choose h) :=
  (chooseX h).2
#align encodable.choose_spec Encodable.choose_spec

end FindA

/-- A constructive version of `Classical.axiom_of_choice` for `Encodable` types. -/
theorem axiom_of_choice {α : Type _} {β : α → Type _} {R : ∀ x, β x → Prop} [∀ a, Encodable (β a)]
    [∀ x y, Decidable (R x y)] (H : ∀ x, ∃ y, R x y) : ∃ f : ∀ a, β a, ∀ x, R x (f x) :=
  ⟨fun x => choose (H x), fun x => choose_spec (H x)⟩
#align encodable.axiom_of_choice Encodable.axiom_of_choice

/-- A constructive version of `Classical.skolem` for `Encodable` types. -/
theorem skolem {α : Type _} {β : α → Type _} {P : ∀ x, β x → Prop} [∀ a, Encodable (β a)]
    [∀ x y, Decidable (P x y)] : (∀ x, ∃ y, P x y) ↔ ∃ f : ∀ a, β a, ∀ x, P x (f x) :=
  ⟨axiom_of_choice, fun ⟨_, H⟩ x => ⟨_, H x⟩⟩
#align encodable.skolem Encodable.skolem

/-
There is a total ordering on the elements of an encodable type, induced by the map to ℕ.
-/
/-- The `encode` function, viewed as an embedding. -/
def encode' (α) [Encodable α] : α ↪ ℕ :=
  ⟨Encodable.encode, Encodable.encode_injective⟩
#align encodable.encode' Encodable.encode'

instance {α} [Encodable α] : IsTrans _ (encode' α ⁻¹'o (· ≤ ·)) :=
  (RelEmbedding.preimage _ _).isTrans

instance {α} [Encodable α] : IsAntisymm _ (Encodable.encode' α ⁻¹'o (· ≤ ·)) :=
  (RelEmbedding.preimage _ _).isAntisymm

instance {α} [Encodable α] : IsTotal _ (Encodable.encode' α ⁻¹'o (· ≤ ·)) :=
  (RelEmbedding.preimage _ _).isTotal

end Encodable

namespace Directed

open Encodable

variable {α : Type _} {β : Type _} [Encodable α] [Inhabited α]

/-- Given a `Directed r` function `f : α → β` defined on an encodable inhabited type,
construct a noncomputable sequence such that `r (f (x n)) (f (x (n + 1)))`
and `r (f a) (f (x (encode a + 1))`. -/
protected noncomputable def sequence {r : β → β → Prop} (f : α → β) (hf : Directed r f) : ℕ → α
  | 0 => default
  | n + 1 =>
    let p := Directed.sequence f hf n
    match (decode n: Option α) with
    | none => Classical.choose (hf p p)
    | some a => Classical.choose (hf p a)
#align directed.sequence Directed.sequence

theorem sequence_mono_nat {r : β → β → Prop} {f : α → β} (hf : Directed r f) (n : ℕ) :
    r (f (hf.sequence f n)) (f (hf.sequence f (n + 1))) :=
  by
  dsimp [Directed.sequence]
  generalize eq : hf.sequence f n = p
  cases' h : (decode n: Option α) with a
  · exact (Classical.choose_spec (hf p p)).1
  · exact (Classical.choose_spec (hf p a)).1
#align directed.sequence_mono_nat Directed.sequence_mono_nat

theorem rel_sequence {r : β → β → Prop} {f : α → β} (hf : Directed r f) (a : α) :
    r (f a) (f (hf.sequence f (encode a + 1))) := by
  simp only [Directed.sequence, add_eq, add_zero, encodek, and_self]
  exact (Classical.choose_spec (hf _ a)).2
#align directed.rel_sequence Directed.rel_sequence

variable [Preorder β] {f : α → β} (hf : Directed (· ≤ ·) f)

theorem sequence_mono : Monotone (f ∘ hf.sequence f) :=
  monotone_nat_of_le_succ <| hf.sequence_mono_nat
#align directed.sequence_mono Directed.sequence_mono

theorem le_sequence (a : α) : f a ≤ f (hf.sequence f (encode a + 1)) :=
  hf.rel_sequence a
#align directed.le_sequence Directed.le_sequence

end Directed

section Quotient

open Encodable Quotient

variable {α : Type _} {s : Setoid α} [@DecidableRel α (· ≈ ·)] [Encodable α]

/-- Representative of an equivalence class. This is a computable version of `quot.out` for a setoid
on an encodable type. -/
def Quotient.rep (q : Quotient s) : α :=
  choose (exists_rep q)
#align quotient.rep Quotient.rep

theorem Quotient.rep_spec (q : Quotient s) : ⟦q.rep⟧ = q :=
  choose_spec (exists_rep q)
#align quotient.rep_spec Quotient.rep_spec

/-- The quotient of an encodable space by a decidable equivalence relation is encodable. -/
def encodableQuotient : Encodable (Quotient s) :=
  ⟨fun q => encode q.rep, fun n => Quotient.mk'' <$> decode n, by
    rintro ⟨l⟩ ; dsimp ; rw [encodek] ; exact congr_arg some ⟦l⟧.rep_spec⟩
#align encodable_quotient encodableQuotient

end Quotient


import mynat.definition -- Imports the natural numbers.
import mynat.add -- imports addition.
namespace mynat -- hide

/- Axiom : add_zero (a : mynat) :
a + 0 = a
-/

/- Axiom : add_succ (a b : mynat) :
a + succ(b) = succ(a + b)
-/

/- Tactic : induction

## Summary

if `n : mynat` is in our assumptions, then `induction n with d hd`
attempts to prove the goal by induction on `n`, with the inductive
assumption in the `succ` case being `hd`.

## Details

If you have a natural number `n : mynat` in your context
(above the `⊢`) then `induction n with d hd` turns your
goal into two goals, a base case with `n = 0` and
an inductive step where `hd` is a proof of the `n = d`
case and your goal is the `n = succ(d)` case.

### Example:
If this is our local context:
```
n : mynat
⊢ 2 * n = n + n
```

then

`induction n with d hd`

will give us two goals:

```
⊢ 2 * 0 = 0 + 0
```

and
```
d : mynat,
hd : 2 * d = d + d
⊢ 2 * succ d = succ d + succ d
```

-/

/-
# Addition World.

Welcome to Addition World. If you've done all four levels in tutorial world
and know about `rw` and `refl`, then you're in the right place. Here's
a reminder of the things you're now equipped with which we'll need in this world.

## Data:

  * a type called `mynat`
  * a term `0 : mynat`, interpreted as the number zero.
  * a function `succ : mynat → mynat`, with `succ n` interpreted as "the number after `n`".
  * Usual numerical notation 0,1,2 etc (although 2 onwards will be of no use to us until much later ;-) ).
  * Addition (with notation `a + b`).

## Theorems:

  * `add_zero (a : mynat) : a + 0 = a`. Use with `rw add_zero`.
  * `add_succ (a b : mynat) : a + succ(b) = succ(a + b)`. Use with `rw add_succ`.
  * The principle of mathematical induction. Use with `induction` (see below)

## Tactics:

  * `refl` :  proves goals of the form `X = X`
  * `rw h` : if h is a proof of `A = B`, changes all A's in the goal to B's.
  * `induction n with d hd` : we're going to learn this right now.

# Important thing:

This is a *really* good time to check you understand about the box on the left with the drop down
menus. All the theorems and all the tactics above are documented there. You can find
all you need to know about what theorems you have collected in Theorem statements -> Addition world.
Have a click around and check that you can find statements of the theorems above, and explanations of
the tactics above. As we go through the game, these lists will grow. The box on the left
will prove invaluable as the number of theorems we prove gets bigger. On the other hand,
we only need to learn one more tactic to really start going places, so let's learn about
that tactic right now.

## Level 1: the `induction` tactic.

OK so let's see induction in action. We're going to prove

  `zero_add (n : mynat) : 0 + n = n`.

That is: for all natural numbers $n$, $0+n=n$. Wait $-$ what is going on here?
Didn't we already prove that adding zero to $n$ gave us $n$?
No we didn't! We proved $n + 0 = n$, and that proof was called `add_zero`. We're now
trying to establish `zero_add`, the proof that $0 + n = n$. But aren't these two theorems
the same? No they're not! It is *true* that `x + y = y + x`, but we haven't
*proved* it yet, and in fact we will need both `add_zero` and `zero_add` in order
to prove this. In fact `x + y = y + x` is the boss level for addition world,
and `induction` is the only other tactic you'll need to beat it.

Now `add_zero` is one of Peano's axioms, so we don't need to prove it, we already have it
(indeed, if you've opened the Addition World theorem statements on the left, you can even see it).
To prove `0 + n = n` we need to use induction on $n$. While we're here,
  note that `zero_add` is about zero add something, and `add_zero` is about something add zero.
  The names of the proofs tell you what the theorems are. Anyway, let's prove `0 + n = n`.

  Delete `sorry` and replace it with `induction n with d hd,`
and **don't forget the comma**. Hit enter, wait for Lean to finish thinking,
and let's see what we have.

When Lean has finished thinking, we see that we now have *two goals*! The
induction tactic has generated for us a base case with `n = 0` (the goal at the top)
and an inductive step (the goal underneath). The golden rule: **Tactics operate on the first goal** --
the goal at the top. So let's just worry about that top goal now, the base case `⊢ 0 + 0 = 0`.

Remember that `add_zero` (the proof we have already) is the proof of `x + 0 = x`
(for any $x$) so we can try

`rw add_zero,`

. What do you think the goal will
change to? Remember to just keep
focussing on the top goal, ignore the other one for now, it's not changing
and we're not working on it. You should be able to solve the top goal yourself
now with `refl`.

When you solved this base case goal, we are now be back down
to one goal -- the inductive step. Take a look at the
text below the lemma to see an explanation of this goal.
-/

/- Lemma
For all natural numbers $n$, we have
$$0 + n = n.$$
-/
lemma zero_add (n : mynat) : 0 + n = n :=
begin [nat_num_game]
  induction n with d hd,
    rw add_zero,
    refl,
  rw add_succ,
  rw hd,
  refl

end

/-
We're in the successor case, and your top right box should look
something like this:

```
case mynat.succ
d : mynat,
hd : 0 + d = d
⊢ 0 + succ d = succ d
```

*Important:* make sure that you only have one goal at this point. You
should have proved `0 + 0 = 0` by now. Tactics only operate on the top goal.

The first line just reminds us we're doing the inductive step.
We have a fixed natural number `d`, and the inductive hypothesis `hd : 0 + d = d`
saying that we have a proof of `0 + d = d`.
Our goal is to prove `0 + succ d = succ d`. In words, we're showing that
if the lemma is true for `d`, then it's also true for the number after `d`.
That's the inductive step. Once we've proved this inductive step, we will have proved
`zero_add` by the principle of mathematical induction.

To prove our goal, we need to use `add_succ`. We know that `add_succ 0 d`
is the result that `0 + succ d = succ (0 + d)`, so the first thing
we need to do is to replace the left hand side `0 + succ d` of our
goal with the right hand side. We do this with the `rw` command. You can write

`rw add_succ,`

(or even `rw add_succ 0 d,` if you want to give Lean all the inputs instead of making it
figure them out itself). Don't forget the comma though. Hit enter. The goal should change to

`⊢ succ (0 + d) = succ d`

Now remember our inductive hypothesis `hd : 0 + d = d`. We need
to rewrite this too! Type

`rw hd,`

(don't forget the comma). The goal will now change to

`⊢ succ d = succ d`

This goal can be solved with the `refl` tactic. After you apply it,
Lean will inform you that there are no goals left. You are done!

## Now venture off on your own.

Those three tactics --

* `induction n with d hd,`
* `rw h,`
* `refl,`

will get you quite a long way through this game. Using only these tactics
you can beat Addition World level 4 (the boss level of Addition World),
all of Multiplication World including the boss level `a * b = b * a`,
and even all of Power World including the fiendish final boss. This route will
give you a good grounding in these three basic tactics; after that, if you
are still interested, there are other worlds to master, where you can learn
more tactics.

But we're getting ahead of ourselves, you still have to beat the rest of Addition World.
We're going to stop explaining stuff carefully now. If you get stuck or want
to know more about Lean (e.g. how to do much harder maths in Lean),
ask in `#new members` at
the Lean chat
(login required, real name preferred). Kevin or Mohammad or one of the other
people there might be able to help.

Good luck! Click on "next level" to solve some levels on your own.

-/

end mynat -- hide


import data.real.basic
import tactic

-- maybe try this? suggested by Leo
/-
class geometry :=
(line : Type)
(point : Type)
-/

-- variables {P L : Type} (p q r : P) (l m n : L)

-- A notion of a line going throuhg a point. The very closely-related notion of parallel lines is also defined
class has_goes_thru (line point : Type):=
(goes_thru : line → point → Prop)

open has_goes_thru

-- the idea of parallel lines is tied to Euclid's axioms
def parallel {line : Type} (point : Type) [inst : has_goes_thru line point] (l m : line) : Prop := (l = m) ∨ ∀ p : point, ¬(goes_thru l p ∧ goes_thru m p)

class has_euclid_post5 (line point : Type) extends has_goes_thru line point :=
(euclid_post5 : ∀ (l : line) (p: point), ∃! (m : line), parallel point l m ∧ goes_thru m p)

open has_euclid_post5

section
variables {line : Type} (point: Type) [has_goes_thru line point] (l m n : line)

theorem parallel_refl : parallel point l l := begin
  left, refl,
end

theorem parallel_symm : parallel point l m ↔ parallel point m l := begin
  split; intro h; cases h,
  left,exact h.symm,
  right,
  intros p f, specialize h p, exact h ⟨f.2, f.1⟩,
  left, exact h.symm,
  right,
  intros p f, specialize h p, exact h ⟨f.2, f.1⟩,
end

theorem parallel_trans : parallel point l m → parallel point m n → parallel point l n := begin
  intros plm pmn,
  cases plm; cases pmn,
  left,
  rwa plm,
  right,
  rwa plm,
  right,
  rwa ←pmn,
  sorry, -- we need Euclid's 5th postulate
end
end

-- theorem parallel_refl {line : Type} (point: Type) [inst : has_goes_thru line point] (l m : line)

-- variables [has_goes_thru L P]

-- parallel lines are those which do not intersect

#check parallel
#check goes_thru
#check exists_unique

-- Euclid's fifth postulate

-- A notion of distance obeying basic laws.
class has_distance (point : Type) :=
(distance : point → point → ℝ)
(distance_nonnegative : ∀ p q : point, distance p q ≥ 0)
(distance_zero_iff_eq : ∀ p q : point, distance p q = 0 ↔ p = q)
(distance_comm : ∀ p q : point, distance p q = distance q p)
(distance_add: ∀ p q r : point, distance p q + distance q r ≥ distance p r)

open has_distance

-- a notion of "between" for points.
-- TODO depend on has_goes_thru since a point can only be between two collinear points
-- TODO move to axioms
class between (point : Type) :=
(between : point → point → point → Prop)
(between_comm : ∀ p q r : point, between p q r ↔ between r q p)
(one_between : ∀ p q r: point, ¬(between p q r ∧ between q p r))

-- basic notions that geometry should support
-- the first point is between the others

-- I'd like a way to use this in the geometry class
-- def goes_thru2 : Prop := goes_thru l p ∧ goes_thru l q

-- there is a line through any two points. If those points are different, that line is unique.
-- (line_thru_pts : ∀ p q : point, ∃ l : line, goes_thru l p ∧ goes_thru l q)
-- (uniq_line_thru_pts : ∀ (p q : point) (l m : line), goes_thru l p ∧ goes_thru l q ∧ goes_thru m p ∧ goes_thru l q → p = q ∨ l = m)

-- one point is between the two others


import data.finset

universes u

open finset

variables {α : Type u} [decidable_eq α] -- need decidability for set difference

def independent (ℐ : finset (finset α)) (I₁ I₂ : finset α) (h₁ : I₁ ∈ ℐ) (h₂ : I₂ ∈ ℐ) : Prop :=
  finset.card I₁ < finset.card I₂ → ∃ (e ∈ I₂ \ I₁), (insert e I₁ ∈ ℐ)
-- how should i define this?

def independent' (ℐ : finset α → Prop) : Prop :=
∀ I₁ I₂, ℐ I₁ ∧ ℐ I₂ → finset.card I₁ < finset.card I₂ → ∃ (e ∈ I₂ \ I₁), (ℐ (insert e I₁))

def independent_collection (ℐ : finset (finset α)) : Prop :=
  ∀ (I₁ I₂ : finset α) (h₁ : I₁ ∈ ℐ) (h₂ : I₂ ∈ ℐ), independent ℐ I₁ I₂ h₁ h₂
-- don't love that

lemma subset_independent (ℐ ℐ': finset (finset α)) (hi : independent_collection ℐ) :
  ℐ' ⊆ ℐ → independent_collection ℐ' :=
begin
  intros h,
  rw independent_collection,
  intros I₁ I₂ h₁ h₂,
  rw independent_collection at hi,
  --rw subset_iff at h,
  have h1' := h h₁,
  have h2' := h h₂,
  specialize hi I₁ I₂ h1' h2',
  --exact hi,
  sorry,
end

/- A matroid M is an ordered pair `(E, ℐ)` consisting of a finite set `E` and
a collection `ℐ` of subsets of `E` having the following three properties:
  (I1) `∅ ∈ ℐ`.
  (I2) If `I ∈ ℐ` and `I' ⊆ I`, then `I' ∈ ℐ`.
  (I3) If `I₁` and `I₂` are in `I` and `|I₁| < |I₂|`, then there is an element `e` of `I₂ − I₁`
    such that `I₁ ∪ {e} ∈ I`.-/
structure matroid (E : finset α) (ℐ : finset (finset α)) :=
(subsets : ∀ (I ∈ ℐ), I ⊆ E)
(empty : ∅ ∈ ℐ) -- (I1)
(hereditary : ∀ (I₁ ∈ ℐ), ∀ (I₂ : finset α), I₂ ⊆ I₁ → I₂ ∈ ℐ) -- (I2)
(ind : independent_collection ℐ) -- (I3)

/- A subset of `E` that is not in `ℐ` is called dependent. -/
-- is this something that merits a separate definition?
def dependent_sets (E : finset α) (ℐ : finset (finset α)) : finset (finset α) := E.powerset \ ℐ

variables {E : finset α} {ℐ : finset (finset α)}
variables [decidable_pred (λ (D : finset α), independent_collection (erase D.powerset D))]
-- figure out where this needs to go later

namespace matroid

def circuit (M : matroid E ℐ) : finset (finset α) :=
  filter (λ (D : finset α), independent_collection (erase D.powerset D)) (dependent_sets E ℐ)

-- we're not defining n-circuits lmao

@[simp]
lemma mem_circuit (M : matroid E ℐ) (C₁ : finset α) :
  C₁ ∈ M.circuit ↔ C₁ ∈ dependent_sets E ℐ ∧ independent_collection (erase C₁.powerset C₁) :=
begin
  rw circuit,
  rw mem_filter,
end

/- `(C1)` ∅ ∉ C  -/
lemma empty_notmem_circuit (M : matroid E ℐ) : ∅ ∉ M.circuit :=
begin
  -- this is just due to the fact that ∅ ∈ ℐ lol
  unfold matroid.circuit,
  unfold dependent_sets,
  rw mem_filter,
  rw and_comm,
  push_neg,
  intros h,
  simp,
  exact M.empty,
end

/- `(C2)` if C₁ and C₂ are members of C and C₁ ⊆ C₂, then C₂ = C₂.
In other words, C forms an antichain. -/
lemma circuit_antichain (M : matroid E ℐ) (C₁ C₂ : finset α) (h₁ : C₁ ∈ M.circuit) (h₂ : C₂ ∈ M.circuit) :
  C₁ ⊆ C₂ → C₁ = C₂ :=
begin
  -- this is because the proper subsets are independent and therefore not in M.circuit
  intros h,
  rw mem_circuit at h₂,
  by_contra h2,
  have h3 : C₁ ∈ powerset C₂,
  { exact finset.mem_powerset.2 h },
  have h4 : C₁ ∈ C₂.powerset.erase C₂,
  { rw mem_erase,
    simp,
    exact ⟨h2, h⟩ },
  have h5 : C₁ ⊂ C₂,
  { sorry },

  sorry,
end

end matroid


theorem tst0 {p q : Prop } (h : p ∨ q) : q ∨ p :=
by {
  induction h;
  { apply Or.inr; assumption };
  { apply Or.inl; assumption }
}

theorem tst0' {p q : Prop } (h : p ∨ q) : q ∨ p := by
induction h
focus
  apply Or.inr
  assumption
focus
  apply Or.inl
  assumption

theorem tst1 {p q : Prop } (h : p ∨ q) : q ∨ p := by
induction h with
| inr h2 => exact Or.inl h2
| inl h1 => exact Or.inr h1

theorem tst6 {p q : Prop } (h : p ∨ q) : q ∨ p :=
by {
  cases h with
  | inr h2 => exact Or.inl h2
  | inl h1 => exact Or.inr h1
}

theorem tst7 {α : Type} (xs : List α) (h : (a : α) → (as : List α) → xs ≠ a :: as) : xs = [] :=
by {
  induction xs with
  | nil          => exact rfl
  | cons z zs ih => exact absurd rfl (h z zs)
}

theorem tst8 {α : Type} (xs : List α) (h : (a : α) → (as : List α) → xs ≠ a :: as) : xs = [] := by {
  induction xs;
  exact rfl;
  exact absurd rfl $ h _ _
}

theorem tst9 {α : Type} (xs : List α) (h : (a : α) → (as : List α) → xs ≠ a :: as) : xs = [] := by
  cases xs with
     | nil       => exact rfl
     | cons z zs => exact absurd rfl (h z zs)

theorem tst10 {p q : Prop } (h₁ : p ↔ q) (h₂ : p) : q := by
  induction h₁ with
  | intro h _ => exact h h₂

def Iff2 (m p q : Prop) := p ↔ q

theorem tst11 {p q r : Prop } (h₁ : Iff2 r p q) (h₂ : p) : q := by
  induction h₁ using Iff.rec with
  | intro h _ => exact h h₂

theorem tst12 {p q : Prop } (h₁ : p ∨ q) (h₂ : p ↔ q) (h₃ : p) : q := by
  failIfSuccess induction h₁ using Iff.casesOn
  induction h₂ using Iff.casesOn with
  | intro h _ =>
    exact h h₃

inductive Tree
  | leaf₁
  | leaf₂
  | node : Tree → Tree → Tree

def Tree.isLeaf₁ : Tree → Bool
  | leaf₁ => true
  | _     => false

theorem tst13 (x : Tree) (h : x = Tree.leaf₁) : x.isLeaf₁ = true := by
  cases x with
  | leaf₁ => rfl
  | _     => injection h

theorem tst14 (x : Tree) (h : x = Tree.leaf₁) : x.isLeaf₁ = true := by
  induction x with
  | leaf₁ => rfl
  | _     => injection h

inductive Vec (α : Type) : Nat → Type
  | nil  : Vec α 0
  | cons : (a : α) → {n : Nat} → (as : Vec α n) → Vec α (n+1)

def getHeads {α β} {n} (xs : Vec α (n+1)) (ys : Vec β (n+1)) : α × β := by
  cases xs
  cases ys
  apply Prod.mk
  repeat
    traceState
    assumption
  done

theorem ex1 (n m o : Nat) : n = m + 0 → m = o → m = o := by
  intro (h₁ : n = m) h₂
  rw [← h₁, ← h₂]
  assumption