/-
Copyright (c) 2022 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/

import computability.encoding
import logic.small.list
import model_theory.syntax
import set_theory.cardinal.ordinal

/-! # Encodings and Cardinality of First-Order Syntax

## Main Definitions
* `first_order.language.term.encoding` encodes terms as lists.
* `first_order.language.bounded_formula.encoding` encodes bounded formulas as lists.

## Main Results
* `first_order.language.term.card_le` shows that the number of terms in `L.term α` is at most
`max ℵ₀ # (α ⊕ Σ i, L.functions i)`.
* `first_order.language.bounded_formula.card_le` shows that the number of bounded formulas in
`Σ n, L.bounded_formula α n` is at most
`max ℵ₀ (cardinal.lift.{max u v} (#α) + cardinal.lift.{u'} L.card)`.

## TODO
* `primcodable` instances for terms and formulas, based on the `encoding`s
* Computability facts about term and formula operations, to set up a computability approach to
incompleteness

-/

universes u v w u' v'

namespace first_order
namespace language

variables {L : language.{u v}}
variables {M : Type w} {N P : Type*} [L.Structure M] [L.Structure N] [L.Structure P]
variables {α : Type u'} {β : Type v'}
open_locale first_order cardinal
open computability list Structure cardinal fin

namespace term

/-- Encodes a term as a list of variables and function symbols. -/
def list_encode : L.term α → list (α ⊕ Σ i, L.functions i)
| (var i) := [sum.inl i]
| (func f ts) := ((sum.inr (⟨_, f⟩ : Σ i, L.functions i)) ::
    ((list.fin_range _).bind (λ i, (ts i).list_encode)))

/-- Decodes a list of variables and function symbols as a list of terms. -/
def list_decode :
  list (α ⊕ Σ i, L.functions i) → list (option (L.term α))
| [] := []
| ((sum.inl a) :: l) := some (var a) :: list_decode l
| ((sum.inr ⟨n, f⟩) :: l) :=
  if h : ∀ (i : fin n), ((list_decode l).nth i).join.is_some
  then func f (λ i, option.get (h i)) :: ((list_decode l).drop n)
  else [none]

theorem list_decode_encode_list (l : list (L.term α)) :
  list_decode (l.bind list_encode) = l.map option.some :=
begin
  suffices h : ∀ (t : L.term α) (l : list (α ⊕ Σ i, L.functions i)),
    list_decode (t.list_encode ++ l) = some t :: list_decode l,
  { induction l with t l lih,
    { refl },
    { rw [cons_bind, h t (l.bind list_encode), lih, list.map] } },
  { intro t,
    induction t with a n f ts ih; intro l,
    { rw [list_encode, singleton_append, list_decode] },
    { rw [list_encode, cons_append, list_decode],
      have h : list_decode ((fin_range n).bind (λ (i : fin n), (ts i).list_encode) ++ l) =
        (fin_range n).map (option.some ∘ ts) ++ list_decode l,
      { induction (fin_range n) with i l' l'ih,
        { refl },
        { rw [cons_bind, list.append_assoc, ih, map_cons, l'ih, cons_append] } },
      have h' : ∀ i, (list_decode ((fin_range n).bind (λ (i : fin n), (ts i).list_encode) ++ l)).nth
        ↑i = some (some (ts i)),
      { intro i,
        rw [h, nth_append, nth_map],
        { simp only [option.map_eq_some', function.comp_app, nth_eq_some],
          refine ⟨i, ⟨lt_of_lt_of_le i.2 (ge_of_eq (length_fin_range _)), _⟩, rfl⟩,
          rw [nth_le_fin_range, fin.eta] },
        { refine lt_of_lt_of_le i.2 _,
          simp } },
      refine (dif_pos (λ i, option.is_some_iff_exists.2 ⟨ts i, _⟩)).trans _,
      { rw [option.join_eq_some, h'] },
      refine congr (congr rfl (congr rfl (congr rfl (funext (λ i, option.get_of_mem _ _))))) _,
      { simp [h'] },
      { rw [h, drop_left'],
        rw [length_map, length_fin_range] } } }
end

/-- An encoding of terms as lists. -/
@[simps] protected def encoding : encoding (L.term α) :=
{ Γ := α ⊕ Σ i, L.functions i,
  encode := list_encode,
  decode := λ l, (list_decode l).head'.join,
  decode_encode := λ t, begin
    have h := list_decode_encode_list [t],
    rw [bind_singleton] at h,
    simp only [h, option.join, head', list.map, option.some_bind, id.def],
  end }

lemma list_encode_injective :
  function.injective (list_encode : L.term α → list (α ⊕ Σ i, L.functions i)) :=
term.encoding.encode_injective

theorem card_le : # (L.term α) ≤ max ℵ₀ (# (α ⊕ Σ i, L.functions i)) :=
lift_le.1 (trans term.encoding.card_le_card_list (lift_le.2 (mk_list_le_max _)))

theorem card_sigma : # (Σ n, (L.term (α ⊕ fin n))) = max ℵ₀ (# (α ⊕ Σ i, L.functions i)) :=
begin
  refine le_antisymm _ _,
  { rw mk_sigma,
    refine (sum_le_supr_lift _).trans _,
    rw [mk_nat, lift_aleph_0, mul_eq_max_of_aleph_0_le_left le_rfl, max_le_iff,
      csupr_le_iff' (bdd_above_range _)],
    { refine ⟨le_max_left _ _, λ i, card_le.trans _⟩,
      refine max_le (le_max_left _ _) _,
      rw [← add_eq_max le_rfl, mk_sum, mk_sum, mk_sum, add_comm (cardinal.lift (#α)), lift_add,
        add_assoc, lift_lift, lift_lift, mk_fin, lift_nat_cast],
      exact add_le_add_right (nat_lt_aleph_0 _).le _ },
    { rw [← one_le_iff_ne_zero],
      refine trans _ (le_csupr (bdd_above_range _) 1),
      rw [one_le_iff_ne_zero, mk_ne_zero_iff],
      exact ⟨var (sum.inr 0)⟩ } },
  { rw [max_le_iff, ← infinite_iff],
    refine ⟨infinite.of_injective (λ i, ⟨i + 1, var (sum.inr i)⟩) (λ i j ij, _), _⟩,
    { cases ij,
      refl },
    { rw [cardinal.le_def],
      refine ⟨⟨sum.elim (λ i, ⟨0, var (sum.inl i)⟩)
        (λ F, ⟨1, func F.2 (λ _, var (sum.inr 0))⟩), _⟩⟩,
      { rintros (a | a) (b | b) h,
        { simp only [sum.elim_inl, eq_self_iff_true, heq_iff_eq, true_and] at h,
          rw h },
        { simp only [sum.elim_inl, sum.elim_inr, nat.zero_ne_one, false_and] at h,
          exact h.elim },
        { simp only [sum.elim_inr, sum.elim_inl, nat.one_ne_zero, false_and] at h,
          exact h.elim },
        { simp only [sum.elim_inr, eq_self_iff_true, heq_iff_eq, true_and] at h,
          rw sigma.ext_iff.2 ⟨h.1, h.2.1⟩, } } } }
end

instance [encodable α] [encodable ((Σ i, L.functions i))] :
  encodable (L.term α) :=
encodable.of_left_injection list_encode (λ l, (list_decode l).head'.join)
  (λ t, begin
    rw [← bind_singleton list_encode, list_decode_encode_list],
    simp only [option.join, head', list.map, option.some_bind, id.def],
  end)

instance [h1 : countable α] [h2 : countable (Σl, L.functions l)] :
  countable (L.term α) :=
begin
  refine mk_le_aleph_0_iff.1 (card_le.trans (max_le_iff.2 _)),
  simp only [le_refl, mk_sum, add_le_aleph_0, lift_le_aleph_0, true_and],
  exact ⟨cardinal.mk_le_aleph_0, cardinal.mk_le_aleph_0⟩,
end

instance small [small.{u} α] :
  small.{u} (L.term α) :=
small_of_injective list_encode_injective

end term

namespace bounded_formula

/-- Encodes a bounded formula as a list of symbols. -/
def list_encode : ∀ {n : ℕ}, L.bounded_formula α n →
  list ((Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ)
| n falsum := [sum.inr (sum.inr (n + 2))]
| n (equal t₁ t₂) := [sum.inl ⟨_, t₁⟩, sum.inl ⟨_, t₂⟩]
| n (rel R ts) := [sum.inr (sum.inl ⟨_, R⟩), sum.inr (sum.inr n)] ++
  ((list.fin_range _).map (λ i, sum.inl ⟨n, (ts i)⟩))
| n (imp φ₁ φ₂) := (sum.inr (sum.inr 0)) :: φ₁.list_encode ++ φ₂.list_encode
| n (all φ) := (sum.inr (sum.inr 1)) :: φ.list_encode

/-- Applies the `forall` quantifier to an element of `(Σ n, L.bounded_formula α n)`,
or returns `default` if not possible. -/
def sigma_all : (Σ n, L.bounded_formula α n) → Σ n, L.bounded_formula α n
| ⟨(n + 1), φ⟩ := ⟨n, φ.all⟩
| _ := default

/-- Applies `imp` to two elements of `(Σ n, L.bounded_formula α n)`,
or returns `default` if not possible. -/
def sigma_imp :
  (Σ n, L.bounded_formula α n) → (Σ n, L.bounded_formula α n) → (Σ n, L.bounded_formula α n)
| ⟨m, φ⟩ ⟨n, ψ⟩ := if h : m = n then ⟨m, φ.imp (eq.mp (by rw h) ψ)⟩ else default

/-- Decodes a list of symbols as a list of formulas. -/
@[simp] def list_decode :
  Π (l : list ((Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ)),
    (Σ n, L.bounded_formula α n) ×
    { l' : list ((Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ)
    // l'.sizeof ≤ max 1 l.sizeof }
| ((sum.inr (sum.inr (n + 2))) :: l) := ⟨⟨n, falsum⟩, l, le_max_of_le_right le_add_self⟩
| ((sum.inl ⟨n₁, t₁⟩) :: sum.inl ⟨n₂, t₂⟩ :: l) :=
    ⟨if h : n₁ = n₂ then ⟨n₁, equal t₁ (eq.mp (by rw h) t₂)⟩ else default, l, begin
      simp only [list.sizeof, ← add_assoc],
      exact le_max_of_le_right le_add_self,
    end⟩
| (sum.inr (sum.inl ⟨n, R⟩) :: (sum.inr (sum.inr k)) :: l) := ⟨
    if h : ∀ (i : fin n), ((l.map sum.get_left).nth i).join.is_some
    then if h' : ∀ i, (option.get (h i)).1 = k
      then ⟨k, bounded_formula.rel R (λ i, eq.mp (by rw h' i) (option.get (h i)).2)⟩
      else default
    else default,
    l.drop n, le_max_of_le_right (le_add_left (le_add_left (list.drop_sizeof_le _ _)))⟩
| ((sum.inr (sum.inr 0)) :: l) :=
  have (↑((list_decode l).2) : list ((Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ)).sizeof
    < 1 + (1 + 1) + l.sizeof, from begin
      refine lt_of_le_of_lt (list_decode l).2.2 (max_lt _ (nat.lt_add_of_pos_left dec_trivial)),
      rw [add_assoc, add_comm, nat.lt_succ_iff, add_assoc],
      exact le_self_add,
    end,
  ⟨sigma_imp (list_decode l).1 (list_decode (list_decode l).2).1,
    (list_decode (list_decode l).2).2, le_max_of_le_right (trans (list_decode _).2.2 (max_le
      (le_add_right le_self_add) (trans (list_decode _).2.2
      (max_le (le_add_right le_self_add) le_add_self))))⟩
| ((sum.inr (sum.inr 1)) :: l) := ⟨sigma_all (list_decode l).1, (list_decode l).2,
  (list_decode l).2.2.trans (max_le_max le_rfl le_add_self)⟩
| _ := ⟨default, [], le_max_left _ _⟩

@[simp] theorem list_decode_encode_list (l : list (Σ n, L.bounded_formula α n)) :
  (list_decode (l.bind (λ φ, φ.2.list_encode))).1 = l.head :=
begin
  suffices h : ∀ (φ : (Σ n, L.bounded_formula α n)) l,
    (list_decode (list_encode φ.2 ++ l)).1 = φ ∧ (list_decode (list_encode φ.2 ++ l)).2.1 = l,
  { induction l with φ l lih,
    { rw [list.nil_bind],
      simp [list_decode], },
    { rw [cons_bind, (h φ _).1, head_cons] } },
  { rintro ⟨n, φ⟩,
    induction φ with _ _ _ _ _ _ _ ts _ _ _ ih1 ih2 _ _ ih; intro l,
    { rw [list_encode, singleton_append, list_decode],
      simp only [eq_self_iff_true, heq_iff_eq, and_self], },
    { rw [list_encode, cons_append, cons_append, list_decode, dif_pos],
      { simp only [eq_mp_eq_cast, cast_eq, eq_self_iff_true, heq_iff_eq, and_self, nil_append], },
      { simp only [eq_self_iff_true, heq_iff_eq, and_self], } },
    { rw [list_encode, cons_append, cons_append, singleton_append, cons_append, list_decode],
      { have h : ∀ (i : fin φ_l), ((list.map sum.get_left (list.map (λ (i : fin φ_l),
          sum.inl (⟨(⟨φ_n, rel φ_R ts⟩ : Σ n, L.bounded_formula α n).fst, ts i⟩ :
            Σ n, L.term (α ⊕ fin n))) (fin_range φ_l) ++ l)).nth ↑i).join = some ⟨_, ts i⟩,
        { intro i,
          simp only [option.join, map_append, map_map, option.bind_eq_some, id.def, exists_eq_right,
            nth_eq_some, length_append, length_map, length_fin_range],
          refine ⟨lt_of_lt_of_le i.2 le_self_add, _⟩,
          rw [nth_le_append, nth_le_map],
          { simp only [sum.get_left, nth_le_fin_range, fin.eta, function.comp_app, eq_self_iff_true,
            heq_iff_eq, and_self] },
          { exact lt_of_lt_of_le i.is_lt (ge_of_eq (length_fin_range _)) },
          { rw [length_map, length_fin_range],
            exact i.2 } },
        rw dif_pos, swap,
        { exact λ i, option.is_some_iff_exists.2 ⟨⟨_, ts i⟩, h i⟩ },
        rw dif_pos, swap,
        { intro i,
          obtain ⟨h1, h2⟩ := option.eq_some_iff_get_eq.1 (h i),
          rw h2 },
        simp only [eq_self_iff_true, heq_iff_eq, true_and],
        refine ⟨funext (λ i, _), _⟩,
        { obtain ⟨h1, h2⟩ := option.eq_some_iff_get_eq.1 (h i),
          rw [eq_mp_eq_cast, cast_eq_iff_heq],
          exact (sigma.ext_iff.1 ((sigma.eta (option.get h1)).trans h2)).2 },
        rw [list.drop_append_eq_append_drop, length_map, length_fin_range, nat.sub_self, drop,
          drop_eq_nil_of_le, nil_append],
        rw [length_map, length_fin_range], }, },
    { rw [list_encode, list.append_assoc, cons_append, list_decode],
      simp only [subtype.val_eq_coe] at *,
      rw [(ih1 _).1, (ih1 _).2, (ih2 _).1, (ih2 _).2, sigma_imp, dif_pos rfl],
      exact ⟨rfl, rfl⟩, },
    { rw [list_encode, cons_append, list_decode],
      simp only,
      simp only [subtype.val_eq_coe] at *,
      rw [(ih _).1, (ih _).2, sigma_all],
      exact ⟨rfl, rfl⟩ } }
end

/-- An encoding of bounded formulas as lists. -/
@[simps] protected def encoding : encoding (Σ n, L.bounded_formula α n) :=
{ Γ := (Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ,
  encode := λ φ, φ.2.list_encode,
  decode := λ l, (list_decode l).1,
  decode_encode := λ φ, begin
    have h := list_decode_encode_list [φ],
    rw [bind_singleton] at h,
    rw h,
    refl,
  end }

lemma list_encode_sigma_injective :
  function.injective (λ (φ : Σ n, L.bounded_formula α n), φ.2.list_encode) :=
bounded_formula.encoding.encode_injective

theorem card_le : # (Σ n, L.bounded_formula α n) ≤
  max ℵ₀ (cardinal.lift.{max u v} (#α) + cardinal.lift.{u'} L.card) :=
begin
  refine lift_le.1 ((bounded_formula.encoding.card_le_card_list).trans _),
  rw [encoding_Γ, mk_list_eq_max_mk_aleph_0, lift_max, lift_aleph_0, lift_max, lift_aleph_0,
    max_le_iff],
  refine ⟨_, le_max_left _ _⟩,
  rw [mk_sum, term.card_sigma, mk_sum, ← add_eq_max le_rfl, mk_sum, mk_nat],
  simp only [lift_add, lift_lift, lift_aleph_0],
  rw [← add_assoc, add_comm, ← add_assoc, ← add_assoc, aleph_0_add_aleph_0, add_assoc,
    add_eq_max le_rfl, add_assoc, card, symbols, mk_sum, lift_add, lift_lift, lift_lift],
end

end bounded_formula

end language
end first_order


/-
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
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.big_operators.basic
import Mathlib.data.finset.pi
import Mathlib.data.finset.powerset
import Mathlib.PostPort

universes u v u_1 u_2

namespace Mathlib

/-!
# Results about big operators with values in a (semi)ring

We prove results about big operators that involve some interaction between
multiplicative and additive structures on the values being combined.
-/

namespace finset

theorem sum_mul {α : Type u} {β : Type v} {s : finset α} {b : β} {f : α → β} [semiring β] :
    (finset.sum s fun (x : α) => f x) * b = finset.sum s fun (x : α) => f x * b :=
  Eq.symm (sum_hom s fun (x : β) => x * b)

theorem mul_sum {α : Type u} {β : Type v} {s : finset α} {b : β} {f : α → β} [semiring β] :
    (b * finset.sum s fun (x : α) => f x) = finset.sum s fun (x : α) => b * f x :=
  Eq.symm (sum_hom s (Mul.mul b))

theorem sum_mul_boole {α : Type u} {β : Type v} [semiring β] [DecidableEq α] (s : finset α)
    (f : α → β) (a : α) :
    (finset.sum s fun (x : α) => f x * ite (a = x) 1 0) = ite (a ∈ s) (f a) 0 :=
  sorry

theorem sum_boole_mul {α : Type u} {β : Type v} [semiring β] [DecidableEq α] (s : finset α)
    (f : α → β) (a : α) :
    (finset.sum s fun (x : α) => ite (a = x) 1 0 * f x) = ite (a ∈ s) (f a) 0 :=
  sorry

theorem sum_div {α : Type u} {β : Type v} [division_ring β] {s : finset α} {f : α → β} {b : β} :
    (finset.sum s fun (x : α) => f x) / b = finset.sum s fun (x : α) => f x / b :=
  sorry

/-- The product over a sum can be written as a sum over the product of sets, `finset.pi`.
  `finset.prod_univ_sum` is an alternative statement when the product is over `univ`. -/
theorem prod_sum {α : Type u} {β : Type v} [comm_semiring β] {δ : α → Type u_1} [DecidableEq α]
    [(a : α) → DecidableEq (δ a)] {s : finset α} {t : (a : α) → finset (δ a)}
    {f : (a : α) → δ a → β} :
    (finset.prod s fun (a : α) => finset.sum (t a) fun (b : δ a) => f a b) =
        finset.sum (pi s t)
          fun (p : (a : α) → a ∈ s → δ a) =>
            finset.prod (attach s)
              fun (x : Subtype fun (x : α) => x ∈ s) =>
                f (subtype.val x) (p (subtype.val x) (subtype.property x)) :=
  sorry

theorem sum_mul_sum {β : Type v} [comm_semiring β] {ι₁ : Type u_1} {ι₂ : Type u_2} (s₁ : finset ι₁)
    (s₂ : finset ι₂) (f₁ : ι₁ → β) (f₂ : ι₂ → β) :
    ((finset.sum s₁ fun (x₁ : ι₁) => f₁ x₁) * finset.sum s₂ fun (x₂ : ι₂) => f₂ x₂) =
        finset.sum (finset.product s₁ s₂) fun (p : ι₁ × ι₂) => f₁ (prod.fst p) * f₂ (prod.snd p) :=
  sorry

/-- The product of `f a + g a` over all of `s` is the sum
  over the powerset of `s` of the product of `f` over a subset `t` times
  the product of `g` over the complement of `t`  -/
theorem prod_add {α : Type u} {β : Type v} [comm_semiring β] (f : α → β) (g : α → β)
    (s : finset α) :
    (finset.prod s fun (a : α) => f a + g a) =
        finset.sum (powerset s)
          fun (t : finset α) =>
            (finset.prod t fun (a : α) => f a) * finset.prod (s \ t) fun (a : α) => g a :=
  sorry

/--  Summing `a^s.card * b^(n-s.card)` over all finite subsets `s` of a `finset`
gives `(a + b)^s.card`.-/
theorem sum_pow_mul_eq_add_pow {α : Type u_1} {R : Type u_2} [comm_semiring R] (a : R) (b : R)
    (s : finset α) :
    (finset.sum (powerset s) fun (t : finset α) => a ^ card t * b ^ (card s - card t)) =
        (a + b) ^ card s :=
  sorry

theorem prod_pow_eq_pow_sum {α : Type u} {β : Type v} [comm_semiring β] {x : β} {f : α → ℕ}
    {s : finset α} : (finset.prod s fun (i : α) => x ^ f i) = x ^ finset.sum s fun (x : α) => f x :=
  sorry

theorem dvd_sum {α : Type u} {β : Type v} [comm_semiring β] {b : β} {s : finset α} {f : α → β}
    (h : ∀ (x : α), x ∈ s → b ∣ f x) : b ∣ finset.sum s fun (x : α) => f x :=
  sorry

theorem prod_nat_cast {α : Type u} {β : Type v} [comm_semiring β] (s : finset α) (f : α → ℕ) :
    ↑(finset.prod s fun (x : α) => f x) = finset.prod s fun (x : α) => ↑(f x) :=
  ring_hom.map_prod (nat.cast_ring_hom β) f s

/-- A product over all subsets of `s ∪ {x}` is obtained by multiplying the product over all subsets
of `s`, and over all subsets of `s` to which one adds `x`. -/
theorem prod_powerset_insert {α : Type u} {β : Type v} [DecidableEq α] [comm_monoid β]
    {s : finset α} {x : α} (h : ¬x ∈ s) (f : finset α → β) :
    (finset.prod (powerset (insert x s)) fun (a : finset α) => f a) =
        (finset.prod (powerset s) fun (a : finset α) => f a) *
          finset.prod (powerset s) fun (t : finset α) => f (insert x t) :=
  sorry

end Mathlib


import tactic
import cw3.euclidean_domain
import cw3.ufd
import data.int.parity
import algebra.order.archimedean

/--
The type of Gaussian Integers ℤ[i]
-/
@[nolint has_inhabited_instance]
structure gaussian_ints :=
(re : ℤ)
(im : ℤ)

attribute [ext] gaussian_ints

namespace gaussian_ints

/--
Component wise addition
-/
def add (x y : gaussian_ints) : gaussian_ints :=
⟨x.re + y.re, x.im + y.im ⟩
instance : has_add gaussian_ints :=
{ add := add }

/--
Complex multiplication
-/
def prod (x y : gaussian_ints) : gaussian_ints :=
⟨ x.re * y.re - x.im * y.im , x.re * y.im + x.im * y.re ⟩
instance : has_mul gaussian_ints :=
{ mul := prod }
lemma mul_def (x y : gaussian_ints) :
x * y = ⟨ x.re * y.re - x.im * y.im , x.re * y.im + x.im * y.re ⟩ := rfl
lemma mul_re (x y : gaussian_ints):
(x*y).re = x.re * y.re - x.im * y.im := rfl
lemma mul_im (x y : gaussian_ints):
(x*y).im = x.re * y.im + x.im * y.re:= rfl

/--
Convert an integer x to x + 0i
-/
def convert_int (x : ℤ) : gaussian_ints := ⟨x , (0 : ℤ) ⟩

instance : has_zero gaussian_ints :=
{zero := convert_int (0:ℤ)}
instance : has_one gaussian_ints :=
{one := convert_int (1:ℤ)}

/--
Complex negation (component-wise)
-/
def neg (x : gaussian_ints) : gaussian_ints := ⟨-x.re, -x.im⟩
instance : has_neg gaussian_ints :=
{ neg := neg }

/--
Component wise subtraction
-/
def sub (x y : gaussian_ints) : gaussian_ints :=
⟨x.re - y.re, x.im - y.im ⟩
instance : has_sub gaussian_ints :=
{ sub := sub }

/--
Complex conjugation
-/
def conj (x : gaussian_ints) : gaussian_ints := ⟨ x.re, -x.im ⟩

@[nolint doc_blame]
def nsmul : ℕ → gaussian_ints → gaussian_ints
| 0 x := (0 : gaussian_ints)
| (n + 1) x := x +(nsmul n x)

@[nolint doc_blame]
def zsmul : ℤ → gaussian_ints → gaussian_ints
| (int.of_nat a) x := nsmul a x
| -[1+ a] x := -(nsmul (a + 1) x)

@[nolint doc_blame]
def npow : ℕ → gaussian_ints → gaussian_ints
| 0 x := 1
| (n+1) x := x * (npow n x)

instance : has_coe ℤ gaussian_ints :=
{ coe := convert_int }

@[simp] lemma coe_mul (x y : ℤ) : coe (x*y) = (x : gaussian_ints ) * (y:gaussian_ints) :=
begin
  ext,
  change x*y = x * y - 0 * 0,
  ring,
  change 0 * 0 = x * 0 + 0 * y,
  ring,
end

lemma ext_eq {x y : gaussian_ints} : x = y ↔ x.re = y.re ∧ x.im = y.im :=
begin
  split,
  {
    intro h,
    split;
    rw h,
  },
  {
    intro h,
    ext,
    exact h.left,
    exact h.right,
  }
end

/-
The Gaussian integers ℤ[i] are a ring.
-/
instance : comm_ring gaussian_ints :=
{ add := add,
  add_assoc := begin
    intros a b c,
    ext,
    {
      change (a.re+b.re ) + c.re =(a.re + (b.re + c.re)),
      ring,
    },
    {
      change (a.im+b.im ) + c.im =(a.im + (b.im + c.im)),
      ring,
    },
  end,
  zero := convert_int 0,
  zero_add := begin
    intro a,
    ext,
    {
      change (0 : ℤ) + a.re = a.re,
      rw zero_add,
    },
    {
      change (0 : ℤ) + a.im = a.im,
      rw zero_add,
    }
  end,
  add_zero := begin
    intro a,
    ext,
    {
      change  a.re + (0 : ℤ) = a.re,
      rw add_zero,
    },
    {
      change a.im + (0 : ℤ) = a.im,
      rw add_zero,
    }
  end,
  nsmul := nsmul,
  nsmul_zero' := by {intro a, refl},
  nsmul_succ' := by {intros a x, refl},
  neg := neg,
  sub := sub,
  sub_eq_add_neg := begin
    intros a b,
    ext,
    {
      change a.re - b.re = (a.re + -b.re),
      ring,
    },{
      change a.im - b.im = (a.im + -b.im),
      ring,
    }
  end,
  zsmul := zsmul,
  zsmul_zero' := by {intro a, refl},
  zsmul_succ' := by {intros a b, refl},
  zsmul_neg' := by {intros a b, refl},
  add_left_neg := begin
    intro a, ext,
    {
      change -a.re + a.re = (0 : ℤ),
      ring,
    },{
      change -a.im + a.im = (0 : ℤ),
      ring,
    }
  end,
  add_comm := begin
    intros a b,
    ext,
    {
      change a.re + b.re = b.re + a.re,
      ring,
    },{
      change a.im + b.im = b.im + a.im,
      ring,
    }
  end,
  mul := prod,
  mul_assoc := begin
    intros a b c,
    ext,
    {
      change (a.re * b.re - a.im * b.im) * c.re - (a.re * b.im + a.im * b.re) * c.im =
      a.re * (b.re * c.re - b.im * c.im) - a.im * (b.re * c.im + b.im * c.re),
      ring,
    },
    {
      change (a.re * b.re - a.im * b.im) * c.im + (a.re * b.im + a.im *b.re) * c.re =
      a.re * (b.re * c.im + b.im * c.re) + a.im * (b.re * c.re - b.im * c.im),
      ring,
    }
  end,
  one := (1 : gaussian_ints),
  one_mul := begin
    intro a,
    ext,
    {
      change 1 * a.re - 0 * a.im = a.re,
      ring,
    },
    {
      change 1 * a.im + 0 * a.re = a.im,
      ring,
    }
  end,
  mul_one := begin
    intro a,
    ext,
    {change a.re * 1 - a.im * 0 = a.re, ring,},
    {change a.re * 0 + a.im * 1 = a.im, ring,}
  end,
  npow := npow,
  npow_zero' := by {intro a, refl},
  npow_succ' := by {intros a b, refl},
  left_distrib := begin
    intros a b c,
    ext,
    {
      change a.re * (b.re + c.re) - a.im * (b.im + c.im) =
      (a.re * b.re - a.im * b.im) + (a.re * c.re - a.im * c.im),
      ring,
    },{
      change a.re * (b.im + c.im) + a.im * (b.re + c.re) =
      (a.re * b.im + a.im * b.re) + (a.re * c.im + a.im * c.re),
      ring,
    }
  end,
  right_distrib := begin
    intros a b c,
    ext,
    {
      change (a.re + b.re) * c.re - (a.im + b.im) * c.im =
      (a.re * c.re - a.im * c.im) + (b.re * c.re - b.im * c.im),
      ring,
    },
    {
      change (a.re + b.re) * c.im + (a.im + b.im) * c.re =
      (a.re * c.im + a.im * c.re) + (b.re * c.im + b.im * c.re),
      ring,
    }
  end,
  mul_comm := begin
    intros a b,
    ext,
    {
      change a.re * b.re - a.im * b.im = b.re * a.re - b.im * a.im,
      ring,
    },
    {
      change a.re * b.im + a.im * b.re = b.re * a.im + b.im * a.re,
      ring,
    }
  end
}

/--
Norm function for Gaussian integers. Defined by Re(x)^2 + Im(x)^2 rather than x * x.conj
-/
def norm (x : gaussian_ints) : ℤ := x.re ^ 2 + x.im ^ 2

lemma norm_nonneg : ∀ (x : gaussian_ints), 0 ≤ norm x :=
begin
  intro x,
  have hx := sq_nonneg x.re,
  have hy := sq_nonneg x.im,
  change 0 ≤ x.re^2 +x.im^2,
  linarith,
end
lemma sum_sqs_eq_zero  (x y : ℤ) : x^2 + y^2 = 0 → x = 0:=
begin
  intro h,
  have hx := sq_nonneg x,
  have hy := sq_nonneg y,
  apply @pow_eq_zero _ _ _ _ 2,
  linarith, apply_instance,
end
lemma norm_zero_iff_zero : ∀ (a : gaussian_ints), norm a = (0:ℤ) ↔ a = (0:gaussian_ints) :=
begin
  intro x,
  split,
  {
    intro h,
    change x.re^2 + x.im^2 = 0 at h,
    ext,
    {
      apply sum_sqs_eq_zero x.re x.im,
      exact h,
    },
    {
      rw add_comm at h,
      apply sum_sqs_eq_zero x.im x.re,
      exact h,
    }
  },{
    intro h,
    rw h,
    change (0 : ℤ) ^2 + (0 : ℤ)^2 = 0,
    norm_num,
  }
end

lemma norm_zero_eq_zero : norm 0 = 0 :=
begin
  change (0 : ℤ) ^2 + (0 : ℤ)^2 = 0,
  norm_num,
end

lemma norm_pos_if_nonzero {b : gaussian_ints} (h : b ≠ 0) : (0:ℤ) < norm b :=
begin
  change ¬(b = 0) at h,
  rw ←norm_zero_iff_zero at h,
  rw eq_comm at h,
  rw ←(ne.le_iff_lt h),
  exact norm_nonneg b,
end

lemma norm_mul (x y : gaussian_ints) : norm (x*y) = (norm x) * (norm y) :=
begin
  change (x.re * y.re - x.im * y.im)^2 + (x.re * y.im + x.im * y.re)^2 = (x.re^2+x.im^2) * (y.re^2 + y.im^2),
  ring,
end

lemma norm_div {x y: gaussian_ints} (h : x \ y) :  norm x ∣ norm y :=
begin
  cases h with k hk,
  use k.norm,
  rw ←norm_mul,
  rw hk,
end

lemma norm_conj_eq_norm (x : gaussian_ints) : norm(x) = norm(x.conj) :=
begin
  change norm x = x.re^2 + (-x.im)^2,
  rw neg_sq,
  refl,
end

lemma norm_eq_conj_mul (x : gaussian_ints) : coe (norm x) = x * x.conj :=
begin
  ext,
  change x.re^2 +x.im^2= x.re * x.re - x.im * (-x.im),
  ring,
  change 0 = x.re * (-x.im) + x.im * x.re,
  ring,
end

lemma norm_one_iff_unit {x : gaussian_ints}: norm x = 1 ↔ is_unit x :=
begin
  split,
  {
    intro h,
    rw is_unit_iff_exists_inv,
    apply_fun convert_int at h,
    change coe (norm x) = (1 : gaussian_ints) at h,
    rw norm_eq_conj_mul at h,
    use x.conj,
    exact h,
  },
  {
    intro h,
    rw is_unit_iff_exists_inv at h,
    cases h with i hi,
    apply_fun norm at hi,
    change (x * i).norm = 1^2 + 0^2 at hi,
    rw ( by ring :(1:ℤ)^2 + 0^2 = 1) at hi,
    rw norm_mul at hi,
    rw mul_comm at hi,
    exact int.eq_one_of_mul_eq_one_left (norm_nonneg x) hi,
  }
end

/-
The only units in ℤ[i] are 1, -1, i, -i.
-/
lemma all_the_units {x : gaussian_ints} : is_unit x ↔ x ∈ ({1, -1, ⟨0, 1⟩, ⟨0, -1⟩} : set gaussian_ints) :=
begin
  rw ←norm_one_iff_unit,
  split;
  intro h,
  {
    change x.re^2 +x.im^2 = 1 at h,
    have h2 : 0 ≤ (x.re^2), exact (sq_nonneg x.re), --doing what I did for h3 does not work with interval_cases???
    have h3 := sq_nonneg x.im,
    have h4 : x.re^2 ≤ 1,
    linarith,
    interval_cases (x.re^2) with h5,
    {
      rw h5 at h,
      rw zero_add at h,
      rw eq_comm at h5,
      rw (by ring: x.re^2 = x.re*x.re) at h5,
      rw zero_eq_mul at h5,
      rw or_self at h5,
      rw sqrt_one_eqn at h,
      cases h,
      right,right,left, ext, exact h5, exact h,
      right,right,right, ext, exact h5, exact h,
    },
    {
      rw h5 at h,
      nth_rewrite 1 ←add_zero (1:ℤ) at h,
      rw add_left_cancel_iff at h,
      rw eq_comm at h,
      rw (by ring: x.im^2 = x.im*x.im) at h,
      rw zero_eq_mul at h,
      rw or_self at h,
      rw sqrt_one_eqn at h5,
      cases h5,
      left, ext, exact h5, exact h,
      right, left, ext, exact h5, exact h,
    }

  },
  {
    cases h,
    rw h,
    change 1^2 + 0^2 = (1 : ℤ),
    norm_num,
    cases h,
    rw h,
    change (-1)^2 + 0^2 = (1 : ℤ),
    norm_num,
    cases h,
    rw h,
    change 0^2 + 1^2 = (1 : ℤ),
    norm_num,
    cases h,
    cases h,
    change 0^2 + (-1)^2 = (1 : ℤ),
    norm_num,
  }
end

lemma i_sq_minus_one : (⟨0, 1⟩: gaussian_ints)^2 = (⟨-1, 0⟩ : gaussian_ints) :=
begin
  rw (by ring: (⟨0, 1⟩:gaussian_ints)^2 = (⟨0, 1⟩ :gaussian_ints) * (⟨0, 1⟩ :gaussian_ints)),
  ext,
  norm_num [mul_re, mul_def, mul_im],
  norm_num [mul_re, mul_def, mul_im],
end

lemma i_cub_minus_i : (⟨0, 1⟩: gaussian_ints)^3 = (⟨0, -1⟩ : gaussian_ints) :=
begin
  rw (by ring: (⟨0, 1⟩:gaussian_ints)^3 = (⟨0, 1⟩ :gaussian_ints) * (⟨0, 1⟩ :gaussian_ints) * (⟨0, 1⟩ :gaussian_ints)),
  ext,
  norm_num [mul_re, mul_def, mul_im],
  norm_num [mul_re, mul_def, mul_im],
end

/-
The ring ℤ[i] is a Euclidean domain.
-/
instance : my_euclidean_domain gaussian_ints :=
{
  hzd := begin
    intros x y h,
    apply_fun norm at h,
    rw norm_mul at h,
    rw norm_zero_eq_zero at h,
    rw mul_eq_zero at h,
    rw norm_zero_iff_zero at h,
    rw norm_zero_iff_zero at h,
    exact h,
  end,
  norm := norm,
  norm_nonneg := norm_nonneg,
  norm_zero_iff_zero := norm_zero_iff_zero,
  hnorm := begin
    intros a b hb,
    let d_real := ((a * b.conj).re : ℚ)/((norm b) : ℚ),
    let d_imag := ((a * b.conj).im : ℚ)/((norm b) : ℚ),
    let d_real_rounded := round d_real,
    let d_imag_rounded := round d_imag,
    let q := gaussian_ints.mk d_real_rounded d_imag_rounded,
    use q,
    use a - b * q,
    split,
    {
      ring,
    },
    {
      have hre := abs_sub_round d_real,
      have him := abs_sub_round d_imag,
      have hre2 := sq_le_sq (le_abs_le hre),
      have him2 := sq_le_sq (le_abs_le him),
      rw (by norm_num : ((1:ℚ)/(2:ℚ))^2 = 1/4 ) at hre2 him2,
      change (a - b*q).re ^2 + (a - b*q).im^2 < norm b,
      have hdr : (d_imag - coe q.im) ^ 2 + (d_real - coe q.re) ^ 2 ≤ 1/2,
        linarith,
      have h3 : (0 : ℚ) < b.norm,
      {
        norm_cast,
        exact (norm_pos_if_nonzero hb),
      },
      have h4 : (b.norm : ℚ) ≠ 0,
      {
        norm_cast,
        by_contra,
        apply hb,
        rw norm_zero_iff_zero b at h,
        exact h,
      },
      rw ←mul_le_mul_left h3 at hdr,
      have hlr : (b.norm : ℚ) * ((d_imag - ↑(q.im)) ^ 2 + (d_real - ↑(q.re)) ^ 2) = coe ((a - b * q).re ^ 2 + (a - b * q).im ^ 2),
      {
        push_cast,
        rw mul_add,
        have hsq_eval : ∀(a b : ℚ), (a - b)^2 = a^2 + b^2 - 2*a*b,
          intros a b,
          ring,
        rw hsq_eval d_imag (coe d_imag_rounded),
        rw hsq_eval d_real (coe d_real_rounded),
        rw mul_sub,
        rw mul_add,
        rw mul_sub,
        rw mul_add,
        rw (by ring : ↑(b.norm) * d_imag ^ 2 + ↑(b.norm) * ↑d_imag_rounded ^ 2 - ↑(b.norm) * (2 * d_imag * ↑d_imag_rounded) + (↑(b.norm) * d_real ^ 2 + ↑(b.norm) * ↑d_real_rounded ^ 2 - ↑(b.norm) * (2 * d_real * ↑d_real_rounded)) =
        (↑(b.norm) * d_real ^ 2 +↑(b.norm) * d_imag ^ 2) - (↑(b.norm) * (2 * d_imag * ↑d_imag_rounded) + ↑(b.norm) * (2 * d_real * ↑d_real_rounded)) + ↑(b.norm) * ↑d_imag_rounded ^ 2  + ( ↑(b.norm) * ↑d_real_rounded ^ 2 )),
        have h_2d_b_mul : ↑(b.norm) * (2 * d_imag * ↑d_imag_rounded) + ↑(b.norm) * (2 * d_real * ↑d_real_rounded) = 2 * (a*b.conj).im * ↑d_imag_rounded + 2 * (a*b.conj).re * ↑d_real_rounded,
        {
          nth_rewrite 2 mul_comm,
          rw ←mul_assoc,
          rw ←mul_assoc,
          have hbim : (b.norm : ℚ) * (((a * b.conj).im : ℚ)/((norm b) : ℚ)) = ((a * b.conj).im : ℚ),
          {
            exact mul_div_cancel' ((a * b.conj).im : ℚ) h4,
          },
          have hdre : (b.norm : ℚ) * (((a * b.conj).re : ℚ)/((norm b) : ℚ)) = ((a * b.conj).re : ℚ),
          {
            exact mul_div_cancel' ((a * b.conj).re : ℚ) h4,
          },
          change ↑(b.norm) * (((a * b.conj).im : ℚ)/((norm b) : ℚ)) * 2 * ↑d_imag_rounded + ↑(b.norm) * (2 * d_real * ↑d_real_rounded) = 2 * ↑((a * b.conj).im) * ↑d_imag_rounded + 2 * ↑((a * b.conj).re) * ↑d_real_rounded,
          rw hbim,
          nth_rewrite 5 mul_comm,
          rw ←mul_assoc,
          rw ←mul_assoc,
          rw hdre,
          ring,
        },
        rw h_2d_b_mul,
        have hna_b_mul : ↑(b.norm) * d_real ^ 2 + ↑(b.norm) * d_imag ^ 2 = a.re ^2 + a.im ^2,
        {
          change ↑(b.norm) * (↑((a * b.conj).re) / ↑(b.norm)) ^ 2 + ↑(b.norm) * (↑((a * b.conj).im) / ↑(b.norm)) ^ 2 =
          ↑(a.re) ^ 2 + ↑(a.im) ^ 2,
          rw mul_re,
          rw mul_im,
          change
          ↑(b.norm) * (↑(a.re * b.re - a.im * (-b.im)) / ↑(b.norm)) ^ 2 +
          ↑(b.norm) * (↑(a.re * (-b.im) + a.im * b.re) / ↑(b.norm)) ^ 2
          = ↑(a.re) ^ 2 + ↑(a.im) ^ 2,
          field_simp,
          norm_cast,
          change (b.re^2+b.im^2) * (a.re * b.re + a.im * b.im) ^ 2 + (b.re^2+b.im^2) * (-(a.re * b.im) + a.im * b.re) ^ 2
          = (a.re ^ 2 + a.im ^ 2) * (b.re^2+b.im^2) ^ 2,
          ring,
        },
        rw hna_b_mul,
        norm_cast,
        change a.re ^ 2 + a.im ^ 2 - (2 * (a * b.conj).im * q.im +
        2 * (a * b.conj).re * q.re) + (b.re^2 + b.im^2) * q.im ^ 2 + (b.re^2 + b.im^2) * q.re ^ 2
        = (a.re - (b * q).re) ^ 2 + (a.im - (b * q).im) ^ 2,
        rw [mul_re, mul_re, mul_im, mul_im],
        change a.re ^ 2 + a.im ^ 2 - (2 * (a.re * (-b.im) + a.im * b.re) * q.im +
         2 * (a.re * b.re - a.im * (-b.im)) * q.re) + (b.re ^ 2 + b.im ^ 2) * q.im ^ 2 + (b.re ^ 2 + b.im ^ 2) * q.re ^ 2 =
         (a.re - (b.re * q.re - b.im * q.im)) ^ 2 + (a.im - (b.re * q.im + b.im * q.re)) ^ 2,
        ring,
      },
      suffices : ↑((a - b * q).re ^ 2 + (a - b * q).im ^ 2) < (b.norm : ℚ),
      exact int.cast_lt.mp this,
      rw ←hlr,
      linarith,
    },

  end
}
/-
  Weaker separating powers trick to remove the unit multiplication since every unit has a cube root.
  We just do this by trying all the cases for units.
-/
theorem separating_powers_cubes {p a b : gaussian_ints} (hcop : coprime a b) (heq : p^3 = a * b) : ∃(r : gaussian_ints), r^3 = a :=
begin
  have h2 := separating_powers_trick hcop heq,
  cases h2 with r hr,
  cases hr with u hu,
  cases hu with hu hrn,
  rw all_the_units at hu,
  cases hu,
    use r,
    rw hu at hrn,
    rw one_mul at hrn,
    exact hrn,
  cases hu,
    use -r,
    rw hu at hrn,
    rw (by ring : (-1) * r ^ 3 = (-r)^3) at hrn,
    exact hrn,
  cases hu,
    use (-u) * r,
    rw (by ring: (-u * r)^3 = -(u^3) * r^3),
    rw hu at ⊢ hrn,
    rw i_cub_minus_i,
    rw (by ring : -(⟨0, -1⟩:gaussian_ints) = ⟨0, 1 ⟩ ),
    exact hrn,
  cases hu, cases hu,
    use ⟨0, 1⟩ * r,
    rw (by ring : ((⟨0, 1⟩:gaussian_ints) * r) ^ 3 = (⟨0, 1⟩:gaussian_ints)^3 * r^3),
    rw i_cub_minus_i,
    exact hrn,
end

end gaussian_ints

/-
The only solution to X^2 + 1 = Y^3 over Z is x = 0, y = 1
-/
theorem my_diophantine_equation (x y : ℤ) : x^2 + 1 = y^3 → x = 0 :=
begin
  intro he,
  have heven : even x,
  {
    by_contra,
    rw ←int.odd_iff_not_even at h,
    cases h with u hu,
    apply_fun (λ t, t % 4) at he,
    rw hu at he,
    rw (by ring: (2*u + 1)^2 + 1 = 2 + (u^2 + u) * 4) at he,
    rw int.add_mul_mod_self at he,
    rw (by norm_num: (2 : ℤ ) % 4 = 2) at he,
    by_cases even y,
    {
      cases h with v hv,
      have h2 := int.mod_lt_of_pos v (by norm_num : (0:ℤ) < 4),
      have h3 := int.mod_nonneg v (by norm_num : 4 ≠ (0:ℤ)),
      rw hv at he,
      rw (by ring: (2 * v) ^ 3 =  ( 2*v^3) * 4) at he,
      rw int.mul_mod_left at he,
      linarith,
    },
    {
      rw ←int.odd_iff_not_even at h,
      cases h with v hv,
      rw hv at he,
      rw (by ring: ((2:ℤ) * v + 1)^3 = (6*v + 1) + ( (2*v^3 + 3 * v^2) * 4) ) at he,
      rw int.add_mul_mod_self at he,
      have h2 := int.mod_lt_of_pos v (by norm_num : (0:ℤ) < 4),
      have h3 := int.mod_nonneg v (by norm_num : 4 ≠ (0:ℤ)),
      rw int.add_mod at he,
      rw int.mul_mod at he,
      interval_cases (v % 4);
      rw h at he,
        rw (by norm_num : (6 % 4 * 0 % 4 + 1 % 4) % 4 = (1:ℤ )) at he,
        linarith,
        rw (by norm_num : (6 % 4 * 1 % 4 + 1 % 4) % 4 = (3:ℤ )) at he,
        linarith,
        rw (by norm_num : (6 % 4 * 2 % 4 + 1 % 4) % 4 = (1:ℤ )) at he,
        linarith,
        rw (by norm_num : (6 % 4 * 3 % 4 + 1 % 4) % 4 = (3:ℤ )) at he,
        linarith,
    },
  },
  have haqodd : odd (x^2 + 1),
  {
    cases heven with k hk,
    rw hk,
    rw (by ring: (2 * k) ^ 2 + 1 = 2 * (2* k^2) + 1),
    use 2 * k^2,
  },
  have h2 : (x : gaussian_ints) ^ 2 + (1:gaussian_ints) = (y:gaussian_ints) ^ 3,
  {
    rw (by ring : (x : gaussian_ints)^2 = coe x * coe x),
    rw ←gaussian_ints.coe_mul,
    rw (by ring : (y : gaussian_ints)^3 = coe y * coe y * coe y),
    rw ←gaussian_ints.coe_mul,
    rw ←gaussian_ints.coe_mul,
    change coe (x * x + 1)   = coe (y * y * y),
    rw (by ring : x*x = x^2 ),
    rw he,
    rw (by ring : y*y*y = y^3 ),
  },
  let a := (x : gaussian_ints),
  let b := (y : gaussian_ints),
  let i := gaussian_ints.mk 0 1,
  let q := gaussian_ints.mk x 1,
  have hq : q = a + i,
  {
    ext,
    change x = x + 0,
    rw add_zero,
    change (1 : ℤ) = 0 + 1,
    norm_num,
  },
  rw (by ring : a^2 + 1 = (a + i) * (a - i)) at h2,
  have hcop : coprime (a + i) (a - i),
  {
    intros z h h2,
    have h3 := divis_sub h h2,
    rw (by ring: a + i - (a - i) = 2 * i) at h3,
    have h4 := gaussian_ints.norm_div h3,
    have h5 := gaussian_ints.norm_div h,
    change z.norm ∣ 0^2 + 2^2 at h4,
    rw (by norm_num: (0:ℤ) ^ 2 + 2 ^ 2 = 4) at h4,
    have hd := int.le_of_dvd  (by norm_num) h4,
    rw ←hq at h5,
    change z.norm ∣ (x^2 + 1^2) at h5,
    rw (by norm_num: (1:ℤ)^2 = 1) at h5,
    have h6 := int.odd_div h5 haqodd,
    have h7 := gaussian_ints.norm_nonneg z,
    rw ←gaussian_ints.norm_one_iff_unit,
    rw int.odd_iff_not_even at h6,
    interval_cases z.norm,
      exfalso, apply h6, use 0, rw mul_zero, exact h_1,
      exact h_1,
      exfalso, apply h6, use 1, rw mul_one, exact h_1,
      exfalso, rw h_1 at h4, apply (by norm_num : ¬((3:ℤ) ∣ 4)), exact h4,
      exfalso, apply h6, use 2, rw h_1, norm_num,
  },

  rw eq_comm at h2,
  have hpow := gaussian_ints.separating_powers_cubes hcop h2,
  cases hpow with r hr,
  rw ←hq at hr,
  rw gaussian_ints.ext_eq at hr,
  change (r ^ 3).re = x ∧ (r ^ 3).im = 1 at hr,
  cases hr with hrr hri,
  rw (by ring_nf : (r^3).re = (r*r*r).re) at hrr,
  rw (by ring_nf : (r^3).im = (r*r*r).im) at hri,
  rw gaussian_ints.mul_re at hrr,
  rw gaussian_ints.mul_re at hrr,
  rw gaussian_ints.mul_im at hrr,
  rw gaussian_ints.mul_im at hri,
  rw gaussian_ints.mul_im at hri,
  rw gaussian_ints.mul_re at hri,
  rw (by ring : (r.re * r.re - r.im * r.im) * r.re - (r.re * r.im + r.im * r.re) * r.im = r.re^3 - 3 * r.re * r.im^2) at hrr,
  rw (by ring: (r.re * r.re - r.im * r.im) * r.im + (r.re * r.im + r.im * r.re) * r.re = r.im * (3 * r.re^2 - r.im^2) ) at hri,
  rw mul_comm at hri,
  by_cases hrip : 0 ≤ r.im,
  {
    have h3 := int.eq_one_of_mul_eq_one_left hrip hri,
    rw [h3, mul_one] at hri,
    apply_fun (λt, t+1) at hri,
    rw (by ring: 1 + (1: ℤ ) = 2) at hri,
    rw sub_eq_add_neg at hri,
    rw add_assoc at hri,
    rw (by ring: -1 ^ 2 + 1 = (0:ℤ)) at hri,
    rw add_zero at hri,
    have h4 : (3:ℤ) ∣ 2,
    {
      use r.re^2,
      rw hri,
    },
    exfalso,
    apply (by norm_num : ¬ ((3:ℤ) ∣ 2)),
    exact h4,
  },
  {
    have hrip2 : 0 ≤ -r.im,
    linarith [hrip],
    rw (by ring: (3 * r.re ^ 2 - r.im ^ 2) * r.im = (-(3 * r.re ^ 2 - r.im ^ 2)) * (-r.im)) at hri,
    have h3 := int.eq_one_of_mul_eq_one_left hrip2 hri,
    rw [h3,mul_one] at hri,
    rw [eq_comm, eq_neg_iff_eq_neg] at h3,
    rw h3 at hri,
    rw [eq_comm, eq_neg_iff_eq_neg] at hri,
    apply_fun (λt, t+1) at hri,
    rw (by ring: -1 + (1: ℤ ) = 0) at hri,
    rw sub_eq_add_neg at hri,
    rw add_assoc at hri,
    rw (by ring: -(-1) ^ 2 + 1 = (0:ℤ)) at hri,
    rw add_zero at hri,
    rw eq_comm at hri,
    rw zero_eq_mul at hri,
    cases hri,
      linarith [hri],
    rw eq_comm at hri,
    rw (by ring: r.re^2 = r.re * r.re) at hri,
    rw zero_eq_mul at hri,
    rw or_self at hri,
    rw ←hrr,
    rw [hri, h3],
    norm_num,
  }
end

#lint


/-
Copyright (c) 2023 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Geißer, Michael Stoll
-/

import tactic.qify
import data.zmod.basic
import number_theory.diophantine_approximation
import number_theory.zsqrtd.basic

/-!
# Pell's Equation

We prove the following

**Theorem.** Let $d$ be a positive integer that is not a square. Then the equation
$x^2 - d y^2 = 1$ has a nontrivial (i.e., with $y \ne 0$) solution in integers.

See `pell.exists_of_not_is_square`.

This is the beginning of a development that aims at providing all of the essential theory
of Pell's Equation for general $d$ (as opposed to the contents of `number_theory.pell_matiyasevic`,
which is specific to the case $d = a^2 - 1$ for some $a > 1$).

## References

* [K. Ireland, M. Rosen, *A classical introduction to modern number theory*
   (Section 17.5)][IrelandRosen1990]

## Tags

Pell's equation

## TODO

* Provide the structure theory of the solution set to Pell's equation
  and furthermore also for `x ^ 2 - d * y ^ 2 = -1` and further generalizations.
* Connect solutions to the continued fraction expansion of `√d`.
-/

namespace pell

/-!
### Group structure of the solution set

We define a structure of a commutative multiplicative group with distributive negation
on the set of all solutions to the Pell equation `x^2 - d*y^2 = 1`.

The type of such solutions is `pell.solution₁ d`. It corresponds to a pair of integers `x` and `y`
and a proof that `(x, y)` is indeed a solution.

The multiplication is given by `(x, y) * (x', y') = (x*y' + d*y*y', x*y' + y*x')`.
This is obtained by mapping `(x, y)` to `x + y*√d` and multiplying the results.
In fact, we define `pell.solution₁ d` to be `↥(unitary (ℤ√d))` and transport
the "commutative group with distributive negation" structure from `↥(unitary (ℤ√d))`.

We then set up an API for `pell.solution₁ d`.
-/

open zsqrtd

/-- An element of `ℤ√d` has norm one (i.e., `a.re^2 - d*a.im^2 = 1`) if and only if
it is contained in the submonoid of unitary elements.

TODO: merge this result with `pell.is_pell_iff_mem_unitary`. -/
lemma is_pell_solution_iff_mem_unitary {d : ℤ} {a : ℤ√d} :
  a.re ^ 2 - d * a.im ^ 2 = 1 ↔ a ∈ unitary ℤ√d :=
by rw [← norm_eq_one_iff_mem_unitary, norm_def, sq, sq, ← mul_assoc]

-- We use `solution₁ d` to allow for a more general structure `solution d m` that
-- encodes solutions to `x^2 - d*y^2 = m` to be added later.

/-- `pell.solution₁ d` is the type of solutions to the Pell equation `x^2 - d*y^2 = 1`.
We define this in terms of elements of `ℤ√d` of norm one.
-/
@[derive [comm_group, has_distrib_neg, inhabited]]
def solution₁ (d : ℤ) : Type := ↥(unitary ℤ√d)

namespace solution₁

variables {d : ℤ}

instance : has_coe (solution₁ d) ℤ√d := { coe := subtype.val }

/-- The `x` component of a solution to the Pell equation `x^2 - d*y^2 = 1` -/
protected def x (a : solution₁ d) : ℤ := (a : ℤ√d).re

/-- The `y` component of a solution to the Pell equation `x^2 - d*y^2 = 1` -/
protected def y (a : solution₁ d) : ℤ := (a : ℤ√d).im

/-- The proof that `a` is a solution to the Pell equation `x^2 - d*y^2 = 1` -/
lemma prop (a : solution₁ d) : a.x ^ 2 - d * a.y ^ 2 = 1 :=
is_pell_solution_iff_mem_unitary.mpr a.property

/-- An alternative form of the equation, suitable for rewriting `x^2`. -/
lemma prop_x (a : solution₁ d) : a.x ^ 2 = 1 + d * a.y ^ 2 := by {rw ← a.prop, ring}

/-- An alternative form of the equation, suitable for rewriting `d * y^2`. -/
lemma prop_y (a : solution₁ d) : d * a.y ^ 2 = a.x ^ 2 - 1 := by {rw ← a.prop, ring}

/-- Two solutions are equal if their `x` and `y` components are equal. -/
@[ext]
lemma ext {a b : solution₁ d} (hx : a.x = b.x) (hy : a.y = b.y) : a = b :=
subtype.ext $ ext.mpr ⟨hx, hy⟩

/-- Construct a solution from `x`, `y` and a proof that the equation is satisfied. -/
def mk (x y : ℤ) (prop : x ^ 2 - d * y ^ 2 = 1) : solution₁ d :=
{ val := ⟨x, y⟩,
  property := is_pell_solution_iff_mem_unitary.mp prop }

@[simp]
lemma x_mk (x y : ℤ) (prop : x ^ 2 - d * y ^ 2 = 1) : (mk x y prop).x = x := rfl

@[simp]
lemma y_mk (x y : ℤ) (prop : x ^ 2 - d * y ^ 2 = 1) : (mk x y prop).y = y := rfl

@[simp]
lemma coe_mk  (x y : ℤ) (prop : x ^ 2 - d * y ^ 2 = 1) : (↑(mk x y prop) : ℤ√d) = ⟨x,y⟩ :=
zsqrtd.ext.mpr ⟨x_mk x y prop, y_mk x y prop⟩

@[simp]
lemma x_one : (1 : solution₁ d).x = 1 := rfl

@[simp]
lemma y_one : (1 : solution₁ d).y = 0 := rfl

@[simp]
lemma x_mul (a b : solution₁ d) : (a * b).x = a.x * b.x + d * (a.y * b.y) :=
by {rw ← mul_assoc, refl}

@[simp]
lemma y_mul (a b : solution₁ d) : (a * b).y = a.x * b.y + a.y * b.x := rfl

@[simp]
lemma x_inv (a : solution₁ d) : a⁻¹.x = a.x := rfl

@[simp]
lemma y_inv (a : solution₁ d) : a⁻¹.y = -a.y := rfl

@[simp]
lemma x_neg (a : solution₁ d) : (-a).x = -a.x := rfl

@[simp]
lemma y_neg (a : solution₁ d) : (-a).y = -a.y := rfl

end solution₁

section existence

/-!
### Existence of nontrivial solutions
-/

variables {d : ℤ}

open set real

/-- If `d` is a positive integer that is not a square, then there is a nontrivial solution
to the Pell equation `x^2 - d*y^2 = 1`. -/
theorem exists_of_not_is_square (h₀ : 0 < d) (hd : ¬ is_square d) :
  ∃ x y : ℤ, x ^ 2 - d * y ^ 2 = 1 ∧ y ≠ 0 :=
begin
  let ξ : ℝ := sqrt d,
  have hξ : irrational ξ,
  { refine irrational_nrt_of_notint_nrt 2 d (sq_sqrt $ int.cast_nonneg.mpr h₀.le) _ two_pos,
    rintro ⟨x, hx⟩,
    refine hd ⟨x, @int.cast_injective ℝ _ _ d (x * x) _⟩,
    rw [← sq_sqrt $ int.cast_nonneg.mpr h₀.le, int.cast_mul, ← hx, sq], },
  obtain ⟨M, hM₁⟩ := exists_int_gt (2 * |ξ| + 1),
  have hM : {q : ℚ | |q.1 ^ 2 - d * q.2 ^ 2| < M}.infinite,
  { refine infinite.mono (λ q h, _) (infinite_rat_abs_sub_lt_one_div_denom_sq_of_irrational hξ),
    have h0 : 0 < (q.2 : ℝ) ^ 2 := pow_pos (nat.cast_pos.mpr q.pos) 2,
    have h1 : (q.num : ℝ) / (q.denom : ℝ) = q := by exact_mod_cast q.num_div_denom,
    rw [mem_set_of, abs_sub_comm, ← @int.cast_lt ℝ, ← div_lt_div_right (abs_pos_of_pos h0)],
    push_cast,
    rw [← abs_div, abs_sq, sub_div, mul_div_cancel _ h0.ne',
        ← div_pow, h1, ← sq_sqrt (int.cast_pos.mpr h₀).le, sq_sub_sq, abs_mul, ← mul_one_div],
    refine mul_lt_mul'' (((abs_add ξ q).trans _).trans_lt hM₁) h (abs_nonneg _) (abs_nonneg _),
    rw [two_mul, add_assoc, add_le_add_iff_left, ← sub_le_iff_le_add'],
    rw [mem_set_of, abs_sub_comm] at h,
    refine (abs_sub_abs_le_abs_sub (q : ℝ) ξ).trans (h.le.trans _),
    rw [div_le_one h0, one_le_sq_iff_one_le_abs, nat.abs_cast, nat.one_le_cast],
    exact q.pos, },
  obtain ⟨m, hm⟩ : ∃ m : ℤ, {q : ℚ | q.1 ^ 2 - d * q.2 ^ 2 = m}.infinite,
  { contrapose! hM,
    simp only [not_infinite] at hM ⊢,
    refine (congr_arg _ (ext (λ x, _))).mp (finite.bUnion (finite_Ioo (-M) M) (λ m _, hM m)),
    simp only [abs_lt, mem_set_of_eq, mem_Ioo, mem_Union, exists_prop, exists_eq_right'], },
  have hm₀ : m ≠ 0,
  { rintro rfl,
    obtain ⟨q, hq⟩ := hm.nonempty,
    rw [mem_set_of, sub_eq_zero, mul_comm] at hq,
    obtain ⟨a, ha⟩ := (int.pow_dvd_pow_iff two_pos).mp ⟨d, hq⟩,
    rw [ha, mul_pow, mul_right_inj' (pow_pos (int.coe_nat_pos.mpr q.pos) 2).ne'] at hq,
    exact hd ⟨a, sq a ▸ hq.symm⟩, },
  haveI := ne_zero_iff.mpr (int.nat_abs_ne_zero.mpr hm₀),
  let f : ℚ → (zmod m.nat_abs) × (zmod m.nat_abs) := λ q, (q.1, q.2),
  obtain ⟨q₁, h₁ : q₁.1 ^ 2 - d * q₁.2 ^ 2 = m, q₂, h₂ : q₂.1 ^ 2 - d * q₂.2 ^ 2 = m, hne, hqf⟩ :=
    hm.exists_ne_map_eq_of_maps_to (maps_to_univ f _) finite_univ,
  obtain ⟨hq1 : (q₁.1 : zmod m.nat_abs) = q₂.1, hq2 : (q₁.2 : zmod m.nat_abs) = q₂.2⟩ :=
    prod.ext_iff.mp hqf,
  have hd₁ : m ∣ q₁.1 * q₂.1 - d * (q₁.2 * q₂.2),
  { rw [← int.nat_abs_dvd, ← zmod.int_coe_zmod_eq_zero_iff_dvd],
    push_cast,
    rw [hq1, hq2, ← sq, ← sq],
    norm_cast,
    rw [zmod.int_coe_zmod_eq_zero_iff_dvd, int.nat_abs_dvd, nat.cast_pow, ← h₂], },
  have hd₂ : m ∣ q₁.1 * q₂.2 - q₂.1 * q₁.2,
  { rw [← int.nat_abs_dvd, ← zmod.int_coe_eq_int_coe_iff_dvd_sub],
    push_cast,
    rw [hq1, hq2], },
  replace hm₀ : (m : ℚ) ≠ 0 := int.cast_ne_zero.mpr hm₀,
  refine ⟨(q₁.1 * q₂.1 - d * (q₁.2 * q₂.2)) / m, (q₁.1 * q₂.2 - q₂.1 * q₁.2) / m, _, _⟩,
  { qify [hd₁, hd₂],
    field_simp [hm₀],
    norm_cast,
    conv_rhs {congr, rw sq, congr, rw ← h₁, skip, rw ← h₂},
    push_cast,
    ring, },
  { qify [hd₂],
    refine div_ne_zero_iff.mpr ⟨_, hm₀⟩,
    exact_mod_cast mt sub_eq_zero.mp (mt rat.eq_iff_mul_eq_mul.mpr hne), },
end

/-- If `d` is a positive integer, then there is a nontrivial solution
to the Pell equation `x^2 - d*y^2 = 1` if and only if `d` is not a square. -/
theorem exists_iff_not_is_square (h₀ : 0 < d) :
  (∃ x y : ℤ, x ^ 2 - d * y ^ 2 = 1 ∧ y ≠ 0) ↔ ¬ is_square d :=
begin
  refine ⟨_, exists_of_not_is_square h₀⟩,
  rintros ⟨x, y, hxy, hy⟩ ⟨a, rfl⟩,
  rw [← sq, ← mul_pow, sq_sub_sq] at hxy,
  simpa [mul_self_pos.mp h₀, sub_eq_add_neg, eq_neg_self_iff] using int.eq_of_mul_eq_one hxy,
end

/-- If `d` is a positive integer that is not a square, then there exists a solution
to the Pell equation `x^2 - d*y^2 = 1` with `x > 1` and `y > 0`. -/
lemma exists_pos_of_not_is_square (h₀ : 0 < d) (hd : ¬ is_square d) :
  ∃ x y : ℤ, x ^ 2 - d * y ^ 2 = 1 ∧ 1 < x ∧ 0 < y :=
begin
  obtain ⟨x, y, h, hy⟩ := exists_of_not_is_square h₀ hd,
  refine ⟨|x|, |y|, by rwa [sq_abs, sq_abs], _, abs_pos.mpr hy⟩,
  rw [← one_lt_sq_iff_one_lt_abs, eq_add_of_sub_eq h, lt_add_iff_pos_right],
  exact mul_pos h₀ (sq_pos_of_ne_zero y hy),
end

end existence
end pell


/-
f = ( nat n ↦ ( n<3 ? n : ( even(n) ? f(n−2)+f(n−3) : f(n−1)+f(n+1) ) ) )
where even = ( nat n ↦ exists m in nat ( m*2=n ) )
-/

def even : nat → Prop :=
λ n, ∃ m, m * 2 = n

def odd : nat → Prop :=
λ n, ∃ m, nat.succ (m * 2) = n

theorem even_xor_odd (n : nat) : xor (even n) (odd n) :=
begin
  induction n with n ih,
  { left,
    split,
    { existsi 0,
      refl },
    { intro h,
      cases h with n h,
      exact nat.no_confusion h, } },
  { cases ih; cases ih with ih1 ih2,
    { right,
      split,
      { cases ih1 with m hm,
        existsi m,
        rw hm },
      { intro h,
        cases h with m hm,
        cases m with m,
        { exact nat.no_confusion hm },
        { rw [nat.mul_succ, nat.add_succ, nat.add_comm, nat.mul_one, nat.add_succ] at hm,
          apply ih2,
          existsi m,
          rw [nat.mul_succ, nat.mul_one],
          exact nat.succ_inj hm } } },
    { left,
      split,
      { cases ih1 with m hm,
        cases m with m,
        { existsi 1,
          rw ← hm,
          refl },
        { existsi m + 2,
          rw [← hm],
          simp [add_mul, nat.succ_mul, nat.succ_eq_add_one],
          rw [← add_assoc, ← add_assoc, ← add_assoc] } },
      { intro ih,
        cases ih with m ih,
        apply ih2,
        existsi m,
        exact nat.succ_inj ih } } }
end

theorem odd_of_not_even (n : nat) : ¬ even n → odd n :=
λ h, or.cases_on (even_xor_odd n) (λ h1, false.elim $ h h1.1) and.left

theorem not_even_of_odd (n : nat) : odd n → ¬ even n :=
λ h1 h2, or.cases_on (even_xor_odd n) (λ h3, h3.2 h1) (λ h3, h3.2 h2)

theorem even_of_even_add_two : ∀ n, even (n+2) → even n
| 0 _               := ⟨0, rfl⟩
| n ⟨0, hm⟩          := false.elim $ nat.no_confusion hm
| n ⟨nat.succ m, hm⟩ := ⟨m, by simp [nat.succ_eq_add_one, add_mul] at hm;
    rw add_comm at hm;
    exact nat.add_right_cancel hm⟩

theorem not_even_of_even_succ : ∀ n, even (n+1) → ¬even n
| n ⟨0, hm⟩          := nat.no_confusion hm
| n ⟨nat.succ m, hm⟩ := not_even_of_odd _ ⟨m, by rw [← nat.succ_inj hm, add_comm, nat.mul_succ, add_comm]; refl⟩

theorem even_of_not_even_succ : ∀ n, ¬ even (n+1) → even n
| 0 _       := ⟨0, rfl⟩
| (nat.succ n) hm := let ⟨m, hm⟩ := odd_of_not_even _ hm in ⟨m, nat.succ_inj hm⟩

theorem even_succ_of_not_even : ∀ n, ¬ even n → even (n+1) :=
λ n h, let ⟨m, hm⟩ := odd_of_not_even _ h in ⟨m+1, hm ▸ by rw [add_mul]; refl⟩

instance : decidable_pred even :=
begin
  intro n,
  induction n with n ih,
  { right,
    existsi 0,
    refl },
  { cases ih,
    { right,
      cases even_xor_odd n with h h,
      { exfalso,
        exact ih h.1 },
      { cases h.1 with m hm,
        cases m with m,
        { existsi 1,
          rw ← hm,
          refl },
        { existsi m + 2,
          rw [← hm],
          simp [add_mul, nat.succ_mul, nat.succ_eq_add_one],
          rw [← add_assoc, ← add_assoc, ← add_assoc] } } },
    { left,
      intro h1,
      cases even_xor_odd (nat.succ n) with h h,
      { apply h.2,
        cases ih with p hp,
        existsi p,
        rw hp },
      { exact h.2 h1 } } }
end

def aux : nat → nat
| n := if n < 3 then n else
if even n then n - 1 else n + 1

instance aux2 : has_well_founded ℕ :=
{ r := inv_image (<) aux,
  wf := inv_image.wf aux nat.lt_wf }

theorem nat.le_of_not_gt {n m : nat} : ¬ m > n → m ≤ n :=
begin
  intro h,
  cases nat.lt_trichotomy m n with h1 h1,
  { exact nat.le_of_lt h1 },
  cases h1 with h1 h1,
  { rw h1 },
  { exfalso,
    exact h h1 }
end

theorem aux3 (n : nat) (H1 : ¬n < 3) (H2 : even n) : aux (n - 2) < aux n :=
begin
  have H3 := nat.le_of_not_gt H1,
  rw [aux, aux, if_neg H1, if_pos H2],
  let m := n - 3,
  have H4 : n = m + 3,
  { dsimp [m], rw [nat.sub_add_cancel H3] },
  rw H4 at *,
  simp,
  by_cases m + 1 < 3,
  { simp [h],
    apply add_lt_add_left,
    constructor },
  { simp [h, even_of_even_add_two _ H2],
    apply nat.lt_add_of_pos_right,
    constructor,
    constructor }
end

theorem aux4 (n : nat) (H1 : ¬n < 3) (H2 : even n) : aux (n - 3) < aux n :=
begin
  have H3 := nat.le_of_not_gt H1,
  simp [aux, H1, H2],
  let m := n - 3,
  have H4 : n = m + 3,
  { dsimp [m], rw [nat.sub_add_cancel H3] },
  rw H4 at *,
  simp,
  by_cases m < 3,
  { simp [h],
    apply nat.lt_add_of_pos_right,
    constructor,
    constructor },
  { simp [h],
    simp [not_even_of_even_succ _ (even_of_even_add_two _ H2)],
    apply nat.add_lt_add_left,
    constructor }
end

theorem aux5 (n : nat) (H1 : ¬n < 3) (H2 : ¬even n) : aux (n - 1) < aux n :=
begin
  have H3 := nat.le_of_not_gt H1,
  simp [aux, H1, H2],
  let m := n - 3,
  have H4 : n = m + 3,
  { dsimp [m], rw [nat.sub_add_cancel H3] },
  rw H4 at *,
  simp,
  by_cases m + 2 < 3,
  { simp [h],
    apply nat.add_lt_add_left,
    constructor,
    constructor },
  { simp [h],
    simp [even_of_not_even_succ _ H2],
    apply nat.add_lt_add_left,
    constructor,
    constructor,
    constructor }
end

theorem aux6 (n : nat) (H1 : ¬n < 3) (H2 : ¬even n) : aux (n + 1) < aux n :=
begin
  have H3 := nat.le_of_not_gt H1,
  simp [aux, H1, H2],
  let m := n - 3,
  have H4 : n = m + 3,
  { dsimp [m], rw [nat.sub_add_cancel H3] },
  rw H4 at *,
  simp,
  by_cases m + 4 < 3,
  { exfalso,
    cases h with h h,
    cases h with h h,
    cases h with h h,
    cases h with h h },
  { simp [h],
    simp [even_succ_of_not_even _ H2],
    apply add_lt_add_left,
    constructor }
end

def f : nat → nat
| n := if H1 : n < 3 then n else
if H2 : even n then
  f (n - 2) + f (n - 3)
else
  f (n - 1) + f (n + 1)
using_well_founded
{ dec_tac := `[exact aux3 n H1 H2 <|> exact aux4 n H1 H2 <|>
    exact aux5 n H1 H2 <|> exact aux6 n H1 H2],
  rel_tac := λ _ _, `[exact aux2] }


/-
Copyright (c) 2021 Alex Kontorovich and Heather Macbeth and Marc Masdeu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Kontorovich, Heather Macbeth, Marc Masdeu
-/

import linear_algebra.special_linear_group
import analysis.complex.basic
import group_theory.group_action.defs
import linear_algebra.general_linear_group

/-!
# The upper half plane and its automorphisms

This file defines `upper_half_plane` to be the upper half plane in `ℂ`.

We furthermore equip it with the structure of an `GL_pos 2 ℝ` action by
fractional linear transformations.

We define the notation `ℍ` for the upper half plane available in the locale
`upper_half_plane` so as not to conflict with the quaternions.
-/

noncomputable theory

open matrix matrix.special_linear_group

open_locale classical big_operators matrix_groups

local attribute [instance] fintype.card_fin_even

/- Disable this instances as it is not the simp-normal form, and having them disabled ensures
we state lemmas in this file without spurious `coe_fn` terms. -/
local attribute [-instance] matrix.special_linear_group.has_coe_to_fun

local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) _) _

local notation `GL(` n `, ` R `)`⁺ := matrix.GL_pos (fin n) R

/-- The open upper half plane -/
@[derive [λ α, has_coe α ℂ]]
def upper_half_plane := {point : ℂ // 0 < point.im}

localized "notation `ℍ` := upper_half_plane" in upper_half_plane

namespace upper_half_plane

instance : inhabited ℍ := ⟨⟨complex.I, by simp⟩⟩

/-- Imaginary part -/
def im (z : ℍ) := (z : ℂ).im

/-- Real part -/
def re (z : ℍ) := (z : ℂ).re

/-- Constructor for `upper_half_plane`. It is useful if `⟨z, h⟩` makes Lean use a wrong
typeclass instance. -/
def mk (z : ℂ) (h : 0 < z.im) : ℍ := ⟨z, h⟩

@[simp] lemma coe_im (z : ℍ) : (z : ℂ).im = z.im := rfl

@[simp] lemma coe_re (z : ℍ) : (z : ℂ).re = z.re := rfl

@[simp] lemma mk_re (z : ℂ) (h : 0 < z.im) : (mk z h).re = z.re := rfl
@[simp] lemma mk_im (z : ℂ) (h : 0 < z.im) : (mk z h).im = z.im := rfl
@[simp] lemma coe_mk (z : ℂ) (h : 0 < z.im) : (mk z h : ℂ) = z := rfl
@[simp] lemma mk_coe (z : ℍ) (h : 0 < (z : ℂ).im := z.2) : mk z h = z := subtype.eta z h

lemma re_add_im (z : ℍ) : (z.re + z.im * complex.I : ℂ) = z :=
complex.re_add_im z

lemma im_pos (z : ℍ) : 0 < z.im := z.2

lemma im_ne_zero (z : ℍ) : z.im ≠ 0 := z.im_pos.ne'

lemma ne_zero (z : ℍ) : (z : ℂ) ≠ 0 :=
mt (congr_arg complex.im) z.im_ne_zero

lemma norm_sq_pos (z : ℍ) : 0 < complex.norm_sq (z : ℂ) :=
by { rw complex.norm_sq_pos, exact z.ne_zero }

lemma norm_sq_ne_zero (z : ℍ) : complex.norm_sq (z : ℂ) ≠ 0 := (norm_sq_pos z).ne'

/-- Numerator of the formula for a fractional linear transformation -/
@[simp] def num (g : GL(2, ℝ)⁺) (z : ℍ) : ℂ := (↑ₘg 0 0 : ℝ) * z + (↑ₘg 0 1 : ℝ)

/-- Denominator of the formula for a fractional linear transformation -/
@[simp] def denom (g : GL(2, ℝ)⁺) (z : ℍ) : ℂ := (↑ₘg 1 0 : ℝ) * z + (↑ₘg 1 1 : ℝ)

lemma linear_ne_zero (cd : fin 2 → ℝ) (z : ℍ) (h : cd ≠ 0) : (cd 0 : ℂ) * z + cd 1 ≠ 0 :=
begin
  contrapose! h,
  have : cd 0 = 0, -- we will need this twice
  { apply_fun complex.im at h,
    simpa only [z.im_ne_zero, complex.add_im, add_zero, coe_im, zero_mul, or_false,
      complex.of_real_im, complex.zero_im, complex.mul_im, mul_eq_zero] using h, },
  simp only [this, zero_mul, complex.of_real_zero, zero_add, complex.of_real_eq_zero] at h,
  ext i,
  fin_cases i; assumption,
end

lemma denom_ne_zero (g : GL(2, ℝ)⁺) (z : ℍ) : denom g z ≠ 0 :=
begin
  intro H,
  have DET := (mem_GL_pos _).1 g.prop,
  have hz := z.prop,
  simp only [general_linear_group.coe_det_apply] at DET,
  have H1 : (↑ₘg 1 0 : ℝ) = 0 ∨ z.im = 0, by simpa using congr_arg complex.im H,
  cases H1,
  { simp only [H1, complex.of_real_zero, denom, coe_fn_eq_coe, zero_mul, zero_add,
    complex.of_real_eq_zero] at H,
    rw [←coe_coe, (matrix.det_fin_two (↑g : matrix (fin 2) (fin 2) ℝ))] at DET,
    simp only [coe_coe,H, H1, mul_zero, sub_zero, lt_self_iff_false] at DET,
    exact DET, },
  { change z.im > 0 at hz,
    linarith, }
end

lemma norm_sq_denom_pos (g : GL(2, ℝ)⁺) (z : ℍ) : 0 < complex.norm_sq (denom g z) :=
complex.norm_sq_pos.mpr (denom_ne_zero g z)

lemma norm_sq_denom_ne_zero (g : GL(2, ℝ)⁺) (z : ℍ) : complex.norm_sq (denom g z) ≠ 0 :=
ne_of_gt (norm_sq_denom_pos g z)

/-- Fractional linear transformation, also known as the Moebius transformation -/
def smul_aux' (g : GL(2, ℝ)⁺) (z : ℍ) : ℂ := num g z / denom g z

lemma smul_aux'_im (g : GL(2, ℝ)⁺) (z : ℍ) :
  (smul_aux' g z).im = ((det ↑ₘg) * z.im) / (denom g z).norm_sq :=
begin
  rw [smul_aux', complex.div_im],
  set NsqBot := (denom g z).norm_sq,
  have : NsqBot ≠ 0,
  { simp only [denom_ne_zero g z, monoid_with_zero_hom.map_eq_zero, ne.def, not_false_iff], },
  field_simp [smul_aux', -coe_coe],
  rw (matrix.det_fin_two (↑ₘg)),
  ring,
end

/-- Fractional linear transformation, also known as the Moebius transformation -/
def smul_aux (g : GL(2, ℝ)⁺) (z : ℍ) : ℍ :=
 ⟨smul_aux' g z, begin
  rw smul_aux'_im,
  convert (mul_pos ((mem_GL_pos _).1 g.prop)
    (div_pos z.im_pos (complex.norm_sq_pos.mpr (denom_ne_zero g z)))),
  simp only [general_linear_group.coe_det_apply, coe_coe],
  ring
end⟩

lemma denom_cocycle (x y : GL(2, ℝ)⁺) (z : ℍ) :
  denom (x * y) z = denom x (smul_aux y z) * denom y z :=
begin
  change _ = (_ * (_ / _) + _) * _,
  field_simp [denom_ne_zero, -denom, -num],
  simp only [matrix.mul, dot_product, fin.sum_univ_succ, denom, num, coe_coe, subgroup.coe_mul,
    general_linear_group.coe_mul, fintype.univ_of_subsingleton, fin.mk_eq_subtype_mk, fin.mk_zero,
    finset.sum_singleton, fin.succ_zero_eq_one, complex.of_real_add, complex.of_real_mul],
  ring
end

lemma mul_smul' (x y : GL(2, ℝ)⁺) (z : ℍ) :
  smul_aux (x * y) z = smul_aux x (smul_aux y z) :=
begin
  ext1,
  change _ / _ = (_ * (_ / _) + _) * _,
  rw denom_cocycle,
  field_simp [denom_ne_zero, -denom, -num],
  simp only [matrix.mul, dot_product, fin.sum_univ_succ, num, denom, coe_coe, subgroup.coe_mul,
    general_linear_group.coe_mul, fintype.univ_of_subsingleton, fin.mk_eq_subtype_mk, fin.mk_zero,
    finset.sum_singleton, fin.succ_zero_eq_one, complex.of_real_add, complex.of_real_mul],
  ring
end

/-- The action of ` GL_pos 2 ℝ` on the upper half-plane by fractional linear transformations. -/
instance : mul_action (GL(2, ℝ)⁺) ℍ :=
{ smul := smul_aux,
  one_smul := λ z, by { ext1, change _ / _ = _,
   simp [coe_fn_coe_base'] },
  mul_smul := mul_smul' }

section modular_scalar_towers

variable (Γ : subgroup (special_linear_group (fin 2) ℤ))

instance SL_action {R : Type*} [comm_ring R] [algebra R ℝ] : mul_action SL(2, R) ℍ :=
mul_action.comp_hom ℍ $ (special_linear_group.to_GL_pos).comp $ map (algebra_map R ℝ)

instance : has_coe SL(2,ℤ) (GL(2, ℝ)⁺) := ⟨λ g , ((g : SL(2, ℝ)) : (GL(2, ℝ)⁺))⟩

instance SL_on_GL_pos : has_scalar SL(2,ℤ) (GL(2, ℝ)⁺) := ⟨λ s g, s * g⟩

lemma SL_on_GL_pos_smul_apply (s : SL(2,ℤ)) (g : (GL(2, ℝ)⁺)) (z : ℍ) :
  (s • g) • z = ( (s : GL(2, ℝ)⁺) * g) • z := rfl

instance SL_to_GL_tower : is_scalar_tower SL(2,ℤ) (GL(2, ℝ)⁺) ℍ :=
{ smul_assoc := by {intros s g z, simp only [SL_on_GL_pos_smul_apply, coe_coe], apply mul_smul',},}

instance subgroup_GL_pos : has_scalar Γ (GL(2, ℝ)⁺) := ⟨λ s g, s * g⟩

lemma subgroup_on_GL_pos_smul_apply (s : Γ) (g : (GL(2, ℝ)⁺)) (z : ℍ) :
  (s • g) • z = ( (s : GL(2, ℝ)⁺) * g) • z := rfl

instance subgroup_on_GL_pos : is_scalar_tower Γ (GL(2, ℝ)⁺) ℍ :=
{ smul_assoc :=
  by {intros s g z, simp only [subgroup_on_GL_pos_smul_apply, coe_coe], apply mul_smul',},}

instance subgroup_SL : has_scalar Γ SL(2,ℤ) := ⟨λ s g, s * g⟩

lemma subgroup_on_SL_apply (s : Γ) (g : SL(2,ℤ) ) (z : ℍ) :
  (s • g) • z = ( (s : SL(2, ℤ)) * g) • z := rfl

instance subgroup_to_SL_tower : is_scalar_tower Γ SL(2,ℤ) ℍ :=
{ smul_assoc := λ s g z, by { rw subgroup_on_SL_apply, apply mul_action.mul_smul } }

end modular_scalar_towers

@[simp] lemma coe_smul (g : GL(2, ℝ)⁺) (z : ℍ) : ↑(g • z) = num g z / denom g z := rfl
@[simp] lemma re_smul (g : GL(2, ℝ)⁺) (z : ℍ) : (g • z).re = (num g z / denom g z).re := rfl
lemma im_smul (g : GL(2, ℝ)⁺) (z : ℍ) : (g • z).im = (num g z / denom g z).im := rfl

lemma im_smul_eq_div_norm_sq (g : GL(2, ℝ)⁺) (z : ℍ) :
  (g • z).im = (det ↑ₘg * z.im) / (complex.norm_sq (denom g z)) := smul_aux'_im g z

@[simp] lemma neg_smul (g : GL(2, ℝ)⁺) (z : ℍ) : -g • z = g • z :=
begin
  ext1,
  change _ / _ = _ / _,
  field_simp [denom_ne_zero, -denom, -num],
  simp only [num, denom, coe_coe, complex.of_real_neg, neg_mul, GL_pos.coe_neg_GL, units.coe_neg,
    pi.neg_apply],
  ring_nf,
end

section SL_modular_action

variables (g : SL(2, ℤ)) (z : ℍ) (Γ : subgroup SL(2,ℤ))

@[simp] lemma sl_moeb (A : SL(2,ℤ)) (z : ℍ) : A • z = (A : (GL(2, ℝ)⁺)) • z := rfl
lemma subgroup_moeb (A : Γ) (z : ℍ) : A • z = (A : (GL(2, ℝ)⁺)) • z := rfl
@[simp] lemma subgroup_to_sl_moeb (A : Γ) (z : ℍ) : A • z = (A : SL(2,ℤ)) • z := rfl

@[simp] lemma SL_neg_smul (g : SL(2,ℤ)) (z : ℍ) : -g • z = g • z :=
begin
simp only [coe_GL_pos_neg, sl_moeb, coe_coe, coe_int_neg, neg_smul],
end

lemma c_mul_im_sq_le_norm_sq_denom (z : ℍ) (g : SL(2, ℝ)) :
  ((↑ₘg 1 0 : ℝ) * (z.im))^2 ≤ complex.norm_sq (denom g z) :=
begin
  let c := (↑ₘg 1 0 : ℝ),
  let d := (↑ₘg 1 1 : ℝ),
  calc (c * z.im)^2 ≤ (c * z.im)^2 + (c * z.re + d)^2 : by nlinarith
                ... = complex.norm_sq (denom g z) : by simp [complex.norm_sq]; ring,
end

lemma special_linear_group.im_smul_eq_div_norm_sq :
  (g • z).im = z.im / (complex.norm_sq (denom g z)) :=
begin
  convert (im_smul_eq_div_norm_sq g z),
  simp only [coe_coe, general_linear_group.coe_det_apply,coe_GL_pos_coe_GL_coe_matrix,
    int.coe_cast_ring_hom,(g : SL(2,ℝ)).prop, one_mul],
end

lemma denom_apply (g : SL(2, ℤ)) (z : ℍ) : denom g z = (↑g : matrix (fin 2) (fin 2) ℤ) 1 0 * z +
  (↑g : matrix (fin 2) (fin 2) ℤ) 1 1 := by simp

end SL_modular_action

end upper_half_plane


import data.polynomial.basic
import data.polynomial.degree.definitions

lemma polynomial.nat_degree_eq_nat_degree {R} [semiring R] {p q: polynomial R}
  (hpq: p.degree = q.degree): p.nat_degree = q.nat_degree :=
begin
  apply le_antisymm,
  exact polynomial.nat_degree_le_nat_degree (le_of_eq hpq),
  exact polynomial.nat_degree_le_nat_degree (le_of_eq hpq.symm),
end

theorem with_bot.lt_iff_exists_coe {α} [partial_order α]: ∀ {a b: with_bot α}, a < b ↔ (∃ p : α, b = p ∧ a < ↑p)
| a (some b) := by simp [with_bot.some_eq_coe, with_bot.coe_eq_coe]
| a none := by simp [with_bot.none_eq_bot]; exact (λ x hx, hx ▸ (@not_lt_bot _ _ a))

lemma polynomial.zero_le_nat_degree {R} [semiring R] {p: polynomial R}
  (hne: p ≠ 0): 0 ≤ p.nat_degree :=
begin
  have := (mt polynomial.degree_eq_bot.1) hne,
  obtain ⟨ n, ⟨ hdeg, hbot ⟩ ⟩ := with_bot.lt_iff_exists_coe.1 (bot_lt_iff_ne_bot.2 this),
  rw polynomial.nat_degree_eq_of_degree_eq_some hdeg,
  have := polynomial.zero_le_degree_iff.2 hne,
  rw hdeg at this,
  exact_mod_cast this,
end

lemma polynomial.nat_degree_add_C {R} [semiring R] {a: R} {p: polynomial R}:
  (p.nat_degree = 0 → p + polynomial.C a ≠ 0)  → (p + polynomial.C a).nat_degree = p.nat_degree :=
begin
  intro h_cancel,
  apply (polynomial.degree_eq_iff_nat_degree_eq _).1,
  rotate 1,
  {
    by_cases (p.nat_degree = 0),
    exact h_cancel h,
    have h_deg := (nat.eq_zero_or_pos _).resolve_left h,
    suffices : 0 ≤ (p + polynomial.C a).degree, from polynomial.ne_zero_of_coe_le_degree this,
    rw polynomial.degree_add_eq_left_of_degree_lt,
    exact le_of_lt (polynomial.nat_degree_pos_iff_degree_pos.1 h_deg),
    calc (polynomial.C a).degree ≤ 0 : polynomial.degree_C_le
    ... < p.degree : polynomial.nat_degree_pos_iff_degree_pos.1 h_deg,
  },
  by_cases (0 < p.nat_degree),
  {
    rw polynomial.degree_add_C (polynomial.nat_degree_pos_iff_degree_pos.1 h),
    exact polynomial.degree_eq_nat_degree (polynomial.ne_zero_of_nat_degree_gt h),
  },
  {
    replace h := nonpos_iff_eq_zero.1 (not_lt.1 h),
    rw polynomial.eq_C_of_nat_degree_eq_zero h,
    by_cases ha_zero : a = 0,
    {
      rw ha_zero at *,
      simp only [add_zero, ring_hom.map_zero, polynomial.nat_degree_C, with_top.coe_zero],
      simp only [add_zero, ring_hom.map_zero, ne.def] at h_cancel,
      rw ← polynomial.eq_C_of_nat_degree_eq_zero h,
      rw_mod_cast [polynomial.degree_eq_nat_degree (h_cancel h), h],
    },
    {
      replace h_cancel := h_cancel h,
      by_cases hp_zero: p.coeff 0 = 0,
      {
        simp [hp_zero, le_antisymm
        (polynomial.degree_C_le)
        (polynomial.zero_le_degree_iff.2 ((not_iff_not_of_iff polynomial.C_eq_zero).2 ha_zero))],
      },
      {
        rw [polynomial.degree_add_eq_of_leading_coeff_add_ne_zero],
        rw_mod_cast [← polynomial.eq_C_of_nat_degree_eq_zero h, polynomial.degree_eq_nat_degree,
        h, polynomial.degree_C ha_zero],
        exact max_self _,
        {
          rw [polynomial.eq_C_of_nat_degree_eq_zero h],
          simp [hp_zero],
        },
        {
          rw [polynomial.eq_C_of_nat_degree_eq_zero h, ← polynomial.C_add, ne.def, polynomial.C_eq_zero] at h_cancel,
          simp [h_cancel],
        },
      }
    }
  },
end


import algebra.order.ring.defs algebra.big_operators.fin algebra.order.group.min_max

/-! # IMO 2019 A2 -/

namespace IMOSL
namespace IMO2019A2

open multiset function
open_locale classical

variables {R : Type*} [linear_ordered_comm_ring R]

section results

private lemma lem1 (a : multiset R) : ∀ x : R, x ∈ a → x ≤ a.fold max 0 :=
begin
  refine multiset.induction_on a _ _,
  intros x h; exfalso; exact h,
  clear a; intros x a h y h0,
  rw multiset.mem_cons at h0,
  rw [fold_cons_left, le_max_iff],
  rcases h0 with rfl | h0,
  left; exact le_refl y,
  right; exact h y h0
end

private lemma lem2 (a : multiset R) : 0 ≤ a.fold max 0 :=
begin
  refine multiset.induction_on a (by rw fold_zero) (λ x s h, _),
  rw [fold_cons_left, le_max_iff],
  right; exact h
end

private lemma lem3 {a : multiset R} (h : ∀ x : R, x ∈ a → x ≤ 0) : a.fold max 0 = 0 :=
begin
  revert h; refine multiset.induction_on a (λ h, by rw fold_zero) (λ x s h h0, _),
  rw [fold_cons_left, h (λ x h, h0 x (mem_cons_of_mem h)), max_eq_right_iff],
  exact h0 x (mem_cons_self x s)
end

private lemma lem4 (a : multiset R) : -a.fold min 0 = (a.map has_neg.neg).fold max 0 :=
begin
  refine multiset.induction_on a _ (λ x s h, _),
  rw [fold_zero, neg_zero, multiset.map_zero, fold_zero],
  rw [map_cons, fold_cons_left, fold_cons_left, ← h, max_neg_neg]
end

variables {a : multiset R} (ha : ∀ x : R, x ∈ a → 0 ≤ x)
include ha

private lemma lem5 : a.sum ≤ a.card * a.fold max 0 :=
  by convert sum_le_sum_map (const R (a.fold max 0)) (lem1 a);
    rw [map_const, sum_repeat, nsmul_eq_mul]

private lemma lem6 : (a.map (λ c, c ^ 2)).sum ≤ a.sum * a.fold max 0 :=
begin
  convert sum_map_le_sum_map (λ c, c ^ 2) (λ c, c * a.fold max 0) (λ x h, _),
  rw [sum_map_mul_right, map_id'],
  rw sq; exact mul_le_mul_of_nonneg_left (lem1 a x h) (ha x h)
end

variables {b : multiset R} (hb : ∀ x : R, x ∈ b → 0 ≤ x)
include hb

private lemma lem7 : fold max 0 (a + map has_neg.neg b) = fold max 0 a :=
begin
  nth_rewrite 0 ← max_self (0 : R),
  rw [fold_add, max_eq_left_iff],
  convert lem2 a; refine lem3 (λ x h0, _),
  rw mem_map at h0; rcases h0 with ⟨c, h0, rfl⟩,
  rw neg_nonpos; exact hb c h0
end

variables (h : a.sum = b.sum)
include h

private lemma lem8 : (a.map (λ c, c ^ 2)).sum ≤ (b.card : R) * (a.fold max 0 * b.fold max 0) :=
begin
  rw [mul_comm (a.fold max 0), ← mul_assoc],
  refine le_trans (lem6 ha) (mul_le_mul_of_nonneg_right _ (lem2 a)),
  rw h; exact lem5 hb
end

/-- The intermediate big result -/
theorem final_solution' : (a.map (λ c, c ^ 2)).sum + (b.map (λ c, c ^ 2)).sum
    ≤ (a.card + b.card : R) * (a.fold max 0 * b.fold max 0) :=
  by convert add_le_add (lem8 ha hb h) (lem8 hb ha h.symm);
    rw [mul_comm (b.fold max 0), ← add_mul, add_comm]

end results

/-- Final solution -/
theorem final_solution {u : multiset R} (h : u.sum = 0) :
  (u.card : R) * (u.fold min 0 * u.fold max 0) ≤ -(u.map (λ c, c ^ 2)).sum :=
begin
  obtain ⟨a, b, ha, hb, rfl⟩ : ∃ a b : multiset R,
    (∀ x : R, x ∈ a → 0 ≤ x) ∧ (∀ x : R, x ∈ b → 0 ≤ x) ∧ a + b.map has_neg.neg = u :=
  begin
    refine ⟨u.filter (λ x, 0 ≤ x), (u.filter (λ x : R, ¬0 ≤ x)).map has_neg.neg,
      λ x h0, (mem_filter.mp h0).2, λ x h0, _, _⟩,
    rw mem_map at h0; rcases h0 with ⟨y, h0, rfl⟩,
    rw [mem_filter, not_le, ← neg_pos] at h0; exact le_of_lt h0.2,
    rw [map_map, neg_comp_neg, map_id]; exact u.filter_add_not _
  end,

  rw [sum_add, sum_map_neg, map_id', add_neg_eq_zero] at h,
  rw [card_add, card_map, multiset.map_add, map_map, le_neg, ← mul_neg, ← neg_mul, nat.cast_add],
  simp_rw [comp_app, neg_sq, sum_add],
  rw [mul_comm (-(fold min (0 : R) _)), lem7 ha hb, lem4],
  convert final_solution' ha hb h using 3,
  rw [multiset.map_add, map_map, neg_comp_neg, map_id, add_comm, lem7 hb ha]
end

end IMO2019A2
end IMOSL


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.measure_space
import measure_theory.borel_space
import topology.opens
import topology.compacts

/-!
# Contents

In this file we work with *contents*. A content `λ` is a function from a certain class of subsets
(such as the the compact subsets) to `ℝ≥0∞` (or `ℝ≥0`) that is
* additive: If `K₁` and `K₂` are disjoint sets in the domain of `λ`,
  then `λ(K₁ ∪ K₂) = λ(K₁) + λ(K₂)`;
* subadditive: If `K₁` and `K₂` are in the domain of `λ`, then `λ(K₁ ∪ K₂) ≤ λ(K₁) + λ(K₂)`;
* monotone: If `K₁ ⊆ K₂` are in the domain of `λ`, then `λ(K₁) ≤ λ(K₂)`.

We show that:
* Given a content `λ` on compact sets, we get a countably subadditive map that vanishes at `∅`.
  In Halmos (1950) this is called the *inner content* `λ*` of `λ`.
* Given an inner content, we define an outer measure.

We don't explicitly define the type of contents.
In this file we only work on contents on compact sets, and inner contents on open sets, and both
contents and inner contents map into the extended nonnegative reals. However, in other applications
other choices can be made, and it is not a priori clear what the best interface should be.

## Main definitions
* `measure_theory.inner_content`: define an inner content from an content
* `measure_theory.outer_measure.of_content`: construct an outer measure from a content

## References

* Paul Halmos (1950), Measure Theory, §53
* <https://en.wikipedia.org/wiki/Content_(measure_theory)>
-/

universe variables u v w
noncomputable theory

open set topological_space
open_locale nnreal ennreal

namespace measure_theory

variables {G : Type w} [topological_space G]

/-- Constructing the inner content of a content. From a content defined on the compact sets, we
  obtain a function defined on all open sets, by taking the supremum of the content of all compact
  subsets. -/
def inner_content (μ : compacts G → ℝ≥0∞) (U : opens G) : ℝ≥0∞ :=
⨆ (K : compacts G) (h : K.1 ⊆ U), μ K

lemma le_inner_content {μ : compacts G → ℝ≥0∞} (K : compacts G) (U : opens G)
  (h2 : K.1 ⊆ U) : μ K ≤ inner_content μ U :=
le_supr_of_le K $ le_supr _ h2

lemma inner_content_le {μ : compacts G → ℝ≥0∞}
  (h : ∀ (K₁ K₂ : compacts G), K₁.1 ⊆ K₂.1 → μ K₁ ≤ μ K₂)
  (U : opens G) (K : compacts G)
  (h2 : (U : set G) ⊆ K.1) : inner_content μ U ≤ μ K :=
bsupr_le $ λ K' hK', h _ _ (subset.trans hK' h2)

lemma inner_content_of_is_compact {μ : compacts G → ℝ≥0∞}
  (h : ∀ (K₁ K₂ : compacts G), K₁.1 ⊆ K₂.1 → μ K₁ ≤ μ K₂) {K : set G} (h1K : is_compact K)
  (h2K : is_open K) : inner_content μ ⟨K, h2K⟩ = μ ⟨K, h1K⟩ :=
le_antisymm (bsupr_le $ λ K' hK', h _ ⟨K, h1K⟩ hK')
            (le_inner_content _ _ subset.rfl)

lemma inner_content_empty {μ : compacts G → ℝ≥0∞} (h : μ ⊥ = 0) :
  inner_content μ ∅ = 0 :=
begin
  refine le_antisymm _ (zero_le _), rw ←h,
  refine bsupr_le (λ K hK, _),
  have : K = ⊥, { ext1, rw [subset_empty_iff.mp hK, compacts.bot_val] }, rw this, refl'
end

/-- This is "unbundled", because that it required for the API of `induced_outer_measure`. -/
lemma inner_content_mono {μ : compacts G → ℝ≥0∞} ⦃U V : set G⦄ (hU : is_open U) (hV : is_open V)
  (h2 : U ⊆ V) : inner_content μ ⟨U, hU⟩ ≤ inner_content μ ⟨V, hV⟩ :=
supr_le_supr $ λ K, supr_le_supr_const $ λ hK, subset.trans hK h2

lemma inner_content_exists_compact {μ : compacts G → ℝ≥0∞} {U : opens G}
  (hU : inner_content μ U < ∞) {ε : ℝ≥0} (hε : 0 < ε) :
  ∃ K : compacts G, K.1 ⊆ U ∧ inner_content μ U ≤ μ K + ε :=
begin
  have h'ε := ennreal.zero_lt_coe_iff.2 hε,
  cases le_or_lt (inner_content μ U) ε,
  { exact ⟨⊥, empty_subset _, le_trans h (le_add_of_nonneg_left (zero_le _))⟩ },
  have := ennreal.sub_lt_self (ne_of_lt hU) (ne_of_gt $ lt_trans h'ε h) h'ε,
  conv at this {to_rhs, rw inner_content }, simp only [lt_supr_iff] at this,
  rcases this with ⟨U, h1U, h2U⟩, refine ⟨U, h1U, _⟩,
  rw [← ennreal.sub_le_iff_le_add], exact le_of_lt h2U
end

/-- The inner content of a supremum of opens is at most the sum of the individual inner
contents. -/
lemma inner_content_Sup_nat [t2_space G] {μ : compacts G → ℝ≥0∞}
  (h1 : μ ⊥ = 0)
  (h2 : ∀ (K₁ K₂ : compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂) (U : ℕ → opens G) :
  inner_content μ (⨆ (i : ℕ), U i) ≤ ∑' (i : ℕ), inner_content μ (U i) :=
begin
  have h3 : ∀ (t : finset ℕ) (K : ℕ → compacts G), μ (t.sup K) ≤ t.sum (λ i, μ (K i)),
  { intros t K, refine finset.induction_on t _ _,
    { simp only [h1, nonpos_iff_eq_zero, finset.sum_empty, finset.sup_empty] },
    { intros n s hn ih, rw [finset.sup_insert, finset.sum_insert hn],
      exact le_trans (h2 _ _) (add_le_add_left ih _) }},
  refine bsupr_le (λ K hK, _),
  rcases is_compact.elim_finite_subcover K.2 _ (λ i, (U i).prop) _ with ⟨t, ht⟩, swap,
  { convert hK, rw [opens.supr_def, subtype.coe_mk] },
  rcases K.2.finite_compact_cover t (coe ∘ U) (λ i _, (U _).prop) (by simp only [ht])
    with ⟨K', h1K', h2K', h3K'⟩,
  let L : ℕ → compacts G := λ n, ⟨K' n, h1K' n⟩,
  convert le_trans (h3 t L) _,
  { ext1, rw [h3K', compacts.finset_sup_val, finset.sup_eq_supr] },
  refine le_trans (finset.sum_le_sum _) (ennreal.sum_le_tsum t),
  intros i hi, refine le_trans _ (le_supr _ (L i)),
  refine le_trans _ (le_supr _ (h2K' i)), refl'
end

/-- The inner content of a union of sets is at most the sum of the individual inner contents.
  This is the "unbundled" version of `inner_content_Sup_nat`.
  It required for the API of `induced_outer_measure`. -/
lemma inner_content_Union_nat [t2_space G] {μ : compacts G → ℝ≥0∞}
  (h1 : μ ⊥ = 0)
  (h2 : ∀ (K₁ K₂ : compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)
  ⦃U : ℕ → set G⦄ (hU : ∀ (i : ℕ), is_open (U i)) :
  inner_content μ ⟨⋃ (i : ℕ), U i, is_open_Union hU⟩ ≤ ∑' (i : ℕ), inner_content μ ⟨U i, hU i⟩ :=
by { have := inner_content_Sup_nat h1 h2 (λ i, ⟨U i, hU i⟩), rwa [opens.supr_def] at this }

lemma inner_content_comap {μ : compacts G → ℝ≥0∞} (f : G ≃ₜ G)
  (h : ∀ ⦃K : compacts G⦄, μ (K.map f f.continuous) = μ K) (U : opens G) :
  inner_content μ (U.comap f.continuous) = inner_content μ U :=
begin
  refine supr_congr _ ((compacts.equiv f).surjective) _,
  intro K, refine supr_congr_Prop image_subset_iff _,
  intro hK, simp only [equiv.coe_fn_mk, subtype.mk_eq_mk, ennreal.coe_eq_coe, compacts.equiv],
  apply h,
end

@[to_additive]
lemma is_mul_left_invariant_inner_content [group G] [topological_group G] {μ : compacts G → ℝ≥0∞}
  (h : ∀ (g : G) {K : compacts G}, μ (K.map _ $ continuous_mul_left g) = μ K) (g : G)
  (U : opens G) : inner_content μ (U.comap $ continuous_mul_left g) = inner_content μ U :=
by convert inner_content_comap (homeomorph.mul_left g) (λ K, h g) U

-- @[to_additive] (fails for now)
lemma inner_content_pos_of_is_mul_left_invariant [t2_space G] [group G] [topological_group G]
  {μ : compacts G → ℝ≥0∞}
  (h1 : μ ⊥ = 0)
  (h2 : ∀ (K₁ K₂ : compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)
  (h3 : ∀ (g : G) {K : compacts G}, μ (K.map _ $ continuous_mul_left g) = μ K)
  (K : compacts G) (hK : 0 < μ K) (U : opens G) (hU : (U : set G).nonempty) :
  0 < inner_content μ U :=
begin
  have : (interior (U : set G)).nonempty, rwa [U.prop.interior_eq],
  rcases compact_covered_by_mul_left_translates K.2 this with ⟨s, hs⟩,
  suffices : μ K ≤ s.card * inner_content μ U,
  { exact (ennreal.mul_pos.mp $ lt_of_lt_of_le hK this).2 },
  have : K.1 ⊆ ↑⨆ (g ∈ s), U.comap $ continuous_mul_left g,
  { simpa only [opens.supr_def, opens.coe_comap, subtype.coe_mk] },
  refine (le_inner_content _ _ this).trans _,
  refine (rel_supr_sum (inner_content μ) (inner_content_empty h1) (≤)
    (inner_content_Sup_nat h1 h2) _ _).trans _,
  simp only [is_mul_left_invariant_inner_content h3, finset.sum_const, nsmul_eq_mul, le_refl]
end

lemma inner_content_mono' {μ : compacts G → ℝ≥0∞} ⦃U V : set G⦄
  (hU : is_open U) (hV : is_open V) (h2 : U ⊆ V) :
  inner_content μ ⟨U, hU⟩ ≤ inner_content μ ⟨V, hV⟩ :=
supr_le_supr $ λ K, supr_le_supr_const $ λ hK, subset.trans hK h2

namespace outer_measure

/-- Extending a content on compact sets to an outer measure on all sets. -/
def of_content [t2_space G] (μ : compacts G → ℝ≥0∞) (h1 : μ ⊥ = 0) : outer_measure G :=
induced_outer_measure (λ U hU, inner_content μ ⟨U, hU⟩) is_open_empty (inner_content_empty h1)

variables [t2_space G] {μ : compacts G → ℝ≥0∞} {h1 : μ ⊥ = 0}
  (h2 : ∀ (K₁ K₂ : compacts G), μ (K₁ ⊔ K₂) ≤ μ K₁ + μ K₂)

include h2
lemma of_content_opens (U : opens G) : of_content μ h1 U = inner_content μ U :=
induced_outer_measure_eq' (λ _, is_open_Union) (inner_content_Union_nat h1 h2)
  inner_content_mono U.2

lemma of_content_le (h : ∀ (K₁ K₂ : compacts G), K₁.1 ⊆ K₂.1 → μ K₁ ≤ μ K₂)
  (U : opens G) (K : compacts G) (hUK : (U : set G) ⊆ K.1) : of_content μ h1 U ≤ μ K :=
(of_content_opens h2 U).le.trans $ inner_content_le h U K hUK

lemma le_of_content_compacts (K : compacts G) : μ K ≤ of_content μ h1 K.1 :=
begin
  rw [of_content, induced_outer_measure_eq_infi],
  { exact le_infi (λ U, le_infi $ λ hU, le_infi $ le_inner_content K ⟨U, hU⟩) },
  { exact inner_content_Union_nat h1 h2 },
  { exact inner_content_mono }
end

lemma of_content_eq_infi (A : set G) :
  of_content μ h1 A = ⨅ (U : set G) (hU : is_open U) (h : A ⊆ U), inner_content μ ⟨U, hU⟩ :=
induced_outer_measure_eq_infi _ (inner_content_Union_nat h1 h2) inner_content_mono A

lemma of_content_interior_compacts (h3 : ∀ (K₁ K₂ : compacts G), K₁.1 ⊆ K₂.1 → μ K₁ ≤ μ K₂)
  (K : compacts G) : of_content μ h1 (interior K.1) ≤ μ K :=
le_trans (le_of_eq $ of_content_opens h2 (opens.interior K.1))
         (inner_content_le h3 _ _ interior_subset)

lemma of_content_exists_compact {U : opens G} (hU : of_content μ h1 U < ∞) {ε : ℝ≥0}
  (hε : 0 < ε) : ∃ K : compacts G, K.1 ⊆ U ∧ of_content μ h1 U ≤ of_content μ h1 K.1 + ε :=
begin
  rw [of_content_opens h2] at hU ⊢,
  rcases inner_content_exists_compact hU hε with ⟨K, h1K, h2K⟩,
  exact ⟨K, h1K, le_trans h2K $ add_le_add_right (le_of_content_compacts h2 K) _⟩,
end

lemma of_content_exists_open {A : set G} (hA : of_content μ h1 A < ∞) {ε : ℝ≥0} (hε : 0 < ε) :
  ∃ U : opens G, A ⊆ U ∧ of_content μ h1 U ≤ of_content μ h1 A + ε :=
begin
  rcases induced_outer_measure_exists_set _ _ inner_content_mono hA hε with ⟨U, hU, h2U, h3U⟩,
  exact ⟨⟨U, hU⟩, h2U, h3U⟩, swap, exact inner_content_Union_nat h1 h2
end

lemma of_content_preimage (f : G ≃ₜ G) (h : ∀ ⦃K : compacts G⦄, μ (K.map f f.continuous) = μ K)
  (A : set G) : of_content μ h1 (f ⁻¹' A) = of_content μ h1 A :=
begin
  refine induced_outer_measure_preimage _ (inner_content_Union_nat h1 h2) inner_content_mono _
    (λ s, f.is_open_preimage) _,
  intros s hs, convert inner_content_comap f h ⟨s, hs⟩
end

@[to_additive]
lemma is_mul_left_invariant_of_content [group G] [topological_group G]
  (h : ∀ (g : G) {K : compacts G}, μ (K.map _ $ continuous_mul_left g) = μ K) (g : G)
  (A : set G) : of_content μ h1 ((λ h, g * h) ⁻¹' A) = of_content μ h1 A :=
by convert of_content_preimage h2 (homeomorph.mul_left g) (λ K, h g) A

lemma of_content_caratheodory (A : set G) :
  (of_content μ h1).caratheodory.measurable_set' A ↔ ∀ (U : opens G),
  of_content μ h1 (U ∩ A) + of_content μ h1 (U \ A) ≤ of_content μ h1 U :=
begin
  dsimp [opens], rw subtype.forall,
  apply induced_outer_measure_caratheodory,
  apply inner_content_Union_nat h1 h2,
  apply inner_content_mono'
end

-- @[to_additive] (fails for now)
lemma of_content_pos_of_is_mul_left_invariant [group G] [topological_group G]
  (h3 : ∀ (g : G) {K : compacts G}, μ (K.map _ $ continuous_mul_left g) = μ K)
  (K : compacts G) (hK : 0 < μ K) {U : set G} (h1U : is_open U) (h2U : U.nonempty) :
  0 < of_content μ h1 U :=
by { convert inner_content_pos_of_is_mul_left_invariant h1 h2 h3 K hK ⟨U, h1U⟩ h2U,
     exact of_content_opens h2 ⟨U, h1U⟩ }

end outer_measure
end measure_theory


/-
# References

1. Avigad, Jeremy. ‘Theorem Proving in Lean’, n.d.
-/

-- Exercise 1
--
-- Define the function `Do_Twice`, as described in Section 2.4.
namespace ex1

def double (x : Nat) := x + x
def doTwice (f : Nat → Nat) (x : Nat) : Nat := f (f x)
def doTwiceTwice (f : (Nat → Nat) → (Nat → Nat)) (x : Nat → Nat) := f (f x)

#reduce doTwiceTwice doTwice double 2

end ex1

-- Exercise 2
--
-- Define the functions `curry` and `uncurry`, as described in Section 2.4.
namespace ex2

def curry (f : α × β → γ) : (α → β → γ) :=
  fun α β => f (α, β)

def uncurry (f : α → β → γ) : (α × β → γ) :=
  fun x => f x.1 x.2

end ex2

-- Exercise 3
--
-- Above, we used the example `vec α n` for vectors of elements of type `α` of
-- length `n`. Declare a constant `vec_add` that could represent a function that
-- adds two vectors of natural numbers of the same length, and a constant
-- `vec_reverse` that can represent a function that reverses its argument. Use
-- implicit arguments for parameters that can be inferred. Declare some
-- variables and check some expressions involving the constants that you have
-- declared.
namespace ex3

universe u
axiom vec : Type u → Nat → Type u

namespace vec

axiom empty : ∀ (α : Type u), vec α 0
axiom cons : ∀ (α : Type u) (n : Nat), α → vec α n → vec α (n + 1)
axiom append : ∀ (α : Type u) (n m : Nat), vec α m → vec α n → vec α (n + m)
axiom add : ∀ {α : Type u} {n : Nat}, vec α n → vec α n → vec α n
axiom reverse : ∀ {α : Type u} {n : Nat}, vec α n → vec α n

end vec

-- Check results.
variable (a b : vec Prop 1)
variable (c d : vec Prop 2)

#check vec.add a b
-- #check vec.add a c
#check vec.reverse a

end ex3

-- Exercise 4
--
-- Similarly, declare a constant `matrix` so that `matrix α m n` could represent
-- the type of `m` by `n` matrices. Declare some constants to represent
-- functions on this type, such as matrix addition and multiplication, and
-- (using vec) multiplication of a matrix by a vector. Once again, declare some
-- variables and check some expressions involving the constants that you have
-- declared.
namespace ex4

universe u
axiom matrix : Type u → Nat → Nat → Type u

namespace matrix

axiom add : ∀ {α : Type u} {m n : Nat},
  matrix α m n → matrix α m n → matrix α m n
axiom mul : ∀ {α : Type u} {m n p : Nat},
  matrix α m n → matrix α n p → matrix α m p
axiom app : ∀ {α : Type u} {m n : Nat},
  matrix α m n → ex3.vec α n → ex3.vec α m

end matrix

variable (a b : matrix Prop 5 7)
variable (c : matrix Prop 7 3)
variable (d : ex3.vec Prop 3)

#check matrix.add a b
-- #check matrix.add a c
#check matrix.mul a c
#check matrix.app c d

end ex4


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

! This file was ported from Lean 3 source module topology.algebra.infinite_sum.real
! leanprover-community/mathlib commit 9a59dcb7a2d06bf55da57b9030169219980660cd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Intervals
import Mathlib.Topology.Algebra.InfiniteSum.Order
import Mathlib.Topology.Instances.Real

/-!
# Infinite sum in the reals

This file provides lemmas about Cauchy sequences in terms of infinite sums.
-/

open Filter Finset BigOperators NNReal Topology

variable {α : Type _}

/-- If the extended distance between consecutive points of a sequence is estimated
by a summable series of `NNReal`s, then the original sequence is a Cauchy sequence. -/
theorem cauchySeq_of_edist_le_of_summable [PseudoEMetricSpace α] {f : ℕ → α} (d : ℕ → ℝ≥0)
    (hf : ∀ n, edist (f n) (f n.succ) ≤ d n) (hd : Summable d) : CauchySeq f := by
  refine EMetric.cauchySeq_iff_NNReal.2 fun ε εpos => ?_
  -- Actually we need partial sums of `d` to be a Cauchy sequence
  replace hd : CauchySeq fun n : ℕ => ∑ x in range n, d x :=
    let ⟨_, H⟩ := hd
    H.tendsto_sum_nat.cauchySeq
  -- Now we take the same `N` as in one of the definitions of a Cauchy sequence
  refine (Metric.cauchySeq_iff'.1 hd ε (NNReal.coe_pos.2 εpos)).imp fun N hN n hn => ?_
  specialize hN n hn
  -- We simplify the known inequality
  rw [dist_nndist, NNReal.nndist_eq, ← sum_range_add_sum_Ico _ hn, add_tsub_cancel_left,
    NNReal.coe_lt_coe, max_lt_iff] at hN
  rw [edist_comm]
  -- Then use `hf` to simplify the goal to the same form
  refine lt_of_le_of_lt (edist_le_Ico_sum_of_edist_le hn fun _ _ => hf _) ?_
  exact_mod_cast hN.1
#align cauchy_seq_of_edist_le_of_summable cauchySeq_of_edist_le_of_summable

variable [PseudoMetricSpace α] {f : ℕ → α} {a : α}

/-- If the distance between consecutive points of a sequence is estimated by a summable series,
then the original sequence is a Cauchy sequence. -/
theorem cauchySeq_of_dist_le_of_summable (d : ℕ → ℝ) (hf : ∀ n, dist (f n) (f n.succ) ≤ d n)
    (hd : Summable d) : CauchySeq f := by
  -- Porting note: todo: with `Topology/Instances/NNReal` we can use this:
  -- lift d to ℕ → ℝ≥0 using fun n => dist_nonneg.trans (hf n)
  -- refine cauchySeq_of_edist_le_of_summable d ?_ ?_
  -- · exact_mod_cast hf
  -- · exact_mod_cast hd
  refine' Metric.cauchySeq_iff'.2 fun ε εpos => _
  replace hd : CauchySeq fun n : ℕ => ∑ x in range n, d x :=
    let ⟨_, H⟩ := hd
    H.tendsto_sum_nat.cauchySeq
  refine' (Metric.cauchySeq_iff'.1 hd ε εpos).imp fun N hN n hn => _
  have hsum := hN n hn
  rw [Real.dist_eq, ← sum_Ico_eq_sub _ hn] at hsum
  calc
    dist (f n) (f N) = dist (f N) (f n) := dist_comm _ _
    _ ≤ ∑ x in Ico N n, d x := dist_le_Ico_sum_of_dist_le hn fun _ _ => hf _
    _ ≤ |∑ x in Ico N n, d x| := le_abs_self _
    _ < ε := hsum
#align cauchy_seq_of_dist_le_of_summable cauchySeq_of_dist_le_of_summable

theorem cauchySeq_of_summable_dist (h : Summable fun n => dist (f n) (f n.succ)) : CauchySeq f :=
  cauchySeq_of_dist_le_of_summable _ (fun _ => le_rfl) h
#align cauchy_seq_of_summable_dist cauchySeq_of_summable_dist

theorem dist_le_tsum_of_dist_le_of_tendsto (d : ℕ → ℝ) (hf : ∀ n, dist (f n) (f n.succ) ≤ d n)
    (hd : Summable d) {a : α} (ha : Tendsto f atTop (𝓝 a)) (n : ℕ) :
    dist (f n) a ≤ ∑' m, d (n + m) := by
  refine' le_of_tendsto (tendsto_const_nhds.dist ha) (eventually_atTop.2 ⟨n, fun m hnm => _⟩)
  refine' le_trans (dist_le_Ico_sum_of_dist_le hnm fun _ _ => hf _) _
  rw [sum_Ico_eq_sum_range]
  refine' sum_le_tsum (range _) (fun _ _ => le_trans dist_nonneg (hf _)) _
  exact hd.comp_injective (add_right_injective n)
#align dist_le_tsum_of_dist_le_of_tendsto dist_le_tsum_of_dist_le_of_tendsto

theorem dist_le_tsum_of_dist_le_of_tendsto₀ (d : ℕ → ℝ) (hf : ∀ n, dist (f n) (f n.succ) ≤ d n)
    (hd : Summable d) (ha : Tendsto f atTop (𝓝 a)) : dist (f 0) a ≤ tsum d := by
  simpa only [zero_add] using dist_le_tsum_of_dist_le_of_tendsto d hf hd ha 0
#align dist_le_tsum_of_dist_le_of_tendsto₀ dist_le_tsum_of_dist_le_of_tendsto₀

theorem dist_le_tsum_dist_of_tendsto (h : Summable fun n => dist (f n) (f n.succ))
    (ha : Tendsto f atTop (𝓝 a)) (n) : dist (f n) a ≤ ∑' m, dist (f (n + m)) (f (n + m).succ) :=
  show dist (f n) a ≤ ∑' m, (fun x => dist (f x) (f x.succ)) (n + m) from
    dist_le_tsum_of_dist_le_of_tendsto (fun n => dist (f n) (f n.succ)) (fun _ => le_rfl) h ha n
#align dist_le_tsum_dist_of_tendsto dist_le_tsum_dist_of_tendsto

theorem dist_le_tsum_dist_of_tendsto₀ (h : Summable fun n => dist (f n) (f n.succ))
    (ha : Tendsto f atTop (𝓝 a)) : dist (f 0) a ≤ ∑' n, dist (f n) (f n.succ) := by
  simpa only [zero_add] using dist_le_tsum_dist_of_tendsto h ha 0
#align dist_le_tsum_dist_of_tendsto₀ dist_le_tsum_dist_of_tendsto₀


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Johan Commelin
-/
import group_theory.free_abelian_group
import ring_theory.subring

/-!
# Free rings

The theory of the free ring over a type.

## Main definitions

* `free_ring α` : the free (not commutative in general) ring over a type.
* `lift (f : α → R)` : the ring hom `free_ring α →+* R` induced by `f`.
* `map (f : α → β)` : the ring hom `free_ring α →+* free_ring β` induced by `f`.

## Implementation details

`free_ring α` is implemented as the free abelian group over the free monoid on `α`.

## Tags

free ring

-/

universes u v

/-- The free ring over a type `α`. -/
@[derive [ring, inhabited]]
def free_ring (α : Type u) : Type u :=
free_abelian_group $ free_monoid α

namespace free_ring

variables {α : Type u}

/-- The canonical map from α to `free_ring α`. -/
def of (x : α) : free_ring α :=
free_abelian_group.of (free_monoid.of x)

lemma of_injective : function.injective (of : α → free_ring α) :=
free_abelian_group.of_injective.comp free_monoid.of_injective

@[elab_as_eliminator] protected lemma induction_on
  {C : free_ring α → Prop} (z : free_ring α)
  (hn1 : C (-1)) (hb : ∀ b, C (of b))
  (ha : ∀ x y, C x → C y → C (x + y))
  (hm : ∀ x y, C x → C y → C (x * y)) : C z :=
have hn : ∀ x, C x → C (-x), from λ x ih, neg_one_mul x ▸ hm _ _ hn1 ih,
have h1 : C 1, from neg_neg (1 : free_ring α) ▸ hn _ hn1,
free_abelian_group.induction_on z
  (add_left_neg (1 : free_ring α) ▸ ha _ _ hn1 h1)
  (λ m, list.rec_on m h1 $ λ a m ih, hm _ _ (hb a) ih)
  (λ m ih, hn _ ih)
  ha

section lift

variables {R : Type v} [ring R] (f : α → R)

/-- The ring homomorphism `free_ring α →+* R` induced from a map `α → R`. -/
def lift : (α → R) ≃ (free_ring α →+* R) :=
free_monoid.lift.trans free_abelian_group.lift_monoid

@[simp] lemma lift_of (x : α) : lift f (of x) = f x :=
congr_fun (lift.left_inv f) x

@[simp] lemma lift_comp_of (f : free_ring α →+* R) : lift (f ∘ of) = f :=
lift.right_inv f

@[ext]
lemma hom_ext ⦃f g : free_ring α →+* R⦄ (h : ∀ x, f (of x) = g (of x)) :
  f = g :=
lift.symm.injective (funext h)

end lift

variables {β : Type v} (f : α → β)

/-- The canonical ring homomorphism `free_ring α →+* free_ring β` generated by a map `α → β`. -/
def map : free_ring α →+* free_ring β :=
lift $ of ∘ f

@[simp]
lemma map_of (x : α) : map f (of x) = of (f x) := lift_of _ _

end free_ring