/-
Copyright (c) 2019 Yury Kudriashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudriashov
-/
import algebra.big_operators.order
import analysis.convex.hull
import linear_algebra.affine_space.basis

/-!
# Convex combinations

This file defines convex combinations of points in a vector space.

## Main declarations

* `finset.center_mass`: Center of mass of a finite family of points.

## Implementation notes

We divide by the sum of the weights in the definition of `finset.center_mass` because of the way
mathematical arguments go: one doesn't change weights, but merely adds some. This also makes a few
lemmas unconditional on the sum of the weights being `1`.
-/

open set function
open_locale big_operators classical pointwise

universes u u'
variables {R E F ι ι' α : Type*} [linear_ordered_field R] [add_comm_group E] [add_comm_group F]
  [linear_ordered_add_comm_group α] [module R E] [module R F] [module R α] [ordered_smul R α]
  {s : set E}

/-- Center of mass of a finite collection of points with prescribed weights.
Note that we require neither `0 ≤ w i` nor `∑ w = 1`. -/
def finset.center_mass (t : finset ι) (w : ι → R) (z : ι → E) : E :=
(∑ i in t, w i)⁻¹ • (∑ i in t, w i • z i)

variables (i j : ι) (c : R) (t : finset ι) (w : ι → R) (z : ι → E)

open finset

lemma finset.center_mass_empty : (∅ : finset ι).center_mass w z = 0 :=
by simp only [center_mass, sum_empty, smul_zero]

lemma finset.center_mass_pair (hne : i ≠ j) :
  ({i, j} : finset ι).center_mass w z = (w i / (w i + w j)) • z i + (w j / (w i + w j)) • z j :=
by simp only [center_mass, sum_pair hne, smul_add, (mul_smul _ _ _).symm, div_eq_inv_mul]

variable {w}

lemma finset.center_mass_insert (ha : i ∉ t) (hw : ∑ j in t, w j ≠ 0) :
  (insert i t).center_mass w z = (w i / (w i + ∑ j in t, w j)) • z i +
    ((∑ j in t, w j) / (w i + ∑ j in t, w j)) • t.center_mass w z :=
begin
  simp only [center_mass, sum_insert ha, smul_add, (mul_smul _ _ _).symm, ← div_eq_inv_mul],
  congr' 2,
  rw [div_mul_eq_mul_div, mul_inv_cancel hw, one_div]
end

lemma finset.center_mass_singleton (hw : w i ≠ 0) : ({i} : finset ι).center_mass w z = z i :=
by rw [center_mass, sum_singleton, sum_singleton, ← mul_smul, inv_mul_cancel hw, one_smul]

lemma finset.center_mass_eq_of_sum_1 (hw : ∑ i in t, w i = 1) :
  t.center_mass w z = ∑ i in t, w i • z i :=
by simp only [finset.center_mass, hw, inv_one, one_smul]

lemma finset.center_mass_smul : t.center_mass w (λ i, c • z i) = c • t.center_mass w z :=
by simp only [finset.center_mass, finset.smul_sum, (mul_smul _ _ _).symm, mul_comm c, mul_assoc]

/-- A convex combination of two centers of mass is a center of mass as well. This version
deals with two different index types. -/
lemma finset.center_mass_segment'
  (s : finset ι) (t : finset ι') (ws : ι → R) (zs : ι → E) (wt : ι' → R) (zt : ι' → E)
  (hws : ∑ i in s, ws i = 1) (hwt : ∑ i in t, wt i = 1) (a b : R) (hab : a + b = 1) :
  a • s.center_mass ws zs + b • t.center_mass wt zt =
    (s.disj_sum t).center_mass (sum.elim (λ i, a * ws i) (λ j, b * wt j)) (sum.elim zs zt) :=
begin
  rw [s.center_mass_eq_of_sum_1 _ hws, t.center_mass_eq_of_sum_1 _ hwt,
    smul_sum, smul_sum, ← finset.sum_sum_elim, finset.center_mass_eq_of_sum_1],
  { congr' with ⟨⟩; simp only [sum.elim_inl, sum.elim_inr, mul_smul] },
  { rw [sum_sum_elim, ← mul_sum, ← mul_sum, hws, hwt, mul_one, mul_one, hab] }
end

/-- A convex combination of two centers of mass is a center of mass as well. This version
works if two centers of mass share the set of original points. -/
lemma finset.center_mass_segment
  (s : finset ι) (w₁ w₂ : ι → R) (z : ι → E)
  (hw₁ : ∑ i in s, w₁ i = 1) (hw₂ : ∑ i in s, w₂ i = 1) (a b : R) (hab : a + b = 1) :
  a • s.center_mass w₁ z + b • s.center_mass w₂ z =
    s.center_mass (λ i, a * w₁ i + b * w₂ i) z :=
have hw : ∑ i in s, (a * w₁ i + b * w₂ i) = 1,
  by simp only [mul_sum.symm, sum_add_distrib, mul_one, *],
by simp only [finset.center_mass_eq_of_sum_1, smul_sum, sum_add_distrib, add_smul, mul_smul, *]

lemma finset.center_mass_ite_eq (hi : i ∈ t) :
  t.center_mass (λ j, if (i = j) then (1 : R) else 0) z = z i :=
begin
  rw [finset.center_mass_eq_of_sum_1],
  transitivity ∑ j in t, if (i = j) then z i else 0,
  { congr' with i, split_ifs, exacts [h ▸ one_smul _ _, zero_smul _ _] },
  { rw [sum_ite_eq, if_pos hi] },
  { rw [sum_ite_eq, if_pos hi] }
end

variables {t w}

lemma finset.center_mass_subset {t' : finset ι} (ht : t ⊆ t')
  (h : ∀ i ∈ t', i ∉ t → w i = 0) :
  t.center_mass w z = t'.center_mass w z :=
begin
  rw [center_mass, sum_subset ht h, smul_sum, center_mass, smul_sum],
  apply sum_subset ht,
  assume i hit' hit,
  rw [h i hit' hit, zero_smul, smul_zero]
end

lemma finset.center_mass_filter_ne_zero :
  (t.filter (λ i, w i ≠ 0)).center_mass w z = t.center_mass w z :=
finset.center_mass_subset z (filter_subset _ _) $ λ i hit hit',
  by simpa only [hit, mem_filter, true_and, ne.def, not_not] using hit'

namespace finset

lemma center_mass_le_sup {s : finset ι} {f : ι → α} {w : ι → R}
  (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : 0 < ∑ i in s, w i) :
  s.center_mass w f ≤ s.sup' (nonempty_of_ne_empty $ by { rintro rfl, simpa using hw₁ }) f :=
begin
  rw [center_mass, inv_smul_le_iff hw₁, sum_smul],
  exact sum_le_sum (λ i hi, smul_le_smul_of_nonneg (le_sup' _ hi) $ hw₀ i hi),
  apply_instance,
end

lemma inf_le_center_mass {s : finset ι} {f : ι → α} {w : ι → R}
  (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : 0 < ∑ i in s, w i) :
  s.inf' (nonempty_of_ne_empty $ by { rintro rfl, simpa using hw₁ }) f ≤ s.center_mass w f :=
@center_mass_le_sup R _ αᵒᵈ _ _ _ _ _ _ _ hw₀ hw₁

end finset

variable {z}

/-- The center of mass of a finite subset of a convex set belongs to the set
provided that all weights are non-negative, and the total weight is positive. -/
lemma convex.center_mass_mem (hs : convex R s) :
  (∀ i ∈ t, 0 ≤ w i) → (0 < ∑ i in t, w i) → (∀ i ∈ t, z i ∈ s) → t.center_mass w z ∈ s :=
begin
  induction t using finset.induction with i t hi ht, { simp [lt_irrefl] },
  intros h₀ hpos hmem,
  have zi : z i ∈ s, from hmem _ (mem_insert_self _ _),
  have hs₀ : ∀ j ∈ t, 0 ≤ w j, from λ j hj, h₀ j $ mem_insert_of_mem hj,
  rw [sum_insert hi] at hpos,
  by_cases hsum_t : ∑ j in t, w j = 0,
  { have ws : ∀ j ∈ t, w j = 0, from (sum_eq_zero_iff_of_nonneg hs₀).1 hsum_t,
    have wz : ∑ j in t, w j • z j = 0, from sum_eq_zero (λ i hi, by simp [ws i hi]),
    simp only [center_mass, sum_insert hi, wz, hsum_t, add_zero],
    simp only [hsum_t, add_zero] at hpos,
    rw [← mul_smul, inv_mul_cancel (ne_of_gt hpos), one_smul],
    exact zi },
  { rw [finset.center_mass_insert _ _ _ hi hsum_t],
    refine convex_iff_div.1 hs zi (ht hs₀ _ _) _ (sum_nonneg hs₀) hpos,
    { exact lt_of_le_of_ne (sum_nonneg hs₀) (ne.symm hsum_t) },
    { intros j hj, exact hmem j (mem_insert_of_mem hj) },
    { exact h₀ _ (mem_insert_self _ _) } }
end

lemma convex.sum_mem (hs : convex R s) (h₀ : ∀ i ∈ t, 0 ≤ w i) (h₁ : ∑ i in t, w i = 1)
  (hz : ∀ i ∈ t, z i ∈ s) :
  ∑ i in t, w i • z i ∈ s :=
by simpa only [h₁, center_mass, inv_one, one_smul] using
  hs.center_mass_mem h₀ (h₁.symm ▸ zero_lt_one) hz

/-- A version of `convex.sum_mem` for `finsum`s. If `s` is a convex set, `w : ι → R` is a family of
nonnegative weights with sum one and `z : ι → E` is a family of elements of a module over `R` such
that `z i ∈ s` whenever `w i ≠ 0``, then the sum `∑ᶠ i, w i • z i` belongs to `s`. See also
`partition_of_unity.finsum_smul_mem_convex`. -/
lemma convex.finsum_mem {ι : Sort*} {w : ι → R} {z : ι → E} {s : set E}
  (hs : convex R s) (h₀ : ∀ i, 0 ≤ w i) (h₁ : ∑ᶠ i, w i = 1) (hz : ∀ i, w i ≠ 0 → z i ∈ s) :
  ∑ᶠ i, w i • z i ∈ s :=
begin
  have hfin_w : (support (w ∘ plift.down)).finite,
  { by_contra H,
    rw [finsum, dif_neg H] at h₁,
    exact zero_ne_one h₁ },
  have hsub : support ((λ i, w i • z i) ∘ plift.down) ⊆ hfin_w.to_finset,
    from (support_smul_subset_left _ _).trans hfin_w.coe_to_finset.ge,
  rw [finsum_eq_sum_plift_of_support_subset hsub],
  refine hs.sum_mem (λ _ _, h₀ _) _ (λ i hi, hz _ _),
  { rwa [finsum, dif_pos hfin_w] at h₁ },
  { rwa [hfin_w.mem_to_finset] at hi }
end

lemma convex_iff_sum_mem :
  convex R s ↔
    (∀ (t : finset E) (w : E → R),
      (∀ i ∈ t, 0 ≤ w i) → ∑ i in t, w i = 1 → (∀ x ∈ t, x ∈ s) → ∑ x in t, w x • x ∈ s ) :=
begin
  refine ⟨λ hs t w hw₀ hw₁ hts, hs.sum_mem hw₀ hw₁ hts, _⟩,
  intros h x hx y hy a b ha hb hab,
  by_cases h_cases: x = y,
  { rw [h_cases, ←add_smul, hab, one_smul], exact hy },
  { convert h {x, y} (λ z, if z = y then b else a) _ _ _,
    { simp only [sum_pair h_cases, if_neg h_cases, if_pos rfl] },
    { simp_intros i hi,
      cases hi; subst i; simp [ha, hb, if_neg h_cases] },
    { simp only [sum_pair h_cases, if_neg h_cases, if_pos rfl, hab] },
    { simp_intros i hi,
      cases hi; subst i; simp [hx, hy, if_neg h_cases] } }
end

lemma finset.center_mass_mem_convex_hull (t : finset ι) {w : ι → R} (hw₀ : ∀ i ∈ t, 0 ≤ w i)
  (hws : 0 < ∑ i in t, w i) {z : ι → E} (hz : ∀ i ∈ t, z i ∈ s) :
  t.center_mass w z ∈ convex_hull R s :=
(convex_convex_hull R s).center_mass_mem hw₀ hws (λ i hi, subset_convex_hull R s $ hz i hi)

/-- A refinement of `finset.center_mass_mem_convex_hull` when the indexed family is a `finset` of
the space. -/
lemma finset.center_mass_id_mem_convex_hull (t : finset E) {w : E → R} (hw₀ : ∀ i ∈ t, 0 ≤ w i)
  (hws : 0 < ∑ i in t, w i) :
  t.center_mass w id ∈ convex_hull R (t : set E) :=
t.center_mass_mem_convex_hull hw₀ hws (λ i, mem_coe.2)

lemma affine_combination_eq_center_mass {ι : Type*} {t : finset ι} {p : ι → E} {w : ι → R}
  (hw₂ : ∑ i in t, w i = 1) :
  t.affine_combination R p w = center_mass t w p :=
begin
  rw [affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one _ w _ hw₂ (0 : E),
    finset.weighted_vsub_of_point_apply, vadd_eq_add, add_zero, t.center_mass_eq_of_sum_1 _ hw₂],
  simp_rw [vsub_eq_sub, sub_zero],
end

lemma affine_combination_mem_convex_hull
  {s : finset ι} {v : ι → E} {w : ι → R} (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : s.sum w = 1) :
  s.affine_combination R v w ∈ convex_hull R (range v) :=
begin
  rw affine_combination_eq_center_mass hw₁,
  apply s.center_mass_mem_convex_hull hw₀,
  { simp [hw₁], },
  { simp, },
end

/-- The centroid can be regarded as a center of mass. -/
@[simp] lemma finset.centroid_eq_center_mass (s : finset ι) (hs : s.nonempty) (p : ι → E) :
  s.centroid R p = s.center_mass (s.centroid_weights R) p :=
affine_combination_eq_center_mass (s.sum_centroid_weights_eq_one_of_nonempty R hs)

lemma finset.centroid_mem_convex_hull (s : finset E) (hs : s.nonempty) :
  s.centroid R id ∈ convex_hull R (s : set E) :=
begin
  rw s.centroid_eq_center_mass hs,
  apply s.center_mass_id_mem_convex_hull,
  { simp only [inv_nonneg, implies_true_iff, nat.cast_nonneg, finset.centroid_weights_apply], },
  { have hs_card : (s.card : R) ≠ 0, { simp [finset.nonempty_iff_ne_empty.mp hs] },
    simp only [hs_card, finset.sum_const, nsmul_eq_mul, mul_inv_cancel, ne.def, not_false_iff,
      finset.centroid_weights_apply, zero_lt_one] }
end

lemma convex_hull_range_eq_exists_affine_combination (v : ι → E) :
  convex_hull R (range v) = { x | ∃ (s : finset ι) (w : ι → R)
    (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : s.sum w = 1), s.affine_combination R v w = x } :=
begin
  refine subset.antisymm (convex_hull_min _ _) _,
  { intros x hx,
    obtain ⟨i, hi⟩ := set.mem_range.mp hx,
    refine ⟨{i}, function.const ι (1 : R), by simp, by simp, by simp [hi]⟩, },
  { rintro x ⟨s, w, hw₀, hw₁, rfl⟩ y ⟨s', w', hw₀', hw₁', rfl⟩ a b ha hb hab,
    let W : ι → R := λ i, (if i ∈ s then a * w i else 0) + (if i ∈ s' then b * w' i else 0),
    have hW₁ : (s ∪ s').sum W = 1,
    { rw [sum_add_distrib, ← sum_subset (subset_union_left s s'),
        ← sum_subset (subset_union_right s s'), sum_ite_of_true _ _ (λ i hi, hi),
        sum_ite_of_true _ _ (λ i hi, hi), ← mul_sum, ← mul_sum, hw₁, hw₁', ← add_mul, hab, mul_one];
      intros i hi hi';
      simp [hi'], },
    refine ⟨s ∪ s', W, _, hW₁, _⟩,
    { rintros i -,
      by_cases hi : i ∈ s;
      by_cases hi' : i ∈ s';
      simp [hi, hi', add_nonneg, mul_nonneg ha (hw₀ i _), mul_nonneg hb (hw₀' i _)], },
    { simp_rw [affine_combination_eq_linear_combination (s ∪ s') v _ hW₁,
        affine_combination_eq_linear_combination s v w hw₁,
        affine_combination_eq_linear_combination s' v w' hw₁', add_smul, sum_add_distrib],
      rw [← sum_subset (subset_union_left s s'), ← sum_subset (subset_union_right s s')],
      { simp only [ite_smul, sum_ite_of_true _ _ (λ i hi, hi), mul_smul, ← smul_sum], },
      { intros i hi hi', simp [hi'], },
      { intros i hi hi', simp [hi'], }, }, },
  { rintros x ⟨s, w, hw₀, hw₁, rfl⟩,
    exact affine_combination_mem_convex_hull hw₀ hw₁, },
end

/-- Convex hull of `s` is equal to the set of all centers of masses of `finset`s `t`, `z '' t ⊆ s`.
This version allows finsets in any type in any universe. -/
lemma convex_hull_eq (s : set E) :
  convex_hull R s = {x : E | ∃ (ι : Type u') (t : finset ι) (w : ι → R) (z : ι → E)
    (hw₀ : ∀ i ∈ t, 0 ≤ w i) (hw₁ : ∑ i in t, w i = 1) (hz : ∀ i ∈ t, z i ∈ s),
    t.center_mass w z = x} :=
begin
  refine subset.antisymm (convex_hull_min _ _) _,
  { intros x hx,
    use [punit, {punit.star}, λ _, 1, λ _, x, λ _ _, zero_le_one,
      finset.sum_singleton, λ _ _, hx],
    simp only [finset.center_mass, finset.sum_singleton, inv_one, one_smul] },
  { rintros x ⟨ι, sx, wx, zx, hwx₀, hwx₁, hzx, rfl⟩ y ⟨ι', sy, wy, zy, hwy₀, hwy₁, hzy, rfl⟩
      a b ha hb hab,
    rw [finset.center_mass_segment' _ _ _ _ _ _ hwx₁ hwy₁ _ _ hab],
    refine ⟨_, _, _, _, _, _, _, rfl⟩,
    { rintros i hi,
      rw [finset.mem_disj_sum] at hi,
      rcases hi with ⟨j, hj, rfl⟩|⟨j, hj, rfl⟩;
        simp only [sum.elim_inl, sum.elim_inr];
        apply_rules [mul_nonneg, hwx₀, hwy₀] },
    { simp [finset.sum_sum_elim, finset.mul_sum.symm, *], },
    { intros i hi,
      rw [finset.mem_disj_sum] at hi,
      rcases hi with ⟨j, hj, rfl⟩|⟨j, hj, rfl⟩; apply_rules [hzx, hzy] } },
  { rintros _ ⟨ι, t, w, z, hw₀, hw₁, hz, rfl⟩,
    exact t.center_mass_mem_convex_hull hw₀ (hw₁.symm ▸ zero_lt_one) hz }
end

lemma finset.convex_hull_eq (s : finset E) :
  convex_hull R ↑s = {x : E | ∃ (w : E → R) (hw₀ : ∀ y ∈ s, 0 ≤ w y) (hw₁ : ∑ y in s, w y = 1),
    s.center_mass w id = x} :=
begin
  refine subset.antisymm (convex_hull_min _ _) _,
  { intros x hx,
    rw [finset.mem_coe] at hx,
    refine ⟨_, _, _, finset.center_mass_ite_eq _ _ _ hx⟩,
    { intros, split_ifs, exacts [zero_le_one, le_refl 0] },
    { rw [finset.sum_ite_eq, if_pos hx] } },
  { rintro x ⟨wx, hwx₀, hwx₁, rfl⟩ y ⟨wy, hwy₀, hwy₁, rfl⟩ a b ha hb hab,
    rw [finset.center_mass_segment _ _ _ _ hwx₁ hwy₁ _ _ hab],
    refine ⟨_, _, _, rfl⟩,
    { rintros i hi,
      apply_rules [add_nonneg, mul_nonneg, hwx₀, hwy₀], },
    { simp only [finset.sum_add_distrib, finset.mul_sum.symm, mul_one, *] } },
  { rintros _ ⟨w, hw₀, hw₁, rfl⟩,
    exact s.center_mass_mem_convex_hull (λ x hx, hw₀ _ hx)
      (hw₁.symm ▸ zero_lt_one) (λ x hx, hx) }
end

lemma finset.mem_convex_hull {s : finset E} {x : E} :
  x ∈ convex_hull R (s : set E) ↔
    ∃ (w : E → R) (hw₀ : ∀ y ∈ s, 0 ≤ w y) (hw₁ : ∑ y in s, w y = 1), s.center_mass w id = x :=
by rw [finset.convex_hull_eq, set.mem_set_of_eq]

lemma set.finite.convex_hull_eq {s : set E} (hs : s.finite) :
  convex_hull R s = {x : E | ∃ (w : E → R) (hw₀ : ∀ y ∈ s, 0 ≤ w y)
    (hw₁ : ∑ y in hs.to_finset, w y = 1), hs.to_finset.center_mass w id = x} :=
by simpa only [set.finite.coe_to_finset, set.finite.mem_to_finset, exists_prop]
  using hs.to_finset.convex_hull_eq

/-- A weak version of Carathéodory's theorem. -/
lemma convex_hull_eq_union_convex_hull_finite_subsets (s : set E) :
  convex_hull R s = ⋃ (t : finset E) (w : ↑t ⊆ s), convex_hull R ↑t :=
begin
  refine subset.antisymm _ _,
  { rw convex_hull_eq,
    rintros x ⟨ι, t, w, z, hw₀, hw₁, hz, rfl⟩,
    simp only [mem_Union],
    refine ⟨t.image z, _, _⟩,
    { rw [coe_image, set.image_subset_iff],
      exact hz },
    { apply t.center_mass_mem_convex_hull hw₀,
      { simp only [hw₁, zero_lt_one] },
      { exact λ i hi, finset.mem_coe.2 (finset.mem_image_of_mem _ hi) } } },
  { exact Union_subset (λ i, Union_subset convex_hull_mono), },
end

lemma mk_mem_convex_hull_prod {t : set F} {x : E} {y : F} (hx : x ∈ convex_hull R s)
  (hy : y ∈ convex_hull R t) :
  (x, y) ∈ convex_hull R (s ×ˢ t) :=
begin
  rw convex_hull_eq at ⊢ hx hy,
  obtain ⟨ι, a, w, S, hw, hw', hS, hSp⟩ := hx,
  obtain ⟨κ, b, v, T, hv, hv', hT, hTp⟩ := hy,
  have h_sum : ∑ (i : ι × κ) in a ×ˢ b, w i.fst * v i.snd = 1,
  { rw [finset.sum_product, ← hw'],
    congr,
    ext i,
    have : ∑ (y : κ) in b, w i * v y = ∑ (y : κ) in b, v y * w i,
    { congr, ext, simp [mul_comm] },
    rw [this, ← finset.sum_mul, hv'],
    simp },
  refine ⟨ι × κ, a ×ˢ b, λ p, (w p.1) * (v p.2), λ p, (S p.1, T p.2),
    λ p hp, _, h_sum, λ p hp, _, _⟩,
  { rw mem_product at hp,
    exact mul_nonneg (hw p.1 hp.1) (hv p.2 hp.2) },
  { rw mem_product at hp,
    exact ⟨hS p.1 hp.1, hT p.2 hp.2⟩ },
  ext,
  { rw [←hSp, finset.center_mass_eq_of_sum_1 _ _ hw', finset.center_mass_eq_of_sum_1 _ _ h_sum],
    simp_rw [prod.fst_sum, prod.smul_mk],
    rw finset.sum_product,
    congr,
    ext i,
    have : ∑ (j : κ) in b, (w i * v j) • S i = ∑ (j : κ) in b, v j • w i • S i,
    { congr, ext, rw [mul_smul, smul_comm] },
    rw [this, ←finset.sum_smul, hv', one_smul] },
  { rw [←hTp, finset.center_mass_eq_of_sum_1 _ _ hv', finset.center_mass_eq_of_sum_1 _ _ h_sum],
    simp_rw [prod.snd_sum, prod.smul_mk],
    rw [finset.sum_product, finset.sum_comm],
    congr,
    ext j,
    simp_rw mul_smul,
    rw [←finset.sum_smul, hw', one_smul] }
end

@[simp] lemma convex_hull_prod (s : set E) (t : set F) :
  convex_hull R (s ×ˢ t) = convex_hull R s ×ˢ convex_hull R t :=
subset.antisymm (convex_hull_min (prod_mono (subset_convex_hull _ _) $ subset_convex_hull _ _) $
  (convex_convex_hull _ _).prod $ convex_convex_hull _ _) $
    prod_subset_iff.2 $ λ x hx y, mk_mem_convex_hull_prod hx

lemma convex_hull_add (s t : set E) : convex_hull R (s + t) = convex_hull R s + convex_hull R t :=
by simp_rw [←image2_add, ←image_prod, is_linear_map.is_linear_map_add.convex_hull_image,
  convex_hull_prod]

lemma convex_hull_sub (s t : set E) : convex_hull R (s - t) = convex_hull R s - convex_hull R t :=
by simp_rw [sub_eq_add_neg, convex_hull_add, convex_hull_neg]

/-! ### `std_simplex` -/

variables (ι) [fintype ι] {f : ι → R}

/-- `std_simplex 𝕜 ι` is the convex hull of the canonical basis in `ι → 𝕜`. -/
lemma convex_hull_basis_eq_std_simplex :
  convex_hull R (range $ λ(i j:ι), if i = j then (1:R) else 0) = std_simplex R ι :=
begin
  refine subset.antisymm (convex_hull_min _ (convex_std_simplex R ι)) _,
  { rintros _ ⟨i, rfl⟩,
    exact ite_eq_mem_std_simplex R i },
  { rintros w ⟨hw₀, hw₁⟩,
    rw [pi_eq_sum_univ w, ← finset.univ.center_mass_eq_of_sum_1 _ hw₁],
    exact finset.univ.center_mass_mem_convex_hull (λ i hi, hw₀ i)
      (hw₁.symm ▸ zero_lt_one) (λ i hi, mem_range_self i) }
end

variable {ι}

/-- The convex hull of a finite set is the image of the standard simplex in `s → ℝ`
under the linear map sending each function `w` to `∑ x in s, w x • x`.

Since we have no sums over finite sets, we use sum over `@finset.univ _ hs.fintype`.
The map is defined in terms of operations on `(s → ℝ) →ₗ[ℝ] ℝ` so that later we will not need
to prove that this map is linear. -/
lemma set.finite.convex_hull_eq_image {s : set E} (hs : s.finite) :
  convex_hull R s = by haveI := hs.fintype; exact
    (⇑(∑ x : s, (@linear_map.proj R s _ (λ i, R) _ _ x).smul_right x.1)) '' (std_simplex R s) :=
begin
  rw [← convex_hull_basis_eq_std_simplex, ← linear_map.convex_hull_image, ← set.range_comp, (∘)],
  apply congr_arg,
  convert subtype.range_coe.symm,
  ext x,
  simp [linear_map.sum_apply, ite_smul, finset.filter_eq]
end

/-- All values of a function `f ∈ std_simplex 𝕜 ι` belong to `[0, 1]`. -/
lemma mem_Icc_of_mem_std_simplex (hf : f ∈ std_simplex R ι) (x) :
  f x ∈ Icc (0 : R) 1 :=
⟨hf.1 x, hf.2 ▸ finset.single_le_sum (λ y hy, hf.1 y) (finset.mem_univ x)⟩

/-- The convex hull of an affine basis is the intersection of the half-spaces defined by the
corresponding barycentric coordinates. -/
lemma affine_basis.convex_hull_eq_nonneg_coord {ι : Type*} (b : affine_basis ι R E) :
  convex_hull R (range b) = {x | ∀ i, 0 ≤ b.coord i x} :=
begin
  rw convex_hull_range_eq_exists_affine_combination,
  ext x,
  refine ⟨_, λ hx, _⟩,
  { rintros ⟨s, w, hw₀, hw₁, rfl⟩ i,
    by_cases hi : i ∈ s,
    { rw b.coord_apply_combination_of_mem hi hw₁,
      exact hw₀ i hi, },
    { rw b.coord_apply_combination_of_not_mem hi hw₁, }, },
  { have hx' : x ∈ affine_span R (range b),
    { rw b.tot, exact affine_subspace.mem_top R E x, },
    obtain ⟨s, w, hw₁, rfl⟩ := (mem_affine_span_iff_eq_affine_combination R E).mp hx',
    refine ⟨s, w, _, hw₁, rfl⟩,
    intros i hi,
    specialize hx i,
    rw b.coord_apply_combination_of_mem hi hw₁ at hx,
    exact hx, },
end


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-

# More on functions

Another question on the Imperial introduction to proof problem sheet on functions
is "If `f : X → Y` and `g : Y → Z` and `g ∘ f` is injective, is it true that `g` is injective?"
This is not true. A counterexample could be made by letting `X` and `Z` have one element,
and letting `Y` have two elements; `f` and `g` are then not hard to write down. Let's
see how to do this in Lean by making inductive types `X`, `Y` and `Z` and functions
`f` and `g` which give an explicit counterexample.

-/

-- Let X be {a}
inductive X : Type
| a : X

-- in fact the term of type X is called `X.a`.

-- Let Y be {b,c}
inductive Y : Type
| b : Y
| c : Y

inductive Z : Type
| d : Z

-- Define f by f(X.a)=Y.b
def f : X → Y
| X.a := Y.b

-- define g by g(Y.b)=g(Y.c)=Z.d
def g : Y → Z
| Y.b := Z.d
| Y.c := Z.d

-- Here `Z` only has one term, so if `z : Z` then `cases z` only produces one goal,
-- namely "what you get if you change `z` to `Z.d`".
example (z : Z) : z = Z.d :=
begin
  cases z,
  refl,
end

lemma Yb_ne_Yc : Y.b ≠ Y.c :=
begin
  intro h, -- x ≠ y is definitionally equal to (x = y) → false
  cases h, -- no cases when they're equal!
end

-- The above and the below show that `g` is not injective
lemma gYb_eq_gYc : g Y.b = g Y.c :=
begin
  -- they're both definitionally `Z.d` so which tactic solves this goal?
  sorry
end

open function

lemma gf_injective : injective (g ∘ f) :=
begin
  sorry,
end

-- This is a question on the IUM (Imperial introduction to proof course) function problem sheet.
-- Recall that if you have a hypothesis of the form `h : ∀ A, ...`, then `specialize h X`
-- will specialize `h` to the specific case `A = X`.
example : ¬ (∀ A B C : Type, ∀ (φ : A → B) (ψ : B → C), injective (ψ ∘ φ) → injective ψ) :=
begin
  sorry,
end

-- This is another one. You might want to make some sublemmas first.
example : ¬ (∀ A B C : Type, ∀ (φ : A → B) (ψ : B → C), surjective (ψ ∘ φ) → surjective φ) :=
begin
  sorry,
end


/-
This is a d∃∀duction file providing exercises for basic set theory. 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
import push_neg_once

-- dEAduction definitions
import set_definitions

-- General principles :
-- Type should be defined as parameters, in order to be implicit everywhere
-- other parameters are implicit in definitions, i.e. defined using '{}' (e.g. {A : set X} )
-- but explicit everywhere else, i.e. defined using '()' (e.g. (A : set X) )
-- each definition must be an iff statement or an equality
-- (since it will be called with 'rw' or 'symp_rw')

-------------------------
-- dEAduction METADATA --
-------------------------
-- logic names ['and', 'or', 'negate', 'implicate', 'iff', 'forall', 'exists']
-- proofs names ['use_proof_methods', 'new_object', 'apply', 'assumption']
-- magic names ['compute']
-- proof methods names ['cbr', 'contrapose', 'absurdum', 'sorry']

/- dEAduction
Title
    Théorie des ensembles
Author
    Frédéric Le Roux
Institution
    Université de France
Description
    Ce cours correspond à un cours standard de théorie "élémentaire" des ensembles.
-/

local attribute [instance] classical.prop_decidable

---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course
parameters {X Y Z: Type}

open set

------------------
-- COURSE TITLE --
------------------
namespace theorie_des_ensembles
/- dEAduction
PrettyName
    Théorie des ensembles
-/

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

------------------------
-- COURSE DEFINITIONS --
------------------------
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
ImplicitUse
    True
-/
begin
     exact set.ext_iff
end

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

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

lemma definition.ensemble_extension {X: Type}  {P : X → Prop} {x:X} :
 x ∈ {x | P x} ↔ P x
:=
/- dEAduction
PrettyName
    Ensemble en extension
-/
begin
    refl
end

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

lemma exercise.inclusion_transitive
(A B C : set X) :
(A ⊆ B ∧ B ⊆ C) → A ⊆ C
:=
/- dEAduction
PrettyName
    Transitivité de l'inclusion
-/
begin
    todo
end

end generalites

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

-----------------
-- DEFINITIONS --
-----------------
namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

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.intersection_quelconque_ensembles {I : index_set} {E : I → set X}  {x : X} :
(x ∈ set.Inter E) ↔ (∀ i:I, x ∈ E i) :=
/- dEAduction
PrettyName
    Intersection d'une famille quelconque d'ensembles
MatchPattern
    IFF(
    ∈(?0, SET_INTER+(?1) )
    ∀(TYPE, ?2, ∈(?0, APP(?1, ?2) ) )
    )
-/
begin
    exact set.mem_Inter
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

lemma definition.union_quelconque_ensembles {I : index_set} {E : I → set X}  {x : X} :
(x ∈ set.Union E) ↔ (∃ i:I, x ∈ E i) :=
/- dEAduction
PrettyName
    Union d'une famille quelconque d'ensembles
-/
begin
    exact set.mem_Union
end

end definitions

---------------
-- EXERCICES --
---------------
namespace exercices

lemma exercise.intersection_inclus_ensemble :
A ∩ B ⊆ A
:=
/- dEAduction
PrettyName
    Un ensemble contient son intersection avec un autre
-/
begin
    todo
end

lemma exercise.union_distributive_inter : A ∩ (B ∪ C)  = (A ∩ B) ∪ (A ∩ C) :=
/- dEAduction
PrettyName
    Intersection avec une union
Description
    L'intersection est distributive par rapport à l'union
AvailableLogic
    $ALL
AvailableProofs
    $ALL
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
AvailableTheorems
    double_inclusion
ExpectedVarsNumber
    X=3, A=1, B=1
-/
begin
    rw generalites.definition.egalite_deux_ensembles,
    intro x, split,
    intro H,
    cases H with H1 H2,
    cases H2 with H2a H2b,
    left,
    split,
    assumption, assumption,
    right, split, assumption, assumption, todo
end

-- NB: 'ExpectedVarsNumber' is not implemented yet
-- planned to be used for naming variables

lemma exercise.inter_distributive_union : A ∪ (B ∩ C)  = (A ∪ B) ∩ (A ∪ C) :=
/- dEAduction
PrettyName
    Union avec une intersection
Description
    L'union est distributive par rapport à l'intersection
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
-/
begin
    todo
end

end exercices

end unions_et_intersections

---------------
-- SECTION 2 --
---------------
namespace complementaire
/- dEAduction
PrettyName
    Complémentaire
-/

-- variables complementaire --
variables  {A B : set X}
variables {I : index_set} {E F : I → set X}
-- notation `∁`A := set.compl A

-----------------
-- DEFINITIONS --
-----------------
lemma definition.complement {A : set X} {x : X} : x ∈ set.compl A ↔ x ∉ A :=
/- dEAduction
PrettyName
    Complémentaire
-/
begin
    finish
end

---------------
-- EXERCICES --
---------------
lemma exercise.complement_complement : (set.compl (set.compl A)) = A :=
/- dEAduction
PrettyName
    Complémentaire du complémentaire
Description
    Tout ensemble est égal au complémentaire de son complémentaire
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
-/
begin
    todo
end

lemma exercise.complement_union_deux :
set.compl (A ∪ B) = (set.compl A) ∩ (set.compl B) :=
/- dEAduction
PrettyName
    Complémentaire d'union I
Description
    Le complémentaire de l'union de deux ensembles égale l'intersection des complémentaires
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
-/
begin
    todo
end

lemma exercise.complement_union_quelconque :
set.compl (set.Union (λ i, E i)) = set.Inter (λ i, set.compl (E i)) :=
/- dEAduction
PrettyName
    Complémentaire d'union II
Description
    Le complémentaire d'une réunion quelconque égale l'intersection des complémentaires
-/
begin
    todo
end

lemma exercise.inclusion_complement_I :
A ⊆ B → set.compl B ⊆ set.compl A
:=
/- dEAduction
PrettyName
    Le passage au complémentaire renverse les inclusions, implication
Description
    Si A est inclus dans B, alors le complémentaire de A contient le complémentaire de B
-/
begin
    todo
end

lemma exercise.inclusion_complement_II :
A ⊆ B ↔ set.compl B ⊆ set.compl A
:=
/- dEAduction
PrettyName
    Le passage au complémentaire renverse les inclusions, équivalence
Description
    Si A est inclus dans B, alors le complémentaire de A contient le complémentaire de B
-/
begin
    todo
end

/- Autres : différence-/

end complementaire

-- Ajouter :  4. relations ?

namespace produits_cartesiens
/- dEAduction
PrettyName
    Produits cartésiens
-/

-- Peut-on en faire une définition ?
lemma theorem.type_produit :
∀ z:X × Y, ∃ x:X, ∃ y:Y, z = (x,y)
:=
/- dEAduction
PrettyName
    Element d'un produit cartésien de deux ensembles
-/
begin
    todo
end

lemma definition.produit_de_parties {A : set X} {B : set Y}
{x:X} {y:Y} :
(x,y) ∈ set.prod A B ↔ x ∈ A ∧ y ∈ B
:=
/- dEAduction
PrettyName
    Produit cartésien de deux parties
-/
begin
    todo
end

lemma exercise.produit_avec_intersection
(A : set X) (B C : set Y) :
set.prod A (B ∩ C) = (set.prod A B) ∩ (set.prod A C)
:=
begin
    todo,
end

end produits_cartesiens
---------------
-- SECTION 3 --
---------------
namespace applications_I
/- dEAduction
PrettyName
    Applications et opérations ensemblistes
-/

-- variables applications --

variables  {A A': set X}
variables {f: X → Y} {B B': set Y}
-- variables {I : Type} {E : I → set X} {F : I → set Y}
variables {I : index_set} {E : set_family I X} {F : set_family I Y}
variables (g : Y → Z) (h : X → Z)

-- a-t-on besoin de ceci ?
-- lemma theorem.egalite_fonctions : f = f' ↔ ∀ x : X, f(x) = f'(x) :=
--  function.funext_iff

-----------------
-- DEFINITIONS --
-----------------
namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

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

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

lemma definition.composition {x:X}:
composition g f x = g (f x)
:=
begin
    todo,
end

lemma definition.egalite_fonctions (f' : X → Y) :
f = f' ↔ ∀ x, f x = f' x :=
/- dEAduction
PrettyName
    Egalité de deux fonctions
-/
begin
    exact function.funext_iff,
end

lemma definition.Identite (f₀: X → X) :
f₀ = Identite ↔ ∀ x, f₀ x = x :=
/- dEAduction
PrettyName
    Application identité
-/
begin
    apply definition.egalite_fonctions,
end

end definitions

---------------
-- EXERCICES --
---------------
namespace exercices
/- dEAduction
PrettyName
    Exercices
-/
open applications_I.definitions

lemma exercise.image_de_reciproque : f '' (f ⁻¹' B)  ⊆ B :=
/- dEAduction
PrettyName
    Image de l'image réciproque
-/
begin
    todo
end

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

lemma exercise.image_reciproque_inter :  f ⁻¹'  (B∩B') = f ⁻¹'  (B) ∩ f ⁻¹'  (B') :=
/- dEAduction
PrettyName
    Image réciproque d'une intersection de deux ensembles
-/
begin
    todo
end

lemma  exercise.image_reciproque_union  : f ⁻¹' (B ∪ B') = f ⁻¹' B ∪ f ⁻¹' B'
:=
/- dEAduction
PrettyName
    Image réciproque d'une union de deux ensembles
-/
begin
    todo
end

-- set_option pp.width 100
lemma exercise.image_reciproque_inter_quelconque :
(f ⁻¹'  (set.Inter (F))) = set.Inter (λ i, f ⁻¹' (F i): set_family I X)
-- (f ⁻¹'  (set.Inter (λ i, F i))) = set.Inter (λ i, f ⁻¹' (F i))
:=
/- dEAduction
PrettyName
    Image réciproque d'une intersection quelconque
-/
begin
    todo
end

lemma exercise.image_reciproque_union_quelconque :
(f ⁻¹'  (set.Union (λ i, F i))) = set.Union (λ i, f ⁻¹' (F i))
:=
/- dEAduction
PrettyName
    Image réciproque d'une union quelconque
-/
begin
    todo
end

lemma exercise.image_inter_inclus_inter_images :
f '' (A∩A') ⊆ f '' (A) ∩ f '' (A')
:=
/- dEAduction
PrettyName
    Image d'une intersection
-/
begin
    todo
end

lemma exercise.reciproque_complementaire_I :
f ⁻¹' (set.compl B) ⊆ set.compl (f ⁻¹' B)
:=
/- dEAduction
PrettyName
    Image réciproque du complémentaire, inclusion
-/
begin
    todo
end

lemma exercise.reciproque_complementaire_II :
f ⁻¹' (set.compl B) = set.compl (f ⁻¹' B)
:=
/- dEAduction
PrettyName
    Image réciproque du complémentaire, égalité
-/
begin
    todo
end

lemma exercices.image_reciproque.composition
(C: set Z)
:
((composition g f) )⁻¹' C = f ⁻¹' (g ⁻¹' C)
:=
begin
    todo
end

end exercices
end applications_I

----------------
-- SUBSECTION --
----------------
namespace applications_II
/- dEAduction
PrettyName
    Injections et surjections
-/

-- variables injections_surjections --
variables (f: X → Y) (g : Y → Z) (h : X → Z)

-----------------
-- DEFINITIONS --
-----------------
namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

lemma definition.injectivite :
injective f ↔ ∀ x y : X, (f x = f y → x = y)
:=
/- 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

-- A bouger, mais à enlever de tous les exos où ça ne sert pas !
lemma definition.existe_un_unique
(P : X → Prop) :
(∃! (λx,  P x)) ↔  (∃ x : X, (P x ∧ (∀ x' : X, P x' → x' = x)))
:=
/- dEAduction
PrettyName
    ∃! : existence et unicité
-/
begin
    todo
end

lemma definition.bijectivite_1 :
bijective f ↔ (injective f ∧ surjective f)
:=
/- dEAduction
PrettyName
    Application bijective (première définition)
-/
begin
    todo
end

lemma definition.bijectivite_2 :
bijective f ↔ ∀ y : Y, exists_unique (λ x, y = f x)
:=
/- dEAduction
PrettyName
    Application bijective (seconde définition)
-/
begin
    refl,
end

end definitions

---------------
-- EXERCICES --
---------------
namespace exercices
/- dEAduction
PrettyName
    Exercices
-/

open applications_II.definitions

lemma exercise.composition_injections
(H1 : injective f) (H2 : injective g)
:
injective (composition g f)
:=
/- dEAduction
PrettyName
    Composition d'injections
-/
begin
    todo
end

lemma exercise.composition_surjections
(H1 : surjective f) (H2 : surjective g) :
surjective (composition g f)
:=
/- dEAduction
PrettyName
    Composition de surjections
-/
begin
    todo
end

lemma exercise.injective_si_compo_injective
(H1 : injective (composition g f)) :
injective f
:=
/- dEAduction
PrettyName
    Injective si composition injective
-/
begin
    todo
end

lemma exercise.surjective_si_compo_surjective
(H1 : surjective (composition g f)) :
surjective g
:=
/- dEAduction
PrettyName
    Surjective si composition surjective
-/
begin
    todo
end

lemma exercise.injective_ssi_inverse_gauche : (injective f) ↔
∃ F: Y → X, (composition F f) = Identite :=
/- dEAduction
PrettyName
    (x) Injectivité et inverse à gauche
-/
begin
    todo
end

lemma exercise.surjective_ssi_inverse_droite : (surjective f) ↔
∃ F: Y → X, (composition f F) = Identite :=
/- dEAduction
PrettyName
    (*) Surjectivité et inverse à droite
-/
begin
    todo
end

lemma exercise.bijective_ssi_inverse :
(bijective f) ↔ ∃ g : Y → X,
composition g f = Identite ∧ composition f g  = Identite
:=
/- dEAduction
PrettyName
    (**) Bijectivité et existence d'une application réciproque
-/
begin
    todo
end

lemma exercise.unicite_inverse :
(bijective f) → exists_unique (λ g : Y → X,
composition g f = Identite)
:=
/- dEAduction
PrettyName
    (+) Unicité de la réciproque d'une application bijective
-/
begin
    todo
end

lemma exercise.Cantor (f : X → set X):
 ¬ surjective f
:=
/- dEAduction
PrettyName
    (+) Théorème de Cantor : il n'y a pas de surjection d'un ensemble vers l'ensemble de ses parties
-/
begin
    by_contradiction H14,
    let A := {x | x ∉ f x}, have H15 : A = {x | x ∉ f x}, refl,
    rw theorie_des_ensembles.applications_II.definitions.definition.surjectivite at H14,
    have H16 := H14 A,
    cases H16 with x H17,
    cases (classical.em (x dans A)) with H22 H23,
    {
        have H22b: x ∉ A,
        rw H15 at H22,
        rw generalites.definition.ensemble_extension at H22,
        rw H17, assumption,
        contradiction,
    },
    {
        have H22b: x ∈ A,
        rw H15 at H23,
        -- simp only[ensemble_extension] at H23,
        rw generalites.definition.ensemble_extension at H23,
        push_neg at H23,
        rw H17, assumption,
        contradiction
    }
end

end exercices

end applications_II

-----------------------------------
-----------------------------------
namespace exercices_supplementaires

-- relations : rel d'eq implique classes égales ou disjointes
-- les images réciproques des singletons forment une partition
-- bijective ssi inversible à g et d et inverses coincident

lemma exercise.exercice_ensembles_1
(A B : set X) :
A ⊆ B ↔ A ∩ B = A
:=
/- dEAduction
PrettyName
    Caractérisation de l'inclusion par l'intersection
-/
begin
    todo
end

lemma exercise.complement_intersection_2
(A B : set X):
set.compl (A ∩  B) = (set.compl A) ∪ (set.compl B)
:=
/- dEAduction
PrettyName
    Complémentaire d'une intersection
-/
begin
    todo
end

lemma exercise.exercice_ensembles_3
(A B : set X) :
A ∩ B = A ∪ B → A = B
:=
/- dEAduction
PrettyName
    Quand l'intersection égale l'union
-/
begin
    todo
end

lemma exercise.exercice_ensembles_4a
(A B C : set X) :
A ∩ B = A ∩ C ∧ (set.compl A) ∩ B = (set.compl A) ∩ C → B ⊆ C
:=
/- dEAduction
PrettyName
    Caractérisation par intersection avec A et son complémentaire, I
-/
begin
    todo
end

lemma exercise.exercice_ensembles_4b
(A B C : set X) :
A ∩ B = A ∩ C ∧ (set.compl A) ∩ B = (set.compl A) ∩ C → B = C
:=
/- dEAduction
PrettyName
    Caractérisaton par intersection avec A et son complémentaire, II
-/
begin
    todo
end

lemma exercise.exercice_ensembles_5
(A B C : set X) :
A ∩ B = A ∩ C ∧ A ∪ B = A ∪ C → B = C
:=
/- dEAduction
PrettyName
    Même union et même intersection
-/
begin
    todo
end

--def diff {X : Type} (A B : set X) := {x ∈ A | ¬ x ∈ B}
--notation A `\\` B := diff A B

-- def symmetric_difference {X : Type} (A B : set X) := (A ∪ B) \ (A ∩ B)
-- notation A `Δ` B := symmetric_difference A B

namespace difference_et_difference_symetrique
/- dEAduction
PrettyName
    Différence et différence symétrique
-/

namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

lemma definition.difference
(A B : set X) (x : X) :
x ∈ (A \ B) ↔ x ∈ A ∧ x ∉ B
:=
/- dEAduction
PrettyName
    Différence de deux ensembles
-/
begin
    refl,
end

lemma definition.difference_symetrique
(A B : set X) :
(A Δ B) =  (A ∪ B) \ (A ∩ B)
:=
/- dEAduction
PrettyName
    Différence symétrique de deux ensembles
-/
begin
    refl,
end

end definitions

namespace exercices
/- dEAduction
PrettyName
    Exercices
-/

lemma exercise.difference_symetrique_1
(A B : set X) :
(A Δ B) = (A \ B) ∪ (B \ A)
:=
/- dEAduction
PrettyName
    Différence symétrique I
-/
begin
    todo
end

lemma exercise.difference_symetrique_2
(A B : set X) :
(A Δ B) = (B Δ A)
:=
/- dEAduction
PrettyName
    (*) Différence symétrique II
-/
begin
    todo
end

lemma exercise.difference_symetrique_3
(A B C : set X) :
((A Δ B) Δ C) = (A Δ (B Δ C))
:=
/- dEAduction
PrettyName
    (**) Différence symétrique III
-/
begin
    todo
end

lemma exercise.difference_symetrique_4 :
∃! (λE : set X, ∀ A : set X, (A Δ E) = A) :=
/- dEAduction
PrettyName
    (+) Différence symétrique VI
-/
begin
    todo
end

lemma exercise.difference_symetrique_5 (A : set X) :
exists_unique (λA' : set X, (A Δ A') = set.univ)
:=
/- dEAduction
PrettyName
    (+) Différence symétrique V
-/
begin
    todo
    -- use complement A,
    -- norm_num,
end

lemma exercise.difference_symetrique_6
(A B : set X) :
(A Δ B) = ∅ ↔ A = B
:=
/- dEAduction
PrettyName
    (+) Différence symétrique VI
-/
begin
    todo
end

end exercices

end difference_et_difference_symetrique

-- applications
variable (f: X → Y)

namespace applications

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

lemma exercise.exercice_applications_2
(A B : set X) :
f '' (A ∪ B)  = f '' A ∪ f '' B
:=
/- dEAduction
PrettyName
    Image d'une union
-/
begin
    todo
end

open applications_II.definitions
lemma exercise.exercice_factorisation_I
(g : Y → Z) (h: X → Z) :
(∃ f: X → Y, h = (composition g f)) ↔ h '' set.univ ⊆ g '' set.univ
:=
/- dEAduction
PrettyName
    (+) Factorisation I
-/
begin
    todo
end

lemma exercise.exercice_factorisation_II
(f : X → Y) (h: X → Z) :
(∃ g: Y → Z, h = (composition g f)) ↔ (∀ x y, (f x = f y → h x = h y))
:=
/- dEAduction
PrettyName
    (+) Factorisation II
-/
begin
    todo
end

-- TODO: ajouter exoset ficall.pdf exos (140 bijections) 141 142 146

lemma exercise.injectivite_surjecivite_1 (f: X → Y) (g: Y → Z)
(H1 : injective (composition g f)) (H2 : surjective f)
:
injective g
:=
/- dEAduction
PrettyName
    Injectivité et surjectivité I
-/
begin
    todo
end

lemma exercise.injectivite_surjecivite_2 (f: X → Y) (g: Y → Z)
(H1 : surjective (composition g f)) (H2 : injective g)
:
surjective f
:=
/- dEAduction
PrettyName
    Injectivité et surjectivité II
-/
begin
    todo
end

lemma exercise.injectivite_categorielle
(f: Y → Z):
(injective f) → (∀X: Type, ∀ g h : X → Y, (composition f g) = (composition f h) → g = h)
:=
/- dEAduction
PrettyName
    Injectivité catégorielle
-/
begin
    todo
end

lemma exercise.surjectivite_categorielle
(f: X → Y):
(surjective f) →  (∀Z: Type, ∀ g h : Y → Z, (composition g f ) = (composition h f ) → g = h)
:=
/- dEAduction
PrettyName
    Surjectivité catégorielle
-/
begin
    todo
end

end applications

end exercices_supplementaires

end theorie_des_ensembles

end course


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import number_theory.zsqrtd.basic
import data.complex.basic
import ring_theory.principal_ideal_domain
import number_theory.quadratic_reciprocity
/-!
# Gaussian integers

The Gaussian integers are complex integer, complex numbers whose real and imaginary parts are both
integers.

## Main definitions

The Euclidean domain structure on `ℤ[i]` is defined in this file.

The homomorphism `to_complex` into the complex numbers is also defined in this file.

## Main statements

`prime_iff_mod_four_eq_three_of_nat_prime`
A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4`

## Notations

This file uses the local notation `ℤ[i]` for `gaussian_int`

## Implementation notes

Gaussian integers are implemented using the more general definition `zsqrtd`, the type of integers
adjoined a square root of `d`, in this case `-1`. The definition is reducible, so that properties
and definitions about `zsqrtd` can easily be used.
-/

open zsqrtd complex

@[reducible] def gaussian_int : Type := zsqrtd (-1)

local notation `ℤ[i]` := gaussian_int

namespace gaussian_int

instance : has_repr ℤ[i] := ⟨λ x, "⟨" ++ repr x.re ++ ", " ++ repr x.im ++ "⟩"⟩

instance : comm_ring ℤ[i] := zsqrtd.comm_ring

section
local attribute [-instance] complex.field -- Avoid making things noncomputable unnecessarily.

/-- The embedding of the Gaussian integers into the complex numbers, as a ring homomorphism. -/
def to_complex : ℤ[i] →+* ℂ :=
zsqrtd.lift ⟨I, by simp⟩
end

instance : has_coe (ℤ[i]) ℂ := ⟨to_complex⟩

lemma to_complex_def (x : ℤ[i]) : (x : ℂ) = x.re + x.im * I := rfl

lemma to_complex_def' (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ) = x + y * I := by simp [to_complex_def]

lemma to_complex_def₂ (x : ℤ[i]) : (x : ℂ) = ⟨x.re, x.im⟩ :=
by apply complex.ext; simp [to_complex_def]

@[simp] lemma to_real_re (x : ℤ[i]) : ((x.re : ℤ) : ℝ) = (x : ℂ).re := by simp [to_complex_def]
@[simp] lemma to_real_im (x : ℤ[i]) : ((x.im : ℤ) : ℝ) = (x : ℂ).im := by simp [to_complex_def]
@[simp] lemma to_complex_re (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ).re = x := by simp [to_complex_def]
@[simp] lemma to_complex_im (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ).im = y := by simp [to_complex_def]
@[simp] lemma to_complex_add (x y : ℤ[i]) : ((x + y : ℤ[i]) : ℂ) = x + y := to_complex.map_add _ _
@[simp] lemma to_complex_mul (x y : ℤ[i]) : ((x * y : ℤ[i]) : ℂ) = x * y := to_complex.map_mul _ _
@[simp] lemma to_complex_one : ((1 : ℤ[i]) : ℂ) = 1 := to_complex.map_one
@[simp] lemma to_complex_zero : ((0 : ℤ[i]) : ℂ) = 0 := to_complex.map_zero
@[simp] lemma to_complex_neg (x : ℤ[i]) : ((-x : ℤ[i]) : ℂ) = -x := to_complex.map_neg _
@[simp] lemma to_complex_sub (x y : ℤ[i]) : ((x - y : ℤ[i]) : ℂ) = x - y := to_complex.map_sub _ _

@[simp] lemma to_complex_inj {x y : ℤ[i]} : (x : ℂ) = y ↔ x = y :=
by cases x; cases y; simp [to_complex_def₂]

@[simp] lemma to_complex_eq_zero {x : ℤ[i]} : (x : ℂ) = 0 ↔ x = 0 :=
by rw [← to_complex_zero, to_complex_inj]

@[simp] lemma nat_cast_real_norm (x : ℤ[i]) : (x.norm : ℝ) = (x : ℂ).norm_sq :=
by rw [norm, norm_sq]; simp

@[simp] lemma nat_cast_complex_norm (x : ℤ[i]) : (x.norm : ℂ) = (x : ℂ).norm_sq :=
by cases x; rw [norm, norm_sq]; simp

lemma norm_nonneg (x : ℤ[i]) : 0 ≤ norm x := norm_nonneg (by norm_num) _

@[simp] lemma norm_eq_zero {x : ℤ[i]} : norm x = 0 ↔ x = 0 :=
by rw [← @int.cast_inj ℝ _ _ _]; simp

lemma norm_pos {x : ℤ[i]} : 0 < norm x ↔ x ≠ 0 :=
by rw [lt_iff_le_and_ne, ne.def, eq_comm, norm_eq_zero]; simp [norm_nonneg]

@[simp] lemma coe_nat_abs_norm (x : ℤ[i]) : (x.norm.nat_abs : ℤ) = x.norm :=
int.nat_abs_of_nonneg (norm_nonneg _)

@[simp] lemma nat_cast_nat_abs_norm {α : Type*} [ring α]
  (x : ℤ[i]) : (x.norm.nat_abs : α) = x.norm :=
by rw [← int.cast_coe_nat, coe_nat_abs_norm]

lemma nat_abs_norm_eq (x : ℤ[i]) : x.norm.nat_abs =
  x.re.nat_abs * x.re.nat_abs + x.im.nat_abs * x.im.nat_abs :=
int.coe_nat_inj $ begin simp, simp [norm] end

protected def div (x y : ℤ[i]) : ℤ[i] :=
let n := (rat.of_int (norm y))⁻¹ in let c := y.conj in
⟨round (rat.of_int (x * c).re * n : ℚ),
 round (rat.of_int (x * c).im * n : ℚ)⟩

instance : has_div ℤ[i] := ⟨gaussian_int.div⟩

lemma div_def (x y : ℤ[i]) : x / y = ⟨round ((x * conj y).re / norm y : ℚ),
  round ((x * conj y).im / norm y : ℚ)⟩ :=
show zsqrtd.mk _ _ = _, by simp [rat.of_int_eq_mk, rat.mk_eq_div, div_eq_mul_inv]

lemma to_complex_div_re (x y : ℤ[i]) : ((x / y : ℤ[i]) : ℂ).re = round ((x / y : ℂ).re) :=
by rw [div_def, ← @rat.round_cast ℝ _ _];
  simp [-rat.round_cast, mul_assoc, div_eq_mul_inv, mul_add, add_mul]

lemma to_complex_div_im (x y : ℤ[i]) : ((x / y : ℤ[i]) : ℂ).im = round ((x / y : ℂ).im) :=
by rw [div_def, ← @rat.round_cast ℝ _ _, ← @rat.round_cast ℝ _ _];
  simp [-rat.round_cast, mul_assoc, div_eq_mul_inv, mul_add, add_mul]

lemma norm_sq_le_norm_sq_of_re_le_of_im_le {x y : ℂ} (hre : |x.re| ≤ |y.re|)
  (him : |x.im| ≤ |y.im|) : x.norm_sq ≤ y.norm_sq :=
by rw [norm_sq_apply, norm_sq_apply, ← _root_.abs_mul_self, _root_.abs_mul,
  ← _root_.abs_mul_self y.re, _root_.abs_mul y.re,
  ← _root_.abs_mul_self x.im, _root_.abs_mul x.im,
  ← _root_.abs_mul_self y.im, _root_.abs_mul y.im]; exact
(add_le_add (mul_self_le_mul_self (abs_nonneg _) hre)
  (mul_self_le_mul_self (abs_nonneg _) him))

lemma norm_sq_div_sub_div_lt_one (x y : ℤ[i]) :
  ((x / y : ℂ) - ((x / y : ℤ[i]) : ℂ)).norm_sq < 1 :=
calc ((x / y : ℂ) - ((x / y : ℤ[i]) : ℂ)).norm_sq =
    ((x / y : ℂ).re - ((x / y : ℤ[i]) : ℂ).re +
    ((x / y : ℂ).im - ((x / y : ℤ[i]) : ℂ).im) * I : ℂ).norm_sq :
      congr_arg _ $ by apply complex.ext; simp
  ... ≤ (1 / 2 + 1 / 2 * I).norm_sq :
  have |(2⁻¹ : ℝ)| = 2⁻¹, from _root_.abs_of_nonneg (by norm_num),
  norm_sq_le_norm_sq_of_re_le_of_im_le
    (by rw [to_complex_div_re]; simp [norm_sq, this];
      simpa using abs_sub_round (x / y : ℂ).re)
    (by rw [to_complex_div_im]; simp [norm_sq, this];
      simpa using abs_sub_round (x / y : ℂ).im)
  ... < 1 : by simp [norm_sq]; norm_num

protected def mod (x y : ℤ[i]) : ℤ[i] := x - y * (x / y)

instance : has_mod ℤ[i] := ⟨gaussian_int.mod⟩

lemma mod_def (x y : ℤ[i]) : x % y = x - y * (x / y) := rfl

lemma norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) : (x % y).norm < y.norm :=
have (y : ℂ) ≠ 0, by rwa [ne.def, ← to_complex_zero, to_complex_inj],
(@int.cast_lt ℝ _ _ _ _).1 $
  calc ↑(norm (x % y)) = (x - y * (x / y : ℤ[i]) : ℂ).norm_sq : by simp [mod_def]
  ... = (y : ℂ).norm_sq * (((x / y) - (x / y : ℤ[i])) : ℂ).norm_sq :
    by rw [← norm_sq_mul, mul_sub, mul_div_cancel' _ this]
  ... < (y : ℂ).norm_sq * 1 : mul_lt_mul_of_pos_left (norm_sq_div_sub_div_lt_one _ _)
    (norm_sq_pos.2 this)
  ... = norm y : by simp

lemma nat_abs_norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
  (x % y).norm.nat_abs < y.norm.nat_abs :=
int.coe_nat_lt.1 (by simp [-int.coe_nat_lt, norm_mod_lt x hy])

lemma norm_le_norm_mul_left (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
  (norm x).nat_abs ≤ (norm (x * y)).nat_abs :=
by rw [norm_mul, int.nat_abs_mul];
  exact le_mul_of_one_le_right (nat.zero_le _)
    (int.coe_nat_le.1 (by rw [coe_nat_abs_norm]; exact int.add_one_le_of_lt (norm_pos.2 hy)))

instance : nontrivial ℤ[i] :=
⟨⟨0, 1, dec_trivial⟩⟩

instance : euclidean_domain ℤ[i] :=
{ quotient := (/),
  remainder := (%),
  quotient_zero := by { simp [div_def], refl },
  quotient_mul_add_remainder_eq := λ _ _, by simp [mod_def],
  r := _,
  r_well_founded := measure_wf (int.nat_abs ∘ norm),
  remainder_lt := nat_abs_norm_mod_lt,
  mul_left_not_lt := λ a b hb0, not_lt_of_ge $ norm_le_norm_mul_left a hb0,
  .. gaussian_int.comm_ring,
  .. gaussian_int.nontrivial }

open principal_ideal_ring

lemma mod_four_eq_three_of_nat_prime_of_prime (p : ℕ) [hp : fact p.prime] (hpi : prime (p : ℤ[i])) :
  p % 4 = 3 :=
hp.1.eq_two_or_odd.elim
  (λ hp2, absurd hpi (mt irreducible_iff_prime.2 $
    λ ⟨hu, h⟩, begin
      have := h ⟨1, 1⟩ ⟨1, -1⟩ (hp2.symm ▸ rfl),
      rw [← norm_eq_one_iff, ← norm_eq_one_iff] at this,
      exact absurd this dec_trivial
    end))
  (λ hp1, by_contradiction $ λ hp3 : p % 4 ≠ 3,
    have hp41 : p % 4 = 1,
      begin
        rw [← nat.mod_mul_left_mod p 2 2, show 2 * 2 = 4, from rfl] at hp1,
        have := nat.mod_lt p (show 0 < 4, from dec_trivial),
        revert this hp3 hp1,
        generalize : p % 4 = m, dec_trivial!,
      end,
    let ⟨k, hk⟩ := (zmod.exists_sq_eq_neg_one_iff_mod_four_ne_three p).2 $
      by rw hp41; exact dec_trivial in
    begin
      obtain ⟨k, k_lt_p, rfl⟩ : ∃ (k' : ℕ) (h : k' < p), (k' : zmod p) = k,
      { refine ⟨k.val, k.val_lt, zmod.nat_cast_zmod_val k⟩ },
      have hpk : p ∣ k ^ 2 + 1,
        by rw [← char_p.cast_eq_zero_iff (zmod p) p]; simp *,
      have hkmul : (k ^ 2 + 1 : ℤ[i]) = ⟨k, 1⟩ * ⟨k, -1⟩ :=
        by simp [sq, zsqrtd.ext],
      have hpne1 : p ≠ 1 := ne_of_gt hp.1.one_lt,
      have hkltp : 1 + k * k < p * p,
        from calc 1 + k * k ≤ k + k * k :
          add_le_add_right (nat.pos_of_ne_zero
            (λ hk0, by clear_aux_decl; simp [*, pow_succ'] at *)) _
        ... = k * (k + 1) : by simp [add_comm, mul_add]
        ... < p * p : mul_lt_mul k_lt_p k_lt_p (nat.succ_pos _) (nat.zero_le _),
      have hpk₁ : ¬ (p : ℤ[i]) ∣ ⟨k, -1⟩ :=
        λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
          calc (norm (p * x : ℤ[i])).nat_abs = (norm ⟨k, -1⟩).nat_abs : by rw hx
          ... < (norm (p : ℤ[i])).nat_abs : by simpa [add_comm, norm] using hkltp
          ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
            (λ hx0, (show (-1 : ℤ) ≠ 0, from dec_trivial) $
              by simpa [hx0] using congr_arg zsqrtd.im hx),
      have hpk₂ : ¬ (p : ℤ[i]) ∣ ⟨k, 1⟩ :=
        λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
          calc (norm (p * x : ℤ[i])).nat_abs = (norm ⟨k, 1⟩).nat_abs : by rw hx
          ... < (norm (p : ℤ[i])).nat_abs : by simpa [add_comm, norm] using hkltp
          ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
            (λ hx0, (show (1 : ℤ) ≠ 0, from dec_trivial) $
                by simpa [hx0] using congr_arg zsqrtd.im hx),
      have hpu : ¬ is_unit (p : ℤ[i]), from mt norm_eq_one_iff.2
        (by rw [norm_nat_cast, int.nat_abs_mul, nat.mul_eq_one_iff];
        exact λ h, (ne_of_lt hp.1.one_lt).symm h.1),
      obtain ⟨y, hy⟩ := hpk,
      have := hpi.2.2 ⟨k, 1⟩ ⟨k, -1⟩ ⟨y, by rw [← hkmul, ← nat.cast_mul p, ← hy]; simp⟩,
      clear_aux_decl, tauto
    end)

lemma sq_add_sq_of_nat_prime_of_not_irreducible (p : ℕ) [hp : fact p.prime]
  (hpi : ¬irreducible (p : ℤ[i])) : ∃ a b, a^2 + b^2 = p :=
have hpu : ¬ is_unit (p : ℤ[i]), from mt norm_eq_one_iff.2 $
  by rw [norm_nat_cast, int.nat_abs_mul, nat.mul_eq_one_iff];
    exact λ h, (ne_of_lt hp.1.one_lt).symm h.1,
have hab : ∃ a b, (p : ℤ[i]) = a * b ∧ ¬ is_unit a ∧ ¬ is_unit b,
  by simpa [irreducible_iff, hpu, not_forall, not_or_distrib] using hpi,
let ⟨a, b, hpab, hau, hbu⟩ := hab in
have hnap : (norm a).nat_abs = p, from ((hp.1.mul_eq_prime_sq_iff
    (mt norm_eq_one_iff.1 hau) (mt norm_eq_one_iff.1 hbu)).1 $
  by rw [← int.coe_nat_inj', int.coe_nat_pow, sq,
    ← @norm_nat_cast (-1), hpab];
    simp).1,
⟨a.re.nat_abs, a.im.nat_abs, by simpa [nat_abs_norm_eq, sq] using hnap⟩

lemma prime_of_nat_prime_of_mod_four_eq_three (p : ℕ) [hp : fact p.prime] (hp3 : p % 4 = 3) :
  prime (p : ℤ[i]) :=
irreducible_iff_prime.1 $ classical.by_contradiction $ λ hpi,
  let ⟨a, b, hab⟩ := sq_add_sq_of_nat_prime_of_not_irreducible p hpi in
have ∀ a b : zmod 4, a^2 + b^2 ≠ p, by erw [← zmod.nat_cast_mod 4 p, hp3]; exact dec_trivial,
this a b (hab ▸ by simp)

/-- A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4` -/
lemma prime_iff_mod_four_eq_three_of_nat_prime (p : ℕ) [hp : fact p.prime] :
  prime (p : ℤ[i]) ↔ p % 4 = 3 :=
⟨mod_four_eq_three_of_nat_prime_of_prime p, prime_of_nat_prime_of_mod_four_eq_three p⟩

end gaussian_int


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import analysis.normed_space.star.basic
import analysis.normed_space.operator_norm

/-! # The left-regular representation is an isometry for C⋆-algebras -/

open continuous_linear_map

local postfix `⋆`:std.prec.max_plus := star

variables (𝕜 : Type*) {E : Type*}
variables [densely_normed_field 𝕜] [non_unital_normed_ring E] [star_ring E] [cstar_ring E]
variables [normed_space 𝕜 E] [is_scalar_tower 𝕜 E E] [smul_comm_class 𝕜 E E] (a : E)

/-- In a C⋆-algebra `E`, either unital or non-unital, multiplication on the left by `a : E` has
norm equal to the norm of `a`. -/
@[simp] lemma op_nnnorm_mul : ‖mul 𝕜 E a‖₊ = ‖a‖₊ :=
begin
  rw ←Sup_closed_unit_ball_eq_nnnorm,
  refine cSup_eq_of_forall_le_of_forall_lt_exists_gt _ _ (λ r hr, _),
  { exact (metric.nonempty_closed_ball.mpr zero_le_one).image _ },
  { rintro - ⟨x, hx, rfl⟩,
    exact ((mul 𝕜 E a).unit_le_op_norm x $ mem_closed_ball_zero_iff.mp hx).trans
      (op_norm_mul_apply_le 𝕜 E a) },
  { have ha : 0 < ‖a‖₊ := zero_le'.trans_lt hr,
    rw [←inv_inv (‖a‖₊), nnreal.lt_inv_iff_mul_lt (inv_ne_zero ha.ne')] at hr,
    obtain ⟨k, hk₁, hk₂⟩ := normed_field.exists_lt_nnnorm_lt 𝕜 (mul_lt_mul_of_pos_right hr $
      inv_pos.2 ha),
    refine ⟨_, ⟨k • star a, _, rfl⟩, _⟩,
    { simpa only [mem_closed_ball_zero_iff, norm_smul, one_mul, norm_star] using
        (nnreal.le_inv_iff_mul_le ha.ne').1 (one_mul ‖a‖₊⁻¹ ▸ hk₂.le : ‖k‖₊ ≤ ‖a‖₊⁻¹) },
    { simp only [map_smul, nnnorm_smul, mul_apply', mul_smul_comm, cstar_ring.nnnorm_self_mul_star],
      rwa [←nnreal.div_lt_iff (mul_pos ha ha).ne', div_eq_mul_inv, mul_inv, ←mul_assoc] } },
end

/-- In a C⋆-algebra `E`, either unital or non-unital, multiplication on the right by `a : E` has
norm eqaul to the norm of `a`. -/
@[simp] lemma op_nnnorm_mul_flip : ‖(mul 𝕜 E).flip a‖₊ = ‖a‖₊ :=
begin
  rw [←Sup_unit_ball_eq_nnnorm, ←nnnorm_star, ←@op_nnnorm_mul 𝕜 E, ←Sup_unit_ball_eq_nnnorm],
  congr' 1,
  simp only [mul_apply', flip_apply],
  refine set.subset.antisymm _ _;
  rintro - ⟨b, hb, rfl⟩;
  refine ⟨star b, by simpa only [norm_star, mem_ball_zero_iff] using hb, _⟩,
  { simp only [←star_mul, nnnorm_star] },
  { simpa using (nnnorm_star (star b * a)).symm }
end

variables (E)

/-- In a C⋆-algebra `E`, either unital or non-unital, the left regular representation is an
isometry. -/
lemma mul_isometry : isometry (mul 𝕜 E) :=
add_monoid_hom_class.isometry_of_norm _ (λ a, congr_arg coe $ op_nnnorm_mul 𝕜 a)

/-- In a C⋆-algebra `E`, either unital or non-unital, the right regular anti-representation is an
isometry. -/
lemma mul_flip_isometry : isometry (mul 𝕜 E).flip :=
add_monoid_hom_class.isometry_of_norm _ (λ a, congr_arg coe $ op_nnnorm_mul_flip 𝕜 a)


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.set.basic
import order.lattice
import order.max

/-!
# Directed indexed families and sets

This file defines directed indexed families and directed sets. An indexed family/set is
directed iff each pair of elements has a shared upper bound.

## Main declarations

* `directed r f`: Predicate stating that the indexed family `f` is `r`-directed.
* `directed_on r s`: Predicate stating that the set `s` is `r`-directed.
* `is_directed α r`: Prop-valued mixin stating that `α` is `r`-directed. Follows the style of the
  unbundled relation classes such as `is_total`.
-/

open function

universes u v w

variables {α : Type u} {β : Type v} {ι : Sort w} (r s : α → α → Prop)
local infix ` ≼ ` : 50 := r

/-- A family of elements of α is directed (with respect to a relation `≼` on α)
  if there is a member of the family `≼`-above any pair in the family.  -/
def directed (f : ι → α) := ∀ x y, ∃ z, f x ≼ f z ∧ f y ≼ f z

/-- A subset of α is directed if there is an element of the set `≼`-above any
  pair of elements in the set. -/
def directed_on (s : set α) := ∀ (x ∈ s) (y ∈ s), ∃ z ∈ s, x ≼ z ∧ y ≼ z

variables {r}

theorem directed_on_iff_directed {s} : @directed_on α r s ↔ directed r (coe : s → α) :=
by simp [directed, directed_on]; refine ball_congr (λ x hx, by simp; refl)

alias directed_on_iff_directed ↔ directed_on.directed_coe _

theorem directed_on_image {s} {f : β → α} :
  directed_on r (f '' s) ↔ directed_on (f ⁻¹'o r) s :=
by simp only [directed_on, set.ball_image_iff, set.bex_image_iff, order.preimage]

theorem directed_on.mono {s : set α} (h : directed_on r s)
  {r' : α → α → Prop} (H : ∀ {a b}, r a b → r' a b) :
  directed_on r' s :=
λ x hx y hy, let ⟨z, zs, xz, yz⟩ := h x hx y hy in ⟨z, zs, H xz, H yz⟩

theorem directed_comp {ι} {f : ι → β} {g : β → α} :
  directed r (g ∘ f) ↔ directed (g ⁻¹'o r) f := iff.rfl

theorem directed.mono {s : α → α → Prop} {ι} {f : ι → α}
  (H : ∀ a b, r a b → s a b) (h : directed r f) : directed s f :=
λ a b, let ⟨c, h₁, h₂⟩ := h a b in ⟨c, H _ _ h₁, H _ _ h₂⟩

theorem directed.mono_comp {ι} {rb : β → β → Prop} {g : α → β} {f : ι → α}
  (hg : ∀ ⦃x y⦄, x ≼ y → rb (g x) (g y)) (hf : directed r f) :
  directed rb (g ∘ f) :=
directed_comp.2 $ hf.mono hg

/-- A monotone function on a sup-semilattice is directed. -/
lemma directed_of_sup [semilattice_sup α] {f : α → β} {r : β → β → Prop}
  (H : ∀ ⦃i j⦄, i ≤ j → r (f i) (f j)) : directed r f :=
λ a b, ⟨a ⊔ b, H le_sup_left, H le_sup_right⟩

lemma monotone.directed_le [semilattice_sup α] [preorder β] {f : α → β} :
  monotone f → directed (≤) f :=
directed_of_sup

lemma directed.extend_bot [preorder α] [order_bot α] {e : ι → β} {f : ι → α}
  (hf : directed (≤) f) (he : function.injective e) :
  directed (≤) (function.extend e f ⊥) :=
begin
  intros a b,
  rcases (em (∃ i, e i = a)).symm with ha | ⟨i, rfl⟩,
  { use b, simp [function.extend_apply' _ _ _ ha] },
  rcases (em (∃ i, e i = b)).symm with hb | ⟨j, rfl⟩,
  { use e i, simp [function.extend_apply' _ _ _ hb] },
  rcases hf i j with ⟨k, hi, hj⟩,
  use (e k),
  simp only [function.extend_apply he, *, true_and]
end

/-- An antitone function on an inf-semilattice is directed. -/
lemma directed_of_inf [semilattice_inf α] {r : β → β → Prop} {f : α → β}
  (hf : ∀ a₁ a₂, a₁ ≤ a₂ → r (f a₂) (f a₁)) : directed r f :=
λ x y, ⟨x ⊓ y, hf _ _ inf_le_left, hf _ _ inf_le_right⟩

/-- `is_directed α r` states that for any elements `a`, `b` there exists an element `c` such that
`r a c` and `r b c`. -/
class is_directed (α : Type*) (r : α → α → Prop) : Prop :=
(directed (a b : α) : ∃ c, r a c ∧ r b c)

lemma directed_of (r : α → α → Prop) [is_directed α r] (a b : α) : ∃ c, r a c ∧ r b c :=
is_directed.directed _ _

lemma directed_id [is_directed α r] : directed r id := by convert directed_of r
lemma directed_id_iff : directed r id ↔ is_directed α r := ⟨λ h, ⟨h⟩, @directed_id _ _⟩

lemma directed_on_univ [is_directed α r] : directed_on r set.univ :=
λ a _ b _, let ⟨c, hc⟩ := directed_of r a b in ⟨c, trivial, hc⟩

lemma directed_on_univ_iff : directed_on r set.univ ↔ is_directed α r :=
⟨λ h, ⟨λ a b, let ⟨c, _, hc⟩ := h a trivial b trivial in ⟨c, hc⟩⟩, @directed_on_univ _ _⟩

@[priority 100]  -- see Note [lower instance priority]
instance is_total.to_is_directed [is_total α r] : is_directed α r :=
⟨λ a b, or.cases_on (total_of r a b) (λ h, ⟨b, h, refl _⟩) (λ h, ⟨a, refl _, h⟩)⟩

lemma is_directed_mono [is_directed α r] (h : ∀ ⦃a b⦄, r a b → s a b) : is_directed α s :=
⟨λ a b, let ⟨c, ha, hb⟩ := is_directed.directed a b in ⟨c, h ha, h hb⟩⟩

lemma exists_ge_ge [has_le α] [is_directed α (≤)] (a b : α) : ∃ c, a ≤ c ∧ b ≤ c :=
directed_of (≤) a b

lemma exists_le_le [has_le α] [is_directed α (swap (≤))] (a b : α) : ∃ c, c ≤ a ∧ c ≤ b :=
directed_of (swap (≤)) a b

instance order_dual.is_directed_ge [has_le α] [is_directed α (≤)] :
  is_directed (order_dual α) (swap (≤)) :=
by assumption

instance order_dual.is_directed_le [has_le α] [is_directed α (swap (≤))] :
  is_directed (order_dual α) (≤) :=
by assumption

section preorder
variables [preorder α] {a : α}

protected lemma is_min.is_bot [is_directed α (swap (≤))] (h : is_min a) : is_bot a :=
λ b, let ⟨c, hca, hcb⟩ := exists_le_le a b in (h hca).trans hcb

protected lemma is_max.is_top [is_directed α (≤)] (h : is_max a) : is_top a :=
λ b, let ⟨c, hac, hbc⟩ := exists_ge_ge a b in hbc.trans $ h hac

lemma is_bot_iff_is_min [is_directed α (swap (≤))] : is_bot a ↔ is_min a :=
⟨is_bot.is_min, is_min.is_bot⟩

lemma is_top_iff_is_max [is_directed α (≤)] : is_top a ↔ is_max a := ⟨is_top.is_max, is_max.is_top⟩

end preorder

@[priority 100]  -- see Note [lower instance priority]
instance semilattice_sup.to_is_directed_le [semilattice_sup α] : is_directed α (≤) :=
⟨λ a b, ⟨a ⊔ b, le_sup_left, le_sup_right⟩⟩

@[priority 100]  -- see Note [lower instance priority]
instance semilattice_inf.to_is_directed_ge [semilattice_inf α] : is_directed α (swap (≤)) :=
⟨λ a b, ⟨a ⊓ b, inf_le_left, inf_le_right⟩⟩

@[priority 100]  -- see Note [lower instance priority]
instance order_top.to_is_directed_le [has_le α] [order_top α] : is_directed α (≤) :=
⟨λ a b, ⟨⊤, le_top, le_top⟩⟩

@[priority 100]  -- see Note [lower instance priority]
instance order_bot.to_is_directed_ge [has_le α] [order_bot α] : is_directed α (swap (≤)) :=
⟨λ a b, ⟨⊥, bot_le, bot_le⟩⟩


import data.real.basic
import algebra.field.basic
import data.nat.parity
import algebra.big_operators.ring

open_locale big_operators

open division_ring
open finset
open nat

-- supporting proofs

theorem alg_sup_proof_1 (n : ℕ) (h₀ : n > 1) :
  (n-1)/2 < n :=
begin
  rw nat.div_lt_iff_lt_mul,
  {
    induction n with n hn,
    {linarith},
    {rw succ_eq_add_one, simp, linarith}
  },
  {exact zero_lt_two}
end

theorem alg_sup_proof_2 (n : ℕ) (h₀ : n > 1) :
  n/2 < n :=
begin
  rw nat.div_lt_iff_lt_mul,
  {linarith},
  {exact zero_lt_two}
end

theorem alg_sup_proof_3 (n k : ℕ) :
  2 * 2 ^ k * (n + 1) > 1 :=
begin
  have hx : ∃ x : ℕ, x = 2 ^ k, by use 2 ^ k,
  cases hx with x hx,
  have hx₂ : x > 0, by simp *,
  have hy : ∃ y : ℕ, y = n + 1, by use (n+1),
  cases hy with y hy,
  have hy₂ : y > 0, by simp *,
  have hxy : ∃ xy : ℕ, xy = x * y, by use x * y,
  cases hxy with xy hxy,
  have hxy₂ : xy > 0, by {rw hxy, exact mul_pos hx₂ hy₂},
  rw [←hx, ←hy, mul_assoc, ←hxy],
  linarith
end

def c : ℕ → ℤ
| n :=
  if h₀ : n > 1 then
    if h₁ : odd n then
      have (n-1)/2 < n, by exact alg_sup_proof_1 n h₀,
      (-1) ^ ((n-1)/2) * c ((n-1)/2)
    else
      have n/2 < n, by exact alg_sup_proof_2 n h₀,
      c (n/2)
  else
    1

-- lhs of core

theorem c_2n_eq_c_n (n : ℕ) :
  c(2*n) = c(n) :=
begin
  rw c,
  cases n,
  {simp, rw c, simp},
  {
    rw succ_eq_add_one,
    have n_greater : 2 * (n + 1) > 1, by {
      exact (cmp_eq_lt_iff 1 (2 * (n + 1))).mp rfl
    },
    have n_even : even (2 * (n + 1)), by {rw even, use n + 1},
    simp *,
  }
end

theorem c_2n_add_2_eq_c_n_add_1 (n : ℕ) :
  c(2*n+2) = c(n+1) :=
begin
  have eq_ex : 2 * n + 2 = 2 * (n + 1), by linarith,
  rw eq_ex,
  exact c_2n_eq_c_n (n + 1)
end

-- rhs of core

theorem c_2n_add_1_eq_sign_c_n (n : ℕ) :
  c(2*n+1) = (-1) ^ n * c(n) :=
begin
  rw c,
  cases n,
  {simp, rw c, simp},
  {
    rw succ_eq_add_one,
    have ex_greater : 2 * (n + 1) + 1 > 1, by linarith,
    have ex_odd : odd (2*(n+1)+1), by {rw odd, use (n+1)},
    simp *
  }
end

theorem c_2n_add_3_eq_sign_c_n_add_1 (n : ℕ) :
  c(2*n+3) = (-1) ^ (n+1) * c(n+1) :=
begin
  have eq_ex : 2 * n + 3 = 2 * (n + 1) + 1, by linarith,
  rw eq_ex,
  exact c_2n_add_1_eq_sign_c_n (n + 1)
end

-- main equality
theorem core_eq_putnam (n : ℕ) :
  c(2*n) * c(2*n+2) = (-1) * c(2*n+1) * c(2*n+3) :=
begin
  -- exploiting mini-proofs to simplify
  rw c_2n_eq_c_n,
  rw c_2n_add_2_eq_c_n_add_1,
  rw c_2n_add_1_eq_sign_c_n,
  rw c_2n_add_3_eq_sign_c_n_add_1,
  -- deal with signs
  -- get rid of (-1)^(2)
  rw [←mul_assoc, ←mul_assoc, ←pow_succ],
  rw mul_assoc ((-1 : ℤ) ^ (n + 1)),
  rw mul_comm (c(n)) ((-1)^(n+1)),
  rw [←mul_assoc, pow_succ, ←mul_assoc],
  rw [mul_assoc (-1 : ℤ), mul_comm ((-1 : ℤ)^n)],
  rw ←mul_assoc (-1 : ℤ) (-1) ((-1)^n),
  rw [←sq (-1 : ℤ), neg_one_sq, one_mul],
  -- get rid of (-1)^n
  rw [←pow_add, ←two_mul, mul_comm 2 n],
  rw [pow_mul', neg_one_sq, one_pow, one_mul]
end

theorem putnam_2013_b1 :
  ∑ i in range 2014, c(i) * c(i+2) = 0 :=
begin
  have eq : 2014 = 2 * 1007, by norm_num,
  rw eq,
  induction 1007,
  {simp},
  {
    rw [succ_eq_add_one, mul_add, mul_one],
    rw [sum_range_succ, sum_range_succ],
    rw [ih, zero_add, core_eq_putnam],
    linarith
  }
end


/-
This is a sorry-free file covering the material on Wednesday afternoon
at LFTCM2020. It's how to build some algebraic structures in Lean
-/

import data.rat.basic-- we'll need the rationals at the end of this file

/-
As a mathematician I essentially always start my Lean files with the following line:
-/
import tactic

/- That gives me access to all Lean's tactics
(see https://leanprover-community.github.io/mathlib_docs/tactics.html)
-/

/-
## The point of this file
The idea of this file is to show how to build in Lean what the computer scientists call
"an algebraic heirarchy", and what mathematicians call "groups, rings, fields, modules etc".
Firstly, we will define groups, and develop a basic interface for groups.
Then we will define rings, fields, modules, vector spaces, and just demonstrate
that they are usable, rather than making a complete interface for all of them.
Let's start with the theory of groups. Unfortunately Lean has groups already,
so we will have to do everything in a namespace
-/

namespace lftcm

/-
... which means that now when we define `group`, it will actually be called `lftcm.group`.
## Notation typeclasses
To make a term of type `has_mul G`, you need to give a map G^2 → G (or
more precisely, a map `has_mul.mul : G → G → G`. Lean's notation `g * h`
is notation for `has_mul.mul g h`. Furthermore, `has_mul` is a class.
In short, this means that if you write `[has_mul G]` then `G` will
magically have a multiplication called `*` (satisfying no axioms).
Similarly `[has_one G]` gives you `has_one.one : G` with notation `1 : G`,
and `[has_inv G]` gives you `has_inv.inv : G → G` with notation `g⁻¹ : G`
## Definition of a group
If `G` is a type, equipped with `* : G^2 → G`, `1 : G` and `⁻¹ : G → G`
then it's a group if it satisfies the group axioms.
-/

-- `group G` is the type of group structures on a type `G`.
-- first we ask for the structure
class group (G : Type) extends has_mul G, has_one G, has_inv G :=
-- and then we ask for the axioms
  (mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
  (one_mul : ∀ (a : G), 1 * a = a)
  (mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

/-
Advantages of this approach: axioms look lovely.
Disadvantage: what if I want the group law to be `+`?? I have embedded `has_mul`
in the definition.
Lean's solution: develop a `to_additive` metaprogram which translates all theorems about
`group`s (with group law `*`) to theorems about `add_group`s (with group law `+`). We will
not go into details here.
-/

namespace group

-- let G be a group

variables {G : Type} [group G]

/-
Lemmas about groups are proved in this namespace. We already have some!
All the group axioms are theorems in this namespace. Indeed we have just defined
`group.mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c)`
`group.one_mul : ∀ (a : G), 1 * a = a`
`group.mul_left_inv : ∀ (a : G), a⁻¹ * a = 1`
Because we are in the `group` namespace, we don't need to write `group.`
everywhere.
Let's put some more theorems into the `group` namespace.
We definitely need `mul_one` and `mul_right_inv`, and it's a fun exercise to
get them. Here is a route:
`mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c`
`mul_eq_of_eq_inv_mul {a x y : G} : x = a⁻¹ * y → a * x = y`
`mul_one (a : G) : a * 1 = a`
`mul_right_inv (a : G) : a * a⁻¹ = 1`
-/

lemma mul_left_cancel (a b c : G) (Habac : a * b = a * c) : b = c :=
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by rw mul_left_inv
    ... = a⁻¹ * (a * b) : by rw mul_assoc
    ... = a⁻¹ * (a * c) : by rw Habac
    ... = (a⁻¹ * a) * c : by rw ←mul_assoc
    ... = 1 * c         : by rw ←mul_left_inv
    ... = c             : by rw one_mul

-- more mathlib-ish proof:
lemma mul_left_cancel' (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
  rw [←one_mul b, ←mul_left_inv a, mul_assoc, Habac, ←mul_assoc, mul_left_inv, one_mul],
end

lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  -- ⊢ a⁻¹ * (a * x) = a⁻¹ * y
  rwa [←mul_assoc, mul_left_inv, one_mul],
end

-- The same proof
lemma mul_eq_of_eq_inv_mul' {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
mul_left_cancel a⁻¹ _ _ $ by rwa [←mul_assoc, mul_left_inv, one_mul]

/-
So now we can finally prove `mul_one` and `mul_right_inv`.
But before we start, let's learn a little bit about the simplifier.
## The `simp` tactic -- Lean's simplifier
We have the theorems (axioms) `one_mul g : 1 * g = g` and
`mul_left_inv g : g⁻¹ * g = 1`. Both of these theorems are of
the form `A = B`, with `A` more complicated than `B`. This means
that they are *perfect* theorems for the simplifier. Let's teach
those theorems to the simplifier, by adding the `@[simp]` attribute to them.
An "attribute" is just a tag which we attach to a theorem (or definition).
-/

attribute [simp] one_mul mul_left_inv

/-
Now let's prove `mul_one` using the simplifier. This also a perfect
`simp` lemma, so let's also add the `simp` tag to it.
-/

@[simp] theorem mul_one (a : G) : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  -- ⊢ 1 = a⁻¹ * a
  simp,
end

/-
The simplifier solved `1 = a⁻¹ * a` because it knew `mul_left_inv`.
Feel free to comment out the `attribute [simp] one_mul mul_left_inv` line
above, and observe that the proof breaks.
-/

-- term mode proof
theorem mul_one' (a : G) : a * 1 = a :=
mul_eq_of_eq_inv_mul $ by simp

-- see if you can get the simplifier to do this one too
@[simp] theorem mul_right_inv (a : G) : a * a⁻¹ = 1 :=
begin
  apply mul_left_cancel a⁻¹,
  rw [← mul_assoc, mul_left_inv, one_mul, mul_one],
end

-- Now here's a question. Can we train the simplifier to solve the following problem:

-- example (a b c d : G) :
--  ((a * b)⁻¹ * a * 1⁻¹⁻¹⁻¹ * b⁻¹ * b * b * 1 * 1⁻¹)⁻¹ = (c⁻¹⁻¹ * d * d⁻¹ * 1⁻¹⁻¹ * c⁻¹⁻¹⁻¹)⁻¹⁻¹ :=
-- by simp

-- Remove the --'s and see that it fails. Let's see if we can get it to work.

-- We start with two very natural `simp` lemmas.

@[simp] lemma one_inv : (1 : G)⁻¹ = 1 :=
begin
  apply mul_left_cancel (1 : G),
  rw [mul_right_inv, mul_one],
end

@[simp] lemma inv_inv (a : G) : a⁻¹⁻¹ = a :=
begin
  apply mul_left_cancel a⁻¹,
  rw [mul_right_inv, mul_left_inv],
end

-- Here is a riskier looking `[simp]` lemma.

attribute [simp] mul_assoc -- recall this says (a * b) * c = a * (b * c)

-- The simplifier will now push all brackets to the right, which means
-- that it's worth proving the following two lemmas and tagging
-- them `[simp]`, so that we can still cancel a with a⁻¹ in these situations.

@[simp] lemma inv_mul_cancel_left (a b : G) : a⁻¹ * (a * b) = b :=
begin
  rw [← mul_assoc, mul_left_inv, one_mul],
end

@[simp] lemma mul_inv_cancel_left (a b : G) : a * (a⁻¹ * b) = b :=
begin
  rw [← mul_assoc, mul_right_inv, one_mul],
end

-- Finally, let's make a `simp` lemma which enables us to
-- reduce all inverses to inverses of variables
@[simp] lemma mul_inv_rev (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  apply mul_left_cancel (a * b),
  simp [mul_right_inv],
end

/-
If you solved them all -- congratulations!
You have just turned Lean's simplifier into a normalising confluent
rewriting system for groups, following Knuth-Bendix.
https://en.wikipedia.org/wiki/Confluence_(abstract_rewriting)#Motivating_examples
In other words, the simplifier will now put any element of a free group
into a canonical normal form, and can hence solve the word problem
for free groups.
-/
example (a b c d : G) :
  ((a * b)⁻¹ * a * 1⁻¹⁻¹⁻¹ * b⁻¹ * b * b * 1 * 1⁻¹)⁻¹ = (c⁻¹⁻¹ * d * d⁻¹ * 1⁻¹⁻¹ * c⁻¹⁻¹⁻¹)⁻¹⁻¹ :=
by simp

-- Abstract example of the power of classes: we can define products of groups with instances

instance (G : Type) [group G] (H : Type) [group H] : group (G × H) :=
{ mul := λ k l, (k.1*l.1, k.2*l.2),
  one := (1,1),
  inv := λ k, (k.1⁻¹, k.2⁻¹),
  mul_assoc := begin
    intros a b c,
    cases a, cases b, cases c,
    ext;
    simp,
  end,
  one_mul := begin
    intro a, ext; simp,
  end,
  mul_left_inv := begin
    intro a, ext; simp,
  end }

-- the type class inference system now knows that products of groups are groups
example (G H K : Type) [group G] [group H] [group K] : group (G × H × K) :=
by apply_instance

end group

-- let's make a group of order two.

-- First the elements {+1, -1}
inductive mu2
| p1 : mu2
| m1 : mu2

namespace mu2

-- Now let's do some CS stuff:

-- 1) prove it has decidable equality
attribute [derive decidable_eq] mu2

-- 2) prove it is finite
instance : fintype mu2 := ⟨⟨[mu2.p1, mu2.m1], by simp⟩, λ x, by cases x; simp⟩

-- now back to the maths.

-- Define multiplication by doing all cases
def mul : mu2 → mu2 → mu2
| p1 p1 := p1
| p1 m1 := m1
| m1 p1 := m1
| m1 m1 := p1

instance : has_mul mu2 := ⟨mul⟩

-- identity
def one : mu2 := p1

-- notation
instance : has_one mu2 := ⟨one⟩

-- inverse
def inv : mu2 → mu2 := id

-- notation
instance : has_inv mu2 := ⟨inv⟩

-- currently we have notation but no axioms

example : p1 * m1 * m1 = p1⁻¹ * p1 := rfl -- all true by definition

-- now let's make it a group
instance : group mu2 :=
begin
  -- first define the structure
  refine_struct { mul := mul, one := one, inv := inv },
  -- now we have three goals (the axioms)
  all_goals {exact dec_trivial}
end

end mu2

-- Now let's build rings and modules and stuff (via monoids and add_comm_groups)

-- a monoid is a group without inverses
class monoid (M : Type) extends has_mul M, has_one M :=
(mul_assoc : ∀ (a b c : M), a * b * c = a * (b * c))
(one_mul : ∀ (a : M), 1 * a = a)
(mul_one : ∀ (a : M), a * 1 = a)

-- additive commutative groups from first principles
class add_comm_group (A : Type) extends has_add A, has_zero A, has_neg A :=
(add_assoc : ∀ (a b c : A), a + b + c = a + (b + c))
(zero_add : ∀ (a : A), 0 + a = a)
(add_left_neg : ∀ (a : A), -a + a = 0)
(add_comm : ∀ a b : A, a + b = b + a)

-- Notation for subtraction is handy to have; define a - b to be a + (-b)
instance (A : Type) [add_comm_group A] : has_sub A := ⟨λ a b, a + -b⟩

-- rings are additive abelian groups and multiplicative monoids,
-- with distributivity
class ring (R : Type) extends monoid R, add_comm_group R :=
(mul_add : ∀ (a b c : R), a * (b + c) = a * b + a * c)
(add_mul : ∀ (a b c : R), (a + b) * c = a * c + b * c)

-- for commutative rings, add commutativity of multiplication
class comm_ring (R : Type) extends ring R :=
(mul_comm : ∀ a b : R, a * b = b * a)

/-- Typeclass for types with a scalar multiplication operation, denoted `•` (`\bu`) -/
class has_scalar (R : Type) (M : Type) := (smul : R → M → M)

infixr ` • `:73 := has_scalar.smul

-- modules for a ring
class module (R : Type) [ring R] (M : Type) [add_comm_group M]
extends has_scalar R M :=
(smul_add : ∀(r : R) (x y : M), r • (x + y) = r • x + r • y)
(add_smul : ∀(r s : R) (x : M), (r + s) • x = r • x + s • x)
(mul_smul : ∀ (r s : R) (x : M), (r * s) • x = r • s • x)
(one_smul : ∀ x : M, (1 : R) • x = x)

-- for fields we let ⁻¹ be defined on the entire field, and demand 0⁻¹ = 0
-- and that a⁻¹ * a = 1 for non-zero a. This is merely for convenience;
-- one can easily check that it's mathematically equivalent to the usual
-- definition of a field.
class field (K : Type) extends comm_ring K, has_inv K :=
(zero_ne_one : (0 : K) ≠ 1)
(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1)
(inv_zero : (0 : K)⁻¹ = 0)

-- the type of vector spaces
def vector_space (K : Type) [field K] (V : Type) [add_comm_group V] := module K V

/-
Exercise for the reader: define manifolds, schemes, perfectoid spaces in Lean.
All have been done! As you can see, it is clearly *feasible*, although it does
sometimes take time to get it right. It is all very much work in progress.
The extraordinary thing is that although these computer theorem
provers have been around for about 50 years, there has never been a serious
effort to make the standard definitions used all over modern mathematics in
one of them, and this is why these systems are rarely used in mathematics departments.
Changing this is one of the goals of the Leanprover community.
-/

/-
Let's check that we can make the rational numbers into a field. Of course
they are already a field in Lean, but remember that when we say `field`
below, we mean our just-defined structure `lftcm.field`.
-/

-- the rationals are a field (easy because all the work is done in the import)
instance : field ℚ :=
{ mul := (*),
  one := 1,
  mul_assoc := rat.mul_assoc,
  one_mul := rat.one_mul,
  mul_one := rat.mul_one,
  add := (+),
  zero := 0,
  neg := has_neg.neg, -- no () trickery for unary operators
  add_assoc := rat.add_assoc,
  zero_add := rat.zero_add,
  add_left_neg := rat.add_left_neg,
  add_comm := rat.add_comm,
  mul_add := rat.mul_add,
  add_mul := rat.add_mul,
  mul_comm := rat.mul_comm,
  inv := has_inv.inv, -- see neg
  zero_ne_one := rat.zero_ne_one,
  mul_inv_cancel := rat.mul_inv_cancel,
  inv_zero := inv_zero -- I don't know why rat.inv_zero was never explicitly defined
  }

/-
Below is evidence that we can prove basic theorems about these structures.
Note however that it is a *complete pain* because we are *re-implementing*
everything; `add_comm` defaults to Lean's version for Lean's `add_comm_group`s, so we
have to explicitly write `add_comm_group.add_comm` to use our own version.
The mathlib versions of these proofs are less ugly.
-/

variables {A : Type} [add_comm_group A]

lemma add_comm_group.add_left_cancel (a b c : A) (Habac : a + b = a + c) : b = c :=
begin
  rw ←add_comm_group.zero_add b,
  rw ←add_comm_group.add_left_neg a,
  rw add_comm_group.add_assoc,
  rw Habac,
  rw ←add_comm_group.add_assoc,
  rw add_comm_group.add_left_neg,
  rw add_comm_group.zero_add,
end

lemma add_comm_group.add_right_neg (a : A) : a + -a = 0 :=
begin
  rw add_comm_group.add_comm,
  rw add_comm_group.add_left_neg,
end

lemma add_comm_group.sub_eq_add_neg (a b : A) :
  a - b = a + -b :=
begin
  -- this is just our definition of subtraction
  refl
end

lemma add_comm_group.sub_self (a : A) : a - a = 0 :=
begin
  rw add_comm_group.sub_eq_add_neg,
  rw add_comm_group.add_comm,
  rw add_comm_group.add_left_neg,
end

lemma add_comm_group.neg_eq_of_add_eq_zero (a b : A) (h : a + b = 0) : -a = b :=
begin
  apply add_comm_group.add_left_cancel a,
  rw h,
  rw add_comm_group.add_right_neg,
end

lemma add_comm_group.add_zero (a : A) : a + 0 = a :=
begin
  rw add_comm_group.add_comm,
  rw add_comm_group.zero_add,
end

variables {R : Type} [ring R]

lemma ring.mul_zero (r : R) : r * 0 = 0 :=
begin
  apply add_comm_group.add_left_cancel (r * 0),
  rw ←ring.mul_add,
  rw add_comm_group.add_zero,
  rw add_comm_group.add_zero,
end

-- etc etc, for thousands of lines of mathlib, which develop the interface
-- abelian groups, rings, commutative rings, modules, fields, vector spaces etc.

end lftcm

/-
## Advertisement
Finished the natural number game? Have Lean installed? Want more games/exercises?
Take a look at the following projects, many of which are ongoing but
the first three of which are pretty much ready:
*) The complex number game (complete, needs to be played within VS Code)
https://github.com/ImperialCollegeLondon/complex-number-game
To install, type
`leanproject get ImperialCollegeLondon/complex-number-game`
and then just open the levels in `src/complex`.
*) Undergraduate level mathematics Lean puzzles (plenty of stuff here,
and more appearing over the summer):
https://github.com/ImperialCollegeLondon/Example-Lean-Projects
`leanproject get ImperialCollegeLondon/Example-Lean-Projects`
*) The max mini-game (a simple browser game like the natural number game)
http://wwwf.imperial.ac.uk/~buzzard/xena/max_minigame/
(this is part of what will become the real number game, a game to teach
series, sequences and limits etc like the natural number game):
`leanproject get ImperialCollegeLondon/real-number-game`
*) Some commutative algebra experiments (ongoing work to prove the Nullstellensatz,
going slowly because I'm busy):
https://github.com/ImperialCollegeLondon/M4P33/blob/1a179372db71ad6802d11eacbc1f02f327d55f8f/src/for_mathlib/commutative_algebra/Zariski_lemma.lean#L80-L81
`leanproject get ImperialCollegeLondon/M4P33`
*) The group theory game (work in progress, expect more progress over the summer,
as a couple of undergraduates are working on it)
https://github.com/ImperialCollegeLondon/group-theory-game
`leanproject get ImperialCollegeLondon/group-theory-game`
*) Galois theory experiments
https://github.com/ImperialCollegeLondon/P11-Galois-Theory
`leanproject get ImperialCollegeLondon/P11-Galois-Theory`
*) Beginnings of the theory of condensed sets (currently on hold because
we need a good interface for abelian categories in mathlib)
https://github.com/ImperialCollegeLondon/condensed-sets
`leanproject get ImperialCollegeLondon/condensed-sets`
## The Xena Project
Why do these projects exist? I (Kevin Buzzard) am interested in teaching
undergraduates how to use Lean. I have been running a club at Imperial College London
called the Xena Project for the last three years, I am proud that many Imperial
mathematics undegraduates have contributed to Lean's maths library, and three of them
(Chris Hughes, Kenny Lau, Amelia Livingston) have each contributed over 5,000 lines of
code. It is non-trivial to get your work into such a polished state that it
is acceptable to the mathlib maintainers. It is also very good practice.
I am running Lean summer projects this summer, on a Discord server. If you
know of any undergraduates who you think might be interested in Lean, please
direct them to the Xena Project Discord!
https://discord.gg/BgyVYgJ
Undergraduates use Discord for lots of things, and seem to be more likely
to use a Discord server than the Zulip chat. The Discord server is chaotic and
full of off-topic material -- quite unlike the Lean Zulip server, which is
professional and focussed. If you have a serious question about Lean,
ask it on the Zulip chat! But if you know an undergraduate who is interested
in Lean, they might be interested in the Discord server. We have meetings
every Thursday evening (UK time), with live Lean coding and streaming, speedruns,
there is music, people posting pictures of cats, Haikus, and so on. To a large
extent it is run by undergraduates and PhD students. Over the summer (July
and August 2020) there are also live Twitch talks at https://www.twitch.tv/kbuzzard ,
on Tuesdays 10am and Thursdays 4pm UK time (UTC+1), aimed at mathematics
undergraduates. It is an informal place for undergraduates to hang out and
meet other undergraduates who are interested in Lean.
I believe that it is crucial to make undergraduates aware of computer proof
verification systems, because one day (possibly a long time in the future,
but one day) these things will cause a paradigm shift in the way mathematics
is done, and the sooner young mathematicians learn about them, the sooner it will happen.
Prove a theorem. Write a function. @XenaProject
https://twitter.com/XenaProject
-/


import MyNat.Power
import AdditionWorld.Level5 -- one_eq_succ_zero
import PowerWorld.Level3 -- pow_one
import AdditionWorld.Level6 -- simp additions
import MultiplicationWorld.Level7 -- add_mul
import MultiplicationWorld.Level9 -- simp additions
namespace MyNat
open MyNat

/-!
# Power World

## Level 8: `add_squared`

## Theorem
For all naturals `a` and `b`, we have `(a + b)^2 = a^2 + b^2 + 2ab.`

The first step in writing this proof is to convert `2` into something we
have theorems about, which is `1` and `0`.
-/
def two : MyNat := 2
def two_eq_succ_one : two = succ 1 := by rfl
lemma one_plus_one : (1 : MyNat) + (1 : MyNat) = (2 : MyNat) := by rfl
-- and we already have one_eq_succ_zero.

/-!
Now we are ready to tackle the proof:
-/

lemma add_squared (a b : MyNat) :
  (a + b) ^ two = a ^ two + b ^ two + 2 * a * b := by
  rw [two_eq_succ_one]
  rw [one_eq_succ_zero]
  repeat rw [pow_succ]
  repeat rw [pow_zero]
  repeat rw [one_mul]
  rw [mul_add]
  repeat rw [add_mul]
  rw [←one_plus_one]
  repeat rw [add_mul]
  repeat rw [one_mul]
  simp

/-!
It is also helpful to teach `simp` our new tricks:
-/
attribute [simp] pow_succ pow_one pow_zero

/-!
There is some fun discussion on [Lean3 Zulip](https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/function.20with.20random.20definition/near/179723073)
about different ways to solve this one in fewer steps.
Feel free to try some of those solutions here, just note that the Lean 4 syntax is a bit different,
no commands between tactics, and square brackets are required on the `rw` tactic.

Do you fancy doing `(a+b)^3` now? You might want to read
[this Xena Project blog post](https://xenaproject.wordpress.com/2018/06/13/ab3/) before you start though.

If you got this far -- very well done! If you only learnt the three
tactics `rw`, `induction` and `refl` then there are now more tactics to
learn; time to try  [Function World](../FunctionWorld.lean.md).

The main thing we really want to impress upon people is that we believe
that *all of pure mathematics* can be done in this new way.

The [Liquid Tensor Experiment](https://xenaproject.wordpress.com/2022/09/12/beyond-the-liquid-tensor-experiment/)
shows that Lean3 could be used to prove very large math theorems.

Lean 3 also has a [definition of perfectoid spaces](https://leanprover-community.github.io/lean-perfectoid-spaces/)
(a very complex modern mathematical structure). We believe that these systems will one day
cause a paradigm shift in the way mathematics is done, but first we need
to build what we know, or at least build enough to state what we
mathematicians believe.

If you want to get involved, come and join
us at the [Zulip Lean chat](https://leanprover.zulipchat.com").
The #new members stream is a great place to start asking questions.

Next up [Function World](../FunctionWorld.lean.md).
-/