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

! This file was ported from Lean 3 source module data.pnat.xgcd
! leanprover-community/mathlib commit 6afc9b06856ad973f6a2619e3e8a0a8d537a58f2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Tactic.Ring
import Mathlib.Data.PNat.Prime

/-!
# Euclidean algorithm for ℕ

This file sets up a version of the Euclidean algorithm that only works with natural numbers.
Given `0 < a, b`, it computes the unique `(w, x, y, z, d)` such that the following identities hold:
* `a = (w + x) d`
* `b = (y + z) d`
* `w * z = x * y + 1`
`d` is then the gcd of `a` and `b`, and `a' := a / d = w + x` and `b' := b / d = y + z` are coprime.

This story is closely related to the structure of SL₂(ℕ) (as a free monoid on two generators) and
the theory of continued fractions.

## Main declarations

* `XgcdType`: Helper type in defining the gcd. Encapsulates `(wp, x, y, zp, ap, bp)`. where `wp`
  `zp`, `ap`, `bp` are the variables getting changed through the algorithm.
* `IsSpecial`: States `wp * zp = x * y + 1`
* `IsReduced`: States `ap = a ∧ bp = b`

## Notes

See `Nat.Xgcd` for a very similar algorithm allowing values in `ℤ`.
-/

open Nat

namespace PNat

/-- A term of `XgcdType` is a system of six naturals.  They should
 be thought of as representing the matrix
 [[w, x], [y, z]] = [[wp + 1, x], [y, zp + 1]]
 together with the vector [a, b] = [ap + 1, bp + 1].
-/
structure XgcdType where
  /-- `wp` is a variable which changes through the algorithm. -/
  wp : ℕ
  /-- `x` satisfies `a / d = w + x` at the final step. -/
  x : ℕ
  /-- `y` satisfies `b / d = z + y` at the final step. -/
  y : ℕ
  /-- `zp` is a variable which changes through the algorithm. -/
  zp : ℕ
  /-- `ap` is a variable which changes through the algorithm. -/
  ap : ℕ
  /-- `bp` is a variable which changes through the algorithm. -/
  bp : ℕ
  deriving Inhabited
#align pnat.xgcd_type PNat.XgcdType

namespace XgcdType

variable (u : XgcdType)

instance : SizeOf XgcdType :=
  ⟨fun u => u.bp⟩

/-- The `Repr` instance converts terms to strings in a way that
 reflects the matrix/vector interpretation as above. -/
instance : Repr XgcdType where
  reprPrec
  | g, _ => s!"[[[ {repr (g.wp + 1)}, {(repr g.x)} ], [" ++
            s!"{repr g.y}, {repr (g.zp + 1)}]], [" ++
            s!"{repr (g.ap + 1)}, {repr (g.bp + 1)}]]"

/-- Another `mk` using ℕ and ℕ+ -/
def mk' (w : ℕ+) (x : ℕ) (y : ℕ) (z : ℕ+) (a : ℕ+) (b : ℕ+) : XgcdType :=
  mk w.val.pred x y z.val.pred a.val.pred b.val.pred
#align pnat.xgcd_type.mk' PNat.XgcdType.mk'

/-- `w = wp + 1` -/
def w : ℕ+ :=
  succPNat u.wp
#align pnat.xgcd_type.w PNat.XgcdType.w

/-- `z = zp + 1` -/
def z : ℕ+ :=
  succPNat u.zp
#align pnat.xgcd_type.z PNat.XgcdType.z

/-- `a = ap + 1` -/
def a : ℕ+ :=
  succPNat u.ap
#align pnat.xgcd_type.a PNat.XgcdType.a

/-- `b = bp + 1` -/
def b : ℕ+ :=
  succPNat u.bp
#align pnat.xgcd_type.b PNat.XgcdType.b

/-- `r = a % b`: remainder -/
def r : ℕ :=
  (u.ap + 1) % (u.bp + 1)
#align pnat.xgcd_type.r PNat.XgcdType.r

/-- `q = ap / bp`: quotient -/
def q : ℕ :=
  (u.ap + 1) / (u.bp + 1)
#align pnat.xgcd_type.q PNat.XgcdType.q

/-- `qp = q - 1` -/
def qp : ℕ :=
  u.q - 1
#align pnat.xgcd_type.qp PNat.XgcdType.qp

/-- The map `v` gives the product of the matrix
 [[w, x], [y, z]] = [[wp + 1, x], [y, zp + 1]]
 and the vector [a, b] = [ap + 1, bp + 1].  The map
 `vp` gives [sp, tp] such that v = [sp + 1, tp + 1].
-/
def vp : ℕ × ℕ :=
  ⟨u.wp + u.x + u.ap + u.wp * u.ap + u.x * u.bp, u.y + u.zp + u.bp + u.y * u.ap + u.zp * u.bp⟩
#align pnat.xgcd_type.vp PNat.XgcdType.vp

/-- `v = [sp + 1, tp + 1]`, check `vp` -/
def v : ℕ × ℕ :=
  ⟨u.w * u.a + u.x * u.b, u.y * u.a + u.z * u.b⟩
#align pnat.xgcd_type.v PNat.XgcdType.v

/-- `succ₂ [t.1, t.2] = [t.1.succ, t.2.succ]` -/
def succ₂ (t : ℕ × ℕ) : ℕ × ℕ :=
  ⟨t.1.succ, t.2.succ⟩
#align pnat.xgcd_type.succ₂ PNat.XgcdType.succ₂

theorem v_eq_succ_vp : u.v = succ₂ u.vp := by
  ext <;> dsimp [v, vp, w, z, a, b, succ₂] <;> (repeat' rw [Nat.succ_eq_add_one]; ring_nf)
#align pnat.xgcd_type.v_eq_succ_vp PNat.XgcdType.v_eq_succ_vp

/-- `IsSpecial` holds if the matrix has determinant one. -/
def IsSpecial : Prop :=
  u.wp + u.zp + u.wp * u.zp = u.x * u.y
#align pnat.xgcd_type.is_special PNat.XgcdType.IsSpecial

/-- `IsSpecial'` is an alternative of `IsSpecial`. -/
def IsSpecial' : Prop :=
  u.w * u.z = succPNat (u.x * u.y)
#align pnat.xgcd_type.is_special' PNat.XgcdType.IsSpecial'

theorem isSpecial_iff : u.IsSpecial ↔ u.IsSpecial' := by
  dsimp [IsSpecial, IsSpecial']
  let ⟨wp, x, y, zp, ap, bp⟩ := u
  constructor <;> intro h <;> simp [w, z, succPNat] at * <;>
    simp only [← coe_inj, mul_coe, mk_coe] at *
  . simp_all [← h, Nat.mul, Nat.succ_eq_add_one]; ring
  . simp [Nat.succ_eq_add_one, Nat.mul_add, Nat.add_mul, ← Nat.add_assoc] at h; rw [← h]; ring
  -- Porting note: Old code has been removed as it was much more longer.
#align pnat.xgcd_type.is_special_iff PNat.XgcdType.isSpecial_iff

/-- `IsReduced` holds if the two entries in the vector are the
 same.  The reduction algorithm will produce a system with this
 property, whose product vector is the same as for the original
 system. -/
def IsReduced : Prop :=
  u.ap = u.bp
#align pnat.xgcd_type.is_reduced PNat.XgcdType.IsReduced

/-- `IsReduced'` is an alternative of `IsReduced`. -/
def IsReduced' : Prop :=
  u.a = u.b
#align pnat.xgcd_type.is_reduced' PNat.XgcdType.IsReduced'

theorem isReduced_iff : u.IsReduced ↔ u.IsReduced' :=
  succPNat_inj.symm
#align pnat.xgcd_type.is_reduced_iff PNat.XgcdType.isReduced_iff

/-- `flip` flips the placement of variables during the algorithm. -/
def flip : XgcdType where
  wp := u.zp
  x := u.y
  y := u.x
  zp := u.wp
  ap := u.bp
  bp := u.ap
#align pnat.xgcd_type.flip PNat.XgcdType.flip

@[simp]
theorem flip_w : (flip u).w = u.z :=
  rfl
#align pnat.xgcd_type.flip_w PNat.XgcdType.flip_w

@[simp]
theorem flip_x : (flip u).x = u.y :=
  rfl
#align pnat.xgcd_type.flip_x PNat.XgcdType.flip_x

@[simp]
theorem flip_y : (flip u).y = u.x :=
  rfl
#align pnat.xgcd_type.flip_y PNat.XgcdType.flip_y

@[simp]
theorem flip_z : (flip u).z = u.w :=
  rfl
#align pnat.xgcd_type.flip_z PNat.XgcdType.flip_z

@[simp]
theorem flip_a : (flip u).a = u.b :=
  rfl
#align pnat.xgcd_type.flip_a PNat.XgcdType.flip_a

@[simp]
theorem flip_b : (flip u).b = u.a :=
  rfl
#align pnat.xgcd_type.flip_b PNat.XgcdType.flip_b

theorem flip_isReduced : (flip u).IsReduced ↔ u.IsReduced := by
  dsimp [IsReduced, flip]
  constructor <;> intro h <;> exact h.symm
#align pnat.xgcd_type.flip_is_reduced PNat.XgcdType.flip_isReduced

theorem flip_isSpecial : (flip u).IsSpecial ↔ u.IsSpecial := by
  dsimp [IsSpecial, flip]
  rw [mul_comm u.x, mul_comm u.zp, add_comm u.zp]
#align pnat.xgcd_type.flip_is_special PNat.XgcdType.flip_isSpecial

theorem flip_v : (flip u).v = u.v.swap := by
  dsimp [v]
  ext
  · simp only
    ring
  · simp only
    ring
#align pnat.xgcd_type.flip_v PNat.XgcdType.flip_v

/-- Properties of division with remainder for a / b.  -/
theorem rq_eq : u.r + (u.bp + 1) * u.q = u.ap + 1 :=
  Nat.mod_add_div (u.ap + 1) (u.bp + 1)
#align pnat.xgcd_type.rq_eq PNat.XgcdType.rq_eq

theorem qp_eq (hr : u.r = 0) : u.q = u.qp + 1 := by
  by_cases hq : u.q = 0
  · let h := u.rq_eq
    rw [hr, hq, mul_zero, add_zero] at h
    cases h
  · exact (Nat.succ_pred_eq_of_pos (Nat.pos_of_ne_zero hq)).symm
#align pnat.xgcd_type.qp_eq PNat.XgcdType.qp_eq

/-- The following function provides the starting point for
 our algorithm.  We will apply an iterative reduction process
 to it, which will produce a system satisfying IsReduced.
 The gcd can be read off from this final system.
-/
def start (a b : ℕ+) : XgcdType :=
  ⟨0, 0, 0, 0, a - 1, b - 1⟩
#align pnat.xgcd_type.start PNat.XgcdType.start

theorem start_isSpecial (a b : ℕ+) : (start a b).IsSpecial := by
  dsimp [start, IsSpecial]
#align pnat.xgcd_type.start_is_special PNat.XgcdType.start_isSpecial

theorem start_v (a b : ℕ+) : (start a b).v = ⟨a, b⟩ := by
  dsimp [start, v, XgcdType.a, XgcdType.b, w, z]
  have : succ 0 = 1 := rfl
  rw [this, one_mul, one_mul, zero_mul, zero_mul, zero_add, add_zero]
  rw [← Nat.pred_eq_sub_one, ← Nat.pred_eq_sub_one]
  rw [Nat.succ_pred_eq_of_pos a.pos, Nat.succ_pred_eq_of_pos b.pos]
#align pnat.xgcd_type.start_v PNat.XgcdType.start_v

/-- `finish` happens when the reducing process ends. -/
def finish : XgcdType :=
  XgcdType.mk u.wp ((u.wp + 1) * u.qp + u.x) u.y (u.y * u.qp + u.zp) u.bp u.bp
#align pnat.xgcd_type.finish PNat.XgcdType.finish

theorem finish_isReduced : u.finish.IsReduced := by
  dsimp [IsReduced]
  rfl
#align pnat.xgcd_type.finish_is_reduced PNat.XgcdType.finish_isReduced

theorem finish_isSpecial (hs : u.IsSpecial) : u.finish.IsSpecial := by
  dsimp [IsSpecial, finish] at hs⊢
  rw [add_mul _ _ u.y, add_comm _ (u.x * u.y), ← hs]
  ring
#align pnat.xgcd_type.finish_is_special PNat.XgcdType.finish_isSpecial

theorem finish_v (hr : u.r = 0) : u.finish.v = u.v := by
  let ha : u.r + u.b * u.q = u.a := u.rq_eq
  rw [hr, zero_add] at ha
  ext
  · change (u.wp + 1) * u.b + ((u.wp + 1) * u.qp + u.x) * u.b = u.w * u.a + u.x * u.b
    have : u.wp + 1 = u.w := rfl
    rw [this, ← ha, u.qp_eq hr]
    ring_nf
  · change u.y * u.b + (u.y * u.qp + u.z) * u.b = u.y * u.a + u.z * u.b
    rw [← ha, u.qp_eq hr]
    ring
#align pnat.xgcd_type.finish_v PNat.XgcdType.finish_v

/-- This is the main reduction step, which is used when u.r ≠ 0, or
 equivalently b does not divide a. -/
def step : XgcdType :=
  XgcdType.mk (u.y * u.q + u.zp) u.y ((u.wp + 1) * u.q + u.x) u.wp u.bp (u.r - 1)
#align pnat.xgcd_type.step PNat.XgcdType.step

/-- We will apply the above step recursively.  The following result
 is used to ensure that the process terminates. -/
theorem step_wf (hr : u.r ≠ 0) : SizeOf.sizeOf u.step < SizeOf.sizeOf u := by
  change u.r - 1 < u.bp
  have h₀ : u.r - 1 + 1 = u.r := Nat.succ_pred_eq_of_pos (Nat.pos_of_ne_zero hr)
  have h₁ : u.r < u.bp + 1 := Nat.mod_lt (u.ap + 1) u.bp.succ_pos
  rw [← h₀] at h₁
  exact lt_of_succ_lt_succ h₁
#align pnat.xgcd_type.step_wf PNat.XgcdType.step_wf

theorem step_isSpecial (hs : u.IsSpecial) : u.step.IsSpecial := by
  dsimp [IsSpecial, step] at hs⊢
  rw [mul_add, mul_comm u.y u.x, ← hs]
  ring
#align pnat.xgcd_type.step_is_special PNat.XgcdType.step_isSpecial

/-- The reduction step does not change the product vector. -/
theorem step_v (hr : u.r ≠ 0) : u.step.v = u.v.swap := by
  let ha : u.r + u.b * u.q = u.a := u.rq_eq
  let hr : u.r - 1 + 1 = u.r := (add_comm _ 1).trans (add_tsub_cancel_of_le (Nat.pos_of_ne_zero hr))
  ext
  · change ((u.y * u.q + u.z) * u.b + u.y * (u.r - 1 + 1) : ℕ) = u.y * u.a + u.z * u.b
    rw [← ha, hr]
    ring
  · change ((u.w * u.q + u.x) * u.b + u.w * (u.r - 1 + 1) : ℕ) = u.w * u.a + u.x * u.b
    rw [← ha, hr]
    ring
#align pnat.xgcd_type.step_v PNat.XgcdType.step_v

-- Porting note: removed 'have' and added decreasing_by to avoid lint errors
/-- We can now define the full reduction function, which applies
 step as long as possible, and then applies finish. Note that the
 "have" statement puts a fact in the local context, and the
 equation compiler uses this fact to help construct the full
 definition in terms of well-founded recursion.  The same fact
 needs to be introduced in all the inductive proofs of properties
 given below. -/
def reduce (u : XgcdType) : XgcdType :=
  dite (u.r = 0) (fun _ => u.finish) fun _h =>
    flip (reduce u.step)
decreasing_by apply u.step_wf _h
#align pnat.xgcd_type.reduce PNat.XgcdType.reduce

theorem reduce_a {u : XgcdType} (h : u.r = 0) : u.reduce = u.finish := by
  rw [reduce]
  exact if_pos h
#align pnat.xgcd_type.reduce_a PNat.XgcdType.reduce_a

theorem reduce_b {u : XgcdType} (h : u.r ≠ 0) : u.reduce = u.step.reduce.flip := by
  rw [reduce]
  exact if_neg h
#align pnat.xgcd_type.reduce_b PNat.XgcdType.reduce_b

theorem reduce_isReduced : ∀ u : XgcdType, u.reduce.IsReduced
  | u =>
    dite (u.r = 0)
      (fun h => by
        rw [reduce_a h]
        exact u.finish_isReduced)
      fun h => by
      have : SizeOf.sizeOf u.step < SizeOf.sizeOf u := u.step_wf h
      rw [reduce_b h, flip_isReduced]
      apply reduce_isReduced
#align pnat.xgcd_type.reduce_reduced PNat.XgcdType.reduce_isReduced

theorem reduce_isReduced' (u : XgcdType) : u.reduce.IsReduced' :=
  (isReduced_iff _).mp u.reduce_isReduced
#align pnat.xgcd_type.reduce_reduced' PNat.XgcdType.reduce_isReduced'

theorem reduce_isSpecial : ∀ u : XgcdType, u.IsSpecial → u.reduce.IsSpecial
  | u =>
    dite (u.r = 0)
      (fun h hs => by
        rw [reduce_a h]
        exact u.finish_isSpecial hs)
      fun h hs => by
      have : SizeOf.sizeOf u.step < SizeOf.sizeOf u := u.step_wf h
      rw [reduce_b h]
      exact (flip_isSpecial _).mpr (reduce_isSpecial _ (u.step_isSpecial hs))
#align pnat.xgcd_type.reduce_special PNat.XgcdType.reduce_isSpecial

theorem reduce_isSpecial' (u : XgcdType) (hs : u.IsSpecial) : u.reduce.IsSpecial' :=
  (isSpecial_iff _).mp (u.reduce_isSpecial hs)
#align pnat.xgcd_type.reduce_special' PNat.XgcdType.reduce_isSpecial'

theorem reduce_v : ∀ u : XgcdType, u.reduce.v = u.v
  | u =>
    dite (u.r = 0) (fun h => by rw [reduce_a h, finish_v u h]) fun h =>
      by
      have : SizeOf.sizeOf u.step < SizeOf.sizeOf u := u.step_wf h
      rw [reduce_b h, flip_v, reduce_v (step u), step_v u h, Prod.swap_swap]
#align pnat.xgcd_type.reduce_v PNat.XgcdType.reduce_v

end XgcdType

section gcd

variable (a b : ℕ+)

/-- Extended Euclidean algorithm -/
def xgcd : XgcdType :=
  (XgcdType.start a b).reduce
#align pnat.xgcd PNat.xgcd

/-- `gcdD a b = gcd a b` -/
def gcdD : ℕ+ :=
  (xgcd a b).a
#align pnat.gcd_d PNat.gcdD

/-- Final value of `w` -/
def gcdW : ℕ+ :=
  (xgcd a b).w
#align pnat.gcd_w PNat.gcdW

/-- Final value of `x` -/
def gcdX : ℕ :=
  (xgcd a b).x
#align pnat.gcd_x PNat.gcdX

/-- Final value of `y` -/
def gcdY : ℕ :=
  (xgcd a b).y
#align pnat.gcd_y PNat.gcdY

/-- Final value of `z` -/
def gcdZ : ℕ+ :=
  (xgcd a b).z
#align pnat.gcd_z PNat.gcdZ

/-- Final value of `a / d` -/
def gcdA' : ℕ+ :=
  succPNat ((xgcd a b).wp + (xgcd a b).x)
#align pnat.gcd_a' PNat.gcdA'

/-- Final value of `b / d` -/
def gcdB' : ℕ+ :=
  succPNat ((xgcd a b).y + (xgcd a b).zp)
#align pnat.gcd_b' PNat.gcdB'

theorem gcdA'_coe : (gcdA' a b : ℕ) = gcdW a b + gcdX a b :=
  by
  dsimp [gcdA', gcdX, gcdW, XgcdType.w]
  rw [Nat.succ_eq_add_one, Nat.succ_eq_add_one, add_right_comm]
#align pnat.gcd_a'_coe PNat.gcdA'_coe

theorem gcdB'_coe : (gcdB' a b : ℕ) = gcdY a b + gcdZ a b := by
  dsimp [gcdB', gcdY, gcdZ, XgcdType.z]
  rw [Nat.succ_eq_add_one, Nat.succ_eq_add_one, add_assoc]
#align pnat.gcd_b'_coe PNat.gcdB'_coe

theorem gcd_props :
    let d := gcdD a b
    let w := gcdW a b
    let x := gcdX a b
    let y := gcdY a b
    let z := gcdZ a b
    let a' := gcdA' a b
    let b' := gcdB' a b
    w * z = succPNat (x * y) ∧
      a = a' * d ∧
        b = b' * d ∧
          z * a' = succPNat (x * b') ∧
            w * b' = succPNat (y * a') ∧ (z * a : ℕ) = x * b + d ∧ (w * b : ℕ) = y * a + d := by
  intros d w x y z a' b'
  let u := XgcdType.start a b
  let ur := u.reduce

  have _ : d = ur.a := rfl
  have hb : d = ur.b := u.reduce_isReduced'
  have ha' : (a' : ℕ) = w + x := gcdA'_coe a b
  have hb' : (b' : ℕ) = y + z := gcdB'_coe a b
  have hdet : w * z = succPNat (x * y) := u.reduce_isSpecial' rfl
  constructor
  exact hdet
  have hdet' : (w * z : ℕ) = x * y + 1 := by rw [← mul_coe, hdet, succPNat_coe]
  have _ : u.v = ⟨a, b⟩ := XgcdType.start_v a b
  let hv : Prod.mk (w * d + x * ur.b : ℕ) (y * d + z * ur.b : ℕ) = ⟨a, b⟩ :=
    u.reduce_v.trans (XgcdType.start_v a b)
  rw [← hb, ← add_mul, ← add_mul, ← ha', ← hb'] at hv
  have ha'' : (a : ℕ) = a' * d := (congr_arg Prod.fst hv).symm
  have hb'' : (b : ℕ) = b' * d := (congr_arg Prod.snd hv).symm
  constructor
  exact eq ha''
  constructor
  exact eq hb''
  have hza' : (z * a' : ℕ) = x * b' + 1 := by
    rw [ha', hb', mul_add, mul_add, mul_comm (z : ℕ), hdet']
    ring
  have hwb' : (w * b' : ℕ) = y * a' + 1 := by
    rw [ha', hb', mul_add, mul_add, hdet']
    ring
  constructor
  · apply eq
    rw [succPNat_coe, Nat.succ_eq_add_one, mul_coe, hza']
  constructor
  · apply eq
    rw [succPNat_coe, Nat.succ_eq_add_one, mul_coe, hwb']
  rw [ha'', hb'']
  repeat' rw [← @mul_assoc]
  rw [hza', hwb']
  constructor <;> ring
#align pnat.gcd_props PNat.gcd_props

theorem gcd_eq : gcdD a b = gcd a b :=
  by
  rcases gcd_props a b with ⟨_, h₁, h₂, _, _, h₅, _⟩
  apply dvd_antisymm
  · apply dvd_gcd
    exact Dvd.intro (gcdA' a b) (h₁.trans (mul_comm _ _)).symm
    exact Dvd.intro (gcdB' a b) (h₂.trans (mul_comm _ _)).symm
  · have h₇ : (gcd a b : ℕ) ∣ gcdZ a b * a := (Nat.gcd_dvd_left a b).trans (dvd_mul_left _ _)
    have h₈ : (gcd a b : ℕ) ∣ gcdX a b * b := (Nat.gcd_dvd_right a b).trans (dvd_mul_left _ _)
    rw [h₅] at h₇
    rw [dvd_iff]
    exact (Nat.dvd_add_iff_right h₈).mpr h₇
#align pnat.gcd_eq PNat.gcd_eq

theorem gcd_det_eq : gcdW a b * gcdZ a b = succPNat (gcdX a b * gcdY a b) :=
  (gcd_props a b).1
#align pnat.gcd_det_eq PNat.gcd_det_eq

theorem gcd_b_eq : b = gcdB' a b * gcd a b :=
  gcd_eq a b ▸ (gcd_props a b).2.2.1
#align pnat.gcd_b_eq PNat.gcd_b_eq

theorem gcd_rel_left' : gcdZ a b * gcdA' a b = succPNat (gcdX a b * gcdB' a b) :=
  (gcd_props a b).2.2.2.1
#align pnat.gcd_rel_left' PNat.gcd_rel_left'

theorem gcd_rel_right' : gcdW a b * gcdB' a b = succPNat (gcdY a b * gcdA' a b) :=
  (gcd_props a b).2.2.2.2.1
#align pnat.gcd_rel_right' PNat.gcd_rel_right'

theorem gcd_rel_left : (gcdZ a b * a : ℕ) = gcdX a b * b + gcd a b :=
  gcd_eq a b ▸ (gcd_props a b).2.2.2.2.2.1
#align pnat.gcd_rel_left PNat.gcd_rel_left

theorem gcd_rel_right : (gcdW a b * b : ℕ) = gcdY a b * a + gcd a b :=
  gcd_eq a b ▸ (gcd_props a b).2.2.2.2.2.2
#align pnat.gcd_rel_right PNat.gcd_rel_right

end gcd

end PNat


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem graph_2_colorable {G : Type*} [graph G] : (∃ c : G → ℤ, c G = 2) ↔ ∃ V1 V2 : set G, bipartite_graph G V1 V2 :=
begin
  -- ...
end

--OUTPUT 2
theorem bipartite_graph_two_colorable {G : Type} [graph G] : 2-colorable G ↔ bipartite G :=
begin
  -- $G$ is 2-colorable, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : 2-colorable G → ∃ (R : set G) (B : set G), ∀ v : G, v ∈ R ∨ v ∈ B ∧ ∀ e : edge G, (e.1 ∈ R ∧ e.2 ∈ B) ∨ (e.1 ∈ B ∧ e.2 ∈ R), from by auto [two_colorable_def],

  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : 2-colorable G → ∃ (A : set G) (B : set G), ∀ v : G, v ∈ A ∨ v ∈ B ∧ ∀ e : edge G, (e.1 ∈ A ∧ e.2 ∈ B) ∨ (e.1 ∈ B ∧ e.2 ∈ A), from by auto [two_colorable_def, h1],

  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : 2-colorable G → ∃ (A : set G) (B : set G), ∀ v : G, v ∈ A ∨ v ∈ B ∧ ∀ e : edge G, (e.1 ∈ A ∧ e.2 ∈ B) ∨ (e.1 ∈ B ∧ e.2 ∈ A) ∧ ∀ e : edge G, e.1 ∉ A ∨ e.2 ∉ A ∧ e.1 ∉ B ∨ e.2 ∉ B, from by auto [h2, two_colorable_def],

  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h4 : 2-colorable G → bipartite G, from by auto [h3, bipartite_def],

  show 2-colorable G ↔ bipartite G, from by auto [h4, two_colorable_def, bipartite_def],
end

--OUTPUT 3
theorem bipartite_graph_is_two_colorable (G : Type*) [graph G] : ∀ A B : set G,
  is_bipartite_graph_aux G A B ↔ is_two_colorable_graph_aux G A B :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  assume (A : set G) (B : set G),
  split,
    -- Suppose $G$ is 2-colorable, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
    assume h1 : is_two_colorable_graph_aux G A B,
    -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
    -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
    have h2 : ∀ x ∈ A, ∀ y ∈ A, x ≠ y → ¬ E x y, from by auto [h1.2],
    have h3 : ∀ x ∈ B, ∀ y ∈ B, x ≠ y → ¬ E x y, from by auto [h1.3],
    -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
    have h4 : ∀ x ∈ A, ∀ y ∈ B, x ≠ y → E x y, from by auto [h1.1],

    show is_bipartite_graph_aux G A B, from by auto [is_bipartite_graph_aux, h2, h3, h4],

    -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
    assume h1 : is_bipartite_graph_aux G A B,
    -- Suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
    -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
    -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
    have h2 : ∀ x ∈ A, ∀ y ∈ A, x ≠ y → ¬ E x y, from by auto [h1.1],
    have h3 : ∀ x ∈ B, ∀ y ∈ B, x ≠ y → ¬ E x y, from by auto [h1.2],
    -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
    have h4 : ∀ x ∈ A, ∀ y ∈ B, x ≠ y → E x y, from by auto [h1.3],

    show is_two_colorable_graph_aux G A B, from by auto [is_two_colorable_graph_aux, h2, h3, h4],
end

--OUTPUT 4
theorem bipartite_graph_two_colorable {G : Type*} : G.two_colorable ↔ G.bipartite :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue,
  -- and no edge will have both endpoints colored the same color.
  assume h1 : G.two_colorable,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set G.V, (∀ v : G.V, v ∈ A ∨ v ∈ B) ∧ (∀ v : G.V, v ∈ A → ¬ (v ∈ B)) ∧ (∀ v : G.V, v ∈ B → ¬ (v ∈ A)) ∧ (∀ v w : G.V, (v ≠ w) → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A)), from by auto using [h1, two_colorable.def],
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ v w : G.V, v ∈ A → w ∈ A → (v, w) ∉ G.E, from by auto using [h2],
  have h4 : ∀ v w : G.V, v ∈ B → w ∈ B → (v, w) ∉ G.E, from by auto using [h2],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h5 : ∀ v w : G.V, (v, w) ∈ G.E → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A), from by auto using [h2, h3, h4],
  show G.bipartite, from by auto using [bipartite.def, h2, h5],
  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$
  -- every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  assume h1 : G.bipartite,
  have h2 : ∃ A B : set G.V, (∀ v : G.V, v ∈ A ∨ v ∈ B) ∧ (∀ v : G.V, v ∈ A → ¬ (v ∈ B)) ∧ (∀ v : G.V, v ∈ B → ¬ (v ∈ A)) ∧ (∀ v w : G.V, (v ≠ w) → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A)), from by auto using [h1, bipartite.def],
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring,
  have h3 : ∀ v : G.V, v ∈ A → (∀ w : G.V, (v, w) ∈ G.E → w ∉ A), from by auto using [h2],
  have h4 : ∀ v : G.V, v ∈ B → (∀ w : G.V, (v, w) ∈ G.E → w ∉ B), from by auto using [h2],
  -- so $G$ is 2-colorable.
  show G.two_colorable, from by auto using [two_colorable.def, h2, h3, h4],
end

--OUTPUT 5
theorem bipartite_if_two_colorable {G : Type*} [graph G] (h1 : is_bipartite G) : is_two_colorable G :=
begin
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set G, is_coloring G A B, from by auto [h1],
  obtain A B h3, from h2,
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h4 : ∀ (u v : G), u ∈ A → v ∈ A → ¬ edge G u v, from by auto [h3],
  have h5 : ∀ (u v : G), u ∈ B → v ∈ B → ¬ edge G u v, from by auto [h3],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  show is_bipartite G, from by auto [h1, h3, h4, h5],
end

--OUTPUT 6
theorem bipartite_iff_two_colorable (G : Type*) [graph G] : bipartite G ↔ two_colorable G :=
begin
  -- There exists a subset $A$ of vertices of $G$ such that there are no edges within $A$ and all edges with one endpoint in $A$ have the other endpoint in $B$
  have h1 : bipartite G → ∃ A : set G, no_edges_in A ∧ (∀ (a : G) (b : G), a ∈ A ∧ (a,b) ∈ E G → b ∈ B G), from by auto [bipartite],
  -- There exists a subset $B$ of vertices of $G$ such that there are no edges within $B$ and all edges with one endpoint in $B$ have the other endpoint in $A$
  have h2 : bipartite G → ∃ B : set G, no_edges_in B ∧ (∀ (a : G) (b : G), a ∈ B ∧ (a,b) ∈ E G → b ∈ A G), from by auto [bipartite],

  -- If $G$ is 2-colorable, then we can color every vertex either red or blue, and no edge will have both endpoints colored the same color
  have h3 : two_colorable G → ∃ (r : set G) (b : set G), no_edges_in r ∧ no_edges_in b ∧ (∀ (a : G) (b : G), a ∈ r ∧ b ∈ r → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ b ∧ b ∈ b → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ r ∧ b ∈ b → (a,b) ∈ E G), from by auto [two_colorable],

  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue
  have h4 : two_colorable G → ∀ (r : set G) (b : set G), no_edges_in r ∧ no_edges_in b ∧ (∀ (a : G) (b : G), a ∈ r ∧ b ∈ r → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ b ∧ b ∈ b → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ r ∧ b ∈ b → (a,b) ∈ E G) → ∃ A : set G, no_edges_in A ∧ (∀ (a : G) (b : G), a ∈ A ∧ (a,b) ∈ E G → b ∈ B G), from by auto [h3],

  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$
  have h5 : two_colorable G → ∀ (r : set G) (b : set G), no_edges_in r ∧ no_edges_in b ∧ (∀ (a : G) (b : G), a ∈ r ∧ b ∈ r → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ b ∧ b ∈ b → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ r ∧ b ∈ b → (a,b) ∈ E G) → ∃ B : set G, no_edges_in B ∧ (∀ (a : G) (b : G), a ∈ B ∧ (a,b) ∈ E G → b ∈ A G), from by auto [h3],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite
  have h6 : two_colorable G → ∀ (r : set G) (b : set G), no_edges_in r ∧ no_edges_in b ∧ (∀ (a : G) (b : G), a ∈ r ∧ b ∈ r → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ b ∧ b ∈ b → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ r ∧ b ∈ b → (a,b) ∈ E G) → bipartite G, from by auto [h3],

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$
  have h7 : bipartite G → ∃ (A : set G) (B : set G), no_edges_in A ∧ no_edges_in B ∧ (∀ (a : G) (b : G), a ∈ A ∧ b ∈ A → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ B ∧ b ∈ B → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ A ∧ b ∈ B → (a,b) ∈ E G), from by auto [h1, h2],
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable
  have h8 : bipartite G → ∀ (A : set G) (B : set G), no_edges_in A ∧ no_edges_in B ∧ (∀ (a : G) (b : G), a ∈ A ∧ b ∈ A → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ B ∧ b ∈ B → (a,b) ∉ E G) ∧ (∀ (a : G) (b : G), a ∈ A ∧ b ∈ B → (a,b) ∈ E G) → two_colorable G, from by auto [h7],

  show bipartite G ↔ two_colorable G, from by auto [h3, h7],
end

--OUTPUT 7
theorem graph_bipartite_two_colorable (G : Type*) [graph G] : two_colorable G ↔ bipartite G :=
begin
  -- $G$ is 2-colorable graph
  assume h1 : two_colorable G,

  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set G, ∀ v : G, (v ∈ A ∧ v ∉ B) ∨ (v ∈ B ∧ v ∉ A), from by auto [h1],
  cases h2 with A h2,
  cases h2 with B h2,

  -- Since all vertices of $A$ are red, there are no edges within $A$
  have h3 : ∀ a b : G, (a ∈ A ∧ b ∈ A) → (a,b) ∉ E, from by auto [h2],

  -- Similarly for $B$
  have h4 : ∀ a b : G, (a ∈ B ∧ b ∈ B) → (a,b) ∉ E, from by auto [h2],

  -- This implies that every edge has one endpoint in $A$ and the other in $B$
  have h5 : ∀ a b : G, (a,b) ∈ E → ((a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)), from by auto [h3, h4],

  -- which means $G$ is bipartite.
  have h6 : bipartite G, from by auto [h2, h5],

  show two_colorable G ↔ bipartite G, from by auto [h6] using [iff_def],
end

--OUTPUT 8
theorem bipartite_graph_two_colorable {G : Type*} : bipartite G ↔ two_colorable G :=
begin
  -- $G$ is 2-colorable, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : two_colorable G → ∃ A B : set G, (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a : G, (a ∈ A ∧ a ∈ B) → false) ∧ (∀ a b : G, (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)), from by auto using [two_colorable.def, two_colorable.def],

  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : two_colorable G → ∃ A B : set G, (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a : G, (a ∈ A ∧ a ∈ B) → false) ∧ (∀ a b : G, (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)) ∧ (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a : G, (a ∈ A ∧ a ∈ B) → false) ∧ (∀ a b : G, (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)), from by auto [h1],

  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : two_colorable G → ∃ A B : set G, (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a : G, (a ∈ A ∧ a ∈ B) → false) ∧ (∀ a b : G, (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)) ∧ (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a : G, (a ∈ A ∧ a ∈ B) → false) ∧ (∀ a b : G, (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)) ∧ (∀ a b : G, (a ∈ A ∧ a ∈ A) ∨ (b ∈ B ∧ b ∈ B) → false), from by auto using [h2],

  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h4 : two_colorable G → ∃ A B : set G, (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a : G, (a ∈ A ∧ a ∈ B) → false) ∧ (∀ a b : G, (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)) ∧ (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a : G, (a ∈ A ∧ a ∈ B) → false) ∧ (∀ a b : G, (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)) ∧ (∀ a b : G, (a ∈ A ∧ a ∈ A) ∨ (b ∈ B ∧ b ∈ B) → false) ∧ (∀ a b : G, (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)), from by auto using [h3],

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  have h5 : bipartite G → ∃ A B : set G, (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a : G, (a ∈ A ∧ a ∈ B) → false) ∧ (∀ a b : G, (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A)), from by auto using [bipartite.def],

  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h6 : bipartite G → two_colorable G, from by auto using [h5],

  -- We have proved our theorem
  show bipartite G ↔ two_colorable G, from by auto [h4, h6],
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov
Ported by: Anatole Dedecker

! This file was ported from Lean 3 source module group_theory.submonoid.basic
! leanprover-community/mathlib commit feb99064803fd3108e37c18b0f77d0a8344677a3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Group
import Mathlib.Algebra.Group.Units
import Mathlib.GroupTheory.Subsemigroup.Basic

/-!
# Submonoids: definition and `CompleteLattice` structure

This file defines bundled multiplicative and additive submonoids. We also define
a `CompleteLattice` structure on `Submonoid`s, define the closure of a set as the minimal submonoid
that includes this set, and prove a few results about extending properties from a dense set (i.e.
a set with `closure s = ⊤`) to the whole monoid, see `Submonoid.dense_induction` and
`MonoidHom.ofClosureEqTopLeft`/`MonoidHom.ofClosureEqTopRight`.

## Main definitions

* `Submonoid M`: the type of bundled submonoids of a monoid `M`; the underlying set is given in
  the `carrier` field of the structure, and should be accessed through coercion as in `(S : Set M)`.
* `AddSubmonoid M` : the type of bundled submonoids of an additive monoid `M`.

For each of the following definitions in the `Submonoid` namespace, there is a corresponding
definition in the `AddSubmonoid` namespace.

* `Submonoid.copy` : copy of a submonoid with `carrier` replaced by a set that is equal but possibly
  not definitionally equal to the carrier of the original `Submonoid`.
* `Submonoid.closure` :  monoid closure of a set, i.e., the least submonoid that includes the set.
* `Submonoid.gi` : `closure : Set M → Submonoid M` and coercion `coe : Submonoid M → Set M`
  form a `GaloisInsertion`;
* `MonoidHom.eqLocus`: the submonoid of elements `x : M` such that `f x = g x`;
* `MonoidHom.ofClosureEqTopRight`:  if a map `f : M → N` between two monoids satisfies
  `f 1 = 1` and `f (x * y) = f x * f y` for `y` from some dense set `s`, then `f` is a monoid
  homomorphism. E.g., if `f : ℕ → M` satisfies `f 0 = 0` and `f (x + 1) = f x + f 1`, then `f` is
  an additive monoid homomorphism.

## Implementation notes

Submonoid inclusion is denoted `≤` rather than `⊆`, although `∈` is defined as
membership of a submonoid's underlying set.

Note that `Submonoid M` does not actually require `Monoid M`, instead requiring only the weaker
`MulOneClass M`.

This file is designed to have very few dependencies. In particular, it should not use natural
numbers. `Submonoid` is implemented by extending `Subsemigroup` requiring `one_mem'`.

## Tags
submonoid, submonoids
-/

-- Only needed for notation
-- Only needed for notation
variable {M : Type _} {N : Type _}

variable {A : Type _}

section NonAssoc

variable [MulOneClass M] {s : Set M}

variable [AddZeroClass A] {t : Set A}

/-- `OneMemClass S M` says `S` is a type of subsets `s ≤ M`, such that `1 ∈ s` for all `s`. -/
class OneMemClass (S : Type _) (M : Type _) [One M] [SetLike S M] : Prop where
  /-- By definition, if we have `OneMemClass S M`, we have `1 ∈ s` for all `s : S`. -/
  one_mem : ∀ s : S, (1 : M) ∈ s
#align one_mem_class OneMemClass

export OneMemClass (one_mem)

/-- `ZeroMemClass S M` says `S` is a type of subsets `s ≤ M`, such that `0 ∈ s` for all `s`. -/
class ZeroMemClass (S : Type _) (M : Type _) [Zero M] [SetLike S M] : Prop where
  /-- By definition, if we have `ZeroMemClass S M`, we have `0 ∈ s` for all `s : S`. -/
  zero_mem : ∀ s : S, (0 : M) ∈ s
#align zero_mem_class ZeroMemClass

export ZeroMemClass (zero_mem)

attribute [to_additive] OneMemClass

section

/-- A submonoid of a monoid `M` is a subset containing 1 and closed under multiplication. -/
structure Submonoid (M : Type _) [MulOneClass M] extends Subsemigroup M where
  /-- A submonoid contains `1`. -/
  one_mem' : (1 : M) ∈ carrier
#align submonoid Submonoid

end

/-- A submonoid of a monoid `M` can be considered as a subsemigroup of that monoid. -/
add_decl_doc Submonoid.toSubsemigroup
#align submonoid.to_subsemigroup Submonoid.toSubsemigroup

/-- `SubmonoidClass S M` says `S` is a type of subsets `s ≤ M` that contain `1`
and are closed under `(*)` -/
class SubmonoidClass (S : Type _) (M : Type _) [MulOneClass M] [SetLike S M] extends
  MulMemClass S M, OneMemClass S M : Prop
#align submonoid_class SubmonoidClass

section

/-- An additive submonoid of an additive monoid `M` is a subset containing 0 and
  closed under addition. -/
structure AddSubmonoid (M : Type _) [AddZeroClass M] extends AddSubsemigroup M where
  /-- An additive submonoid contains `0`. -/
  zero_mem' : (0 : M) ∈ carrier
#align add_submonoid AddSubmonoid

end

/-- An additive submonoid of an additive monoid `M` can be considered as an
additive subsemigroup of that additive monoid. -/
add_decl_doc AddSubmonoid.toAddSubsemigroup
#align add_submonoid.to_add_subsemigroup AddSubmonoid.toAddSubsemigroup

/-- `AddSubmonoidClass S M` says `S` is a type of subsets `s ≤ M` that contain `0`
and are closed under `(+)` -/
class AddSubmonoidClass (S : Type _) (M : Type _) [AddZeroClass M] [SetLike S M] extends
  AddMemClass S M, ZeroMemClass S M : Prop
#align add_submonoid_class AddSubmonoidClass

attribute [to_additive] Submonoid SubmonoidClass

@[to_additive]
theorem pow_mem {M A} [Monoid M] [SetLike A M] [SubmonoidClass A M] {S : A} {x : M}
    (hx : x ∈ S) : ∀ n : ℕ, x ^ n ∈ S
  | 0 => by
    rw [pow_zero]
    exact OneMemClass.one_mem S
  | n + 1 => by
    rw [pow_succ]
    exact mul_mem hx (pow_mem hx n)
#align pow_mem pow_mem
#align nsmul_mem nsmul_mem

namespace Submonoid

@[to_additive]
instance : SetLike (Submonoid M) M where
  coe s := s.carrier
  coe_injective' p q h := by cases p; cases q; congr; exact SetLike.coe_injective' h

@[to_additive]
instance : SubmonoidClass (Submonoid M) M where
  one_mem := Submonoid.one_mem'
  mul_mem {s} := s.mul_mem'

initialize_simps_projections Submonoid (carrier → coe)

initialize_simps_projections AddSubmonoid (carrier → coe)

@[to_additive (attr := simp)]
theorem mem_toSubsemigroup {s : Submonoid M} {x : M} : x ∈ s.toSubsemigroup ↔ x ∈ s :=
  Iff.rfl

-- Porting note: `x ∈ s.carrier` is now syntactically `x ∈ s.toSubsemigroup.carrier`,
-- which `simp` already simplifies to `x ∈ s.toSubsemigroup`. So we remove the `@[simp]` attribute
-- here, and instead add the simp lemma `mem_toSubsemigroup` to allow `simp` to do this exact
-- simplification transitively.
@[to_additive]
theorem mem_carrier {s : Submonoid M} {x : M} : x ∈ s.carrier ↔ x ∈ s :=
  Iff.rfl
#align submonoid.mem_carrier Submonoid.mem_carrier
#align add_submonoid.mem_carrier AddSubmonoid.mem_carrier

@[to_additive (attr := simp)]
theorem mem_mk {s : Set M} {x : M} (h_one) (h_mul) : x ∈ mk ⟨s, h_mul⟩ h_one ↔ x ∈ s :=
  Iff.rfl
#align submonoid.mem_mk Submonoid.mem_mk
#align add_submonoid.mem_mk AddSubmonoid.mem_mk

@[to_additive (attr := simp)]
theorem coe_set_mk {s : Set M} (h_one) (h_mul) : (mk ⟨s, h_mul⟩ h_one : Set M) = s :=
  rfl
#align submonoid.coe_set_mk Submonoid.coe_set_mk
#align add_submonoid.coe_set_mk AddSubmonoid.coe_set_mk

@[to_additive (attr := simp)]
theorem mk_le_mk {s t : Set M} (h_one) (h_mul) (h_one') (h_mul') :
    mk ⟨s, h_mul⟩ h_one ≤ mk ⟨t, h_mul'⟩ h_one' ↔ s ⊆ t :=
  Iff.rfl
#align submonoid.mk_le_mk Submonoid.mk_le_mk
#align add_submonoid.mk_le_mk AddSubmonoid.mk_le_mk

/-- Two submonoids are equal if they have the same elements. -/
@[to_additive (attr := ext) "Two `AddSubmonoid`s are equal if they have the same elements."]
theorem ext {S T : Submonoid M} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T :=
  SetLike.ext h
#align submonoid.ext Submonoid.ext
#align add_submonoid.ext AddSubmonoid.ext

/-- Copy a submonoid replacing `carrier` with a set that is equal to it. -/
@[to_additive "Copy an additive submonoid replacing `carrier` with a set that is equal to it."]
protected def copy (S : Submonoid M) (s : Set M) (hs : s = S) : Submonoid M where
  carrier := s
  one_mem' := show 1 ∈ s from hs.symm ▸ S.one_mem'
  mul_mem' := hs.symm ▸ S.mul_mem'
#align submonoid.copy Submonoid.copy
#align add_submonoid.copy AddSubmonoid.copy

variable {S : Submonoid M}

@[to_additive (attr := simp)]
theorem coe_copy {s : Set M} (hs : s = S) : (S.copy s hs : Set M) = s :=
  rfl
#align submonoid.coe_copy Submonoid.coe_copy
#align add_submonoid.coe_copy AddSubmonoid.coe_copy

@[to_additive]
theorem copy_eq {s : Set M} (hs : s = S) : S.copy s hs = S :=
  SetLike.coe_injective hs
#align submonoid.copy_eq Submonoid.copy_eq
#align add_submonoid.copy_eq AddSubmonoid.copy_eq

variable (S)

/-- A submonoid contains the monoid's 1. -/
@[to_additive "An `AddSubmonoid` contains the monoid's 0."]
protected theorem one_mem : (1 : M) ∈ S :=
  one_mem S
#align submonoid.one_mem Submonoid.one_mem
#align add_submonoid.zero_mem AddSubmonoid.zero_mem

/-- A submonoid is closed under multiplication. -/
@[to_additive "An `AddSubmonoid` is closed under addition."]
protected theorem mul_mem {x y : M} : x ∈ S → y ∈ S → x * y ∈ S :=
  mul_mem
#align submonoid.mul_mem Submonoid.mul_mem
#align add_submonoid.add_mem AddSubmonoid.add_mem

/-- The submonoid `M` of the monoid `M`. -/
@[to_additive "The additive submonoid `M` of the `AddMonoid M`."]
instance : Top (Submonoid M) :=
  ⟨{  carrier := Set.univ
      one_mem' := Set.mem_univ 1
      mul_mem' := fun _ _ => Set.mem_univ _ }⟩

/-- The trivial submonoid `{1}` of an monoid `M`. -/
@[to_additive "The trivial `AddSubmonoid` `{0}` of an `AddMonoid` `M`."]
instance : Bot (Submonoid M) :=
  ⟨{  carrier := {1}
      one_mem' := Set.mem_singleton 1
      mul_mem' := fun ha hb => by
        simp only [Set.mem_singleton_iff] at *
        rw [ha, hb, mul_one] }⟩

@[to_additive]
instance : Inhabited (Submonoid M) :=
  ⟨⊥⟩

@[to_additive (attr := simp)]
theorem mem_bot {x : M} : x ∈ (⊥ : Submonoid M) ↔ x = 1 :=
  Set.mem_singleton_iff
#align submonoid.mem_bot Submonoid.mem_bot
#align add_submonoid.mem_bot AddSubmonoid.mem_bot

@[to_additive (attr := simp)]
theorem mem_top (x : M) : x ∈ (⊤ : Submonoid M) :=
  Set.mem_univ x
#align submonoid.mem_top Submonoid.mem_top
#align add_submonoid.mem_top AddSubmonoid.mem_top

@[to_additive (attr := simp)]
theorem coe_top : ((⊤ : Submonoid M) : Set M) = Set.univ :=
  rfl
#align submonoid.coe_top Submonoid.coe_top
#align add_submonoid.coe_top AddSubmonoid.coe_top

@[to_additive (attr := simp)]
theorem coe_bot : ((⊥ : Submonoid M) : Set M) = {1} :=
  rfl
#align submonoid.coe_bot Submonoid.coe_bot
#align add_submonoid.coe_bot AddSubmonoid.coe_bot

/-- The inf of two submonoids is their intersection. -/
@[to_additive "The inf of two `AddSubmonoid`s is their intersection."]
instance : Inf (Submonoid M) :=
  ⟨fun S₁ S₂ =>
    { carrier := S₁ ∩ S₂
      one_mem' := ⟨S₁.one_mem, S₂.one_mem⟩
      mul_mem' := fun ⟨hx, hx'⟩ ⟨hy, hy'⟩ => ⟨S₁.mul_mem hx hy, S₂.mul_mem hx' hy'⟩ }⟩

@[to_additive (attr := simp)]
theorem coe_inf (p p' : Submonoid M) : ((p ⊓ p' : Submonoid M) : Set M) = (p : Set M) ∩ p' :=
  rfl
#align submonoid.coe_inf Submonoid.coe_inf
#align add_submonoid.coe_inf AddSubmonoid.coe_inf

@[to_additive (attr := simp)]
theorem mem_inf {p p' : Submonoid M} {x : M} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' :=
  Iff.rfl
#align submonoid.mem_inf Submonoid.mem_inf
#align add_submonoid.mem_inf AddSubmonoid.mem_inf

@[to_additive]
instance : InfSet (Submonoid M) :=
  ⟨fun s =>
    { carrier := ⋂ t ∈ s, ↑t
      one_mem' := Set.mem_binterᵢ fun i _ => i.one_mem
      mul_mem' := fun hx hy =>
        Set.mem_binterᵢ fun i h =>
          i.mul_mem (by apply Set.mem_interᵢ₂.1 hx i h) (by apply Set.mem_interᵢ₂.1 hy i h) }⟩

@[to_additive (attr := simp, norm_cast)]
theorem coe_infₛ (S : Set (Submonoid M)) : ((infₛ S : Submonoid M) : Set M) = ⋂ s ∈ S, ↑s :=
  rfl
#align submonoid.coe_Inf Submonoid.coe_infₛ
#align add_submonoid.coe_Inf AddSubmonoid.coe_infₛ

@[to_additive]
theorem mem_infₛ {S : Set (Submonoid M)} {x : M} : x ∈ infₛ S ↔ ∀ p ∈ S, x ∈ p :=
  Set.mem_interᵢ₂
#align submonoid.mem_Inf Submonoid.mem_infₛ
#align add_submonoid.mem_Inf AddSubmonoid.mem_infₛ

@[to_additive]
theorem mem_infᵢ {ι : Sort _} {S : ι → Submonoid M} {x : M} : (x ∈ ⨅ i, S i) ↔ ∀ i, x ∈ S i := by
  simp only [infᵢ, mem_infₛ, Set.forall_range_iff]
#align submonoid.mem_infi Submonoid.mem_infᵢ
#align add_submonoid.mem_infi AddSubmonoid.mem_infᵢ

@[to_additive (attr := simp, norm_cast)]
theorem coe_infᵢ {ι : Sort _} {S : ι → Submonoid M} : (↑(⨅ i, S i) : Set M) = ⋂ i, S i := by
  simp only [infᵢ, coe_infₛ, Set.binterᵢ_range]
#align submonoid.coe_infi Submonoid.coe_infᵢ
#align add_submonoid.coe_infi AddSubmonoid.coe_infᵢ

/-- Submonoids of a monoid form a complete lattice. -/
@[to_additive "The `AddSubmonoid`s of an `AddMonoid` form a complete lattice."]
instance : CompleteLattice (Submonoid M) :=
  { (completeLatticeOfInf (Submonoid M)) fun _ =>
      IsGLB.of_image (f := (SetLike.coe : Submonoid M → Set M))
        (@fun S T => show (S : Set M) ≤ T ↔ S ≤ T from SetLike.coe_subset_coe)
        isGLB_binfᵢ with
    le := (· ≤ ·)
    lt := (· < ·)
    bot := ⊥
    bot_le := fun S _ hx => (mem_bot.1 hx).symm ▸ S.one_mem
    top := ⊤
    le_top := fun _ x _ => mem_top x
    inf := (· ⊓ ·)
    infₛ := InfSet.infₛ
    le_inf := fun _ _ _ ha hb _ hx => ⟨ha hx, hb hx⟩
    inf_le_left := fun _ _ _ => And.left
    inf_le_right := fun _ _ _ => And.right }

@[to_additive (attr := simp)]
theorem subsingleton_iff : Subsingleton (Submonoid M) ↔ Subsingleton M :=
  ⟨fun h =>
    ⟨fun x y =>
      have : ∀ i : M, i = 1 := fun i =>
        mem_bot.mp <| Subsingleton.elim (⊤ : Submonoid M) ⊥ ▸ mem_top i
      (this x).trans (this y).symm⟩,
    fun h =>
    ⟨fun x y => Submonoid.ext fun i => Subsingleton.elim 1 i ▸ by simp [Submonoid.one_mem]⟩⟩
#align submonoid.subsingleton_iff Submonoid.subsingleton_iff
#align add_submonoid.subsingleton_iff AddSubmonoid.subsingleton_iff

@[to_additive (attr := simp)]
theorem nontrivial_iff : Nontrivial (Submonoid M) ↔ Nontrivial M :=
  not_iff_not.mp
    ((not_nontrivial_iff_subsingleton.trans subsingleton_iff).trans
      not_nontrivial_iff_subsingleton.symm)
#align submonoid.nontrivial_iff Submonoid.nontrivial_iff
#align add_submonoid.nontrivial_iff AddSubmonoid.nontrivial_iff

@[to_additive]
instance [Subsingleton M] : Unique (Submonoid M) :=
  ⟨⟨⊥⟩, fun a => @Subsingleton.elim _ (subsingleton_iff.mpr ‹_›) a _⟩

@[to_additive]
instance [Nontrivial M] : Nontrivial (Submonoid M) :=
  nontrivial_iff.mpr ‹_›

/-- The `Submonoid` generated by a set. -/
@[to_additive "The `add_submonoid` generated by a set"]
def closure (s : Set M) : Submonoid M :=
  infₛ { S | s ⊆ S }
#align submonoid.closure Submonoid.closure
#align add_submonoid.closure AddSubmonoid.closure

@[to_additive]
theorem mem_closure {x : M} : x ∈ closure s ↔ ∀ S : Submonoid M, s ⊆ S → x ∈ S :=
  mem_infₛ
#align submonoid.mem_closure Submonoid.mem_closure
#align add_submonoid.mem_closure AddSubmonoid.mem_closure

/-- The submonoid generated by a set includes the set. -/
@[to_additive (attr := simp) "The `AddSubmonoid` generated by a set includes the set."]
theorem subset_closure : s ⊆ closure s := fun _ hx => mem_closure.2 fun _ hS => hS hx
#align submonoid.subset_closure Submonoid.subset_closure
#align add_submonoid.subset_closure AddSubmonoid.subset_closure

@[to_additive]
theorem not_mem_of_not_mem_closure {P : M} (hP : P ∉ closure s) : P ∉ s := fun h =>
  hP (subset_closure h)
#align submonoid.not_mem_of_not_mem_closure Submonoid.not_mem_of_not_mem_closure
#align add_submonoid.not_mem_of_not_mem_closure AddSubmonoid.not_mem_of_not_mem_closure

variable {S}

open Set

/-- A submonoid `S` includes `closure s` if and only if it includes `s`. -/
@[to_additive (attr := simp)
"An additive submonoid `S` includes `closure s` if and only if it includes `s`"]
theorem closure_le : closure s ≤ S ↔ s ⊆ S :=
  ⟨Subset.trans subset_closure, fun h => infₛ_le h⟩
#align submonoid.closure_le Submonoid.closure_le
#align add_submonoid.closure_le AddSubmonoid.closure_le

/-- Submonoid closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
@[to_additive
      "Additive submonoid closure of a set is monotone in its argument: if `s ⊆ t`,
      then `closure s ≤ closure t`"]
theorem closure_mono ⦃s t : Set M⦄ (h : s ⊆ t) : closure s ≤ closure t :=
  closure_le.2 <| Subset.trans h subset_closure
#align submonoid.closure_mono Submonoid.closure_mono
#align add_submonoid.closure_mono AddSubmonoid.closure_mono

@[to_additive]
theorem closure_eq_of_le (h₁ : s ⊆ S) (h₂ : S ≤ closure s) : closure s = S :=
  le_antisymm (closure_le.2 h₁) h₂
#align submonoid.closure_eq_of_le Submonoid.closure_eq_of_le
#align add_submonoid.closure_eq_of_le AddSubmonoid.closure_eq_of_le

variable (S)

/-- An induction principle for closure membership. If `p` holds for `1` and all elements of `s`, and
is preserved under multiplication, then `p` holds for all elements of the closure of `s`. -/
@[to_additive (attr := elab_as_elim)
      "An induction principle for additive closure membership. If `p` holds for `0` and all
      elements of `s`, and is preserved under addition, then `p` holds for all elements of the
      additive closure of `s`."]
theorem closure_induction {p : M → Prop} {x} (h : x ∈ closure s) (Hs : ∀ x ∈ s, p x) (H1 : p 1)
    (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
  (@closure_le _ _ _ ⟨⟨p, Hmul _ _⟩, H1⟩).2 Hs h
#align submonoid.closure_induction Submonoid.closure_induction
#align add_submonoid.closure_induction AddSubmonoid.closure_induction

/-- A dependent version of `Submonoid.closure_induction`.  -/
@[to_additive (attr := elab_as_elim) "A dependent version of `AddSubmonoid.closure_induction`. "]
theorem closure_induction' (s : Set M) {p : ∀ x, x ∈ closure s → Prop}
    (Hs : ∀ (x) (h : x ∈ s), p x (subset_closure h)) (H1 : p 1 (one_mem _))
    (Hmul : ∀ x hx y hy, p x hx → p y hy → p (x * y) (mul_mem hx hy)) {x} (hx : x ∈ closure s) :
    p x hx := by
  refine' Exists.elim _ fun (hx : x ∈ closure s) (hc : p x hx) => hc
  exact
    closure_induction hx (fun x hx => ⟨_, Hs x hx⟩) ⟨_, H1⟩ fun x y ⟨hx', hx⟩ ⟨hy', hy⟩ =>
      ⟨_, Hmul _ _ _ _ hx hy⟩
#align submonoid.closure_induction' Submonoid.closure_induction'
#align add_submonoid.closure_induction' AddSubmonoid.closure_induction'

/-- An induction principle for closure membership for predicates with two arguments.  -/
@[to_additive (attr := elab_as_elim)
      "An induction principle for additive closure membership for predicates with two arguments."]
theorem closure_induction₂ {p : M → M → Prop} {x} {y : M} (hx : x ∈ closure s) (hy : y ∈ closure s)
    (Hs : ∀ x ∈ s, ∀ y ∈ s, p x y) (H1_left : ∀ x, p 1 x) (H1_right : ∀ x, p x 1)
    (Hmul_left : ∀ x y z, p x z → p y z → p (x * y) z)
    (Hmul_right : ∀ x y z, p z x → p z y → p z (x * y)) : p x y :=
  closure_induction hx
    (fun x xs =>
      closure_induction hy (Hs x xs) (H1_right x) fun z _ h₁ h₂ => Hmul_right z _ _ h₁ h₂)
    (H1_left y) fun _ _ h₁ h₂ => Hmul_left _ _ _ h₁ h₂
#align submonoid.closure_induction₂ Submonoid.closure_induction₂
#align add_submonoid.closure_induction₂ AddSubmonoid.closure_induction₂

/-- If `s` is a dense set in a monoid `M`, `Submonoid.closure s = ⊤`, then in order to prove that
some predicate `p` holds for all `x : M` it suffices to verify `p x` for `x ∈ s`, verify `p 1`,
and verify that `p x` and `p y` imply `p (x * y)`. -/
@[to_additive (attr := elab_as_elim)
      "If `s` is a dense set in an additive monoid `M`, `AddSubmonoid.closure s = ⊤`, then in
      order to prove that some predicate `p` holds for all `x : M` it suffices to verify `p x` for
      `x ∈ s`, verify `p 0`, and verify that `p x` and `p y` imply `p (x + y)`."]
theorem dense_induction {p : M → Prop} (x : M) {s : Set M} (hs : closure s = ⊤) (Hs : ∀ x ∈ s, p x)
    (H1 : p 1) (Hmul : ∀ x y, p x → p y → p (x * y)) : p x := by
  have : ∀ x ∈ closure s, p x := fun x hx => closure_induction hx Hs H1 Hmul
  simpa [hs] using this x
#align submonoid.dense_induction Submonoid.dense_induction
#align add_submonoid.dense_induction AddSubmonoid.dense_induction

variable (M)

/-- `closure` forms a Galois insertion with the coercion to set. -/
@[to_additive "`closure` forms a Galois insertion with the coercion to set."]
protected def gi : GaloisInsertion (@closure M _) SetLike.coe where
  choice s _ := closure s
  gc _ _ := closure_le
  le_l_u _ := subset_closure
  choice_eq _ _ := rfl
#align submonoid.gi Submonoid.gi
#align add_submonoid.gi AddSubmonoid.gi

variable {M}

/-- Closure of a submonoid `S` equals `S`. -/
@[to_additive (attr := simp) "Additive closure of an additive submonoid `S` equals `S`"]
theorem closure_eq : closure (S : Set M) = S :=
  (Submonoid.gi M).l_u_eq S
#align submonoid.closure_eq Submonoid.closure_eq
#align add_submonoid.closure_eq AddSubmonoid.closure_eq

@[to_additive (attr := simp)]
theorem closure_empty : closure (∅ : Set M) = ⊥ :=
  (Submonoid.gi M).gc.l_bot
#align submonoid.closure_empty Submonoid.closure_empty
#align add_submonoid.closure_empty AddSubmonoid.closure_empty

@[to_additive (attr := simp)]
theorem closure_univ : closure (univ : Set M) = ⊤ :=
  @coe_top M _ ▸ closure_eq ⊤
#align submonoid.closure_univ Submonoid.closure_univ
#align add_submonoid.closure_univ AddSubmonoid.closure_univ

@[to_additive]
theorem closure_union (s t : Set M) : closure (s ∪ t) = closure s ⊔ closure t :=
  (Submonoid.gi M).gc.l_sup
#align submonoid.closure_union Submonoid.closure_union
#align add_submonoid.closure_union AddSubmonoid.closure_union

@[to_additive]
theorem closure_unionᵢ {ι} (s : ι → Set M) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
  (Submonoid.gi M).gc.l_supᵢ
#align submonoid.closure_Union Submonoid.closure_unionᵢ
#align add_submonoid.closure_Union AddSubmonoid.closure_unionᵢ

-- Porting note: `simp` can now prove this, so we remove the `@[simp]` attribute
@[to_additive]
theorem closure_singleton_le_iff_mem (m : M) (p : Submonoid M) : closure {m} ≤ p ↔ m ∈ p := by
  rw [closure_le, singleton_subset_iff, SetLike.mem_coe]
#align submonoid.closure_singleton_le_iff_mem Submonoid.closure_singleton_le_iff_mem
#align add_submonoid.closure_singleton_le_iff_mem AddSubmonoid.closure_singleton_le_iff_mem

@[to_additive]
theorem mem_supᵢ {ι : Sort _} (p : ι → Submonoid M) {m : M} :
    (m ∈ ⨆ i, p i) ↔ ∀ N, (∀ i, p i ≤ N) → m ∈ N := by
  rw [← closure_singleton_le_iff_mem, le_supᵢ_iff]
  simp only [closure_singleton_le_iff_mem]
#align submonoid.mem_supr Submonoid.mem_supᵢ
#align add_submonoid.mem_supr AddSubmonoid.mem_supᵢ

@[to_additive]
theorem supᵢ_eq_closure {ι : Sort _} (p : ι → Submonoid M) :
    (⨆ i, p i) = Submonoid.closure (⋃ i, (p i : Set M)) := by
  simp_rw [Submonoid.closure_unionᵢ, Submonoid.closure_eq]
#align submonoid.supr_eq_closure Submonoid.supᵢ_eq_closure
#align add_submonoid.supr_eq_closure AddSubmonoid.supᵢ_eq_closure

@[to_additive]
theorem disjoint_def {p₁ p₂ : Submonoid M} : Disjoint p₁ p₂ ↔ ∀ {x : M}, x ∈ p₁ → x ∈ p₂ → x = 1 :=
  by simp_rw [disjoint_iff_inf_le, SetLike.le_def, mem_inf, and_imp, mem_bot]
#align submonoid.disjoint_def Submonoid.disjoint_def
#align add_submonoid.disjoint_def AddSubmonoid.disjoint_def

@[to_additive]
theorem disjoint_def' {p₁ p₂ : Submonoid M} :
    Disjoint p₁ p₂ ↔ ∀ {x y : M}, x ∈ p₁ → y ∈ p₂ → x = y → x = 1 :=
  disjoint_def.trans ⟨fun h _ _ hx hy hxy => h hx <| hxy.symm ▸ hy, fun h _ hx hx' => h hx hx' rfl⟩
#align submonoid.disjoint_def' Submonoid.disjoint_def'
#align add_submonoid.disjoint_def' AddSubmonoid.disjoint_def'

end Submonoid

namespace MonoidHom

variable [MulOneClass N]

open Submonoid

/-- The submonoid of elements `x : M` such that `f x = g x` -/
@[to_additive "The additive submonoid of elements `x : M` such that `f x = g x`"]
def eqLocusM (f g : M →* N) : Submonoid M where
  carrier := { x | f x = g x }
  one_mem' := by rw [Set.mem_setOf_eq, f.map_one, g.map_one]
  mul_mem' (hx : _ = _) (hy : _ = _) := by simp [*]
#align monoid_hom.eq_mlocus MonoidHom.eqLocusM
#align add_monoid_hom.eq_mlocus AddMonoidHom.eqLocusM

@[to_additive (attr := simp)]
theorem eqLocusM_same (f : M →* N) : f.eqLocusM f = ⊤ :=
  SetLike.ext fun _ => eq_self_iff_true _
#align monoid_hom.eq_mlocus_same MonoidHom.eqLocusM_same
#align add_monoid_hom.eq_mlocus_same AddMonoidHom.eqLocusM_same

/-- If two monoid homomorphisms are equal on a set, then they are equal on its submonoid closure. -/
@[to_additive
      "If two monoid homomorphisms are equal on a set, then they are equal on its submonoid
      closure."]
theorem eqOn_closureM {f g : M →* N} {s : Set M} (h : Set.EqOn f g s) : Set.EqOn f g (closure s) :=
  show closure s ≤ f.eqLocusM g from closure_le.2 h
#align monoid_hom.eq_on_mclosure MonoidHom.eqOn_closureM
#align add_monoid_hom.eq_on_mclosure AddMonoidHom.eqOn_closureM

@[to_additive]
theorem eq_of_eqOn_topM {f g : M →* N} (h : Set.EqOn f g (⊤ : Submonoid M)) : f = g :=
  ext fun _ => h trivial
#align monoid_hom.eq_of_eq_on_mtop MonoidHom.eq_of_eqOn_topM
#align add_monoid_hom.eq_of_eq_on_mtop AddMonoidHom.eq_of_eqOn_topM

@[to_additive]
theorem eq_of_eqOn_denseM {s : Set M} (hs : closure s = ⊤) {f g : M →* N} (h : s.EqOn f g) :
    f = g :=
  eq_of_eqOn_topM <| hs ▸ eqOn_closureM h
#align monoid_hom.eq_of_eq_on_mdense MonoidHom.eq_of_eqOn_denseM
#align add_monoid_hom.eq_of_eq_on_mdense AddMonoidHom.eq_of_eqOn_denseM

end MonoidHom

end NonAssoc

section Assoc

variable [Monoid M] [Monoid N] {s : Set M}

section IsUnit

/-- The submonoid consisting of the units of a monoid -/
@[to_additive "The additive submonoid consisting of the additive units of an additive monoid"]
def IsUnit.submonoid (M : Type _) [Monoid M] : Submonoid M where
  carrier := setOf IsUnit
  one_mem' := by simp only [isUnit_one, Set.mem_setOf_eq]
  mul_mem' := by
    intro a b ha hb
    rw [Set.mem_setOf_eq] at *
    exact IsUnit.mul ha hb
#align is_unit.submonoid IsUnit.submonoid
#align is_add_unit.add_submonoid IsAddUnit.addSubmonoid

@[to_additive]
theorem IsUnit.mem_submonoid_iff {M : Type _} [Monoid M] (a : M) :
    a ∈ IsUnit.submonoid M ↔ IsUnit a := by
  change a ∈ setOf IsUnit ↔ IsUnit a
  rw [Set.mem_setOf_eq]
#align is_unit.mem_submonoid_iff IsUnit.mem_submonoid_iff
#align is_add_unit.mem_add_submonoid_iff IsAddUnit.mem_addSubmonoid_iff

end IsUnit

namespace MonoidHom

open Submonoid

/-- Let `s` be a subset of a monoid `M` such that the closure of `s` is the whole monoid.
Then `MonoidHom.ofClosureEqTopLeft` defines a monoid homomorphism from `M` asking for
a proof of `f (x * y) = f x * f y` only for `x ∈ s`. -/
@[to_additive
      "Let `s` be a subset of an additive monoid `M` such that the closure of `s` is
      the whole monoid. Then `AddMonoidHom.ofClosureEqTopLeft` defines an additive monoid
      homomorphism from `M` asking for a proof of `f (x + y) = f x + f y` only for `x ∈ s`. "]
def ofClosureMEqTopLeft {M N} [Monoid M] [Monoid N] {s : Set M} (f : M → N) (hs : closure s = ⊤)
    (h1 : f 1 = 1) (hmul : ∀ x ∈ s, ∀ (y), f (x * y) = f x * f y) :
    M →* N where
  toFun := f
  map_one' := h1
  map_mul' x :=
    (dense_induction (p := _) x hs hmul fun y => by rw [one_mul, h1, one_mul]) fun a b ha hb y => by
      rw [mul_assoc, ha, ha, hb, mul_assoc]
#align monoid_hom.of_mclosure_eq_top_left MonoidHom.ofClosureMEqTopLeft
#align add_monoid_hom.of_mclosure_eq_top_left AddMonoidHom.ofClosureMEqTopLeft

@[to_additive (attr := simp, norm_cast)]

/-- Let `s` be a subset of a monoid `M` such that the closure of `s` is the whole monoid.
Then `MonoidHom.ofClosureEqTopRight` defines a monoid homomorphism from `M` asking for
a proof of `f (x * y) = f x * f y` only for `y ∈ s`. -/
@[to_additive
      "Let `s` be a subset of an additive monoid `M` such that the closure of `s` is
      the whole monoid. Then `AddMonoidHom.ofClosureEqTopRight` defines an additive monoid
      homomorphism from `M` asking for a proof of `f (x + y) = f x + f y` only for `y ∈ s`. "]
def ofClosureMEqTopRight {M N} [Monoid M] [Monoid N] {s : Set M} (f : M → N) (hs : closure s = ⊤)
    (h1 : f 1 = 1) (hmul : ∀ (x), ∀ y ∈ s, f (x * y) = f x * f y) :
    M →* N where
  toFun := f
  map_one' := h1
  map_mul' x y :=
    dense_induction y hs (fun y hy x => hmul x y hy) (by simp [h1])
      (fun y₁ y₂ (h₁ : ∀ x, f _ = f _ * f _) (h₂ : ∀ x, f _ = f _ * f _) x => by
        simp [← mul_assoc, h₁, h₂]) x
#align monoid_hom.of_mclosure_eq_top_right MonoidHom.ofClosureMEqTopRight
#align add_monoid_hom.of_mclosure_eq_top_right AddMonoidHom.ofClosureMEqTopRight

@[to_additive (attr := simp, norm_cast)]
theorem coe_ofClosureMEqTopRight (f : M → N) (hs : closure s = ⊤) (h1 hmul) :
    ⇑(ofClosureMEqTopRight f hs h1 hmul) = f :=
  rfl
#align monoid_hom.coe_of_mclosure_eq_top_right MonoidHom.coe_ofClosureMEqTopRight
#align add_monoid_hom.coe_of_mclosure_eq_top_right AddMonoidHom.coe_ofClosureMEqTopRight

end MonoidHom

end Assoc


/-
(1) Boo! Happy Halloween!
(2) You gotta love the ℕs!
(3) Notes from Tue in IN
(4) Weather warning.
(3) No exam on Tuesday.
-/

/-
Review: We define day to be a type.
-/
inductive day : Type
/-
Type is the type of *computational* types.
Constructors define the values of the type.
-/
| mon
| tue
| wed
| thu
| fri
| sat
| sun

/-
Now we can define variables of this type.
-/

open day

def d : day :=
    tue

/-
NEW IDEA: another syntax for defintions
Definition now given by a "PROOF SCRIPT"
-/

def d' : day :=
begin
    exact sat,
end

/-
***************************************
Propositions as Types, Proofs as Values
***************************************
-/

/-
We define emily's_from_cville to be a new
kind of type: a logical type as opposed to
a computational type. We understand this
*type* to represent a proposition. Now the
question, is what does it mean to have a
proof of such a proposition?

Informally, we might say that we'll take
a driver's license, passport, or utility
bill as a proof. We can formalize this idea
by defining drivers_license, passport, and
proof to be *values* of this type! We have
a proof of a proposition if we can produce
a value of its type!
-/
inductive emily's_from_cville : Prop
/-
Constructors define the values, which we
now accept as "proofs" of the proposition
Proofs in Lean are values of *logical* types.
-/
| drivers_license
| passport
| utility_bill

open emily's_from_cville

-- Proofs represented formally as *values*
def a_proof : emily's_from_cville  :=
    passport

theorem a_proof' : emily's_from_cville :=
    utility_bill

theorem a_proof'' : emily's_from_cville  :=
begin
    exact utility_bill,
end

/-
Note the use of def in the first example and
theorem in the second. There is no practical
difference. We use "theorem" to inform the
reader that we intend to produce a proof of
a proposition.
-/

/-
****************************************
Predicates as parameterized propositions
****************************************
-/

/-
Here's aother data (computational) type.
-/
inductive person : Type
| mari
| jose
| jane
| bill

open person

inductive mari_is_from_cville : Prop
| yes_she_is

#check mari_is_from_cville

open mari_is_from_cville

theorem mari_proof : mari_is_from_cville := yes_she_is

/-
We can generalize from a specific proposition,
such as *emily* is from charlottesville to one
that allows us to assert that any given person
is from charlottesville. We do this by adding
a parameter.

The result is what we call a predicate. We can
say that a predicate is a proposition with a
parameter. When applied to an argument of the
right type, the result is again a proposition.

Ex: inductive is_from_cville : person → Prop

The constructors of the parameterized type define
the set of proofs that can be produced for  each
of the corresponding propositions.
-/

inductive is_from_cville : person → Prop
| proof_for :
    ∀ (p : person),
        p = mari → is_from_cville p

#check is_from_cville
#check is_from_cville mari
#check is_from_cville jose
#check is_from_cville jane
#check is_from_cville bill

open is_from_cville

#check proof_for
/-
Think of a proof of a "∀" proposition
as being like a function. A constructor
is a proof. In particular, proof_for can
be understood as a proof of the ∀ claim.
So we can treat proof_for as a function
that takes a person as an argument and
that returns a proposition, obtained by
applying the predicate on the right of
the comma to the given argument.
-/
#check proof_for mari
#check proof_for jose
#check proof_for bill

theorem mifc : is_from_cville mari :=
begin
    apply proof_for _ _,
    apply eq.refl mari,
end

theorem bifc : is_from_cville bill :=
begin
    apply proof_for,
    _
end

/-
What we're seeing here is what we call
the elimination principle for proofs of
∀ propositions. We can treat such a proof
as a function and apply it to a particular
object of the quantified type to get a
proof for the stated proposition *about
that particular object*.

Here' we get back proofs of proposition
such as mari = mari → is_from_cvill mari
and bill = mari → is_from_cville bill.

Each of these is a proof of an implication,
of the form P → Q, which we can also treat
as a kind of function: if we can produce a
proof of a premise, then we can apply the
proof-of-implication/function to it to get
a proof of the conclusion.

In this case, we will be able to construct
and thereby obtain a proof of mari = mari,
but there is no proof of bill = mari, so we
will be able to construct a proof of the
proposition, (is_from_cville mari) but not
one of (is_from_cville bill).
-/

/-
Understand that the constructors of a type are to
be understood as the "axioms," or fundamental rules
of reasoning, for a given type. They tell us exactly
how we can produce values (or proofs) of a given type
(or proposition, understood as a type).
-/

/-
As an example, suppose we to prove the proposition
that mari is from cville. Formally we'd state this
as the proposition (is_from_cville mari). To prove it,
we need to construct a proof. To do that, we have to
use the only available "reasoning rule", which is
given by the one constructor for this type, namely:

proof_for : ∀ (p : person), p = mari → is_from_cville p

What this says is that for any person, p, *if* you
have a proof that (p = mari) then you can derive a
proof of (is_from_cville mari).

In plain English, the proof would thus go like this:

"To produce a proof of (is_from_cville mari) we first
apply the `proof_for' rule to mari to conclude that
(mari = mari) → is_from_cville mari. To prove the
conclusion, it will suffice to produce a proof of
(mari = mari). But this follows from the reflexivity
of the equality relation. QED."

Now look at what happens if we try to prove jane is
from cville. We apply proof_for to jane, yielding the
proposition, (jane = mari) → is_from_cville jane. The
conclusion is what we want, but to reach it, we have
to produce a proof of (jane = mari), and there is no
way to do that because jane and mari are different
people. So we are stuck, with no way to build the
proof we require.
-/

/-
******************************************
Predicates define properties and relations
******************************************
-/

/-
The is_from_cville predicate defines the
"property" of being from Charlottesville.
Only mari has this property according to
our definitions, because only for mari is
there a proof.

A predicate of one argument defines proofs
for none, some, or all values of its argument
type and thereby identifies those with the
given property.

A predicate of two arguments similarly
defines a *relation*: a set of pairs of
values that have a given property. The
equality relation is a very good example.

We accept as an axiom that there is a
proof for every proposition of the form,
a = a, no matter what type of thing a is,
and that there are no other proofs of
equalities. (Slight footnote here.)

This idea is formalized in Lean with a
predicate called that takes two arguments
(of any given type -- it's polymorphic),
for which there's a proof only if both
are the same. Convention infix notation
uses the = operator.
-/

#check eq 4 4
#check eq 4 5
#check 4 = 5
#check eq "Hi" "Hi"

/-
Each of these terms is a proposition/type.
There are proofs for those that are true!
The proofs are constructed by a constructor
called refl defined for the eq type. We
refer to it as eq.refl. It takes *one*
argument, a, and yields a proof/value of
type a = a. It's thus impossible to create
a proof of a = b unless a and b are really
equal to each other!
-/

#check (eq.refl 3)
#check (eq.refl "Hi")
#check (eq.refl mari)

/-
The term, (proof_for mari (eq.refl mari)), is accepted
as a value of type (is_from_cville mari), i.e., as a
proof that mari is from charlottesville. Can we construct
a proof
-/

theorem mari_is_from_cville' : is_from_cville mari :=
begin
    apply proof_for mari _,
    exact (eq.refl mari),
    _
end

-- YAY!

theorem mari_is_from_cville'' : is_from_cville mari :=
begin
    apply proof_for _ _,    -- lean infer first arg!
    --exact mari,
    exact (eq.refl mari),
end

theorem bill_is_from_cville : is_from_cville bill :=
begin
    apply proof_for _ _,    -- lean infer first arg!
    --exact mari,
    exact (eq.refl mari),   -- no way
end

/-
End of lecture
-/

/-
Some comments about function definitions.
Consider the following simple definition.
-/

def evenb (n : ℕ) : bool :=
    n % 2 = 0

#eval evenb 3
#eval evenb 4

#check evenb

def evenb' : ℕ → bool :=
    λ n, n % 2 = 0

def evenb'' : Π (n : ℕ), bool :=
    λ n, n % 2 = 0

#eval evenb'' 5

def evenb''' : ∀ (n : ℕ), bool :=
    λ n, n % 2 = 0

#eval evenb''' 6

/-
Predicates are often used to represent properties
of objects, here, a property of people, namely
the property of a person being from Cville.
-/

inductive is_zero : ℕ → Prop
| zmk: ∀ (n : ℕ), n = 0 → is_zero n

open is_zero

theorem zero_is_zero_0 : is_zero 0 :=
    zmk 0 (eq.refl 0)

/-
Even: inductively defined proofs
-/

inductive is_even : ℕ → Prop
| pf_zero_is_even : (is_even 0)
| pf_even_plus_two_is_even :
    ∀ (n : ℕ), is_even n → is_even (nat.succ (nat.succ n))

open is_even

theorem zero_is_even : is_even 0 :=
    pf_zero_is_even

theorem zero_is_even' : is_even 0 :=
begin
    exact pf_zero_is_even
end

/-
Inductive
-/

theorem two_is_even : is_even 2 :=
    pf_even_plus_two_is_even 0 zero_is_even

theorem four_is_even : is_even 4 :=
    pf_even_plus_two_is_even 2 two_is_even

theorem ten_is_even : is_even 1000 :=
begin
    repeat { apply pf_even_plus_two_is_even },
    exact pf_zero_is_even,
end

#print ten_is_even

theorem two_is_even' : is_even 2 :=
begin
    apply pf_even_plus_two_is_even 0 zero_is_even,
end

theorem two_is_even'' : is_even 2 :=
begin
    apply pf_even_plus_two_is_even 0 _,
    exact zero_is_even,
end

theorem two_is_even''' : is_even 2 :=
begin
    apply pf_even_plus_two_is_even _ _,
    exact zero_is_even,
end

theorem two_is_even'''' : is_even 2 :=
begin
    apply pf_even_plus_two_is_even,
    exact zero_is_even,
end

theorem four_is_even' : is_even 4 :=
    pf_even_plus_two_is_even 2 two_is_even

theorem four_is_even'' : is_even 4 :=
begin
    apply pf_even_plus_two_is_even 2 two_is_even,
end

theorem four_is_even''' : is_even 4 :=
begin
    apply pf_even_plus_two_is_even,
    apply two_is_even,
end

theorem four_is_even'''' : is_even 4 :=
begin
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    apply zero_is_even,
end

theorem ten_is_even' : is_even 10 :=
begin
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    exact zero_is_even,
end

#print ten_is_even'

-- Here's some automation in Lean
theorem ten_is_even'' : is_even 10 :=
begin
    repeat {apply pf_even_plus_two_is_even},
    exact zero_is_even,
end

inductive successor_of : ℕ → ℕ → Prop
| mk : ∀ (n : ℕ), successor_of (nat.succ n) n

theorem five_succ_four : successor_of 5 4 :=
    successor_of.mk 4

inductive equal_to_nat : ℕ → ℕ → Prop
| refl : ∀ (n : ℕ), equal_to_nat n n

theorem five_equals_five : equal_to_nat 5 5 :=
    equal_to_nat.refl 5

theorem five_equals_five' : equal_to_nat 5 5 :=
begin
    apply equal_to_nat.refl _,
end

inductive equal_to_nat' (n : ℕ) :  ℕ → Prop
| refl : ∀ (n : ℕ), equal_to_nat' n

#check equal_to_nat
#check equal_to_nat'

theorem five_eq_five'' : equal_to_nat' 5 5 :=
    equal_to_nat'.refl 5 5

inductive equal_to {α : Type} : α → α → Prop
| refl : ∀ (a : α), equal_to a a