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

import data.setoid.basic
import data.set.lattice

/-!
# Equivalence relations: partitions

This file comprises properties of equivalence relations viewed as partitions.

## Tags

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

namespace setoid

variables {α : Type*}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

section partition

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

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

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

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

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

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

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

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

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

variables (α)

/-- The order-preserving bijection between equivalence relations and partitions of sets. -/
def partition.rel_iso :
  setoid α ≃o subtype (@is_partition α) :=
{ to_fun := λ r, ⟨r.classes, empty_not_mem_classes, classes_eqv_classes⟩,
  inv_fun := λ x, mk_classes x.1 x.2.2,
  left_inv := mk_classes_classes,
  right_inv := λ x, by rw [subtype.ext_iff_val, ←classes_mk_classes x.1 x.2],
  map_rel_iff' := λ x y,
    by { conv_rhs { rw [←mk_classes_classes x, ←mk_classes_classes y] }, refl } }

variables {α}

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

end partition

end setoid


import .Q2
import analysis.normed_space.basic

noncomputable theory

namespace quaternion

instance : has_norm ℍ := ⟨λ z, real.sqrt (norm_sq z)⟩

instance : has_dist ℍ := ⟨λ z w, ∥z-w∥⟩

lemma dist_self (z : ℍ) : dist z z = 0 :=
by {dsimp [dist], rw add_right_neg, dsimp [norm], simp}

lemma eq_of_dist_eq_zero (z w : ℍ) : dist z w = 0 → z = w :=
begin
    intros h,
    dsimp [dist, norm] at h,
    have w := (real.sqrt_eq_zero (norm_sq_nonneg (z + -w))).1 h,
    rw norm_sq_eq_zero at w,
    exact eq_of_sub_eq_zero w,
end

lemma dist_comm (z w : ℍ) : dist z w = dist w z :=
begin
    dsimp [dist, norm],
    have h₁ : norm_sq (z-w) ≥ 0 := norm_sq_nonneg (z-w),
    have h₂ : norm_sq (w-z) ≥ 0 := norm_sq_nonneg (w-z),
    apply (real.sqrt_inj h₁ h₂).2,
    dsimp [norm_sq],
    ring,
end
.

lemma le_of_eq_of_le {a b c : ℝ} : b = c → a ≤ b → a ≤ c :=
by {intros h w, rw [h] at w, exact w}

-- It turned out to be absolutely impossible to prove this without Cauchy-Schwartz.
-- I would have proven that the norm was induced by an inner product first,
-- but inner products are not implemented in MathLib anywhere that I could find.
lemma norm_triangle (z w : ℍ) : ∥z+w∥ ≤ ∥z∥+∥w∥ :=
begin
    dsimp [norm],
    have h₁ := add_nonneg (real.sqrt_nonneg (norm_sq z)) (real.sqrt_nonneg (norm_sq w)),
    rw [real.sqrt_le_left h₁, pow_two],
    ring,
    rw [real.ring.right_distrib, ←pow_two, real.sqr_sqrt (norm_sq_nonneg z), real.sqr_sqrt (norm_sq_nonneg w)],
    have h₂ := real.sqrt_mul (norm_sq_nonneg w) (norm_sq z),
    have h₃ := congr_arg (λ (x : ℝ), 2 * x) h₂,
    simp at h₃,
    rw [←real.ring.mul_assoc] at h₃,
    have h₄ : norm_sq z + 2 * real.sqrt (norm_sq w) * real.sqrt (norm_sq z) + norm_sq w = norm_sq z + 2 * real.sqrt (norm_sq w * norm_sq z) + norm_sq w, by {simp, exact h₃.symm},
    apply le_of_eq_of_le h₄.symm,
    clear h₃ h₄,
    rw [norm_sq_add],
    simp,
    have zero_lt_two : (0 : ℝ) < 2 := by linarith,
    apply (@mul_le_mul_left _ _ (z.i * w.i + (z.j * w.j + (z.k * w.k + z.re * w.re))) _ 2 zero_lt_two).2,
    clear zero_lt_two,
    sorry,
end

lemma dist_triangle (x y z : ℍ) : dist x z ≤ dist x y + dist y z :=
begin
    dsimp [dist],
    have w := norm_triangle (x-y) (y-z),
    simp at w,
    exact w,
end

instance : metric_space ℍ :=
{dist := dist, dist_self := dist_self, eq_of_dist_eq_zero := eq_of_dist_eq_zero,
    dist_comm := dist_comm, dist_triangle := dist_triangle, ..}

lemma dist_eq (x y : ℍ) : dist x y = ∥x-y∥ :=
by {dsimp [dist], refl}

instance : normed_group ℍ :=
{dist := dist, dist_eq := dist_eq, .. (by apply_instance : metric_space ℍ)}

instance : vector_space ℝ ℍ := by constructor

lemma norm_smul (r : ℝ) (z : ℍ) : ∥r • z∥ = ∥r∥ * ∥z∥ :=
begin
    dsimp [norm],
    rw ←real.sqrt_mul_self_eq_abs,
    rw ←(real.sqrt_mul' (r*r) (norm_sq_nonneg z)),
    have w := mul_nonneg (mul_self_nonneg r) (norm_sq_nonneg z),
    rw (real.sqrt_inj (norm_sq_nonneg (r • z)) w),
    dsimp [norm_sq, (•)],
    ring,
end

-- Question 2f
instance : normed_space ℝ ℍ :=
{norm_smul := norm_smul, .. (by apply_instance : vector_space ℝ ℍ)}

end quaternion


import PowerWorld.Level1
import MyNat.Multiplication -- mul_zero
namespace MyNat
open MyNat

/-!

# Power World

## Level 2: `zero_pow_succ`

## Lemma
For all naturals `m`, `0 ^ (succ m) = 0`.
-/
lemma zero_pow_succ (m : MyNat) : (0 : MyNat) ^ (succ m) = 0 := by
  rw [pow_succ]
  rw [mul_zero]

/-!
Next up [Level 3](./Level3.lean.md)
-/


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import algebra.big_operators.ring
import algebra.module.big_operators
import number_theory.divisors
import data.nat.squarefree
import data.nat.gcd.big_operators
import algebra.invertible
import data.nat.factorization.basic

/-!
# Arithmetic Functions and Dirichlet Convolution

This file defines arithmetic functions, which are functions from `ℕ` to a specified type that map 0
to 0. In the literature, they are often instead defined as functions from `ℕ+`. These arithmetic
functions are endowed with a multiplication, given by Dirichlet convolution, and pointwise addition,
to form the Dirichlet ring.

## Main Definitions
 * `arithmetic_function R` consists of functions `f : ℕ → R` such that `f 0 = 0`.
 * An arithmetic function `f` `is_multiplicative` when `x.coprime y → f (x * y) = f x * f y`.
 * The pointwise operations `pmul` and `ppow` differ from the multiplication
  and power instances on `arithmetic_function R`, which use Dirichlet multiplication.
 * `ζ` is the arithmetic function such that `ζ x = 1` for `0 < x`.
 * `σ k` is the arithmetic function such that `σ k x = ∑ y in divisors x, y ^ k` for `0 < x`.
 * `pow k` is the arithmetic function such that `pow k x = x ^ k` for `0 < x`.
 * `id` is the identity arithmetic function on `ℕ`.
 * `ω n` is the number of distinct prime factors of `n`.
 * `Ω n` is the number of prime factors of `n` counted with multiplicity.
 * `μ` is the Möbius function (spelled `moebius` in code).

## Main Results
 * Several forms of Möbius inversion:
 * `sum_eq_iff_sum_mul_moebius_eq` for functions to a `comm_ring`
 * `sum_eq_iff_sum_smul_moebius_eq` for functions to an `add_comm_group`
 * `prod_eq_iff_prod_pow_moebius_eq` for functions to a `comm_group`
 * `prod_eq_iff_prod_pow_moebius_eq_of_nonzero` for functions to a `comm_group_with_zero`

## Notation
The arithmetic functions `ζ` and `σ` have Greek letter names, which are localized notation in
the namespace `arithmetic_function`.

## Tags
arithmetic functions, dirichlet convolution, divisors

-/

open finset
open_locale big_operators

namespace nat
variable (R : Type*)

/-- An arithmetic function is a function from `ℕ` that maps 0 to 0. In the literature, they are
  often instead defined as functions from `ℕ+`. Multiplication on `arithmetic_functions` is by
  Dirichlet convolution. -/
@[derive [has_zero, inhabited]]
def arithmetic_function [has_zero R] := zero_hom ℕ R

variable {R}

namespace arithmetic_function

section has_zero
variable [has_zero R]

instance : has_coe_to_fun (arithmetic_function R) (λ _, ℕ → R) := zero_hom.has_coe_to_fun

@[simp] lemma to_fun_eq (f : arithmetic_function R) : f.to_fun = f := rfl

@[simp]
lemma map_zero {f : arithmetic_function R} : f 0 = 0 :=
zero_hom.map_zero' f

theorem coe_inj {f g : arithmetic_function R} : (f : ℕ → R) = g ↔ f = g :=
⟨λ h, zero_hom.coe_inj h, λ h, h ▸ rfl⟩

@[simp]
lemma zero_apply {x : ℕ} : (0 : arithmetic_function R) x = 0 :=
zero_hom.zero_apply x

@[ext] theorem ext ⦃f g : arithmetic_function R⦄ (h : ∀ x, f x = g x) : f = g :=
zero_hom.ext h

theorem ext_iff {f g : arithmetic_function R} : f = g ↔ ∀ x, f x = g x :=
zero_hom.ext_iff

section has_one
variable [has_one R]

instance : has_one (arithmetic_function R) := ⟨⟨λ x, ite (x = 1) 1 0, rfl⟩⟩

lemma one_apply {x : ℕ} : (1 : arithmetic_function R) x = ite (x = 1) 1 0 := rfl

@[simp] lemma one_one : (1 : arithmetic_function R) 1 = 1 := rfl

@[simp] lemma one_apply_ne {x : ℕ} (h : x ≠ 1) : (1 : arithmetic_function R) x = 0 := if_neg h

end has_one
end has_zero

instance nat_coe [add_monoid_with_one R] :
  has_coe (arithmetic_function ℕ) (arithmetic_function R) :=
⟨λ f, ⟨↑(f : ℕ → ℕ), by { transitivity ↑(f 0), refl, simp }⟩⟩

@[simp]
lemma nat_coe_nat (f : arithmetic_function ℕ) :
  (↑f : arithmetic_function ℕ) = f :=
ext $ λ _, cast_id _

@[simp]
lemma nat_coe_apply [add_monoid_with_one R] {f : arithmetic_function ℕ} {x : ℕ} :
  (f : arithmetic_function R) x = f x := rfl

instance int_coe [add_group_with_one R] :
  has_coe (arithmetic_function ℤ) (arithmetic_function R) :=
⟨λ f, ⟨↑(f : ℕ → ℤ), by { transitivity ↑(f 0), refl, simp }⟩⟩

@[simp]
lemma int_coe_int (f : arithmetic_function ℤ) :
  (↑f : arithmetic_function ℤ) = f :=
ext $ λ _, int.cast_id _

@[simp]
lemma int_coe_apply [add_group_with_one R]
  {f : arithmetic_function ℤ} {x : ℕ} :
  (f : arithmetic_function R) x = f x := rfl

@[simp]
lemma coe_coe [add_group_with_one R] {f : arithmetic_function ℕ} :
  ((f : arithmetic_function ℤ) : arithmetic_function R) = f :=
by { ext, simp, }

@[simp] lemma nat_coe_one [add_monoid_with_one R] :
  ((1 : arithmetic_function ℕ) : arithmetic_function R) = 1 :=
by { ext n, simp [one_apply] }

@[simp] lemma int_coe_one [add_group_with_one R] :
  ((1 : arithmetic_function ℤ) : arithmetic_function R) = 1 :=
by { ext n, simp [one_apply] }

section add_monoid

variable [add_monoid R]

instance : has_add (arithmetic_function R) := ⟨λ f g, ⟨λ n, f n + g n, by simp⟩⟩

@[simp]
lemma add_apply {f g : arithmetic_function R} {n : ℕ} : (f + g) n = f n + g n := rfl

instance : add_monoid (arithmetic_function R) :=
{ add_assoc := λ _ _ _, ext (λ _, add_assoc _ _ _),
  zero_add := λ _, ext (λ _, zero_add _),
  add_zero := λ _, ext (λ _, add_zero _),
  .. arithmetic_function.has_zero R,
  .. arithmetic_function.has_add }

end add_monoid

instance [add_monoid_with_one R] : add_monoid_with_one (arithmetic_function R) :=
{ nat_cast := λ n, ⟨λ x, if x = 1 then (n : R) else 0, by simp⟩,
  nat_cast_zero := by ext; simp [nat.cast],
  nat_cast_succ := λ _, by ext; by_cases x = 1; simp [nat.cast, *],
  .. arithmetic_function.add_monoid, .. arithmetic_function.has_one }

instance [add_comm_monoid R] : add_comm_monoid (arithmetic_function R) :=
{ add_comm := λ _ _, ext (λ _, add_comm _ _),
  .. arithmetic_function.add_monoid }

instance [add_group R] : add_group (arithmetic_function R) :=
{ neg := λ f, ⟨λ n, - f n, by simp⟩,
  add_left_neg := λ _, ext (λ _, add_left_neg _),
  .. arithmetic_function.add_monoid }

instance [add_comm_group R] : add_comm_group (arithmetic_function R) :=
{ .. arithmetic_function.add_comm_monoid,
  .. arithmetic_function.add_group }

section has_smul
variables {M : Type*} [has_zero R] [add_comm_monoid M] [has_smul R M]

/-- The Dirichlet convolution of two arithmetic functions `f` and `g` is another arithmetic function
  such that `(f * g) n` is the sum of `f x * g y` over all `(x,y)` such that `x * y = n`. -/
instance : has_smul (arithmetic_function R) (arithmetic_function M) :=
⟨λ f g, ⟨λ n, ∑ x in divisors_antidiagonal n, f x.fst • g x.snd, by simp⟩⟩

@[simp]
lemma smul_apply {f : arithmetic_function R} {g : arithmetic_function M} {n : ℕ} :
  (f • g) n = ∑ x in divisors_antidiagonal n, f x.fst • g x.snd := rfl

end has_smul

/-- The Dirichlet convolution of two arithmetic functions `f` and `g` is another arithmetic function
  such that `(f * g) n` is the sum of `f x * g y` over all `(x,y)` such that `x * y = n`. -/
instance [semiring R] : has_mul (arithmetic_function R) := ⟨(•)⟩

@[simp]
lemma mul_apply [semiring R] {f g : arithmetic_function R} {n : ℕ} :
  (f * g) n = ∑ x in divisors_antidiagonal n, f x.fst * g x.snd := rfl

lemma mul_apply_one [semiring R] {f g : arithmetic_function R} :
  (f * g) 1 = f 1 * g 1 :=
by simp

@[simp, norm_cast] lemma nat_coe_mul [semiring R] {f g : arithmetic_function ℕ} :
  (↑(f * g) : arithmetic_function R) = f * g :=
by { ext n, simp }

@[simp, norm_cast] lemma int_coe_mul [ring R] {f g : arithmetic_function ℤ} :
  (↑(f * g) : arithmetic_function R) = f * g :=
by { ext n, simp }

section module
variables {M : Type*} [semiring R] [add_comm_monoid M] [module R M]

lemma mul_smul' (f g : arithmetic_function R) (h : arithmetic_function M) :
  (f * g) • h = f • g • h :=
begin
  ext n,
  simp only [mul_apply, smul_apply, sum_smul, mul_smul, smul_sum, finset.sum_sigma'],
  apply finset.sum_bij,
  swap 5,
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H, exact ⟨(k, l*j), (l, j)⟩ },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H,
    simp only [finset.mem_sigma, mem_divisors_antidiagonal] at H ⊢,
    rcases H with ⟨⟨rfl, n0⟩, rfl, i0⟩,
    refine ⟨⟨(mul_assoc _ _ _).symm, n0⟩, rfl, _⟩,
    rw mul_ne_zero_iff at *,
    exact ⟨i0.2, n0.2⟩, },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H, simp only [mul_assoc] },
  { rintros ⟨⟨a,b⟩, ⟨c,d⟩⟩ ⟨⟨i,j⟩, ⟨k,l⟩⟩ H₁ H₂,
    simp only [finset.mem_sigma, mem_divisors_antidiagonal,
      and_imp, prod.mk.inj_iff, add_comm, heq_iff_eq] at H₁ H₂ ⊢,
    rintros rfl h2 rfl rfl,
    exact ⟨⟨eq.trans H₁.2.1.symm H₂.2.1, rfl⟩, rfl, rfl⟩ },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H, refine ⟨⟨(i*k, l), (i, k)⟩, _, _⟩,
    { simp only [finset.mem_sigma, mem_divisors_antidiagonal] at H ⊢,
      rcases H with ⟨⟨rfl, n0⟩, rfl, j0⟩,
      refine ⟨⟨mul_assoc _ _ _, n0⟩, rfl, _⟩,
      rw mul_ne_zero_iff at *,
      exact ⟨n0.1, j0.1⟩ },
    { simp only [true_and, mem_divisors_antidiagonal, and_true, prod.mk.inj_iff, eq_self_iff_true,
        ne.def, mem_sigma, heq_iff_eq] at H ⊢,
      rw H.2.1 } }
end

lemma one_smul' (b : arithmetic_function M) :
  (1 : arithmetic_function R) • b = b :=
begin
  ext,
  rw smul_apply,
  by_cases x0 : x = 0, {simp [x0]},
  have h : {(1,x)} ⊆ divisors_antidiagonal x := by simp [x0],
  rw ← sum_subset h, {simp},
  intros y ymem ynmem,
  have y1ne : y.fst ≠ 1,
  { intro con,
    simp only [con, mem_divisors_antidiagonal, one_mul, ne.def] at ymem,
    simp only [mem_singleton, prod.ext_iff] at ynmem,
    tauto },
  simp [y1ne],
end

end module

section semiring
variable [semiring R]

instance : monoid (arithmetic_function R) :=
{ one_mul := one_smul',
  mul_one := λ f,
  begin
    ext,
    rw mul_apply,
    by_cases x0 : x = 0, {simp [x0]},
    have h : {(x,1)} ⊆ divisors_antidiagonal x := by simp [x0],
    rw ← sum_subset h, {simp},
    intros y ymem ynmem,
    have y2ne : y.snd ≠ 1,
    { intro con,
      simp only [con, mem_divisors_antidiagonal, mul_one, ne.def] at ymem,
      simp only [mem_singleton, prod.ext_iff] at ynmem,
      tauto },
    simp [y2ne],
  end,
  mul_assoc := mul_smul',
  .. arithmetic_function.has_one,
  .. arithmetic_function.has_mul }

instance : semiring (arithmetic_function R) :=
{ zero_mul := λ f, by { ext, simp only [mul_apply, zero_mul, sum_const_zero, zero_apply] },
  mul_zero := λ f, by { ext, simp only [mul_apply, sum_const_zero, mul_zero, zero_apply] },
  left_distrib := λ a b c, by { ext, simp only [←sum_add_distrib, mul_add, mul_apply, add_apply] },
  right_distrib := λ a b c, by { ext, simp only [←sum_add_distrib, add_mul, mul_apply, add_apply] },
  .. arithmetic_function.has_zero R,
  .. arithmetic_function.has_mul,
  .. arithmetic_function.has_add,
  .. arithmetic_function.add_comm_monoid,
  .. arithmetic_function.add_monoid_with_one,
  .. arithmetic_function.monoid }

end semiring

instance [comm_semiring R] : comm_semiring (arithmetic_function R) :=
{ mul_comm := λ f g, by { ext,
    rw [mul_apply, ← map_swap_divisors_antidiagonal, sum_map],
    simp [mul_comm] },
  .. arithmetic_function.semiring }

instance [comm_ring R] : comm_ring (arithmetic_function R) :=
{ .. arithmetic_function.add_comm_group,
  .. arithmetic_function.comm_semiring }

instance {M : Type*} [semiring R] [add_comm_monoid M] [module R M] :
  module (arithmetic_function R) (arithmetic_function M) :=
{ one_smul := one_smul',
  mul_smul := mul_smul',
  smul_add := λ r x y, by { ext, simp only [sum_add_distrib, smul_add, smul_apply, add_apply] },
  smul_zero := λ r, by { ext, simp only [smul_apply, sum_const_zero, smul_zero, zero_apply] },
  add_smul := λ r s x, by { ext, simp only [add_smul, sum_add_distrib, smul_apply, add_apply] },
  zero_smul := λ r, by { ext, simp only [smul_apply, sum_const_zero, zero_smul, zero_apply] }, }

section zeta

/-- `ζ 0 = 0`, otherwise `ζ x = 1`. The Dirichlet Series is the Riemann ζ.  -/
def zeta : arithmetic_function ℕ :=
⟨λ x, ite (x = 0) 0 1, rfl⟩

localized "notation (name := arithmetic_function.zeta)
  `ζ` := nat.arithmetic_function.zeta" in arithmetic_function

@[simp]
lemma zeta_apply {x : ℕ} : ζ x = if (x = 0) then 0 else 1 := rfl

lemma zeta_apply_ne {x : ℕ} (h : x ≠ 0) : ζ x = 1 := if_neg h

@[simp] theorem coe_zeta_smul_apply {M} [semiring R] [add_comm_monoid M] [module R M]
  {f : arithmetic_function M} {x : ℕ} :
  ((↑ζ : arithmetic_function R) • f) x = ∑ i in divisors x, f i :=
begin
  rw smul_apply,
  transitivity ∑ i in divisors_antidiagonal x, f i.snd,
  { refine sum_congr rfl (λ i hi, _),
    rcases mem_divisors_antidiagonal.1 hi with ⟨rfl, h⟩,
    rw [nat_coe_apply, zeta_apply_ne (left_ne_zero_of_mul h), cast_one, one_smul] },
  { rw [← map_div_left_divisors, sum_map, function.embedding.coe_fn_mk] }
end

@[simp]
theorem coe_zeta_mul_apply [semiring R] {f : arithmetic_function R} {x : ℕ} :
  (↑ζ * f) x = ∑ i in divisors x, f i :=
coe_zeta_smul_apply

@[simp]
theorem coe_mul_zeta_apply [semiring R] {f : arithmetic_function R} {x : ℕ} :
  (f * ζ) x = ∑ i in divisors x, f i :=
begin
  rw mul_apply,
  transitivity ∑ i in divisors_antidiagonal x, f i.1,
  { refine sum_congr rfl (λ i hi, _),
    rcases mem_divisors_antidiagonal.1 hi with ⟨rfl, h⟩,
    rw [nat_coe_apply, zeta_apply_ne (right_ne_zero_of_mul h), cast_one, mul_one] },
  { rw [← map_div_right_divisors, sum_map, function.embedding.coe_fn_mk] }
end

theorem zeta_mul_apply {f : arithmetic_function ℕ} {x : ℕ} :
  (ζ * f) x = ∑ i in divisors x, f i :=
by rw [← nat_coe_nat ζ, coe_zeta_mul_apply]

theorem mul_zeta_apply {f : arithmetic_function ℕ} {x : ℕ} :
  (f * ζ) x = ∑ i in divisors x, f i :=
by rw [← nat_coe_nat ζ, coe_mul_zeta_apply]

end zeta

open_locale arithmetic_function

section pmul

/-- This is the pointwise product of `arithmetic_function`s. -/
def pmul [mul_zero_class R] (f g : arithmetic_function R) :
  arithmetic_function R :=
⟨λ x, f x * g x, by simp⟩

@[simp]
lemma pmul_apply [mul_zero_class R] {f g : arithmetic_function R} {x : ℕ} :
  f.pmul g x = f x * g x := rfl

lemma pmul_comm [comm_monoid_with_zero R] (f g : arithmetic_function R) :
  f.pmul g = g.pmul f :=
by { ext, simp [mul_comm] }

section non_assoc_semiring
variable [non_assoc_semiring R]

@[simp]
lemma pmul_zeta (f : arithmetic_function R) : f.pmul ↑ζ = f :=
begin
  ext x,
  cases x;
  simp [nat.succ_ne_zero],
end

@[simp]
lemma zeta_pmul (f : arithmetic_function R) : (ζ : arithmetic_function R).pmul f = f :=
begin
  ext x,
  cases x;
  simp [nat.succ_ne_zero],
end

end non_assoc_semiring

variables [semiring R]

/-- This is the pointwise power of `arithmetic_function`s. -/
def ppow (f : arithmetic_function R) (k : ℕ) :
  arithmetic_function R :=
if h0 : k = 0 then ζ else ⟨λ x, (f x) ^ k,
  by { rw [map_zero], exact zero_pow (nat.pos_of_ne_zero h0) }⟩

@[simp]
lemma ppow_zero {f : arithmetic_function R} : f.ppow 0 = ζ :=
by rw [ppow, dif_pos rfl]

@[simp]
lemma ppow_apply {f : arithmetic_function R} {k x : ℕ} (kpos : 0 < k) :
  f.ppow k x = (f x) ^ k :=
by { rw [ppow, dif_neg (ne_of_gt kpos)], refl }

lemma ppow_succ {f : arithmetic_function R} {k : ℕ} :
  f.ppow (k + 1) = f.pmul (f.ppow k) :=
begin
  ext x,
  rw [ppow_apply (nat.succ_pos k), pow_succ],
  induction k; simp,
end

lemma ppow_succ' {f : arithmetic_function R} {k : ℕ} {kpos : 0 < k} :
  f.ppow (k + 1) = (f.ppow k).pmul f :=
begin
  ext x,
  rw [ppow_apply (nat.succ_pos k), pow_succ'],
  induction k; simp,
end

end pmul

/-- Multiplicative functions -/
def is_multiplicative [monoid_with_zero R] (f : arithmetic_function R) : Prop :=
f 1 = 1 ∧ (∀ {m n : ℕ}, m.coprime n → f (m * n) = f m * f n)

namespace is_multiplicative

section monoid_with_zero
variable [monoid_with_zero R]

@[simp]
lemma map_one {f : arithmetic_function R} (h : f.is_multiplicative) : f 1 = 1 :=
h.1

@[simp]
lemma map_mul_of_coprime {f : arithmetic_function R} (hf : f.is_multiplicative)
  {m n : ℕ} (h : m.coprime n) : f (m * n) = f m * f n :=
hf.2 h

end monoid_with_zero

lemma map_prod {ι : Type*} [comm_monoid_with_zero R] (g : ι → ℕ) {f : nat.arithmetic_function R}
  (hf : f.is_multiplicative) (s : finset ι) (hs : (s : set ι).pairwise (coprime on g)):
  f (∏ i in s, g i) = ∏ i in s, f (g i) :=
begin
  classical,
  induction s using finset.induction_on with a s has ih hs,
  { simp [hf] },
  rw [coe_insert, set.pairwise_insert_of_symmetric (coprime.symmetric.comap g)] at hs,
  rw [prod_insert has, prod_insert has, hf.map_mul_of_coprime, ih hs.1],
  exact nat.coprime_prod_right (λ i hi, hs.2 _ hi (hi.ne_of_not_mem has).symm),
end

lemma nat_cast {f : arithmetic_function ℕ} [semiring R] (h : f.is_multiplicative) :
  is_multiplicative (f : arithmetic_function R) :=
⟨by simp [h], λ m n cop, by simp [cop, h]⟩

lemma int_cast {f : arithmetic_function ℤ} [ring R] (h : f.is_multiplicative) :
  is_multiplicative (f : arithmetic_function R) :=
⟨by simp [h], λ m n cop, by simp [cop, h]⟩

lemma mul [comm_semiring R] {f g : arithmetic_function R}
  (hf : f.is_multiplicative) (hg : g.is_multiplicative) :
  is_multiplicative (f * g) :=
⟨by { simp [hf, hg], }, begin
  simp only [mul_apply],
  intros m n cop,
  rw sum_mul_sum,
  symmetry,
  apply sum_bij (λ (x : (ℕ × ℕ) × ℕ × ℕ) h, (x.1.1 * x.2.1, x.1.2 * x.2.2)),
  { rintros ⟨⟨a1, a2⟩, ⟨b1, b2⟩⟩ h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at h,
    rcases h with ⟨⟨rfl, ha⟩, ⟨rfl, hb⟩⟩,
    simp only [mem_divisors_antidiagonal, nat.mul_eq_zero, ne.def],
    split, {ring},
    rw nat.mul_eq_zero at *,
    apply not_or ha hb },
  { rintros ⟨⟨a1, a2⟩, ⟨b1, b2⟩⟩ h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at h,
    rcases h with ⟨⟨rfl, ha⟩, ⟨rfl, hb⟩⟩,
    dsimp only,
    rw [hf.map_mul_of_coprime cop.coprime_mul_right.coprime_mul_right_right,
        hg.map_mul_of_coprime cop.coprime_mul_left.coprime_mul_left_right],
    ring, },
  { rintros ⟨⟨a1, a2⟩, ⟨b1, b2⟩⟩ ⟨⟨c1, c2⟩, ⟨d1, d2⟩⟩ hab hcd h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at hab,
    rcases hab with ⟨⟨rfl, ha⟩, ⟨rfl, hb⟩⟩,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at hcd,
    simp only [prod.mk.inj_iff] at h,
    ext; dsimp only,
    { transitivity nat.gcd (a1 * a2) (a1 * b1),
      { rw [nat.gcd_mul_left, cop.coprime_mul_left.coprime_mul_right_right.gcd_eq_one, mul_one] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.1.1, h.1, nat.gcd_mul_left,
            cop.coprime_mul_left.coprime_mul_right_right.gcd_eq_one, mul_one] } },
    { transitivity nat.gcd (a1 * a2) (a2 * b2),
      { rw [mul_comm, nat.gcd_mul_left, cop.coprime_mul_right.coprime_mul_left_right.gcd_eq_one,
            mul_one] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.1.1, h.2, mul_comm, nat.gcd_mul_left,
            cop.coprime_mul_right.coprime_mul_left_right.gcd_eq_one, mul_one] } },
    { transitivity nat.gcd (b1 * b2) (a1 * b1),
      { rw [mul_comm, nat.gcd_mul_right,
           cop.coprime_mul_right.coprime_mul_left_right.symm.gcd_eq_one, one_mul] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.2.1, h.1, mul_comm c1 d1, nat.gcd_mul_left,
            cop.coprime_mul_right.coprime_mul_left_right.symm.gcd_eq_one, mul_one] } },
    { transitivity nat.gcd (b1 * b2) (a2 * b2),
      { rw [nat.gcd_mul_right,
           cop.coprime_mul_left.coprime_mul_right_right.symm.gcd_eq_one, one_mul] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.2.1, h.2, nat.gcd_mul_right,
            cop.coprime_mul_left.coprime_mul_right_right.symm.gcd_eq_one, one_mul] } } },
  { rintros ⟨b1, b2⟩ h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at h,
    use ((b1.gcd m, b2.gcd m), (b1.gcd n, b2.gcd n)),
    simp only [exists_prop, prod.mk.inj_iff, ne.def, mem_product, mem_divisors_antidiagonal],
    rw [← cop.gcd_mul _, ← cop.gcd_mul _, ← h.1, nat.gcd_mul_gcd_of_coprime_of_mul_eq_mul cop h.1,
        nat.gcd_mul_gcd_of_coprime_of_mul_eq_mul cop.symm _],
    { rw [nat.mul_eq_zero, decidable.not_or_iff_and_not] at h, simp [h.2.1, h.2.2] },
    rw [mul_comm n m, h.1] }
end⟩

lemma pmul [comm_semiring R] {f g : arithmetic_function R}
  (hf : f.is_multiplicative) (hg : g.is_multiplicative) :
  is_multiplicative (f.pmul g) :=
⟨by { simp [hf, hg], }, λ m n cop, begin
  simp only [pmul_apply, hf.map_mul_of_coprime cop, hg.map_mul_of_coprime cop],
  ring,
end⟩

/-- For any multiplicative function `f` and any `n > 0`,
we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/
lemma multiplicative_factorization [comm_monoid_with_zero R] (f : arithmetic_function R)
  (hf : f.is_multiplicative) {n : ℕ} (hn : n ≠ 0) : f n = n.factorization.prod (λ p k, f (p ^ k)) :=
multiplicative_factorization f (λ _ _, hf.2) hf.1 hn

/-- A recapitulation of the definition of multiplicative that is simpler for proofs -/
lemma iff_ne_zero [monoid_with_zero R] {f : arithmetic_function R} :
  is_multiplicative f ↔
    f 1 = 1 ∧ (∀ {m n : ℕ}, m ≠ 0 → n ≠ 0 → m.coprime n → f (m * n) = f m * f n) :=
begin
  refine and_congr_right' (forall₂_congr (λ m n, ⟨λ h _ _, h, λ h hmn, _⟩)),
  rcases eq_or_ne m 0 with rfl | hm,
  { simp },
  rcases eq_or_ne n 0 with rfl | hn,
  { simp },
  exact h hm hn hmn,
end

/-- Two multiplicative functions `f` and `g` are equal if and only if
they agree on prime powers -/
lemma eq_iff_eq_on_prime_powers [comm_monoid_with_zero R]
  (f : arithmetic_function R) (hf : f.is_multiplicative)
  (g : arithmetic_function R) (hg : g.is_multiplicative) :
  f = g ↔ ∀ (p i : ℕ), nat.prime p → f (p ^ i) = g (p ^ i) :=
begin
  split,
  { intros h p i _, rw [h] },
  intros h,
  ext n,
  by_cases hn : n = 0,
  { rw [hn, arithmetic_function.map_zero, arithmetic_function.map_zero] },
  rw [multiplicative_factorization f hf hn, multiplicative_factorization g hg hn],
  refine finset.prod_congr rfl _,
  simp only [support_factorization, list.mem_to_finset],
  intros p hp,
  exact h p _ (nat.prime_of_mem_factors hp),
end

end is_multiplicative

section special_functions

/-- The identity on `ℕ` as an `arithmetic_function`.  -/
def id : arithmetic_function ℕ := ⟨id, rfl⟩

@[simp]
lemma id_apply {x : ℕ} : id x = x := rfl

/-- `pow k n = n ^ k`, except `pow 0 0 = 0`. -/
def pow (k : ℕ) : arithmetic_function ℕ := id.ppow k

@[simp]
lemma pow_apply {k n : ℕ} : pow k n = if (k = 0 ∧ n = 0) then 0 else n ^ k :=
begin
  cases k,
  { simp [pow] },
  simp [pow, (ne_of_lt (nat.succ_pos k)).symm],
end

lemma pow_zero_eq_zeta : pow 0 = ζ := by { ext n, simp }

/-- `σ k n` is the sum of the `k`th powers of the divisors of `n` -/
def sigma (k : ℕ) : arithmetic_function ℕ :=
⟨λ n, ∑ d in divisors n, d ^ k, by simp⟩

localized "notation (name := arithmetic_function.sigma)
  `σ` := nat.arithmetic_function.sigma" in arithmetic_function

lemma sigma_apply {k n : ℕ} : σ k n = ∑ d in divisors n, d ^ k := rfl

lemma sigma_one_apply (n : ℕ) : σ 1 n = ∑ d in divisors n, d := by simp [sigma_apply]

lemma sigma_zero_apply (n : ℕ) : σ 0 n = (divisors n).card := by simp [sigma_apply]

lemma sigma_zero_apply_prime_pow {p i : ℕ} (hp : p.prime) :
  σ 0 (p ^ i) = i + 1 :=
by rw [sigma_zero_apply, divisors_prime_pow hp, card_map, card_range]

lemma zeta_mul_pow_eq_sigma {k : ℕ} : ζ * pow k = σ k :=
begin
  ext,
  rw [sigma, zeta_mul_apply],
  apply sum_congr rfl,
  intros x hx,
  rw [pow_apply, if_neg (not_and_of_not_right _ _)],
  contrapose! hx,
  simp [hx],
end

lemma is_multiplicative_one [monoid_with_zero R] : is_multiplicative (1 : arithmetic_function R) :=
is_multiplicative.iff_ne_zero.2 ⟨by simp,
begin
  intros m n hm hn hmn,
  rcases eq_or_ne m 1 with rfl | hm',
  { simp },
  rw [one_apply_ne, one_apply_ne hm', zero_mul],
  rw [ne.def, nat.mul_eq_one_iff, not_and_distrib],
  exact or.inl hm'
end⟩

lemma is_multiplicative_zeta : is_multiplicative ζ :=
is_multiplicative.iff_ne_zero.2 ⟨by simp, by simp {contextual := tt}⟩

lemma is_multiplicative_id : is_multiplicative arithmetic_function.id :=
⟨rfl, λ _ _ _, rfl⟩

lemma is_multiplicative.ppow [comm_semiring R] {f : arithmetic_function R}
  (hf : f.is_multiplicative) {k : ℕ} :
  is_multiplicative (f.ppow k) :=
begin
  induction k with k hi,
  { exact is_multiplicative_zeta.nat_cast },
  { rw ppow_succ,
    apply hf.pmul hi },
end

lemma is_multiplicative_pow {k : ℕ} : is_multiplicative (pow k) :=
is_multiplicative_id.ppow

lemma is_multiplicative_sigma {k : ℕ} :
  is_multiplicative (σ k) :=
begin
  rw [← zeta_mul_pow_eq_sigma],
  apply ((is_multiplicative_zeta).mul is_multiplicative_pow)
end

/-- `Ω n` is the number of prime factors of `n`. -/
def card_factors : arithmetic_function ℕ :=
⟨λ n, n.factors.length, by simp⟩

localized "notation (name := card_factors)
  `Ω` := nat.arithmetic_function.card_factors" in arithmetic_function

lemma card_factors_apply {n : ℕ} :
  Ω n = n.factors.length := rfl

@[simp]
lemma card_factors_one : Ω 1 = 0 := by simp [card_factors]

lemma card_factors_eq_one_iff_prime {n : ℕ} :
  Ω n = 1 ↔ n.prime :=
begin
  refine ⟨λ h, _, λ h, list.length_eq_one.2 ⟨n, factors_prime h⟩⟩,
  cases n,
  { contrapose! h,
    simp },
  rcases list.length_eq_one.1 h with ⟨x, hx⟩,
  rw [← prod_factors n.succ_ne_zero, hx, list.prod_singleton],
  apply prime_of_mem_factors,
  rw [hx, list.mem_singleton]
end

lemma card_factors_mul {m n : ℕ} (m0 : m ≠ 0) (n0 : n ≠ 0) :
  Ω (m * n) = Ω m + Ω n :=
by rw [card_factors_apply, card_factors_apply, card_factors_apply, ← multiset.coe_card,
  ← factors_eq, unique_factorization_monoid.normalized_factors_mul m0 n0, factors_eq, factors_eq,
  multiset.card_add, multiset.coe_card, multiset.coe_card]

lemma card_factors_multiset_prod {s : multiset ℕ} (h0 : s.prod ≠ 0) :
  Ω s.prod = (multiset.map Ω s).sum :=
begin
  revert h0,
  apply s.induction_on, by simp,
  intros a t h h0,
  rw [multiset.prod_cons, mul_ne_zero_iff] at h0,
  simp [h0, card_factors_mul, h],
end

@[simp] lemma card_factors_apply_prime {p : ℕ} (hp : p.prime) : Ω p = 1 :=
card_factors_eq_one_iff_prime.2 hp

@[simp] lemma card_factors_apply_prime_pow {p k : ℕ} (hp : p.prime) : Ω (p ^ k) = k :=
by rw [card_factors_apply, hp.factors_pow, list.length_replicate]

/-- `ω n` is the number of distinct prime factors of `n`. -/
def card_distinct_factors : arithmetic_function ℕ :=
⟨λ n, n.factors.dedup.length, by simp⟩

localized "notation (name := card_distinct_factors)
  `ω` := nat.arithmetic_function.card_distinct_factors" in arithmetic_function

lemma card_distinct_factors_zero : ω 0 = 0 := by simp

@[simp] lemma card_distinct_factors_one : ω 1 = 0 := by simp [card_distinct_factors]

lemma card_distinct_factors_apply {n : ℕ} :
  ω n = n.factors.dedup.length := rfl

lemma card_distinct_factors_eq_card_factors_iff_squarefree {n : ℕ} (h0 : n ≠ 0) :
  ω n = Ω n ↔ squarefree n :=
begin
  rw [squarefree_iff_nodup_factors h0, card_distinct_factors_apply],
  split; intro h,
  { rw ←n.factors.dedup_sublist.eq_of_length h,
    apply list.nodup_dedup },
  { rw h.dedup,
    refl }
end

@[simp] lemma card_distinct_factors_apply_prime_pow {p k : ℕ} (hp : p.prime) (hk : k ≠ 0) :
  ω (p ^ k) = 1 :=
by rw [card_distinct_factors_apply, hp.factors_pow, list.replicate_dedup hk, list.length_singleton]

@[simp] lemma card_distinct_factors_apply_prime {p : ℕ} (hp : p.prime) : ω p = 1 :=
by rw [←pow_one p, card_distinct_factors_apply_prime_pow hp one_ne_zero]

/-- `μ` is the Möbius function. If `n` is squarefree with an even number of distinct prime factors,
  `μ n = 1`. If `n` is squarefree with an odd number of distinct prime factors, `μ n = -1`.
  If `n` is not squarefree, `μ n = 0`. -/
def moebius : arithmetic_function ℤ :=
⟨λ n, if squarefree n then (-1) ^ (card_factors n) else 0, by simp⟩

localized "notation (name := moebius)
  `μ` := nat.arithmetic_function.moebius" in arithmetic_function

@[simp]
lemma moebius_apply_of_squarefree {n : ℕ} (h : squarefree n) : μ n = (-1) ^ card_factors n :=
if_pos h

@[simp] lemma moebius_eq_zero_of_not_squarefree {n : ℕ} (h : ¬ squarefree n) : μ n = 0 := if_neg h

lemma moebius_apply_one : μ 1 = 1 := by simp

lemma moebius_ne_zero_iff_squarefree {n : ℕ} : μ n ≠ 0 ↔ squarefree n :=
begin
  split; intro h,
  { contrapose! h,
    simp [h] },
  { simp [h, pow_ne_zero] }
end

lemma moebius_ne_zero_iff_eq_or {n : ℕ} : μ n ≠ 0 ↔ μ n = 1 ∨ μ n = -1 :=
begin
  split; intro h,
  { rw moebius_ne_zero_iff_squarefree at h,
    rw moebius_apply_of_squarefree h,
    apply neg_one_pow_eq_or },
  { rcases h with h | h; simp [h] }
end

lemma moebius_apply_prime {p : ℕ} (hp : p.prime) : μ p = -1 :=
by rw [moebius_apply_of_squarefree hp.squarefree, card_factors_apply_prime hp, pow_one]

lemma moebius_apply_prime_pow {p k : ℕ} (hp : p.prime) (hk : k ≠ 0) :
  μ (p ^ k) = if k = 1 then -1 else 0 :=
begin
  split_ifs,
  { rw [h, pow_one, moebius_apply_prime hp] },
  rw [moebius_eq_zero_of_not_squarefree],
  rw [squarefree_pow_iff hp.ne_one hk, not_and_distrib],
  exact or.inr h,
end

lemma moebius_apply_is_prime_pow_not_prime {n : ℕ} (hn : is_prime_pow n) (hn' : ¬ n.prime) :
  μ n = 0 :=
begin
  obtain ⟨p, k, hp, hk, rfl⟩ := (is_prime_pow_nat_iff _).1 hn,
  rw [moebius_apply_prime_pow hp hk.ne', if_neg],
  rintro rfl,
  exact hn' (by simpa),
end

lemma is_multiplicative_moebius : is_multiplicative μ :=
begin
  rw is_multiplicative.iff_ne_zero,
  refine ⟨by simp, λ n m hn hm hnm, _⟩,
  simp only [moebius, zero_hom.coe_mk, squarefree_mul hnm, ite_and, card_factors_mul hn hm],
  rw [pow_add, mul_comm, ite_mul_zero_left, ite_mul_zero_right, mul_comm],
end

open unique_factorization_monoid

@[simp]

@[simp] lemma coe_zeta_mul_moebius : (ζ * μ : arithmetic_function ℤ) = 1 :=
by rw [mul_comm, moebius_mul_coe_zeta]

@[simp] lemma coe_moebius_mul_coe_zeta [ring R] : (μ * ζ : arithmetic_function R) = 1 :=
by rw [←coe_coe, ←int_coe_mul, moebius_mul_coe_zeta, int_coe_one]

@[simp] lemma coe_zeta_mul_coe_moebius [ring R] : (ζ * μ : arithmetic_function R) = 1 :=
by rw [←coe_coe, ←int_coe_mul, coe_zeta_mul_moebius, int_coe_one]

section comm_ring
variable [comm_ring R]

instance : invertible (ζ : arithmetic_function R) :=
{ inv_of := μ,
  inv_of_mul_self := coe_moebius_mul_coe_zeta,
  mul_inv_of_self := coe_zeta_mul_coe_moebius}

/-- A unit in `arithmetic_function R` that evaluates to `ζ`, with inverse `μ`. -/
def zeta_unit : (arithmetic_function R)ˣ :=
⟨ζ, μ, coe_zeta_mul_coe_moebius, coe_moebius_mul_coe_zeta⟩

@[simp]
lemma coe_zeta_unit :
  ((zeta_unit : (arithmetic_function R)ˣ) : arithmetic_function R) = ζ := rfl

@[simp]
lemma inv_zeta_unit :
  ((zeta_unit⁻¹ : (arithmetic_function R)ˣ) : arithmetic_function R) = μ := rfl

end comm_ring

/-- Möbius inversion for functions to an `add_comm_group`. -/
theorem sum_eq_iff_sum_smul_moebius_eq
  [add_comm_group R] {f g : ℕ → R} :
  (∀ (n : ℕ), 0 < n → ∑ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∑ (x : ℕ × ℕ) in n.divisors_antidiagonal, μ x.fst • g x.snd = f n :=
begin
  let f' : arithmetic_function R := ⟨λ x, if x = 0 then 0 else f x, if_pos rfl⟩,
  let g' : arithmetic_function R := ⟨λ x, if x = 0 then 0 else g x, if_pos rfl⟩,
  transitivity (ζ : arithmetic_function ℤ) • f' = g',
  { rw ext_iff,
    apply forall_congr,
    intro n,
    cases n, { simp },
    rw coe_zeta_smul_apply,
    simp only [n.succ_ne_zero, forall_prop_of_true, succ_pos', if_false, zero_hom.coe_mk],
    rw sum_congr rfl (λ x hx, _),
    rw (if_neg (ne_of_gt (nat.pos_of_mem_divisors hx))) },
  transitivity μ • g' = f',
  { split; intro h,
    { rw [← h, ← mul_smul, moebius_mul_coe_zeta, one_smul] },
    { rw [← h, ← mul_smul, coe_zeta_mul_moebius, one_smul] } },
  { rw ext_iff,
    apply forall_congr,
    intro n,
    cases n, { simp },
    simp only [n.succ_ne_zero, forall_prop_of_true, succ_pos', smul_apply,
      if_false, zero_hom.coe_mk],
    rw sum_congr rfl (λ x hx, _),
    rw (if_neg (ne_of_gt (nat.pos_of_mem_divisors (snd_mem_divisors_of_mem_antidiagonal hx)))) },
end

/-- Möbius inversion for functions to a `ring`. -/
theorem sum_eq_iff_sum_mul_moebius_eq [ring R] {f g : ℕ → R} :
  (∀ (n : ℕ), 0 < n → ∑ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∑ (x : ℕ × ℕ) in n.divisors_antidiagonal, (μ x.fst : R) * g x.snd = f n :=
begin
  rw sum_eq_iff_sum_smul_moebius_eq,
  apply forall_congr,
  refine λ a, imp_congr_right (λ _, (sum_congr rfl $ λ x hx, _).congr_left),
  rw [zsmul_eq_mul],
end

/-- Möbius inversion for functions to a `comm_group`. -/
theorem prod_eq_iff_prod_pow_moebius_eq [comm_group R] {f g : ℕ → R} :
  (∀ (n : ℕ), 0 < n → ∏ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∏ (x : ℕ × ℕ) in n.divisors_antidiagonal, g x.snd ^ (μ x.fst) = f n :=
@sum_eq_iff_sum_smul_moebius_eq (additive R) _ _ _

/-- Möbius inversion for functions to a `comm_group_with_zero`. -/
theorem prod_eq_iff_prod_pow_moebius_eq_of_nonzero [comm_group_with_zero R] {f g : ℕ → R}
  (hf : ∀ (n : ℕ), 0 < n → f n ≠ 0) (hg : ∀ (n : ℕ), 0 < n → g n ≠ 0) :
  (∀ (n : ℕ), 0 < n → ∏ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∏ (x : ℕ × ℕ) in n.divisors_antidiagonal, g x.snd ^ (μ x.fst) = f n :=
begin
  refine iff.trans (iff.trans (forall_congr (λ n, _)) (@prod_eq_iff_prod_pow_moebius_eq Rˣ _
    (λ n, if h : 0 < n then units.mk0 (f n) (hf n h) else 1)
    (λ n, if h : 0 < n then units.mk0 (g n) (hg n h) else 1))) (forall_congr (λ n, _));
  refine imp_congr_right (λ hn, _),
  { dsimp,
    rw [dif_pos hn, ← units.eq_iff, ← units.coe_hom_apply, monoid_hom.map_prod, units.coe_mk0,
      prod_congr rfl _],
    intros x hx,
    rw [dif_pos (nat.pos_of_mem_divisors hx), units.coe_hom_apply, units.coe_mk0] },
  { dsimp,
    rw [dif_pos hn, ← units.eq_iff, ← units.coe_hom_apply, monoid_hom.map_prod, units.coe_mk0,
      prod_congr rfl _],
    intros x hx,
    rw [dif_pos (nat.pos_of_mem_divisors (nat.snd_mem_divisors_of_mem_antidiagonal hx)),
      units.coe_hom_apply, units.coe_zpow, units.coe_mk0] }
end

end special_functions
end arithmetic_function
end nat


import Lean4Axiomatic.Natural.Addition
import Lean4Axiomatic.Natural.Sign

/-!
# Natural number ordering
-/

namespace Lean4Axiomatic.Natural

open Signed (Positive)

/-!
## Axioms
-/

/--
Definition of the _less than or equal to_ and _less than_ relations.

All other properties of ordering on natural numbers can be derived from this.
-/
class Order (ℕ : Type) [Core ℕ] [Addition ℕ] :=
  /-- Definition of and syntax for the _less than or equal to_ relation. -/
  leOp : LE ℕ

  /--
  The _less than or equal to_ relation between two natural numbers `n` and `m`
  is equivalent to there being a natural number -- the _difference_ between `n`
  and `m` -- that, when added to `n`, results in `m`.
  -/
  le_defn {n m : ℕ} : n ≤ m ↔ ∃ k : ℕ, n + k ≃ m

  /-- Definition of and syntax for the _less than_ relation. -/
  ltOp : LT ℕ

  /--
  The _less than_ relation between two natural numbers is defined to be the
  same as _less than or equal to_, with the added condition that the numbers
  are not equal.
  -/
  lt_defn {n m : ℕ} : n < m ↔ n ≤ m ∧ n ≄ m

-- Higher priority than the stdlib definitions
attribute [instance default+1] Order.leOp
attribute [instance default+1] Order.ltOp

export Order (le_defn leOp lt_defn ltOp)

/-!
## Derived properties
-/

variable {ℕ : Type}
variable [Core ℕ]
variable [Axioms ℕ]
variable [Addition ℕ]
variable [Sign ℕ]
variable [order_inst : Order ℕ]

/--
The _less than or equal to_ relation is preserved when both sides are
incremented.
-/
theorem le_subst_step {n₁ n₂ : ℕ} : n₁ ≤ n₂ → step n₁ ≤ step n₂ := by
  intro (_ : n₁ ≤ n₂)
  show step n₁ ≤ step n₂
  have ⟨d, (_ : n₁ + d ≃ n₂)⟩ := le_defn.mp ‹n₁ ≤ n₂›
  apply le_defn.mpr
  exists d
  show step n₁ + d ≃ step n₂
  calc
    step n₁ + d   ≃ _ := step_add
    step (n₁ + d) ≃ _ := AA.subst₁ ‹n₁ + d ≃ n₂›
    step n₂       ≃ _ := Rel.refl

instance le_substitutive_step
    : AA.Substitutive₁ (α := ℕ) step (· ≤ ·) (· ≤ ·)
    := {
  subst₁ := le_subst_step
}

/--
The _less than or equal to_ relation is preserved when both sides are
decremented.
-/
theorem le_inject_step {n₁ n₂ : ℕ} : step n₁ ≤ step n₂ → n₁ ≤ n₂ := by
  intro (_ : step n₁ ≤ step n₂)
  show n₁ ≤ n₂
  have ⟨d, (_ : step n₁ + d ≃ step n₂)⟩ := le_defn.mp ‹step n₁ ≤ step n₂›
  apply le_defn.mpr
  exists d
  show n₁ + d ≃ n₂
  have : step (n₁ + d) ≃ step n₂ := calc
    step (n₁ + d) ≃ _ := Rel.symm step_add
    step n₁ + d   ≃ _ := ‹step n₁ + d ≃ step n₂›
    step n₂       ≃ _ := Rel.refl
  exact AA.inject ‹step (n₁ + d) ≃ step n₂›

instance le_injective_step : AA.Injective (α := ℕ) step (· ≤ ·) (· ≤ ·) := {
  inject := le_inject_step
}

/--
Equal natural numbers can be substituted on the left side of
_less than or equal to_.
-/
theorem le_subst_eqv {n₁ n₂ m : ℕ} : n₁ ≃ n₂ → n₁ ≤ m → n₂ ≤ m := by
  intro (_ : n₁ ≃ n₂) (_ : n₁ ≤ m)
  show n₂ ≤ m
  have ⟨d, (_ : n₁ + d ≃ m)⟩ := le_defn.mp ‹n₁ ≤ m›
  apply le_defn.mpr
  exists d
  show n₂ + d ≃ m
  calc
    n₂ + d ≃ _ := Rel.symm (AA.substL ‹n₁ ≃ n₂›)
    n₁ + d ≃ _ := ‹n₁ + d ≃ m›
    m      ≃ _ := Rel.refl

def le_substL_eqv
    : AA.SubstitutiveOn Hand.L (α := ℕ) (· ≤ ·) AA.tc (· ≃ ·) (· → ·)
    := {
  subst₂ := λ (_ : True) => le_subst_eqv
}

/--
Equal natural numbers can be substituted on the right side of
_less than or equal to_.
-/
theorem le_eqv_subst {n m₁ m₂ : ℕ} : m₁ ≃ m₂ → n ≤ m₁ → n ≤ m₂ := by
  intro (_ : m₁ ≃ m₂) (_ : n ≤ m₁)
  show n ≤ m₂
  have ⟨d, (_ : n + d ≃ m₁)⟩ := le_defn.mp ‹n ≤ m₁›
  apply le_defn.mpr
  exists d
  show n + d ≃ m₂
  exact Rel.trans ‹n + d ≃ m₁› ‹m₁ ≃ m₂›

def le_substR_eqv
    : AA.SubstitutiveOn Hand.R (α := ℕ) (· ≤ ·) AA.tc (· ≃ ·) (· → ·)
    := {
  subst₂ := λ (_ : True) => le_eqv_subst
}

instance le_substitutive_eqv
    : AA.Substitutive₂ (α := ℕ) (· ≤ ·) AA.tc (· ≃ ·) (· → ·)
    := {
  substitutiveL := le_substL_eqv
  substitutiveR := le_substR_eqv
}

/-- All natural numbers are _less than or equal to_ themselves. -/
theorem le_refl {n : ℕ} : n ≤ n := by
  apply le_defn.mpr
  exists (0 : ℕ)
  show n + 0 ≃ n
  exact add_zero

instance le_reflexive : Relation.Reflexive (α := ℕ) (· ≤ ·) := {
  refl := le_refl
}

theorem le_step_split {n m : ℕ} : n ≤ step m → n ≤ m ∨ n ≃ step m := by
  intro (_ : n ≤ step m)
  show n ≤ m ∨ n ≃ step m
  have ⟨d, (_ : n + d ≃ step m)⟩ := le_defn.mp ‹n ≤ step m›
  let motive := λ x => d ≃ x → n ≤ m ∨ n ≃ step m
  apply (cases_on (motive := motive) d · · Rel.refl)
  · intro (_ : d ≃ 0)
    apply Or.inr
    show n ≃ step m
    calc
      n      ≃ _ := Rel.symm add_zero
      n + 0  ≃ _ := AA.substR (Rel.symm ‹d ≃ 0›)
      n + d  ≃ _ := ‹n + d ≃ step m›
      step m ≃ _ := Rel.refl
  · intro e (_ : d ≃ step e)
    apply Or.inl
    show n ≤ m
    apply le_defn.mpr
    exists e
    show n + e ≃ m
    apply AA.inject (β := ℕ) (rβ := (· ≃ ·))
    show step (n + e) ≃ step m
    calc
      step (n + e) ≃ _ := Rel.symm add_step
      n + step e   ≃ _ := AA.substR (Rel.symm ‹d ≃ step e›)
      n + d        ≃ _ := ‹n + d ≃ step m›
      step m       ≃ _ := Rel.refl

theorem le_step {n m : ℕ} : n ≤ m → n ≤ step m := by
  intro (_ : n ≤ m)
  show n ≤ step m
  have ⟨d, (_ : n + d ≃ m)⟩ := le_defn.mp ‹n ≤ m›
  apply le_defn.mpr
  exists step d
  show n + step d ≃ step m
  calc
    n + step d   ≃ _ := add_step
    step (n + d) ≃ _ := AA.subst₁ ‹n + d ≃ m›
    step m       ≃ _ := Rel.refl

/--
The _less than or equal to_ relation can be extended through intermediate
values.
-/
theorem le_trans {n m k : ℕ} : n ≤ m → m ≤ k → n ≤ k := by
  intro (_ : n ≤ m)
  have ⟨d, (_ : n + d ≃ m)⟩ := le_defn.mp ‹n ≤ m›
  apply ind_on (motive := λ k => m ≤ k → n ≤ k) k
  case zero =>
    intro (_ : m ≤ 0)
    have ⟨e, (_ : m + e ≃ 0)⟩ := le_defn.mp ‹m ≤ 0›
    show n ≤ 0
    apply le_defn.mpr
    exists d + e
    show n + (d + e) ≃ 0
    calc
      n + (d + e) ≃ _ := Rel.symm AA.assoc
      (n + d) + e ≃ _ := AA.substL ‹n + d ≃ m›
      m + e       ≃ _ := ‹m + e ≃ 0›
      0           ≃ _ := Rel.refl
  case step =>
    intro k (ih : m ≤ k → n ≤ k) (_ : m ≤ step k)
    show n ≤ step k
    match le_step_split ‹m ≤ step k› with
    | Or.inl (_ : m ≤ k) =>
      exact le_step (ih ‹m ≤ k›)
    | Or.inr (_ : m ≃ step k) =>
      exact AA.substRFn ‹m ≃ step k› ‹n ≤ m›

instance le_transitive : Relation.Transitive (α := ℕ) (· ≤ ·) := {
  trans := le_trans
}

/--
The _less than or equal to_ relation is preserved when the same value is
added on the left to both sides.
-/
theorem le_subst_add {n₁ n₂ m : ℕ} : n₁ ≤ n₂ → n₁ + m ≤ n₂ + m := by
  intro (_ : n₁ ≤ n₂)
  show n₁ + m ≤ n₂ + m
  have ⟨d, (_ : n₁ + d ≃ n₂)⟩ := le_defn.mp ‹n₁ ≤ n₂›
  apply le_defn.mpr
  exists d
  show (n₁ + m) + d ≃ n₂ + m
  calc
    (n₁ + m) + d ≃ _ := AA.assoc
    n₁ + (m + d) ≃ _ := AA.substR AA.comm
    n₁ + (d + m) ≃ _ := Rel.symm AA.assoc
    (n₁ + d) + m ≃ _ := AA.substL ‹n₁ + d ≃ n₂›
    n₂ + m       ≃ _ := Rel.refl

def le_substL_add
    : AA.SubstitutiveOn Hand.L (α := ℕ) (· + ·) AA.tc (· ≤ ·) (· ≤ ·)
    := {
  subst₂ := λ (_ : True) => le_subst_add
}

instance le_substitutive_add
    : AA.Substitutive₂ (α := ℕ) (· + ·) AA.tc (· ≤ ·) (· ≤ ·)
    := {
  substitutiveL := le_substL_add
  substitutiveR := AA.substR_from_substL_swap (rS := (· ≃ ·)) le_substL_add
}

/--
The _less than or equal to_ relation is preserved when the same value is
removed from the left side of an addition on both sides of an equivalence.
-/
theorem le_cancel_add {n m₁ m₂ : ℕ} : n + m₁ ≤ n + m₂ → m₁ ≤ m₂ := by
  intro (_ : n + m₁ ≤ n + m₂)
  show m₁ ≤ m₂
  have ⟨d, (_ : (n + m₁) + d ≃ n + m₂)⟩ := le_defn.mp ‹n + m₁ ≤ n + m₂›
  apply le_defn.mpr
  exists d
  show m₁ + d ≃ m₂
  have : n + (m₁ + d) ≃ n + m₂ := calc
    n + (m₁ + d) ≃ _ := Rel.symm AA.assoc
    (n + m₁) + d ≃ _ := ‹(n + m₁) + d ≃ n + m₂›
    n + m₂       ≃ _ := Rel.refl
  exact AA.cancelL ‹n + (m₁ + d) ≃ n + m₂›

def le_cancelL_add
    : AA.CancellativeOn Hand.L (α := ℕ) (· + ·) AA.tc (· ≤ ·) (· ≤ ·)
    := {
  cancel := λ (_ : True) => le_cancel_add
}

instance le_cancellative_add
    : AA.Cancellative (α := ℕ) (· + ·) AA.tc (· ≤ ·) (· ≤ ·) := {
  cancellativeL := le_cancelL_add
  cancellativeR := AA.cancelR_from_cancelL le_cancelL_add
}

/-- Two natural numbers `n` and `m` are equal if `n ≤ m` and `m ≤ n`. -/
theorem le_antisymm {n m : ℕ} : n ≤ m → m ≤ n → n ≃ m := by
  intro (_ : n ≤ m) (_ : m ≤ n)
  show n ≃ m
  have ⟨d₁, (_ : n + d₁ ≃ m)⟩ := le_defn.mp ‹n ≤ m›
  have ⟨d₂, (_ : m + d₂ ≃ n)⟩ := le_defn.mp ‹m ≤ n›
  have : n + (d₁ + d₂) ≃ n + 0 := calc
    n + (d₁ + d₂) ≃ _ := Rel.symm AA.assoc
    (n + d₁) + d₂ ≃ _ := AA.substL ‹n + d₁ ≃ m›
    m + d₂        ≃ _ := ‹m + d₂ ≃ n›
    n             ≃ _ := Rel.symm add_zero
    n + 0         ≃ _ := Rel.refl
  have : d₁ + d₂ ≃ 0 := AA.cancelL ‹n + (d₁ + d₂) ≃ n + 0›
  have ⟨(_ : d₁ ≃ 0), _⟩ := zero_sum_split ‹d₁ + d₂ ≃ 0›
  calc
    n      ≃ _ := Rel.symm add_zero
    n + 0  ≃ _ := AA.substR (Rel.symm ‹d₁ ≃ 0›)
    n + d₁ ≃ _ := ‹n + d₁ ≃ m›
    m      ≃ _ := Rel.refl

/--
Equivalent natural numbers can be substituted on the left side of _less than_.
-/
theorem lt_subst_eqv {n₁ n₂ m : ℕ} : n₁ ≃ n₂ → n₁ < m → n₂ < m := by
  intro (_ : n₁ ≃ n₂) (_ : n₁ < m)
  show n₂ < m
  have ⟨(_ : n₁ ≤ m), (_ : n₁ ≄ m)⟩ := lt_defn.mp ‹n₁ < m›
  have : n₂ ≤ m := AA.substLFn ‹n₁ ≃ n₂› ‹n₁ ≤ m›
  have : n₂ ≄ m := AA.neqv_substL ‹n₁ ≃ n₂› ‹n₁ ≄ m›
  apply lt_defn.mpr
  exact ⟨‹n₂ ≤ m›, ‹n₂ ≄ m›⟩

def lt_substL_eqv
    : AA.SubstitutiveOn Hand.L (α := ℕ) (· < ·) AA.tc (· ≃ ·) (· → ·)
    := {
  subst₂ := λ (_ : True) => lt_subst_eqv
}

/--
Equivalent natural numbers can be substituted on the right side of _less than_.
-/
theorem lt_eqv_subst {n₁ n₂ m : ℕ} : n₁ ≃ n₂ → m < n₁ → m < n₂ := by
  intro (_ : n₁ ≃ n₂) (_ : m < n₁)
  show m < n₂
  have ⟨(_ : m ≤ n₁), (_ : m ≄ n₁)⟩ := lt_defn.mp ‹m < n₁›
  have : m ≤ n₂ := AA.substRFn ‹n₁ ≃ n₂› ‹m ≤ n₁›
  have : m ≄ n₂ := AA.neqv_substR ‹n₁ ≃ n₂› ‹m ≄ n₁›
  apply lt_defn.mpr
  exact ⟨‹m ≤ n₂›, ‹m ≄ n₂›⟩

def lt_substR_eqv
    : AA.SubstitutiveOn Hand.R (α := ℕ) (· < ·) AA.tc (· ≃ ·) (· → ·)
    := {
  subst₂ := λ (_ : True) => lt_eqv_subst
}

instance lt_substitutive_eqv
    : AA.Substitutive₂ (α := ℕ) (· < ·) AA.tc (· ≃ ·) (· → ·)
    := {
  substitutiveL := lt_substL_eqv
  substitutiveR := lt_substR_eqv
}

/-- A natural number is always less than its successor. -/
theorem lt_step {n : ℕ} : n < step n := by
  show n < step n
  apply lt_defn.mpr
  apply And.intro
  · show n ≤ step n
    apply le_defn.mpr
    exists (1 : ℕ)
    show n + 1 ≃ step n
    exact add_one_step
  · show n ≄ step n
    exact Rel.symm step_neqv

/--
A useful way to convert between _less than_ and _less than or equal to_ while
keeping the larger number fixed.
-/
theorem lt_step_le {n m : ℕ} : n < m ↔ step n ≤ m := by
  apply Iff.intro
  · intro (_ : n < m)
    show step n ≤ m
    have ⟨(_ : n ≤ m), (_ : n ≄ m)⟩ := lt_defn.mp ‹n < m›
    have ⟨d, (_ : n + d ≃ m)⟩ := le_defn.mp ‹n ≤ m›
    have : d ≄ 0 := by
      intro (_ : d ≃ 0)
      show False
      apply ‹n ≄ m›
      show n ≃ m
      calc
        n     ≃ _ := Rel.symm add_zero
        n + 0 ≃ _ := AA.substR (Rel.symm ‹d ≃ 0›)
        n + d ≃ _ := ‹n + d ≃ m›
        m     ≃ _ := Rel.refl
    have : Positive d := Signed.positive_defn.mpr ‹d ≄ 0›
    have ⟨d', (_ : step d' ≃ d)⟩ := positive_step ‹Positive d›
    show step n ≤ m
    apply le_defn.mpr
    exists d'
    show step n + d' ≃ m
    calc
      step n + d'   ≃ _ := step_add
      step (n + d') ≃ _ := Rel.symm add_step
      n + step d'   ≃ _ := AA.substR ‹step d' ≃ d›
      n + d         ≃ _ := ‹n + d ≃ m›
      m             ≃ _ := Rel.refl
  · intro (_ : step n ≤ m)
    show n < m
    have ⟨d, (_ : step n + d ≃ m)⟩ := le_defn.mp ‹step n ≤ m›
    have : n + step d ≃ m := calc
      n + step d   ≃ _ := add_step
      step (n + d) ≃ _ := Rel.symm step_add
      step n + d   ≃ _ := ‹step n + d ≃ m›
      m            ≃ _ := Rel.refl
    have : ∃ d, n + d ≃ m := ⟨step d, ‹n + step d ≃ m›⟩
    have : n ≤ m := le_defn.mpr ‹∃ d, n + d ≃ m›
    have : n ≄ m := by
      intro (_ : n ≃ m)
      show False
      have : n + step d ≃ n + 0 := calc
        n + step d ≃ _ := ‹n + step d ≃ m›
        m          ≃ _ := Rel.symm ‹n ≃ m›
        n          ≃ _ := Rel.symm add_zero
        n + 0      ≃ _ := Rel.refl
      have : step d ≃ 0 := AA.cancelL ‹n + step d ≃ n + 0›
      exact absurd ‹step d ≃ 0› step_neqv_zero
    show n < m
    apply lt_defn.mpr
    exact ⟨‹n ≤ m›, ‹n ≄ m›⟩

/--
The _less than_ relation between two natural numbers `n` and `m` is
equivalent to there being a positive natural number -- the _difference_
between `n` and `m` -- that, when added to `n`, results in `m`.

**Intuition**: This is already quite intuitive, as it's clear that for one
number to be less than another, there must be a nonzero gap between them.
-/
theorem lt_defn_add {n m : ℕ} : n < m ↔ ∃ k, Positive k ∧ m ≃ n + k := by
  apply Iff.intro
  · intro (_ : n < m)
    show ∃ k, Positive k ∧ m ≃ n + k
    have : step n ≤ m := lt_step_le.mp ‹n < m›
    have ⟨k, (_ : step n + k ≃ m)⟩ := le_defn.mp ‹step n ≤ m›
    exists step k
    apply And.intro
    · show Positive (step k)
      have : step k ≄ 0 := step_neqv_zero
      have : Positive (step k) := Signed.positive_defn.mpr ‹step k ≄ 0›
      exact this
    · show m ≃ n + step k
      calc
        m            ≃ _ := Rel.symm ‹step n + k ≃ m›
        step n + k   ≃ _ := step_add
        step (n + k) ≃ _ := Rel.symm add_step
        n + step k   ≃ _ := Rel.refl
  · intro ⟨k, (_ : Positive k), (_ : m ≃ n + k)⟩
    show n < m
    apply lt_step_le.mpr
    show step n ≤ m
    apply le_defn.mpr
    show ∃ k, step n + k ≃ m
    have ⟨k', (_ : step k' ≃ k)⟩ := positive_step ‹Positive k›
    exists k'
    show step n + k' ≃ m
    calc
      step n + k'   ≃ _ := step_add
      step (n + k') ≃ _ := Rel.symm add_step
      n + step k'   ≃ _ := AA.substR ‹step k' ≃ k›
      n + k         ≃ _ := Rel.symm ‹m ≃ n + k›
      m             ≃ _ := Rel.refl

/-- No natural number is less than zero. -/
theorem lt_zero {n : ℕ} : n ≮ 0 := by
  intro (_ : n < 0)
  show False
  have : step n ≤ 0 := lt_step_le.mp ‹n < 0›
  have ⟨d, (_ : step n + d ≃ 0)⟩ := le_defn.mp ‹step n ≤ 0›
  have : step (n + d) ≃ 0 := calc
    step (n + d) ≃ _ := Rel.symm step_add
    step n + d   ≃ _ := ‹step n + d ≃ 0›
    0            ≃ _ := Rel.refl
  exact absurd ‹step (n + d) ≃ 0› step_neqv_zero

/--
A natural number is positive iff it's greater than zero.

**Proof intuition**: The _less than_ relation can be defined in terms of a
positive difference between its two arguments. If the left argument is zero,
then the right argument must be positive.
-/
theorem lt_zero_pos {n : ℕ} : Positive n ↔ n > 0 := by
  apply Iff.intro
  · intro (_ : Positive n)
    show 0 < n
    apply lt_defn_add.mpr
    show ∃ k, Positive k ∧ n ≃ 0 + k
    exists n
    apply And.intro
    · show Positive n
      exact ‹Positive n›
    · show n ≃ 0 + n
      exact Rel.symm zero_add
  · intro (_ : 0 < n)
    show Positive n
    have ⟨k, ⟨(_ : Positive k), (_ : n ≃ 0 + k)⟩⟩ := lt_defn_add.mp ‹0 < n›
    have : k ≃ n := Rel.symm (Rel.trans ‹n ≃ 0 + k› zero_add)
    exact AA.substFn ‹k ≃ n› ‹Positive k›

/-- Weakens equivalence to _less than or equal to_. -/
theorem le_from_eqv {n m : ℕ} : n ≃ m → n ≤ m := by
  intro (_ : n ≃ m)
  show n ≤ m
  have : n ≤ n := Rel.refl
  exact AA.substRFn ‹n ≃ m› ‹n ≤ n›

/-- Weakens _less than_ to _less than or equal to_. -/
theorem le_from_lt {n m : ℕ} : n < m → n ≤ m := by
  intro (_ : n < m)
  show n ≤ m
  have ⟨(_ : n ≤ m), _⟩ := lt_defn.mp ‹n < m›
  exact ‹n ≤ m›

/--
As the name implies, if _less than or equal to_ holds between two natural
numbers, then either _less than_ holds between them as well, or the numbers are
equivalent.
-/
theorem le_split {n m : ℕ} : n ≤ m → n < m ∨ n ≃ m := by
  intro (_ : n ≤ m)
  show n < m ∨ n ≃ m
  have ⟨d, (h : n + d ≃ m)⟩ := le_defn.mp ‹n ≤ m›
  revert h
  apply cases_on (motive := λ d => n + d ≃ m → n < m ∨ n ≃ m) d
  case zero =>
    intro (_ : n + 0 ≃ m)
    apply Or.inr
    show n ≃ m
    calc
      n     ≃ _ := Rel.symm add_zero
      n + 0 ≃ _ := ‹n + 0 ≃ m›
      m     ≃ _ := Rel.refl
  case step =>
    intro d (_ : n + step d ≃ m)
    apply Or.inl
    show n < m
    apply lt_step_le.mpr
    show step n ≤ m
    apply le_defn.mpr
    exists d
    show step n + d ≃ m
    calc
      step n + d   ≃ _ := step_add
      step (n + d) ≃ _ := Rel.symm add_step
      n + step d   ≃ _ := ‹n + step d ≃ m›
      m            ≃ _ := Rel.refl

/--
Useful result when needing to decrement the larger number in a _less than_
relation.
-/
theorem lt_split {n m : ℕ} : n < step m → n < m ∨ n ≃ m := by
  intro (_ : n < step m)
  show n < m ∨ n ≃ m
  have : step n ≤ step m := lt_step_le.mp ‹n < step m›
  have : n ≤ m := AA.inject ‹step n ≤ step m›
  exact le_split ‹n ≤ m›

/-- The _less than_ relation can be extended through intermediate values. -/
theorem lt_trans {n m k : ℕ} : n < m → m < k → n < k := by
  intro (_ : n < m) (_ : m < k)
  show n < k
  apply lt_step_le.mpr
  show step n ≤ k
  calc
    step n ≤ _ := lt_step_le.mp ‹n < m›
    m      ≤ _ := le_from_lt lt_step
    step m ≤ _ := lt_step_le.mp ‹m < k›
    k      ≤ _ := Rel.refl

instance lt_transitive : Relation.Transitive (α := ℕ) (· < ·) := {
  trans := lt_trans
}

/--
The same number can be added (on the right) to both sides of a _less than_
relation, preserving the ordering of the left operands.

**Property intuition**: Increasing two numbers by the same amount keeps them
the same distance apart.

**Proof intuition**: Split _less than_ into _less than or equivalent to_ and
_not equivalent to_. Show that both of them are preserved under addition. Put
them back together.
-/
theorem lt_substL_add {n₁ n₂ m : ℕ} : n₁ < n₂ → n₁ + m < n₂ + m := by
  intro (_ : n₁ < n₂)
  show n₁ + m < n₂ + m
  have (And.intro (_ : n₁ ≤ n₂) (_ : n₁ ≄ n₂)) := lt_defn.mp ‹n₁ < n₂›
  have : n₁ + m ≤ n₂ + m := AA.substL ‹n₁ ≤ n₂›
  have : n₁ + m ≄ n₂ + m := mt AA.cancelR ‹n₁ ≄ n₂›
  have : n₁ + m < n₂ + m :=
    lt_defn.mpr (And.intro ‹n₁ + m ≤ n₂ + m› ‹n₁ + m ≄ n₂ + m›)
  exact this

/--
The same number can be added (on the left) to both sides of a _less than_
relation, preserving the ordering of the right operands.

**Property intuition**: Increasing two numbers by the same amount keeps them
the same distance apart.

**Proof intuition**: Use commutativity of addition with the opposite-hand
version of this theorem.
-/
theorem lt_substR_add {n₁ n₂ m : ℕ} : n₁ < n₂ → m + n₁ < m + n₂ := by
  intro (_ : n₁ < n₂)
  show m + n₁ < m + n₂
  have : n₁ + m < n₂ + m := lt_substL_add ‹n₁ < n₂›
  have : m + n₁ < n₂ + m := AA.substLFn AA.comm ‹n₁ + m < n₂ + m›
  have : m + n₁ < m + n₂ := AA.substRFn AA.comm ‹m + n₁ < n₂ + m›
  exact this

/--
Very general property about ordering which often simplifies proofs that would
otherwise have had to use induction.
-/
theorem trichotomy (n m : ℕ)
    : AA.ExactlyOneOfThree (n < m) (n ≃ m) (n > m) := by
  constructor
  case atLeastOne =>
    let motive := λ n => AA.OneOfThree (n < m) (n ≃ m) (n > m)
    apply ind_on (motive := motive) n
    case zero =>
      show AA.OneOfThree (0 < m) (0 ≃ m) (0 > m)
      let motive := λ m : ℕ => AA.OneOfThree (0 < m) (0 ≃ m) (0 > m)
      apply cases_on (motive := motive) m
      case zero =>
        apply AA.OneOfThree.second
        show 0 ≃ 0
        exact Rel.refl
      case step =>
        intro m
        apply AA.OneOfThree.first
        show 0 < step m
        apply lt_defn.mpr
        apply And.intro
        · show 0 ≤ step m
          apply le_defn.mpr
          exists step m
          exact zero_add
        · show 0 ≄ step m
          exact Rel.symm step_neqv_zero
    case step =>
      intro n (ih : AA.OneOfThree (n < m) (n ≃ m) (n > m))
      show AA.OneOfThree (step n < m) (step n ≃ m) (step n > m)
      match ih with
      | AA.OneOfThree.first (_ : n < m) =>
        have : step n ≤ m := lt_step_le.mp ‹n < m›
        have : step n < m ∨ step n ≃ m := le_split ‹step n ≤ m›
        match ‹step n < m ∨ step n ≃ m› with
        | Or.inl (_ : step n < m) => exact AA.OneOfThree.first ‹step n < m›
        | Or.inr (_ : step n ≃ m) => exact AA.OneOfThree.second ‹step n ≃ m›
      | AA.OneOfThree.second (_ : n ≃ m) =>
        have : m ≃ n := Rel.symm ‹n ≃ m›
        have : m ≤ n := le_from_eqv ‹m ≃ n›
        have : step m ≤ step n := AA.subst₁ ‹m ≤ n›
        have : m < step n := lt_step_le.mpr ‹step m ≤ step n›
        apply AA.OneOfThree.third
        exact ‹m < step n›
      | AA.OneOfThree.third (_ : n > m) =>
        apply AA.OneOfThree.third
        show m < step n
        exact Rel.trans ‹m < n› lt_step
  case atMostOne =>
    show ¬ AA.TwoOfThree (n < m) (n ≃ m) (n > m)
    intro
    | AA.TwoOfThree.oneAndTwo (_ : n < m) (_ : n ≃ m) =>
      show False
      have ⟨_, (_ : n ≄ m)⟩ := lt_defn.mp ‹n < m›
      exact absurd ‹n ≃ m› ‹n ≄ m›
    | AA.TwoOfThree.oneAndThree (_ : n < m) (_ : n > m) =>
      show False
      have ⟨(_ : n ≤ m), (_ : n ≄ m)⟩ := lt_defn.mp ‹n < m›
      have ⟨(_ : m ≤ n), _⟩ := lt_defn.mp ‹n > m›
      have : n ≃ m := le_antisymm ‹n ≤ m› ‹m ≤ n›
      exact absurd ‹n ≃ m› ‹n ≄ m›
    | AA.TwoOfThree.twoAndThree (_ : n ≃ m) (_ : n > m) =>
      show False
      have ⟨_, (_ : m ≄ n)⟩ := lt_defn.mp ‹n > m›
      exact absurd ‹n ≃ m› (Rel.symm ‹m ≄ n›)

/--
Defines `compare`, a comparison function on natural numbers, that determines
the ordering between any two of them: whether one is less than, equivalent to,
or greater than the other.
-/
class Compare (ℕ : Type) [Core ℕ] [Addition ℕ] [Order ℕ] extends Ord ℕ :=
  /--
  Replacing `compare`'s left operand with an equivalent natural number gives an
  identical result.
  -/
  compare_substL {n₁ n₂ m : ℕ} : n₁ ≃ n₂ → compare n₁ m = compare n₂ m

  /--
  Replacing `compare`'s right operand with an equivalent natural number gives
  an identical result.
  -/
  compare_substR {n₁ n₂ m : ℕ} : n₁ ≃ n₂ → compare m n₁ = compare m n₂

  /--
  If `compare` returns `Ordering.lt`, its first argument is less than its
  second argument.
  -/
  compare_lt {n m : ℕ} : compare n m = Ordering.lt ↔ n < m

  /-- If `compare` returns `Ordering.eq`, its arguments are equivalent. -/
  compare_eq {n m : ℕ} : compare n m = Ordering.eq ↔ n ≃ m

  /--
  If `compare` returns `Ordering.gt`, its first argument is greater than its
  second argument.
  -/
  compare_gt {n m : ℕ} : compare n m = Ordering.gt ↔ n > m

export Compare (compare_eq compare_gt compare_lt compare_substL compare_substR)

variable [Compare ℕ]

/--
Increasing `compare`'s operands by the same amount gives an identical result.

**Property intuition**: The distance between the operands doesn't change.

**Proof intuition**: There are three possible relations between `compare`'s
operands, by trichotomy. Show via substitution and transitivity that each one
is unchanged under addition.
-/
theorem compare_add {n m k : ℕ} : compare n m = compare (n + k) (m + k) := by
  have tri : AA.OneOfThree (n < m) (n ≃ m) (n > m) :=
    (trichotomy n m).atLeastOne
  match tri with
  | AA.OneOfThree.first (_ : n < m) =>
    have : compare n m = Ordering.lt := compare_lt.mpr ‹n < m›
    have : n + k < m + k := lt_substL_add ‹n < m›
    have : compare (n + k) (m + k) = Ordering.lt := compare_lt.mpr this
    calc
      compare n m
        = _ := ‹compare n m = Ordering.lt›
      Ordering.lt
        = _ := by rw [‹compare (n + k) (m + k) = Ordering.lt›]
      compare (n + k) (m + k)
        = _ := rfl
  | AA.OneOfThree.second (_ : n ≃ m) =>
    have : compare n m = Ordering.eq := compare_eq.mpr ‹n ≃ m›
    have : n + k ≃ m + k := AA.substL ‹n ≃ m›
    have : compare (n + k) (m + k) = Ordering.eq :=
      compare_eq.mpr ‹n + k ≃ m + k›
    calc
      compare n m
        = _ := ‹compare n m = Ordering.eq›
      Ordering.eq
        = _ := Eq.symm ‹compare (n + k) (m + k) = Ordering.eq›
      compare (n + k) (m + k)
        = _ := rfl
  | AA.OneOfThree.third (_ : n > m) =>
    have : compare n m = Ordering.gt := compare_gt.mpr ‹n > m›
    have : n + k > m + k := lt_substL_add ‹n > m›
    have : compare (n + k) (m + k) = Ordering.gt :=
      compare_gt.mpr ‹n + k > m + k›
    calc
      compare n m
        = _ := ‹compare n m = Ordering.gt›
      Ordering.gt
        = _ := Eq.symm ‹compare (n + k) (m + k) = Ordering.gt›
      compare (n + k) (m + k)
        = _ := rfl

/--
If two pairs of natural numbers have the same ordering, their component-wise
sum will as well.

**Property intuition**: Adding the components of the pairs will just increase
(or in the case of equality, maintain) the degree of difference. For example,
if the pairs compare as `Ordering.lt`, their first elements are both less than
their second elements. The first element of the sum will be less than the
second element by the combined difference of the input pairs.

**Proof intuition**: For each `Ordering` value, convert the statements about
`compare` into the equivalent statements about ordering relations. Use
addition substitution properties of those relations to obtain the result.
-/
theorem add_preserves_compare
    {ord : Ordering} {n m k j : ℕ}
    : compare n m = ord → compare k j = ord → compare (n + k) (m + j) = ord
    := by
  match ord with
  | Ordering.lt =>
    intro (_ : compare n m = Ordering.lt) (_ : compare k j = Ordering.lt)
    show compare (n + k) (m + j) = Ordering.lt
    have : n < m := compare_lt.mp ‹compare n m = Ordering.lt›
    have : k < j := compare_lt.mp ‹compare k j = Ordering.lt›
    have : n + k < m + j := calc
      n + k < m + k := lt_substL_add ‹n < m›
      m + k < m + j := lt_substR_add ‹k < j›
    have : compare (n + k) (m + j) = Ordering.lt := compare_lt.mpr this
    exact this
  | Ordering.eq =>
    intro (_ : compare n m = Ordering.eq) (_ : compare k j = Ordering.eq)
    show compare (n + k) (m + j) = Ordering.eq
    have : n ≃ m := compare_eq.mp ‹compare n m = Ordering.eq›
    have : k ≃ j := compare_eq.mp ‹compare k j = Ordering.eq›
    have : n + k ≃ m + j := calc
      n + k ≃ m + k := AA.substL ‹n ≃ m›
      m + k ≃ m + j := AA.substR ‹k ≃ j›
    have : compare (n + k) (m + j) = Ordering.eq := compare_eq.mpr this
    exact this
  | Ordering.gt =>
    intro (_ : compare n m = Ordering.gt) (_ : compare k j = Ordering.gt)
    show compare (n + k) (m + j) = Ordering.gt
    have : n > m := compare_gt.mp ‹compare n m = Ordering.gt›
    have : k > j := compare_gt.mp ‹compare k j = Ordering.gt›
    have : m + j < n + k := calc
      m + j < m + k := lt_substR_add ‹j < k›
      m + k < n + k := lt_substL_add ‹m < n›
    have : compare (n + k) (m + j) = Ordering.gt := compare_gt.mpr this
    exact this

end Lean4Axiomatic.Natural


import data.nat.order.basic data.set.image

/-! # IMO 2010 A6 -/

namespace IMOSL
namespace IMO2010A6

open_locale classical

def good (f g : ℕ → ℕ) := ∀ n : ℕ, f (g n) = (f n).succ

private lemma lem1 {f g : ℕ → ℕ} (h : good f g) : ∃ a : ℕ, ∀ k : ℕ, k ∈ set.range f ↔ a ≤ k :=
begin
  have h0 : ∃ n, n ∈ set.range f := ⟨f 0, set.mem_range_self 0⟩,
  use nat.find h0; refine λ k, ⟨nat.find_min' h0, _⟩,
  apply nat.le_induction; clear k,
  exact nat.find_spec h0,
  rintros n - ⟨k, h1⟩,
  use g k; rw [h, h1]
end

private lemma lem2 {f g : ℕ → ℕ} (h : good f g) {x y : ℕ} (h0 : g x = g y) : f x = f y :=
  by rw [← nat.succ_inj', ← h, ← h, h0]

private lemma lem3 {f g : ℕ → ℕ} (h : good f g) (h0 : good g f) {x y : ℕ} :
  f x = f y ↔ g x = g y := ⟨lem2 h0, lem2 h⟩

private lemma lem4 {f g : ℕ → ℕ} (h : good g f) {a : ℕ}
  (ha : ∀ k : ℕ, k ∈ set.range f ↔ a ≤ k) : a.succ ≤ f a :=
begin
  have h1 : a ≤ f a := by rw ← ha; use a,
  rw [le_iff_eq_or_lt, or_comm] at h1,
  cases h1 with h1 h1,
  rwa nat.succ_le_iff,
  replace h := h a,
  rw [← h1, nat.succ_eq_add_one] at h,
  exfalso; exact nat.succ_ne_self (g a) h.symm
end

private lemma lem5 {f g : ℕ → ℕ} (h : good f g) (h0 : good g f) {a b : ℕ} (h1 : a ≤ b)
  (ha : ∀ k : ℕ, k ∈ set.range f ↔ a ≤ k) (hb : ∀ k : ℕ, k ∈ set.range g ↔ b ≤ k) : a = b :=
begin
  obtain ⟨x, h2⟩ : ∃ x : ℕ, f a = f x + 1 :=
  begin
    have h2 := lem4 h0 ha,
    rw [nat.succ_eq_add_one, le_iff_exists_add] at h2,
    cases h2 with c h2,
    obtain ⟨x, h3⟩ : a + c ∈ set.range f := (ha (a + c)).mpr le_self_add,
    use x; rw [h2, h3, add_right_comm]
  end,
  obtain ⟨c, h3⟩ := (ha a).mpr (le_refl a),
  obtain ⟨d, h4⟩ := (ha (g x)).mpr (le_trans h1 (by rw ← hb; use x)),
  rw [← nat.succ_eq_add_one, ← h, ← h3, ← h4, lem3 h h0, h0, h0, nat.succ_inj', lem3 h0 h] at h2,
  refine le_antisymm h1 _,
  rw [← h3, h2, h4, ← hb]; use x
end

private lemma lem6 {f g : ℕ → ℕ} (h : good f g) (h0 : good g f) {a b : ℕ}
  (ha : ∀ k : ℕ, k ∈ set.range f ↔ a ≤ k) (hb : ∀ k : ℕ, k ∈ set.range g ↔ b ≤ k) : a = b :=
begin
  cases le_total a b with h1 h1,
  exact lem5 h h0 h1 ha hb,
  rw lem5 h0 h h1 hb ha
end

private lemma lem7 {f g : ℕ → ℕ} (h : good f g) (h0 : good g f) {a : ℕ}
  (ha : ∀ k : ℕ, k ∈ set.range f ↔ a ≤ k) (ha' : ∀ k : ℕ, k ∈ set.range g ↔ a ≤ k) : f a = a.succ :=
begin
  have h1 := lem4 h0 ha,
  rw [le_iff_eq_or_lt, ← nat.succ_le_iff] at h1,
  cases h1 with h1 h1,
  rw h1,
  obtain ⟨x, h2⟩ : ∃ x : ℕ, f a = f x + 1 + 1 :=
  begin
    rw [nat.succ_eq_add_one, nat.succ_eq_add_one, add_assoc, le_iff_exists_add] at h1,
    cases h1 with c h1,
    obtain ⟨x, h2⟩ : a + c ∈ set.range f := (ha (a + c)).mpr le_self_add,
    use x; rw [h1, h2, add_right_comm]
  end,
  rw [← nat.succ_eq_add_one, ← nat.succ_eq_add_one, ← h, ← h] at h2,
  obtain ⟨c, h3⟩ := (ha a).mpr (le_refl a),
  obtain ⟨d, h4⟩ := (ha (g (g x))).mpr (by rw ← ha'; use (g x)),
  rw [← h3, ← h4, lem3 h h0, h0, h0, nat.succ_inj', lem3 h0 h] at h2,
  obtain ⟨e, h5⟩ := (ha (g x)).mpr (by rw ← ha'; use x),
  rw [h3, h4, ← h5, h0, eq_comm] at h2,
  replace h2 := le_of_le_of_eq (nat.succ_le_succ_iff.mpr (by rw ← ha'; use e)) h2,
  rw [nat.succ_eq_add_one, add_le_iff_nonpos_right, ← not_lt] at h2,
  exfalso; exact h2 one_pos
end

/-- Final solution -/
theorem final_solution {f g : ℕ → ℕ} (h : good f g) (h0 : good g f) : f = g :=
begin
  cases lem1 h with a h1,
  cases lem1 h0 with b h2,
  have h3 := lem6 h h0 h1 h2; subst h3,
  suffices : ∀ n : ℕ, a ≤ n → (f n = n.succ ∧ g n = n.succ),
    ext n; rw [← nat.succ_inj', ← h, (this (g n) (by rw ← h2; use n)).left],
  intros n; apply nat.le_induction; clear n,
  exact ⟨lem7 h h0 h1 h2, lem7 h0 h h2 h1⟩,
  rintros n h3 ⟨h4, h5⟩; split,
  rw [← nat.succ_eq_add_one, ← h5, h, h4, h5],
  rw [← nat.succ_eq_add_one, ← h4, h0, h5, h4]
end

end IMO2010A6
end IMOSL


/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn

! This file was ported from Lean 3 source module order.ideal
! leanprover-community/mathlib commit 59694bd07f0a39c5beccba34bd9f413a160782bf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Encodable.Basic
import Mathlib.Order.Atoms
import Mathlib.Order.UpperLower.Basic

/-!
# Order ideals, cofinal sets, and the Rasiowa–Sikorski lemma

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections require more
structure, such as a bottom element, a top element, or a join-semilattice structure.
- `Order.Ideal P`: the type of nonempty, upward directed, and downward closed subsets of `P`.
  Dual to the notion of a filter on a preorder.
- `Order.IsIdeal I`: a predicate for when a `Set P` is an ideal.
- `Order.Ideal.principal p`: the principal ideal generated by `p : P`.
- `Order.Ideal.IsProper I`: a predicate for proper ideals.
  Dual to the notion of a proper filter.
- `Order.Ideal.IsMaximal I`: a predicate for maximal ideals.
  Dual to the notion of an ultrafilter.
- `Order.Cofinal P`: the type of subsets of `P` containing arbitrarily large elements.
  Dual to the notion of 'dense set' used in forcing.
- `Order.idealOfCofinals p 𝒟`, where `p : P`, and `𝒟` is a countable family of cofinal
  subsets of `P`: an ideal in `P` which contains `p` and intersects every set in `𝒟`. (This a form
  of the Rasiowa–Sikorski lemma.)

## References

- <https://en.wikipedia.org/wiki/Ideal_(order_theory)>
- <https://en.wikipedia.org/wiki/Cofinal_(mathematics)>
- <https://en.wikipedia.org/wiki/Rasiowa%E2%80%93Sikorski_lemma>

Note that for the Rasiowa–Sikorski lemma, Wikipedia uses the opposite ordering on `P`,
in line with most presentations of forcing.

## Tags

ideal, cofinal, dense, countable, generic

-/

open Function Set

namespace Order

variable {P : Type _}

/-- An ideal on an order `P` is a subset of `P` that is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
structure Ideal (P) [LE P] extends LowerSet P where
  /-- The ideal is nonempty. -/
  nonempty' : carrier.Nonempty
  /-- The ideal is upward directed. -/
  directed' : DirectedOn (· ≤ ·) carrier
#align order.ideal Order.Ideal

-- Porting note: todo: remove this configuration and use the default configuration.
-- We keep this to be consistent with Lean 3.
initialize_simps_projections Ideal (+toLowerSet, -carrier)

/-- A subset of a preorder `P` is an ideal if it is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
@[mk_iff]
structure IsIdeal {P} [LE P] (I : Set P) : Prop where
  /-- The ideal is downward closed. -/
  IsLowerSet : IsLowerSet I
  /-- The ideal is nonempty. -/
  Nonempty : I.Nonempty
  /-- The ideal is upward directed. -/
  Directed : DirectedOn (· ≤ ·) I
#align order.is_ideal Order.IsIdeal

/-- Create an element of type `Order.Ideal` from a set satisfying the predicate
`Order.IsIdeal`. -/
def IsIdeal.toIdeal [LE P] {I : Set P} (h : IsIdeal I) : Ideal P :=
  ⟨⟨I, h.IsLowerSet⟩, h.Nonempty, h.Directed⟩
#align order.is_ideal.to_ideal Order.IsIdeal.toIdeal

namespace Ideal

section LE

variable [LE P]

section

variable {I J s t : Ideal P} {x y : P}

theorem toLowerSet_injective : Injective (toLowerSet : Ideal P → LowerSet P) := fun s t _ ↦ by
  cases s
  cases t
  congr
#align order.ideal.to_lower_set_injective Order.Ideal.toLowerSet_injective

instance : SetLike (Ideal P) P where
  coe s := s.carrier
  coe_injective' _ _ h := toLowerSet_injective <| SetLike.coe_injective h

@[ext]
theorem ext {s t : Ideal P} : (s : Set P) = t → s = t :=
  SetLike.ext'
#align order.ideal.ext Order.Ideal.ext

@[simp]
theorem carrier_eq_coe (s : Ideal P) : s.carrier = s :=
  rfl
#align order.ideal.carrier_eq_coe Order.Ideal.carrier_eq_coe

@[simp]
theorem coe_toLowerSet (s : Ideal P) : (s.toLowerSet : Set P) = s :=
  rfl
#align order.ideal.coe_to_lower_set Order.Ideal.coe_toLowerSet

protected theorem lower (s : Ideal P) : IsLowerSet (s : Set P) :=
  s.lower'
#align order.ideal.lower Order.Ideal.lower

protected theorem nonempty (s : Ideal P) : (s : Set P).Nonempty :=
  s.nonempty'
#align order.ideal.nonempty Order.Ideal.nonempty

protected theorem directed (s : Ideal P) : DirectedOn (· ≤ ·) (s : Set P) :=
  s.directed'
#align order.ideal.directed Order.Ideal.directed

protected theorem isIdeal (s : Ideal P) : IsIdeal (s : Set P) :=
  ⟨s.lower, s.nonempty, s.directed⟩
#align order.ideal.is_ideal Order.Ideal.isIdeal

theorem mem_compl_of_ge {x y : P} : x ≤ y → x ∈ (I : Set P)ᶜ → y ∈ (I : Set P)ᶜ := fun h ↦
  mt <| I.lower h
#align order.ideal.mem_compl_of_ge Order.Ideal.mem_compl_of_ge

/-- The partial ordering by subset inclusion, inherited from `Set P`. -/
instance : PartialOrder (Ideal P) :=
  PartialOrder.lift SetLike.coe SetLike.coe_injective

-- @[simp] -- Porting note: simp can prove this
theorem coe_subset_coe : (s : Set P) ⊆ t ↔ s ≤ t :=
  Iff.rfl
#align order.ideal.coe_subset_coe Order.Ideal.coe_subset_coe

-- @[simp] -- Porting note: simp can prove this
theorem coe_ssubset_coe : (s : Set P) ⊂ t ↔ s < t :=
  Iff.rfl
#align order.ideal.coe_ssubset_coe Order.Ideal.coe_ssubset_coe

@[trans]
theorem mem_of_mem_of_le {x : P} {I J : Ideal P} : x ∈ I → I ≤ J → x ∈ J :=
  @Set.mem_of_mem_of_subset P x I J
#align order.ideal.mem_of_mem_of_le Order.Ideal.mem_of_mem_of_le

/-- A proper ideal is one that is not the whole set.
    Note that the whole set might not be an ideal. -/
@[mk_iff]
class IsProper (I : Ideal P) : Prop where
  /-- This ideal is not the whole set. -/
  ne_univ : (I : Set P) ≠ univ
#align order.ideal.is_proper Order.Ideal.IsProper

theorem isProper_of_not_mem {I : Ideal P} {p : P} (nmem : p ∉ I) : IsProper I :=
  ⟨fun hp ↦ by
    have := mem_univ p
    rw [← hp] at this
    exact nmem this⟩
#align order.ideal.is_proper_of_not_mem Order.Ideal.isProper_of_not_mem

/-- An ideal is maximal if it is maximal in the collection of proper ideals.

Note that `IsCoatom` is less general because ideals only have a top element when `P` is directed
and nonempty. -/
@[mk_iff]
class IsMaximal (I : Ideal P) extends IsProper I : Prop where
  /-- This ideal is maximal in the collection of proper ideals. -/
  maximal_proper : ∀ ⦃J : Ideal P⦄, I < J → (J : Set P) = univ
#align order.ideal.is_maximal Order.Ideal.IsMaximal

theorem inter_nonempty [IsDirected P (· ≥ ·)] (I J : Ideal P) : (I ∩ J : Set P).Nonempty := by
  obtain ⟨a, ha⟩ := I.nonempty
  obtain ⟨b, hb⟩ := J.nonempty
  obtain ⟨c, hac, hbc⟩ := exists_le_le a b
  exact ⟨c, I.lower hac ha, J.lower hbc hb⟩
#align order.ideal.inter_nonempty Order.Ideal.inter_nonempty

end

section Directed

variable [IsDirected P (· ≤ ·)] [Nonempty P] {I : Ideal P}

/-- In a directed and nonempty order, the top ideal of a is `univ`. -/
instance : OrderTop (Ideal P) where
  top := ⟨⊤, univ_nonempty, directedOn_univ⟩
  le_top _ _ _ := LowerSet.mem_top

@[simp]
theorem top_toLowerSet : (⊤ : Ideal P).toLowerSet = ⊤ :=
  rfl
#align order.ideal.top_to_lower_set Order.Ideal.top_toLowerSet

@[simp]
theorem coe_top : ((⊤ : Ideal P) : Set P) = univ :=
  rfl
#align order.ideal.coe_top Order.Ideal.coe_top

theorem isProper_of_ne_top (ne_top : I ≠ ⊤) : IsProper I :=
  ⟨fun h ↦ ne_top <| ext h⟩
#align order.ideal.is_proper_of_ne_top Order.Ideal.isProper_of_ne_top

theorem IsProper.ne_top (_ : IsProper I) : I ≠ ⊤ :=
  fun h ↦ IsProper.ne_univ <| congr_arg SetLike.coe h
#align order.ideal.is_proper.ne_top Order.Ideal.IsProper.ne_top

theorem IsCoatom.isProper (hI : IsCoatom I) : IsProper I :=
  isProper_of_ne_top hI.1
#align is_coatom.is_proper Order.Ideal.IsCoatom.isProper

theorem isProper_iff_ne_top : IsProper I ↔ I ≠ ⊤ :=
  ⟨fun h ↦ h.ne_top, fun h ↦ isProper_of_ne_top h⟩
#align order.ideal.is_proper_iff_ne_top Order.Ideal.isProper_iff_ne_top

theorem IsMaximal.isCoatom (_ : IsMaximal I) : IsCoatom I :=
  ⟨IsMaximal.toIsProper.ne_top, fun _ h ↦ ext <| IsMaximal.maximal_proper h⟩
#align order.ideal.is_maximal.is_coatom Order.Ideal.IsMaximal.isCoatom

theorem IsMaximal.isCoatom' [IsMaximal I] : IsCoatom I :=
  IsMaximal.isCoatom ‹_›
#align order.ideal.is_maximal.is_coatom' Order.Ideal.IsMaximal.isCoatom'

theorem IsCoatom.isMaximal (hI : IsCoatom I) : IsMaximal I :=
  { IsCoatom.isProper hI with maximal_proper := fun _ hJ ↦ by simp [hI.2 _ hJ] }
#align is_coatom.is_maximal Order.Ideal.IsCoatom.isMaximal

theorem isMaximal_iff_isCoatom : IsMaximal I ↔ IsCoatom I :=
  ⟨fun h ↦ h.isCoatom, fun h ↦ IsCoatom.isMaximal h⟩
#align order.ideal.is_maximal_iff_is_coatom Order.Ideal.isMaximal_iff_isCoatom

end Directed

section OrderBot

variable [OrderBot P]

@[simp]
theorem bot_mem (s : Ideal P) : ⊥ ∈ s :=
  s.lower bot_le s.nonempty'.some_mem
#align order.ideal.bot_mem Order.Ideal.bot_mem

end OrderBot

section OrderTop

variable [OrderTop P] {I : Ideal P}

theorem top_of_top_mem (h : ⊤ ∈ I) : I = ⊤ := by
  ext
  exact iff_of_true (I.lower le_top h) trivial
#align order.ideal.top_of_top_mem Order.Ideal.top_of_top_mem

theorem IsProper.top_not_mem (hI : IsProper I) : ⊤ ∉ I := fun h ↦ hI.ne_top <| top_of_top_mem h
#align order.ideal.is_proper.top_not_mem Order.Ideal.IsProper.top_not_mem

end OrderTop

end LE

section Preorder

variable [Preorder P]

section

variable {I J : Ideal P} {x y : P}

/-- The smallest ideal containing a given element. -/
@[simps]
def principal (p : P) : Ideal P where
  toLowerSet := LowerSet.Iic p
  nonempty' := nonempty_Iic
  directed' _ hx _ hy := ⟨p, le_rfl, hx, hy⟩
#align order.ideal.principal Order.Ideal.principal

instance [Inhabited P] : Inhabited (Ideal P) :=
  ⟨Ideal.principal default⟩

@[simp]
theorem principal_le_iff : principal x ≤ I ↔ x ∈ I :=
  ⟨fun h ↦ h le_rfl, fun hx _ hy ↦ I.lower hy hx⟩
#align order.ideal.principal_le_iff Order.Ideal.principal_le_iff

@[simp]
theorem mem_principal : x ∈ principal y ↔ x ≤ y :=
  Iff.rfl
#align order.ideal.mem_principal Order.Ideal.mem_principal

end

section OrderBot

variable [OrderBot P]

/-- There is a bottom ideal when `P` has a bottom element. -/
instance : OrderBot (Ideal P) where
  bot := principal ⊥
  bot_le := by simp

@[simp]
theorem principal_bot : principal (⊥ : P) = ⊥ :=
  rfl
#align order.ideal.principal_bot Order.Ideal.principal_bot

end OrderBot

section OrderTop

variable [OrderTop P]

@[simp]
theorem principal_top : principal (⊤ : P) = ⊤ :=
  toLowerSet_injective <| LowerSet.Iic_top
#align order.ideal.principal_top Order.Ideal.principal_top

end OrderTop

end Preorder

section SemilatticeSup

variable [SemilatticeSup P] {x y : P} {I s : Ideal P}

/-- A specific witness of `I.directed` when `P` has joins. -/
theorem sup_mem (hx : x ∈ s) (hy : y ∈ s) : x ⊔ y ∈ s :=
  let ⟨_, hz, hx, hy⟩ := s.directed x hx y hy
  s.lower (sup_le hx hy) hz
#align order.ideal.sup_mem Order.Ideal.sup_mem

@[simp]
theorem sup_mem_iff : x ⊔ y ∈ I ↔ x ∈ I ∧ y ∈ I :=
  ⟨fun h ↦ ⟨I.lower le_sup_left h, I.lower le_sup_right h⟩, fun h ↦ sup_mem h.1 h.2⟩
#align order.ideal.sup_mem_iff Order.Ideal.sup_mem_iff

end SemilatticeSup

section SemilatticeSupDirected

variable [SemilatticeSup P] [IsDirected P (· ≥ ·)] {x : P} {I J K s t : Ideal P}

/-- The infimum of two ideals of a co-directed order is their intersection. -/
instance : Inf (Ideal P) :=
  ⟨fun I J ↦
    { toLowerSet := I.toLowerSet ⊓ J.toLowerSet
      nonempty' := inter_nonempty I J
      directed' := fun x hx y hy ↦ ⟨x ⊔ y, ⟨sup_mem hx.1 hy.1, sup_mem hx.2 hy.2⟩, by simp⟩ }⟩

/-- The supremum of two ideals of a co-directed order is the union of the down sets of the pointwise
supremum of `I` and `J`. -/
instance : Sup (Ideal P) :=
  ⟨fun I J ↦
    { carrier := { x | ∃ i ∈ I, ∃ j ∈ J, x ≤ i ⊔ j }
      nonempty' := by
        cases' inter_nonempty I J with w h
        exact ⟨w, w, h.1, w, h.2, le_sup_left⟩
      directed' := fun x ⟨xi, _, xj, _, _⟩ y ⟨yi, _, yj, _, _⟩ ↦
        ⟨x ⊔ y,  ⟨xi ⊔ yi, sup_mem ‹_› ‹_›, xj ⊔ yj, sup_mem ‹_› ‹_›,
            sup_le
              (calc
                x ≤ xi ⊔ xj := ‹_›
                _ ≤ xi ⊔ yi ⊔ (xj ⊔ yj) := sup_le_sup le_sup_left le_sup_left)
              (calc
                y ≤ yi ⊔ yj := ‹_›
                _ ≤ xi ⊔ yi ⊔ (xj ⊔ yj) := sup_le_sup le_sup_right le_sup_right)⟩,
          le_sup_left, le_sup_right⟩
      lower' := fun x y h ⟨yi, hi, yj, hj, hxy⟩ ↦ ⟨yi, hi, yj, hj, h.trans hxy⟩ }⟩

instance : Lattice (Ideal P) :=
  { Ideal.instPartialOrderIdeal with
    sup := (· ⊔ ·)
    le_sup_left := fun _ J i hi ↦
      let ⟨w, hw⟩ := J.nonempty
      ⟨i, hi, w, hw, le_sup_left⟩
    le_sup_right := fun I _ j hj ↦
      let ⟨w, hw⟩ := I.nonempty
      ⟨w, hw, j, hj, le_sup_right⟩
    sup_le := fun _ _ K hIK hJK _ ⟨_, hi, _, hj, ha⟩ ↦
      K.lower ha <| sup_mem (mem_of_mem_of_le hi hIK) (mem_of_mem_of_le hj hJK)
    inf := (· ⊓ ·)
    inf_le_left := fun I J ↦ inter_subset_left I.carrier J.carrier
    inf_le_right := fun I J ↦ inter_subset_right I.carrier J.carrier
    le_inf := fun _ _ _ ↦ subset_inter }

@[simp]
theorem coe_sup : ↑(s ⊔ t) = { x | ∃ a ∈ s, ∃ b ∈ t, x ≤ a ⊔ b } :=
  rfl
#align order.ideal.coe_sup Order.Ideal.coe_sup

-- Porting note: Modified `s ∩ t` to `↑s ∩ ↑t`.
@[simp]
theorem coe_inf : (↑(s ⊓ t) : Set P) = ↑s ∩ ↑t :=
  rfl
#align order.ideal.coe_inf Order.Ideal.coe_inf

@[simp]
theorem mem_inf : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J :=
  Iff.rfl
#align order.ideal.mem_inf Order.Ideal.mem_inf

@[simp]
theorem mem_sup : x ∈ I ⊔ J ↔ ∃ i ∈ I, ∃ j ∈ J, x ≤ i ⊔ j :=
  Iff.rfl
#align order.ideal.mem_sup Order.Ideal.mem_sup

theorem lt_sup_principal_of_not_mem (hx : x ∉ I) : I < I ⊔ principal x :=
  le_sup_left.lt_of_ne fun h ↦ hx <| by simpa only [left_eq_sup, principal_le_iff] using h
#align order.ideal.lt_sup_principal_of_not_mem Order.Ideal.lt_sup_principal_of_not_mem

end SemilatticeSupDirected

section SemilatticeSupOrderBot

variable [SemilatticeSup P] [OrderBot P] {x : P} {I J K : Ideal P}

instance : InfSet (Ideal P) :=
  ⟨fun S ↦
    { toLowerSet := ⨅ s ∈ S, toLowerSet s
      nonempty' :=
        ⟨⊥, by
          rw [LowerSet.carrier_eq_coe, LowerSet.coe_infᵢ₂, Set.mem_interᵢ₂]
          exact fun s _ ↦ s.bot_mem⟩
      directed' := fun a ha b hb ↦
        ⟨a ⊔ b,
          ⟨by
            rw [LowerSet.carrier_eq_coe, LowerSet.coe_infᵢ₂, Set.mem_interᵢ₂] at ha hb⊢
            exact fun s hs ↦ sup_mem (ha _ hs) (hb _ hs), le_sup_left, le_sup_right⟩⟩ }⟩

variable {S : Set (Ideal P)}

@[simp]
theorem coe_infₛ : (↑(infₛ S) : Set P) = ⋂ s ∈ S, ↑s :=
  LowerSet.coe_infᵢ₂ _
#align order.ideal.coe_Inf Order.Ideal.coe_infₛ

@[simp]
theorem mem_infₛ : x ∈ infₛ S ↔ ∀ s ∈ S, x ∈ s := by
  simp_rw [← SetLike.mem_coe, coe_infₛ, mem_interᵢ₂]
#align order.ideal.mem_Inf Order.Ideal.mem_infₛ

instance : CompleteLattice (Ideal P) :=
  { (inferInstance : Lattice (Ideal P)),
    completeLatticeOfInf (Ideal P) fun S ↦ by
      refine' ⟨fun s hs ↦ _, fun s hs ↦ by rwa [← coe_subset_coe, coe_infₛ, subset_interᵢ₂_iff]⟩
      rw [← coe_subset_coe, coe_infₛ]
      exact binterᵢ_subset_of_mem hs with }

end SemilatticeSupOrderBot

section DistribLattice

variable [DistribLattice P]

variable {I J : Ideal P}

theorem eq_sup_of_le_sup {x i j : P} (hi : i ∈ I) (hj : j ∈ J) (hx : x ≤ i ⊔ j) :
    ∃ i' ∈ I, ∃ j' ∈ J, x = i' ⊔ j' := by
  refine' ⟨x ⊓ i, I.lower inf_le_right hi, x ⊓ j, J.lower inf_le_right hj, _⟩
  calc
    x = x ⊓ (i ⊔ j) := left_eq_inf.mpr hx
    _ = x ⊓ i ⊔ x ⊓ j := inf_sup_left

#align order.ideal.eq_sup_of_le_sup Order.Ideal.eq_sup_of_le_sup

theorem coe_sup_eq : ↑(I ⊔ J) = { x | ∃ i ∈ I, ∃ j ∈ J, x = i ⊔ j } :=
  Set.ext fun _ ↦
    ⟨fun ⟨_, _, _, _, _⟩ ↦ eq_sup_of_le_sup ‹_› ‹_› ‹_›, fun ⟨i, _, j, _, _⟩ ↦
      ⟨i, ‹_›, j, ‹_›, le_of_eq ‹_›⟩⟩
#align order.ideal.coe_sup_eq Order.Ideal.coe_sup_eq

end DistribLattice

section BooleanAlgebra

variable [BooleanAlgebra P] {x : P} {I : Ideal P}

theorem IsProper.not_mem_of_compl_mem (hI : IsProper I) (hxc : xᶜ ∈ I) : x ∉ I := by
  intro hx
  apply hI.top_not_mem
  have ht : x ⊔ xᶜ ∈ I := sup_mem ‹_› ‹_›
  rwa [sup_compl_eq_top] at ht
#align order.ideal.is_proper.not_mem_of_compl_mem Order.Ideal.IsProper.not_mem_of_compl_mem

theorem IsProper.not_mem_or_compl_not_mem (hI : IsProper I) : x ∉ I ∨ xᶜ ∉ I := by
  have h : xᶜ ∈ I → x ∉ I := hI.not_mem_of_compl_mem
  tauto
#align order.ideal.is_proper.not_mem_or_compl_not_mem Order.Ideal.IsProper.not_mem_or_compl_not_mem

end BooleanAlgebra

end Ideal

/-- For a preorder `P`, `Cofinal P` is the type of subsets of `P`
  containing arbitrarily large elements. They are the dense sets in
  the topology whose open sets are terminal segments. -/
structure Cofinal (P) [Preorder P] where
  /-- The carrier of a `Cofinal` is the underlying set. -/
  carrier : Set P
  /-- The `Cofinal` contains arbitrarily large elements. -/
  mem_gt : ∀ x : P, ∃ y ∈ carrier, x ≤ y
#align order.cofinal Order.Cofinal

namespace Cofinal

variable [Preorder P]

instance : Inhabited (Cofinal P) :=
  ⟨{  carrier := univ
      mem_gt := fun x ↦ ⟨x, trivial, le_rfl⟩ }⟩

instance : Membership P (Cofinal P) :=
  ⟨fun x D ↦ x ∈ D.carrier⟩

variable (D : Cofinal P) (x : P)

/-- A (noncomputable) element of a cofinal set lying above a given element. -/
noncomputable def above : P :=
  Classical.choose <| D.mem_gt x
#align order.cofinal.above Order.Cofinal.above

theorem above_mem : D.above x ∈ D :=
  (Classical.choose_spec <| D.mem_gt x).1
#align order.cofinal.above_mem Order.Cofinal.above_mem

theorem le_above : x ≤ D.above x :=
  (Classical.choose_spec <| D.mem_gt x).2
#align order.cofinal.le_above Order.Cofinal.le_above

end Cofinal

section IdealOfCofinals

variable [Preorder P] (p : P) {ι : Type _} [Encodable ι] (𝒟 : ι → Cofinal P)

/-- Given a starting point, and a countable family of cofinal sets,
  this is an increasing sequence that intersects each cofinal set. -/
noncomputable def sequenceOfCofinals : ℕ → P
  | 0 => p
  | n + 1 =>
    match Encodable.decode n with
    | none => sequenceOfCofinals n
    | some i => (𝒟 i).above (sequenceOfCofinals n)
#align order.sequence_of_cofinals Order.sequenceOfCofinals

theorem sequenceOfCofinals.monotone : Monotone (sequenceOfCofinals p 𝒟) := by
  apply monotone_nat_of_le_succ
  intro n
  dsimp only [sequenceOfCofinals, Nat.add]
  cases (Encodable.decode n : Option ι)
  · rfl
  · apply Cofinal.le_above
#align order.sequence_of_cofinals.monotone Order.sequenceOfCofinals.monotone

theorem sequenceOfCofinals.encode_mem (i : ι) :
    sequenceOfCofinals p 𝒟 (Encodable.encode i + 1) ∈ 𝒟 i := by
  dsimp only [sequenceOfCofinals, Nat.add]
  rw [Encodable.encodek]
  apply Cofinal.above_mem
#align order.sequence_of_cofinals.encode_mem Order.sequenceOfCofinals.encode_mem

/-- Given an element `p : P` and a family `𝒟` of cofinal subsets of a preorder `P`,
  indexed by a countable type, `idealOfCofinals p 𝒟` is an ideal in `P` which
  - contains `p`, according to `mem_idealOfCofinals p 𝒟`, and
  - intersects every set in `𝒟`, according to `cofinal_meets_idealOfCofinals p 𝒟`.

  This proves the Rasiowa–Sikorski lemma. -/
def idealOfCofinals : Ideal P where
  carrier := { x : P | ∃ n, x ≤ sequenceOfCofinals p 𝒟 n }
  lower' := fun _ _ hxy ⟨n, hn⟩ ↦ ⟨n, le_trans hxy hn⟩
  nonempty' := ⟨p, 0, le_rfl⟩
  directed' := fun _ ⟨n, hn⟩ _ ⟨m, hm⟩ ↦
    ⟨_, ⟨max n m, le_rfl⟩, le_trans hn <| sequenceOfCofinals.monotone p 𝒟 (le_max_left _ _),
      le_trans hm <| sequenceOfCofinals.monotone p 𝒟 (le_max_right _ _)⟩
#align order.ideal_of_cofinals Order.idealOfCofinals

theorem mem_idealOfCofinals : p ∈ idealOfCofinals p 𝒟 :=
  ⟨0, le_rfl⟩
#align order.mem_ideal_of_cofinals Order.mem_idealOfCofinals

/-- `idealOfCofinals p 𝒟` is `𝒟`-generic. -/
theorem cofinal_meets_idealOfCofinals (i : ι) : ∃ x : P, x ∈ 𝒟 i ∧ x ∈ idealOfCofinals p 𝒟 :=
  ⟨_, sequenceOfCofinals.encode_mem p 𝒟 i, _, le_rfl⟩
#align order.cofinal_meets_ideal_of_cofinals Order.cofinal_meets_idealOfCofinals

end IdealOfCofinals

end Order


import tactic
import data.real.basic

universe u

example (T : Type u) [add_comm_group T] (a b c: T) : a + b = c → b + a = c :=
begin
  intro h,
  rw add_comm,
  assumption
end

-- Next time:
-- definition of a graph (simple = no loops, no multiple edges)
-- definition of the adjacency matrix of a graph
-- definition of the degree of a vertex
-- examples: empty graphs, complete graphs (eg. K_3, K_n), bipartite graphs
-- theorem: sum of degrees of all the vertices is even.

-- Useful tips about Lean
-- tidy?
-- library_search
-- calc mode
-- squeeze_simp
-- Try codewars puzzles if you've time

lemma pow_x_3_monotone (f : ℝ → ℝ) (hf : f = λ x, x^3) : monotone f :=
begin
  unfold monotone,
  intros a b h,
  rw hf,
  simp only,
  sorry,
end

example (a b c: ℕ) : (b + c) * a = b * a + c * a:=
begin
  exact add_mul b c a,
end

example (a b : ℕ) : (a + b)^2 = a^2 + 2 * a * b + b^2 :=
begin
  calc (a + b)^2 = (a + b) * (a + b) : sq _
  ... = a * (a + b) + b * (a + b) : add_mul _ _ _
  ... = a * a + a * b + b * a + b * b : by sorry
  ... = a^2 + 2 * a * b + b^2 : sorry,
end


variables x y z w : ℕ

example (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w :=
begin
  apply eq.trans,
  assumption,
  apply eq.trans,
  assumption,
  assumption
end