/- Copyright 2023 Daniel J. Velleman -/

import HTPILib.Chap8Part1
namespace HTPI

/- Definitions and theorems in Chap8Part1 and HTPIDefs

theorem zero_elts_iff_empty {A : Type} (X : Set A) :
    numElts X 0 ↔ empty X

theorem one_elt_iff_singleton {A : Type} (X : Set A) :
    numElts X 1 ↔ ∃ (x : A), X = {x}

theorem nonempty_of_pos_numElts {A : Type} {X : Set A} {n : Nat}
    (h1 : numElts X n) (h2 : n > 0) : ∃ (x : A), x ∈ X

theorem remove_one_numElts {A : Type} {X : Set A} {n : Nat} {x : A}
    (h1 : numElts X (n + 1)) (h2 : x ∈ X) : numElts (X \ {x}) n

def sum_seq {A : Type} [AddZeroClass A] (m k : Nat) (f : Nat → A) : A :=
  match m with
    | 0 => 0
    | n + 1 => sum_seq n k f + f (k + n)

theorem sum_base {A : Type} [AddZeroClass A] {k : Nat} {f : Nat → A} :
    Sum i from k to k, f i = f k

theorem sum_step {A : Type} [AddZeroClass A] {k n : Nat} {f : Nat → A}
    (h : k ≤ n) : Sum i from k to (n + 1), f i = (Sum i from k to n, f i) + f (n + 1)

theorem sum_from_zero_step {A : Type} [AddZeroClass A] {n : Nat} {f : Nat → A} :
    Sum i from 0 to (n + 1), f i = (Sum i from 0 to n, f i) + f (n + 1)
-/

/- Definitions -/
def nat_even (n : Nat) : Prop := ∃ (k : Nat), n = 2 * k

def nat_odd (n : Nat) : Prop := ∃ (k : Nat), n = 2 * k + 1

def extendPO {A : Type} (R : BinRel A) (b : A) (x y : A) : Prop :=
  R x y ∨ (R x b ∧ ¬R y b)

def fact (k : Nat) : Nat :=
  match k with
    | 0 => 1
    | n + 1 => (n + 1) * fact n

def Fib (n : Nat) : Nat :=
  match n with
    | 0 => 0
    | 1 => 1
    | k + 2 => Fib k + Fib (k + 1)

def rep_image {A : Type} (f : A → A) (n : Nat) (B : Set A) : Set A :=
  match n with
    | 0 => B
    | k + 1 => image f (rep_image f k B)

def cumul_image {A : Type} (f : A → A) (B : Set A) : Set A :=
  {x : A | ∃ (n : Nat), x ∈ rep_image f n B}

/- Section 6.1 -/
theorem Like_Example_6_1_2 :
    ∀ (n : Nat), 3 ∣ n ^ 3 + 2 * n := by
  by_induc
  · -- Base Case
    define         --Goal : ∃ (c : Nat), 0 ^ 3 + 2 * 0 = 3 * c
    apply Exists.intro 0
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : 3 ∣ n ^ 3 + 2 * n
    define at ih   --ih : ∃ (c : Nat), n ^ 3 + 2 * n = 3 * c
    obtain (k : Nat) (h1 : n ^ 3 + 2 * n = 3 * k) from ih
    define         --Goal : ∃ (c : Nat), (n + 1) ^ 3 + 2 * (n + 1) = 3 * c
    apply Exists.intro (k + n ^ 2 + n + 1)
    show (n + 1) ^ 3 + 2 * (n + 1) = 3 * (k + n ^ 2 + n + 1) from
      calc (n + 1) ^ 3 + 2 * (n + 1)
        _ = n ^ 3 + 2 * n + 3 * n ^ 2 + 3 * n + 3 := by ring
        _ = 3 * k + 3 * n ^ 2 + 3 * n + 3 := by rw [h1]
        _ = 3 * (k + n ^ 2 + n + 1) := by ring
    done
  done

theorem Like_Example_6_1_1 :
    ∀ (n : Nat), (Sum i from 0 to n, 2 ^ i) + 1 = 2 ^ (n + 1) := by
  by_induc
  · -- Base Case
    rewrite [sum_base]
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : (Sum i from 0 to n, 2 ^ i) + 1 = 2 ^ (n + 1)
    show (Sum i from 0 to n + 1, 2 ^ i) + 1 = 2 ^ (n + 1 + 1) from
      calc (Sum i from 0 to n + 1, 2 ^ i) + 1
        _ = (Sum i from 0 to n, 2 ^ i) + 2 ^ (n + 1) + 1 := by
              rw [sum_from_zero_step]
        _ = (Sum i from 0 to n, 2 ^ i) + 1 + 2 ^ (n + 1) := by ring
        _ = 2 ^ (n + 1) + 2 ^ (n + 1) := by rw [ih]
        _ = 2 ^ (n + 1 + 1) := by ring
    done
  done

theorem Example_6_1_3 : ∀ n ≥ 5, 2 ^ n > n ^ 2 := by
  by_induc
  · -- Base Case
    decide
    done
  · -- Induction Step
    fix n : Nat
    assume h1 : n ≥ 5
    assume ih : 2 ^ n > n ^ 2
    have h2 : n * n ≥ 5 * n := Nat.mul_le_mul_right n h1
    show 2 ^ (n + 1) > (n + 1) ^ 2 from
      calc 2 ^ (n + 1)
        _ = 2 * 2 ^ n := by ring
        _ > 2 * n ^ 2 := by linarith
        _ ≥ n ^ 2 + 5 * n := by linarith
        _ > n ^ 2 + 2 * n + 1 := by linarith
        _ = (n + 1) ^ 2 := by ring
    done
  done

#eval 2 - 3       --Answer: 0

theorem Example_6_1_1 :
    ∀ (n : Nat), Sum i from 0 to n, (2 : Int) ^ i =
    (2 : Int) ^ (n + 1) - (1 : Int) := by
  by_induc
  · -- Base Case
    rewrite [sum_base]
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : Sum i from 0 to n, (2 : Int) ^ i =
        (2 : Int) ^ (n + 1) - (1 : Int)
    show Sum i from 0 to n + 1, (2 : Int) ^ i =
        (2 : Int) ^ (n + 1 + 1) - (1 : Int) from
      calc Sum i from 0 to n + 1, (2 : Int) ^ i
        _ = (Sum i from 0 to n, (2 : Int) ^ i)
            + (2 : Int) ^ (n + 1) := by rw [sum_from_zero_step]
        _ = (2 : Int) ^ (n + 1) - (1 : Int)
            + (2 : Int) ^ (n + 1) := by rw [ih]
        _ = (2 : Int) ^ (n + 1 + 1) - (1 : Int) := by ring
    done
  done

/- Section 6.2 -/
lemma Lemma_6_2_1_1 {A : Type} {R : BinRel A} {B : Set A} {b c : A}
    (h1 : partial_order R) (h2 : b ∈ B) (h3 : minimalElt R c (B \ {b}))
    (h4 : R b c) : minimalElt R b B := by
  define at h3
    --h3 : c ∈ B \ {b} ∧ ¬∃ x ∈ B \ {b}, R x c ∧ x ≠ c
  define  --Goal : b ∈ B ∧ ¬∃ x ∈ B, R x b ∧ x ≠ b
  apply And.intro h2    --Goal : ¬∃ x ∈ B, R x b ∧ x ≠ b
  contradict h3.right with h5
  obtain (x : A) (h6 : x ∈ B ∧ R x b ∧ x ≠ b) from h5
  apply Exists.intro x  --Goal : x ∈ B \ {b} ∧ R x c ∧ x ≠ c
  apply And.intro
  · -- Proof that x ∈ B \ {b}
    show x ∈ B \ {b} from And.intro h6.left h6.right.right
    done
  · -- Proof that R x c ∧ x ≠ c
    have Rtrans : transitive R := h1.right.left
    have h7 : R x c := Rtrans x b c h6.right.left h4
    apply And.intro h7
    by_contra h8
    rewrite [h8] at h6  --h6 : c ∈ B ∧ R c b ∧ c ≠ b
    have Rantisymm : antisymmetric R := h1.right.right
    have h9 : c = b := Rantisymm c b h6.right.left h4
    show False from h6.right.right h9
    done
  done

lemma Lemma_6_2_1_2 {A : Type} {R : BinRel A} {B : Set A} {b c : A}
    (h1 : partial_order R) (h2 : b ∈ B) (h3 : minimalElt R c (B \ {b}))
    (h4 : ¬R b c) : minimalElt R c B := sorry

theorem Example_6_2_1 {A : Type} (R : BinRel A) (h : partial_order R) :
    ∀ n ≥ 1, ∀ (B : Set A), numElts B n →
      ∃ (x : A), minimalElt R x B := by
  by_induc
  · -- Base Case
    fix B : Set A
    assume h2 : numElts B 1
    rewrite [one_elt_iff_singleton] at h2
    obtain (b : A) (h3 : B = {b}) from h2
    apply Exists.intro b
    define         --Goal : b ∈ B ∧ ¬∃ x ∈ B, R x b ∧ x ≠ b
    apply And.intro
    · -- Proof that b ∈ B
      rewrite [h3]    --Goal : b ∈ {b}
      define          --Goal : b = b
      rfl
      done
    · -- Proof that nothing in B is smaller than b
      by_contra h4
      obtain (x : A) (h5 : x ∈ B ∧ R x b ∧ x ≠ b) from h4
      have h6 : x ∈ B := h5.left
      rewrite [h3] at h6   --h6 : x ∈ {b}
      define at h6         --h6 : x = b
      show False from h5.right.right h6
      done
    done
  · -- Induction Step
    fix n : Nat
    assume h2 : n ≥ 1
    assume ih : ∀ (B : Set A), numElts B n → ∃ (x : A), minimalElt R x B
    fix B : Set A
    assume h3 : numElts B (n + 1)
    have h4 : n + 1 > 0 := by linarith
    obtain (b : A) (h5 : b ∈ B) from nonempty_of_pos_numElts h3 h4
    set B' : Set A := B \ {b}
    have h6 : numElts B' n := remove_one_numElts h3 h5
    obtain (c : A) (h7 : minimalElt R c B') from ih B' h6
    by_cases h8 : R b c
    · -- Case 1. h8 : R b c
      have h9 : minimalElt R b B := Lemma_6_2_1_1 h h5 h7 h8
      show ∃ (x : A), minimalElt R x B from Exists.intro b h9
      done
    · -- Case 2. h8 : ¬R b c
      have h9 : minimalElt R c B := Lemma_6_2_1_2 h h5 h7 h8
      show ∃ (x : A), minimalElt R x B from Exists.intro c h9
      done
    done
  done

lemma extendPO_is_ref {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : reflexive (extendPO R b) := sorry

lemma extendPO_is_trans {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : transitive (extendPO R b) := sorry

lemma extendPO_is_antisymm {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : antisymmetric (extendPO R b) := sorry

lemma extendPO_is_po {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : partial_order (extendPO R b) :=
  And.intro (extendPO_is_ref R b h)
    (And.intro (extendPO_is_trans R b h) (extendPO_is_antisymm R b h))

lemma extendPO_extends {A : Type} (R : BinRel A) (b : A) (x y : A) :
    R x y → extendPO R b x y := by
  assume h1 : R x y
  define
  show R x y ∨ R x b ∧ ¬R y b from Or.inl h1
  done

lemma extendPO_all_comp {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) :
    ∀ (x : A), extendPO R b b x ∨ extendPO R b x b := by
  have Rref : reflexive R := h.left
  fix x : A
  or_left with h1
  define at h1     --h1 : ¬(R x b ∨ R x b ∧ ¬R b b)
  demorgan at h1   --h1 : ¬R x b ∧ ¬(R x b ∧ ¬R b b)
  define           --Goal : R b x ∨ R b b ∧ ¬R x b
  apply Or.inr
  show R b b ∧ ¬R x b from And.intro (Rref b) h1.left
  done

theorem Exercise_6_2_2 {A : Type} (R : BinRel A) (h : partial_order R) :
    ∀ (n : Nat) (B : Set A), numElts B n → ∃ (T : BinRel A),
    partial_order T ∧ (∀ (x y : A), R x y → T x y) ∧
    ∀ x ∈ B, ∀ (y : A), T x y ∨ T y x := by
  by_induc
  · -- Base Case
    fix B : Set A
    assume h2 : numElts B 0
    rewrite [zero_elts_iff_empty] at h2
    define at h2       --h2 : ¬∃ (x : A), x ∈ B
    apply Exists.intro R
    apply And.intro h
    apply And.intro
    · -- Proof that R extends R
      fix x : A; fix y : A
      assume h3 : R x y
      show R x y from h3
      done
    · -- Proof that everything in B comparable to everything under R
      fix x : A
      assume h3 : x ∈ B
      contradict h2
      show ∃ (x : A), x ∈ B from Exists.intro x h3
      done
    done
  · -- Induction Step
    fix n : Nat
    assume ih : ∀ (B : Set A), numElts B n → ∃ (T : BinRel A),
      partial_order T ∧ (∀ (x y : A), R x y → T x y) ∧
      ∀ (x : A), x ∈ B → ∀ (y : A), T x y ∨ T y x
    fix B : Set A
    assume h2 : numElts B (n + 1)
    have h3 : n + 1 > 0 := by linarith
    obtain (b : A) (h4 : b ∈ B) from nonempty_of_pos_numElts h2 h3
    set B' : Set A := B \ {b}
    have h5 : numElts B' n := remove_one_numElts h2 h4
    have h6 : ∃ (T : BinRel A), partial_order T ∧
      (∀ (x y : A), R x y → T x y) ∧
      ∀ (x : A), x ∈ B' → ∀ (y : A), T x y ∨ T y x := ih B' h5
    obtain (T' : BinRel A)
      (h7 : partial_order T' ∧ (∀ (x y : A), R x y → T' x y) ∧
      ∀ (x : A), x ∈ B' → ∀ (y : A), T' x y ∨ T' y x) from h6
    have T'po : partial_order T' := h7.left
    have T'extR : ∀ (x y : A), R x y → T' x y := h7.right.left
    have T'compB' : ∀ (x : A), x ∈ B' →
      ∀ (y : A), T' x y ∨ T' y x := h7.right.right
    set T : BinRel A := extendPO T' b
    apply Exists.intro T
    apply And.intro (extendPO_is_po T' b T'po)
    apply And.intro
    · -- Proof that T extends R
      fix x : A; fix y : A
      assume h8 : R x y
      have h9 : T' x y := T'extR x y h8
      show T x y from (extendPO_extends T' b x y h9)
      done
    · -- Proof that everything in B comparable to everything under T
      fix x : A
      assume h8 : x ∈ B
      by_cases h9 : x = b
      · -- Case 1. h9 : x = b
        rewrite [h9]
        show ∀ (y : A), T b y ∨ T y b from extendPO_all_comp T' b T'po
        done
      · -- Case 2. h9 : x ≠ b
        have h10 : x ∈ B' := And.intro h8 h9
        fix y : A
        have h11 : T' x y ∨ T' y x := T'compB' x h10 y
        by_cases on h11
        · -- Case 2.1. h11 : T' x y
          show T x y ∨ T y x from
            Or.inl (extendPO_extends T' b x y h11)
          done
        · -- Case 2.2. h11 : T' y x
          show T x y ∨ T y x from
            Or.inr (extendPO_extends T' b y x h11)
          done
        done
      done
    done
  done

/- Section 6.3 -/
#eval fact 4       --Answer: 24

theorem Example_6_3_1 : ∀ n ≥ 4, fact n > 2 ^ n

:= by
  by_induc
  · -- Base Case
    decide
    done
  · -- Induction Step
    fix n : Nat
    assume h1 : n ≥ 4
    assume ih : fact n > 2 ^ n
    have h2 : n + 1 > 2 := by linarith
    show fact (n + 1) > 2 ^ (n + 1) from
      calc fact (n + 1)
        _ = (n + 1) * fact n := by rfl
        _ > (n + 1) * 2 ^ n := by rel [ih]
        _ > 2 * 2 ^ n := by rel [h2]
        _ = 2 ^ (n + 1) := by ring
    done
  done


/- Copyright 2023 Daniel J. Velleman -/

import HTPILib.Chap6
namespace HTPI

/- Definitions -/
lemma mod_succ_lt (a n : Nat) : a % (n + 1) < n + 1 := by
  have h : n + 1 > 0 := Nat.succ_pos n
  show a % (n + 1) < n + 1 from Nat.mod_lt a h
  done

def gcd (a b : Nat) : Nat :=
  match b with
    | 0 => a
    | n + 1 =>
      have : a % (n + 1) < n + 1 := mod_succ_lt a n
      gcd (n + 1) (a % (n + 1))
  termination_by b

mutual
  def gcd_c1 (a b : Nat) : Int :=
    match b with
      | 0 => 1
      | n + 1 =>
        have : a % (n + 1) < n + 1 := mod_succ_lt a n
        gcd_c2 (n + 1) (a % (n + 1))
          --Corresponds to s = t'
    termination_by b

  def gcd_c2 (a b : Nat) : Int :=
    match b with
      | 0 => 0
      | n + 1 =>
        have : a % (n + 1) < n + 1 := mod_succ_lt a n
        gcd_c1 (n + 1) (a % (n + 1)) -
          (gcd_c2 (n + 1) (a % (n + 1))) * ↑(a / (n + 1))
          --Corresponds to t = s' - t'q
    termination_by b
end

def prime (n : Nat) : Prop :=
  2 ≤ n ∧ ¬∃ (a b : Nat), a * b = n ∧ a < n ∧ b < n

def prime_factor (p n : Nat) : Prop := prime p ∧ p ∣ n

def all_prime (l : List Nat) : Prop := ∀ p ∈ l, prime p

def nondec (l : List Nat) : Prop :=
  match l with
    | [] => True   --Of course, True is a proposition that is always true
    | n :: L => (∀ m ∈ L, n ≤ m) ∧ nondec L

def nondec_prime_list (l : List Nat) : Prop := all_prime l ∧ nondec l

def prod (l : List Nat) : Nat :=
  match l with
    | [] => 1
    | n :: L => n * (prod L)

def prime_factorization (n : Nat) (l : List Nat) : Prop :=
  nondec_prime_list l ∧ prod l = n

def rel_prime (a b : Nat) : Prop := gcd a b = 1

def congr_mod (m : Nat) (a b : Int) : Prop := (↑m : Int) ∣ (a - b)

def cc (m : Nat) (a : Int) : ZMod m := (↑a : ZMod m)

notation:50 a " ≡ " b " (MOD " m ")" => congr_mod m a b

notation:max "["a"]_"m:max => cc m a

def invertible {m : Nat} (X : ZMod m) : Prop :=
  ∃ (Y : ZMod m), X * Y = [1]_m

def num_rp_below (m k : Nat) : Nat :=
  match k with
    | 0 => 0
    | j + 1 => if gcd m j = 1 then (num_rp_below m j) + 1
                else num_rp_below m j

def phi (m : Nat) : Nat := num_rp_below m m

def prod_seq {m : Nat}
    (j k : Nat) (f : Nat → ZMod m) : ZMod m :=
  match j with
    | 0 => [1]_m
    | n + 1 => prod_seq n k f * f (k + n)

def maps_below (n : Nat) (g : Nat → Nat) : Prop := ∀ i < n, g i < n

def one_one_below (n : Nat) (g : Nat → Nat) : Prop :=
  ∀ i1 < n, ∀ i2 < n, g i1 = g i2 → i1 = i2

def onto_below (n : Nat) (g : Nat → Nat) : Prop :=
  ∀ k < n, ∃ i < n, g i = k

def perm_below (n : Nat) (g : Nat → Nat) : Prop :=
  maps_below n g ∧ one_one_below n g ∧ onto_below n g

def inv_mod (m a : Nat) : Nat := Int.toNat ((gcd_c2 m a) % m)

def swap (u v i : Nat) : Nat :=
  if i = u then v else if i = v then u else i

namespace Euler  --For definitions specific to Euler's theorem

def F (m i : Nat) : ZMod m := if gcd m i = 1 then [i]_m else [1]_m

def G (m a i : Nat) : Nat := (a * i) % m

def Ginv (m a i : Nat) : Nat := G m (inv_mod m a) i

end Euler

/- Section 7.1 -/

theorem dvd_mod_of_dvd_a_b {a b d : Nat}
    (h1 : d ∣ a) (h2 : d ∣ b) : d ∣ (a % b)

:= by
  set q : Nat := a / b
  have h3 : b * q + a % b = a := Nat.div_add_mod a b
  obtain (j : Nat) (h4 : a = d * j) from h1
  obtain (k : Nat) (h5 : b = d * k) from h2
  define    --Goal : ∃ (c : Nat), a % b = d * c
  apply Exists.intro (j - k * q)
  show a % b = d * (j - k * q) from
    calc a % b
      _ = b * q + a % b - b * q := (Nat.add_sub_cancel_left _ _).symm
      _ = a - b * q := by rw [h3]
      _ = d * j - d * (k * q) := by rw [h4, h5, mul_assoc]
      _ = d * (j - k * q) := (Nat.mul_sub_left_distrib _ _ _).symm
  done


/- Copyright 2023 Daniel J. Velleman -/

import HTPILib.Chap4
namespace HTPI

/- Definitions -/
def graph {A B : Type} (f : A → B) : Set (A × B) :=
    {(a, b) : A × B | f a = b}

def is_func_graph {A B : Type} (G : Set (A × B)) : Prop :=
    ∀ (x : A), ∃! (y : B), (x, y) ∈ G

def onto {A B : Type} (f : A → B) : Prop :=
  ∀ (y : B), ∃ (x : A), f x = y

def one_to_one {A B : Type} (f : A → B) : Prop :=
  ∀ (x1 x2 : A), f x1 = f x2 → x1 = x2

def closed {A : Type} (f : A → A) (C : Set A) : Prop := ∀ x ∈ C, f x ∈ C

def closure {A : Type} (f : A → A) (B C : Set A) : Prop :=
  smallestElt (sub A) C {D : Set A | B ⊆ D ∧ closed f D}

def closed2 {A : Type} (f : A → A → A) (C : Set A) : Prop :=
  ∀ x ∈ C, ∀ y ∈ C, f x y ∈ C

def closure2 {A : Type} (f : A → A → A) (B C : Set A) : Prop :=
  smallestElt (sub A) C {D : Set A | B ⊆ D ∧ closed2 f D}

def closed_family {A : Type} (F : Set (A → A)) (C : Set A) : Prop :=
  ∀ f ∈ F, closed f C

def closure_family {A : Type} (F : Set (A → A)) (B C : Set A) : Prop :=
  smallestElt (sub A) C {D : Set A | B ⊆ D ∧ closed_family F D}

def image {A B : Type} (f : A → B) (X : Set A) : Set B :=
  {f x | x ∈ X}

def inverse_image {A B : Type} (f : A → B) (Y : Set B) : Set A :=
  {a : A | f a ∈ Y}

/- Section 5.1 -/
theorem graph_def {A B : Type} (f : A → B) (a : A) (b : B) :
    (a, b) ∈ graph f ↔ f a = b := by rfl

theorem func_from_graph_ltr {A B : Type} (F : Set (A × B)) :
    (∃ (f : A → B), graph f = F) → is_func_graph F := sorry

--This proof is explained in Section 8.2
theorem func_from_graph_rtl {A B : Type} (F : Set (A × B)) :
    is_func_graph F → (∃ (f : A → B), graph f = F) := by
  assume h1 : is_func_graph F
  define at h1    --h1 : ∀ (x : A), ∃! (y : B), (x, y) ∈ F
  have h2 : ∀ (x : A), ∃ (y : B), (x, y) ∈ F := by
    fix x : A
    obtain (y : B) (h3 : (x, y) ∈ F)
      (h4 : ∀ (y1 y2 : B), (x, y1) ∈ F → (x, y2) ∈ F → y1 = y2) from h1 x
    show ∃ (y : B), (x, y) ∈ F from Exists.intro y h3
    done
  set f : A → B := fun (x : A) => Classical.choose (h2 x)
  apply Exists.intro f
  apply Set.ext
  fix (x, y) : A × B
  have h3 : (x, f x) ∈ F := Classical.choose_spec (h2 x)
  apply Iff.intro
  · -- (→)
    assume h4 : (x, y) ∈ graph f
    define at h4        --h4 : f x = y
    rewrite [h4] at h3
    show (x, y) ∈ F from h3
    done
  · -- (←)
    assume h4 : (x, y) ∈ F
    define              --Goal : f x = y
    obtain (z : B) (h5 : (x, z) ∈ F)
      (h6 : ∀ (y1 y2 : B), (x, y1) ∈ F → (x, y2) ∈ F → y1 = y2) from h1 x
    show f x = y from h6 (f x) y h3 h4
    done
  done

theorem func_from_graph {A B : Type} (F : Set (A × B)) :
    (∃ (f : A → B), graph f = F) ↔ is_func_graph F :=
  Iff.intro (func_from_graph_ltr F) (func_from_graph_rtl F)

theorem Theorem_5_1_4 {A B : Type} (f g : A → B) :
    (∀ (a : A), f a = g a) → f = g := funext

example {A B : Type} (f g : A → B) :
    graph f = graph g → f = g := by
  assume h1 : graph f = graph g  --Goal : f = g
  apply funext                   --Goal : ∀ (x : A), f x = g x
  fix x : A
  have h2 : (x, f x) ∈ graph f := by
    define                       --Goal : f x = f x
    rfl
    done
  rewrite [h1] at h2             --h2 : (x, f x) ∈ graph g
  define at h2                   --h2 : g x = f x
  show f x = g x from h2.symm
  done

def square1 (n : Nat) : Nat := n ^ 2

def square2 : Nat → Nat := fun (n : Nat) => n ^ 2

example : square1 = square2 := by rfl

#eval square1 7     --Answer: 49

theorem Theorem_5_1_5 {A B C : Type} (f : A → B) (g : B → C) :
    ∃ (h : A → C), graph h = comp (graph g) (graph f) := by
  set h : A → C := fun (x : A) => g (f x)
  apply Exists.intro h
  apply Set.ext
  fix (a, c) : A × C
  apply Iff.intro
  · -- Proof that (a, c) ∈ graph h → (a, c) ∈ comp (graph g) (graph f)
    assume h1 : (a, c) ∈ graph h
    define at h1  --h1 : h a = c
    define        --Goal : ∃ (x : B), (a, x) ∈ graph f ∧ (x, c) ∈ graph g
    apply Exists.intro (f a)
    apply And.intro
    · -- Proof that (a, f a) ∈ graph f
      define
      rfl
      done
    · -- Proof that (f a, c) ∈ graph g
      define
      show g (f a) = c from h1
      done
    done
  · -- Proof that (a, c) ∈ comp (graph g) (graph f) → (a, c) ∈ graph h
    assume h1 : (a, c) ∈ comp (graph g) (graph f)
    define        --Goal : h a = c
    define at h1  --h1 : ∃ (x : B), (a, x) ∈ graph f ∧ (x, c) ∈ graph g
    obtain (b : B) (h2 : (a, b) ∈ graph f ∧ (b, c) ∈ graph g) from h1
    have h3 : (a, b) ∈ graph f := h2.left
    have h4 : (b, c) ∈ graph g := h2.right
    define at h3          --h3 : f a = b
    define at h4          --h4 : g b = c
    rewrite [←h3] at h4   --h4 : g (f a) = c
    show h a = c from h4
    done
  done

example {A B C D : Type} (f : A → B) (g : B → C) (h : C → D) :
    h ∘ (g ∘ f) = (h ∘ g) ∘ f := by rfl

example {A B : Type} (f : A → B) : f ∘ id = f := by rfl

example {A B : Type} (f : A → B) : id ∘ f = f := by rfl

/- Section 5.2 -/
theorem Theorem_5_2_5_1 {A B C : Type} (f : A → B) (g : B → C) :
    one_to_one f → one_to_one g → one_to_one (g ∘ f) := by
  assume h1 : one_to_one f
  assume h2 : one_to_one g
  define at h1  --h1 : ∀ (x1 x2 : A), f x1 = f x2 → x1 = x2
  define at h2  --h2 : ∀ (x1 x2 : B), g x1 = g x2 → x1 = x2
  define        --Goal : ∀ (x1 x2 : A), (g ∘ f) x1 = (g ∘ f) x2 → x1 = x2
  fix a1 : A
  fix a2 : A    --Goal : (g ∘ f) a1 = (g ∘ f) a2 → a1 = a2
  define : (g ∘ f) a1; define : (g ∘ f) a2
                --Goal : g (f a1) = g (f a2) → a1 = a2
  assume h3 : g (f a1) = g (f a2)
  have h4 : f a1 = f a2 := h2 (f a1) (f a2) h3
  show a1 = a2 from h1 a1 a2 h4
  done

lemma comp_def {A B C : Type} (g : B → C) (f : A → B) (x : A) :
    (g ∘ f) x = g (f x) := by rfl

theorem Theorem_5_2_5_2 {A B C : Type} (f : A → B) (g : B → C) :
    onto f → onto g → onto (g ∘ f) := by
  assume h1 : onto f
  assume h2 : onto g
  define at h1           --h1 : ∀ (y : B), ∃ (x : A), f x = y
  define at h2           --h2 : ∀ (y : C), ∃ (x : B), g x = y
  define                 --Goal : ∀ (y : C), ∃ (x : A), (g ∘ f) x = y
  fix c : C
  obtain (b : B) (h3 : g b = c) from h2 c
  obtain (a : A) (h4 : f a = b) from h1 b
  apply Exists.intro a   --Goal : (g ∘ f) a = c
  rewrite [comp_def]     --Goal : g (f a) = c
  rewrite [←h4] at h3
  show g (f a) = c from h3
  done

/- Section 5.3 -/
theorem Theorem_5_3_1 {A B : Type}
    (f : A → B) (h1 : one_to_one f) (h2 : onto f) :
    ∃ (g : B → A), graph g = inv (graph f) := by
  rewrite [func_from_graph]   --Goal : is_func_graph (inv (graph f))
  define        --Goal : ∀ (x : B), ∃! (y : A), (x, y) ∈ inv (graph f)
  fix b : B
  exists_unique
  · -- Existence
    define at h2          --h2 : ∀ (y : B), ∃ (x : A), f x = y
    obtain (a : A) (h4 : f a = b) from h2 b
    apply Exists.intro a  --Goal : (b, a) ∈ inv (graph f)
    define                --Goal : f a = b
    show f a = b from h4
    done
  · -- Uniqueness
    fix a1 : A; fix a2 : A
    assume h3 : (b, a1) ∈ inv (graph f)
    assume h4 : (b, a2) ∈ inv (graph f) --Goal : a1 = a2
    define at h3          --h3 : f a1 = b
    define at h4          --h4 : f a2 = b
    rewrite [←h4] at h3   --h3 : f a1 = f a2
    define at h1          --h1 : ∀ (x1 x2 : A), f x1 = f x2 → x1 = x2
    show a1 = a2 from h1 a1 a2 h3
    done
  done

theorem Theorem_5_3_2_1 {A B : Type} (f : A → B) (g : B → A)
    (h1 : graph g = inv (graph f)) : g ∘ f = id := by
  apply funext           --Goal : ∀ (x : A), (g ∘ f) x = id x
  fix a : A              --Goal : (g ∘ f) a = id a
  have h2 : (f a, a) ∈ graph g := by
    rewrite [h1]         --Goal : (f a, a) ∈ inv (graph f)
    define               --Goal : f a = f a
    rfl
    done
  define at h2           --h2 : g (f a) = a
  show (g ∘ f) a = id a from h2
  done

theorem Theorem_5_3_2_2 {A B : Type} (f : A → B) (g : B → A)
    (h1 : graph g = inv (graph f)) : f ∘ g = id := sorry

theorem Theorem_5_3_3_1 {A B : Type} (f : A → B) (g : B → A)
    (h1 : g ∘ f = id) : one_to_one f := by
  define              --Goal : ∀ (x1 x2 : A), f x1 = f x2 → x1 = x2
  fix a1 : A; fix a2 : A
  assume h2 : f a1 = f a2
  show a1 = a2 from
    calc a1
      _ = id a1 := by rfl
      _ = (g ∘ f) a1 := by rw [h1]
      _ = g (f a1) := by rfl
      _ = g (f a2) := by rw [h2]
      _ = (g ∘ f) a2 := by rfl
      _ = id a2 := by rw [h1]
      _ = a2 := by rfl
  done

theorem Theorem_5_3_3_2 {A B : Type} (f : A → B) (g : B → A)
    (h1 : f ∘ g = id) : onto f := sorry

theorem Theorem_5_3_5 {A B : Type} (f : A → B) (g : B → A)
    (h1 : g ∘ f = id) (h2 : f ∘ g = id) : graph g = inv (graph f) := by
  have h3 : one_to_one f := Theorem_5_3_3_1 f g h1
  have h4 : onto f := Theorem_5_3_3_2 f g h2
  obtain (g' : B → A) (h5 : graph g' = inv (graph f))
    from Theorem_5_3_1 f h3 h4
  have h6 : g' ∘ f = id := Theorem_5_3_2_1 f g' h5
  have h7 : g = g' :=
    calc g
      _ = id ∘ g := by rfl
      _ = (g' ∘ f) ∘ g := by rw [h6]
      _ = g' ∘ (f ∘ g) := by rfl
      _ = g' ∘ id := by rw [h2]
      _ = g' := by rfl
  rewrite [←h7] at h5
  show graph g = inv (graph f) from h5
  done

/- Section 5.4 -/
theorem Theorem_5_4_5 {A : Type} (f : A → A) (B : Set A) :
    ∃ (C : Set A), closure f B C := by
  set F : Set (Set A) := {D : Set A | B ⊆ D ∧ closed f D}
  set C : Set A := ⋂₀ F
  apply Exists.intro C    --Goal : closure f B C
  define                  --Goal : C ∈ F ∧ ∀ x ∈ F, C ⊆ x
  apply And.intro
  · -- Proof that C ∈ F
    define                  --Goal : B ⊆ C ∧ closed f C
    apply And.intro
    · -- Proof that B ⊆ C
      fix a : A
      assume h1 : a ∈ B       --Goal : a ∈ C
      define                  --Goal : ∀ t ∈ F, a ∈ t
      fix D : Set A
      assume h2 : D ∈ F
      define at h2            --h2 : B ⊆ D ∧ closed f D
      show a ∈ D from h2.left h1
      done
    · -- Proof that C is closed under f
      define                  --Goal : ∀ x ∈ C, f x ∈ C
      fix a : A
      assume h1 : a ∈ C       --Goal : f a ∈ C
      define                  --Goal : ∀ t ∈ F, f a ∈ t
      fix D : Set A
      assume h2 : D ∈ F       --Goal : f a ∈ D
      define at h1            --h1 : ∀ t ∈ F, a ∈ t
      have h3 : a ∈ D := h1 D h2
      define at h2            --h2 : B ⊆ D ∧ closed f D
      have h4 : closed f D := h2.right
      define at h4            --h4 : ∀ x ∈ D, f x ∈ D
      show f a ∈ D from h4 a h3
      done
    done
  · -- Proof that C is smallest
    fix D : Set A
    assume h1 : D ∈ F      --Goal : sub A C D
    define
    fix a : A
    assume h2 : a ∈ C       --Goal : a ∈ D
    define at h2            --h2 : ∀ t ∈ F, a ∈ t
    show a ∈ D from h2 D h1
    done
  done

def plus (m n : Int) : Int := m + n

def plus' : Int → Int → Int := fun (m n : Int) => m + n

def plus'' : Int → Int → Int := fun (m : Int) => (fun (n : Int) => m + n)

example : plus = plus'' := by rfl

example : plus' = plus'' := by rfl

#eval plus 3 2     --Answer: 5

theorem Theorem_5_4_9 {A : Type} (f : A → A → A) (B : Set A) :
    ∃ (C : Set A), closure2 f B C := sorry

/- Section 5.5 -/
theorem image_def {A B : Type} (f : A → B) (X : Set A) (b : B) :
    b ∈ image f X ↔ ∃ x ∈ X, f x = b := by rfl

theorem inverse_image_def {A B : Type} (f : A → B) (Y : Set B) (a : A) :
    a ∈ inverse_image f Y ↔ f a ∈ Y := by rfl

theorem Theorem_5_5_2_1 {A B : Type} (f : A → B) (W X : Set A) :
    image f (W ∩ X) ⊆ image f W ∩ image f X := by
  fix y : B
  assume h1 : y ∈ image f (W ∩ X)  --Goal : y ∈ image f W ∩ image f X
  define at h1                     --h1 : ∃ x ∈ W ∩ X, f x = y
  obtain (x : A) (h2 : x ∈ W ∩ X ∧ f x = y) from h1
  define : x ∈ W ∩ X at h2         --h2 : (x ∈ W ∧ x ∈ X) ∧ f x = y
  apply And.intro
  · -- Proof that y ∈ image f W
    define                         --Goal : ∃ x ∈ W, f x = y
    show ∃ (x : A), x ∈ W ∧ f x = y from
      Exists.intro x (And.intro h2.left.left h2.right)
    done
  · -- Proof that y ∈ image f X
    show y ∈ image f X from
      Exists.intro x (And.intro h2.left.right h2.right)
    done
  done

theorem Theorem_5_5_2_2 {A B : Type} (f : A → B) (W X : Set A)
    (h1 : one_to_one f) : image f (W ∩ X) = image f W ∩ image f X

:= by
  apply Set.ext
  fix y : B      --Goal : y ∈ image f (W ∩ X) ↔ y ∈ image f W ∩ image f X
  apply Iff.intro
  · -- (→)
    assume h2 : y ∈ image f (W ∩ X)
    show y ∈ image f W ∩ image f X from Theorem_5_5_2_1 f W X h2
    done
  · -- (←)
    assume h2 : y ∈ image f W ∩ image f X  --Goal : y ∈ image f (W ∩ X)
    define at h2                  --h2 : y ∈ image f W ∧ y ∈ image f X
    rewrite [image_def, image_def] at h2
          --h2 : (∃ x ∈ W, f x = y) ∧ ∃ x ∈ X, f x = y
    obtain (x1 : A) (h3 : x1 ∈ W ∧ f x1 = y) from h2.left
    obtain (x2 : A) (h4 : x2 ∈ X ∧ f x2 = y) from h2.right
    have h5 : f x2 = y := h4.right
    rewrite [←h3.right] at h5  --h5 : f x2 = f x1
    define at h1               --h1 : ∀ (x1 x2 : A), f x1 = f x2 → x1 = x2
    have h6 : x2 = x1 := h1 x2 x1 h5
    rewrite [h6] at h4           --h4 : x1 ∈ X ∧ f x1 = y
    show y ∈ image f (W ∩ X) from
      Exists.intro x1 (And.intro (And.intro h3.left h4.left) h3.right)
    done
  done


/- Copyright 2023 Daniel J. Velleman -/

import HTPILib.Chap8Part1
namespace HTPI

/- Definitions and theorems in Chap8Part1 and HTPIDefs

theorem zero_elts_iff_empty {A : Type} (X : Set A) :
    numElts X 0 ↔ empty X

theorem one_elt_iff_singleton {A : Type} (X : Set A) :
    numElts X 1 ↔ ∃ (x : A), X = {x}

theorem nonempty_of_pos_numElts {A : Type} {X : Set A} {n : Nat}
    (h1 : numElts X n) (h2 : n > 0) : ∃ (x : A), x ∈ X

theorem remove_one_numElts {A : Type} {X : Set A} {n : Nat} {x : A}
    (h1 : numElts X (n + 1)) (h2 : x ∈ X) : numElts (X \ {x}) n

def sum_seq {A : Type} [AddZeroClass A] (m k : Nat) (f : Nat → A) : A :=
  match m with
    | 0 => 0
    | n + 1 => sum_seq n k f + f (k + n)

theorem sum_base {A : Type} [AddZeroClass A] {k : Nat} {f : Nat → A} :
    Sum i from k to k, f i = f k

theorem sum_step {A : Type} [AddZeroClass A] {k n : Nat} {f : Nat → A}
    (h : k ≤ n) : Sum i from k to (n + 1), f i = (Sum i from k to n, f i) + f (n + 1)

theorem sum_from_zero_step {A : Type} [AddZeroClass A] {n : Nat} {f : Nat → A} :
    Sum i from 0 to (n + 1), f i = (Sum i from 0 to n, f i) + f (n + 1)
-/

/- Definitions -/
def nat_even (n : Nat) : Prop := ∃ (k : Nat), n = 2 * k

def nat_odd (n : Nat) : Prop := ∃ (k : Nat), n = 2 * k + 1

def extendPO {A : Type} (R : BinRel A) (b : A) (x y : A) : Prop :=
  R x y ∨ (R x b ∧ ¬R y b)

def fact (k : Nat) : Nat :=
  match k with
    | 0 => 1
    | n + 1 => (n + 1) * fact n

def Fib (n : Nat) : Nat :=
  match n with
    | 0 => 0
    | 1 => 1
    | k + 2 => Fib k + Fib (k + 1)

def rep_image {A : Type} (f : A → A) (n : Nat) (B : Set A) : Set A :=
  match n with
    | 0 => B
    | k + 1 => image f (rep_image f k B)

def cumul_image {A : Type} (f : A → A) (B : Set A) : Set A :=
  {x : A | ∃ (n : Nat), x ∈ rep_image f n B}

/- Section 6.1 -/
theorem Like_Example_6_1_2 :
    ∀ (n : Nat), 3 ∣ n ^ 3 + 2 * n := by
  by_induc
  · -- Base Case
    define         --Goal : ∃ (c : Nat), 0 ^ 3 + 2 * 0 = 3 * c
    apply Exists.intro 0
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : 3 ∣ n ^ 3 + 2 * n
    define at ih   --ih : ∃ (c : Nat), n ^ 3 + 2 * n = 3 * c
    obtain (k : Nat) (h1 : n ^ 3 + 2 * n = 3 * k) from ih
    define         --Goal : ∃ (c : Nat), (n + 1) ^ 3 + 2 * (n + 1) = 3 * c
    apply Exists.intro (k + n ^ 2 + n + 1)
    show (n + 1) ^ 3 + 2 * (n + 1) = 3 * (k + n ^ 2 + n + 1) from
      calc (n + 1) ^ 3 + 2 * (n + 1)
        _ = n ^ 3 + 2 * n + 3 * n ^ 2 + 3 * n + 3 := by ring
        _ = 3 * k + 3 * n ^ 2 + 3 * n + 3 := by rw [h1]
        _ = 3 * (k + n ^ 2 + n + 1) := by ring
    done
  done

theorem Like_Example_6_1_1 :
    ∀ (n : Nat), (Sum i from 0 to n, 2 ^ i) + 1 = 2 ^ (n + 1) := by
  by_induc
  · -- Base Case
    rewrite [sum_base]
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : (Sum i from 0 to n, 2 ^ i) + 1 = 2 ^ (n + 1)
    show (Sum i from 0 to n + 1, 2 ^ i) + 1 = 2 ^ (n + 1 + 1) from
      calc (Sum i from 0 to n + 1, 2 ^ i) + 1
        _ = (Sum i from 0 to n, 2 ^ i) + 2 ^ (n + 1) + 1 := by
              rw [sum_from_zero_step]
        _ = (Sum i from 0 to n, 2 ^ i) + 1 + 2 ^ (n + 1) := by ring
        _ = 2 ^ (n + 1) + 2 ^ (n + 1) := by rw [ih]
        _ = 2 ^ (n + 1 + 1) := by ring
    done
  done

theorem Example_6_1_3 : ∀ n ≥ 5, 2 ^ n > n ^ 2

:= by
  by_induc
  · -- Base Case
    decide
    done
  · -- Induction Step
    fix n : Nat
    assume h1 : n ≥ 5
    assume ih : 2 ^ n > n ^ 2
    have h2 : n * n ≥ 5 * n := Nat.mul_le_mul_right n h1
    show 2 ^ (n + 1) > (n + 1) ^ 2 from
      calc 2 ^ (n + 1)
        _ = 2 * 2 ^ n := by ring
        _ > 2 * n ^ 2 := by linarith
        _ ≥ n ^ 2 + 5 * n := by linarith
        _ > n ^ 2 + 2 * n + 1 := by linarith
        _ = (n + 1) ^ 2 := by ring
    done
  done


/- Copyright 2023 Daniel J. Velleman -/

import HTPILib.Chap7
namespace HTPI

/- Definitions -/
def fnz (n : Nat) : Int := if 2 ∣ n then ↑(n / 2) else -↑((n + 1) / 2)

def fzn (a : Int) : Nat := if a ≥ 0 then 2 * Int.toNat a else 2 * Int.toNat (-a) - 1

def tri (k : Nat) : Nat := k * (k + 1) / 2

def fnnn (p : Nat × Nat) : Nat := tri (p.1 + p.2) + p.1

def num_elts_below (A : Set Nat) (m s : Nat) : Prop :=
  match m with
    | 0 => s = 0
    | n + 1 => (n ∈ A ∧ 1 ≤ s ∧ num_elts_below A n (s - 1)) ∨
                (n ∉ A ∧ num_elts_below A n s)

def enum (A : Set Nat) (s n : Nat) : Prop := n ∈ A ∧ num_elts_below A n s

def unique_val_on_N {U : Type} (R : Rel Nat U) : Prop :=
  ∀ ⦃n : Nat⦄ ⦃x1 x2 : U⦄, R n x1 → R n x2 → x1 = x2

def nat_rel_onto {U : Type} (R : Rel Nat U) (A : Set U) : Prop :=
  ∀ ⦃x : U⦄, x ∈ A → ∃ (n : Nat), R n x

def fcnl_onto_from_nat {U : Type} (R : Rel Nat U) (A : Set U) : Prop :=
  unique_val_on_N R ∧ nat_rel_onto R A

def fcnl_one_one_to_nat {U : Type} (R : Rel U Nat) (A : Set U) : Prop :=
  fcnl_on R A ∧ ∀ ⦃x1 x2 : U⦄ ⦃n : Nat⦄,
    (x1 ∈ A ∧ R x1 n) → (x2 ∈ A ∧ R x2 n) → x1 = x2

def least_rel_to {U : Type} (S : Rel Nat U) (x : U) (n : Nat) : Prop :=
  S n x ∧ ∀ (m : Nat), S m x → n ≤ m

def restrict_to {U V : Type} (S : Rel U V) (A : Set U)
  (x : U) (y : V) : Prop := x ∈ A ∧ S x y

def fqn (q : Rat) : Nat := fnnn (fzn q.num, q.den)

def Set_rp_below (m : Nat) : Set Nat := {n : Nat | rel_prime m n ∧ n < m}

def Set_prod {U V : Type} (A : Set U) (B : Set V) : Set (U × V) :=
  {(a, b) : U × V | a ∈ A ∧ b ∈ B}

notation:75 A:75 " ×ₛ " B:75 => Set_prod A B

def Rel_prod {U V W X : Type} (R : Rel U V) (S : Rel W X)
  (p : U × W) (q : V × X) : Prop := R p.1 q.1 ∧ S p.2 q.2

notation:75 R:75 " ×ᵣ " S:75 => Rel_prod R S

def qr (n a : Nat) : Nat × Nat := (a / n, a % n)

def mod_mod (m n a : Nat) : Nat × Nat := (a % m, a % n)

def enum_union_fam {U : Type}
  (F : Set (Set U)) (f : Set U → Rel Nat U) (R : Rel Nat (Set U))
  (n : Nat) (a : U) : Prop := ∃ (p : Nat × Nat), fnnn p = n ∧
    ∃ A ∈ F, R p.1 A ∧ (f A) p.2 a

def seq {U : Type} (A : Set U) : Set (List U) :=
  {l : List U | ∀ x ∈ l, x ∈ A}

def seq_by_length {U : Type} (A : Set U) (n : Nat) : Set (List U) :=
  {l : List U | l ∈ seq A ∧ l.length = n}

def seq_cons (U : Type) (p : U × (List U)) : List U := p.1 :: p.2

def sbl_set {U : Type} (A : Set U) : Set (Set (List U)) :=
  {S : Set (List U) | ∃ (n : Nat), seq_by_length A n = S}

def rep_common_image
  {U V : Type} (R S : Rel U V) (X0 : Set U) (n : Nat) : Set U :=
  match n with
    | 0 => X0
    | m + 1 => {a : U | ∃ x ∈ rep_common_image R S X0 m,
                          ∃ (y : V), R x y ∧ S a y}

def cum_rep_image {U V : Type} (R S : Rel U V) (X0 : Set U) : Set U :=
  {a : U | ∃ (n : Nat), a ∈ rep_common_image R S X0 n}

def csb_match {U V : Type} (R S : Rel U V) (X0 : Set U)
  (x : U) (y : V) : Prop := x ∈ cum_rep_image R S X0 ∧ R x y ∨
    x ∉ cum_rep_image R S X0 ∧ S x y

/- Section 8.1 -/
#eval [fnz 0, fnz 1, fnz 2, fnz 3, fnz 4, fnz 5, fnz 6]
  --Answer: [0, -1, 1, -2, 2, -3, 3]

#eval [fzn 0, fzn (-1), fzn 1, fzn (-2), fzn 2, fzn (-3), fzn 3]
  --Answer: [0, 1, 2, 3, 4, 5, 6]

lemma fnz_even (k : Nat) : fnz (2 * k) = ↑k := by
  have h1 : 2 ∣ 2 * k := by
    apply Exists.intro k
    rfl
    done
  have h2 : fnz (2 * k) = if 2 ∣ 2 * k then ↑(2 * k / 2)
    else -↑((2 * k + 1) / 2) := by rfl
  rewrite [if_pos h1] at h2  --h2 : fnz (2 * k) = ↑(2 * k / 2)
  have h3 : 0 < 2 := by linarith
  rewrite [Nat.mul_div_cancel_left k h3] at h2
  show fnz (2 * k) = ↑k from h2
  done

lemma fnz_odd (k : Nat) : fnz (2 * k + 1) = -↑(k + 1) := sorry

lemma fzn_nat (k : Nat) : fzn ↑k = 2 * k := by rfl

lemma fzn_neg_succ_nat (k : Nat) : fzn (-↑(k + 1)) = 2 * k + 1 := by rfl

--From exercises of Section 6.1
theorem Exercise_6_1_16a1 : ∀ (n : Nat), nat_even n ∨ nat_odd n := sorry

lemma fzn_fnz : fzn ∘ fnz = id := by
  apply funext        --Goal : ∀ (x : Nat), (fzn ∘ fnz) x = id x
  fix n : Nat
  rewrite [comp_def]  --Goal : fzn (fnz n) = id n
  have h1 : nat_even n ∨ nat_odd n := Exercise_6_1_16a1 n
  by_cases on h1
  · -- Case 1. h1 : nat_even n
    obtain (k : Nat) (h2 : n = 2 * k) from h1
    rewrite [h2, fnz_even, fzn_nat]
    rfl
    done
  · -- Case 2. h1 : nat_odd n
    obtain (k : Nat) (h2 : n = 2 * k + 1) from h1
    rewrite [h2, fnz_odd, fzn_neg_succ_nat]
    rfl
    done
  done

lemma fnz_fzn : fnz ∘ fzn = id  := sorry

lemma fzn_one_one : one_to_one fzn := Theorem_5_3_3_1 fzn fnz fnz_fzn

lemma fzn_onto : onto fzn := Theorem_5_3_3_2 fzn fnz fzn_fnz

lemma fnz_one_one : one_to_one fnz := Theorem_5_3_3_1 fnz fzn fzn_fnz

lemma fnz_onto : onto fnz := Theorem_5_3_3_2 fnz fzn fnz_fzn

lemma fnnn_def (a b : Nat) : fnnn (a, b) = tri (a + b) + a := by rfl

#eval [fnnn (0, 0), fnnn (0, 1), fnnn (1, 0), fnnn (0, 2), fnnn (1, 1)]
  --Answer: [0, 1, 2, 3, 4]

lemma tri_step (k : Nat) : tri (k + 1) = tri k + k + 1 := sorry

lemma tri_incr {j k : Nat} (h1 : j ≤ k) : tri j ≤ tri k := sorry

lemma le_of_fnnn_eq {a1 b1 a2 b2 : Nat}
    (h1 : fnnn (a1, b1) = fnnn (a2, b2)) : a1 + b1 ≤ a2 + b2 := by
  by_contra h2
  have h3 : a2 + b2 + 1 ≤ a1 + b1 := by linarith
  have h4 : fnnn (a2, b2) < fnnn (a1, b1) :=
    calc fnnn (a2, b2)
      _ = tri (a2 + b2) + a2 := by rfl
      _ < tri (a2 + b2) + (a2 + b2) + 1 := by linarith
      _ = tri (a2 + b2 + 1) := (tri_step _).symm
      _ ≤ tri (a1 + b1) := tri_incr h3
      _ ≤ tri (a1 + b1) + a1 := by linarith
      _ = fnnn (a1, b1) := by rfl
  linarith
  done

lemma fnnn_one_one : one_to_one fnnn := by
  fix (a1, b1) : Nat × Nat
  fix (a2, b2) : Nat × Nat
  assume h1 : fnnn (a1, b1) = fnnn (a2, b2)  --Goal : (a1, b1) = (a2, b2)
  have h2 : a1 + b1 ≤ a2 + b2 := le_of_fnnn_eq h1
  have h3 : a2 + b2 ≤ a1 + b1 := le_of_fnnn_eq h1.symm
  have h4 : a1 + b1 = a2 + b2 := by linarith
  rewrite [fnnn_def, fnnn_def, h4] at h1
    --h1 : tri (a2 + b2) + a1 = tri (a2 + b2) + a2
  have h6 : a1 = a2 := Nat.add_left_cancel h1
  rewrite [h6] at h4   --h4 : a2 + b1 = a2 + b2
  have h7 : b1 = b2 := Nat.add_left_cancel h4
  rewrite [h6, h7]
  rfl
  done

lemma fnnn_onto : onto fnnn := by
  define  --Goal : ∀ (y : Nat), ∃ (x : Nat × Nat), fnnn x = y
  by_induc
  · -- Base Case
    apply Exists.intro (0, 0)
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : ∃ (x : Nat × Nat), fnnn x = n
    obtain ((a, b) : Nat × Nat) (h1 : fnnn (a, b) = n) from ih
    by_cases h2 : b = 0
    · -- Case 1. h2 : b = 0
      apply Exists.intro (0, a + 1)
      show fnnn (0, a + 1) = n + 1 from
        calc fnnn (0, a + 1)
          _ = tri (0 + (a + 1)) + 0 := by rfl
          _ = tri (a + 1) := by ring
          _ = tri a + a + 1 := tri_step a
          _ = tri (a + 0) + a + 1 := by ring
          _ = fnnn (a, b) + 1 := by rw [h2, fnnn_def]
          _ = n + 1 := by rw [h1]
      done
    · -- Case 2. h2 : b ≠ 0
      obtain (k : Nat) (h3 : b = k + 1) from
        exists_eq_add_one_of_ne_zero h2
      apply Exists.intro (a + 1, k)
      show fnnn (a + 1, k) = n + 1 from
        calc fnnn (a + 1, k)
          _ = tri (a + 1 + k) + (a + 1) := by rfl
          _ = tri (a + (k + 1)) + a + 1 := by ring
          _ = tri (a + b) + a + 1 := by rw [h3]
          _ = fnnn (a, b) + 1 := by rfl
          _ = n + 1 := by rw [h1]
      done
    done
  done

lemma one_one_on_of_one_one {U V : Type} {f : U → V}
    (h : one_to_one f) (A : Set U) : one_one_on f A := by
  define
  fix x1 : U; fix x2 : U
  assume h1 : x1 ∈ A
  assume h2 : x2 ∈ A
  show f x1 = f x2 → x1 = x2 from h x1 x2
  done

lemma elt_Univ {U : Type} (u : U) :
    u ∈ Univ U := by trivial

theorem equinum_Univ {U V : Type} {f : U → V}
    (h1 : one_to_one f) (h2 : onto f) : Univ U ∼ Univ V := by
  have h3 : image f (Univ U) = Univ V := by
    apply Set.ext
    fix v : V
    apply Iff.intro
    · -- (→)
      assume h3 : v ∈ image f (Univ U)
      show v ∈ Univ V from elt_Univ v
      done
    · -- (←)
      assume h3 : v ∈ Univ V
      obtain (u : U) (h4 : f u = v) from h2 v
      apply Exists.intro u
      apply And.intro _ h4
      show u ∈ Univ U from elt_Univ u
      done
    done
  show Univ U ∼ Univ V from
    equinum_image (one_one_on_of_one_one h1 (Univ U)) h3
  done

theorem Z_equinum_N : Univ Int ∼ Univ Nat :=
  equinum_Univ fzn_one_one fzn_onto

theorem NxN_equinum_N : Univ (Nat × Nat) ∼ Univ Nat :=
  equinum_Univ fnnn_one_one fnnn_onto

lemma neb_step (A : Set Nat) (n s : Nat) : num_elts_below A (n + 1) s ↔
    (n ∈ A ∧ 1 ≤ s ∧ num_elts_below A n (s - 1)) ∨
      (n ∉ A ∧ num_elts_below A n s) := by rfl

lemma neb_step_elt {A : Set Nat} {n : Nat} (h1 : n ∈ A) (s : Nat) :
    num_elts_below A (n + 1) s ↔ 1 ≤ s ∧ num_elts_below A n (s - 1) := by
  rewrite [neb_step]
  apply Iff.intro
  · -- (→)
    assume h2 : n ∈ A ∧ 1 ≤ s ∧ num_elts_below A n (s - 1) ∨
      ¬n ∈ A ∧ num_elts_below A n s
    by_cases on h2
    · -- Case 1. h2 : n ∈ A ∧ 1 ≤ s ∧ num_elts_below A n (s - 1)
      show 1 ≤ s ∧ num_elts_below A n (s - 1) from h2.right
      done
    · -- Case 2. h2 : ¬n ∈ A ∧ num_elts_below A n s
      show 1 ≤ s ∧ num_elts_below A n (s - 1) from absurd h1 h2.left
      done
    done
  · -- (←)
    assume h2 : 1 ≤ s ∧ num_elts_below A n (s - 1)
    apply Or.inl
    show n ∈ A ∧ 1 ≤ s ∧ num_elts_below A n (s - 1) from And.intro h1 h2
    done
  done

lemma neb_step_not_elt {A : Set Nat} {n : Nat} (h1 : n ∉ A) (s : Nat) :
    num_elts_below A (n + 1) s ↔ num_elts_below A n s := by
  rewrite [neb_step]
  apply Iff.intro
  · -- (→)
    assume h2 : n ∈ A ∧ 1 ≤ s ∧ num_elts_below A n (s - 1) ∨
      ¬n ∈ A ∧ num_elts_below A n s
    by_cases on h2
    · -- Case 1. h2 : n ∈ A ∧ 1 ≤ s ∧ num_elts_below A n (s - 1)
      show num_elts_below A n s from absurd h2.left h1
      done
    · -- Case 2. h2 : ¬n ∈ A ∧ num_elts_below A n s
      show num_elts_below A n s from h2.right
      done
    done
  · -- (←)
    assume h2 : num_elts_below A n s
    apply Or.inr
    show ¬n ∈ A ∧ num_elts_below A n s from And.intro h1 h2
    done
  done

lemma neb_exists (A : Set Nat) :
    ∀ (n : Nat), ∃ (s : Nat), num_elts_below A n s := by
  by_induc
  · -- Base Case
    apply Exists.intro 0
    define
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : ∃ (s : Nat), num_elts_below A n s
    obtain (t : Nat) (h1 : num_elts_below A n t) from ih
    by_cases h2 : n ∈ A
    · -- Case 1. h2 : n ∈ A
      apply Exists.intro (t + 1)
      rewrite [neb_step_elt h2, Nat.add_sub_cancel]
      apply And.intro _ h1
      linarith
      done
    · -- Case 2. h2 : n ∉ A
      apply Exists.intro t
      rewrite [neb_step_not_elt h2]
      show num_elts_below A n t from h1
      done
    done
  done

lemma neb_unique (A : Set Nat) : ∀ ⦃n : Nat⦄, ∀ ⦃s1 s2 : Nat⦄,
    num_elts_below A n s1 → num_elts_below A n s2 → s1 = s2 := by
  by_induc
  · -- Base Case
    fix s1 : Nat; fix s2 : Nat
    assume h1 : num_elts_below A 0 s1
    assume h2 : num_elts_below A 0 s2
    define at h1; define at h2  --h1 : s1 = 0; h2 : s2 = 0
    rewrite [h1, h2]
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : ∀ ⦃s1 s2 : Nat⦄,
      num_elts_below A n s1 → num_elts_below A n s2 → s1 = s2
    fix s1 : Nat; fix s2 : Nat
    assume h1 : num_elts_below A (n + 1) s1
    assume h2 : num_elts_below A (n + 1) s2
    by_cases h3 : n ∈ A
    · -- Case 1. h3 : n ∈ A
      rewrite [neb_step_elt h3] at h1
      rewrite [neb_step_elt h3] at h2
        --h1 : 1 ≤ s1 ∧ num_elts_below A n (s1 - 1)
        --h2 : 1 ≤ s2 ∧ num_elts_below A n (s2 - 1)
      have h4 : s1 - 1 = s2 - 1 := ih h1.right h2.right
      show s1 = s2 from
        calc s1
          _ = s1 - 1 + 1 := (Nat.sub_add_cancel h1.left).symm
          _ = s2 - 1 + 1 := by rw [h4]
          _ = s2 := Nat.sub_add_cancel h2.left
      done
    · -- Case 2. h3 : n ∉ A
      rewrite [neb_step_not_elt h3] at h1 --h1 : num_elts_below A n s1
      rewrite [neb_step_not_elt h3] at h2 --h2 : num_elts_below A n s2
      show s1 = s2 from ih h1 h2
      done
    done
  done

lemma neb_increase {A : Set Nat} {n s : Nat} (h1 : enum A s n) :
    ∀ ⦃m : Nat⦄, m ≥ n + 1 → ∀ ⦃t : Nat⦄, num_elts_below A m t → s < t := by
  by_induc
  · -- Base Case
    define at h1
    fix t : Nat
    assume h2 : num_elts_below A (n + 1) t
    rewrite [neb_step_elt h1.left] at h2
    have h3 : s = t - 1 := neb_unique A h1.right h2.right
    show s < t from
      calc s
        _ = t - 1 := h3
        _ < t - 1 + 1 := by linarith
        _ = t := Nat.sub_add_cancel h2.left
    done
  · -- Induction Step
    fix m : Nat
    assume h2 : m ≥ n + 1
    assume ih : ∀ ⦃t : Nat⦄, num_elts_below A m t → s < t
    fix t : Nat
    assume h3 : num_elts_below A (m + 1) t
    by_cases h4 : m ∈ A
    · -- Case 1. h4 : m ∈ A
      rewrite [neb_step_elt h4] at h3
      have h5 : s < t - 1 := ih h3.right
      show s < t from
        calc s
          _ < t - 1 := h5
          _ ≤ t := Nat.sub_le _ _
      done
    · -- Case 2. h4 : m ∉ A
      rewrite [neb_step_not_elt h4] at h3
      show s < t from ih h3
      done
    done
  done

lemma enum_not_skip {A : Set Nat} : ∀ ⦃m s : Nat⦄, num_elts_below A m s →
    ∀ t < s, ∃ (n : Nat), enum A t n := by
  by_induc
  · -- Base Case
    fix s : Nat
    assume h1 : num_elts_below A 0 s
    define at h1
    fix t : Nat
    contrapos
    assume h2 : ¬∃ (n : Nat), enum A t n
    linarith
    done
  · -- Induction Step
    fix m : Nat
    assume ih : ∀ ⦃s : Nat⦄, num_elts_below A m s → ∀ t < s, ∃ (n : Nat), enum A t n
    fix s : Nat
    assume h1 : num_elts_below A (m + 1) s
    by_cases h2 : m ∈ A
    · -- Case 1. h2 : m ∈ A
      rewrite [neb_step_elt h2] at h1
      have h3 : ∀ t < s - 1, ∃ (n : Nat), enum A t n := ih h1.right
      fix t : Nat
      assume h4 : t < s
      by_cases h5 : t = s - 1
      · -- Case 1.1. h5 : t = s - 1
        apply Exists.intro m
        define
        apply And.intro h2
        rewrite [h5]
        show num_elts_below A m (s - 1) from h1.right
        done
      · -- Case 1.2. h5 : t ≠ s - 1
        have h6 : t ≤ s - 1 := Nat.le_pred_of_lt h4
        have h7 : t < s - 1 := Nat.lt_of_le_of_ne h6 h5
        show ∃ (n : Nat), enum A t n from ih h1.right t h7
        done
      done
    · -- Case 2. h2 : m ∉ A
      rewrite [neb_step_not_elt h2] at h1
      show ∀ t < s, ∃ (n : Nat), enum A t n from ih h1
      done
    done
  done

lemma enum_le {A : Set Nat} {t n1 n2 : Nat}
    (h1 : enum A t n1) (h2 : enum A t n2) : n1 ≤ n2 := by
  by_contra h3
  have h4 : n2 + 1 ≤ n1 := by linarith
  define at h1
  have h5 : t < t := neb_increase h2 h4 h1.right
  linarith
  done

lemma enum_unique (A : Set Nat) (t : Nat) :
    ∀ ⦃n1 n2 : Nat⦄, enum A t n1 → enum A t n2 → n1 = n2 := by
  fix n1 : Nat; fix n2 : Nat
  assume h1 : enum A t n1
  assume h2 : enum A t n2
  have h3 : n1 ≤ n2 := enum_le h1 h2
  have h4 : n2 ≤ n1 := enum_le h2 h1
  linarith
  done

lemma inv_enum_fcnl (A : Set Nat) : fcnl_on (invRel (enum A)) A := by
  define
  fix n : Nat
  assume h1 : n ∈ A
  exists_unique
  · -- Existence
    obtain (s : Nat) (h2 : num_elts_below A n s) from neb_exists A n
    apply Exists.intro s
    define
    show n ∈ A ∧ num_elts_below A n s from And.intro h1 h2
    done
  · -- Uniqueness
    fix s1 : Nat; fix s2 : Nat
    assume h2 : invRel (enum A) n s1
    assume h3 : invRel (enum A) n s2
    define at h2; define at h3
    show s1 = s2 from neb_unique A h2.right h3.right
    done
  done

lemma bdd_subset_nat_match {A : Set Nat} {m s : Nat}
    (h1 : ∀ n ∈ A, n < m) (h2 : num_elts_below A m s) :
    matching (enum A) (I s) A := by
  define
  apply And.intro
  · -- Proof of rel_within
    define
    fix t : Nat; fix n : Nat
    assume h3 : enum A t n
    have h4 : ∀ ⦃m : Nat⦄, m ≥ n + 1 → ∀ ⦃t_1 : Nat⦄, num_elts_below A m t_1 → t < t_1 :=
      neb_increase h3
    define at h3
    apply And.intro _ h3.left
    define
    have h5 : n < m := h1 n h3.left
    have h6 : m ≥ n + 1 := h5
    show t < s from h4 h6 h2
    done
  · -- Proof of fcnl_ons
    apply And.intro
    · -- proof of fcnl_on (enum A) (I s)
      define
      fix t : Nat
      assume h3 : t ∈ I s
      define at h3
      exists_unique
      · -- Existence
        show ∃ (y : Nat), enum A t y from enum_not_skip h2 t h3
        done
      · -- Uniqueness
        show ∀ (y_1 y_2 : Nat), enum A t y_1 → enum A t y_2 → y_1 = y_2 from
          enum_unique A t
        done
      done
    · -- Proof of fcnl_on (invRel (enum A)) A
      show fcnl_on (invRel (enum A)) A from inv_enum_fcnl A
      done
    done
  done

lemma bdd_subset_nat {A : Set Nat} {m s : Nat}
    (h1 : ∀ n ∈ A, n < m) (h2 : num_elts_below A m s) :
    I s ∼ A := Exists.intro (enum A) (bdd_subset_nat_match h1 h2)

lemma enum_fcnl_of_unbdd {A : Set Nat} (h1 : ∀ (m : Nat), ∃ n ∈ A, n ≥ m) :
    fcnl_on (enum A) (Univ Nat) := by
  define
  by_induc
  · -- Base Case
    assume h2 : 0 ∈ Univ Nat
    exists_unique
    · -- Existence
      obtain (n : Nat) (h3 : n ∈ A ∧ n ≥ 0) from h1 0
      obtain (s : Nat) (h4 : num_elts_below A (n + 1) s) from neb_exists A (n + 1)
      have h5 : ∀ (t : Nat), t < s → ∃ (n : Nat), enum A t n := enum_not_skip h4
      rewrite [neb_step_elt h3.left] at h4
      show ∃ (y : Nat), enum A 0 y from h5 0 h4.left
      done
    · -- Uniqueness
      show ∀ (y_1 y_2 : Nat), enum A 0 y_1 → enum A 0 y_2 → y_1 = y_2 from enum_unique A 0
      done
    done
  · -- Induction Step
    fix s : Nat
    assume ih : s ∈ Univ Nat → ∃! (y : Nat), enum A s y
    assume h2 : s + 1 ∈ Univ Nat
    exists_unique
    · -- Existence
      have h3 : s ∈ Univ Nat := elt_Univ s
      obtain (m : Nat) (h4 : enum A s m)
        (h5 : ∀ (y_1 y_2 : Nat), enum A s y_1 → enum A s y_2 → y_1 = y_2) from ih h3
      obtain (n : Nat) (h6 : n ∈ A ∧ n ≥ m + 1) from h1 (m + 1)
      obtain (t : Nat) (h7 : num_elts_below A n t) from neb_exists A n
      have h8 : s < t := neb_increase h4 h6.right h7
      have h9 : s + 1 < t ∨ s + 1 = t := Nat.lt_or_eq_of_le h8
      by_cases on h9
      · -- Case 1. h9 : s + 1 < t
        show ∃ (y : Nat), enum A (s + 1) y from enum_not_skip h7 (s + 1) h9
        done
      · -- Case 2. h9 : s + 1 = t
        rewrite [h9]
        apply Exists.intro n
        define
        show n ∈ A ∧ num_elts_below A n t from And.intro h6.left h7
        done
      done
    · -- Uniqueness
      show ∀ (y_1 y_2 : Nat), enum A (s + 1) y_1 → enum A (s + 1) y_2 → y_1 = y_2
        from enum_unique A (s + 1)
      done
    done
  done

lemma unbdd_subset_nat_match {A : Set Nat}
    (h1 : ∀ (m : Nat), ∃ n ∈ A, n ≥ m) :
    matching (enum A) (Univ Nat) A := by
  define
  apply And.intro
  · -- Proof of rel_within
    define
    fix s : Nat; fix n : Nat
    assume h2 : enum A s n
    define at h2
    apply And.intro (elt_Univ s) h2.left
    done
  · -- Proof of fcnl_ons
    apply And.intro
    · -- Proof of fcnl_on (enum A)
      show fcnl_on (enum A) (Univ Nat) from enum_fcnl_of_unbdd h1
      done
    · -- Proof of fcnl_on (invRel (enum A))
      show fcnl_on (invRel (enum A)) A from inv_enum_fcnl A
      done
    done
  done

lemma unbdd_subset_nat {A : Set Nat}
    (h1 : ∀ (m : Nat), ∃ n ∈ A, n ≥ m) :
    denum A := Exists.intro (enum A) (unbdd_subset_nat_match h1)

lemma subset_nat_ctble (A : Set Nat) : ctble A := by
  define          --Goal : finite A ∨ denum A
  by_cases h1 : ∃ (m : Nat), ∀ n ∈ A, n < m
  · -- Case 1. h1 : ∃ (m : Nat), ∀ n ∈ A, n < m
    apply Or.inl  --Goal : finite A
    obtain (m : Nat) (h2 : ∀ n ∈ A, n < m) from h1
    obtain (s : Nat) (h3 : num_elts_below A m s) from neb_exists A m
    apply Exists.intro s
    show I s ∼ A from bdd_subset_nat h2 h3
    done
  · -- Case 2. h1 : ¬∃ (m : Nat), ∀ n ∈ A, n < m
    apply Or.inr  --Goal : denum A
    push_neg at h1
      --This tactic converts h1 to ∀ (m : Nat), ∃ n ∈ A, m ≤ n
    show denum A from unbdd_subset_nat h1
    done
  done

lemma ctble_of_equinum_ctble {U V : Type} {A : Set U} {B : Set V}
    (h1 : A ∼ B) (h2 : ctble A) : ctble B := sorry

lemma ctble_iff_equinum_set_nat {U : Type} (A : Set U) :
    ctble A ↔ ∃ (I : Set Nat), I ∼ A := by
  apply Iff.intro
  · -- (→)
    assume h1 : ctble A
    define at h1  --h1 : finite A ∨ denum A
    by_cases on h1
    · -- Case 1. h1 : finite A
      define at h1  --h1 : ∃ (n : Nat), I n ∼ A
      obtain (n : Nat) (h2 : I n ∼ A) from h1
      show ∃ (I : Set Nat), I ∼ A from Exists.intro (I n) h2
      done
    · -- Case 2. h1 : denum A
      rewrite [denum_def] at h1  --h1 : Univ Nat ∼ A
      show ∃ (I : Set Nat), I ∼ A from Exists.intro (Univ Nat) h1
      done
    done
  · -- (←)
    assume h1 : ∃ (I : Set Nat), I ∼ A
    obtain (I : Set Nat) (h2 : I ∼ A) from h1
    have h3 : ctble I := subset_nat_ctble I
    show ctble A from ctble_of_equinum_ctble h2 h3
    done
  done

theorem Theorem_8_1_5_1_to_2 {U : Type} {A : Set U} (h1 : ctble A) :
    ∃ (R : Rel Nat U), fcnl_onto_from_nat R A := by
  rewrite [ctble_iff_equinum_set_nat] at h1
  obtain (I : Set Nat) (h2 : I ∼ A) from h1
  obtain (R : Rel Nat U) (h3 : matching R I A) from h2
  define at h3
    --h3 : rel_within R I A ∧ fcnl_on R I ∧ fcnl_on (invRel R) A
  apply Exists.intro R
  define  --Goal : unique_val_on_N R ∧ nat_rel_onto R A
  apply And.intro
  · -- Proof of unique_val_on_N R
    define
    fix n : Nat; fix x1 : U; fix x2 : U
    assume h4 : R n x1
    assume h5 : R n x2      --Goal : x1 = x2
    have h6 : n ∈ I ∧ x1 ∈ A := h3.left h4
    show x1 = x2 from fcnl_unique h3.right.left h6.left h4 h5
    done
  · -- Proof of nat_rel_onto R A
    define
    fix x : U
    assume h4 : x ∈ A  --Goal : ∃ (n : Nat), R n x
    show ∃ (n : Nat), R n x from fcnl_exists h3.right.right h4
    done
  done

lemma exists_least_rel_to {U : Type} {S : Rel Nat U} {x : U}
    (h1 : ∃ (n : Nat), S n x) : ∃ (n : Nat), least_rel_to S x n := by
  set W : Set Nat := {n : Nat | S n x}
  have h2 : ∃ (n : Nat), n ∈ W := h1
  show ∃ (n : Nat), least_rel_to S x n from well_ord_princ W h2
  done

theorem Theorem_8_1_5_2_to_3 {U : Type} {A : Set U}
    (h1 : ∃ (R : Rel Nat U), fcnl_onto_from_nat R A) :
    ∃ (R : Rel U Nat), fcnl_one_one_to_nat R A

:= by
  obtain (S : Rel Nat U) (h2 : fcnl_onto_from_nat S A) from h1
  define at h2  --h2 : unique_val_on_N S ∧ nat_rel_onto S A
  set R : Rel U Nat := least_rel_to S
  apply Exists.intro R
  define
  apply And.intro
  · -- Proof of fcnl_on R A
    define
    fix x : U
    assume h4 : x ∈ A  --Goal : ∃! (y : Nat), R x y
    exists_unique
    · -- Existence
      have h5 : ∃ (n : Nat), S n x := h2.right h4
      show ∃ (n : Nat), R x n from exists_least_rel_to h5
      done
    · -- Uniqueness
      fix n1 : Nat; fix n2 : Nat
      assume h5 : R x n1
      assume h6 : R x n2      --Goal : n1 = n2
      define at h5    --h5 : S n1 x ∧ ∀ (m : Nat), S m x → n1 ≤ m
      define at h6    --h6 : S n2 x ∧ ∀ (m : Nat), S m x → n2 ≤ m
      have h7 : n1 ≤ n2 := h5.right n2 h6.left
      have h8 : n2 ≤ n1 := h6.right n1 h5.left
      linarith
      done
    done
  · -- Proof of one-to-one
    fix x1 : U; fix x2 : U; fix n : Nat
    assume h4 : x1 ∈ A ∧ R x1 n
    assume h5 : x2 ∈ A ∧ R x2 n
    have h6 : R x1 n := h4.right
    have h7 : R x2 n := h5.right
    define at h6   --h6 : S n x1 ∧ ∀ (m : Nat), S m x1 → n ≤ m
    define at h7   --h7 : S n x2 ∧ ∀ (m : Nat), S m x2 → n ≤ m
    show x1 = x2 from h2.left h6.left h7.left
    done
  done


/- Copyright 2023 Daniel J. Velleman -/

import HTPILib.Chap6
namespace HTPI

/- Definitions -/
lemma mod_succ_lt (a n : Nat) : a % (n + 1) < n + 1 := by
  have h : n + 1 > 0 := Nat.succ_pos n
  show a % (n + 1) < n + 1 from Nat.mod_lt a h
  done

def gcd (a b : Nat) : Nat :=
  match b with
    | 0 => a
    | n + 1 =>
      have : a % (n + 1) < n + 1 := mod_succ_lt a n
      gcd (n + 1) (a % (n + 1))
  termination_by b

mutual
  def gcd_c1 (a b : Nat) : Int :=
    match b with
      | 0 => 1
      | n + 1 =>
        have : a % (n + 1) < n + 1 := mod_succ_lt a n
        gcd_c2 (n + 1) (a % (n + 1))
          --Corresponds to s = t'
    termination_by b

  def gcd_c2 (a b : Nat) : Int :=
    match b with
      | 0 => 0
      | n + 1 =>
        have : a % (n + 1) < n + 1 := mod_succ_lt a n
        gcd_c1 (n + 1) (a % (n + 1)) -
          (gcd_c2 (n + 1) (a % (n + 1))) * ↑(a / (n + 1))
          --Corresponds to t = s' - t'q
    termination_by b
end

def prime (n : Nat) : Prop :=
  2 ≤ n ∧ ¬∃ (a b : Nat), a * b = n ∧ a < n ∧ b < n

def prime_factor (p n : Nat) : Prop := prime p ∧ p ∣ n

def all_prime (l : List Nat) : Prop := ∀ p ∈ l, prime p

def nondec (l : List Nat) : Prop :=
  match l with
    | [] => True   --Of course, True is a proposition that is always true
    | n :: L => (∀ m ∈ L, n ≤ m) ∧ nondec L

def nondec_prime_list (l : List Nat) : Prop := all_prime l ∧ nondec l

def prod (l : List Nat) : Nat :=
  match l with
    | [] => 1
    | n :: L => n * (prod L)

def prime_factorization (n : Nat) (l : List Nat) : Prop :=
  nondec_prime_list l ∧ prod l = n

def rel_prime (a b : Nat) : Prop := gcd a b = 1

def congr_mod (m : Nat) (a b : Int) : Prop := (↑m : Int) ∣ (a - b)

def cc (m : Nat) (a : Int) : ZMod m := (↑a : ZMod m)

notation:50 a " ≡ " b " (MOD " m ")" => congr_mod m a b

notation:max "["a"]_"m:max => cc m a

def invertible {m : Nat} (X : ZMod m) : Prop :=
  ∃ (Y : ZMod m), X * Y = [1]_m

def num_rp_below (m k : Nat) : Nat :=
  match k with
    | 0 => 0
    | j + 1 => if gcd m j = 1 then (num_rp_below m j) + 1
                else num_rp_below m j

def phi (m : Nat) : Nat := num_rp_below m m

def prod_seq {m : Nat}
    (j k : Nat) (f : Nat → ZMod m) : ZMod m :=
  match j with
    | 0 => [1]_m
    | n + 1 => prod_seq n k f * f (k + n)

def maps_below (n : Nat) (g : Nat → Nat) : Prop := ∀ i < n, g i < n

def one_one_below (n : Nat) (g : Nat → Nat) : Prop :=
  ∀ i1 < n, ∀ i2 < n, g i1 = g i2 → i1 = i2

def onto_below (n : Nat) (g : Nat → Nat) : Prop :=
  ∀ k < n, ∃ i < n, g i = k

def perm_below (n : Nat) (g : Nat → Nat) : Prop :=
  maps_below n g ∧ one_one_below n g ∧ onto_below n g

def inv_mod (m a : Nat) : Nat := Int.toNat ((gcd_c2 m a) % m)

def swap (u v i : Nat) : Nat :=
  if i = u then v else if i = v then u else i

namespace Euler  --For definitions specific to Euler's theorem

def F (m i : Nat) : ZMod m := if gcd m i = 1 then [i]_m else [1]_m

def G (m a i : Nat) : Nat := (a * i) % m

def Ginv (m a i : Nat) : Nat := G m (inv_mod m a) i

end Euler

/- Section 7.1 -/
theorem dvd_mod_of_dvd_a_b {a b d : Nat}
    (h1 : d ∣ a) (h2 : d ∣ b) : d ∣ (a % b) := by
  set q : Nat := a / b
  have h3 : b * q + a % b = a := Nat.div_add_mod a b
  obtain (j : Nat) (h4 : a = d * j) from h1
  obtain (k : Nat) (h5 : b = d * k) from h2
  define    --Goal : ∃ (c : Nat), a % b = d * c
  apply Exists.intro (j - k * q)
  show a % b = d * (j - k * q) from
    calc a % b
      _ = b * q + a % b - b * q := (Nat.add_sub_cancel_left _ _).symm
      _ = a - b * q := by rw [h3]
      _ = d * j - d * (k * q) := by rw [h4, h5, mul_assoc]
      _ = d * (j - k * q) := (Nat.mul_sub_left_distrib _ _ _).symm
  done

theorem dvd_a_of_dvd_b_mod {a b d : Nat}
    (h1 : d ∣ b) (h2 : d ∣ (a % b)) : d ∣ a := sorry

#eval gcd 672 161    --Answer: 7

lemma gcd_base (a : Nat) : gcd a 0 = a := by rfl

lemma gcd_nonzero (a : Nat) {b : Nat} (h : b ≠ 0) :
    gcd a b = gcd b (a % b) := by
  obtain (n : Nat) (h2 : b = n + 1) from exists_eq_add_one_of_ne_zero h
  rewrite [h2]   --Goal : gcd a (n + 1) = gcd (n + 1) (a % (n + 1))
  rfl
  done

lemma mod_nonzero_lt (a : Nat) {b : Nat} (h : b ≠ 0) : a % b < b := by
  have h1 : b > 0 := Nat.pos_of_ne_zero h
  show a % b < b from Nat.mod_lt a h1
  done

lemma dvd_self (n : Nat) : n ∣ n := by
  apply Exists.intro 1
  ring
  done

theorem gcd_dvd : ∀ (b a : Nat), (gcd a b) ∣ a ∧ (gcd a b) ∣ b := by
  by_strong_induc
  fix b : Nat
  assume ih : ∀ b_1 < b, ∀ (a : Nat), (gcd a b_1) ∣ a ∧ (gcd a b_1) ∣ b_1
  fix a : Nat
  by_cases h1 : b = 0
  · -- Case 1. h1 : b = 0
    rewrite [h1, gcd_base]   --Goal: a ∣ a ∧ a ∣ 0
    apply And.intro (dvd_self a)
    define
    apply Exists.intro 0
    rfl
    done
  · -- Case 2. h1 : b ≠ 0
    rewrite [gcd_nonzero a h1]
      --Goal : gcd b (a % b) ∣ a ∧ gcd b (a % b) ∣ b
    have h2 : a % b < b := mod_nonzero_lt a h1
    have h3 : (gcd b (a % b)) ∣ b ∧ (gcd b (a % b)) ∣ (a % b) :=
      ih (a % b) h2 b
    apply And.intro _ h3.left
    show (gcd b (a % b)) ∣ a from dvd_a_of_dvd_b_mod h3.left h3.right
    done
  done

theorem gcd_dvd_left (a b : Nat) : (gcd a b) ∣ a := (gcd_dvd b a).left

theorem gcd_dvd_right (a b : Nat) : (gcd a b) ∣ b := (gcd_dvd b a).right

lemma gcd_c1_base (a : Nat) : gcd_c1 a 0 = 1 := by rfl

lemma gcd_c1_nonzero (a : Nat) {b : Nat} (h : b ≠ 0) :
    gcd_c1 a b = gcd_c2 b (a % b) := by
  obtain (n : Nat) (h2 : b = n + 1) from exists_eq_add_one_of_ne_zero h
  rewrite [h2]
  rfl
  done

lemma gcd_c2_base (a : Nat) : gcd_c2 a 0 = 0 := by rfl

lemma gcd_c2_nonzero (a : Nat) {b : Nat} (h : b ≠ 0) :
    gcd_c2 a b = gcd_c1 b (a % b) - (gcd_c2 b (a % b)) * ↑(a / b) := by
  obtain (n : Nat) (h2 : b = n + 1) from exists_eq_add_one_of_ne_zero h
  rewrite [h2]
  rfl
  done

theorem gcd_lin_comb : ∀ (b a : Nat),
    (gcd_c1 a b) * ↑a + (gcd_c2 a b) * ↑b = ↑(gcd a b) := by
  by_strong_induc
  fix b : Nat
  assume ih : ∀ b_1 < b, ∀ (a : Nat),
    (gcd_c1 a b_1) * ↑a + (gcd_c2 a b_1) * ↑b_1 = ↑(gcd a b_1)
  fix a : Nat
  by_cases h1 : b = 0
  · -- Case 1. h1 : b = 0
    rewrite [h1, gcd_c1_base, gcd_c2_base, gcd_base]
      --Goal : 1 * ↑a + 0 * ↑0 = ↑a
    ring
    done
  · -- Case 2. h1 : b ≠ 0
    rewrite [gcd_c1_nonzero a h1, gcd_c2_nonzero a h1, gcd_nonzero a h1]
      --Goal : gcd_c2 b (a % b) * ↑a +
      -- (gcd_c1 b (a % b) - gcd_c2 b (a % b) * ↑(a / b)) * ↑b =
      -- ↑(gcd b (a % b))
    set r : Nat := a % b
    set q : Nat := a / b
    set s : Int := gcd_c1 b r
    set t : Int := gcd_c2 b r
      --Goal : t * ↑a + (s - t * ↑q) * ↑b = ↑(gcd b r)
    have h2 : r < b := mod_nonzero_lt a h1
    have h3 : s * ↑b + t * ↑r = ↑(gcd b r) := ih r h2 b
    have h4 : b * q + r = a := Nat.div_add_mod a b
    rewrite [←h3, ←h4]
    rewrite [Nat.cast_add, Nat.cast_mul]
      --Goal : t * (↑b * ↑q + ↑r) + (s - t * ↑q) * ↑b = s * ↑b + t * ↑r
    ring
    done
  done

#eval gcd_c1 672 161  --Answer: 6
#eval gcd_c2 672 161  --Answer: -25
  --Note 6 * 672 - 25 * 161 = 4032 - 4025 = 7 = gcd 672 161

theorem Theorem_7_1_6 {d a b : Nat} (h1 : d ∣ a) (h2 : d ∣ b) :
    d ∣ gcd a b := by
  rewrite [←Int.natCast_dvd_natCast]    --Goal : ↑d ∣ ↑(gcd a b)
  set s : Int := gcd_c1 a b
  set t : Int := gcd_c2 a b
  have h3 : s * ↑a + t * ↑b = ↑(gcd a b) := gcd_lin_comb b a
  rewrite [←h3]                 --Goal : ↑d ∣ s * ↑a + t * ↑b
  obtain (j : Nat) (h4 : a = d * j) from h1
  obtain (k : Nat) (h5 : b = d * k) from h2
  rewrite [h4, h5, Nat.cast_mul, Nat.cast_mul]
    --Goal : ↑d ∣ s * (↑d * ↑j) + t * (↑d * ↑k)
  define
  apply Exists.intro (s * ↑j + t * ↑k)
  ring
  done

/- Section 7.2 -/
theorem dvd_trans {a b c : Nat} (h1 : a ∣ b) (h2 : b ∣ c) : a ∣ c := by
  define at h1; define at h2; define
  obtain (m : Nat) (h3 : b = a * m) from h1
  obtain (n : Nat) (h4 : c = b * n) from h2
  rewrite [h3, mul_assoc] at h4
  apply Exists.intro (m * n)
  show c = a * (m * n) from h4
  done

lemma exists_prime_factor : ∀ (n : Nat), 2 ≤ n →
    ∃ (p : Nat), prime_factor p n := by
  by_strong_induc
  fix n : Nat
  assume ih : ∀ n_1 < n, 2 ≤ n_1 → ∃ (p : Nat), prime_factor p n_1
  assume h1 : 2 ≤ n
  by_cases h2 : prime n
  · -- Case 1. h2 : prime n
    apply Exists.intro n
    define            --Goal : prime n ∧ n ∣ n
    show prime n ∧ n ∣ n from And.intro h2 (dvd_self n)
    done
  · -- Case 2. h2 : ¬prime n
    define at h2
      --h2 : ¬(2 ≤ n ∧ ¬∃ (a b : Nat), a * b = n ∧ a < n ∧ b < n)
    demorgan at h2
    disj_syll h2 h1
    obtain (a : Nat) (h3 : ∃ (b : Nat), a * b = n ∧ a < n ∧ b < n) from h2
    obtain (b : Nat) (h4 : a * b = n ∧ a < n ∧ b < n) from h3
    have h5 : 2 ≤ a := by
      by_contra h6
      have h7 : a ≤ 1 := by linarith
      have h8 : n ≤ b :=
        calc n
          _ = a * b := h4.left.symm
          _ ≤ 1 * b := by rel [h7]
          _ = b := by ring
      linarith        --n ≤ b contradicts b < n
      done
    have h6 : ∃ (p : Nat), prime_factor p a := ih a h4.right.left h5
    obtain (p : Nat) (h7 : prime_factor p a) from h6
    apply Exists.intro p
    define            --Goal : prime p ∧ p ∣ n
    define at h7      --h7 : prime p ∧ p ∣ a
    apply And.intro h7.left
    have h8 : a ∣ n := by
      apply Exists.intro b
      show n = a * b from (h4.left).symm
      done
    show p ∣ n from dvd_trans h7.right h8
    done
  done

lemma exists_least_prime_factor {n : Nat} (h : 2 ≤ n) :
    ∃ (p : Nat), prime_factor p n ∧
    ∀ (q : Nat), prime_factor q n → p ≤ q := by
  set S : Set Nat := {p : Nat | prime_factor p n}
  have h2 : ∃ (p : Nat), p ∈ S := exists_prime_factor n h
  show ∃ (p : Nat), prime_factor p n ∧
    ∀ (q : Nat), prime_factor q n → p ≤ q from well_ord_princ S h2
  done

lemma all_prime_nil : all_prime [] := by
  define     --Goal : ∀ p ∈ [], prime p
  fix p : Nat
  contrapos  --Goal : ¬prime p → p ∉ []
  assume h1 : ¬prime p
  show p ∉ [] from List.not_mem_nil p
  done

lemma all_prime_cons (n : Nat) (L : List Nat) :
    all_prime (n :: L) ↔ prime n ∧ all_prime L := by
  apply Iff.intro
  · -- (→)
    assume h1 : all_prime (n :: L)  --Goal : prime n ∧ all_prime L
    define at h1  --h1 : ∀ p ∈ n :: L, prime p
    apply And.intro (h1 n (List.mem_cons_self n L))
    define        --Goal : ∀ p ∈ L, prime p
    fix p : Nat
    assume h2 : p ∈ L
    show prime p from h1 p (List.mem_cons_of_mem n h2)
    done
  · -- (←)
    assume h1 : prime n ∧ all_prime L  --Goal : all_prime (n :: l)
    define : all_prime L at h1
    define
    fix p : Nat
    assume h2 : p ∈ n :: L
    rewrite [List.mem_cons] at h2   --h2 : p = n ∨ p ∈ L
    by_cases on h2
    · -- Case 1. h2 : p = n
      rewrite [h2]
      show prime n from h1.left
      done
    · -- Case 2. h2 : p ∈ L
      show prime p from h1.right p h2
      done
    done
  done

lemma nondec_nil : nondec [] := by
  define  --Goal : True
  trivial --trivial proves some obviously true statements, such as True
  done

lemma nondec_cons (n : Nat) (L : List Nat) :
    nondec (n :: L) ↔ (∀ m ∈ L, n ≤ m) ∧ nondec L := by rfl

lemma prod_nil : prod [] = 1 := by rfl

lemma prod_cons : prod (n :: L) = n * (prod L) := by rfl

lemma exists_cons_of_length_eq_succ {A : Type}
    {l : List A} {n : Nat} (h : l.length = n + 1) :
    ∃ (a : A) (L : List A), l = a :: L ∧ L.length = n := by
  have h1 : ¬l.length = 0 := by linarith
  rewrite [List.length_eq_zero] at h1
  obtain (a : A) (h2 : ∃ (L : List A), l = a :: L) from
    List.exists_cons_of_ne_nil h1
  obtain (L : List A) (h3 : l = a :: L) from h2
  apply Exists.intro a
  apply Exists.intro L
  apply And.intro h3
  have h4 : (a :: L).length = L.length + 1 := List.length_cons a L
  rewrite [←h3, h] at h4
  show L.length = n from (Nat.add_right_cancel h4).symm
  done

lemma list_elt_dvd_prod_by_length (a : Nat) : ∀ (n : Nat),
    ∀ (l : List Nat), l.length = n → a ∈ l → a ∣ prod l := by
  by_induc
  · --Base Case
    fix l : List Nat
    assume h1 : l.length = 0
    rewrite [List.length_eq_zero] at h1     --h1 : l = []
    rewrite [h1]                            --Goal : a ∈ [] → a ∣ prod []
    contrapos
    assume h2 : ¬a ∣ prod []
    show a ∉ [] from List.not_mem_nil a
    done
  · -- Induction Step
    fix n : Nat
    assume ih : ∀ (l : List Nat), List.length l = n → a ∈ l → a ∣ prod l
    fix l : List Nat
    assume h1 : l.length = n + 1            --Goal : a ∈ l → a ∣ prod l
    obtain (b : Nat) (h2 : ∃ (L : List Nat),
      l = b :: L ∧ L.length = n) from exists_cons_of_length_eq_succ h1
    obtain (L : List Nat) (h3 : l = b :: L ∧ L.length = n) from h2
    have h4 : a ∈ L → a ∣ prod L := ih L h3.right
    assume h5 : a ∈ l
    rewrite [h3.left, prod_cons]            --Goal : a ∣ b * prod L
    rewrite [h3.left, List.mem_cons] at h5  --h5 : a = b ∨ a ∈ L
    by_cases on h5
    · -- Case 1. h5 : a = b
      apply Exists.intro (prod L)
      rewrite [h5]
      rfl
      done
    · -- Case 2. h5 : a ∈ L
      have h6 : a ∣ prod L := h4 h5
      have h7 : prod L ∣ b * prod L := by
        apply Exists.intro b
        ring
        done
      show a ∣ b * prod L from dvd_trans h6 h7
      done
    done
  done

lemma list_elt_dvd_prod {a : Nat} {l : List Nat}
    (h : a ∈ l) : a ∣ prod l := by
  set n : Nat := l.length
  have h1 : l.length = n := by rfl
  show a ∣ prod l from list_elt_dvd_prod_by_length a n l h1 h
  done

lemma exists_prime_factorization : ∀ (n : Nat), n ≥ 1 →
    ∃ (l : List Nat), prime_factorization n l := by
  by_strong_induc
  fix n : Nat
  assume ih : ∀ n_1 < n, n_1 ≥ 1 →
    ∃ (l : List Nat), prime_factorization n_1 l
  assume h1 : n ≥ 1
  by_cases h2 : n = 1
  · -- Case 1. h2 : n = 1
    apply Exists.intro []
    define
    apply And.intro
    · -- Proof of nondec_prime_list []
      define
      show all_prime [] ∧ nondec [] from
        And.intro all_prime_nil nondec_nil
      done
    · -- Proof of prod [] = n
      rewrite [prod_nil, h2]
      rfl
      done
    done
  · -- Case 2. h2 : n ≠ 1
    have h3 : n ≥ 2 := lt_of_le_of_ne' h1 h2
    obtain (p : Nat) (h4 : prime_factor p n ∧ ∀ (q : Nat),
      prime_factor q n → p ≤ q) from exists_least_prime_factor h3
    have p_prime_factor : prime_factor p n := h4.left
    define at p_prime_factor
    have p_prime : prime p := p_prime_factor.left
    have p_dvd_n : p ∣ n := p_prime_factor.right
    have p_least : ∀ (q : Nat), prime_factor q n → p ≤ q := h4.right
    obtain (m : Nat) (n_eq_pm : n = p * m) from p_dvd_n
    have h5 : m ≠ 0 := by
      contradict h1 with h6
      have h7 : n = 0 :=
        calc n
          _ = p * m := n_eq_pm
          _ = p * 0 := by rw [h6]
          _ = 0 := by ring
      rewrite [h7]
      decide
      done
    have m_pos : 0 < m := Nat.pos_of_ne_zero h5
    have m_lt_n : m < n := by
      define at p_prime
      show m < n from
        calc m
          _ < m + m := by linarith
          _ = 2 * m := by ring
          _ ≤ p * m := by rel [p_prime.left]
          _ = n := n_eq_pm.symm
      done
    obtain (L : List Nat) (h6 : prime_factorization m L)
      from ih m m_lt_n m_pos
    define at h6
    have ndpl_L : nondec_prime_list L := h6.left
    define at ndpl_L
    apply Exists.intro (p :: L)
    define
    apply And.intro
    · -- Proof of nondec_prime_list (p :: L)
      define
      apply And.intro
      · -- Proof of all_prime (p :: L)
        rewrite [all_prime_cons]
        show prime p ∧ all_prime L from And.intro p_prime ndpl_L.left
        done
      · -- Proof of nondec (p :: L)
        rewrite [nondec_cons]
        apply And.intro _ ndpl_L.right
        fix q : Nat
        assume q_in_L : q ∈ L
        have h7 : q ∣ prod L := list_elt_dvd_prod q_in_L
        rewrite [h6.right] at h7   --h7 : q ∣ m
        have h8 : m ∣ n := by
          apply Exists.intro p
          rewrite [n_eq_pm]
          ring
          done
        have q_dvd_n : q ∣ n := dvd_trans h7 h8
        have ap_L : all_prime L := ndpl_L.left
        define at ap_L
        have q_prime_factor : prime_factor q n :=
          And.intro (ap_L q q_in_L) q_dvd_n
        show p ≤ q from p_least q q_prime_factor
        done
      done
    · -- Proof of prod (p :: L) = n
      rewrite [prod_cons, h6.right, n_eq_pm]
      rfl
      done
    done
  done

theorem Theorem_7_2_2 {a b c : Nat}
    (h1 : c ∣ a * b) (h2 : rel_prime a c) : c ∣ b := by
  rewrite [←Int.natCast_dvd_natCast]  --Goal : ↑c ∣ ↑b
  define at h1; define at h2; define
  obtain (j : Nat) (h3 : a * b = c * j) from h1
  set s : Int := gcd_c1 a c
  set t : Int := gcd_c2 a c
  have h4 : s * ↑a + t * ↑c = ↑(gcd a c) := gcd_lin_comb c a
  rewrite [h2, Nat.cast_one] at h4  --h4 : s * ↑a + t * ↑c = (1 : Int)
  apply Exists.intro (s * ↑j + t * ↑b)
  show ↑b = ↑c * (s * ↑j + t * ↑b) from
    calc ↑b
      _ = (1 : Int) * ↑b := (one_mul _).symm
      _ = (s * ↑a + t * ↑c) * ↑b := by rw [h4]
      _ = s * (↑a * ↑b) + t * ↑c * ↑b := by ring
      _ = s * (↑c * ↑j) + t * ↑c * ↑b := by
            rw [←Nat.cast_mul a b, h3, Nat.cast_mul c j]
      _ = ↑c * (s * ↑j + t * ↑b) := by ring
  done

lemma le_nonzero_prod_left {a b : Nat} (h : a * b ≠ 0) : a ≤ a * b := by
  have h1 : b ≠ 0 := by
    contradict h with h1
    rewrite [h1]
    ring
    done
  have h2 : 1 ≤ b := Nat.pos_of_ne_zero h1
  show a ≤ a * b from
    calc a
        = a * 1 := (mul_one a).symm
      _ ≤ a * b := by rel [h2]
  done

lemma le_nonzero_prod_right {a b : Nat} (h : a * b ≠ 0) : b ≤ a * b := by
  rewrite [mul_comm]
  rewrite [mul_comm] at h
  show b ≤ b * a from le_nonzero_prod_left h
  done

lemma dvd_prime {a p : Nat}
    (h1 : prime p) (h2 : a ∣ p) : a = 1 ∨ a = p := sorry

lemma rel_prime_of_prime_not_dvd {a p : Nat}
    (h1 : prime p) (h2 : ¬p ∣ a) : rel_prime a p

:= by
  have h3 : gcd a p ∣ a := gcd_dvd_left a p
  have h4 : gcd a p ∣ p := gcd_dvd_right a p
  have h5 : gcd a p = 1 ∨ gcd a p = p := dvd_prime h1 h4
  have h6 : gcd a p ≠ p := by
    contradict h2 with h6
    rewrite [h6] at h3
    show p ∣ a from h3
    done
  disj_syll h5 h6
  show rel_prime a p from h5
  done


/- Copyright 2023 Daniel J. Velleman -/

import HTPILib.Chap7
namespace HTPI

/- Definitions -/
def fnz (n : Nat) : Int := if 2 ∣ n then ↑(n / 2) else -↑((n + 1) / 2)

def fzn (a : Int) : Nat := if a ≥ 0 then 2 * Int.toNat a else 2 * Int.toNat (-a) - 1

def tri (k : Nat) : Nat := k * (k + 1) / 2

def fnnn (p : Nat × Nat) : Nat := tri (p.1 + p.2) + p.1

def num_elts_below (A : Set Nat) (m s : Nat) : Prop :=
  match m with
    | 0 => s = 0
    | n + 1 => (n ∈ A ∧ 1 ≤ s ∧ num_elts_below A n (s - 1)) ∨
                (n ∉ A ∧ num_elts_below A n s)

def enum (A : Set Nat) (s n : Nat) : Prop := n ∈ A ∧ num_elts_below A n s

def unique_val_on_N {U : Type} (R : Rel Nat U) : Prop :=
  ∀ ⦃n : Nat⦄ ⦃x1 x2 : U⦄, R n x1 → R n x2 → x1 = x2

def nat_rel_onto {U : Type} (R : Rel Nat U) (A : Set U) : Prop :=
  ∀ ⦃x : U⦄, x ∈ A → ∃ (n : Nat), R n x

def fcnl_onto_from_nat {U : Type} (R : Rel Nat U) (A : Set U) : Prop :=
  unique_val_on_N R ∧ nat_rel_onto R A

def fcnl_one_one_to_nat {U : Type} (R : Rel U Nat) (A : Set U) : Prop :=
  fcnl_on R A ∧ ∀ ⦃x1 x2 : U⦄ ⦃n : Nat⦄,
    (x1 ∈ A ∧ R x1 n) → (x2 ∈ A ∧ R x2 n) → x1 = x2

def least_rel_to {U : Type} (S : Rel Nat U) (x : U) (n : Nat) : Prop :=
  S n x ∧ ∀ (m : Nat), S m x → n ≤ m

def restrict_to {U V : Type} (S : Rel U V) (A : Set U)
  (x : U) (y : V) : Prop := x ∈ A ∧ S x y

def fqn (q : Rat) : Nat := fnnn (fzn q.num, q.den)

def Set_rp_below (m : Nat) : Set Nat := {n : Nat | rel_prime m n ∧ n < m}

def Set_prod {U V : Type} (A : Set U) (B : Set V) : Set (U × V) :=
  {(a, b) : U × V | a ∈ A ∧ b ∈ B}

notation:75 A:75 " ×ₛ " B:75 => Set_prod A B

def Rel_prod {U V W X : Type} (R : Rel U V) (S : Rel W X)
  (p : U × W) (q : V × X) : Prop := R p.1 q.1 ∧ S p.2 q.2

notation:75 R:75 " ×ᵣ " S:75 => Rel_prod R S

def qr (n a : Nat) : Nat × Nat := (a / n, a % n)

def mod_mod (m n a : Nat) : Nat × Nat := (a % m, a % n)

def enum_union_fam {U : Type}
  (F : Set (Set U)) (f : Set U → Rel Nat U) (R : Rel Nat (Set U))
  (n : Nat) (a : U) : Prop := ∃ (p : Nat × Nat), fnnn p = n ∧
    ∃ A ∈ F, R p.1 A ∧ (f A) p.2 a

def seq {U : Type} (A : Set U) : Set (List U) :=
  {l : List U | ∀ x ∈ l, x ∈ A}

def seq_by_length {U : Type} (A : Set U) (n : Nat) : Set (List U) :=
  {l : List U | l ∈ seq A ∧ l.length = n}

def seq_cons (U : Type) (p : U × (List U)) : List U := p.1 :: p.2

def sbl_set {U : Type} (A : Set U) : Set (Set (List U)) :=
  {S : Set (List U) | ∃ (n : Nat), seq_by_length A n = S}

def rep_common_image
  {U V : Type} (R S : Rel U V) (X0 : Set U) (n : Nat) : Set U :=
  match n with
    | 0 => X0
    | m + 1 => {a : U | ∃ x ∈ rep_common_image R S X0 m,
                          ∃ (y : V), R x y ∧ S a y}

def cum_rep_image {U V : Type} (R S : Rel U V) (X0 : Set U) : Set U :=
  {a : U | ∃ (n : Nat), a ∈ rep_common_image R S X0 n}

def csb_match {U V : Type} (R S : Rel U V) (X0 : Set U)
  (x : U) (y : V) : Prop := x ∈ cum_rep_image R S X0 ∧ R x y ∨
    x ∉ cum_rep_image R S X0 ∧ S x y

/- Section 8.1 -/
#eval [fnz 0, fnz 1, fnz 2, fnz 3, fnz 4, fnz 5, fnz 6]
  --Answer: [0, -1, 1, -2, 2, -3, 3]

#eval [fzn 0, fzn (-1), fzn 1, fzn (-2), fzn 2, fzn (-3), fzn 3]
  --Answer: [0, 1, 2, 3, 4, 5, 6]

lemma fnz_even (k : Nat) : fnz (2 * k) = ↑k := by
  have h1 : 2 ∣ 2 * k := by
    apply Exists.intro k
    rfl
    done
  have h2 : fnz (2 * k) = if 2 ∣ 2 * k then ↑(2 * k / 2)
    else -↑((2 * k + 1) / 2) := by rfl
  rewrite [if_pos h1] at h2  --h2 : fnz (2 * k) = ↑(2 * k / 2)
  have h3 : 0 < 2 := by linarith
  rewrite [Nat.mul_div_cancel_left k h3] at h2
  show fnz (2 * k) = ↑k from h2
  done

lemma fnz_odd (k : Nat) : fnz (2 * k + 1) = -↑(k + 1) := sorry

lemma fzn_nat (k : Nat) : fzn ↑k = 2 * k := by rfl

lemma fzn_neg_succ_nat (k : Nat) : fzn (-↑(k + 1)) = 2 * k + 1 := by rfl

--From exercises of Section 6.1
theorem Exercise_6_1_16a1 : ∀ (n : Nat), nat_even n ∨ nat_odd n := sorry

lemma fzn_fnz : fzn ∘ fnz = id := by
  apply funext        --Goal : ∀ (x : Nat), (fzn ∘ fnz) x = id x
  fix n : Nat
  rewrite [comp_def]  --Goal : fzn (fnz n) = id n
  have h1 : nat_even n ∨ nat_odd n := Exercise_6_1_16a1 n
  by_cases on h1
  · -- Case 1. h1 : nat_even n
    obtain (k : Nat) (h2 : n = 2 * k) from h1
    rewrite [h2, fnz_even, fzn_nat]
    rfl
    done
  · -- Case 2. h1 : nat_odd n
    obtain (k : Nat) (h2 : n = 2 * k + 1) from h1
    rewrite [h2, fnz_odd, fzn_neg_succ_nat]
    rfl
    done
  done

lemma fnz_fzn : fnz ∘ fzn = id  := sorry

lemma fzn_one_one : one_to_one fzn := Theorem_5_3_3_1 fzn fnz fnz_fzn

lemma fzn_onto : onto fzn := Theorem_5_3_3_2 fzn fnz fzn_fnz

lemma fnz_one_one : one_to_one fnz := Theorem_5_3_3_1 fnz fzn fzn_fnz

lemma fnz_onto : onto fnz := Theorem_5_3_3_2 fnz fzn fnz_fzn

lemma fnnn_def (a b : Nat) : fnnn (a, b) = tri (a + b) + a := by rfl

#eval [fnnn (0, 0), fnnn (0, 1), fnnn (1, 0), fnnn (0, 2), fnnn (1, 1)]
  --Answer: [0, 1, 2, 3, 4]

lemma tri_step (k : Nat) : tri (k + 1) = tri k + k + 1 := sorry

lemma tri_incr {j k : Nat} (h1 : j ≤ k) : tri j ≤ tri k := sorry

lemma le_of_fnnn_eq {a1 b1 a2 b2 : Nat}
    (h1 : fnnn (a1, b1) = fnnn (a2, b2)) : a1 + b1 ≤ a2 + b2 := by
  by_contra h2
  have h3 : a2 + b2 + 1 ≤ a1 + b1 := by linarith
  have h4 : fnnn (a2, b2) < fnnn (a1, b1) :=
    calc fnnn (a2, b2)
      _ = tri (a2 + b2) + a2 := by rfl
      _ < tri (a2 + b2) + (a2 + b2) + 1 := by linarith
      _ = tri (a2 + b2 + 1) := (tri_step _).symm
      _ ≤ tri (a1 + b1) := tri_incr h3
      _ ≤ tri (a1 + b1) + a1 := by linarith
      _ = fnnn (a1, b1) := by rfl
  linarith
  done

lemma fnnn_one_one : one_to_one fnnn := by
  fix (a1, b1) : Nat × Nat
  fix (a2, b2) : Nat × Nat
  assume h1 : fnnn (a1, b1) = fnnn (a2, b2)  --Goal : (a1, b1) = (a2, b2)
  have h2 : a1 + b1 ≤ a2 + b2 := le_of_fnnn_eq h1
  have h3 : a2 + b2 ≤ a1 + b1 := le_of_fnnn_eq h1.symm
  have h4 : a1 + b1 = a2 + b2 := by linarith
  rewrite [fnnn_def, fnnn_def, h4] at h1
    --h1 : tri (a2 + b2) + a1 = tri (a2 + b2) + a2
  have h6 : a1 = a2 := Nat.add_left_cancel h1
  rewrite [h6] at h4   --h4 : a2 + b1 = a2 + b2
  have h7 : b1 = b2 := Nat.add_left_cancel h4
  rewrite [h6, h7]
  rfl
  done

:= by
  define  --Goal : ∀ (y : Nat), ∃ (x : Nat × Nat), fnnn x = y
  by_induc
  · -- Base Case
    apply Exists.intro (0, 0)
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : ∃ (x : Nat × Nat), fnnn x = n
    obtain ((a, b) : Nat × Nat) (h1 : fnnn (a, b) = n) from ih
    by_cases h2 : b = 0
    · -- Case 1. h2 : b = 0
      apply Exists.intro (0, a + 1)
      show fnnn (0, a + 1) = n + 1 from
        calc fnnn (0, a + 1)
          _ = tri (0 + (a + 1)) + 0 := by rfl
          _ = tri (a + 1) := by ring
          _ = tri a + a + 1 := tri_step a
          _ = tri (a + 0) + a + 1 := by ring
          _ = fnnn (a, b) + 1 := by rw [h2, fnnn_def]
          _ = n + 1 := by rw [h1]
      done
    · -- Case 2. h2 : b ≠ 0
      obtain (k : Nat) (h3 : b = k + 1) from
        exists_eq_add_one_of_ne_zero h2
      apply Exists.intro (a + 1, k)
      show fnnn (a + 1, k) = n + 1 from
        calc fnnn (a + 1, k)
          _ = tri (a + 1 + k) + (a + 1) := by rfl
          _ = tri (a + (k + 1)) + a + 1 := by ring
          _ = tri (a + b) + a + 1 := by rw [h3]
          _ = fnnn (a, b) + 1 := by rfl
          _ = n + 1 := by rw [h1]
      done
    done
  done


/- Copyright 2023 Daniel J. Velleman -/

import HTPILib.Chap5
namespace HTPI

/- Definitions -/
def invRel {U V : Type} (R : Rel U V) : Rel V U :=
  RelFromExt (inv (extension R))

def rel_within {U V : Type} (R : Rel U V) (A : Set U) (B : Set V) : Prop :=
  ∀ ⦃x : U⦄ ⦃y : V⦄, R x y → x ∈ A ∧ y ∈ B

def fcnl_on {U V : Type} (R : Rel U V) (A : Set U) : Prop :=
  ∀ ⦃x : U⦄, x ∈ A → ∃! (y : V), R x y

def matching {U V : Type} (R : Rel U V) (A : Set U) (B : Set V) : Prop :=
  rel_within R A B ∧ fcnl_on R A ∧ fcnl_on (invRel R) B

def equinum {U V : Type} (A : Set U) (B : Set V) : Prop :=
  ∃ (R : Rel U V), matching R A B

notation:50  A:50 " ∼ " B:50 => equinum A B

def RelWithinFromFunc {U V : Type} (f : U → V) (A : Set U)
  (x : U) (y : V) : Prop := x ∈ A ∧ f x = y

def one_one_on {U V : Type} (f : U → V) (A : Set U) : Prop :=
  ∀ ⦃x1 x2 : U⦄, x1 ∈ A → x2 ∈ A → f x1 = f x2 → x1 = x2

def Univ (U : Type) : Set U := {x : U | True}

def compRel {U V W : Type} (S : Rel V W) (R : Rel U V) : Rel U W :=
  RelFromExt (comp (extension S) (extension R))

def I (n : Nat) : Set Nat := {k : Nat | k < n}

def finite {U : Type} (A : Set U) : Prop :=
  ∃ (n : Nat), I n ∼ A

def denum {U : Type} (A : Set U) : Prop :=
  Univ Nat ∼ A

def ctble {U : Type} (A : Set U) : Prop :=
  finite A ∨ denum A

def numElts {U : Type} (A : Set U) (n : Nat) : Prop := I n ∼ A

def emptyRel (U V : Type) (x : U) (y : V) : Prop := False

def remove_one {U V : Type} (R : Rel U V) (u : U) (v : V)
  (x : U) (y : V) : Prop := x ≠ u ∧ y ≠ v ∧ (R x y ∨ (R x v ∧ R u y))

def one_match {U V : Type} (a : U) (b : V)
  (x : U) (y : V) : Prop := x = a ∧ y = b

/- Section 8.1 -/
lemma invRel_def {U V : Type} (R : Rel U V) (u : U) (v : V) :
    invRel R v u ↔ R u v := by rfl

theorem equinum_image {U V : Type} {A : Set U} {B : Set V} {f : U → V}
    (h1 : one_one_on f A) (h2 : image f A = B) : A ∼ B := by
  rewrite [←h2]
  define   --Goal : ∃ (R : Rel U V), matching R A (image f A)
  set R : Rel U V := RelWithinFromFunc f A
  apply Exists.intro R
  define   --Goal : rel_within R A (image f A) ∧
           --fcnl_on R A ∧ fcnl_on (invRel R) (image f A)
  apply And.intro
  · -- Proof of rel_within
    define --Goal : ∀ ⦃x : U⦄ ⦃y : V⦄, R x y → x ∈ A ∧ y ∈ image f A
    fix x : U; fix y : V
    assume h3 : R x y  --Goal : x ∈ A ∧ y ∈ image f A
    define at h3       --h3 : x ∈ A ∧ f x = y
    apply And.intro h3.left
    define
    show ∃ x ∈ A, f x = y from Exists.intro x h3
    done
  · -- Proofs of fcnl_ons
    apply And.intro
    · -- Proof of fcnl_on R A
      define  --Goal : ∀ ⦃x : U⦄, x ∈ A → ∃! (y : V), R x y
      fix x : U
      assume h3 : x ∈ A
      exists_unique
      · -- Existence
        apply Exists.intro (f x)
        define  --Goal : x ∈ A ∧ f x = f x
        apply And.intro h3
        rfl
        done
      · -- Uniqueness
        fix y1 : V; fix y2 : V
        assume h4 : R x y1
        assume h5 : R x y2   --Goal : y1 = y2
        define at h4; define at h5
          --h4 : x ∈ A ∧ f x = y1;  h5 : x ∈ A ∧ f x = y2
        rewrite [h4.right] at h5
        show y1 = y2 from h5.right
        done
      done
    · -- Proof of fcnl_on (invRel R) (image f A)
      define  --Goal : ∀ ⦃x : V⦄, x ∈ image f A → ∃! (y : U), invRel R x y
      fix y : V
      assume h3 : y ∈ image f A
      obtain (x : U) (h4 : x ∈ A ∧ f x = y) from h3
      exists_unique
      · -- Existence
        apply Exists.intro x
        define
        show x ∈ A ∧ f x = y from h4
        done
      · -- Uniqueness
        fix x1 : U; fix x2 : U
        assume h5 : invRel R y x1
        assume h6 : invRel R y x2
        define at h5; define at h6
          --h5 : x1 ∈ A ∧ f x1 = y;  h6 : x2 ∈ A ∧ f x2 = y
        rewrite [←h6.right] at h5
        show x1 = x2 from h1 h5.left h6.left h5.right
        done
      done
    done
  done

lemma id_one_one_on {U : Type} (A : Set U) : one_one_on id A := by
  define
  fix x1 : U; fix x2 : U
  assume h1 : x1 ∈ A
  assume h2 : x2 ∈ A
  assume h3 : id x1 = id x2
  show x1 = x2 from h3
  done

lemma image_id {U : Type} (A : Set U) : image id A = A := by
  apply Set.ext
  fix x : U
  apply Iff.intro
  · -- (→)
    assume h1 : x ∈ image id A
    obtain (y : U) (h2 : y ∈ A ∧ id y = x) from h1
    rewrite [←h2.right]
    show id y ∈ A from h2.left
    done
  · -- (←)
    assume h1 : x ∈ A
    apply Exists.intro x  --Goal : x ∈ A ∧ id x = x
    apply And.intro h1
    rfl
    done
  done

theorem Theorem_8_1_3_1 {U : Type} (A : Set U) : A ∼ A :=
  equinum_image (id_one_one_on A) (image_id A)

lemma inv_inv {U V : Type} (R : Rel U V) : invRel (invRel R) = R := by rfl

lemma inv_match {U V : Type} {R : Rel U V} {A : Set U} {B : Set V}
    (h : matching R A B) : matching (invRel R) B A := by
  define       --Goal : rel_within (invRel R) B A ∧
               --fcnl_on (invRel R) B ∧ fcnl_on (invRel (invRel R)) A
  define at h  --h : rel_within R A B ∧ fcnl_on R A ∧ fcnl_on (invRel R) B
  apply And.intro
  · -- Proof that rel_within (invRel R) B A
    define     --Goal : ∀ ⦃x : V⦄ ⦃y : U⦄, invRel R x y → x ∈ B ∧ y ∈ A
    fix y : V; fix x : U
    assume h1 : invRel R y x
    define at h1  --h1 : R x y
    have h2 : x ∈ A ∧ y ∈ B := h.left h1
    show y ∈ B ∧ x ∈ A from And.intro h2.right h2.left
    done
  · -- proof that fcnl_on (inv R) B ∧ fcnl_on (inv (inv R)) A
    rewrite [inv_inv]
    show fcnl_on (invRel R) B ∧ fcnl_on R A from
      And.intro h.right.right h.right.left
    done
  done

theorem Theorem_8_1_3_2 {U V : Type} {A : Set U} {B : Set V}
    (h : A ∼ B) : B ∼ A := by
  obtain (R : Rel U V) (h1 : matching R A B) from h
  apply Exists.intro (invRel R)
  show matching (invRel R) B A from inv_match h1
  done

lemma fcnl_exists {U V : Type} {R : Rel U V} {A : Set U} {x : U}
    (h1 : fcnl_on R A) (h2 : x ∈ A) : ∃ (y : V), R x y := by
  define at h1
  obtain (y : V) (h3 : R x y)
    (h4 : ∀ (y_1 y_2 : V), R x y_1 → R x y_2 → y_1 = y_2) from h1 h2
  show ∃ (y : V), R x y from Exists.intro y h3
  done

lemma fcnl_unique {U V : Type}
    {R : Rel U V} {A : Set U} {x : U} {y1 y2 : V} (h1 : fcnl_on R A)
    (h2 : x ∈ A) (h3 : R x y1) (h4 : R x y2) : y1 = y2 := by
  define at h1
  obtain (z : V) (h5 : R x z)
    (h6 : ∀ (y_1 y_2 : V), R x y_1 → R x y_2 → y_1 = y_2) from h1 h2
  show y1 = y2 from h6 y1 y2 h3 h4
  done

lemma compRel_def {U V W : Type}
    (S : Rel V W) (R : Rel U V) (u : U) (w : W) :
    compRel S R u w ↔ ∃ (x : V), R u x ∧ S x w := by rfl

lemma inv_comp {U V W : Type} (R : Rel U V) (S : Rel V W) :
    invRel (compRel S R) = compRel (invRel R) (invRel S) :=
  calc invRel (compRel S R)
    _ = RelFromExt (inv (comp (extension S) (extension R))) := by rfl
    _ = RelFromExt (comp (inv (extension R)) (inv (extension S))) := by
          rw [Theorem_4_2_5_5]
    _ = compRel (invRel R) (invRel S) := by rfl

lemma comp_fcnl {U V W : Type} {R : Rel U V} {S : Rel V W}
    {A : Set U} {B : Set V} {C : Set W} (h1 : matching R A B)
    (h2 : matching S B C) : fcnl_on (compRel S R) A := by
  define; define at h1; define at h2
  fix a : U
  assume h3 : a ∈ A
  obtain (b : V) (h4 : R a b) from fcnl_exists h1.right.left h3
  have h5 : a ∈ A ∧ b ∈ B := h1.left h4
  obtain (c : W) (h6 : S b c) from fcnl_exists h2.right.left h5.right
  exists_unique
  · -- Existence
    apply Exists.intro c
    rewrite [compRel_def]
    show ∃ (x : V), R a x ∧ S x c from Exists.intro b (And.intro h4 h6)
    done
  · -- Uniqueness
    fix c1 : W; fix c2 : W
    assume h7 : compRel S R a c1
    assume h8 : compRel S R a c2    --Goal : c1 = c2
    rewrite [compRel_def] at h7
    rewrite [compRel_def] at h8
    obtain (b1 : V) (h9 : R a b1 ∧ S b1 c1) from h7
    obtain (b2 : V) (h10 : R a b2 ∧ S b2 c2) from h8
    have h11 : b1 = b := fcnl_unique h1.right.left h3 h9.left h4
    have h12 : b2 = b := fcnl_unique h1.right.left h3 h10.left h4
    rewrite [h11] at h9
    rewrite [h12] at h10
    show c1 = c2 from
      fcnl_unique h2.right.left h5.right h9.right h10.right
    done
  done

lemma comp_match {U V W : Type} {R : Rel U V} {S : Rel V W}
    {A : Set U} {B : Set V} {C : Set W} (h1 : matching R A B)
    (h2 : matching S B C) : matching (compRel S R) A C := by
  define
  apply And.intro
  · -- Proof of rel_within (compRel S R) A C
    define
    fix a : U; fix c : W
    assume h3 : compRel S R a c
    rewrite [compRel_def] at h3
    obtain (b : V) (h4 : R a b ∧ S b c) from h3
    have h5 : a ∈ A ∧ b ∈ B := h1.left h4.left
    have h6 : b ∈ B ∧ c ∈ C := h2.left h4.right
    show a ∈ A ∧ c ∈ C from And.intro h5.left h6.right
    done
  · -- Proof of fcnl_on statements
    apply And.intro
    · -- Proof of fcnl_on (compRel S R) A
      show fcnl_on (compRel S R) A from comp_fcnl h1 h2
      done
    · -- Proof of fcnl_on (invRel (compRel S R)) Z
      rewrite [inv_comp]
      have h3 : matching (invRel R) B A := inv_match h1
      have h4 : matching (invRel S) C B := inv_match h2
      show fcnl_on (compRel (invRel R) (invRel S)) C from comp_fcnl h4 h3
      done
    done
  done

theorem Theorem_8_1_3_3 {U V W : Type} {A : Set U} {B : Set V} {C : Set W}
    (h1 : A ∼ B) (h2 : B ∼ C) : A ∼ C := by
  obtain (R : Rel U V) (h3 : matching R A B) from h1
  obtain (S : Rel V W) (h4 : matching S B C) from h2
  apply Exists.intro (compRel S R)
  show matching (compRel S R) A C from comp_match h3 h4
  done

lemma I_def (k n : Nat) : k ∈ I n ↔ k < n := by rfl

lemma denum_def {U : Type} (A : Set U) : denum A ↔ Univ Nat ∼ A := by rfl

/- Section 8.1½ -/
lemma numElts_def {U : Type} (A : Set U) (n : Nat) :
    numElts A n ↔ I n ∼ A := by rfl

lemma finite_def {U : Type} (A : Set U) :
    finite A ↔ ∃ (n : Nat), numElts A n := by rfl

lemma fcnl_on_empty {U V : Type}
    (R : Rel U V) {A : Set U} (h1 : empty A) : fcnl_on R A := by
  define
  fix a : U
  assume h2 : a ∈ A      --Goal : ∃! (y : V), R a y
  contradict h1 with h3  --Goal : ∃ (x : U), x ∈ A
  show ∃ (x : U), x ∈ A from Exists.intro a h2
  done

lemma empty_match {U V : Type} {A : Set U} {B : Set V}
    (h1 : empty A) (h2 : empty B) : matching (emptyRel U V) A B := by
  define
  apply And.intro
  · -- Proof of rel_within
    define
    fix a : U; fix b : V
    assume h3 : emptyRel U V a b   --Goal : a ∈ A ∧ b ∈ B
    by_contra h4                   --Goal : False
    define at h3
    show False from h3
    done
  · -- Proof of fcnl_ons
    apply And.intro
    · -- Proof of fcnl_on emptyRel
      show fcnl_on (emptyRel U V) A from fcnl_on_empty (emptyRel U V) h1
      done
    · -- Proof of fcnl_on (invRel emptyRel)
      show fcnl_on (invRel (emptyRel U V)) B from
        fcnl_on_empty (invRel (emptyRel U V)) h2
      done
  done

lemma I_0_empty : empty (I 0) := by
  define
  by_contra h1    --h1 : ∃ (x : Nat), x ∈ I 0
  obtain (x : Nat) (h2 : x ∈ I 0) from h1
  define at h2    --h2 : x < 0
  linarith
  done

theorem zero_elts_iff_empty {U : Type} (A : Set U) :
    numElts A 0 ↔ empty A := by
  apply Iff.intro
  · -- (→)
    assume h1 : numElts A 0
    define
    by_contra h2         --h2 : ∃ (x : U), x ∈ A
    obtain (x : U) (h3 : x ∈ A) from h2
    define at h1
    obtain (R : Rel Nat U) (h4 : matching R (I 0) A) from h1
    define at h4
      --h4 : rel_within R (I 0) A ∧ fcnl_on R (I 0) ∧ fcnl_on (invRel R) A
    obtain (j : Nat) (h5 : invRel R x j) from
      fcnl_exists h4.right.right h3
    define at h5         --h5 : R j x
    have h6 : j ∈ I 0 ∧ x ∈ A := h4.left h5
    contradict I_0_empty --Goal : ∃ (x : Nat), x ∈ I 0
    show ∃ (x : Nat), x ∈ I 0 from Exists.intro j h6.left
    done
  · -- (←)
    assume h1 : empty A
    show ∃ (R : Rel Nat U), matching R (I 0) A from
      Exists.intro (emptyRel Nat U) (empty_match I_0_empty h1)
    done
  done

theorem nonempty_of_pos_numElts {U : Type} {A : Set U} {n : Nat}
    (h1 : numElts A n) (h2 : n > 0) : ∃ (x : U), x ∈ A := by
  define at h1
  obtain (R : Rel Nat U) (h3 : matching R (I n) A) from h1
  define at h3
  have h4 : 0 ∈ I n := h2
  obtain (x : U) (h5 : R 0 x) from fcnl_exists h3.right.left h4
  have h6 : 0 ∈ I n ∧ x ∈ A := h3.left h5
  show ∃ (x : U), x ∈ A from Exists.intro x h6.right
  done

theorem relext {U V : Type} {R S : Rel U V}
    (h : ∀ (u : U) (v : V), R u v ↔ S u v) : R = S := by
  have h2 : extension R = extension S := by
    apply Set.ext
    fix (u, v) : U × V --Goal : (u, v) ∈ extension R ↔ (u, v) ∈ extension S
    rewrite [ext_def, ext_def]  --Goal : R u v ↔ S u v
    show R u v ↔ S u v from h u v
    done
  show R = S from
    calc R
      _ = RelFromExt (extension R) := by rfl
      _ = RelFromExt (extension S) := by rw [h2]
      _ = S := by rfl
  done

lemma remove_one_def {U V : Type} (R : Rel U V) (u x : U) (v y : V) :
    remove_one R u v x y ↔
      x ≠ u ∧ y ≠ v ∧ (R x y ∨ (R x v ∧ R u y)) := by rfl

lemma remove_one_rel_within {U V : Type}
    {R : Rel U V} {A : Set U} {B : Set V} {x u : U} {y v : V}
    (h1 : matching R A B) (h2 : remove_one R u v x y) :
    x ∈ A \ {u} ∧ y ∈ B \ {v} := by
  define at h1  --h1 : rel_within R A B ∧ fcnl_on R A ∧ fcnl_on (invRel R) B
  define at h2  --h2 : x ≠ u ∧ y ≠ v ∧ (R x y ∨ R x v ∧ R u y)
  have h3 : x ∈ A ∧ y ∈ B := by
    by_cases on h2.right.right with h3
    · -- Case 1. h3 : R x y
      show x ∈ A ∧ y ∈ B from h1.left h3
      done
    · -- Case 2. h3 : R x v ∧ R u y
      have h4 : x ∈ A ∧ v ∈ B := h1.left h3.left
      have h5 : u ∈ A ∧ y ∈ B := h1.left h3.right
      show x ∈ A ∧ y ∈ B from And.intro h4.left h5.right
      done
    done
  show x ∈ A \ {u} ∧ y ∈ B \ {v} from
    And.intro (And.intro h3.left h2.left) (And.intro h3.right h2.right.left)
  done

lemma remove_one_inv {U V : Type} (R : Rel U V) (u : U) (v : V) :
    invRel (remove_one R u v) = remove_one (invRel R) v u := by
  apply relext
  fix y : V; fix x : U
    --Goal : invRel (remove_one R u v) y x ↔ remove_one (invRel R) v u y x
  rewrite [invRel_def, remove_one_def, remove_one_def]
  rewrite [invRel_def, invRel_def, invRel_def]
  rewrite [←and_assoc, ←and_assoc]
    --Goal : (x ≠ u ∧ y ≠ v) ∧ (R x y ∨ R x v ∧ R u y) ↔
    --       (y ≠ v ∧ x ≠ u) ∧ (R x y ∨ R u y ∧ R x v)
  have h1 : x ≠ u ∧ y ≠ v ↔ y ≠ v ∧ x ≠ u := and_comm
  have h2 : R x v ∧ R u y ↔ R u y ∧ R x v := and_comm
  rewrite [h1, h2]
  rfl
  done

lemma remove_one_iff {U V : Type}
    {A : Set U} {B : Set V} {R : Rel U V} (h1 : matching R A B)
    {u : U} (h2 : u ∈ A) (v : V) {x : U} (h3 : x ∈ A \ {u}) :
    ∃ w ∈ A, ∀ (y : V), remove_one R u v x y ↔ R w y := sorry

theorem remove_one_fcnl {U V : Type}
    {R : Rel U V} {A : Set U} {B : Set V} {u : U}
    (h1 : matching R A B) (h2 : u ∈ A) (v : V) :
    fcnl_on (remove_one R u v) (A \ {u}) := by
  define
  fix x : U
  assume h3 : x ∈ A \ {u}  --Goal : ∃! (y : V), remove_one R u v x y
  obtain (w : U) (h4 : w ∈ A ∧ ∀ (y : V),
    remove_one R u v x y ↔ R w y) from remove_one_iff h1 h2 v h3
  define at h1
  exists_unique
  · -- Existence
    obtain (y : V) (h5 : R w y) from fcnl_exists h1.right.left h4.left
    apply Exists.intro y
    rewrite [h4.right]
    show R w y from h5
    done
  · -- Uniqueness
    fix y1 : V; fix y2 : V
    rewrite [h4.right, h4.right]
    assume h5 : R w y1
    assume h6 : R w y2
    show y1 = y2 from fcnl_unique h1.right.left h4.left h5 h6
    done
  done

theorem remove_one_match {U V : Type}
    {R : Rel U V} {A : Set U} {B : Set V} {u : U} {v : V}
    (h1 : matching R A B) (h2 : u ∈ A) (h3 : v ∈ B) :
    matching (remove_one R u v) (A \ {u}) (B \ {v}) := by
  define
  apply And.intro
  · -- Proof of rel_within
    define
    fix x : U; fix y : V
    assume h4 : remove_one R u v x y
    show x ∈ A \ {u} ∧ y ∈ B \ {v} from remove_one_rel_within h1 h4
    done
  · -- Proof of fcnl_ons
    apply And.intro (remove_one_fcnl h1 h2 v)
    rewrite [remove_one_inv]
    show fcnl_on (remove_one (invRel R) v u) (B \ {v}) from
      remove_one_fcnl (inv_match h1) h3 u
  done

theorem remove_one_equinum {U V : Type}
    {A : Set U} {B : Set V} {u : U} {v : V}
    (h1 : A ∼ B) (h2 : u ∈ A) (h3 : v ∈ B) : A \ {u} ∼ B \ {v} := by
  define
  obtain (R : Rel U V) (h4 : matching R A B) from h1
  apply Exists.intro (remove_one R u v)
  show matching (remove_one R u v) (A \ {u}) (B \ {v}) from
    remove_one_match h4 h2 h3
  done

lemma I_max (n : Nat) : n ∈ I (n + 1) := by
  define
  linarith
  done

lemma I_diff (n : Nat) : I (n + 1) \ {n} = I n := by
  apply Set.ext
  fix x : Nat
  apply Iff.intro
  · -- (→)
    assume h1 : x ∈ I (n + 1) \ {n}
    define                --Goal : x < n
    define at h1
    have h2 : x ∈ I (n + 1) := h1.left
    have h3 : ¬x ∈ {n} := h1.right
    define at h2          --h2 : x < n + 1
    define at h3          --h3 : ¬x = n
    have h4 : x ≤ n := Nat.le_of_lt_succ h2
    show x < n from Nat.lt_of_le_of_ne h4 h3
    done
  · -- (←)
    assume h1 : x ∈ I n
    define at h1          --h1 : x < n
    define                --Goal : x ∈ I (n + 1) ∧ ¬x ∈ {n}
    apply And.intro
    · -- Proof that x ∈ I (n + 1)
      define              --Goal : x < n + 1
      linarith
      done
    · -- Proof that x ∉ {n}
      by_contra h2        --h2 : x ∈ {n}
      define at h2        --h2 : x = n
      linarith
      done
    done
  done

theorem remove_one_numElts {U : Type} {A : Set U} {n : Nat} {a : U}
    (h1 : numElts A (n + 1)) (h2 : a ∈ A) : numElts (A \ {a}) n := by
  have h3 : n ∈ I (n + 1) := I_max n
  rewrite [numElts_def] at h1     --h1 : I (n + 1) ∼ X
  have h4 : I (n + 1) \ {n} ∼ A \ {a} := remove_one_equinum h1 h3 h2
  rewrite [I_diff] at h4          --h4 : I n ∼ A \ {a}
  show numElts (A \ {a}) n from h4
  done

lemma one_match_def {U V : Type} (a x : U) (b y : V) :
    one_match a b x y ↔ x = a ∧ y = b := by rfl

lemma one_match_match {U V : Type} (a : U) (b : V) :
    matching (one_match a b) {a} {b} := sorry

lemma I_1_singleton : I 1 = {0} := by
  apply Set.ext
  fix x : Nat
  apply Iff.intro
  · -- (→)
    assume h1 : x ∈ I 1
    rewrite [I_def] at h1  --h1 : x < 1
    define                 --Goal : x = 0
    linarith
    done
  · -- (←)
    assume h1 : x ∈ {0}
    define at h1           --h1 : x = 0
    rewrite [h1, I_def]    --Goal : 0 < 1
    linarith
    done
  done

lemma singleton_of_diff_empty {U : Type} {A : Set U} {a : U}
    (h1 : a ∈ A) (h2 : empty (A \ {a})) : A = {a} := by
  apply Set.ext
  fix x : U
  apply Iff.intro
  · -- (→)
    assume h3 : x ∈ A
    contradict h2 with h4
    apply Exists.intro x
    define
    show x ∈ A ∧ ¬x ∈ {a} from And.intro h3 h4
    done
  · -- (←)
    assume h3 : x ∈ {a}
    define at h3
    rewrite [h3]
    show a ∈ A from h1
    done
  done

lemma singleton_one_elt {U : Type} (u : U) : numElts {u} 1

:= by
  define
  rewrite [I_1_singleton]
  show ∃ (R : Rel Nat U), matching R {0} {u} from
    Exists.intro (one_match 0 u) (one_match_match 0 u)
  done