/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import analysis.convex.basic
import linear_algebra.finite_dimensional

/-!
# Carathéodory's convexity theorem

This file is devoted to proving Carathéodory's convexity theorem:
The convex hull of a set `s` in ℝᵈ is the union of the convex hulls of the (d+1)-tuples in `s`.

## Main results:

* `convex_hull_eq_union`: Carathéodory's convexity theorem

## Implementation details

This theorem was formalized as part of the Sphere Eversion project.

## Tags
convex hull, caratheodory

-/

universes u

open set finset finite_dimensional
open_locale big_operators

variables {E : Type u} [add_comm_group E] [module ℝ E] [finite_dimensional ℝ E]

namespace caratheodory

/--
If `x` is in the convex hull of some finset `t` with strictly more than `finrank + 1` elements,
then it is in the union of the convex hulls of the finsets `t.erase y` for `y ∈ t`.
-/

/--
The convex hull of a finset `t` with `finrank ℝ E + 1 < t.card` is equal to
the union of the convex hulls of the finsets `t.erase x` for `x ∈ t`.
-/
lemma step [decidable_eq E] (t : finset E) (h : finrank ℝ E + 1 < t.card) :
  convex_hull (↑t : set E) = ⋃ (x : (↑t : set E)), convex_hull ↑(t.erase x) :=
begin
  apply set.subset.antisymm,
  { intros x m',
    obtain ⟨y, m⟩ := mem_convex_hull_erase h m',
    exact mem_Union.2 ⟨y, m⟩, },
  { refine Union_subset _,
    intro x,
    apply convex_hull_mono,
    apply erase_subset, }
end

/--
The convex hull of a finset `t` with `finrank ℝ E + 1 < t.card` is contained in
the union of the convex hulls of the finsets `t' ⊆ t` with `t'.card ≤ finrank ℝ E + 1`.
-/
lemma shrink' (t : finset E) (k : ℕ) (h : t.card = finrank ℝ E + 1 + k) :
  convex_hull (↑t : set E) ⊆
    ⋃ (t' : finset E) (w : t' ⊆ t) (b : t'.card ≤ finrank ℝ E + 1), convex_hull ↑t' :=
begin
  induction k with k ih generalizing t,
  { apply subset_subset_Union t,
    apply subset_subset_Union (set.subset.refl _),
    exact subset_subset_Union (le_of_eq h) (subset.refl _), },
  { classical,
    rw step _ (by { rw h, simp, } : finrank ℝ E + 1 < t.card),
    apply Union_subset,
    intro i,
    transitivity,
    { apply ih,
      rw [card_erase_of_mem, h, nat.pred_succ],
      exact i.2, },
    { apply Union_subset_Union,
      intro t',
      apply Union_subset_Union_const,
      exact λ h, set.subset.trans h (erase_subset _ _), } }
end

/--
The convex hull of any finset `t` is contained in
the union of the convex hulls of the finsets `t' ⊆ t` with `t'.card ≤ finrank ℝ E + 1`.
-/
lemma shrink (t : finset E) :
  convex_hull (↑t : set E) ⊆
    ⋃ (t' : finset E) (w : t' ⊆ t) (b : t'.card ≤ finrank ℝ E + 1), convex_hull ↑t' :=
begin
  by_cases h : t.card ≤ finrank ℝ E + 1,
  { apply subset_subset_Union t,
    apply subset_subset_Union (set.subset.refl _),
    exact subset_subset_Union h (set.subset.refl _), },
  push_neg at h,
  obtain ⟨k, w⟩ := le_iff_exists_add.mp (le_of_lt h), clear h,
  exact shrink' _ _ w,
end

end caratheodory

/--
One inclusion of Carathéodory's convexity theorem.

The convex hull of a set `s` in ℝᵈ is contained in
the union of the convex hulls of the (d+1)-tuples in `s`.
-/
lemma convex_hull_subset_union (s : set E) :
  convex_hull s ⊆ ⋃ (t : finset E) (w : ↑t ⊆ s) (b : t.card ≤ finrank ℝ E + 1), convex_hull ↑t :=
begin
  -- First we replace `convex_hull s` with the union of the convex hulls of finite subsets,
  rw convex_hull_eq_union_convex_hull_finite_subsets,
  -- and prove the inclusion for each of those.
  apply Union_subset, intro r,
  apply Union_subset, intro h,
  -- Second, for each convex hull of a finite subset, we shrink it.
  refine subset.trans (caratheodory.shrink _) _,
  -- After that it's just shuffling unions around.
  refine Union_subset_Union (λ t, _),
  exact Union_subset_Union2 (λ htr, ⟨subset.trans htr h, subset.refl _⟩)
end

/--
Carathéodory's convexity theorem.

The convex hull of a set `s` in ℝᵈ is the union of the convex hulls of the (d+1)-tuples in `s`.
-/
theorem convex_hull_eq_union (s : set E) :
  convex_hull s = ⋃ (t : finset E) (w : ↑t ⊆ s) (b : t.card ≤ finrank ℝ E + 1), convex_hull ↑t :=
begin
  apply set.subset.antisymm,
  { apply convex_hull_subset_union, },
  iterate 3 { convert Union_subset _, intro, },
  exact convex_hull_mono ‹_›,
end

/--
A more explicit formulation of Carathéodory's convexity theorem,
writing an element of a convex hull as the center of mass
of an explicit `finset` with cardinality at most `dim + 1`.
-/
theorem eq_center_mass_card_le_dim_succ_of_mem_convex_hull
  {s : set E} {x : E} (h : x ∈ convex_hull s) :
  ∃ (t : finset E) (w : ↑t ⊆ s) (b : t.card ≤ finrank ℝ E + 1)
    (f : E → ℝ), (∀ y ∈ t, 0 ≤ f y) ∧ t.sum f = 1 ∧ t.center_mass f id = x :=
begin
  rw convex_hull_eq_union at h,
  simp only [exists_prop, mem_Union] at h,
  obtain ⟨t, w, b, m⟩ := h,
  refine ⟨t, w, b, _⟩,
  rw finset.convex_hull_eq at m,
  simpa only [exists_prop] using m,
end

/--
A variation on Carathéodory's convexity theorem,
writing an element of a convex hull as a center of mass
of an explicit `finset` with cardinality at most `dim + 1`,
where all coefficients in the center of mass formula
are strictly positive.

(This is proved using `eq_center_mass_card_le_dim_succ_of_mem_convex_hull`,
and discarding any elements of the set with coefficient zero.)
-/
theorem eq_pos_center_mass_card_le_dim_succ_of_mem_convex_hull
  {s : set E} {x : E} (h : x ∈ convex_hull s) :
  ∃ (t : finset E) (w : ↑t ⊆ s) (b : t.card ≤ finrank ℝ E + 1)
    (f : E → ℝ), (∀ y ∈ t, 0 < f y) ∧ t.sum f = 1 ∧ t.center_mass f id = x :=
begin
  obtain ⟨t, w, b, f, ⟨pos, sum, center⟩⟩ := eq_center_mass_card_le_dim_succ_of_mem_convex_hull h,
  let t' := t.filter (λ z, 0 < f z),
  have t'sum : t'.sum f = 1,
  { rw ← sum,
    exact sum_filter_of_ne (λ x hxt hfx, (pos x hxt).lt_of_ne hfx.symm) },
  refine ⟨t', _, _, f, ⟨_, t'sum, _⟩⟩,
  { exact subset.trans (filter_subset _ t) w, },
  { exact (card_filter_le _ _).trans b, },
  { exact λ y H, (mem_filter.mp H).right, },
  { rw ← center,
    simp only [center_mass, t'sum, sum, inv_one, one_smul, id.def],
    refine sum_filter_of_ne (λ x hxt hfx, (pos x hxt).lt_of_ne $ λ hf₀, _),
    rw [← hf₀, zero_smul] at hfx,
    exact hfx rfl },
end


import linear_algebra.basic inner_product_spaces.ring_involution

open module ring ring_invo

class sesquilinear_form_space (R : Type*) (V : Type*) [ring R] (Hi : ring_invo R) extends module R V :=
(sesq_form : V → V → R)
(fst_add_lin : ∀ (x y z : V), sesq_form (x + y) z = sesq_form x z + sesq_form y z)
(fst_mul_lin : ∀ (x y : V) (a : R), sesq_form (a • x) y = a * (sesq_form x y))
(snd_add_lin : ∀ (x y z : V), sesq_form x (y + z) = sesq_form x y + sesq_form x z)
(snd_mul_antilin : ∀ (a : R) (x y : V), sesq_form x (a • y) = (invo Hi a) * (sesq_form x y))

open sesquilinear_form_space

section sesquilinear_form_space

variables {R : Type*} [ring R] {V : Type*} (Hi : ring_invo R) [sesquilinear_form_space R V Hi]

lemma zero_sesq (x : V) :
sesq_form Hi 0 x = 0 := by rw [←zero_smul, fst_mul_lin, ring.zero_mul]; exact 0

lemma sesq_zero (x : V) :
sesq_form Hi x 0 = 0 := by rw [←zero_smul, snd_mul_antilin, invo_zero, ring.zero_mul]; exact 0

lemma sesq_neg_left (x y : V) :
sesq_form Hi (-x) y = -(sesq_form Hi x y : R) := by rw [←neg_one_smul, fst_mul_lin, neg_one_mul]

lemma sesq_neg_right (x y : V) :
sesq_form Hi x (-y) = -(sesq_form Hi x y) := by rw [←neg_one_smul, snd_mul_antilin, invo_neg, ring_invo.map_one, neg_one_mul]

lemma sesq_sub_left (x y z : V) :
sesq_form Hi (x - y) z = sesq_form Hi x z - sesq_form Hi y z := by rw [sub_eq_add_neg, fst_add_lin, sesq_neg_left]; refl

lemma sesq_sub_right (x y z : V) :
sesq_form Hi x (y - z) = sesq_form Hi x y - sesq_form Hi x z := by rw [sub_eq_add_neg, snd_add_lin, sesq_neg_right]; refl

def is_ortho (x y : V) : Prop :=
sesq_form Hi x y = 0

lemma ortho_zero (x : V) :
is_ortho Hi 0 x := zero_sesq Hi x

theorem ortho_mul_left {D : Type*} [domain D] (Hi : ring_invo D) [sesquilinear_form_space D V Hi] (x y : V) (a : D) (ha : a ≠ 0) :
(is_ortho Hi x y) ↔ (is_ortho Hi (a • x) y) :=
begin
dunfold is_ortho,
split,
    intros H,
    rw [fst_mul_lin, H, ring.mul_zero],

    intros H,
    rw [fst_mul_lin, mul_eq_zero] at H,
    cases H,
        trivial,

        exact H,
end

theorem ortho_mul_right {D : Type*} [domain D] (Hi : ring_invo D) [sesquilinear_form_space D V Hi] (x y : V) (a : D) (ha : a ≠ 0) :
(is_ortho Hi x y) ↔ (is_ortho Hi x (a • y)) :=
begin
dunfold is_ortho,
split,
    intros H,
    rw [snd_mul_antilin, H, ring.mul_zero],

    intros H,
    rw [snd_mul_antilin, mul_eq_zero] at H,
    cases H,
        rw invo_zero_iff at H,
        trivial,

        exact H,
end

end sesquilinear_form_space

class sym_sesquilinear_form_space (R : Type*) (V : Type*) [ring R] (Hi : ring_invo R) extends sesquilinear_form_space R V Hi :=
(is_invo_sym : ∀ (x y : V), sesq_form x y = invo Hi (sesq_form y x))

open sym_sesquilinear_form_space

lemma ortho_sym {R : Type*} {V : Type*} [ring R] (Hi : ring_invo R) [sym_sesquilinear_form_space R V Hi] (x y : V) :
is_ortho Hi x y ↔ is_ortho Hi y x :=
begin
dunfold is_ortho,
split;
intros H;
rw is_invo_sym;
rw invo_zero_iff;
exact H,
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import ring_theory.matrix_algebra
import data.polynomial.algebra_map
import data.matrix.basis
import data.matrix.dmatrix

/-!
# Algebra isomorphism between matrices of polynomials and polynomials of matrices

Given `[comm_ring R] [ring A] [algebra R A]`
we show `polynomial A ≃ₐ[R] (A ⊗[R] R[X])`.
Combining this with the isomorphism `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)` proved earlier
in `ring_theory.matrix_algebra`, we obtain the algebra isomorphism
```
def mat_poly_equiv :
  matrix n n R[X] ≃ₐ[R] polynomial (matrix n n R)
```
which is characterized by
```
coeff (mat_poly_equiv m) k i j = coeff (m i j) k
```

We will use this algebra isomorphism to prove the Cayley-Hamilton theorem.
-/

universes u v w

open_locale polynomial tensor_product

open polynomial
open tensor_product
open algebra.tensor_product (alg_hom_of_linear_map_tensor_product include_left)

noncomputable theory

variables (R A : Type*)
variables [comm_semiring R]
variables [semiring A] [algebra R A]

namespace poly_equiv_tensor

/--
(Implementation detail).
The function underlying `A ⊗[R] R[X] →ₐ[R] polynomial A`,
as a bilinear function of two arguments.
-/
@[simps apply_apply]
def to_fun_bilinear : A →ₗ[A] R[X] →ₗ[R] A[X] :=
linear_map.to_span_singleton A _ (aeval (polynomial.X : polynomial A)).to_linear_map

lemma to_fun_bilinear_apply_eq_sum (a : A) (p : R[X]) :
  to_fun_bilinear R A a p = p.sum (λ n r, monomial n (a * algebra_map R A r)) :=
begin
  dsimp [to_fun_bilinear_apply_apply, aeval_def, eval₂_eq_sum, polynomial.sum],
  rw finset.smul_sum,
  congr' with i : 1,
  rw [←algebra.smul_def, ←C_mul', mul_smul_comm, C_mul_X_pow_eq_monomial, ←algebra.commutes,
    ←algebra.smul_def, smul_monomial],
end

/--
(Implementation detail).
The function underlying `A ⊗[R] R[X] →ₐ[R] polynomial A`,
as a linear map.
-/
def to_fun_linear : A ⊗[R] R[X] →ₗ[R] polynomial A :=
tensor_product.lift (to_fun_bilinear R A)

@[simp]
lemma to_fun_linear_tmul_apply (a : A) (p : R[X]) :
  to_fun_linear R A (a ⊗ₜ[R] p) = to_fun_bilinear R A a p := lift.tmul _ _

-- We apparently need to provide the decidable instance here
-- in order to successfully rewrite by this lemma.
lemma to_fun_linear_mul_tmul_mul_aux_1
  (p : R[X]) (k : ℕ) (h : decidable (¬p.coeff k = 0)) (a : A) :
  ite (¬coeff p k = 0) (a * (algebra_map R A) (coeff p k)) 0 = a * (algebra_map R A) (coeff p k) :=
by { classical, split_ifs; simp *, }

lemma to_fun_linear_mul_tmul_mul_aux_2 (k : ℕ) (a₁ a₂ : A) (p₁ p₂ : R[X]) :
  a₁ * a₂ * (algebra_map R A) ((p₁ * p₂).coeff k) =
    (finset.nat.antidiagonal k).sum
      (λ x, a₁ * (algebra_map R A) (coeff p₁ x.1) * (a₂ * (algebra_map R A) (coeff p₂ x.2))) :=
begin
  simp_rw [mul_assoc, algebra.commutes, ←finset.mul_sum, mul_assoc, ←finset.mul_sum],
  congr,
  simp_rw [algebra.commutes (coeff p₂ _), coeff_mul, ring_hom.map_sum, ring_hom.map_mul],
end

lemma to_fun_linear_mul_tmul_mul (a₁ a₂ : A) (p₁ p₂ : R[X]) :
  (to_fun_linear R A) ((a₁ * a₂) ⊗ₜ[R] (p₁ * p₂)) =
    (to_fun_linear R A) (a₁ ⊗ₜ[R] p₁) * (to_fun_linear R A) (a₂ ⊗ₜ[R] p₂) :=
begin
  classical,
  simp only [to_fun_linear_tmul_apply, to_fun_bilinear_apply_eq_sum],
  ext k,
  simp_rw [coeff_sum, coeff_monomial, sum_def, finset.sum_ite_eq', mem_support_iff, ne.def],
  conv_rhs { rw [coeff_mul] },
  simp_rw [finset_sum_coeff, coeff_monomial,
    finset.sum_ite_eq', mem_support_iff, ne.def,
    mul_ite, mul_zero, ite_mul, zero_mul],
  simp_rw [ite_mul_zero_left (¬coeff p₁ _ = 0) (a₁ * (algebra_map R A) (coeff p₁ _))],
  simp_rw [ite_mul_zero_right (¬coeff p₂ _ = 0) _ (_ * _)],
  simp_rw [to_fun_linear_mul_tmul_mul_aux_1, to_fun_linear_mul_tmul_mul_aux_2],
end

lemma to_fun_linear_algebra_map_tmul_one (r : R) :
  (to_fun_linear R A) ((algebra_map R A) r ⊗ₜ[R] 1) = (algebra_map R (polynomial A)) r :=
by rw [to_fun_linear_tmul_apply, to_fun_bilinear_apply_apply, polynomial.aeval_one,
  algebra_map_smul, algebra.algebra_map_eq_smul_one]

/--
(Implementation detail).
The algebra homomorphism `A ⊗[R] R[X] →ₐ[R] polynomial A`.
-/
def to_fun_alg_hom : A ⊗[R] R[X] →ₐ[R] polynomial A :=
alg_hom_of_linear_map_tensor_product
  (to_fun_linear R A)
  (to_fun_linear_mul_tmul_mul R A)
  (to_fun_linear_algebra_map_tmul_one R A)

@[simp] lemma to_fun_alg_hom_apply_tmul (a : A) (p : R[X]) :
  to_fun_alg_hom R A (a ⊗ₜ[R] p) = p.sum (λ n r, monomial n (a * (algebra_map R A) r)) :=
begin
  dsimp [to_fun_alg_hom],
  rw [to_fun_linear_tmul_apply, to_fun_bilinear_apply_eq_sum],
end

/--
(Implementation detail.)

The bare function `polynomial A → A ⊗[R] R[X]`.
(We don't need to show that it's an algebra map, thankfully --- just that it's an inverse.)
-/
def inv_fun (p : A[X]) : A ⊗[R] R[X] :=
p.eval₂
  (include_left : A →ₐ[R] A ⊗[R] R[X])
  ((1 : A) ⊗ₜ[R] (X : R[X]))

@[simp]
lemma inv_fun_add {p q} : inv_fun R A (p + q) = inv_fun R A p + inv_fun R A q :=
by simp only [inv_fun, eval₂_add]

lemma inv_fun_monomial (n : ℕ) (a : A) :
  inv_fun R A (monomial n a) = include_left a * ((1 : A) ⊗ₜ[R] (X : R[X])) ^ n :=
eval₂_monomial _ _

lemma left_inv (x : A ⊗ R[X]) :
  inv_fun R A ((to_fun_alg_hom R A) x) = x :=
begin
  apply tensor_product.induction_on x,
  { simp [inv_fun], },
  { intros a p, dsimp only [inv_fun],
    rw [to_fun_alg_hom_apply_tmul, eval₂_sum],
    simp_rw [eval₂_monomial, alg_hom.coe_to_ring_hom, algebra.tensor_product.tmul_pow, one_pow,
      algebra.tensor_product.include_left_apply, algebra.tensor_product.tmul_mul_tmul,
      mul_one, one_mul, ←algebra.commutes, ←algebra.smul_def, smul_tmul, sum_def, ←tmul_sum],
    conv_rhs { rw [←sum_C_mul_X_eq p], },
    simp only [algebra.smul_def],
    refl, },
  { intros p q hp hq,
    simp only [alg_hom.map_add, inv_fun_add, hp, hq], },
end

lemma right_inv (x : A[X]) :
  (to_fun_alg_hom R A) (inv_fun R A x) = x :=
begin
  apply polynomial.induction_on' x,
  { intros p q hp hq, simp only [inv_fun_add, alg_hom.map_add, hp, hq], },
  { intros n a,
    rw [inv_fun_monomial, algebra.tensor_product.include_left_apply,
      algebra.tensor_product.tmul_pow, one_pow, algebra.tensor_product.tmul_mul_tmul,
      mul_one, one_mul, to_fun_alg_hom_apply_tmul, X_pow_eq_monomial, sum_monomial_index];
    simp, }
end

/--
(Implementation detail)

The equivalence, ignoring the algebra structure, `(A ⊗[R] R[X]) ≃ polynomial A`.
-/
def equiv : (A ⊗[R] R[X]) ≃ polynomial A :=
{ to_fun := to_fun_alg_hom R A,
  inv_fun := inv_fun R A,
  left_inv := left_inv R A,
  right_inv := right_inv R A, }

end poly_equiv_tensor

open poly_equiv_tensor

/--
The `R`-algebra isomorphism `polynomial A ≃ₐ[R] (A ⊗[R] R[X])`.
-/
def poly_equiv_tensor : A[X] ≃ₐ[R] (A ⊗[R] R[X]) :=
alg_equiv.symm
{ ..(poly_equiv_tensor.to_fun_alg_hom R A), ..(poly_equiv_tensor.equiv R A) }

@[simp]
lemma poly_equiv_tensor_apply (p : A[X]) :
  poly_equiv_tensor R A p =
    p.eval₂ (include_left : A →ₐ[R] A ⊗[R] R[X]) ((1 : A) ⊗ₜ[R] (X : R[X])) :=
rfl

@[simp]
lemma poly_equiv_tensor_symm_apply_tmul (a : A) (p : R[X]) :
  (poly_equiv_tensor R A).symm (a ⊗ₜ p) = p.sum (λ n r, monomial n (a * algebra_map R A r)) :=
to_fun_alg_hom_apply_tmul _ _ _ _

open dmatrix matrix
open_locale big_operators

variables {R}
variables {n : Type w} [decidable_eq n] [fintype n]

/--
The algebra isomorphism stating "matrices of polynomials are the same as polynomials of matrices".

(You probably shouldn't attempt to use this underlying definition ---
it's an algebra equivalence, and characterised extensionally by the lemma
`mat_poly_equiv_coeff_apply` below.)
-/
noncomputable def mat_poly_equiv :
  matrix n n R[X] ≃ₐ[R] polynomial (matrix n n R) :=
(((matrix_equiv_tensor R R[X] n)).trans
  (algebra.tensor_product.comm R _ _)).trans
  (poly_equiv_tensor R (matrix n n R)).symm

open finset

lemma mat_poly_equiv_coeff_apply_aux_1 (i j : n) (k : ℕ) (x : R) :
  mat_poly_equiv (std_basis_matrix i j $ monomial k x) =
    monomial k (std_basis_matrix i j x) :=
begin
  simp only [mat_poly_equiv, alg_equiv.trans_apply,
    matrix_equiv_tensor_apply_std_basis],
  apply (poly_equiv_tensor R (matrix n n R)).injective,
  simp only [alg_equiv.apply_symm_apply],
  convert algebra.tensor_product.comm_tmul _ _ _ _ _,
  simp only [poly_equiv_tensor_apply],
  convert eval₂_monomial _ _,
  simp only [algebra.tensor_product.tmul_mul_tmul, one_pow, one_mul, matrix.mul_one,
    algebra.tensor_product.tmul_pow, algebra.tensor_product.include_left_apply, mul_eq_mul],
  rw [monomial_eq_smul_X, ← tensor_product.smul_tmul],
  congr' with i' j'; simp
end

lemma mat_poly_equiv_coeff_apply_aux_2
  (i j : n) (p : R[X]) (k : ℕ) :
  coeff (mat_poly_equiv (std_basis_matrix i j p)) k =
    std_basis_matrix i j (coeff p k) :=
begin
  apply polynomial.induction_on' p,
  { intros p q hp hq, ext,
    simp [hp, hq, coeff_add, add_apply, std_basis_matrix_add], },
  { intros k x,
    simp only [mat_poly_equiv_coeff_apply_aux_1, coeff_monomial],
    split_ifs; { funext, simp, }, }
end

@[simp] lemma mat_poly_equiv_coeff_apply
  (m : matrix n n R[X]) (k : ℕ) (i j : n) :
  coeff (mat_poly_equiv m) k i j = coeff (m i j) k :=
begin
  apply matrix.induction_on' m,
  { simp, },
  { intros p q hp hq, simp [hp, hq], },
  { intros i' j' x,
    erw mat_poly_equiv_coeff_apply_aux_2,
    dsimp [std_basis_matrix],
    split_ifs,
    { rcases h with ⟨rfl, rfl⟩, simp [std_basis_matrix], },
    { simp [std_basis_matrix, h], }, },
end

@[simp] lemma mat_poly_equiv_symm_apply_coeff
  (p : (matrix n n R)[X]) (i j : n) (k : ℕ) :
  coeff (mat_poly_equiv.symm p i j) k = coeff p k i j :=
begin
  have t : p = mat_poly_equiv
    (mat_poly_equiv.symm p) := by simp,
  conv_rhs { rw t, },
  simp only [mat_poly_equiv_coeff_apply],
end

lemma mat_poly_equiv_smul_one (p : R[X]) :
  mat_poly_equiv (p • 1) = p.map (algebra_map R (matrix n n R)) :=
begin
  ext m i j,
  simp only [coeff_map, one_apply, algebra_map_matrix_apply, mul_boole,
    pi.smul_apply, mat_poly_equiv_coeff_apply],
  split_ifs; simp,
end

lemma support_subset_support_mat_poly_equiv
  (m : matrix n n R[X]) (i j : n) :
  support (m i j) ⊆ support (mat_poly_equiv m) :=
begin
  assume k,
  contrapose,
  simp only [not_mem_support_iff],
  assume hk,
  rw [← mat_poly_equiv_coeff_apply, hk],
  refl
end


-- anything after two minus signs like this is a comment.

variables P Q R : Prop -- P, Q, R are now true/false statements.

-- Reminder : ∧ means "and".

theorem basic_logic : (P → Q) ∧ (Q → R) → (P → R) :=
begin
intro H, -- H is "P implies Q and Q implies R"
have HPQ : P → Q,
exact H.left,
have HQR : Q → R,
exact H.right,
clear H, -- we don't need it any more

-- We now have hypothesis HPQ, which is P -> Q
-- and hypothesis HQR, which is Q -> R.
-- We want to prove P -> R so let's assume P
-- and deduce R.

intro HP,
have HQ : Q,
exact HPQ HP, -- apply P->Q to P to get Q.
-- now we can get the goal
exact HQR HQ
end


/-
Copyright (c) 2021 Jordan Brown, Thomas Browning, Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jordan Brown, Thomas Browning, Patrick Lutz
-/

import data.fin.vec_notation
import group_theory.abelianization
import set_theory.cardinal.basic

/-!
# Solvable Groups

In this file we introduce the notion of a solvable group. We define a solvable group as one whose
derived series is eventually trivial. This requires defining the commutator of two subgroups and
the derived series of a group.

## Main definitions

* `derived_series G n` : the `n`th term in the derived series of `G`, defined by iterating
    `general_commutator` starting with the top subgroup
* `is_solvable G` : the group `G` is solvable
-/

open subgroup

variables {G G' : Type*} [group G] [group G'] {f : G →* G'}

section derived_series

variables (G)

/-- The derived series of the group `G`, obtained by starting from the subgroup `⊤` and repeatedly
  taking the commutator of the previous subgroup with itself for `n` times. -/
def derived_series : ℕ → subgroup G
| 0       := ⊤
| (n + 1) := ⁅(derived_series n), (derived_series n)⁆

@[simp] lemma derived_series_zero : derived_series G 0 = ⊤ := rfl

@[simp] lemma derived_series_succ (n : ℕ) :
  derived_series G (n + 1) = ⁅(derived_series G n), (derived_series G n)⁆ := rfl

lemma derived_series_normal (n : ℕ) : (derived_series G n).normal :=
begin
  induction n with n ih,
  { exact (⊤ : subgroup G).normal_of_characteristic },
  { exactI subgroup.commutator_normal (derived_series G n) (derived_series G n) }
end

@[simp] lemma derived_series_one : derived_series G 1 = commutator G :=
rfl

end derived_series

section commutator_map

section derived_series_map

variables (f)

lemma map_derived_series_le_derived_series (n : ℕ) :
  (derived_series G n).map f ≤ derived_series G' n :=
begin
  induction n with n ih,
  { exact le_top },
  { simp only [derived_series_succ, map_commutator, commutator_mono, ih] }
end

variables {f}

lemma derived_series_le_map_derived_series (hf : function.surjective f) (n : ℕ) :
  derived_series G' n ≤ (derived_series G n).map f :=
begin
  induction n with n ih,
  { exact (map_top_of_surjective f hf).ge },
  { exact commutator_le_map_commutator ih ih }
end

lemma map_derived_series_eq (hf : function.surjective f) (n : ℕ) :
  (derived_series G n).map f = derived_series G' n :=
le_antisymm (map_derived_series_le_derived_series f n) (derived_series_le_map_derived_series hf n)

end derived_series_map
end commutator_map

section solvable

variables (G)

/-- A group `G` is solvable if its derived series is eventually trivial. We use this definition
  because it's the most convenient one to work with. -/
class is_solvable : Prop :=
(solvable : ∃ n : ℕ, derived_series G n = ⊥)

lemma is_solvable_def : is_solvable G ↔ ∃ n : ℕ, derived_series G n = ⊥ :=
⟨λ h, h.solvable, λ h, ⟨h⟩⟩

@[priority 100]
instance comm_group.is_solvable {G : Type*} [comm_group G] : is_solvable G :=
⟨⟨1, le_bot_iff.mp (abelianization.commutator_subset_ker (monoid_hom.id G))⟩⟩

lemma is_solvable_of_comm {G : Type*} [hG : group G]
  (h : ∀ a b : G, a * b = b * a) : is_solvable G :=
begin
  letI hG' : comm_group G := { mul_comm := h .. hG },
  casesI hG,
  exact comm_group.is_solvable,
end

lemma is_solvable_of_top_eq_bot (h : (⊤ : subgroup G) = ⊥) : is_solvable G :=
⟨⟨0, h⟩⟩

@[priority 100]
instance is_solvable_of_subsingleton [subsingleton G] : is_solvable G :=
is_solvable_of_top_eq_bot G (by ext; simp at *)

variables {G}

lemma solvable_of_ker_le_range {G' G'' : Type*} [group G'] [group G''] (f : G' →* G)
  (g : G →* G'') (hfg : g.ker ≤ f.range) [hG' : is_solvable G'] [hG'' : is_solvable G''] :
  is_solvable G :=
begin
  obtain ⟨n, hn⟩ := id hG'',
  obtain ⟨m, hm⟩ := id hG',
  refine ⟨⟨n + m, le_bot_iff.mp (map_bot f ▸ (hm ▸ _))⟩⟩,
  clear hm,
  induction m with m hm,
  { exact f.range_eq_map ▸ ((derived_series G n).map_eq_bot_iff.mp (le_bot_iff.mp
      ((map_derived_series_le_derived_series g n).trans hn.le))).trans hfg },
  { exact commutator_le_map_commutator hm hm },
end

lemma solvable_of_solvable_injective (hf : function.injective f) [h : is_solvable G'] :
  is_solvable G :=
solvable_of_ker_le_range (1 : G' →* G) f ((f.ker_eq_bot_iff.mpr hf).symm ▸ bot_le)

instance subgroup_solvable_of_solvable (H : subgroup G) [h : is_solvable G] : is_solvable H :=
solvable_of_solvable_injective (show function.injective (subtype H), from subtype.val_injective)

lemma solvable_of_surjective (hf : function.surjective f) [h : is_solvable G] :
  is_solvable G' :=
solvable_of_ker_le_range f (1 : G' →* G) ((f.range_top_of_surjective hf).symm ▸ le_top)

instance solvable_quotient_of_solvable (H : subgroup G) [H.normal] [h : is_solvable G] :
  is_solvable (G ⧸ H) :=
solvable_of_surjective (quotient_group.mk'_surjective H)

instance solvable_prod {G' : Type*} [group G'] [h : is_solvable G] [h' : is_solvable G'] :
  is_solvable (G × G') :=
solvable_of_ker_le_range (monoid_hom.inl G G') (monoid_hom.snd G G')
  (λ x hx, ⟨x.1, prod.ext rfl hx.symm⟩)

end solvable

section is_simple_group

variable [is_simple_group G]

lemma is_simple_group.derived_series_succ {n : ℕ} : derived_series G n.succ = commutator G :=
begin
  induction n with n ih,
  { exact derived_series_one G },
  rw [derived_series_succ, ih],
  cases (commutator.normal G).eq_bot_or_eq_top with h h,
  { rw [h, commutator_bot_left] },
  { rwa h },
end

lemma is_simple_group.comm_iff_is_solvable :
  (∀ a b : G, a * b = b * a) ↔ is_solvable G :=
⟨is_solvable_of_comm, λ ⟨⟨n, hn⟩⟩, begin
  cases n,
  { intros a b,
    refine (mem_bot.1 _).trans (mem_bot.1 _).symm;
    { rw ← hn,
      exact mem_top _ } },
  { rw is_simple_group.derived_series_succ at hn,
    intros a b,
    rw [← mul_inv_eq_one, mul_inv_rev, ← mul_assoc, ← mem_bot, ← hn, commutator_eq_closure],
    exact subset_closure ⟨a, b, rfl⟩ }
end⟩

end is_simple_group

section perm_not_solvable

lemma not_solvable_of_mem_derived_series {g : G} (h1 : g ≠ 1)
  (h2 : ∀ n : ℕ, g ∈ derived_series G n) : ¬ is_solvable G :=
mt (is_solvable_def _).mp (not_exists_of_forall_not
  (λ n h, h1 (subgroup.mem_bot.mp ((congr_arg (has_mem.mem g) h).mp (h2 n)))))

lemma equiv.perm.fin_5_not_solvable : ¬ is_solvable (equiv.perm (fin 5)) :=
begin
  let x : equiv.perm (fin 5) := ⟨![1, 2, 0, 3, 4], ![2, 0, 1, 3, 4], dec_trivial, dec_trivial⟩,
  let y : equiv.perm (fin 5) := ⟨![3, 4, 2, 0, 1], ![3, 4, 2, 0, 1], dec_trivial, dec_trivial⟩,
  let z : equiv.perm (fin 5) := ⟨![0, 3, 2, 1, 4], ![0, 3, 2, 1, 4], dec_trivial, dec_trivial⟩,
  have key : x = z * ⁅x, y * x * y⁻¹⁆ * z⁻¹ := by dec_trivial,
  refine not_solvable_of_mem_derived_series (show x ≠ 1, by dec_trivial) (λ n, _),
  induction n with n ih,
  { exact mem_top x },
  { rw [key, (derived_series_normal _ _).mem_comm_iff, inv_mul_cancel_left],
    exact commutator_mem_commutator ih ((derived_series_normal _ _).conj_mem _ ih _) },
end

lemma equiv.perm.not_solvable (X : Type*) (hX : 5 ≤ cardinal.mk X) :
  ¬ is_solvable (equiv.perm X) :=
begin
  introI h,
  have key : nonempty (fin 5 ↪ X),
  { rwa [←cardinal.lift_mk_le, cardinal.mk_fin, cardinal.lift_nat_cast,
    nat.cast_bit1, nat.cast_bit0, nat.cast_one, cardinal.lift_id] },
  exact equiv.perm.fin_5_not_solvable (solvable_of_solvable_injective
    (equiv.perm.via_embedding_hom_injective (nonempty.some key))),
end

end perm_not_solvable


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

import algebra.group.units
import algebra.group_with_zero.units.lemmas
import algebra.ring.defs

/-!
# Invertible elements

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

This file defines a typeclass `invertible a` for elements `a` with a two-sided
multiplicative inverse.

The intent of the typeclass is to provide a way to write e.g. `⅟2` in a ring
like `ℤ[1/2]` where some inverses exist but there is no general `⁻¹` operator;
or to specify that a field has characteristic `≠ 2`.
It is the `Type`-valued analogue to the `Prop`-valued `is_unit`.

For constructions of the invertible element given a characteristic, see
`algebra/char_p/invertible` and other lemmas in that file.

## Notation

 * `⅟a` is `invertible.inv_of a`, the inverse of `a`

## Implementation notes

The `invertible` class lives in `Type`, not `Prop`, to make computation easier.
If multiplication is associative, `invertible` is a subsingleton anyway.

The `simp` normal form tries to normalize `⅟a` to `a ⁻¹`. Otherwise, it pushes
`⅟` inside the expression as much as possible.

Since `invertible a` is not a `Prop` (but it is a `subsingleton`), we have to be careful about
coherence issues: we should avoid having multiple non-defeq instances for `invertible a` in the
same context.  This file plays it safe and uses `def` rather than `instance` for most definitions,
users can choose which instances to use at the point of use.

For example, here's how you can use an `invertible 1` instance:
```lean
variables {α : Type*} [monoid α]

def something_that_needs_inverses (x : α) [invertible x] := sorry

section
local attribute [instance] invertible_one
def something_one := something_that_needs_inverses 1
end
```

## Tags

invertible, inverse element, inv_of, a half, one half, a third, one third, ½, ⅓

-/

universes u

variables {α : Type u}

/-- `invertible a` gives a two-sided multiplicative inverse of `a`. -/
class invertible [has_mul α] [has_one α] (a : α) : Type u :=
(inv_of : α) (inv_of_mul_self : inv_of * a = 1) (mul_inv_of_self : a * inv_of = 1)

-- This notation has the same precedence as `has_inv.inv`.
notation `⅟`:1034 := invertible.inv_of

@[simp]
lemma inv_of_mul_self [has_mul α] [has_one α] (a : α) [invertible a] : ⅟a * a = 1 :=
invertible.inv_of_mul_self

@[simp]
lemma mul_inv_of_self [has_mul α] [has_one α] (a : α) [invertible a] : a * ⅟a = 1 :=
invertible.mul_inv_of_self

@[simp]
lemma inv_of_mul_self_assoc [monoid α] (a b : α) [invertible a] : ⅟a * (a * b) = b :=
by rw [←mul_assoc, inv_of_mul_self, one_mul]

@[simp]
lemma mul_inv_of_self_assoc [monoid α] (a b : α) [invertible a] : a * (⅟a * b) = b :=
by rw [←mul_assoc, mul_inv_of_self, one_mul]

@[simp]
lemma mul_inv_of_mul_self_cancel [monoid α] (a b : α) [invertible b] : a * ⅟b * b = a :=
by simp [mul_assoc]

@[simp]
lemma mul_mul_inv_of_self_cancel [monoid α] (a b : α) [invertible b] : a * b * ⅟b = a :=
by simp [mul_assoc]

lemma inv_of_eq_right_inv [monoid α] {a b : α} [invertible a] (hac : a * b = 1) : ⅟a = b :=
left_inv_eq_right_inv (inv_of_mul_self _) hac

lemma inv_of_eq_left_inv [monoid α] {a b : α} [invertible a] (hac : b * a = 1) : ⅟a = b :=
(left_inv_eq_right_inv hac (mul_inv_of_self _)).symm

lemma invertible_unique {α : Type u} [monoid α] (a b : α) [invertible a] [invertible b]
  (h : a = b) :
  ⅟a = ⅟b :=
by { apply inv_of_eq_right_inv, rw [h, mul_inv_of_self], }

instance [monoid α] (a : α) : subsingleton (invertible a) :=
⟨ λ ⟨b, hba, hab⟩ ⟨c, hca, hac⟩, by { congr, exact left_inv_eq_right_inv hba hac } ⟩

/-- If `r` is invertible and `s = r`, then `s` is invertible. -/
def invertible.copy [mul_one_class α] {r : α} (hr : invertible r) (s : α) (hs : s = r) :
  invertible s :=
{ inv_of := ⅟r,
  inv_of_mul_self := by rw [hs, inv_of_mul_self],
  mul_inv_of_self := by rw [hs, mul_inv_of_self] }

/-- An `invertible` element is a unit. -/
@[simps]
def unit_of_invertible [monoid α] (a : α) [invertible a] : αˣ :=
{ val     := a,
  inv     := ⅟a,
  val_inv := by simp,
  inv_val := by simp, }

lemma is_unit_of_invertible [monoid α] (a : α) [invertible a] : is_unit a :=
⟨unit_of_invertible a, rfl⟩

/-- Units are invertible in their associated monoid. -/
def units.invertible [monoid α] (u : αˣ) : invertible (u : α) :=
{ inv_of := ↑(u⁻¹), inv_of_mul_self := u.inv_mul, mul_inv_of_self := u.mul_inv }

@[simp] lemma inv_of_units [monoid α] (u : αˣ) [invertible (u : α)] : ⅟(u : α) = ↑(u⁻¹) :=
inv_of_eq_right_inv u.mul_inv

lemma is_unit.nonempty_invertible [monoid α] {a : α} (h : is_unit a) : nonempty (invertible a) :=
let ⟨x, hx⟩ := h in ⟨x.invertible.copy _ hx.symm⟩

/-- Convert `is_unit` to `invertible` using `classical.choice`.

Prefer `casesI h.nonempty_invertible` over `letI := h.invertible` if you want to avoid choice. -/
noncomputable def is_unit.invertible [monoid α] {a : α} (h : is_unit a) : invertible a :=
classical.choice h.nonempty_invertible

@[simp] lemma nonempty_invertible_iff_is_unit [monoid α] (a : α) :
  nonempty (invertible a) ↔ is_unit a :=
⟨nonempty.rec $ @is_unit_of_invertible _ _ _, is_unit.nonempty_invertible⟩

/-- Each element of a group is invertible. -/
def invertible_of_group [group α] (a : α) : invertible a :=
⟨a⁻¹, inv_mul_self a, mul_inv_self a⟩

@[simp] lemma inv_of_eq_group_inv [group α] (a : α) [invertible a] : ⅟a = a⁻¹ :=
inv_of_eq_right_inv (mul_inv_self a)

/-- `1` is the inverse of itself -/
def invertible_one [monoid α] : invertible (1 : α) :=
⟨1, mul_one _, one_mul _⟩

@[simp] lemma inv_of_one [monoid α] [invertible (1 : α)] : ⅟(1 : α) = 1 :=
inv_of_eq_right_inv (mul_one _)

/-- `-⅟a` is the inverse of `-a` -/
def invertible_neg [has_mul α] [has_one α] [has_distrib_neg α] (a : α) [invertible a] :
  invertible (-a) := ⟨-⅟a, by simp, by simp ⟩

@[simp] lemma inv_of_neg [monoid α] [has_distrib_neg α] (a : α) [invertible a] [invertible (-a)] :
  ⅟(-a) = -⅟a :=
inv_of_eq_right_inv (by simp)

@[simp] lemma one_sub_inv_of_two [ring α] [invertible (2:α)] : 1 - (⅟2:α) = ⅟2 :=
(is_unit_of_invertible (2:α)).mul_right_inj.1 $
  by rw [mul_sub, mul_inv_of_self, mul_one, bit0, add_sub_cancel]

@[simp] lemma inv_of_two_add_inv_of_two [non_assoc_semiring α] [invertible (2 : α)] :
  (⅟2 : α) + (⅟2 : α) = 1 :=
by rw [←two_mul, mul_inv_of_self]

/-- `a` is the inverse of `⅟a`. -/
instance invertible_inv_of [has_one α] [has_mul α] {a : α} [invertible a] : invertible (⅟a) :=
⟨ a, mul_inv_of_self a, inv_of_mul_self a ⟩

@[simp] lemma inv_of_inv_of [monoid α] (a : α) [invertible a] [invertible (⅟a)] : ⅟(⅟a) = a :=
inv_of_eq_right_inv (inv_of_mul_self _)

@[simp] lemma inv_of_inj [monoid α] {a b : α} [invertible a] [invertible b] :
  ⅟ a = ⅟ b ↔ a = b :=
⟨invertible_unique _ _, invertible_unique _ _⟩

/-- `⅟b * ⅟a` is the inverse of `a * b` -/
def invertible_mul [monoid α] (a b : α) [invertible a] [invertible b] : invertible (a * b) :=
⟨ ⅟b * ⅟a, by simp [←mul_assoc], by simp [←mul_assoc] ⟩

@[simp] lemma inv_of_mul [monoid α] (a b : α) [invertible a] [invertible b] [invertible (a * b)] :
  ⅟(a * b) = ⅟b * ⅟a :=
inv_of_eq_right_inv (by simp [←mul_assoc])

theorem commute.inv_of_right [monoid α] {a b : α} [invertible b] (h : commute a b) :
  commute a (⅟b) :=
calc a * (⅟b) = (⅟b) * (b * a * (⅟b)) : by simp [mul_assoc]
... = (⅟b) * (a * b * ((⅟b))) : by rw h.eq
... = (⅟b) * a : by simp [mul_assoc]

theorem commute.inv_of_left [monoid α] {a b : α} [invertible b] (h : commute b a) :
  commute (⅟b) a :=
calc (⅟b) * a = (⅟b) * (a * b * (⅟b)) : by simp [mul_assoc]
... = (⅟b) * (b * a * (⅟b)) : by rw h.eq
... = a * (⅟b) : by simp [mul_assoc]

lemma commute_inv_of {M : Type*} [has_one M] [has_mul M] (m : M) [invertible m] :
  commute m (⅟m) :=
calc m * ⅟m = 1       : mul_inv_of_self m
        ... = ⅟ m * m : (inv_of_mul_self m).symm

lemma nonzero_of_invertible [mul_zero_one_class α] (a : α) [nontrivial α] [invertible a] : a ≠ 0 :=
λ ha, zero_ne_one $ calc   0 = ⅟a * a : by simp [ha]
                         ... = 1 : inv_of_mul_self a

@[priority 100] instance invertible.ne_zero [mul_zero_one_class α] [nontrivial α] (a : α)
  [invertible a] : ne_zero a := ⟨nonzero_of_invertible a⟩

section monoid_with_zero
variable [monoid_with_zero α]

/-- A variant of `ring.inverse_unit`. -/
@[simp] lemma ring.inverse_invertible (x : α) [invertible x] : ring.inverse x = ⅟x :=
ring.inverse_unit (unit_of_invertible _)

end monoid_with_zero

section group_with_zero

variable [group_with_zero α]

/-- `a⁻¹` is an inverse of `a` if `a ≠ 0` -/
def invertible_of_nonzero {a : α} (h : a ≠ 0) : invertible a :=
⟨ a⁻¹, inv_mul_cancel h, mul_inv_cancel h ⟩

@[simp] lemma inv_of_eq_inv (a : α) [invertible a] : ⅟a = a⁻¹ :=
inv_of_eq_right_inv (mul_inv_cancel (nonzero_of_invertible a))

@[simp] lemma inv_mul_cancel_of_invertible (a : α) [invertible a] : a⁻¹ * a = 1 :=
inv_mul_cancel (nonzero_of_invertible a)

@[simp] lemma mul_inv_cancel_of_invertible (a : α) [invertible a] : a * a⁻¹ = 1 :=
mul_inv_cancel (nonzero_of_invertible a)

@[simp] lemma div_mul_cancel_of_invertible (a b : α) [invertible b] : a / b * b = a :=
div_mul_cancel a (nonzero_of_invertible b)

@[simp] lemma mul_div_cancel_of_invertible (a b : α) [invertible b] : a * b / b = a :=
mul_div_cancel a (nonzero_of_invertible b)

@[simp] lemma div_self_of_invertible (a : α) [invertible a] : a / a = 1 :=
div_self (nonzero_of_invertible a)

/-- `b / a` is the inverse of `a / b` -/
def invertible_div (a b : α) [invertible a] [invertible b] : invertible (a / b) :=
⟨b / a, by simp [←mul_div_assoc], by simp [←mul_div_assoc]⟩

@[simp] lemma inv_of_div (a b : α) [invertible a] [invertible b] [invertible (a / b)] :
  ⅟(a / b) = b / a :=
inv_of_eq_right_inv (by simp [←mul_div_assoc])

/-- `a` is the inverse of `a⁻¹` -/
def invertible_inv {a : α} [invertible a] : invertible (a⁻¹) :=
⟨ a, by simp, by simp ⟩

end group_with_zero

/-- Monoid homs preserve invertibility. -/
def invertible.map {R : Type*} {S : Type*} {F : Type*} [mul_one_class R] [mul_one_class S]
  [monoid_hom_class F R S] (f : F) (r : R) [invertible r] :
  invertible (f r) :=
{ inv_of := f (⅟r),
  inv_of_mul_self := by rw [←map_mul, inv_of_mul_self, map_one],
  mul_inv_of_self := by rw [←map_mul, mul_inv_of_self, map_one] }

/-- Note that the `invertible (f r)` argument can be satisfied by using `letI := invertible.map f r`
before applying this lemma. -/
lemma map_inv_of {R : Type*} {S : Type*} {F : Type*} [mul_one_class R] [monoid S]
  [monoid_hom_class F R S] (f : F) (r : R) [invertible r] [invertible (f r)] :
  f (⅟r) = ⅟(f r) :=
by { letI := invertible.map f r, convert rfl }

/-- If a function `f : R → S` has a left-inverse that is a monoid hom,
  then `r : R` is invertible if `f r` is.

The inverse is computed as `g (⅟(f r))` -/
@[simps {attrs := []}]
def invertible.of_left_inverse {R : Type*} {S : Type*} {G : Type*}
  [mul_one_class R] [mul_one_class S] [monoid_hom_class G S R]
  (f : R → S) (g : G) (r : R) (h : function.left_inverse g f) [invertible (f r)] :
  invertible r :=
(invertible.map g (f r)).copy _ (h r).symm

/-- Invertibility on either side of a monoid hom with a left-inverse is equivalent. -/
@[simps]
def invertible_equiv_of_left_inverse {R : Type*} {S : Type*} {F G : Type*}
  [monoid R] [monoid S] [monoid_hom_class F R S] [monoid_hom_class G S R]
  (f : F) (g : G) (r : R) (h : function.left_inverse g f) :
  invertible (f r) ≃ invertible r :=
{ to_fun := λ _, by exactI invertible.of_left_inverse f _ _ h,
  inv_fun := λ _, by exactI invertible.map f _,
  left_inv := λ x, subsingleton.elim _ _,
  right_inv := λ x, subsingleton.elim _ _ }


/-
Copyright (c) Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.calculus.times_cont_diff
import analysis.complex.basic

/-! # Real differentiability of complex-differentiable functions

`has_deriv_at.real_of_complex` expresses that, if a function on `ℂ` is differentiable (over `ℂ`),
then its restriction to `ℝ` is differentiable over `ℝ`, with derivative the real part of the
complex derivative.
-/

section real_deriv_of_complex
/-! ### Differentiability of the restriction to `ℝ` of complex functions -/
open complex
variables {e : ℂ → ℂ} {e' : ℂ} {z : ℝ}

/-- If a complex function is differentiable at a real point, then the induced real function is also
differentiable at this point, with a derivative equal to the real part of the complex derivative. -/
theorem has_strict_deriv_at.real_of_complex (h : has_strict_deriv_at e e' z) :
  has_strict_deriv_at (λx:ℝ, (e x).re) e'.re z :=
begin
  have A : has_strict_fderiv_at (coe : ℝ → ℂ) of_real_clm z := of_real_clm.has_strict_fderiv_at,
  have B : has_strict_fderiv_at e
    ((continuous_linear_map.smul_right 1 e' : ℂ →L[ℂ] ℂ).restrict_scalars ℝ)
    (of_real_clm z) :=
    h.has_strict_fderiv_at.restrict_scalars ℝ,
  have C : has_strict_fderiv_at re re_clm (e (of_real_clm z)) := re_clm.has_strict_fderiv_at,
  simpa using (C.comp z (B.comp z A)).has_strict_deriv_at
end

/-- If a complex function is differentiable at a real point, then the induced real function is also
differentiable at this point, with a derivative equal to the real part of the complex derivative. -/
theorem has_deriv_at.real_of_complex (h : has_deriv_at e e' z) :
  has_deriv_at (λx:ℝ, (e x).re) e'.re z :=
begin
  have A : has_fderiv_at (coe : ℝ → ℂ) of_real_clm z := of_real_clm.has_fderiv_at,
  have B : has_fderiv_at e ((continuous_linear_map.smul_right 1 e' : ℂ →L[ℂ] ℂ).restrict_scalars ℝ)
    (of_real_clm z) :=
    h.has_fderiv_at.restrict_scalars ℝ,
  have C : has_fderiv_at re re_clm (e (of_real_clm z)) := re_clm.has_fderiv_at,
  simpa using (C.comp z (B.comp z A)).has_deriv_at
end

theorem times_cont_diff_at.real_of_complex {n : with_top ℕ} (h : times_cont_diff_at ℂ n e z) :
  times_cont_diff_at ℝ n (λ x : ℝ, (e x).re) z :=
begin
  have A : times_cont_diff_at ℝ n (coe : ℝ → ℂ) z,
    from of_real_clm.times_cont_diff.times_cont_diff_at,
  have B : times_cont_diff_at ℝ n e z := h.restrict_scalars ℝ,
  have C : times_cont_diff_at ℝ n re (e z), from re_clm.times_cont_diff.times_cont_diff_at,
  exact C.comp z (B.comp z A)
end

theorem times_cont_diff.real_of_complex {n : with_top ℕ} (h : times_cont_diff ℂ n e) :
  times_cont_diff ℝ n (λ x : ℝ, (e x).re) :=
times_cont_diff_iff_times_cont_diff_at.2 $ λ x,
  h.times_cont_diff_at.real_of_complex

end real_deriv_of_complex


import data.list data.set algebra.binary algebra.group classical
open nat list

definition no_dup {V : Type} : list V → Prop
| [] := true
| (x :: xs) := ¬ x ∈ xs ∧ no_dup xs

definition last {V : Type} [V_inhabited : inhabited V] : list V → V
| [] := arbitrary V
| [x] := x
| (x :: xs) := last xs

lemma reverse_last_head {V : Type} [V_inhabited : inhabited V] (xs : list V) : last (reverse xs) = head xs:= sorry
lemma reverse_head_last {V : Type} [V_inhabited : inhabited V] (xs : list V) : head (reverse xs) = last xs := sorry
lemma reverse_nil {V : Type} (xs :  list V) : xs = nil → reverse xs = nil := sorry
lemma reverse_nnil {V : Type} (xs :  list V) : xs ≠ nil → reverse xs ≠ nil := sorry

definition rcons {V : Type} : list V → V → list V
| [] v := [v]
| (x :: xs) v := x :: (rcons xs v)

definition graph V := V → V → Prop

namespace path

section V

variables {V : Type} [V_inhabited : inhabited V]
include V_inhabited
variables (g : graph V)

/- [KS]
A path in a graph G = (V, E) is a series of nodes (v1, v2, …, vn) where for any i ∈ ℕ with 1 ≤ i < n,
there is an edge from vi to vi+1.
-/

-- this definition is not good enough
definition path (xs : list V) := ∀ i, i + 1 < length xs → g (nth xs i) (nth xs (i + 1))

/- [KS]
A simple path is a path with no repeated nodes.
-/

definition simple_path (xs : list V) := path g xs ∧ no_dup xs

/- [KS]
A cycle is a path that starts and ends at the same node.
-/

-- #DHS his definitions are inconsistent at the null path
definition cycle (xs : list V) := path g xs ∧ xs ≠ [] ∧ head xs = last xs

/- [KS]
A simple cycle is a cycle that does not contain any duplicate nodes (except for the very last node) or
duplicate edges.
-/

-- #DHS easier to exclude the first than the last
definition simple_cycle (xs : list V) := cycle g xs ∧ no_dup (tail xs)

-- 4.2 Graph Connectivity
-- 4.2.1 Connected Components

/- [KS]
Let G be an undirected graph. Two nodes u and v are called connected iff there is a path from u to v
in G. If u and v are connected, we denote this by writing u ↔ v. If u and v are not connected, we denote
this by writing u ↮ v.
-/

variables {g_symmetric : symmetric g}

-- #DHS this definition is terrible

definition path_btw (u v : V) (xs : list V) := path g xs ∧ xs ≠ nil ∧ head xs = u ∧ last xs = v
definition connected := ∀ (u v : V), ∃ xs, path_btw g u v xs

local notation u ↔ v := connected g u v

/- [KS]
Theorem: Let G = (V, E) be an undirected graph. Then:
(1) If v ∈ V, then v ↔ v.
(2) If u, v ∈ V and u ↔ v, then v ↔ u.
(3) If u, v, w ∈ V, then if u ↔ v and v ↔ w, then u ↔ w
Proof: We prove each part independently.
To prove (1), note that for any v ∈ V, the trivial path (v) is a path from v to itself. Thus v ↔ v.
To prove (2), consider any u, v ∈ V where u ↔ v. Then there must be some path (u, x1, x2, …, xn, v).
Since G is an undirected graph, this means v, xn, …, x1, u is a path from v to u. Thus v ↔ u.
To prove (3), consider any u, v, w ∈ V where u ↔ v and v ↔ w. Then there must be paths u, x1, x2,
…, xn, v and v, y1, y2, …, ym, w. Consequently, (u, x1, …, xn, v, y1, …, ym, w) is a path from u to w.
Thus u ↔ w.
-/

theorem connected_refl : ∀ (v : V), v ↔ v :=
  -- To prove (1), note that for any v ∈ V,
  take v,
  -- the trivial path (v) is a path from v to itself.
  have v_path_v : path_btw g v v [v], from sorry,
  -- Thus v ↔ v.
  show v ↔ v, from exists.intro _ v_path_v

theorem connected_symm : ∀ {u v : V}, u ↔ v → v ↔ u :=
  -- To prove (2), consider any u, v ∈ V where u ↔ v.
  take u v,
  assume u_conn_v : u ↔ v,
  -- Then there must be some path (u, x1, x2, …, xn, v).
  obtain (xs : list V) (path_btw_u_v : path_btw g u v xs), from u_conn_v,
  -- Since G is an undirected graph, this means v, xn, …, x1, u is a path from v to u.
  have g_holds : ∀ {i}, i + 1 < length xs → g (nth xs i) (nth xs (i + 1)), from and.elim_left path_btw_u_v,
  have g_holds_bwd : ∀ {i}, i + 1 < length xs → g (nth xs (i + 1)) (nth xs i), from take i i_in_bounds, g_symmetric (g_holds i_in_bounds),
  have g_holds_rev : ∀ {i}, i + 1 < length xs → g (nth (reverse xs) i) (nth (reverse xs) (i + 1)), from sorry,
  have path_btw_v_u : path_btw g v u (reverse xs), from sorry,
  -- Thus v ↔ u.
  show v ↔ u, from exists.intro _ path_btw_v_u

theorem connected_trans : ∀ {u v w : V}, u ↔ v → v ↔ w → u ↔ w :=
  -- To prove (3), consider any u, v, w ∈ V where u ↔ v and v ↔ w.
  take u v w,
  assume (u_conn_v : u ↔ v) (v_conn_w : v ↔ w),
  -- Then there must be paths u, x1, x2, …, xn, v and v, y1, y2, …, ym, w.
  obtain (xs : list V) (path_btw_u_v : path_btw g u v xs), from u_conn_v,
  obtain (ys : list V) (path_btw_v_w : path_btw g v w ys), from v_conn_w,
  -- Consequently, (u, x1, …, xn, v, y1, …, ym, w) is a path from u to w.
  have path_btw_u_w : path_btw g u w (xs ++ tail ys), from sorry,
  -- Thus u ↔ w.
  show u ↔ w, from exists.intro _ path_btw_u_w

/- [KS]
An undirected graph G = (V, E) is called connected if for any u, v ∈ V, we have u ↔ v. If G is an
undirected graph that is not connected, we say that G is disconnected.
-/

definition graph_connected := ∀ (u v : V), u ↔ v
definition graph_disconnected := ¬ graph_connected g

/- [KS]
Let G = (V, E) be an undirected graph. A connected component of G is a nonempty set of nodes C
(that is, C ⊆ V), such that
(1) For any u, v ∈ C, we have u ↔ v.
(2) For any u ∈ C and v ∈ V – C, we have u ↮ v.
-/

-- #DHS could be a set, but doesn't need to be here

open set binary eq.ops

definition set_minus [reducible] {T : Type} (A B : set T) :=   λ x, x ∈ A ∧ ¬ x ∈ B
notation a - b := set_minus a b
theorem union_com : ∀ {T : Type}, commutative (@union T) := sorry
theorem inter_com : ∀ {T : Type}, commutative (@inter T) := sorry

definition connected_component (vs : set V) := ∀ ⦃u : V⦄, u ∈ vs → ∀ {v : V}, (v ∈ vs → u ↔ v) ∧ (¬ v ∈ vs → ¬ (u ↔ v))

/- [KS]
Theorem: Let G be an undirected graph and let C1 and C2 be connected components of G. If C1 ≠ C2,
then C1 ∩ C2 = Ø.
Proof: By contradiction. Suppose that C1 and C2 are connected components of some undirected
graph G, that C1 ≠ C2, but that C1 ∩ C2 ≠ Ø. Since C1 ∩ C2 ≠ Ø, there must be some node v such that
v ∈ C1 and v ∈ C2. Furthermore, since C1 ≠ C2, there must be some node u that either u ∈ C1 or
u ∈ C2, but not both. Without loss of generality, assume that u ∈ C1 and u ∉ C2.
By the definition of a connected component, since u ∈ C1 and v ∈ C1, we know u ↔ v. Similarly, by
the definition of a connected component, since v ∈ C2 and u ∉ C2, we know that u ↮ v, contradicting
our previous assertion. We have reached a contradiction, so our assumption must have been wrong.
Thus C1 ∩ C2 = Ø, as required.
-/

-- #TODO need to handle unpacking/coercions here...tricky!

lemma inter_nonempty_imp_elem_in_both : ∀ {C1 C2 : set V}, C1 ∩ C2 ≠ ∅ → ∃ v, v ∈ C1 ∧ v ∈ C2 := sorry
lemma inter_empty_imp_not_elem_in_both : ∀ {C1 C2 : set V}, C1 ∩ C2 = ∅ → ∀ {u:V}, u ∈ C1 → ¬ u ∈ C2 := sorry

lemma connected_components_disjoint_helper : ∀ {C1 C2 : set V}, connected_component g C1 → connected_component g C2 → (C1 ∩ C2 ≠ ∅) → ¬ (∃ u:V, u ∈ C1 - C2) :=
  take (C1 C2 : set V),
  assume (CC1 : connected_component g C1) (CC2 : connected_component g C2) (C1_overlap_C2 : C1 ∩ C2 ≠ ∅) (exists_u_in_diff : ∃ u, u ∈ C1 - C2),
  obtain (u : V) (u_in_diff : u ∈ C1 - C2), from exists_u_in_diff,
  have exists_v_in_both : ∃ v, v ∈ C1 ∩ C2, from inter_nonempty_imp_elem_in_both C1_overlap_C2,
  obtain (v : V) (v_in_both : v ∈ C1 ∩ C2), from exists_v_in_both,
  have v_conn_u : v ↔ u, from and.elim_left (CC1 (and.elim_left v_in_both)) (and.elim_left u_in_diff),
  have v_nconn_u : ¬ (v ↔ u), from and.elim_right (CC2 (and.elim_right v_in_both)) (and.elim_right u_in_diff),
  show false, from v_nconn_u v_conn_u

theorem connected_components_disjoint : ∀ {C1 C2 : set V}, connected_component g C1 → connected_component g C2 → C1 ≠ C2 → C1 ∩ C2 = ∅ :=
  take (C1 C2 : set V),
  assume (CC1 : connected_component g C1) (CC2 : connected_component g C2) (C1_neq_C2 : C1 ≠ C2),
  by_contradiction
  (assume C1_ndisj_C2 : C1 ∩ C2 ≠ ∅,
   show false, from
   have u_in_one : (∃ u:V, u ∈ C1 - C2) ∨ (∃ u:V, u ∈ C2 - C1), from sorry,
   or.elim u_in_one
           (take (exists_u : ∃ u, u ∈ C1 - C2), connected_components_disjoint_helper g CC1 CC2 C1_ndisj_C2 exists_u)
           (take (exists_u : ∃ u, u ∈ C2 - C1), connected_components_disjoint_helper g CC2 CC1 ((inter_com C1 C2) ▸ C1_ndisj_C2) exists_u))

/- [DHS]#DESIGN
1. Troublesome WLOG
2. Lots of painful obviousness (e.g. inter_nonempty_imp_elem_in_both)
-/

/- [KS]
Theorem: Let G = (V, E) be an undirected graph. Then for any v ∈ V, there is a connected component
C such that v ∈ C.
Proof: Let G = (V, E) be any undirected graph and let v ∈ V be an arbitrary node in the graph. Consider
the set C = { u ∈ V | u ↔ v }. We will prove C is a connected component containing v.
First, we prove that v ∈ C. To see this, note that by construction, v ∈ C iff v ↔ v. As proven earlier,
v ↔ v is always true. Consequently, v ∈ C.
Next, we prove that C is a connected component. This proof proceeds in two steps: first, we prove
that for any u1, u2 ∈ C, that u1 ↔ u2; second, we prove that for any u1 ∈ C and u2 ∈ V – C, that u1 ↮ u2.
To prove that for any u1, u2 ∈ C, that u1 ↔ u2, consider any u1, u2 ∈ C. By construction, this means
that u1 ↔ v and u2 ↔ v. As proven earlier, since u2 ↔ v, we know that v ↔ u2. Also as proven earlier,
since u1 ↔ v and v ↔ u2, this means that u1 ↔ u2.
Finally, to prove that for any u1 ∈ C and u2 ∈ V – C, that u1 ↮ u2, consider any u1 ∈ C and u2 ∈ V – C.
Assume for the sake of contradiction that u1 ↔ u2. Since u1 ∈ C, we know that u1 ↔ v. Since u1↔ u2,
we know u2 ↔ u1. Therefore, since u2 ↔ u1 and u1 ↔ v, we have that u2 ↔ v. Thus by definition of
C, this means that u2 ∈ C, contradicting the fact that u2 ∈ V – C. We have reached a contradiction, so
our assumption must have been wrong. Thus u1 ↮ u2.
Thus C is a connected component containing v. Since our choice of v and G were arbitrary, any node
in any graph belongs to at least one connected component.
-/

theorem every_node_in_connected_component : ∀ (v : V), ∃ (C : set V), connected_component g C ∧ v ∈ C :=
  -- Proof: Let G = (V, E) be any undirected graph and let v ∈ V be an arbitrary node in the graph.
  take (v : V),
  -- Consider the set C = { u ∈ V | u ↔ v }. We will prove C is a connected component containing v.
  let C := (λ u, u ↔ v) in
  -- First, we prove that v ∈ C.
  have v_in_C : v ∈ C, from
    -- To see this, note that by construction, v ∈ C iff v ↔ v. As proven earlier, v ↔ v is always true. Consequently, v ∈ C.
    connected_refl g v,
  -- Next, we prove that C is a connected component.
  have CC : connected_component g C, from
    -- This proof proceeds in two steps: first, we prove that for any u1, u2 ∈ C, that u1 ↔ u2; second, we prove that for any u1 ∈ C and u2 ∈ V – C, that u1 ↮ u2.
    assume (u1 : V) (u1_in_C : u1 ∈ C) (u2 : V),
    and.intro
      (-- To prove that for any u1, u2 ∈ C, that u1 ↔ u2, consider any u1, u2 ∈ C.
       assume (u2_in_C : u2 ∈ C),
       -- By construction, this means that u1 ↔ v and u2 ↔ v.
       have u1_conn_v : u1 ↔ v, from sorry,
       have u2_conn_v : u2 ↔ v, from sorry,
       -- As proven earlier, since u2 ↔ v, we know that v ↔ u2.
       have v_conn_u2 : v ↔ u2, from @connected_symm _ _ g g_symmetric _ _ u2_conn_v,
       -- Also as proven earlier, since u1 ↔ v and v ↔ u2, this means that u1 ↔ u2.
       have u1_conn_u2 : u1 ↔ u2, from connected_trans g u1_conn_v v_conn_u2,
       show u1 ↔ u2, from u1_conn_u2)
      (-- Finally, to prove that for any u1 ∈ C and u2 ∈ V – C, that u1 ↮ u2, consider any u1 ∈ C and u2 ∈ V – C.
       assume (u2_nin_C : ¬ (u2 ∈ C)),
       -- Assume for the sake of contradiction that u1 ↔ u2.
       show ¬ (u1 ↔ u2), from
       assume u1_conn_u2 : u1 ↔ u2,
       -- Since u1 ∈ C, we know that u1 ↔ v.
       have u1_conn_v : u1 ↔ v, from u1_in_C,
       -- Since u1 ↔ u2, we know u2 ↔ u1.
       have u2_conn_u1 : u2 ↔ u1, from @connected_symm _ _ g g_symmetric _ _ u1_conn_u2,
       -- Therefore, since u2 ↔ u1 and u1 ↔ v, we have that u2 ↔ v.
       have u2_conn_v : u2 ↔ v, from connected_trans g u2_conn_u1 u1_conn_v,
       -- Thus by definition of C, this means that u2 ∈ C,
       have u2_in_C : u2 ∈ C, from u2_conn_v,
       -- contradicting the fact that u2 ∈ V – C.
       -- We have reached a contradiction, so our assumption must have been wrong. Thus u1 ↮ u2.
       absurd u2_in_C u2_nin_C),
  show ∃ (C : set V), connected_component g C ∧ v ∈ C, from exists.intro _ (and.intro CC v_in_C)

/- [KS]
Theorem: Every node in an undirected graph belongs to exactly one connected component.
Proof: <no formal proof>
-/
theorem connected_components_cover : ∀ (v : V), ∃! (C : set V), connected_component g C ∧ v ∈ C :=
  take (v : V),
  exists.elim (@every_node_in_connected_component _ _ g g_symmetric v)
  (
    take (C : set V) (HC : connected_component g C ∧ v ∈ C),
    have C_unique : ∀ (D : set V), connected_component g D ∧ v ∈ D → D = C, from
      take (D : set V) (HD : connected_component g D ∧ v ∈ D),
      by_contradiction
      (
        take D_neq_C : D ≠ C,
        have D_disj_C : D ∩ C = ∅, from connected_components_disjoint g (and.elim_left HD) (and.elim_left HC) D_neq_C,
        inter_empty_imp_not_elem_in_both D_disj_C (and.elim_right HD) (and.elim_right HC)
      ),
    exists_unique.intro _ HC C_unique
  )

/- [KS]
An undirected graph G is called minimally connected iff G is connected, but the removal of any edge
from G leaves G disconnected.

A graph is called acyclic iff it contains no simple cycles.
-/

definition remove_edge (u1 u2 : V) : graph V :=
  λ v1 v2, if u1 = v1 ∧ u2 = v2 ∨ u1 = v2 ∧ u2 = v1 then false else g v1 v2

definition minimally_connected := connected g ∧ ∀ u1 u2, ¬ connected (remove_edge g u1 u2)

definition acyclic := ¬ ∃ (xs : list V), simple_cycle g xs

/- [KS]
Theorem: If an undirected graph G is minimally-connected, then it is connected and acyclic.
Proof: By contradiction; assume that G is minimally-connected, but that it is not connected or that it
is not acyclic. It cannot be the case that G is not connected, since by definition any minimally-connected
graph must be connected. So we must have that G is not acyclic, meaning that it contains a
simple cycle; call it C. By our previous corollary, since G is connected and C is a simple cycle, we
can delete any edge e ∈ C from G without disconnecting G. This contradicts the fact that G is minimally-connected.
We have reached a contradiction, so our assumption must have been wrong. Thus
if G is minimally-connected, then it must be connected and acyclic.
-/

lemma double_negation : ∀ {P : Prop}, ¬ ¬ P → P := sorry

-- TODO need notion of edge being in a path (This theorem is false!)
lemma connected_w_simple_cycle_imp_not_fragile : connected g → ∀ {xs : list V}, simple_cycle g xs → ∀ (u v : V), connected (remove_edge g u v) := sorry

theorem minimally_connected_imp_connected_and_acyclic : minimally_connected g → connected g ∧ acyclic g :=
  and.rec
    (assume (g_connected : connected g) (g_fragile : ∀ (u1 u2 : V), ¬ connected (remove_edge g u1 u2)),
    -- Proof: By contradiction; assume that G is minimally-connected, but that it is not connected or that it is not acyclic.
    by_contradiction
      (assume not__connected_and_acyclic : ¬ (connected g ∧ acyclic g),
       have not_connected_or_not_acyclic : ¬ connected g ∨ ¬ acyclic g, from sorry,
       -- It cannot be the case that G is not connected, since by definition any minimally-connected graph must be connected.
       -- So we must have that G is not acyclic, meaning that it contains a simple cycle; call it C.
       or.elim not_connected_or_not_acyclic
         (assume g_not_connected : ¬ connected g, absurd g_connected g_not_connected)
         (assume g_not_acyclic : ¬ acyclic g,
          have g_has_simple_cycle : ∃ (xs : list V), simple_cycle g xs, from double_negation g_not_acyclic,
          obtain (C : list V) (C_simple_cycle : simple_cycle g C), from g_has_simple_cycle,
          -- By our previous corollary, since G is connected and C is a simple cycle, we can delete any edge e ∈ C from G without disconnecting G.
          -- [DHS]TODO simple cycles contain edges
          -- [DHS]absurdity
          sorry)))
         -- This contradicts the fact that G is minimally-connected.
         -- We have reached a contradiction, so our assumption must have been wrong. Thus if G is minimally-connected, then it must be connected and acyclic.

end V
end path


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import algebra.order.group.defs
import data.set.pointwise.smul
import order.upper_lower.basic

/-!
# Algebraic operations on upper/lower sets

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

Upper/lower sets are preserved under pointwise algebraic operations in ordered groups.
-/

open function set
open_locale pointwise

section ordered_comm_monoid
variables {α : Type*} [ordered_comm_monoid α] {s : set α} {x : α}

@[to_additive] lemma is_upper_set.smul_subset (hs : is_upper_set s) (hx : 1 ≤ x) : x • s ⊆ s :=
smul_set_subset_iff.2 $ λ y, hs $ le_mul_of_one_le_left' hx

@[to_additive] lemma is_lower_set.smul_subset (hs : is_lower_set s) (hx : x ≤ 1) : x • s ⊆ s :=
smul_set_subset_iff.2 $ λ y, hs $ mul_le_of_le_one_left' hx

end ordered_comm_monoid

section ordered_comm_group
variables {α : Type*} [ordered_comm_group α] {s t : set α} {a : α}

@[to_additive] lemma is_upper_set.smul (hs : is_upper_set s) : is_upper_set (a • s) :=
begin
  rintro _ y hxy ⟨x, hx, rfl⟩,
  exact mem_smul_set_iff_inv_smul_mem.2 (hs (le_inv_mul_iff_mul_le.2 hxy) hx),
end

@[to_additive] lemma is_lower_set.smul (hs : is_lower_set s) : is_lower_set (a • s) :=
hs.of_dual.smul

@[to_additive] lemma set.ord_connected.smul (hs : s.ord_connected) : (a • s).ord_connected :=
begin
  rw [←hs.upper_closure_inter_lower_closure, smul_set_inter],
  exact (upper_closure _).upper.smul.ord_connected.inter (lower_closure _).lower.smul.ord_connected,
end

@[to_additive] lemma is_upper_set.mul_left (ht : is_upper_set t) : is_upper_set (s * t) :=
by { rw [←smul_eq_mul, ←bUnion_smul_set], exact is_upper_set_Union₂ (λ x hx, ht.smul) }

@[to_additive] lemma is_upper_set.mul_right (hs : is_upper_set s) : is_upper_set (s * t) :=
by { rw mul_comm, exact hs.mul_left }

@[to_additive] lemma is_lower_set.mul_left (ht : is_lower_set t) : is_lower_set (s * t) :=
ht.of_dual.mul_left

@[to_additive] lemma is_lower_set.mul_right (hs : is_lower_set s) : is_lower_set (s * t) :=
hs.of_dual.mul_right

@[to_additive] lemma is_upper_set.inv (hs : is_upper_set s) : is_lower_set s⁻¹ :=
λ x y h, hs $ inv_le_inv' h

@[to_additive] lemma is_lower_set.inv (hs : is_lower_set s) : is_upper_set s⁻¹ :=
λ x y h, hs $ inv_le_inv' h

@[to_additive] lemma is_upper_set.div_left (ht : is_upper_set t) : is_lower_set (s / t) :=
by { rw div_eq_mul_inv, exact ht.inv.mul_left }

@[to_additive] lemma is_upper_set.div_right (hs : is_upper_set s) : is_upper_set (s / t) :=
by { rw div_eq_mul_inv, exact hs.mul_right }

@[to_additive] lemma is_lower_set.div_left (ht : is_lower_set t) : is_upper_set (s / t) :=
ht.of_dual.div_left

@[to_additive] lemma is_lower_set.div_right (hs : is_lower_set s) : is_lower_set (s / t) :=
hs.of_dual.div_right

namespace upper_set

@[to_additive] instance : has_one (upper_set α) := ⟨Ici 1⟩
@[to_additive] instance : has_mul (upper_set α) := ⟨λ s t, ⟨image2 (*) s t, s.2.mul_right⟩⟩
@[to_additive] instance : has_div (upper_set α) := ⟨λ s t, ⟨image2 (/) s t, s.2.div_right⟩⟩
@[to_additive] instance : has_smul α (upper_set α) := ⟨λ a s, ⟨(•) a '' s, s.2.smul⟩⟩

@[simp, norm_cast, to_additive] lemma coe_one : ((1 : upper_set α) : set α) = set.Ici 1 := rfl
@[simp, norm_cast, to_additive]
lemma coe_smul (a : α) (s : upper_set α) : (↑(a • s) : set α) = a • s := rfl
@[simp, norm_cast, to_additive]
lemma coe_mul (s t : upper_set α) : (↑(s * t) : set α) = s * t := rfl
@[simp, norm_cast, to_additive]
lemma coe_div (s t : upper_set α) : (↑(s / t) : set α) = s / t := rfl

@[simp, to_additive] lemma Ici_one : Ici (1 : α) = 1 := rfl

@[to_additive] instance : mul_action α (upper_set α) := set_like.coe_injective.mul_action _ coe_smul

@[to_additive]
instance : comm_semigroup (upper_set α) :=
{ mul := (*),
  ..(set_like.coe_injective.comm_semigroup _ coe_mul : comm_semigroup (upper_set α)) }

@[to_additive]
private lemma one_mul (s : upper_set α) : 1 * s = s :=
set_like.coe_injective $ (subset_mul_right _ left_mem_Ici).antisymm' $
    by { rw [←smul_eq_mul, ←bUnion_smul_set], exact Union₂_subset (λ _, s.upper.smul_subset) }

@[to_additive] instance : comm_monoid (upper_set α) :=
{ one := 1,
  one_mul := one_mul,
  mul_one := λ s, by { rw mul_comm, exact one_mul _ },
  ..upper_set.comm_semigroup }

end upper_set

namespace lower_set

@[to_additive] instance : has_one (lower_set α) := ⟨Iic 1⟩
@[to_additive] instance : has_mul (lower_set α) := ⟨λ s t, ⟨image2 (*) s t, s.2.mul_right⟩⟩
@[to_additive] instance : has_div (lower_set α) := ⟨λ s t, ⟨image2 (/) s t, s.2.div_right⟩⟩
@[to_additive] instance : has_smul α (lower_set α) := ⟨λ a s, ⟨(•) a '' s, s.2.smul⟩⟩

@[simp, norm_cast, to_additive]
lemma coe_smul (a : α) (s : lower_set α) : (↑(a • s) : set α) = a • s := rfl
@[simp, norm_cast, to_additive]
lemma coe_mul (s t : lower_set α) : (↑(s * t) : set α) = s * t := rfl
@[simp, norm_cast, to_additive]
lemma coe_div (s t : lower_set α) : (↑(s / t) : set α) = s / t := rfl

@[simp, to_additive] lemma Iic_one : Iic (1 : α) = 1 := rfl

@[to_additive] instance : mul_action α (lower_set α) := set_like.coe_injective.mul_action _ coe_smul

@[to_additive]
instance : comm_semigroup (lower_set α) :=
{ mul := (*),
  ..(set_like.coe_injective.comm_semigroup _ coe_mul : comm_semigroup (lower_set α)) }

@[to_additive]
private lemma one_mul (s : lower_set α) : 1 * s = s :=
set_like.coe_injective $ (subset_mul_right _ right_mem_Iic).antisymm' $
    by { rw [←smul_eq_mul, ←bUnion_smul_set], exact Union₂_subset (λ _, s.lower.smul_subset) }

@[to_additive] instance : comm_monoid (lower_set α) :=
{ one := 1,
  one_mul := one_mul,
  mul_one := λ s, by { rw mul_comm, exact one_mul _ },
  ..lower_set.comm_semigroup }

end lower_set

variables (a s t)

@[simp, to_additive] lemma upper_closure_one : upper_closure (1 : set α) = 1 :=
upper_closure_singleton _

@[simp, to_additive] lemma lower_closure_one : lower_closure (1 : set α) = 1 :=
lower_closure_singleton _

@[simp, to_additive] lemma upper_closure_smul : upper_closure (a • s) = a • upper_closure s :=
upper_closure_image $ order_iso.mul_left a

@[simp, to_additive] lemma lower_closure_smul : lower_closure (a • s) = a • lower_closure s :=
lower_closure_image $ order_iso.mul_left a

@[to_additive] lemma mul_upper_closure : s * upper_closure t = upper_closure (s * t) :=
by simp_rw [←smul_eq_mul, ←bUnion_smul_set, upper_closure_Union, upper_closure_smul,
  upper_set.coe_infi₂, upper_set.coe_smul]

@[to_additive] lemma mul_lower_closure : s * lower_closure t = lower_closure (s * t) :=
by simp_rw [←smul_eq_mul, ←bUnion_smul_set, lower_closure_Union, lower_closure_smul,
  lower_set.coe_supr₂, lower_set.coe_smul]

@[to_additive] lemma upper_closure_mul : ↑(upper_closure s) * t = upper_closure (s * t) :=
by { simp_rw mul_comm _ t, exact mul_upper_closure _ _ }

@[to_additive] lemma lower_closure_mul : ↑(lower_closure s) * t = lower_closure (s * t) :=
by { simp_rw mul_comm _ t, exact mul_lower_closure _ _ }

@[simp, to_additive]
lemma upper_closure_mul_distrib : upper_closure (s * t) = upper_closure s * upper_closure t :=
set_like.coe_injective $
  by rw [upper_set.coe_mul, mul_upper_closure, upper_closure_mul, upper_set.upper_closure]

@[simp, to_additive]
lemma lower_closure_mul_distrib : lower_closure (s * t) = lower_closure s * lower_closure t :=
set_like.coe_injective $
  by rw [lower_set.coe_mul, mul_lower_closure, lower_closure_mul, lower_set.lower_closure]

end ordered_comm_group


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker, Anne Baanen
-/

import algebra.associated
import data.list.big_operators
import data.list.perm

/-!
# Products of lists of prime elements.

This file contains some theorems relating `prime` and products of `list`s.

-/

open list

section comm_monoid_with_zero

variables {M : Type*} [comm_monoid_with_zero M]

/-- Prime `p` divides the product of a list `L` iff it divides some `a ∈ L` -/
lemma prime.dvd_prod_iff {p : M} {L : list M} (pp : prime p) : p ∣ L.prod ↔ ∃ a ∈ L, p ∣ a :=
begin
  split,
  { intros h,
    induction L with L_hd L_tl L_ih,
    { rw prod_nil at h, exact absurd h pp.not_dvd_one },
    { rw prod_cons at h,
      cases pp.dvd_or_dvd h with hd hd,
      { exact ⟨L_hd, mem_cons_self L_hd L_tl, hd⟩ },
      { obtain ⟨x, hx1, hx2⟩ := L_ih hd,
        exact ⟨x, mem_cons_of_mem L_hd hx1, hx2⟩ } } },
  { exact λ ⟨a, ha1, ha2⟩, dvd_trans ha2 (dvd_prod ha1) },
end

lemma prime.not_dvd_prod {p : M} {L : list M} (pp : prime p) (hL : ∀ a ∈ L, ¬ p ∣ a) :
  ¬ p ∣ L.prod :=
mt (prime.dvd_prod_iff pp).mp $ not_bex.mpr hL

end comm_monoid_with_zero

section cancel_comm_monoid_with_zero

variables {M : Type*} [cancel_comm_monoid_with_zero M] [unique (units M)]

lemma mem_list_primes_of_dvd_prod {p : M} (hp : prime p) {L : list M} (hL : ∀ q ∈ L, prime q)
  (hpL : p ∣ L.prod) : p ∈ L :=
begin
  obtain ⟨x, hx1, hx2⟩ := hp.dvd_prod_iff.mp hpL,
  rwa (prime_dvd_prime_iff_eq hp (hL x hx1)).mp hx2
end

lemma perm_of_prod_eq_prod : ∀ {l₁ l₂ : list M}, l₁.prod = l₂.prod →
  (∀ p ∈ l₁, prime p) → (∀ p ∈ l₂, prime p) → perm l₁ l₂
| []        []        _  _  _  := perm.nil
| []        (a :: l)  h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil M _ ▸ h₁.symm ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₃ a (mem_cons_self _ _)))
| (a :: l)  []        h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil M _ ▸ h₁ ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₂ a (mem_cons_self _ _)))
| (a :: l₁) (b :: l₂) h hl₁ hl₂ :=
  begin
    classical,
    have hl₁' : ∀ p ∈ l₁, prime p := λ p hp, hl₁ p (mem_cons_of_mem _ hp),
    have hl₂' : ∀ p ∈ (b :: l₂).erase a, prime p := λ p hp, hl₂ p (mem_of_mem_erase hp),
    have ha : a ∈ (b :: l₂) := mem_list_primes_of_dvd_prod (hl₁ a (mem_cons_self _ _)) hl₂
      (h ▸ by rw prod_cons; exact dvd_mul_right _ _),
    have hb : b :: l₂ ~ a :: (b :: l₂).erase a := perm_cons_erase ha,
    have hl : prod l₁ = prod ((b :: l₂).erase a) :=
      ((mul_right_inj' (hl₁ a (mem_cons_self _ _)).ne_zero).1 $
        by rwa [← prod_cons, ← prod_cons, ← hb.prod_eq]),
    exact perm.trans ((perm_of_prod_eq_prod hl hl₁' hl₂').cons _) hb.symm
  end

end cancel_comm_monoid_with_zero


import tactic
import data.real.basic

-- dEAduction imports
import structures2
import compute
import utils

-- import definitions
-- import notations_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 (since it will be called with 'rw' or 'symp_rw')

local attribute [instance] classical.prop_decidable

---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course

------------------
-- COURSE TITLE --
------------------
namespace maths_approfondies
/- dEAduction
PrettyName
    1M003 : mathématiques approfondies
-/

-- lemma definition.valeur_absolue
-- {a: ℝ} : |a| = if a ≤ 0 then -a else a
-- :=
-- begin
--     todo
-- end

lemma exercise.majorer_valeur_absolue
{a b : ℝ} : abs a ≤ b ↔ -b ≤ a ∧ a ≤ b
:=
begin
  todo
  --  rw definition.valeur_absolue,
  --  split_ifs,
  --  split,
  --  intro H, split, {compute_n 1},
  --  {compute_n 1},
  --  intro H, {compute_n 1},
  --  split,
  --  intro H, split, compute_n 1, compute_n 1,
  --  intro H, compute_n 1,
end

lemma theorem.inegalite_triangulaire1
{a b : ℝ} : abs (a-b) ≤ abs a + abs b :=
begin
    -- simp [exercise.majorer_valeur_absolue],
    -- split,
    -- rw definition.valeur_absolue, rw definition.valeur_absolue,
    -- split_ifs,
    -- repeat {linarith},
    -- rw definition.valeur_absolue, rw definition.valeur_absolue,
    -- split_ifs,
    -- repeat {linarith},
  todo
end

lemma theorem.inegalite_triangulaire2
{a b c : ℝ} : |a-b| ≤ |a-c| + |b-c| :=
begin
  todo
    -- calc |a-b| = |a-c- (b-c)|: by ring
    --      ...   ≤ |a-c| + |b-c|: @theorem.inegalite_triangulaire1 (a-c) (b-c),
end

variables (u:ℕ → ℝ) (l: ℝ)

def limite (u:ℕ → ℝ ) (l: ℝ) :=
∀ ε > 0, ∃ N >0, ∀ n ≥ N, |u n - l| < ε

lemma definition.limite :
limite u l ↔  ∀ ε > 0, ∃ n_0 >0, ∀ n ≥ n_0, |u n - l| < ε
:=
/- dEAduction
ImplicitUse
    True
DummyVarsNames
    FromLean
-/
begin
    refl,
end

-- exo 8 a b c d
lemma exercise.plus_petit_que_tout_positif_I :
∀x:ℝ, ((∀ ε>0, x< ε) → x ≤ 0) :=
/- dEAduction
PrettyName
    1M003 exercice 1.8 (a)
-/

begin
  todo
end

lemma exercise.unicite_limite (l': ℝ) :
(limite u l) ∧ (limite u l') → l=l'
:=
begin
  todo
end

lemma exercise.essai_suites1 :
limite (λ n, 1/(n+1)) 0 :=
begin
    todo
end

lemma exercise.essai_suites2
(f: ℝ → ℝ):
limite (λ n, f 1/(n+1)) 0 :=
begin
    todo
end

end maths_approfondies

end course


import game.sup_inf.level04

namespace xena -- hide

/-
# Chapter 3 : Sup and Inf

## Level 5

A classical result: the supremum of an element-wise sum of sets.
-/

-- see also ds_infSum.lean for only the better-organized version -- hide
def mem_sum_sets (A : set ℝ) (B : set ℝ) := { x : ℝ | ∃ y ∈ A, ∃ z ∈ B, x = y + z}

/- Lemma
If $A$ and $B$ are sets of reals, then
$$ \textrm{sup} (A + B) = \textrm{sup} (A) + \textrm{sup}(B)$$
-/
lemma sup_sum_sets (A : set ℝ) (B : set ℝ) (h1A : A.nonempty) (h1B : B.nonempty)
  (h2A : bdd_above A) (h2B : bdd_above B) (a : ℝ) (b : ℝ) :
  (is_lub A a) ∧ (is_lub B b) → is_lub (mem_sum_sets A B) (a + b) :=
begin
  intro h,
  cases h with hA hB,
  split,
  { -- prove that (a+b) is an upper bound
    intros x h0,
    cases h0 with y h1, cases h1 with yA h2,
    cases h2 with z h3, cases h3 with zB hx,
    have H12A := hA.left, have H12B := hB.left,
    have H13A := H12A y yA, have H13B := H12B z zB,
    linarith,
  },
  -- now prove that (a+b) is the least upper bound
  intros S hS,
  --change ∀ xab ∈ (sum_of_sets A B), xab ≤ S at hS,
  have H1 : ∀ y ∈ A, ∀ z ∈ B, (y + z) ∈ (mem_sum_sets A B),
    intros y hy z hz,
    unfold mem_sum_sets,
    existsi y, existsi hy, existsi z, existsi hz, refl,
  have H2 : ∀ y ∈ A, ∀ z ∈ B, (y + z) ≤ S,
    intros y hy z hz,
    apply hS, exact H1 y hy z hz,
  have H3 : ∀ y ∈ A, ∀ z ∈ B, y ≤ S - z,
    intros y hy z hz,
    have H3a := H2 y hy z hz,
    exact le_sub_right_of_add_le H3a,
  have h21B := hB.right, have h22B := hB.left,
  --change ∀ z ∈ B, z ≤ b at h22B,
  have H4 : ∀ z ∈ B, (S - z) ∈ upper_bounds A, --!
    intros z hz y hy,
    exact H3 y hy z hz,
  have H5 : ∀ z ∈ B, a ≤ (S - z),
    intros z hz,
    have H13A := hA.right,
    change ∀ u ∈ upper_bounds A, a ≤ u at H13A,
    have H5a := H4 z hz,
    exact H13A (S-z) H5a,
  have H6 : ∀ z ∈ B, z ≤ S - a,
    intros z hz,
    have H6a := H5 z hz, exact le_sub.1 H6a,
  --have H7 : (S - a) ∈ upper_bounds B, exact H6,
  have H8 : b ≤ (S-a),
    have H13B := hB.right,
    change ∀ u ∈ upper_bounds B, b ≤ u at H13B,
    exact H13B (S-a) H6,  -- I had H7 instead of H6 here
  exact add_le_of_le_sub_left H8, done
end

-- begin hide
-- Kevin's term proof for second part
-- NOTE: I altered this after is_lub changed. I don't *think* it's broken -- GT.
lemma sup_sum_of_sets' (A : set ℝ) (B : set ℝ) (a : ℝ) (b : ℝ)
  (hA : is_lub A a) (hB : is_lub B b) :
  a + b ∈ lower_bounds (upper_bounds (mem_sum_sets A B)) :=
    λ S hS, add_le_of_le_sub_left $ hB.2 (S - a) $ λ z hz, le_sub.1 $ hA.2 (S - z) $ λ y hy,
    le_sub_right_of_add_le $ hS ⟨y, hy, z, hz, rfl⟩

-- Patrick Massot's proof for second part
lemma sup_sum_of_sets'' (A : set ℝ) (B : set ℝ) (a : ℝ) (b : ℝ)
  (hA : is_lub A a) (hB : is_lub B b) :
  a + b ∈ lower_bounds (upper_bounds (mem_sum_sets A B)) :=
begin
    intros S hS,
  have H1 : ∀ x ∈ A, S - x ∈ upper_bounds B,
  { intros x hx y hy,
    suffices : x + y ≤ S, by linarith, -- by rwa le_sub_iff_add_le',
    exact hS ⟨x, hx, y, hy, rfl⟩, },
  have H2 : S - b ∈ upper_bounds A,
  { intros x hx,
    suffices : b ≤ S - x, by linarith, -- by rwa le_sub,
    exact hB.2 (S - x) (H1 x hx) },
  linarith [hA.2 (S - b) H2],  --exact le_sub_iff_add_le.mp (hA.2 H2),
end

--- end hide
end xena -- hide


/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/

import ring_theory.polynomial.chebyshev
import ring_theory.localization
import data.zmod.basic
import algebra.char_p.invertible

/-!
# Dickson polynomials

The (generalised) Dickson polynomials are a family of polynomials indexed by `ℕ × ℕ`,
with coefficients in a commutative ring `R` depending on an element `a∈R`. More precisely, the
they satisfy the recursion `dickson k a (n + 2) = X * (dickson k a n + 1) - a * (dickson k a n)`
with starting values `dickson k a 0 = 3 - k` and `dickson k a 1 = X`. In the literature,
`dickson k a n` is called the `n`-th Dickson polynomial of the `k`-th kind associated to the
parameter `a : R`. They are closely related to the Chebyshev polynomials in the case that `a=1`.
When `a=0` they are just the family of monomials `X ^ n`.

## Main definition

* `polynomial.dickson`: the generalised Dickson polynomials.

## Main statements

* `polynomial.dickson_one_one_mul`, the `(m * n)`-th Dickson polynomial of the first kind for
  parameter `1 : R` is the composition of the `m`-th and `n`-th Dickson polynomials of the first
  kind for `1 : R`.
* `polynomial.dickson_one_one_char_p`, for a prime number `p`, the `p`-th Dickson polynomial of the
  first kind associated to parameter `1 : R` is congruent to `X ^ p` modulo `p`.

## References

* [R. Lidl, G. L. Mullen and G. Turnwald, _Dickson polynomials_][MR1237403]

## TODO

* Redefine `dickson` in terms of `linear_recurrence`.
* Show that `dickson 2 1` is equal to the characteristic polynomial of the adjacency matrix of a
  type A Dynkin diagram.
* Prove that the adjacency matrices of simply laced Dynkin diagrams are precisely the adjacency
  matrices of simple connected graphs which annihilate `dickson 2 1`.
-/

noncomputable theory

namespace polynomial

variables {R S : Type*} [comm_ring R] [comm_ring S] (k : ℕ) (a : R)

/-- `dickson` is the `n`the (generalised) Dickson polynomial of the `k`-th kind associated to the
element `a ∈ R`. -/
noncomputable def dickson : ℕ → polynomial R
| 0       := 3 - k
| 1       := X
| (n + 2) := X * dickson (n + 1) - (C a) * dickson n

@[simp] lemma dickson_zero : dickson k a 0 = 3 - k := rfl
@[simp] lemma dickson_one : dickson k a 1 = X := rfl
lemma dickson_two : dickson k a 2 = X ^ 2 - C a * (3 - k) :=
by simp only [dickson, sq]
@[simp] lemma dickson_add_two (n : ℕ) :
  dickson k a (n + 2) = X * dickson k a (n + 1) - C a * dickson k a n :=
by rw dickson

lemma dickson_of_two_le {n : ℕ} (h : 2 ≤ n) :
  dickson k a n = X * dickson k a (n - 1) - C a * dickson k a (n - 2) :=
begin
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
  rw add_comm,
  exact dickson_add_two k a n
end

variables {R S k a}

lemma map_dickson (f : R →+* S) :
  ∀ (n : ℕ), map f (dickson k a n) = dickson k (f a) n
| 0       := by simp only [dickson_zero, map_sub, map_nat_cast, bit1, bit0, map_add, map_one]
| 1       := by simp only [dickson_one, map_X]
| (n + 2) :=
begin
  simp only [dickson_add_two, map_sub, map_mul, map_X, map_C],
  rw [map_dickson, map_dickson]
end

variable {R}

@[simp] lemma dickson_two_zero :
  ∀ (n : ℕ), dickson 2 (0 : R) n = X ^ n
| 0       := by { simp only [dickson_zero, pow_zero], norm_num }
| 1       := by simp only [dickson_one, pow_one]
| (n + 2) :=
begin
  simp only [dickson_add_two, C_0, zero_mul, sub_zero],
  rw [dickson_two_zero, pow_add X (n + 1) 1, mul_comm, pow_one]
end

section dickson
/-!

### A Lambda structure on `polynomial ℤ`

Mathlib doesn't currently know what a Lambda ring is.
But once it does, we can endow `polynomial ℤ` with a Lambda structure
in terms of the `dickson 1 1` polynomials defined below.
There is exactly one other Lambda structure on `polynomial ℤ` in terms of binomial polynomials.

-/

variables {R}

lemma dickson_one_one_eval_add_inv (x y : R) (h : x * y = 1) :
  ∀ n, (dickson 1 (1 : R) n).eval (x + y) = x ^ n + y ^ n
| 0       := by { simp only [bit0, eval_one, eval_add, pow_zero, dickson_zero], norm_num }
| 1       := by simp only [eval_X, dickson_one, pow_one]
| (n + 2) :=
begin
  simp only [eval_sub, eval_mul, dickson_one_one_eval_add_inv, eval_X, dickson_add_two, C_1,
    eval_one],
  conv_lhs { simp only [pow_succ, add_mul, mul_add, h, ← mul_assoc, mul_comm y x, one_mul] },
  ring_exp
end

variables (R)

lemma dickson_one_one_eq_chebyshev_T [invertible (2 : R)] :
  ∀ n, dickson 1 (1 : R) n = 2 * (chebyshev.T R n).comp (C (⅟2) * X)
| 0       := by { simp only [chebyshev.T_zero, mul_one, one_comp, dickson_zero], norm_num }
| 1       := by rw [dickson_one, chebyshev.T_one, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul,
                    mul_inv_of_self, C_1, one_mul]
| (n + 2) :=
begin
  simp only [dickson_add_two, chebyshev.T_add_two, dickson_one_one_eq_chebyshev_T (n + 1),
    dickson_one_one_eq_chebyshev_T n, sub_comp, mul_comp, add_comp, X_comp, bit0_comp, one_comp],
  simp only [← C_1, ← C_bit0, ← mul_assoc, ← C_mul, mul_inv_of_self],
  rw [C_1, one_mul],
  ring
end

lemma chebyshev_T_eq_dickson_one_one [invertible (2 : R)] (n : ℕ) :
  chebyshev.T R n = C (⅟2) * (dickson 1 1 n).comp (2 * X) :=
begin
  rw dickson_one_one_eq_chebyshev_T,
  simp only [comp_assoc, mul_comp, C_comp, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul],
  rw [inv_of_mul_self, C_1, one_mul, one_mul, comp_X]
end

/-- The `(m * n)`-th Dickson polynomial of the first kind is the composition of the `m`-th and
`n`-th. -/
lemma dickson_one_one_mul (m n : ℕ) :
  dickson 1 (1 : R) (m * n) = (dickson 1 1 m).comp (dickson 1 1 n) :=
begin
  have h : (1 : R) = int.cast_ring_hom R (1),
    simp only [ring_hom.eq_int_cast, int.cast_one],
  rw h,
  simp only [← map_dickson (int.cast_ring_hom R), ← map_comp],
  congr' 1,
  apply map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  simp only [map_dickson, map_comp, ring_hom.eq_int_cast, int.cast_one,
    dickson_one_one_eq_chebyshev_T, chebyshev.T_mul, two_mul, ← add_comp],
  simp only [← two_mul, ← comp_assoc],
  apply eval₂_congr rfl rfl,
  rw [comp_assoc],
  apply eval₂_congr rfl _ rfl,
  rw [mul_comp, C_comp, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul,
      inv_of_mul_self, C_1, one_mul]
end

lemma dickson_one_one_comp_comm (m n : ℕ) :
  (dickson 1 (1 : R) m).comp (dickson 1 1 n) = (dickson 1 1 n).comp (dickson 1 1 m) :=
by rw [← dickson_one_one_mul, mul_comm, dickson_one_one_mul]

lemma dickson_one_one_zmod_p (p : ℕ) [fact p.prime] :
  dickson 1 (1 : zmod p) p = X ^ p :=
begin
  -- Recall that `dickson_eval_add_inv` characterises `dickson 1 1 p`
  -- as a polynomial that maps `x + x⁻¹` to `x ^ p + (x⁻¹) ^ p`.
  -- Since `X ^ p` also satisfies this property in characteristic `p`,
  -- we can use a variant on `polynomial.funext` to conclude that these polynomials are equal.
  -- For this argument, we need an arbitrary infinite field of characteristic `p`.
  obtain ⟨K, _, _, H⟩ : ∃ (K : Type) [field K], by exactI ∃ [char_p K p], infinite K,
  { let K := fraction_ring (polynomial (zmod p)),
    let f : zmod p →+* K := (fraction_ring.of _).to_map.comp C,
    haveI : char_p K p := by { rw ← f.char_p_iff_char_p, apply_instance },
    haveI : infinite K :=
    by { apply infinite.of_injective _ (fraction_ring.of _).injective, apply_instance },
    refine ⟨K, _, _, _⟩; apply_instance },
  resetI,
  apply map_injective (zmod.cast_hom (dvd_refl p) K) (ring_hom.injective _),
  rw [map_dickson, map_pow, map_X],
  apply eq_of_infinite_eval_eq,
  -- The two polynomials agree on all `x` of the form `x = y + y⁻¹`.
  apply @set.infinite_mono _ {x : K | ∃ y, x = y + y⁻¹ ∧ y ≠ 0},
  { rintro _ ⟨x, rfl, hx⟩,
    simp only [eval_X, eval_pow, set.mem_set_of_eq, @add_pow_char K _ p,
      dickson_one_one_eval_add_inv _ _ (mul_inv_cancel hx), inv_pow', zmod.cast_hom_apply,
      zmod.cast_one'] },
  -- Now we need to show that the set of such `x` is infinite.
  -- If the set is finite, then we will show that `K` is also finite.
  { intro h,
    rw ← set.infinite_univ_iff at H,
    apply H,
    -- To each `x` of the form `x = y + y⁻¹`
    -- we `bind` the set of `y` that solve the equation `x = y + y⁻¹`.
    -- For every `x`, that set is finite (since it is governed by a quadratic equation).
    -- For the moment, we claim that all these sets together cover `K`.
    suffices : (set.univ : set K) =
      {x : K | ∃ (y : K), x = y + y⁻¹ ∧ y ≠ 0} >>= (λ x, {y | x = y + y⁻¹ ∨ y = 0}),
    { rw this, clear this,
      refine h.bUnion (λ x hx, _),
      -- The following quadratic polynomial has as solutions the `y` for which `x = y + y⁻¹`.
      let φ : polynomial K := X ^ 2 - C x * X + 1,
      have hφ : φ ≠ 0,
      { intro H,
        have : φ.eval 0 = 0, by rw [H, eval_zero],
        simpa [eval_X, eval_one, eval_pow, eval_sub, sub_zero, eval_add,
          eval_mul, mul_zero, sq, zero_add, one_ne_zero] },
      classical,
      convert (φ.roots ∪ {0}).to_finset.finite_to_set using 1,
      ext1 y,
      simp only [multiset.mem_to_finset, set.mem_set_of_eq, finset.mem_coe, multiset.mem_union,
        mem_roots hφ, is_root, eval_add, eval_sub, eval_pow, eval_mul, eval_X, eval_C, eval_one,
        multiset.mem_singleton, multiset.singleton_eq_singleton],
      by_cases hy : y = 0,
      { simp only [hy, eq_self_iff_true, or_true] },
      apply or_congr _ iff.rfl,
      rw [← mul_left_inj' hy, eq_comm, ← sub_eq_zero, add_mul, inv_mul_cancel hy],
      apply eq_iff_eq_cancel_right.mpr,
      ring },
    -- Finally, we prove the claim that our finite union of finite sets covers all of `K`.
    { apply (set.eq_univ_of_forall _).symm,
      intro x,
      simp only [exists_prop, set.mem_Union, set.bind_def, ne.def, set.mem_set_of_eq],
      by_cases hx : x = 0,
      { simp only [hx, and_true, eq_self_iff_true, inv_zero, or_true],
        exact ⟨_, 1, rfl, one_ne_zero⟩ },
      { simp only [hx, or_false, exists_eq_right],
        exact ⟨_, rfl, hx⟩ } } }
end

lemma dickson_one_one_char_p (p : ℕ) [fact p.prime] [char_p R p] :
  dickson 1 (1 : R) p = X ^ p :=
begin
  have h : (1 : R) = zmod.cast_hom (dvd_refl p) R (1),
    simp only [zmod.cast_hom_apply, zmod.cast_one'],
  rw [h, ← map_dickson (zmod.cast_hom (dvd_refl p) R), dickson_one_one_zmod_p, map_pow, map_X]
end

end dickson

end polynomial


import ring_theory.unique_factorization_domain ring_theory.int.basic number_theory.divisors algebra.squarefree

section squarefree

variables {R : Type*}

/-- An element of a monoid is squarefree if the only squares that
  divide it are the squares of units. -/
def squarefree' [monoid R] (r : R) : Prop := ∀ x : R, x * x ∣ r → is_unit x

namespace multiplicity

variables [comm_monoid R] [decidable_rel (has_dvd.dvd : R → R → Prop)]

lemma squarefree_iff_multiplicity_le_one' (r : R) :
  squarefree r ↔ ∀ x : R, multiplicity x r ≤ 1 ∨ is_unit x :=
begin
  refine forall_congr (λ a, _),
  rw ← sq,
  rw pow_dvd_iff_le_multiplicity,
  rw or_iff_not_imp_left,
  rw not_le,
  rw imp_congr,
  { convert enat.add_one_le_iff_lt (enat.coe_ne_top _),
    norm_cast},
  { refl},
end

example : 1 + 1 = 2 := by linarith -- by norm_num

end multiplicity

open nat

#check sq_mul_squarefree_of_pos

lemma sq_mul_squarefree_of_pos' {n : ℕ} (h : 0 < n) :
  ∃ a b : ℕ, (b + 1) ^ 2 * (a + 1) = n ∧ squarefree (a + 1) :=
begin
  obtain ⟨a₁, b₁, ha₁, hb₁, hab₁, ha₂⟩ := sq_mul_squarefree_of_pos h,
  refine ⟨a₁.pred, b₁.pred, _, _⟩;
  simpa only [add_one, succ_pred_eq_of_pos, ha₁, hb₁],
end

end squarefree

section finite_groups
/-!
# Finite Groups
-/

variables {G : Type*} [group G]

-- This one is a beast

open subgroup

#check submonoid.fg_iff
#check le_antisymm

/-- A subgroup is finitely generated if and only if it is finitely generated as a submonoid. -/
lemma fg_iff_submonoid_fg' (P : subgroup G) : P.fg ↔ P.to_submonoid.fg :=
begin
  split,
  { rintro ⟨S, rfl⟩,
    rw submonoid.fg_iff,
    refine ⟨S ∪ S⁻¹, (subgroup.closure_to_submonoid _).symm, S.finite_to_set.union S.finite_to_set.inv⟩,
  },
  { rintro ⟨S, hS⟩,
    refine ⟨S, le_antisymm _ _⟩,
    { rw [closure_le, ← coe_to_submonoid, ← hS],
      exact submonoid.subset_closure,
    },
    { rw [← subgroup.to_submonoid_le, ← hS, submonoid.closure_le],
      exact subgroup.subset_closure,
    }
  },
end

/-!
# NB!
What we just proved is extremely useful, we can use several variants of it, for
example;
-/

#check subgroup.fg_iff_submonoid_fg -- **
#check add_subgroup.fg_iff_add_submonoid.fg -- **

-- ** these two are the same as Lean knows that `add_groups` are `groups`

end finite_groups


import tactic

example (P : Prop) : P → P :=
begin
intros grzes,
exact grzes,
end

example (P Q : Prop) : P ∧ Q → P :=
begin
rintros ⟨lewy_grzes, _⟩,
-- cases grzes with lewy_grzes prawy_grzes,
exact lewy_grzes,
end

def P (n : ℕ) : Prop := ∀m>0,m∣n → (m = 1 ∨ m = n)

theorem yo (n : ℕ) (hn : 0 < n) : (n + 1) ∣ (n^2 + 1) ↔ n = 1 :=
begin
  split,
  { rintro ⟨c, hc⟩,
    have h1 : (n : ℤ)^2 - 1 = (n + 1) * (n - 1) := by ring,
    zify at hc,
    have h2 : (n : ℤ) + 1 ∣ 2,
    { use c - (n - 1),
      rw [ mul_sub, ← hc, ← h1 ],
      ring },
    have h3 : (n : ℤ) + 1 ≤ 2 := int.le_of_dvd zero_lt_two h2,
    have h4 : n + 1 ≤ 2,
    exact_mod_cast h3,
    linarith },
  { rintro rfl,
    norm_num },
end


import game.sup_inf.level02
import data.real.basic

namespace xena -- hide

/-
# Chapter 3 : Sup and Inf

## Level 3
-/

/-
This level asks you to prove what the supremum of a given open set is.
-/

definition reals_lt_59 := {x : ℝ | x < 59}

-- begin hide
-- The next result must be placed in the sidebar axioms.
theorem helper_lemma (x y : ℝ) (H : x < y) : x < (x + y) / 2 ∧ (x + y) / 2 < y :=
begin
  have two_ge_zero : (2 : ℝ) ≥ 0 := by norm_num,
  split,
  { apply lt_of_mul_lt_mul_right _ two_ge_zero,
    rw [mul_two,div_mul_cancel],
    apply add_lt_add_left H,
    norm_num},
  { apply lt_of_mul_lt_mul_right _ two_ge_zero,
    rw [div_mul_cancel,mul_two],
    apply add_lt_add_right H,
    norm_num,
  },
end
-- end hide

/- Lemma
The LUB of...
-/
lemma lub_of_open_set : is_lub reals_lt_59 59 :=
begin
  split,
  { intros s Hs,
    exact le_of_lt Hs,
  },
  { intros y Hy,
    apply le_of_not_gt,
    intro H,
    let s := (y + 59) / 2,
    have H1 : y < s := (helper_lemma _ _ H).1,
    have H2 : s < 59 := (helper_lemma _ _ H).2,
--    unfold is_upper_bound at Hy,
    have H1' := Hy s H2,
    exact not_le_of_lt H1 H1', --of_not_gt
  }
end

end xena -- hide


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov,
Neil Strickland, Aaron Anderson
-/

import algebra.hom.group

/-!
# Divisibility

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

This file defines the basics of the divisibility relation in the context of `(comm_)` `monoid`s.

## Main definitions

 * `monoid.has_dvd`

## Implementation notes

The divisibility relation is defined for all monoids, and as such, depends on the order of
  multiplication if the monoid is not commutative. There are two possible conventions for
  divisibility in the noncommutative context, and this relation follows the convention for ordinals,
  so `a | b` is defined as `∃ c, b = a * c`.

## Tags

divisibility, divides
-/

variables {α : Type*}

section semigroup

variables [semigroup α] {a b c : α}

/-- There are two possible conventions for divisibility, which coincide in a `comm_monoid`.
    This matches the convention for ordinals. -/
@[priority 100]
instance semigroup_has_dvd : has_dvd α :=
has_dvd.mk (λ a b, ∃ c, b = a * c)

-- TODO: this used to not have `c` explicit, but that seems to be important
--       for use with tactics, similar to `exists.intro`
theorem dvd.intro (c : α) (h : a * c = b) : a ∣ b :=
exists.intro c h^.symm

alias dvd.intro ← dvd_of_mul_right_eq

theorem exists_eq_mul_right_of_dvd (h : a ∣ b) : ∃ c, b = a * c := h

theorem dvd.elim {P : Prop} {a b : α} (H₁ : a ∣ b) (H₂ : ∀ c, b = a * c → P) : P :=
exists.elim H₁ H₂

local attribute [simp] mul_assoc mul_comm mul_left_comm

@[trans] theorem dvd_trans : a ∣ b → b ∣ c → a ∣ c
| ⟨d, h₁⟩ ⟨e, h₂⟩ := ⟨d * e, h₁ ▸ h₂.trans $ mul_assoc a d e⟩

alias dvd_trans ← has_dvd.dvd.trans

instance : is_trans α (∣) := ⟨λ a b c, dvd_trans⟩

@[simp] theorem dvd_mul_right (a b : α) : a ∣ a * b := dvd.intro b rfl

theorem dvd_mul_of_dvd_left (h : a ∣ b) (c : α) : a ∣ b * c :=
h.trans (dvd_mul_right b c)

alias dvd_mul_of_dvd_left ← has_dvd.dvd.mul_right

theorem dvd_of_mul_right_dvd (h : a * b ∣ c) : a ∣ c :=
(dvd_mul_right a b).trans h

section map_dvd

variables {M N : Type*} [monoid M] [monoid N]

lemma map_dvd {F : Type*} [mul_hom_class F M N] (f : F) {a b} : a ∣ b → f a ∣ f b
| ⟨c, h⟩ := ⟨f c, h.symm ▸ map_mul f a c⟩

lemma mul_hom.map_dvd (f : M →ₙ* N) {a b} : a ∣ b → f a ∣ f b := map_dvd f

lemma monoid_hom.map_dvd (f : M →* N) {a b} : a ∣ b → f a ∣ f b := map_dvd f

end map_dvd

end semigroup

section monoid

variables [monoid α]

@[refl, simp] theorem dvd_refl (a : α) : a ∣ a := dvd.intro 1 (mul_one a)
theorem dvd_rfl : ∀ {a : α}, a ∣ a := dvd_refl
instance : is_refl α (∣) := ⟨dvd_refl⟩

theorem one_dvd (a : α) : 1 ∣ a := dvd.intro a (one_mul a)

end monoid

section comm_semigroup

variables [comm_semigroup α] {a b c : α}

theorem dvd.intro_left (c : α) (h : c * a = b) : a ∣ b :=
dvd.intro _ (begin rewrite mul_comm at h, apply h end)

alias dvd.intro_left ← dvd_of_mul_left_eq

theorem exists_eq_mul_left_of_dvd (h : a ∣ b) : ∃ c, b = c * a :=
dvd.elim h (assume c, assume H1 : b = a * c, exists.intro c (eq.trans H1 (mul_comm a c)))

lemma dvd_iff_exists_eq_mul_left : a ∣ b ↔ ∃ c, b = c * a :=
⟨exists_eq_mul_left_of_dvd, by { rintro ⟨c, rfl⟩, exact ⟨c, mul_comm _ _⟩, }⟩

theorem dvd.elim_left {P : Prop} (h₁ : a ∣ b) (h₂ : ∀ c, b = c * a → P) : P :=
exists.elim (exists_eq_mul_left_of_dvd h₁) (assume c, assume h₃ : b = c * a, h₂ c h₃)

@[simp] theorem dvd_mul_left (a b : α) : a ∣ b * a := dvd.intro b (mul_comm a b)

theorem dvd_mul_of_dvd_right (h : a ∣ b) (c : α) : a ∣ c * b :=
begin rw mul_comm, exact h.mul_right _ end

alias dvd_mul_of_dvd_right ← has_dvd.dvd.mul_left

local attribute [simp] mul_assoc mul_comm mul_left_comm

theorem mul_dvd_mul : ∀ {a b c d : α}, a ∣ b → c ∣ d → a * c ∣ b * d
| a ._ c ._ ⟨e, rfl⟩ ⟨f, rfl⟩ := ⟨e * f, by simp⟩

theorem dvd_of_mul_left_dvd (h : a * b ∣ c) : b ∣ c :=
dvd.elim h (λ d ceq, dvd.intro (a * d) (by simp [ceq]))

end comm_semigroup

section comm_monoid

variables [comm_monoid α] {a b : α}

theorem mul_dvd_mul_left (a : α) {b c : α} (h : b ∣ c) : a * b ∣ a * c :=
mul_dvd_mul (dvd_refl a) h

theorem mul_dvd_mul_right (h : a ∣ b) (c : α) : a * c ∣ b * c :=
mul_dvd_mul h (dvd_refl c)

theorem pow_dvd_pow_of_dvd {a b : α} (h : a ∣ b) : ∀ n : ℕ, a ^ n ∣ b ^ n
| 0     := by rw [pow_zero, pow_zero]
| (n+1) := by { rw [pow_succ, pow_succ], exact mul_dvd_mul h (pow_dvd_pow_of_dvd n) }

end comm_monoid