import data.matrix.basic
import analysis.normed_space.inner_product
import algebra.big_operators.default

open_locale big_operators
open is_R_or_C

------------------------------------------------------------------------------
-- ℝ lemmas

lemma real.le_of_le_pow_two {a b : ℝ} : a^2 ≤ b^2 → 0 ≤ a → 0 ≤ b → a ≤ b
:= begin
    intros h an bn,
    rw <- real.sqrt_mul_self an,
    rw <- real.sqrt_mul_self bn,
    iterate 2 { rw pow_two at h },
    apply real.sqrt_le_sqrt; assumption,
end

------------------------------------------------------------------------------
-- Begining of the namespace `matrix`

namespace matrix

-- We could use `has_star.star`, but `inner_product_space` expects `is_R_or_C` anyways.
local notation x `†`:90 := is_R_or_C.conj x
local notation |x| := is_R_or_C.abs x

------------------------------------------------------------------------------
-- matrix.conj for vectors

section conjugate

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type}

/--
Conjugate of a vector.
-/
def conj (v : m → 𝕜) : m → 𝕜 := λ i : m, (v i)†

end conjugate

------------------------------------------------------------------------------
-- matrix.conj lemmas

section conj_lemmas

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type}
variables {x y : m → 𝕜}

variable {s : 𝕜}

@[simp]
lemma conj_zero : conj 0 = (0 : m → 𝕜)
:= begin
    unfold conj,
    ext1 i, simp,
end

lemma conj_smul : conj (s • x) = s† • conj x
:= begin
    unfold conj,
    ext1 i,
    iterate 2 { rw pi.smul_apply }, simp,
end

lemma conj_add : conj (x + y) = conj x + conj y
:= begin
    unfold conj,
    ext1 i,
    iterate 2 { rw pi.add_apply }, simp,
end

lemma conj_neg : conj (-x) = - conj x
:= begin
    unfold conj,
    ext1 i,
    simp,
end

end conj_lemmas

------------------------------------------------------------------------------
-- matrix.inner_product for vectors

section inner_product

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]

/--
Inner product of vectors.
Following analysis.normed_space.inner_product's convention that
inner products are conjugate linear in the first argument and linear
in the second.
-/
def inner_product (x y : m → 𝕜) : 𝕜 := dot_product (conj x) y

instance : has_inner 𝕜 (m → 𝕜) := ⟨inner_product⟩

end inner_product

-- `⟪x, y⟫` : inner product notation.
-- `⟨ , ⟩` is already taken in Lean. So, use  `⟪ , ⟫`, instead.
-- Also, it's consistent with analysis.normed_space.inner_product's other notations.
local notation `⟪` X `,` Y `⟫` := inner_product X Y

------------------------------------------------------------------------------
-- matrix.inner_product lemmas

section inner_product_lemmas

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]
variables {x y z : m → 𝕜}

lemma inner_product_self_eq_sum_conj_mul : ⟪x, x⟫ = ∑ i, ((x i)†) * x i := by refl

lemma inner_product_self_eq_sum_norm_sq : ⟪x, x⟫ = ∑ i, norm_sq (x i)
:= begin
    rw inner_product_self_eq_sum_conj_mul,
    congr, apply funext, intro i,
    rw conj_mul_eq_norm_sq_left,
end

@[simp]
lemma inner_product_self_im_zero : im ⟪x, x⟫ = 0
:= begin
    rw inner_product_self_eq_sum_norm_sq,
    rw <- finset.univ.sum_hom im,
    apply finset.sum_eq_zero, intros i ip, simp,
    split, simp,
end

@[simp]
lemma inner_product_self_re_eq_self : (re ⟪x,x⟫ : 𝕜) = ⟪x,x⟫
:= begin
    rw inner_product_self_eq_sum_norm_sq,
    rw <- finset.univ.sum_hom re, {
        simp,
    }, {
        split, simp,
    }
end

-- Positive semi-definite or nonnegative-definite
@[simp]
lemma inner_product_self_re_nonneg (x : m → 𝕜) : 0 ≤ re ⟪x, x⟫
:= begin
    rw inner_product_self_eq_sum_norm_sq,
    rw <- finset.univ.sum_hom re, {
        apply finset.sum_nonneg,
        intros i ip, simp,
        apply norm_sq_nonneg,
    }, {
        split, simp,
    }
end

-- Point-separating or non-degenerate
lemma inner_product_self_zero : ⟪x, x⟫ = 0 → x = 0
:= begin
    rw inner_product_self_eq_sum_norm_sq,
    intros h,

    have h': ∑ (i : m), norm_sq (x i) = 0, {
        apply_mod_cast h,
    },
    clear h,

    have f1: ∀ i, norm_sq (x i) = 0, {
        intro i,
        apply (finset.sum_eq_zero_iff_of_nonneg _).mp h'; simp,
        intros, apply norm_sq_nonneg,
    },

    have f2: ∀ i, x i = 0, {
        intros i,
        apply norm_sq_eq_zero.mp; apply f1,
    },

    ext i,
    apply f2,
end

lemma inner_product_self_add : ⟪x+y , x+y⟫ = ⟪x,x⟫ + ⟪x,y⟫ + ⟪y,x⟫ + ⟪y,y⟫
:= begin
    unfold inner_product,
    rw conj_add,
    repeat { rw add_dot_product },
    repeat { rw dot_product_add },
    ring,
end

@[simp]
lemma inner_product_self_neg : ⟪-x, -x⟫ = ⟪x, x⟫
:= begin
    unfold inner_product,
    rw conj_neg, simp,
end

variable {s : 𝕜}

lemma inner_product_smul_l {s : 𝕜} : ⟪s • x, y⟫ = (s†) * ⟪x, y⟫
:= begin
    unfold inner_product,
    rw conj_smul,
    rw smul_dot_product,
end

lemma inner_product_smul_r {s : 𝕜} : ⟪x, s • y⟫ = s * ⟪x, y⟫
:= begin
    unfold inner_product,
    rw dot_product_smul,
end

lemma inner_product_add_left : ⟪x + y, z⟫ = ⟪x, z⟫ + ⟪y, z⟫
:= begin
    unfold inner_product,
    rw conj_add,
    rw add_dot_product,
end

lemma inner_product_add_right : ⟪x, y + z⟫ = ⟪x, y⟫ + ⟪x, z⟫
:= begin
    unfold inner_product,
    rw dot_product_add,
end

@[simp]
lemma inner_product_zero_r : ⟪x,(0 : m → 𝕜)⟫ = 0
:= by { unfold inner inner_product, simp, }

@[simp]
lemma inner_product_zero_l : ⟪(0 : m → 𝕜),x⟫ = 0
:= by { unfold inner inner_product, simp, }

@[simp]
lemma conj_inner_product : ⟪y, x⟫† = ⟪x, y⟫
:= begin
    unfold matrix.inner_product,
    unfold matrix.dot_product,
    rw <- finset.univ.sum_hom is_R_or_C.conj, {
        congr' 1, apply funext, intro i,
        unfold conj,
        simp, ring,
    }, {
        split; simp,
    }
end

lemma inner_product_mul_eq_norm_sq : ⟪x, y⟫ * ⟪y, x⟫ = norm_sq ⟪y, x⟫
:= begin
    rw <- conj_inner_product,
    rw conj_mul_eq_norm_sq_left,
end

lemma abs_inner_product_comm : |⟪x, y⟫| = |⟪y, x⟫|
:= begin
    rw <- conj_inner_product,
    rw is_R_or_C.abs_conj,
end

lemma re_inner_product_comm : re ⟪x, y⟫ = re ⟪y, x⟫
:= begin
    rw <- conj_inner_product,
    apply conj_re,
end

end inner_product_lemmas

------------------------------------------------------------------------------
-- matrix.norm for a vector

section norm

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]

/--
Norm of a vector
-/
noncomputable
def norm (x : m → 𝕜) : ℝ := (re ⟪x, x⟫).sqrt

noncomputable
instance : has_norm (m → 𝕜) := ⟨norm⟩

-- Use the standard norm notation of `∥x∥`

end norm

------------------------------------------------------------------------------
-- matrix.norm lemmas

section norm_lemmas

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]
variables {x : m → 𝕜}

lemma norm_smul (s : 𝕜) : norm (s • x) = ∥s∥ * norm x
:= begin
    have f1: ∥s∥ = real.sqrt (norm_sq s), {
        rw norm_sq_eq_abs,
        rw pow_two,
        rw real.sqrt_mul_self, {
            apply norm_eq_abs,
        }, {
            apply is_R_or_C.abs_nonneg,
        }
    },
    rw f1, clear f1,

    unfold norm,
    rw inner_product_smul_l,
    rw inner_product_smul_r,
    rw <- mul_assoc,
    rw conj_mul_eq_norm_sq_left,
    simp,
end

@[simp]
lemma norm_zero : norm (0 : m → 𝕜) = 0
:= begin
    unfold norm, simp [inner_product_self_eq_sum_norm_sq],
end

@[simp]
lemma norm_nonneg : 0 ≤ norm x
:= begin
    unfold norm, apply real.sqrt_nonneg,
end

@[simp]
lemma norm_neg : norm (-x) = norm x
:= begin
    unfold norm, simp,
end

end norm_lemmas

-- has_norm.norm lemmas for proof automation
section has_norm_lemmas

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]
variables {x : m → 𝕜}

lemma has_norm_sq_eq_re_inner_product_self : ∥x∥^2 = re ⟪x, x⟫
:= begin
    unfold has_norm.norm norm,
    rw pow_two,
    rw real.mul_self_sqrt, simp,
end

@[simp]
lemma has_norm_zero : ∥(0 : m → 𝕜)∥ = 0
:= begin
    unfold has_norm.norm norm, simp,
end

@[simp]
lemma has_norm_nonneg : 0 ≤ ∥x∥
:= begin
    unfold has_norm.norm norm,
    apply real.sqrt_nonneg,
end

end has_norm_lemmas

------------------------------------------------------------------------------
-- cauchy_schwarz_inequality

section cauchy_schwarz_inequality

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]
variables {u v : m → 𝕜}

lemma cauchy_schwarz_inequality_step1 : ∥u + v∥^2 = (∥u∥^2 + re ⟪u,v⟫) + (re ⟪v,u⟫ + ∥v∥^2)
:= begin
    iterate 3 { rw has_norm_sq_eq_re_inner_product_self },
    repeat { rw pow_two },

    unfold inner inner_product,
    rw conj_add,
    rw dot_product_add,
    iterate 2 { rw add_dot_product },
    have vector_add_apply: ∀ {i : m} {x y : m → 𝕜}, (x + y) i = (x i) + (y i), by {intros, simp},
    repeat { rw vector_add_apply },
    simp,
    ring,
end

lemma cauchy_schwarz_inequality_step2_1 : ⟪u,(-(⟪v,u⟫/⟪v,v⟫)) • v⟫ = -|⟪u,v⟫|^2/⟪v,v⟫
:= begin
    rw inner_product_smul_r,
    simp,
    ring,
    rw mul_assoc,
    rw mul_comm,
    rw mul_assoc,
    rw inner_product_mul_eq_norm_sq,
    rw norm_sq_eq_abs, simp,
    ring,
end

lemma cauchy_schwarz_inequality_step2_2 : ⟪(-(⟪v,u⟫/⟪v,v⟫)) • v, u⟫ = -|⟪u,v⟫|^2/⟪v,v⟫
:= begin
    rw inner_product_smul_l,
    simp,
    rw is_R_or_C.conj_div,
    rw conj_inner_product,
    simp,
    ring,
    simp,
    rw mul_assoc,
    rw mul_comm,
    rw mul_assoc,
    rw inner_product_mul_eq_norm_sq,
    rw norm_sq_eq_abs,
    norm_cast,
    repeat { rw <- is_R_or_C.abs_to_complex },
    rw abs_inner_product_comm,
    ring,
end

lemma cauchy_schwarz_inequality_step2_3 : v ≠ 0 → ∥-(⟪v,u⟫/⟪v,v⟫) • v∥ ^ 2 = |⟪u,v⟫|^2/(re ⟪v,v⟫)
:= begin
    intro h,
    rw has_norm_sq_eq_re_inner_product_self,
    rw inner_product_smul_l,
    rw inner_product_smul_r,
    rw <- mul_assoc,

    have f1: (-(⟪v,u⟫ / ⟪v,v⟫))† * (-(⟪v,u⟫ / ⟪v,v⟫))
           = norm_sq (⟪v,u⟫ / ⟪v,v⟫), {
        simp [conj_mul_eq_norm_sq_left],
    },
    rw f1, clear f1,
    rw norm_sq_div,
    simp,
    norm_cast,
    rw norm_sq_eq_abs,

    have f2: norm_sq ⟪v,v⟫ = re ⟪v,v⟫ * re ⟪v,v⟫, {
        unfold norm_sq, simp,
    },
    rw f2, clear f2,
    ring,
    congr' 1, {
        rw mul_inv',
        rw <- mul_assoc,
        rw mul_inv_cancel, simp *,
        revert h,
        contrapose!,
        intro h,
        apply inner_product_self_zero,
        have f3: (re ⟪v,v⟫ : 𝕜) = 0, {
            rw h, simp,
        },
        simp at f3, apply f3,
    }, {
        repeat { rw <- is_R_or_C.abs_to_complex },
        rw abs_inner_product_comm,
    }
end

-- The equality part.
lemma cauchy_schwarz_inequality_part1 :
        v ≠ 0
        → ∥u - (⟪v,u⟫/⟪v,v⟫) • v∥ ^ 2 = ∥u∥^2 - re (|⟪u,v⟫|^2 / ⟪v,v⟫ : 𝕜)
:= begin
    intros h,
    -- Step 1. Change the equation to (A + B) = (C + 0) form,
    have f1: u - (⟪v,u⟫/⟪v,v⟫) • v = u + (-(⟪v,u⟫/⟪v,v⟫)) • v, {
        simp, ring,
    },
    rw f1,
    rw cauchy_schwarz_inequality_step1,

    have f2: ∥u∥^2 - re (|⟪u,v⟫|^2 / ⟪v,v⟫ : 𝕜) = (∥u∥^2 + re (-|⟪u,v⟫|^2 / ⟪v,v⟫ : 𝕜)) + 0, {
        rw neg_div, simp, ring,
    },
    rw f2,

    -- Step 2. Solve individual sub-equations of A = C and B = 0.
    congr' 1, {
        congr' 1,
        have f3: re (⟪u,(-(⟪v,u⟫/⟪v,v⟫)) • v⟫) = re (-|⟪u,v⟫|^2/⟪v,v⟫ : 𝕜), {
            rw cauchy_schwarz_inequality_step2_1,
        },
        apply f3,
    }, {
        rw cauchy_schwarz_inequality_step2_2,
        rw cauchy_schwarz_inequality_step2_3 h,
        have f4: ∀ {r s : ℝ}, r = -s → r + s = 0, {intros r s h, rw h, simp,},
        apply f4,
        have f5: ∀ {r s : ℝ}, -(r/s) = re (-r / s : 𝕜), {
            intros, norm_cast, ring,
        },
        rw f5, clear f5, simp,
    }
end

theorem cauchy_schwarz_inequality : |⟪u,v⟫|^2 ≤ ∥u∥^2 * ∥v∥^2
:= begin
    by_cases h: v = 0, {
        rw h,
        repeat { rw pow_two },
        simp,
    },

    -- case h: v ≠ 0,
    have f1: 0 ≤ ∥u∥^2 - re (|⟪u,v⟫|^2 / ⟪v,v⟫ : 𝕜), {
        rw <- cauchy_schwarz_inequality_part1; try {assumption},
        rw has_norm_sq_eq_re_inner_product_self, simp,
    },
    have f2: re (|⟪u,v⟫|^2 / ⟪v,v⟫ : 𝕜) ≤ ∥u∥^2, {
        have g1: ∀ (r s : ℝ), 0 ≤ r - s → s ≤ r, simp,
        apply g1,
        apply f1,
    },
    have f3: |⟪u,v⟫|^2 / ∥v∥^2 ≤ ∥u∥^2, {
        rw has_norm_sq_eq_re_inner_product_self,
        have f3': ∀ {r s : ℝ}, r/s = re (r / s : 𝕜), {
            intros, norm_cast,
        },
        rw f3', simp,
        apply_mod_cast f2,
    },
    clear f1 f2,
    apply (div_le_iff _).mp; try {assumption},
    clear f3,
    rw has_norm_sq_eq_re_inner_product_self,

    let f4 := inner_product_self_re_nonneg v,
    have f5: re ⟪v,v⟫ ≠ 0, {
        revert h, contrapose!, intro h,
        apply inner_product_self_zero,
        have f5': (re ⟪v,v⟫ : 𝕜) = 0, {
            rw h, simp,
        },
        simp at f5', apply f5',
    },

    by_contradiction c,
    push_neg at c,
    apply f5, clear f5,
    linarith,
end

lemma cauchy_schwarz_inequality_alt : |⟪u,v⟫| ≤ ∥u∥ * ∥v∥
:= begin
    apply real.le_of_le_pow_two, {
        calc |⟪u,v⟫|^2 ≤ ∥u∥^2 * ∥v∥^2 : cauchy_schwarz_inequality
                   ... = (∥u∥ * ∥v∥)^2 : by ring,
    }, {
        apply is_R_or_C.abs_nonneg,
    }, {
        apply mul_nonneg; simp,
    }
end

end cauchy_schwarz_inequality

------------------------------------------------------------------------------
section triangle_inequality
-- Wikipedia proof: depends on Cauchy-Schwarz inequality

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]
variables {x y : m → 𝕜}

lemma norm_sq_add_le_add_norm_sq : ∥x + y∥^2 ≤ (∥x∥ + ∥y∥)^2
:= begin
    -- Part 1. expand both sides of inequality
    rw has_norm_sq_eq_re_inner_product_self,
    rw inner_product_self_add,
    simp,

    repeat { rw pow_two },
    repeat { rw add_mul },
    repeat { rw mul_add },
    repeat { rw <- pow_two },
    repeat { rw has_norm_sq_eq_re_inner_product_self },

    have f0: re ⟪y,x⟫ = re ⟪x,y⟫, {
        rw re_inner_product_comm,
    },
    rw f0, clear f0,
    have f1: re ⟪x,x⟫ + re ⟪x,y⟫ + re ⟪x,y⟫ + re ⟪y,y⟫ = (re ⟪x,x⟫ + re ⟪y,y⟫) + (2 * re ⟪x,y⟫), {
        ring,
    },
    rw f1, clear f1,
    have f2: re ⟪x,x⟫ + ∥x∥ * ∥y∥ + (∥y∥ * ∥x∥ + re ⟪y,y⟫) = (re ⟪x,x⟫ + re ⟪y,y⟫) + 2 * ∥x∥ * ∥y∥, {
        ring,
    },
    rw f2, clear f2,

    -- Part 2. simplify inequality by canceling out identical terms
    simp,
    rw mul_assoc,

    have f3: re ⟪x,y⟫ ≤ (∥x∥ * ∥y∥) → 2 * re ⟪x,y⟫ ≤ 2 * (∥x∥ * ∥y∥), {
        intros h, linarith,
    },
    apply f3, clear f3,

    -- Part 3. solve the main inequality using Cauchy-Schwarz_inequality
    have f1: re ⟪x,y⟫ ≤ |re ⟪x,y⟫|, {
        simp, apply le_abs_self,
    },
    have f2: |re ⟪x,y⟫| ≤ |⟪x,y⟫|, {
        simp, apply abs_re_le_abs,
    },
    calc re ⟪x,y⟫ ≤ |re ⟪x,y⟫| : f1
              ... ≤ |⟪x,y⟫| : f2
              ... ≤ ∥x∥ * ∥y∥ : cauchy_schwarz_inequality_alt,
end

lemma triangle_inequality : ∥x + y∥ ≤ ∥x∥ + ∥y∥
:= begin
    apply real.le_of_le_pow_two; try {solve1 {simp}}, {
        apply norm_sq_add_le_add_norm_sq,
    }, {
        apply add_nonneg; simp,
    }
end

end triangle_inequality

------------------------------------------------------------------------------
-- dist

section dist

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]

/--
Distance between two vectors
-/
noncomputable
def dist (x y : m → 𝕜) := norm (x - y)

noncomputable
instance : has_dist (m → 𝕜) := ⟨dist⟩

end dist

------------------------------------------------------------------------------
-- dist lemmas

section dist_lemmas

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]
variables {x y z : m → 𝕜}

lemma dist_self : dist x x = 0
:= begin
    unfold dist, simp,
end

lemma eq_of_dist_eq_zero : dist x y = 0 → x = y
:= begin
    intros h,
    have h': (dist x y) ^ 2 = 0, {
        rw h, simp,
    },
    have f1: ⟪x - y, x - y⟫ = (0 : 𝕜), {
        unfold has_dist.dist dist norm at h',
        rw pow_two at h',
        rw real.mul_self_sqrt at h', {
            rw <- inner_product_self_re_eq_self,
            apply_mod_cast h',
        }, {
            simp,
        }
    },
    have f2: x - y = 0, {
        apply inner_product_self_zero f1,
    },
    have f2': x - y = y - y, {
        rw f2, simp,
    },
    apply sub_left_inj.mp f2',
end

lemma dist_comm : dist x y = dist y x
:= begin
    unfold has_dist.dist dist,
    have f1: y - x = -(x - y), simp,
    rw f1,
    rw norm_neg,
end

lemma dist_triangle : dist x z ≤ dist x y + dist y z
:= begin
    unfold dist,
    have f1: x - z = (x - y) + (y - z), by abel,
    rw f1, clear f1,
    apply triangle_inequality,
end

end dist_lemmas

------------------------------------------------------------------------------
-- normed_group

section normed_group

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]
variables {x y z : m → 𝕜}

noncomputable
instance : metric_space (m → 𝕜) := {
    dist               := dist,
    dist_self          := by {apply dist_self},
    eq_of_dist_eq_zero := by {apply eq_of_dist_eq_zero},
    dist_comm          := by {apply dist_comm},
    dist_triangle      := by {apply dist_triangle},
}

lemma dist_eq (x y : m → 𝕜) : dist x y = ∥x - y∥ := by refl

noncomputable
instance : normed_group (m → 𝕜) := ⟨ dist_eq ⟩

end normed_group

------------------------------------------------------------------------------
-- inner_product_space

section inner_product_space

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {m : Type} [fintype m]
variables {x : m → 𝕜}

noncomputable
instance : normed_space 𝕜 (m → 𝕜) := {
    norm_smul_le := by {
        intros,
        unfold has_norm.norm,
        rw norm_smul,
    }
}

noncomputable
instance : inner_product_space 𝕜 (m → 𝕜) := {
    norm_sq_eq_inner := by {unfold inner, intros, rw has_norm_sq_eq_re_inner_product_self},
    conj_sym := by {unfold inner, intros, rw <- conj_inner_product, simp},
    add_left := by {unfold inner, apply inner_product_add_left},
    smul_left := by {unfold inner, apply inner_product_smul_l},
}

end inner_product_space

------------------------------------------------------------------------------
-- End of namespace `matrix`

end matrix


-- Copyright © 2019 François G. Dorais. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.

import .basic
import .monoid
import .loop

set_option default_priority 0

namespace algebra

signature group (α : Type*) :=
(op : α → α → α)
(inv : α → α)
(id : α)

namespace group_sig
variables {α : Type*} (s : group_sig α)

abbreviation ldiv (x y : α) := s.op (s.inv x) y -- (λ x y, x⁻¹ ∙ y)

abbreviation rdiv (x y : α) := s.op x (s.inv y) -- (λ x y, x ∙ y⁻¹)

@[signature_instance]
definition to_monoid : monoid_sig α :=
{ op := s.op
, id := s.id
}

@[signature_instance]
definition to_loop : loop_sig α :=
{ op := s.op
, ldiv := s.ldiv
, rdiv := s.rdiv
, id := s.id
}

end group_sig

variables {α : Type*} (s : group_sig α)
local infix ∙ := s.op
local postfix ⁻¹ := s.inv
local notation `e` := s.id

@[theory]
class group : Prop := intro ::
(associative : identity.op_associative s.op)
(right_identity : identity.op_right_identity s.op s.id)
(right_inverse : identity.op_right_inverse s.op s.inv s.id)

namespace group
variable [i : group s]
include i

@[identity_instance]
theorem right_cancellative : identity.op_right_cancellative s.op :=
λ x y z,
assume h : x ∙ y = z ∙ y,
show x = z,
from calc x
= x ∙ e : by rw op_right_identity s.op ...
= x ∙ (y ∙ y⁻¹) : by rw op_right_inverse s.op s.inv ...
= (x ∙ y) ∙ y⁻¹ : by rw op_associative s.op ...
= (z ∙ y) ∙ y⁻¹ : by rw h ...
= z ∙ (y ∙ y⁻¹) : by rw op_associative s.op ...
= z ∙ e : by rw op_right_inverse s.op s.inv ...
= z : by rw op_right_identity s.op

@[identity_instance]
theorem left_identity : identity.op_left_identity s.op s.id :=
λ x,
have (e ∙ x) ∙ x⁻¹ = x ∙ x⁻¹,
from calc (e ∙ x) ∙ x⁻¹
= e ∙ (x ∙ x⁻¹) : by rw op_associative s.op ...
= e ∙ e : by rw op_right_inverse s.op ...
= e : by rw op_right_identity s.op ...
= x ∙ x⁻¹ : by rw op_right_inverse s.op,
op_right_cancellative s.op this

@[identity_instance]
theorem left_inverse : identity.op_left_inverse s.op s.inv s.id :=
λ x,
have (x⁻¹ ∙ x) ∙ x⁻¹ = e ∙ x⁻¹,
from calc (x⁻¹ ∙ x) ∙ x⁻¹
= x⁻¹ ∙ (x ∙ x⁻¹) : by rw op_associative s.op ...
= x⁻¹ ∙ e : by rw op_right_inverse s.op s.inv ...
= x⁻¹ : by rw op_right_identity s.op ...
= e ∙ x⁻¹ : by rw op_left_identity s.op,
op_right_cancellative s.op this

@[identity_instance]
theorem left_cancellative : identity.op_left_cancellative s.op :=
λ x y z,
assume h : x ∙ y = x ∙ z,
show y = z,
from calc y
= e ∙ y : by rw op_left_identity s.op ...
= (x⁻¹ ∙ x) ∙ y : by rw op_left_inverse s.op ...
= x⁻¹ ∙ (x ∙ y) : by rw op_associative s.op ...
= x⁻¹ ∙ (x ∙ z) : by rw h ...
= (x⁻¹ ∙ x) ∙ z : by rw op_associative s.op ...
= e ∙ z : by rw op_left_inverse s.op ...
= z : by rw op_left_identity s.op

@[identity_instance]
theorem inv_fixpoint : identity.fn_fixpoint s.inv s.id :=
show e⁻¹ = e,
from calc e⁻¹
= e⁻¹ ∙ e : by rw op_right_identity s.op ...
= e : by rw op_left_inverse s.op

@[identity_instance]
theorem inv_involutive : identity.fn_involutive s.inv :=
λ x,
have x⁻¹⁻¹ ∙ x⁻¹ = x ∙ x⁻¹,
from calc x⁻¹⁻¹ ∙ x⁻¹
= e : by rw op_left_inverse s.op ...
= x ∙ x⁻¹ : by rw op_right_inverse s.op,
op_right_cancellative s.op this

@[identity_instance]
theorem inv_antimorphism : identity.fn_op_antimorphism s.inv s.op s.op :=
λ x y,
have (x ∙ y)⁻¹ ∙ (x ∙ y) = (y⁻¹ ∙ x⁻¹) ∙ (x ∙ y),
from calc (x ∙ y)⁻¹ ∙ (x ∙ y)
= e : by rw op_left_inverse s.op ...
= y⁻¹ ∙ y : by rw op_left_inverse s.op ...
= (y⁻¹ ∙ e) ∙ y : by rw op_right_identity s.op s.id ...
= (y⁻¹ ∙ (x⁻¹ ∙ x)) ∙ y : by rw op_left_inverse s.op ...
= ((y⁻¹ ∙ x⁻¹) ∙ x) ∙ y : by rw op_associative s.op y⁻¹ x⁻¹ x ...
= (y⁻¹ ∙ x⁻¹) ∙ (x ∙ y) : by rw op_associative s.op,
op_right_cancellative s.op this

@[identity_instance]
theorem left_division : identity.op_left_division s.op s.ldiv :=
λ x y,
show x ∙ (x⁻¹ ∙ y) = y,
from calc x ∙ (x⁻¹ ∙ y)
= (x ∙ x⁻¹) ∙ y : by rw op_associative s.op ...
= e ∙ y : by rw op_right_inverse s.op ...
= y : by rw op_left_identity s.op

@[identity_instance]
theorem right_division : identity.op_right_division s.op s.rdiv :=
λ x y,
show (y ∙ x⁻¹) ∙ x = y,
from calc (y ∙ x⁻¹) ∙ x
= y ∙ (x⁻¹ ∙ x) : by rw op_associative s.op ...
= y ∙ e : by rw op_left_inverse s.op ...
= y : by rw op_right_identity s.op

instance to_monoid : monoid s.to_monoid := monoid.infer _
instance to_loop : loop s.to_loop := loop.infer _

end group

@[theory]
class comm_group : Prop := intro ::
(associative : identity.op_associative s.op)
(commutative : identity.op_commutative s.op)
(right_identity : identity.op_right_identity s.op s.id)
(right_inverse : identity.op_right_inverse s.op s.inv s.id)

namespace comm_group
variable [i : comm_group s]
include i

instance to_group : group s := group.infer _

@[identity_instance]
theorem inv_homomorphism : identity.fn_op_homomorphism s.inv s.op s.op :=
λ x y, show (x ∙ y)⁻¹ = x⁻¹ ∙ y⁻¹,
from calc (x ∙ y)⁻¹
= (y ∙ x)⁻¹ : by rw op_commutative s.op ...
= x⁻¹ ∙ y⁻¹ : by rw fn_op_antimorphism s.inv s.op s.op

instance to_comm_monoid : comm_monoid s.to_monoid := comm_monoid.infer _

end comm_group

end algebra


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.kernels
import category_theory.limits.preserves.shapes.zero

/-!
# Preserving (co)kernels

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

Constructions to relate the notions of preserving (co)kernels and reflecting (co)kernels
to concrete (co)forks.

In particular, we show that `kernel_comparison f g G` is an isomorphism iff `G` preserves
the limit of the parallel pair `f,0`, as well as the dual result.
-/

noncomputable theory

universes v₁ v₂ u₁ u₂

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v₁} C] [has_zero_morphisms C]
variables {D : Type u₂} [category.{v₂} D] [has_zero_morphisms D]
variables (G : C ⥤ D) [functor.preserves_zero_morphisms G]

namespace category_theory.limits

section kernels
variables {X Y Z : C} {f : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = 0)

/--
The map of a kernel fork is a limit iff
the kernel fork consisting of the mapped morphisms is a limit.
This essentially lets us commute `kernel_fork.of_ι` with `functor.map_cone`.

This is a variant of `is_limit_map_cone_fork_equiv` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_limit_map_cone_fork_equiv' :
  is_limit (G.map_cone (kernel_fork.of_ι h w)) ≃
  is_limit (kernel_fork.of_ι (G.map h) (by simp only [←G.map_comp, w, functor.map_zero])
    : fork (G.map f) 0) :=
begin
  refine (is_limit.postcompose_hom_equiv _ _).symm.trans (is_limit.equiv_iso_limit _),
  refine parallel_pair.ext (iso.refl _) (iso.refl _) _ _; simp,
  refine fork.ext (iso.refl _) _,
  simp [fork.ι]
end

/--
The property of preserving kernels expressed in terms of kernel forks.

This is a variant of `is_limit_fork_map_of_is_limit` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_limit_fork_map_of_is_limit' [preserves_limit (parallel_pair f 0) G]
  (l : is_limit (kernel_fork.of_ι h w)) :
  is_limit (kernel_fork.of_ι (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :
    fork (G.map f) 0) :=
is_limit_map_cone_fork_equiv' G w (preserves_limit.preserves l)

variables (f) [has_kernel f]

/--
If `G` preserves kernels and `C` has them, then the fork constructed of the mapped morphisms of
a kernel fork is a limit.
-/
def is_limit_of_has_kernel_of_preserves_limit [preserves_limit (parallel_pair f 0) G] :
  is_limit (fork.of_ι (G.map (kernel.ι f))
    (by simp only [←G.map_comp, equalizer.condition, comp_zero, functor.map_zero])
      : fork (G.map f) 0) :=
is_limit_fork_map_of_is_limit' G (kernel.condition f) (kernel_is_kernel f)

instance [preserves_limit (parallel_pair f 0) G] : has_kernel (G.map f) :=
{ exists_limit := ⟨⟨_, is_limit_of_has_kernel_of_preserves_limit G f⟩⟩, }

variables [has_kernel (G.map f)]

/--
If the kernel comparison map for `G` at `f` is an isomorphism, then `G` preserves the
kernel of `f`.
-/
def preserves_kernel.of_iso_comparison [i : is_iso (kernel_comparison f G)] :
  preserves_limit (parallel_pair f 0) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (kernel_is_kernel f),
  apply (is_limit_map_cone_fork_equiv' G (kernel.condition f)).symm _,
  apply is_limit.of_point_iso (kernel_is_kernel (G.map f)),
  exact i,
end

variables [preserves_limit (parallel_pair f 0) G]
/--
If `G` preserves the kernel of `f`, then the kernel comparison map for `G` at `f` is
an isomorphism.
-/
def preserves_kernel.iso :
  G.obj (kernel f) ≅ kernel (G.map f) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_kernel_of_preserves_limit G f)
  (kernel_is_kernel _)

@[simp]
lemma preserves_kernel.iso_hom :
  (preserves_kernel.iso G f).hom = kernel_comparison f G :=
rfl

instance : is_iso (kernel_comparison f G) :=
begin
  rw ← preserves_kernel.iso_hom,
  apply_instance
end

@[reassoc] lemma kernel_map_comp_preserves_kernel_iso_inv {X' Y' : C} (g : X' ⟶ Y') [has_kernel g]
  [has_kernel (G.map g)] [preserves_limit (parallel_pair g 0) G] (p : X ⟶ X') (q : Y ⟶ Y')
  (hpq : f ≫ q = p ≫ g) :
  kernel.map (G.map f) (G.map g) (G.map p) (G.map q)
    (by rw [←G.map_comp, hpq, G.map_comp]) ≫ (preserves_kernel.iso G _).inv
  = (preserves_kernel.iso G _).inv ≫ G.map (kernel.map f g p q hpq) :=
begin
  rw [iso.comp_inv_eq, category.assoc, preserves_kernel.iso_hom, iso.eq_inv_comp],
  exact kernel_comparison_comp_kernel_map _ _ _ _ _ _,
end

end kernels

section cokernels

variables {X Y Z : C} {f : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = 0)

/--
The map of a cokernel cofork is a colimit iff
the cokernel cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cokernel_cofork.of_π` with `functor.map_cocone`.

This is a variant of `is_colimit_map_cocone_cofork_equiv` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_colimit_map_cocone_cofork_equiv' :
  is_colimit (G.map_cocone (cokernel_cofork.of_π h w)) ≃
  is_colimit (cokernel_cofork.of_π (G.map h) (by simp only [←G.map_comp, w, functor.map_zero])
    : cofork (G.map f) 0) :=
begin
  refine (is_colimit.precompose_hom_equiv _ _).symm.trans (is_colimit.equiv_iso_colimit _),
  refine parallel_pair.ext (iso.refl _) (iso.refl _) _ _; simp,
  refine cofork.ext (iso.refl _) _,
  simp only [cofork.π, iso.refl_hom, id_comp, cocones.precompose_obj_ι,
    nat_trans.comp_app, parallel_pair.ext_hom_app, functor.map_cocone_ι_app,
    cofork.of_π_ι_app],
  apply category.comp_id
end

/--
The property of preserving cokernels expressed in terms of cokernel coforks.

This is a variant of `is_colimit_cofork_map_of_is_colimit` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_colimit_cofork_map_of_is_colimit' [preserves_colimit (parallel_pair f 0) G]
  (l : is_colimit (cokernel_cofork.of_π h w)) :
  is_colimit (cokernel_cofork.of_π (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :
    cofork (G.map f) 0) :=
is_colimit_map_cocone_cofork_equiv' G w (preserves_colimit.preserves l)

variables (f) [has_cokernel f]

/--
If `G` preserves cokernels and `C` has them, then the cofork constructed of the mapped morphisms of
a cokernel cofork is a colimit.
-/
def is_colimit_of_has_cokernel_of_preserves_colimit [preserves_colimit (parallel_pair f 0) G] :
  is_colimit (cofork.of_π (G.map (cokernel.π f))
    (by simp only [←G.map_comp, coequalizer.condition, zero_comp, functor.map_zero])
      : cofork (G.map f) 0) :=
is_colimit_cofork_map_of_is_colimit' G (cokernel.condition f) (cokernel_is_cokernel f)

instance [preserves_colimit (parallel_pair f 0) G] : has_cokernel (G.map f) :=
{ exists_colimit := ⟨⟨_, is_colimit_of_has_cokernel_of_preserves_colimit G f⟩⟩, }

variables [has_cokernel (G.map f)]

/--
If the cokernel comparison map for `G` at `f` is an isomorphism, then `G` preserves the
cokernel of `f`.
-/
def preserves_cokernel.of_iso_comparison [i : is_iso (cokernel_comparison f G)] :
  preserves_colimit (parallel_pair f 0) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (cokernel_is_cokernel f),
  apply (is_colimit_map_cocone_cofork_equiv' G (cokernel.condition f)).symm _,
  apply is_colimit.of_point_iso (cokernel_is_cokernel (G.map f)),
  exact i,
end

variables [preserves_colimit (parallel_pair f 0) G]
/--
If `G` preserves the cokernel of `f`, then the cokernel comparison map for `G` at `f` is
an isomorphism.
-/
def preserves_cokernel.iso :
  G.obj (cokernel f) ≅ cokernel (G.map f) :=
is_colimit.cocone_point_unique_up_to_iso
  (is_colimit_of_has_cokernel_of_preserves_colimit G f)
  (cokernel_is_cokernel _)

@[simp]
lemma preserves_cokernel.iso_inv :
  (preserves_cokernel.iso G f).inv = cokernel_comparison f G :=
rfl

instance : is_iso (cokernel_comparison f G) :=
begin
  rw ← preserves_cokernel.iso_inv,
  apply_instance
end

@[reassoc] lemma preserves_cokernel_iso_comp_cokernel_map {X' Y' : C} (g : X' ⟶ Y')
  [has_cokernel g] [has_cokernel (G.map g)] [preserves_colimit (parallel_pair g 0) G]
  (p : X ⟶ X') (q : Y ⟶ Y') (hpq : f ≫ q = p ≫ g) :
  (preserves_cokernel.iso G _).hom ≫ cokernel.map (G.map f) (G.map g) (G.map p) (G.map q)
    (by rw [←G.map_comp, hpq, G.map_comp]) =
  G.map (cokernel.map f g p q hpq) ≫ (preserves_cokernel.iso G _).hom :=
begin
  rw [←iso.comp_inv_eq, category.assoc, ←iso.eq_inv_comp],
  exact cokernel_map_comp_cokernel_comparison _ _ _ _ _ _,
end

end cokernels

end category_theory.limits


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import data.zmod.basic
import group_theory.group_action.quotient
import ring_theory.int.basic
import ring_theory.ideal.quotient_operations

/-!
# `zmod n` and quotient groups / rings

This file relates `zmod n` to the quotient group
`quotient_add_group.quotient (add_subgroup.zmultiples n)` and to the quotient ring
`(ideal.span {n}).quotient`.

## Main definitions

 - `zmod.quotient_zmultiples_nat_equiv_zmod` and `zmod.quotient_zmultiples_equiv_zmod`:
   `zmod n` is the group quotient of `ℤ` by `n ℤ := add_subgroup.zmultiples (n)`,
   (where `n : ℕ` and `n : ℤ` respectively)
 - `zmod.quotient_span_nat_equiv_zmod` and `zmod.quotient_span_equiv_zmod`:
   `zmod n` is the ring quotient of `ℤ` by `n ℤ : ideal.span {n}`
   (where `n : ℕ` and `n : ℤ` respectively)
 - `zmod.lift n f` is the map from `zmod n` induced by `f : ℤ →+ A` that maps `n` to `0`.

## Tags

zmod, quotient group, quotient ring, ideal quotient
-/

open quotient_add_group
open zmod

variables (n : ℕ) {A R : Type*} [add_group A] [ring R]

namespace int

/-- `ℤ` modulo multiples of `n : ℕ` is `zmod n`. -/
def quotient_zmultiples_nat_equiv_zmod :
  ℤ ⧸ add_subgroup.zmultiples (n : ℤ) ≃+ zmod n :=
(quotient_add_equiv_of_eq (zmod.ker_int_cast_add_hom _)).symm.trans $
quotient_ker_equiv_of_right_inverse (int.cast_add_hom (zmod n)) coe int_cast_zmod_cast

/-- `ℤ` modulo multiples of `a : ℤ` is `zmod a.nat_abs`. -/
def quotient_zmultiples_equiv_zmod (a : ℤ) :
  ℤ ⧸ add_subgroup.zmultiples a ≃+ zmod a.nat_abs :=
(quotient_add_equiv_of_eq (zmultiples_nat_abs a)).symm.trans
  (quotient_zmultiples_nat_equiv_zmod a.nat_abs)

/-- `ℤ` modulo the ideal generated by `n : ℕ` is `zmod n`. -/
def quotient_span_nat_equiv_zmod :
  ℤ ⧸ ideal.span {↑n} ≃+* zmod n :=
(ideal.quot_equiv_of_eq (zmod.ker_int_cast_ring_hom _)).symm.trans $
  ring_hom.quotient_ker_equiv_of_right_inverse $
  show function.right_inverse coe (int.cast_ring_hom (zmod n)),
  from int_cast_zmod_cast

/-- `ℤ` modulo the ideal generated by `a : ℤ` is `zmod a.nat_abs`. -/
def quotient_span_equiv_zmod (a : ℤ) :
  ℤ ⧸ ideal.span ({a} : set ℤ) ≃+* zmod a.nat_abs :=
(ideal.quot_equiv_of_eq (span_nat_abs a)).symm.trans
  (quotient_span_nat_equiv_zmod a.nat_abs)

end int

namespace add_action

open add_subgroup add_monoid_hom add_equiv function

variables {α β : Type*} [add_group α] (a : α) [add_action α β] (b : β)

/-- The quotient `(ℤ ∙ a) ⧸ (stabilizer b)` is cyclic of order `minimal_period ((+ᵥ) a) b`. -/
noncomputable def zmultiples_quotient_stabilizer_equiv :
  zmultiples a ⧸ stabilizer (zmultiples a) b ≃+ zmod (minimal_period ((+ᵥ) a) b) :=
(of_bijective (map _ (stabilizer (zmultiples a) b)
  (zmultiples_hom (zmultiples a) ⟨a, mem_zmultiples a⟩) (by
  { rw [zmultiples_le, mem_comap, mem_stabilizer_iff,
        zmultiples_hom_apply, coe_nat_zsmul, ←vadd_iterate],
    exact is_periodic_pt_minimal_period ((+ᵥ) a) b })) ⟨by
  { rw [←ker_eq_bot_iff, eq_bot_iff],
    refine λ q, induction_on' q (λ n hn, _),
    rw [mem_bot, eq_zero_iff, int.mem_zmultiples_iff, ←zsmul_vadd_eq_iff_minimal_period_dvd],
    exact (eq_zero_iff _).mp hn },
  λ q, induction_on' q (λ ⟨_, n, rfl⟩, ⟨n, rfl⟩)⟩).symm.trans
  (int.quotient_zmultiples_nat_equiv_zmod (minimal_period ((+ᵥ) a) b))

lemma zmultiples_quotient_stabilizer_equiv_symm_apply (n : zmod (minimal_period ((+ᵥ) a) b)) :
  (zmultiples_quotient_stabilizer_equiv a b).symm n =
    (n : ℤ) • (⟨a, mem_zmultiples a⟩ : zmultiples a) :=
rfl

end add_action

namespace mul_action

open add_action subgroup add_subgroup function

variables {α β : Type*} [group α] (a : α) [mul_action α β] (b : β)

local attribute [semireducible] mul_opposite

/-- The quotient `(a ^ ℤ) ⧸ (stabilizer b)` is cyclic of order `minimal_period ((•) a) b`. -/
noncomputable def zpowers_quotient_stabilizer_equiv :
  zpowers a ⧸ stabilizer (zpowers a) b ≃* multiplicative (zmod (minimal_period ((•) a) b)) :=
let f := zmultiples_quotient_stabilizer_equiv (additive.of_mul a) b in
⟨f.to_fun, f.inv_fun, f.left_inv, f.right_inv, f.map_add'⟩

lemma zpowers_quotient_stabilizer_equiv_symm_apply (n : zmod (minimal_period ((•) a) b)) :
  (zpowers_quotient_stabilizer_equiv a b).symm n = (⟨a, mem_zpowers a⟩ : zpowers a) ^ (n : ℤ) :=
rfl

/-- The orbit `(a ^ ℤ) • b` is a cycle of order `minimal_period ((•) a) b`. -/
noncomputable def orbit_zpowers_equiv : orbit (zpowers a) b ≃ zmod (minimal_period ((•) a) b) :=
(orbit_equiv_quotient_stabilizer _ b).trans (zpowers_quotient_stabilizer_equiv a b).to_equiv

/-- The orbit `(ℤ • a) +ᵥ b` is a cycle of order `minimal_period ((+ᵥ) a) b`. -/
noncomputable def _root_.add_action.orbit_zmultiples_equiv
  {α β : Type*} [add_group α] (a : α) [add_action α β] (b : β) :
  add_action.orbit (zmultiples a) b ≃ zmod (minimal_period ((+ᵥ) a) b) :=
(add_action.orbit_equiv_quotient_stabilizer (zmultiples a) b).trans
  (zmultiples_quotient_stabilizer_equiv a b).to_equiv

attribute [to_additive orbit_zmultiples_equiv] orbit_zpowers_equiv

@[to_additive orbit_zmultiples_equiv_symm_apply]
lemma orbit_zpowers_equiv_symm_apply (k : zmod (minimal_period ((•) a) b)) :
  (orbit_zpowers_equiv a b).symm k =
    (⟨a, mem_zpowers a⟩ : zpowers a) ^ (k : ℤ) • ⟨b, mem_orbit_self b⟩ :=
rfl

lemma orbit_zpowers_equiv_symm_apply' (k : ℤ) :
  (orbit_zpowers_equiv a b).symm k =
    (⟨a, mem_zpowers a⟩ : zpowers a) ^ k • ⟨b, mem_orbit_self b⟩ :=
begin
  rw [orbit_zpowers_equiv_symm_apply, zmod.coe_int_cast],
  exact subtype.ext (zpow_smul_mod_minimal_period _ _ k),
end

lemma _root_.add_action.orbit_zmultiples_equiv_symm_apply'
  {α β : Type*} [add_group α] (a : α) [add_action α β] (b : β) (k : ℤ) :
  (add_action.orbit_zmultiples_equiv a b).symm k =
    (k • (⟨a, mem_zmultiples a⟩ : zmultiples a)) +ᵥ ⟨b, add_action.mem_orbit_self b⟩ :=
begin
  rw [add_action.orbit_zmultiples_equiv_symm_apply, zmod.coe_int_cast],
  exact subtype.ext (zsmul_vadd_mod_minimal_period _ _ k),
end

attribute [to_additive orbit_zmultiples_equiv_symm_apply'] orbit_zpowers_equiv_symm_apply'

@[to_additive] lemma minimal_period_eq_card [fintype (orbit (zpowers a) b)] :
  minimal_period ((•) a) b = fintype.card (orbit (zpowers a) b) :=
by rw [←fintype.of_equiv_card (orbit_zpowers_equiv a b), zmod.card]

@[to_additive] instance minimal_period_pos [finite $ orbit (zpowers a) b] :
  ne_zero $ minimal_period ((•) a) b :=
⟨begin
  casesI nonempty_fintype (orbit (zpowers a) b),
  haveI : nonempty (orbit (zpowers a) b) := (orbit_nonempty b).to_subtype,
  rw minimal_period_eq_card,
  exact fintype.card_ne_zero,
end⟩

end mul_action

section group

open subgroup

variables {α : Type*} [group α] (a : α)

/-- See also `order_eq_card_zpowers`. -/
@[to_additive add_order_eq_card_zmultiples' "See also `add_order_eq_card_zmultiples`."]
lemma order_eq_card_zpowers' : order_of a = nat.card (zpowers a) :=
begin
  have := nat.card_congr (mul_action.orbit_zpowers_equiv a (1 : α)),
  rwa [nat.card_zmod, orbit_subgroup_one_eq_self, eq_comm] at this,
end

variables {a}

@[to_additive is_of_fin_add_order.finite_zmultiples]
lemma is_of_fin_order.finite_zpowers (h : is_of_fin_order a) : finite $ zpowers a :=
begin
  rw [← order_of_pos_iff, order_eq_card_zpowers'] at h,
  exact nat.finite_of_card_ne_zero h.ne.symm,
end

end group


import data.real.basic analysis.special_functions.exp_log
import analysis.special_functions.pow

import .tactics .BernoulliReal
open real set

notation `|`x`|` := abs x

lemma log_mul' {a b : ℝ} (hb : 0 < b) : a * log (b * a) = a * log b + a * log a :=
begin
  by_cases h: a ≠ 0,
  { rw [mul_comm b a, log_mul h, mul_add, add_comm],
    linarith},
  { rw not_not at h,
    simp only [not_not, h, zero_mul, zero_add]}
end

lemma s_pow_le_s_pow (s : ℝ) (s_pos : 0 < s) (s_max : s ≤ 1): (s + 1) ^ (s + 1) / s ^ s ≤ 4 :=
begin
  rw rpow_add (show 0 < s +1, by linarith),
  rw rpow_one,
  rw ← div_mul_eq_mul_div,
  rw ← div_rpow (show 0 ≤ s +1, by linarith) (le_of_lt s_pos),
  rw add_div,
  rw div_self (show s ≠ 0, by linarith),
  have H1 : 0 < 1/s, {rw one_div_pos, exact s_pos},
  have HT : (1 + 1/s)^s * (s + 1) ≤ 2 * (s+1),
  { apply mul_le_mul,
    { rw ← one_add_one_eq_two,
      conv_rhs {
        congr,
        skip,
        rw ← div_self (show s ≠ 0, by linarith),
        rw ← mul_one_div,
      },
      -- rw ← [one_add_one_eq_two, div_self , mul_one_div],
      apply BernoulliInequality (1/s) (le_of_lt H1) s (le_of_lt s_pos) s_max,},
    { refl},
    { linarith,},
    { norm_num},
  },
  have HTw : (s + 1) ≤ 2,
  { linarith,},
  linarith,
end

lemma log_le_id (x : ℝ) (hx : 0 < x) : log x < x :=
begin
  -- rw ← sub_lt_zero,
  let f := λ x, log x - x,
  have h1 : ∀ x > 0, has_deriv_at f (1/x - 1) x,
  { intros x hx,
    change f with λ x, log x - x,
    apply has_deriv_at.sub,
    { apply has_deriv_at.log,
      { apply has_deriv_at_id'},
      { linarith},
    },
    { apply has_deriv_at_id'},
  },

  sorry
end

example (x : ℝ) (hx : 0 ≤ x) : x < exp x :=
begin
  have H : 1 ≤ exp x,
  { rw [← exp_zero, exp_le_exp],
   exact hx },
  let f := λ x, exp x - x,
  have h1 : has_deriv_at f (exp x - 1) x,
  { change f with λ x, exp x - x,
    apply has_deriv_at.sub,
    { apply has_deriv_at_exp },
    { apply has_deriv_at_id' },
  },
  have h2 : 0 ≤ deriv f x,
  { rw h1.deriv,
    linarith },
  have h3 : f 0 = 0,
  { change f with λ x, exp x - x,
    simp only [exp_zero, sub_zero],
    sorry},
  have h4 : 0 ≤ f x,
  { sorry},
  have h5 : ∀ x : ℝ, 0 ≤ x → exp x - x ≤ 1,
  { sorry},
  sorry
end

example (a b : ℝ) : a < b → a - b < 0 := sub_lt_zero.mpr

private lemma dodgyScholze : 0^0 = 1 := by norm_num

lemma x_log_x_le_log_two {x : ℝ} (hx_min : -1 ≤ x) (hx_max : x ≤ 0) : |x * log(|x|)| ≤ log 2 :=
begin
  rw log_abs,
  -- have H := log_le_
  sorry
end

example (x : ℝ) (hx_max : x < 1) (hx_min : 0 < x) : |x * log(|x|)| ≤ log 2 :=
begin
  rw log_abs,
  rw abs_mul,
  rw abs_of_pos hx_min,
  rw abs_of_neg (log_neg hx_min hx_max),
  rw mul_neg_eq_neg_mul_symm,
  rw neg_le,
  rw ← log_inv,
  rw ← log_rpow hx_min,
  rw log_le_log,
  {
    sorry},
  { norm_num},
  { exact rpow_pos_of_pos hx_min _},
end

lemma x_to_x_cont : continuous_on (λ (x : ℝ), x^x) (set.Icc 0 1) :=
begin
  intros x hx,
  by_cases h : x = 0,
  { rw h,
    intros y hy,
    simp only [filter.mem_map],
    simp only at hy,
    rw (rpow_zero (0 : ℝ)) at hy,
    unfold nhds_within,
    rw filter.mem_inf_sets,
    let s := { x : ℝ | x^x ∈ y },
    refine ⟨s, _, Icc 0 1, _, _⟩,
    {
      sorry},
    { simp only [filter.mem_principal_sets],},
    { simp only [inter_subset_left],},
  },
  { sorry},
end

example: 0 ^ 0 = 1 := pow_zero 0

#check convex_on_of_deriv2_nonneg (convex_Icc 0 1)

example (x : ℝ) : 2⁻¹ ≤ x ^ x :=
begin

  sorry
end

example (x : ℝ) (hx : 0 < x) : exp(|x|) = exp x := by rw abs_of_pos hx

example (x y : ℝ) (hx : 0 < x) (hx1 : x < 1) (hy : 0 < y) : x^y ≤ 2 :=
  le_trans (rpow_le_one (le_of_lt hx) (le_of_lt hx1) (le_of_lt hy)) (show 1 ≤ (2 : ℝ), by norm_num)

lemma x_one_log_x_one_le_log_two {x : ℝ} (hx_min : -1 ≤ x) (hx_max : x ≤ 0) : |(x + 1) * log (|x + 1|)| ≤ log 2 :=
begin
  sorry
end


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.normed.group.basic
import topology.algebra.group_completion
import topology.metric_space.completion

/-!
# Completion of a normed group

In this file we prove that the completion of a (semi)normed group is a normed group.

## Tags

normed group, completion
-/

noncomputable theory

namespace uniform_space
namespace completion

variables (E : Type*)

instance [uniform_space E] [has_norm E] :
  has_norm (completion E) :=
{ norm := completion.extension has_norm.norm }

@[simp] lemma norm_coe {E} [semi_normed_group E] (x : E) :
  ∥(x : completion E)∥ = ∥x∥ :=
completion.extension_coe uniform_continuous_norm x

instance [semi_normed_group E] : normed_group (completion E) :=
{ dist_eq :=
  begin
    intros x y,
    apply completion.induction_on₂ x y; clear x y,
    { refine is_closed_eq (completion.uniform_continuous_extension₂ _).continuous _,
      exact continuous.comp completion.continuous_extension continuous_sub },
    { intros x y,
      rw [← completion.coe_sub, norm_coe, metric.completion.dist_eq, dist_eq_norm] }
  end,
  .. uniform_space.completion.add_comm_group,
  .. metric.completion.metric_space }

end completion
end uniform_space


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem graph_bipartite_iff_two_colorable (G : Type*) (E : set (G × G)) :
  bipartite G E ↔ ∃ c : G → fin 2, ∀ x ∈ G, ∀ y ∈ G, im pair x y ∈ E → c x ≠ c y :=
begin
  split,
  -- Forwards direction
  assume hbip G,
  --By definition of bipartite, there exist color sets $V_1$ and $V_2$
  --such that every vertex has a different color
  --and every edge has one vertex in $V_1$ and the other in $V_2$
  rcases hbip with ⟨h1,h2⟩,

  -- Let $c$ denote the coloring where we assign color red to $V_1$
  --and color blue to $V_2$
  have c1 : ∃ c : G → fin 2, c = g, from ⟨⟨g,h1⟩,rfl⟩,
  have c2 : ∃ c : G → fin 2, c = r, from ⟨⟨r,h2⟩,rfl⟩,
  rcases c1 with ⟨c,rfl⟩,

  show ∃ c : G → fin 2, ∀ x ∈ G, ∀ y ∈ G, (im pair x y) ∈ E → c x ≠ c y, from
  ⟨c, assume x hx y hy hxy,
    -- By definition of edge set,
    -- we know that $(x,y) \in E$
    -- $\iff$ there exists $z \in G$ such that $z * x = y$
    have h3 : (im pair x y) ∈ E ↔ ∃ z ∈ G, z * x = y, from im_pair_range_eq_source E,
    have h3' : (im pair x y) ∈ E ↔ ∃ z ∈ G, x = y * z, from by
    {rw ← mul_inv y at h3,
     rw ← h3,
    },
    have h3'' : ((im pair x y) ∈ E) ↔ false, from iff.intro
      ( assume h : (im pair x y) ∈ E, begin
        rcases h3' h with ⟨z,hz⟩,
        --Since $V_1$ and $V_2$ are partition sets,
        --we have that $x$ and $z$ cannot have the same color
        have hr : c x ≠ c z, from by {
          assume h4 : c x = c z,
          have h5 : x ∈ G, from by {
            apply h1,
            rw h4,
            apply h2,
            assumption,
          },
          have h6 : z ∈ G, from by {
            apply h2,
            rw h4,
            apply h1,
            assumption,
          },
          show false, from (hxy h5 h6 hz),
        },
        apply hr,
        rw h4,
      end
      )
      ( assume h : false, begin
        apply eq.rec,
      end),
      have h4 : (c x ≠ c y) ↔ ((im pair x y) ∈ E), from begin
        apply iff.intro,
        assume h : (c x ≠ c y),
        have h5 : (im pair x y) ∈ E, from begin
          apply eq.rec,
          apply hbip.right,
          apply hx,
          apply hy,
        end,
        apply h5,
        assume h : (im pair x y) ∈ E,
        apply false.rec,
        have h5 : (c x) = (c z), from begin
          rw ← h4',
          apply h,
          apply hx,
        end,
        exact h5,
      end,
      apply h4,
    -- we know that $x$ and $y$ don't have the same color
    -- By definition of coloring, $x$ and $y$ cannot have the same color
    exact (c x ≠ c y)
    -- Hence, the coloring is valid
  ⟩,

  -- Backwards direction
  assume hc G,
  -- From 2-colorable,
  -- we know that there exists a valid coloring $c$
  rcases hc with ⟨c,hc⟩,

  -- Let $V_1$ denote the subset of vertices colored red
  -- Let $V_2$ denote the subset of vertices colored blue
  have h1 : ∃ V1 : set G, V1 = {x : G | c x = 0}, from ⟨{x : G | c x = 0}, rfl⟩,
  have h2 : ∃ V2 : set G, V2 = {x : G | c x = 1}, from ⟨{x : G | c x = 1}, rfl⟩,
  rcases h1 with ⟨V1,rfl⟩,
  rcases h2 with ⟨V2,rfl⟩,

  -- Then every vertex has a different color
  have h3 : ∀ (x : G) (y : G), x ∈ G → y ∈ G → x ≠ y → c x ≠ c y, from by {
    assume (x : G) (y : G) (hx : x ∈ G) (hy : y ∈ G) (hxy : x ≠ y),
    have h3a : im pair x y ∈ E, from by {apply eq.rec, apply hx,},
    have h3b : im pair y x ∈ E, from by {apply eq.rec, apply hy,},
    show c x ≠ c y, from by {
      apply hc,
      apply hx,
      apply hy,
      apply hxy,
    },
  },
  have h3' : ((∀ (x : G) (y : G), x ∈ G → y ∈ G → x ≠ y → c x ≠ c y) ∧ (E ≠ ∅)) →
  ∀ (x : G) (y : G), x ∈ G → y ∈ G → c x ≠ c y, from by {
    assume (h : ((∀ (x : G) (y : G), x ∈ G → y ∈ G → x ≠ y → c x ≠ c y) ∧ (E ≠ ∅))),
    assume (x : G) (y : G) (hx : x ∈ G) (hy : y ∈ G) (hxy : x ≠ y),
    have h3a : im pair x y ∈ E, from by {apply eq.rec, apply hx,},
    have h3b : im pair y x ∈ E, from by {apply eq.rec, apply hy,},
    show c x ≠ c y, from h.left x y hx hy hxy,
  },

  -- Every vertex has a different color
  have h4 : (∀ (x : G) (y : G), x ∈ G → y ∈ G → c x ≠ c y), from by {
    -- If $E$ is non-empty, then we can color $x$ and $y$ differently
    -- Note: an empty graph has no edges, so every vertex is a member of a different set
    rw h3',
    have h5 : x ∈ G, from by {
      apply eq.rec,
      apply (nonempty_of_ne_empty E).some,
    },
    have h6 : y ∈ G, from by {
      apply eq.rec,
      apply (nonempty_of_ne_empty E).some,
    },
    show c x ≠ c y, from by {
      apply h3,
      apply h5,
      apply h6,
      apply ne.symm,
      apply ne_of_ne_empty,
      apply E,
    },
    apply (ne_empty_of_mem E).some,
  },

  -- Every edge has one vertex in $V_1$ and the other in $V_2$
  show bipartite G E, from by {
    have h3a :
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem bipartite_is_two_colorable : ∀ G : fin_graph, @is_two_colorable G.V G.E ↔ @is_bipartite G.V G.E :=
begin
  assume G : fin_graph,
  have h1 : @is_two_colorable G.V G.E → @is_bipartite G.V G.E, from
    by {
      assume H : @is_two_colorable G.V G.E,
      have H1 : ∀ (v w : G.V), @is_bipartite G.V G.E v w, from by {
        assume v w : G.V,
        have H2 : ∃! c : color, @is_two_colorable G.V G.E v c, from
          H v,
        have H3 : ∃! c : color, @is_two_colorable G.V G.E w c, from
          H w,
        have H4 : ∃ (c₁ c₂ : color), @is_two_colorable G.V G.E v c₁ ∧ @is_two_colorable G.V G.E w c₂, from
          exists_unique.exists (H v),
        have H5 : ∃ (c₁ c₂ : color), @is_two_colorable G.V G.E v c₁ ∧ @is_two_colorable G.V G.E w c₂, from
          exists_unique.exists (H w),
        have H6 : ∀ (c₁ c₂ : color), (@is_two_colorable G.V G.E v c₁ ∧ @is_two_colorable G.V G.E w c₂) → c₁ ≠ c₂, from
          assume c₁ c₂ : color, assume H7 : (@is_two_colorable G.V G.E v c₁ ∧ @is_two_colorable G.V G.E w c₂),
          have H8 : @is_two_colorable G.V G.E v c₁, from and.elim_left H7,
          have H9 : @is_two_colorable G.V G.E w c₂, from and.elim_right H7,
          have H10 : ∀ (v' : G.V), ∀ (e : G.E), ((v, v') ∈ e) → @is_two_colorable G.V G.E v' c₂, from
            assume v' : G.V, assume e : G.E, assume H11 : ((v, v') ∈ e),
            have H12 : (@is_two_colorable G.V G.E v' c₁ ∨ @is_two_colorable G.V G.E v' c₂), from
              H8 v' e H11,
            or.elim H12
            (assume H13 : @is_two_colorable G.V G.E v' c₁, absurd H9.def H13.def)
            (assume H14 : @is_two_colorable G.V G.E v' c₂, by exact H14),
          have H13 : (∃ (v' : G.V), ∃ (e : G.E), ((v, v') ∈ e) ∧ ((w, v') ∈ e)), from
            exists.intro w (exists.intro H10),
          obtain (v' : G.V) (e : G.E) (H14 : (v, v') ∈ e ∧ (w, v') ∈ e), from H13,
          have H15 : @is_two_colorable G.V G.E v' c₁, from H8 v' e (and.elim_left H14),
          have H16 : @is_two_colorable G.V G.E v' c₂, from H10 v' e (and.elim_left H14),
          ne.symm (ne.intro H16.def H15.def),
        exists.elim (exists_unique.exists (H v)) (λ c₁, exists.elim (exists_unique.exists (H w)) (λ c₂, assume H17 : @is_two_colorable G.V G.E v c₁ ∧ @is_two_colorable G.V G.E w c₂,
          have H18 : @is_two_colorable G.V G.E w c₂, from and.elim_right H17,
          have H19 : @is_two_colorable G.V G.E v c₁, from and.elim_left H17,
          have H20 : ((@is_two_colorable G.V G.E v c₁ ∧ @is_two_colorable G.V G.E w c₂) → c₁ ≠ c₂), from H6,
          have H21 : c₁ ≠ c₂, from H20 c₁ c₂ H17,
          have H22 : c₁ = blue, from H19.def,
          have H23 : c₂ = red, from H18.def,
          have H24 : c₁ = red, from H22.symm ▸ H21 ▸ H23,
          have H25 : c₂ = blue, from H23.symm ▸ H21 ▸ H24,
          have H26 : c₁ = red ∧ c₂ = blue ∨ c₁ = blue ∧ c₂ = red, from or_iff_not_imp_left.mp H21,
          or.elim H26
          (assume H27 : c₁ = red ∧ c₂ = blue, have H28 : c₁ = red, from and.elim_left H27, have H29 : c₂ = blue, from and.elim_right H27, ⟨H28,H29⟩)
          (assume H27 : c₁ = blue ∧ c₂ = red, have H28 : c₁ = blue, from and.elim_left H27, have H29 : c₂ = red, from and.elim_right H27, ⟨H28,H29⟩))),
        show @is_bipartite G.V G.E v w, from
          H1 v w,
      },
      exact ⟨H1⟩,
    },
  have h2 : @is_bipartite G.V G.E → @is_two_colorable G.V G.E, from
    by {
      assume H : @is_bipartite G.V G.E,
      have H1 : ∃ (A B : finset G.V), (∀ v w, (v ∈ A ∧ w ∈ B) → ∃ (e : G.E), (v,w) ∈ e) ∧ (∀ v : G.V, v ∈ A ∨ v ∈ B) ∧ (∀ v : G.V, ¬ (v ∈ A ∧ v ∈ B)), from
        H,
      obtain (A B : finset G.V) (h1 : ∀ v w : G.V, (v ∈ A ∧ w ∈ B) → ∃ e : G.E, (v, w) ∈ e)
             (h2 : ∀ v : G.V, v ∈ A ∨ v ∈ B)
             (h3 : ∀ v : G.V, ¬ (v ∈ A ∧ v ∈ B)) from H1,
      have H2 : ∀ v : G.V, ∃ (c : color), @is_two_colorable G.V G.E v c, from
        assume v : G.V,
        have H3 : v ∈ A ∨ v ∈ B, from h2 v,
        have H4 : ∀ (c₁ c₂ : color), ((∃ e : G.E, (v, c
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem two_colorable_bipartite {G : Type*} [graph G] :
  ∀ f : G → color_type, list.pairwise_disjoint (edges G) → (∀ x ∈ G, ∃ c : color_type, f x = c ∧ c ≠ f x)
  → (∃ (A : set G), (∀ x ∉ A, f x = blue) ∧ (∀ x ∈ A, f x = red)) :=
begin
  intros f h1 h2,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  let A : set G := {x ∈ G | f x = red},
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : (∀ a b ∈ A, ∃ c d ∈ G, a ∈ c ∧ b ∈ d ∧ (c,d) ∈ edges G) → false, from
    λ hAB, (λ hA, hAB a b hA.left hA.left) (h2 a),
  have h4 : (∀ a b ∈ -A, ∃ c d ∈ G, a ∈ c ∧ b ∈ d ∧ (c,d) ∈ edges G) → false, from
    λ hAB, (λ hA, hAB a b hA.left hA.left) (h2 a),
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h5 : (∀ a b ∈ G, a ∈ A ∧ b ∈ -A ∨ a ∈ -A ∧ b ∈ A ∨ a ∈ A ∧ b ∈ A ∨ a ∈ -A ∧ b ∈ -A), from
    assume a b, classical.by_contradiction (λ h6, begin
      -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
      have h7 : (∀ a b ∈ A, ∃ c d ∈ G, a ∈ c ∧ b ∈ d ∧ (c,d) ∈ edges G) → false, from
        λ hAB, (λ hA, hAB a b hA.left hA.left) (h2 a),
      have h8 : (∀ a b ∈ -A, ∃ c d ∈ G, a ∈ c ∧ b ∈ d ∧ (c,d) ∈ edges G) → false, from
        λ hAB, (λ hA, hAB a b hA.left hA.left) (h2 a),
      sorry
  end),
  sorry
end

--OUTPUT 4
theorem graph_bipartite_iff_two_colourable (G : Type*) [graph G] : (∃ (V₁ V₂ : set G), V₁ ∪ V₂ = set.univ ∧ ∀ (v ∈ V₁), ∀ w ∈ V₂, (v,w) ∈ E G) ↔ (∃ (f : G → ℕ), ∀ (v w : G), (f v = 0 ∧ f w = 1) ∨ (f v = 1 ∧ f w = 0)) :=
begin
  split,
  assume h,
  cases h with V₁ h,
  cases h with V₂ h,
  cases h with h1 h2,
  use λ v, if v ∈ V₁ then 0 else 1,
  assume v w,
  by_cases hv : v ∈ V₁,
  by_cases hw : w ∈ V₁,
  simp_rw [hv,hw],
  have : (v,w) ∈ E G, from h2 _ hv _ hw,
  have : (w,v) ∈ E G, from h2 _ hw _ hv,
  induction hv,
  simp_rw [hv,hw],
  have : (v,w) ∈ E G, from h2 _ hv _ hw,
  have : (w,v) ∈ E G, from h2 _ hw _ hv,
  induction hw,
  simp_rw [hv,hw],
  have : (v,w) ∈ E G, from h2 _ hv _ hw,
  have : (w,v) ∈ E G, from h2 _ hw _ hv,

  assume h,
  cases h with f h,
  use {v : G | f v = 0},
  use {v : G | f v = 1},
  split,
  ext v,
  split,
  assume h1,
  cases h1 with a ha,
  simp_rw ha,
  have h2 : (f v = 0 ∨ f v = 1), from
  by_cases hv : f v = 0,
  induction hv,
  simp_rw hv,
  simp_rw hv,
  cases h2 with h2 h2,
  induction h2,
  simp_rw [h1,h2],
  simp_rw [h1,h2],
  assume h1,
  cases h1 with a ha,
  simp_rw ha,
  have h2 : (f v = 0 ∨ f v = 1), from
  by_cases hv : f v = 0,
  induction hv,
  simp_rw hv,
  simp_rw hv,
  cases h2 with h2 h2,
  induction h2,
  simp_rw [h1,h2],
  simp_rw [h1,h2],
  assume v hv,
  assume w hw,
  have h1 : (f v = 0 ∨ f v = 1), from
    by_cases hv : f v = 0,
    induction hv,
    simp_rw hv,
    simp_rw hv,
  have h2 : (f w = 0 ∨ f w = 1), from
    by_cases hw : f w = 0,
    induction hw,
    simp_rw hw,
    simp_rw hw,
  have h3 : (f v ≠ f w), from
    assume h,
    cases h with h h,
    induction h,
    simp_rw h,
    induction h,
    simp_rw h,
  have h4 : (f v ≠ f w), from
    assume h,
    cases h with h h,
    induction h,
    simp_rw h,
    induction h,
    simp_rw h,
  have : (v,w) ∈ E G, from h _ h1 _ h2,
  have : (w,v) ∈ E G, from h _ h2 _ h1,
end

--OUTPUT 5
theorem two_color_iff_bipartite {G : Type*} [fintype G] [decidable_eq G] :
  (∃ (coloring : G → bool), ∀ (v : G), ∃ (w : G), v ≠ w → G.has_edge v w → coloring v ≠ coloring w) ↔ (∃ (A B : set G), ∀ v ∈ A, ∀ w ∈ B, G.has_edge v w) :=
begin
--  assume (hColor : ∃ f : G → bool, ∀ v : G, ∃ w : G, v ≠ w → G.has_edge v w → f v ≠ f w)
-- have h2 : (∃ (A B : set G), ∀ v ∈ A, ∀ w ∈ B, G.has_edge v w), from
--    assume f : G → bool, assume h2 : ∀ v : G, ∃ w : G, v ≠ w → G.has_edge v w → f v ≠ f w,
--    have h3 :
end

--OUTPUT 6
theorem bipartite_graph_twocolorable (G : Type*) [bg : bipartite_graph G] : twocolorable G := sorry

/--`theorem`
Eigenvectors corresponding to different eigenvalues are linearly independent.
Let $A$ be an $n \times n$ matrix with complex entries, and $\lambda_{1}, \lambda_{2} \in \C$ be distinct eigenvalues of $A$. Suppose that $v_{1}$ is an eigenvector of $A$ corresponding to $\lambda_{1}$, and $v_{2}$ is an eigenvector of $A$ corresponding to $\lambda_{2}$. Then $v_{1}$ and $v_{2}$ are linearly independent.
`proof`
Suppose we have $v_{1}, v_{2} \in \C$ such that:
:$v_{1} \in \span \cbr a v_{1}$
and
:$v_{2} \in \span \cbr a v_{2}$

Then $v_{1} = \alpha v_{1}$ and $v_{2} = \beta v_{2}$, for $\alpha, \beta \in \C$.

Since $A v_{1} = \lambda_{1} v_{1}$ and $A v_{2} = \lambda_{2} v_{2}$, we have:
:$\lambda_{1} v_{1} = A v_{1}= \alpha A v_{1}$
and
:$\lambda_{2} v_{2} = A v_{2} = \beta A v_{2}$

But since $\lambda_{1} \neq \lambda_{2}$, $v_{1}$ and $v_{2}$ cannot be multiples of each other. Hence, $v_{1}$ and $v_{2}$ are linearly independent.
QED
-/
theorem eigenvector_linear_independent {A : ℂ^{n×n}} {λ₁ λ₂ : ℂ} :
  λ₁ ≠ λ₂ →
  (∃ (v₁ : ℂ^n) (hv₁ : v₁ ∈ span A {v₁ | λ₁ = A v₁}), ∃ (v₂ : ℂ^n) (hv₂ : v₂ ∈ span A {v₂ | λ₂ = A v₂}), v₁ ≠ v₂) →
  linear_independent A {v₁ | λ₁ = A v₁} ∧ linear_independent A {v₂ | λ₂ = A v₂} :=
begin
  -- Let $A$ be an $n \times n$ matrix with complex entries, and $\lambda_{1}, \lambda_{2} \in \C$ be distinct eigenvalues of $A$.
  -- Suppose that $v_{1}$ is an eigenvector of $A$ corresponding to $\lambda_{1}$, and $v_{2}$ is an eigenvector of $A$ corresponding to $\lambda_{2}$.
  -- Then $v_{1}$ and $v_{2}$ are linearly independent.
  assume (hdiff : λ₁ ≠ λ₂)
  (hev : ∃ (v₁ : ℂ^n) (hv₁ : v₁ ∈ span A {v₁ | λ₁ = A v₁}), ∃ (v₂ : ℂ^n) (hv₂ : v₂ ∈ span A {v₂ | λ₂ = A v₂}), v₁ ≠ v₂),
  have hv₁ : ∃ (v₁ : ℂ^n) (hv₁ : v₁ ∈ span A {v₁ | λ₁ = A v₁}), from (hev.left),
  have hv₂ : ∃ (v₂ : ℂ^n) (hv₂ : v₂ ∈ span A {v₂ | λ₂ = A v₂}), from (hev.right),
  have hneq : v₁ ≠ v₂, from (hev.right).right,

  -- Suppose we have $v_{1}, v_{2} \in \C$ such that:
  -- :$v_{1} \in \span \cbr a v_{1}$
  -- and
  -- :$v_{2} \in \span \cbr a v_{2}$
  have hv₁v₂ : v₁ ∈ span A {v₁ | λ₁ = A v₁} ∧ v₂ ∈ span A {v₂ | λ₂ = A v₂}, from and.intro hv₁.right hv₂.right,

  -- Then $v_{1} = \alpha v_{1}$ and $v_{2} = \beta v_{2}$, for $\alpha, \beta \in \C$.
  have hab : ∀ (v : ℂ^n) (hv : v ∈ span A {v₁ | λ₁ = A v₁}), ∃ (α : ℂ), v = α * v₁, from by {
    assume v hv,
    have h1 : (∀ (v : ℂ^n) ((hv : v ∈ span A {v₁ | λ₁ = A v₁})) (α : ℂ),
      ∀ (β : ℂ) (v₁ : ℂ^n) (hv₁ : v₁ ∈ span A {v₁ | λ₁ = A v₁}),
      α * (v - β * v₁) = α * v - α * β * v₁), from by {
        assume v hv α,
        have h2 : (∀ (β : ℂ) (v₁ : ℂ^n) (hv₁ : v₁ ∈ span A {v₁ | λ₁ = A v₁}),
          (α : ℂ) * (v - β * v₁) = α * v - alpha * β * v₁), from by {
          assume β v₁ hv₁,
          have h3 : (α : ℂ) * (v - β * v₁) = α * v - alpha * β * v₁, from by {rw mul_sub, rw mul_assoc, ring},
          exact h3},
        exact h2},
      have h3 : (∀ (v : ℂ^n) ((hv : v ∈ span A {v₁ | λ₁ = A v₁})) (α : ℂ),
      (∃ (v₁ : ℂ^n) (hv₁ : v₁ ∈ span A {v₁ | λ₁ = A v₁}), v = α * v₁)), from by {
        assume v hv α,
        have h4 : (∀ (v₁ : ℂ^n) (hv₁ : v₁ ∈ span A {v₁ | λ₁ = A v₁}),
          v = α * v₁), from by {
          assume v₁ hv₁,
          have h5 : (∀ β : ℂ, α * v - α * β * v₁ = 0), from by {
            assume β,
            have h6 : α * v - α * β * v₁ = 0, from by {
              have h7 : ∀ β : ℂ, α * v - α * β * v₁ = α * v - α * β * v₁, from assume β, rfl,
              have h8 : ∀ β : ℂ, (α : ℂ)
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem bipartite_iff_colorable (G : Type*) (E : G → G → Prop) : (∃ A B : set G, disjoint A B ∧ ∀ (x y : G), x ≠ y → E x y → (x ∈ A ∧ y ∈ B) ∨ (x ∈ B ∧ y ∈ A)) ↔ ∃ f : G → Prop, (∀ (x y : G), E x y → f x ≠ f y) :=
begin
  --($\Leftarrow$)
  assume h1 : ∃ (A B : set G), disjoint A B ∧ ∀ (x y : G), x ≠ y → E x y → (x ∈ A ∧ y ∈ B) ∨ (x ∈ B ∧ y ∈ A),
  rcases h1 with ⟨A, B, h1⟩,
  have h1' : ∀ (x y : G), x ≠ y → E x y → (x ∈ A ∧ y ∈ B) ∨ (x ∈ B ∧ y ∈ A), from and.right h1,
  have h2 : ∀ (x y : G), E x y → (x ∈ A ∧ y ∈ B) ∨ (x ∈ B ∧ y ∈ A), from
    assume (x y : G) (heq : E x y), h1' x y (ne.symm (heq rfl)) heq,
  have h3 : ∀ (x y : G), E x y → (x ∈ A ∨ x ∈ B) ∧ (y ∈ A ∨ y ∈ B), from
    assume (x y : G) (heq : E x y),
    by { cases (h2 x y heq) with h6 h7,
      { have h4 : x ∈ A ∧ y ∈ B , from h6,
        have h5 : (x ∈ A ∨ x ∈ B) ∧ (y ∈ A ∨ y ∈ B), from and.intro (or.inl (and.left h4)) (or.inr (and.right h4)),
        show (x ∈ A ∨ x ∈ B) ∧ (y ∈ A ∨ y ∈ B), from h5,},
      { have h8 : x ∈ B ∧ y ∈ A, from h7,
        have h9 : (x ∈ A ∨ x ∈ B) ∧ (y ∈ A ∨ y ∈ B), from and.intro (or.inr (and.left h8)) (or.inl (and.right h8)),
        show (x ∈ A ∨ x ∈ B) ∧ (y ∈ A ∨ y ∈ B), from h9,}},
  let f : G → Prop := λ (x : G), x ∈ A,
  have h4 : ∀ (x y : G), E x y → f x ≠ f y, from
    assume (x y : G) (heq : E x y),
    by { have h5 : (x ∈ A ∨ x ∈ B) ∧ (y ∈ A ∨ y ∈ B), from h3 x y heq,
      have h6 : (x ∈ A ∧ y ∈ A) ∨ (x ∈ B ∧ y ∈ B), from or.inl (and.intro (and.left h5) (and.left h5)),
      have h7 : (x ∈ A ∧ y ∈ A) ∨ (x ∈ B ∧ y ∈ B), from or.inr (and.intro (and.right h5) (and.right h5)),
      have h8 : ((x ∈ A ∧ x ∈ A) ∨ (x ∈ B ∧ x ∈ B)) ↔ false, from eq_false_iff_ne,
      have h9 : (x ∈ A ∧ y ∈ A) ↔ false, from h8.elim_left (or.inl (and.intro (f x) (f y))),
      have h10 : (x ∈ B ∧ y ∈ B) ↔ false, from h8.elim_left (or.inr (and.intro (f x) (f y))),
      cases h6 with h6 h7, {
        have h11 : x ≠ y, from h9 h6,
        assume h12 : f x = f y,
        have h13 : x ∈ A ∧ x ∈ A, from and.intro (f x) (f x),
        have h14 : (x ∈ A ∧ y ∈ A) ↔ false, from h9,
        have h15 : false, from h14.elim_right (and.intro (f x) (f y)),
        have h16 : (x ∈ A ∧ x ∈ A) ↔ false, from h8.elim_left (or.inl (and.intro (f x) (f x))),
        have h17 : false, from h16.elim_right (and.intro (f x) (f x)),
        have h18 : false, from h15,
        have h19 : false, from h17,
        show f x ≠ f y, from h18,},
      {
        have h11 : x ≠ y, from h10 h7,
        assume h12 : f x = f y,
        have h13 : x ∈ B ∧ x ∈ B, from and.intro (f x) (f x),
        have h14 : (x ∈ B ∧ y ∈ B) ↔ false, from h10,
        have h15 : false, from h14.elim_right (and.intro (f x) (f y)),
        have h16 : (x ∈ B ∧ x ∈ B) ↔ false, from h8.elim_left (or.inr (and.intro (f x) (f x))),
        have h17 : false, from h16.elim_right (and.intro (f x) (f x)),
        have h18 : false, from h15,
        have h19 : false, from h17,
        show f x ≠ f y, from h18,},
    },
  have h5 : (∀ (x y : G), E x y → f x ≠ f y), from h4,
  show ∃ (f : G → Prop), (∀ (x y : G), E x y → f x ≠ f y), from ⟨f, h5⟩,
end

--OUTPUT 8
theorem two_colorable_bipartite (G : Type*) [fin_graph G] :
  (∃! col : ℤ → G → Prop, ∀ g : G, col 0 g ∨ col 1 g) ↔ bipartite G :=
begin

end

--OUTPUT 9
theorem two_colorable_bipartite (G : Type*) (E : set (G × G)) : bipartite G E ↔ ∃ (V1 V2 : finset G), ∀ (a b : G), (a,b) ∈ E → ((a ∈ V1) ∧ (b ∈ V2)) ∨ ((a ∈ V2) ∧ (b ∈ V1)) :=
begin
  -- $G$ is 2-colorable if and only if $G$ is bipartite
  have h1 : (bipartite G E ↔ 2-colorable G E), from by apply bipartite_iff_two_colorable,
  simp at h1, rw ← h1,
  show (2-colorable G E ↔ ∃ (V1 V2 : finset G), ∀ (a b : G), (a,b) ∈ E → ((a ∈ V1) ∧ (b ∈ V2)) ∨ ((a ∈ V2) ∧ (b ∈ V1))), from by {
  -- Let $G$ be a 2-colorable graph.
  assume h2 : 2-colorable G E,
  have h3 : ∃ (c : G → color), ∀ (a b : G), (a,b) ∈ E → c a ≠ c b, from h2,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  let c : G → color := classical.some h3,
  let A : finset G := {a : G | c a = red},
  let B : finset G := {a : G | c a = blue},
  have h4 : ∀ (a b : G), (a,b) ∈ E → c a ≠ c b, from classical.some_spec h3,
  have h5 : ∀ (a : G), a ∈ A → c a = red, from by {assume a : G, assume h6 : a ∈ A, have h7 : c a = red, from exists.elim (set.mem_def.mp h6) (assume (x : G) (hx : x = a ∧ c x = red), hx.right), assumption,},
  have h6 : ∀ (a : G), a ∈ B → c a = blue, from by {assume a : G, assume h6 : a ∈ B, have h7 : c a = blue, from exists.elim (set.mem_def.mp h6) (assume (x : G) (hx : x = a ∧ c x = blue), hx.right), assumption,},
  have h7 : ∀ (a : G), c a = red → a ∈ A, from by {assume a : G, assume h7 : c a = red, apply exists.intro a, split; assumption,},
  have h8 : ∀ (a : G), c a = blue → a ∈ B, from by {assume a : G, assume h7 : c a = blue, apply exists.intro a, split; assumption,},
  have h9 : ∀ (a b : G), (a,b) ∈ E → (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A), from by {
    assume a b : G, assume h9 : (a,b) ∈ E,
    have h10 : c a ≠ c b, from h4 a b h9,
    have h11 : c a = red ∨ c a = blue, from by {cases c a; obviously,},
    have h12 : c b = red ∨ c b = blue, from by {cases c b; obviously,},
    have h13 : a ∈ A ∨ a ∈ B, from by {simp [h11,h5,h7] },
    have h14 : b ∈ A ∨ b ∈ B, from by {simp [h12,h6,h8] },
    cases h13; cases h14;
    show (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A), from by {rw h11,rw h12, assumption},
  },
  -- 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.
  have h10 : bipartite G E, from {
    --have h11 : ∀ (a : G), a ∉ A → a ∈ B, from by {
    --  assume a : G, assume h11 : a ∉ A,
    --  have h12 : c a = blue, from by {rw h11,},
    --  show a ∈ B, from h8 a h12,
    --},
    --have h12 : (∀ (a b : G), (a,b) ∈ E → (a ∈ A ∧ b ∈ A) ∨ (a ∈ B ∧ b ∈ B)), from by {
    --  assume a b : G,
    --  assume h12 : (a,b) ∈ E,
    --  cases h10,
    --  cases h12;
    --  show (a ∈ A ∧ b ∈ A) ∨ (a ∈ B ∧ b ∈ B), from by obviously,
    --},
    rw bipartite_iff,
  },
  show ∃ (V1 V2 : finset G), ∀ (a b : G), (a,b) ∈ E → ((a ∈ V1) ∧ (b ∈ V2)) ∨ ((a ∈ V2) ∧ (b ∈ V1)), from by {
    use A,
    use B,
    assumption,
  },
},
end

--OUTPUT 10
theorem graph_2_colorable {G : Type*} [uGraph G] : ∃ f : G → Prop, ∀ a, b : G, (a, b) ∈ uEdges G → f a ≠ f b :=
begin
  sorry
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 {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
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 rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, 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 {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

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

  -- 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 assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
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)-/


/-
This is a d∃∀duction file providing exercises for sets and maps. French version.
-/

import data.set
import tactic

-- dEAduction tactics
import structures2      -- hypo_analysis, targets_analysis
import utils            -- no_meta_vars
import user_notations   -- notations that can be used in deaduction UI for a new object

-- dEAduction definitions
import set_definitions

-------------------------
-- dEAduction METADATA --
-------------------------
/- dEAduction
Title
    Ensembles et applications
Author
    Frédéric Le Roux, Camille Lichère, Zoé Mesnil
Institution
    Université du monde
Description
    Ce fichier contient une série d'exercices concernant les opérations ensemblistes
    préservées par image directe ou réciproque par une application. Pour l'aborder,
    les étudiant.e.s devraient avoir une bonne image mentale des définitions
    d'image directe et réciproque, ainsi que d'injectivité et de surjectivité.
AvailableProof
    proof_methods new_object
AvailableMagic
    assumption
AvailableExercises
  UNTIL_NOW -image_directe_et_inclusion_II -image_reciproque_et_inclusion_II -image_directe_et_intersection_II
-/

local attribute [instance] classical.prop_decidable
---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course
parameters {X Y Z: Type}

open set

------------------
-- COURSE TITLE --
------------------
namespace ensembles_et_applications
/- dEAduction
PrettyName
    Ensembles et applications
-/

namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

namespace generalites
/- dEAduction
PrettyName
    Généralités
-/

lemma definition.inclusion {A B : set X} : A ⊆ B ↔ ∀ {x:X}, x ∈ A → x ∈ B :=
/- dEAduction
ImplicitUse
  True
-/
begin
    exact iff.rfl
end

lemma definition.egalite_deux_ensembles {A A' : set X} :
(A = A') ↔ ( ∀ x, x ∈ A ↔ x ∈ A' ) :=
/- dEAduction
PrettyName
    Egalité de deux ensembles
-/
begin
     exact set.ext_iff
end

-- Unfortunately split cannot work
lemma definition.double_inclusion (A A' : set X) :
A = A' ↔ (A ⊆ A' ∧ A' ⊆ A) :=
/- dEAduction
PrettyName
    Egalité de deux ensembles : double inclusion
ImplicitUse
  False
-/
begin
    exact set.subset.antisymm_iff
end

lemma definition.ensemble_vide
{A: set X} :
(A = ∅) ↔ ∀ x : X, x ∉ A
:=
begin
    exact eq_empty_iff_forall_not_mem,
end

lemma theorem.ensemble_non_vide
(A: set X) :
(A ≠ ∅) ↔ ∃ x : X, x ∈ A
:=
begin
    todo
end

end generalites

---------------
-- SECTION 1 --
---------------
namespace unions_et_intersections
-- variables unions_et_intersections --
variables {A B C : set X}

lemma definition.intersection_deux_ensembles {A B : set X} {x : X} :
x ∈ A ∩ B ↔ ( x ∈ A ∧ x ∈ B) :=
/- dEAduction
PrettyName
    Intersection de deux ensembles
ImplicitUse
    True
-/
begin
    exact iff.rfl
end

lemma definition.union_deux_ensembles  {A : set X} {B : set X} {x : X} :
x ∈ A ∪ B ↔ ( x ∈ A ∨ x ∈ B) :=
/- dEAduction
PrettyName
    Union de deux ensembles
ImplicitUse
    True
-/
begin
    exact iff.rfl
end

end unions_et_intersections

namespace applications

-- variables applications --

variables  {A A': set X}
variables {f: X → Y} {B B': set Y}

lemma definition.injectivite :
injective f ↔ ∀ x x' : X, (f x = f x' → x = x')
:=
/- dEAduction
PrettyName
    Application injective
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.surjectivite :
surjective f ↔ ∀ y : Y, ∃ x : X, y = f x
:=
/- dEAduction
PrettyName
    Application surjective
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.image_directe (y : Y) :
y ∈ f '' A ↔ ∃ x : X, x ∈ A ∧  f x = y
:=
begin
    todo
end

lemma theorem.image_directe :
∀ f: X→Y, ∀{A: set X}, ∀{x: X},
 (x ∈ A → f x ∈ f '' A)
:=
begin
    todo
end

lemma definition.image_reciproque (x:X) :
x ∈ f  ⁻¹' B ↔ f(x) ∈ B
:=
begin
    todo
end

end applications

end definitions

-----------------
--- EXERCICES ---
-----------------
namespace exercices
variables  {A A': set X}
variables {f: X → Y} {B B': set Y}

/-
1. ∀A,B⊆E A⊆B⇒f(A)⊆f(B)
2. ∀A,B⊆E f(A)⊆f(B)⇒A⊆B
3. Sif estinjective,alors∀A,B⊆E f(A)⊆f(B)⇒A⊆B
4. f estinjectivesietseulementsi∀A,B⊆E f(A)⊆f(B)⇒A⊆B

5. ∀A,B⊆F A⊆B⇒f−1(A)⊆f−1(B)
6. ∀A,B⊆F f−1(A)⊆f−1(B)⇒A⊆B
7. Si f est surjective, alors ∀A,B ⊆ F f−1(A) ⊆ f−1(B) ⇒ A ⊆ B
8. festsurjectivesietseulementsi∀A,B⊆F f−1(A)⊆f−1(B)⇒A⊆B

9. ∀A ⊆ F f(f−1(A)) ⊆ A
10. ∀A ⊆ F A ⊆ f(f−1(A))
11. Si f est surjective, alors ∀A ⊆ F A ⊆ f(f−1(A))
12. f est surjective si et seulement si ∀A ⊆ F A = f(f−1(A))

13. ∀A ⊆ E A ⊆ f−1(f(A))
14. ∀A ⊆ E f−1(f(A)) ⊆ A
15. Si f est injective alors ∀A ⊆ E f−1(f(A)) ⊆ A
16. f est injective si et seulement si ∀A ⊆ E f−1(f(A)) = A

17. ∀A,B⊆E f(A∩B)⊆f(A)∩f(B)
18. ∀A,B⊆E f(A)∩f(B)⊆f(A∩B)
19. Sif estinjective,alors∀A,B⊆E f(A)∩f(B)⊆f(A∩B)
20. f estinjectivesietseulementsi∀A,B⊆E f(A)∩f(B)=f(A∩B)

21. ∀A,B⊆E 22.∀A,B⊆F 23.∀A,B⊆F
22. f(A∪B)=f(A)∪f(B)
23. f−1(A ∩ B) = f−1(A) ∩ f−1(B) f−1(A ∪ B) = f−1(A) ∪ f−1(B)
-/

---------------------------------
namespace image_directe_inclusion
/- dEAduction
PrettyName
  Image directe et inclusion
-/

lemma exercise.image_directe_et_inclusion_I :
∀ A B: set X, A ⊆ B → f '' (A) ⊆ f '' (B)
:=
/- dEAduction
PrettyName
  Image directe et inclusion (i)
-/
begin
  todo
end

lemma exercise.image_directe_et_inclusion_II :
∀ A B: set X,  f '' (A) ⊆ f '' (B) → A ⊆ B
:=
/- dEAduction
PrettyName
  Image directe et inclusion (ii)
-/
begin
  todo
end

lemma exercise.image_directe_et_inclusion_III :
(injective f) →  (∀ A B: set X,  f '' (A) ⊆ f '' (B) → A ⊆ B)
:=
/- dEAduction
PrettyName
  Image directe et inclusion (iii)
-/
begin
  todo
end

end image_directe_inclusion

---------------------------------
namespace image_reciproque_inclusion
/- dEAduction
PrettyName
  Image réciproque et inclusion
-/

lemma exercise.image_reciproque_et_inclusion_I :
∀ A' B': set Y, A'⊆B' → f ⁻¹' (A') ⊆ f ⁻¹' (B')
:=
/- dEAduction
PrettyName
  Image réciproque et inclusion (i)
-/
begin
  todo
end

lemma exercise.image_reciproque_et_inclusion_II :
∀ A' B': set Y,  f ⁻¹' (A') ⊆ f ⁻¹' (B') → A' ⊆ B'
:=
/- dEAduction
PrettyName
  Image réciproque et inclusion (ii)
-/
begin
  todo
end

lemma exercise.image_reciproque_et_inclusion_III :
(surjective f) → (∀ A' B': set Y,  f ⁻¹' (A') ⊆ f ⁻¹' (B') → A' ⊆ B')
:=
/- dEAduction
PrettyName
  Image réciproque et inclusion (iii)
-/
begin
  todo
end

end image_reciproque_inclusion

---------------------------------
namespace image_et_image_reciproque
/- dEAduction
PrettyName
  Image et image réciproque
-/

namespace inclusions

lemma exercise.image_de_image_reciproque :
∀ A' : set Y, f '' (f ⁻¹' (A')) ⊆ A'
:=
/- dEAduction
PrettyName
  Image de l'image réciproque
-/
begin
  todo
end

lemma exercise.image_reciproque_de_image :
∀ A : set X, A ⊆ f ⁻¹' (f '' (A))
:=
/- dEAduction
PrettyName
  Image réciproque de l'image
-/
begin
  todo
end

end inclusions

namespace inclusions_reciproques
/- dEAduction
PrettyName
  Inclusions réciproques
-/

lemma exercise.image_de_image_reciproque_bis :
(surjective f) → (∀ A' : set Y, A' ⊆ f '' (f ⁻¹' (A')))
:=
/- dEAduction
PrettyName
  Image de l'image réciproque : inclusion réciproque
-/
begin
  todo
end

lemma exercise.image_reciproque_de_image_bis :
(injective f) → (∀ A : set X, f ⁻¹' (f '' (A)) ⊆ A)
:=
/- dEAduction
PrettyName
  Image réciproque de l'image : inclusion réciproque
-/
begin
  todo
end

end inclusions_reciproques
end image_et_image_reciproque

namespace image_intersection
/- dEAduction
PrettyName
  Image de l'intersection
-/

lemma exercise.image_directe_et_intersection_I :
∀ A B: set X, f '' (A ∩ B) ⊆ f '' (A) ∩ f '' (B)
:=
/- dEAduction
PrettyName
  Image directe et intersection (i)
-/
begin
  todo
end

lemma exercise.image_directe_et_intersection_II :
∀ A B: set X,  f '' (A) ∩ f '' (B) ⊆ f '' (A ∩ B)
:=
/- dEAduction
PrettyName
  Image directe et intersection (ii)
-/
begin
  todo
end

lemma exercise.image_directe_et_intersection_III
(H : injective f) :
∀ A B: set X,  f '' (A) ∩ f '' (B) ⊆ f '' (A ∩ B)
:=
/- dEAduction
PrettyName
  Image directe et intersection (iii)
-/
begin
  todo
end

end image_intersection

namespace egalites
/- dEAduction
PrettyName
  Autres formules
-/

lemma exercise.egalite_I :
∀ A B : set X, f '' ( A ∪ B) = f '' (A) ∪ f '' (B)
:=
/- dEAduction
PrettyName
  Image directe et union
-/
begin
  todo
end

lemma exercise.egalite_II :
∀ A' B' : set Y, f ⁻¹' ( A' ∩ B') = f ⁻¹' (A') ∩ f ⁻¹' (B')
:=
/- dEAduction
PrettyName
  Image réciproque et intersection
-/
begin
  todo
end

lemma exercise.egalite_III :
∀ A' B' : set Y, f ⁻¹' ( A' ∪ B') = f ⁻¹' (A') ∪ f ⁻¹' (B')
:=
/- dEAduction
PrettyName
  Image réciproque et union
-/
begin
  todo
end

end egalites

end exercices

end ensembles_et_applications

end course