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

! This file was ported from Lean 3 source module order.filter.archimedean
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Archimedean
import Mathlib.Order.Filter.AtTopBot

/-!
# `Filter.atTop` filter and archimedean (semi)rings/fields

In this file we prove that for a linear ordered archimedean semiring `R` and a function `f : α → ℕ`,
the function `Nat.cast ∘ f : α → R` tends to `Filter.atTop` along a filter `l` if and only if so
does `f`. We also prove that `Nat.cast : ℕ → R` tends to `Filter.atTop` along `Filter.atTop`, as
well as version of these two results for `ℤ` (and a ring `R`) and `ℚ` (and a field `R`).
-/

variable {α R : Type _}

open Filter Set Function

@[simp]
theorem Nat.comap_cast_atTop [StrictOrderedSemiring R] [Archimedean R] :
    comap ((↑) : ℕ → R) atTop = atTop :=
  comap_embedding_atTop (fun _ _ => Nat.cast_le) exists_nat_ge
#align nat.comap_coe_at_top Nat.comap_cast_atTop

theorem tendsto_nat_cast_atTop_iff [StrictOrderedSemiring R] [Archimedean R] {f : α → ℕ}
    {l : Filter α} : Tendsto (fun n => (f n : R)) l atTop ↔ Tendsto f l atTop :=
  tendsto_atTop_embedding (fun _ _ => Nat.cast_le) exists_nat_ge
#align tendsto_coe_nat_at_top_iff tendsto_nat_cast_atTop_iff

theorem tendsto_nat_cast_atTop_atTop [StrictOrderedSemiring R] [Archimedean R] :
    Tendsto ((↑) : ℕ → R) atTop atTop :=
  tendsto_nat_cast_atTop_iff.2 tendsto_id
#align tendsto_coe_nat_at_top_at_top tendsto_nat_cast_atTop_atTop

@[simp] theorem Int.comap_cast_atTop [StrictOrderedRing R] [Archimedean R] :
    comap ((↑) : ℤ → R) atTop = atTop :=
  comap_embedding_atTop (fun _ _ => Int.cast_le) fun r =>
    let ⟨n, hn⟩ := exists_nat_ge r; ⟨n, by exact_mod_cast hn⟩
#align int.comap_coe_at_top Int.comap_cast_atTop

@[simp]
theorem Int.comap_cast_atBot [StrictOrderedRing R] [Archimedean R] :
    comap ((↑) : ℤ → R) atBot = atBot :=
  comap_embedding_atBot (fun _ _ => Int.cast_le) fun r =>
    let ⟨n, hn⟩ := exists_nat_ge (-r)
    ⟨-n, by simpa [neg_le] using hn⟩
#align int.comap_coe_at_bot Int.comap_cast_atBot

theorem tendsto_int_cast_atTop_iff [StrictOrderedRing R] [Archimedean R] {f : α → ℤ}
    {l : Filter α} : Tendsto (fun n => (f n : R)) l atTop ↔ Tendsto f l atTop := by
  rw [← @Int.comap_cast_atTop R, tendsto_comap_iff]; rfl
#align tendsto_coe_int_at_top_iff tendsto_int_cast_atTop_iff

theorem tendsto_int_cast_atBot_iff [StrictOrderedRing R] [Archimedean R] {f : α → ℤ}
    {l : Filter α} : Tendsto (fun n => (f n : R)) l atBot ↔ Tendsto f l atBot := by
  rw [← @Int.comap_cast_atBot R, tendsto_comap_iff]; rfl
#align tendsto_coe_int_at_bot_iff tendsto_int_cast_atBot_iff

theorem tendsto_int_cast_atTop_atTop [StrictOrderedRing R] [Archimedean R] :
    Tendsto ((↑) : ℤ → R) atTop atTop :=
  tendsto_int_cast_atTop_iff.2 tendsto_id
#align tendsto_coe_int_at_top_at_top tendsto_int_cast_atTop_atTop

@[simp]
theorem Rat.comap_cast_atTop [LinearOrderedField R] [Archimedean R] :
    comap ((↑) : ℚ → R) atTop = atTop :=
  comap_embedding_atTop (fun _ _ => Rat.cast_le) fun r =>
    let ⟨n, hn⟩ := exists_nat_ge r; ⟨n, by simpa⟩
#align rat.comap_coe_at_top Rat.comap_cast_atTop

@[simp] theorem Rat.comap_cast_atBot [LinearOrderedField R] [Archimedean R] :
    comap ((↑) : ℚ → R) atBot = atBot :=
  comap_embedding_atBot (fun _ _ => Rat.cast_le) fun r =>
    let ⟨n, hn⟩ := exists_nat_ge (-r)
    ⟨-n, by simpa [neg_le] ⟩
#align rat.comap_coe_at_bot Rat.comap_cast_atBot

theorem tendsto_rat_cast_atTop_iff [LinearOrderedField R] [Archimedean R] {f : α → ℚ}
    {l : Filter α} : Tendsto (fun n => (f n : R)) l atTop ↔ Tendsto f l atTop := by
  rw [← @Rat.comap_cast_atTop R, tendsto_comap_iff]; rfl
#align tendsto_coe_rat_at_top_iff tendsto_rat_cast_atTop_iff

theorem tendsto_rat_cast_atBot_iff [LinearOrderedField R] [Archimedean R] {f : α → ℚ}
    {l : Filter α} : Tendsto (fun n => (f n : R)) l atBot ↔ Tendsto f l atBot := by
  rw [← @Rat.comap_cast_atBot R, tendsto_comap_iff]; rfl
#align tendsto_coe_rat_at_bot_iff tendsto_rat_cast_atBot_iff

-- porting note: new lemma
theorem atTop_hasAntitoneBasis_of_archimedean [StrictOrderedSemiring R] [Archimedean R] :
    (atTop : Filter R).HasAntitoneBasis fun n : ℕ => Ici n where
  antitone := fun _ _ h => Ici_subset_Ici.2 (Nat.mono_cast h)
  mem_iff' _t := ⟨fun ht => infᵢ_sets_induct ht ⟨0, trivial, subset_univ _⟩
      fun {x _ _} h₁ ⟨n, _, hn⟩ =>
        let ⟨m, hm⟩ := exists_nat_ge x
        ⟨max m n, trivial, fun _y hy => ⟨h₁ (hm.trans ((Nat.cast_le.2 (le_max_left _ _)).trans hy)),
          hn <| (Nat.cast_le.2 (le_max_right _ _)).trans hy⟩⟩,
    fun ⟨_n, _, hn⟩ => mem_of_superset (Ici_mem_atTop _) hn⟩

theorem atTop_hasCountableBasis_of_archimedean [StrictOrderedSemiring R] [Archimedean R] :
    (atTop : Filter R).HasCountableBasis (fun _ : ℕ => True) fun n => Ici n :=
  ⟨atTop_hasAntitoneBasis_of_archimedean.1, to_countable _⟩
#align at_top_countable_basis_of_archimedean atTop_hasCountableBasis_of_archimedean

-- porting note: todo: generalize to a `StrictOrderedRing`
theorem atBot_hasCountableBasis_of_archimedean [LinearOrderedRing R] [Archimedean R] :
    (atBot : Filter R).HasCountableBasis (fun _ : ℤ => True) fun m => Iic m :=
  { countable := to_countable _
    toHasBasis :=
      atBot_basis.to_hasBasis
        (fun x _ => let ⟨m, hm⟩ := exists_int_lt x; ⟨m, trivial, Iic_subset_Iic.2 hm.le⟩)
        fun m _ => ⟨m, trivial, Subset.rfl⟩ }
#align at_bot_countable_basis_of_archimedean atBot_hasCountableBasis_of_archimedean

instance (priority := 100) atTop_isCountablyGenerated_of_archimedean [StrictOrderedSemiring R]
    [Archimedean R] : (atTop : Filter R).IsCountablyGenerated :=
  atTop_hasCountableBasis_of_archimedean.isCountablyGenerated
#align at_top_countably_generated_of_archimedean atTop_isCountablyGenerated_of_archimedean

instance (priority := 100) atBot_isCountablyGenerated_of_archimedean [LinearOrderedRing R]
    [Archimedean R] : (atBot : Filter R).IsCountablyGenerated :=
  atBot_hasCountableBasis_of_archimedean.isCountablyGenerated
#align at_bot_countably_generated_of_archimedean atBot_isCountablyGenerated_of_archimedean

namespace Filter

variable {l : Filter α} {f : α → R} {r : R}

section LinearOrderedSemiring

variable [LinearOrderedSemiring R] [Archimedean R]

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the left) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `Filter.Tendsto.const_mul_atTop`). -/
theorem Tendsto.const_mul_atTop' (hr : 0 < r) (hf : Tendsto f l atTop) :
    Tendsto (fun x => r * f x) l atTop := by
  refine' tendsto_atTop.2 fun b => _
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := Archimedean.arch 1 hr
  rw [nsmul_eq_mul'] at hn
  filter_upwards [tendsto_atTop.1 hf (n * max b 0)]with x hx
  calc
    b ≤ 1 * max b 0 := by
    { rw [one_mul]
      exact le_max_left _ _ }
    _ ≤ r * n * max b 0 := mul_le_mul_of_nonneg_right hn (le_max_right _ _)
    _ = r * (n * max b 0) := by rw [mul_assoc]
    _ ≤ r * f x := mul_le_mul_of_nonneg_left hx (le_of_lt hr)
#align filter.tendsto.const_mul_at_top' Filter.Tendsto.const_mul_atTop'

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the right) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `Filter.Tendsto.atTop_mul_const`). -/
theorem Tendsto.atTop_mul_const' (hr : 0 < r) (hf : Tendsto f l atTop) :
    Tendsto (fun x => f x * r) l atTop := by
  refine' tendsto_atTop.2 fun b => _
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := Archimedean.arch 1 hr
  have hn' : 1 ≤ (n : R) * r := by rwa [nsmul_eq_mul] at hn
  filter_upwards [tendsto_atTop.1 hf (max b 0 * n)]with x hx
  calc
    b ≤ max b 0 * 1 := by
    { rw [mul_one]
      exact le_max_left _ _ }
    _ ≤ max b 0 * (n * r) := mul_le_mul_of_nonneg_left hn' (le_max_right _ _)
    _ = max b 0 * n * r := by rw [mul_assoc]
    _ ≤ f x * r := mul_le_mul_of_nonneg_right hx (le_of_lt hr)
#align filter.tendsto.at_top_mul_const' Filter.Tendsto.atTop_mul_const'

end LinearOrderedSemiring

section LinearOrderedRing

variable [LinearOrderedRing R] [Archimedean R]

/-- See also `Filter.Tendsto.atTop_mul_neg_const` for a version of this lemma for
`LinearOrderedField`s which does not require the `Archimedean` assumption. -/
theorem Tendsto.atTop_mul_neg_const' (hr : r < 0) (hf : Tendsto f l atTop) :
    Tendsto (fun x => f x * r) l atBot := by
  simpa only [tendsto_neg_atTop_iff, mul_neg] using hf.atTop_mul_const' (neg_pos.mpr hr)
#align filter.tendsto.at_top_mul_neg_const' Filter.Tendsto.atTop_mul_neg_const'

/-- See also `Filter.Tendsto.atBot_mul_const` for a version of this lemma for
`LinearOrderedField`s which does not require the `Archimedean` assumption. -/
theorem Tendsto.atBot_mul_const' (hr : 0 < r) (hf : Tendsto f l atBot) :
    Tendsto (fun x => f x * r) l atBot := by
  simp only [← tendsto_neg_atTop_iff, ← neg_mul] at hf⊢
  exact hf.atTop_mul_const' hr
#align filter.tendsto.at_bot_mul_const' Filter.Tendsto.atBot_mul_const'

/-- See also `Filter.Tendsto.atBot_mul_neg_const` for a version of this lemma for
`LinearOrderedField`s which does not require the `Archimedean` assumption. -/
theorem Tendsto.atBot_mul_neg_const' (hr : r < 0) (hf : Tendsto f l atBot) :
    Tendsto (fun x => f x * r) l atTop := by
  simpa only [mul_neg, tendsto_neg_atBot_iff] using hf.atBot_mul_const' (neg_pos.2 hr)
#align filter.tendsto.at_bot_mul_neg_const' Filter.Tendsto.atBot_mul_neg_const'

end LinearOrderedRing

section LinearOrderedCancelAddCommMonoid

variable [LinearOrderedCancelAddCommMonoid R] [Archimedean R]

theorem Tendsto.atTop_nsmul_const {f : α → ℕ} (hr : 0 < r) (hf : Tendsto f l atTop) :
    Tendsto (fun x => f x • r) l atTop := by
  refine' tendsto_atTop.mpr fun s => _
  obtain ⟨n : ℕ, hn : s ≤ n • r⟩ := Archimedean.arch s hr
  exact (tendsto_atTop.mp hf n).mono fun a ha => hn.trans (nsmul_le_nsmul hr.le ha)
#align filter.tendsto.at_top_nsmul_const Filter.Tendsto.atTop_nsmul_const

end LinearOrderedCancelAddCommMonoid

section LinearOrderedAddCommGroup

variable [LinearOrderedAddCommGroup R] [Archimedean R]

theorem Tendsto.atTop_nsmul_neg_const {f : α → ℕ} (hr : r < 0) (hf : Tendsto f l atTop) :
    Tendsto (fun x => f x • r) l atBot := by simpa using hf.atTop_nsmul_const (neg_pos.2 hr)
#align filter.tendsto.at_top_nsmul_neg_const Filter.Tendsto.atTop_nsmul_neg_const

theorem Tendsto.atTop_zsmul_const {f : α → ℤ} (hr : 0 < r) (hf : Tendsto f l atTop) :
    Tendsto (fun x => f x • r) l atTop := by
  refine' tendsto_atTop.mpr fun s => _
  obtain ⟨n : ℕ, hn : s ≤ n • r⟩ := Archimedean.arch s hr
  replace hn : s ≤ (n : ℤ) • r; · simpa
  exact (tendsto_atTop.mp hf n).mono fun a ha => hn.trans (zsmul_le_zsmul hr.le ha)
#align filter.tendsto.at_top_zsmul_const Filter.Tendsto.atTop_zsmul_const

theorem Tendsto.atTop_zsmul_neg_const {f : α → ℤ} (hr : r < 0) (hf : Tendsto f l atTop) :
    Tendsto (fun x => f x • r) l atBot := by simpa using hf.atTop_zsmul_const (neg_pos.2 hr)
#align filter.tendsto.at_top_zsmul_neg_const Filter.Tendsto.atTop_zsmul_neg_const

theorem Tendsto.atBot_zsmul_const {f : α → ℤ} (hr : 0 < r) (hf : Tendsto f l atBot) :
    Tendsto (fun x => f x • r) l atBot := by
  simp only [← tendsto_neg_atTop_iff, ← neg_zsmul] at hf⊢
  exact hf.atTop_zsmul_const hr
#align filter.tendsto.at_bot_zsmul_const Filter.Tendsto.atBot_zsmul_const

theorem Tendsto.atBot_zsmul_neg_const {f : α → ℤ} (hr : r < 0) (hf : Tendsto f l atBot) :
    Tendsto (fun x => f x • r) l atTop := by simpa using hf.atBot_zsmul_const (neg_pos.2 hr)
#align filter.tendsto.at_bot_zsmul_neg_const Filter.Tendsto.atBot_zsmul_neg_const

end LinearOrderedAddCommGroup

end Filter


import data.matrix.pequiv data.rat.basic data.vector2

variables {m n : ℕ}

/-- The type of ordered partitions of `m + n` elements into vectors of
  `m` row variables and `n` column variables  -/
structure partition (m n : ℕ) : Type :=
(row_indices : vector (fin (m + n)) m)
(col_indices : vector (fin (m + n)) n)
(mem_row_indices_or_col_indices :
  ∀ v : fin (m + n), v ∈ row_indices.to_list ∨ v ∈ col_indices.to_list)

open pequiv function matrix finset fintype

namespace partition

local infix ` ⬝ `:70 := matrix.mul
local postfix `ᵀ` : 1500 := transpose

variable (P : partition m n)

def fintype_aux : partition m n ≃ { x : vector (fin (m + n)) m × vector (fin (m + n)) n //
  ∀ v : fin (m + n), v ∈ x.1.to_list ∨ v ∈ x.2.to_list } :=
{ to_fun := λ ⟨r, c, h⟩, ⟨⟨r, c⟩, h⟩,
  inv_fun := λ ⟨⟨r, c⟩, h⟩, ⟨r, c, h⟩,
  left_inv := λ ⟨r, c, h⟩, rfl,
  right_inv := λ ⟨⟨r, c⟩, h⟩, rfl }

instance : fintype (partition m n) := fintype.of_equiv _ fintype_aux.symm

def rowg : fin m → fin (m + n) := P.row_indices.nth
def colg : fin n → fin (m + n) := P.col_indices.nth

lemma mem_row_indices_iff_exists {v : fin (m + n)} :
  v ∈ P.row_indices.to_list ↔ ∃ i, v = P.rowg i :=
by simp only [vector.mem_iff_nth, eq_comm, rowg]

lemma mem_col_indices_iff_exists {v : fin (m + n)} :
  v ∈ P.col_indices.to_list ↔ ∃ j, v = P.colg j :=
by simp only [vector.mem_iff_nth, eq_comm, colg]

lemma eq_rowg_or_colg (v : fin (m + n)) : (∃ i, v = P.rowg i) ∨ (∃ j, v = P.colg j) :=
by rw [← mem_row_indices_iff_exists, ← mem_col_indices_iff_exists];
  exact P.mem_row_indices_or_col_indices _

lemma row_indices_append_col_indices_nodup : (P.row_indices.append P.col_indices).to_list.nodup :=
vector.nodup_iff_nth_inj.2 $ fintype.injective_iff_surjective.2 $ λ v,
  (P.mem_row_indices_or_col_indices v).elim
    (by rw [← vector.mem_iff_nth]; simp {contextual := tt})
    (by rw [← vector.mem_iff_nth]; simp {contextual := tt})

lemma row_indices_nodup : P.row_indices.to_list.nodup :=
begin
  have := P.row_indices_append_col_indices_nodup,
  simp [list.nodup_append] at this, tauto
end

lemma col_indices_nodup : P.col_indices.to_list.nodup :=
begin
  have := P.row_indices_append_col_indices_nodup,
  simp [list.nodup_append] at this, tauto
end

@[simp] lemma rowg_ne_colg (i j) : P.rowg i ≠ P.colg j :=
λ h, begin
  rw [rowg, colg] at h,
  have := P.row_indices_append_col_indices_nodup,
  rw [vector.to_list_append (P.row_indices) (P.col_indices), list.nodup_append,
    list.disjoint_right] at this,
  exact this.2.2 (by rw h; exact vector.nth_mem _ _) (vector.nth_mem i P.row_indices)
end

@[simp] lemma colg_ne_rowg (i j) : P.colg j ≠ P.rowg i := ne.symm $ rowg_ne_colg _ _ _

lemma injective_rowg : injective P.rowg :=
vector.nodup_iff_nth_inj.1 P.row_indices_nodup

@[simp] lemma rowg_inj {i i' : fin m} : P.rowg i = P.rowg i' ↔ i = i' := P.injective_rowg.eq_iff

lemma injective_colg : injective P.colg :=
vector.nodup_iff_nth_inj.1 P.col_indices_nodup

@[simp] lemma colg_inj {j j' : fin n} : P.colg j = P.colg j' ↔ j = j' := P.injective_colg.eq_iff

def rowp : fin (m + n) ≃. fin m :=
{ to_fun := λ v, fin.find (λ i, P.rowg i = v),
  inv_fun := λ i, some (P.rowg i),
  inv := λ v i, begin
    cases h : fin.find (λ i, P.rowg i = v),
    { simp [fin.find_eq_none_iff, *] at * },
    { rw [fin.find_eq_some_iff] at h,
      cases h with h _,
      subst h,
      simp [P.injective_rowg.eq_iff, eq_comm] }
  end }

def colp : fin (m + n) ≃. fin n :=
{ to_fun := λ v, fin.find (λ j, P.colg j = v),
  inv_fun := λ j, some (P.colg j),
  inv := λ v j, begin
    cases h : fin.find (λ j, P.colg j = v),
    { simp [fin.find_eq_none_iff, *] at * },
    { rw [fin.find_eq_some_iff] at h,
      cases h with h _,
      subst h,
      simp [P.injective_rowg.eq_iff, eq_comm] }
  end }

@[simp] lemma rowp_trans_rowp_symm : P.rowp.symm.trans P.rowp = pequiv.refl _ :=
trans_symm_eq_iff_forall_is_some.2 (λ _, rfl)

@[simp] lemma colp_trans_colp_symm : P.colp.symm.trans P.colp = pequiv.refl _ :=
trans_symm_eq_iff_forall_is_some.2 (λ _, rfl)

@[simp] lemma rowg_mem (P : partition m n) (r : fin m) : (P.rowg r) ∈ P.rowp.symm r := eq.refl _

lemma rowp_symm_eq_some_rowg (P : partition m n) (r : fin m) : P.rowp.symm r = some (P.rowg r) := rfl

@[simp] lemma colg_mem (P : partition m n) (s : fin n) : (P.colg s) ∈ P.colp.symm s := eq.refl _

lemma colp_symm_eq_some_colg (P : partition m n) (s : fin n) : P.colp.symm s = some (P.colg s) := rfl

@[simp] lemma rowp_rowg (P : partition m n) (r : fin m) : P.rowp (P.rowg r) = some r :=
P.rowp.symm.mem_iff_mem.2 (rowg_mem _ _)

@[simp] lemma colp_colg (P : partition m n) (s : fin n) : P.colp (P.colg s) = some s :=
P.colp.symm.mem_iff_mem.2 (colg_mem _ _)

@[simp] lemma rowp_symm_trans_colp : P.rowp.symm.trans P.colp = ⊥ :=
begin
  ext,
  dsimp [pequiv.trans, colp],
  simp [P.rowp_symm_eq_some_rowg, fin.find_eq_some_iff],
end

@[simp] lemma colg_get_colp_symm (v : fin (m + n)) (h : (P.colp v).is_some) :
  P.colg (option.get h) = v :=
let ⟨j, hj⟩ := option.is_some_iff_exists.1 h in
have hj' : j ∈ P.colp (P.colg (option.get h)), by simpa,
P.colp.inj hj' hj

@[simp] lemma rowg_get_rowp_symm (v : fin (m + n)) (h : (P.rowp v).is_some) :
  P.rowg (option.get h) = v :=
let ⟨i, hi⟩ := option.is_some_iff_exists.1 h in
have hi' : i ∈ P.rowp (P.rowg (option.get h)), by simpa,
P.rowp.inj hi' hi

def default : partition m n :=
{ row_indices := ⟨(list.fin_range m).map (fin.cast_add _), by simp⟩,
  col_indices := ⟨(list.fin_range n).map
    (λ i, ⟨m + i.1, add_lt_add_of_le_of_lt (le_refl _) i.2⟩), by simp⟩,
  mem_row_indices_or_col_indices := λ v,
    if h : v.1 < m
    then or.inl (list.mem_map.2 ⟨⟨v.1, h⟩, list.mem_fin_range _, fin.eta _ _⟩)
    else have v.val - m < n, from (nat.sub_lt_left_iff_lt_add (le_of_not_gt h)).2 v.2,
      or.inr (list.mem_map.2 ⟨⟨v.1 - m, this⟩, list.mem_fin_range _,
        by simp [nat.add_sub_cancel' (le_of_not_gt h)]⟩) }

instance : inhabited (partition m n) := ⟨default⟩

lemma is_some_rowp_symm (P : partition m n) : ∀ (i : fin m), (P.rowp.symm i).is_some := λ _, rfl

lemma is_some_colp_symm (P : partition m n) : ∀ (k : fin n), (P.colp.symm k).is_some := λ _, rfl

lemma injective_rowp_symm (P : partition m n) : injective P.rowp.symm :=
injective_of_forall_is_some (is_some_rowp_symm P)

lemma injective_colp_symm (P : partition m n) : injective P.colp.symm :=
injective_of_forall_is_some (is_some_colp_symm P)

@[elab_as_eliminator] def row_col_cases_on {C : fin (m + n) → Sort*} (P : partition m n)
  (v : fin (m + n)) (row : fin m → C v) (col : fin n → C v) : C v :=
begin
  cases h : P.rowp v with r,
  { exact col (option.get (show (P.colp v).is_some,
    from (P.eq_rowg_or_colg v).elim (λ ⟨r, hr⟩, absurd h (hr.symm ▸ by simp))
      (λ ⟨c, hc⟩, hc.symm ▸ by simp))) },
  { exact row r }
end

@[simp] lemma row_col_cases_on_rowg {C : fin (m + n) → Sort*} (P : partition m n)
  (r : fin m) (row : fin m → C (P.rowg r)) (col : fin n → C (P.rowg r)) :
  (row_col_cases_on P (P.rowg r) row col : C (P.rowg r)) = row r :=
by simp [row_col_cases_on]

local infix ` ♠ `: 70 := pequiv.trans

def swap (P : partition m n) (r : fin m) (s : fin n) : partition m n :=
{ row_indices := P.row_indices.update_nth r (P.col_indices.nth s),
  col_indices := P.col_indices.update_nth s (P.row_indices.nth r),
  mem_row_indices_or_col_indices := λ v,
    (P.mem_row_indices_or_col_indices v).elim
      (λ h, begin
        revert h,
        simp only [vector.mem_iff_nth, exists_imp_distrib, vector.nth_update_nth_eq_if],
        intros i hi,
        subst hi,
        by_cases r = i,
        { right, use s, simp [h] },
        { left, use i, simp [h] }
      end)
      (λ h, begin
        revert h,
        simp only [vector.mem_iff_nth, exists_imp_distrib, vector.nth_update_nth_eq_if],
        intros j hj,
        subst hj,
        by_cases s = j,
        { left, use r, simp [h] },
        { right, use j, simp [h] }
      end)}

lemma not_is_some_colp_of_is_some_rowp (P : partition m n) (j : fin (m + n)) :
  (P.rowp j).is_some → (P.colp j).is_some → false :=
begin
  rw [option.is_some_iff_exists, option.is_some_iff_exists],
  rintros ⟨i, hi⟩ ⟨k, hk⟩,
  have : P.rowp.symm.trans P.colp i = none,
  { rw [P.rowp_symm_trans_colp, pequiv.bot_apply] },
  rw [pequiv.trans_eq_none] at this,
  rw [← pequiv.eq_some_iff] at hi,
  exact (this j k).resolve_left (not_not.2 hi) hk
end

lemma colp_ne_none_of_rowp_eq_none (P : partition m n) (v : fin (m + n))
  (hb : P.rowp v = none) (hnb : P.colp v = none) : false :=
have hs : card (univ.image P.rowg) = m,
  by rw [card_image_of_injective _ (P.injective_rowg), card_univ, card_fin],
have ht : card (univ.image P.colg) = n,
  by rw [card_image_of_injective _ (P.injective_colg), card_univ, card_fin],
have hst : disjoint (univ.image P.rowg) (univ.image P.colg),
  from finset.disjoint_left.2 begin
    simp only [mem_image, exists_imp_distrib, not_exists],
    assume v i _ hi j _ hj,
    subst hi,
    exact not_is_some_colp_of_is_some_rowp P (P.rowg i)
      (option.is_some_iff_exists.2 ⟨i, by simp⟩)
      (hj ▸ option.is_some_iff_exists.2 ⟨j, by simp⟩),
  end,
have (univ.image P.rowg) ∪ (univ.image P.colg) = univ,
  from eq_of_subset_of_card_le (λ _ _, mem_univ _)
    (by rw [card_disjoint_union hst, hs, ht, card_univ, card_fin]),
begin
  cases mem_union.1 (eq_univ_iff_forall.1 this v);
  rcases mem_image.1 h with ⟨_, _, h⟩; subst h; simp * at *
end

lemma is_some_rowp_iff (P : partition m n) (j : fin (m + n)) :
  (P.rowp j).is_some ↔ ¬(P.colp j).is_some :=
⟨not_is_some_colp_of_is_some_rowp P j,
  by erw [option.not_is_some_iff_eq_none, ← option.ne_none_iff_is_some, forall_swap];
    exact colp_ne_none_of_rowp_eq_none P j⟩

@[simp] lemma colp_rowg_eq_none (P : partition m n) (r : fin m) :
  P.colp (P.rowg r) = none :=
option.not_is_some_iff_eq_none.1 ((P.is_some_rowp_iff _).1 (by simp))

@[simp] lemma rowp_colg_eq_none (P : partition m n) (s : fin n) :
  P.rowp (P.colg s) = none :=
option.not_is_some_iff_eq_none.1 (mt (P.is_some_rowp_iff _).1 (by simp))

@[simp] lemma row_col_cases_on_colg {C : fin (m + n) → Sort*} (P : partition m n)
  (c : fin n) (row : fin m → C (P.colg c)) (col : fin n → C (P.colg c)) :
  (row_col_cases_on P (P.colg c) row col : C (P.colg c)) = col c :=
have ∀ (v' : option (fin m)) (p : option (fin m) → Prop) (h : p v') (h1 : v' = none)
  (f : Π (hpn : p none), fin n),
  (option.rec (λ (h : p none), col (f h)) (λ (r : fin m) (h : p (some r)), row r)
      v' h : C (colg P c)) = col (f (h1 ▸ h)),
  from λ v' p pv' hn f, by subst hn,
begin
  convert this (P.rowp (P.colg c)) (λ x, P.rowp (P.colg c) = x) rfl (by simp)
    (λ h, option.get (row_col_cases_on._proof_1 P (colg P c) h)),
  erw [← option.some_inj, option.some_get, colp_colg]
end

@[simp] lemma option.get_inj {α : Type*} : Π {a b : option α} {ha : a.is_some} {hb : b.is_some},
  option.get ha = option.get hb ↔ a = b
| (some a) (some b) _ _ := by rw [option.get_some, option.get_some, option.some_inj]

@[ext] lemma ext {P C : partition m n} (h : ∀ i, P.rowg i = C.rowg i)
  (h₂ : ∀ j, P.colg j = C.colg j) : P = C :=
begin
  cases P, cases C,
  simp [rowg, colg, function.funext_iff] at *,
  split; apply vector.ext; assumption
end

@[simp] lemma single_rowg_mul_rowp (P : partition m n) (i : fin m) :
  ((single (0 : fin 1) (P.rowg i)).to_matrix : matrix _ _ ℚ) ⬝
    P.rowp.to_matrix = (single (0 : fin 1) i).to_matrix :=
by rw [← to_matrix_trans, single_trans_of_mem _ (rowp_rowg _ _)]

@[simp] lemma single_rowg_mul_colp (P : partition m n) (i : fin m) :
  ((single (0 : fin 1) (P.rowg i)).to_matrix : matrix _ _ ℚ) ⬝
    P.colp.to_matrix = 0 :=
by rw [← to_matrix_trans, single_trans_of_eq_none _ (colp_rowg_eq_none _ _),
  to_matrix_bot]; apply_instance

@[simp] lemma single_colg_mul_colp (P : partition m n) (k : fin n) :
  ((single (0 : fin 1) (P.colg k)).to_matrix : matrix _ _ ℚ) ⬝
    P.colp.to_matrix = (single (0 : fin 1) k).to_matrix :=
by rw [← to_matrix_trans, single_trans_of_mem _ (colp_colg _ _)]

lemma single_colg_mul_rowp (P : partition m n) (k : fin n) :
  ((single (0 : fin 1) (P.colg k)).to_matrix : matrix _ _ ℚ) ⬝
    P.rowp.to_matrix = 0 :=
by rw [← to_matrix_trans, single_trans_of_eq_none _ (rowp_colg_eq_none _ _),
  to_matrix_bot]; apply_instance

lemma colp_symm_trans_rowp (P : partition m n) : P.colp.symm.trans P.rowp = ⊥ :=
symm_injective $ by rw [symm_trans_rev, symm_symm, rowp_symm_trans_colp, symm_bot]

@[simp] lemma colp_transpose_mul_rowp (P : partition m n) :
  (P.colp.to_matrix : matrix _ _ ℚ)ᵀ ⬝ P.rowp.to_matrix = 0 :=
by rw [← to_matrix_bot, ← P.colp_symm_trans_rowp, to_matrix_trans, to_matrix_symm]

@[simp] lemma rowp_transpose_mul_colp (P : partition m n) :
  (P.rowp.to_matrix : matrix _ _ ℚ)ᵀ ⬝ P.colp.to_matrix = 0 :=
by rw [← to_matrix_bot, ← P.rowp_symm_trans_colp, to_matrix_trans, to_matrix_symm]

@[simp] lemma colp_transpose_mul_colp (P : partition m n) :
  (P.colp.to_matrix : matrix _ _ ℚ)ᵀ ⬝ P.colp.to_matrix = 1 :=
by rw [← to_matrix_refl, ← P.colp_trans_colp_symm, to_matrix_trans, to_matrix_symm]

@[simp] lemma rowp_transpose_mul_rowp (P : partition m n) :
  (P.rowp.to_matrix : matrix _ _ ℚ)ᵀ ⬝ P.rowp.to_matrix = 1 :=
by rw [← to_matrix_refl, ← P.rowp_trans_rowp_symm, to_matrix_trans, to_matrix_symm]

lemma mul_transpose_add_mul_transpose (P : partition m n) :
  (P.rowp.to_matrix ⬝ P.rowp.to_matrixᵀ : matrix _ _ ℚ) +
  P.colp.to_matrix ⬝ P.colp.to_matrixᵀ = 1 :=
begin
  ext,
  repeat {rw [← to_matrix_symm, ← to_matrix_trans] },
  simp only [add_val, pequiv.trans_symm, pequiv.to_matrix, one_val,
    pequiv.mem_of_set_iff, set.mem_set_of_eq],
  have := is_some_rowp_iff P j,
  split_ifs; tauto
end

@[simp] lemma rowg_swap (P : partition m n) (r : fin m) (s : fin n) :
  (P.swap r s).rowg r = P.colg s :=
option.some_inj.1 begin
  dsimp [swap, rowg, colg, pequiv.trans],
  simp
end

@[simp] lemma colg_swap (P : partition m n) (r : fin m) (s : fin n) :
  (P.swap r s).colg s = P.rowg r :=
option.some_inj.1 begin
  dsimp [swap, rowg, colg, pequiv.trans],
  simp
end

@[simp] lemma swap_ne_self (P : partition m n) (r : fin m) (c : fin n) : (P.swap r c) ≠ P :=
mt (congr_arg (λ P : partition m n, P.rowg r)) $ by simp

lemma rowg_swap_of_ne (P : partition m n) {i r : fin m} {s : fin n} (h : i ≠ r) :
  (P.swap r s).rowg i = P.rowg i :=
option.some_inj.1 begin
  dsimp [swap, rowg, colg, pequiv.trans],
  simp [vector.nth_update_nth_of_ne h.symm]
end

lemma colg_swap_of_ne (P : partition m n) {r : fin m} {j s : fin n} (h : j ≠ s) :
  (P.swap r s).colg j = P.colg j :=
option.some_inj.1 begin
  dsimp [swap, rowg, colg, pequiv.trans],
  simp [vector.nth_update_nth_of_ne h.symm]
end

lemma rowg_swap' (P : partition m n) (i r : fin m) (s : fin n) :
  (P.swap r s).rowg i = if i = r then P.colg s else P.rowg i :=
if hir : i = r then by simp [hir]
  else by rw [if_neg hir, rowg_swap_of_ne _ hir]

lemma colg_swap' (P : partition m n) (r : fin m) (j s : fin n) :
  (P.swap r s).colg j = if j = s then P.rowg r else P.colg j :=
if hjs : j = s then by simp [hjs]
  else by rw [if_neg hjs, colg_swap_of_ne _ hjs]

@[simp] lemma swap_swap (P : partition m n) (r : fin m) (s : fin n) :
  (P.swap r s).swap r s = P :=
by ext; intros; simp [rowg_swap', colg_swap']; split_ifs; cc

def fin.lastp : fin (m + 1 + n) := fin.cast (add_right_comm _ _ _) (fin.last (m + n))

def fin.castp (v : fin (m + n)) : fin (m + 1 + n) :=
fin.cast (add_right_comm _ _ _) (fin.cast_succ v)

@[simp] lemma fin.castp_ne_lastp (v : fin (m + n)) : (fin.lastp : fin (m + 1 + n)) ≠ fin.castp v :=
ne_of_gt v.2

@[simp] lemma fin.lastp_ne_castp (v : fin (m + n)) : fin.castp v ≠ fin.lastp :=
ne_of_lt v.2

lemma fin.injective_castp : injective (@fin.castp m n) :=
λ ⟨_, _⟩ ⟨_, _⟩, by simp [fin.castp, fin.cast, fin.cast_le, fin.cast_lt, fin.cast_succ]

def add_row (P : partition m n) : partition (m + 1) n :=
{ row_indices := (P.row_indices.map fin.castp).append ⟨[fin.lastp], rfl⟩,
  col_indices := P.col_indices.map (fin.cast (add_right_comm _ _ _) ∘ fin.cast_succ),
  mem_row_indices_or_col_indices := begin
    rintros ⟨v, hv⟩,
    simp only [fin.cast, fin.cast_le, fin.cast_lt, fin.last, vector.to_list_map,
      fin.eq_iff_veq, list.mem_map, fin.cast_le, vector.to_list_append, list.mem_append,
      function.comp, fin.cast_succ, fin.cast_add, fin.exists_iff, and_comm _ (_ = _),
      exists_and_distrib_left, exists_eq_left, fin.lastp, fin.castp],
    by_cases hvmn : v = m + n,
    { simp [hvmn] },
    { have hv : v < m + n, from lt_of_le_of_ne (nat.le_of_lt_succ $ by simpa using hv) hvmn,
      cases P.mem_row_indices_or_col_indices ⟨v, hv⟩; simp * }
  end }

lemma add_row_rowg_last (P : partition m n) : P.add_row.rowg (fin.last m) = fin.lastp :=
have (fin.last m).1 = (P.row_indices.map fin.castp).to_list.length := by simp [fin.last],
option.some_inj.1 $ by simp only [add_row, rowg, vector.nth_eq_nth_le, vector.to_list_append,
  (list.nth_le_nth _).symm, list.nth_concat_length, this, vector.to_list_mk]; refl

lemma add_row_rowg_cast_succ (P : partition m n) (i : fin m) :
  P.add_row.rowg (fin.cast_succ i) = fin.castp (P.rowg i) :=
have i.1 < (P.row_indices.to_list.map fin.castp).length, by simp [i.2],
by simp [add_row, rowg, vector.nth_eq_nth_le, vector.to_list_append,
  (list.nth_le_nth _).symm, list.nth_concat_length, vector.to_list_mk,
  list.nth_le_append _ this, list.nth_le_map]

lemma add_row_colg (P : partition m n) (j : fin n) : P.add_row.colg j = fin.castp (P.colg j) :=
fin.eq_of_veq $ by simp [add_row, colg, vector.nth_eq_nth_le, fin.castp]

def dual (P : partition m n) : partition n m :=
{ row_indices := P.col_indices.map (fin.cast (add_comm _ _)),
  col_indices := P.row_indices.map (fin.cast (add_comm _ _)),
  mem_row_indices_or_col_indices := λ v,
    (P.mem_row_indices_or_col_indices (fin.cast (add_comm _ _) v)).elim
      (λ h, or.inr begin
          simp only [vector.to_list_map, list.mem_map],
          use fin.cast (add_comm _ _) v,
          simp [fin.eq_iff_veq, h],
        end)
      (λ h, or.inl begin
          simp only [vector.to_list_map, list.mem_map],
          use fin.cast (add_comm _ _) v,
          simp [fin.eq_iff_veq, h],
        end) }

@[simp] lemma dual_dual (P : partition m n) : P.dual.dual = P :=
by cases P; simp [dual]; split; ext; simp [fin.eq_iff_veq]

end partition


import ..lovelib

/-! # Project : Eudoxus Reals
Reference: https://arxiv.org/pdf/math/0405454.pdf -/

/-
  This project formalizes a construction of the real numbers called the Eudoxus reals.

  To do so we first introduce almost homomorphisms which are functions ℤ → ℤ for which
  the set {f(m+n) - f(m) - f(n), n m : ℤ} is finite.

  Eudoxus Reals are then defined as equivalence classes of almost homomorphisms.
  With f ~ g ↔ {f(n) - g(n), n : ℤ} is finite.

  Therefore these are fonctions that grow almost linearily and the growth rate
  represents a given real.
  For intuition, the Eudoxus real that represents the real number α will be the
  equivalence class of (λ n : ℤ, ⌊α * n⌋).

  Currently we show that the Eudoxus real form a commutative ring.

  Left to do:
    - Invertibility of non zero elements for *
    - Ordering
    - Completeness
-/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-
  We start with some general results about sets of integers.
-/

lemma int_interval_is_finite (M : ℤ):
M ≥ 0 → set.finite ({x | x < M ∧ - M < x}):=
begin
  --apply set.finite_Ioo (-M) M,
  sorry,
end

lemma bounded_intset_is_finite (s : set ℤ) :
  (∃ M : ℤ, ∀ x ∈ s, abs(x) < M) → s.finite :=
  begin
    intro hbounded,
    cases' hbounded with M1,
    let M := abs M1,
    have haux1 : M1 ≤ M :=
      by exact le_abs_self M1,

    have haux2 : ∀ (x : ℤ), x ∈ s → abs x < M :=
    begin
      intros x hx,
      exact gt_of_ge_of_gt haux1 (h x hx),
    end,

    have haux3 : s ⊆ {x | x < M ∧ -M < x} :=
    begin
      simp [set.subset_def],
      intros x hx,
      specialize haux2 x hx,
      have haux_aux_1 : x < M :=
      begin
        exact lt_of_abs_lt haux2,
      end,
      have haux_aux_2 :  x > -M :=
      begin
        exact neg_lt_of_abs_lt haux2,
      end,
      exact ⟨haux_aux_1, haux_aux_2⟩,
    end,

    have haux4 : M ≥ 0 :=
      by exact abs_nonneg M1,

    apply (set.finite.subset (int_interval_is_finite M haux4) haux3),
  end

lemma finset_exists_max {α : Type} (s : set α) [linear_order α]
  (hnonempty : set.nonempty s) :
  s.finite → ∃ m ∈ s, ∀ x ∈ s, x ≤ m :=
  begin
    intro hfin,
    exact set.exists_max_image s (λ (b : α), b) hfin hnonempty,
  end

lemma finset_exists_bound (s : set ℤ )
  (hnonempty : set.nonempty s) :
  s.finite → ∃ m ∈ s, ∀ x ∈ s, abs(x) ≤ abs(m) :=
  begin
    intro hfin,
    exact set.exists_max_image s (λ (b : ℤ), abs(b)) hfin hnonempty,
  end

lemma finset_exists_strict_bound (s : set ℤ )
  (hnonempty : set.nonempty s) :
  s.finite → ∃ C : ℤ, ∀ x ∈ s, abs(x) < C :=
  begin
    intro hfin,
    cases' (finset_exists_bound s hnonempty hfin),
    cases' h with hw,
    apply exists.intro (abs w + 1),
    have haux1 : abs w < abs w + 1 := lt_add_one (abs w),
    intros x hx,
    specialize h x hx,
    exact lt_of_le_of_lt h haux1,
  end

/- # Almost homomorphisms  -/

def almost_hom (f : ℤ → ℤ) : Prop :=
{x | ∃ m n : ℤ, x = f(n + m) - f(n) - f(m)}.finite

structure almost_homs :=
(func         : ℤ → ℤ)
(almost_hom   : almost_hom func)

namespace almost_homomorphisms

@[instance] def setoid : setoid almost_homs :=
{ r     := λf g : almost_homs, {x | ∃ n : ℤ, x = f.func(n) - g.func(n)}.finite,
  iseqv :=
        begin
          apply and.intro,
          { simp [reflexive] },
          apply and.intro,
          { simp [symmetric],
            intros f g,
            intro hfg,
            let sfg := {x | ∃ n : ℤ, x = f.func(n) - g.func(n)},
            let sgf := {x | ∃ n : ℤ, x = g.func(n) - f.func(n)},
            have hneg : sgf = (λn, -n) '' sfg :=
              begin
                apply eq.symm,
                apply set.surj_on.image_eq_of_maps_to _ _,
                { simp [set.surj_on, set.subset_def],
                  intro a, apply exists.intro a, simp,},
                { simp [set.maps_to],
                  intro a, apply exists.intro a, simp,},
              end,
            have sgf_def : {x | ∃ n : ℤ, x = g.func(n) - f.func(n)} = sgf := by simp,
            have sfg_def : {x | ∃ n : ℤ, x = f.func(n) - g.func(n)} = sfg := by simp,
            rw sgf_def at ⊢,
            rw sfg_def at hfg,
            rw hneg at ⊢,
            apply set.finite.image (λ n, -n) hfg,
            },
          { simp [transitive],
            intros f g h hfg hgh,
            let sfg := {x : ℤ | ∃ (n : ℤ), x = f.func n - g.func n},
            have sfg_def : {x : ℤ | ∃ (n : ℤ), x = f.func n - g.func n} = sfg := by refl,
            let sgh := {x : ℤ | ∃ (n : ℤ), x = g.func n - h.func n},
            have sgh_def : {x : ℤ | ∃ (n : ℤ), x = g.func n - h.func n} = sgh := by refl,
            let sfh := {x : ℤ | ∃ (n : ℤ), x = f.func n - h.func n},
            have sfh_def : {x : ℤ | ∃ (n : ℤ), x = f.func n - h.func n} = sfh := by refl,
            rw sfg_def at hfg,
            rw sgh_def at hgh,
            have hsub : sfh ⊆ set.image2 (λa b, a+b) sfg sgh :=
              begin
                rw set.image2,
                simp [set.subset_def],
                intro n,
                apply exists.intro (f.func n - g.func n),
                apply and.intro,
                {apply exists.intro n, refl,},
                apply exists.intro (g.func n - h.func n),
                apply and.intro,
                {apply exists.intro n, refl},
                linarith,
              end,
            simp [sfh_def],
            have himfin : set.finite(set.image2 (λ a b, a + b) sfg sgh) :=
              by apply set.finite.image2 (λ a b, a+b) hfg hgh,
            apply set.finite.subset himfin hsub,
          },
        end
}

lemma setoid_iff (f g : almost_homs) :
  f ≈ g ↔ {x | ∃ n : ℤ, x = f.func(n) - g.func(n) }.finite :=
by refl

@[instance] def has_zero : has_zero almost_homs :=
{ zero :=
    { func:= λ n, 0,
      almost_hom         := by simp [almost_hom],
    }
}

@[simp] lemma zero_func :
  (0 : almost_homs).func = λn, 0 :=
  by refl

@[instance] def has_neg : has_neg almost_homs :=
{ neg := λ f : almost_homs,
    { func           := - f.func,
      almost_hom         :=
        begin
          simp [almost_hom],
          let s := {x | ∃ m n : ℤ, x = f.func(n + m) - f.func(n) - f.func(m)},
          have hsfin : s.finite := f.almost_hom,
          have him : {x | ∃ m n : ℤ, x = f.func(n) - f.func(n + m) + f.func(m)} = (λn, -n) '' s :=
            begin
              apply eq.symm,
              refine set.surj_on.image_eq_of_maps_to _ _,
              { simp [set.surj_on, set.subset_def],
                intros x m n h,
                apply exists.intro m,
                apply exists.intro n,
                linarith,
              },
              { simp [set.maps_to],
                intros x m n h,
                apply exists.intro m,
                apply exists.intro n,
                linarith,},
            end,
          rw him at ⊢,
          refine set.finite.image (λ n, -n) hsfin,
        end,
    }
}

@[simp] lemma neg_func (f : almost_homs) :
  (-f).func = - f.func :=
  by refl

@[instance] def has_one : has_one almost_homs :=
{ one :=
    { func:= λ n, n,
      almost_hom         := by simp [almost_hom],
    }
}

@[simp] lemma one_func :
  (1 : almost_homs).func = λn, n :=
  by refl

-- # Addition

@[instance] def has_add : has_add almost_homs :=
{ add := λf g : almost_homs,
    { func:= f.func + g.func,
      almost_hom         :=
        begin
          simp [almost_hom],
          let sf := {x | ∃ m n : ℤ, x = f.func(n + m) - f.func(n) - f.func(m)},
          have hf : sf.finite := f.almost_hom,
          let sg := {x | ∃ m n : ℤ, x = g.func(n + m) - g.func(n) - g.func(m)},
          have hg : sg.finite := g.almost_hom,
          let sfg := {x : ℤ | ∃ (m n : ℤ), x = f.func (n + m) + g.func (n + m)
                              - (f.func n + g.func n) - (f.func m + g.func m)},
          have sfg_def : {x : ℤ | ∃ (m n : ℤ), x = f.func (n + m) + g.func (n + m)
                - (f.func n + g.func n) - (f.func m + g.func m)} = sfg := by refl,
          have hsub : sfg ⊆ set.image2 (λ a b, a + b) sf sg :=
            begin
              rw set.image2,
              simp [set.subset_def],
              intros x m n hmn,
              apply exists.intro (f.func (n + m) - f.func n - f.func m),
              apply and.intro,
              {
              apply exists.intro m,
              apply exists.intro n,
              refl,
              },
              apply exists.intro (g.func (n + m) - g.func n - g.func m),
              apply and.intro,
              {
                apply exists.intro m,
                apply exists.intro n,
                refl,
              },
              simp [hmn],
              linarith,
            end,
          simp [sfg_def],
          have himfin : set.finite(set.image2 (λ a b, a + b) sf sg) :=
            by apply set.finite.image2 (λ a b, a+b) hf hg,
          apply set.finite.subset himfin hsub,
        end,
    }
}

@[simp] lemma add_func (f g : almost_homs):
  (f + g).func = f.func + g.func :=
  by refl

lemma add_equiv_add {f f' g g' : almost_homs}
(hf : f ≈ f') (hg : g ≈ g') :
  f + g ≈ f' + g' :=
  begin
    simp [setoid_iff] at *,
    let sff' := {x | ∃ n : ℤ, x = f.func n - f'.func n},
    have sff'_def : {x | ∃ n : ℤ, x = f.func n - f'.func n} = sff' := by refl,
    let sgg' := {x | ∃ n : ℤ, x = g.func n - g'.func n},
    have sgg'_def : {x | ∃ n : ℤ, x = g.func n - g'.func n} = sgg' := by refl,
    let s := {x | ∃ n : ℤ, x = f.func n + g.func n - (f'.func n + g'.func n)},
    have s_def : {x | ∃ n : ℤ, x = f.func n + g.func n - (f'.func n + g'.func n)} = s := by refl,
    simp [sff'_def, sgg'_def, s_def] at *,
    have hsub : s ⊆ set.image2 (λ a b, a + b) sff' sgg' :=
    begin
      rw set.image2,
      simp [set.subset_def],
      intro n,
      apply exists.intro (f.func n - f'.func n),
      apply and.intro,
      {apply exists.intro n, refl},
      {
        apply exists.intro (g.func n - g'.func n),
        apply and.intro,
        {apply exists.intro n, refl},
        linarith,
      }
    end,
  have himfin : set.finite(set.image2 (λ a b, a + b) sff' sgg') :=
    by apply set.finite.image2 (λ a b, a+b) hf hg,
  apply set.finite.subset himfin hsub,
  end

lemma zero_add {f : almost_homs} :
  0 + f ≈ f :=
  by simp [setoid_iff]

lemma add_zero {f : almost_homs} :
  f + 0 ≈ f :=
  by simp [setoid_iff]

-- # Order

def is_positive (f : almost_homs) : Prop :=
{x | ∃ n : ℕ, x = f.func(n)}.infinite

/-
lemma lemma5 (f : almost_homs) :
xor
  (∃ M, ∀ n, f.func n < M)
(xor
  (∀ C > 0, ∃ N, ∀ p > N, f.func(p) > C)
  (∀ C > 0, ∃ N, ∀ p > N, f.func(p) < -C)
) :=
sorry -/

-- # Multiplication

-- We now define the error of an almost homomorphism.
-- d_f(m, n) = f(m + n) - f(m) - f(n)
-- This value represents by how much f is not actually a homomorphism.

def hom_error (f : ℤ → ℤ) (m n : ℤ) :=
  f(m + n) - f(m) - f(n)

lemma hbounded_error (f : almost_homs) :
∃ C : ℤ, ∀ m n : ℤ, abs (f.func(n + m) - f.func(n) - f.func(m)) < C :=
begin
  let s_hom_err := {x | ∃ m n : ℤ, x = f.func(n + m) - f.func(n) - f.func(m)},
  have hfin : set.finite s_hom_err := f.almost_hom,
  have hnonempty : set.nonempty s_hom_err :=
  begin
    simp [set.nonempty_def],
    apply exists.intro (- f.func 0),
    apply exists.intro (int.of_nat 0),
    apply exists.intro (int.of_nat 0),
    simp,
  end,

  cases' (finset_exists_bound s_hom_err hnonempty hfin),
  let C := abs(w) + 1,
  have hC_def : C = abs(w) + 1 := by refl,
  apply exists.intro C,
  intros m n,
  cases' h with hw,
  have hin : f.func (n + m) - f.func n - f.func m ∈ s_hom_err :=
  begin
    simp,
    apply exists.intro m,
    apply exists.intro n,
    simp,
  end,
  rw hC_def,
  have haux : abs (f.func (n + m) - f.func n - f.func m) ≤ abs w :=
  by apply (h (f.func (n + m) - f.func n - f.func m) hin),
  have hsimp : abs w <  abs w + 1 := by linarith,
  apply lt_of_le_of_lt haux hsimp,
end

lemma lemma7 (f : almost_homs) :
∃ C : ℤ, ∀ m n : ℤ,
abs (m * (f.func n) - n * (f.func m)) < (abs m + abs n + 2) * C :=
  begin

    let s_hom_err := {x | ∃ m n : ℤ, x = f.func(n + m) - f.func(n) - f.func(m)},
    have hbounded_homerror : ∃ C : ℤ, ∀ x ∈ s_hom_err,
        abs(x) < C :=
        begin
          simp,
          cases' (hbounded_error f) with C,
          apply exists.intro C,
          intros x m n hx,
          rw hx,
          apply (h m n),
        end,

      cases' hbounded_homerror with C,

    -- m ≥ 0
    have haux_m_nat : ∀ m : ℕ, ∀ n : ℤ,
    abs(f.func (m*n) - m * f.func n) < (abs (m) + 1) * C :=
    begin
      intros m n,
      induction m,
        {
          -- m = 0
          simp,
          have hf_mzero_in : (- f.func 0) ∈ s_hom_err :=
          begin
            simp,
            apply exists.intro (int.of_nat 0),
            apply exists.intro (int.of_nat 0),
            simp,
          end,
          have habsneg : abs (f.func 0) = abs (- f.func 0) :=
          by simp [abs_neg],
          rw habsneg at ⊢,
          refine h (- f.func 0) hf_mzero_in,
        },
          -- p m → p m+1
        {
          simp,
          rename m_n m,
          rename m_ih ih,
          have hin : f.func (m*n + n) - f.func (m*n) - f.func n ∈ s_hom_err :=
          begin
            simp,
            apply exists.intro n,
            apply exists.intro (int.of_nat m*n),
            simp,
          end,
          have haux : abs (f.func (m*n + n) - f.func (m*n) - f.func n) < C :=
            by exact h (f.func (↑m * n + n) - f.func (↑m * n) - f.func n) hin,
          calc abs (f.func ((↑m + 1) * n) - (↑m + 1) * f.func n)
          = abs (f.func (↑m * n + n) - f.func (↑m * n) - f.func n
                + f.func (int.of_nat m * n) - int.of_nat m * f.func n) : _
          ... ≤ abs (f.func (↑m * n + n) - f.func (↑m * n) - f.func n)
                + abs (f.func (int.of_nat m * n) - int.of_nat m * f.func n) : _
          ... < (abs(↑m + 1) + 1) * C : _,
          {
            simp,
            have hsimp1 : (↑m + 1) * n = ↑m * n + n :=
              begin
                linarith,
              end,
            rw hsimp1 at ⊢,
            have hsimp2 : f.func (↑m * n + n) - f.func (↑m * n) - f.func n + f.func (↑m * n) - ↑m * f.func n
            = f.func (↑m * n + n) - f.func n - ↑m * f.func n := by linarith,
            rw hsimp2 at ⊢,
            have hsimp3 : (↑m + 1) * f.func n = f.func n + ↑m * f.func n := by linarith,
            rw hsimp3 at ⊢,
            have hsimp4 : f.func (↑m * n + n) - (f.func n + ↑m * f.func n)
                        = f.func (↑m * n + n) - f.func n - ↑m * f.func n := by linarith,
            rw hsimp4 at ⊢,
          },
          {
            let a := f.func (↑m * n + n) - f.func (↑m * n) - f.func n,
            have a_def : f.func (↑m * n + n) - f.func (↑m * n) - f.func n = a := by refl,
            have hsimp1 : a + f.func (↑m * n) - ↑m * f.func n
                        = a + (f.func (↑m * n) - ↑m * f.func n) := by linarith,
            let b := f.func (↑m * n) - ↑m * f.func n,
            have b_def : f.func (↑m * n) - ↑m * f.func n = b := by refl,
            rw a_def,
            simp,
            rw hsimp1 at ⊢,
            rw b_def,
            exact abs_add a b,
          },
          {
            have haux2 : abs (f.func (int.of_nat m * n) - int.of_nat m * f.func n)
                        + abs (f.func (↑m * n + n) - f.func (↑m * n) - f.func n)
                        < (abs (int.of_nat m) + 1) * C + C := by exact add_lt_add ih haux,
            have hsimp1 : (abs (int.of_nat m) + 1) = int.of_nat m + 1 :=
            begin
              have haux1_1 : abs (int.of_nat m) = int.of_nat m :=
              begin
                simp,
              end,
              rw haux1_1 at ⊢,
            end,
            have hsimp2 : (abs (int.of_nat m + 1) + 1) = int.of_nat m + 1 + 1 :=
            begin
              exact rfl,
            end,
            have hsimp3 : (abs (↑m + 1) + 1) * C = (abs (int.of_nat m + 1) + 1) * C := by refl,
            rw hsimp3,
            rw hsimp2,
            rw hsimp1 at haux2,
            linarith,
          }
        },
    end,

    -- m ≤ 0
    have haux_m_neg : ∀ m : ℕ, ∀ n : ℤ,
    abs (f.func (-[1+ m] * n) - -[1+ m] * f.func n) < (abs -[1+ m] + 1) * C :=
    begin
      intro m,
      induction m,
      {
        intro n,
        have hsimp0 : -[1+0] = -1 :=
          by exact rfl,

        simp [hsimp0],

        have hsimp1 : f.func (-n) + f.func n
        = (f.func (-n) + f.func n - f.func(n - n)) + f.func 0 :=
          by simp,

        calc abs (f.func (-n) + f.func n)
        = abs(f.func (-n) + f.func n - f.func(n - n) + f.func 0) : by simp
        ... ≤ abs (f.func (-n) + f.func n - f.func(n - n)) + abs (f.func 0) : _
        ... < C + C : _
        ... = (1 + 1) * C : by linarith,
        {
          exact abs_add (f.func (-n) + f.func n - f.func (n - n)) (f.func 0),
        },
        {
          have haux1 : abs (f.func (-n) + f.func n - f.func (n - n)) < C :=
          begin
            have hmember : (f.func (n-n) - f.func(-n) - f.func n) ∈ s_hom_err :=
              begin
                simp,
                apply exists.intro n,
                apply exists.intro (-n),
                simp,
              end,
            have haux1_1 : abs((f.func (n-n) - f.func(-n) - f.func n)) < C :=
              by exact h (f.func (n - n) - f.func (-n) - f.func n) hmember,

            have hsimp: abs (f.func (n-n) - f.func (-n) - f.func n)
            = abs (f.func (-n) + f.func n - f.func (n - n)) :=
            begin
              have hsimp_simp : (f.func (n-n) - f.func (-n) - f.func n)
              = - (f.func (-n) + f.func n - f.func (n - n)) :=
                by linarith,
              rw hsimp_simp,
              exact abs_neg (f.func (-n) + f.func n - f.func (n - n)),
            end,
            rw hsimp at haux1_1,
            exact haux1_1,
          end,
          have haux2 : abs(f.func 0) < C :=
          begin
            have hmem : f.func 0 - f.func 0 - f.func 0 ∈ s_hom_err :=
            begin
              simp,
              apply exists.intro (int.of_nat 0),
              apply exists.intro (int.of_nat 0),
              simp,
            end,

            have hsimp1 : abs(f.func 0) = abs (- f.func 0) :=
              by simp [abs_neg (f.func 0)],
            have hsimp2 : -f.func 0 = f.func 0 - f.func 0 - f.func 0 :=
            by linarith,
            rw hsimp1,
            rw hsimp2,
            exact h (f.func 0 - f.func 0 - f.func 0) hmem,
          end,
          exact add_lt_add haux1 haux2,
        },
      },
      {
        intro n,
        rename m_ih ih,
        rename m_n m,
        have hsimp0 : -[1+ nat.succ m] = - (m + 2) := by exact rfl,
        simp [hsimp0],
        have hsimp1 : -[1+ m] = -(m + 1) := by exact rfl,
        simp [hsimp1] at ih,
        have hsimp2 : f.func ((-2 + -↑m) * n) - (-2 + -↑m) * f.func n
        = f.func ((-2 + -↑m) * n) + f.func n - f.func ((-1 + -↑m) * n)
        + (f.func ((-1 + -↑m) * n) - (-1 + -↑m) * f.func n) :=
        begin
          linarith,
        end,

        have haux1 : abs (f.func ((-2 + -↑m) * n) + f.func n - f.func ((-1 + -↑m) * n)) < C :=
        begin
          have hmem : f.func ((-1 + -↑m) * n) - f.func ((-2 + -↑m) * n) - f.func n ∈ s_hom_err :=
          begin
            simp,
            apply exists.intro n,
            apply exists.intro ((-2 + -↑m) * n),
            simp,
            have hsimp : (-1 + -↑m) * n = (-2 + -↑m) * n + n := by linarith,
            simp [hsimp],
          end,
          have haux_aux : abs(f.func ((-1 + -↑m) * n) - f.func ((-2 + -↑m) * n) - f.func n) < C :=
          begin
            apply (h (f.func ((-1 + -↑m) * n) - f.func ((-2 + -↑m) * n) - f.func n) hmem),
          end,
          have hsimp_simp : f.func ((-1 + -↑m) * n) - f.func ((-2 + -↑m) * n) - f.func n
          = - (f.func ((-2 + -↑m) * n) + f.func n - f.func ((-1 + -↑m) * n)) :=
            by linarith,
          rw hsimp_simp at haux_aux,
          rw abs_neg at haux_aux,
          exact haux_aux,
        end,
        have haux2 : abs (f.func ((-1 + -↑m) * n) - (-1 + -↑m) * f.func n) < (abs -[1+ m] + 1) * C :=
          by simp [hsimp1]; exact (ih n),

        calc abs (f.func ((-2 + -↑m) * n) - (-2 + -↑m) * f.func n)
        = abs(f.func ((-2 + -↑m) * n) + f.func n - f.func ((-1 + -↑m) * n)
        + (f.func ((-1 + -↑m) * n) - (-1 + -↑m) * f.func n)) : by rw hsimp2
        ... ≤ abs(f.func ((-2 + -↑m) * n) + f.func n - f.func ((-1 + -↑m) * n))
        + abs ((f.func ((-1 + -↑m) * n) - (-1 + -↑m) * f.func n)) : _
        ... < C + (abs -[1+ m] + 1) * C : by apply (add_lt_add haux1 haux2)
        ... = (abs (-2 + -↑m) + 1) * C : _,
        {
          exact abs_add (f.func ((-2 + -↑m) * n) + f.func n - f.func ((-1 + -↑m) * n))
          (f.func ((-1 + -↑m) * n) - (-1 + -↑m) * f.func n),
        },
        {
          rw hsimp1 at ⊢,
          have habsneg : abs (-1 + -(int.of_nat m)) = m + 1 :=
          begin
            exact abs_sub (-1) (int.of_nat m),
          end,
          have habsneg2 : abs(-2 + -int.of_nat m) = m + 2 :=
          begin
            exact abs_sub (-2) (int.of_nat m),
          end,
          simp at *,
          rw habsneg,
          rw habsneg2,
          linarith,
        }
      },

    end,

    -- m : ℤ
    have haux : ∀ m n : ℤ,
    abs(f.func (m*n) - m * f.func n) < (abs (m) + 1) * C :=
    begin
      intros m n,
      cases' m, -- m is positive or negative
      simp,
      simp at haux_m_nat,
      exact haux_m_nat m n,
      exact haux_m_neg m n,
    end,

    apply exists.intro C,
    intros m n,
    have h1 : abs (f.func(m*n) - m*f.func(n)) < (abs(m) + 1) * C := haux m n,
    have h2 : abs (n*f.func(m) - f.func(m*n)) < (abs(n) + 1) * C :=
      begin
        have hsimp : abs (n*f.func(m) - f.func(m*n))
        = abs (f.func(m*n) - n*f.func(m)) :=
          by exact abs_sub (n * f.func m) (f.func (m * n)),
        rw hsimp,
        have hsimp2 : m*n = n*m := by linarith,
        rw hsimp2,
        exact haux n m,
      end,
    calc abs (m * f.func n - n * f.func m)
      = abs (f.func (m * n) - m * f.func n + n * f.func m - f.func (m * n)) : _
      ... ≤ abs (f.func (m * n) - m * f.func n) + abs (n * f.func m - f.func (m * n)) : _
      ... < (abs m + 1) * C + (abs n + 1) * C : by exact add_lt_add h1 h2
      ... = (abs m + abs n + 2) * C : by linarith,
      {
        have hsimp : m * f.func n - n * f.func m
        = - (f.func (m * n) - m * f.func n + n * f.func m - f.func (m * n)) :=
        begin
          linarith,
        end,
        rw hsimp,
        exact abs_neg (f.func (m * n) - m * f.func n + n * f.func m - f.func (m * n)),
      },
      {
        let a := f.func (m * n) - m * f.func n,
        have a_def : f.func (m * n) - m * f.func n = a := by refl,
        let b := n * f.func m - f.func (m * n),
        have b_def : n * f.func m - f.func (m * n) = b := by refl,
        rw a_def,
        have hsimp : a + n * f.func m - f.func (m * n) =
        a + (n * f.func m - f.func (m * n)) := by linarith,
        rw hsimp,
        rw b_def,
        exact abs_add a b,
      },
  end

lemma lemma8 (f : almost_homs) :
∃ A B : ℤ, ∀ m : ℤ, abs (f.func m) < A * abs(m) + B :=
  begin
    cases' (lemma7 f) with C,
    apply exists.intro (C + abs (f.func 1)),
    apply exists.intro (3*C),
    intro m,
    have haux1 : abs (m * f.func 1 - 1 * f.func m) < (abs m + abs 1 + 2) * C :=
    by exact (h m 1),
    simp at haux1,
    have haux2 : abs (f.func m) - abs (m * f.func 1) ≤  abs (f.func m - m * f.func 1) :=
      by apply abs_sub_abs_le_abs_sub,
    have hsimp1 : abs (m * f.func 1 - f.func m) = abs (f.func m - m * f.func 1) :=
      by exact abs_sub (m * f.func 1) (f.func m),
    rw hsimp1 at haux1,
    have haux3 : abs (f.func m) - abs (m * f.func 1) < (abs m + 1 + 2) * C :=
      by apply lt_of_le_of_lt haux2 haux1,
    have haux4 : abs (f.func m) < (abs m + 1 + 2) * C + abs (m * f.func 1) :=
      by exact sub_lt_iff_lt_add.mp haux3,

    have hsimp2 : abs (m * f.func 1) = abs (m) * abs(f.func 1) :=
      by exact abs_mul m (f.func 1),
    have hsimp3 : (abs m + 1 + 2) * C + abs (m) * abs(f.func 1)
      = (C + abs (f.func 1)) * abs m + 3 * C :=
        by linarith,
    simp [hsimp2, hsimp3] at haux4,
    exact haux4,
  end

@[instance] def has_mul : has_mul almost_homs :=
{ mul := λf g : almost_homs,
    { func:= f.func ∘ g.func,
      almost_hom         :=
        begin
          simp [almost_hom],
          apply bounded_intset_is_finite,
          cases' (hbounded_error f) with Cf hCf,
          cases' (hbounded_error g) with Cg hCg,

          have haux1 : ∀ m n : ℤ, abs(f.func(g.func m + g.func n)
              - f.func (g.func m) - f.func (g.func n)) < Cf :=
              begin
                intros m n,
                apply (hCf (g.func n) (g.func m)),
              end,

          have haux2 : ∀ m n : ℤ, abs(f.func(g.func (m + n))
              - f.func (g.func (m + n) - g.func m - g.func n)
              - f.func (g.func m + g.func n)) < Cf :=
              begin
                intros m n,
                let h := (hCf (g.func m + g.func n) (g.func(m + n) - g.func m - g.func n)),
                simp at *,
                apply h,
              end,

          have haux3 : ∃ C, ∀ m n : ℤ,
          abs(f.func(g.func (m + n) - g.func m - g.func n)) < C :=
          begin
            let sg := {x | ∃ m n : ℤ, x = g.func(n + m) - g.func(n) - g.func(m)},
            have hsg_fin : sg.finite := g.almost_hom,
            let sfg := {x | ∃ y ∈ sg, x = (f.func y)},
            have hfabs_fin : set.finite sfg :=
              by exact set.finite.dependent_image hsg_fin (λ (x : ℤ) (hx : x ∈ sg), (f.func x)),
            cases' (finset_exists_bound sfg _ hfabs_fin),
            {
              apply exists.intro ((abs w) + 1),
              intros m n,
              have haux1 : (g.func (m + n) - g.func m - g.func n) ∈ sg :=
              begin
                simp,
                apply exists.intro n,
                apply exists.intro m,
                refl,
              end,
              have haux2 : (f.func(g.func (m + n) - g.func m - g.func n)) ∈ sfg :=
              begin
                simp,
                apply exists.intro (g.func (m + n) - g.func m - g.func n),
                apply and.intro,
                apply exists.intro n,
                apply exists.intro m,
                refl,
                refl,
              end,
              cases' h with w hw,
              have haux3 : abs w < abs w + 1 :=
                by exact lt_add_one (abs w),
              exact lt_of_le_of_lt (hw (f.func (g.func (m + n) - g.func m - g.func n)) haux2) haux3,
            },
            {
              simp [set.nonempty_def],
              apply exists.intro (f.func(- g.func 0)),
              apply exists.intro (- g.func 0),
              apply and.intro,
              apply exists.intro (int.of_nat 0),
              apply exists.intro (int.of_nat 0),
              simp,
            },
          end,

          have haux4 :
          ∀ m n : ℤ,
          f.func(g.func (m + n)) - f.func (g.func m) - f.func (g.func n) =
          f.func(g.func m + g.func n) - f.func (g.func m) - f.func (g.func n)
          + (f.func(g.func (m + n)) - f.func (g.func (m + n) - g.func m - g.func n) - f.func (g.func m + g.func n))
          + (f.func(g.func (m + n) - g.func m - g.func n)) :=
          by intros m n; linarith,

          cases' haux3 with C,

          have haux5 :
          ∀ m n : ℤ,
          abs (f.func(g.func (m + n)) - f.func (g.func m) - f.func (g.func n)) < 2*Cf + C
          :=
          begin
            intros m n,
            calc abs (f.func(g.func (m + n)) - f.func (g.func m) - f.func (g.func n))
            = abs (f.func(g.func m + g.func n) - f.func (g.func m) - f.func (g.func n)
              + (f.func(g.func (m + n)) - f.func (g.func (m + n) - g.func m - g.func n) - f.func (g.func m + g.func n))
              + (f.func(g.func (m + n) - g.func m - g.func n))) : by simp [haux4]
            ... ≤ abs (f.func(g.func m + g.func n) - f.func (g.func m) - f.func (g.func n))
              + abs(f.func(g.func (m + n)) - f.func (g.func (m + n) - g.func m - g.func n) - f.func (g.func m + g.func n))
              + abs(f.func(g.func (m + n) - g.func m - g.func n)) : _
            ... < Cf + Cf + C : by exact add_lt_add (add_lt_add (haux1 m n) (haux2 m n)) (h m n)
            ... = 2 * Cf + C : by linarith,
            {
              exact abs_add_three (f.func (g.func m + g.func n) - f.func (g.func m) - f.func (g.func n))
              (f.func (g.func (m + n)) - f.func (g.func (m + n) - g.func m - g.func n) - f.func (g.func m + g.func n))
              (f.func (g.func (m + n) - g.func m - g.func n)),
            },
          end,

          apply exists.intro (2*Cf + C),
          intro x,
          simp,
          intros m n hx,
          rw hx,
          apply (haux5 n m),
        end,
    }
}

@[simp] lemma mul_func (f g : almost_homs):
  (f * g).func = f.func ∘ g.func :=
  by refl

lemma one_mul {f : almost_homs} :
  1 * f ≈ f :=
  by simp [setoid_iff]

lemma mul_equiv_mul {f f' g g' : almost_homs}
(hff' : f ≈ f') (hgg' : g ≈ g') :
  f * g ≈ f' * g' :=
  begin
    simp [setoid_iff] at *,
    apply bounded_intset_is_finite,
    set sff' := {x : ℤ | ∃ (n : ℤ), x = f.func n - f'.func n} with sff'_def,
    set sgg' := {x : ℤ | ∃ (n : ℤ), x = g.func n - g'.func n} with sgg'_def,

    have hnonemptyf : set.nonempty sff' :=
    begin
      simp [set.nonempty_def],
      apply exists.intro  (f.func 0 - f'.func 0),
      apply exists.intro (int.of_nat 0),
      simp,
    end,
    have hnonemptyg : set.nonempty sgg' :=
    begin
      simp [set.nonempty_def],
      apply exists.intro  (g.func 0 - g'.func 0),
      apply exists.intro (int.of_nat 0),
      simp,
    end,
    cases' (finset_exists_strict_bound sff' hnonemptyf hff') with Cff' hCff',
    cases' (finset_exists_strict_bound sgg' hnonemptyg hgg') with Cgg' hCgg',

    have haux1 : ∀ n : ℤ,
    abs (f.func (g.func n) - f'.func (g.func n)) < Cff' :=
    begin
      intro n,
      have hmember : f.func (g.func n) - f'.func (g.func n) ∈ sff' :=
      begin
        simp,
        apply exists.intro (g.func n),
        refl,
      end,
      apply (hCff' (f.func (g.func n) - f'.func (g.func n)) hmember),
    end,

    let sf' := {x | ∃ m n : ℤ, x = f'.func(n + m) - f'.func(n) - f'.func(m)},
    have hsg_fin : sf'.finite := f'.almost_hom,
    cases' (hbounded_error f') with Cf' hCf',

    have haux2 : ∀ n : ℤ,
    abs (f'.func(g.func n) - f'.func(g.func n - g'.func n) - f'.func (g'.func n)) < Cf' :=
    begin
      intro n,
      have hsimp : f'.func (g.func n) = f'.func(g.func n - g'.func n + g'.func n) := by simp,
      rw hsimp,
      apply (hCf' (g'.func n) (g.func n - g'.func n)),
    end,

    have haux3 : ∃ C : ℤ, ∀ n : ℤ,
    abs (f'.func (g.func n - g'.func n)) < C :=
    begin
      set sf'g := {x | ∃ y ∈ sgg', x = f'.func y} with sf'g_def,
      have hfin : set.finite sf'g :=
        by exact set.finite.dependent_image hgg' (λ (x : ℤ) (hx : x ∈ sgg'), f'.func x),
      have hnonempty : set.nonempty sf'g :=
      begin
        simp [set.nonempty_def],
        apply exists.intro (f'.func (g.func 0 - g'.func 0)),
        apply exists.intro ((g.func 0 - g'.func 0)),
        apply and.intro,
        apply exists.intro (int.of_nat 0),
        refl,
        refl,
      end,
      cases' (finset_exists_strict_bound sf'g hnonempty hfin) with C hC,
      apply exists.intro C,
      simp [sf'g_def] at hC,
      exact hC,
    end,

    cases' haux3 with C,

    have hrw : ∀ n : ℤ,
    f.func (g.func n) - f'.func (g'.func n)
    =
    (f.func (g.func n) - f'.func (g.func n))
    + (f'.func(g.func n) - f'.func(g.func n - g'.func n) - f'.func (g'.func n))
    + (f'.func (g.func n - g'.func n)) := by intro n; linarith,

    apply exists.intro (Cff' + Cf' + C),

    have haux4 : ∀ n : ℤ,
    abs (f.func (g.func n) - f'.func (g'.func n)) < Cff' + Cf' + C :=
    begin
      intro n,

      calc abs (f.func (g.func n) - f'.func (g'.func n))
      = abs((f.func (g.func n) - f'.func (g.func n))
      + (f'.func(g.func n) - f'.func(g.func n - g'.func n) - f'.func (g'.func n))
      + (f'.func (g.func n - g'.func n))) : by rw hrw
      ... ≤ abs (f.func (g.func n) - f'.func (g.func n))
      + abs (f'.func(g.func n) - f'.func(g.func n - g'.func n) - f'.func (g'.func n))
      + abs (f'.func (g.func n - g'.func n)) : _
      ... < Cff' + Cf' + C : _,
      {
        exact abs_add_three (f.func (g.func n) - f'.func (g.func n))
        (f'.func (g.func n) - f'.func (g.func n - g'.func n) - f'.func (g'.func n))
        (f'.func (g.func n - g'.func n)),
      },
      {
        apply add_lt_add (add_lt_add (haux1 n) (haux2 n)) (h n),
      }
    end,
    simp,
    exact haux4,
  end

lemma mul_monotone (a b c :ℤ):
a ≥ 0 → b ≥ c → a * b ≥ a * c :=
begin
  intros ha hbc,
  exact mul_le_mul_of_nonneg_left hbc ha,
end
lemma mul_monotone_right (a b c :ℤ):
a ≥ 0 → b ≥ c → b * a ≥ c * a :=
begin
  intros ha hbc,
  have hsimp1 : b * a = a * b := by linarith,
  have hsimp2 : c * a = a * c := by linarith,
  rw hsimp1 at ⊢,
  rw hsimp2 at ⊢,
  exact mul_monotone a b c ha hbc,
end

lemma mul_comm_aux (f g : almost_homs) :
∃ A B C : ℤ, (A ≥ 0 ∧ B ≥ 0 ∧ C ≥ 0) ∧
∀ (p : ℤ), abs (p) * abs(f.func (g.func p) - g.func (f.func p)) < 2 * (abs p + (A * abs p + B) + 2) * C :=
begin
  cases' (almost_homomorphisms.lemma7 f) with Cf hCf,
  cases' (almost_homomorphisms.lemma7 g) with Cg hCg,
  set absCf := abs Cf with absCf_def,
  set absCg := abs Cg with absCg_def,

  have haux1 : ∀ p, abs (p * f.func (g.func p) - g.func p * f.func p)
  < (abs p + abs (g.func p ) + 2) * Cf :=
    by intro p; exact  hCf p (g.func p),

  have haux2 : ∀ p, abs (g.func p * f.func p - p * (g.func (f.func p)))
  < (abs p + abs (f.func p) + 2) * Cg :=
    begin
      intro p,
      have hsimp : abs (g.func p * f.func p - p * g.func (f.func p))
        = abs (- (g.func p * f.func p - p * g.func (f.func p))):=
        by exact eq.symm (abs_neg (g.func p * f.func p - p * g.func (f.func p))),

      simp [hsimp],
      rw (mul_comm (g.func p) (f.func p)),
      apply hCg p (f.func p),
    end,

    have haux3 : ∀ p,
    abs (p * (f.func (g.func p)) - p * (g.func (f.func p)))
    < (abs p + abs (g.func p ) + 2) * Cf  + (abs p + abs (f.func p) + 2) * Cg :=
    begin
      intro p,
      calc abs (p * (f.func (g.func p)) - p * (g.func (f.func p)))
    = abs ((p * f.func (g.func p) - g.func p * f.func p)
     + (g.func p * f.func p - p * g.func (f.func p))) : _
    ... ≤ abs (p * f.func (g.func p) - g.func p * f.func p)
     + abs (g.func p * f.func p - p * g.func (f.func p)) : _
    ... < (abs p + abs (g.func p ) + 2) * Cf  + (abs p + abs (f.func p) + 2) * Cg : _,
    {
      have hlinarith : p * (f.func (g.func p)) - p * (g.func (f.func p))
       = p * (f.func (g.func p)) - g.func p * (f.func p) + (g.func p * (f.func p) - p * (g.func (f.func p)))
       := by linarith,
      rw hlinarith,
    },
    {exact abs_add (p * f.func (g.func p) - g.func p * f.func p) (g.func p * f.func p - p * g.func (f.func p)),},
    {exact add_lt_add (hCf p (g.func p)) (haux2 p),}
    end,

    cases' (almost_homomorphisms.lemma8 f) with Af hAf,
    cases' hAf with Bf hABf,
    cases' (almost_homomorphisms.lemma8 g) with Ag hAg,
    cases' hAg with Bg hABg,

    have haux1'_aux : ∀ p, (abs p + abs (g.func p) + 2) * Cf ≤ (abs p + abs (g.func p) + 2) * absCf :=
    begin
      intro p,
      have h1 : (abs p + abs (g.func p) + 2) ≥ 0 :=
      begin
        have h1_1 : abs p ≥ 0 := abs_nonneg p,
        have h1_2 : abs (g.func p) ≥ 0 := abs_nonneg (g.func p),
        linarith,
      end,
      apply (mul_monotone (abs p + abs (g.func p) + 2) absCf Cf h1 _),
      exact le_abs_self Cf,
    end,
    have haux1' :  ∀ p, abs (p * f.func (g.func p) - g.func p * f.func p) < (abs p + abs (g.func p) + 2) * absCf :=
    begin
      intro p,
      have haux1'_aux : (abs p + abs (g.func p) + 2) * Cf ≤ (abs p + abs (g.func p) + 2) * absCf :=
      begin
        have h1 : (abs p + abs (g.func p) + 2) ≥ 0 :=
        begin
          have h1_1 : abs p ≥ 0 := abs_nonneg p,
          have h1_2 : abs (g.func p) ≥ 0 := abs_nonneg (g.func p),
          linarith,
        end,
        apply (mul_monotone (abs p + abs (g.func p) + 2) absCf Cf h1 _),
        exact le_abs_self Cf,
      end,
      apply lt_of_lt_of_le (haux1 p) haux1'_aux,
    end,

    have haux2' : ∀ (p : ℤ), abs (g.func p * f.func p - p * g.func (f.func p)) < (abs p + abs (f.func p) + 2) * absCg :=
    begin
      intro p,
      have haux2'_aux : (abs p + abs (f.func p) + 2) * Cg ≤ (abs p + abs (f.func p) + 2) * absCg :=
      begin
        have h1 : (abs p + abs (f.func p) + 2) ≥ 0 :=
        begin
          have h1_1 : abs p ≥ 0 := abs_nonneg p,
          have h1_2 : abs (f.func p) ≥ 0 := abs_nonneg (f.func p),
          linarith,
        end,
        apply (mul_monotone (abs p + abs (f.func p) + 2) absCg Cg h1 _),
        exact le_abs_self Cg,
      end,
      apply lt_of_lt_of_le (haux2 p) haux2'_aux,
    end,

    have haux4 :  ∀ p,
    (abs p + abs (g.func p) + 2) * absCf
    ≤ (abs p + (Ag * abs p + Bg) + 2) * absCf :=
    begin
      intro p,
      have h1 : (abs p + abs(g.func p) + 2) < (abs p + (Ag * abs p + Bg) + 2) :=
      begin
        have h1_1 : abs p + abs (g.func p) < abs p + (Ag * abs p + Bg) :=
          by exact add_lt_add_left (hABg p) (abs p),
        exact add_lt_add_right h1_1 2,
      end,
      have h : absCf * (abs p + (Ag * abs p + Bg) + 2) ≥ absCf * (abs p + abs (g.func p) + 2) :=
      begin
        apply mul_monotone absCf (abs p + (Ag * abs p + Bg) + 2) (abs p + abs(g.func p) + 2),
        exact abs_nonneg Cf,
        exact le_of_lt h1,
      end,
      linarith,
    end,

    have haux5 :  ∀ p,
    (abs p + abs (f.func p) + 2) * absCg
    ≤ (abs p + (Af * abs p + Bf) + 2) * absCg :=
    begin
      intro p,
      have h1 : (abs p + abs(f.func p) + 2) < (abs p + (Af * abs p + Bf) + 2) :=
      begin
        have h1_1 : abs p + abs (f.func p) < abs p + (Af * abs p + Bf) :=
          by exact add_lt_add_left (hABf p) (abs p),
        exact add_lt_add_right h1_1 2,
      end,
      have h : absCg * (abs p + (Af * abs p + Bf) + 2) ≥ absCg * (abs p + abs (f.func p) + 2) :=
      begin
        apply mul_monotone absCg (abs p + (Af * abs p + Bf) + 2) (abs p + abs(f.func p) + 2),
        exact abs_nonneg Cg,
        exact le_of_lt h1,
      end,
      linarith,
    end,

    have haux6 : ∀ (p : ℤ),
    (abs p + abs (g.func p) + 2) * absCf + (abs p + abs (f.func p) + 2) * absCg
    ≤ (abs p + (Ag * abs p + Bg) + 2) * absCf + (abs p + (Af * abs p + Bf) + 2) * absCg :=
    begin
      intro p,
      apply add_le_add (haux4 p) (haux5 p),
    end,

    have haux3' : ∀ (p : ℤ), abs (p * f.func (g.func p) - p * g.func (f.func p))
    < (abs p + abs (g.func p) + 2) * absCf + (abs p + abs (f.func p) + 2) * absCg :=
    begin
      intro p,
      calc abs (p * (f.func (g.func p)) - p * (g.func (f.func p)))
    = abs ((p * f.func (g.func p) - g.func p * f.func p)
     + (g.func p * f.func p - p * g.func (f.func p))) : _
    ... ≤ abs (p * f.func (g.func p) - g.func p * f.func p)
     + abs (g.func p * f.func p - p * g.func (f.func p)) : _
    ... < (abs p + abs (g.func p ) + 2) * absCf  + (abs p + abs (f.func p) + 2) * absCg : _,
    {
      have hlinarith : p * (f.func (g.func p)) - p * (g.func (f.func p))
       = p * (f.func (g.func p)) - g.func p * (f.func p) + (g.func p * (f.func p) - p * (g.func (f.func p)))
       := by linarith,
      rw hlinarith,
    },
    {exact abs_add (p * f.func (g.func p) - g.func p * f.func p) (g.func p * f.func p - p * g.func (f.func p)),},
    {exact add_lt_add (lt_of_lt_of_le (hCf p (g.func p)) (haux1'_aux p)) (haux2' p),},
    end,

    have haux4' : ∀ (p : ℤ),
    abs (p * f.func (g.func p) - p * g.func (f.func p))
    < (abs p + (Ag * abs p + Bg) + 2) * absCf + (abs p + (Af * abs p + Bf) + 2) * absCg :=
    begin
      intro p,
      apply lt_of_lt_of_le (haux3' p) (haux6 p),
    end,

    have haux5' : ∀ p,
    abs (p * f.func (g.func p) - p * g.func (f.func p)) =
    abs p * abs (f.func (g.func p) - g.func (f.func p)) :=
    begin
      intro p,
      have h : (p * f.func (g.func p) - p * g.func (f.func p)) =
      p * (f.func (g.func p) - g.func (f.func p)) := by linarith,
      rw h,
      exact abs_mul p (f.func (g.func p) - g.func (f.func p)),
    end,

    set A := max Af Ag with Adef,
    set B := max Bf Bg with Bdef,
    have hsimp1 : ∀ p,
    Af * abs p + Bf ≤ A * abs p + B :=
    begin
      intro p,
      have h1 : abs p * A ≥ abs p * Af :=
      begin
        apply mul_monotone (abs p) A Af,
        exact abs_nonneg p,
        exact le_max_left Af Ag,
      end,
      have h1' : abs p * Af ≤ abs p * A :=
        by apply ge.le h1,

      have h2 : Bf ≤ B := by exact le_max_left Bf Bg,
      have h3 : abs p * Af + Bf ≤ abs p * A + B :=
        by apply add_le_add h1 h2,

      have hsimp1 : abs p * Af = Af * abs p := by linarith,
      have hsimp2 : abs p * A = A * abs p := by linarith,
      rw hsimp1 at h3,
      rw hsimp2 at h3,
      exact h3,
    end,

    have hsimp2 : ∀ p,
    Ag * abs p + Bg ≤ A * abs p + B :=
    begin
      intro p,
      have h1 : abs p * A ≥ abs p * Ag :=
      begin
        apply mul_monotone (abs p) A Ag,
        exact abs_nonneg p,
        exact le_max_right Af Ag,
      end,
      have h1' : abs p * Ag ≤ abs p * A :=
        by apply ge.le h1,

      have h2 : Bg ≤ B := by exact le_max_right Bf Bg,
      have h3 : abs p * Ag + Bg ≤ abs p * A + B :=
        by apply add_le_add h1 h2,

      have hsimp1 : abs p * Ag = Ag * abs p := by linarith,
      have hsimp2 : abs p * A = A * abs p := by linarith,
      rw hsimp1 at h3,
      rw hsimp2 at h3,
      exact h3,
    end,

  set C := max absCf absCg with Cdef,
  have hCpos : C ≥ 0 :=
  begin
    have haux : C ≥ absCf := by apply le_max_left absCf absCg,
    have habsCfpos : absCf ≥ 0 := abs_nonneg Cf,
    exact le_trans habsCfpos haux,
  end,
  set absA := abs A with absAdef,
  set absB := abs B with absBdef,

  have haux6': ∀ (p : ℤ), abs (p * f.func (g.func p) - p * g.func (f.func p))
  < 2 * (abs p + (absA * abs p + absB) + 2) * C :=
  begin
    intro p,
    calc  abs (p * f.func (g.func p) - p * g.func (f.func p))
    < (abs p + (Ag * abs p + Bg) + 2) * absCf + (abs p + (Af * abs p + Bf) + 2) * absCg : by exact (haux4' p)
    ... ≤ (abs p + (A * abs p + B) + 2) * absCf + (abs p + (A * abs p + B) + 2) * absCg : _
    ... ≤ (abs p + (absA * abs p + absB) + 2) * absCf + (abs p + (absA * abs p + absB) + 2) * absCg : _
    ... ≤ (abs p + (absA * abs p + absB) + 2) * C + (abs p + (absA * abs p + absB) + 2) * C : _
    ... = 2 * (abs p + (absA * abs p + absB) + 2) * C : by linarith,
    {
      have h1 : absCf *  (abs p + (A * abs p + B) + 2) ≥ absCf * (abs p + (Ag * abs p + Bg) + 2) :=
      begin
        apply mul_monotone absCf (abs p + (A * abs p + B) + 2) (abs p + (Ag * abs p + Bg) + 2),
        exact abs_nonneg Cf,
        simp,
        exact hsimp2 p,
      end,
      have h2 : absCg *  (abs p + (A * abs p + B) + 2) ≥ absCg * (abs p + (Af * abs p + Bf) + 2) :=
      begin
        apply mul_monotone absCg (abs p + (A * abs p + B) + 2) (abs p + (Af * abs p + Bf) + 2),
        exact abs_nonneg Cg,
        simp,
        exact hsimp1 p,
      end,
      rw ge_iff_le at h1,
      rw ge_iff_le at h2,
      have h3 : absCf * (abs p + (Ag * abs p + Bg) + 2) + absCg * (abs p + (Af * abs p + Bf) + 2) ≤
      absCf * (abs p + (A * abs p + B) + 2) + absCg * (abs p + (A * abs p + B) + 2) :=
        by apply add_le_add h1 h2,

      have hs1 : absCf * (abs p + (Ag * abs p + Bg) + 2) = (abs p + (Ag * abs p + Bg) + 2) * absCf := by linarith,
      have hs2 : absCg * (abs p + (Af * abs p + Bf) + 2) = (abs p + (Af * abs p + Bf) + 2) * absCg := by linarith,
      have hs3 : absCf * (abs p + (A * abs p + B) + 2) = (abs p + (A * abs p + B) + 2) * absCf := by linarith,
      have hs4 : absCg * (abs p + (A * abs p + B) + 2) =  (abs p + (A * abs p + B) + 2) * absCg := by linarith,
      rw hs1 at h3,
      rw hs2 at h3,
      rw hs3 at h3,
      rw hs4 at h3,
      exact h3,
    },
    {
      have h1 : (abs p + (absA * abs p + absB) + 2) * absCf ≥ (abs p + (A * abs p + B) + 2) * absCf :=
      begin
        have h1_1 : absA * abs p ≥ A * abs p :=
          by apply mul_monotone_right (abs p) (absA) A (abs_nonneg p) (le_abs_self A),
        have h1_2 : absB ≥ B :=
          by exact le_abs_self B,
        have h1_3 : absA * abs p  + absB ≥ A * abs p + B :=
          by exact add_le_add h1_1 h1_2,
        apply mul_monotone_right absCf (abs p + (absA * abs p + absB) + 2) (abs p + (A * abs p + B) + 2),
        exact abs_nonneg Cf,
        simp,
        apply h1_3,
      end,
      have h2 : (abs p + (absA * abs p + absB) + 2) * absCg ≥ (abs p + (A * abs p + B) + 2) * absCg :=
      begin
        have h1_1 : absA * abs p ≥ A * abs p :=
          by apply mul_monotone_right (abs p) (absA) A (abs_nonneg p) (le_abs_self A),
        have h1_2 : absB ≥ B :=
          by exact le_abs_self B,
        have h1_3 : absA * abs p  + absB ≥ A * abs p + B :=
          by exact add_le_add h1_1 h1_2,
        apply mul_monotone_right absCg (abs p + (absA * abs p + absB) + 2) (abs p + (A * abs p + B) + 2),
        exact abs_nonneg Cg,
        simp,
        apply h1_3,
      end,
      apply add_le_add h1 h2,
    },
    {
      have hpos : abs p + (absA * abs p + absB) + 2 ≥ 0 :=
      begin
        have hpos1 : absA ≥ 0 := abs_nonneg A,
        have hpos2 : absB ≥ 0 := abs_nonneg B,
        have hpos3 : abs p ≥ 0 := abs_nonneg p,
        have hpos4 : absA * abs p ≥ 0 := mul_nonneg hpos1 hpos3,
        have hpos5 : absA * abs p + absB ≥ 0 := add_nonneg hpos4 hpos2,
        have hpos6 : abs p + (absA * abs p + absB) ≥ 0 := add_nonneg hpos3 hpos5,
        refine add_nonneg hpos6 _,
        linarith,
      end,
      have h1 : (abs p + (absA * abs p + absB) + 2) * C ≥ (abs p + (absA * abs p + absB) + 2) * absCf :=
      begin
        apply mul_monotone  (abs p + (absA * abs p + absB) + 2) C absCf,
        apply hpos,
        apply le_max_left absCf absCg,
      end,
      have h2 : (abs p + (absA * abs p + absB) + 2) * C ≥ (abs p + (absA * abs p + absB) + 2) * absCg :=
      begin
        apply mul_monotone  (abs p + (absA * abs p + absB) + 2) C absCg,
        apply hpos,
        apply le_max_right absCf absCg,
      end,
      apply add_le_add h1 h2,
    },
  end,

  have haux7': ∀ (p : ℤ), abs (p) * abs(f.func (g.func p) - g.func (f.func p))
  < 2 * (abs p + (absA * abs p + absB) + 2) * C :=
  begin
    intro p,
    have h := (eq.symm (haux5' p)),
    rw h at ⊢,
    exact (haux6' p),
  end,

  apply exists.intro absA,
  apply exists.intro absB,
  apply exists.intro C,
  apply and.intro,
  apply and.intro,
  apply abs_nonneg A,
  apply and.intro,
  apply abs_nonneg B,
  apply hCpos,
  exact haux7',
end

lemma abs_nonnul_ge_1 (x : ℤ) :
x ≠ 0 → abs x ≥ 1 :=
begin
  intro hx,
  have hpos : 0 < abs x :=
  begin
    exact abs_pos.mpr hx,
  end,
  exact hpos,
end

lemma mul_comm (f g : almost_homs) :
f * g ≈ g * f :=
begin
  simp [almost_homomorphisms.setoid_iff],
  apply bounded_intset_is_finite,
  cases' mul_comm_aux f g with A hrest,
  cases' hrest with B hrest,
  cases' hrest with C hrest,
  have hABCpos : (A ≥ 0 ∧ B ≥ 0 ∧ C ≥ 0) := by apply and.elim_left hrest,
  have hApos : A ≥ 0 := and.elim_left hABCpos,
  have hBpos : B ≥ 0 := and.elim_left (and.elim_right hABCpos),
  have hCpos : C ≥ 0 := and.elim_right (and.elim_right hABCpos),
  have hbound :  ∀ (p : ℤ), abs (p) * abs(f.func (g.func p) - g.func (f.func p))
  < 2 * (abs p + (A * abs p + B) + 2) * C := by apply and.elim_right hrest,
  clear hrest,
  have hbound_1 :  ∀ (p : ℤ), p ≠ 0 → abs(f.func (g.func p) - g.func (f.func p))
  < 2 * (1 + (A + B) + 2) * C :=
  begin
    intros p hp,
    have haux1 :  abs (p) * abs(f.func (g.func p) - g.func (f.func p))
    < 2 * (abs p + (A * abs p + B) + 2) * C := hbound p,

    have haux2 : abs p * abs(f.func (g.func p) - g.func (f.func p)) < abs p * (2 * (1 + (A + B) + 2) * C)
    ↔ abs(f.func (g.func p) - g.func (f.func p)) < 2 * (1 + (A + B) + 2) * C :=
    begin
      apply (@mul_lt_mul_left _ _ (abs(f.func (g.func p) - g.func (f.func p))) (2 * (1 + (A + B) + 2) * C) (abs p) _),
      apply (iff.elim_right abs_pos),
      apply hp,
    end,

    apply (iff.elim_left haux2),

    have habsp_one : abs p ≥ 1 := by apply abs_nonnul_ge_1 p hp,

    have haux4 : 2 * (abs p + (A * abs p + B) + 2) * C ≤ abs p * (2 * (1 + (A + B) + 2) * C) :=
    begin
      have hsimp : abs p * (2 * (1 + (A + B) + 2) * C) = 2 * (abs p * 1 + (A * abs p + abs p * B) + abs p *2) * C :=
        by linarith,
      rw hsimp,
      have h1 := mul_monotone_right B (abs p) 1 hBpos habsp_one,
      simp at h1,
      have h2 := mul_monotone_right 2 (abs p) 1 zero_le_two habsp_one,
      simp at h2,
      have h3 : A * abs p + B ≤ A * abs p + abs p * B :=
      begin
        refine add_le_add _ h1,
        linarith,
      end,
      have h4 : (A * abs p + B) + 2 ≤ (A * abs p + abs p * B) + abs p * 2 := by exact add_le_add h3 h2,
      have h5 : abs p + (A * abs p + B) + 2 ≤ abs p + (A * abs p + abs p * B) + abs p * 2 := by linarith,
      have h6 : 2 * (abs p + (A * abs p + B) + 2) ≤ 2 * (abs p + (A * abs p + abs p * B) + abs p * 2) := by linarith,
      have h7 := mul_monotone_right C (2 * (abs p + (A * abs p + abs p * B) + abs p * 2)) (2 * (abs p + (A * abs p + B) + 2)) hCpos h6,
      simp at h7,
      simp,
      exact h7,
    end,

    calc abs p * abs (f.func (g.func p) - g.func (f.func p))
        < 2 * (abs p + (A * abs p + B) + 2) * C : hbound p
    ... ≤ abs p * (2 * (1 + (A + B) + 2) * C) : haux4,
  end,

  set M0 := abs (f.func (g.func 0) - g.func (f.func 0)) with M0_def,
  set Mp := 2 * (1 + (A + B) + 2) * C with Mp_def,
  set M := max (M0+1) Mp,
  apply exists.intro M,
  intros x,
  simp,
  intros n hx,
  have cases_n : n = 0 ∨ n ≠ 0 := dec_em (n = 0),
  cases cases_n,
  {
    simp [cases_n] at hx,
    have hxM0 : abs x ≤ M0 := by simp [hx],
    refine or.inl _,
    calc abs x ≤ M0 : hxM0
    ... < M0 + 1 : lt_add_one M0,
  },
  {
    refine or.inr _,
    simp [hx],
    apply (hbound_1 n cases_n),
  },
end

end almost_homomorphisms

/-
  # Eudoxus Reals
-/

namespace Eudoxus_Reals

def Eudoxus_Reals : Type :=
quotient almost_homomorphisms.setoid

@[instance] def has_add : has_add Eudoxus_Reals :=
{ add := quotient.lift₂ (λf g : almost_homs, ⟦f + g⟧)
    begin
      intros f g f' g' hf hg,
      apply quotient.sound,
      exact almost_homomorphisms.add_equiv_add hf hg,
    end }

@[instance] def has_zero : has_zero Eudoxus_Reals :=
{ zero := ⟦0⟧ }

lemma zero_add (x : Eudoxus_Reals) : 0 + x = x :=
begin
  apply quotient.induction_on x,
  intro x',
  apply quotient.sound,
  apply almost_homomorphisms.zero_add,
end

lemma add_zero (x : Eudoxus_Reals) : x + 0 = x :=
begin
  apply quotient.induction_on x,
  intro x',
  apply quotient.sound,
  apply almost_homomorphisms.add_zero,
end

@[instance] def has_one : has_one Eudoxus_Reals :=
{ one := ⟦1⟧ }

lemma add_comm (a b : Eudoxus_Reals) :
  a+b=b+a :=
  begin
    apply quotient.induction_on₂ a b,
    intros a' b',
    apply quotient.sound,
    simp [almost_homomorphisms.setoid_iff],
    have haux : a'.func + b'.func - (b'.func + a'.func) = 0 :=
    begin
      have hauxaux: a'.func + b'.func = b'.func + a'.func :=
        by exact add_comm a'.func b'.func,
      exact sub_eq_zero.mpr hauxaux,
    end,
    have haux2 : ∀ n, a'.func n + b'.func n - (b'.func n + a'.func n) = 0 :=
      by exact congr_fun haux,
    simp [haux2],
  end

lemma add_assoc (a b c : Eudoxus_Reals) :
  a + b + c = a + (b + c) :=
  begin
    apply quotient.induction_on₃ a b c,
    intros a' b' c',
    apply quotient.sound,
    simp [almost_homomorphisms.setoid_iff],
    have haux : ∀ n,
    a'.func n + b'.func n + c'.func n - (a'.func n + (b'.func n + c'.func n)) = 0
    := by intro n; linarith,
    simp [haux],
  end

@[instance] def has_neg : has_neg Eudoxus_Reals :=
{ neg := quotient.lift (λf : almost_homs, ⟦- f⟧)
        begin
          intros f g hfg,
          apply quotient.sound,
          simp [almost_homomorphisms.setoid_iff] at *,
          exact (almost_homomorphisms.setoid_iff g f).mp (setoid.symm hfg),
        end
}

lemma add_left_neg (a : Eudoxus_Reals) :
-a + a = 0 :=
  begin
    apply quotient.induction_on a,
    intro a',
    apply quotient.sound,
    simp [almost_homomorphisms.setoid_iff],
  end

/- # Eudoxus Reals form an abelian group -/

@[instance] def Eudoxus_Reals.add_group :
add_comm_group Eudoxus_Reals :=
{
  add := Eudoxus_Reals.has_add.add,
  add_assoc := add_assoc,
  zero := Eudoxus_Reals.has_zero.zero,
  zero_add := zero_add,
  add_zero := add_zero,
  neg  := Eudoxus_Reals.has_neg.neg,
  add_left_neg := add_left_neg,
  add_comm := add_comm,
}

@[instance] def has_mul : has_mul Eudoxus_Reals :=
{ mul := quotient.lift₂ (λf g : almost_homs, ⟦f * g⟧)
    begin
      intros f g f' g' hf hg,
      apply quotient.sound,
      exact almost_homomorphisms.mul_equiv_mul hf hg,
    end }

lemma mul_assoc (a b c : Eudoxus_Reals) :
a * b * c = a * (b * c) :=
  begin
    apply quotient.induction_on₃ a b c,
    intros a' b' c',
    apply quotient.sound,
    simp [almost_homomorphisms.setoid_iff],
  end

lemma mul_comm (a b : Eudoxus_Reals) :
  a * b = b * a :=
  begin
    apply quotient.induction_on₂ a b,
    intros f g,
    apply quotient.sound,
    apply almost_homomorphisms.mul_comm f g,
end

lemma one_mul (x : Eudoxus_Reals) :
1 * x = x :=
begin
  apply quotient.induction_on x,
  intro x',
  apply quotient.sound,
  simp [almost_homomorphisms.setoid_iff],
end

lemma mul_one (x : Eudoxus_Reals) :
x * 1 = x :=
begin
  apply quotient.induction_on x,
  intro x',
  apply quotient.sound,
  simp [almost_homomorphisms.setoid_iff],
end

lemma left_distrib (a b c : Eudoxus_Reals):
a * (b + c) = a * b + a * c :=
begin
  apply quotient.induction_on₃ a b c,
  intros f g h,
  apply quotient.sound,
  simp [almost_homomorphisms.setoid_iff],
  set s_hom_err := {x | ∃ m n : ℤ, x = f.func(n + m) - f.func(n) - f.func(m)} with s_hom_err_def,
  set s := {x : ℤ | ∃ (n : ℤ), x = f.func (g.func n + h.func n) - (f.func (g.func n) + f.func (h.func n))} with s_def,
  have hfin : set.finite s_hom_err := f.almost_hom,
  have hsub : s ⊆ s_hom_err :=
  begin
    simp [set.subset_def],
    intro n,
    apply exists.intro (h.func n),
    apply exists.intro (g.func n),
    linarith,
  end,
  exact set.finite.subset hfin hsub,
end

lemma right_distrib (a b c : Eudoxus_Reals):
(a + b) * c = a * c + b * c :=
begin
  apply quotient.induction_on₃ a b c,
  intros f g h,
  apply quotient.sound,
  simp [almost_homomorphisms.setoid_iff],
end

/- # Eudoxus Reals form a ring -/
@[instance] def Eudoxus_Reals.ring:
comm_ring Eudoxus_Reals :=
{
  add := Eudoxus_Reals.has_add.add,
  add_assoc := add_assoc,
  zero := Eudoxus_Reals.has_zero.zero,
  zero_add := zero_add,
  add_zero := add_zero,
  neg  := Eudoxus_Reals.has_neg.neg,
  add_left_neg := add_left_neg,
  add_comm := add_comm,

  mul := Eudoxus_Reals.has_mul.mul,
  mul_assoc := mul_assoc,
  one := Eudoxus_Reals.has_one.one,
  one_mul := one_mul,
  mul_one := mul_one,
  left_distrib := left_distrib,
  right_distrib := right_distrib,
  mul_comm := mul_comm,
}
end Eudoxus_Reals

end LoVe


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Robert Y. Lewis
-/
import data.real.cau_seq

/-!
# Cauchy completion

This file generalizes the Cauchy completion of `(ℚ, abs)` to the completion of a commutative ring
with absolute value.
-/

namespace cau_seq.completion
open cau_seq

section
parameters {α : Type*} [linear_ordered_field α]
parameters {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv]

/-- The Cauchy completion of a commutative ring with absolute value. -/
def Cauchy := @quotient (cau_seq _ abv) cau_seq.equiv

/-- The map from Cauchy sequences into the Cauchy completion. -/
def mk : cau_seq _ abv → Cauchy := quotient.mk

@[simp] theorem mk_eq_mk (f) : @eq Cauchy ⟦f⟧ (mk f) := rfl

theorem mk_eq {f g} : mk f = mk g ↔ f ≈ g := quotient.eq

/-- The map from the original ring into the Cauchy completion. -/
def of_rat (x : β) : Cauchy := mk (const abv x)

instance : has_zero Cauchy := ⟨of_rat 0⟩
instance : has_one Cauchy := ⟨of_rat 1⟩
instance : inhabited Cauchy := ⟨0⟩

theorem of_rat_zero : of_rat 0 = 0 := rfl
theorem of_rat_one : of_rat 1 = 1 := rfl

@[simp] theorem mk_eq_zero {f} : mk f = 0 ↔ lim_zero f :=
by have : mk f = 0 ↔ lim_zero (f - 0) := quotient.eq;
   rwa sub_zero at this

instance : has_add Cauchy :=
⟨λ x y, quotient.lift_on₂ x y (λ f g, mk (f + g)) $
  λ f₁ g₁ f₂ g₂ hf hg, quotient.sound $
  by simpa [(≈), setoid.r, sub_eq_add_neg, add_comm, add_left_comm, add_assoc]
    using add_lim_zero hf hg⟩

@[simp] theorem mk_add (f g : cau_seq β abv) : mk f + mk g = mk (f + g) := rfl

instance : has_neg Cauchy :=
⟨λ x, quotient.lift_on x (λ f, mk (-f)) $
  λ f₁ f₂ hf, quotient.sound $
  by simpa [(≈), setoid.r] using neg_lim_zero hf⟩

@[simp] theorem mk_neg (f : cau_seq β abv) : -mk f = mk (-f) := rfl

instance : has_mul Cauchy :=
⟨λ x y, quotient.lift_on₂ x y (λ f g, mk (f * g)) $
  λ f₁ g₁ f₂ g₂ hf hg, quotient.sound $
  by simpa [(≈), setoid.r, mul_add, mul_comm, add_assoc, sub_eq_add_neg] using
    add_lim_zero (mul_lim_zero_right g₁ hf) (mul_lim_zero_right f₂ hg)⟩

@[simp] theorem mk_mul (f g : cau_seq β abv) : mk f * mk g = mk (f * g) := rfl

instance : has_sub Cauchy :=
⟨λ x y, quotient.lift_on₂ x y (λ f g, mk (f - g)) $
  λ f₁ g₁ f₂ g₂ hf hg, quotient.sound $ show ((f₁ - g₁) - (f₂ - g₂)).lim_zero,
    by simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using sub_lim_zero hf hg⟩

@[simp] theorem mk_sub (f g : cau_seq β abv) : mk f - mk g = mk (f - g) := rfl

theorem of_rat_add (x y : β) : of_rat (x + y) = of_rat x + of_rat y :=
congr_arg mk (const_add _ _)

theorem of_rat_neg (x : β) : of_rat (-x) = -of_rat x :=
congr_arg mk (const_neg _)

theorem of_rat_mul (x y : β) : of_rat (x * y) = of_rat x * of_rat y :=
congr_arg mk (const_mul _ _)

private lemma zero_def : 0 = mk 0 := rfl

private lemma one_def : 1 = mk 1 := rfl

instance : comm_ring Cauchy :=
by refine { neg := has_neg.neg, sub := has_sub.sub, sub_eq_add_neg := _,
    add := (+), zero := (0 : Cauchy), mul := (*), one := 1, nsmul := nsmul_rec, npow := npow_rec,
    zsmul := zsmul_rec, .. }; try { intros; refl };
{ repeat {refine λ a, quotient.induction_on a (λ _, _)},
  simp [zero_def, one_def, mul_left_comm, mul_comm, mul_add, add_comm, add_left_comm,
          sub_eq_add_neg] }

theorem of_rat_sub (x y : β) : of_rat (x - y) = of_rat x - of_rat y :=
congr_arg mk (const_sub _ _)

end

open_locale classical
section

parameters {α : Type*} [linear_ordered_field α]
parameters {β : Type*} [field β] {abv : β → α} [is_absolute_value abv]
local notation `Cauchy` := @Cauchy _ _ _ _ abv _

noncomputable instance : has_inv Cauchy :=
⟨λ x, quotient.lift_on x
  (λ f, mk $ if h : lim_zero f then 0 else inv f h) $
λ f g fg, begin
  have := lim_zero_congr fg,
  by_cases hf : lim_zero f,
  { simp [hf, this.1 hf, setoid.refl] },
  { have hg := mt this.2 hf, simp [hf, hg],
    have If : mk (inv f hf) * mk f = 1 := mk_eq.2 (inv_mul_cancel hf),
    have Ig : mk (inv g hg) * mk g = 1 := mk_eq.2 (inv_mul_cancel hg),
    rw [mk_eq.2 fg, ← Ig] at If,
    rw mul_comm at Ig,
    rw [← mul_one (mk (inv f hf)), ← Ig, ← mul_assoc, If,
        mul_assoc, Ig, mul_one] }
end⟩

@[simp] theorem inv_zero : (0 : Cauchy)⁻¹ = 0 :=
congr_arg mk $ by rw dif_pos; [refl, exact zero_lim_zero]

@[simp] theorem inv_mk {f} (hf) : (@mk α _ β _ abv _ f)⁻¹ = mk (inv f hf) :=
congr_arg mk $ by rw dif_neg

lemma cau_seq_zero_ne_one : ¬ (0 : cau_seq _ abv) ≈ 1 := λ h,
have lim_zero (1 - 0), from setoid.symm h,
have lim_zero 1, by simpa,
one_ne_zero $ const_lim_zero.1 this

lemma zero_ne_one : (0 : Cauchy) ≠ 1 :=
λ h, cau_seq_zero_ne_one $ mk_eq.1 h

protected theorem inv_mul_cancel {x : Cauchy} : x ≠ 0 → x⁻¹ * x = 1 :=
quotient.induction_on x $ λ f hf, begin
  simp at hf, simp [hf],
  exact quotient.sound (cau_seq.inv_mul_cancel hf)
end

/-- The Cauchy completion forms a field.
See note [reducible non-instances]. -/
@[reducible]
noncomputable def field : field Cauchy :=
{ inv              := has_inv.inv,
  mul_inv_cancel   := λ x x0, by rw [mul_comm, cau_seq.completion.inv_mul_cancel x0],
  exists_pair_ne   := ⟨0, 1, zero_ne_one⟩,
  inv_zero         := inv_zero,
  .. Cauchy.comm_ring }

local attribute [instance] field

theorem of_rat_inv (x : β) : of_rat (x⁻¹) = ((of_rat x)⁻¹ : Cauchy) :=
congr_arg mk $ by split_ifs with h; [simp [const_lim_zero.1 h], refl]

theorem of_rat_div (x y : β) : of_rat (x / y) = (of_rat x / of_rat y : Cauchy) :=
by simp only [div_eq_inv_mul, of_rat_inv, of_rat_mul]

end
end cau_seq.completion

variables {α : Type*} [linear_ordered_field α]
namespace cau_seq
section

variables (β : Type*) [ring β] (abv : β → α) [is_absolute_value abv]

/-- A class stating that a ring with an absolute value is complete, i.e. every Cauchy
sequence has a limit. -/
class is_complete :=
(is_complete : ∀ s : cau_seq β abv, ∃ b : β, s ≈ const abv b)
end

section

variables {β : Type*} [ring β] {abv : β → α} [is_absolute_value abv]
variable [is_complete β abv]

lemma complete : ∀ s : cau_seq β abv, ∃ b : β, s ≈ const abv b :=
is_complete.is_complete

/-- The limit of a Cauchy sequence in a complete ring. Chosen non-computably. -/
noncomputable def lim (s : cau_seq β abv) : β :=
classical.some (complete s)

lemma equiv_lim (s : cau_seq β abv) : s ≈ const abv (lim s) :=
classical.some_spec (complete s)

lemma eq_lim_of_const_equiv {f : cau_seq β abv} {x : β} (h : cau_seq.const abv x ≈ f) : x = lim f :=
const_equiv.mp $ setoid.trans h $ equiv_lim f

lemma lim_eq_of_equiv_const {f : cau_seq β abv} {x : β} (h : f ≈ cau_seq.const abv x) : lim f = x :=
(eq_lim_of_const_equiv $ setoid.symm h).symm

lemma lim_eq_lim_of_equiv {f g : cau_seq β abv} (h : f ≈ g) : lim f = lim g :=
lim_eq_of_equiv_const $ setoid.trans h $ equiv_lim g

@[simp] lemma lim_const (x : β) : lim (const abv x) = x :=
lim_eq_of_equiv_const $ setoid.refl _

lemma lim_add (f g : cau_seq β abv) : lim f + lim g = lim (f + g) :=
eq_lim_of_const_equiv $ show lim_zero (const abv (lim f + lim g) - (f + g)),
  by rw [const_add, add_sub_comm];
  exact add_lim_zero (setoid.symm (equiv_lim f)) (setoid.symm (equiv_lim g))

lemma lim_mul_lim (f g : cau_seq β abv) : lim f * lim g = lim (f * g) :=
eq_lim_of_const_equiv $ show lim_zero (const abv (lim f * lim g) - f * g),
  from have h : const abv (lim f * lim g) - f * g = (const abv (lim f) - f) * g
      + const abv (lim f) * (const abv (lim g) - g) :=
    by simp [const_mul (lim f), mul_add, add_mul, sub_eq_add_neg, add_comm, add_left_comm],
  by rw h; exact add_lim_zero (mul_lim_zero_left _ (setoid.symm (equiv_lim _)))
    (mul_lim_zero_right _ (setoid.symm (equiv_lim _)))

lemma lim_mul (f : cau_seq β abv) (x : β) : lim f * x = lim (f * const abv x) :=
by rw [← lim_mul_lim, lim_const]

lemma lim_neg (f : cau_seq β abv) : lim (-f) = -lim f :=
lim_eq_of_equiv_const (show lim_zero (-f - const abv (-lim f)),
  by rw [const_neg, sub_neg_eq_add, add_comm, ← sub_eq_add_neg];
  exact setoid.symm (equiv_lim f))

lemma lim_eq_zero_iff (f : cau_seq β abv) : lim f = 0 ↔ lim_zero f :=
⟨assume h,
  by have hf := equiv_lim f;
  rw h at hf;
  exact (lim_zero_congr hf).mpr (const_lim_zero.mpr rfl),
assume h,
  have h₁ : f = (f - const abv 0) := ext (λ n, by simp [sub_apply, const_apply]),
  by rw h₁ at h; exact lim_eq_of_equiv_const h ⟩

end

section
variables {β : Type*} [field β] {abv : β → α} [is_absolute_value abv] [is_complete β abv]

lemma lim_inv {f : cau_seq β abv} (hf : ¬ lim_zero f) : lim (inv f hf) = (lim f)⁻¹ :=
have hl : lim f ≠ 0 := by rwa ← lim_eq_zero_iff at hf,
lim_eq_of_equiv_const $ show lim_zero (inv f hf - const abv (lim f)⁻¹),
  from have h₁ : ∀ (g f : cau_seq β abv) (hf : ¬ lim_zero f), lim_zero (g - f * inv f hf * g) :=
    λ g f hf, by rw [← one_mul g, ← mul_assoc, ← sub_mul, mul_one, mul_comm, mul_comm f];
    exact mul_lim_zero_right _ (setoid.symm (cau_seq.inv_mul_cancel _)),
  have h₂ : lim_zero ((inv f hf - const abv (lim f)⁻¹) - (const abv (lim f) - f) *
      (inv f hf * const abv (lim f)⁻¹)) :=
    by rw [sub_mul, ← sub_add, sub_sub, sub_add_eq_sub_sub, sub_right_comm, sub_add];
    exact show lim_zero (inv f hf - const abv (lim f) * (inv f hf * const abv (lim f)⁻¹)
      - (const abv (lim f)⁻¹ - f * (inv f hf * const abv (lim f)⁻¹))),
    from sub_lim_zero
      (by rw [← mul_assoc, mul_right_comm, const_inv hl]; exact h₁ _ _ _)
      (by rw [← mul_assoc]; exact h₁ _ _ _),
  (lim_zero_congr h₂).mpr $ mul_lim_zero_left _ (setoid.symm (equiv_lim f))

end

section
variables [is_complete α abs]

lemma lim_le {f : cau_seq α abs} {x : α}
  (h : f ≤ cau_seq.const abs x) : lim f ≤ x :=
cau_seq.const_le.1 $ cau_seq.le_of_eq_of_le (setoid.symm (equiv_lim f)) h

lemma le_lim {f : cau_seq α abs} {x : α}
  (h : cau_seq.const abs x ≤ f) : x ≤ lim f :=
cau_seq.const_le.1 $ cau_seq.le_of_le_of_eq h (equiv_lim f)

lemma lt_lim {f : cau_seq α abs} {x : α}
  (h : cau_seq.const abs x < f) : x < lim f :=
cau_seq.const_lt.1 $ cau_seq.lt_of_lt_of_eq h (equiv_lim f)

lemma lim_lt {f : cau_seq α abs} {x : α}
  (h : f < cau_seq.const abs x) : lim f < x :=
cau_seq.const_lt.1 $ cau_seq.lt_of_eq_of_lt (setoid.symm (equiv_lim f)) h

end
end cau_seq