import tactic.induction
import data.int.basic
import data.set.basic

import .base .point

noncomputable theory
open_locale classical

-----

lemma dist_self {a : Point} : dist a a = 0 :=
begin
  change int.to_nat _ = 0,
  simp_rw [sub_self, abs_zero, max_self], refl,
end

lemma eq_zero_left_of_max_eq_zero {a b : ℤ}
  (h : (max (|a|) (|b|)).to_nat = 0) : a = 0 :=
begin
  by_contra h₁,
  replace h₁ := lt_max_of_lt_left (abs_pos.mpr h₁),
  replace h₁ : int.to_nat 0 < (max (|a|) (|b|)).to_nat,
  { rw int.to_nat_lt_to_nat; assumption },
  rw h at h₁, cases h₁,
end

lemma eq_zero_right_of_max_eq_zero {a b : ℤ}
  (h : (max (|a|) (|b|)).to_nat = 0) : b = 0 :=
by { rw max_comm at h, exact eq_zero_left_of_max_eq_zero h }

lemma eq_zero_of_max_eq_zero {a b : ℤ}
  (h : (max (|a|) (|b|)).to_nat = 0) : a = 0 ∧ b = 0 :=
⟨eq_zero_left_of_max_eq_zero h, eq_zero_right_of_max_eq_zero h⟩

lemma dist_eq_zero_iff {a b : Point} : dist a b = 0 ↔ a = b :=
begin
  split; intro h,
  { obtain ⟨h₁, h₂⟩ := eq_zero_of_max_eq_zero h,
    rw sub_eq_zero at h₁ h₂, ext; assumption },
  { subst h, exact dist_self },
end

lemma dist_coe_int {a b : Point} :
  (dist a b : ℤ) = max (|a.x - b.x|) (|a.y - b.y|) :=
begin
  rw [dist, int.to_nat_eq_max, max_def, if_pos],
  rw max_def, split_ifs; apply abs_nonneg,
end

lemma triangle_aux {a b x y : ℤ} :
  |a + b| ≤ max (|a|) x + max (|b|) y :=
begin
  calc |a + b| ≤ |a| + |b| : abs_add _ _
  ... ≤ max (|a|) x + |b| : add_le_add_right (le_max_left _ _) _
  ... ≤ max (|a|) x + max (|b|) y : add_le_add_left (le_max_left _ _) _
end

lemma dist_triangle {a b c : Point} :
  dist a c ≤ dist a b + dist b c :=
begin
  zify, simp_rw [dist_coe_int, max_le_iff], split,
  { have h := @triangle_aux (a.x - b.x) (b.x - c.x) (|a.y - b.y|) (|b.y - c.y|),
    simp at h, exact h },
  { have h := @triangle_aux (a.y - b.y) (b.y - c.y) (|a.x - b.x|) (|b.x - c.x|),
    simp [max_comm] at h, exact h },
end

lemma dist_comm {a b : Point} : dist a b = dist b a :=
by { simp_rw dist, congr' 2; apply abs_sub_comm }

lemma dist_le_iff_zify {a b : Point} {d : ℕ} :
  dist a b ≤ d ↔ max (|a.x - b.x|) (|a.y - b.y|) ≤ d :=
by { simp [dist] }

lemma dist_le_iff {a b : Point} {d : ℕ} :
  dist a b ≤ d ↔ |a.x - b.x| ≤ d ∧ |a.y - b.y| ≤ d :=
by simp [dist_le_iff_zify]

lemma dist_le_set_finite {c : Point} {d : ℕ} :
  {p : Point | dist p c ≤ d}.finite :=
begin
  simp_rw dist_le_iff, apply set_finite_of_set_equiv_finite Point_equiv_prod.symm,
  convert_to {p : ℤ × ℤ | (|p.1 - c.x|) ≤ d ∧ (|p.2 - c.y|) ≤ d}.finite,
  { rw set.ext_iff, intro p, change _ ∧ _ ↔ _ ∧ _, rw iff_iff_eq,
    congr; rw Point_equiv_symm_apply },
  apply @set.finite.prod ℤ ℤ {x : ℤ | |x - c.x| ≤ ↑d} {y : ℤ | |y - c.y| ≤ ↑d};
  exact abs_sub_le_finite,
end


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module data.int.order.basic
! leanprover-community/mathlib commit 728baa2f54e6062c5879a3e397ac6bac323e506f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/

import Mathlib.Data.Int.Basic
import Mathlib.Algebra.Ring.Divisibility
import Mathlib.Algebra.Order.Group.Abs
import Mathlib.Algebra.Order.Ring.CharZero

/-!
# Order instances on the integers

This file contains:
* instances on `ℤ`. The stronger one is `Int.linearOrderedCommRing`.
* basic lemmas about integers that involve order properties.

## Recursors

* `Int.rec`: Sign disjunction. Something is true/defined on `ℤ` if it's true/defined for nonnegative
  and for negative values. (Defined in core Lean 3)
* `Int.inductionOn`: Simple growing induction on positive numbers, plus simple decreasing induction
  on negative numbers. Note that this recursor is currently only `Prop`-valued.
* `Int.inductionOn'`: Simple growing induction for numbers greater than `b`, plus simple decreasing
  induction on numbers less than `b`.
-/

open Nat

namespace Int

instance linearOrderedCommRing : LinearOrderedCommRing ℤ :=
  { instCommRingInt, instLinearOrderInt, instNontrivialInt with
    add_le_add_left := @Int.add_le_add_left,
    mul_pos := @Int.mul_pos, zero_le_one := le_of_lt Int.zero_lt_one }

/-! ### Extra instances to short-circuit type class resolution
-/

instance orderedCommRing : OrderedCommRing ℤ :=
  StrictOrderedCommRing.toOrderedCommRing'

instance orderedRing : OrderedRing ℤ :=
  StrictOrderedRing.toOrderedRing'

instance linearOrderedAddCommGroup : LinearOrderedAddCommGroup ℤ := by infer_instance

end Int

namespace Int

theorem abs_eq_natAbs : ∀ a : ℤ, |a| = natAbs a
  | (n : ℕ) => abs_of_nonneg <| ofNat_zero_le _
  | -[_+1] => abs_of_nonpos <| le_of_lt <| negSucc_lt_zero _
#align int.abs_eq_nat_abs Int.abs_eq_natAbs

@[simp, norm_cast] lemma coe_natAbs (n : ℤ) : (n.natAbs : ℤ) = |n| := n.abs_eq_natAbs.symm
#align int.coe_nat_abs Int.coe_natAbs

lemma _root_.Nat.cast_natAbs {α : Type _} [AddGroupWithOne α] (n : ℤ) : (n.natAbs : α) = |n| :=
by rw [←coe_natAbs, Int.cast_ofNat]
#align nat.cast_nat_abs Nat.cast_natAbs

theorem natAbs_abs (a : ℤ) : natAbs (|a|) = natAbs a := by rw [abs_eq_natAbs] ; rfl
#align int.nat_abs_abs Int.natAbs_abs

theorem sign_mul_abs (a : ℤ) : sign a * |a| = a := by
  rw [abs_eq_natAbs, sign_mul_natAbs a]
#align int.sign_mul_abs Int.sign_mul_abs

theorem coe_nat_eq_zero {n : ℕ} : (n : ℤ) = 0 ↔ n = 0 :=
  Nat.cast_eq_zero
#align int.coe_nat_eq_zero Int.coe_nat_eq_zero

theorem coe_nat_ne_zero {n : ℕ} : (n : ℤ) ≠ 0 ↔ n ≠ 0 := by simp
#align int.coe_nat_ne_zero Int.coe_nat_ne_zero

theorem coe_nat_ne_zero_iff_pos {n : ℕ} : (n : ℤ) ≠ 0 ↔ 0 < n :=
  ⟨fun h => Nat.pos_of_ne_zero (coe_nat_ne_zero.1 h),
   fun h => (_root_.ne_of_lt (ofNat_lt.2 h)).symm⟩
#align int.coe_nat_ne_zero_iff_pos Int.coe_nat_ne_zero_iff_pos

@[norm_cast] lemma abs_coe_nat (n : ℕ) : |(n : ℤ)| = n := abs_of_nonneg (coe_nat_nonneg n)
#align int.abs_coe_nat Int.abs_coe_nat

theorem sign_add_eq_of_sign_eq : ∀ {m n : ℤ}, m.sign = n.sign → (m + n).sign = n.sign := by
  have : (1 : ℤ) ≠ -1 := by decide
  rintro ((_ | m) | m) ((_ | n) | n) <;> simp [this, this.symm]
  rw [Int.sign_eq_one_iff_pos]
  apply Int.add_pos <;> · exact zero_lt_one.trans_le (le_add_of_nonneg_left <| coe_nat_nonneg _)
#align int.sign_add_eq_of_sign_eq Int.sign_add_eq_of_sign_eq

/-! ### succ and pred -/

theorem lt_succ_self (a : ℤ) : a < succ a :=
  lt_add_of_pos_right _ zero_lt_one
#align int.lt_succ_self Int.lt_succ_self

theorem pred_self_lt (a : ℤ) : pred a < a :=
  sub_lt_self _ zero_lt_one
#align int.pred_self_lt Int.pred_self_lt

#align int.lt_add_one_iff Int.lt_add_one_iff
#align int.le_add_one Int.le_add_one

theorem sub_one_lt_iff {a b : ℤ} : a - 1 < b ↔ a ≤ b :=
  sub_lt_iff_lt_add.trans lt_add_one_iff
#align int.sub_one_lt_iff Int.sub_one_lt_iff

theorem le_sub_one_iff {a b : ℤ} : a ≤ b - 1 ↔ a < b :=
  le_sub_iff_add_le
#align int.le_sub_one_iff Int.le_sub_one_iff

@[simp]
theorem abs_lt_one_iff {a : ℤ} : |a| < 1 ↔ a = 0 :=
  ⟨fun a0 => by
    let ⟨hn, hp⟩ := abs_lt.mp a0
    rw [←zero_add 1, lt_add_one_iff] at hp
    -- Defeq abuse: `hn : -1 < a` but should be `hn : 0 λ a`.
    exact hp.antisymm hn,
    fun a0 => (abs_eq_zero.mpr a0).le.trans_lt zero_lt_one⟩
#align int.abs_lt_one_iff Int.abs_lt_one_iff

theorem abs_le_one_iff {a : ℤ} : |a| ≤ 1 ↔ a = 0 ∨ a = 1 ∨ a = -1 := by
  rw [le_iff_lt_or_eq, abs_lt_one_iff, abs_eq (zero_le_one' ℤ)]
#align int.abs_le_one_iff Int.abs_le_one_iff

theorem one_le_abs {z : ℤ} (h₀ : z ≠ 0) : 1 ≤ |z| :=
  add_one_le_iff.mpr (abs_pos.mpr h₀)
#align int.one_le_abs Int.one_le_abs

/-- Inductively define a function on `ℤ` by defining it at `b`, for the `succ` of a number greater
than `b`, and the `pred` of a number less than `b`. -/
@[elab_as_elim] protected def inductionOn' {C : ℤ → Sort _}
    (z : ℤ) (b : ℤ) (H0 : C b) (Hs : ∀ k, b ≤ k → C k → C (k + 1))
    (Hp : ∀ k ≤ b, C k → C (k - 1)) : C z := by
  rw [← sub_add_cancel (G := ℤ) z b, add_comm]
  exact match z - b with
  | .ofNat n => pos n
  | .negSucc n => neg n
where
  /-- The positive case of `Int.inductionOn'`. -/
  pos : ∀ n : ℕ, C (b + n)
  | 0 => _root_.cast (by erw [add_zero]) H0
  | n+1 => _root_.cast (by rw [add_assoc]; rfl) <|
    Hs _ (Int.le_add_of_nonneg_right (ofNat_nonneg _)) (pos n)

  /-- The negative case of `Int.inductionOn'`. -/
  neg : ∀ n : ℕ, C (b + -[n+1])
  | 0 => Hp _ (Int.le_refl _) H0
  | n+1 => by
    refine _root_.cast (by rw [add_sub_assoc]; rfl) (Hp _ (Int.le_of_lt ?_) (neg n))
    conv => rhs; apply (add_zero b).symm
    rw [Int.add_lt_add_iff_left]; apply negSucc_lt_zero
#align int.induction_on' Int.inductionOn'

/-- See `Int.inductionOn'` for an induction in both directions. -/
protected theorem le_induction {P : ℤ → Prop} {m : ℤ} (h0 : P m)
    (h1 : ∀ n : ℤ, m ≤ n → P n → P (n + 1)) (n : ℤ) : m ≤ n → P n := by
  refine Int.inductionOn' n m ?_ ?_ ?_
  · intro
    exact h0
  · intro k hle hi _
    exact h1 k hle (hi hle)
  · intro k hle _ hle'
    exfalso
    exact lt_irrefl k (le_sub_one_iff.mp (hle.trans hle'))
#align int.le_induction Int.le_induction

/-- See `Int.inductionOn'` for an induction in both directions. -/
protected theorem le_induction_down {P : ℤ → Prop} {m : ℤ} (h0 : P m)
    (h1 : ∀ n : ℤ, n ≤ m → P n → P (n - 1)) (n : ℤ) : n ≤ m → P n := by
  refine Int.inductionOn' n m ?_ ?_ ?_
  · intro
    exact h0
  · intro k hle _ hle'
    exfalso
    exact lt_irrefl k (add_one_le_iff.mp (hle'.trans hle))
  · intro k hle hi _
    exact h1 k hle (hi hle)
#align int.le_induction_down Int.le_induction_down

/-! ### nat abs -/

variable {a b : ℤ} {n : ℕ}

attribute [simp] natAbs_ofNat natAbs_zero natAbs_one

#align int.nat_abs_dvd_iff_dvd Int.natAbs_dvd_natAbs

/-! ### `/`  -/

#align int.div_nonpos Int.ediv_nonpos

theorem ediv_eq_zero_of_lt_abs {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < |b|) : a / b = 0 :=
  match b, |b|, abs_eq_natAbs b, H2 with
  | (n : ℕ), _, rfl, H2 => ediv_eq_zero_of_lt H1 H2
  | -[n+1], _, rfl, H2 => neg_injective <| by rw [← Int.ediv_neg]; exact ediv_eq_zero_of_lt H1 H2
#align int.div_eq_zero_of_lt_abs Int.ediv_eq_zero_of_lt_abs

#align int.add_mul_div_right Int.add_mul_ediv_right

#align int.add_mul_div_left Int.add_mul_ediv_left

#align int.mul_div_cancel Int.mul_ediv_cancel

#align int.mul_div_cancel_left Int.mul_ediv_cancel_left

#align int.div_self Int.ediv_self

attribute [local simp] Int.zero_ediv Int.ediv_zero

#align int.add_div_of_dvd_right Int.add_ediv_of_dvd_right

#align int.add_div_of_dvd_left Int.add_ediv_of_dvd_left

/-! ### mod -/

@[simp]
theorem emod_abs (a b : ℤ) : a % |b| = a % b :=
  abs_by_cases (fun i => a % i = a % b) rfl (emod_neg _ _)
#align int.mod_abs Int.emod_abs

#align int.mod_nonneg Int.emod_nonneg

#align int.mod_lt_of_pos Int.emod_lt_of_pos

theorem emod_lt (a : ℤ) {b : ℤ} (H : b ≠ 0) : a % b < |b| := by
  rw [← emod_abs]; exact emod_lt_of_pos _ (abs_pos.2 H)
#align int.mod_lt Int.emod_lt

#align int.add_mul_mod_self Int.add_mul_emod_self

#align int.add_mul_mod_self_left Int.add_mul_emod_self_left

#align int.add_mod_self Int.add_emod_self

#align int.add_mod_self_left Int.add_emod_self_left

#align int.mod_add_mod Int.emod_add_emod

#align int.add_mod_mod Int.add_emod_emod

#align int.add_mod Int.add_emod

theorem add_emod_eq_add_mod_right {m n k : ℤ} (i : ℤ) (H : m % n = k % n) :
    (m + i) % n = (k + i) % n := by rw [← emod_add_emod, ← emod_add_emod k, H]
#align int.add_mod_eq_add_mod_right Int.add_emod_eq_add_emod_right

#align int.add_mod_eq_add_mod_left Int.add_emod_eq_add_emod_left

#align int.mod_add_cancel_right Int.emod_add_cancel_right

#align int.mod_add_cancel_left Int.emod_add_cancel_left

#align int.mod_sub_cancel_right Int.emod_sub_cancel_right

#align int.mul_mod_left Int.mul_emod_left

#align int.mul_mod_right Int.mul_emod_right

#align int.mul_mod Int.mul_emod

#align int.mod_self Int.emod_self

#align int.mod_mod_of_dvd Int.emod_emod_of_dvd

#align int.mod_mod Int.emod_emod

#align int.sub_mod Int.sub_emod

-- porting note: this should be a doc comment, but the lemma isn't here any more!
/- See also `Int.divModEquiv` for a similar statement as an `Equiv`. -/
#align int.div_mod_unique Int.ediv_emod_unique

attribute [local simp] Int.zero_emod

#align int.mod_eq_mod_iff_mod_sub_eq_zero Int.emod_eq_emod_iff_emod_sub_eq_zero

@[simp]
theorem neg_emod_two (i : ℤ) : -i % 2 = i % 2 := by
  apply Int.emod_eq_emod_iff_emod_sub_eq_zero.mpr
  convert Int.mul_emod_right 2 (-i) using 2
  rw [two_mul, sub_eq_add_neg]
#align int.neg_mod_two Int.neg_emod_two

/-! ### properties of `/` and `%` -/

#align int.lt_div_add_one_mul_self Int.lt_ediv_add_one_mul_self

theorem abs_ediv_le_abs : ∀ a b : ℤ, |a / b| ≤ |a| :=
  suffices ∀ (a : ℤ) (n : ℕ), |a / n| ≤ |a| from fun a b =>
    match b, eq_nat_or_neg b with
    | _, ⟨n, Or.inl rfl⟩ => this _ _
    | _, ⟨n, Or.inr rfl⟩ => by rw [Int.ediv_neg, abs_neg]; apply this
  fun a n => by
  rw [abs_eq_natAbs, abs_eq_natAbs];
    exact
      ofNat_le_ofNat_of_le
        (match a, n with
        | (m : ℕ), n => Nat.div_le_self _ _
        | -[m+1], 0 => Nat.zero_le _
        | -[m+1], n + 1 => Nat.succ_le_succ (Nat.div_le_self _ _))
#align int.abs_div_le_abs Int.abs_ediv_le_abs

#align int.div_le_self Int.ediv_le_self

theorem emod_two_eq_zero_or_one (n : ℤ) : n % 2 = 0 ∨ n % 2 = 1 :=
  have h : n % 2 < 2 := abs_of_nonneg (show 0 ≤ (2 : ℤ) by decide) ▸ Int.emod_lt _ (by decide)
  have h₁ : 0 ≤ n % 2 := Int.emod_nonneg _ (by decide)
  match n % 2, h, h₁ with
  | (0 : ℕ), _ ,_ => Or.inl rfl
  | (1 : ℕ), _ ,_ => Or.inr rfl
  -- Porting note: this used to be `=> absurd h (by decide)`
  -- see https://github.com/leanprover-community/mathlib4/issues/994
  | (k + 2 : ℕ), h₁, _ => False.elim (h₁.not_le (by
    rw [Nat.cast_add]
    exact (le_add_iff_nonneg_left 2).2 (NonNeg.mk k)))
  -- Porting note: this used to be `=> absurd h₁ (by decide)`
  | -[a+1], _, h₁ => by cases h₁
#align int.mod_two_eq_zero_or_one Int.emod_two_eq_zero_or_one

/-! ### dvd -/

#align int.dvd_of_mod_eq_zero Int.dvd_of_emod_eq_zero

#align int.mod_eq_zero_of_dvd Int.emod_eq_zero_of_dvd

#align int.dvd_iff_mod_eq_zero Int.dvd_iff_emod_eq_zero

#align int.dvd_sub_of_mod_eq Int.dvd_sub_of_emod_eq

#align int.nat_abs_dvd Int.natAbs_dvd

#align int.dvd_nat_abs Int.dvd_natAbs

#align int.decidable_dvd Int.decidableDvd

#align int.div_mul_cancel Int.ediv_mul_cancel

#align int.mul_div_cancel' Int.mul_ediv_cancel'

theorem ediv_dvd_ediv : ∀ {a b c : ℤ} (_ : a ∣ b) (_ : b ∣ c), b / a ∣ c / a
  | a, _, _, ⟨b, rfl⟩, ⟨c, rfl⟩ =>
    if az : a = 0 then by simp [az]
    else by
      rw [Int.mul_ediv_cancel_left _ az, mul_assoc, Int.mul_ediv_cancel_left _ az];
        apply dvd_mul_right
#align int.div_dvd_div Int.ediv_dvd_ediv

#align int.eq_mul_of_div_eq_right Int.eq_mul_of_ediv_eq_right

#align int.div_eq_of_eq_mul_right Int.ediv_eq_of_eq_mul_right

#align int.eq_div_of_mul_eq_right Int.eq_ediv_of_mul_eq_right

#align int.div_eq_iff_eq_mul_right Int.ediv_eq_iff_eq_mul_right

#align int.div_eq_iff_eq_mul_left Int.ediv_eq_iff_eq_mul_left

#align int.eq_mul_of_div_eq_left Int.eq_mul_of_ediv_eq_left

#align int.div_eq_of_eq_mul_left Int.ediv_eq_of_eq_mul_left

#align int.eq_zero_of_div_eq_zero Int.eq_zero_of_ediv_eq_zero

#align int.div_left_inj Int.ediv_left_inj

theorem abs_sign_of_nonzero {z : ℤ} (hz : z ≠ 0) : |z.sign| = 1 := by
  rw [abs_eq_natAbs, natAbs_sign_of_nonzero hz, Int.ofNat_one]
#align int.abs_sign_of_nonzero Int.abs_sign_of_nonzero

/-- If `n > 0` then `m` is not divisible by `n` iff it is between `n * k` and `n * (k + 1)`
  for some `k`. -/
theorem exists_lt_and_lt_iff_not_dvd (m : ℤ) {n : ℤ} (hn : 0 < n) :
    (∃ k, n * k < m ∧ m < n * (k + 1)) ↔ ¬n ∣ m := by
  constructor
  · rintro ⟨k, h1k, h2k⟩ ⟨l, rfl⟩
    rw [mul_lt_mul_left hn] at h1k h2k
    rw [lt_add_one_iff, ← not_lt] at h2k
    exact h2k h1k
  · intro h
    rw [dvd_iff_emod_eq_zero, ← Ne.def] at h
    have := (emod_nonneg m hn.ne.symm).lt_of_ne h.symm
    simp (config := { singlePass := true }) only [← emod_add_ediv m n]
    refine' ⟨m / n, lt_add_of_pos_left _ this, _⟩
    rw [add_comm _ (1 : ℤ), left_distrib, mul_one]
    exact add_lt_add_right (emod_lt_of_pos _ hn) _
#align int.exists_lt_and_lt_iff_not_dvd Int.exists_lt_and_lt_iff_not_dvd

attribute [local simp] Int.ediv_zero

#align int.mul_div_assoc Int.mul_ediv_assoc

#align int.mul_div_assoc' Int.mul_ediv_assoc'

#align int.neg_div_of_dvd Int.neg_ediv_of_dvd

#align int.sub_div_of_dvd Int.sub_ediv_of_dvd

#align int.sub_div_of_dvd_sub Int.sub_ediv_of_dvd_sub

protected theorem sign_eq_ediv_abs (a : ℤ) : sign a = a / |a| :=
  if az : a = 0 then by simp [az]
  else (Int.ediv_eq_of_eq_mul_left (mt abs_eq_zero.1 az) (sign_mul_abs _).symm).symm
#align int.sign_eq_div_abs Int.sign_eq_ediv_abs

/-! ### `/` and ordering -/

protected theorem ediv_mul_le (a : ℤ) {b : ℤ} (H : b ≠ 0) : a / b * b ≤ a :=
  le_of_sub_nonneg <| by rw [mul_comm, ← emod_def]; apply emod_nonneg _ H
#align int.div_mul_le Int.ediv_mul_le

protected theorem ediv_le_of_le_mul {a b c : ℤ} (H : 0 < c) (H' : a ≤ b * c) : a / c ≤ b :=
  le_of_mul_le_mul_right (le_trans (Int.ediv_mul_le _ (ne_of_gt H)) H') H
#align int.div_le_of_le_mul Int.ediv_le_of_le_mul

protected theorem mul_lt_of_lt_ediv {a b c : ℤ} (H : 0 < c) (H3 : a < b / c) : a * c < b :=
  lt_of_not_ge <| mt (Int.ediv_le_of_le_mul H) (not_le_of_gt H3)
#align int.mul_lt_of_lt_div Int.mul_lt_of_lt_ediv

protected theorem mul_le_of_le_ediv {a b c : ℤ} (H1 : 0 < c) (H2 : a ≤ b / c) : a * c ≤ b :=
  le_trans (mul_le_mul_of_nonneg_right H2 (le_of_lt H1)) (Int.ediv_mul_le _ (ne_of_gt H1))
#align int.mul_le_of_le_div Int.mul_le_of_le_ediv

protected

protected theorem le_ediv_iff_mul_le {a b c : ℤ} (H : 0 < c) : a ≤ b / c ↔ a * c ≤ b :=
  ⟨Int.mul_le_of_le_ediv H, Int.le_ediv_of_mul_le H⟩
#align int.le_div_iff_mul_le Int.le_ediv_iff_mul_le

protected theorem ediv_le_ediv {a b c : ℤ} (H : 0 < c) (H' : a ≤ b) : a / c ≤ b / c :=
  Int.le_ediv_of_mul_le H (le_trans (Int.ediv_mul_le _ (ne_of_gt H)) H')
#align int.div_le_div Int.ediv_le_ediv

protected theorem ediv_lt_of_lt_mul {a b c : ℤ} (H : 0 < c) (H' : a < b * c) : a / c < b :=
  lt_of_not_ge <| mt (Int.mul_le_of_le_ediv H) (not_le_of_gt H')
#align int.div_lt_of_lt_mul Int.ediv_lt_of_lt_mul

protected theorem lt_mul_of_ediv_lt {a b c : ℤ} (H1 : 0 < c) (H2 : a / c < b) : a < b * c :=
  lt_of_not_ge <| mt (Int.le_ediv_of_mul_le H1) (not_le_of_gt H2)
#align int.lt_mul_of_div_lt Int.lt_mul_of_ediv_lt

protected theorem ediv_lt_iff_lt_mul {a b c : ℤ} (H : 0 < c) : a / c < b ↔ a < b * c :=
  ⟨Int.lt_mul_of_ediv_lt H, Int.ediv_lt_of_lt_mul H⟩
#align int.div_lt_iff_lt_mul Int.ediv_lt_iff_lt_mul

protected theorem le_mul_of_ediv_le {a b c : ℤ} (H1 : 0 ≤ b) (H2 : b ∣ a) (H3 : a / b ≤ c) :
    a ≤ c * b := by rw [← Int.ediv_mul_cancel H2]; exact mul_le_mul_of_nonneg_right H3 H1
#align int.le_mul_of_div_le Int.le_mul_of_ediv_le

protected theorem lt_ediv_of_mul_lt {a b c : ℤ} (H1 : 0 ≤ b) (H2 : b ∣ c) (H3 : a * b < c) :
    a < c / b :=
  lt_of_not_ge <| mt (Int.le_mul_of_ediv_le H1 H2) (not_le_of_gt H3)
#align int.lt_div_of_mul_lt Int.lt_ediv_of_mul_lt

protected theorem lt_ediv_iff_mul_lt {a b : ℤ} (c : ℤ) (H : 0 < c) (H' : c ∣ b) :
    a < b / c ↔ a * c < b :=
  ⟨Int.mul_lt_of_lt_ediv H, Int.lt_ediv_of_mul_lt (le_of_lt H) H'⟩
#align int.lt_div_iff_mul_lt Int.lt_ediv_iff_mul_lt

theorem ediv_pos_of_pos_of_dvd {a b : ℤ} (H1 : 0 < a) (H2 : 0 ≤ b) (H3 : b ∣ a) : 0 < a / b :=
  Int.lt_ediv_of_mul_lt H2 H3 (by rwa [zero_mul])
#align int.div_pos_of_pos_of_dvd Int.ediv_pos_of_pos_of_dvd

theorem natAbs_eq_of_dvd_dvd {s t : ℤ} (hst : s ∣ t) (hts : t ∣ s) : natAbs s = natAbs t :=
  Nat.dvd_antisymm (natAbs_dvd_natAbs.mpr hst) (natAbs_dvd_natAbs.mpr hts)
#align int.nat_abs_eq_of_dvd_dvd Int.natAbs_eq_of_dvd_dvd

theorem ediv_eq_ediv_of_mul_eq_mul {a b c d : ℤ} (H2 : d ∣ c) (H3 : b ≠ 0) (H4 : d ≠ 0)
    (H5 : a * d = b * c) : a / b = c / d :=
  Int.ediv_eq_of_eq_mul_right H3 <| by
    rw [← Int.mul_ediv_assoc _ H2]; exact (Int.ediv_eq_of_eq_mul_left H4 H5.symm).symm
#align int.div_eq_div_of_mul_eq_mul Int.ediv_eq_ediv_of_mul_eq_mul

theorem ediv_dvd_of_dvd {s t : ℤ} (hst : s ∣ t) : t / s ∣ t := by
  rcases eq_or_ne s 0 with (rfl | hs)
  · simpa using hst
  rcases hst with ⟨c, hc⟩
  simp [hc, Int.mul_ediv_cancel_left _ hs]
#align int.div_dvd_of_dvd Int.ediv_dvd_of_dvd

/-! ### toNat -/

@[simp]
theorem toNat_le {a : ℤ} {n : ℕ} : toNat a ≤ n ↔ a ≤ n := by
  rw [ofNat_le.symm, toNat_eq_max, max_le_iff]; exact and_iff_left (ofNat_zero_le _)
#align int.to_nat_le Int.toNat_le

@[simp]
theorem lt_toNat {n : ℕ} {a : ℤ} : n < toNat a ↔ (n : ℤ) < a :=
  le_iff_le_iff_lt_iff_lt.1 toNat_le
#align int.lt_to_nat Int.lt_toNat

@[simp]
theorem coe_nat_nonpos_iff {n : ℕ} : (n : ℤ) ≤ 0 ↔ n = 0 :=
  ⟨fun h => le_antisymm (Int.ofNat_le.mp (h.trans Int.ofNat_zero.le)) n.zero_le,
   fun h => (coe_nat_eq_zero.mpr h).le⟩
#align int.coe_nat_nonpos_iff Int.coe_nat_nonpos_iff

theorem toNat_le_toNat {a b : ℤ} (h : a ≤ b) : toNat a ≤ toNat b := by
  rw [toNat_le]; exact le_trans h (self_le_toNat b)
#align int.to_nat_le_to_nat Int.toNat_le_toNat

theorem toNat_lt_toNat {a b : ℤ} (hb : 0 < b) : toNat a < toNat b ↔ a < b :=
  ⟨fun h => by cases a; exact lt_toNat.1 h; exact lt_trans (neg_of_sign_eq_neg_one rfl) hb,
   fun h => by rw [lt_toNat]; cases a; exact h; exact hb⟩
#align int.to_nat_lt_to_nat Int.toNat_lt_toNat

theorem lt_of_toNat_lt {a b : ℤ} (h : toNat a < toNat b) : a < b :=
  (toNat_lt_toNat <| lt_toNat.1 <| lt_of_le_of_lt (Nat.zero_le _) h).1 h
#align int.lt_of_to_nat_lt Int.lt_of_toNat_lt

@[simp]
theorem toNat_pred_coe_of_pos {i : ℤ} (h : 0 < i) : ((i.toNat - 1 : ℕ) : ℤ) = i - 1 := by
  simp [h, le_of_lt h, push_cast]
#align int.to_nat_pred_coe_of_pos Int.toNat_pred_coe_of_pos

@[simp]
theorem toNat_eq_zero : ∀ {n : ℤ}, n.toNat = 0 ↔ n ≤ 0
  | (n : ℕ) =>
    calc
      _ ↔ n = 0 := ⟨(toNat_coe_nat n).symm.trans, (toNat_coe_nat n).trans⟩
      _ ↔ _ := coe_nat_nonpos_iff.symm

  | -[n+1] =>
    show (-((n : ℤ) + 1)).toNat = 0 ↔ (-(n + 1) : ℤ) ≤ 0 from
      calc
        _ ↔ True := ⟨fun _ => trivial, fun _ => toNat_neg_nat _⟩
        _ ↔ _ := ⟨fun _ => neg_nonpos_of_nonneg (ofNat_zero_le _), fun _ => trivial⟩

#align int.to_nat_eq_zero Int.toNat_eq_zero

@[simp]
theorem toNat_sub_of_le {a b : ℤ} (h : b ≤ a) : (toNat (a - b) : ℤ) = a - b :=
  Int.toNat_of_nonneg (sub_nonneg_of_le h)
#align int.to_nat_sub_of_le Int.toNat_sub_of_le

end Int

-- Porting note assert_not_exists not ported yet.
-- We should need only a minimal development of sets in order to get here.
-- assert_not_exists set.range


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import order.conditionally_complete_lattice
import data.int.least_greatest

/-!
## `ℤ` forms a conditionally complete linear order

The integers form a conditionally complete linear order.
-/

open int
open_locale classical
noncomputable theory

instance : conditionally_complete_linear_order ℤ :=
{ Sup := λ s, if h : s.nonempty ∧ bdd_above s then
    greatest_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0,
  Inf := λ s, if h : s.nonempty ∧ bdd_below s then
    least_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0,
  le_cSup := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_above s := ⟨⟨n, hns⟩, hs⟩,
    rw [dif_pos this],
    exact (greatest_of_bdd _ _ _).2.2 n hns
  end,
  cSup_le := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_above s := ⟨hs, ⟨n, hns⟩⟩,
    rw [dif_pos this],
    exact hns (greatest_of_bdd _ (classical.some_spec this.2) _).2.1
  end,
  cInf_le := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_below s := ⟨⟨n, hns⟩, hs⟩,
    rw [dif_pos this],
    exact (least_of_bdd _ _ _).2.2 n hns
  end,
  le_cInf := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_below s := ⟨hs, ⟨n, hns⟩⟩,
    rw [dif_pos this],
    exact hns (least_of_bdd _ (classical.some_spec this.2) _).2.1
  end,
  .. int.linear_order, ..lattice_of_linear_order }

namespace int

lemma cSup_eq_greatest_of_bdd {s : set ℤ} [decidable_pred (∈ s)]
  (b : ℤ) (Hb : ∀ z ∈ s, z ≤ b) (Hinh : ∃ z : ℤ, z ∈ s) :
  Sup s = greatest_of_bdd b Hb Hinh :=
begin
  convert dif_pos _ using 1,
  { convert coe_greatest_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_above s)) _ },
  { exact ⟨Hinh, b, Hb⟩, }
end

@[simp]
lemma cSup_empty : Sup (∅ : set ℤ) = 0 := dif_neg (by simp)

lemma cSup_of_not_bdd_above {s : set ℤ} (h : ¬ bdd_above s) : Sup s = 0 := dif_neg (by simp [h])

lemma cInf_eq_least_of_bdd {s : set ℤ} [decidable_pred (∈ s)]
  (b : ℤ) (Hb : ∀ z ∈ s, b ≤ z) (Hinh : ∃ z : ℤ, z ∈ s) :
  Inf s = least_of_bdd b Hb Hinh :=
begin
  convert dif_pos _ using 1,
  { convert coe_least_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_below s)) _ },
  { exact ⟨Hinh, b, Hb⟩, }
end

@[simp]
lemma cInf_empty : Inf (∅ : set ℤ) = 0 := dif_neg (by simp)

lemma cInf_of_not_bdd_below {s : set ℤ} (h : ¬ bdd_below s) : Inf s = 0 := dif_neg (by simp [h])

lemma cSup_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_above s) : Sup s ∈ s :=
begin
  convert (greatest_of_bdd _ (classical.some_spec h2) h1).2.1,
  exact dif_pos ⟨h1, h2⟩,
end

lemma cInf_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_below s) : Inf s ∈ s :=
begin
  convert (least_of_bdd _ (classical.some_spec h2) h1).2.1,
  exact dif_pos ⟨h1, h2⟩,
end

end int


/-
Copyright (c) 2021 Scott Morrison All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module algebra.category.Module.epi_mono
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Quotient
import Mathbin.Algebra.Category.Module.Basic

/-!
# Monomorphisms in `Module R`

This file shows that an `R`-linear map is a monomorphism in the category of `R`-modules
if and only if it is injective, and similarly an epimorphism if and only if it is surjective.
-/

universe v u

open CategoryTheory

open ModuleCat

open ModuleCat

namespace ModuleCat

variable {R : Type u} [Ring R] {X Y : ModuleCat.{v} R} (f : X ⟶ Y)

variable {M : Type v} [AddCommGroup M] [Module R M]

theorem ker_eq_bot_of_mono [Mono f] : f.ker = ⊥ :=
  LinearMap.ker_eq_bot_of_cancel fun u v => (@cancel_mono _ _ _ _ _ f _ (↟u) (↟v)).1
#align Module.ker_eq_bot_of_mono ModuleCat.ker_eq_bot_of_mono

theorem range_eq_top_of_epi [Epi f] : f.range = ⊤ :=
  LinearMap.range_eq_top_of_cancel fun u v => (@cancel_epi _ _ _ _ _ f _ (↟u) (↟v)).1
#align Module.range_eq_top_of_epi ModuleCat.range_eq_top_of_epi

theorem mono_iff_ker_eq_bot : Mono f ↔ f.ker = ⊥ :=
  ⟨fun hf => ker_eq_bot_of_mono _, fun hf =>
    ConcreteCategory.mono_of_injective _ <| LinearMap.ker_eq_bot.1 hf⟩
#align Module.mono_iff_ker_eq_bot ModuleCat.mono_iff_ker_eq_bot

theorem mono_iff_injective : Mono f ↔ Function.Injective f := by
  rw [mono_iff_ker_eq_bot, LinearMap.ker_eq_bot]
#align Module.mono_iff_injective ModuleCat.mono_iff_injective

theorem epi_iff_range_eq_top : Epi f ↔ f.range = ⊤ :=
  ⟨fun hf => range_eq_top_of_epi _, fun hf =>
    ConcreteCategory.epi_of_surjective _ <| LinearMap.range_eq_top.1 hf⟩
#align Module.epi_iff_range_eq_top ModuleCat.epi_iff_range_eq_top

theorem epi_iff_surjective : Epi f ↔ Function.Surjective f := by
  rw [epi_iff_range_eq_top, LinearMap.range_eq_top]
#align Module.epi_iff_surjective ModuleCat.epi_iff_surjective

/-- If the zero morphism is an epi then the codomain is trivial. -/
def uniqueOfEpiZero (X) [h : Epi (0 : X ⟶ of R M)] : Unique M :=
  uniqueOfSurjectiveZero X ((ModuleCat.epi_iff_surjective _).mp h)
#align Module.unique_of_epi_zero ModuleCat.uniqueOfEpiZero

instance mono_as_hom'_subtype (U : Submodule R X) : Mono (↾U.Subtype) :=
  (mono_iff_ker_eq_bot _).mpr (Submodule.ker_subtype U)
#align Module.mono_as_hom'_subtype ModuleCat.mono_as_hom'_subtype

instance epi_as_hom''_mkQ (U : Submodule R X) : Epi (↿U.mkQ) :=
  (epi_iff_range_eq_top _).mpr <| Submodule.range_mkQ _
#align Module.epi_as_hom''_mkq ModuleCat.epi_as_hom''_mkQ

instance forget_preservesEpimorphisms : (forget (ModuleCat.{v} R)).PreservesEpimorphisms
    where preserves X Y f hf := by
    rwa [forget_map_eq_coe, CategoryTheory.epi_iff_surjective, ← epi_iff_surjective]
#align Module.forget_preserves_epimorphisms ModuleCat.forget_preservesEpimorphisms

instance forget_preservesMonomorphisms : (forget (ModuleCat.{v} R)).PreservesMonomorphisms
    where preserves X Y f hf := by
    rwa [forget_map_eq_coe, CategoryTheory.mono_iff_injective, ← mono_iff_injective]
#align Module.forget_preserves_monomorphisms ModuleCat.forget_preservesMonomorphisms

end ModuleCat


import lib.m154

/-
Ce fichier concerne la définition de limite d'une suite (de nombres réels).
Une suite u est une fonction de ℕ dans ℝ, Lean écrit donc u : ℕ → ℝ
-/

-- Définition de « u tend vers l »
def limite_suite (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

/-
On notera dans la définition ci-dessus l'utilisation de « ∀ ε > 0, ... »
qui est une abbréviation de « ∀ ε, ε > 0 → ... ».

En particulier un énoncé de la forme « h : ∀ ε > 0, P ε » se spécialise à
un ε₀ fixé pour lequel on a une démonstration ε₀_pos : ε₀ > 0, par la commande
« Par h appliqué à [ε₀, ε₀_pos] on obtient (hε₀ : P ε₀) »
pour obtenir une nouvelle hypothèse hε₀ affirmant P ε₀.

Le lemme demi_pos ci-dessous sera utile pour transformer une démonstration
de ε > 0 en une démonstration de ε/2 > 0 lorsque l'on spécialise un énoncé
avec ε/2 au lieu de ε.

La démonstration n'est pas très éclairante car Lean fait le travail
automatiquement, mais c'est l'occasion de rappeler que la commande
`On conclut par` accepte ce type de travail d'ajustement très direct.
-/

lemma demi_pos { ε : ℝ } : ε > 0 → ε/2 > 0 :=
begin
  Supposons hyp : ε > 0,
  On conclut par hyp,
end

-- Dans toute la suite, u, v et w sont des suites tandis que l et l' sont des
-- nombres réels
variables (u v w : ℕ → ℝ) (l l' : ℝ)

-- Si u est constante de valeur l, alors u tend vers l
example : (∀ n, u n = l) → limite_suite u l :=
begin
  sorry
end

/- Concernant les valeurs absolues, on pourra utiliser les lemmes

`abs_inferieur_ssi (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y`

`abs_plus (x y : ℝ) : |x + y| ≤ |x| + |y|`

`ineg_triangle (x y z : ℝ) : |x - y| ≤ |x - z| + |z - y|`

`abs_diff (x y : ℝ) : |x - y| = |y - x|`

Il est conseillé de noter ces lemmes sur une feuille car ils
peuvent être utiles dans chaque exercice.
-/

-- Si u tend vers l strictement positif, alors u n ≥ l/2 pour n assez grand.
example (hl : l > 0) : limite_suite u l → ∃ N, ∀ n ≥ N, u n ≥ l/2 :=
begin
  sorry
end

/- Concernant le maximum de deux nombres, on pourra utiliser les lemmes

`superieur_max_ssi (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q`

`inferieur_max_gauche p q : p ≤ max p q`

`inferieur_max_droite p q : q ≤ max p q`

Il est conseillé de noter ces lemmes sur une feuille car ils
peuvent être utiles dans chaque exercice.

Dans l'exemple suivant, notez particulièrement la façon dont
`demi_pos` est utilisé : sachant que `ε` est fixé et qu'on a une
hypothèse `ε_pos : ε > 0`, on peut former l'expression
`demi_pos ε_pos : ε/2 > 0`.

Notez aussi l'utilisation de `superieur_max_ssi` qui reviendra
très souvent, et la façon d'annoncer à l'avance des inégalités
intermédiaire avant de la combiner par `On combine`.
-/

-- Si u tend vers l et v tend vers l' alors u+v tend vers l+l'
example (hu : limite_suite u l) (hv : limite_suite v l') :
limite_suite (u + v) (l + l') :=
begin
  Soit ε > 0,
  Par hu appliqué à [ε/2, demi_pos ε_pos] on obtient N₁
      tel que hN₁ : ∀ n ≥ N₁, |u n - l| ≤ ε / 2,
  Par hv appliqué à [ε/2, demi_pos ε_pos] on obtient N₂
      tel que hN₂ : ∀ n ≥ N₂, |v n - l'| ≤ ε / 2,
  Montrons que max N₁ N₂ convient : ∀ n ≥ max N₁ N₂, |(u + v) n - (l + l')| ≤ ε,
  Soit n ≥ max N₁ N₂,
  On réécrit via superieur_max_ssi dans n_ge,
  Par n_ge on obtient (hn₁ : n ≥ N₁) (hn₂ : n ≥ N₂),
  Fait fait₁ : |u n - l| ≤ ε/2,
    On applique hN₁,
  Fait fait₂ : |v n - l'| ≤ ε/2,
    On conclut par hN₂ appliqué à [n, hn₂],  -- Notez la variante Lean par rapport à fait₁
  calc
  |(u + v) n - (l + l')| = |(u n - l) + (v n - l')| : by On calcule
                     ... ≤ |u n - l| + |v n - l'| : by On applique abs_plus
                     ... ≤  ε/2 + ε/2             : by On combine [fait₁, fait₂]
                     ... =  ε                     : by On calcule,
end

example (hu : limite_suite u l) (hw : limite_suite w l)
(h : ∀ n, u n ≤ v n)
(h' : ∀ n, v n ≤ w n) : limite_suite v l :=
begin
  sorry

end

-- La dernière inégalité dans la définition de limite peut être remplacée par
-- une inégalité stricte.
example (u l) : limite_suite u l ↔
 ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| < ε :=
begin
  sorry
end

/- Dans l'exercice suivant, on pourra utiliser le lemme

`egal_si_abs_eps (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y`
-/

-- Une suite u admet au plus une limite
example : limite_suite u l → limite_suite u l' → l = l' :=
begin
  sorry
end

-- Définition de « la suite u est croissante »
def croissante (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

-- Définition de « M est borne supérieure des termes de la suite u  »
def est_borne_sup (M : ℝ) (u : ℕ → ℝ) :=
(∀ n, u n ≤ M) ∧ ∀ ε > 0, ∃ n₀, u n₀ ≥ M - ε

-- Toute suite croissante ayant une borne supérieure tend vers cette borne
example (M : ℝ) (h : est_borne_sup M u) (h' : croissante u) :
limite_suite u M :=
begin
  sorry
end


import tactic
import data.nat.parity
import system.io

section warm_up

variables {α β : Type} (p q : α → Prop) (r : α → β → Prop)

lemma exercise_1 : (∀ x, p x) ∧ (∀ x, q x) → ∀ x, p x ∧ q x :=
begin
  intro H, intro x, refine ⟨_,_⟩,
  cases H with Hp Hq, exact Hp x,
  cases H with Hp Hq, exact Hq x
end

#check exercise_1

#check Prop

#check Type

#print and

-- blast our way to the end

example : (∀ x, p x → q x) → (∀ x, p x) → ∀ x, q x := by finish

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := by finish

example : (∃ x, p x ∧ q x) → ∃ x, p x := by finish

example : (∃ x, ∀ y, r x y) → ∀ y, ∃ x, r x y := by tidy

end warm_up

/-
We're going to solve a simplified version of the `coffee can problem`, due to David Gries' `The Science of Programming` (note: really good read).

Suppose you have a coffee can filled with finitely many white and black beans. You have an infinite supply of white and black beans outside the can.

Carry out the following procedure until there is only 1 bean left in the can:

 - Draw two beans
   - if their colors are different (i.e. (white, black) or (black, white)), then you discard the white one and return the black one.
   - if their colors are the same, discard both of them and you add a white bean to the can.

Prove that this process terminates with a single white bean iff the number of black beans is even.

We're going to solve this problem where the coffee can is a list and we only pop and push beans from the head of the list.
-/

/-
  To state this problem , we need:
     - [x] a notion of beans
     - [x] define the "coffee operation"
     - [ ] a way to count the number of white and black beans
     - [ ] a notion of evenness (I'm going to import this from mathlib).
-/

inductive beans : Type
| white : beans
| black : beans

#print beans.cases_on

open beans -- this opens the namespace `beans` so we don't have to qualify the constructors

@[simp]
def coffee : list beans → list beans
| [] := []
| [b] := [b]
| (white::white::bs) := coffee (white::bs)
| (white::black::bs) := coffee (black::bs)
| (black::white::bs) := coffee (black::bs)
| (black::black::bs) := coffee (white::bs)

def some_beans : list beans := [white, black, white, black, black]

instance : has_repr beans :=
{ repr := λ b, beans.cases_on b "◽" "◾" }

#eval coffee (some_beans)

@[simp] -- by tagging this as simp, make all the equation lemmas generated by Lean
-- available to the simplifier
def count_beans : beans → list beans → ℕ
| b [] := 0
| white (white::bs) := count_beans white bs + 1
| white (black::bs) := count_beans white bs
| black (white::bs) := count_beans black bs
| black (black::bs) := count_beans black bs + 1

-- Lean has a powerful built-in simplifier tactic that has access to a global library of
-- `simp lemmas`. `simp` is essentially a confluent rewriting system.

lemma count_beans_is_not_horribly_wrong {xs} : count_beans white xs + count_beans black xs = xs.length :=
begin
  induction xs with hd tl IH,
    { refl },
    { cases hd,
      { simp, rw ← IH, omega }, -- omega will decide linear Presburger arith
      { simp, rw ← IH, omega } }
end

open nat -- open nat namespace to avoid qualifying imported defs

lemma coffee_lemma_1 {x : beans} {xs : list beans} : even (count_beans black (x::xs)) ↔ even (count_beans black $ coffee (x::xs)) :=
begin
  induction xs with hd tl IH generalizing x,
    { cases x; simp },
    { cases x; cases hd,
      all_goals {try {simp * at *}},
     have := @IH white, simp * with parity_simps at *,

    have := @IH black, simp * with parity_simps at *,

    have := @IH black, simp * with parity_simps at *,

    have := @IH white, simp * with parity_simps at * }
end

lemma coffee_lemma_2 {x : beans} {xs : list beans} : coffee (x::xs) = [white] ∨ coffee (x::xs) = [black] :=
begin
  induction xs with hd tl IH generalizing x,
    { cases x, simp, simp },
    { cases x; cases hd,
      all_goals { simp * at * }}
end

theorem coffee_can_problem {x : beans} {xs : list beans} :
  coffee (x::xs) = [white] ↔ even (count_beans black (x::xs)) :=
begin
  have H₁ : even (count_beans black (x::xs)) ↔ even (count_beans black $ coffee (x::xs)),
  by { apply coffee_lemma_1 },
  have H₂ : coffee (x::xs) = [white] ∨ coffee (x::xs) = [black],
  by { apply coffee_lemma_2 },
  cases H₂,
    { refine ⟨_,_⟩,
       { intro H, rw H₁, rw H, simp },
       { intro H, assumption }},
    {
    refine ⟨_,_⟩,
      { intro H_bad, exfalso, cc }, -- cc is the congruence closure tactic
                                    -- chains together equalities and knows
                                    -- how to reach simple contradictions
                                    -- involving constructors
      { intro H, exfalso, rw H₁ at H, rw H₂ at H, simp at H, exact H }}
end

def coffee2 : list beans → list beans := λ bns,
match bns with
| [] := []
| bns := let num_black_beans := count_beans black bns in
         if (even num_black_beans) then [white] else [black]
end

theorem coffee_coffee2 : coffee = coffee2 :=
begin
  funext bns, cases bns,
    { simp[coffee2] },
    { by_cases H : even (count_beans black $ bns_hd :: bns_tl),
      { simp [coffee2, *], rwa ← coffee_can_problem at H },
      { simp [coffee2, *], rw ← coffee_can_problem at H, finish using coffee_lemma_2 }}
end

namespace tactic
namespace interactive
namespace tactic_parser

section metaprogramming

@[reducible]meta def tactic_parser : Type → Type := state_t string tactic

meta def tactic_parser.run {α} : tactic_parser α → string → tactic α :=
λ p σ, prod.fst <$> state_t.run p σ

meta def parse_char : tactic_parser string :=
{ run := λ s, match s with
              | ⟨[]⟩ := tactic.failed
              | ⟨(c::cs)⟩ := prod.mk <$> return ⟨[c]⟩ <*> return ⟨cs⟩
              end }

meta def failed {α} : tactic_parser α := {run := λ s, tactic.failed}

meta def parse_bean : tactic_parser beans :=
do c ← parse_char,
   if c = "1" then return white else
   if c = "0" then return black else failed

meta def repeat {α} : tactic_parser α → tactic_parser (list α) :=
λ p, (list.cons <$> p <*> repeat p) <|> return []

meta instance format_of_repr {α} [has_repr α] : has_to_tactic_format α :=
{ to_tactic_format := λ b,
    return (let f := (by apply_instance : has_repr α).repr in format.of_string (f b))}

run_cmd ((repeat parse_bean).run "101010111001" >>= tactic.trace)

-- #eval some_more_beans

end metaprogramming
end tactic_parser
end interactive
end tactic

/-
  Some set theory, using Aczel sets (see mathlib's set_theory/zfc.lean for a more thorough development, or Flypitch for a Boolean-valued version)
-/
universe u

inductive pSet : Type (u+1) -- Aczel sets
| mk (α : Type u) (A : α → pSet)

namespace pSet

def eqv : pSet → pSet → Prop
| (⟨α, A⟩) (⟨α', A'⟩) := (∀ a : α, ∃ a' : α', eqv (A a)  (A' a')) ∧ (∀ a' : α', ∃ a : α, eqv (A a) (A' a'))

def mem : pSet → pSet → Prop
| x (⟨α, A⟩) := ∃ a : α, eqv x (A a)

infix `∈ˢ`:1024 := pSet.mem
infix `=ˢ`:1024 := pSet.eqv

end pSet

-- this proof actually doesn't use anything and just works for any binary relation
-- lemma russell (x : pSet.{u}) (Hx : (∀ y : pSet.{u}, (y ∈ˢ x ↔ (¬ y ∈ˢ y)))): (x ∈ˢ x) ∧ (¬ x ∈ˢ x) :=
-- begin
--   refine ⟨_,_⟩,
--   { classical, by_contradiction, have := (Hx x).mpr ‹_›, contradiction },
--   { classical, by_contradiction, have := (Hx x).mp ‹_›, contradiction }
-- end

-- indeed
lemma russell_aux {α : Type*} {mem : α → α → Prop} {x : α} (Hx : (∀ a : α, mem a x ↔ ¬ mem a a)) : mem x x ∧ ¬ mem x x :=
begin
  refine ⟨_,_⟩,
  { classical, by_contradiction, have := (Hx x).mpr ‹_›, contradiction },
  { classical, by_contradiction, have := (Hx x).mp ‹_›, contradiction }
end

lemma russell (x : pSet.{u}) (Hx : (∀ y : pSet.{u}, (y ∈ˢ x ↔ (¬ y ∈ˢ y)))): (x ∈ˢ x) ∧ (¬ x ∈ˢ x) := russell_aux ‹_›

@[simp]lemma eqv_refl {x : pSet} : x =ˢ x := by induction x; tidy

lemma eqv_trans {x y z : pSet} (H₁ : x =ˢ y) (H₂ : y =ˢ z) : x =ˢ z :=
begin
  induction x with α₁ A₁ generalizing y z, induction y with α₂ A₂, induction z with α₃ A₃,
  cases H₁ with H₁_left H₁_right, cases H₂ with H₂_left H₂_right,
  refine ⟨_,_⟩; intro i,
    { cases H₁_left i with j Hj, cases H₂_left j with k Hk,
      refine ⟨k, _⟩, apply x_ih, exact Hj, exact Hk, },
    { cases H₂_right i with j Hj, cases H₁_right j with k Hk,
      refine ⟨k, _⟩, apply x_ih, exact Hk, exact Hj }
end

lemma eqv_symm {x y : pSet} (H : x =ˢ y) : y =ˢ x :=
begin
  induction x with α A generalizing y, induction y with α' A' generalizing α A,
  refine ⟨_,_⟩; intro i; cases H with H₁ H₂,
    { specialize H₂ i, cases H₂ with a Ha, use a, finish },
    { specialize H₁ i, cases H₁ with a' Ha', use a', finish }
end

lemma eqv.symm {x y} : x =ˢ y ↔ y =ˢ x := ⟨eqv_symm, eqv_symm⟩

@[simp]lemma mem_congr_right {x y z : pSet} (H_mem : x ∈ˢ y) (H_eqv : y =ˢ z) : x ∈ˢ z :=
begin
  induction y with α A, induction z with β B,
  cases H_eqv with H₁ H₂, cases H_mem with a Ha,
  cases H₁ a with b Hb, use b, exact eqv_trans Ha Hb
end

@[simp]lemma mem_congr_left {x y z : pSet} (H_mem : x ∈ˢ y) (H_eqv : x =ˢ z) : z ∈ˢ y :=
begin
  induction y with α A, cases H_mem with a' Ha', use a', exact eqv_trans (eqv_symm H_eqv) ‹_›
end

@[simp]lemma mem.mk {α : Type u} {a : α} {A : α → pSet.{u}} : A a ∈ˢ (pSet.mk α A : pSet.{u}) := ⟨a, by simp⟩

lemma mem_iff {x y : pSet.{u}} : x ∈ˢ y ↔ ∃ z : pSet.{u}, z ∈ˢ y ∧ x =ˢ z :=
begin
  refine ⟨_,_⟩; intro H,
    { cases y with α A, cases H with a_x H_a_x,
      refine ⟨A a_x, ⟨_,_⟩⟩,
        { simp },
        { assumption }},
    { rcases H with ⟨z, ⟨Hz₁, Hz₂⟩⟩, apply mem_congr_left ‹_›, exact eqv_symm ‹_› }
end

-- technically a consequence of foundation
lemma foundation {x} : x ∈ˢ x → false :=
begin
  intro H_mem_self, induction x with α A,
  rcases H_mem_self with ⟨a, Ha⟩, apply x_ih a,
  exact mem_congr_right (mem.mk) ‹_›
end

-- run this file with `lean --run hello_world.lean`
def main : io unit :=
do trace (string.join ((by apply_instance : has_repr beans).repr <$> [white, black, white, black, black, black, white])) (return ()),
   trace ("Hello world!") (return ())


import mynat.definition -- hide
import mynat.add -- hide
import game.world8.level1 -- hide
namespace mynat -- hide

/-

# Advanced Addition World

## Level 2: `succ_succ_inj`.
-/

/-
In the below theorem, we need to apply `succ_inj` twice. Once to prove
$succ(succ(a))=succ(succ(b))\implies succ(a)=succ(b)$, and then again
to prove $succ(a)=succ(b)\implies a=b$. However `succ(a)=succ(b)` is
nowhere to be found, it's neither an assumption or a goal when we start
this level. You can make it with `have` or you can use `apply`.
-/
/- Theorem
For all naturals $a$ and $b$, if we assume $succ(succ(a))=succ(succ(b))$, then we can
deduce $a=b$.
-/
theorem succ_succ_inj {a b : mynat} (h : succ(succ(a)) = succ(succ(b))) :  a = b :=
begin [nat_num_game]
    have h2 : succ(a)=succ(b),
      exact succ_inj(h),
    exact succ_inj(h2),

end

/-
## Sample solutions to this level.

Make sure you understand them all. And remember that `rw` should not be used
with `succ_inj` -- `rw` works only with equalities or `↔` statements,
not implications or functions.

-/
example {a b : mynat} (h : succ(succ(a)) = succ(succ(b))) :  a = b :=
begin
  apply succ_inj,
  apply succ_inj,
  exact h
end

example {a b : mynat} (h : succ(succ(a)) = succ(succ(b))) :  a = b :=
begin
  apply succ_inj,
  exact succ_inj(h),
end

example {a b : mynat} (h : succ(succ(a)) = succ(succ(b))) :  a = b :=
begin
  exact succ_inj(succ_inj(h)),
end

end mynat -- hide


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad, Andrew Zipperer

Using classical logic, defines an inverse function.
-/
import .function .map
open eq.ops classical

namespace set

variables {X Y : Type}

noncomputable definition inv_fun (f : X → Y) (a : set X) (dflt : X) (y : Y) : X :=
if H : ∃₀ x ∈ a, f x = y then some H else dflt

theorem inv_fun_pos {f : X → Y} {a : set X} {dflt : X} {y : Y}
  (H : ∃₀ x ∈ a, f x = y) : (inv_fun f a dflt y ∈ a) ∧ (f (inv_fun f a dflt y) = y) :=
have H1 : inv_fun f a dflt y = some H, from dif_pos H,
H1⁻¹ ▸ some_spec H

theorem inv_fun_neg {f : X → Y} {a : set X} {dflt : X} {y : Y}
  (H : ¬ ∃₀ x ∈ a, f x = y) : inv_fun f a dflt y = dflt :=
dif_neg H

variables {f : X → Y} {a : set X} {b : set Y}

theorem maps_to_inv_fun {dflt : X} (dflta : dflt ∈ a) :
  maps_to (inv_fun f a dflt) b a :=
let f' := inv_fun f a dflt in
take y,
assume yb : y ∈ b,
show f' y ∈ a, from
  by_cases
    (assume H : ∃₀ x ∈ a, f x = y,
      and.left (inv_fun_pos H))
    (assume H : ¬ ∃₀ x ∈ a, f x = y,
      (inv_fun_neg H)⁻¹ ▸ dflta)

theorem left_inv_on_inv_fun_of_inj_on (dflt : X) (H : inj_on f a) :
  left_inv_on (inv_fun f a dflt) f a :=
let f' := inv_fun f a dflt in
take x,
assume xa : x ∈ a,
have H1 : ∃₀ x' ∈ a, f x' = f x, from exists.intro x (and.intro xa rfl),
have H2 : f' (f x) ∈ a ∧ f (f' (f x)) = f x, from inv_fun_pos H1,
show f' (f x) = x, from H (and.left H2) xa (and.right H2)

theorem surj_on_inv_fun_of_inj_on (dflt : X) (mapsto : maps_to f a b) (H : inj_on f a) :
  surj_on (inv_fun f a dflt) b a :=
surj_on_of_right_inv_on mapsto (left_inv_on_inv_fun_of_inj_on dflt H)

theorem right_inv_on_inv_fun_of_surj_on (dflt : X) (H : surj_on f a b) :
  right_inv_on (inv_fun f a dflt) f b :=
let f' := inv_fun f a dflt in
take y,
assume yb: y ∈ b,
obtain x (Hx : x ∈ a ∧ f x = y), from H yb,
have Hy : f' y ∈ a ∧ f (f' y) = y, from inv_fun_pos (exists.intro x Hx),
and.right Hy

theorem inj_on_inv_fun (dflt : X) (H : surj_on f a b) :
  inj_on (inv_fun f a dflt) b :=
inj_on_of_left_inv_on (right_inv_on_inv_fun_of_surj_on dflt H)

end set

open set

namespace map

variables {X Y : Type} {a : set X} {b : set Y}

protected noncomputable definition inverse (f : map a b) {dflt : X} (dflta : dflt ∈ a) :=
map.mk (inv_fun f a dflt) (@maps_to_inv_fun _ _ _ _ b _ dflta)

theorem left_inverse_inverse {f : map a b} {dflt : X} (dflta : dflt ∈ a) (H : map.injective f) :
  map.left_inverse (map.inverse f dflta) f :=
left_inv_on_inv_fun_of_inj_on dflt H

theorem right_inverse_inverse {f : map a b} {dflt : X} (dflta : dflt ∈ a) (H : map.surjective f) :
  map.right_inverse (map.inverse f dflta) f :=
right_inv_on_inv_fun_of_surj_on dflt H

theorem is_inverse_inverse {f : map a b} {dflt : X} (dflta : dflt ∈ a) (H : map.bijective f) :
map.is_inverse (map.inverse f dflta) f :=
and.intro
  (left_inverse_inverse dflta (and.left H))
  (right_inverse_inverse dflta (and.right H))

end map


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.covering.density_theorem
import measure_theory.measure.haar_lebesgue

/-!
# Covering theorems for Lebesgue measure in one dimension

We have a general theory of covering theorems for doubling measures, developed notably
in `density_theorems.lean`. In this file, we expand the API for this theory in one dimension,
by showing that intervals belong to the relevant Vitali family.
-/

open set measure_theory is_doubling_measure filter
open_locale topology

namespace real

lemma Icc_mem_vitali_family_at_right {x y : ℝ} (hxy : x < y) :
  Icc x y ∈ (vitali_family (volume : measure ℝ) 1).sets_at x :=
begin
  rw Icc_eq_closed_ball,
  refine closed_ball_mem_vitali_family_of_dist_le_mul _ _ (by linarith),
  rw [dist_comm, real.dist_eq, abs_of_nonneg];
  linarith,
end

lemma tendsto_Icc_vitali_family_right (x : ℝ) :
  tendsto (λ y, Icc x y) (𝓝[>] x) ((vitali_family (volume : measure ℝ) 1).filter_at x) :=
begin
  refine (vitali_family.tendsto_filter_at_iff _).2 ⟨_, _⟩,
  { filter_upwards [self_mem_nhds_within] with y hy using Icc_mem_vitali_family_at_right hy },
  { assume ε εpos,
    have : x ∈ Ico x (x + ε) := ⟨le_refl _, by linarith⟩,
    filter_upwards [Icc_mem_nhds_within_Ioi this] with y hy,
    rw closed_ball_eq_Icc,
    exact Icc_subset_Icc (by linarith) hy.2 }
end

lemma Icc_mem_vitali_family_at_left {x y : ℝ} (hxy : x < y) :
  Icc x y ∈ (vitali_family (volume : measure ℝ) 1).sets_at y :=
begin
  rw Icc_eq_closed_ball,
  refine closed_ball_mem_vitali_family_of_dist_le_mul _ _ (by linarith),
  rw [real.dist_eq, abs_of_nonneg];
  linarith,
end

lemma tendsto_Icc_vitali_family_left (x : ℝ) :
  tendsto (λ y, Icc y x) (𝓝[<] x) ((vitali_family (volume : measure ℝ) 1).filter_at x) :=
begin
  refine (vitali_family.tendsto_filter_at_iff _).2 ⟨_, _⟩,
  { filter_upwards [self_mem_nhds_within] with y hy using Icc_mem_vitali_family_at_left hy },
  { assume ε εpos,
    have : x ∈ Ioc (x - ε) x := ⟨by linarith, le_refl _⟩,
    filter_upwards [Icc_mem_nhds_within_Iio this] with y hy,
    rw closed_ball_eq_Icc,
    exact Icc_subset_Icc hy.1 (by linarith) }
end

end real


-- Aplicacion_de_particiones_en_relaciones_de_equivalencia.lean
-- Aplicación de particiones en relaciones de equivalencia
-- José A. Alonso Jiménez
-- Sevilla, 12 de octubre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Definir la función
--    relacionP : particion A → {R : A → A → Prop // equivalence R}
-- tal que (relacionP P) es la relación de equivalencia definida por la
-- partición P.
-- ---------------------------------------------------------------------

import tactic

@[ext] structure particion (A : Type) :=
(Bloques    : set (set A))
(Hno_vacios : ∀ X ∈ Bloques, (X : set A).nonempty)
(Hrecubren  : ∀ a, ∃ X ∈ Bloques, a ∈ X)
(Hdisjuntos : ∀ X Y ∈ Bloques, (X ∩ Y : set A).nonempty → X = Y)

namespace particion

variable  {A : Type}
variables {X Y : set A}
variable  {P : particion A}

def relacion : (particion A) → (A → A → Prop) :=
  λ P a b, ∀ X ∈ Bloques P, a ∈ X → b ∈ X

lemma reflexiva
  (P : particion A)
  : reflexive (relacion P) :=
λ a X hXC haX, haX

lemma iguales_si_comun
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
Hdisjuntos P X hX Y hY ⟨a, haX, haY⟩

lemma pertenece_si_pertenece
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a b : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  (hbX : b ∈ X)
  : b ∈ Y :=
begin
  convert hbX,
  exact iguales_si_comun hY hX haY haX,
end

lemma simetrica
  (P : particion A)
  : symmetric (relacion P) :=
begin
  intros a b h X hX hbX,
  obtain ⟨Y, hY, haY⟩ := Hrecubren P a,
  specialize h Y hY haY,
  exact pertenece_si_pertenece hY hX h hbX haY,
end

lemma transitiva
  (P : particion A)
  : transitive (relacion P) :=
λ a b c hab hbc X hX haX, hbc X hX (hab X hX haX)

def relacionP : particion A → {R : A → A → Prop // equivalence R} :=
  λ P, ⟨λ a b, ∀ X ∈ Bloques P, a ∈ X → b ∈ X,
        ⟨reflexiva P, simetrica P, transitiva P⟩⟩

end particion


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

import algebra.geom_sum
import ring_theory.ideal.quotient

/-!
# Basic results in number theory

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

This file should contain basic results in number theory. So far, it only contains the essential
lemma in the construction of the ring of Witt vectors.

## Main statement

`dvd_sub_pow_of_dvd_sub` proves that for elements `a` and `b` in a commutative ring `R` and for
all natural numbers `p` and `k` if `p` divides `a-b` in `R`, then `p ^ (k + 1)` divides
`a ^ (p ^ k) - b ^ (p ^ k)`.
-/

section

open ideal ideal.quotient

lemma dvd_sub_pow_of_dvd_sub {R : Type*} [comm_ring R] {p : ℕ}
  {a b : R} (h : (p : R) ∣ a - b) (k : ℕ) :
  (p^(k+1) : R) ∣ a^(p^k) - b^(p^k) :=
begin
  induction k with k ih,
  { rwa [pow_one, pow_zero, pow_one, pow_one] },
  rw [pow_succ' p k, pow_mul, pow_mul, ← geom_sum₂_mul, pow_succ],
  refine mul_dvd_mul _ ih,
  let I : ideal R := span {p},
  let f : R →+* R ⧸ I := mk I,
  have hp : (p : R ⧸ I) = 0,
  { rw [← map_nat_cast f, eq_zero_iff_mem, mem_span_singleton] },
  rw [← mem_span_singleton, ← ideal.quotient.eq] at h,
  rw [← mem_span_singleton, ← eq_zero_iff_mem, ring_hom.map_geom_sum₂,
      ring_hom.map_pow, ring_hom.map_pow, h, geom_sum₂_self, hp, zero_mul],
end

end


/-
Copyright (c) 2020 Kevin Lacker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Lacker, Heather Macbeth
-/

import analysis.special_functions.trigonometric

/-!
# IMO 1962 Q4

Solve the equation `cos x ^ 2 + cos (2 * x) ^ 2 + cos (3 * x) ^ 2 = 1`.

Since Lean does not have a concept of "simplest form", we just express what is
in fact the simplest form of the set of solutions, and then prove it equals the set of solutions.
-/

open real
open_locale real
noncomputable theory

def problem_equation (x : ℝ) : Prop := cos x ^ 2 + cos (2 * x) ^ 2 + cos (3 * x) ^ 2 = 1

def solution_set : set ℝ :=
{ x : ℝ | ∃ k : ℤ, x = (2 * ↑k + 1) * π / 4 ∨ x = (2 * ↑k + 1) * π / 6 }

/-
The key to solving this problem simply is that we can rewrite the equation as
a product of terms, shown in `alt_formula`, being equal to zero.
-/

def alt_formula (x : ℝ) : ℝ := cos x * (cos x ^ 2 - 1/2) * cos (3 * x)

lemma cos_sum_equiv {x : ℝ} :
(cos x ^ 2 + cos (2 * x) ^ 2 + cos (3 * x) ^ 2 - 1) / 4 = alt_formula x :=
begin
  simp only [real.cos_two_mul, cos_three_mul, alt_formula],
  ring
end

lemma alt_equiv {x : ℝ} : problem_equation x ↔ alt_formula x = 0 :=
begin
  rw [ problem_equation, ← cos_sum_equiv, div_eq_zero_iff, sub_eq_zero],
  norm_num,
end

lemma finding_zeros {x : ℝ} :
alt_formula x = 0 ↔ cos x ^ 2 = 1/2 ∨ cos (3 * x) = 0 :=
begin
  simp only [alt_formula, mul_assoc, mul_eq_zero, sub_eq_zero],
  split,
  { rintro (h1|h2),
    { right,
      rw [cos_three_mul, h1],
      ring },
    { exact h2 } },
  { exact or.inr }
end

/-
Now we can solve for `x` using basic-ish trigonometry.
-/

lemma solve_cos2_half {x : ℝ} : cos x ^ 2 = 1/2 ↔ ∃ k : ℤ, x = (2 * ↑k + 1) * π / 4 :=
begin
  rw cos_sq,
  simp only [add_right_eq_self, div_eq_zero_iff],
  norm_num,
  rw cos_eq_zero_iff,
  split;
  { rintro ⟨k, h⟩,
    use k,
    linarith },
end

lemma solve_cos3x_0 {x : ℝ} : cos (3 * x) = 0 ↔ ∃ k : ℤ, x = (2 * ↑k + 1) * π / 6 :=
begin
  rw cos_eq_zero_iff,
  refine exists_congr (λ k, _),
  split; intro; linarith
end

/-
The final theorem is now just gluing together our lemmas.
-/

theorem imo1962_q4 {x : ℝ} : problem_equation x ↔ x ∈ solution_set :=
begin
  rw [alt_equiv, finding_zeros, solve_cos3x_0, solve_cos2_half],
  exact exists_or_distrib.symm
end

/-
We now present a second solution.  The key to this solution is that, when the identity is
converted to an identity which is polynomial in `a` := `cos x`, it can be rewritten as a product of
terms, `a ^ 2 * (2 * a ^ 2 - 1) * (4 * a ^ 2 - 3)`, being equal to zero.
-/

/-- Someday, when there is a Grobner basis tactic, try to automate this proof. (A little tricky --
the ideals are not the same but their Jacobson radicals are.) -/
lemma formula {R : Type*} [integral_domain R] [char_zero R] (a : R) :
  a ^ 2 + (2 * a ^ 2 - 1) ^ 2 + (4 * a ^ 3 - 3 * a) ^ 2 = 1
  ↔ (2 * a ^ 2 - 1) * (4 * a ^ 3 - 3 * a) = 0 :=
calc a ^ 2 + (2 * a ^ 2 - 1) ^ 2 + (4 * a ^ 3 - 3 * a) ^ 2 = 1
    ↔ a ^ 2 + (2 * a ^ 2 - 1) ^ 2 + (4 * a ^ 3 - 3 * a) ^ 2 - 1 = 0 : by rw ← sub_eq_zero
... ↔ 2 * a ^ 2 * (2 * a ^ 2 - 1) * (4 * a ^ 2 - 3) = 0 : by { split; intros h; convert h; ring }
... ↔ a * (2 * a ^ 2 - 1) * (4 * a ^ 2 - 3) = 0 : by simp [(by norm_num : (2:R) ≠ 0)]
... ↔ (2 * a ^ 2 - 1) * (4 * a ^ 3 - 3 * a) = 0 : by { split; intros h; convert h using 1; ring }

/-
Again, we now can solve for `x` using basic-ish trigonometry.
-/

lemma solve_cos2x_0 {x : ℝ} :
  cos (2 * x) = 0 ↔ ∃ k : ℤ, x = (2 * ↑k + 1) * π / 4 :=
begin
  rw cos_eq_zero_iff,
  refine exists_congr (λ k, _),
  split; intro; linarith
end

/-
Again, the final theorem is now just gluing together our lemmas.
-/

theorem imo1962_q4' {x : ℝ} : problem_equation x ↔ x ∈ solution_set :=
calc problem_equation x
    ↔ cos x ^ 2 + cos (2 * x) ^ 2 + cos (3 * x) ^ 2 = 1 : by refl
... ↔ cos (2 * x) = 0 ∨ cos (3 * x) = 0 : by simp [cos_two_mul, cos_three_mul, formula]
... ↔ x ∈ solution_set : by { rw [solve_cos2x_0, solve_cos3x_0, ← exists_or_distrib], refl }


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

Ring-theoretic supplement of data.polynomial.

Main result: Hilbert basis theorem, that if a ring is noetherian then so is its polynomial ring.
-/

import data.polynomial data.mv_polynomial
import ring_theory.principal_ideal_domain
import ring_theory.subring

universes u v w

namespace polynomial

variables (R : Type u) [comm_ring R] [decidable_eq R]

/-- The `R`-submodule of `R[X]` consisting of polynomials of degree ≤ `n`. -/
def degree_le (n : with_bot ℕ) : submodule R (polynomial R) :=
⨅ k : ℕ, ⨅ h : ↑k > n, (lcoeff R k).ker

variable {R}

theorem mem_degree_le {n : with_bot ℕ} {f : polynomial R} :
  f ∈ degree_le R n ↔ degree f ≤ n :=
by simp only [degree_le, submodule.mem_infi, degree_le_iff_coeff_zero, linear_map.mem_ker]; refl

theorem degree_le_mono {m n : with_bot ℕ} (H : m ≤ n):
  degree_le R m ≤ degree_le R n :=
λ f hf, mem_degree_le.2 (le_trans (mem_degree_le.1 hf) H)

theorem degree_le_eq_span_X_pow {n : ℕ} :
  degree_le R n = submodule.span R ↑((finset.range (n+1)).image (λ n, X^n) : finset (polynomial R)) :=
begin
  apply le_antisymm,
  { intros p hp, replace hp := mem_degree_le.1 hp,
    rw [← finsupp.sum_single p, finsupp.sum, submodule.mem_coe],
    refine submodule.sum_mem _ (λ k hk, _),
    have := with_bot.coe_le_coe.1 (finset.sup_le_iff.1 hp k hk),
    rw [single_eq_C_mul_X, C_mul'],
    refine submodule.smul_mem _ _ (submodule.subset_span $ finset.mem_coe.2 $
      finset.mem_image.2 ⟨_, finset.mem_range.2 (nat.lt_succ_of_le this), rfl⟩) },
  rw [submodule.span_le, finset.coe_image, set.image_subset_iff],
  intros k hk, apply mem_degree_le.2,
  apply le_trans (degree_X_pow_le _) (with_bot.coe_le_coe.2 $ nat.le_of_lt_succ $ finset.mem_range.1 hk)
end

/-- Given a polynomial, return the polynomial whose coefficients are in
the ring closure of the original coefficients. -/
def restriction (p : polynomial R) : polynomial (ring.closure (↑p.frange : set R)) :=
⟨p.support, λ i, ⟨p.to_fun i,
  if H : p.to_fun i = 0 then H.symm ▸ is_add_submonoid.zero_mem _
  else ring.subset_closure $ finsupp.mem_frange.2 ⟨H, i, rfl⟩⟩,
λ i, finsupp.mem_support_iff.trans (not_iff_not_of_iff ⟨λ H, subtype.eq H, subtype.mk.inj⟩)⟩

@[simp] theorem coeff_restriction {p : polynomial R} {n : ℕ} : ↑(coeff (restriction p) n) = coeff p n := rfl

@[simp] theorem coeff_restriction' {p : polynomial R} {n : ℕ} : (coeff (restriction p) n).1 = coeff p n := rfl

@[simp] theorem degree_restriction {p : polynomial R} : (restriction p).degree = p.degree := rfl

@[simp] theorem nat_degree_restriction {p : polynomial R} : (restriction p).nat_degree = p.nat_degree := rfl

@[simp] theorem monic_restriction {p : polynomial R} : monic (restriction p) ↔ monic p :=
⟨λ H, congr_arg subtype.val H, λ H, subtype.eq H⟩

@[simp] theorem restriction_zero : restriction (0 : polynomial R) = 0 := rfl

@[simp] theorem restriction_one : restriction (1 : polynomial R) = 1 :=
ext.2 $ λ i, subtype.eq $ by rw [coeff_restriction', coeff_one, coeff_one]; split_ifs; refl

variables {S : Type v} [comm_ring S] {f : R → S} {x : S}

theorem eval₂_restriction {p : polynomial R} :
  eval₂ f x p = eval₂ (f ∘ subtype.val) x p.restriction :=
rfl

section to_subring
variables (p : polynomial R) (T : set R) [is_subring T]

/-- Given a polynomial `p` and a subring `T` that contains the coefficients of `p`,
return the corresponding polynomial whose coefficients are in `T. -/
def to_subring (hp : ↑p.frange ⊆ T) : polynomial T :=
⟨p.support, λ i, ⟨p.to_fun i,
  if H : p.to_fun i = 0 then H.symm ▸ is_add_submonoid.zero_mem _
  else hp $ finsupp.mem_frange.2 ⟨H, i, rfl⟩⟩,
λ i, finsupp.mem_support_iff.trans (not_iff_not_of_iff ⟨λ H, subtype.eq H, subtype.mk.inj⟩)⟩

variables (hp : ↑p.frange ⊆ T)
include hp

@[simp] theorem coeff_to_subring {n : ℕ} : ↑(coeff (to_subring p T hp) n) = coeff p n := rfl

@[simp] theorem coeff_to_subring' {n : ℕ} : (coeff (to_subring p T hp) n).1 = coeff p n := rfl

@[simp] theorem degree_to_subring : (to_subring p T hp).degree = p.degree := rfl

@[simp] theorem nat_degree_to_subring : (to_subring p T hp).nat_degree = p.nat_degree := rfl

@[simp] theorem monic_to_subring : monic (to_subring p T hp) ↔ monic p :=
⟨λ H, congr_arg subtype.val H, λ H, subtype.eq H⟩

omit hp

@[simp] theorem to_subring_zero : to_subring (0 : polynomial R) T (set.empty_subset _) = 0 := rfl

@[simp] theorem to_subring_one : to_subring (1 : polynomial R) T
  (set.subset.trans (finset.coe_subset.2 finsupp.frange_single)
    (set.singleton_subset_iff.2 (is_submonoid.one_mem _))) = 1 :=
ext.2 $ λ i, subtype.eq $ by rw [coeff_to_subring', coeff_one, coeff_one]; split_ifs; refl
end to_subring

variables (T : set R) [is_subring T]

/-- Given a polynomial whose coefficients are in some subring, return
the corresponding polynomial whose coefificents are in the ambient ring. -/
def of_subring (p : polynomial T) : polynomial R :=
⟨p.support, subtype.val ∘ p.to_fun,
λ n, finsupp.mem_support_iff.trans (not_iff_not_of_iff
  ⟨λ h, congr_arg subtype.val h, λ h, subtype.eq h⟩)⟩

@[simp] theorem frange_of_subring {p : polynomial T} :
  ↑(p.of_subring T).frange ⊆ T :=
λ y H, let ⟨hy, x, hx⟩ := finsupp.mem_frange.1 H in hx ▸ (p.to_fun x).2

end polynomial

variables {R : Type u} [comm_ring R] [decidable_eq R]

namespace ideal
open polynomial

/-- Transport an ideal of `R[X]` to an `R`-submodule of `R[X]`. -/
def of_polynomial (I : ideal (polynomial R)) : submodule R (polynomial R) :=
{ carrier := I.carrier,
  zero := I.zero_mem,
  add := λ _ _, I.add_mem,
  smul := λ c x H, by rw [← C_mul']; exact submodule.smul_mem _ _ H }

variables {I : ideal (polynomial R)}
theorem mem_of_polynomial (x) : x ∈ I.of_polynomial ↔ x ∈ I := iff.rfl
variables (I)

/-- Given an ideal `I` of `R[X]`, make the `R`-submodule of `I`
consisting of polynomials of degree ≤ `n`. -/
def degree_le (n : with_bot ℕ) : submodule R (polynomial R) :=
degree_le R n ⊓ I.of_polynomial

/-- Given an ideal `I` of `R[X]`, make the ideal in `R` of
leading coefficients of polynomials in `I` with degree ≤ `n`. -/
def leading_coeff_nth (n : ℕ) : ideal R :=
(I.degree_le n).map $ lcoeff R n

theorem mem_leading_coeff_nth (n : ℕ) (x) :
  x ∈ I.leading_coeff_nth n ↔ ∃ p ∈ I, degree p ≤ n ∧ leading_coeff p = x :=
begin
  simp only [leading_coeff_nth, degree_le, submodule.mem_map, lcoeff_apply, submodule.mem_inf, mem_degree_le],
  split,
  { rintro ⟨p, ⟨hpdeg, hpI⟩, rfl⟩,
    cases lt_or_eq_of_le hpdeg with hpdeg hpdeg,
    { refine ⟨0, I.zero_mem, lattice.bot_le, _⟩,
      rw [leading_coeff_zero, eq_comm],
      exact coeff_eq_zero_of_degree_lt hpdeg },
    { refine ⟨p, hpI, le_of_eq hpdeg, _⟩,
      rw [leading_coeff, nat_degree, hpdeg], refl } },
  { rintro ⟨p, hpI, hpdeg, rfl⟩,
    have : nat_degree p + (n - nat_degree p) = n,
    { exact nat.add_sub_cancel' (nat_degree_le_of_degree_le hpdeg) },
    refine ⟨p * X ^ (n - nat_degree p), ⟨_, I.mul_mem_right hpI⟩, _⟩,
    { apply le_trans (degree_mul_le _ _) _,
      apply le_trans (add_le_add' (degree_le_nat_degree) (degree_X_pow_le _)) _,
      rw [← with_bot.coe_add, this],
      exact le_refl _ },
    { rw [leading_coeff, ← coeff_mul_X_pow p (n - nat_degree p), this] } }
end

theorem mem_leading_coeff_nth_zero (x) :
  x ∈ I.leading_coeff_nth 0 ↔ C x ∈ I :=
(mem_leading_coeff_nth _ _ _).trans
⟨λ ⟨p, hpI, hpdeg, hpx⟩, by rwa [← hpx, leading_coeff,
  nat.eq_zero_of_le_zero (nat_degree_le_of_degree_le hpdeg),
  ← eq_C_of_degree_le_zero hpdeg],
λ hx, ⟨C x, hx, degree_C_le, leading_coeff_C x⟩⟩

theorem leading_coeff_nth_mono {m n : ℕ} (H : m ≤ n) :
  I.leading_coeff_nth m ≤ I.leading_coeff_nth n :=
begin
  intros r hr,
  simp only [submodule.mem_coe, mem_leading_coeff_nth] at hr ⊢,
  rcases hr with ⟨p, hpI, hpdeg, rfl⟩,
  refine ⟨p * X ^ (n - m), I.mul_mem_right hpI, _, leading_coeff_mul_X_pow⟩,
  refine le_trans (degree_mul_le _ _) _,
  refine le_trans (add_le_add' hpdeg (degree_X_pow_le _)) _,
  rw [← with_bot.coe_add, nat.add_sub_cancel' H],
  exact le_refl _
end

/-- Given an ideal `I` in `R[X]`, make the ideal in `R` of the
leading coefficients in `I`. -/
def leading_coeff : ideal R :=
⨆ n : ℕ, I.leading_coeff_nth n

theorem mem_leading_coeff (x) :
  x ∈ I.leading_coeff ↔ ∃ p ∈ I, polynomial.leading_coeff p = x :=
begin
  rw [leading_coeff, submodule.mem_supr_of_directed],
  simp only [mem_leading_coeff_nth],
  { split, { rintro ⟨i, p, hpI, hpdeg, rfl⟩, exact ⟨p, hpI, rfl⟩ },
    rintro ⟨p, hpI, rfl⟩, exact ⟨nat_degree p, p, hpI, degree_le_nat_degree, rfl⟩ },
  { exact ⟨0⟩ },
  intros i j, exact ⟨i + j, I.leading_coeff_nth_mono (nat.le_add_right _ _),
    I.leading_coeff_nth_mono (nat.le_add_left _ _)⟩
end

theorem is_fg_degree_le [is_noetherian_ring R] (n : ℕ) :
  submodule.fg (I.degree_le n) :=
is_noetherian_submodule_left.1 (is_noetherian_of_fg_of_noetherian _
  ⟨_, degree_le_eq_span_X_pow.symm⟩) _

end ideal

/-- Hilbert basis theorem. -/
theorem is_noetherian_ring_polynomial [is_noetherian_ring R] : is_noetherian_ring (polynomial R) :=
⟨assume I : ideal (polynomial R),
let L := I.leading_coeff in
let M := well_founded.min (is_noetherian_iff_well_founded.1 (by apply_instance))
  (set.range I.leading_coeff_nth) (set.ne_empty_of_mem ⟨0, rfl⟩) in
have hm : M ∈ set.range I.leading_coeff_nth := well_founded.min_mem _ _ _,
let ⟨N, HN⟩ := hm, ⟨s, hs⟩ := I.is_fg_degree_le N in
have hm2 : ∀ k, I.leading_coeff_nth k ≤ M := λ k, or.cases_on (le_or_lt k N)
  (λ h, HN ▸ I.leading_coeff_nth_mono h)
  (λ h x hx, classical.by_contradiction $ λ hxm,
    have ¬M < I.leading_coeff_nth k, by refine well_founded.not_lt_min
      well_founded_submodule_gt _ _ _; exact ⟨k, rfl⟩,
    this ⟨HN ▸ I.leading_coeff_nth_mono (le_of_lt h), λ H, hxm (H hx)⟩),
have hs2 : ∀ {x}, x ∈ I.degree_le N → x ∈ ideal.span (↑s : set (polynomial R)),
from hs ▸ λ x hx, submodule.span_induction hx (λ _ hx, ideal.subset_span hx) (ideal.zero_mem _)
  (λ _ _, ideal.add_mem _) (λ c f hf, f.C_mul' c ▸ ideal.mul_mem_left _ hf),
⟨s, le_antisymm (ideal.span_le.2 $ λ x hx, have x ∈ I.degree_le N, from hs ▸ submodule.subset_span hx, this.2) $ begin
  change I ≤ ideal.span ↑s,
  intros p hp, generalize hn : p.nat_degree = k,
  induction k using nat.strong_induction_on with k ih generalizing p,
  cases le_or_lt k N,
  { subst k, refine hs2 ⟨polynomial.mem_degree_le.2
      (le_trans polynomial.degree_le_nat_degree $ with_bot.coe_le_coe.2 h), hp⟩ },
  { have hp0 : p ≠ 0,
    { rintro rfl, cases hn, exact nat.not_lt_zero _ h },
    have : (0 : R) ≠ 1,
    { intro h, apply hp0, ext i, refine (mul_one _).symm.trans _,
      rw [← h, mul_zero], refl },
    letI : nonzero_comm_ring R := { zero_ne_one := this,
      ..(infer_instance : comm_ring R) },
    have : p.leading_coeff ∈ I.leading_coeff_nth N,
    { rw HN, exact hm2 k ((I.mem_leading_coeff_nth _ _).2
        ⟨_, hp, hn ▸ polynomial.degree_le_nat_degree, rfl⟩) },
    rw I.mem_leading_coeff_nth at this,
    rcases this with ⟨q, hq, hdq, hlqp⟩,
    have hq0 : q ≠ 0,
    { intro H, rw [← polynomial.leading_coeff_eq_zero] at H,
      rw [hlqp, polynomial.leading_coeff_eq_zero] at H, exact hp0 H },
    have h1 : p.degree = (q * polynomial.X ^ (k - q.nat_degree)).degree,
    { rw [polynomial.degree_mul_eq', polynomial.degree_X_pow],
      rw [polynomial.degree_eq_nat_degree hp0, polynomial.degree_eq_nat_degree hq0],
      rw [← with_bot.coe_add, nat.add_sub_cancel', hn],
      { refine le_trans (polynomial.nat_degree_le_of_degree_le hdq) (le_of_lt h) },
      rw [polynomial.leading_coeff_X_pow, mul_one],
      exact mt polynomial.leading_coeff_eq_zero.1 hq0 },
    have h2 : p.leading_coeff = (q * polynomial.X ^ (k - q.nat_degree)).leading_coeff,
    { rw [← hlqp, polynomial.leading_coeff_mul_X_pow] },
    have := polynomial.degree_sub_lt h1 hp0 h2,
    rw [polynomial.degree_eq_nat_degree hp0] at this,
    rw ← sub_add_cancel p (q * polynomial.X ^ (k - q.nat_degree)),
    refine (ideal.span ↑s).add_mem _ ((ideal.span ↑s).mul_mem_right _),
    { by_cases hpq : p - q * polynomial.X ^ (k - q.nat_degree) = 0,
      { rw hpq, exact ideal.zero_mem _ },
      refine ih _ _ (I.sub_mem hp (I.mul_mem_right hq)) rfl,
      rwa [polynomial.degree_eq_nat_degree hpq, with_bot.coe_lt_coe, hn] at this },
    exact hs2 ⟨polynomial.mem_degree_le.2 hdq, hq⟩ }
end⟩⟩

theorem is_noetherian_ring_mv_polynomial_fin {n : ℕ} [is_noetherian_ring R] :
  is_noetherian_ring (mv_polynomial (fin n) R) :=
begin
  induction n with n ih,
  { exact is_noetherian_ring_of_ring_equiv R
      ((mv_polynomial.pempty_ring_equiv R).symm.trans $ mv_polynomial.ring_equiv_of_equiv _
        ⟨pempty.elim, fin.elim0, λ x, pempty.elim x, λ x, fin.elim0 x⟩) },
  exact @is_noetherian_ring_of_ring_equiv (polynomial (mv_polynomial (fin n) R)) _
    (mv_polynomial (fin (n+1)) R) _
    ((mv_polynomial.option_equiv_left _ _).symm.trans (mv_polynomial.ring_equiv_of_equiv _
      ⟨λ x, option.rec_on x 0 fin.succ, λ x, fin.cases none some x,
      by rintro ⟨none | x⟩; [refl, exact fin.cases_succ _],
      λ x, fin.cases rfl (λ i, show (option.rec_on (fin.cases none some (fin.succ i) : option (fin n))
        0 fin.succ : fin n.succ) = _, by rw fin.cases_succ) x⟩))
    (@@is_noetherian_ring_polynomial _ _ ih)
end

theorem is_noetherian_ring_mv_polynomial_of_fintype {σ : Type v} [fintype σ] [decidable_eq σ]
  [is_noetherian_ring R] : is_noetherian_ring (mv_polynomial σ R) :=
trunc.induction_on (fintype.equiv_fin σ) $ λ e,
@is_noetherian_ring_of_ring_equiv (mv_polynomial (fin (fintype.card σ)) R) _ _ _
  (mv_polynomial.ring_equiv_of_equiv _ e.symm) is_noetherian_ring_mv_polynomial_fin


-- Eliminación de la equivalencia en Lean
-- ======================================

-- Demostrar que si
--    P ↔ Q
--    Q → R
-- entonces
--    P → R

import tactic
variables (P Q R : Prop)

-- 1ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
begin
  intro hP,
  apply hQR,
  cases h with hPQ hQP,
  apply hPQ,
  exact hP,
end

-- 2ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
begin
  intro hP,
  apply hQR,
  cases h with hPQ hQP,
  exact hPQ hP,
end

-- 3ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
begin
  intro hP,
  exact hQR (h.1 hP),
end

-- 4ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
λ hP, hQR (h.1 hP)

-- 5ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
begin
  rw h,
  exact hQR,
end

-- 6ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
begin
  rw ← h at hQR,
  exact hQR,
end

-- 7ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
begin
  assume hP : P,
  have hQ : Q, from h.1 hP,
  show R, from hQR hQ,
end

-- 8ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
assume hP, hQR (h.1 hP)

-- 9ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
by tauto

-- 10ª demostración
example
  (h : P ↔ Q)
  (hQR : Q → R)
  : P → R :=
by finish


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

/-!
# The `finsupp` counterpart of `multiset.antidiagonal`.

The antidiagonal of `s : α →₀ ℕ` consists of
all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)` such that `t₁ + t₂ = s`.
-/

noncomputable theory
open_locale classical big_operators

namespace finsupp

open finset
variables {α : Type*}

/-- The `finsupp` counterpart of `multiset.antidiagonal`: the antidiagonal of
`s : α →₀ ℕ` consists of all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)` such that `t₁ + t₂ = s`.
The finitely supported function `antidiagonal s` is equal to the multiplicities of these pairs. -/
def antidiagonal' (f : α →₀ ℕ) : ((α →₀ ℕ) × (α →₀ ℕ)) →₀ ℕ :=
(f.to_multiset.antidiagonal.map (prod.map multiset.to_finsupp multiset.to_finsupp)).to_finsupp

/-- The antidiagonal of `s : α →₀ ℕ` is the finset of all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)`
such that `t₁ + t₂ = s`. -/
def antidiagonal (f : α →₀ ℕ) : finset ((α →₀ ℕ) × (α →₀ ℕ)) :=
f.antidiagonal'.support

@[simp] lemma mem_antidiagonal {f : α →₀ ℕ} {p : (α →₀ ℕ) × (α →₀ ℕ)} :
  p ∈ antidiagonal f ↔ p.1 + p.2 = f :=
begin
  rcases p with ⟨p₁, p₂⟩,
  simp [antidiagonal, antidiagonal', ← and.assoc, ← finsupp.to_multiset.apply_eq_iff_eq]
end

lemma swap_mem_antidiagonal {n : α →₀ ℕ} {f : (α →₀ ℕ) × (α →₀ ℕ)} :
  f.swap ∈ antidiagonal n ↔ f ∈ antidiagonal n :=
by simp only [mem_antidiagonal, add_comm, prod.swap]

lemma antidiagonal_filter_fst_eq (f g : α →₀ ℕ)
  [D : Π (p : (α →₀ ℕ) × (α →₀ ℕ)), decidable (p.1 = g)] :
  (antidiagonal f).filter (λ p, p.1 = g) = if g ≤ f then {(g, f - g)} else ∅ :=
begin
  ext ⟨a, b⟩,
  suffices : a = g → (a + b = f ↔ g ≤ f ∧ b = f - g),
  { simpa [apply_ite ((∈) (a, b)), ← and.assoc, @and.right_comm _ (a = _), and.congr_left_iff] },
  unfreezingI {rintro rfl}, split,
  { rintro rfl, exact ⟨le_add_right le_rfl, (add_tsub_cancel_left _ _).symm⟩ },
  { rintro ⟨h, rfl⟩, exact add_tsub_cancel_of_le h }
end

lemma antidiagonal_filter_snd_eq (f g : α →₀ ℕ)
  [D : Π (p : (α →₀ ℕ) × (α →₀ ℕ)), decidable (p.2 = g)] :
  (antidiagonal f).filter (λ p, p.2 = g) = if g ≤ f then {(f - g, g)} else ∅ :=
begin
  ext ⟨a, b⟩,
  suffices : b = g → (a + b = f ↔ g ≤ f ∧ a = f - g),
  { simpa [apply_ite ((∈) (a, b)), ← and.assoc, and.congr_left_iff] },
  unfreezingI {rintro rfl}, split,
  { rintro rfl, exact ⟨le_add_left le_rfl, (add_tsub_cancel_right _ _).symm⟩ },
  { rintro ⟨h, rfl⟩, exact tsub_add_cancel_of_le h }
end

@[simp] lemma antidiagonal_zero : antidiagonal (0 : α →₀ ℕ) = singleton (0,0) :=
by rw [antidiagonal, antidiagonal', multiset.to_finsupp_support]; refl

@[to_additive]
lemma prod_antidiagonal_swap {M : Type*} [comm_monoid M] (n : α →₀ ℕ)
  (f : (α →₀ ℕ) → (α →₀ ℕ) → M) :
  ∏ p in antidiagonal n, f p.1 p.2 = ∏ p in antidiagonal n, f p.2 p.1 :=
finset.prod_bij (λ p hp, p.swap) (λ p, swap_mem_antidiagonal.2) (λ p hp, rfl)
  (λ p₁ p₂ _ _ h, prod.swap_injective h)
  (λ p hp, ⟨p.swap, swap_mem_antidiagonal.2 hp, p.swap_swap.symm⟩)

end finsupp


import tactic.suggest
import tactic.solve_by_elim
import tactic.show_term
-- https://github.com/Sterrs/leaning/blob/lean-3.4.2/src/principia/mygroup/basic.lean
namespace hidden

set_option trace.simplify.rewrite true

class mygroup (α : Type)
extends has_mul α, has_inv α :=
(e : α)
(mul_assoc (a b c : α) : a * b * c = a * (b * c))
(mul_id (a : α) : a * e = a)
(mul_inv (a : α) : a * a⁻¹ = e)

namespace mygroup
variables {α : Type} [mygroup α]
variables {a b c : α}

theorem mul_right (c : α) : a = b → a * c = b * c :=
  begin
    assume h,
    type_check congr_arg (λ d, d * c⁻¹) h, -- (λ (d : α), d * c⁻¹) a = (λ (d : α), d * c⁻¹) b
    have h2 := congr_arg (λ d, d * c) h,
    dsimp only [] at h2,
    exact h2,
  end

theorem mul_by_right : a = b → a * c = b * c := mul_right c
theorem mul_left (c : α) : a = b → c * a = c * b :=
  begin
    assume h,
    congr,
    exact h,
  end

theorem inv_mul (a : α) : a⁻¹ * a = e :=
  begin
    rw ←mul_inv a,
    rw ←mul_id (a⁻¹ * a),
    rw ←mul_inv a⁻¹,
    rw ←mul_assoc (a⁻¹ * a) a⁻¹ a⁻¹⁻¹,
    -- simp only [mul_assoc, mul_id, mul_inv],
    rw mul_assoc a⁻¹,
    rw mul_inv a,
    rw mul_id a⁻¹,
    rw mul_inv a⁻¹,
    -- [hidden.mygroup.mul_assoc]: a⁻¹ * a * a⁻¹ ==> a⁻¹ * (a * a⁻¹)
    -- [hidden.mygroup.mul_inv]: a * a⁻¹ ==> e
    -- [hidden.mygroup.mul_id]: a⁻¹ * e ==> a⁻¹
    -- [hidden.mygroup.mul_inv]: a⁻¹ * a⁻¹⁻¹ ==> e
  end

theorem id_mul (a : α) : e * a = a :=
  begin
    rw ←mul_inv a,
    rw mul_assoc,
    rw inv_mul,
    rw mul_id,
    -- simp only [←mul_inv a, mul_assoc, inv_mul, mul_id],
    -- [[←mul_inv]]: e ==> a * a⁻¹
    -- [hidden.mygroup.mul_assoc]: a * a⁻¹ * a ==> a * (a⁻¹ * a)
    -- [hidden.mygroup.inv_mul]: a⁻¹ * a ==> e
    -- [[anonymous]]: e ==> a * a⁻¹

    -- anonymous <=> ←mul_inv
  end

theorem id_unique (a b : α) : a * b = a ↔ b = e :=
  begin
    split; assume h,
      have H := (mul_left a⁻¹) h,
      clear h,
      rw ←mul_assoc at H,
      rw inv_mul at H,
      rw id_mul at H,
      exact H,
    subst h,
    exact mul_id a,
    -- second way, but not works: https://github.com/Sterrs/leaning/blob/c0f3c5ee190184762ae7b926c999095f8ec9a9ac/src/principia/mygroup/basic.lean#L67-L70
    -- split; assume h,
    --   rwa [mul_left a, mul_id],
    -- subst h,
    -- from mul_id a,
  end

theorem inv_unique (a b : α) : a * b = e ↔ b = a⁻¹ :=
  begin
    split; assume h,
      have H := (mul_left a⁻¹) h,
      clear h,
      rw ←mul_assoc at H,
      rw inv_mul at H,
      rw [id_mul, mul_id] at H,
      exact H,
    subst h,
    exact mul_inv a,
  end

lemma inv_inv (a : α) : a⁻¹⁻¹ = a :=
  begin
    have h := inv_mul a⁻¹, -- ↔ @inv_mul α _inst_1 a⁻¹
    have H := mul_right a h,
    clear h,
    rw mul_assoc at H,
    rw inv_mul at H,
    rw [id_mul, mul_id] at H,
    exact H,
  end
---
attribute [simp] mul_right mul_left inv_mul id_mul mul_id id_unique inv_unique inv_inv mul_assoc mul_inv
namespace hidden2
lemma inv_four : a⁻¹⁻¹⁻¹⁻¹ = a :=
  begin
    have h := inv_inv a,
    have h2 := inv_inv a⁻¹⁻¹,
    exact eq.trans h2 h,
  end

lemma inv_four' : a⁻¹⁻¹⁻¹⁻¹ = a :=
  begin
    calc a⁻¹⁻¹⁻¹⁻¹ = a⁻¹⁻¹ : inv_inv a⁻¹⁻¹
               ... = a     : inv_inv a
  end

lemma inv_four'' : a⁻¹⁻¹⁻¹⁻¹ = a :=
  by calc a⁻¹⁻¹⁻¹⁻¹ = a⁻¹⁻¹ : inv_inv _
                ... = a     : inv_inv _

-- equals each other
#print inv_four
#print inv_four'
#print inv_four''

theorem id_mul' : e * a = a :=
  begin
    -- infinite loop:
    -- simp only [mul_assoc, inv_mul, mul_id, mul_inv a, ←mul_inv, ←mul_assoc, ←mul_id, ←mul_inv a, ←inv_mul],
    sorry,
  end
end hidden2

end mygroup

variables {α : Type} [mygroup α]
example (a : α) : a⁻¹⁻¹⁻¹⁻¹ = a := eq.trans (mygroup.inv_inv a⁻¹⁻¹) (mygroup.inv_inv a)

example (a : α) : a⁻¹⁻¹⁻¹⁻¹⁻¹⁻¹⁻¹⁻¹ = a := by simp
example (a : α) : a⁻¹⁻¹⁻¹⁻¹⁻¹⁻¹⁻¹ = a⁻¹ := by simp
example (a b c : α) : c⁻¹ * a⁻¹ * a * b = c⁻¹ * b := by simp

example (a : α) : a⁻¹⁻¹⁻¹⁻¹⁻¹⁻¹⁻¹⁻¹ = a :=
begin
  repeat {
    apply eq.trans,
    apply mygroup.inv_inv,
  }
  refl,
end

example (a : α) : a⁻¹⁻¹⁻¹ = a⁻¹ :=
begin
  repeat {
    apply eq.trans,
    apply mygroup.inv_inv,
    try { refl },
  },
end

example (a : α) : a⁻¹ = a⁻¹⁻¹⁻¹ :=
begin
  apply eq.symm,
  repeat {
    apply eq.trans,
    apply mygroup.inv_inv,
    try { refl },
  },
end

open int

example (n x a : ℤ) : abs x = a → x = a ∨ x = -a :=
begin
  intros h_abs,
  have helper : ∀ (k : ℤ), k < 0 ↔ ¬ k ≥ 0, sorry,
  by_cases (a < 0), {
    have h_pos : abs x >= 0, sorry,
    rw h_abs at h_pos,
    type_check iff.elim_left (helper a),
    type_check (helper a).elim_left,
    type_check (helper a).1,
    have H2 := iff.elim_left (helper a) h,
    contradiction,
  }, {
    rw helper _ at h,
    -- simp at h, -- not works
    -- change (a ≥ 0 → false) → false at h,
    have notnot : ∀ (p : Prop), p ↔ ¬¬p, from sorry, -- dec_trivial, simp, change not works
    type_check (notnot (a ≥ 0)).2 h,
    have new_h := (notnot (a ≥ 0)).2 h, clear h, rename new_h h,
    clear helper notnot,
    induction a,
    case int.of_nat {
      sorry,
    },
    case int.neg_succ_of_nat {
      sorry,
    },
  },

end

end hidden


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

import set_theory.cardinal_ordinal
import algebra.is_prime_pow

/-!
# Cardinal Divisibility

We show basic results about divisibility in the cardinal numbers. This relation can be characterised
in the following simple way: if `a` and `b` are both less than `ω`, then `a ∣ b` iff they are
divisible as natural numbers. If `b` is greater than `ω`, then `a ∣ b` iff `a ≤ b`. This furthermore
shows that all infinite cardinals are prime; recall that `a * b = max a b` if `ω ≤ a * b`; therefore
`a ∣ b * c = a ∣ max b c` and therefore clearly either `a ∣ b` or `a ∣ c`. Note furthermore that
no infinite cardinal is irreducible (`cardinal.not_irreducible_of_omega_le`), showing that the
cardinal numbers do not form a `comm_cancel_monoid_with_zero`.

## Main results

* `cardinal.prime_of_omega_le`: a `cardinal` is prime if it is infinite.
* `cardinal.is_prime_iff`: a `cardinal` is prime iff it is infinite or a prime natural number.
* `cardinal.is_prime_pow_iff`: a `cardinal` is a prime power iff it is infinite or a natural number
  which is itself a prime power.

-/

namespace cardinal

open_locale cardinal

universe u
variables {a b : cardinal.{u}} {n m : ℕ}

@[simp] lemma is_unit_iff : is_unit a ↔ a = 1 :=
begin
  refine ⟨λ h, _, by { rintro rfl, exact is_unit_one }⟩,
  rcases eq_or_ne a 0 with rfl | ha,
  { exact (not_is_unit_zero h).elim },
  rw is_unit_iff_forall_dvd at h,
  cases h 1 with t ht,
  rw [eq_comm, mul_eq_one_iff'] at ht,
  { exact ht.1 },
  all_goals { rwa one_le_iff_ne_zero },
  { rintro rfl,
    rw mul_zero at ht,
    exact zero_ne_one ht }
end

instance : unique cardinal.{u}ˣ :=
{ default := 1,
  uniq := λ a, units.coe_eq_one.mp $ is_unit_iff.mp a.is_unit }

theorem le_of_dvd : ∀ {a b : cardinal}, b ≠ 0 → a ∣ b → a ≤ b
| a _ b0 ⟨b, rfl⟩ := by simpa only [mul_one] using mul_le_mul_left'
  (one_le_iff_ne_zero.2 (λ h : b = 0, by simpa only [h, mul_zero] using b0)) a

lemma dvd_of_le_of_omega_le (ha : a ≠ 0) (h : a ≤ b) (hb : ω ≤ b) : a ∣ b :=
⟨b, (mul_eq_right hb h ha).symm⟩

@[simp] lemma prime_of_omega_le (ha : ω ≤ a) : prime a :=
begin
  refine ⟨(omega_pos.trans_le ha).ne', _, λ b c hbc, _⟩,
  { rw is_unit_iff,
    exact (one_lt_omega.trans_le ha).ne' },
  cases eq_or_ne (b * c) 0 with hz hz,
  { rcases mul_eq_zero.mp hz with rfl | rfl; simp },
  wlog h : c ≤ b,
  left,
  have habc := le_of_dvd hz hbc,
  rwa [mul_eq_max' $ ha.trans $ habc, max_def, if_pos h] at hbc
end

lemma not_irreducible_of_omega_le (ha : ω ≤ a) : ¬irreducible a :=
begin
  rw [irreducible_iff, not_and_distrib],
  refine or.inr (λ h, _),
  simpa [mul_omega_eq ha, is_unit_iff, (one_lt_omega.trans_le ha).ne', one_lt_omega.ne'] using h a ω
end

@[simp, norm_cast] lemma nat_coe_dvd_iff : (n : cardinal) ∣ m ↔ n ∣ m :=
begin
  refine ⟨_, λ ⟨h, ht⟩, ⟨h, by exact_mod_cast ht⟩⟩,
  rintro ⟨k, hk⟩,
  have : ↑m < ω := nat_lt_omega m,
  rw [hk, mul_lt_omega_iff] at this,
  rcases this with h | h | ⟨-, hk'⟩,
  iterate 2 { simp only [h, mul_zero,  zero_mul, nat.cast_eq_zero] at hk, simp [hk] },
  lift k to ℕ using hk',
  exact ⟨k, by exact_mod_cast hk⟩
end

@[simp] lemma nat_is_prime_iff : prime (n : cardinal) ↔ n.prime :=
begin
  simp only [prime, nat.prime_iff],
  refine and_congr (by simp) (and_congr _ ⟨λ h b c hbc, _, λ h b c hbc, _⟩),
  { simp only [is_unit_iff, nat.is_unit_iff],
    exact_mod_cast iff.rfl },
  { exact_mod_cast h b c (by exact_mod_cast hbc) },
  cases lt_or_le (b * c) ω with h' h',
  { rcases mul_lt_omega_iff.mp h' with rfl | rfl | ⟨hb, hc⟩,
    { simp },
    { simp },
    lift b to ℕ using hb,
    lift c to ℕ using hc,
    exact_mod_cast h b c (by exact_mod_cast hbc) },
  rcases omega_le_mul_iff.mp h' with ⟨hb, hc, hω⟩,
  have hn : (n : cardinal) ≠ 0,
  { intro h,
    rw [h, zero_dvd_iff, mul_eq_zero] at hbc,
    cases hbc; contradiction },
  wlog hω : ω ≤ b := hω using [b c],
  exact or.inl (dvd_of_le_of_omega_le hn ((nat_lt_omega n).le.trans hω) hω),
end

lemma is_prime_iff {a : cardinal} : prime a ↔ ω ≤ a ∨ ∃ p : ℕ, a = p ∧ p.prime :=
begin
  cases le_or_lt ω a with h h,
  { simp [h] },
  lift a to ℕ using id h,
  simp [not_le.mpr h]
end

lemma is_prime_pow_iff {a : cardinal} : is_prime_pow a ↔ ω ≤ a ∨ ∃ n : ℕ, a = n ∧ is_prime_pow n :=
begin
  by_cases h : ω ≤ a,
  { simp [h, (prime_of_omega_le h).is_prime_pow] },
  lift a to ℕ using not_le.mp h,
  simp only [h, nat.cast_inj, exists_eq_left', false_or, is_prime_pow_nat_iff],
  rw is_prime_pow_def,
  refine ⟨_, λ ⟨p, k, hp, hk, h⟩, ⟨p, k, nat_is_prime_iff.2 hp, by exact_mod_cast and.intro hk h⟩⟩,
  rintro ⟨p, k, hp, hk, hpk⟩,
  have key : _ ≤ p ^ k :=
    power_le_power_left hp.ne_zero (show (1 : cardinal) ≤ k, by exact_mod_cast hk),
  rw [power_one, hpk] at key,
  lift p to ℕ using key.trans_lt (nat_lt_omega a),
  exact ⟨p, k, nat_is_prime_iff.mp hp, hk, by exact_mod_cast hpk⟩
end

end cardinal


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland
-/
import algebra.ring.semiconj
import algebra.ring.units
import algebra.group.commute

/-!
# Semirings and rings

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

This file gives lemmas about semirings, rings and domains.
This is analogous to `algebra.group.basic`,
the difference being that the former is about `+` and `*` separately, while
the present file is about their interaction.

For the definitions of semirings and rings see `algebra.ring.defs`.

-/
universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x}

open function

namespace commute

@[simp] theorem add_right [distrib R] {a b c : R} :
  commute a b → commute a c → commute a (b + c) :=
semiconj_by.add_right

@[simp] theorem add_left [distrib R] {a b c : R} :
  commute a c → commute b c → commute (a + b) c :=
semiconj_by.add_left

lemma bit0_right [distrib R] {x y : R} (h : commute x y) : commute x (bit0 y) :=
h.add_right h

lemma bit0_left [distrib R] {x y : R} (h : commute x y) : commute (bit0 x) y :=
h.add_left h

lemma bit1_right [non_assoc_semiring R] {x y : R} (h : commute x y) : commute x (bit1 y) :=
h.bit0_right.add_right (commute.one_right x)

lemma bit1_left [non_assoc_semiring R] {x y : R} (h : commute x y) : commute (bit1 x) y :=
h.bit0_left.add_left (commute.one_left y)

/-- Representation of a difference of two squares of commuting elements as a product. -/
lemma mul_self_sub_mul_self_eq [non_unital_non_assoc_ring R] {a b : R} (h : commute a b) :
  a * a - b * b = (a + b) * (a - b) :=
by rw [add_mul, mul_sub, mul_sub, h.eq, sub_add_sub_cancel]

lemma mul_self_sub_mul_self_eq' [non_unital_non_assoc_ring R] {a b : R} (h : commute a b) :
  a * a - b * b = (a - b) * (a + b) :=
by rw [mul_add, sub_mul, sub_mul, h.eq, sub_add_sub_cancel]

lemma mul_self_eq_mul_self_iff [non_unital_non_assoc_ring R] [no_zero_divisors R] {a b : R}
  (h : commute a b) : a * a = b * b ↔ a = b ∨ a = -b :=
by rw [← sub_eq_zero, h.mul_self_sub_mul_self_eq, mul_eq_zero, or_comm, sub_eq_zero,
  add_eq_zero_iff_eq_neg]

section
variables [has_mul R] [has_distrib_neg R] {a b : R}

theorem neg_right : commute a b → commute a (- b) := semiconj_by.neg_right
@[simp] theorem neg_right_iff : commute a (-b) ↔ commute a b := semiconj_by.neg_right_iff

theorem neg_left : commute a b → commute (- a) b := semiconj_by.neg_left
@[simp] theorem neg_left_iff : commute (-a) b ↔ commute a b := semiconj_by.neg_left_iff

end

section
variables [mul_one_class R] [has_distrib_neg R] {a : R}

@[simp] theorem neg_one_right (a : R) : commute a (-1) := semiconj_by.neg_one_right a
@[simp] theorem neg_one_left (a : R): commute (-1) a := semiconj_by.neg_one_left a

end

section
variables [non_unital_non_assoc_ring R] {a b c : R}

@[simp] theorem sub_right : commute a b → commute a c → commute a (b - c) := semiconj_by.sub_right
@[simp] theorem sub_left : commute a c → commute b c → commute (a - b) c := semiconj_by.sub_left

end

end commute

/-- Representation of a difference of two squares in a commutative ring as a product. -/
theorem mul_self_sub_mul_self [comm_ring R] (a b : R) : a * a - b * b = (a + b) * (a - b) :=
(commute.all a b).mul_self_sub_mul_self_eq

lemma mul_self_sub_one [non_assoc_ring R] (a : R) : a * a - 1 = (a + 1) * (a - 1) :=
by rw [←(commute.one_right a).mul_self_sub_mul_self_eq, mul_one]

lemma mul_self_eq_mul_self_iff [comm_ring R] [no_zero_divisors R] {a b : R} :
  a * a = b * b ↔ a = b ∨ a = -b :=
(commute.all a b).mul_self_eq_mul_self_iff

lemma mul_self_eq_one_iff [non_assoc_ring R] [no_zero_divisors R] {a : R} :
  a * a = 1 ↔ a = 1 ∨ a = -1 :=
by rw [←(commute.one_right a).mul_self_eq_mul_self_iff, mul_one]

namespace units

/-- In the unit group of an integral domain, a unit is its own inverse iff the unit is one or
  one's additive inverse. -/
lemma inv_eq_self_iff [ring R] [no_zero_divisors R] (u : Rˣ) : u⁻¹ = u ↔ u = 1 ∨ u = -1 :=
begin
  rw inv_eq_iff_mul_eq_one,
  simp only [ext_iff],
  push_cast,
  exact mul_self_eq_one_iff
end

end units


import data.real.basic

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

example : (λ x y : ℝ, (x + y)^2) = (λ x y : ℝ, x^2 + 2*x*y + y^2) :=
by { ext, ring }

example (a b : ℝ) : abs a = abs (a - b + b) :=
by  { congr, ring }

example {a : ℝ} (h : 1 < a) : a < a * a :=
begin
  convert (mul_lt_mul_right _).2 h;
  linarith
end

theorem converges_to_const (a : ℝ) : converges_to (λ x : ℕ, a) a :=
begin
  intros ε εpos,
  use 0,
  intros n nge, dsimp,
  rw [sub_self, abs_zero],
  apply εpos
end

theorem converges_to_add {s t : ℕ → ℝ} {a b : ℝ}
  (cs : converges_to s a) (ct : converges_to t b):
converges_to (λ n, s n + t n) (a + b) :=
begin
  intros ε εpos, dsimp,
  have ε2pos : 0 < ε / 2,
  { linarith },
  cases cs (ε / 2) ε2pos with Ns hs,
  cases ct (ε / 2) ε2pos with Nt ht,
  use max Ns Nt,
  intros n hM,
  have h_ex1 : |s n - a| < ε / 2,
  { exact hs n (by linarith [le_max_left Ns Nt]) },
  -- `linarith` does require both arguments `Ns` and `Nt`
  have h_ex2 : |t n - b| < ε / 2,
  { exact ht n (by linarith [le_max_right Ns Nt]) },
  calc
    |s n + t n - (a + b)| = |s n - a + (t n - b)| : by ring
    ...      ≤ |s n - a| + |t n - b| : abs_add _ _
    ...      < ε/2 + ε/2 : by { linarith }
    ...      = ε : by ring,
end

theorem converges_to_mul_const {s : ℕ → ℝ} {a : ℝ}
    (c : ℝ) (cs : converges_to s a) :
  converges_to (λ n, c * s n) (c * a) :=
begin
  by_cases h : c = 0,
  { convert converges_to_const 0,
    { ext, rw [h, zero_mul] },
    rw [h, zero_mul] },
  have acpos : 0 < abs c,
    from abs_pos.mpr h,
  intros ε ε_pos, dsimp,
  have εcpos : 0 < ε / |c|,
  { exact div_pos ε_pos acpos},
  cases cs (ε / |c|) εcpos with Ns hs,
  use Ns,
  intros n hn,
  have : |c| * (ε / |c|) = ε,
  -- Next two goals solved in a horribly convoluted way
  { calc
    |c| * (ε / |c|)  = |c| * |c|⁻¹ * ε :  by ring
    ... =  ε : by { rw mul_inv_cancel, norm_num, linarith} },
  calc
  |c * s n - c * a| = |c| * |s n - a| : by rw [← mul_sub, abs_mul]
  ...               < ε                :
  begin
    convert @mul_lt_mul' ℝ (by apply_instance) (|c|) _ (|c|) (ε / |c|) _ _ _ _ ;
    linarith [hs n hn, abs_nonneg (s n - a)]
  end
end

theorem exists_abs_le_of_converges_to {s : ℕ → ℝ} {a : ℝ}
    (cs : converges_to s a) :
  ∃ N b, ∀ n, N ≤ n → abs (s n) < b :=
begin
  cases cs 1 zero_lt_one with N h,
  use [N, abs a + 1],
  sorry
end

lemma aux {s t : ℕ → ℝ} {a : ℝ}
    (cs : converges_to s a) (ct : converges_to t 0) :
  converges_to (λ n, s n * t n) 0 :=
begin
  intros ε εpos, dsimp,
  rcases exists_abs_le_of_converges_to cs with ⟨N₀, B, h₀⟩,
  have Bpos : 0 < B,
    from lt_of_le_of_lt (abs_nonneg _) (h₀ N₀ (le_refl _)),
  have pos₀ : ε / B > 0,
    from div_pos εpos Bpos,
  cases ct _ pos₀ with N₁ h₁,
  sorry
end

theorem converges_to_mul {s t : ℕ → ℝ} {a b : ℝ}
    (cs : converges_to s a) (ct : converges_to t b):
  converges_to (λ n, s n * t n) (a * b) :=
begin
  have h₁ : converges_to (λ n, s n * (t n - b)) 0,
  { apply aux cs,
    convert converges_to_add ct (converges_to_const (-b)),
    ring },
  convert (converges_to_add h₁ (converges_to_mul_const b cs)),
  { ext, ring },
  ring
end

theorem converges_to_unique {s : ℕ → ℝ} {a b : ℝ}
    (sa : converges_to s a) (sb : converges_to s b) :
  a = b :=
begin
  by_contradiction abne,
  have : abs (a - b) > 0,
  { apply lt_abs.mpr, norm_num, tauto},
  let ε := abs (a - b) / 2,
  have εpos : ε > 0,
  { change abs (a - b) / 2 > 0, linarith },
  cases sa ε εpos with Na hNa,
  cases sb ε εpos with Nb hNb,
  let N := max Na Nb,
  have absa : abs (s N - a) < ε,
  { exact hNa N (le_max_left Na Nb) },
  have absb : abs (s N - b) < ε,
  { exact hNb N (le_max_right Na Nb) },
  have : abs (a - b) < abs (a - b),
  {
    calc
    |a - b| = |(s N - b) - (s N - a)| : by ring
    ...     ≤ |s N - b| + |s N - a|   : by { apply abs_sub,}
    ...     < ε + ε   : by linarith
    ...     = |a - b| : by norm_num,
   },
  exact lt_irrefl _ this
end

section
variables {α : Type*} [linear_order α]

def converges_to' (s : α → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

end