/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import data.nat.log
import algebra.order.floor
import algebra.field_power

/-!
# Integer logarithms in a field with respect to a natural base

This file defines two `ℤ`-valued analogs of the logarithm of `r : R` with base `b : ℕ`:

* `int.log b r`: Lower logarithm, or floor **log**. Greatest `k` such that `↑b^k ≤ r`.
* `int.clog b r`: Upper logarithm, or **c**eil **log**. Least `k` such that `r ≤ ↑b^k`.

Note that `int.log` gives the position of the left-most non-zero digit:
```lean
#eval (int.log 10 (0.09 : ℚ), int.log 10 (0.10 : ℚ), int.log 10 (0.11 : ℚ))
--    (-2,                    -1,                    -1)
#eval (int.log 10 (9 : ℚ),    int.log 10 (10 : ℚ),   int.log 10 (11 : ℚ))
--    (0,                     1,                     1)
```
which means it can be used for computing digit expansions
```lean
import data.fin.vec_notation

def digits (b : ℕ) (q : ℚ) (n : ℕ) : ℕ :=
⌊q*b^(↑n - int.log b q)⌋₊ % b

#eval digits 10 (1/7) ∘ (coe : fin 8 → ℕ)
-- ![1, 4, 2, 8, 5, 7, 1, 4]
```

## Main results

* For `int.log`:
  * `int.zpow_log_le_self`, `int.lt_zpow_succ_log_self`: the bounds formed by `int.log`,
    `(b : R) ^ log b r ≤ r < (b : R) ^ (log b r + 1)`.
  * `int.zpow_log_gi`: the galois coinsertion between `zpow` and `int.log`.
* For `int.clog`:
  * `int.zpow_pred_clog_lt_self`, `int.self_le_zpow_clog`: the bounds formed by `int.clog`,
    `(b : R) ^ (clog b r - 1) < r ≤ (b : R) ^ clog b r`.
  * `int.clog_zpow_gi`:  the galois insertion between `int.clog` and `zpow`.
* `int.neg_log_inv_eq_clog`, `int.neg_clog_inv_eq_log`: the link between the two definitions.

-/
variables {R : Type*} [linear_ordered_field R] [floor_ring R]

namespace int

/-- The greatest power of `b` such that `b ^ log b r ≤ r`. -/
def log (b : ℕ) (r : R) : ℤ :=
if 1 ≤ r then
  nat.log b ⌊r⌋₊
else
  -nat.clog b ⌈r⁻¹⌉₊

lemma log_of_one_le_right (b : ℕ) {r : R} (hr : 1 ≤ r) : log b r = nat.log b ⌊r⌋₊ :=
if_pos hr

lemma log_of_right_le_one (b : ℕ) {r : R} (hr : r ≤ 1) : log b r = -nat.clog b ⌈r⁻¹⌉₊ :=
begin
  obtain rfl | hr := hr.eq_or_lt,
  { rw [log, if_pos hr, inv_one, nat.ceil_one, nat.floor_one, nat.log_one_right, nat.clog_one_right,
        int.coe_nat_zero, neg_zero], },
  { exact if_neg hr.not_le }
end

@[simp, norm_cast] lemma log_nat_cast (b : ℕ) (n : ℕ) : log b (n : R) = nat.log b n :=
begin
  cases n,
  { simp [log_of_right_le_one _ _, nat.log_zero_right] },
  { have : 1 ≤ (n.succ : R) := by simp,
    simp [log_of_one_le_right _ this, ←nat.cast_succ] }
end

lemma log_of_left_le_one {b : ℕ} (hb : b ≤ 1) (r : R) : log b r = 0 :=
begin
  cases le_total 1 r,
  { rw [log_of_one_le_right _ h, nat.log_of_left_le_one hb, int.coe_nat_zero] },
  { rw [log_of_right_le_one _ h, nat.clog_of_left_le_one hb, int.coe_nat_zero, neg_zero] },
end

lemma log_of_right_le_zero (b : ℕ) {r : R} (hr : r ≤ 0) : log b r = 0 :=
by rw [log_of_right_le_one _ (hr.trans zero_le_one),
    nat.clog_of_right_le_one ((nat.ceil_eq_zero.mpr $ inv_nonpos.2 hr).trans_le zero_le_one),
    int.coe_nat_zero, neg_zero]

lemma zpow_log_le_self {b : ℕ} {r : R} (hb : 1 < b) (hr : 0 < r) :
  (b : R) ^ log b r ≤ r :=
begin
  cases le_total 1 r with hr1 hr1,
  { rw log_of_one_le_right _ hr1,
    refine le_trans _ (nat.floor_le hr.le),
    rw [zpow_coe_nat, ←nat.cast_pow, nat.cast_le],
    exact nat.pow_log_le_self hb (nat.floor_pos.mpr hr1) },
  { rw [log_of_right_le_one _ hr1, zpow_neg, zpow_coe_nat, ← nat.cast_pow],
    apply inv_le_of_inv_le hr,
    refine (nat.le_ceil _).trans (nat.cast_le.2 _),
    exact nat.le_pow_clog hb _ },
end

lemma lt_zpow_succ_log_self {b : ℕ} (hb : 1 < b) (r : R) :
  r < (b : R) ^ (log b r + 1) :=
begin
  cases le_or_lt r 0 with hr hr,
  { rw [log_of_right_le_zero _ hr, zero_add, zpow_one],
    exact hr.trans_lt (zero_lt_one.trans_le $ by exact_mod_cast hb.le) },
  cases le_or_lt 1 r with hr1 hr1,
  { rw log_of_one_le_right _ hr1,
    rw [int.coe_nat_add_one_out, zpow_coe_nat, ←nat.cast_pow],
    apply nat.lt_of_floor_lt,
    exact nat.lt_pow_succ_log_self hb _, },
  { rw log_of_right_le_one _ hr1.le,
    have hcri : 1 < r⁻¹ := one_lt_inv hr hr1,
    have : 1 ≤ nat.clog b ⌈r⁻¹⌉₊ :=
      nat.succ_le_of_lt (nat.clog_pos hb $ nat.one_lt_cast.1 $ hcri.trans_le (nat.le_ceil _)),
    rw [neg_add_eq_sub, ←neg_sub, ←int.coe_nat_one, ← int.coe_nat_sub this,
      zpow_neg, zpow_coe_nat, lt_inv hr (pow_pos (nat.cast_pos.mpr $ zero_lt_one.trans hb) _),
      ←nat.cast_pow],
    refine nat.lt_ceil.1 _,
    exact (nat.pow_pred_clog_lt_self hb $ nat.one_lt_cast.1 $ hcri.trans_le $ nat.le_ceil _), }
end

@[simp] lemma log_zero_right (b : ℕ) : log b (0 : R) = 0 :=
log_of_right_le_zero b le_rfl

@[simp] lemma log_one_right (b : ℕ) : log b (1 : R) = 0 :=
by rw [log_of_one_le_right _ le_rfl, nat.floor_one, nat.log_one_right, int.coe_nat_zero]

lemma log_zpow {b : ℕ} (hb : 1 < b) (z : ℤ) : log b (b ^ z : R) = z :=
begin
  obtain ⟨n, rfl | rfl⟩ := z.eq_coe_or_neg,
  { rw [log_of_one_le_right _ (one_le_zpow_of_nonneg _ $ int.coe_nat_nonneg _),
      zpow_coe_nat, ←nat.cast_pow, nat.floor_coe, nat.log_pow hb],
    exact_mod_cast hb.le, },
  { rw [log_of_right_le_one _ (zpow_le_one_of_nonpos _ $ neg_nonpos.mpr (int.coe_nat_nonneg _)),
      zpow_neg, inv_inv, zpow_coe_nat, ←nat.cast_pow, nat.ceil_coe, nat.clog_pow _ _ hb],
    exact_mod_cast hb.le, },
end

@[mono] lemma log_mono_right {b : ℕ} {r₁ r₂ : R} (h₀ : 0 < r₁) (h : r₁ ≤ r₂) :
  log b r₁ ≤ log b r₂ :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw [log_of_left_le_one hb, log_of_left_le_one hb], },
  cases le_total r₁ 1 with h₁ h₁; cases le_total r₂ 1 with h₂ h₂,
  { rw [log_of_right_le_one _ h₁, log_of_right_le_one _ h₂, neg_le_neg_iff, int.coe_nat_le],
    exact nat.clog_mono_right _ (nat.ceil_mono $ inv_le_inv_of_le h₀ h), },
  { rw [log_of_right_le_one _ h₁, log_of_one_le_right _ h₂],
    exact (neg_nonpos.mpr (int.coe_nat_nonneg _)).trans (int.coe_nat_nonneg _) },
  { obtain rfl := le_antisymm h (h₂.trans h₁), refl, },
  { rw [log_of_one_le_right _ h₁, log_of_one_le_right _ h₂, int.coe_nat_le],
    exact nat.log_mono_right (nat.floor_mono h), },
end

variables (R)

/-- Over suitable subtypes, `zpow` and `int.log` form a galois coinsertion -/
def zpow_log_gi {b : ℕ} (hb : 1 < b) :
  galois_coinsertion
    (λ z : ℤ, subtype.mk ((b : R) ^ z) $ zpow_pos_of_pos (by exact_mod_cast zero_lt_one.trans hb) z)
    (λ r : set.Ioi (0 : R), int.log b (r : R)) :=
galois_coinsertion.monotone_intro
  (λ r₁ r₂, log_mono_right r₁.prop)
  (λ z₁ z₂ hz, subtype.coe_le_coe.mp $ (zpow_strict_mono $ by exact_mod_cast hb).monotone hz)
  (λ r, subtype.coe_le_coe.mp $ zpow_log_le_self hb r.prop)
  (λ _, log_zpow hb _)

variables {R}

/-- `zpow b` and `int.log b` (almost) form a Galois connection. -/
lemma lt_zpow_iff_log_lt {b : ℕ} (hb : 1 < b) {x : ℤ} {r : R} (hr : 0 < r) :
  r < (b : R) ^ x ↔ log b r < x :=
@galois_connection.lt_iff_lt _ _ _ _ _ _ (zpow_log_gi R hb).gc x ⟨r, hr⟩

/-- `zpow b` and `int.log b` (almost) form a Galois connection. -/
lemma zpow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x : ℤ} {r : R} (hr : 0 < r) :
  (b : R) ^ x ≤ r ↔ x ≤ log b r :=
@galois_connection.le_iff_le _ _ _ _ _ _ (zpow_log_gi R hb).gc x ⟨r, hr⟩

/-- The least power of `b` such that `r ≤ b ^ log b r`. -/
def clog (b : ℕ) (r : R) : ℤ :=
if 1 ≤ r then
  nat.clog b ⌈r⌉₊
else
  -nat.log b ⌊r⁻¹⌋₊

lemma clog_of_one_le_right (b : ℕ) {r : R} (hr : 1 ≤ r) : clog b r = nat.clog b ⌈r⌉₊ :=
if_pos hr

lemma clog_of_right_le_one (b : ℕ) {r : R} (hr : r ≤ 1) : clog b r = -nat.log b ⌊r⁻¹⌋₊ :=
begin
  obtain rfl | hr := hr.eq_or_lt,
  { rw [clog, if_pos hr, inv_one, nat.ceil_one, nat.floor_one, nat.log_one_right,
        nat.clog_one_right, int.coe_nat_zero, neg_zero], },
  { exact if_neg hr.not_le }
end

lemma clog_of_right_le_zero (b : ℕ) {r : R} (hr : r ≤ 0) : clog b r = 0 :=
begin
  rw [clog, if_neg (hr.trans_lt zero_lt_one).not_le, neg_eq_zero, int.coe_nat_eq_zero,
    nat.log_eq_zero_iff],
  cases le_or_lt b 1 with hb hb,
  { exact or.inr hb },
  { refine or.inl (lt_of_le_of_lt _ hb),
    exact nat.floor_le_one_of_le_one ((inv_nonpos.2 hr).trans zero_le_one) },
end

@[simp] lemma clog_inv (b : ℕ) (r : R) : clog b r⁻¹ = -log b r :=
begin
  cases lt_or_le 0 r with hrp hrp,
  { obtain hr | hr := le_total 1 r,
    { rw [clog_of_right_le_one _ (inv_le_one hr), log_of_one_le_right _ hr, inv_inv] },
    { rw [clog_of_one_le_right _ (one_le_inv hrp hr),  log_of_right_le_one _ hr, neg_neg] }, },
  { rw [clog_of_right_le_zero _ (inv_nonpos.mpr hrp), log_of_right_le_zero _ hrp, neg_zero], },
end

@[simp] lemma log_inv (b : ℕ) (r : R) : log b r⁻¹ = -clog b r :=
by rw [←inv_inv r, clog_inv, neg_neg, inv_inv]

-- note this is useful for writing in reverse
lemma neg_log_inv_eq_clog (b : ℕ) (r : R) : -log b r⁻¹ = clog b r :=
by rw [log_inv, neg_neg]

lemma neg_clog_inv_eq_log (b : ℕ) (r : R) : -clog b r⁻¹ = log b r :=
by rw [clog_inv, neg_neg]

@[simp, norm_cast] lemma clog_nat_cast (b : ℕ) (n : ℕ) : clog b (n : R) = nat.clog b n :=
begin
  cases n,
  { simp [clog_of_right_le_one _ _, nat.clog_zero_right] },
  { have : 1 ≤ (n.succ : R) := by simp,
    simp [clog_of_one_le_right _ this, ←nat.cast_succ] }
end

lemma clog_of_left_le_one {b : ℕ} (hb : b ≤ 1) (r : R) : clog b r = 0 :=
by rw [←neg_log_inv_eq_clog, log_of_left_le_one hb, neg_zero]

lemma self_le_zpow_clog {b : ℕ} (hb : 1 < b) (r : R) : r ≤ (b : R) ^ clog b r :=
begin
  cases le_or_lt r 0 with hr hr,
  { rw [clog_of_right_le_zero _ hr, zpow_zero],
    exact hr.trans zero_le_one },
  rw [←neg_log_inv_eq_clog, zpow_neg, le_inv hr (zpow_pos_of_pos _ _)],
  { exact zpow_log_le_self hb (inv_pos.mpr hr), },
  { exact nat.cast_pos.mpr (zero_le_one.trans_lt hb), },
end

lemma zpow_pred_clog_lt_self {b : ℕ} {r : R} (hb : 1 < b) (hr : 0 < r) :
  (b : R) ^ (clog b r - 1) < r :=
begin
  rw [←neg_log_inv_eq_clog, ←neg_add', zpow_neg, inv_lt (zpow_pos_of_pos _ _) hr],
  { exact lt_zpow_succ_log_self hb _, },
  { exact nat.cast_pos.mpr (zero_le_one.trans_lt hb), },
end

@[simp] lemma clog_zero_right (b : ℕ) : clog b (0 : R) = 0 :=
clog_of_right_le_zero _ le_rfl

@[simp] lemma clog_one_right (b : ℕ) : clog b (1 : R) = 0 :=
by rw [clog_of_one_le_right _ le_rfl, nat.ceil_one, nat.clog_one_right, int.coe_nat_zero]

lemma clog_zpow {b : ℕ} (hb : 1 < b) (z : ℤ) : clog b (b ^ z : R) = z :=
by rw [←neg_log_inv_eq_clog, ←zpow_neg, log_zpow hb, neg_neg]

@[mono] lemma clog_mono_right {b : ℕ} {r₁ r₂ : R} (h₀ : 0 < r₁) (h : r₁ ≤ r₂) :
  clog b r₁ ≤ clog b r₂ :=
begin
  rw [←neg_log_inv_eq_clog, ←neg_log_inv_eq_clog, neg_le_neg_iff],
  exact log_mono_right (inv_pos.mpr $ h₀.trans_le h) (inv_le_inv_of_le h₀ h),
end

variables (R)
/-- Over suitable subtypes, `int.clog` and `zpow` form a galois insertion -/
def clog_zpow_gi {b : ℕ} (hb : 1 < b) :
  galois_insertion
    (λ r : set.Ioi (0 : R), int.clog b (r : R))
    (λ z : ℤ, ⟨(b : R) ^ z, zpow_pos_of_pos (by exact_mod_cast zero_lt_one.trans hb) z⟩) :=
galois_insertion.monotone_intro
  (λ z₁ z₂ hz, subtype.coe_le_coe.mp $ (zpow_strict_mono $ by exact_mod_cast hb).monotone hz)
  (λ r₁ r₂, clog_mono_right r₁.prop)
  (λ r, subtype.coe_le_coe.mp $ self_le_zpow_clog hb _)
  (λ _, clog_zpow hb _)
variables {R}

/-- `int.clog b` and `zpow b` (almost) form a Galois connection. -/

/-- `int.clog b` and `zpow b` (almost) form a Galois connection. -/
lemma le_zpow_iff_clog_le {b : ℕ} (hb : 1 < b) {x : ℤ} {r : R} (hr : 0 < r) :
  r ≤ (b : R) ^ x ↔ clog b r ≤ x :=
(@galois_connection.le_iff_le _ _ _ _ _ _ (clog_zpow_gi R hb).gc ⟨r, hr⟩ x).symm

end int


import tactic.basic
import .ch07_indprop

/-
Check nat_ind.
-/

#check nat.rec_on

open nat

/-
Theorem mult_0_r' : ∀n:nat,
  n * 0 = 0.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *) simpl. intros n' IHn'. rewrite → IHn'.
    reflexivity. Qed.
-/

theorem mult_0_r' (n) : n * 0 = 0 :=
begin
  apply n.rec_on,
    refl,
  intros n' ih,
  /- i tried to get the ih in -/
  rw succ_mul,
  rw ih,
end

/-
Theorem plus_one_r' : ∀n:nat,
  n + 1 = S n.
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem plus_on_r' (n) : n + 1 = succ n :=
begin
  apply n.rec_on,
    refl,
  intros n' ih,
  rw ←ih,
end

/-
Inductive yesno : Type :=
  | yes
  | no.

Check yesno_ind.
(* ===> yesno_ind : forall P : yesno -> Prop,
                      P yes  ->
                      P no  ->
                      forall y : yesno, P y *)
-/

inductive yesno
| yes
| no

#check yesno.rec_on

/-
Inductive rgb : Type :=
  | red
  | green
  | blue.

Check rgb_ind.
-/

inductive rgb'
| red
| green
| blue

#check rgb.rec_on

/-
Inductive natlist : Type :=
  | nnil
  | ncons (n : nat) (l : natlist).

Check natlist_ind.
(* ===> (modulo a little variable renaming)
   natlist_ind :
      forall P : natlist -> Prop,
         P nnil  ->
         (forall (n : nat) (l : natlist),
            P l -> P (ncons n l)) ->
         forall n : natlist, P n *)
-/

inductive natlist
| nnil
| ncons (n : ℕ) (l : natlist)

#check natlist.rec_on

/-
Inductive natlist1 : Type :=
  | nnil1
  | nsnoc1 (l : natlist1) (n : nat).
-/

inductive natlist₁
| nnil₁
| nsnoc₁ (l : natlist₁) (n : ℕ)

#check natlist₁.rec_on

/-
Inductive byntree : Type :=
 | bempty
 | bleaf (yn : yesno)
 | nbranch (yn : yesno) (t1 t2 : byntree).
-/

inductive byntree
| bempty
| bleaf (yn : yesno)
| nbranch (yn : yesno) (t₁ t₂ : byntree)

#check byntree.rec_on

/-
Inductive ExSet : Type :=
  (* FILL IN HERE *)
.
-/

inductive ExSet
| con₁ (b : bool)
| con₂ (n : ℕ) (e : ExSet)

#check ExSet.rec_on

/-
Inductive list (X:Type) : Type :=
        | nil : list X
        | cons : X → list X → list X.
-/

inductive list' (α : Type)
| nil : list'
| cons : α → list' → list'

#check list'.rec_on

/-
Inductive tree (X:Type) : Type :=
  | leaf (x : X)
  | node (t1 t2 : tree X).

Check tree_ind.
-/

inductive tree (α : Type)
| leaf (a : α) : tree
| node (t₁ t₂ : tree) : tree

#check tree.rec_on

inductive mytype_ind (α : Type)
| constr₁ (a : α) : mytype_ind
| constr₂ (n : ℕ) : mytype_ind
| constr₃ (m : mytype_ind) (n : ℕ) : mytype_ind

#check mytype_ind.rec_on

inductive foo (α β : Type)
| bar (a : α) : foo
| baz (b : β) : foo
| quux (f₁ : ℕ → foo) : foo

#check foo.rec_on

/-
Inductive foo' (X:Type) : Type :=
  | C1 (l : list X) (f : foo' X)
  | C2.
-/

inductive foo' (α : Type)
| C₁ (l : list α) (f : foo') : foo'
| C₂ : foo'

#check foo'.rec_on

/-
Definition P_m0r (n:nat) : Prop :=
  n * 0 = 0.
-/

def P_m0r (n) := n * 0 = 0

/-
Definition P_m0r' : nat→Prop :=
  fun n ⇒ n * 0 = 0.
-/

def P_m0r' := λn, n * 0 = 0

/-
Theorem mult_0_r'' : ∀n:nat,
  P_m0r n.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* Note the proof state at this point! *)
    intros n IHn.
    unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn. Qed.
-/

theorem mult_0_r'' (n) : P_m0r n :=
begin
  apply n.rec_on,
    unfold P_m0r,
    refl,
  intros n ih,
  unfold P_m0r at ih,
  unfold P_m0r,
  rw succ_mul,
  apply ih,
end

/-
Theorem plus_assoc' : ∀n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* ...we first introduce all 3 variables into the context,
     which amounts to saying "Consider an arbitrary n, m, and
     p..." *)
  intros n m p.
  (* ...We now use the induction tactic to prove P n (that
     is, n + (m + p) = (n + m) + p) for _all_ n,
     and hence also for the particular n that is in the context
     at the moment. *)
  induction n as [| n'].
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* In the second subgoal generated by induction -- the
       "inductive step" -- we must prove that P n' implies
       P (S n') for all n'.  The induction tactic
       automatically introduces n' and P n' into the context
       for us, leaving just P (S n') as the goal. *)
    simpl. rewrite → IHn'. reflexivity. Qed.
-/

theorem plus_assoc''' (n m p : ℕ)
  : n + (m + p) = ((n + m) + p) :=
begin
  induction n with n' ih,
    repeat { rw zero_add, },
  rw succ_add,
  rw ih,
  repeat { rw ←succ_add, },
end

/-
Theorem plus_comm' : ∀n m : nat,
  n + m = m + n.
Proof.
  induction n as [| n'].
  - (* n = O *) intros m. rewrite <- plus_n_O. reflexivity.
  - (* n = S n' *) intros m. simpl. rewrite → IHn'.
    rewrite <- plus_n_Sm. reflexivity. Qed.
-/

/- does not work in lean -/
-- theorem plus_comm'
--   : ∀n m : ℕ, n + m = m + n :=
-- begin
--   induction n with n' ih,
-- end

/-
Theorem plus_comm'' : ∀n m : nat,
  n + m = m + n.
Proof.
  (* Let's do induction on m this time, instead of n... *)
  induction m as [| m'].
  - (* m = O *) simpl. rewrite <- plus_n_O. reflexivity.
  - (* m = S m' *) simpl. rewrite <- IHm'.
    rewrite <- plus_n_Sm. reflexivity. Qed.
-/

/- does not work in lean -/

def p_assoc (n m p : ℕ)
  := n + (m + p) = ((n + m) + p)

theorem plus_assoc'''' (n m p) : p_assoc n m p :=
begin
  induction n with n' ih,
    unfold p_assoc,
    repeat { rw zero_add },
  unfold p_assoc at *,
  rw [succ_add, ih, ←succ_add, ←succ_add],
end

def p_comm (n m : ℕ) := n + m = m + n

theorem plus_comm' (n m) : p_comm n m :=
begin
  induction n with n' ih generalizing m,
    unfold p_comm,
    rw zero_add,
    refl,
  unfold p_comm at *,
  rw [succ_add, ih],
end

/-
Inductive even : nat → Prop :=
    | ev_0 : even 0
    | ev_SS : ∀n : nat, even n → even (S (S n)).
-/

inductive even''' : ℕ → Prop
| ev_0 : even''' 0
| ev_SS : ∀n, even''' n → even''' (succ (succ n))

#check even.rec_on

theorem even'''_even'' {n} (h: even''' n) : even'' n :=
begin
  apply h.rec_on,
    exact even''.even''_0,
  intros n hn ih,
  exact even''.even''_sum n 2 ih (even''.even''_2),
end

inductive le' (n : ℕ) : ℕ → Prop
| le_n : le' n
| le_S (m) (h : le' m) : le' (succ m)

#check le.rec_on
#check le'.rec_on


/-
Copyright (c) 2022. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Firsching, Fabian Kruse, Nikolas Kuhn
-/
import analysis.p_series
import analysis.special_functions.log.deriv

/-!
# Stirling's formula

This file proves Theorem 90 from the [100 Theorem List] <https://www.cs.ru.nl/~freek/100/>.
It states that $n!$ grows asymptotically like $\sqrt{2\pi n}(\frac{n}{e})^n$.
TODO: Add Part 2 to complete the proof

## Proof outline

The proof follows: <https://proofwiki.org/wiki/Stirling%27s_Formula>.

### Part 1
We consider the fraction sequence $a_n$ of fractions $n!$ over $\sqrt{2n}(\frac{n}{e})^n$ and
proves that this sequence converges against a real, positve number $a$. For this the two main
ingredients are
 - taking the logarithm of the sequence and
 - use the series expansion of $\log(1 + x)$.
-/

open_locale topological_space big_operators
open finset filter nat real

namespace stirling

/-!
 ### Part 1
 https://proofwiki.org/wiki/Stirling%27s_Formula#Part_1
-/

/--
Define `stirling_seq n` as $\frac{n!}{\sqrt{2n}/(\frac{n}{e})^n$.
Stirling's formula states that this sequence has limit $\sqrt(π)$.
-/
noncomputable def stirling_seq (n : ℕ) : ℝ :=
n.factorial / (sqrt (2 * n) * (n / exp 1) ^ n)

/-- Define `log_stirling_seq n` as the log of `stirling_seq n`. -/
noncomputable def log_stirling_seq (n : ℕ) : ℝ := log (stirling_seq n)

/--
We have the expression
`log_stirling_seq (n + 1) = log(n + 1)! - 1 / 2 * log(2 * n) - n * log ((n + 1) / e)`.
-/
lemma log_stirling_seq_formula (n : ℕ) : log_stirling_seq n.succ =
  log n.succ.factorial - 1 / 2 * log (2 * n.succ) - n.succ * log (n.succ / exp 1) :=
begin
  have h3, from sqrt_ne_zero'.mpr (mul_pos two_pos $ cast_pos.mpr (succ_pos n)),
  have h4 : 0 ≠ ((n.succ : ℝ) / exp 1) ^ n.succ, from
    ne_of_lt (pow_pos (div_pos (cast_pos.mpr n.succ_pos ) (exp_pos 1)) n.succ),
  rw [log_stirling_seq, stirling_seq, log_div, log_mul, sqrt_eq_rpow, log_rpow, log_pow],
  { linarith },
  { refine (zero_lt_mul_left two_pos).mpr _,
    rw ←cast_zero,
    exact cast_lt.mpr (succ_pos n), },
  { exact h3, },
  { exact h4.symm, },
  { exact cast_ne_zero.mpr n.succ.factorial_ne_zero, },
  { apply (mul_ne_zero h3 h4.symm), },
end

/--
The sequence `log_stirling_seq (m + 1) - log_stirling_seq (m + 2)` has the series expansion
   `∑ 1 / (2 * (k + 1) + 1) * (1 / 2 * (m + 1) + 1)^(2 * (k + 1))`
-/
lemma log_stirling_seq_diff_has_sum (m : ℕ) :
  has_sum (λ k : ℕ, (1 : ℝ) / (2 * k.succ + 1) * ((1 / (2 * m.succ + 1)) ^ 2) ^ k.succ)
  (log_stirling_seq m.succ - log_stirling_seq m.succ.succ) :=
begin
  change
    has_sum ((λ b : ℕ, 1 / (2 * (b : ℝ) + 1) * ((1 / (2 * m.succ + 1)) ^ 2) ^ b) ∘ succ) _,
  rw has_sum_nat_add_iff 1,
  convert (has_sum_log_one_add_inv $ cast_pos.mpr (succ_pos m)).mul_left ((m.succ : ℝ) + 1 / 2),
  { ext k,
    rw [← pow_mul, pow_add],
    push_cast,
    have : 2 * (k : ℝ) + 1 ≠ 0, {norm_cast, exact succ_ne_zero (2*k)},
    have : 2 * ((m : ℝ) + 1) + 1 ≠ 0, {norm_cast, exact succ_ne_zero (2*m.succ)},
    field_simp,
    ring },
  { have h : ∀ (x : ℝ) (hx : x ≠ 0), 1 + x⁻¹ = (x + 1) / x,
    { intros, rw [_root_.add_div, div_self hx, inv_eq_one_div], },
    simp only [log_stirling_seq_formula, log_div, log_mul, log_exp, factorial_succ, cast_mul,
      cast_succ, cast_zero, range_one, sum_singleton, h] { discharger :=
      `[norm_cast, apply_rules [mul_ne_zero, succ_ne_zero, factorial_ne_zero, exp_ne_zero]] },
    ring },
  { apply_instance }
end

/-- The sequence `log_stirling_seq ∘ succ` is monotone decreasing -/
lemma log_stirling_seq'_antitone : antitone (log_stirling_seq ∘ succ) :=
begin
  apply antitone_nat_of_succ_le,
  intro n,
  rw [← sub_nonneg, ← succ_eq_add_one],
  refine (log_stirling_seq_diff_has_sum n).nonneg _,
  norm_num,
  simp only [one_div],
  intro m,
  refine mul_nonneg _ _,
  all_goals {refine inv_nonneg.mpr _, norm_cast, exact (zero_le _)},
end

/--
We have the bound  `log_stirling_seq n - log_stirling_seq (n+1) ≤ 1/(2n+1)^2* 1/(1-(1/2n+1)^2)`.
-/
lemma log_stirling_seq_diff_le_geo_sum (n : ℕ) :
  log_stirling_seq n.succ - log_stirling_seq n.succ.succ ≤
  (1 / (2 * n.succ + 1)) ^ 2 / (1 - (1 / (2 * n.succ + 1)) ^ 2) :=
begin
  have h_nonneg : 0 ≤ ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2),
  { rw [cast_succ, one_div, inv_pow, inv_nonneg], norm_cast, exact zero_le', },
  have g : has_sum (λ k : ℕ, ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2) ^ k.succ)
    ((1 / (2 * n.succ + 1)) ^ 2 / (1 - (1 / (2 * n.succ + 1)) ^ 2)),
  { have h_pow_succ := λ k : ℕ,
      symm (pow_succ ((1 / (2 * ((n : ℝ) + 1) + 1)) ^ 2) k),
    have hlt : (1 / (2 * (n.succ : ℝ) + 1)) ^ 2 < 1,
    { simp only [cast_succ, one_div, inv_pow],
      refine inv_lt_one _,
      norm_cast,
      simp only [nat.one_lt_pow_iff, ne.def, zero_eq_bit0, nat.one_ne_zero, not_false_iff,
        lt_add_iff_pos_left, canonically_ordered_comm_semiring.mul_pos, succ_pos', and_self], },
    exact (has_sum_geometric_of_lt_1 h_nonneg hlt).mul_left ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2) },
  have hab : ∀ (k : ℕ), (1 / (2 * (k.succ : ℝ) + 1)) * ((1 / (2 * n.succ + 1)) ^ 2) ^ k.succ ≤
    ((1 / (2 * n.succ + 1)) ^ 2) ^ k.succ,
  { intro k,
    have h_zero_le : 0 ≤ ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2) ^ k.succ := pow_nonneg h_nonneg _,
    have h_left : 1 / (2 * (k.succ : ℝ) + 1) ≤ 1,
    { rw [cast_succ, one_div],
      refine inv_le_one _,
      norm_cast,
      exact (le_add_iff_nonneg_left 1).mpr zero_le', },
    exact mul_le_of_le_one_left h_zero_le h_left, },
  exact has_sum_le hab (log_stirling_seq_diff_has_sum n) g,
end

/--
We have the bound  `log_stirling_seq n - log_stirling_seq (n+1)` ≤ 1/(4 n^2)
-/
lemma log_stirling_seq_sub_log_stirling_seq_succ (n : ℕ) :
  log_stirling_seq n.succ - log_stirling_seq n.succ.succ ≤ 1 / (4 * n.succ ^ 2) :=
begin
  have h₁ : 0 < 4 * ((n : ℝ) + 1) ^ 2 := by nlinarith [@cast_nonneg ℝ _ n],
  have h₃ : 0 < (2 * ((n : ℝ) + 1) + 1) ^ 2 := by nlinarith [@cast_nonneg ℝ _ n],
  have h₂ : 0 < 1 - (1 / (2 * ((n : ℝ) + 1) + 1)) ^ 2,
  { rw ← mul_lt_mul_right h₃,
    have H : 0 < (2 * ((n : ℝ) + 1) + 1) ^ 2 - 1 := by nlinarith [@cast_nonneg ℝ _ n],
    convert H using 1; field_simp [h₃.ne'] },
  refine (log_stirling_seq_diff_le_geo_sum n).trans _,
  push_cast at *,
  rw div_le_div_iff h₂ h₁,
  field_simp [h₃.ne'],
  rw div_le_div_right h₃,
  ring_nf,
  norm_cast,
  linarith,
end

/-- For any `n`, we have `log_stirling_seq 1 - log_stirling_seq n ≤ 1/4 * ∑' 1/k^2`  -/
lemma log_stirling_seq_bounded_aux :
  ∃ (c : ℝ), ∀ (n : ℕ), log_stirling_seq 1 - log_stirling_seq n.succ ≤ c :=
begin
  let d := ∑' k : ℕ, (1 : ℝ) / k.succ ^ 2,
  use (1 / 4 * d : ℝ),
  let log_stirling_seq' : ℕ → ℝ := λ k : ℕ, log_stirling_seq k.succ,
  intro n,
  calc
  log_stirling_seq 1 - log_stirling_seq n.succ = log_stirling_seq' 0 - log_stirling_seq' n : rfl
  ... = ∑ k in range n, (log_stirling_seq' k - log_stirling_seq' (k + 1)) : by
    rw ← sum_range_sub' log_stirling_seq' n
  ... ≤ ∑ k in range n, (1/4) * (1 / k.succ^2) : by
  { apply sum_le_sum,
    intros k hk,
    convert log_stirling_seq_sub_log_stirling_seq_succ k using 1,
    field_simp, }
  ... = 1 / 4 * ∑ k in range n, 1 / k.succ ^ 2 : by rw mul_sum
  ... ≤ 1 / 4 * d : by
  { refine (mul_le_mul_left _).mpr _, { exact one_div_pos.mpr four_pos, },
    refine sum_le_tsum (range n) (λ k _, _)
      ((summable_nat_add_iff 1).mpr (real.summable_one_div_nat_pow.mpr one_lt_two)),
    apply le_of_lt,
    rw one_div_pos,
    rw sq_pos_iff,
    exact nonzero_of_invertible ↑(succ k), },
end

/-- The sequence `log_stirling_seq` is bounded below for `n ≥ 1`. -/
lemma log_stirling_seq_bounded_by_constant : ∃ c, ∀ (n : ℕ), c ≤ log_stirling_seq n.succ :=
begin
  obtain ⟨d, h⟩ := log_stirling_seq_bounded_aux,
  use log_stirling_seq 1 - d,
  intro n,
  exact sub_le.mp (h n),
end

/-- The sequence `stirling_seq` is positive for `n > 0`  -/
lemma stirling_seq'_pos (n : ℕ) : 0 < stirling_seq n.succ :=
begin
  dsimp only [stirling_seq],
  apply_rules [div_pos, cast_pos.mpr, mul_pos, factorial_pos, exp_pos, pow_pos, real.sqrt_pos.mpr,
    two_pos, succ_pos] 7 {md := reducible}; apply_instance,
end

/--
The sequence `stirling_seq` has a positive lower bound.
-/
lemma stirling_seq'_bounded_by_pos_constant : ∃ a, 0 < a ∧ ∀ n : ℕ, a ≤ stirling_seq n.succ :=
begin
  cases log_stirling_seq_bounded_by_constant with c h,
  refine ⟨exp c, exp_pos _, λ n, _⟩,
  rw ← le_log_iff_exp_le (stirling_seq'_pos n),
  exact h n,
end

/-- The sequence `stirling_seq ∘ succ` is monotone decreasing -/
lemma stirling_seq'_antitone : antitone (stirling_seq ∘ succ) :=
λ n m h, (log_le_log (stirling_seq'_pos m) (stirling_seq'_pos n)).mp (log_stirling_seq'_antitone h)

/-- The limit `a` of the sequence `stirling_seq` satisfies `0 < a` -/
lemma stirling_seq_has_pos_limit_a :
  ∃ (a : ℝ), 0 < a ∧ tendsto stirling_seq at_top (𝓝 a) :=
begin
  obtain ⟨x, x_pos, hx⟩ := stirling_seq'_bounded_by_pos_constant,
  have hx' : x ∈ lower_bounds (set.range (stirling_seq ∘ succ)) := by simpa [lower_bounds] using hx,
  refine ⟨_, lt_of_lt_of_le x_pos (le_cInf (set.range_nonempty _) hx'), _⟩,
  rw ←filter.tendsto_add_at_top_iff_nat 1,
  exact tendsto_at_top_cinfi stirling_seq'_antitone ⟨x, hx'⟩,
end

end stirling


/-
Copyright (c) 2014 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Floris van Doorn, Jeremy Avigad
Distance function on the natural numbers.
-/
import data.nat.basic

namespace nat

/- distance -/

/-- Distance (absolute value of difference) between natural numbers. -/
def dist (n m : ℕ) := (n - m) + (m - n)

theorem dist.def (n m : ℕ) : dist n m = (n - m) + (m - n) := rfl

@[simp] theorem dist_comm (n m : ℕ) : dist n m = dist m n :=
by simp [dist.def]

@[simp] theorem dist_self (n : ℕ) : dist n n = 0 :=
by simp [dist.def, nat.sub_self]

theorem eq_of_dist_eq_zero {n m : ℕ} (h : dist n m = 0) : n = m :=
have n - m = 0, from eq_zero_of_add_eq_zero_right h,
have n ≤ m, from nat.le_of_sub_eq_zero this,
have m - n = 0, from eq_zero_of_add_eq_zero_left h,
have m ≤ n, from nat.le_of_sub_eq_zero this,
le_antisymm ‹n ≤ m› ‹m ≤ n›

theorem dist_eq_zero {n m : ℕ} (h : n = m) : dist n m = 0 :=
begin rw [h, dist_self] end

theorem dist_eq_sub_of_le {n m : ℕ} (h : n ≤ m) : dist n m = m - n :=
begin rw [dist.def, sub_eq_zero_of_le h, zero_add] end

theorem dist_eq_sub_of_ge {n m : ℕ} (h : n ≥ m) : dist n m = n - m :=
begin rw [dist_comm], apply dist_eq_sub_of_le h end

theorem dist_zero_right (n : ℕ) : dist n 0 = n :=
eq.trans (dist_eq_sub_of_ge (zero_le n)) (nat.sub_zero n)

theorem dist_zero_left (n : ℕ) : dist 0 n = n :=
eq.trans (dist_eq_sub_of_le (zero_le n)) (nat.sub_zero n)

theorem dist_add_add_right (n k m : ℕ) : dist (n + k) (m + k) = dist n m :=
calc
  dist (n + k) (m + k) = ((n + k) - (m + k)) + ((m + k)-(n + k)) : rfl
                   ... = (n - m) + ((m + k) - (n + k))   : by rw nat.add_sub_add_right
                   ... = (n - m) + (m - n)               : by rw nat.add_sub_add_right

theorem dist_add_add_left (k n m : ℕ) : dist (k + n) (k + m) = dist n m :=
begin rw [add_comm k n, add_comm k m], apply dist_add_add_right end

theorem dist_eq_intro {n m k l : ℕ} (h : n + m = k + l) : dist n k = dist l m :=
calc
  dist n k = dist (n + m) (k + m) : by rw dist_add_add_right
       ... = dist (k + l) (k + m) : by rw h
       ... = dist l m             : by rw dist_add_add_left

protected theorem sub_lt_sub_add_sub (n m k : ℕ) : n - k ≤ (n - m) + (m - k) :=
or.elim (le_total k m)
  (assume : k ≤ m,
    begin rw ←nat.add_sub_assoc this, apply nat.sub_le_sub_right, apply nat.le_sub_add end)
  (assume : k ≥ m,
    begin rw [sub_eq_zero_of_le this, add_zero], apply nat.sub_le_sub_left, exact this end)

theorem dist.triangle_inequality (n m k : ℕ) : dist n k ≤ dist n m + dist m k :=
have dist n m + dist m k = (n - m) + (m - k) + ((k - m) + (m - n)), by simp [dist.def],
begin
  rw [this, dist.def], apply add_le_add, repeat { apply nat.sub_lt_sub_add_sub }
end

theorem dist_mul_right (n k m : ℕ) : dist (n * k) (m * k) = dist n m * k :=
by rw [dist.def, dist.def, right_distrib, nat.mul_sub_right_distrib, nat.mul_sub_right_distrib]

theorem dist_mul_left (k n m : ℕ) : dist (k * n) (k * m) = k * dist n m :=
by rw [mul_comm k n, mul_comm k m, dist_mul_right, mul_comm]

-- TODO(Jeremy): do when we have max and minx
--theorem dist_eq_max_sub_min {i j : nat} : dist i j = (max i j) - min i j :=
--sorry
/-
or.elim (lt_or_ge i j)
  (assume : i < j,
    by rw [max_eq_right_of_lt this, min_eq_left_of_lt this, dist_eq_sub_of_lt this])
  (assume : i ≥ j,
    by rw [max_eq_left this , min_eq_right this, dist_eq_sub_of_ge this])
-/

theorem dist_succ_succ {i j : nat} : dist (succ i) (succ j) = dist i j :=
by simp [dist.def, succ_sub_succ]

theorem dist_pos_of_ne {i j : nat} : i ≠ j → dist i j > 0 :=
assume hne, nat.lt_by_cases
  (assume : i < j,
     begin rw [dist_eq_sub_of_le (le_of_lt this)], apply nat.sub_pos_of_lt this end)
  (assume : i = j, by contradiction)
  (assume : i > j,
     begin rw [dist_eq_sub_of_ge (le_of_lt this)], apply nat.sub_pos_of_lt this end)

end nat


/-
Formalising Mathematics - Project 3
Based on Number Theory module taken in term 1 of MSc in Pure Mathematics 2021-22
Submitted by: Additi Pandey
CID: 02119403
-/

--We will first import the necessary mathlib libraries needed to proceed with the definitions and proofs.
import tactic
import data.int.modeq
import data.zmod.basic
import data.int.gcd
import init.data.int.basic
import data.nat.prime
import algebra.big_operators.finprod
import number_theory.divisors

/-!
## Number Theory Problem - Reflexive and Corpulent Integers
This file is based on a problem in the Number Theory past paper for Year 3/4. The question
deals with a integer `n` which is said to be:
* Reflexive - If two conditions are equivalent, that is, if `∀ a,b ∈ ℤ` with `(a,b) = 1` then,
 `a ≡ b (mod n)` and `a*b ≡ 1 (mod n)`.
* Corpulent - If `∀ a ∈ ℤ` with `(a,n)=1`, `a^2 ≡ 1 (mod n)`.
The aim is to first show that `n` is reflexive ↔ `n` is corpulent and then show that if `n` is
corpulent then all prime divisors of `n` are also corpulent. -/

/-- Definition of Reflexive Number: An integer `1 ≤ n` is reflexive if for all integers `a b` with
`a.gcd b = 1`, the following two conditions are equivalent:
(i) `a ≡ b (mod n)`.
(ii) `a * b ≡ 1 (mod n)`.-/
def reflexiv {n : ℕ} (hn : 1 ≤ n) :=
(∀ {a b : ℤ} (h : a.gcd b = 1),  a ≡ b [ZMOD n] ↔ a * b ≡ 1 [ZMOD n])

/-
Hence, `reflexiv` defines a integer `n` which is `1 ≤ n` as reflexive. To define a natural
number `n` as corpulent, a `def` called `corpulent` is defined as :
-/

/--Definition of Corpulent Number: An integer `1 ≤ n` is corpulent if for all integers `a` with
`a.gcd n = 1`, we have `a^2 ≡ 1 (mod n)`.-/
def corpulent {n : ℕ} (hn : 1 ≤ n) :=
( ∀ {a : ℤ} (han : a.gcd n = 1), a^2  ≡ 1 [ZMOD n])

/-
We now declare the global variables `n` and `m` so that if they are used anywhere in the file,
Lean knows that they are in `ℕ` and `1 ≤ n`.
-/
variables  {n : ℕ} (hn : 1 ≤ n) {m : ℕ}

/-
To proceed with the proof of "`n` is reflexive ↔ `n` is corpulent", there was a requirement of a
lemma called  `int.gcd_add_self_left (m n : ℤ) : m.gcd (m + n) = m.gcd n` which says that:
if `m` and `n` are two integers then `gcd(m,m+n)` is same as the `gcd(m,n)`. So to show this,
Professor Kevin Buzzard defined `int.nat_abs_def` which says that if an integer `a ≥ 0` then it
is defined as `a` or else it is less than `0` and is defined as `-a`. He proceeded to further
define `int.add_nat_abs` which defines `(a+b).nat_abs`, `a.nat_abs` and `b.nat_abs` and defined
`int.gcd_add_self_right` which helped in defining `int.nat_add_self_left` by applying `add_comm`
and `gcd_comm` on the already proven `int.gcd_add_self_left` theorem.
-/

/-- This theorem applies cases on `a` to show that if `a ≥ 0` then it is either `a` or `-a`. -/
theorem int.nat_abs_def (a : ℤ) : (a.nat_abs : ℤ) = if 0 ≤ a then a else -a :=
begin
  cases a,
  { simp,},
  { ring,},
end

/-- Defining integers and their sum in `nat_abs`, i.e. coercing from `ℤ` to `ℕ`. -/
theorem int.add_nat_abs (a b : ℤ) :
  (a + b).nat_abs = a.nat_abs + b.nat_abs ∨
  a.nat_abs = (a + b).nat_abs + b.nat_abs ∨
  b.nat_abs = (a + b).nat_abs + a.nat_abs :=
begin
  zify,
  simp [int.nat_abs_def],
  split_ifs,
  { left, ring, },
  { right, left, ring, },
  { right, right, ring, },
  { linarith, },
  { linarith, },
  { right, right, ring, },
  { right, left, ring, },
  { left, ring },
end

/-- Given two integers `m` and `n`, show that `gcd(m,n+m) = gcd(m,n)`. -/
theorem int.gcd_add_self_right  (m n : ℤ) :
m.gcd (n + m) = m.gcd n :=
begin
  change (m.nat_abs).gcd (n + m).nat_abs = (m.nat_abs).gcd n.nat_abs,
  rcases int.add_nat_abs n m with (h | h | h);
  rw h,
  { exact (int.nat_abs m).gcd_add_self_right (int.nat_abs n) },
  { exact ((int.nat_abs m).gcd_add_self_right (n + m).nat_abs).symm },
  { rw nat.gcd_add_self_left,
    rw add_comm,
    rw nat.gcd_add_self_left,
    rw nat.gcd_comm },
end

/-- Using the above three theorems, I created a lemma that given integers `m` and `n`,
the  `gcd(m,m_n) = gcd(m,n)`. -/
@[simp]lemma int.gcd_add_self_left (m n : ℤ) : m.gcd (m + n) = m.gcd n :=
begin
  change (m.nat_abs).gcd (m + n).nat_abs = (m.nat_abs).gcd n.nat_abs,
  rcases int.add_nat_abs m n with (h | h | h);
  rw h,
  { exact (int.nat_abs m).gcd_self_add_right (int.nat_abs n),},
  { rw nat.gcd_add_self_left,
    rw add_comm,
    rw nat.gcd_add_self_left,
    rw nat.gcd_comm,},
  { rw add_comm,
    exact ((int.nat_abs m).gcd_add_self_right (n + m).nat_abs).symm,},
end

/-
Having defined `int.gcd_add_self_left`, there are two other lemmas needed that will help in
proving that an integer  `1 ≤ n` is reflexive ↔ `1 ≤ n` is corpulent. The first lemma is called
`gcd_sn_given_t_s` which gives the gcd of two numbers `s` and `n` (where `s` is an integer and since,
`n` is such that `1 ≤ n`, the number `n` is defined as `n : ℕ`), when `t ≡ s [ZMOD n]` and `gcd(s,t) = 1`.
This lemma has been proven by contradiction as it did not involve dealing with integer divisions, which
is a harder and lesser efficient approach.
After this, there is a lemma  `gcd_sn_given_st` defined, which by its name tells that given `gcd(s,t) = 1`
and `s*t ≡ 1 [ZMOD n]`, the `gcd(s,n) = 1`. Again, I proved this by contradiction, as it was easier
to avoid integer division in this method, which tends to be more pathological.
-/

/-- Given `gcd(s,t) = 1` and `t ≡ s [ZMOD n]`, show that `gcd(s,n) = 1`. -/
lemma gcd_sn_given_t_s {s t : ℤ} {n : ℕ} (hp : t ≡ s [ZMOD n]): (s.gcd t) = 1 → (s.gcd n) = 1 :=
begin
  intro hst,
  --We will now proceed by contradiction.
  apply of_not_not,
  intro hk,
  set d :=  (s.gcd n) with hd, -- Letting `d` to be the `gcd (s, n)`.
  -- Since `d` is the `gcd (s,n) → d ∣ s ∧ d ∣ n`.
  have h1: (d : ℤ) ∣ s,
  { apply int.gcd_dvd_left s n,},
  have h2: (d : ℤ) ∣ n,
  { apply int.gcd_dvd_right s n,},
  -- Since `d ∣ s → s = d * p`, for some `(p : ℤ)` and similarly, `↑n = ↑d * q`, for some `(q : ℤ)`.
  have h12: ∃ (p : ℤ), s = d * p,
  { assumption,},
  have h22 :  ∃ (q : ℤ), ↑n = ↑d * q,
  { assumption, },
  -- We have `t ≡ s [ZMOD n]`, so `↑n ∣ (t - s)` and since, `d ∣ n`, we have `d ∣ (t - s)`.
  have h4 : ↑ n ∣ (t - s),
  { apply int.modeq.dvd,
    exact hp.symm,},
  have h5' : (d : ℤ) ∣ (t - s),
  { cases h22 with c hc,
    exact dvd_trans h2 h4,},
  -- The previous hypothesis imply that `d ∣ s` and `d ∣ t` but we already have `h1` for former.
  have h5: (d : ℤ) ∣ t,
  { exact (dvd_iff_dvd_of_dvd_sub h5').mpr h1,},
  have h6: ↑ d ∣ ↑ (s.gcd t), -- Since `d` divides both `s` and `t`, it should divide their gcd.
  { apply int.dvd_gcd h1 h5,},
  rw hst at h6, -- The `gcd (s,t) = 1`
  norm_cast at *,
  -- `d ∣ 1` so `d = 1` but we assumed it is `≠ 1`, hence, a contradiction!
  finish,
end

/-- Given `gcd(s,t) = 1` and `s * t ≡ 1 [ZMOD n]`, show that `gcd(s,n) = 1`. -/
@[simp]lemma gcd_sn_given_st {s t : ℤ}{n : ℕ} (hp : s * t ≡ 1 [ZMOD n]) : s.gcd n = 1 :=
begin
  -- As there was no use of `gcd(s,t) = 1` in the proof, I omitted it from the definition of lemma.
  -- We will proceed by contradiction.
  apply of_not_not, -- Assume that the `gcd(s,n) ≠ 1`.
  intro hk,
  set d :=  (s.gcd n) with hd, -- Let `d` be the `gcd (s,n)`.
  -- Clearly `d ∣ s` and `d ∣ n`.
  have h1: (d : ℤ) ∣ s,
  { apply int.gcd_dvd_left s n,},
  have h2: (d : ℤ) ∣ n,
  { apply int.gcd_dvd_right s n,},
  -- Given `s * t ≡ 1 [ZMOD n] → ↑n ∣ (s*t -1)`.
  have h3: ↑ n ∣ (s * t - 1) ,
  { apply int.modeq.dvd,
    apply hp.symm,},
  rw dvd_iff_exists_eq_mul_left at h3,
  -- With `h3` now, we can express `s * t - 1` in terms of `n`.
  have h3' : ∃ (c : ℤ), s * t - n * c = 1,
  { cases h3 with k hk,
    use k,
    rw mul_comm ↑ n k,
    linarith,},
  -- Since `d ∣ s` and `d ∣ n`, `d` should divide their linear combination.
  have h4: ∃ (c : ℤ), ↑ d ∣ (s * t - n * c),
  { cases h1 with x hx,
    cases h2 with y hy,
    cases h3 with k hk,
    rw hx,
    rw hy,
    use k,
    rw [mul_assoc, mul_assoc],
    rw ← mul_sub (↑d) (x*t) (y * k),
    simp,},
  have hs : ∀ (c : ℤ), ↑ d ∣ s * c,
  { apply dvd_mul_of_dvd_left h1,},
  have hn : ∀ (c : ℤ), ↑ d ∣ ↑ n * c,
  { apply dvd_mul_of_dvd_left h2,},
  -- Since `∀ c` in ℤ,  `d ∣ s * c` , `d` will divide `s * t` where `t` is an integer.
  have hs_ : ↑ d ∣ s * t,
  { apply hs,},
  have hn_ : ∃ (c : ℤ), ↑d ∣ ↑n * c,
  { tauto,},
  -- Since `d` divides `s * t - ↑n * c` so it will divide `1` as well by `h3`.
  have h5: ↑ d ∣ (1 : ℤ),
  { cases h3' with k hk,
    rw ← hk,
    specialize hn k,
    apply dvd_sub hs_ hn, },
  norm_cast at *,
  finish, -- `d ∣ 1` → `d = 1` and this imply that our claim that `d ≠ 1` is false.
end

/-- Show that `n` is reflexive if and only if `n` is corpulent.-/
theorem reflexive_iff_corpulent : reflexiv hn ↔ corpulent hn :=
begin
  split,
  -- We will first prove the forward direction, i.e., `n` is reflexive → `n` is corpulent.
    { unfold reflexiv,
      unfold corpulent,
      intros hp q hqn,
      -- The goal now is to show that `q ^ 2 ≡ 1 [ZMOD ↑n]`, given `n`, `hn`, `hp`, `q`, `hqn`.
      have hp1 : q.gcd (q+n) = 1 → (q ≡ (q+n) [ZMOD ↑n] ↔ q * (q+n) ≡ 1 [ZMOD ↑n]),
        { exact hp},
      have hp2 : (q ≡ q + ↑n [ZMOD ↑n] ↔ q * (q + ↑n) ≡ 1 [ZMOD ↑n]),
        { rw hp1,
          simp,
          rw hqn },
      have hp3 : q * (q + ↑n) ≡ 1 [ZMOD ↑n],
        { rw ← hp2,
          apply int.modeq.symm,
          have h1 : q ≡ q [ZMOD ↑n] := int.modeq.rfl,
          have h2 : ↑n ≡ 0 [ZMOD ↑n],
          { rw int.modeq_zero_iff_dvd,},
          conv
            begin
              to_rhs,
              congr,
              skip,
              skip,
              rw ← add_zero q,
            end,
          apply int.modeq.add,
          exact h1,
          exact h2, },
      have hp4: (q * ↑n) ≡ 0 [ZMOD ↑n],
      { rw int.modeq,
        simp only [int.mul_mod_left, euclidean_domain.zero_mod],},
      have hp5 : q ^ 2 + (q * ↑n) ≡ 1 [ZMOD ↑n],
      { have h: q * q = q ^ 2,
        { ring,},
        rw ← h,
        rw ← mul_add,
        exact hp3,},
      set x := q + ↑n with hx,
      set y := q * ↑n with hy,
      have hp6: q ^ 2 + y - y ≡ 1 - 0 [ZMOD ↑n],
      { apply int.modeq.sub hp5 hp4,},
      simp at hp6,
      exact hp6,},
  -- We will now prove the converse, i.e. `n` is corpulent → `n` is reflexive.
    { unfold corpulent,
      unfold reflexiv,
      intros hp s t hst,
      -- After unfolding the definitions of reflexive and corpulent, we observe that given
      -- `n`, `hn`, `hp`, integers `s` and `t`, and a hypothesis `hst`, we need to show two
      -- things to prove that `n` is reflexive. So, the goal now is `s ≡ t [ZMOD ↑n] ↔ s * t ≡ 1 [ZMOD ↑n]`.
      split,
      -- We will first show that given `s ≡ t [ZMOD ↑n] →  s * t ≡ 1 [ZMOD ↑n]`.
      { intro hst_mod,
        have h : t * t = t ^ 2,
        { ring,},
        have hts : t ≡ s [ZMOD ↑n],
        { apply int.modeq.symm,
          exact hst_mod,},
        have htn : t.gcd n = 1,
        { rwa gcd_sn_given_t_s hst_mod,
          rwa int.gcd_comm,},
        have ht: t * t ≡ 1 [ZMOD ↑n],
        { rw h,
          apply hp,
          exact htn,},
        have hst : s * t ≡ t * t [ZMOD ↑n],
        { apply int.modeq.mul_right t hst_mod,},
        apply int.modeq.trans hst ht,},
      -- We will now show that `s * t ≡ 1 [ZMOD ↑n] → s ≡ t [ZMOD ↑n]`.
      { intro h_st,
        have hsn : s.gcd n = 1,
        { rwa gcd_sn_given_st h_st,},
        have hss : s^2 ≡ 1 [ZMOD ↑n],
        { apply hp,
          exact hsn,},
        have hs2 : s^2 = s * s,
        { ring,},
        have hs_modn : s * s ≡ 1 [ZMOD ↑n],
        { rw ← hs2,
          exact hss,},
        have hst2 : s * s - s * t ≡ 1 - 1 [ZMOD ↑n],
        { apply int.modeq.sub hs_modn h_st,},
        simp at hst2,
        have hst_sub : s * (s - t) = s * s - s * t ,
        { rw mul_sub,},
        have hp_st_sub: s * (s-t) ≡ 0 [ZMOD ↑n],
        { rw hst_sub,
          exact hst2,},
        have hn_dvd_st: ↑n ∣ s * (s - t),
        { set x := s * (s - t) with hx,
          rwa ← int.modeq_zero_iff_dvd,},
        have hns_gcd : (n : ℤ).gcd s = 1,
        { rw hsn.symm,
          exact int.gcd_comm n s,},
        have hn_dvd_st : ↑n ∣ (s - t),
        { apply int.dvd_of_dvd_mul_right_of_gcd_one hn_dvd_st hns_gcd,},
        have hts_modn: t ≡ s [ZMOD ↑n],
        { apply int.modeq_of_dvd,
          exact hn_dvd_st,},
        apply int.modeq.symm ,
        exact hts_modn,},},
  -- Hence, we proved that `n` is reflexive ↔ `n` is corpulent.
end

/-
To proceed with the next part of the project which is to prove that `n` is corpulent ↔
`m` is corpulent for every prime power `m` dividing `n`, I constructed a helper lemma called
`na.coprime_lift`, which shows that units in `[ZMOD n]` are the units in `[ZMOD m]`. To do so,
I constructed a `findprod f` called `x` to denote the product of all primes dividing `n` which
do not divide `b`, and `f` is a map from `nat.coprime_alpha` (which gives a condition on primes)
to the set of integers, such that `b` is some integer such that ∃ an `a₀ : ℤ` is coprime to `n`
and `a₀ ≡ b [ZMOD d]` where `d ∣ n` and `gcd(b,d) = 1`.
-/

/-- Defining a subtype `nat.coprime_alpha` such that `∀ n,d ∈ ℕ` and `b ∈ ℤ`, there is a set of
primes `p` which divide `n` but do not divide `b`. -/
@[nolint has_inhabited_instance] def nat.coprime_alpha (n : ℕ) (b : ℤ):
  Type := { p : ℕ // p∣n ∧ ¬ ↑p∣b ∧ p.prime}

/-
To proceed with the proof, there are lemmas that need to be defined as below:
The lemmas `dvd_mem_gcd` and `dvd_mem_gcd` state that if there are integers `a` and `b` such that
for all primes that divide `a`, do not divide `b` or primes that do not divide `b` and divide `a`,
the `gcd(a,b) = 1`. The lemma `dvd_mem_dvd_sum` is a basic lemma stating that if a number does not
divide one or all of the members, then it does not divide their sum. The proof of the same is by
contradiction.
-/

/-- For some integers `a` and `b`, and `∀ (p : ℕ)` where `p` is prime and divides `a`, then `p` do
not divide `b ↔ gcd (a,b) = 1`. -/
lemma dvd_mem_gcd (a b : ℤ) : (∀ p : ℕ, p.prime → ↑p ∣ a → ¬ ↑p ∣ b) ↔ a.gcd b = 1 :=
begin
  split,
  -- To show that: `a.gcd b = 1`
  { intro hp,
    -- We proceed by contradiction.
    apply of_not_not,
    set d:= a.gcd b with hd,
    intro hpd,
    have d_ne1 : d ≠ 1,
    { exact hpd, },
    -- If `a.gcd b` is not equal to `1` then there is a prime such that it divides the gcd.
    have hprime_d : ∃ (p : ℕ) , p.prime ∧ p ∣ d,
    { rwa nat.ne_one_iff_exists_prime_dvd at d_ne1,},
    -- Since the prime divides the `a.gcd b` → it divides `a` and `b`.
    have hprime_a_b :∃ (p : ℕ) , p.prime ∧ ↑p ∣ a ∧ ↑p ∣ b,
    {
      cases hprime_d with p hprime,
      use p,
      have hd_a : (d : ℤ) ∣ a,
      {
        exact int.gcd_dvd_left a b,
      },
      have hd_b : (d : ℤ) ∣ b,
      {
        exact int.gcd_dvd_right a b,
      },
      split,
      {exact hprime.1,},
      { split,
        { exact dvd_trans (int.coe_nat_dvd.mpr hprime.2) hd_a,},
        {exact dvd_trans (int.coe_nat_dvd.mpr hprime.2) hd_b,},},},
    finish,},
    -- To show : `a.gcd b = 1 → ∀ (p : ℕ), nat.prime p → ↑p ∣ a → ¬↑p ∣ b`
    { intros hp p hprime hp_a hp_b,
      have hp_gcd : ↑p ∣ ↑ (a.gcd b),
      { apply int.dvd_gcd hp_a hp_b,},
      rw hp at hp_gcd,
      -- Since `p` divides `a` and `b` and also their gcd → `p ∣ 1` but a prime does
      -- not divide `1`, hence, proved `a.gcd b = 1 → ∀ (p : ℕ), nat.prime p → ↑p ∣ a → ¬↑p ∣ b`
      apply nat.prime.not_dvd_one hprime (int.coe_nat_dvd.mp hp_gcd),
    },
end

/-- If `c` divides `a` and `c` does not divide `b`, then it does not divide their sum. -/
lemma dvd_mem_dvd_sum (a b c: ℤ) : (c ∣ a ∧ ¬ c ∣ b) →  ¬ c ∣ (a + b) :=
begin
  intros h_ab hp,
  set d:= a.gcd b with hd,
  have hc_a : c ∣ a ,
  { finish,},
  have hc_b : c ∣ ((a+b)-a),
  { apply dvd_sub hp hc_a,},
  simp at hc_b,
  finish,
end

/-- Define a map from `nat.coprime_alpha` to the set of natural numbers. -/
def nat.coprime_alpha_id (n : ℕ) (b : ℤ) : nat.coprime_alpha n b → ℕ := λ p, p.1

/-- To show that `f` is finite, where `f` is the map `nat.coprime_alpha_id`.-/
lemma nat.coprime_alpha_finite (n : ℕ) (b : ℤ) (hn : 0 < n) :
(function.mul_support (nat.coprime_alpha_id n b)).finite :=
begin
show set.finite {x : nat.coprime_alpha n b | nat.coprime_alpha_id n b x ≠ 1},
unfold nat.coprime_alpha_id,
have t : {a : ℕ | a ∣ n} ⊆ {a : ℕ | a ≤ n},
{ intro a,
  apply nat.le_of_dvd hn,},
have k : fintype (n.coprime_alpha b),
{ unfold nat.coprime_alpha,
  show fintype ↥{p | p ∣ n ∧ ¬↑p ∣ b ∧ nat.prime p},
  apply set.finite.fintype,
  rw [set.set_of_and, set.set_of_and],
  apply set.finite.inter_of_left,
  apply set.finite.subset (set.finite_le_nat _) t,},
apply @set.finite.of_fintype _ k _,
end

/-- Helper lemma to show that if `p ∣ finprod f` then there is a `t` in `α` such that
`p` divides that `t` in the product of `f t`-/
lemma prime_dvd_finprod {α : Type} (f : α → ℕ) (hf : (function.mul_support f).finite)
{p : ℕ} (hp : p.prime) : p ∣ finprod f ↔ ∃ t : α, p ∣ f t := sorry

/-- This is a pre-existing mathlib lemma that says that if a prime number is divisible by a
natural number which is not `1`, then the number is the prime number itself. -/
lemma nat.prime.dvd_iff_eq {p a : ℕ} (hp : p.prime) (a1 : a ≠ 1) : a ∣ p ↔ p = a := sorry

/- Please note: The above stated lemma is already there in mathlib but since the addition was
recent (in the month of March itself), I am unable to use it in my file. Hence, I mentioned it
here. -/

/-- Defining `nat.coprime_lift` which says that units in `[ZMOD n]` are units in `[ZMOD d]` where
`d∣n` and here, the goal is to show that this map is surjective. Reference for the proof can be found
on the link : https://math.stackexchange.com/q/487022 -/
lemma nat.coprime_lift {n d : ℕ} {b : ℤ}
  (hn : 1 ≤ n)
  (hs : d ∣ n)
  (hyp : b.gcd ↑d = 1) :
  ∃ a₀ : ℤ, a₀.gcd n = 1 ∧ a₀ ≡ b [ZMOD d] :=
begin
  set f:= nat.coprime_alpha_id n b,
  set x:= finprod f,
  use (b + d * x),
  have hyp' : (d : ℤ).gcd b = 1,
  { rwa int.gcd_comm ↑d b,},
  split,
  -- To first show that : `(b + ↑d * ↑x).gcd ↑n = 1`
  { set g:= (b + ↑d * x).gcd ↑n with hg,
    have h1: ↑g ∣ ↑n,
    { apply int.gcd_dvd_right (b + ↑d * x) ↑n,},
    have h2: ↑g ∣ (b + ↑d * x),
    { apply int.gcd_dvd_left (b + ↑d * x) ↑n,},
    -- To show that: All primes that divide `n`, do not divide `(b + ↑d * x)`:
    have h3: ∀ (p : ℕ), p.prime ∧ p ∣ n → ¬ ↑p ∣ (b + ↑d * x),
      { intros p hp1 hp2,
      by_cases (↑p ∣ b),
      -- To show if `p` divides `b` then it does not divide `(↑d * x)` hence,
      -- does not divide `(b + ↑d * x)`
      { have h3_pd : ¬ ↑p ∣ ↑d,
        { apply (dvd_mem_gcd b ↑d).mpr hyp p hp1.1 h,},
        have h3_pd_nat : ¬ p ∣ d,
        { intro ht,
        have hkt: ↑p ∣ ↑d,
        {exact int.coe_nat_dvd.mpr ht,}, finish, },
        have h3_px : ¬ p ∣ x,
        { intro hpx,
          change p ∣ finprod f at hpx,
          rw prime_dvd_finprod f (nat.coprime_alpha_finite n b hn) hp1.1 at hpx,
          cases hpx with t ht,
          change p ∣ t.1 at ht,
          set t_val2 := t.2,
          have h3_t_ne1 : t.val ≠ 1,
          { apply nat.prime.ne_one t_val2.2.2,},
          have h_p_ne1 : p ≠ 1,
          {apply nat.prime.ne_one hp1.1,},
          have h3_tp : p = t.val,
          { rw (nat.prime.dvd_iff_eq hp1.1 h3_t_ne1).mp,
            rwa (nat.prime.dvd_iff_eq t_val2.2.2 h_p_ne1).mp,},
          finish,},
        have h3'_p : ¬ p ∣ (d * x),
        { apply nat.prime.not_dvd_mul hp1.1 h3_pd_nat h3_px,},
        have h3''_p :  ¬ ↑p ∣ (d : ℤ) * x,
        { norm_cast,
          exact h3'_p,},
        have h3_p : ¬ ↑p ∣ (b + ↑d * x) ,
        { apply dvd_mem_dvd_sum b (↑d * x) ↑p,
          change ¬ (p : ℤ) ∣ ↑d * ↑x at h3''_p,
          refine ⟨h, h3''_p⟩,},
        finish,},
      -- To show if `p` does not divide `b` then it does not divide `(b + ↑d * x)`.
      { have h3' : p ∣ x,
        { show p ∣ finprod f,
         rw prime_dvd_finprod f (nat.coprime_alpha_finite n b hn) hp1.1,
         use p,
         finish,
         finish,},
         have h3'' : ↑ p ∣ ↑x,
         {  exact int.coe_nat_dvd.mpr h3'},
        have h3_p : ¬ ↑p ∣ (↑d * ↑x + b) ,
        { apply dvd_mem_dvd_sum (↑d * x) b ↑p,
        split,
        -- To show that `p` divides `(↑d * x)`.
        { apply dvd_mul_of_dvd_right h3'' ↑d,},
        -- To show that `p` does not divide `b`.
        {exact h,},},
        have h3_p : ¬ ↑p ∣ (b + ↑d * x ),
        { rwa add_comm at h3_p,},
        -- Hence, we have a contradiction at `hp2` and `h3_p`.
        finish,},},
        -- We have shown that all primes `p` that divide `n`, do not divide `(b + ↑d * x)`.
        -- To show: (b + ↑d * x).gcd n = 1
        show (b + d * x).gcd n = 1,
        have h3': ∀ (p : ℕ), p.prime → (p : ℤ) ∣ (n : ℤ) → ¬ ↑p ∣ (b + ↑d * x),
        {intros p hp hs ht, rw int.coe_nat_dvd at hs, finish, },
        rw ← (dvd_mem_gcd n (b + d*x)).mp h3',
        rw int.gcd_comm,},
  -- To show that: `b + ↑d * ↑x ≡ b [ZMOD ↑d]`.
  { rw int.modeq_iff_dvd,
    simp only [dvd_neg, sub_add_cancel', dvd_mul_right],},
end

/-
We now have all the lemmas needed to prove the second theorem of the project, so we define the theorem
as below and prove it by first unfolding our definitions and then using `nat.coprime_lift` and
`int.modeq.modeq_of_dvd`, we get `a₀ ^ 2 ≡ 1 [ZMOD ↑(p ^ e)]`. We will use this and `a₀ ≡ b [ZMOD ↑t]`
to show that `b ^ 2 ≡ 1 [ZMOD ↑(p ^ e)]` as follows:
-/

/--Show that `n` is corpulent if `m` is corpulent for every prime power `m|n`
(i.e. for every divisor of `n` of the form `p^e` with `1 ≤ e`).-/
theorem corpulent_two_int: corpulent hn →  ∀ {p e : ℕ} {hp : nat.prime p} {hm : (pow p e) ∣ n} ,
 corpulent (pow_pos (nat.pos_of_ne_zero (nat.prime.ne_zero hp)) e) :=
begin
  { unfold corpulent,
    intros hp p e s hs,
    unfold corpulent,
    intros b hyp,
    -- To show: `b ^ 2 ≡ 1 [ZMOD ↑(p ^ e)]`, we can use `nat.coprime_lift` and draw a
    -- connection between the units in `[ZMOD ↑n]` and `[ZMOD ↑(p ^ e)]`.
    obtain ⟨a₀, ha₀n, ha₀b⟩ := nat.coprime_lift hn hs hyp,
    specialize @hp a₀ ha₀n,
    set t:= (p ^ e) with ht,
    -- Since we have that `t ∣ n`, we can say that if `a₀ ^ 2 ≡ 1 [ZMOD ↑n]` then
    --`a₀ ^ 2 ≡ 1 [ZMOD ↑(p ^ e)]`.
    have ht: ↑t ∣ ↑n,
    { exact int.coe_nat_dvd.mpr hs, },
    have hp' : a₀ ^ 2 ≡ 1 [ZMOD ↑(p^e)],
    { apply int.modeq.modeq_of_dvd ht hp, },
    have hab : ↑t ∣ (a₀ - b),
    { apply int.modeq.dvd ,
      exact ha₀b.symm,},
    rw dvd_iff_exists_eq_mul_left at hab,
    -- Expressing `a₀` in terms of `↑t` and `b`, so that we can get an expression for `b` and `↑t`:
    have h_ab: ∃ (c : ℤ), a₀ = c * ↑t + b,
    { cases hab with k hk,
      use k,
      rw ← mul_comm ↑t k,
      linarith, },
    have h_ap : ↑t ∣ (a₀ ^ 2 - 1),
    { apply int.modeq.dvd ,
    exact hp'.symm, },
    rw dvd_iff_exists_eq_mul_left at h_ap,
    have h_bp : ∃ (c k : ℤ), (c * ↑t + b)^2 - 1 = k * ↑t,
    { cases h_ap with l hl,
      cases h_ab with s hs,
      use s,
      use l,
      rwa ← hs, },
      -- To show that in the expansion of `(c * ↑t + b)^2` , all terms with `↑t` can be grouped together
      -- and be expressed just as `g * ↑t` for some integer `g`.
    have helper : ∃ (c k : ℤ), b ^ 2 - 1 = k * ↑t - c ^ 2 * ↑t ^ 2 - 2 * c * ↑t * b,
    { cases h_bp with x hx,
      cases hx with y hy,
      rw add_pow_two (x * ↑t) (b) at hy,
      use x,
      use y,
      apply eq_sub_of_add_eq',
      apply eq_sub_of_add_eq',
      rw (mul_pow x ↑t 2).symm,
      rw ← add_assoc,
      rw add_sub,
      nth_rewrite 1 (mul_assoc),
      exact hy,},
    have h_bp' : ∃ (g : ℤ), b^2 - 1 = g * ↑t,
    { cases helper with c hc,
      cases hc with k hk,
      use (k - c ^ 2 * ↑t - 2 * c  * b),
      rw mul_sub_right_distrib,
      rw mul_sub_right_distrib,
      rw hk,
      ring, },
    -- Since `↑t` divides `b^2 - 1`, we can say that `b^2 ≡ 1 [ZMOD ↑t]`.
    rw ← dvd_iff_exists_eq_mul_left at h_bp',
    have h_bp_mod : 1 ≡ b^2 [ZMOD ↑t],
    { apply int.modeq_of_dvd,
      exact h_bp',},
    exact h_bp_mod.symm,},
end

#lint
/-While there are the `unused_arguments` linter reports but I feel that they are really
important to be a part of definition to maintain coherency, hence I did not remove them. -/


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro

! This file was ported from Lean 3 source module data.nat.pairing
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Sqrt
import Mathlib.Data.Set.Lattice
import Mathlib.Algebra.Group.Prod
import Mathlib.Algebra.Order.Monoid.MinMax

/-!
#  Naturals pairing function

This file defines a pairing function for the naturals as follows:
```text
 0  1  4  9 16
 2  3  5 10 17
 6  7  8 11 18
12 13 14 15 19
20 21 22 23 24
```

It has the advantage of being monotone in both directions and sending `⟦0, n^2 - 1⟧` to
`⟦0, n - 1⟧²`.
-/

open Prod Decidable Function

namespace Nat

/-- Pairing function for the natural numbers. -/
-- porting notes: no pp_nodot
--@[pp_nodot]
def pair (a b : ℕ) : ℕ :=
  if a < b then b * b + a else a * a + a + b
#align nat.mkpair Nat.pair

/-- Unpairing function for the natural numbers. -/
-- porting notes: no pp_nodot
--@[pp_nodot]
def unpair (n : ℕ) : ℕ × ℕ :=
  let s := sqrt n
  if n - s * s < s then (n - s * s, s) else (s, n - s * s - s)
#align nat.unpair Nat.unpair

@[simp]
theorem pair_unpair (n : ℕ) : pair (unpair n).1 (unpair n).2 = n := by
  dsimp only [unpair]; let s := sqrt n
  have sm : s * s + (n - s * s) = n := add_tsub_cancel_of_le (sqrt_le _)
  split_ifs with h
  · simp [pair, h, sm]
  · have hl : n - s * s - s ≤ s :=
      tsub_le_iff_left.mpr (tsub_le_iff_left.mpr <| by rw [← add_assoc] ; apply sqrt_le_add)
    simp [pair, hl.not_lt, add_assoc, add_tsub_cancel_of_le (le_of_not_gt h), sm]
#align nat.mkpair_unpair Nat.pair_unpair

theorem pair_unpair' {n a b} (H : unpair n = (a, b)) : pair a b = n := by
  simpa [H] using pair_unpair n
#align nat.mkpair_unpair' Nat.pair_unpair'

@[simp]

/-- An equivalence between `ℕ × ℕ` and `ℕ`. -/
@[simps (config := { fullyApplied := false })]
def pairEquiv : ℕ × ℕ ≃ ℕ :=
  ⟨uncurry pair, unpair, fun ⟨a, b⟩ => unpair_pair a b, pair_unpair⟩
#align nat.mkpair_equiv Nat.pairEquiv
#align nat.mkpair_equiv_apply Nat.pairEquiv_apply
#align nat.mkpair_equiv_symm_apply Nat.pairEquiv_symm_apply

theorem surjective_unpair : Surjective unpair :=
  pairEquiv.symm.surjective
#align nat.surjective_unpair Nat.surjective_unpair

@[simp]
theorem pair_eq_pair {a b c d : ℕ} : pair a b = pair c d ↔ a = c ∧ b = d :=
  pairEquiv.injective.eq_iff.trans (@Prod.ext_iff ℕ ℕ (a, b) (c, d))
#align nat.mkpair_eq_mkpair Nat.pair_eq_pair

theorem unpair_lt {n : ℕ} (n1 : 1 ≤ n) : (unpair n).1 < n := by
  let s := sqrt n
  simp [unpair];
  by_cases h : n - s * s < s <;> simp [h]
  · exact lt_of_lt_of_le h (sqrt_le_self _)
  · simp at h
    have s0 : 0 < s := sqrt_pos.2 n1
    exact lt_of_le_of_lt h (tsub_lt_self n1 (mul_pos s0 s0))
#align nat.unpair_lt Nat.unpair_lt

@[simp]
theorem unpair_zero : unpair 0 = 0 := by
  rw [unpair]
  simp
#align nat.unpair_zero Nat.unpair_zero

theorem unpair_left_le : ∀ n : ℕ, (unpair n).1 ≤ n
  | 0 => by simp
  | n + 1 => le_of_lt (unpair_lt (Nat.succ_pos _))
#align nat.unpair_left_le Nat.unpair_left_le

theorem left_le_pair (a b : ℕ) : a ≤ pair a b := by simpa using unpair_left_le (pair a b)
#align nat.left_le_mkpair Nat.left_le_pair

theorem right_le_pair (a b : ℕ) : b ≤ pair a b := by
  by_cases h : a < b <;> simp [pair, h]
  exact le_trans (le_mul_self _) (Nat.le_add_right _ _)
#align nat.right_le_mkpair Nat.right_le_pair

theorem unpair_right_le (n : ℕ) : (unpair n).2 ≤ n := by
  simpa using right_le_pair n.unpair.1 n.unpair.2
#align nat.unpair_right_le Nat.unpair_right_le

theorem pair_lt_pair_left {a₁ a₂} (b) (h : a₁ < a₂) : pair a₁ b < pair a₂ b := by
  by_cases h₁ : a₁ < b <;> simp [pair, h₁, add_assoc]
  · by_cases h₂ : a₂ < b <;> simp [pair, h₂, h]
    simp at h₂
    apply add_lt_add_of_le_of_lt
    exact mul_self_le_mul_self h₂
    exact Nat.lt_add_right _ _ _ h
  · simp at h₁
    simp [not_lt_of_gt (lt_of_le_of_lt h₁ h)]
    apply add_lt_add
    exact mul_self_lt_mul_self h
    apply add_lt_add_right ; assumption
#align nat.mkpair_lt_mkpair_left Nat.pair_lt_pair_left

theorem pair_lt_pair_right (a) {b₁ b₂} (h : b₁ < b₂) : pair a b₁ < pair a b₂ := by
  by_cases h₁ : a < b₁ <;> simp [pair, h₁, add_assoc]
  · simp [pair, lt_trans h₁ h, h]
    exact mul_self_lt_mul_self h
  · by_cases h₂ : a < b₂ <;> simp [pair, h₂, h]
    simp at h₁
    rw [add_comm, add_comm _ a, add_assoc, add_lt_add_iff_left]
    rwa [add_comm, ← sqrt_lt, sqrt_add_eq]
    exact le_trans h₁ (Nat.le_add_left _ _)
#align nat.mkpair_lt_mkpair_right Nat.pair_lt_pair_right

theorem pair_lt_max_add_one_sq (m n : ℕ) : pair m n < (max m n + 1) ^ 2 := by
  rw [pair, add_sq, mul_one, two_mul, sq, add_assoc, add_assoc]
  cases' (lt_or_le m n) with h h
  rw [if_pos h, max_eq_right h.le, add_lt_add_iff_left, add_assoc]
  exact h.trans_le (self_le_add_right n _)
  rw [if_neg h.not_lt, max_eq_left h, add_lt_add_iff_left, add_assoc, add_lt_add_iff_left]
  exact lt_succ_of_le h
#align nat.mkpair_lt_max_add_one_sq Nat.pair_lt_max_add_one_sq

theorem max_sq_add_min_le_pair (m n : ℕ) : max m n ^ 2 + min m n ≤ pair m n := by
  rw [pair]
  cases' lt_or_le m n with h h
  rw [if_pos h, max_eq_right h.le, min_eq_left h.le, sq]
  rw [if_neg h.not_lt, max_eq_left h, min_eq_right h, sq, add_assoc, add_le_add_iff_left]
  exact le_add_self
#align nat.max_sq_add_min_le_mkpair Nat.max_sq_add_min_le_pair

theorem add_le_pair (m n : ℕ) : m + n ≤ pair m n :=
  (max_sq_add_min_le_pair _ _).trans' <| by
    rw [sq, ← min_add_max, add_comm, add_le_add_iff_right]
    exact le_mul_self _
#align nat.add_le_mkpair Nat.add_le_pair

theorem unpair_add_le (n : ℕ) : (unpair n).1 + (unpair n).2 ≤ n :=
  (add_le_pair _ _).trans_eq (pair_unpair _)
#align nat.unpair_add_le Nat.unpair_add_le

end Nat

open Nat

section CompleteLattice

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
theorem supᵢ_unpair {α} [CompleteLattice α] (f : ℕ → ℕ → α) :
    (⨆ n : ℕ, f n.unpair.1 n.unpair.2) = ⨆ (i : ℕ) (j : ℕ), f i j := by
  rw [← (supᵢ_prod : (⨆ i : ℕ × ℕ, f i.1 i.2) = _), ← Nat.surjective_unpair.supᵢ_comp]
#align supr_unpair supᵢ_unpair

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
theorem infᵢ_unpair {α} [CompleteLattice α] (f : ℕ → ℕ → α) :
    (⨅ n : ℕ, f n.unpair.1 n.unpair.2) = ⨅ (i : ℕ) (j : ℕ), f i j :=
  supᵢ_unpair (show ℕ → ℕ → αᵒᵈ from f)
#align infi_unpair infᵢ_unpair

end CompleteLattice

namespace Set

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem unionᵢ_unpair_prod {α β} {s : ℕ → Set α} {t : ℕ → Set β} :
    (⋃ n : ℕ, s n.unpair.fst ×ˢ t n.unpair.snd) = (⋃ n, s n) ×ˢ ⋃ n, t n := by
  rw [← Set.unionᵢ_prod]
  exact surjective_unpair.unionᵢ_comp (fun x => s x.fst ×ˢ t x.snd)
#align set.Union_unpair_prod Set.unionᵢ_unpair_prod

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
theorem unionᵢ_unpair {α} (f : ℕ → ℕ → Set α) :
    (⋃ n : ℕ, f n.unpair.1 n.unpair.2) = ⋃ (i : ℕ) (j : ℕ), f i j :=
  supᵢ_unpair f
#align set.Union_unpair Set.unionᵢ_unpair

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
theorem interᵢ_unpair {α} (f : ℕ → ℕ → Set α) :
    (⋂ n : ℕ, f n.unpair.1 n.unpair.2) = ⋂ (i : ℕ) (j : ℕ), f i j :=
  infᵢ_unpair f
#align set.Inter_unpair Set.interᵢ_unpair

end Set


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov
-/
import algebra.hom.equiv.basic
import algebra.hom.units

/-!
# Multiplicative and additive equivalence acting on units.

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

variables {F α β A B M N P Q G H : Type*}

/-- A group is isomorphic to its group of units. -/
@[to_additive "An additive group is isomorphic to its group of additive units"]
def to_units [group G] : G ≃* Gˣ :=
{ to_fun := λ x, ⟨x, x⁻¹, mul_inv_self _, inv_mul_self _⟩,
  inv_fun := coe,
  left_inv := λ x, rfl,
  right_inv := λ u, units.ext rfl,
  map_mul' := λ x y, units.ext rfl }

@[simp, to_additive] lemma coe_to_units [group G] (g : G) :
  (to_units g : G) = g := rfl

namespace units

variables [monoid M] [monoid N] [monoid P]

/-- A multiplicative equivalence of monoids defines a multiplicative equivalence
of their groups of units. -/
def map_equiv (h : M ≃* N) : Mˣ ≃* Nˣ :=
{ inv_fun := map h.symm.to_monoid_hom,
  left_inv := λ u, ext $ h.left_inv u,
  right_inv := λ u, ext $ h.right_inv u,
  .. map h.to_monoid_hom }

@[simp]
lemma map_equiv_symm (h : M ≃* N) : (map_equiv h).symm = map_equiv h.symm :=
rfl

@[simp]
lemma coe_map_equiv (h : M ≃* N) (x : Mˣ) : (map_equiv h x : N) = h x :=
rfl

/-- Left multiplication by a unit of a monoid is a permutation of the underlying type. -/
@[to_additive "Left addition of an additive unit is a permutation of the underlying type.",
  simps apply {fully_applied := ff}]
def mul_left (u : Mˣ) : equiv.perm M :=
{ to_fun    := λx, u * x,
  inv_fun   := λx, ↑u⁻¹ * x,
  left_inv  := u.inv_mul_cancel_left,
  right_inv := u.mul_inv_cancel_left }

@[simp, to_additive]
lemma mul_left_symm (u : Mˣ) : u.mul_left.symm = u⁻¹.mul_left :=
equiv.ext $ λ x, rfl

@[to_additive]
lemma mul_left_bijective (a : Mˣ) : function.bijective ((*) a : M → M) :=
(mul_left a).bijective

/-- Right multiplication by a unit of a monoid is a permutation of the underlying type. -/
@[to_additive "Right addition of an additive unit is a permutation of the underlying type.",
  simps apply {fully_applied := ff}]
def mul_right (u : Mˣ) : equiv.perm M :=
{ to_fun    := λx, x * u,
  inv_fun   := λx, x * ↑u⁻¹,
  left_inv  := λ x, mul_inv_cancel_right x u,
  right_inv := λ x, inv_mul_cancel_right x u }

@[simp, to_additive]
lemma mul_right_symm (u : Mˣ) : u.mul_right.symm = u⁻¹.mul_right :=
equiv.ext $ λ x, rfl

@[to_additive]
lemma mul_right_bijective (a : Mˣ) : function.bijective ((* a) : M → M) :=
(mul_right a).bijective

end units

namespace equiv

section group
variables [group G]

/-- Left multiplication in a `group` is a permutation of the underlying type. -/
@[to_additive "Left addition in an `add_group` is a permutation of the underlying type."]
protected def mul_left (a : G) : perm G := (to_units a).mul_left

@[simp, to_additive]
lemma coe_mul_left (a : G) : ⇑(equiv.mul_left a) = (*) a := rfl

/-- Extra simp lemma that `dsimp` can use. `simp` will never use this. -/
@[simp, nolint simp_nf,
  to_additive "Extra simp lemma that `dsimp` can use. `simp` will never use this."]
lemma mul_left_symm_apply (a : G) : ((equiv.mul_left a).symm : G → G) = (*) a⁻¹ := rfl

@[simp, to_additive]
lemma mul_left_symm (a : G) : (equiv.mul_left a).symm = equiv.mul_left a⁻¹ :=
ext $ λ x, rfl

@[to_additive]
lemma _root_.group.mul_left_bijective (a : G) : function.bijective ((*) a) :=
(equiv.mul_left a).bijective

/-- Right multiplication in a `group` is a permutation of the underlying type. -/
@[to_additive "Right addition in an `add_group` is a permutation of the underlying type."]
protected def mul_right (a : G) : perm G := (to_units a).mul_right

@[simp, to_additive]
lemma coe_mul_right (a : G) : ⇑(equiv.mul_right a) = λ x, x * a := rfl

@[simp, to_additive]
lemma mul_right_symm (a : G) : (equiv.mul_right a).symm = equiv.mul_right a⁻¹ :=
ext $ λ x, rfl

/-- Extra simp lemma that `dsimp` can use. `simp` will never use this. -/
@[simp, nolint simp_nf,
  to_additive "Extra simp lemma that `dsimp` can use. `simp` will never use this."]
lemma mul_right_symm_apply (a : G) : ((equiv.mul_right a).symm : G → G) = λ x, x * a⁻¹ := rfl

@[to_additive]
lemma _root_.group.mul_right_bijective (a : G) : function.bijective (* a) :=
(equiv.mul_right a).bijective

/-- A version of `equiv.mul_left a b⁻¹` that is defeq to `a / b`. -/
@[to_additive /-" A version of `equiv.add_left a (-b)` that is defeq to `a - b`. "-/, simps]
protected def div_left (a : G) : G ≃ G :=
{ to_fun := λ b, a / b,
  inv_fun := λ b, b⁻¹ * a,
  left_inv := λ b, by simp [div_eq_mul_inv],
  right_inv := λ b, by simp [div_eq_mul_inv] }

@[to_additive]
lemma div_left_eq_inv_trans_mul_left (a : G) :
  equiv.div_left a = (equiv.inv G).trans (equiv.mul_left a) :=
ext $ λ _, div_eq_mul_inv _ _

/-- A version of `equiv.mul_right a⁻¹ b` that is defeq to `b / a`. -/
@[to_additive /-" A version of `equiv.add_right (-a) b` that is defeq to `b - a`. "-/, simps]
protected def div_right (a : G) : G ≃ G :=
{ to_fun := λ b, b / a,
  inv_fun := λ b, b * a,
  left_inv := λ b, by simp [div_eq_mul_inv],
  right_inv := λ b, by simp [div_eq_mul_inv] }

@[to_additive]
lemma div_right_eq_mul_right_inv (a : G) : equiv.div_right a = equiv.mul_right a⁻¹ :=
ext $ λ _, div_eq_mul_inv _ _

end group

end equiv

/-- In a `division_comm_monoid`, `equiv.inv` is a `mul_equiv`. There is a variant of this
`mul_equiv.inv' G : G ≃* Gᵐᵒᵖ` for the non-commutative case. -/
@[to_additive "When the `add_group` is commutative, `equiv.neg` is an `add_equiv`.", simps apply]
def mul_equiv.inv (G : Type*) [division_comm_monoid G] : G ≃* G :=
{ to_fun   := has_inv.inv,
  inv_fun  := has_inv.inv,
  map_mul' := mul_inv,
  ..equiv.inv G }

@[simp] lemma mul_equiv.inv_symm (G : Type*) [division_comm_monoid G] :
  (mul_equiv.inv G).symm = mul_equiv.inv G := rfl


-- The first part can be done using only "constructive logic"

theorem contrapositive (P Q : Prop) (HPQ : P → Q) : ¬ Q → ¬ P :=
begin
  /-
    P Q : Prop,
    HPQ : P → Q
    ⊢ ¬Q → ¬P
  -/
  intro HnQ,
  intro HP,
  /-
    P Q : Prop,
    HPQ : P → Q,
    HnQ : ¬Q,
    HP : P
    ⊢ false
  -/
  apply HnQ, -- !
  apply HPQ,
  assumption
end

-- The other way needs normal logic (i.e. you can use the law of the excluded middle)
-- The Lean term `classical.em Q` is a proof of `Q ∨ ¬ Q` , if `Q` is a proposition
-- (that is, if `Q` has type `Prop`).

theorem other_way (P Q : Prop) (HnQnP : ¬ Q → ¬ P) : P → Q :=
begin
  intro HP,
  have HQnQ := classical.em Q,
  cases HQnQ, -- Q is either true or false
    assumption,
  have HnP := HnQnP HQnQ,
  have Hfalse := HnP HP,
  cases Hfalse,
end

theorem both_ways (P Q : Prop) : (P → Q) ↔ (¬ Q → ¬ P) := by ??


import algebra.char_p.basic
import ring_theory.localization
import algebra.free_algebra

namespace ring_char

lemma of_prime_eq_zero
  {A : Type*} [non_assoc_semiring A] [nontrivial A]
  {p : ℕ} (hprime : nat.prime p) (hp0 : (p : A) = 0) :
  ring_char A = p :=
begin
  have hchar : ring_char A ∣ p := ring_char.dvd hp0,
  unfold nat.prime at hprime,
  have heq := hprime.2 (ring_char A) hchar,
  cases heq,
  { exfalso,
    exact char_p.ring_char_ne_one heq },
  { exact heq },
end

lemma lt_char {A : Type*} [non_assoc_semiring A]
  {n : ℕ} : (n : A) = 0 → n < ring_char A → n = 0 :=
begin
  rw spec A n,
  exact nat.eq_zero_of_dvd_of_lt,
end

lemma lt_char_field {A : Type*} [field A]
  {n : ℕ} : (n : A) = 0 → n < ring_char A → n = 0 :=
begin
  rw spec A n,
  exact nat.eq_zero_of_dvd_of_lt,
end

end ring_char

/-- If the algebra map `R →+* A` is injective then `A` has the same characteristic as `R`. -/
lemma char_p_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  (h : function.injective (algebra_map R A)) (p : ℕ) [char_p R p] : char_p A p :=
{ cast_eq_zero_iff := λx,
  begin
    rw ←char_p.cast_eq_zero_iff R p x,
    change algebra_map ℕ A x = 0 ↔ algebra_map ℕ R x = 0,
    rw is_scalar_tower.algebra_map_apply ℕ R A x,
    refine iff.trans _ h.eq_iff,
    rw ring_hom.map_zero,
  end }


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.inner_product_space.basic

/-!
# Inversion in an affine space

In this file we define inversion in a sphere in an affine space. This map sends each point `x` to
the point `y` such that `y -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c)`, where `c` and `R` are the center
and the radius the sphere.

In many applications, it is convenient to assume that the inversions swaps the center and the point
at infinity. In order to stay in the original affine space, we define the map so that it sends
center to itself.

Currently, we prove only a few basic lemmas needed to prove Ptolemy's inequality, see
`euclidean_geometry.mul_dist_le_mul_dist_add_mul_dist`.
-/

noncomputable theory
open metric real function

namespace euclidean_geometry

variables {V P : Type*}
  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
  {a b c d x y z : P} {R : ℝ}

include V

/-- Inversion in a sphere in an affine space. This map sends each point `x` to the point `y` such
that `y -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c)`, where `c` and `R` are the center and the radius the
sphere. -/
def inversion (c : P) (R : ℝ) (x : P) : P := (R / dist x c) ^ 2 • (x -ᵥ c) +ᵥ c

lemma inversion_vsub_center (c : P) (R : ℝ) (x : P) :
  inversion c R x -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c) :=
vadd_vsub _ _

@[simp] lemma inversion_self (c : P) (R : ℝ) : inversion c R c = c := by simp [inversion]

@[simp] lemma inversion_dist_center (c x : P) : inversion c (dist x c) x = x :=
begin
  rcases eq_or_ne x c with rfl|hne,
  { apply inversion_self },
  { rw [inversion, div_self, one_pow, one_smul, vsub_vadd],
    rwa [dist_ne_zero] }
end

lemma inversion_of_mem_sphere (h : x ∈ metric.sphere c R) : inversion c R x = x :=
h.out ▸ inversion_dist_center c x

/-- Distance from the image of a point under inversion to the center. This formula accidentally
works for `x = c`. -/
lemma dist_inversion_center (c x : P) (R : ℝ) : dist (inversion c R x) c = R ^ 2 / dist x c :=
begin
  rcases eq_or_ne x c with (rfl|hx), { simp },
  have : dist x c ≠ 0, from dist_ne_zero.2 hx,
  field_simp [inversion, norm_smul, abs_div, ← dist_eq_norm_vsub, sq, mul_assoc]
end

/-- Distance from the center of an inversion to the image of a point under the inversion. This
formula accidentally works for `x = c`. -/
lemma dist_center_inversion (c x : P) (R : ℝ) : dist c (inversion c R x) = R ^ 2 / dist c x :=
by rw [dist_comm c, dist_comm c, dist_inversion_center]

@[simp] lemma inversion_inversion (c : P) {R : ℝ} (hR : R ≠ 0) (x : P) :
  inversion c R (inversion c R x) = x :=
begin
  rcases eq_or_ne x c with rfl|hne,
  { rw [inversion_self, inversion_self] },
  { rw [inversion, dist_inversion_center, inversion_vsub_center, smul_smul, ← mul_pow,
      div_mul_div_comm, div_mul_cancel _ (dist_ne_zero.2 hne), ← sq, div_self, one_pow, one_smul,
      vsub_vadd],
    exact pow_ne_zero _ hR }
end

lemma inversion_involutive (c : P) {R : ℝ} (hR : R ≠ 0) : involutive (inversion c R) :=
inversion_inversion c hR

lemma inversion_surjective (c : P) {R : ℝ} (hR : R ≠ 0) : surjective (inversion c R) :=
(inversion_involutive c hR).surjective

lemma inversion_injective (c : P) {R : ℝ} (hR : R ≠ 0) : injective (inversion c R) :=
(inversion_involutive c hR).injective

lemma inversion_bijective (c : P) {R : ℝ} (hR : R ≠ 0) : bijective (inversion c R) :=
(inversion_involutive c hR).bijective

/-- Distance between the images of two points under an inversion. -/
lemma dist_inversion_inversion (hx : x ≠ c) (hy : y ≠ c) (R : ℝ) :
  dist (inversion c R x) (inversion c R y) = (R ^ 2 / (dist x c * dist y c)) * dist x y :=
begin
  dunfold inversion,
  simp_rw [dist_vadd_cancel_right, dist_eq_norm_vsub V _ c],
  simpa only [dist_vsub_cancel_right]
    using dist_div_norm_sq_smul (vsub_ne_zero.2 hx) (vsub_ne_zero.2 hy) R
end

/-- **Ptolemy's inequality**: in a quadrangle `ABCD`, `|AC| * |BD| ≤ |AB| * |CD| + |BC| * |AD|`. If
`ABCD` is a convex cyclic polygon, then this inequality becomes an equality, see
`euclidean_geometry.mul_dist_add_mul_dist_eq_mul_dist_of_cospherical`.  -/
lemma mul_dist_le_mul_dist_add_mul_dist (a b c d : P) :
  dist a c * dist b d ≤ dist a b * dist c d + dist b c * dist a d :=
begin
  -- If one of the points `b`, `c`, `d` is equal to `a`, then the inequality is trivial.
  rcases eq_or_ne b a with rfl|hb,
  { rw [dist_self, zero_mul, zero_add] },
  rcases eq_or_ne c a with rfl|hc,
  { rw [dist_self, zero_mul],
    apply_rules [add_nonneg, mul_nonneg, dist_nonneg] },
  rcases eq_or_ne d a with rfl|hd,
  { rw [dist_self, mul_zero, add_zero, dist_comm d, dist_comm d, mul_comm] },
  /- Otherwise, we apply the triangle inequality to `euclidean_geometry.inversion a 1 b`,
  `euclidean_geometry.inversion a 1 c`, and `euclidean_geometry.inversion a 1 d`. -/
  have H := dist_triangle (inversion a 1 b) (inversion a 1 c) (inversion a 1 d),
  rw [dist_inversion_inversion hb hd, dist_inversion_inversion hb hc,
    dist_inversion_inversion hc hd, one_pow] at H,
  rw [← dist_pos] at hb hc hd,
  rw [← div_le_div_right (mul_pos hb (mul_pos hc hd))],
  convert H; { field_simp [hb.ne', hc.ne', hd.ne', dist_comm a], ring }
end

end euclidean_geometry


/-

# Chapter 12: complex numbers playground

This file contains some scattered code from the Ch 12 lectures,
where we attempted to build a bit of API around the complex numbers.

-/

import algebra.group.basic
import data.real.basic
import analysis.special_functions.trigonometric

section
variables {α β : Type} [group α] [group β]
  (f : α → β)
  (hf : ∀ a b : α, f (a*b) = f a * f b)

include hf

lemma f_one_eq_one :
  f 1 = 1 :=
begin
  have h1 : f (1 * 1) = f 1 * f 1 := hf 1 1,
  rw one_mul at h1,
  rw self_eq_mul_left at h1,
  -- simp at h1,
  assumption
end
#check @f_one_eq_one
lemma f_inv_eq_inv  :
  ∀ a, f (a⁻¹) = (f a)⁻¹ :=
begin
  intro a,
  have h1 : f a * f (a⁻¹)  = 1 := begin
    rw [← hf, mul_right_inv],
    apply f_one_eq_one,
    apply hf
  end,
  exact (inv_eq_of_mul_eq_one h1).symm
end
end

namespace new

structure complex : Type :=
(r im : ℝ)

def add (c1 c2 : complex) : complex :=
{ r := c1.r + c2.r, im := c1.im + c2.im }

def neg (c : complex) : complex :=
{ r := -c.r, im := -c.im }

def mul (c1 c2 : complex) : complex :=
{ r := c1.r*c2.r - c1.im*c2.im, im := c1.r*c2.im + c1.im*c2.r  }

instance : comm_ring complex :=
{ add := add,
  mul := mul,
  zero := {r := 0, im := 0},
  one := {r := 1, im := 0},
  neg := neg,
  add_comm := sorry,
  add_assoc := sorry,
  zero_add := sorry,
  add_zero := sorry,
  add_left_neg := sorry,
  mul_assoc := sorry,
  one_mul := sorry,
  mul_one := sorry,
  left_distrib := sorry,
  right_distrib := sorry,
  mul_comm := sorry }

lemma mul_eq (c1 c2 : complex) :
  c1 * c2 = { r := c1.r*c2.r - c1.im*c2.im, im := c1.r*c2.im + c1.im*c2.r } :=
by refl

def conjugate (a : complex) : complex :=
{ r := a.r, im := - a.im }

theorem mul_conjugate (a : complex) : (a * conjugate a).im = 0 :=
begin
  cases a,
  simp [conjugate, mul_eq],
  ring
end

-- returns (angle, radius)
noncomputable def to_polar (c : complex) : ℝ × ℝ :=
(real.arctan (c.im / c.r), real.sqrt (c.r^2 + c.im^2))

noncomputable def from_polar (angle radius : ℝ) : complex :=
{ r := radius * real.cos angle, im := radius * real.sin angle }

example (angle radius : ℝ) (h_rad : radius > 0) (h_angle1 : -(real.pi / 2) < angle)
  (h_angle2 : angle < real.pi / 2):
  to_polar (from_polar angle radius) = (angle, radius) :=
begin
  simp [to_polar, from_polar],
  split,
  { calc
    real.arctan (radius * real.sin angle / (radius * real.cos angle)) =
      real.arctan (real.sin angle / real.cos angle): _
    ... = real.arctan (real.tan angle) : _
    ... = angle : _,

    { rw mul_div_mul_left,
      linarith },
    { rw real.tan_eq_sin_div_cos },
    { rw real.arctan_tan, assumption, assumption }
     },
  { rw [← eq_of_sq_eq_sq, real.sq_sqrt]
    -- we should be able to finish the remaining stuff
  }
end

def of_real (r : ℝ) : complex :=
{ r := r, im := 0 }

instance : has_coe ℝ complex :=
{ coe := of_real }

example (r : ℝ) (c : complex) : c + r = c + r :=
by refl

end new


import data.real.basic
import tactic

set_option pp.implicit true
-- Make simp display the steps used.
set_option trace.simplify.rewrite true
-- # 1
namespace problem1

-- let X, Y, Z be sets.
variables {X Y Z : Type}

-- a function f : X → Y is *injective* if f(a) = f(b) → a = b for all a,b in X.
def injective (f : X → Y)  : Prop :=
∀ a b : X, f(a) = f(b) → a = b

-- challenge: the composite of two injective functions is injective
theorem challenge1
  (f : X → Y) (hf : injective f)
  (g : Y → Z) (hg : injective g) :
injective (g ∘ f) :=
begin
    intros a b,
    intro h₁, --: g ∘ f a  = g ∘ f b, How to specify the type of h₁?
    have h₂ : f a = f b, from hg (f a) (f b) h₁,
    have h₃ : a = b, from hf a b h₂,
    exact h₃
end

theorem challenge1_solution
  (f : X → Y) (hf : injective f)
  (g : Y → Z) (hg : injective g) :
injective (g ∘ f) :=
begin
  -- the *definition* of "injective" is "for all a and b...", so let
  -- a and b be arbitrary elements of X.
  intros a b,
  -- Assume (g ∘ f) a = (g ∘ f) b
  intro hab,
  -- The goal is now ⊢ a = b .
  -- By injectivity of f, it suffices to prove f(a)=f(b)
  apply hf,
  -- By injectivity of g, it suffices to prove g(f(a))=g(f(b))
  apply hg,
  -- but this is precisely our assumption.
  exact hab,
  -- "no goals" means we're done.
end

end problem1

namespace problem2

-- basic definitions
def upper_bounds (S : set ℝ) : set ℝ := { b | ∀s ∈ S, s ≤ b }
def lower_bounds (S : set ℝ) : set ℝ := { b | ∀s ∈ S, b ≤ s }
def is_least (S : set ℝ) (l : ℝ) : Prop := l ∈ S ∧ l ∈ lower_bounds S
def is_lub (S : set ℝ) (l : ℝ) : Prop := is_least (upper_bounds S) l

/-- A set has at most one least upper bound -/
theorem challenge2
  (S : set ℝ)
  (a b : ℝ)
  (ha : is_lub S a)
  (hb : is_lub S b) :
a = b :=
begin
  have h₁ : a ∈ upper_bounds S, from ha.left,
  have h₂ : b ∈ upper_bounds S, from hb.left,
  have h₃ : a ≤ b, from ha.right b h₂,
  have h₄ : b ≤ a, from hb.right a h₁,
  linarith,
  -- or
  --exact @le_antisymm ℝ real.partial_order a b h₃ h₄
end

theorem challenge2_solution
  (S : set ℝ)
  (a b : ℝ)
  (ha : is_lub S a)
  (hb : is_lub S b) :
a = b :=
begin
  -- if you unfold some definitions
   unfold is_lub at ha,
   unfold is_least at ha,
  -- then you discover that by definition ha is a proof of
  -- a ∈ upper_bounds S ∧ a ∈ lower_bounds (upper_bounds S)
  -- so it's a proof of P ∧ Q, so you can use `cases` to recover the proofs of P and Q.
  cases ha with ha1 ha2,
  -- you don't have to do the unfolding though.
  cases hb with hb1 hb2,
  -- we prove a = b by showing a ≤ b and b ≤ a
  apply le_antisymm,
  { -- to prove a ≤ b we want to argue that b is an upper bound and a is the least upper bound.
    -- First let's use the fact that a is at most all upper bounds
    apply ha2,
    -- and now we just need that b is an upper bound
    exact hb1},
  { -- The other way is similar.
    apply hb2,
    exact ha1}
end

end problem2

namespace ploblem3

theorem challenge3 :
(2 : ℝ) + 2 ≠ 5 :=
begin
  linarith,
end

theorem challenge3_solution :
(2 : ℝ) + 2 ≠ 5 :=
begin
  norm_num
end

/-
Notes:
After checking the docs, norm_num is more lightweight, covering arithmetic
evaluations of *,+,-,^,≤, whereas linarith has norm_num as a subset. It
handles 'linear' arithmetic (not exactly sure what is included here), but it
it is far more comprehensive.
-/

end ploblem3

namespace problem4

open function

theorem challenge4
  (X Y Z : Type)
  (f : X → Y)
  (g : Y → Z) :
surjective (g ∘ f) → surjective g :=
assume h₁,
assume z,
  have h₂ : ∃y : Y, g y = z, from exists.elim (h₁ z)
  (assume (x : X) (hh₁ : (g ∘ f) x = z),
    have hh₂ : g (f x) = z, from hh₁,
    let y := f x in exists.intro y hh₂),
  h₂

theorem challenge4_solution
  (X Y Z : Type)
  (f : X → Y)
  (g : Y → Z) :
surjective (g ∘ f) → surjective g :=
begin
  intro h,
  intro z,
  cases h z with a ha,
  use f a,
  assumption,
end

end problem4


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

import algebra.triv_sq_zero_ext

/-!
# Dual numbers

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

The dual numbers over `R` are of the form `a + bε`, where `a` and `b` are typically elements of a
commutative ring `R`, and `ε` is a symbol satisfying `ε^2 = 0`. They are a special case of
`triv_sq_zero_ext R M` with `M = R`.

## Notation

In the `dual_number` locale:

* `R[ε]` is a shorthand for `dual_number R`
* `ε` is a shorthand for `dual_number.eps`

## Main definitions

* `dual_number`
* `dual_number.eps`
* `dual_number.lift`

## Implementation notes

Rather than duplicating the API of `triv_sq_zero_ext`, this file reuses the functions there.

## References

* https://en.wikipedia.org/wiki/Dual_number
-/

variables {R : Type*}

/-- The type of dual numbers, numbers of the form $a + bε$ where $ε^2 = 0$.-/
abbreviation dual_number (R : Type*) : Type* := triv_sq_zero_ext R R

/-- The unit element $ε$ that squares to zero. -/
def dual_number.eps [has_zero R] [has_one R] : dual_number R := triv_sq_zero_ext.inr 1

localized "notation (name := dual_number.eps) `ε` := dual_number.eps" in dual_number
localized "postfix (name := dual_number) `[ε]`:1025 := dual_number" in dual_number

open_locale dual_number

namespace dual_number

open triv_sq_zero_ext

@[simp]

/-- A version of `triv_sq_zero_ext.snd_mul` with `*` instead of `•`. -/
@[simp] lemma snd_mul [semiring R] (x y : R[ε]) : snd (x * y) = fst x * snd y + snd x * fst y :=
snd_mul _ _

@[simp] lemma eps_mul_eps [semiring R] : (ε * ε : R[ε]) = 0 := inr_mul_inr _ _ _

@[simp] lemma inr_eq_smul_eps [mul_zero_one_class R] (r : R) : inr r = (r • ε : R[ε]) :=
ext (mul_zero r).symm (mul_one r).symm

/-- For two algebra morphisms out of `R[ε]` to agree, it suffices for them to agree on `ε`. -/
@[ext] lemma alg_hom_ext {A} [comm_semiring R] [semiring A] [algebra R A]
  ⦃f g : R[ε] →ₐ[R] A⦄ (h : f ε = g ε) : f = g :=
alg_hom_ext' $ linear_map.ext_ring $ h

variables {A : Type*} [comm_semiring R] [semiring A] [algebra R A]

/-- A universal property of the dual numbers, providing a unique `R[ε] →ₐ[R] A` for every element
of `A` which squares to `0`.

This isomorphism is named to match the very similar `complex.lift`. -/
@[simps {attrs := []}]
def lift : {e : A // e * e = 0} ≃ (R[ε] →ₐ[R] A) :=
equiv.trans
  (show {e : A // e * e = 0} ≃ {f : R →ₗ[R] A // ∀ x y, f x * f y = 0}, from
    (linear_map.ring_lmap_equiv_self R ℕ A).symm.to_equiv.subtype_equiv $ λ a, begin
      dsimp,
      simp_rw smul_mul_smul,
      refine ⟨λ h x y, h.symm ▸ smul_zero _, λ h, by simpa using h 1 1⟩,
    end)
  triv_sq_zero_ext.lift

/- When applied to `ε`, `dual_number.lift` produces the element of `A` that squares to 0. -/
@[simp]
lemma lift_apply_eps (e : {e : A // e * e = 0}) : lift e (ε : R[ε]) = e :=
(triv_sq_zero_ext.lift_aux_apply_inr _ _ _).trans $ one_smul _ _

/- Lifting `dual_number.eps` itself gives the identity. -/
@[simp]
lemma lift_eps : lift ⟨ε, by exact eps_mul_eps⟩ = alg_hom.id R R[ε] :=
alg_hom_ext $ lift_apply_eps _

end dual_number


import GMLInit.Data.Set.Basic
import GMLInit.Logic.Relation

namespace Set
open Set.Notation
variable {s t u : Set α}

def Subset (s t : Set α) : Prop := ∀ x, x ∈ s → x ∈ t

theorem subset_refl (s : Set α) : s ⊆ s := by
  intro x hs
  exact hs
instance (α) : Relation.Reflexive (α:=Set α) (.⊆.) := ⟨subset_refl⟩

theorem subset_trans : s ⊆ t → t ⊆ u → s ⊆ u := by
  intro hst htu x hs
  apply htu
  apply hst
  exact hs
instance (α) : Relation.Transitive (α:=Set α) (.⊆.) := ⟨subset_trans⟩

theorem subset_antisymm : s ⊆ t → t ⊆ s → s = t := by
  intro hst hts
  apply Set.ext
  intro x
  constr
  · exact hst x
  · exact hts x
instance (α) : Relation.Antisymmetric (α:=Set α) (.⊆.) := ⟨subset_antisymm⟩

theorem empty_subset (s : Set α) : Set.empty ⊆ s := by
  intro x h
  contradiction

theorem eq_empty_of_subset_empty : s ⊆ Set.empty → s = Set.empty := by
  intro hs
  antisymmetry using (.⊆.)
  · exact hs
  · exact empty_subset s

theorem subset_univ (s : Set α) : s ⊆ Set.univ := by
  intro _ _
  trivial

theorem eq_univ_of_univ_subset : Set.univ ⊆ s → s = Set.univ := by
  intro hs
  antisymmetry using (.⊆.)
  · exact subset_univ s
  · exact hs

theorem pure_subset_of_mem {x : α} : x ∈ s → pure x ⊆ s := by
  intro | hs, _, rfl => exact hs

theorem subset_union_left (s t : Set α) : s ⊆ s ∪ t := by
  intro x hs
  left
  exact hs

theorem subset_union_right (s t : Set α) : t ⊆ s ∪ t := by
  intro x ht
  right
  exact ht

theorem union_subset_of_subset_of_subset : s ⊆ u → t ⊆ u → s ∪ t ⊆ u := by
  intro hsu htu x
  intro
  | Or.inl hxs =>
    exact hsu x hxs
  | Or.inr hxt =>
    exact htu x hxt

theorem union_subset_union_left : s ⊆ t → (∀ u, u ∪ s ⊆ u ∪ t) := by
  intro hst u x
  intro
  | Or.inl hu =>
    left
    exact hu
  | Or.inr hs =>
    right
    exact hst x hs

theorem union_subset_union_right : s ⊆ t → (∀ u, s ∪ u ⊆ t ∪ u) := by
  intro hst u x
  intro
  | Or.inl hs =>
    left
    exact hst x hs
  | Or.inr hu =>
    right
    exact hu

theorem union_subset_union {s₁ s₂ t₁ t₂ : Set α} : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ∪ t₁ ⊆ s₂ ∪ t₂ := by
  intro hs ht x
  intro
  | Or.inl hs₁ =>
    left
    exact hs x hs₁
  | Or.inr ht₁ =>
    right
    exact ht x ht₁

theorem inter_subset_left (s t : Set α) : s ∩ t ⊆ s := by
  intro x ⟨hs,_⟩
  exact hs

theorem inter_subset_right (s t : Set α) : s ∩ t ⊆ t := by
  intro x ⟨_,ht⟩
  exact ht

theorem subset_inter_of_subset_of_subset : u ⊆ s → u ⊆ t → u ⊆ s ∩ t := by
  intro hus hut x hxu
  constr
  · exact hus x hxu
  · exact hut x hxu

theorem inter_subset_inter_left : s ⊆ t → (∀ u, u ∩ s ⊆ u ∩ t) := by
  intro hst u x ⟨hu, hs⟩
  constr
  · exact hu
  · exact hst x hs

theorem inter_subset_inter_right : s ⊆ t → (∀ u, s ∩ u ⊆ t ∩ u) := by
  intro hst u x ⟨hs, hu⟩
  constr
  · exact hst x hs
  · exact hu

theorem inter_subset_inter {s₁ s₂ t₁ t₂ : Set α} : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ∩ t₁ ⊆ s₂ ∩ t₂ := by
  intro hs ht x ⟨hs₁,ht₁⟩
  constr
  · exact hs x hs₁
  · exact ht x ht₁

theorem map_subset_map (f : α → β) : s ⊆ t → f <$> s ⊆ f <$> t := by
  intro hst y ⟨x,hx,h⟩
  cases h
  exists x
  constr
  · exact hst x hx
  · rfl

theorem bind_subset_bind (f : α → Set β) : s ⊆ t → s >>= f ⊆ t >>= f := by
  intro hst y ⟨x,hx,h⟩
  exists x
  constr
  · exact hst x hx
  · exact h

theorem val_subset_bind (f : α → Set β) {x : α} : x ∈ s → f x ⊆ s >>= f := by
  intro hxs y hfxy
  exists x

theorem bind_subset_of_val_subset {t : Set β} {f : α → Set β} : (∀ x, x ∈ s → f x ⊆ t) → s >>= f ⊆ t := by
  intro h y ⟨x, hxs, hfxy⟩
  exact h x hxs y hfxy

end Set