/- ------------------------------------------------------------------------- -|
| @project: riemann_hypothesis                                                |
| @file:    basic.lean                                                        |
| @author:  Brandon H. Gomes and Alex Kontorovich                                                 |
| @affil:   Rutgers University                                                |
|- ------------------------------------------------------------------------- -/

/-!
-/

namespace riemann_hypothesis --——————————————————————————————————————————————————————————--
variables {α : Type*} {β : Type*}

/--
-/
def const (b : β)
    := λ _ : α, b
notation `↓`:max b:max := const b

section pointwise_classes --—————————————————————————————————————————————————————————————--

/--
-/
instance pointwise.has_le [has_le β] : has_le (α → β)
    := ⟨λ f g, Π x, f x ≤ g x⟩

/--
-/
instance pointwise.has_zero [has_zero β] : has_zero (α → β)
    := ⟨↓0⟩

end pointwise_classes --—————————————————————————————————————————————————————————————————--

namespace algebra --—————————————————————————————————————————————————————————————————————--
variables (α) (β)

/--
-/
class has_left_add_distributivity [has_add α] [has_mul α]
    := (eq : Π x y z : α, x * (y + z) = x * y + x * z)

/--
-/
class has_right_add_distributivity [has_add α] [has_mul α]
    := (eq : Π x y z : α, (y + z) * x = y * x + z * x)

/--
-/
class has_left_sub_distributivity [has_sub α] [has_mul α]
    := (eq : Π x y z : α, x * (y - z) = x * y - x * z)

/--
-/
class has_right_sub_distributivity [has_sub α] [has_mul α]
    := (eq : Π x y z : α, (y - z) * x = y * x - z * x)

/--
-/
class has_lift_add_comm [has_lift_t α β] [has_add α] [has_add β]
    := (eq : Π x y : α, (↑(x + y) : β) = ↑x + ↑y)

/--
-/
class has_lift_sub_comm [has_lift_t α β] [has_sub α] [has_sub β]
    := (eq : Π x y : α, (↑(x - y) : β) = ↑x - ↑y)

/--
-/
class has_lift_mul_comm [has_lift_t α β] [has_mul α] [has_mul β]
    := (eq : Π x y : α, (↑(x * y) : β) = ↑x * ↑y)

/--
-/
class has_lift_inv_comm [has_lift_t α β] [has_inv α] [has_inv β]
    := (eq : Π a : α, (↑(a⁻¹) : β) = (↑a)⁻¹)

/--
-/
class has_right_unit [has_one α] [has_mul α]
    := (eq : Π a : α, a * 1 = a)

/--
-/
class has_left_unit [has_one α] [has_mul α]
    := (eq : Π a : α, 1 * a = a)

/--
-/
class has_add_le_add [has_le α] [has_add α]
    := (le : Π {a b c d : α}, a ≤ b → c ≤ d → a + c ≤ b + d)

/--
-/
class has_add_lt_add [has_lt α] [has_add α]
    := (lt : Π {a b c d : α}, a < b → c < d → a + c < b + d)

/--
-/
class has_le_add_of_nonneg_of_le [has_le α] [has_zero α] [has_add α]
    := (le : Π {a b c : α}, 0 ≤ a → b ≤ c → b ≤ a + c)

/--
-/
class has_lt_add_of_le_of_pos [has_le α] [has_lt α] [has_zero α] [has_add α]
    := (lt : Π {a b c : α}, 0 < a → b ≤ c → b < a + c)

/--
-/
class has_add_nonneg [has_le α] [has_zero α] [has_add α]
    := (le : Π {a b : α}, 0 ≤ a → 0 ≤ b → 0 ≤ a + b)

/--
-/
class has_zero_mul_is_zero [has_zero α] [has_mul α]
    := (eq : Π a : α, 0 * a = 0)

/--
-/
class has_mul_zero_is_zero [has_zero α] [has_mul α]
    := (eq : Π a : α, a * 0 = 0)

/--
-/
class has_lift_zero_same [has_lift_t α β] [has_zero α] [has_zero β]
    := (eq : ↑(0 : α) = (0 : β))

/--
-/
class has_lift_one_same [has_lift_t α β] [has_one α] [has_one β]
    := (eq : ↑(1 : α) = (1 : β))

/--
-/
class has_zero_right_add_cancel [has_zero α] [has_add α]
    := (eq : Π a : α, a + 0 = a)

/--
-/
class has_zero_left_add_cancel [has_zero α] [has_add α]
    := (eq : Π a : α, 0 + a = a)

/--
-/
class has_sub_self_is_zero [has_zero α] [has_sub α]
    := (eq : Π a : α, a - a = 0)

/--
-/
class has_mul_assoc [has_mul α]
    := (eq : Π a b c : α, (a * b) * c = a * (b * c))

/--
-/
class has_add_sub_assoc [has_add α] [has_sub α]
    := (eq : Π a b c : α, (a + b) - c = a + (b - c))

/--
-/
class has_le_sub_add_le [has_le α] [has_sub α] [has_add α]
    := (le : Π {a b c : α}, a ≤ c - b → a + b ≤ c)

/--
-/
class has_le_pos_mul_preserves_right [has_lt α] [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b c : α}, 0 < c → a ≤ b → a * c ≤ b * c)

/--
-/
class has_le_pos_mul_preserves_left [has_lt α] [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b c : α}, 0 < c → a ≤ b → c * a ≤ c * b)

/--
-/
class has_lt_pos_mul_preserves_right [has_lt α] [has_zero α] [has_mul α]
    := (lt : Π {a b c : α}, 0 < c → a < b → a * c < b * c)

/--
-/
class has_le_nonneg_mul_preserves_left [has_lt α] [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b c : α}, 0 ≤ c → a ≤ b → c * a ≤ c * b)

/--
-/
class has_le_nonneg_mul_preserves_right [has_lt α] [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b c : α}, 0 ≤ c → a ≤ b → a * c ≤ b * c)

/--
-/
class has_lift_le_comm [has_lift_t α β] [has_le α] [has_le β]
    := (le : Π {x y : α}, x ≤ y → ↑x ≤ (↑y : β))

/--
-/
class has_lift_lt_comm [has_lift_t α β] [has_lt α] [has_lt β]
    := (lt : Π {x y : α}, x < y → ↑x < (↑y : β))

/--
-/
class has_lift_ne_comm [has_lift_t α β]
    := (ne : Π {x y : α}, x ≠ y → ↑x ≠ (↑y : β))

/--
-/
class has_sub_add_sub_cancel [has_sub α] [has_add α]
    := (eq : Π a b c : α, a - b + (b - c) = a - c)

/--
-/
class has_double_sub_cancel [has_sub α]
    := (eq : Π a b : α, a - (a - b) = b)

/--
-/
class has_inv_mul_right_cancel_self [has_zero α] [has_one α] [has_inv α] [has_mul α]
    := (eq : Π a : α, a ≠ 0 → a * a⁻¹ = 1)

/--
-/
class has_inv_mul_left_cancel_self [has_zero α] [has_one α] [has_inv α] [has_mul α]
    := (eq : Π a : α, a ≠ 0 → a⁻¹ * a = 1)

/--
-/
class has_add_sub_exchange [has_add α] [has_sub α]
    := (eq : Π a b c d : α, (a - b) + (c - d) = (c - b) + (a - d))

/--
-/
class has_zero_sub_is_neg [has_zero α] [has_neg α] [has_sub α]
    := (eq : Π a : α, 0 - a = -a)

/--
-/
class has_inv_right_mul_lt_pos [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < b → a < c * b → a * b⁻¹ < c)

/--
-/
class has_right_mul_inv_lt_pos [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < b → c < b⁻¹ * a → b * c < a)

/--
-/
class has_left_mul_inv_lt_pos [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < b → c < a * b⁻¹ → c * b < a)

/--
-/
class has_left_mul_inv_lt_neg [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, b < 0 → a * b⁻¹ < c → b * c < a)

/--
-/
class has_sub_ne_zero_of_ne [has_zero α] [has_sub α]
    := (ne : Π {a b : α}, a ≠ b → a - b ≠ 0)

/--
-/
class has_lt_sub_neg [has_lt α] [has_zero α] [has_sub α]
    := (lt : Π {a b : α}, a < b → a - b < 0)

/--
-/
class has_zero_lt_one [has_lt α] [has_zero α] [has_one α]
    := (lt : 0 < (1 : α))

/--
-/
class has_pos_mul_neg_is_neg [has_lt α] [has_zero α] [has_mul α]
    := (lt : Π {a b : α}, 0 < a → b < 0 → a * b < 0)

/--
-/
class has_nonneg_mul_nonneg_is_nonneg [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b : α}, 0 ≤ a → 0 ≤ b → 0 ≤ a * b)

/--
-/
class has_squared_le_monotonic [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b : α}, 0 ≤ a → a ≤ b → a * a ≤ b * b)

/--
-/
class has_sub_pos [has_lt α] [has_zero α] [has_sub α]
    := (lt : Π {a b : α}, a < b → 0 < b - a)

/--
-/
class has_sub_sub [has_add α] [has_sub α]
    := (eq : Π a b c : α, a - (b - c) = (a - b) + c)

/--
-/
class has_add_left_lt [has_lt α] [has_add α]
    := (lt : Π a b c : α, a < b → c + a < c + b)

/--
-/
class has_left_inv_pos_lt [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < c → a < b → c⁻¹ * a < c⁻¹ * b)

/--
-/
class has_right_inv_pos_lt [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < c → a < b → a * c⁻¹ < b * c⁻¹)

/--
-/
class has_mul_pos [has_lt α] [has_zero α] [has_mul α]
    := (lt : Π {a b : α}, 0 < a → 0 < b → 0 < a * b)

/--
-/
class has_inv_pos [has_lt α] [has_zero α] [has_inv α]
    := (lt : Π {a : α}, 0 < a → 0 < a⁻¹)

/--
-/
class has_inv_reverses_le [has_le α] [has_inv α]
    := (le : Π {a b : α}, a ≤ b → b⁻¹ ≤ a⁻¹)

/--
-/
class has_inv_reverses_lt [has_lt α] [has_inv α]
    := (lt : Π {a b : α}, a < b → b⁻¹ < a⁻¹)

/--
-/
class has_inv_mul_reverse [has_inv α] [has_mul α]
    := (eq : Π a b : α, (a * b)⁻¹ = b⁻¹ * a⁻¹)

/--
-/
structure Half [has_lt α] [has_zero α] [has_add α]
    := (map          : α → α)
       (preserve_pos : Π {x}, 0 < x → 0 < map x)
       (doubled_inv  : Π (x), map x + map x = x)

/--
-/
structure LiftCeil [has_lift_t nat α] [has_lt α]
    := (map     : α → nat)
       (lift_lt : Π {a n}, map a < n → a < ↑n)

section lemmas --————————————————————————————————————————————————————————————————————————--
variables {α β}

/--
-/
def inv_sub_inv_lemma
    [has_zero α]
    [has_one α]
    [has_inv α]
    [has_mul α]
    [has_sub α]
    [has_right_unit α]
    [has_left_unit α]
    [has_inv_mul_right_cancel_self α]
    [has_mul_assoc α]
    [has_right_sub_distributivity α]
    {a b : α}
    (a_ne_0 : a ≠ 0)
    : a⁻¹ - b⁻¹ = (1 - b⁻¹ * a) * a⁻¹ :=
    begin
        rw has_right_sub_distributivity.eq,
        rw has_mul_assoc.eq,
        rw has_inv_mul_right_cancel_self.eq _ a_ne_0,
        rw has_left_unit.eq,
        rw has_right_unit.eq,
    end

/--
-/
def inv_sub_inv_lemma'
    [has_zero α]
    [has_one α]
    [has_inv α]
    [has_mul α]
    [has_sub α]
    [has_right_unit α]
    [has_left_unit α]
    [has_inv_mul_left_cancel_self α]
    [has_mul_assoc α]
    [has_left_sub_distributivity α]
    {a b : α}
    (a_ne_0 : a ≠ 0)
    : a⁻¹ - b⁻¹ = a⁻¹ * (1 - a * b⁻¹) :=
    begin
        rw has_left_sub_distributivity.eq,
        rw ← has_mul_assoc.eq,
        rw has_inv_mul_left_cancel_self.eq _ a_ne_0,
        rw has_left_unit.eq,
        rw has_right_unit.eq,
    end

/--
-/
def mul_inv_add_one_lemma
    [has_lift_t nat α]
    [has_zero α]
    [has_one α]
    [has_sub α]
    [has_mul α]
    [has_inv α]
    [has_left_unit α]
    [has_inv_mul_right_cancel_self α]
    [has_right_sub_distributivity α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_sub_comm nat α]
    [has_lift_ne_comm nat α]
    (n : nat)
    : (↑n : α) * (↑n.succ)⁻¹ = 1 - (↑n.succ)⁻¹ :=
    begin
        rw ← has_left_unit.eq (↑n.succ : α)⁻¹,

        have succ_non_zero : ↑n.succ ≠ (0 : α),
            rw (_ : 0 = (↑0 : α)),
            refine has_lift_ne_comm.ne (nat.succ_ne_zero _),
            rw has_lift_zero_same.eq,

        rw ← has_inv_mul_right_cancel_self.eq _ succ_non_zero,
        rw ← has_right_sub_distributivity.eq,
        rw has_inv_mul_right_cancel_self.eq _ succ_non_zero,
        rw has_left_unit.eq,

        rw (_ : 1 = (↑1 : α)),

        rw ← has_lift_sub_comm.eq,
        rw nat.succ_sub_one,
        rw has_lift_one_same.eq,
    end

/--
-/
def two_mul_lemma
    [has_one α]
    [has_add α]
    [has_mul α]
    [has_right_add_distributivity α]
    [has_left_unit α]
    (a : α)
    : 2 * a = a + a :=
    begin
        refine (has_right_add_distributivity.eq _ _ _).trans _,
        rw has_left_unit.eq,
    end

/--
-/
def two_mul_lemma'
    [has_one α]
    [has_add α]
    [has_mul α]
    [has_left_add_distributivity α]
    [has_right_unit α]
    (a : α)
    : a * 2 = a + a :=
    begin
        refine (has_left_add_distributivity.eq _ _ _).trans _,
        rw has_right_unit.eq,
    end

/--
-/
def two_squares_is_four_lemma
    [has_one α]

    [has_add α] [has_mul α]

    [has_left_unit α]

    [has_left_add_distributivity α] [has_right_add_distributivity α]

    [has_mul_assoc α]

    (a : α)

    : 4 * (a * a) = (a + a) * (a + a) :=

    begin
        rw has_left_add_distributivity.eq,
        rw has_right_add_distributivity.eq,
        rw ← two_mul_lemma,
        rw ← two_mul_lemma,
        rw ← has_mul_assoc.eq,
        rw ← has_mul_assoc.eq,
        rw two_mul_lemma,
        rw has_mul_assoc.eq,

        refine rfl,
    end

/--
-/
def two_squares_is_four_lemma'
    [has_one α]

    [has_add α] [has_mul α]

    [has_right_unit α]

    [has_left_add_distributivity α] [has_right_add_distributivity α]

    [has_mul_assoc α]

    (a : α)

    : (a * a) * 4 = (a + a) * (a + a) :=

    begin
        rw has_right_add_distributivity.eq,
        rw has_left_add_distributivity.eq,
        rw ← two_mul_lemma',
        rw ← two_mul_lemma',
        rw has_mul_assoc.eq,
        rw has_mul_assoc.eq,
        rw two_mul_lemma',
        rw has_mul_assoc.eq,

        refine rfl,
    end

/--
-/
def nat_mul_commute_lemma
    [has_zero α]
    [has_one α]
    [has_add α]
    [has_mul α]

    [has_zero_mul_is_zero α]
    [has_mul_zero_is_zero α]

    [has_right_unit α]
    [has_left_unit α]

    [has_left_add_distributivity α]
    [has_right_add_distributivity α]

    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_add_comm nat α]

    (a : α) (n : nat)

    : a * ↑n = ↑n * a :=

    begin
        induction n with n hn,
            rw has_lift_zero_same.eq,
            rw has_zero_mul_is_zero.eq,
            rw has_mul_zero_is_zero.eq,
            rw nat.succ_eq_add_one,
            rw has_lift_add_comm.eq,
            rw has_left_add_distributivity.eq,
            rw has_right_add_distributivity.eq,
            rw hn,
            rw has_lift_one_same.eq,
            rw has_left_unit.eq,
            rw has_right_unit.eq,
    end

section lifted_lemmas --—————————————————————————————————————————————————————————————————--
variables (α β)

/--
-/
def zero_is_lifted_zero_lemma
    [has_zero α] [has_zero β] [has_lift_t α β] [has_lift_zero_same α β]
    : (0 : β) = ↑(0 : α)
    := by rw has_lift_zero_same.eq

--———————————————————————————————————————————————————————————————————————————————————————--
variables [has_one α] [has_one β] [has_lift_t α β] [has_lift_one_same α β]

/--
-/
def one_is_lifted_one_lemma
    : (1 : β) = ↑(1 : α)
    := by rw has_lift_one_same.eq

--———————————————————————————————————————————————————————————————————————————————————————--
variables [has_add α] [has_add β] [has_lift_add_comm α β]

/--
-/
def two_is_lifted_two_lemma : (2 : β) = ↑(2 : α) :=
    begin
        rw (_ : (2 : β) = ↑(1 : α) + ↑(1 : α)),
        rw ← has_lift_add_comm.eq,
        refine rfl,
        rw has_lift_one_same.eq,
        refine rfl,
    end

/--
-/
def three_is_lifted_three_lemma : (3 : β) = ↑(3 : α) :=
    begin
        rw (_ : (3 : β) = ↑(1 : α) + ↑(1 : α) + ↑(1 : α)),
        rw [← has_lift_add_comm.eq, ← has_lift_add_comm.eq],
        refine rfl,
        rw has_lift_one_same.eq,
        refine rfl,
    end

/--
-/
def four_is_lifted_four_lemma : (4 : β) = ↑(4 : α) :=
    begin
        rw (_ : (4 : β) = ↑(1 : α) + ↑(1 : α) + (↑(1 : α) + ↑(1 : α))),
        rw [← has_lift_add_comm.eq, ← has_lift_add_comm.eq],
        refine rfl,
        rw has_lift_one_same.eq,
        refine rfl,
    end

end lifted_lemmas --—————————————————————————————————————————————————————————————————————--
end lemmas --————————————————————————————————————————————————————————————————————————————--
end algebra --———————————————————————————————————————————————————————————————————————————--

open algebra

namespace nat --—————————————————————————————————————————————————————————————————————————--

/--
-/
def of_le_succ {n m : nat} (n_le_m_succ : n ≤ m.succ) : n ≤ m ∨ n = m.succ
    := (lt_or_eq_of_le n_le_m_succ).imp nat.le_of_lt_succ id

/--
-/
def sub_sub_sub_cancel_right {a b c} (c_le_b : c ≤ b) : a - c - (b - c) = a - b
    := by rw [nat.sub_sub, ← nat.add_sub_assoc c_le_b, nat.add_sub_cancel_left]

/--
-/
def le_sub_right_of_add_le {m n k} : m + k ≤ n → m ≤ n - k :=
    begin
        intros h,
        rw ← nat.add_sub_cancel m k,
        refine nat.sub_le_sub_right h _,
    end

/--
-/
def le_sub_left_of_add_le {k m n} (h : k + m ≤ n) : m ≤ n - k
    := le_sub_right_of_add_le (by { rw ← nat.add_comm, refine h })

/--
-/
def le_add_of_sub_le_right {k m n} : n - k ≤ m → n ≤ m + k :=
    begin
        intros h,
        rw ← nat.add_sub_cancel m k at h,
        refine (nat.sub_le_sub_right_iff _ _ _ (nat.le_add_left _ _)).mp h,
    end

/--
-/
def add_lt_add_of_le_of_lt {a b c d} (h₁ : a ≤ b) (h₂ : c < d) : a + c < b + d
    := lt_of_le_of_lt (nat.add_le_add_right h₁ c) (nat.add_lt_add_left h₂ b)

/--
-/
def lt_add_of_le_of_pos {a b c} (b_le_c : b ≤ c) (zero_lt_a : 0 < a) : b < c + a
    := nat.add_zero b ▸ nat.add_lt_add_of_le_of_lt b_le_c zero_lt_a

/--
-/
def neg_right_swap {a b c} (c_le_b : c ≤ b) :  a - (b - c) = (a + c) - b :=
    begin
        rw ← nat.add_sub_cancel a _,
        rw nat.sub_sub_sub_cancel_right c_le_b,
        rw nat.add_sub_assoc (le_refl _),
        rw nat.sub_self,
        rw nat.add_zero,
    end

/--
-/
def sub_mono_left_strict {x y z : nat} (z_le_x : z ≤ x) (x_lt_y : x < y)
    : x - z < y - z :=
    begin
        refine @nat.lt_of_add_lt_add_left z _ _ _,
        rw nat.add_sub_of_le (le_trans z_le_x (le_of_lt x_lt_y)),
        rw nat.add_sub_of_le z_le_x,
        refine x_lt_y,
end

/--
-/
def mul_two (n) : n * 2 = n + n :=
    begin
        refine (nat.left_distrib _ _ _).trans _,
        rw nat.mul_one,
    end

/--
-/
def pow_two_ge_one (n : nat) : 1 ≤ 2 ^ n :=
    begin
        induction n with n hn,
            refine le_refl _,
            refine le_trans hn (nat.le_add_left _ _),
    end

/--
-/
def pow_two_monotonic (n : nat) : 2 ^ n < 2 ^ n.succ
    := lt_add_of_le_of_pos (nat.le_add_left _ _) (pow_two_ge_one _)

/--
-/
def smallest_positive_even (n : nat)
    : 2 ≤ 2 * n.succ :=
    begin
        induction n with n hn,
            rw nat.mul_one,
            refine le_trans hn (nat.le.intro rfl),
    end

/--
-/
def successive_difference (u : nat → nat) (n : nat)
    := u n.succ - u n

/--
-/
def power [has_one α] [has_mul α] (a : α) : nat → α
| (nat.zero  ) := 1
| (nat.succ n) := power n * a

namespace power --———————————————————————————————————————————————————————————————————————--
variables [has_one α] [has_mul α]

/--
-/
def mul_commute
    [has_one β] [has_mul β]
    (map     : α → β)
    (map_one : map 1 = 1)
    (map_mul : Π x y, map (x * y) = map x * map y)
    (a : α) (n)
    : map (power a n) = power (map a) n :=
    begin
        induction n with n hn,
            rw [power, power],
            rw map_one,
            rw [power, power],
            rw map_mul,
            rw hn,
    end

end power --—————————————————————————————————————————————————————————————————————————————--

namespace lift --————————————————————————————————————————————————————————————————————————--
variables (α)

/--
-/
def succ_pos
    [has_lt α]
    [has_zero α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_lt_comm nat α]
    (n : nat)
    : 0 < (↑n.succ : α) :=
    begin
        rw zero_is_lifted_zero_lemma nat α,
        refine has_lift_lt_comm.lt (nat.succ_pos _),
    end

/--
-/
def succ_nonzero
    [preorder α]
    [has_zero α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_lt_comm nat α]
    (n : nat)
    : (↑n.succ : α) ≠ 0
    := (ne_of_gt (nat.lift.succ_pos α _))

/--
-/
def zero_lt_one
    [has_lt α]
    [has_zero α]
    [has_one α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_lt_comm nat α]
    : (0 : α) < 1 :=
    begin
        rw one_is_lifted_one_lemma nat α,
        refine nat.lift.succ_pos α _,
    end

/--
-/
instance zero_lt_one_instance
    [has_lt α]
    [has_zero α]
    [has_one α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_lt_comm nat α]
    : has_zero_lt_one α
    := ⟨zero_lt_one α⟩

end lift --——————————————————————————————————————————————————————————————————————————————--
end nat --———————————————————————————————————————————————————————————————————————————————--

section sequences --—————————————————————————————————————————————————————————————————————--

/--
-/
def strictly_increasing
    [has_lt α]
    (seq : nat → α)
    := Π n, seq n < seq n.succ

/--
-/
def increasing
    [has_le α]
    (seq : nat → α)
    := Π n, seq n ≤ seq n.succ

/--
-/
def strictly_increasing.as_increasing
    [preorder α]
    (seq : nat → α)
    : strictly_increasing seq → increasing seq :=
    begin
        intros sinc _,
        refine le_of_lt (sinc _),
    end

/--
-/
def increasing_strong
    [has_le α]
    (seq : nat → α)
    := Π i j, i ≤ j → seq i ≤ seq j

/--
-/
def increasing.as_increasing_strong
    [preorder α]
    (seq : nat → α)
    : increasing seq → increasing_strong seq :=
    begin
        intros inc i j i_le_j,
        induction j with j hj,
            cases i_le_j,
                refine le_refl _,
            cases nat.of_le_succ i_le_j,
                refine le_trans (hj h) (inc _),
                rw h,
    end

/--
-/
def strictly_increasing.as_increasing_strong
    [preorder α]
    (seq : nat → α)
    : strictly_increasing seq → increasing_strong seq
    := λ s, increasing.as_increasing_strong _ (strictly_increasing.as_increasing _ s)

/--
-/
def non_increasing
    [has_le α]
    (seq : nat → α)
    := Π n, seq (nat.succ n) ≤ seq n

/--
-/
def non_increasing_strong
    [has_le α]
    (seq : nat → α) (k)
    := Π n, seq (n + k) ≤ seq n

/--
-/
def non_increasing.as_non_increasing_strong
    [preorder α]
    (seq : nat → α)
    : non_increasing seq → Π k, non_increasing_strong seq k :=
    begin
        intros noninc k _,
        induction k with k hk,
            refine le_refl _,
            refine le_trans (noninc _) hk,
    end

/--
-/
def strictly_increasing.ge_index
    (seq) (sinc : strictly_increasing seq)
    (k)
    : k ≤ seq k :=
    begin
        induction k with _ hk,
            refine nat.zero_le _,
            rw nat.succ_eq_add_one,
            refine le_trans (nat.add_le_add hk (le_refl _)) (sinc _),
    end

/--
-/
def nonneg_compose_preserve
    [has_zero α] [has_le α]
    (seq : nat → α) (φ : nat → nat)
    : 0 ≤ seq → 0 ≤ seq ∘ φ
    := λ p _, p (φ _)

/--
-/
def translate
    (seq : nat → α)
    (k)
    (n)
    := seq (k + n)

/--
-/
def translate.preserve_nonneg
    [has_zero α] [has_le α]
    (seq : nat → α)
    : 0 ≤ seq → 0 ≤ translate seq
    := λ p _ _, p _

/--
-/
def translate.monotonicity
    [has_le α]
    {a b : nat → α}
    : a ≤ b → translate a ≤ translate b
    := λ p _ _, p _

/--
-/
def translate.combine
    (seq : nat → α)
    (i j)
    : translate (translate seq i) j = translate seq (i + j)
    := funext (λ _, by rw [translate, translate, translate, nat.add_assoc])

/--
-/
def translate.compose_commute
    (seq : nat → α)
    (f : α → β)
    (n k)
    : f (translate seq n k) = translate (f ∘ seq) n k
    := by rw [translate, translate]

/--
-/
def translate.compose_commute.funext
    (seq : nat → α)
    (f : α → β)
    (n)
    : f ∘ (translate seq n) = translate (f ∘ seq) n
    := funext (translate.compose_commute seq f n)

end sequences --—————————————————————————————————————————————————————————————————————————--

section series --————————————————————————————————————————————————————————————————————————--
variables [has_zero α] [has_add α]

/--
-/
def partial_sum (seq : nat → α) : nat → α
| (nat.zero  ) := 0
| (nat.succ n) := seq n + partial_sum n

/--
-/
def partial_sum.preserve_nonneg
    [preorder α] [has_add_nonneg α]

    (seq : nat → α)

    : 0 ≤ seq → 0 ≤ partial_sum seq :=

    begin
        intros nonneg k,
        induction k with k hk,
            refine le_refl _,
            refine has_add_nonneg.le (nonneg _) hk,
    end

/--
-/
def partial_sum.left_mul_commute
    [has_mul α] [has_mul_zero_is_zero α] [has_left_add_distributivity α]
    (seq : nat → α)
    (C)
    : partial_sum (λ k, C * seq k) = λ n, C * partial_sum seq n :=
    begin
        refine funext _,
        intros n,
        induction n with n hn,
            rw partial_sum,
            rw partial_sum,
            rw has_mul_zero_is_zero.eq,
            rw partial_sum,
            rw partial_sum,
            rw hn,
            rw has_left_add_distributivity.eq,
    end

/--
-/
def partial_sum.right_mul_commute
    [has_mul α] [has_zero_mul_is_zero α] [has_right_add_distributivity α]
    (seq : nat → α)
    (C)
    : partial_sum (λ k, seq k * C) = λ n, partial_sum seq n * C :=
    begin
        refine funext _,
        intros n,
        induction n with n hn,
            rw partial_sum,
            rw partial_sum,
            rw has_zero_mul_is_zero.eq,
            rw partial_sum,
            rw partial_sum,
            rw hn,
            rw has_right_add_distributivity.eq,
    end

/--
-/
def partial_sum.from_mul
    [has_one α]
    [has_mul α]

    [has_zero_mul_is_zero α]
    [has_left_unit α]
    [has_right_add_distributivity α]

    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_add_comm nat α]

    (a : α)
    (n : nat)

    : ↑n * a = partial_sum ↓a n :=

    begin
        induction n with n hn,
            rw partial_sum,
            rw has_lift_zero_same.eq,
            rw has_zero_mul_is_zero.eq,
            rw partial_sum,
            rw nat.succ_eq_add_one,
            rw nat.add_comm,
            rw has_lift_add_comm.eq,
            rw has_right_add_distributivity.eq,
            rw has_lift_one_same.eq,
            rw has_left_unit.eq,
            rw hn,
            rw const,
    end

/--
-/
def partial_sum.from_mul'
    [has_one α]
    [has_mul α]

    [has_mul_zero_is_zero α]
    [has_right_unit α]
    [has_left_add_distributivity α]

    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_add_comm nat α]

    (a : α)
    (n : nat)

    : a * ↑n = partial_sum ↓a n :=

    begin
        induction n with n hn,
            rw partial_sum,
            rw has_lift_zero_same.eq,
            rw has_mul_zero_is_zero.eq,
            rw partial_sum,
            rw nat.succ_eq_add_one,
            rw nat.add_comm,
            rw has_lift_add_comm.eq,
            rw has_left_add_distributivity.eq,
            rw has_lift_one_same.eq,
            rw has_right_unit.eq,
            rw hn,
            rw const,
    end

/--
-/
def partial_sum.monotonicity
    [preorder α] [has_add_le_add α]
    {a b : nat → α}
    : a ≤ b → partial_sum a ≤ partial_sum b :=
    begin
        intros a_le_b n,
        induction n with _ hn,
            refine le_refl _,
            refine has_add_le_add.le (a_le_b _) hn,
    end

/--
-/
def partial_sum.index_monotonicity
    [preorder α] [has_le_add_of_nonneg_of_le α]

    (seq : nat → α) (nonneg : 0 ≤ seq)

    {m n}

    : m ≤ n → partial_sum seq m ≤ partial_sum seq n :=

    begin
        intros m_le_n,
        induction n with n hn,
            cases m_le_n,
                refine le_refl _,
            cases nat.of_le_succ m_le_n,
                refine has_le_add_of_nonneg_of_le.le (nonneg _) (hn h),
                rw ← h,
    end

/--
-/
def partial_sum.double_monotonicity
    [preorder α] [has_le_add_of_nonneg_of_le α] [has_add_le_add α]

    (a : nat → α) (na)
    (b : nat → α) (nb)

    : 0 ≤ a → a ≤ b → na ≤ nb → partial_sum a na ≤ partial_sum b nb :=

    begin
        intros zero_le_a a_le_b na_le_nb,
        induction nb with _ hnb,
            cases na_le_nb,
                refine le_refl _,
            cases nat.of_le_succ na_le_nb,
                refine has_le_add_of_nonneg_of_le.le
                    (le_trans (zero_le_a _) (a_le_b _)) (hnb h),
                rw h,
                refine has_add_le_add.le
                    (a_le_b _) (partial_sum.monotonicity a_le_b _),
    end

/--
-/
def partial_sum.sub_as_translate
    [has_sub α] [has_sub_self_is_zero α] [has_add_sub_assoc α]

    (seq : nat → α)

    {m n} (m_le_n : m ≤ n)

    : partial_sum seq n - partial_sum seq m = partial_sum (translate seq m) (n - m) :=

    begin
        induction n with n hn,
            cases m_le_n,
                refine has_sub_self_is_zero.eq _,
            cases m_le_n with _ m_le_n,
                rw has_sub_self_is_zero.eq,
                rw nat.sub_self,
                rw partial_sum,
                rw partial_sum,
                rw has_add_sub_assoc.eq,
                rw hn m_le_n,
                rw nat.succ_sub m_le_n,
                rw partial_sum,
                rw translate,
                rw nat.add_sub_of_le m_le_n,
    end

/--
-/
def partial_sum.lower_differences.bottom
    [has_sub α]
    [has_add_sub_assoc α]
    [has_sub_self_is_zero α]

    [preorder α]
    [has_le_add_of_nonneg_of_le α]

    (seq : nat → α) (nonneg : 0 ≤ seq)

    {m n} (m_le_n : m ≤ n)

    : 0 ≤ partial_sum seq n - partial_sum seq m :=

    begin
        induction n with n hn,
            cases m_le_n,
                rw has_sub_self_is_zero.eq,
            cases nat.of_le_succ m_le_n,
                rw partial_sum,
                rw has_add_sub_assoc.eq,
                refine has_le_add_of_nonneg_of_le.le (nonneg _) (hn h),
                rw ← h,
                rw has_sub_self_is_zero.eq,
    end

/--
-/
def partial_sum.lower_differences
    [has_sub α]
    [has_sub_self_is_zero α]
    [has_add_sub_assoc α]

    [preorder α]
    [has_add_le_add α]
    [has_le_add_of_nonneg_of_le α]

    (seq : nat → α) (nonneg : 0 ≤ seq)

    {k m n} (k_le_m : k ≤ m) (m_le_n : m ≤ n)

    : partial_sum seq n - partial_sum seq m ≤ partial_sum seq n - partial_sum seq k :=

    begin
        induction n with n hn,
            cases m_le_n,
                cases k_le_m,
                    refine le_refl _,
            cases nat.of_le_succ m_le_n,
                rw partial_sum,
                rw has_add_sub_assoc.eq,
                rw has_add_sub_assoc.eq,
                refine has_add_le_add.le (le_refl _) (hn h),
                rw ← h,
                rw has_sub_self_is_zero.eq,
                refine partial_sum.lower_differences.bottom _ nonneg k_le_m,
    end

--———————————————————————————————————————————————————————————————————————————————————————--
variables [has_sub α]

/--
-/
def shape_sum (seq : nat → α) (φ : nat → nat) (n : nat)
    := partial_sum seq (φ n.succ) - partial_sum seq (φ n)

/--
-/
def shape_sum.unfold
    [has_sub_self_is_zero α]
    [has_add_sub_assoc α]
    [has_sub_add_sub_cancel α]

    (seq : nat → α)

    (φ) (sinc_φ : strictly_increasing φ)

    {m n} (m_le_n : m ≤ n)

    : partial_sum (translate (shape_sum seq φ) m) (n - m)
    = partial_sum (translate seq (φ m)) (φ n - φ m) :=

    begin
        let strong_inc := strictly_increasing.as_increasing_strong _ sinc_φ,
        induction n with n hn,
            cases m_le_n,
                rw [nat.sub_self, nat.sub_self, partial_sum, partial_sum],
            cases nat.of_le_succ m_le_n,
                rw nat.succ_sub h,
                rw partial_sum,
                rw hn h,
                rw translate,
                rw nat.add_sub_of_le h,
                rw shape_sum,
                rw ← partial_sum.sub_as_translate seq (strong_inc _ _ h),
                rw ← partial_sum.sub_as_translate seq (strong_inc _ _ m_le_n),
                rw has_sub_add_sub_cancel.eq,
                rw h,
                rw [nat.sub_self, nat.sub_self, partial_sum, partial_sum],
    end

end series --————————————————————————————————————————————————————————————————————————————--

section absolute_value --————————————————————————————————————————————————————————————————--
variables [has_zero α] [has_add α]

/--
-/
def triangle_inequality
    [has_zero β] [has_add β] [preorder β] [has_add_le_add β]

    (abs          : α → β)
    (abs_zero     : abs 0 = 0)
    (abs_triangle : Π x y, abs (x + y) ≤ abs x + abs y)

    (seq) (n)

    : abs (partial_sum seq n) ≤ partial_sum (abs ∘ seq) n :=

    begin
        induction n with _ hn,
            rw [partial_sum, partial_sum],
            rw abs_zero,
            refine le_trans (abs_triangle _ _) (has_add_le_add.le (le_refl _) hn),
    end

/--
-/
def triangle_equality
    [preorder α] [has_add_nonneg α]

    (abs           : α → α)
    (nonneg_to_abs : Π z, 0 ≤ z → abs z = z)

    (seq nonneg) (n)

    : abs (partial_sum seq n) = partial_sum seq n

    := nonneg_to_abs _ (partial_sum.preserve_nonneg _ nonneg _)

end absolute_value --————————————————————————————————————————————————————————————————————--

end riemann_hypothesis --————————————————————————————————————————————————————————————————--


/-
Copyright (c) 2020 Thomas Browning and Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning and Patrick Lutz
-/

import field_theory.adjoin
import field_theory.separable
import linear_algebra.free_module
import ring_theory.power_basis

/-!
# Primitive Element Theorem

In this file we prove the primitive element theorem.

## Main results

- `exists_primitive_element`: a finite separable extension `E / F` has a primitive element, i.e.
  there is an `α : E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.
- `power_basis_of_finite_of_separable`: a finite separable extension `E / F` has a power basis

## Implementation notes

In declaration names, `primitive_element` abbreviates `adjoin_simple_eq_top`:
it stands for the statement `F⟮α⟯ = (⊤ : subalgebra F E)`. We did not add an extra
declaration `is_primitive_element F α := F⟮α⟯ = (⊤ : subalgebra F E)` because this
requires more unfolding without much obvious benefit.

## Tags

primitive element, separable field extension, separable extension, intermediate field, adjoin, exists_adjoin_simple_eq_top

-/

noncomputable theory
open_locale classical

open finite_dimensional polynomial intermediate_field

namespace field

section primitive_element_finite
variables (F : Type*) [field F] (E : Type*) [field E] [algebra F E]

/-! ### Primitive element theorem for finite fields -/

/-- Primitive element theorem assuming E is finite. -/
lemma exists_primitive_element_of_fintype_top [fintype E] : ∃ α : E, F⟮α⟯ = ⊤ :=
begin
  obtain ⟨α, hα⟩ := is_cyclic.exists_generator (units E),
  use α,
  apply eq_top_iff.mpr,
  rintros x -,
  by_cases hx : x = 0,
  { rw hx,
    exact F⟮α.val⟯.zero_mem },
  { obtain ⟨n, hn⟩ := set.mem_range.mp (hα (units.mk0 x hx)),
    rw (show x = α^n, by { norm_cast, rw [hn, units.coe_mk0] }),
    exact pow_mem F⟮↑α⟯ (mem_adjoin_simple_self F ↑α) n, },
end

/-- Primitive element theorem for finite dimensional extension of a finite field. -/
theorem exists_primitive_element_of_fintype_bot [fintype F] [finite_dimensional F E] :
  ∃ α : E, F⟮α⟯ = ⊤ :=
begin
  haveI : fintype E := fintype_of_fintype F E,
  exact exists_primitive_element_of_fintype_top F E,
end

end primitive_element_finite

/-! ### Primitive element theorem for infinite fields -/

section primitive_element_inf

variables {F : Type*} [field F] [infinite F] {E : Type*} [field E] (ϕ : F →+* E) (α β : E)

lemma primitive_element_inf_aux_exists_c (f g : polynomial F) :
  ∃ c : F, ∀ (α' ∈ (f.map ϕ).roots) (β' ∈ (g.map ϕ).roots), -(α' - α)/(β' - β) ≠ ϕ c :=
begin
  let sf := (f.map ϕ).roots,
  let sg := (g.map ϕ).roots,
  let s := (sf.bind (λ α', sg.map (λ β', -(α' - α) / (β' - β)))).to_finset,
  let s' := s.preimage ϕ (λ x hx y hy h, ϕ.injective h),
  obtain ⟨c, hc⟩ := infinite.exists_not_mem_finset s',
  simp_rw [finset.mem_preimage, multiset.mem_to_finset, multiset.mem_bind, multiset.mem_map] at hc,
  push_neg at hc,
  exact ⟨c, hc⟩,
end

variables [algebra F E]

section

variables (F)

-- This is the heart of the proof of the primitive element theorem. It shows that if `F` is
-- infinite and `α` and `β` are separable over `F` then `F⟮α, β⟯` is generated by a single element.
lemma primitive_element_inf_aux [is_separable F E] :
  ∃ γ : E, F⟮α, β⟯ = F⟮γ⟯ :=
begin
  have hα := is_separable.is_integral F α,
  have hβ := is_separable.is_integral F β,
  let f := minpoly F α,
  let g := minpoly F β,
  let ιFE := algebra_map F E,
  let ιEE' := algebra_map E (splitting_field (g.map ιFE)),
  obtain ⟨c, hc⟩ := primitive_element_inf_aux_exists_c (ιEE'.comp ιFE) (ιEE' α) (ιEE' β) f g,
  let γ := α + c • β,
  suffices β_in_Fγ : β ∈ F⟮γ⟯,
  { use γ,
    apply le_antisymm,
    { rw adjoin_le_iff,
      have α_in_Fγ : α ∈ F⟮γ⟯,
      { rw ← add_sub_cancel α (c • β),
        exact F⟮γ⟯.sub_mem (mem_adjoin_simple_self F γ) (F⟮γ⟯.to_subalgebra.smul_mem β_in_Fγ c)},
      exact λ x hx, by cases hx; cases hx; cases hx; assumption },
      { rw adjoin_le_iff,
        change {γ} ⊆ _,
        rw set.singleton_subset_iff,
        have α_in_Fαβ : α ∈ F⟮α, β⟯ := subset_adjoin F {α, β} (set.mem_insert α {β}),
        have β_in_Fαβ : β ∈ F⟮α, β⟯ := subset_adjoin F {α, β} (set.mem_insert_of_mem α rfl),
        exact F⟮α,β⟯.add_mem α_in_Fαβ (F⟮α, β⟯.smul_mem β_in_Fαβ) } },
  let p := euclidean_domain.gcd ((f.map (algebra_map F F⟮γ⟯)).comp
    (C (adjoin_simple.gen F γ) - (C ↑c * X))) (g.map (algebra_map F F⟮γ⟯)),
  let h := euclidean_domain.gcd ((f.map ιFE).comp (C γ - (C (ιFE c) * X))) (g.map ιFE),
  have map_g_ne_zero : g.map ιFE ≠ 0 := map_ne_zero (minpoly.ne_zero hβ),
  have h_ne_zero : h ≠ 0 :=  mt euclidean_domain.gcd_eq_zero_iff.mp
    (not_and.mpr (λ _, map_g_ne_zero)),
  suffices p_linear : p.map (algebra_map F⟮γ⟯ E) = (C h.leading_coeff) * (X - C β),
  { have finale : β = algebra_map F⟮γ⟯ E (-p.coeff 0 / p.coeff 1),
    { rw [ring_hom.map_div, ring_hom.map_neg, ←coeff_map, ←coeff_map, p_linear],
      simp [mul_sub, coeff_C, mul_div_cancel_left β (mt leading_coeff_eq_zero.mp h_ne_zero)] },
    rw finale,
    exact subtype.mem (-p.coeff 0 / p.coeff 1) },
  have h_sep : h.separable := separable_gcd_right _ (separable.map (is_separable.separable F β)),
  have h_root : h.eval β = 0,
  { apply eval_gcd_eq_zero,
    { rw [eval_comp, eval_sub, eval_mul, eval_C, eval_C, eval_X, eval_map, ←aeval_def,
          ←algebra.smul_def, add_sub_cancel, minpoly.aeval] },
    { rw [eval_map, ←aeval_def, minpoly.aeval] } },
  have h_splits : splits ιEE' h := splits_of_splits_gcd_right ιEE' map_g_ne_zero
    (splitting_field.splits _),
  have h_roots : ∀ x ∈ (h.map ιEE').roots, x = ιEE' β,
  { intros x hx,
    rw mem_roots_map h_ne_zero at hx,
    specialize hc ((ιEE' γ) - (ιEE' (ιFE c)) * x) (begin
      have f_root := root_left_of_root_gcd hx,
      rw [eval₂_comp, eval₂_sub, eval₂_mul,eval₂_C, eval₂_C, eval₂_X, eval₂_map] at f_root,
      exact (mem_roots_map (minpoly.ne_zero hα)).mpr f_root,
    end),
    specialize hc x (begin
      rw [mem_roots_map (minpoly.ne_zero hβ), ←eval₂_map],
      exact root_right_of_root_gcd hx,
    end),
    by_contradiction a,
    apply hc,
    apply (div_eq_iff (sub_ne_zero.mpr a)).mpr,
    simp only [algebra.smul_def, ring_hom.map_add, ring_hom.map_mul, ring_hom.comp_apply],
    ring },
  rw ← eq_X_sub_C_of_separable_of_root_eq h_ne_zero h_sep h_root h_splits h_roots,
  transitivity euclidean_domain.gcd (_ : polynomial E) (_ : polynomial E),
  { dsimp only [p],
    convert (gcd_map (algebra_map F⟮γ⟯ E)).symm },
  { simpa [map_comp, map_map, ←is_scalar_tower.algebra_map_eq, h] },
end

end

end primitive_element_inf

variables (F : Type*) [field F] (E : Type*) [field E] [algebra F E]

/-- Primitive element theorem: a finite separable field extension `E` of `F` has a
  primitive element, i.e. there is an `α ∈ E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.-/
theorem exists_primitive_element [finite_dimensional F E] [is_separable F E] :
  ∃ α : E, F⟮α⟯ = ⊤ :=
begin
  by_cases F_finite : nonempty (fintype F),
  { exact nonempty.elim F_finite
    (λ h, by haveI := h; exact exists_primitive_element_of_fintype_bot F E) },
  { let P : intermediate_field F E → Prop := λ K, ∃ α : E, F⟮α⟯ = K,
    have base : P ⊥ := ⟨0, adjoin_zero⟩,
    have ih : ∀ (K : intermediate_field F E) (x : E), P K → P ↑K⟮x⟯,
    { intros K β hK,
      cases hK with α hK,
      rw [←hK, adjoin_simple_adjoin_simple],
      haveI : infinite F := not_nonempty_fintype.mp F_finite,
      cases primitive_element_inf_aux F α β with γ hγ,
      exact ⟨γ, hγ.symm⟩ },
    exact induction_on_adjoin P base ih ⊤ },
end

/-- An algebra equivalence induces an equivalence of power bases.

This definition is used for either direction of `power_basis.congr`.
-/
def power_basis.congr_aux {R A A' : Type*} [comm_ring R] [ring A] [ring A']
  [algebra R A] [algebra R A'] (e : A ≃ₐ[R] A')
  (pb : power_basis R A) : power_basis R A' :=
{ gen := e pb.gen,
  dim := pb.dim,
  is_basis := by { simp only [← e.map_pow],
                   convert linear_equiv.is_basis pb.is_basis e.to_linear_equiv } }

@[ext]
lemma power_basis.ext {R A : Type*} [integral_domain R] [ring A] [algebra R A]
  {pb pb' : power_basis R A} (h : pb.gen = pb'.gen) : pb = pb' :=
begin
  cases pb, cases pb', congr,
  { exact h },
  convert le_antisymm
      (pb'_is_basis.card_le_card_of_linear_independent pb_is_basis.1)
      (pb_is_basis.card_le_card_of_linear_independent pb'_is_basis.1);
    rw fintype.card_fin
end

@[ext]
lemma power_basis.ext_iff {R A : Type*} [integral_domain R] [ring A] [algebra R A]
  {pb pb' : power_basis R A} : pb = pb' ↔ pb.gen = pb'.gen :=
⟨λ h, by rw h, power_basis.ext⟩

/-- An algebra equivalence induces an equivalence of power bases. -/
def power_basis.congr {R A A' : Type*} [integral_domain R] [ring A] [ring A']
  [algebra R A] [algebra R A'] (e : A ≃ₐ[R] A') :
  power_basis R A ≃ power_basis R A' :=
{ to_fun := power_basis.congr_aux e,
  inv_fun := power_basis.congr_aux e.symm,
  left_inv := λ pb, power_basis.ext (e.symm_apply_apply pb.gen),
  right_inv := λ pb, power_basis.ext (e.apply_symm_apply pb.gen) }

/-- Two subalgebras with the same elements are isomorphic as `R`-algebras. -/
def subalgebra.equiv_of_eq {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  {S S' : subalgebra R A} (h : S = S') :
  S ≃ₐ[R] S' :=
{ to_fun := λ x, ⟨x, h ▸ x.2⟩,
  inv_fun := λ x, ⟨x, h.symm ▸ x.2⟩,
  left_inv := λ x, subtype.ext rfl,
  right_inv := λ x, subtype.ext rfl,
  map_mul' := λ x y, subtype.ext rfl,
  map_add' := λ x y, subtype.ext rfl,
  commutes' := λ x, subtype.ext rfl }

/-- Two intermediate fields with the same elements are isomorphic as `R`-algebras. -/
def intermediate_field.equiv_of_eq {K L : Type*} [field K] [field L] [algebra K L]
  {S S' : intermediate_field K L} (h : S = S') :
  S ≃ₐ[K] S' :=
{ to_fun := λ x, ⟨x, h ▸ x.2⟩,
  inv_fun := λ x, ⟨x, h.symm ▸ x.2⟩,
  left_inv := λ x, subtype.ext rfl,
  right_inv := λ x, subtype.ext rfl,
  map_mul' := λ x y, subtype.ext rfl,
  map_add' := λ x y, subtype.ext rfl,
  commutes' := λ x, subtype.ext rfl }

/-- A finite separable extension `E / F` has a power basis given by the primitive element -/
def power_basis_of_finite_of_separable [finite_dimensional F E] [F_sep : is_separable F E] :
  power_basis F E :=
let α := classical.some (exists_primitive_element F E) in
power_basis.congr
  (show F⟮α⟯ ≃ₐ[F] E,
   from (intermediate_field.equiv_of_eq
       (show F⟮α⟯ = ⊤, from classical.some_spec (exists_primitive_element F E))).trans $
    (subalgebra.equiv_of_eq (intermediate_field.top_to_subalgebra)).trans
    algebra.top_equiv)
  (intermediate_field.adjoin.power_basis ((is_algebraic_iff_is_integral _).mp
    (algebra.is_algebraic_of_finite α)))

end field


/-
Copyright (c) 2020 Thomas Browning, Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning, Patrick Lutz
-/

import field_theory.adjoin
import field_theory.separable

/-!
# Primitive Element Theorem

In this file we prove the primitive element theorem.

## Main results

- `exists_primitive_element`: a finite separable extension `E / F` has a primitive element, i.e.
  there is an `α : E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.

## Implementation notes

In declaration names, `primitive_element` abbreviates `adjoin_simple_eq_top`:
it stands for the statement `F⟮α⟯ = (⊤ : subalgebra F E)`. We did not add an extra
declaration `is_primitive_element F α := F⟮α⟯ = (⊤ : subalgebra F E)` because this
requires more unfolding without much obvious benefit.

## Tags

primitive element, separable field extension, separable extension, intermediate field, adjoin,
exists_adjoin_simple_eq_top

-/

noncomputable theory
open_locale classical

open finite_dimensional polynomial intermediate_field

namespace field

section primitive_element_finite
variables (F : Type*) [field F] (E : Type*) [field E] [algebra F E]

/-! ### Primitive element theorem for finite fields -/

/-- Primitive element theorem assuming E is finite. -/
lemma exists_primitive_element_of_fintype_top [fintype E] : ∃ α : E, F⟮α⟯ = ⊤ :=
begin
  obtain ⟨α, hα⟩ := is_cyclic.exists_generator (units E),
  use α,
  apply eq_top_iff.mpr,
  rintros x -,
  by_cases hx : x = 0,
  { rw hx,
    exact F⟮α.val⟯.zero_mem },
  { obtain ⟨n, hn⟩ := set.mem_range.mp (hα (units.mk0 x hx)),
    rw (show x = α^n, by { norm_cast, rw [hn, units.coe_mk0] }),
    exact pow_mem F⟮↑α⟯ (mem_adjoin_simple_self F ↑α) n, },
end

/-- Primitive element theorem for finite dimensional extension of a finite field. -/
theorem exists_primitive_element_of_fintype_bot [fintype F] [finite_dimensional F E] :
  ∃ α : E, F⟮α⟯ = ⊤ :=
begin
  haveI : fintype E := fintype_of_fintype F E,
  exact exists_primitive_element_of_fintype_top F E,
end

end primitive_element_finite

/-! ### Primitive element theorem for infinite fields -/

section primitive_element_inf

variables {F : Type*} [field F] [infinite F] {E : Type*} [field E] (ϕ : F →+* E) (α β : E)

lemma primitive_element_inf_aux_exists_c (f g : polynomial F) :
  ∃ c : F, ∀ (α' ∈ (f.map ϕ).roots) (β' ∈ (g.map ϕ).roots), -(α' - α)/(β' - β) ≠ ϕ c :=
begin
  let sf := (f.map ϕ).roots,
  let sg := (g.map ϕ).roots,
  let s := (sf.bind (λ α', sg.map (λ β', -(α' - α) / (β' - β)))).to_finset,
  let s' := s.preimage ϕ (λ x hx y hy h, ϕ.injective h),
  obtain ⟨c, hc⟩ := infinite.exists_not_mem_finset s',
  simp_rw [finset.mem_preimage, multiset.mem_to_finset, multiset.mem_bind, multiset.mem_map] at hc,
  push_neg at hc,
  exact ⟨c, hc⟩,
end

variables [algebra F E]

-- This is the heart of the proof of the primitive element theorem. It shows that if `F` is
-- infinite and `α` and `β` are separable over `F` then `F⟮α, β⟯` is generated by a single element.
lemma primitive_element_inf_aux (F_sep : is_separable F E) :
  ∃ γ : E, F⟮α, β⟯ = F⟮γ⟯ :=
begin
  have hα := F_sep.is_integral α,
  have hβ := F_sep.is_integral β,
  let f := minpoly F α,
  let g := minpoly F β,
  let ιFE := algebra_map F E,
  let ιEE' := algebra_map E (splitting_field (g.map ιFE)),
  obtain ⟨c, hc⟩ := primitive_element_inf_aux_exists_c (ιEE'.comp ιFE) (ιEE' α) (ιEE' β) f g,
  let γ := α + c • β,
  suffices β_in_Fγ : β ∈ F⟮γ⟯,
  { use γ,
    apply le_antisymm,
    { rw adjoin_le_iff,
      have α_in_Fγ : α ∈ F⟮γ⟯,
      { rw ← add_sub_cancel α (c • β),
        exact F⟮γ⟯.sub_mem (mem_adjoin_simple_self F γ) (F⟮γ⟯.to_subalgebra.smul_mem β_in_Fγ c)},
      exact λ x hx, by cases hx; cases hx; cases hx; assumption },
      { rw adjoin_le_iff,
        change {γ} ⊆ _,
        rw set.singleton_subset_iff,
        have α_in_Fαβ : α ∈ F⟮α, β⟯ := subset_adjoin F {α, β} (set.mem_insert α {β}),
        have β_in_Fαβ : β ∈ F⟮α, β⟯ := subset_adjoin F {α, β} (set.mem_insert_of_mem α rfl),
        exact F⟮α,β⟯.add_mem α_in_Fαβ (F⟮α, β⟯.smul_mem β_in_Fαβ) } },
  let p := euclidean_domain.gcd ((f.map (algebra_map F F⟮γ⟯)).comp
    (C (adjoin_simple.gen F γ) - (C ↑c * X))) (g.map (algebra_map F F⟮γ⟯)),
  let h := euclidean_domain.gcd ((f.map ιFE).comp (C γ - (C (ιFE c) * X))) (g.map ιFE),
  have map_g_ne_zero : g.map ιFE ≠ 0 := map_ne_zero (minpoly.ne_zero hβ),
  have h_ne_zero : h ≠ 0 :=  mt euclidean_domain.gcd_eq_zero_iff.mp
    (not_and.mpr (λ _, map_g_ne_zero)),
  suffices p_linear : p.map (algebra_map F⟮γ⟯ E) = (C h.leading_coeff) * (X - C β),
  { have finale : β = algebra_map F⟮γ⟯ E (-p.coeff 0 / p.coeff 1),
    { rw [ring_hom.map_div, ring_hom.map_neg, ←coeff_map, ←coeff_map, p_linear],
      simp [mul_sub, coeff_C, mul_div_cancel_left β (mt leading_coeff_eq_zero.mp h_ne_zero)] },
    rw finale,
    exact subtype.mem (-p.coeff 0 / p.coeff 1) },
  have h_sep : h.separable := separable_gcd_right _ (separable.map (F_sep.separable β)),
  have h_root : h.eval β = 0,
  { apply eval_gcd_eq_zero,
    { rw [eval_comp, eval_sub, eval_mul, eval_C, eval_C, eval_X, eval_map, ←aeval_def,
          ←algebra.smul_def, add_sub_cancel, minpoly.aeval] },
    { rw [eval_map, ←aeval_def, minpoly.aeval] } },
  have h_splits : splits ιEE' h := splits_of_splits_gcd_right ιEE' map_g_ne_zero
    (splitting_field.splits _),
  have h_roots : ∀ x ∈ (h.map ιEE').roots, x = ιEE' β,
  { intros x hx,
    rw mem_roots_map h_ne_zero at hx,
    specialize hc ((ιEE' γ) - (ιEE' (ιFE c)) * x) (begin
      have f_root := root_left_of_root_gcd hx,
      rw [eval₂_comp, eval₂_sub, eval₂_mul,eval₂_C, eval₂_C, eval₂_X, eval₂_map] at f_root,
      exact (mem_roots_map (minpoly.ne_zero hα)).mpr f_root,
    end),
    specialize hc x (begin
      rw [mem_roots_map (minpoly.ne_zero hβ), ←eval₂_map],
      exact root_right_of_root_gcd hx,
    end),
    by_contradiction a,
    apply hc,
    apply (div_eq_iff (sub_ne_zero.mpr a)).mpr,
    simp only [algebra.smul_def, ring_hom.map_add, ring_hom.map_mul, ring_hom.comp_apply],
    ring },
  rw ← eq_X_sub_C_of_separable_of_root_eq h_ne_zero h_sep h_root h_splits h_roots,
  transitivity euclidean_domain.gcd (_ : polynomial E) (_ : polynomial E),
  { dsimp only [p],
    convert (gcd_map (algebra_map F⟮γ⟯ E)).symm },
  { simpa [map_comp, map_map, ←is_scalar_tower.algebra_map_eq, h] },
end

end primitive_element_inf

variables {F : Type*} [field F] {E : Type*} [field E] [algebra F E]

/-- Primitive element theorem: a finite separable field extension `E` of `F` has a
  primitive element, i.e. there is an `α ∈ E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.-/
theorem exists_primitive_element [finite_dimensional F E] (F_sep : is_separable F E) :
  ∃ α : E, F⟮α⟯ = ⊤ :=
begin
  by_cases F_finite : nonempty (fintype F),
  { exact nonempty.elim F_finite
    (λ h, by haveI := h; exact exists_primitive_element_of_fintype_bot F E) },
  { let P : intermediate_field F E → Prop := λ K, ∃ α : E, F⟮α⟯ = K,
    have base : P ⊥ := ⟨0, adjoin_zero⟩,
    have ih : ∀ (K : intermediate_field F E) (x : E), P K → P ↑K⟮x⟯,
    { intros K β hK,
      cases hK with α hK,
      rw [←hK, adjoin_simple_adjoin_simple],
      haveI : infinite F := not_nonempty_fintype.mp F_finite,
      cases primitive_element_inf_aux α β F_sep with γ hγ,
      exact ⟨γ, hγ.symm⟩ },
    exact induction_on_adjoin P base ih ⊤ },
end

end field


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

import ring_theory.integral_closure
import ring_theory.valuation.integers

/-!
# Integral elements over the ring of integers of a valution

The ring of integers is integrally closed inside the original ring.
-/

universes u v w

open_locale big_operators

namespace valuation

namespace integers

section comm_ring

variables {R : Type u} {Γ₀ : Type v} [comm_ring R] [linear_ordered_comm_group_with_zero Γ₀]
variables {v : valuation R Γ₀} {O : Type w} [comm_ring O] [algebra O R] (hv : integers v O)
include hv

open polynomial

lemma mem_of_integral {x : R} (hx : is_integral O x) : x ∈ v.integer :=
let ⟨p, hpm, hpx⟩ := hx in le_of_not_lt $ λ hvx, begin
  rw [hpm.as_sum, eval₂_add, eval₂_pow, eval₂_X, eval₂_finset_sum, add_eq_zero_iff_eq_neg] at hpx,
  replace hpx := congr_arg v hpx, refine ne_of_gt _ hpx,
  rw [v.map_neg, v.map_pow],
  refine v.map_sum_lt' (lt_of_lt_of_le (lt_of_le_of_ne zero_le_one' zero_ne_one)
      (one_le_pow_of_one_le' $ le_of_lt hvx))
    (λ i hi, _),
  rw [eval₂_mul, eval₂_pow, eval₂_C, eval₂_X, v.map_mul, v.map_pow, ← one_mul (v x ^ p.nat_degree)],
  cases lt_or_eq_of_le (hv.2 $ p.coeff i) with hvpi hvpi,
  { exact mul_lt_mul'''' hvpi (pow_lt_pow' hvx $ finset.mem_range.1 hi) },
  { erw hvpi, rw [one_mul, one_mul], exact pow_lt_pow' hvx (finset.mem_range.1 hi) }
end

protected lemma integral_closure : integral_closure O R = ⊥ :=
eq_bot_iff.2 $ λ r hr, let ⟨x, hx⟩ := hv.3 (hv.mem_of_integral hr) in algebra.mem_bot.2 ⟨x, hx⟩

end comm_ring

end integers

end valuation


import Mathbin

namespace PolynomialDegree

open BigOperators

variable {F : Type u}
variable [Field F]

lemma natDegreeProductForm (m : ℕ) (f : Finₓ m → F) :
  Polynomial.natDegree (∏ i in (Finset.finRange m), (Polynomial.x - Polynomial.c (f i))) = m := by
  -- rw [Polynomial.nat_degree_prod]
  sorry

lemma monicOfProductForm (m : ℕ) (f : Finₓ m → F) :
  (∏ i in (Finset.finRange m), (x - Polynomial.c (f i))).Monic := by
  apply Polynomial.monic_prod_of_monic
  intros i hi
  sorry
  -- exact Polynomial.monic_X_sub_C (f i)

end PolynomialDegree


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Reid Barton, Simon Hudon, Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.basic
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Opposites

In this file we define a type synonym `opposite α := α`, denoted by `αᵒᵖ` and two synonyms for the
identity map, `op : α → αᵒᵖ` and `unop : αᵒᵖ → α`. The type tag `αᵒᵖ` is used with two different
meanings:

- if `α` is a category, then `αᵒᵖ` is the opposite category, with all arrows reversed;

- if `α` is a monoid (group, etc), then `αᵒᵖ` is the opposite monoid (group, etc) with
  `op (x * y) = op x * op y`.
-/

/-- The type of objects of the opposite of `α`; used to define the opposite category or group.

  In order to avoid confusion between `α` and its opposite type, we
  set up the type of objects `opposite α` using the following pattern,
  which will be repeated later for the morphisms.

  1. Define `opposite α := α`.
  2. Define the isomorphisms `op : α → opposite α`, `unop : opposite α → α`.
  3. Make the definition `opposite` irreducible.

  This has the following consequences.

  * `opposite α` and `α` are distinct types in the elaborator, so you
    must use `op` and `unop` explicitly to convert between them.
  * Both `unop (op X) = X` and `op (unop X) = X` are definitional
    equalities. Notably, every object of the opposite category is
    definitionally of the form `op X`, which greatly simplifies the
    definition of the structure of the opposite category, for example.

  (If Lean supported definitional eta equality for records, we could
  achieve the same goals using a structure with one field.)
-/
def opposite (α : Sort u) := α

postfix:0 "ᵒᵖ" => Mathlib.opposite

-- Use a high right binding power (like that of postfix ⁻¹) so that, for example,

-- `presheaf Cᵒᵖ` parses as `presheaf (Cᵒᵖ)` and not `(presheaf C)ᵒᵖ`.

namespace opposite

/-- The canonical map `α → αᵒᵖ`. -/
/-- The canonical map `αᵒᵖ → α`. -/
def op {α : Sort u} : α → (αᵒᵖ) := id

def unop {α : Sort u} : αᵒᵖ → α := id

theorem op_injective {α : Sort u} : function.injective op := fun (_x _x_1 : α) => id

theorem unop_injective {α : Sort u} : function.injective unop := fun (_x _x_1 : αᵒᵖ) => id

@[simp] theorem op_inj_iff {α : Sort u} (x : α) (y : α) : op x = op y ↔ x = y := iff.rfl

@[simp] theorem unop_inj_iff {α : Sort u} (x : αᵒᵖ) (y : αᵒᵖ) : unop x = unop y ↔ x = y := iff.rfl

@[simp] theorem op_unop {α : Sort u} (x : αᵒᵖ) : op (unop x) = x := rfl

@[simp] theorem unop_op {α : Sort u} (x : α) : unop (op x) = x := rfl

/-- The type-level equivalence between a type and its opposite. -/
def equiv_to_opposite {α : Sort u} : α ≃ (αᵒᵖ) := equiv.mk op unop unop_op op_unop

@[simp] theorem equiv_to_opposite_apply {α : Sort u} (a : α) : coe_fn equiv_to_opposite a = op a :=
  rfl

@[simp] theorem equiv_to_opposite_symm_apply {α : Sort u} (a : αᵒᵖ) :
    coe_fn (equiv.symm equiv_to_opposite) a = unop a :=
  rfl

theorem op_eq_iff_eq_unop {α : Sort u} {x : α} {y : αᵒᵖ} : op x = y ↔ x = unop y :=
  equiv.apply_eq_iff_eq_symm_apply equiv_to_opposite

theorem unop_eq_iff_eq_op {α : Sort u} {x : αᵒᵖ} {y : α} : unop x = y ↔ x = op y :=
  equiv.apply_eq_iff_eq_symm_apply (equiv.symm equiv_to_opposite)

protected instance inhabited {α : Sort u} [Inhabited α] : Inhabited (αᵒᵖ) :=
  { default := op Inhabited.default }

@[simp] def op_induction {α : Sort u} {F : αᵒᵖ → Sort v} (h : (X : α) → F (op X)) (X : αᵒᵖ) : F X :=
  h (unop X)

end Mathlib


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, David Renshaw
-/

import Lean.Elab.Tactic.Basic
import Lean.Meta.Tactic.Simp.Main
import Std.Lean.Parser
import Mathlib.Algebra.Group.Units
import Mathlib.Tactic.NormNum.Core
import Qq

/-!
# `field_simp` tactic

Tactic to clear denominators in algebraic expressions, based on `simp` with a specific simpset.
-/

namespace Mathlib.Tactic.FieldSimp

open Lean Elab.Tactic Parser.Tactic Lean.Meta
open Qq

initialize registerTraceClass `Tactic.field_simp

/-- Constructs a trace message for the `discharge` function. -/
private def dischargerTraceMessage (prop: Expr) : Except ε (Option Expr) → SimpM MessageData
| .error _ | .ok none => return m!"{crossEmoji} discharge {prop}"
| .ok (some _) => return m!"{checkEmoji} discharge {prop}"

/-- Discharge strategy for the field_simp tactic. -/
partial def discharge (prop : Expr) : SimpM (Option Expr) :=
  withTraceNode `Tactic.field_simp (dischargerTraceMessage prop) do
    if let some r ← Simp.dischargeUsingAssumption? prop then
      return some r

    let prop : Q(Prop) ← (do pure prop)
    let pf? ← match prop with
    | ~q(($e : $α) ≠ $b) =>
        try
          let res ← Mathlib.Meta.NormNum.derive (α := (q(Prop) : Q(Type))) prop
          match res with
          | .isTrue pf => pure (some pf)
          | _ => pure none
        catch _ =>
          pure none
    | _ => pure none
    if let some pf := pf? then return some pf

    let ctx ← read
    let usedTheorems := (← get).usedTheorems

    -- Port note: mathlib3's analagous field_simp discharger `field_simp.ne_zero`
    -- does not explicitly call `simp` recursively like this. It's unclear to me
    -- whether this is because
    --   1) Lean 3 simp dischargers automatically call `simp` recursively. (Do they?),
    --   2) mathlib3 norm_num1 is able to handle any needed discharging, or
    --   3) some other reason?
    let ⟨simpResult, usedTheorems'⟩ ←
      simp prop { ctx with dischargeDepth := ctx.dischargeDepth  + 1} discharge usedTheorems
    set {(← get) with usedTheorems := usedTheorems'}
    if simpResult.expr.isConstOf ``True then
      try
        return some (← mkOfEqTrue (← simpResult.getProof))
      catch _ =>
        return none
    else
      return none

/--
The goal of `field_simp` is to reduce an expression in a field to an expression of the form `n / d`
where neither `n` nor `d` contains any division symbol, just using the simplifier (with a carefully
crafted simpset named `field_simps`) to reduce the number of division symbols whenever possible by
iterating the following steps:

- write an inverse as a division
- in any product, move the division to the right
- if there are several divisions in a product, group them together at the end and write them as a
  single division
- reduce a sum to a common denominator

If the goal is an equality, this simpset will also clear the denominators, so that the proof
can normally be concluded by an application of `ring` or `ring_exp`.

`field_simp [hx, hy]` is a short form for
`simp (discharger := Tactic.FieldSimp.discharge) [-one_div, -mul_eq_zero, hx, hy, field_simps]`

Note that this naive algorithm will not try to detect common factors in denominators to reduce the
complexity of the resulting expression. Instead, it relies on the ability of `ring` to handle
complicated expressions in the next step.

As always with the simplifier, reduction steps will only be applied if the preconditions of the
lemmas can be checked. This means that proofs that denominators are nonzero should be included. The
fact that a product is nonzero when all factors are, and that a power of a nonzero number is
nonzero, are included in the simpset, but more complicated assertions (especially dealing with sums)
should be given explicitly. If your expression is not completely reduced by the simplifier
invocation, check the denominators of the resulting expression and provide proofs that they are
nonzero to enable further progress.

To check that denominators are nonzero, `field_simp` will look for facts in the context, and
will try to apply `norm_num` to close numerical goals.

The invocation of `field_simp` removes the lemma `one_div` from the simpset, as this lemma
works against the algorithm explained above. It also removes
`mul_eq_zero : x * y = 0 ↔ x = 0 ∨ y = 0`, as `norm_num` can not work on disjunctions to
close goals of the form `24 ≠ 0`, and replaces it with `mul_ne_zero : x ≠ 0 → y ≠ 0 → x * y ≠ 0`
creating two goals instead of a disjunction.

For example,
```lean
example (a b c d x y : ℂ) (hx : x ≠ 0) (hy : y ≠ 0) :
    a + b / x + c / x^2 + d / x^3 = a + x⁻¹ * (y * b / y + (d / x + c) / x) := by
  field_simp
  ring
```

Moreover, the `field_simp` tactic can also take care of inverses of units in
a general (commutative) monoid/ring and partial division `/ₚ`, see `Algebra.Group.Units`
for the definition. Analogue to the case above, the lemma `one_divp` is removed from the simpset
as this works against the algorithm. If you have objects with a `IsUnit x` instance like
`(x : R) (hx : IsUnit x)`, you should lift them with
`lift x to Rˣ using id hx, rw [IsUnit.unit_of_val_units] clear hx`
before using `field_simp`.

See also the `cancel_denoms` tactic, which tries to do a similar simplification for expressions
that have numerals in denominators.
The tactics are not related: `cancel_denoms` will only handle numeric denominators, and will try to
entirely remove (numeric) division from the expression by multiplying by a factor.
-/
syntax (name := fieldSimp) "field_simp" (config)? (discharger)? (&" only")?
  (simpArgs)? (ppSpace location)? : tactic

elab_rules : tactic
| `(tactic| field_simp $[$cfg:config]? $[$dis:discharger]? $[only%$only?]?
    $[$sa:simpArgs]? $[$loc:location]?) => do
  let cfg ← elabSimpConfig (cfg.getD ⟨.missing⟩) .simp
  let loc := expandOptLocation (loc.getD ⟨.missing⟩)

  let dis ← match dis with
  | none => pure discharge
  | some d => do
     let ⟨_,d⟩ ← tacticToDischarge d
     pure d

  let thms0 ← if only?.isSome then
    simpOnlyBuiltins.foldlM (·.addConst ·) ({} : SimpTheorems)
  else do
    let thms0 ← getSimpTheorems
    let thms0 ← thms0.erase (.decl ``one_div)
    let thms0 ← thms0.erase (.decl `mul_eq_zero)
    thms0.erase (.decl ``one_divp)

  let some ext ← getSimpExtension? `field_simps | throwError "field_simps not found"
  let thms ← ext.getTheorems

  let ctx : Simp.Context := {
     simpTheorems := #[thms, thms0]
     congrTheorems := (← getSimpCongrTheorems)
     config := cfg
  }
  let r ← elabSimpArgs (sa.getD ⟨.missing⟩) ctx (eraseLocal := false) .simp

  _ ← simpLocation r.ctx dis loc


import boolalg
import boolalg_ring
import init.meta.interactive_base

open boolalg

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

namespace freealg
variables {A : boolalg}

def freealg : nat → Type
| 0 := bool
| (n+1) := (freealg n) × (freealg n)

def zero : forall {n : nat}, (freealg n)
| 0 := ff
| (n+1) := (zero, zero)

def one : forall {n : nat}, (freealg n)
| 0 := tt
| (n+1) := (one, one)

def var : forall {n : nat} (i : nat), (i < n) → (freealg n)
| 0 i Hi := false.elim (nat.not_lt_zero i Hi)
| (n+1) 0 Hi := (one, zero)
| (n+1) (i+1) Hi := let coeff : freealg n := var i (nat.lt_of_succ_lt_succ Hi) in (coeff, coeff)

def plus : forall {n : nat}, (freealg n) → (freealg n) → (freealg n)
| 0 a b := bxor a b
| (n+1) a b := (plus a.1 b.1, plus a.2 b.2)

def times : forall {n : nat}, (freealg n) → (freealg n) → (freealg n)
| 0 a b := band a b
| (n+1) a b := (times a.1 b.1, times a.2 b.2)

def map : forall {n : nat} (V : vector A n), (freealg n) → A
| 0 V ff := 0
| 0 V tt := 1
| (n+1) V a := (map V.tail a.1) * V.head + (map V.tail a.2) * (V.head + 1)

lemma on_zero : forall {n : nat} (V : vector A n),
0 = map V zero
  | 0 V := rfl
  | (n+1) V := calc
      0   = 0 * V.head + 0 * (V.head + 1)                                 : by ring
      ... = (map V.tail zero) * V.head + (map V.tail zero) * (V.head + 1) : by rw on_zero

lemma on_one : forall {n : nat} (V : vector A n),
1 = map V one
  | 0 V := rfl
  | (n+1) V := calc
      1   = V.head + (V.head + 1)                                       : (plus_self_left _ _).symm
      ... = 1 * V.head + 1 * (V.head + 1)                               : by ring
      ... = (map V.tail one) * V.head + (map V.tail one) * (V.head + 1) : by rw on_one

lemma on_var : forall {n : nat} (V : vector A n) (i : nat) (Hi : i < n),
V.nth ⟨i, Hi⟩ = map V (var i Hi)
  | 0 V i Hi := false.elim (nat.not_lt_zero i Hi)
  | (n+1) V 0 Hi := calc
      V.nth ⟨0, Hi⟩ = V.head                                                       : by simp
      ...           = 1 * V.head + 0 * (V.head + 1)                                : by ring
      ...           = (map V.tail one) * V.head + (map V.tail zero) * (V.head + 1) : by rw [on_zero, on_one]
  | (n+1) V (i+1) Hi := let
      Hip : (i < n) := nat.lt_of_succ_lt_succ Hi,
      tail_var := map V.tail (var i Hip)
      in calc V.nth ⟨i + 1, Hi⟩ = V.tail.nth ⟨i, Hip⟩                         : by rw [vector.nth_tail, fin.succ.equations._eqn_1]
      ...                       = tail_var                                    : on_var _ _ _
      ...                       = _                                           : (plus_self_left (tail_var * V.head) _).symm
      ...                       = tail_var * V.head + tail_var * (V.head + 1) : by ring

lemma on_plus : forall {n : nat} (V : vector A n) (a b : freealg n),
(map V a) + (map V b) = map V (plus a b)
  | 0 V a b :=
      begin
        cases a; cases b; unfold map plus bxor; ring,
        exact two_eq_zero,
      end
  | (n+1) V a b :=
      begin
        unfold map plus,
        rw [←on_plus V.tail a.1 b.1, ←on_plus V.tail a.2 b.2],
        ring,
      end

lemma on_times : forall {n : nat} (V : vector A n) (a b : freealg n),
(map V a) * (map V b) = map V (times a b)
  | 0 V a b := by cases a; cases b; unfold map plus band; ring
  | (n+1) V a b :=
      begin
        unfold map times,
        rw [←on_times V.tail a.1 b.1, ←on_times V.tail a.2 b.2,←expand_product],
      end

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

lemma foo (X : A) :  Xᶜᶜᶜᶜ = X :=
begin
  let vars := vector.cons X (vector.nil),
  set_to_ring_eqn,
  have := on_zero vars,
  have : X = _ := on_var vars 0 zero_lt_one,
  rw this,
  --erw [(rfl : X = vars 1)], --, on_var vars (one_lt_two)],
  simp only [on_zero vars , on_one vars, on_plus vars, on_times vars],
  refl,
end

end /-namespace-/ freealg

open interactive
open lean.parser

  --have hx : X = _ := on_var _ _ vars (by norm_num : 0 < 6),
open tactic
open tactic.interactive
open freealg

meta def ids_list : lean.parser (list name) := types.list_of ident
meta def meta_build_vector : list pexpr -> pexpr
| [] := ``(vector.nil)
| (v :: vs) := ``(vector.cons %%v %%(meta_build_vector vs))
meta def list_with_idx {T : Type} : (list T) → nat -> list (nat × T)
| [] n := []
| (v :: vs) n := (n, v) :: list_with_idx vs (n + 1)

meta def tactic.interactive.introduce_varmap_rewrite (vname : parse ident) (vars : parse ids_list) : tactic unit :=
  do
    names <- vars.mmap (fun name, get_local name),
    («let» vname ``(vector _ %%(vars.length)) $ meta_build_vector (names.map to_pexpr)),
    mmap
      (λ (pair : (nat × expr)),
        let name := prod.snd pair in
        let idx := prod.fst pair in
        do
          vname_expr <- get_local vname,
          hname <- get_unused_name `Hv,
          («have» hname ``(%%name = _) ``(on_var %%vname_expr %%idx (by norm_num))),
          hname_expr <- get_local hname,
          tactic.try (rewrite_target hname_expr),
          return ())
      (list_with_idx names 0),
    return ()

meta def tactic.interactive.simplify_sets (sets : parse ids_list) : tactic unit :=
  do
    -- TODO: actually check the goal is of the form of some boolalg equation
    --       also -- do something about hypotheses...
    vname <- get_unused_name `V,
    tactic.interactive.introduce_varmap_rewrite vname sets,
    vname_expr <- get_local vname,
    set_to_ring_eqn,
    simp none tt ([``(freealg.on_one %%vname_expr),
                   ``(freealg.on_plus %%vname_expr),
                   ``(freealg.on_times %%vname_expr),
                   ``(freealg.on_zero %%vname_expr),
                   ``(freealg.on_var %%vname_expr)].map simp_arg_type.expr)
                    list.nil loc.wildcard,
    refl

--#print tactic.interactive.simplify_sets

lemma baz {A : boolalg} (X Y Z : A) : X = X := begin
  introduce_varmap_rewrite V [X, Y, Z],
  refl,
end

--set_option pp.notation false
--set_option pp.implicit false

lemma bar {A : boolalg} (X Y Z P Q W: A) : (X ∪ (Y ∪ Z)) ∪ ((W ∩ P ∩ Q)ᶜ ∪ (P ∪ W ∪ Q)) = ⊤ :=
begin
  simplify_sets [X, Y, Z, P, Q, W],
end


import data.polynomial.eval
import time_bound
import npolynomial

def polytime (c : code) : Prop :=
∃ (p : polynomial ℕ), time_bound c (λ n, p.eval n)

lemma polytime.dom_univ {c : code} (p : polytime c) : c.eval.dom = set.univ :=
by { cases p with p h, exact eval_dom_of_time_bound h, }

lemma polytime.dom_univ' {c : code} (p : polytime c) : ∀ x, (c.eval x).dom :=
by { intro x, change x ∈ c.eval.dom, rw p.dom_univ, trivial, }

@[simp] def polytime.to_fun {c : code} (pc : polytime c) (x : ptree) : ptree :=
(c.eval x).get (pc.dom_univ' _)

lemma polytime_left : polytime code.left :=
⟨polynomial.monomial 1 1, by simpa using time_bound_left⟩

lemma polytime_right : polytime code.right := polytime_left

lemma polytime_id : polytime code.id := polytime_left

lemma polytime_nil : polytime code.nil := ⟨1, by simpa using time_bound_nil⟩

lemma polytime_node {c₁ c₂ : code} : polytime c₁ → polytime c₂ → polytime (code.node c₁ c₂)
| ⟨p₁, e₁⟩ ⟨p₂, e₂⟩ := by { use p₁ + p₂ + 1, convert time_bound_node e₁ e₂, simp, }

lemma polytime_comp {c₁ c₂ : code} : polytime c₁ → polytime c₂ → polytime (code.comp c₁ c₂)
| ⟨p₁, e₁⟩ ⟨p₂, e₂⟩ := by { use (p₁.comp p₂) + p₂ + 1, convert time_bound_comp (monotone_polynomial_nat _) e₁ e₂, simp, }

lemma polytime_case {c₁ c₂ : code} : polytime c₁ → polytime c₂ → polytime (code.case c₁ c₂)
| ⟨p₁, e₁⟩ ⟨p₂, e₂⟩ := by { use p₁ + p₂ + 1, convert time_bound_case' (monotone_polynomial_nat _) (monotone_polynomial_nat _) e₁ e₂, simp, }

lemma polytime_const (v : ptree) : polytime (code.const v) :=
by { induction v, { exact polytime_nil, }, apply polytime_node; assumption }

lemma polytime_ite {c₁ c₂ c₃ : code} (p₁ : polytime c₁) (p₂ : polytime c₂) (p₃ : polytime c₃) :
  polytime (code.ite c₁ c₂ c₃) :=
polytime_comp (polytime_case p₂ p₃) (polytime_node p₁ polytime_id)


import Mathlib

/-!
# Inductive Types

The main way of introducing new types in Lean is through inductive types. An inductive type is a type
which is specified by saying how to construct terms of that type. Concretely, we specify the types of
a set of `constructors` all of which have _final codomain_ the type being constructed.

When an inductive type is defined, Lean automatically generates a _recursor_ for that type, which allows defining by cases, matching, and induction on terms of that type.
-/

namespace Waffle

/-!
## Enumerated Types

Enumerated types are a special case of inductive types where the constructors have no arguments. We simply list the terms of that type.
-/

/--
An enumerated type for the answers to a yes/no question.
-/
inductive Answer where
  | yes : Answer
  | no : Answer
  | maybe : Answer
deriving Repr, Inhabited, DecidableEq

/-!
Some terms introduced when an inductive type is defined. The last two depended on the classes `Repr` and `Inhabited` being derived for the type.

```lean
#check Answer -- Type
#check Answer.yes -- Answer

#eval Answer.yes -- Waffle.Answer.yes

#eval (default : Answer) -- Waffle.Answer.yes
```
-/

#check Answer -- Type
#check Answer.yes -- Answer
#eval Answer.yes -- Waffle.Answer.yes

#eval (default : Answer) -- Waffle.Answer.yes

/-- A function defined by cases which disagrees with the given answer. -/
def disagree: Answer → Answer
  | Answer.yes => Answer.no
  | Answer.no => Answer.yes
  | Answer.maybe => Answer.maybe

/-!
The `disagree` function is defined by cases on the argument. The definition is rewritten by Lean in terms of the `rec` function, which is automatically generated by Lean for each inductive type. The `rec` function is a _recursor_ for the type, which allows defining by cases, matching, and induction on terms of that type.

```lean
#eval disagree Answer.yes -- Waffle.Answer.no
#reduce disagree -- fun x => Answer.rec Answer.no Answer.yes Answer.maybe x
#check Answer.rec -- {motive : Answer → Sort u_1} → motive Answer.yes → motive Answer.no → motive Answer.maybe → (t : Answer) → motive t
```

The type of the recursor looks complicated because we can recursively define _dependent functions_ on the inductive type answer, i.e., a function `f` which takes an argument of type `x: Answer` and returns a value whose type depends on `x`. The `motive` argument specifies the type of `f x` for `x: Answer`.

__Note__: You should think of the word `motive` as corresponding to the english word `motif`, not the english word `motive`. The `motive` encodes the type of the function we are defining, not the reason for defining it.

Recursive definitions simplify if we are defining a (non-dependent) function on the type. Here the motive is a constant function. For example, to define a function `Answer → String` we take as motive `fun _ => String`.
In this case we see the type of the recursor is simplified.

```
#check Answer.rec (motive := fun _ => String) -- String → String → String → Answer → String
```

Indeed the above is easy to interpret. The recursor takes as input the value of the function being defined on the three constructors and returns a function from `Answer` to `String`.
-/

#eval disagree Answer.yes -- Waffle.Answer.no
#reduce disagree -- fun x => Answer.rec Answer.no Answer.yes Answer.maybe x
#check Answer.rec -- {motive : Answer → Sort u_1} → motive Answer.yes → motive Answer.no → motive Answer.maybe → (t : Answer) → motive t
#check Answer.rec (motive := fun _ => String) -- String → String → String → Answer → String

/--
If an answer is equal to its disagreement, then it must be `maybe`.
-/
theorem disagree_eq_maybe(ans: Answer) :
  (disagree ans) = ans → ans = Answer.maybe :=
    by
      cases ans <;> simp [disagree]

#check disagree_eq_maybe -- ∀ (ans : Answer), disagree ans = ans → ans = Answer.maybe

end Waffle

namespace Explained

/-!
## Structures

Another simple kind of inductive type is a `Structure`, whose terms correspond to values of specified fields of given types.
-/

/-- A structure for answers with explanations -/
structure Answer where
  agree : Bool
  explanation: String

/-!
An element of the type can be constructed using special syntax which is similar to a tuple but with left and right angle brackets instead of parentheses.

```lean
example : Answer := ⟨true, "I agree"⟩
```
-/

example : Answer := ⟨true, "I agree"⟩
example : Answer :=
    Answer.mk false "it would be crazy if it was true"

/-!
When a structure is defined, a constructor named `mk` is automatically generated. The constructor is a function which takes the arguments of the structure in the order they are declared and returns a term of the structure type.

Further, projections onto each of the fields are defined as functions named after the field. As with any induction type, a recursor is automatically generated for the structure.

```lean
#check Answer -- Type
#check Answer.agree -- Answer → Bool
#check Answer.explanation -- Answer → String
#check Answer.mk -- Bool → String → Answer
#check Answer.rec -- {motive : Answer → Sort u} → ((agree : Bool) → (explanation : String) → motive { agree := agree, explanation := explanation }) → (t : Answer) → motive t
```
-/
#check Answer -- Type
#check Answer.agree -- Answer → Bool
#check Answer.explanation -- Answer → String
#check Answer.mk -- Bool → String → Answer
#check Answer.rec -- {motive : Answer → Sort u} → ((agree : Bool) → (explanation : String) → motive { agree := agree, explanation := explanation }) → (t : Answer) → motive t

end Explained

namespace VerboseExplained

/-!
We can rewrite the structure `Answer` in terms of inductive types. In this case we have to define the projections manually.
-/

inductive Answer where
| mk : Bool → String → Answer

def Answer.agree : Answer → Bool
| ⟨agree, _⟩ => agree

def Answer.explanation : Answer → String :=
  fun ⟨_, exp⟩ ↦ exp

end VerboseExplained

namespace LongWinded

/-!
## "Genuine" Inductive Types

Our earlier examples had two degenerate forms of inductive types. The main point of inductive types is that terms of such a type can be formed using terms of the same type recursively. For example, we can construct an `Answer` type which includes a constructor that adds an explanation to an existing answer. Note that the existing answer itself can be an `Answer` with an explanation.

-/

inductive Answer where
| yes : Answer
| no : Answer
| maybe : Answer
| explained : String → Answer → Answer
deriving Inhabited, DecidableEq, Repr

#check Answer.explained

/-- An example of an answer -/
def egAnswer : Answer := Answer.explained "I agree" Answer.yes

/-- An example of an answer with nested explanations -/
def egAnswerLong : Answer :=
  Answer.explained "Let me play the devil's advocate" (
    Answer.explained "This is silly" Answer.no
  )

/-- Another example, to illustrate notation -/
def egAnswerCharlieBrown : Answer :=
  Answer.explained "Maybe" <|
    Answer.explained  "Maybe not" Answer.maybe

/-!
Here is an example of an answer with nested explanations.

```lean
#eval egAnswerLong /- LongWinded.Answer.explained
  "Let me play the devil's advocate"
  (LongWinded.Answer.explained "This is silly" (LongWinded.Answer.no)) -/
```

-/
#eval egAnswerLong /- LongWinded.Answer.explained
  "Let me play the devil's advocate"
  (LongWinded.Answer.explained "This is silly" (LongWinded.Answer.no)) -/

/-- A function that disagrees with an answer. The explanation is ridiculed. -/
def disagree  : Answer → Answer
| Answer.yes => Answer.no
| Answer.no => Answer.yes
| Answer.maybe => Answer.maybe
| Answer.explained exp ans =>
    Answer.explained ("It would be silly to say `"++ exp ++"'") (disagree ans)

/-!
We can again define a function that disagrees with an answer by cases. In this case the definition is recursive, so the function in the `Answer.explained exp ans` case depends on the recursive call to `disagree` on `ans`.

```lean
#eval disagree egAnswerLong /- LongWinded.Answer.explained
  "It would be silly to say `Let me play the devil's advocate'"
  (LongWinded.Answer.explained "It would be silly to say `This is silly'" (LongWinded.Answer.yes)) -/
```
-/

#eval disagree egAnswerLong /- LongWinded.Answer.explained
  "It would be silly to say `Let me play the devil's advocate'"
  (LongWinded.Answer.explained "It would be silly to say `This is silly'" (LongWinded.Answer.yes)) -/

/-- A string explanation from the answer, reversing the concatenation of all explanations and adding one based on the answer. -/
def explanation : Answer → String
| Answer.yes => "I agree"
| Answer.no => "I disagree"
| Answer.maybe => "I don't know"
| Answer.explained exp ans => explanation ans  ++ " because " ++ exp

/-!
We can similarly define a function that gives a string explanation from the answer, reversing the concatenation of all explanations and adding one based on the answer.

```lean
#eval explanation egAnswerLong -- "I disagree because This is silly because Let me play the devil's advocate"
```

The recursor in such a case has to enable recursive definitions. To see how  this happnes, we can check the type of the recursor. We consider the case where we are defining a function from `Answer` to `String`.

```lean
#check @Answer.rec (motive := fun _ => String) -- String → String → String → (String → Answer → String → String) → Answer → String
```

The recursor has type `String → String → String → (String → Answer → String → String) → Answer → String`. The first three arguments are the values of the function for the three constructors without an explanation. The last argument is a function that takes the value of the function for the explanation case, the answer, and the string explanation of the answer, and returns the value of the function for the answer. The last argument is the answer itself.
-/

#eval explanation egAnswerLong -- "I disagree because This is silly because Let me play the devil's advocate"

#check @Answer.rec (motive := fun _ => String) -- String → String → String → (String → Answer → String → String) → Answer → String

end LongWinded

namespace Waffle

/-!
## Indexed Inductive Types

A more complex variant of inductive types is an indexed inductive type. Here we introduce a family of inductive types with the constructors giving terms having types lying in the family. As an example, we define an indexed inductive type capturing `≤` on the type `Waffle.Answer`.

As this gives a proposition for a pair of answers, the family has type `Answer → Answer → Prop`. The first two constructors are `Answer.le.no_le` and `Answer.le.le_yes` giving the propositions `Answer.no ≤  ans` and `ans ≤  Answer.yes` for any `ans`. The constructor `Answer.le.refl` gives the proposition `ans ≤  ans` for any `ans`.
-/

inductive Answer.le : Answer → Answer →  Prop where
| no_le (ans: Answer) : Answer.le Answer.no ans
| le_yes (ans: Answer) :
    Answer.le ans Answer.yes
| refl (ans : Answer) :
    Answer.le ans ans

/-- An instance associating `≤` to `Answer.le` -/
instance : LE Answer := ⟨Answer.le⟩

#check Answer.no ≤  Answer.yes -- Answer.no ≤ Answer.yes : Prop
/-- transitivity of the relation `≤` on answers -/
theorem le_trans (a b c : Answer) :
  a ≤  b → b ≤  c → a ≤  c :=
  by
    intro h₁ h₂
    cases c₁:h₁
    case no_le =>
      apply Answer.le.no_le
    case le_yes =>
      cases c₂:h₂
      case le_yes => apply Answer.le.le_yes
      case refl => assumption
    case refl => assumption

end Waffle

namespace PropAnswer

/-!
## `Prop` versus `Type`

To illustrate the difference between propositions and general types, we define a variant of the `Answer` type in the `Prop` universe. The constructors are the same as for `Waffle.Answer`, but the type is `Prop` instead of `Type`.
-/

/-- `Answer` as an inductive prop -/
inductive Answer : Prop where
  | yes : Answer
  | no : Answer
  | maybe : Answer

#check Answer -- PropAnswer.Answer : Prop

/-!
We see that what we have defined is a proposition.
```lean
#check Answer -- PropAnswer.Answer : Prop
```

We can try to define a function `Answer → Bool` by cases. This gives an error message, as the recursor for `Answer` is not defined for general types.

```lean
def generous : Answer → Bool
  | Answer.yes => true
  | Answer.no => false
  | Answer.maybe => true
```
gives error message
```lean
tactic 'cases' failed, nested error:
tactic 'induction' failed, recursor 'PropAnswer.Answer.casesOn' can only eliminate into Prop
motive: Answer → Sort ?u.9737
h_1: Unit → motive Answer.yes
h_2: Unit → motive Answer.no
h_3: Unit → motive Answer.maybe
⊢ motive x✝
 after processing
  _
the dependent pattern matcher can solve the following kinds of equations
- <var> = <term> and <term> = <var>
- <term> = <term> where the terms are definitionally equal
- <constructor> = <constructor>, examples: List.cons x xs = List.cons y ys, and List.cons x xs = List.nil
```

The conceptual reason for this is that two terms of a proposition are definitionally equal. But the definition by cases would give a function that is not constant on the proposition, so equal arguments will give unequal results, a logical contradiction.

The formal reason lies in the type of the recursor constructed for the proposition. The recursor is defined for propositions, not for general types. The type of the recursor is
```lean
#check Answer.rec /- PropAnswer.Answer.rec {motive : Answer → Prop} (yes : motive Answer.yes) (no : motive Answer.no)
  (maybe : motive Answer.maybe) (t : Answer) : motive t
-/
```

In particular if we wish to define a term `Answer → α`, then the motive must be `fun _ ↦ α` and so `α` must be a proposition.
-/

#check Answer.rec /- PropAnswer.Answer.rec {motive : Answer → Prop} (yes : motive Answer.yes) (no : motive Answer.no)
  (maybe : motive Answer.maybe) (t : Answer) : motive t
-/

end PropAnswer