/-
# Formalising *Principles of Mathematical Analysis* (Walter Rudin) in Lean

I will be using the mathlib version of `nat`, `int`, `rat` and `real` here...

Note that they are defined differently from those in IUM:

* The integers are defined as an inductive type with two constructors (nonneg, neg);
* The rationals are defined as an inductive type holding the numerator and denominator;
* The reals are defined as equivalence classes of Cauchy sequences.
-/

import data.nat.basic
import data.int.basic
import data.rat.basic
import data.real.basic
import data.complex.basic
import data.list

import tactic
import tactic.rewrite_search.frontend

noncomputable theory

--------------------------------------------------------------------------------
-- **The real field** in Lean

section
  variables (x y z : ℝ)
  variables (S : set ℝ)

  #check real.field
  #check real.linear_order
  #check real.linear_ordered_field

-- Field axioms
  #check add_assoc x y z                --  x + y + z = x + (y + z)
  #check add_zero x                     --/ x + 0 = x
  #check zero_add x                     --\ 0 + x = x
  #check add_right_neg x                --/ x + -x = 0
  #check add_left_neg x                 --\ -x + x = 0
  #check add_comm x y                   --  x + y = y + x

  #check mul_assoc x y z                --  x * y * z = x * (y * z)
  #check @zero_ne_one ℝ _ _             --/ 0 ≠ 1
  #check @one_ne_zero ℝ _ _             --\ 1 ≠ 0
  #check mul_one x                      --/ x * 1 = x
  #check one_mul x                      --\ 1 * x = x
  #check @mul_inv_cancel _ _ x          --/ x ≠ 0 → x * x⁻¹ = 1
  #check @inv_mul_cancel _ _ x          --\ x ≠ 0 → x⁻¹ * x = 1
  #check mul_comm x y                   --  x * y = y * x

  #check mul_add x y z                  --/ x * (y + z) = x * y + x * z
  #check add_mul x y z                  --\ (x + y) * z = x * z + y * z

-- Conversion between lt and le
  #check @le_iff_lt_or_eq _ _ x y       --/ x ≤ y ↔ x < y ∨ x = y
  #check @lt_iff_le_and_ne _ _ x y      --\ x < y ↔ x ≤ y ∧ x ≠ y

-- Total order axioms (lt)
  #check lt_irrefl x                    --  ¬x < x
  #check @lt_trans _ _ x y z            --  x < y → y < z → x < z
  #check lt_trichotomy x y              --  x < y ∨ x = y ∨ y < x
-- Ordered field axioms (lt)
  #check @add_lt_add_right _ _ _ _ x y  --/ x < y → ∀ (z : ℝ), x + z < y + z
  #check @add_lt_add_left _ _ _ _ y z   --\ y < z → ∀ (x : ℝ), x + y < x + z
  #check @mul_pos _ _ x y               --  0 < x → 0 < y → 0 < x * y

-- Total order axioms (le)
  #check le_refl x                      --  x ≤ x
  #check @le_trans _ _ x y z            --  x ≤ y → y ≤ z → x ≤ z
  #check @le_antisymm _ _ x y           --  x ≤ y → y ≤ x → x = y
  #check le_total x y                   --  x ≤ y ∨ y ≤ x
-- Ordered field axioms (le)
  #check @add_le_add_right _ _ _ _ x y  --/ x ≤ y → ∀ (z : ℝ), x + z ≤ y + z
  #check @add_le_add_left _ _ _ _ y z   --\ y ≤ z → ∀ (x : ℝ), x + y ≤ x + z
  #check @mul_nonneg _ _ x y            --  0 ≤ x → 0 ≤ y → 0 ≤ x * y

-- Completeness axiom (existence & uniqueness of supremum)
  #check real.has_Sup
  #check Sup (λ x : ℝ, x < 1)           --  ℝ (noncomputable?)
  #check real.is_lub_Sup S              --  S.nonempty → bdd_above S → is_lub S (Sup S)

-- Miscellaneous
-- Conversion between minus and negation
  #check sub_eq_add_neg x y             --  x - y = x + -y  (also def eq)
-- Conversion between division and inverse
  #check div_eq_mul_inv x y             --  x / y = x * y⁻¹ (also def eq)
-- "smul by integer" as repeated addition
  #check nsmul 3 x                      --  ℝ (noncomputable?)
  #check gsmul (-3) x                   --  ℝ (noncomputable?)
-- "pow by integer" as repeated multiplication
  #check npow 3 x                       --  ℝ (noncomputable?)
  #check gpow (-3) x                    --  ℝ (noncomputable?)
-- Maximum and minimum (?)
end

--------------------------------------------------------------------------------
-- **The complex field** in Lean

section
  variables (x y z : ℂ)
  variables (a b c d : ℝ)

  #check complex.field

-- Definition as a structure with two ℝ's
-- Constructor
  #reduce complex.mk a b
  #reduce (⟨a, b⟩ : ℂ)
-- Projectors
  #check x.re                           --  ℝ
  #check x.im                           --  ℝ
-- Operations and identity elements
  example :  (⟨a, b⟩ : ℂ) + (⟨c, d⟩ : ℂ) = ⟨a + c, b + d⟩ := rfl
  example : -(⟨a, b⟩ : ℂ)                = ⟨-a, -b⟩       := rfl
  example :       (0 : ℂ)                = ⟨0, 0⟩         := rfl
  example :  (⟨a, b⟩ : ℂ) * (⟨c, d⟩ : ℂ) = ⟨a * c - b * d, a * d + b * c⟩ := rfl
  example :  (⟨a, b⟩ : ℂ)⁻¹              = ⟨a, -b⟩ * ↑((a * a + b * b)⁻¹) := rfl
  example :       (1 : ℂ)                = ⟨1, 0⟩         := rfl
  example :  (⟨a, b⟩ : ℂ).conj           = ⟨a, -b⟩        := rfl

-- Field axioms
  #check add_assoc x y z                --  x + y + z = x + (y + z)
  #check add_zero x                     --/ x + 0 = x
  #check zero_add x                     --\ 0 + x = x
  #check add_right_neg x                --/ x + -x = 0
  #check add_left_neg x                 --\ -x + x = 0
  #check add_comm x y                   --  x + y = y + x

  #check mul_assoc x y z                --  x * y * z = x * (y * z)
  #check @zero_ne_one ℝ _ _             --/ 0 ≠ 1
  #check @one_ne_zero ℝ _ _             --\ 1 ≠ 0
  #check mul_one x                      --/ x * 1 = x
  #check one_mul x                      --\ 1 * x = x
  #check @mul_inv_cancel _ _ x          --/ x ≠ 0 → x * x⁻¹ = 1
  #check @inv_mul_cancel _ _ x          --\ x ≠ 0 → x⁻¹ * x = 1
  #check mul_comm x y                   --  x * y = y * x

  #check mul_add x y z                  --/ x * (y + z) = x * y + x * z
  #check add_mul x y z                  --\ (x + y) * z = x * z + y * z

-- Miscellaneous
-- Conversion between minus and negation
  #check sub_eq_add_neg x y             --  x - y = x + -y  (also def eq)
-- Conversion between division and inverse
  #check div_eq_mul_inv x y             --  x / y = x * y⁻¹ (also def eq)
-- "smul by integer" as repeated addition
  #check nsmul 3 x                      --  ℝ (noncomputable?)
  #check gsmul (-3) x                   --  ℝ (noncomputable?)
-- "pow by integer" as repeated multiplication
  #check npow 3 x                       --  ℝ (noncomputable?)
  #check gpow (-3) x                    --  ℝ (noncomputable?)
-- Imaginary unit
  example : complex.I = ⟨0, 1⟩ := rfl
end

namespace notes

--------------------------------------------------------------------------------
-- **Ordered sets**

section

  def is_upper_bound {α : Type} [linear_order α] (E : set α) (a : α) : Prop :=
    ∀ e, e ∈ E → e ≤ a

  def is_lower_bound {α : Type} [linear_order α] (E : set α) (a : α) : Prop :=
    ∀ e, e ∈ E → a ≤ e

  @[class]
  structure bounded_above {α : Type} [linear_order α] (E : set α) : Type :=
    mk :: (a : α) (h : is_upper_bound E a)

  @[class]
  structure bounded_below {α : Type} [linear_order α] (E : set α) : Type :=
    mk :: (a : α) (h : is_lower_bound E a)

-- (TODO: complete)

end

--------------------------------------------------------------------------------
-- **Fields**
-- The following can be done using `simp` or `norm_num` (or even `library_search`!)
-- I did most by hand just to gain familiarity with field axioms (and their Lean names...)

-- (It would be better if we had an UI that completely avoids the use of "names" to refer to theorems...
--  i.e. use type ascriptions only, relying more heavily on library_search and unification algorithms)

section

  variables (α : Type) [field α]
  variables (x y z : α)

  section propositions_1_14

    #check @add_left_cancel _ _ x y z           -- x + y = x + z → y = z
    #check @add_right_cancel _ _ x y z          -- x + y = z + y → x = z
    example : x + y = x + z → y = z := by
    { intros h,
      calc  y
          = -x + (x + y) : by rw [← add_assoc, add_left_neg, zero_add]
      ... = -x + (x + z) : by rw h
      ... = z            : by rw [← add_assoc, add_left_neg, zero_add] }

    example : x + y = x → y = 0 := by
    { intros h,
      calc  y
          = -x + (x + y) : by rw [← add_assoc, add_left_neg, zero_add]
      ... = -x + x       : by rw h
      ... = 0            : by rw add_left_neg }

    example : x + y = 0 → y = -x := by
    { intros h,
      calc  y
          = -x + (x + y) : by rw [← add_assoc, add_left_neg, zero_add]
      ... = -x           : by rw [h, add_zero] }

    #check neg_neg x                            -- -(-x) = x
    example : -(-x) = x := by
    { calc  -(-x)
          = x + -x + -(-x) : by rw [add_right_neg, zero_add]
      ... = x              : by rw [add_assoc, add_right_neg, add_zero] }

  end propositions_1_14

  section propositions_1_15

    #check @mul_left_cancel₀ _ _ x y z          -- x ≠ 0 → x * y = x * z → y = z
    #check @mul_right_cancel₀ _ _ x y z         -- y ≠ 0 → x * y = z * y → x = z
    example : x ≠ 0 → x * y = x * z → y = z := by
    { intros hx h,
      calc  y
          = x⁻¹ * (x * y) : by rw [← mul_assoc, inv_mul_cancel hx, one_mul]
      ... = x⁻¹ * (x * z) : by rw h
      ... = z             : by rw [← mul_assoc, inv_mul_cancel hx, one_mul] }

    example : x ≠ 0 → x * y = x → y = 1 := by
    { intros hx h,
      calc  y
          = x⁻¹ * (x * y) : by rw [← mul_assoc, inv_mul_cancel hx, one_mul]
      ... = x⁻¹ * x       : by rw h
      ... = 1             : by rw [inv_mul_cancel hx] }

    example : x ≠ 0 → x * y = 1 → y = x⁻¹ := by
    { intros hx h,
      calc  y
          = x⁻¹ * (x * y) : by rw [← mul_assoc, inv_mul_cancel hx, one_mul]
      ... = x⁻¹           : by rw [h, mul_one] }

    #check inv_inv₀ x                           -- x⁻¹⁻¹ = x
    example : x ≠ 0 → x⁻¹⁻¹ = x := by
    { intros hx,
      calc  x⁻¹⁻¹
          = x * x⁻¹ * x⁻¹⁻¹ : by rw [mul_inv_cancel hx, one_mul]
      ... = x               : by simp [hx] }    -- tql (alternatively, prove x⁻¹ = 0 → false by x * x⁻¹ = 0 = 1)

  end propositions_1_15

  section propositions_1_16

    #check zero_mul x                           -- 0 * x = 0
    #check mul_zero x                           -- x * 0 = 0
    example : 0 * x = 0 := by
    { calc  0 * x
          = 0 * x + 1 * x + -(1 * x) : by rw [add_assoc, add_right_neg, add_zero]
      ... = (0 + 1) * x + -(1 * x)   : by rw add_mul
      ... = 0                        : by rw [zero_add, add_right_neg] }

    #check @mul_ne_zero _ _ _ x y               -- x ≠ 0 → y ≠ 0 → x * y ≠ 0
    example : x ≠ 0 → y ≠ 0 → x * y ≠ 0 := by
    { intros hx hy h,
      have : (1 : α) = 0,
      { calc  1
            = x⁻¹ * x * (y⁻¹ * y) : by rw [inv_mul_cancel hx, inv_mul_cancel hy, mul_one]
        ... = x⁻¹ * y⁻¹ * (x * y) : by rw [mul_assoc, ← mul_assoc x, mul_comm x, mul_assoc y⁻¹, ← mul_assoc]
        ... = 0                   : by rw [h, mul_zero] },
      exact one_ne_zero this }

    #check neg_eq_neg_one_mul x                 -- -x = -1 * x
    example : -x = -1 * x := by
    { calc  -x
          = -x + (1 + -1) * x : by rw [add_right_neg, zero_mul, add_zero]
      ... = -x + x + -1 * x   : by rw [add_mul, one_mul, ← add_assoc]
      ... = -1 * x            : by rw [add_left_neg, zero_add] }

    example : -x * y = -(x * y) := by
    { calc  -x * y
          = -1 * x * y : by simp
      ... = -(x * y)   : by simp }

    example : x * -y = -(x * y) := by
    { calc  x * -y
          = x * -1 * y : by simp
      ... = -1 * x * y : by simp
      ... = -(x * y)   : by simp }

    example : -x * -y = x * y := by
    { calc  -x * -y
          = -1 * x * -1 * y : by simp
      ... = -(-1) * x * y   : by simp
      ... = x * y           : by simp }

  end propositions_1_16

end

section

  variables (α : Type) [linear_ordered_field α]
  variables (x y z : α)

  section propositions_1_18

    #check @neg_lt_zero _ _ _ _ x               -- -x < 0 ↔ 0 < x
    example : 0 < x ↔ -x < 0 := by
    { split,
      { intros h,
        calc  -x
            = -x + 0 : by rw add_zero
        ... < -x + x : add_lt_add_left h (-x)
        ... = 0      : by rw add_left_neg },
      { intros h,
        calc  0
            = x + -x : by rw add_right_neg
        ... < x + 0  : add_lt_add_left h x
        ... = x      : by rw add_zero }}

    #check @mul_lt_mul_left _ _ y z x           -- 0 < x → (x * y < x * z ↔ y < z)
    #check @mul_lt_mul_right _ _ y z x          -- 0 < x → (y * x < z * x ↔ y < z)
    example : 0 < x → y < z → x * y < x * z := by
    { intros hx h,
      let a := z + -y,
      have ha : 0 < a,
      { have := add_lt_add_right h (-y),
        rw add_right_neg at this,
        exact this },
      have h₁ : x * y < x * y + x * a,
      { have : 0 < x * a := mul_pos hx ha,
        replace this := add_lt_add_left this (x * y),
        rw add_zero at this,
        exact this },
      calc  x * y
          < x * (y + a)        : by { rw mul_add, exact h₁ }
      ... = x * (y + (z + -y)) : rfl
      ... = x * z              : by { rw [add_comm z, ← add_assoc, add_right_neg, zero_add] }}

    #check @mul_lt_mul_left_of_neg _ _ y z x    -- x < 0 → (x * y < x * z ↔ z < y)
    #check @mul_lt_mul_right_of_neg _ _ y z x   -- x < 0 → (y * x < z * x ↔ z < y)
    example : x < 0 → y < z → x * z < x * y := by
    { intros hx h,
      let a := z + -y,
      have ha : 0 < a,
      { have := add_lt_add_right h (-y),
        rw add_right_neg at this,
        exact this },
      have h₁ : x * y + x * a < x * y,
      { have : 0 < -x * a,
        { have hnx : 0 < -x,
          { calc  0
                = -x + x : by rw add_left_neg
            ... < -x + 0 : add_lt_add_left hx (-x)
            ... = -x     : by rw add_zero },
          exact mul_pos hnx ha },
        replace this := add_lt_add_left this (x * y),
        rw add_zero at this,
        replace this := add_lt_add_right this (x * a),
        rw [add_assoc, ← add_mul, add_left_neg, zero_mul, add_zero] at this,
        exact this },
      calc  x * z
          = x * (y + (z + -y)) : by { rw [add_comm z, ← add_assoc, add_right_neg, zero_add] }
      ... = x * (y + a)        : rfl
      ... < x * y              : by { rw mul_add, exact h₁ }}

    #check @mul_self_pos _ _ x                  -- x ≠ 0 → 0 < x * x
    example : x ≠ 0 → 0 < x * x := by
    { intros hx',
      rcases lt_trichotomy x 0 with (hx|hx|hx),
      { have : x * 0 < x * x := (mul_lt_mul_left_of_neg hx).mpr hx,
        rw mul_zero at this,
        exact this },
      { exfalso, exact hx' hx },
      { have : x * 0 < x * x := (mul_lt_mul_left hx).mpr hx,
        rw mul_zero at this,
        exact this }}

    #check zero_lt_one                          -- 0 < 1
    #check neg_one_lt_zero                      -- -1 < 0
    example : (0 : α) < 1 := by
    { have : (0 : α) < 1 * 1 := mul_self_pos one_ne_zero,
      rw mul_one at this,
      exact this }

    #check @inv_pos _ _ x                       -- 0 < x⁻¹ ↔ 0 < x
    example : 0 < x → 0 < x⁻¹ := by
    { intros hx,
      have hx₀ : x ≠ 0, { intros hx', rw hx' at hx, exact lt_irrefl 0 hx },
      rcases lt_trichotomy x⁻¹ 0 with (h|h|h),
      { exfalso,
        have := (mul_lt_mul_left hx).mpr h,
        rw [mul_inv_cancel hx₀, mul_zero] at this,
        exact lt_irrefl _ (lt_trans zero_lt_one this) },
      { exfalso,
        have : x * x⁻¹ = 0, { rw [h, mul_zero] },
        rw mul_inv_cancel hx₀ at this,
        exact one_ne_zero this },
      { exact h }}

-- example (hx : 0 < x) (h : x < y) : y⁻¹ < x⁻¹ := by library_search!
    example : 0 < x → x < y → y⁻¹ < x⁻¹ := by
    { intros hx h,
      have hy := lt_trans hx h,
      have := (mul_lt_mul_left (inv_pos.mpr hx)).mpr h,
      rw inv_mul_cancel (λ hx' : x = 0, by { rw hx' at hx, exact lt_irrefl _ hx }) at this,
      replace this := (mul_lt_mul_right (inv_pos.mpr hy)).mpr this,
      rw mul_assoc at this,
      rw mul_inv_cancel (λ hy' : y = 0, by { rw hy' at hy, exact lt_irrefl _ hy }) at this,
      rw [one_mul, mul_one] at this,
      exact this }

  end propositions_1_18

-- Some other useful lemmas
  lemma le_iff_not_gt : x ≤ y ↔ ¬ y < x := by
  { split,
    { intros h h',
      rcases le_iff_lt_or_eq.mp h with (h₁|h₁),
      { exact lt_irrefl _ (lt_trans h' h₁) }, { rw h₁ at h', exact lt_irrefl _ h' }},
    { intros h,
      apply le_iff_lt_or_eq.mpr,
      rcases lt_trichotomy x y with (h₁|h₁|h₁),
      { exact or.inl h₁ }, { exact or.inr h₁ }, { exfalso, exact h h₁ }}}
  #check @lt_iff_not_ge _ _ x y                 -- x < y ↔ ¬y ≤ x (def eq)
  #check @le_iff_not_gt _ _ x y                 -- x ≤ y ↔ ¬y < x

end

--------------------------------------------------------------------------------
-- **The real field**

section
-- (TODO: `has_coe ℚ ℝ`)

  variables (x y z : ℝ)

  #check real.archimedean.arch
  theorem real.archimedean' : 0 < x → ∃ n : ℕ, y < n • x := by
-- Proof using the least-upper-bound property
  { intros hx,
    -- Assume otherwise...
    by_contra,
    -- Let A be the set of all nx's...
    let A : set ℝ := (λ z : ℝ, ∃ n : ℕ, z = n • x),
    -- Clearly A is nonempty, and bounded above by y...
    have hne  : A.nonempty := ⟨1 • x, ⟨1, rfl⟩⟩,
    have hbdd : bdd_above A,
    { use y,
      rintros z ⟨n, hn⟩,
      apply (le_iff_not_gt _ _ _).mpr,
      intros hyz,
      apply h, use n,
      rw ← hn, exact hyz },
    -- So we let a := sup A...
    let a := Sup A,
    rcases (real.is_lub_Sup A hne hbdd) with ⟨ha₁, ha₂⟩,
    unfold lower_bounds at ha₂,
    -- And let b := a - x...
    let b := a + -x,
    -- Then b < mx for some m : ℕ (since a is least)...
    have hb : ∃ m : ℕ, b < m • x,
    { by_contra,
      have hb' : b ∈ upper_bounds A,
      { rintros z ⟨mz, hz⟩,
        apply (le_iff_not_gt _ _ _).mpr,
        intros hbz,
        apply h, use mz, rw ← hz, exact hbz },
      replace hb' := ha₂ hb',
      change Sup A ≤ Sup A - x at hb',
      linarith only [hb', hx] },
    rcases hb with ⟨m, hb⟩,
    -- Then a < (m + 1) x, contradiction (since a is upper bound)...
    have h₁ : a < (m + 1) • x,
    { rw [add_smul, one_smul],
      have : a + -x < m • x + x + -x,
      { rw [add_assoc, add_right_neg, add_zero], exact hb },
      replace this := add_lt_add_right this x,
      simp only [add_assoc, add_left_neg, add_zero] at this,
      exact this },
    have : (m + 1) • x ∈ A := ⟨m + 1, rfl⟩,
    specialize ha₁ this,
    change Sup A < (m + 1) • x at h₁,
    linarith only [h₁, ha₁] }

  theorem real.rat_dense' : x < y → ∃ p : ℚ, x < ↑p ∧ ↑p < y := by
-- Proof using the Archimedean property
  { intros h,
    -- Since y - x > 0, we have an n : ℕ such that n (y - x) > 1...
    -- (1 / n < y - x will be our "unit")
    have hyx : 0 < y + -x,
    { have := add_lt_add_right h (-x),
      rw add_right_neg at this,
      exact this },
    rcases real.archimedean' _ 1 hyx with ⟨n, hn⟩,
    -- Also, there are (m₁ m₂ : ℕ) such that -m₁ < nx < m₂...
    rcases real.archimedean' 1 (-(n • x)) zero_lt_one with ⟨m₁, hm₁⟩,
    rw [nat.smul_one_eq_coe] at hm₁,
    replace hm₁ : - ↑m₁ < n • x,
    { replace hm₁ := (mul_lt_mul_left_of_neg neg_one_lt_zero).mpr hm₁,
      simp only [← neg_eq_neg_one_mul, neg_neg] at hm₁,
      exact hm₁ },
    rcases real.archimedean' 1 (n • x) zero_lt_one with ⟨m₂, hm₂⟩,
    rw [nat.smul_one_eq_coe] at hm₂,
    -- So, there is an m : ℤ such that m - 1 ≤ nx < m...
    let m : ℤ := sorry,
    have hml : ↑(m + -1) ≤ n • x := sorry,
    have hmr : n • x < ↑m        := sorry,
    -- Then m ≤ nx + 1 < ny...
    replace hml : ↑m ≤ n • x + 1,
    { sorry },
    -- So x < m / n < y...
    use (↑m : ℚ) / (↑n : ℚ), split,
    { sorry },
    { sorry }}

  theorem real.exists_nth_root' : 0 ≤ x → ∀ n : ℕ, n ≠ 0 → ∃! y : ℝ, npow n y = x := by
  { intros hx n hn,
    -- Let E be the set consisting of all t : ℝ such that t > 0 and t^n < x...
    let E : set ℝ := (λ t, 0 < t ∧ npow n t < x),
    -- E is nonempty, since x / (x + 1) is in E...
    -- E is bounded above by x + 1...
    -- So we let y := sup E...
    -- Lemma: b^n - a^n < (b - a) n b^(n - 1)...
    -- * If y^n < x, choose h such that 0 < h < 1 and h < (x - y^n) / (n (y + 1)^(n - 1))...
    --   Then (y + h)^n - y^n < h n (y + h)^(n - 1) < h n (y + 1)^(n - 1) < x - y^n...
    --   So (y + h)^n < x, contradiction...
    -- * If y^n = x, all good...
    -- * If x < y^n, choose k := (y^n - x) / (n y^(n - 1)), then 0 < k < y...
    --   * For all t such that y - k ≤ t, y^n - t^n ≤ y^n - (y - k)^n < k n y^(n - 1) = y^n - x...
    --     So t^n > x, so t is not in E...
    --   So y - k is an upper bound of E, contradiction...
    sorry  }

  -- lemma...
  -- (I might be giving up on this...)

end

--------------------------------------------------------------------------------
-- **The extended real number system**
-- (Nothing to do here...?)

--------------------------------------------------------------------------------
-- **The complex field**

section

  variables (a b : ℝ)
  variables (z w : ℂ)

  example : (⟨a, 0⟩ : ℂ) + ⟨b, 0⟩ = ⟨a + b, 0⟩ := by
  { have : (⟨a, 0⟩ : ℂ) + ⟨b, 0⟩ = ⟨a + b, 0 + 0⟩ := rfl,
    rw add_zero at this,
    exact this }

  example : (⟨a, 0⟩ : ℂ) * ⟨b, 0⟩ = ⟨a * b, 0⟩ := by
  { have : (⟨a, 0⟩ : ℂ) * ⟨b, 0⟩ = ⟨a * b - 0 * 0, a * 0 + 0 * b⟩ := rfl,
    simp at this,
    exact this }

  example : complex.I = (⟨0, 1⟩ : ℂ)           := rfl
  example : complex.I * complex.I = -1         := by simp
  example : (⟨a, b⟩ : ℂ) = ↑a + ↑b * complex.I := by
  { unfold complex.I,
    change (⟨a, b⟩ : ℂ) = ⟨a + (b * 0 - 0 * 1), 0 + (b * 1 + 0 * 0)⟩,
    simp }

  section theorems_1_31

    example : (z + w).conj = z.conj + w.conj := by
    { unfold complex.conj, -- what? sorry.
      sorry }

    example : (z * w).conj = z.conj * w.conj := by
    { sorry }

    example : z + z.conj = 2 * z.re := by
    { sorry }

    example : z - z.conj = 2 * complex.I * z.im := by
    { sorry }

    -- (TODO: How to express "a complex number is real" in Lean?)
    -- (d)

  end theorems_1_31

  #print complex.abs                            --  real.sqrt (⇑complex.norm_sq z)

end

--------------------------------------------------------------------------------
-- **Euclidean spaces**

end notes


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module data.set.countable
! leanprover-community/mathlib commit 1f0096e6caa61e9c849ec2adbd227e960e9dff58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Finite
import Mathlib.Data.Countable.Basic
import Mathlib.Logic.Equiv.List

/-!
# Countable sets
-/

noncomputable section

open Function Set Encodable Classical

universe u v w x

variable {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

namespace Set

/-- A set is countable if there exists an encoding of the set into the natural numbers.
An encoding is an injection with a partial inverse, which can be viewed as a
constructive analogue of countability. (For the most part, theorems about
`Countable` will be classical and `Encodable` will be constructive.)
-/
protected def Countable (s : Set α) : Prop :=
  Nonempty (Encodable s)
#align set.countable Set.Countable

@[simp]
theorem countable_coe_iff {s : Set α} : Countable s ↔ s.Countable :=
  Encodable.nonempty_encodable.symm
#align set.countable_coe_iff Set.countable_coe_iff

/-- Prove `Set.Countable` from a `Countable` instance on the subtype. -/
theorem to_countable (s : Set α) [Countable s] : s.Countable :=
  countable_coe_iff.mp ‹_›
#align set.to_countable Set.to_countable

/-- Restate `Set.Countable` as a `Countable` instance. -/
alias countable_coe_iff ↔ _root_.Countable.to_set Countable.to_subtype
#align countable.to_set Countable.to_set
#align set.countable.to_subtype Set.Countable.to_subtype

protected theorem countable_iff_exists_injective {s : Set α} :
    s.Countable ↔ ∃ f : s → ℕ, Injective f :=
  countable_coe_iff.symm.trans (countable_iff_exists_injective s)
#align set.countable_iff_exists_injective Set.countable_iff_exists_injective

/-- A set `s : Set α` is countable if and only if there exists a function `α → ℕ` injective
on `s`. -/
theorem countable_iff_exists_injOn {s : Set α} : s.Countable ↔ ∃ f : α → ℕ, InjOn f s :=
  Set.countable_iff_exists_injective.trans exists_injOn_iff_injective.symm
#align set.countable_iff_exists_inj_on Set.countable_iff_exists_injOn

/-- Convert `Set.Countable s` to `Encodable s` (noncomputable). -/
protected def Countable.toEncodable {s : Set α} : s.Countable → Encodable s :=
  Classical.choice
#align set.countable.to_encodable Set.Countable.toEncodable

section Enumerate

/-- Noncomputably enumerate elements in a set. The `default` value is used to extend the domain to
all of `ℕ`. -/
def enumerateCountable {s : Set α} (h : s.Countable) (default : α) : ℕ → α := fun n =>
  match @Encodable.decode s h.toEncodable n with
  | some y => y
  | none => default
#align set.enumerate_countable Set.enumerateCountable

theorem subset_range_enumerate {s : Set α} (h : s.Countable) (default : α) :
    s ⊆ range (enumerateCountable h default) := fun x hx =>
  ⟨@Encodable.encode s h.toEncodable ⟨x, hx⟩, by
    letI := h.toEncodable
    simp [enumerateCountable, Encodable.encodek]⟩
#align set.subset_range_enumerate Set.subset_range_enumerate

end Enumerate

theorem Countable.mono {s₁ s₂ : Set α} (h : s₁ ⊆ s₂) : s₂.Countable → s₁.Countable
  | ⟨H⟩ => ⟨@ofInj _ _ H _ (embeddingOfSubset _ _ h).2⟩
#align set.countable.mono Set.Countable.mono

theorem countable_range [Countable ι] (f : ι → β) : (range f).Countable :=
  surjective_onto_range.countable.to_set
#align set.countable_range Set.countable_range

theorem countable_iff_exists_subset_range [Nonempty α] {s : Set α} :
    s.Countable ↔ ∃ f : ℕ → α, s ⊆ range f :=
  ⟨fun h => by
    inhabit α
    exact ⟨enumerateCountable h default, subset_range_enumerate _ _⟩, fun ⟨f, hsf⟩ =>
    (countable_range f).mono hsf⟩
#align set.countable_iff_exists_subset_range Set.countable_iff_exists_subset_range

/-- A non-empty set is countable iff there exists a surjection from the
natural numbers onto the subtype induced by the set.
-/
protected theorem countable_iff_exists_surjective {s : Set α} (hs : s.Nonempty) :
    s.Countable ↔ ∃ f : ℕ → s, Surjective f :=
  countable_coe_iff.symm.trans <| @countable_iff_exists_surjective s hs.to_subtype
#align set.countable_iff_exists_surjective Set.countable_iff_exists_surjective

alias Set.countable_iff_exists_surjective ↔ Countable.exists_surjective _
#align set.countable.exists_surjective Set.Countable.exists_surjective

theorem countable_univ [Countable α] : (univ : Set α).Countable :=
  to_countable univ
#align set.countable_univ Set.countable_univ

/-- If `s : Set α` is a nonempty countable set, then there exists a map
`f : ℕ → α` such that `s = range f`. -/
theorem Countable.exists_eq_range {s : Set α} (hc : s.Countable) (hs : s.Nonempty) :
    ∃ f : ℕ → α, s = range f := by
  rcases hc.exists_surjective hs with ⟨f, hf⟩
  refine' ⟨(↑) ∘ f, _⟩
  rw [hf.range_comp, Subtype.range_coe]
#align set.countable.exists_eq_range Set.Countable.exists_eq_range

@[simp] theorem countable_empty : (∅ : Set α).Countable := to_countable _
#align set.countable_empty Set.countable_empty

@[simp] theorem countable_singleton (a : α) : ({a} : Set α).Countable := to_countable _
#align set.countable_singleton Set.countable_singleton

theorem Countable.image {s : Set α} (hs : s.Countable) (f : α → β) : (f '' s).Countable := by
  rw [image_eq_range]
  haveI := hs.to_subtype
  apply countable_range
#align set.countable.image Set.Countable.image

theorem MapsTo.countable_of_injOn {s : Set α} {t : Set β} {f : α → β} (hf : MapsTo f s t)
    (hf' : InjOn f s) (ht : t.Countable) : s.Countable :=
  have : Injective (hf.restrict f s t) := (injOn_iff_injective.1 hf').codRestrict _
  ⟨@Encodable.ofInj _ _ ht.toEncodable _ this⟩
#align set.maps_to.countable_of_inj_on Set.MapsTo.countable_of_injOn

theorem Countable.preimage_of_injOn {s : Set β} (hs : s.Countable) {f : α → β}
    (hf : InjOn f (f ⁻¹' s)) : (f ⁻¹' s).Countable :=
  (mapsTo_preimage f s).countable_of_injOn hf hs
#align set.countable.preimage_of_inj_on Set.Countable.preimage_of_injOn

protected theorem Countable.preimage {s : Set β} (hs : s.Countable) {f : α → β} (hf : Injective f) :
    (f ⁻¹' s).Countable :=
  hs.preimage_of_injOn (hf.injOn _)
#align set.countable.preimage Set.Countable.preimage

theorem exists_seq_supᵢ_eq_top_iff_countable [CompleteLattice α] {p : α → Prop} (h : ∃ x, p x) :
    (∃ s : ℕ → α, (∀ n, p (s n)) ∧ (⨆ n, s n) = ⊤) ↔
      ∃ S : Set α, S.Countable ∧ (∀ s ∈ S, p s) ∧ supₛ S = ⊤ := by
  constructor
  · rintro ⟨s, hps, hs⟩
    refine' ⟨range s, countable_range s, forall_range_iff.2 hps, _⟩
    rwa [supₛ_range]
  · rintro ⟨S, hSc, hps, hS⟩
    rcases eq_empty_or_nonempty S with (rfl | hne)
    · rw [supₛ_empty] at hS
      haveI := subsingleton_of_bot_eq_top hS
      rcases h with ⟨x, hx⟩
      exact ⟨fun _ => x, fun _ => hx, Subsingleton.elim _ _⟩
    · rcases(Set.countable_iff_exists_surjective hne).1 hSc with ⟨s, hs⟩
      refine' ⟨fun n => s n, fun n => hps _ (s n).coe_prop, _⟩
      rwa [hs.supᵢ_comp, ← supₛ_eq_supᵢ']
#align set.exists_seq_supr_eq_top_iff_countable Set.exists_seq_supᵢ_eq_top_iff_countable

theorem exists_seq_cover_iff_countable {p : Set α → Prop} (h : ∃ s, p s) :
    (∃ s : ℕ → Set α, (∀ n, p (s n)) ∧ (⋃ n, s n) = univ) ↔
      ∃ S : Set (Set α), S.Countable ∧ (∀ s ∈ S, p s) ∧ ⋃₀ S = univ :=
  exists_seq_supᵢ_eq_top_iff_countable h
#align set.exists_seq_cover_iff_countable Set.exists_seq_cover_iff_countable

theorem countable_of_injective_of_countable_image {s : Set α} {f : α → β} (hf : InjOn f s)
    (hs : (f '' s).Countable) : s.Countable :=
  (mapsTo_image _ _).countable_of_injOn hf hs
#align set.countable_of_injective_of_countable_image Set.countable_of_injective_of_countable_image

theorem countable_unionᵢ {t : ι → Set α} [Countable ι] (ht : ∀ i, (t i).Countable) :
    (⋃ i, t i).Countable := by
  haveI := fun a => (ht a).to_subtype
  rw [unionᵢ_eq_range_psigma]
  apply countable_range
#align set.countable_Union Set.countable_unionᵢ

@[simp]
theorem countable_unionᵢ_iff [Countable ι] {t : ι → Set α} :
    (⋃ i, t i).Countable ↔ ∀ i, (t i).Countable :=
  ⟨fun h _ => h.mono <| subset_unionᵢ _ _, countable_unionᵢ⟩
#align set.countable_Union_iff Set.countable_unionᵢ_iff

theorem Countable.bunionᵢ_iff {s : Set α} {t : ∀ a ∈ s, Set β} (hs : s.Countable) :
    (⋃ a ∈ s, t a ‹_›).Countable ↔ ∀ a (ha : a ∈ s), (t a ha).Countable := by
  haveI := hs.to_subtype
  rw [bunionᵢ_eq_unionᵢ, countable_unionᵢ_iff, SetCoe.forall']
#align set.countable.bUnion_iff Set.Countable.bunionᵢ_iff

theorem Countable.unionₛ_iff {s : Set (Set α)} (hs : s.Countable) :
    (⋃₀ s).Countable ↔ ∀ a ∈ s, (a : _).Countable := by rw [unionₛ_eq_bunionᵢ, hs.bunionᵢ_iff]
#align set.countable.sUnion_iff Set.Countable.unionₛ_iff

alias Countable.bunionᵢ_iff ↔ _ Countable.bunionᵢ
#align set.countable.bUnion Set.Countable.bunionᵢ

alias Countable.unionₛ_iff ↔ _ Countable.unionₛ
#align set.countable.sUnion Set.Countable.unionₛ

@[simp]
theorem countable_union {s t : Set α} : (s ∪ t).Countable ↔ s.Countable ∧ t.Countable := by
  simp [union_eq_unionᵢ, and_comm]
#align set.countable_union Set.countable_union

theorem Countable.union {s t : Set α} (hs : s.Countable) (ht : t.Countable) : (s ∪ t).Countable :=
  countable_union.2 ⟨hs, ht⟩
#align set.countable.union Set.Countable.union

theorem Countable.of_diff {s t : Set α} (h : (s \ t).Countable) (ht : t.Countable) : s.Countable :=
  (h.union ht).mono (subset_diff_union _ _)

@[simp]

theorem Countable.insert {s : Set α} (a : α) (h : s.Countable) : (insert a s).Countable :=
  countable_insert.2 h
#align set.countable.insert Set.Countable.insert

theorem Finite.countable {s : Set α} : s.Finite → s.Countable
  | ⟨_⟩ => Trunc.nonempty (Fintype.truncEncodable s)
#align set.finite.countable Set.Finite.countable

@[nontriviality]
theorem Countable.of_subsingleton [Subsingleton α] (s : Set α) : s.Countable :=
  (Finite.of_subsingleton s).countable
#align set.countable.of_subsingleton Set.Countable.of_subsingleton

theorem Subsingleton.countable {s : Set α} (hs : s.Subsingleton) : s.Countable :=
  hs.finite.countable
#align set.subsingleton.countable Set.Subsingleton.countable

theorem countable_isTop (α : Type _) [PartialOrder α] : { x : α | IsTop x }.Countable :=
  (finite_isTop α).countable
#align set.countable_is_top Set.countable_isTop

theorem countable_isBot (α : Type _) [PartialOrder α] : { x : α | IsBot x }.Countable :=
  (finite_isBot α).countable
#align set.countable_is_bot Set.countable_isBot

/-- The set of finite subsets of a countable set is countable. -/
theorem countable_setOf_finite_subset {s : Set α} (hs : s.Countable) :
    { t | Set.Finite t ∧ t ⊆ s }.Countable := by
  haveI := hs.to_subtype
  refine' Countable.mono _ (countable_range fun t : Finset s => Subtype.val '' (t : Set s))
  rintro t ⟨ht, hts⟩
  lift t to Set s using hts
  lift t to Finset s using ht.of_finite_image (Subtype.val_injective.injOn _)
  exact mem_range_self _
#align set.countable_set_of_finite_subset Set.countable_setOf_finite_subset

theorem countable_univ_pi {π : α → Type _} [Finite α] {s : ∀ a, Set (π a)}
    (hs : ∀ a, (s a).Countable) : (pi univ s).Countable :=
  haveI := fun a => (hs a).to_subtype
  (Countable.of_equiv _ (Equiv.Set.univPi s).symm).to_set
#align set.countable_univ_pi Set.countable_univ_pi

theorem countable_pi {π : α → Type _} [Finite α] {s : ∀ a, Set (π a)} (hs : ∀ a, (s a).Countable) :
    { f : ∀ a, π a | ∀ a, f a ∈ s a }.Countable := by
  simpa only [← mem_univ_pi] using countable_univ_pi hs
#align set.countable_pi Set.countable_pi

protected theorem Countable.prod {s : Set α} {t : Set β} (hs : s.Countable) (ht : t.Countable) :
    Set.Countable (s ×ˢ t) := by
  haveI : Countable s := hs.to_subtype
  haveI : Countable t := ht.to_subtype
  exact (Countable.of_equiv _ <| (Equiv.Set.prod _ _).symm).to_set
#align set.countable.prod Set.Countable.prod

theorem Countable.image2 {s : Set α} {t : Set β} (hs : s.Countable) (ht : t.Countable)
    (f : α → β → γ) : (image2 f s t).Countable := by
  rw [← image_prod]
  exact (hs.prod ht).image _
#align set.countable.image2 Set.Countable.image2

end Set

theorem Finset.countable_toSet (s : Finset α) : Set.Countable (↑s : Set α) :=
  s.finite_toSet.countable
#align finset.countable_to_set Finset.countable_toSet


/-
Copyright (c) 2019 Amelia Livingston. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Amelia Livingston, Bryan Gin-ge Chen, Patrick Massot
-/

import data.fintype.basic
import data.set.finite
import data.setoid.basic

/-!
# Equivalence relations: partitions

This file comprises properties of equivalence relations viewed as partitions.
There are two implementations of partitions here:
* A collection `c : set (set α)` of sets is a partition of `α` if `∅ ∉ c` and each element `a : α`
  belongs to a unique set `b ∈ c`. This is expressed as `is_partition c`
* An indexed partition is a map `s : ι → α` whose image is a partition. This is
  expressed as `indexed_partition s`.

Of course both implementations are related to `quotient` and `setoid`.

## Tags

setoid, equivalence, iseqv, relation, equivalence relation, partition, equivalence class
-/

namespace setoid

variables {α : Type*}

/-- If x ∈ α is in 2 elements of a set of sets partitioning α, those 2 sets are equal. -/
lemma eq_of_mem_eqv_class {c : set (set α)} (H : ∀ a, ∃! b ∈ c, a ∈ b)
  {x b b'} (hc : b ∈ c) (hb : x ∈ b) (hc' : b' ∈ c) (hb' : x ∈ b') :
  b = b' :=
(H x).unique2 hc hb hc' hb'

/-- Makes an equivalence relation from a set of sets partitioning α. -/
def mk_classes (c : set (set α)) (H : ∀ a, ∃! b ∈ c, a ∈ b) :
  setoid α :=
⟨λ x y, ∀ s ∈ c, x ∈ s → y ∈ s, ⟨λ _ _ _ hx, hx,
 λ x y h s hs hy, (H x).elim2 $ λ t ht hx _,
   have s = t, from eq_of_mem_eqv_class H hs hy ht (h t ht hx),
   this.symm ▸ hx,
 λ x y z h1 h2 s hs hx, (H y).elim2 $ λ t ht hy _, (H z).elim2 $ λ t' ht' hz _,
   have hst : s = t, from eq_of_mem_eqv_class H hs (h1 _ hs hx) ht hy,
   have htt' : t = t', from eq_of_mem_eqv_class H ht (h2 _ ht hy) ht' hz,
   (hst.trans htt').symm ▸ hz⟩⟩

/-- Makes the equivalence classes of an equivalence relation. -/
def classes (r : setoid α) : set (set α) :=
{s | ∃ y, s = {x | r.rel x y}}

lemma mem_classes (r : setoid α) (y) : {x | r.rel x y} ∈ r.classes := ⟨y, rfl⟩

lemma classes_ker_subset_fiber_set {β : Type*} (f : α → β) :
  (setoid.ker f).classes ⊆ set.range (λ y, {x | f x = y}) :=
by { rintro s ⟨x, rfl⟩, rw set.mem_range, exact ⟨f x, rfl⟩ }

lemma nonempty_fintype_classes_ker {α β : Type*} [fintype β] (f : α → β) :
  nonempty (fintype (setoid.ker f).classes) :=
by { classical, exact ⟨set.fintype_subset _ (classes_ker_subset_fiber_set f)⟩ }

lemma card_classes_ker_le {α β : Type*} [fintype β]
  (f : α → β) [fintype (setoid.ker f).classes] :
  fintype.card (setoid.ker f).classes ≤ fintype.card β :=
begin
  classical,
  exact le_trans (set.card_le_of_subset (classes_ker_subset_fiber_set f)) (fintype.card_range_le _)
end

/-- Two equivalence relations are equal iff all their equivalence classes are equal. -/
lemma eq_iff_classes_eq {r₁ r₂ : setoid α} :
  r₁ = r₂ ↔ ∀ x, {y | r₁.rel x y} = {y | r₂.rel x y} :=
⟨λ h x, h ▸ rfl, λ h, ext' $ λ x, set.ext_iff.1 $ h x⟩

lemma rel_iff_exists_classes (r : setoid α) {x y} :
  r.rel x y ↔ ∃ c ∈ r.classes, x ∈ c ∧ y ∈ c :=
⟨λ h, ⟨_, r.mem_classes y, h, r.refl' y⟩,
  λ ⟨c, ⟨z, hz⟩, hx, hy⟩, by { subst c, exact r.trans' hx (r.symm' hy) }⟩

/-- Two equivalence relations are equal iff their equivalence classes are equal. -/
lemma classes_inj {r₁ r₂ : setoid α} :
  r₁ = r₂ ↔ r₁.classes = r₂.classes :=
⟨λ h, h ▸ rfl, λ h, ext' $ λ a b, by simp only [rel_iff_exists_classes, exists_prop, h] ⟩

/-- The empty set is not an equivalence class. -/
lemma empty_not_mem_classes {r : setoid α} : ∅ ∉ r.classes :=
λ ⟨y, hy⟩, set.not_mem_empty y $ hy.symm ▸ r.refl' y

/-- Equivalence classes partition the type. -/
lemma classes_eqv_classes {r : setoid α} (a) : ∃! b ∈ r.classes, a ∈ b :=
exists_unique.intro2 {x | r.rel x a} (r.mem_classes a) (r.refl' _) $
begin
  rintros _ ⟨y, rfl⟩ ha,
  ext x,
  exact ⟨λ hx, r.trans' hx (r.symm' ha), λ hx, r.trans' hx ha⟩
end

/-- If x ∈ α is in 2 equivalence classes, the equivalence classes are equal. -/
lemma eq_of_mem_classes {r : setoid α} {x b} (hc : b ∈ r.classes)
  (hb : x ∈ b) {b'} (hc' : b' ∈ r.classes) (hb' : x ∈ b') : b = b' :=
eq_of_mem_eqv_class classes_eqv_classes hc hb hc' hb'

/-- The elements of a set of sets partitioning α are the equivalence classes of the
    equivalence relation defined by the set of sets. -/
lemma eq_eqv_class_of_mem {c : set (set α)}
  (H : ∀ a, ∃! b ∈ c, a ∈ b) {s y} (hs : s ∈ c) (hy : y ∈ s) :
  s = {x | (mk_classes c H).rel x y} :=
set.ext $ λ x,
  ⟨λ hs', symm' (mk_classes c H) $ λ b' hb' h', eq_of_mem_eqv_class H hs hy hb' h' ▸ hs',
   λ hx, (H x).elim2 $ λ b' hc' hb' h',
     (eq_of_mem_eqv_class H hs hy hc' $ hx b' hc' hb').symm ▸ hb'⟩

/-- The equivalence classes of the equivalence relation defined by a set of sets
    partitioning α are elements of the set of sets. -/
lemma eqv_class_mem {c : set (set α)} (H : ∀ a, ∃! b ∈ c, a ∈ b) {y} :
  {x | (mk_classes c H).rel x y} ∈ c :=
(H y).elim2 $ λ b hc hy hb, eq_eqv_class_of_mem H hc hy ▸ hc

lemma eqv_class_mem' {c : set (set α)} (H : ∀ a, ∃! b ∈ c, a ∈ b) {x} :
  {y : α | (mk_classes c H).rel x y} ∈ c :=
by { convert setoid.eqv_class_mem H, ext, rw setoid.comm' }

/-- Distinct elements of a set of sets partitioning α are disjoint. -/
lemma eqv_classes_disjoint {c : set (set α)} (H : ∀ a, ∃! b ∈ c, a ∈ b) :
  c.pairwise_disjoint id :=
λ b₁ h₁ b₂ h₂ h, set.disjoint_left.2 $
  λ x hx1 hx2, (H x).elim2 $ λ b hc hx hb, h $ eq_of_mem_eqv_class H h₁ hx1 h₂ hx2

/-- A set of disjoint sets covering α partition α (classical). -/
lemma eqv_classes_of_disjoint_union {c : set (set α)}
  (hu : set.sUnion c = @set.univ α) (H : c.pairwise_disjoint id) (a) :
  ∃! b ∈ c, a ∈ b :=
let ⟨b, hc, ha⟩ := set.mem_sUnion.1 $ show a ∈ _, by rw hu; exact set.mem_univ a in
  exists_unique.intro2 b hc ha $ λ b' hc' ha', H.elim_set hc' hc a ha' ha

/-- Makes an equivalence relation from a set of disjoints sets covering α. -/
def setoid_of_disjoint_union {c : set (set α)} (hu : set.sUnion c = @set.univ α)
  (H : c.pairwise_disjoint id) : setoid α :=
setoid.mk_classes c $ eqv_classes_of_disjoint_union hu H

/-- The equivalence relation made from the equivalence classes of an equivalence
    relation r equals r. -/
theorem mk_classes_classes (r : setoid α) :
  mk_classes r.classes classes_eqv_classes = r :=
ext' $ λ x y, ⟨λ h, r.symm' (h {z | r.rel z x} (r.mem_classes x) $ r.refl' x),
  λ h b hb hx, eq_of_mem_classes (r.mem_classes x) (r.refl' x) hb hx ▸ r.symm' h⟩

@[simp] theorem sUnion_classes (r : setoid α) : ⋃₀ r.classes = set.univ :=
set.eq_univ_of_forall $ λ x, set.mem_sUnion.2 ⟨{ y | r.rel y x }, ⟨x, rfl⟩, setoid.refl _⟩

section partition

/-- A collection `c : set (set α)` of sets is a partition of `α` into pairwise
disjoint sets if `∅ ∉ c` and each element `a : α` belongs to a unique set `b ∈ c`. -/
def is_partition (c : set (set α)) :=
∅ ∉ c ∧ ∀ a, ∃! b ∈ c, a ∈ b

/-- A partition of `α` does not contain the empty set. -/
lemma nonempty_of_mem_partition {c : set (set α)} (hc : is_partition c) {s} (h : s ∈ c) :
  s.nonempty :=
set.ne_empty_iff_nonempty.1 $ λ hs0, hc.1 $ hs0 ▸ h

lemma is_partition_classes (r : setoid α) : is_partition r.classes :=
⟨empty_not_mem_classes, classes_eqv_classes⟩

lemma is_partition.pairwise_disjoint {c : set (set α)} (hc : is_partition c) :
  c.pairwise_disjoint id :=
eqv_classes_disjoint hc.2

lemma is_partition.sUnion_eq_univ {c : set (set α)} (hc : is_partition c) :
  ⋃₀ c = set.univ :=
set.eq_univ_of_forall $ λ x, set.mem_sUnion.2 $
  let ⟨t, ht⟩ := hc.2 x in ⟨t, by clear_aux_decl; finish⟩

/-- All elements of a partition of α are the equivalence class of some y ∈ α. -/
lemma exists_of_mem_partition {c : set (set α)} (hc : is_partition c) {s} (hs : s ∈ c) :
  ∃ y, s = {x | (mk_classes c hc.2).rel x y} :=
let ⟨y, hy⟩ := nonempty_of_mem_partition hc hs in
  ⟨y, eq_eqv_class_of_mem hc.2 hs hy⟩

/-- The equivalence classes of the equivalence relation defined by a partition of α equal
    the original partition. -/
theorem classes_mk_classes (c : set (set α)) (hc : is_partition c) :
  (mk_classes c hc.2).classes = c :=
set.ext $ λ s,
  ⟨λ ⟨y, hs⟩, (hc.2 y).elim2 $ λ b hm hb hy,
    by rwa (show s = b, from hs.symm ▸ set.ext
      (λ x, ⟨λ hx, symm' (mk_classes c hc.2) hx b hm hb,
             λ hx b' hc' hx', eq_of_mem_eqv_class hc.2 hm hx hc' hx' ▸ hb⟩)),
   exists_of_mem_partition hc⟩

/-- Defining `≤` on partitions as the `≤` defined on their induced equivalence relations. -/
instance partition.le : has_le (subtype (@is_partition α)) :=
⟨λ x y, mk_classes x.1 x.2.2 ≤ mk_classes y.1 y.2.2⟩

/-- Defining a partial order on partitions as the partial order on their induced
    equivalence relations. -/
instance partition.partial_order : partial_order (subtype (@is_partition α)) :=
{ le := (≤),
  lt := λ x y, x ≤ y ∧ ¬y ≤ x,
  le_refl := λ _, @le_refl (setoid α) _ _,
  le_trans := λ _ _ _, @le_trans (setoid α) _ _ _ _,
  lt_iff_le_not_le := λ _ _, iff.rfl,
  le_antisymm := λ x y hx hy, let h := @le_antisymm (setoid α) _ _ _ hx hy in by
    rw [subtype.ext_iff_val, ←classes_mk_classes x.1 x.2, ←classes_mk_classes y.1 y.2, h] }

variables (α)

/-- The order-preserving bijection between equivalence relations on a type `α`, and
  partitions of `α` into subsets. -/
protected def partition.order_iso :
  setoid α ≃o {C : set (set α) // is_partition C} :=
{ to_fun := λ r, ⟨r.classes, empty_not_mem_classes, classes_eqv_classes⟩,
  inv_fun := λ C, mk_classes C.1 C.2.2,
  left_inv := mk_classes_classes,
  right_inv := λ C, by rw [subtype.ext_iff_val, ←classes_mk_classes C.1 C.2],
  map_rel_iff' := λ r s,
    by { conv_rhs { rw [←mk_classes_classes r, ←mk_classes_classes s] }, refl } }

variables {α}

/-- A complete lattice instance for partitions; there is more infrastructure for the
    equivalent complete lattice on equivalence relations. -/
instance partition.complete_lattice : complete_lattice (subtype (@is_partition α)) :=
galois_insertion.lift_complete_lattice $ @order_iso.to_galois_insertion
_ (subtype (@is_partition α)) _ (partial_order.to_preorder _) $ partition.order_iso α

end partition

end setoid

/-- Constructive information associated with a partition of a type `α` indexed by another type `ι`,
`s : ι → set α`.

`indexed_partition.index` sends an element to its index, while `indexed_partition.some` sends
an index to an element of the corresponding set.

This type is primarily useful for definitional control of `s` - if this is not needed, then
`setoid.ker index` by itself may be sufficient. -/
structure indexed_partition {ι α : Type*} (s : ι → set α) :=
(eq_of_mem : ∀ {x i j}, x ∈ s i → x ∈ s j → i = j)
(some : ι → α)
(some_mem : ∀ i, some i ∈ s i)
(index : α → ι)
(mem_index : ∀ x, x ∈ s (index x))

/-- The non-constructive constructor for `indexed_partition`. -/
noncomputable
def indexed_partition.mk' {ι α : Type*} (s : ι → set α) (dis : ∀ i j, i ≠ j → disjoint (s i) (s j))
  (nonempty : ∀ i, (s i).nonempty) (ex : ∀ x, ∃ i, x ∈ s i) : indexed_partition s :=
{ eq_of_mem := λ x i j hxi hxj, classical.by_contradiction $ λ h, dis _ _ h ⟨hxi, hxj⟩,
  some := λ i, (nonempty i).some,
  some_mem := λ i, (nonempty i).some_spec,
  index := λ x, (ex x).some,
  mem_index := λ x, (ex x).some_spec }

namespace indexed_partition

open set

variables {ι α : Type*} {s : ι → set α} (hs : indexed_partition s)

/-- On a unique index set there is the obvious trivial partition -/
instance [unique ι] [inhabited α] :
  inhabited (indexed_partition (λ i : ι, (set.univ : set α))) :=
⟨{ eq_of_mem := λ x i j hi hj, subsingleton.elim _ _,
   some := λ i, default α,
   some_mem := set.mem_univ,
   index := λ a, default ι,
   mem_index := set.mem_univ }⟩

attribute [simp] some_mem mem_index

include hs

lemma exists_mem (x : α) : ∃ i, x ∈ s i := ⟨hs.index x, hs.mem_index x⟩

lemma Union : (⋃ i, s i) = univ :=
by { ext x, simp [hs.exists_mem x] }

lemma disjoint : ∀ {i j}, i ≠ j → disjoint (s i) (s j) :=
λ i j h x ⟨hxi, hxj⟩, h (hs.eq_of_mem hxi hxj)

lemma mem_iff_index_eq {x i} : x ∈ s i ↔ hs.index x = i :=
⟨λ hxi, (hs.eq_of_mem hxi (hs.mem_index x)).symm, λ h, h ▸ hs.mem_index _⟩

lemma eq (i) : s i = {x | hs.index x = i} :=
set.ext $ λ _, hs.mem_iff_index_eq

/-- The equivalence relation associated to an indexed partition. Two
elements are equivalent if they belong to the same set of the partition. -/
protected abbreviation setoid (hs : indexed_partition s) : setoid α :=
setoid.ker hs.index

@[simp]

lemma some_index (x : α) : hs.setoid.rel (hs.some (hs.index x)) x :=
hs.index_some (hs.index x)

/-- The quotient associated to an indexed partition. -/
protected def quotient := quotient hs.setoid

/-- The projection onto the quotient associated to an indexed partition. -/
def proj : α → hs.quotient := quotient.mk'

instance [inhabited α] : inhabited (hs.quotient) := ⟨hs.proj (default α)⟩

lemma proj_eq_iff {x y : α} : hs.proj x = hs.proj y ↔ hs.index x = hs.index y :=
quotient.eq_rel

@[simp] lemma proj_some_index (x : α) : hs.proj (hs.some (hs.index x)) = hs.proj x :=
quotient.eq'.2 (hs.some_index x)

/-- The obvious equivalence between the quotient associated to an indexed partition and
the indexing type. -/
def equiv_quotient : ι ≃ hs.quotient :=
(setoid.quotient_ker_equiv_of_right_inverse hs.index hs.some $ hs.index_some).symm

@[simp] lemma equiv_quotient_index_apply (x : α) : hs.equiv_quotient (hs.index x) = hs.proj x :=
hs.proj_eq_iff.mpr (some_index hs x)

@[simp] lemma equiv_quotient_symm_proj_apply (x : α) :
  hs.equiv_quotient.symm (hs.proj x) = hs.index x :=
rfl

lemma equiv_quotient_index : hs.equiv_quotient ∘ hs.index = hs.proj :=
funext hs.equiv_quotient_index_apply

/-- A map choosing a representative for each element of the quotient associated to an indexed
partition. This is a computable version of `quotient.out'` using `indexed_partition.some`. -/
def out : hs.quotient ↪ α :=
hs.equiv_quotient.symm.to_embedding.trans ⟨hs.some, function.left_inverse.injective hs.index_some⟩

/-- This lemma is analogous to `quotient.mk_out'`. -/
@[simp]
lemma out_proj (x : α) : hs.out (hs.proj x) = hs.some (hs.index x) :=
rfl

/-- The indices of `quotient.out'` and `indexed_partition.out` are equal. -/
lemma index_out' (x : hs.quotient) : hs.index (x.out') = hs.index (hs.out x) :=
quotient.induction_on' x $ λ x, (setoid.ker_apply_mk_out' x).trans (hs.index_some _).symm

/-- This lemma is analogous to `quotient.out_eq'`. -/
@[simp] lemma proj_out (x : hs.quotient) : hs.proj (hs.out x) = x :=
quotient.induction_on' x $ λ x, quotient.sound' $ hs.some_index x

lemma class_of {x : α} : set_of (hs.setoid.rel x) = s (hs.index x) :=
set.ext $ λ y, eq_comm.trans hs.mem_iff_index_eq.symm

lemma proj_fiber (x : hs.quotient) : hs.proj ⁻¹' {x} = s (hs.equiv_quotient.symm x) :=
quotient.induction_on' x $ λ x, begin
  ext y,
  simp only [set.mem_preimage, set.mem_singleton_iff, hs.mem_iff_index_eq],
  exact quotient.eq',
end

end indexed_partition


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.big_operators.basic
import data.nat.prime
import data.zmod.basic
import ring_theory.multiplicity
import data.nat.periodic
import algebra.char_p.two

/-!
# Euler's totient function

This file defines [Euler's totient function](https://en.wikipedia.org/wiki/Euler's_totient_function)
`nat.totient n` which counts the number of naturals less than `n` that are coprime with `n`.
We prove the divisor sum formula, namely that `n` equals `φ` summed over the divisors of `n`. See
`sum_totient`. We also prove two lemmas to help compute totients, namely `totient_mul` and
`totient_prime_pow`.
-/

open finset
open_locale big_operators

namespace nat

/-- Euler's totient function. This counts the number of naturals strictly less than `n` which are
coprime with `n`. -/
def totient (n : ℕ) : ℕ := ((range n).filter n.coprime).card

localized "notation `φ` := nat.totient" in nat

@[simp] theorem totient_zero : φ 0 = 0 := rfl

@[simp] theorem totient_one : φ 1 = 1 :=
by simp [totient]

lemma totient_eq_card_coprime (n : ℕ) : φ n = ((range n).filter n.coprime).card := rfl

lemma totient_le (n : ℕ) : φ n ≤ n :=
calc totient n ≤ (range n).card : card_filter_le _ _
           ... = n              : card_range _

lemma totient_lt (n : ℕ) (hn : 1 < n) : φ n < n :=
calc totient n ≤ ((range n).filter (≠ 0)).card :
  begin
    apply card_le_of_subset (monotone_filter_right _ _),
    intros n1 hn1 hn1',
    simpa only [hn1', coprime_zero_right, hn.ne'] using hn1,
  end
... = n - 1 : by simp only [filter_ne' (range n) 0, card_erase_of_mem, n.pred_eq_sub_one,
                card_range, pos_of_gt hn, mem_range]
... < n : nat.sub_lt (pos_of_gt hn) zero_lt_one

lemma totient_pos : ∀ {n : ℕ}, 0 < n → 0 < φ n
| 0 := dec_trivial
| 1 := by simp [totient]
| (n+2) := λ h, card_pos.2 ⟨1, mem_filter.2 ⟨mem_range.2 dec_trivial, coprime_one_right _⟩⟩

lemma filter_coprime_Ico_eq_totient (a n : ℕ) :
  ((Ico n (n+a)).filter (coprime a)).card = totient a :=
begin
  rw [totient, filter_Ico_card_eq_of_periodic, count_eq_card_filter_range],
  exact periodic_coprime a,
end

lemma Ico_filter_coprime_le {a : ℕ} (k n : ℕ) (a_pos : 0 < a) :
  ((Ico k (k + n)).filter (coprime a)).card ≤ totient a * (n / a + 1) :=
begin
  conv_lhs { rw ←nat.mod_add_div n a },
  induction n / a with i ih,
  { rw ←filter_coprime_Ico_eq_totient a k,
    simp only [add_zero, mul_one, mul_zero, le_of_lt (mod_lt n a_pos)],
    mono,
    refine monotone_filter_left a.coprime _,
    simp only [finset.le_eq_subset],
    exact Ico_subset_Ico rfl.le (add_le_add_left (le_of_lt (mod_lt n a_pos)) k), },
  simp only [mul_succ],
  simp_rw ←add_assoc at ih ⊢,
  calc (filter a.coprime (Ico k (k + n % a + a * i + a))).card
      = (filter a.coprime (Ico k (k + n % a + a * i)
                            ∪ Ico (k + n % a + a * i) (k + n % a + a * i + a))).card :
        begin
          congr,
          rw Ico_union_Ico_eq_Ico,
          rw add_assoc,
          exact le_self_add,
          exact le_self_add,
        end
  ... ≤ (filter a.coprime (Ico k (k + n % a + a * i))).card + a.totient :
        begin
          rw [filter_union, ←filter_coprime_Ico_eq_totient a (k + n % a + a * i)],
          apply card_union_le,
        end
  ... ≤ a.totient * i + a.totient + a.totient : add_le_add_right ih (totient a),
end

open zmod

/-- Note this takes an explicit `fintype ((zmod n)ˣ)` argument to avoid trouble with instance
diamonds. -/
@[simp] lemma _root_.zmod.card_units_eq_totient (n : ℕ) [fact (0 < n)] [fintype ((zmod n)ˣ)] :
  fintype.card ((zmod n)ˣ) = φ n :=
calc fintype.card ((zmod n)ˣ) = fintype.card {x : zmod n // x.val.coprime n} :
  fintype.card_congr zmod.units_equiv_coprime
... = φ n :
begin
  apply finset.card_congr (λ (a : {x : zmod n // x.val.coprime n}) _, a.1.val),
  { intro a, simp [(a : zmod n).val_lt, a.prop.symm] {contextual := tt} },
  { intros _ _ _ _ h, rw subtype.ext_iff_val, apply val_injective, exact h, },
  { intros b hb,
    rw [finset.mem_filter, finset.mem_range] at hb,
    refine ⟨⟨b, _⟩, finset.mem_univ _, _⟩,
    { let u := unit_of_coprime b hb.2.symm,
      exact val_coe_unit_coprime u },
    { show zmod.val (b : zmod n) = b,
      rw [val_nat_cast, nat.mod_eq_of_lt hb.1], } }
end

lemma totient_even {n : ℕ} (hn : 2 < n) : even n.totient :=
begin
  haveI : fact (1 < n) := ⟨one_lt_two.trans hn⟩,
  suffices : 2 = order_of (-1 : (zmod n)ˣ),
  { rw [← zmod.card_units_eq_totient, even_iff_two_dvd, this], exact order_of_dvd_card_univ },
  rw [←order_of_units, units.coe_neg_one, order_of_neg_one, ring_char.eq (zmod n) n, if_neg hn.ne'],
end

lemma totient_mul {m n : ℕ} (h : m.coprime n) : φ (m * n) = φ m * φ n :=
if hmn0 : m * n = 0
  then by cases nat.mul_eq_zero.1 hmn0 with h h;
    simp only [totient_zero, mul_zero, zero_mul, h]
  else
  begin
    haveI : fact (0 < (m * n)) := ⟨nat.pos_of_ne_zero hmn0⟩,
    haveI : fact (0 < m) := ⟨nat.pos_of_ne_zero $ left_ne_zero_of_mul hmn0⟩,
    haveI : fact (0 < n) := ⟨nat.pos_of_ne_zero $ right_ne_zero_of_mul hmn0⟩,
    rw [← zmod.card_units_eq_totient, ← zmod.card_units_eq_totient,
      ← zmod.card_units_eq_totient, fintype.card_congr
      (units.map_equiv (zmod.chinese_remainder h).to_mul_equiv).to_equiv,
      fintype.card_congr (@mul_equiv.prod_units (zmod m) (zmod n) _ _).to_equiv,
      fintype.card_prod]
  end

/-- When `p` is prime, then the totient of `p ^ (n + 1)` is `p ^ n * (p - 1)` -/
lemma totient_prime_pow_succ {p : ℕ} (hp : p.prime) (n : ℕ) :
  φ (p ^ (n + 1)) = p ^ n * (p - 1) :=
calc φ (p ^ (n + 1))
    = ((range (p ^ (n + 1))).filter (coprime (p ^ (n + 1)))).card :
  totient_eq_card_coprime _
... = (range (p ^ (n + 1)) \ ((range (p ^ n)).image (* p))).card :
  congr_arg card begin
    rw [sdiff_eq_filter],
    apply filter_congr,
    simp only [mem_range, mem_filter, coprime_pow_left_iff n.succ_pos,
      mem_image, not_exists, hp.coprime_iff_not_dvd],
    intros a ha,
    split,
    { rintros hap b _ rfl,
      exact hap (dvd_mul_left _ _) },
    { rintros h ⟨b, rfl⟩,
      rw [pow_succ] at ha,
      exact h b (lt_of_mul_lt_mul_left ha (zero_le _)) (mul_comm _ _) }
  end
... = _ :
have h1 : set.inj_on (* p) (range (p ^ n)),
  from λ x _ y _, (nat.mul_left_inj hp.pos).1,
have h2 : (range (p ^ n)).image (* p) ⊆ range (p ^ (n + 1)),
  from λ a, begin
    simp only [mem_image, mem_range, exists_imp_distrib],
    rintros b h rfl,
    rw [pow_succ'],
    exact (mul_lt_mul_right hp.pos).2 h
  end,
begin
  rw [card_sdiff h2, card_image_of_inj_on h1, card_range,
    card_range, ← one_mul (p ^ n), pow_succ, ← tsub_mul,
    one_mul, mul_comm]
end

/-- When `p` is prime, then the totient of `p ^ n` is `p ^ (n - 1) * (p - 1)` -/
lemma totient_prime_pow {p : ℕ} (hp : p.prime) {n : ℕ} (hn : 0 < n) :
  φ (p ^ n) = p ^ (n - 1) * (p - 1) :=
by rcases exists_eq_succ_of_ne_zero (pos_iff_ne_zero.1 hn) with ⟨m, rfl⟩;
  exact totient_prime_pow_succ hp _

lemma totient_prime {p : ℕ} (hp : p.prime) : φ p = p - 1 :=
by rw [← pow_one p, totient_prime_pow hp]; simp

lemma totient_mul_of_prime_of_dvd {p n : ℕ} (hp : p.prime) (h : p ∣ n) :
  (p * n).totient = p * n.totient :=
begin
  by_cases hzero : n = 0,
  { simp [hzero] },
  { have hfin := (multiplicity.finite_nat_iff.2 ⟨hp.ne_one, zero_lt_iff.2 hzero⟩),
    have h0 : 0 < (multiplicity p n).get hfin := multiplicity.pos_of_dvd hfin h,
    obtain ⟨m, hm, hndiv⟩ := multiplicity.exists_eq_pow_mul_and_not_dvd hfin,
    rw [hm, ← mul_assoc, ← pow_succ, nat.totient_mul (coprime_comm.mp (hp.coprime_pow_of_not_dvd
      hndiv)), nat.totient_mul (coprime_comm.mp (hp.coprime_pow_of_not_dvd hndiv)), ← mul_assoc],
    congr,
    rw [ ← succ_pred_eq_of_pos h0, totient_prime_pow_succ hp, totient_prime_pow_succ hp,
      succ_pred_eq_of_pos h0, ← mul_assoc p, ← pow_succ, ← succ_pred_eq_of_pos h0, nat.pred_succ] }
end

lemma totient_eq_iff_prime {p : ℕ} (hp : 0 < p) : p.totient = p - 1 ↔ p.prime :=
begin
  refine ⟨λ h, _, totient_prime⟩,
  replace hp : 1 < p,
  { apply lt_of_le_of_ne,
    { rwa succ_le_iff },
    { rintro rfl,
      rw [totient_one, tsub_self] at h,
      exact one_ne_zero h } },
  rw [totient_eq_card_coprime, range_eq_Ico, ←Ico_insert_succ_left hp.le, finset.filter_insert,
      if_neg (not_coprime_of_dvd_of_dvd hp (dvd_refl p) (dvd_zero p)), ←nat.card_Ico 1 p] at h,
  refine p.prime_of_coprime hp (λ n hn hnz, finset.filter_card_eq h n $ finset.mem_Ico.mpr ⟨_, hn⟩),
  rwa [succ_le_iff, pos_iff_ne_zero],
end

lemma card_units_zmod_lt_sub_one {p : ℕ} (hp : 1 < p) [fintype ((zmod p)ˣ)] :
  fintype.card ((zmod p)ˣ) ≤ p - 1 :=
begin
  haveI : fact (0 < p) := ⟨zero_lt_one.trans hp⟩,
  rw zmod.card_units_eq_totient p,
  exact nat.le_pred_of_lt (nat.totient_lt p hp),
end

lemma prime_iff_card_units (p : ℕ) [fintype ((zmod p)ˣ)] :
  p.prime ↔ fintype.card ((zmod p)ˣ) = p - 1 :=
begin
  by_cases hp : p = 0,
  { substI hp,
    simp only [zmod, not_prime_zero, false_iff, zero_tsub],
    -- the substI created an non-defeq but subsingleton instance diamond; resolve it
    suffices : fintype.card ℤˣ ≠ 0, { convert this },
    simp },
  haveI : fact (0 < p) := ⟨nat.pos_of_ne_zero hp⟩,
  rw [zmod.card_units_eq_totient, nat.totient_eq_iff_prime (fact.out (0 < p))],
end

@[simp] lemma totient_two : φ 2 = 1 :=
(totient_prime prime_two).trans (by norm_num)

end nat


import algebra.big_operators.basic data.nat.digits

/-! # IMO 2010 A4 -/

namespace IMOSL
namespace IMO2010A4

open finset

def x : ℕ → bool := nat.binary_rec ff (λ odd k, bxor (bor odd k.bodd))
def S (n : ℕ) : ℤ := (range n).sum (λ k, cond (x k) (-1) 1)

section x_prop

private lemma x_zero : x 0 = ff := nat.binary_rec_zero ff _

private lemma x_mul2 (k : ℕ) : x (2 * k) = bxor k.bodd (x k) :=
begin
  rw [x, ← nat.bit0_val],
  refine nat.binary_rec_eq _ ff k,
  rw [ff_bor, bxor_ff, nat.bodd_zero]
end

private lemma x_mul2_add1 (k : ℕ) : x (2 * k + 1) = !(x k) :=
begin
  rw [x, ← nat.bit1_val, ← tt_bxor],
  refine nat.binary_rec_eq _ tt k,
  rw [ff_bor, bxor_ff, nat.bodd_zero]
end

private lemma x_mul4_lem1 (k : ℕ) : x (4 * k + 1) = !(x (4 * k)) :=
  by rw [bit0, ← two_mul, mul_assoc, x_mul2, x_mul2_add1, ← nat.bit0_val, nat.bodd_bit0, ff_bxor]

private lemma x_mul4_lem2 (k : ℕ) : x (4 * k + 2) = x k :=
  by rw [bit0, ← two_mul, mul_assoc, ← mul_add_one, x_mul2,
    x_mul2_add1, ← nat.bit1_val, nat.bodd_bit1, tt_bxor, bnot_bnot]

private lemma x_mul4_lem3 (k : ℕ) : x (4 * k + 3) = x k :=
  by rw [bit0, ← two_mul, bit1, ← add_assoc, mul_assoc,
    ← mul_add_one, x_mul2_add1, x_mul2_add1, bnot_bnot]

end x_prop

section S_prop

private lemma S_zero : S 0 = 0 := rfl

private lemma S_succ (a : ℕ) : S a.succ = S a + cond (x a) (-1) 1 :=
  sum_range_succ _ a

private lemma S_mul4_add2 (k : ℕ) : S (4 * k + 2) = S (4 * k) :=
begin
  rw [S_succ, S_succ, add_assoc, add_right_eq_self, x_mul4_lem1],
  generalize : x (4 * k) = b,
  cases b; refl
end

private lemma S_mul4 : ∀ k : ℕ, S (4 * k) = 2 * S k
| 0 := rfl
| (k+1) := by rw [nat.mul_succ, bit0, S_succ, x_mul4_lem3, S_succ, x_mul4_lem2,
  S_mul4_add2, S_mul4, add_assoc, ← two_mul, ← mul_add, ← S_succ]

private lemma S_parity : ∀ k : ℕ, (S k).bodd = k.bodd
| 0 := rfl
| (k+1) := begin
  rw [nat.bodd_succ, S_succ, int.bodd_add, S_parity, ← bxor_tt],
  generalize : x k = b,
  cases b; refl
end

private lemma S_four_mul_add_eq_zero_iff (q : ℕ) {r : ℕ} (h : r < 4) :
  S (4 * q + r) = 0 ↔ S q = 0 ∧ (r = 0 ∨ r = 2) :=
begin
  ---- If `S_q = 0` and `r ∈ {0, 2}`, then `S_{4q + r} = 0`
  symmetry; refine ⟨λ h0, _, λ h0, (and_iff_right_of_imp _).mpr _⟩,
  rcases h0 with ⟨h0, rfl | rfl⟩,
  rw [add_zero, S_mul4, h0, mul_zero],
  rw [S_mul4_add2, S_mul4, h0, mul_zero],

  ---- If `S_{4q + r} = 0` and `r ∈ {0, 2}`, then `S_q = 0`
  replace h : (2 : ℤ) ≠ 0 := two_ne_zero,
  rintros (rfl | rfl),
  rwa [add_zero, S_mul4, mul_eq_zero, or_iff_right h] at h0,
  rwa [S_mul4_add2, S_mul4, mul_eq_zero, or_iff_right h] at h0,

  ---- If `S_{4q + r} = 0`, then `r ∈ {0, 2}`
  apply_fun int.bodd at h0,
  rw [int.bodd_zero, S_parity, nat.bodd_add, nat.bodd_mul, nat.bodd_bit0, ff_band, ff_bxor] at h0,
  iterate 3 { rw nat.lt_succ_iff_lt_or_eq at h },
  rw [nat.lt_one_iff, or_assoc, or_or_or_comm] at h,
  revert h; refine (or_iff_left _).mp,
  rintros (rfl | rfl); exact tt_eq_ff_eq_false h0
end

end S_prop

/-- Final solution -/
theorem final_solution : ∀ k : ℕ, 0 ≤ S k :=
begin
  ---- Reduce to showing that `x_k = ff` whenever `S_k = 0`
  suffices : ∀ k : ℕ, S k = 0 → x k = ff,
  { intros k; induction k with k k_ih,
    rw S_zero,
    rw [le_iff_lt_or_eq, int.lt_iff_add_one_le, zero_add, or_comm] at k_ih,
    rw S_succ; cases k_ih with h h,
    rw [← h, zero_add, this k h.symm, bool.cond_ff]; exact zero_le_one,
    rw ← add_neg_self (1 : ℤ); refine add_le_add h _,
    generalize : x k = b,
    clear this h k; cases b,
    rw [bool.cond_ff, neg_le_self_iff]; exact zero_le_one,
    rw bool.cond_tt },

  ---- Now show that `x_k = ff` whenever `S_k = 0`, using strong induction
  intros k h; induction k using nat.strong_induction_on with k k_ih,
  obtain ⟨q, r, h0, rfl⟩ : ∃ q r : ℕ, r < 4 ∧ 4 * q + r = k :=
    ⟨k / 4, k % 4, nat.mod_lt k four_pos, nat.div_add_mod k 4⟩,
  rw [S_four_mul_add_eq_zero_iff q h0, or_comm] at h,
  clear h0; rcases h with ⟨h, rfl | rfl⟩,
  rw x_mul4_lem2; exact k_ih q (lt_add_of_le_of_pos (nat.le_mul_of_pos_left four_pos) two_pos) h,
  rcases q.eq_zero_or_pos with rfl | h0,
  rw [add_zero, mul_zero, x_zero],
  replace k_ih := k_ih q (lt_mul_left h0 $ nat.succ_lt_succ $ nat.succ_pos 2) h,
  apply_fun int.bodd at h; rw [int.bodd_zero, S_parity] at h,
  rw [add_zero, bit0, ← two_mul, mul_assoc, x_mul2, nat.bodd_mul,
      nat.bodd_bit0, ff_band, ff_bxor, x_mul2, h, k_ih, ff_bxor]
end

/-- Extra part -/
theorem final_solution_extra (k : ℕ) :
  S k = 0 ↔ ∀ c : ℕ, c ∈ nat.digits 4 k → c = 0 ∨ c = 2 :=
begin
  induction k using nat.strong_induction_on with k k_ih,
  obtain ⟨q, r, h, rfl⟩ : ∃ q r : ℕ, r < 4 ∧ 4 * q + r = k :=
    ⟨k / 4, k % 4, nat.mod_lt k four_pos, nat.div_add_mod k 4⟩,
  rw S_four_mul_add_eq_zero_iff q h,
  rcases q.eq_zero_or_pos with rfl | h0,

  ---- Case 1: `q = 0`
  rw [S_zero, eq_self_iff_true, true_and, mul_zero, zero_add],
  rcases r.eq_zero_or_pos with rfl | h0,
  rw [eq_self_iff_true, true_or, true_iff, nat.digits_zero],
  intros c h0; exfalso; exact h0,
  rw [nat.digits_def' (le_add_self : 2 ≤ 2 + 2) h0,
      nat.mod_eq_of_lt h, nat.div_eq_zero h, nat.digits_zero],
  simp_rw list.mem_singleton; rw forall_eq,

  ---- Case 2: `0 < q`
  replace k_ih := k_ih q (nat.lt_add_right q (4 * q) r (lt_mul_left h0 (by norm_num : 1 < 4))),
  rw [k_ih, add_comm, nat.digits_add 4 le_add_self r q h (or.inr h0)]; clear k_ih h h0,
  simp_rw list.mem_cons_iff; rw [forall_eq_or_imp, and_comm]
end

end IMO2010A4
end IMOSL


-- Theorems/Exercises from "Logical Investigations, with the Nuprl Proof Assistant"
-- by Robert L. Constable and Anne Trostle
-- http://www.nuprl.org/MathLibrary/LogicalInvestigations/
import logic

-- 2. The Minimal Implicational Calculus
theorem thm1 {A B : Prop} : A → B → A :=
assume Ha Hb, Ha

theorem thm2 {A B C : Prop} : (A → B) → (A → B → C) → (A → C) :=
assume Hab Habc Ha,
  Habc Ha (Hab Ha)

theorem thm3 {A B C : Prop} : (A → B) → (B → C) → (A → C) :=
assume Hab Hbc Ha,
  Hbc (Hab Ha)

-- 3. False Propositions and Negation
theorem thm4 {P Q : Prop} : ¬P → P → Q :=
assume Hnp Hp,
  absurd Hp Hnp

theorem thm5 {P : Prop} : P → ¬¬P :=
assume (Hp : P) (HnP : ¬P),
  absurd Hp HnP

theorem thm6 {P Q : Prop} : (P → Q) → (¬Q → ¬P) :=
assume (Hpq : P → Q) (Hnq : ¬Q) (Hp : P),
  have Hq : Q, from Hpq Hp,
  show false, from absurd Hq Hnq

theorem thm7 {P Q : Prop} : (P → ¬P) → (P → Q) :=
assume Hpnp Hp,
  absurd Hp (Hpnp Hp)

theorem thm8 {P Q : Prop} : ¬(P → Q) → (P → ¬Q) :=
assume (Hn : ¬(P → Q)) (Hp : P) (Hq : Q),
  -- Rermak we don't even need the hypothesis Hp
  have H : P → Q, from assume H', Hq,
  absurd H Hn

-- 4. Conjunction and Disjunction
theorem thm9 {P : Prop} : (P ∨ ¬P) → (¬¬P → P) :=
assume (em : P ∨ ¬P) (Hnn : ¬¬P),
  or.elim em
    (assume Hp, Hp)
    (assume Hn, absurd Hn Hnn)

theorem thm10 {P : Prop} : ¬¬(P ∨ ¬P) :=
assume Hnem : ¬(P ∨ ¬P),
  have Hnp : ¬P, from
    assume Hp : P,
      have Hem : P ∨ ¬P, from or.inl Hp,
      absurd Hem Hnem,
  have Hem : P ∨ ¬P, from or.inr Hnp,
  absurd Hem Hnem

theorem thm11 {P Q : Prop} : ¬P ∨ ¬Q → ¬(P ∧ Q) :=
assume (H : ¬P ∨ ¬Q) (Hn : P ∧ Q),
  or.elim H
    (assume Hnp : ¬P, absurd (and.elim_left Hn) Hnp)
    (assume Hnq : ¬Q, absurd (and.elim_right Hn) Hnq)

theorem thm12 {P Q : Prop} : ¬(P ∨ Q) → ¬P ∧ ¬Q :=
assume H : ¬(P ∨ Q),
  have Hnp : ¬P, from assume Hp : P, absurd (or.inl Hp) H,
  have Hnq : ¬Q, from assume Hq : Q, absurd (or.inr Hq) H,
  and.intro Hnp Hnq

theorem thm13 {P Q : Prop} : ¬P ∧ ¬Q → ¬(P ∨ Q) :=
assume (H : ¬P ∧ ¬Q) (Hn : P ∨ Q),
  or.elim Hn
    (assume Hp : P, absurd Hp (and.elim_left H))
    (assume Hq : Q, absurd Hq (and.elim_right H))

theorem thm14 {P Q : Prop} : ¬P ∨ Q → P → Q :=
assume (Hor : ¬P ∨ Q) (Hp : P),
  or.elim Hor
    (assume Hnp : ¬P, absurd Hp Hnp)
    (assume Hq : Q, Hq)

theorem thm15 {P Q : Prop} : (P → Q) → ¬¬(¬P ∨ Q) :=
assume (Hpq : P → Q) (Hn : ¬(¬P ∨ Q)),
  have H1 : ¬¬P ∧ ¬Q, from thm12 Hn,
  have Hnp : ¬P, from mt Hpq (and.elim_right H1),
  absurd Hnp (and.elim_left H1)

theorem thm16 {P Q : Prop} : (P → Q) ∧ ((P ∨ ¬P) ∨ (Q ∨ ¬Q)) → ¬P ∨ Q :=
assume H : (P → Q) ∧ ((P ∨ ¬P) ∨ (Q ∨ ¬Q)),
  have Hpq : P → Q, from and.elim_left H,
  or.elim (and.elim_right H)
    (assume Hem1 : P ∨ ¬P, or.elim Hem1
      (assume Hp : P, or.inr (Hpq Hp))
      (assume Hnp : ¬P, or.inl Hnp))
    (assume Hem2 : Q ∨ ¬Q, or.elim Hem2
      (assume Hq : Q, or.inr Hq)
      (assume Hnq : ¬Q, or.inl (mt Hpq Hnq)))

-- 5. First-Order Logic: All and Exists
section
variables {T : Type} {C : Prop} {P : T → Prop}
theorem thm17a : (C → ∀x, P x) → (∀x, C → P x) :=
assume H : C → ∀x, P x,
  take x : T, assume Hc : C,
  H Hc x

theorem thm17b : (∀x, C → P x) → (C → ∀x, P x) :=
assume (H : ∀x, C → P x) (Hc : C),
  take x : T,
  H x Hc

theorem thm18a : ((∃x, P x) → C) → (∀x, P x → C) :=
assume H : (∃x, P x) → C,
  take x, assume Hp : P x,
  have Hex : ∃x, P x, from exists.intro x Hp,
  H Hex

theorem thm18b : (∀x, P x → C) → (∃x, P x) → C :=
assume (H1 : ∀x, P x → C) (H2 : ∃x, P x),
  obtain (w : T) (Hw : P w), from H2,
  H1 w Hw

theorem thm19a : (C ∨ ¬C) → (∃x : T, true) → (C → (∃x, P x)) → (∃x, C → P x) :=
assume (Hem : C ∨ ¬C) (Hin : ∃x : T, true) (H1 : C → ∃x, P x),
  or.elim Hem
    (assume Hc : C,
      obtain (w : T) (Hw : P w), from H1 Hc,
      have Hr : C → P w, from assume Hc, Hw,
      exists.intro w Hr)
    (assume Hnc : ¬C,
      obtain (w : T) (Hw : true), from Hin,
      have Hr : C → P w, from assume Hc, absurd Hc Hnc,
      exists.intro w Hr)

theorem thm19b : (∃x, C → P x) → C → (∃x, P x) :=
assume (H : ∃x, C → P x) (Hc : C),
  obtain (w : T) (Hw : C → P w), from H,
  exists.intro w (Hw Hc)

theorem thm20a : (C ∨ ¬C) → (∃x : T, true) → ((¬∀x, P x) → ∃x, ¬P x) → ((∀x, P x) → C) → (∃x, P x → C) :=
assume Hem Hin Hnf H,
  or.elim Hem
    (assume Hc : C,
      obtain (w : T) (Hw : true), from Hin,
      exists.intro w (assume H : P w, Hc))
    (assume Hnc : ¬C,
      have H1 : ¬(∀x, P x), from mt H Hnc,
      have H2 : ∃x, ¬P x, from Hnf H1,
      obtain (w : T) (Hw : ¬P w), from H2,
      exists.intro w (assume H : P w, absurd H Hw))

theorem thm20b : (∃x, P x → C) → (∀ x, P x) → C :=
assume Hex Hall,
  obtain (w : T) (Hw : P w → C), from Hex,
  Hw (Hall w)

theorem thm21a : (∃x : T, true) → ((∃x, P x) ∨ C) → (∃x, P x ∨ C) :=
assume Hin H,
  or.elim H
    (assume Hex : ∃x, P x,
      obtain (w : T) (Hw : P w), from Hex,
      exists.intro w (or.inl Hw))
    (assume Hc  : C,
      obtain (w : T) (Hw : true), from Hin,
      exists.intro w (or.inr Hc))

theorem thm21b : (∃x, P x ∨ C) → ((∃x, P x) ∨ C) :=
assume H,
  obtain (w : T) (Hw : P w ∨ C), from H,
  or.elim Hw
    (assume H : P w, or.inl (exists.intro w H))
    (assume Hc : C, or.inr Hc)

theorem thm22a : (∀x, P x) ∨ C → ∀x, P x ∨ C :=
assume H, take x,
  or.elim H
    (assume Hl, or.inl (Hl x))
    (assume Hr, or.inr Hr)

theorem thm22b : (C ∨ ¬C) → (∀x, P x ∨ C) → ((∀x, P x) ∨ C) :=
assume Hem H1,
  or.elim Hem
    (assume Hc : C,   or.inr Hc)
    (assume Hnc : ¬C,
      have Hx : ∀x, P x, from
        take x,
        have H1 : P x ∨ C, from H1 x,
        or_resolve_left H1 Hnc,
      or.inl Hx)

theorem thm23a : (∃x, P x) ∧ C → (∃x, P x ∧ C) :=
assume H,
  have Hex : ∃x, P x, from and.elim_left H,
  have Hc : C, from and.elim_right H,
  obtain (w : T) (Hw : P w), from Hex,
  exists.intro w (and.intro Hw Hc)

theorem thm23b : (∃x, P x ∧ C) → (∃x, P x) ∧ C :=
assume H,
  obtain (w : T) (Hw : P w ∧ C), from H,
  have Hex : ∃x, P x, from exists.intro w (and.elim_left Hw),
  and.intro Hex (and.elim_right Hw)

theorem thm24a : (∀x, P x) ∧ C → (∀x, P x ∧ C) :=
assume H, take x,
  and.intro (and.elim_left H x) (and.elim_right H)

theorem thm24b : (∃x : T, true) → (∀x, P x ∧ C) → (∀x, P x) ∧ C :=
assume Hin H,
  obtain (w : T) (Hw : true), from Hin,
  have Hc : C, from and.elim_right (H w),
  have Hx : ∀x, P x, from take x, and.elim_left (H x),
  and.intro Hx Hc

end -- of section


import .nat ...mathlib.data.int.basic

namespace int

lemma le_iff_zero_le_sub (a b) : a ≤ b ↔ (0 : int) ≤ b - a :=
begin
  rewrite le_sub, simp
end

lemma abs_dvd (x y : int) : has_dvd.dvd (abs x) y ↔ has_dvd.dvd x y :=
begin rewrite abs_eq_nat_abs, apply nat_abs_dvd end

lemma mul_nonzero {z y : int} : z ≠ 0 → y ≠ 0 → z * y ≠ 0 :=
begin
  intros hm hn hc, apply hm,
  apply eq.trans, apply eq.symm,
  apply int.mul_div_cancel,
  apply hn, rewrite hc, apply int.zero_div
end

lemma div_nonzero (z y : int) : z ≠ 0 → has_dvd.dvd y z → (z / y) ≠ 0 :=
begin
  intros hz hy hc, apply hz,
  apply eq.trans, apply eq.symm,
  apply int.div_mul_cancel, apply hy,
  rewrite hc, apply zero_mul,
end

lemma nat_abs_nonzero (z : int) : z ≠ 0 → int.nat_abs z ≠ 0 :=
begin
  intro hz, cases z with n n, simp,
  apply nat.neq_zero_of_of_nat_neq_zero hz,
  simp, intro hc, cases hc
end

lemma dvd_iff_nat_abs_dvd_nat_abs {x y : int} :
  (has_dvd.dvd x y)
  ↔ (has_dvd.dvd (int.nat_abs x) (int.nat_abs y)) :=
begin
  rewrite iff.symm int.coe_nat_dvd,
  rewrite int.nat_abs_dvd, rewrite int.dvd_nat_abs
end

def lcm (x y : int) : int :=
  (nat.lcm (nat_abs x) (nat_abs y))

lemma lcm_dvd {x y z : int} (hx : has_dvd.dvd x z) (hy : y ∣ z) : lcm x y ∣ z :=
begin
  rewrite dvd_iff_nat_abs_dvd_nat_abs,
  rewrite dvd_iff_nat_abs_dvd_nat_abs at hx,
  rewrite dvd_iff_nat_abs_dvd_nat_abs at hy,
  unfold lcm, rewrite nat_abs_of_nat,
  apply nat.lcm_dvd; assumption
end

lemma lcm_one_right (z : int) :
  lcm z 1 = abs z :=
begin
  unfold lcm, simp, rewrite nat.lcm_one_right,
  cases (classical.em (0 ≤ z)) with hz hz,
  rewrite abs_eq_nat_abs,
  rewrite not_le at hz,
  apply @eq.trans _ _ (↑(nat_abs z)), refl,
  rewrite (@of_nat_nat_abs_of_nonpos z _),
  rewrite abs_of_neg, apply hz,
  apply le_of_lt hz
end

def lcms : list int → int
| [] := 1
| (z::zs) := lcm z (lcms zs)

lemma dvd_lcm_left : ∀ (x y : int), has_dvd.dvd x (lcm x y) :=
begin
  intros x y, unfold lcm, rewrite iff.symm (abs_dvd _ _),
  rewrite abs_eq_nat_abs, rewrite coe_nat_dvd,
  apply nat.dvd_lcm_left
end

lemma dvd_lcm_right : ∀ (x y : int), has_dvd.dvd y (lcm x y) :=
begin
  intros x y, unfold lcm, rewrite iff.symm (abs_dvd _ _),
  rewrite abs_eq_nat_abs, rewrite coe_nat_dvd,
  apply nat.dvd_lcm_right
end
lemma dvd_lcms {x : int} : ∀ {zs : list int}, x ∈ zs → has_dvd.dvd x (lcms zs)
| [] hm := by cases hm
| (z::zs) hm :=
  begin
    unfold lcms, rewrite list.mem_cons_iff at hm,
    cases hm with hm hm, subst hm,
    apply dvd_lcm_left,
    apply dvd_trans, apply @dvd_lcms zs hm,
    apply dvd_lcm_right,
  end

lemma nonzero_of_pos {z : int} : z > 0 → z ≠ 0 :=
begin intros hgt heq, subst heq, cases hgt end

lemma lcm_nonneg (x y : int) : lcm x y ≥ 0 :=
by unfold lcm

lemma lcms_nonneg : ∀ (zs : list int), lcms zs ≥ 0
| [] := by unfold lcms
| (z::zs) := by unfold lcms

lemma lcm_pos (x y : int) : x ≠ 0 → y ≠ 0 → lcm x y > 0 :=
begin
  intros hx hy, unfold lcm, unfold gt,
  rewrite coe_nat_pos,
  let h := @nat.pos_iff_ne_zero, unfold gt at h,
  rewrite h, apply nat.lcm_nonzero;
  apply nat_abs_nonzero; assumption
end

lemma lcms_pos : ∀ {zs : list int}, (∀ z : int, z ∈ zs → z ≠ 0) → lcms zs > 0
| [] _ := coe_succ_pos _
| (z::zs) hnzs :=
  begin
    unfold lcms, apply lcm_pos,
    apply hnzs _ (or.inl rfl),
    apply nonzero_of_pos, apply lcms_pos,
    apply list.forall_mem_of_forall_mem_cons hnzs
  end

lemma lcms_dvd {k : int} :
  ∀ {zs : list int}, (∀ z ∈ zs, has_dvd.dvd z k) → (has_dvd.dvd (lcms zs) k)
| [] hk := one_dvd _
| (z::zs) hk :=
  begin
    unfold lcms, apply lcm_dvd,
    apply hk _ (or.inl rfl),
    apply lcms_dvd,
    apply list.forall_mem_of_forall_mem_cons hk
  end

lemma lcms_distrib (xs ys zs : list int) :
  list.equiv zs (xs ∪ ys)
  → lcms zs = lcm (lcms xs) (lcms ys) :=
begin
  intro heqv, apply dvd_antisymm,
  apply lcms_nonneg, apply lcm_nonneg,
  apply lcms_dvd, intros z hz,
  rewrite (list.mem_iff_mem_of_equiv heqv) at hz,
  rewrite list.mem_union at hz, cases hz with hz hz,
  apply dvd_trans (dvd_lcms _) (dvd_lcm_left _ _);
  assumption,
  apply dvd_trans (dvd_lcms _) (dvd_lcm_right _ _);
  assumption,
  apply lcm_dvd; apply lcms_dvd; intros z hz;
  apply dvd_lcms; rewrite (list.mem_iff_mem_of_equiv heqv),
  apply list.mem_union_left hz,
  apply list.mem_union_right _ hz
end

-- lemma dvd_of_mul_dvd_mul_left : ∀ {x y z : int},
--   z ≠ 0 → has_dvd.dvd (z * x) (z * y) → has_dvd.dvd x y := sorry

lemma eq_zero_of_nonpos_of_nonzero (z : int) :
(¬ z < 0) → (¬ z > 0) → z = 0 :=
begin
  cases (lt_trichotomy z 0) with h h,
  intro hc, cases (hc h),
  cases h with h h, intros _ _, apply h,
  intros _ hc, cases (hc h)
end

lemma sign_split (z) :
  sign z = -1 ∨ sign z = 0 ∨ sign z = 1 :=
begin
  cases z with n n, cases n,
  apply or.inr (or.inl rfl),
  apply or.inr (or.inr rfl),
  apply or.inl rfl
end

-- lemma abs_neq_zero_of_neq_zero {z : int} (h : z ≠ 0) : abs z ≠ 0 :=
-- begin
--   intro hc, apply h, apply eq_zero_of_abs_eq_zero, apply hc
-- end

lemma mul_le_mul_iff_le_of_pos_left (x y z : int) :
  z > 0 → (z * x ≤ z * y ↔ x ≤ y) :=
begin
  intro hz, apply iff.intro; intro h,
  let h' := @int.div_le_div _ _ z hz h,
  repeat {rewrite mul_comm z at h',
  rewrite int.mul_div_cancel _ (nonzero_of_pos hz) at h'},
  apply h', repeat {rewrite mul_comm z},
  apply int.mul_le_of_le_div hz,
  rewrite int.mul_div_cancel _ (nonzero_of_pos hz),
  apply h
end

lemma mul_le_mul_iff_le_of_neg_left (x y z : int) :
  z < 0 → (z * x ≤ z * y ↔ y ≤ x) :=
begin
  intros hz,
  rewrite eq.symm (neg_neg z),
  repeat {rewrite eq.symm (neg_mul_eq_neg_mul (-z) _)},
  rewrite neg_le_neg_iff,
  apply mul_le_mul_iff_le_of_pos_left,
  unfold gt, rewrite lt_neg, apply hz
end

lemma dvd_iff_exists (x y) :
  has_dvd.dvd x y ↔ ∃ (z : int), z * x = y :=
begin
  apply iff.intro; intro h,
  existsi (y / x), apply int.div_mul_cancel h,
  cases h with z hz, subst hz,
  apply dvd_mul_left
end

lemma div_mul_comm (x y z : int) : has_dvd.dvd y x → (x / y) * z = x * z / y :=
begin
  intro h, rewrite mul_comm x,
  rewrite int.mul_div_assoc _ h, rewrite mul_comm,
end

lemma nonneg_iff_exists (z : int) :
  0 ≤ z ↔ ∃ (n : nat), z = ↑n :=
begin
  cases z with m m, apply true_iff_true, constructor,
  existsi m, refl, apply false_iff_false; intro hc,
  cases hc, cases hc with m hm, cases hm
end

lemma exists_nat_diff (x y : int) (n : nat) :
  x ≤ y → y < x + ↑n → ∃ (m : nat), m < n ∧ y = x + ↑m :=
begin
  intros hxy hyx,
  rewrite iff.symm (sub_nonneg) at hxy,
  rewrite nonneg_iff_exists at hxy,
  cases hxy with m hm, existsi m,
  rewrite iff.symm sub_lt_iff_lt_add' at hyx,
  apply and.intro, rewrite iff.symm coe_nat_lt,
  rewrite eq.symm hm, apply hyx,
  rewrite eq.symm hm, rewrite add_sub, simp,
end

lemma exists_lt_and_lt (x y : int) :
  ∃ z, z < x ∧ z < y :=
begin
  cases (lt_trichotomy x y),
  existsi (pred x),
  apply and.intro (pred_self_lt _) (lt_trans (pred_self_lt _) h),
  cases h with h h, subst h,
  existsi (pred x), apply and.intro (pred_self_lt _) (pred_self_lt _),
  existsi (pred y),
  apply and.intro (lt_trans (pred_self_lt _) h) (pred_self_lt _)
end

lemma le_mul_of_pos_left : ∀ {x y : int}, y ≥ 0 → x > 0 → y ≤ x * y :=
begin
  intros x y hy hx,
  have hx' : x ≥ 1 := add_one_le_of_lt hx,
  let h := mul_le_mul hx' (le_refl y) hy _,
  rewrite one_mul at h, apply h,
  apply le_of_lt hx
end

lemma lt_mul_of_nonneg_right : ∀ {x y z : int}, x < y → y ≥ 0 → z > 0 → x < y * z :=
begin
  intros x y z hxy hy hz,
  have h := @mul_lt_mul _ _ x 1 y z hxy,
  rewrite mul_one at h, apply h,
  apply add_one_le_of_lt hz,
  apply int.zero_lt_one, apply hy
end

lemma zero_mul (z : int) :
  int.of_nat 0 * z = 0 :=
eq.trans (refl _) (zero_mul _)

lemma mul_zero (z : int) :
  z * int.of_nat 0 = 0 :=
eq.trans (refl _) (mul_zero _)

lemma one_mul (z : int) :
  int.of_nat 1 * z = z :=
eq.trans (refl _) (one_mul _)

lemma neg_one_mul (z : int) :
  (int.neg_succ_of_nat 0) * z = -z :=
eq.trans (refl _) (neg_one_mul _)

lemma zero_add (z : int) :
  int.of_nat 0 + z = z :=
eq.trans (refl _) (zero_add _)

lemma coe_eq_of_nat {n : nat} :
  ↑n = int.of_nat n := refl _

lemma coe_neg_succ_eq_neg_succ_of_nat {n : nat} :
  -↑(nat.succ n) = int.neg_succ_of_nat n := refl _

end int


-- Coprimo con potencia de primo
-- =============================

import data.nat.prime
open nat.prime

lemma not_dvd_of_coprime
  {p : ℕ}
  (h : p.prime)
  {n k : ℕ}
  (hc : n.coprime (p^(k + 1)))
  : ¬(p ∣ n) :=
λ hn, not_dvd_one h
begin
  unfold nat.coprime at hc,
  rw ← hc,
  exact nat.dvd_gcd hn ⟨p^k, rfl⟩,
end

lemma coprime_iff_not_div
  {p : ℕ}
  (h : p.prime)
  (n k : ℕ)
  : n.coprime (p^(k + 1)) ↔ ¬ (p ∣ n) :=
⟨not_dvd_of_coprime h, coprime_pow_of_not_dvd h⟩


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import measure_theory.measurable_space

/-

# The extended nonnegative reals [0,∞]

The big dilemma when a designer is faced with "minor modifications"
of a standard type, is whether to just stick with the standard type
and make do, or whether to make a new type and then be faced with the
problem of having to make all the API for that type. Example: in measure
theory a key role is played by the "extended non-negative reals",
namely {x : ℝ | 0 ≤ x} ∪ {∞}. In Lean these are their own type,
called `ennreal`. There is a "locale" containing standard notation
associated for this type. Let's open it.

localized "notation (name := ennreal) `ℝ≥0∞` := ennreal" in ennreal
localized "notation (name := ennreal.top) `∞` := (⊤ : ennreal)" in ennreal
-/

open_locale ennreal

#print notation ℝ≥0∞
#check ennreal

#check ℝ≥0∞ -- [0,∞]

#check ∞ -- it's the ∞ in ℝ≥0∞

-- What can we do with extended non-negative reals?

variables (a b : ℝ≥0∞)

#check a + b
#check a - b -- surprising?
#check a * b -- what is 0 * ∞ then?
#check a / b -- is 1 / 0 = 0 or ∞? In ℝ it's 0 but here there's another possibility

-- See if you can find tactics (or theorems) which prove these.
example : (0 : ℝ≥0∞) * ∞ = 0 :=
begin
  sorry,
end

example : (1 : ℝ≥0∞) / 0 = ∞ :=
begin
  sorry,
end

example (a b c : ℝ≥0∞) : (a + b) * c = a * c + b * c :=
begin
  sorry,
end


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann, Kyle Miller, Mario Carneiro
-/
import data.nat.gcd.basic
import logic.function.iterate
import data.finset.nat_antidiagonal
import algebra.big_operators.basic
import tactic.ring
import tactic.zify
import tactic.wlog

/-!
# The Fibonacci Sequence

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

## Summary

Definition of the Fibonacci sequence `F₀ = 0, F₁ = 1, Fₙ₊₂ = Fₙ + Fₙ₊₁`.

## Main Definitions

- `nat.fib` returns the stream of Fibonacci numbers.

## Main Statements

- `nat.fib_add_two`: shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.`.
- `nat.fib_gcd`: `fib n` is a strong divisibility sequence.
- `nat.fib_succ_eq_sum_choose`: `fib` is given by the sum of `nat.choose` along an antidiagonal.
- `nat.fib_succ_eq_succ_sum`: shows that `F₀ + F₁ + ⋯ + Fₙ = Fₙ₊₂ - 1`.
- `nat.fib_two_mul` and `nat.fib_two_mul_add_one` are the basis for an efficient algorithm to
  compute `fib` (see `nat.fast_fib`). There are `bit0`/`bit1` variants of these can be used to
  simplify `fib` expressions: `simp only [nat.fib_bit0, nat.fib_bit1, nat.fib_bit0_succ,
  nat.fib_bit1_succ, nat.fib_one, nat.fib_two]`.

## Implementation Notes

For efficiency purposes, the sequence is defined using `stream.iterate`.

## Tags

fib, fibonacci
-/

open_locale big_operators

namespace nat

/--
Implementation of the fibonacci sequence satisfying
`fib 0 = 0, fib 1 = 1, fib (n + 2) = fib n + fib (n + 1)`.

*Note:* We use a stream iterator for better performance when compared to the naive recursive
implementation.
-/
@[pp_nodot]
def fib (n : ℕ) : ℕ := ((λ p : ℕ × ℕ, (p.snd, p.fst + p.snd))^[n] (0, 1)).fst

@[simp] lemma fib_zero : fib 0 = 0 := rfl
@[simp] lemma fib_one : fib 1 = 1 := rfl
@[simp] lemma fib_two : fib 2 = 1 := rfl

/-- Shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.` -/
lemma fib_add_two {n : ℕ} : fib (n + 2) = fib n + fib (n + 1) :=
by simp only [fib, function.iterate_succ']

lemma fib_le_fib_succ {n : ℕ} : fib n ≤ fib (n + 1) := by { cases n; simp [fib_add_two] }

@[mono] lemma fib_mono : monotone fib :=
monotone_nat_of_le_succ $ λ _, fib_le_fib_succ

lemma fib_pos {n : ℕ} (n_pos : 0 < n) : 0 < fib n :=
calc 0 < fib 1 : dec_trivial
   ... ≤ fib n : fib_mono n_pos

lemma fib_add_two_sub_fib_add_one {n : ℕ} : fib (n + 2) - fib (n + 1) = fib n :=
by rw [fib_add_two, add_tsub_cancel_right]

lemma fib_lt_fib_succ {n : ℕ} (hn : 2 ≤ n) : fib n < fib (n + 1) :=
begin
  rcases exists_add_of_le hn with ⟨n, rfl⟩,
  rw [← tsub_pos_iff_lt, add_comm 2, fib_add_two_sub_fib_add_one],
  apply fib_pos (succ_pos n),
end

/-- `fib (n + 2)` is strictly monotone. -/
lemma fib_add_two_strict_mono : strict_mono (λ n, fib (n + 2)) :=
begin
  refine strict_mono_nat_of_lt_succ (λ n, _),
  rw add_right_comm,
  exact fib_lt_fib_succ (self_le_add_left _ _)
end

lemma le_fib_self {n : ℕ} (five_le_n : 5 ≤ n) : n ≤ fib n :=
begin
  induction five_le_n with n five_le_n IH,
  { -- 5 ≤ fib 5
    refl },
  { -- n + 1 ≤ fib (n + 1) for 5 ≤ n
    rw succ_le_iff,
    calc n ≤ fib n       : IH
       ... < fib (n + 1) : fib_lt_fib_succ (le_trans dec_trivial five_le_n) }
end

/-- Subsequent Fibonacci numbers are coprime,
  see https://proofwiki.org/wiki/Consecutive_Fibonacci_Numbers_are_Coprime -/
lemma fib_coprime_fib_succ (n : ℕ) : nat.coprime (fib n) (fib (n + 1)) :=
begin
  induction n with n ih,
  { simp },
  { rw [fib_add_two, coprime_add_self_right],
    exact ih.symm }
end

/-- See https://proofwiki.org/wiki/Fibonacci_Number_in_terms_of_Smaller_Fibonacci_Numbers -/
lemma fib_add (m n : ℕ) :
  fib (m + n + 1) = fib m * fib n + fib (m + 1) * fib (n + 1) :=
begin
  induction n with n ih generalizing m,
  { simp },
  { intros,
    specialize ih (m + 1),
    rw [add_assoc m 1 n, add_comm 1 n] at ih,
    simp only [fib_add_two, ih],
    ring, }
end

lemma fib_two_mul (n : ℕ) : fib (2 * n) = fib n * (2 * fib (n + 1) - fib n) :=
begin
  cases n,
  { simp },
  { rw [nat.succ_eq_add_one, two_mul, ←add_assoc, fib_add, fib_add_two, two_mul],
    simp only [← add_assoc, add_tsub_cancel_right],
    ring, },
end

lemma fib_two_mul_add_one (n : ℕ) : fib (2 * n + 1) = fib (n + 1) ^ 2 + fib n ^ 2 :=
by { rw [two_mul, fib_add], ring }

lemma fib_bit0 (n : ℕ) : fib (bit0 n) = fib n * (2 * fib (n + 1) - fib n) :=
by rw [bit0_eq_two_mul, fib_two_mul]

lemma fib_bit1 (n : ℕ) : fib (bit1 n) = fib (n + 1) ^ 2 + fib n ^ 2 :=
by rw [nat.bit1_eq_succ_bit0, bit0_eq_two_mul, fib_two_mul_add_one]

lemma fib_bit0_succ (n : ℕ) : fib (bit0 n + 1) = fib (n + 1) ^ 2 + fib n ^ 2 := fib_bit1 n

lemma fib_bit1_succ (n : ℕ) : fib (bit1 n + 1) = fib (n + 1) * (2 * fib n + fib (n + 1)) :=
begin
  rw [nat.bit1_eq_succ_bit0, fib_add_two, fib_bit0, fib_bit0_succ],
  have : fib n ≤ 2 * fib (n + 1),
  { rw two_mul,
    exact le_add_left fib_le_fib_succ, },
  zify,
  ring,
end

/-- Computes `(nat.fib n, nat.fib (n + 1))` using the binary representation of `n`.
Supports `nat.fast_fib`. -/
def fast_fib_aux : ℕ → ℕ × ℕ :=
nat.binary_rec (fib 0, fib 1) (λ b n p,
  if b
  then (p.2^2 + p.1^2, p.2 * (2 * p.1 + p.2))
  else (p.1 * (2 * p.2 - p.1), p.2^2 + p.1^2))

/-- Computes `nat.fib n` using the binary representation of `n`.
Proved to be equal to `nat.fib` in `nat.fast_fib_eq`. -/
def fast_fib (n : ℕ) : ℕ := (fast_fib_aux n).1

lemma fast_fib_aux_bit_ff (n : ℕ) :
  fast_fib_aux (bit ff n) = let p := fast_fib_aux n in (p.1 * (2 * p.2 - p.1), p.2^2 + p.1^2) :=
begin
  rw [fast_fib_aux, binary_rec_eq],
  { refl },
  { simp },
end

lemma fast_fib_aux_bit_tt (n : ℕ) :
  fast_fib_aux (bit tt n) = let p := fast_fib_aux n in (p.2^2 + p.1^2, p.2 * (2 * p.1 + p.2)) :=
begin
  rw [fast_fib_aux, binary_rec_eq],
  { refl },
  { simp },
end

lemma fast_fib_aux_eq (n : ℕ) :
  fast_fib_aux n = (fib n, fib (n + 1)) :=
begin
  apply nat.binary_rec _ (λ b n' ih, _) n,
  { simp [fast_fib_aux] },
  { cases b; simp only [fast_fib_aux_bit_ff, fast_fib_aux_bit_tt,
      congr_arg prod.fst ih, congr_arg prod.snd ih, prod.mk.inj_iff]; split;
    simp [bit, fib_bit0, fib_bit1, fib_bit0_succ, fib_bit1_succ], },
end

lemma fast_fib_eq (n : ℕ) : fast_fib n = fib n :=
by rw [fast_fib, fast_fib_aux_eq]

lemma gcd_fib_add_self (m n : ℕ) : gcd (fib m) (fib (n + m)) = gcd (fib m) (fib n) :=
begin
  cases nat.eq_zero_or_pos n,
  { rw h, simp },
  replace h := nat.succ_pred_eq_of_pos h, rw [← h, succ_eq_add_one],
  calc gcd (fib m) (fib (n.pred + 1 + m))
        = gcd (fib m) (fib (n.pred) * (fib m) + fib (n.pred + 1) * fib (m + 1)) :
    by { rw ← fib_add n.pred _, ring_nf }
    ... = gcd (fib m) (fib (n.pred + 1) * fib (m + 1)) :
    by rw [add_comm, gcd_add_mul_right_right (fib m) _ (fib (n.pred))]
    ... = gcd (fib m) (fib (n.pred + 1)) :
    coprime.gcd_mul_right_cancel_right
      (fib (n.pred + 1)) (coprime.symm (fib_coprime_fib_succ m))
end

lemma gcd_fib_add_mul_self (m n : ℕ) : ∀ k, gcd (fib m) (fib (n + k * m)) = gcd (fib m) (fib n)
| 0     := by simp
| (k+1) := by rw [← gcd_fib_add_mul_self k, add_mul, ← add_assoc, one_mul, gcd_fib_add_self _ _]

/-- `fib n` is a strong divisibility sequence,
  see https://proofwiki.org/wiki/GCD_of_Fibonacci_Numbers -/

lemma fib_dvd (m n : ℕ) (h : m ∣ n) : fib m ∣ fib n :=
by rwa [gcd_eq_left_iff_dvd, ← fib_gcd, gcd_eq_left_iff_dvd.mp]

lemma fib_succ_eq_sum_choose :
  ∀ (n : ℕ), fib (n + 1) = ∑ p in finset.nat.antidiagonal n, choose p.1 p.2 :=
two_step_induction rfl rfl (λ n h1 h2, by
{ rw [fib_add_two, h1, h2, finset.nat.antidiagonal_succ_succ', finset.nat.antidiagonal_succ'],
  simp [choose_succ_succ, finset.sum_add_distrib, add_left_comm] })

lemma fib_succ_eq_succ_sum (n : ℕ):
  fib (n + 1) = (∑ k in finset.range n, fib k) + 1 :=
begin
  induction n with n ih,
  { simp },
  { calc fib (n + 2) = fib n + fib (n + 1)                        : fib_add_two
                 ... = fib n + (∑ k in finset.range n, fib k) + 1 : by rw [ih, add_assoc]
                 ... = (∑ k in finset.range (n + 1), fib k) + 1   : by simp [finset.range_add_one] }
end
end nat

namespace norm_num
open tactic nat

/-! ### `norm_num` plugin for `fib`

The `norm_num` plugin uses a strategy parallel to that of `nat.fast_fib`, but it instead
produces proofs of what `nat.fib` evaluates to.
-/

/-- Auxiliary definition for `prove_fib` plugin. -/
def is_fib_aux (n a b : ℕ) := fib n = a ∧ fib (n + 1) = b

lemma is_fib_aux_one : is_fib_aux 1 1 1 := ⟨fib_one, fib_two⟩

lemma is_fib_aux_bit0 {n a b c a2 b2 a' b' : ℕ} (H : is_fib_aux n a b)
  (h1 : a + c = bit0 b) (h2 : a * c = a')
  (h3 : a * a = a2) (h4 : b * b = b2) (h5 : a2 + b2 = b') :
  is_fib_aux (bit0 n) a' b' :=
⟨by rw [fib_bit0, H.1, H.2, ← bit0_eq_two_mul,
  show bit0 b-a=c, by rw [← h1, nat.add_sub_cancel_left], h2],
 by rw [fib_bit0_succ, H.1, H.2, pow_two, pow_two, h3, h4, add_comm, h5]⟩

lemma is_fib_aux_bit1 {n a b c a2 b2 a' b' : ℕ} (H : is_fib_aux n a b)
  (h1 : a * a = a2) (h2 : b * b = b2) (h3 : a2 + b2 = a')
  (h4 : bit0 a + b = c) (h5 : b * c = b') :
  is_fib_aux (bit1 n) a' b' :=
⟨by rw [fib_bit1, H.1, H.2, pow_two, pow_two, h1, h2, add_comm, h3],
 by rw [fib_bit1_succ, H.1, H.2, ← bit0_eq_two_mul, h4, h5]⟩

lemma is_fib_aux_bit0_done {n a b c a' : ℕ} (H : is_fib_aux n a b)
  (h1 : a + c = bit0 b) (h2 : a * c = a') : fib (bit0 n) = a' :=
(is_fib_aux_bit0 H h1 h2 rfl rfl rfl).1

lemma is_fib_aux_bit1_done {n a b a2 b2 a' : ℕ} (H : is_fib_aux n a b)
  (h1 : a * a = a2) (h2 : b * b = b2) (h3 : a2 + b2 = a') : fib (bit1 n) = a' :=
(is_fib_aux_bit1 H h1 h2 h3 rfl rfl).1

/-- `prove_fib_aux ic n` returns `(ic', a, b, ⊢ is_fib_aux n a b)`, where `n` is a numeral. -/
meta def prove_fib_aux (ic : instance_cache) :
  expr → tactic (instance_cache × expr × expr × expr)
| e :=
  match match_numeral e with
  | match_numeral_result.one := pure (ic, `(1:ℕ), `(1:ℕ), `(is_fib_aux_one))
  | match_numeral_result.bit0 e := do
    (ic, a, b, H) ← prove_fib_aux e,
    na ← a.to_nat, nb ← b.to_nat,
    (ic, c) ← ic.of_nat (2*nb - na),
    (ic, h1) ← prove_add_nat ic a c (`(bit0:ℕ→ℕ).mk_app [b]),
    (ic, a', h2) ← prove_mul_nat ic a c,
    (ic, a2, h3) ← prove_mul_nat ic a a,
    (ic, b2, h4) ← prove_mul_nat ic b b,
    (ic, b', h5) ← prove_add_nat' ic a2 b2,
    pure (ic, a', b', `(@is_fib_aux_bit0).mk_app
      [e, a, b, c, a2, b2, a', b', H, h1, h2, h3, h4, h5])
  | match_numeral_result.bit1 e := do
    (ic, a, b, H) ← prove_fib_aux e,
    na ← a.to_nat, nb ← b.to_nat,
    (ic, c) ← ic.of_nat (2*na + nb),
    (ic, a2, h1) ← prove_mul_nat ic a a,
    (ic, b2, h2) ← prove_mul_nat ic b b,
    (ic, a', h3) ← prove_add_nat' ic a2 b2,
    (ic, h4) ← prove_add_nat ic (`(bit0:ℕ→ℕ).mk_app [a]) b c,
    (ic, b', h5) ← prove_mul_nat ic b c,
    pure (ic, a', b', `(@is_fib_aux_bit1).mk_app
      [e, a, b, c, a2, b2, a', b', H, h1, h2, h3, h4, h5])
  | _ := failed
  end

/-- A `norm_num` plugin for `fib n` when `n` is a numeral.
Uses the binary representation of `n` like `nat.fast_fib`. -/
meta def prove_fib (ic : instance_cache) (e : expr) : tactic (instance_cache × expr × expr) :=
match match_numeral e with
| match_numeral_result.zero := pure (ic, `(0:ℕ), `(fib_zero))
| match_numeral_result.one := pure (ic, `(1:ℕ), `(fib_one))
| match_numeral_result.bit0 e := do
  (ic, a, b, H) ← prove_fib_aux ic e,
  na ← a.to_nat, nb ← b.to_nat,
  (ic, c) ← ic.of_nat (2*nb - na),
  (ic, h1) ← prove_add_nat ic a c (`(bit0:ℕ→ℕ).mk_app [b]),
  (ic, a', h2) ← prove_mul_nat ic a c,
  pure (ic, a', `(@is_fib_aux_bit0_done).mk_app [e, a, b, c, a', H, h1, h2])
| match_numeral_result.bit1 e := do
  (ic, a, b, H) ← prove_fib_aux ic e,
  (ic, a2, h1) ← prove_mul_nat ic a a,
  (ic, b2, h2) ← prove_mul_nat ic b b,
  (ic, a', h3) ← prove_add_nat' ic a2 b2,
  pure (ic, a', `(@is_fib_aux_bit1_done).mk_app [e, a, b, a2, b2, a', H, h1, h2, h3])
| _ := failed
end

/-- A `norm_num` plugin for `fib n` when `n` is a numeral.
Uses the binary representation of `n` like `nat.fast_fib`. -/
@[norm_num] meta def eval_fib : expr → tactic (expr × expr)
| `(fib %%en) := do
    n ← en.to_nat,
    match n with
    | 0 := pure (`(0:ℕ), `(fib_zero))
    | 1 := pure (`(1:ℕ), `(fib_one))
    | 2 := pure (`(1:ℕ), `(fib_two))
    | _ := do
      c ← mk_instance_cache `(ℕ),
      prod.snd <$> prove_fib c en
    end
| _ := failed

end norm_num