import ..lectures.love01_definitions_and_statements_demo

/-! # LoVe Homework 1: Definitions and Statements

Homework must be done individually.

Replace the placeholders (e.g., `:= sorry`) with your solutions. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (1 point): Fibonacci Numbers

1.1 (1 point). Define the function `fib` that computes the Fibonacci
numbers. -/

def fib : ℕ → ℕ :=
sorry

/-! 1.2 (0 points). Check that your function works as expected. -/

#eval fib 0   -- expected: 0
#eval fib 1   -- expected: 1
#eval fib 2   -- expected: 1
#eval fib 3   -- expected: 2
#eval fib 4   -- expected: 3
#eval fib 5   -- expected: 5
#eval fib 6   -- expected: 8
#eval fib 7   -- expected: 13
#eval fib 8   -- expected: 21

/-! # Question 2 (5 points): Lists - Singletons and Flatten

2.1 (1 point). Define the function `singletons` that turns a list into a list of
singleton lists, where the singleton at each position contains the element in
that position in the original list.

For instance, `singletons [1, 2, 3, 4]` should evaluate to
`[[1], [2], [3], [4]]`.
-/

def singletons {α : Type} : list α → list (list α) :=
sorry

/-! 2.2 (2 points). Define the function `flatten` that takes a list of lists and
"flattens" it into a single list containing all of the elements of the inner
lists.

For example, `flatten [[1], [2, 3], [], [4]]` should evaluate to `[1, 2, 3, 4]`.

You should not call any form of append function (`(++)`, `list.append`, etc.) in
your solution.
-/

def flatten {α : Type} : list (list α) → list α :=
sorry

/-! 2.3 (1 point). State a theorem that says that applying `singletons` and then
    `flatten` to any list gives the same list you started with.
-/

-- Replace `true` with your lemma statement. No need to fill in the `sorry`!
lemma flatten_singletons : true := sorry

/-! 2.4 (1 point). Is it true that applying `flatten` and then `singletons` to a
list gives you back the same list you started with? If so, explain why; if not,
provide an example of a list for which this claim does not hold.
-/

/-
Write your response to part 4 here.
-/

/-! ## Question 3 (5 points): λ-Terms

3.1 (2 points). Complete the following definitions, by replacing the `sorry`
placeholders by terms of the expected type.

Please use reasonable names for the bound variables, e.g., `a : α`, `b : β`,
`c : γ`.

Hint: A procedure for doing so systematically is described in Section 1.1.4 of
the Hitchhiker's Guide. As explained there, you can use `_` as a placeholder
while constructing a term. By hovering over `_`, you will see the current
logical context. -/

def B : (α → β) → (γ → α) → γ → β :=
sorry

def S : (α → β → γ) → (α → β) → α → γ :=
sorry

def more_nonsense : (γ → (α → β) → α) → γ → β → α :=
sorry

def even_more_nonsense : (α → α → β) → (β → γ) → α → β → γ :=
sorry

/-! 3.2 (1 point). Complete the following definition.

This one looks more difficult, but it should be fairly straightforward if you
follow the procedure described in the Hitchhiker's Guide.

Note: Peirce is pronounced like the English word "purse". -/

def weak_peirce : ((((α → β) → α) → α) → β) → β :=
sorry

/-! 3.3 (2 points). Show the typing derivation for your definition of `S` above,
using ASCII or Unicode art. You might find the characters `–` (to draw
horizontal bars) and `⊢` useful.

Feel free to introduce abbreviations to avoid repeating large contexts `C`. -/

-- write your solution here

end LoVe


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Manuel Candales
-/
import analysis.inner_product_space.projection
import algebra.quadratic_discriminant

/-!
# Euclidean spaces

This file makes some definitions and proves very basic geometrical
results about real inner product spaces and Euclidean affine spaces.
Results about real inner product spaces that involve the norm and
inner product but not angles generally go in
`analysis.normed_space.inner_product`.  Results with longer
proofs or more geometrical content generally go in separate files.

## Main definitions

* `euclidean_geometry.orthogonal_projection` is the orthogonal
  projection of a point onto an affine subspace.

* `euclidean_geometry.reflection` is the reflection of a point in an
  affine subspace.

## Implementation notes

To declare `P` as the type of points in a Euclidean affine space with
`V` as the type of vectors, use
`[normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]`.
This works better with `out_param` to make
`V` implicit in most cases than having a separate type alias for
Euclidean affine spaces.

Rather than requiring Euclidean affine spaces to be finite-dimensional
(as in the definition on Wikipedia), this is specified only for those
theorems that need it.

## References

* https://en.wikipedia.org/wiki/Euclidean_space

-/

noncomputable theory
open_locale big_operators
open_locale classical
open_locale real_inner_product_space

namespace euclidean_geometry
/-!
### Geometrical results on Euclidean affine spaces

This section develops some geometrical definitions and results on
Euclidean affine spaces.
-/

variables {V : Type*} {P : Type*}
variables [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P]
variables [normed_add_torsor V P]
include V

/-- The midpoint of the segment AB is the same distance from A as it is from B. -/
lemma dist_left_midpoint_eq_dist_right_midpoint (p1 p2 : P) :
  dist p1 (midpoint ℝ p1 p2) = dist p2 (midpoint ℝ p1 p2) :=
by rw [dist_left_midpoint p1 p2, dist_right_midpoint p1 p2]

/-- The inner product of two vectors given with `weighted_vsub`, in
terms of the pairwise distances. -/
lemma inner_weighted_vsub {ι₁ : Type*} {s₁ : finset ι₁} {w₁ : ι₁ → ℝ} (p₁ : ι₁ → P)
    (h₁ : ∑ i in s₁, w₁ i = 0) {ι₂ : Type*} {s₂ : finset ι₂} {w₂ : ι₂ → ℝ} (p₂ : ι₂ → P)
    (h₂ : ∑ i in s₂, w₂ i = 0) :
  ⟪s₁.weighted_vsub p₁ w₁, s₂.weighted_vsub p₂ w₂⟫ =
    (-∑ i₁ in s₁, ∑ i₂ in s₂,
      w₁ i₁ * w₂ i₂ * (dist (p₁ i₁) (p₂ i₂) * dist (p₁ i₁) (p₂ i₂))) / 2 :=
begin
  rw [finset.weighted_vsub_apply, finset.weighted_vsub_apply,
      inner_sum_smul_sum_smul_of_sum_eq_zero _ h₁ _ h₂],
  simp_rw [vsub_sub_vsub_cancel_right],
  rcongr i₁ i₂; rw dist_eq_norm_vsub V (p₁ i₁) (p₂ i₂)
end

/-- The distance between two points given with `affine_combination`,
in terms of the pairwise distances between the points in that
combination. -/

/-- Suppose that `c₁` is equidistant from `p₁` and `p₂`, and the same
applies to `c₂`.  Then the vector between `c₁` and `c₂` is orthogonal
to that between `p₁` and `p₂`.  (In two dimensions, this says that the
diagonals of a kite are orthogonal.) -/
lemma inner_vsub_vsub_of_dist_eq_of_dist_eq {c₁ c₂ p₁ p₂ : P} (hc₁ : dist p₁ c₁ = dist p₂ c₁)
  (hc₂ : dist p₁ c₂ = dist p₂ c₂) : ⟪c₂ -ᵥ c₁, p₂ -ᵥ p₁⟫ = 0 :=
begin
  have h : ⟪(c₂ -ᵥ c₁) + (c₂ -ᵥ c₁), p₂ -ᵥ p₁⟫ = 0,
  { conv_lhs { congr, congr, rw ←vsub_sub_vsub_cancel_right c₂ c₁ p₁,
               skip, rw ←vsub_sub_vsub_cancel_right c₂ c₁ p₂ },
    rw [sub_add_sub_comm, inner_sub_left],
    conv_lhs { congr, rw ←vsub_sub_vsub_cancel_right p₂ p₁ c₂,
               skip, rw ←vsub_sub_vsub_cancel_right p₂ p₁ c₁ },
    rw [dist_comm p₁, dist_comm p₂, dist_eq_norm_vsub V _ p₁,
        dist_eq_norm_vsub V _ p₂, ←real_inner_add_sub_eq_zero_iff] at hc₁ hc₂,
    simp_rw [←neg_vsub_eq_vsub_rev c₁, ←neg_vsub_eq_vsub_rev c₂, sub_neg_eq_add,
             neg_add_eq_sub, hc₁, hc₂, sub_zero] },
  simpa [inner_add_left, ←mul_two, (by norm_num : (2 : ℝ) ≠ 0)] using h
end

/-- The squared distance between points on a line (expressed as a
multiple of a fixed vector added to a point) and another point,
expressed as a quadratic. -/
lemma dist_smul_vadd_sq (r : ℝ) (v : V) (p₁ p₂ : P) :
  dist (r • v +ᵥ p₁) p₂ * dist (r • v +ᵥ p₁) p₂ =
    ⟪v, v⟫ * r * r + 2 * ⟪v, p₁ -ᵥ p₂⟫ * r + ⟪p₁ -ᵥ p₂, p₁ -ᵥ p₂⟫ :=
begin
  rw [dist_eq_norm_vsub V _ p₂, ←real_inner_self_eq_norm_mul_norm, vadd_vsub_assoc,
    real_inner_add_add_self, real_inner_smul_left, real_inner_smul_left, real_inner_smul_right],
  ring
end

/-- The condition for two points on a line to be equidistant from
another point. -/
lemma dist_smul_vadd_eq_dist {v : V} (p₁ p₂ : P) (hv : v ≠ 0) (r : ℝ) :
  dist (r • v +ᵥ p₁) p₂ = dist p₁ p₂ ↔ (r = 0 ∨ r = -2 * ⟪v, p₁ -ᵥ p₂⟫ / ⟪v, v⟫) :=
begin
  conv_lhs { rw [←mul_self_inj_of_nonneg dist_nonneg dist_nonneg, dist_smul_vadd_sq,
                 ←sub_eq_zero, add_sub_assoc, dist_eq_norm_vsub V p₁ p₂,
                 ←real_inner_self_eq_norm_mul_norm, sub_self] },
  have hvi : ⟪v, v⟫ ≠ 0, by simpa using hv,
  have hd : discrim ⟪v, v⟫ (2 * ⟪v, p₁ -ᵥ p₂⟫) 0 =
    (2 * ⟪v, p₁ -ᵥ p₂⟫) * (2 * ⟪v, p₁ -ᵥ p₂⟫),
  { rw discrim, ring },
  rw [quadratic_eq_zero_iff hvi hd, add_left_neg, zero_div, neg_mul_eq_neg_mul,
      ←mul_sub_right_distrib, sub_eq_add_neg, ←mul_two, mul_assoc, mul_div_assoc,
      mul_div_mul_left, mul_div_assoc],
  norm_num
end

open affine_subspace finite_dimensional

/-- Distances `r₁` `r₂` of `p` from two different points `c₁` `c₂` determine at
most two points `p₁` `p₂` in a two-dimensional subspace containing those points
(two circles intersect in at most two points). -/
lemma eq_of_dist_eq_of_dist_eq_of_mem_of_finrank_eq_two {s : affine_subspace ℝ P}
  [finite_dimensional ℝ s.direction] (hd : finrank ℝ s.direction = 2) {c₁ c₂ p₁ p₂ p : P}
  (hc₁s : c₁ ∈ s) (hc₂s : c₂ ∈ s) (hp₁s : p₁ ∈ s) (hp₂s : p₂ ∈ s) (hps : p ∈ s) {r₁ r₂ : ℝ}
  (hc : c₁ ≠ c₂) (hp : p₁ ≠ p₂) (hp₁c₁ : dist p₁ c₁ = r₁) (hp₂c₁ : dist p₂ c₁ = r₁)
  (hpc₁ : dist p c₁ = r₁) (hp₁c₂ : dist p₁ c₂ = r₂) (hp₂c₂ : dist p₂ c₂ = r₂)
  (hpc₂ : dist p c₂ = r₂) : p = p₁ ∨ p = p₂ :=
begin
  have ho : ⟪c₂ -ᵥ c₁, p₂ -ᵥ p₁⟫ = 0 :=
    inner_vsub_vsub_of_dist_eq_of_dist_eq (hp₁c₁.trans hp₂c₁.symm) (hp₁c₂.trans hp₂c₂.symm),
  have hop : ⟪c₂ -ᵥ c₁, p -ᵥ p₁⟫ = 0 :=
    inner_vsub_vsub_of_dist_eq_of_dist_eq (hp₁c₁.trans hpc₁.symm) (hp₁c₂.trans hpc₂.symm),
  let b : fin 2 → V := ![c₂ -ᵥ c₁, p₂ -ᵥ p₁],
  have hb : linear_independent ℝ b,
  { refine linear_independent_of_ne_zero_of_inner_eq_zero _ _,
    { intro i,
      fin_cases i; simp [b, hc.symm, hp.symm], },
    { intros i j hij,
      fin_cases i; fin_cases j; try { exact false.elim (hij rfl) },
      { exact ho },
      { rw real_inner_comm, exact ho } } },
  have hbs : submodule.span ℝ (set.range b) = s.direction,
  { refine eq_of_le_of_finrank_eq _ _,
    { rw [submodule.span_le, set.range_subset_iff],
      intro i,
      fin_cases i,
      { exact vsub_mem_direction hc₂s hc₁s },
      { exact vsub_mem_direction hp₂s hp₁s } },
    { rw [finrank_span_eq_card hb, fintype.card_fin, hd] } },
  have hv : ∀ v ∈ s.direction, ∃ t₁ t₂ : ℝ, v = t₁ • (c₂ -ᵥ c₁) + t₂ • (p₂ -ᵥ p₁),
  { intros v hv,
    have hr : set.range b = {c₂ -ᵥ c₁, p₂ -ᵥ p₁},
    { have hu : (finset.univ : finset (fin 2)) = {0, 1}, by dec_trivial,
      rw [←fintype.coe_image_univ, hu],
      simp,
      refl },
    rw [←hbs, hr, submodule.mem_span_insert] at hv,
    rcases hv with ⟨t₁, v', hv', hv⟩,
    rw submodule.mem_span_singleton at hv',
    rcases hv' with ⟨t₂, rfl⟩,
    exact ⟨t₁, t₂, hv⟩ },
  rcases hv (p -ᵥ p₁) (vsub_mem_direction hps hp₁s) with ⟨t₁, t₂, hpt⟩,
  simp only [hpt, inner_add_right, inner_smul_right, ho, mul_zero, add_zero, mul_eq_zero,
             inner_self_eq_zero, vsub_eq_zero_iff_eq, hc.symm, or_false] at hop,
  rw [hop, zero_smul, zero_add, ←eq_vadd_iff_vsub_eq] at hpt,
  subst hpt,
  have hp' : (p₂ -ᵥ p₁ : V) ≠ 0, { simp [hp.symm] },
  have hp₂ : dist ((1 : ℝ) • (p₂ -ᵥ p₁) +ᵥ p₁) c₁ = r₁, { simp [hp₂c₁] },
  rw [←hp₁c₁, dist_smul_vadd_eq_dist _ _ hp'] at hpc₁ hp₂,
  simp only [one_ne_zero, false_or] at hp₂,
  rw hp₂.symm at hpc₁,
  cases hpc₁; simp [hpc₁]
end

/-- Distances `r₁` `r₂` of `p` from two different points `c₁` `c₂` determine at
most two points `p₁` `p₂` in two-dimensional space (two circles intersect in at
most two points). -/
lemma eq_of_dist_eq_of_dist_eq_of_finrank_eq_two [finite_dimensional ℝ V] (hd : finrank ℝ V = 2)
  {c₁ c₂ p₁ p₂ p : P} {r₁ r₂ : ℝ} (hc : c₁ ≠ c₂) (hp : p₁ ≠ p₂) (hp₁c₁ : dist p₁ c₁ = r₁)
  (hp₂c₁ : dist p₂ c₁ = r₁) (hpc₁ : dist p c₁ = r₁) (hp₁c₂ : dist p₁ c₂ = r₂)
  (hp₂c₂ : dist p₂ c₂ = r₂) (hpc₂ : dist p c₂ = r₂) : p = p₁ ∨ p = p₂ :=
begin
  have hd' : finrank ℝ (⊤ : affine_subspace ℝ P).direction = 2,
  { rw [direction_top, finrank_top],
    exact hd },
  exact eq_of_dist_eq_of_dist_eq_of_mem_of_finrank_eq_two hd'
    (mem_top ℝ V _) (mem_top ℝ V _) (mem_top ℝ V _) (mem_top ℝ V _) (mem_top ℝ V _)
    hc hp hp₁c₁ hp₂c₁ hpc₁ hp₁c₂ hp₂c₂ hpc₂
end

variables {V}

/-- The orthogonal projection of a point onto a nonempty affine
subspace, whose direction is complete, as an unbundled function.  This
definition is only intended for use in setting up the bundled version
`orthogonal_projection` and should not be used once that is
defined. -/
def orthogonal_projection_fn (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction]
  (p : P) : P :=
classical.some $ inter_eq_singleton_of_nonempty_of_is_compl
  (nonempty_subtype.mp ‹_›)
  (mk'_nonempty p s.directionᗮ)
  begin
    rw direction_mk' p s.directionᗮ,
    exact submodule.is_compl_orthogonal_of_complete_space,
  end

/-- The intersection of the subspace and the orthogonal subspace
through the given point is the `orthogonal_projection_fn` of that
point onto the subspace.  This lemma is only intended for use in
setting up the bundled version and should not be used once that is
defined. -/
lemma inter_eq_singleton_orthogonal_projection_fn {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  (s : set P) ∩ (mk' p s.directionᗮ) = {orthogonal_projection_fn s p} :=
classical.some_spec $ inter_eq_singleton_of_nonempty_of_is_compl
  (nonempty_subtype.mp ‹_›)
  (mk'_nonempty p s.directionᗮ)
  begin
    rw direction_mk' p s.directionᗮ,
    exact submodule.is_compl_orthogonal_of_complete_space
  end

/-- The `orthogonal_projection_fn` lies in the given subspace.  This
lemma is only intended for use in setting up the bundled version and
should not be used once that is defined. -/
lemma orthogonal_projection_fn_mem {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) : orthogonal_projection_fn s p ∈ s :=
begin
  rw [←mem_coe, ←set.singleton_subset_iff, ←inter_eq_singleton_orthogonal_projection_fn],
  exact set.inter_subset_left _ _
end

/-- The `orthogonal_projection_fn` lies in the orthogonal
subspace.  This lemma is only intended for use in setting up the
bundled version and should not be used once that is defined. -/
lemma orthogonal_projection_fn_mem_orthogonal {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  orthogonal_projection_fn s p ∈ mk' p s.directionᗮ :=
begin
  rw [←mem_coe, ←set.singleton_subset_iff, ←inter_eq_singleton_orthogonal_projection_fn],
  exact set.inter_subset_right _ _
end

/-- Subtracting `p` from its `orthogonal_projection_fn` produces a
result in the orthogonal direction.  This lemma is only intended for
use in setting up the bundled version and should not be used once that
is defined. -/
lemma orthogonal_projection_fn_vsub_mem_direction_orthogonal {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  orthogonal_projection_fn s p -ᵥ p ∈ s.directionᗮ :=
direction_mk' p s.directionᗮ ▸
  vsub_mem_direction (orthogonal_projection_fn_mem_orthogonal p) (self_mem_mk' _ _)

local attribute [instance] affine_subspace.to_add_torsor

/-- The orthogonal projection of a point onto a nonempty affine
subspace, whose direction is complete. The corresponding linear map
(mapping a vector to the difference between the projections of two
points whose difference is that vector) is the `orthogonal_projection`
for real inner product spaces, onto the direction of the affine
subspace being projected onto. -/
def orthogonal_projection (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] :
  P →ᵃ[ℝ] s :=
{ to_fun := λ p, ⟨orthogonal_projection_fn s p, orthogonal_projection_fn_mem p⟩,
  linear := orthogonal_projection s.direction,
  map_vadd' := λ p v, begin
    have hs : ((orthogonal_projection s.direction) v : V) +ᵥ orthogonal_projection_fn s p ∈ s :=
      vadd_mem_of_mem_direction (orthogonal_projection s.direction v).2
                                (orthogonal_projection_fn_mem p),
    have ho : ((orthogonal_projection s.direction) v : V) +ᵥ orthogonal_projection_fn s p ∈
      mk' (v +ᵥ p) s.directionᗮ,
    { rw [←vsub_right_mem_direction_iff_mem (self_mem_mk' _ _) _, direction_mk',
          vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, add_comm, add_sub_assoc],
      refine submodule.add_mem _ (orthogonal_projection_fn_vsub_mem_direction_orthogonal p) _,
      rw submodule.mem_orthogonal',
      intros w hw,
      rw [←neg_sub, inner_neg_left, orthogonal_projection_inner_eq_zero _ w hw, neg_zero], },
    have hm : ((orthogonal_projection s.direction) v : V) +ᵥ orthogonal_projection_fn s p ∈
      ({orthogonal_projection_fn s (v +ᵥ p)} : set P),
    { rw ←inter_eq_singleton_orthogonal_projection_fn (v +ᵥ p),
      exact set.mem_inter hs ho },
    rw set.mem_singleton_iff at hm,
    ext,
    exact hm.symm
  end }

@[simp] lemma orthogonal_projection_fn_eq {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  orthogonal_projection_fn s p = orthogonal_projection s p :=
rfl

/-- The linear map corresponding to `orthogonal_projection`. -/
@[simp] lemma orthogonal_projection_linear {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] :
  (orthogonal_projection s).linear = _root_.orthogonal_projection s.direction :=
rfl

/-- The intersection of the subspace and the orthogonal subspace
through the given point is the `orthogonal_projection` of that point
onto the subspace. -/
lemma inter_eq_singleton_orthogonal_projection {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  (s : set P) ∩ (mk' p s.directionᗮ) = {orthogonal_projection s p} :=
begin
  rw ←orthogonal_projection_fn_eq,
  exact inter_eq_singleton_orthogonal_projection_fn p
end

/-- The `orthogonal_projection` lies in the given subspace. -/
lemma orthogonal_projection_mem {s : affine_subspace ℝ P} [nonempty s] [complete_space s.direction]
  (p : P) : ↑(orthogonal_projection s p) ∈ s :=
(orthogonal_projection s p).2

/-- The `orthogonal_projection` lies in the orthogonal subspace. -/
lemma orthogonal_projection_mem_orthogonal (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  ↑(orthogonal_projection s p) ∈ mk' p s.directionᗮ :=
orthogonal_projection_fn_mem_orthogonal p

/-- Subtracting a point in the given subspace from the
`orthogonal_projection` produces a result in the direction of the
given subspace. -/
lemma orthogonal_projection_vsub_mem_direction {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p1 : P} (p2 : P) (hp1 : p1 ∈ s) :
  ↑(orthogonal_projection s p2 -ᵥ ⟨p1, hp1⟩ : s.direction) ∈ s.direction :=
(orthogonal_projection s p2 -ᵥ ⟨p1, hp1⟩ : s.direction).2

/-- Subtracting the `orthogonal_projection` from a point in the given
subspace produces a result in the direction of the given subspace. -/
lemma vsub_orthogonal_projection_mem_direction {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p1 : P} (p2 : P) (hp1 : p1 ∈ s) :
  ↑((⟨p1, hp1⟩ : s) -ᵥ orthogonal_projection s p2 : s.direction) ∈ s.direction :=
((⟨p1, hp1⟩ : s) -ᵥ orthogonal_projection s p2 : s.direction).2

/-- A point equals its orthogonal projection if and only if it lies in
the subspace. -/
lemma orthogonal_projection_eq_self_iff {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} :
  ↑(orthogonal_projection s p) = p ↔ p ∈ s :=
begin
  split,
  { exact λ h, h ▸ orthogonal_projection_mem p },
  { intro h,
    have hp : p ∈ ((s : set P) ∩ mk' p s.directionᗮ) := ⟨h, self_mem_mk' p _⟩,
    rw [inter_eq_singleton_orthogonal_projection p] at hp,
    symmetry,
    exact hp }
end

@[simp] lemma orthogonal_projection_mem_subspace_eq_self {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : s) :
  orthogonal_projection s p = p :=
begin
  ext,
  rw orthogonal_projection_eq_self_iff,
  exact p.2
end

/-- Orthogonal projection is idempotent. -/
@[simp] lemma orthogonal_projection_orthogonal_projection (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  orthogonal_projection s (orthogonal_projection s p) = orthogonal_projection s p :=
begin
  ext,
  rw orthogonal_projection_eq_self_iff,
  exact orthogonal_projection_mem p,
end

lemma eq_orthogonal_projection_of_eq_subspace {s s' : affine_subspace ℝ P} [nonempty s]
  [nonempty s'] [complete_space s.direction] [complete_space s'.direction] (h : s = s') (p : P) :
  (orthogonal_projection s p : P) = (orthogonal_projection s' p : P) :=
begin
  change orthogonal_projection_fn s p = orthogonal_projection_fn s' p,
  congr,
  exact h
end

/-- The distance to a point's orthogonal projection is 0 iff it lies in the subspace. -/
lemma dist_orthogonal_projection_eq_zero_iff {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} :
  dist p (orthogonal_projection s p) = 0 ↔ p ∈ s :=
by rw [dist_comm, dist_eq_zero, orthogonal_projection_eq_self_iff]

/-- The distance between a point and its orthogonal projection is
nonzero if it does not lie in the subspace. -/
lemma dist_orthogonal_projection_ne_zero_of_not_mem {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} (hp : p ∉ s) :
  dist p (orthogonal_projection s p) ≠ 0 :=
mt dist_orthogonal_projection_eq_zero_iff.mp hp

/-- Subtracting `p` from its `orthogonal_projection` produces a result
in the orthogonal direction. -/
lemma orthogonal_projection_vsub_mem_direction_orthogonal (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  (orthogonal_projection s p : P) -ᵥ p ∈ s.directionᗮ :=
orthogonal_projection_fn_vsub_mem_direction_orthogonal p

/-- Subtracting the `orthogonal_projection` from `p` produces a result
in the orthogonal direction. -/
lemma vsub_orthogonal_projection_mem_direction_orthogonal (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  p -ᵥ orthogonal_projection s p ∈ s.directionᗮ :=
direction_mk' p s.directionᗮ ▸
  vsub_mem_direction (self_mem_mk' _ _) (orthogonal_projection_mem_orthogonal s p)

/-- Subtracting the `orthogonal_projection` from `p` produces a result in the kernel of the linear
part of the orthogonal projection. -/
lemma orthogonal_projection_vsub_orthogonal_projection (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  _root_.orthogonal_projection s.direction (p -ᵥ orthogonal_projection s p) = 0 :=
begin
  apply orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero,
  intros c hc,
  rw [← neg_vsub_eq_vsub_rev, inner_neg_right,
    (orthogonal_projection_vsub_mem_direction_orthogonal s p c hc), neg_zero]
end

/-- Adding a vector to a point in the given subspace, then taking the
orthogonal projection, produces the original point if the vector was
in the orthogonal direction. -/
lemma orthogonal_projection_vadd_eq_self {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} (hp : p ∈ s) {v : V}
  (hv : v ∈ s.directionᗮ) :
  orthogonal_projection s (v +ᵥ p) = ⟨p, hp⟩ :=
begin
  have h := vsub_orthogonal_projection_mem_direction_orthogonal s (v +ᵥ p),
  rw [vadd_vsub_assoc, submodule.add_mem_iff_right _ hv] at h,
  refine (eq_of_vsub_eq_zero _).symm,
  ext,
  refine submodule.disjoint_def.1 s.direction.orthogonal_disjoint _ _ h,
  exact (_ : s.direction).2
end

/-- Adding a vector to a point in the given subspace, then taking the
orthogonal projection, produces the original point if the vector is a
multiple of the result of subtracting a point's orthogonal projection
from that point. -/
lemma orthogonal_projection_vadd_smul_vsub_orthogonal_projection {s : affine_subspace ℝ P}
  [nonempty s] [complete_space s.direction] {p1 : P} (p2 : P) (r : ℝ) (hp : p1 ∈ s) :
  orthogonal_projection s (r • (p2 -ᵥ orthogonal_projection s p2 : V) +ᵥ p1) = ⟨p1, hp⟩ :=
orthogonal_projection_vadd_eq_self hp
  (submodule.smul_mem _ _ (vsub_orthogonal_projection_mem_direction_orthogonal s _))

/-- The square of the distance from a point in `s` to `p2` equals the
sum of the squares of the distances of the two points to the
`orthogonal_projection`. -/
lemma dist_sq_eq_dist_orthogonal_projection_sq_add_dist_orthogonal_projection_sq
  {s : affine_subspace ℝ P} [nonempty s] [complete_space s.direction] {p1 : P}
  (p2 : P) (hp1 : p1 ∈ s) :
  dist p1 p2 * dist p1 p2 =
    dist p1 (orthogonal_projection s p2) * dist p1 (orthogonal_projection s p2) +
    dist p2 (orthogonal_projection s p2) * dist p2 (orthogonal_projection s p2) :=
begin
  rw [dist_comm p2 _, dist_eq_norm_vsub V p1 _, dist_eq_norm_vsub V p1 _,
    dist_eq_norm_vsub V _ p2, ← vsub_add_vsub_cancel p1 (orthogonal_projection s p2) p2,
    norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero],
  exact submodule.inner_right_of_mem_orthogonal
    (vsub_orthogonal_projection_mem_direction p2 hp1)
    (orthogonal_projection_vsub_mem_direction_orthogonal s p2),
end

/-- The square of the distance between two points constructed by
adding multiples of the same orthogonal vector to points in the same
subspace. -/
lemma dist_sq_smul_orthogonal_vadd_smul_orthogonal_vadd {s : affine_subspace ℝ P}
    {p1 p2 : P} (hp1 : p1 ∈ s) (hp2 : p2 ∈ s) (r1 r2 : ℝ) {v : V}
    (hv : v ∈ s.directionᗮ) :
  dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2) * dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2) =
    dist p1 p2 * dist p1 p2 + (r1 - r2) * (r1 - r2) * (‖v‖ * ‖v‖) :=
calc dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2) * dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2)
    = ‖(p1 -ᵥ p2) + (r1 - r2) • v‖ * ‖(p1 -ᵥ p2) + (r1 - r2) • v‖
  : by rw [dist_eq_norm_vsub V (r1 • v +ᵥ p1), vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, sub_smul,
      add_comm, add_sub_assoc]
... = ‖p1 -ᵥ p2‖ * ‖p1 -ᵥ p2‖ + ‖(r1 - r2) • v‖ * ‖(r1 - r2) • v‖
  : norm_add_sq_eq_norm_sq_add_norm_sq_real
      (submodule.inner_right_of_mem_orthogonal (vsub_mem_direction hp1 hp2)
        (submodule.smul_mem _ _ hv))
... = ‖(p1 -ᵥ p2 : V)‖ * ‖(p1 -ᵥ p2 : V)‖ + |r1 - r2| * |r1 - r2| * ‖v‖ * ‖v‖
  : by { rw [norm_smul, real.norm_eq_abs], ring }
... = dist p1 p2 * dist p1 p2 + (r1 - r2) * (r1 - r2) * (‖v‖ * ‖v‖)
  : by { rw [dist_eq_norm_vsub V p1, abs_mul_abs_self, mul_assoc] }

/-- Reflection in an affine subspace, which is expected to be nonempty
and complete.  The word "reflection" is sometimes understood to mean
specifically reflection in a codimension-one subspace, and sometimes
more generally to cover operations such as reflection in a point.  The
definition here, of reflection in an affine subspace, is a more
general sense of the word that includes both those common cases. -/
def reflection (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] :
  P ≃ᵃⁱ[ℝ] P :=
affine_isometry_equiv.mk'
  (λ p, (↑(orthogonal_projection s p) -ᵥ p) +ᵥ orthogonal_projection s p)
  (_root_.reflection s.direction)
  ↑(classical.arbitrary s)
  begin
    intros p,
    let v := p -ᵥ ↑(classical.arbitrary s),
    let a : V := _root_.orthogonal_projection s.direction v,
    let b : P := ↑(classical.arbitrary s),
    have key : a +ᵥ b -ᵥ (v +ᵥ b) +ᵥ (a +ᵥ b) = a + a - v +ᵥ (b -ᵥ b +ᵥ b),
    { rw [← add_vadd, vsub_vadd_eq_vsub_sub, vsub_vadd, vadd_vsub],
      congr' 1,
      abel },
    have : p = v +ᵥ ↑(classical.arbitrary s) := (vsub_vadd p ↑(classical.arbitrary s)).symm,
    simpa only [coe_vadd, reflection_apply, affine_map.map_vadd, orthogonal_projection_linear,
      orthogonal_projection_mem_subspace_eq_self, vadd_vsub, continuous_linear_map.coe_coe,
      continuous_linear_equiv.coe_coe, this] using key,
  end

/-- The result of reflecting. -/
lemma reflection_apply (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] (p : P) :
  reflection s p = (↑(orthogonal_projection s p) -ᵥ p) +ᵥ orthogonal_projection s p :=
rfl

lemma eq_reflection_of_eq_subspace {s s' : affine_subspace ℝ P} [nonempty s]
  [nonempty s'] [complete_space s.direction] [complete_space s'.direction] (h : s = s') (p : P) :
  (reflection s p : P) = (reflection s' p : P) :=
by unfreezingI { subst h }

/-- Reflecting twice in the same subspace. -/
@[simp] lemma reflection_reflection (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  reflection s (reflection s p) = p :=
begin
  have : ∀ a : s, ∀ b : V, (_root_.orthogonal_projection s.direction) b = 0
    → reflection s (reflection s (b +ᵥ a)) = b +ᵥ a,
  { intros a b h,
    have : (a:P) -ᵥ (b +ᵥ a) = - b,
    { rw [vsub_vadd_eq_vsub_sub, vsub_self, zero_sub] },
    simp [reflection, h, this] },
  rw ← vsub_vadd p (orthogonal_projection s p),
  exact this (orthogonal_projection s p) _ (orthogonal_projection_vsub_orthogonal_projection s p),
end

/-- Reflection is its own inverse. -/
@[simp] lemma reflection_symm (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] :
  (reflection s).symm = reflection s :=
by { ext, rw ← (reflection s).injective.eq_iff, simp }

/-- Reflection is involutive. -/
lemma reflection_involutive (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] :
  function.involutive (reflection s) :=
reflection_reflection s

/-- A point is its own reflection if and only if it is in the
subspace. -/
lemma reflection_eq_self_iff {s : affine_subspace ℝ P} [nonempty s] [complete_space s.direction]
  (p : P) : reflection s p = p ↔ p ∈ s :=
begin
  rw [←orthogonal_projection_eq_self_iff, reflection_apply],
  split,
  { intro h,
    rw [←@vsub_eq_zero_iff_eq V, vadd_vsub_assoc,
        ←two_smul ℝ (↑(orthogonal_projection s p) -ᵥ p), smul_eq_zero] at h,
    norm_num at h,
    exact h },
  { intro h,
    simp [h] }
end

/-- Reflecting a point in two subspaces produces the same result if
and only if the point has the same orthogonal projection in each of
those subspaces. -/
lemma reflection_eq_iff_orthogonal_projection_eq (s₁ s₂ : affine_subspace ℝ P)
  [nonempty s₁] [nonempty s₂] [complete_space s₁.direction] [complete_space s₂.direction] (p : P) :
  reflection s₁ p = reflection s₂ p ↔
    (orthogonal_projection s₁ p : P) = orthogonal_projection s₂ p :=
begin
  rw [reflection_apply, reflection_apply],
  split,
  { intro h,
    rw [←@vsub_eq_zero_iff_eq V, vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, add_comm,
        add_sub_assoc, vsub_sub_vsub_cancel_right,
        ←two_smul ℝ ((orthogonal_projection s₁ p : P) -ᵥ orthogonal_projection s₂ p),
        smul_eq_zero] at h,
    norm_num at h,
    exact h },
  { intro h,
    rw h }
end

/-- The distance between `p₁` and the reflection of `p₂` equals that
between the reflection of `p₁` and `p₂`. -/
lemma dist_reflection (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction]
  (p₁ p₂ : P) :
  dist p₁ (reflection s p₂) = dist (reflection s p₁) p₂ :=
begin
  conv_lhs { rw ←reflection_reflection s p₁ },
  exact (reflection s).dist_map _ _
end

/-- A point in the subspace is equidistant from another point and its
reflection. -/
lemma dist_reflection_eq_of_mem (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction]
  {p₁ : P} (hp₁ : p₁ ∈ s) (p₂ : P) :
  dist p₁ (reflection s p₂) = dist p₁ p₂ :=
begin
  rw ←reflection_eq_self_iff p₁ at hp₁,
  convert (reflection s).dist_map p₁ p₂,
  rw hp₁
end

/-- The reflection of a point in a subspace is contained in any larger
subspace containing both the point and the subspace reflected in. -/
lemma reflection_mem_of_le_of_mem {s₁ s₂ : affine_subspace ℝ P} [nonempty s₁]
  [complete_space s₁.direction] (hle : s₁ ≤ s₂) {p : P}
  (hp : p ∈ s₂) : reflection s₁ p ∈ s₂ :=
begin
  rw [reflection_apply],
  have ho : ↑(orthogonal_projection s₁ p) ∈ s₂ := hle (orthogonal_projection_mem p),
  exact vadd_mem_of_mem_direction (vsub_mem_direction ho hp) ho
end

/-- Reflecting an orthogonal vector plus a point in the subspace
produces the negation of that vector plus the point. -/
lemma reflection_orthogonal_vadd {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} (hp : p ∈ s) {v : V}
  (hv : v ∈ s.directionᗮ) : reflection s (v +ᵥ p) = -v +ᵥ p :=
begin
  rw [reflection_apply, orthogonal_projection_vadd_eq_self hp hv, vsub_vadd_eq_vsub_sub],
  simp
end

/-- Reflecting a vector plus a point in the subspace produces the
negation of that vector plus the point if the vector is a multiple of
the result of subtracting a point's orthogonal projection from that
point. -/
lemma reflection_vadd_smul_vsub_orthogonal_projection {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p₁ : P} (p₂ : P) (r : ℝ) (hp₁ : p₁ ∈ s) :
  reflection s (r • (p₂ -ᵥ orthogonal_projection s p₂) +ᵥ p₁) =
    -(r • (p₂ -ᵥ orthogonal_projection s p₂)) +ᵥ p₁ :=
reflection_orthogonal_vadd hp₁
  (submodule.smul_mem _ _ (vsub_orthogonal_projection_mem_direction_orthogonal s _))

end euclidean_geometry


/-
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 order.upper_lower.basic
import topology.separation

/-!
# Priestley spaces

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

This file defines Priestley spaces. A Priestley space is an ordered compact topological space such
that any two distinct points can be separated by a clopen upper set.

## Main declarations

* `priestley_space`: Prop-valued mixin stating the Priestley separation axiom: Any two distinct
  points can be separated by a clopen upper set.

## Implementation notes

We do not include compactness in the definition, so a Priestley space is to be declared as follows:
`[preorder α] [topological_space α] [compact_space α] [priestley_space α]`

## References

* [Wikipedia, *Priestley space*](https://en.wikipedia.org/wiki/Priestley_space)
* [Davey, Priestley *Introduction to Lattices and Order*][davey_priestley]
-/

open set

variables {α : Type*}

/-- A Priestley space is an ordered topological space such that any two distinct points can be
separated by a clopen upper set. Compactness is often assumed, but we do not include it here. -/
class priestley_space (α : Type*) [preorder α] [topological_space α] :=
(priestley {x y : α} : ¬ x ≤ y → ∃ U : set α, is_clopen U ∧ is_upper_set U ∧ x ∈ U ∧ y ∉ U)

variables [topological_space α]

section preorder
variables [preorder α] [priestley_space α] {x y : α}

lemma exists_clopen_upper_of_not_le :
  ¬ x ≤ y → ∃ U : set α, is_clopen U ∧ is_upper_set U ∧ x ∈ U ∧ y ∉ U :=
priestley_space.priestley

lemma exists_clopen_lower_of_not_le (h : ¬ x ≤ y) :
  ∃ U : set α, is_clopen U ∧ is_lower_set U ∧ x ∉ U ∧ y ∈ U :=
let ⟨U, hU, hU', hx, hy⟩ := exists_clopen_upper_of_not_le h in
  ⟨Uᶜ, hU.compl, hU'.compl, not_not.2 hx, hy⟩

end preorder

section partial_order
variables [partial_order α] [priestley_space α] {x y : α}

lemma exists_clopen_upper_or_lower_of_ne (h : x ≠ y) :
  ∃ U : set α, is_clopen U ∧ (is_upper_set U ∨ is_lower_set U) ∧ x ∈ U ∧ y ∉ U :=
begin
  obtain (h | h) := h.not_le_or_not_le,
  { exact (exists_clopen_upper_of_not_le h).imp (λ U, and.imp_right $ and.imp_left or.inl) },
  { obtain ⟨U, hU, hU', hy, hx⟩ := exists_clopen_lower_of_not_le h,
    exact ⟨U, hU, or.inr hU', hx, hy⟩ }
end

@[priority 100] -- See note [lower instance priority]
instance priestley_space.to_t2_space : t2_space α :=
⟨λ x y h, let ⟨U, hU, _, hx, hy⟩ := exists_clopen_upper_or_lower_of_ne h in
   ⟨U, Uᶜ, hU.is_open, hU.compl.is_open, hx, hy, disjoint_compl_right⟩⟩

end partial_order


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

144 is the largest square in the Fibonacci sequence.
-/

/- 144 is the largest square in the Fibonacci sequence.
  Copyright Kevin Buzzard.

Authors :
  Kevin Buzzard
  Nicholas Scheel
  Kenny Lau
  Reid Barton

-/

-- definition of Fibonacci sequence
import definitions

-- Statement of main theorem
theorem largest_square_in_fibonacci_sequence (n d : ℕ) : fib n = d ^ 2 → fib n ≤ 144 := sorry


import week_7.solutions.Part_A_quotients
import week_7.solutions.Part_B_universal_property

/-

# `Z ≃ ℤ`

Let's use the previous parts to show that Z and ℤ are isomorphic.

-/

-- Let's define pℤ to be the usual subtraction function ℕ² → ℤ
def pℤ (ab : N2) : ℤ := (ab.1 : ℤ) - ab.2

@[simp] lemma pℤ_def (a b : ℕ) : pℤ (a, b) = (a : ℤ) - b := rfl

-- Start with `intro z, apply int.induction_on z` to prove this.
theorem pℤsurj : function.surjective pℤ :=
begin
  intro z,
  apply int.induction_on z,
  { use (0, 0),
    simp,
  },
  { rintro i ⟨⟨a, b⟩, h⟩,
    use ⟨a + 1, b⟩,
    rw [←h],
    simp,
    ring },
  { rintro i ⟨⟨a, b⟩, h⟩,
    use ⟨a, b + 1⟩,
    rw [←h],
    simp,
    ring }
end

-- The fibres of pℤ are equivalence classes.
theorem pℤequiv (ab cd : N2) : ab ≈ cd ↔ pℤ ab = pℤ cd :=
begin
  cases ab with a b,
  cases cd with c d,
  split;
  { simp,
    intros,
    linarith },
end

-- It's helpful to have a random one-sided inverse coming from surjectivity
noncomputable def invp : ℤ → N2 :=
λ z, classical.some (pℤsurj z)

-- Here's the proof that it is an inverse.
@[simp] theorem invp_inv (z : ℤ) : pℤ (invp z) = z :=
classical.some_spec (pℤsurj z)

-- Now we can prove that ℤ and pℤ are universal.
theorem int_is_universal : is_universal ℤ pℤ :=
begin
  split,
  { rintros ⟨a, b⟩ ⟨c, d⟩,
    rw [N2.equiv_def, pℤ],
    simp,
    intros,
    linarith },
  { intros T p h,
    use (λ z, p (invp z)),
    split,
    { ext ab,
      simp,
      apply h,
      rw pℤequiv,
      simp },
    { intros k hk,
      ext z,
      rw [hk, function.comp],
      simp } },
end

-- and now we can prove they're in bijection
noncomputable example : ℤ ≃ Z :=
universal_equiv_quotient _ _ _ int_is_universal


--import data.set
import tactic

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

-- dEAduction definitions
import set_definitions

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

---------------------
-- Course metadata --
---------------------
-- logic names ['and', 'or', 'negate', 'implicate', 'iff', 'forall', 'exists', 'equal', 'map']
-- proofs names ['use_proof_methods', 'new_object']
-- proof methods names ['cbr', 'contrapose', 'absurdum', 'sorry']
-- magic names ['compute', 'assumption']

/- dEAduction
Title
    exercices de mathématiques discretes.
Author
    Alice Laroche
Institution

AvailableMagic
    ALL
Description
    Exercices d'un cours de maths discrètes à Sorbonne Université.
    Les numéros de questions font référence à la feuille de TD.
-/

namespace set

-- def disjoint {X : Type} (A B : set X) : Prop := A ∩ B = ∅

def partition {X :Type} (A : set (set X)) := (∀A₁ ∈ A , A₁ ≠ ∅) ∧ (∀A₁ A₂ ∈ A, (A₁ ∩ A₂ = ∅) ∨ A₁ = A₂) ∧ (∀x, ∃A₁ ∈ A, x ∈ A₁)

end set

namespace relation

def inv {X Y : Type} (R : set (X × Y)) : set (Y × X)
| (x, y) := (y, x) ∈ R

def product {X Y Z : Type} (R : set (X × Y)) (R' : set (Y × Z)) : set (X × Z)
| (x, y) := ∃z, (x, z) ∈ R ∧ (z, y) ∈ R'

def identite {X: Type} : set (X × X)
| (x, y) := x = y

def reflexive {X : Type} (R : set (X × X)) := ∀x, (x, x) ∈ R

def transitive {X : Type} (R: set (X × X)) := ∀x y z, (x, y) ∈ R ∧ (y, z) ∈ R → (x, z) ∈ R

def symetrique {X : Type} (R : set (X × X)) := ∀x y, (x, y) ∈ R → (y, x) ∈ R

def antisymetrique {X : Type} (R : set (X × X)) := ∀x y, (x, y) ∈ R ∧ (y, x) ∈ R → x = y

def relation_equivalence {X : Type} (R : set (X × X)) := reflexive R ∧ transitive R ∧ symetrique R

def relation_ordre {X : Type} (R : set (X × X)) := reflexive R ∧ transitive R ∧ antisymetrique R

def classe_equivalence {X : Type} (R : set (X × X)) (H1 : relation_equivalence R) (e : X) : set X
| e' :=  (e, e')  ∈ R

def deterministe {X Y : Type} (R : set (X × Y)) := ∀x y z, (x, y) ∈ R ∧ (x, z) ∈ R → y = z

def total_gauche {X Y : Type} (R : set (X × Y)) := ∀x, ∃y, (x, y) ∈ R

def application {X Y : Type} (R : set (X × Y)) := deterministe R ∧ total_gauche R

def injective {X Y : Type} (R : set (X × Y)) := ∀x y z, (x, z) ∈ R ∧ (y, z) ∈ R → x = y

def surjective {X Y : Type} (R : set (X × Y)) := ∀y, ∃x, (x, y) ∈ R

def application_injective {X Y : Type} (R : set (X × Y)) := application R ∧ injective R

def application_surjective {X Y : Type} (R : set (X × Y)) := application R ∧ surjective R

def application_bijective {X Y : Type} (R : set (X × Y)) := application R ∧ injective R ∧ surjective R

def image {X Y : Type} (R : set (X × Y)) (x : X) (y : Y) := (x, y) ∈ R

end relation

local attribute [instance] classical.prop_decidable

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

open set
open relation

notation [parsing_only] R `.` S := relation.product R S

notation R `⁻¹`  := relation.inv R
notation R `dot` S := relation.product R S

------------------
-- COURSE TITLE --
------------------
namespace math_discretes
/- dEAduction
PrettyName
    Mathématiques discrètes
-/

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

------------------------
-- COURSE DEFINITIONS --
------------------------
lemma definition.inclusion {A B : set X} : A ⊆ B ↔ ∀ {x:X}, x ∈ A → x ∈ B :=
/- dEAduction
PrettyName
    Inclusion
ImplicitUse
    True
-/
begin
    todo,
end

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

-- lemma definition.inegalite_deux_ensembles {A A' : set X} :
-- (A ≠ A') ↔ ( ∃x, (x ∈ A ∧ x ∉ A') ∨ (x ∈ A' ∧ x ∉ A)) :=
-- /- dEAduction
-- PrettyName
--     Inégalité de deux ensembles
-- -/
-- begin
--     todo,
-- end

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

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

lemma definition.singleton {X : Type} {x y : X}: x ∈ ({y} : set X) ↔ x = y
:=
/- dEAduction
PrettyName
    Singleton
-/
begin
    exact mem_singleton_iff,
end

lemma definition.double_inclusion (A A' : set X) :
A = A' ↔ (A ⊆ A' ∧ A' ⊆ A) :=
/- dEAduction
PrettyName
    Double inclusion
ImplicitUse
    True
-/
begin
    exact set.subset.antisymm_iff,
end

lemma definition.ensemble_partie (A A' : set X) :
A' ∈ 𝒫(A) ↔  A' ⊆ A
:=
/- dEAduction
PrettyName
    Ensemble des parties
-/
begin
    refl,
end

end generalites

namespace union_intersection
/- dEAduction
PrettyName
    Unions et intersections
-/

------------------------
-- COURSE DEFINITIONS --
------------------------

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

lemma definition.intersection_union (A B C : set X) :
A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
/- dEAduction
PrettyName
   Intersection avec une union
ImplicitUse
    True
-/
begin
  exact set.inter_distrib_left A B C,
end

lemma definition.partition
 {P : set (set X)} :
 partition P ↔ (∀A₁ ∈ P , A₁ ≠ ∅) ∧ (∀A₁ A₂ ∈ P, (A₁ ∩ A₂ = ∅) ∨ A₁ = A₂) ∧ (∀x, ∃A₁ ∈ P, x ∈ A₁)
:=
/- dEAduction
PrettyName
   Partition
-/
begin
    todo
end
-- lemma definition.intersection_videI (A : set X) :
-- A ∩ ∅ = ∅ :=
-- /- dEAduction
-- PrettyName
--     Intersection avec l'ensemble vide I
-- ImplicitUse
--     False
-- -/
-- begin
--     exact inter_empty A,
-- end

-- lemma definition.intersection_videII (A : set X) :
-- ∅ ∩ A = ∅ :=
-- /- dEAduction
-- PrettyName
--     Intersection avec l'ensemble vide II
-- ImplicitUse
--     False
-- -/
-- begin
--     exact empty_inter A,
-- end

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

-- lemma definition.union_intersection (A B C : set X) :
-- A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C) :=
-- /- dEAduction
-- PrettyName
--    Union avec une intersection
-- ImplicitUse
--     False
-- -/
-- begin
--   exact set.union_distrib_left A B C,
-- end

-- lemma definition.union_videI (A : set X) :
-- A ∪ ∅ = A :=
-- /- dEAduction
-- PrettyName
--     Union avec l'ensemble vide I
-- ImplicitUse
--     False
-- -/
-- begin
--     exact union_empty A,
-- end

-- lemma definition.union_videII (A : set X) :
-- ∅ ∪ A = A :=
-- /- dEAduction
-- PrettyName
--     Union avec l'ensemble vide II
-- ImplicitUse
--     False
-- -/
-- begin
--     exact empty_union A,
-- end

end union_intersection

namespace complementaire
/- dEAduction
PrettyName
    Complémentaire
-/

------------------------
-- COURSE DEFINITIONS --
------------------------

lemma definition.complement {A : set X} {x : X} : x ∈ set.compl A ↔ not (x ∈ A) :=
/- dEAduction
PrettyName
    Complementaire
ImplicitUse
    False
-/
begin
    -- split, intro H, targets_analysis,
    finish,
end

lemma definition.difference {A A' : set X} {x : X} : x ∈ set.diff A A' ↔ x ∈ A ∧ x ∉ A' :=
/- dEAduction
PrettyName
    Différence
ImplicitUse
    False
-/
begin
    finish,
end
-- lemma definition.complement_complement {A : set X} : (set.compl (set.compl A)) = A :=
-- /- dEAduction
-- PrettyName
--     Complementaire du complementaire
-- ImplicitUse
--     False
-- -/
-- begin
--     exact compl_compl',
-- end

-- lemma definition.complement_intersection {A B : set X} :
-- set.compl (A ∩ B) = (set.compl A) ∪ (set.compl B) :=
-- /- dEAduction
-- PrettyName
--     Complementaire d'une intersection
-- ImplicitUse
--     False
-- -/
-- begin
--     exact compl_inter A B,
-- end

-- lemma definition.intersection_complement {A : set X} :
-- A ∩ set.compl (A) = ∅ :=
-- /- dEAduction
-- PrettyName
--     Intersection avec le complémentaire
-- ImplicitUse
--     False
-- -/
-- begin
--     exact inter_compl_self A,
-- end

-- lemma definition.complement_union {A B : set X} :
-- set.compl (A ∪ B) = (set.compl A) ∩ (set.compl B) :=
-- /- dEAduction
-- PrettyName
--     Complementaire d'une union
-- ImplicitUse
--     False
-- -/
-- begin
--     exact compl_union A B,
-- end

-- lemma definition.union_complement {A : set X} :
-- A ∪ set.compl (A) = univ :=
-- /- dEAduction
-- PrettyName
--     Union avec le complémentaire
-- ImplicitUse
--     False
-- -/
-- begin
--     exact union_compl_self A,
-- end

end complementaire

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

-- lemma definition.type_produit :
-- ∀ z:X × Y, ∃ x:X, ∃ y:Y, z = (x,y) :=
-- /- dEAduction
-- PrettyName
--     Element d'un produit cartésien de deux ensembles
-- -/
-- begin
--     todo
-- end

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

end produits_cartesiens

namespace relations
/- dEAduction
PrettyName
    Relations
-/

------------------------
-- COURSE DEFINITIONS --
------------------------

lemma definition.inv {R : set (X × Y)} {x : X} {y : Y} :
(y,x) ∈ (inv R) ↔ (x,y) ∈ R :=
/- dEAduction
PrettyName
    Inverse d'une relation
-/
begin
    refl,
end

lemma definition.prod {R : set (X × Y)} {S : set (Y × Z)} {x : X} {z : Z} :
(x,z) ∈ (product R S) ↔ ∃y, (x,y) ∈ R ∧ (y,z) ∈ S :=
/- dEAduction
PrettyName
    Produit de deux relations
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.id {x : X} {y : X} :
(x,y) ∈ (identite : set (X × X))  ↔ x = y :=
/- dEAduction
PrettyName
    Relation identité
-/
begin
    refl,
end

lemma theorem.id :
∀ x:X,  (x,x) ∈ (identite : set (X × X)) :=
/- dEAduction
PrettyName
    Relation identité
-/
begin
    intro x, rw definition.id,
end

lemma definition.reflexive {R : set (X × X)} :
reflexive R ↔ ∀x, (x, x) ∈ R :=
/- dEAduction
PrettyName
    Réflexivité
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.transitive {R : set (X × X)} :
transitive R ↔ ∀x y z, (x, y) ∈ R ∧ (y, z) ∈ R → (x, z) ∈ R :=
/- dEAduction
PrettyName
    Transitivité
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.symetrique {R : set (X × X)} :
symetrique R ↔ ∀x y, (x, y) ∈ R → (y, x) ∈ R:=
/- dEAduction
PrettyName
    Symétrie
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.antisymetrique {R : set (X × X)} :
antisymetrique R ↔ ∀x y, (x, y) ∈ R ∧ (y, x) ∈ R → x = y :=
/- dEAduction
PrettyName
    Antisymétrie
-/
begin
    refl,
end

lemma definition.equivalence {R : set (X × X)} :
relation_equivalence R ↔ reflexive R ∧ transitive R ∧ symetrique R :=
/- dEAduction
PrettyName
    Relation d'équivalence
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.ordre {R : set (X × X)} :
relation_ordre R ↔ reflexive R ∧ transitive R ∧ antisymetrique R :=
/- dEAduction
PrettyName
    Relation d'ordre
-/
begin
    refl,
end

lemma definition.classe_equivalence {x y : X} {R : set (X × X)} {H1 : relation_equivalence R}:
y ∈ classe_equivalence R H1 x ↔ (x, y) ∈ R :=
/- dEAduction
PrettyName
    Classe d'équivalence
-/
begin
    refl,
end
end relations

-- namespace applications

-- lemma definition.deterministe {X Y : Type} (R : set (X × Y))
-- : deterministe R ↔ ∀x y z, (x, y) ∈ R ∧ (x, z) ∈ R → y = z :=
-- /- dEAduction
-- PrettyName
--     Relation déterministe
-- -/
-- begin
--     refl,
-- end

-- lemma definition.total_gauche {X Y : Type} (R : set (X × Y)) :
-- total_gauche R ↔ ∀x, ∃y, (x, y) ∈ R :=
-- /- dEAduction
-- PrettyName
--     Relation totale
-- -/
-- begin
--     refl,
-- end

-- lemma definition.application {X Y : Type} (R : set (X × Y)) :
-- application R ↔ deterministe R ∧ total_gauche R :=
-- /- dEAduction
-- PrettyName
--      Relation et application
-- -/
-- begin
--     refl,
-- end

-- lemma definition.relation_injective {X Y : Type} (R : set (X × Y)) :
-- relation.injective R ↔ ∀x y z, (x, z) ∈ R ∧ (y, z) ∈ R → x = y :=
-- /- dEAduction
-- PrettyName
--     Relation injective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.relation_surjective {X Y : Type} (R : set (X × Y)) :
-- relation.surjective R ↔ ∀y, ∃x, (x, y) ∈ R :=
-- /- dEAduction
-- PrettyName
--     Relation surjective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.application_injective {X Y : Type} (R : set (X × Y)) :
-- application_injective R ↔ application R ∧ relation.injective R :=
-- /- dEAduction
-- PrettyName
--     Application injective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.application_surjective {X Y : Type} (R : set (X × Y)) :
-- application_surjective R ↔ application R ∧ relation.surjective R :=
-- /- dEAduction
-- PrettyName
--     Application surjective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.application_bijective {X Y : Type} (R : set (X × Y)) :
-- application_bijective R ↔ application R ∧ relation.injective R ∧ relation.surjective R :=
-- /- dEAduction
-- PrettyName
--     Application bijective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.image {X Y : Type} (R : set (X × Y)) (x : X) (y : Y) :
-- image R x y ↔ (x, y) ∈ R :=
-- /- dEAduction
-- PrettyName
--     Image d'une relation
-- -/
-- begin
--     refl,
-- end

-- end applications

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

variables  {A B C : set X}

namespace exercice2
/- dEAduction
PrettyName
    Exercice 2
-/

lemma exercise.question1 :
(A ∩ compl (A ∩ B)) = (A ∩ compl B) :=
/- dEAduction
PrettyName
    Question 1
-/
begin
    todo,
end

lemma exercise.question2 :
A ∩ B = A ∩ C → A ∩ compl B = A ∩ compl C :=
/- dEAduction
PrettyName
    Question 2
-/
begin
    todo,
end

lemma exercise.question3 :
A ∩ B = A ∩ C ↔ A ∩ (compl B) = A ∩ (compl C) :=
/- dEAduction
PrettyName
    Question 3
Description
    Deduire de la question précedente l'équivalence des deux énoncés.
-/
begin
    todo,
end

lemma exercise.question4 :
A ∪ B ⊆ A ∪ C ∧ A ∩ B ⊆ A ∩ C → B ⊆ C :=
/- dEAduction
PrettyName
    Question 4
-/
begin
    todo,
end

lemma exercise.question5 :
set.prod A (B ∪ C) = set.prod A B ∪ set.prod A C :=
/- dEAduction
PrettyName
    Question 5
-/
begin
    todo,
end

-- lemma exercise.question61 :
-- 𝒫(A ∪ B) = 𝒫(A) ∪ 𝒫(B) ∨ ¬𝒫(A ∪ B) = 𝒫(A) ∪ 𝒫(B) :=
-- /- dEAduction
-- PrettyName
--     Question 6.1
-- OpenQuestion
--     True
-- -/
-- begin
--     todo,
-- end

lemma exercise.question62 :
𝒫(A ∩ B) = 𝒫(A) ∩ 𝒫(B) :=
/- dEAduction
PrettyName
    Question 6.2
-/
begin
    todo,
end

--𝒫(E ∪ {x}) = 𝒫(E) ∪ {A' | ∃A ∈ 𝒫(E), A' = A ∪ {x}} :=
lemma exercise.question7 (F : Type) (E : set F) (x : F) (h : x ∉ E) :
𝒫(E ∪ {x}) = 𝒫(E) ∪ {A' | ∃A ⊆ E, A' = A ∪ {x}} :=
/- dEAduction
PrettyName
    Question 7
-/
begin
    todo,
end

end exercice2

namespace exercice5
/- dEAduction
PrettyName
    Exercice 5
-/

lemma exercise.question2_produit_inverse (X Y Z : Type) (R : set (X × Y)) (S : set (Y × Z)) :
 (R dot S) ⁻¹ = ((S ⁻¹) dot (R ⁻¹)) :=
 /- dEAduction
PrettyName
    Question 2
-/
begin
    todo,
end
end exercice5

namespace exercice6
/- dEAduction
PrettyName
    Exercice 6
-/

lemma exercise.question1 (X: Type) (R : set (X × X)) :
reflexive R ↔ identite ⊆ R :=
/- dEAduction
PrettyName
    Question 1
-/
begin
    todo,
end

lemma exercise.question2 (X: Type) (R : set (X × X)) :
symetrique R ↔ R = inv R  :=
/- dEAduction
PrettyName
    Question 2
-/
begin
    todo,
end

lemma exercise.question3 (X: Type) (R : set (X × X)) :
antisymetrique R ↔ (R ∩ (inv R)) ⊆ identite :=
/- dEAduction
PrettyName
    Question 3
-/
begin
    todo,
end

lemma exercise.question4 (X: Type) (R : set (X × X)) :
transitive R ↔ (product R R) ⊆ R :=
/- dEAduction
PrettyName
    Question 4
-/
begin
    todo,
end

lemma exercise.question5 (X: Type) (R : set (X × X)) :
reflexive R → R ⊆ (R dot R) ∧ reflexive (R dot R) :=
/- dEAduction
PrettyName
    Question 5
-/
begin
    todo,
end

lemma exercise.question6 (X: Type) (R : set (X × X)) :
symetrique R → (R ⁻¹ dot R) = (R dot R ⁻¹) :=
/- dEAduction
PrettyName
    Question 6
-/
begin
    todo,
end

lemma exercise.question7 (X: Type) (R : set (X × X)) :
transitive R → transitive (R dot R) :=
/- dEAduction
PrettyName
    Question 7
-/
begin
    todo,
end
end exercice6

namespace exercice8
/- dEAduction
PrettyName
    Exercice 8
-/

lemma exercise.question1 (A : Type) (R : set (A × A)) (H1 : relation_equivalence R) :
∀a, a ∈ classe_equivalence R H1 a :=
/- dEAduction
PrettyName
    Question 1
-/
begin
    todo,
end

lemma exercise.question2 (A : Type) (R : set (A × A)) (H1 : relation_equivalence R) (a b : A) :
classe_equivalence R H1 a = classe_equivalence R H1 b ↔ (a,b) ∈ R :=
/- dEAduction
PrettyName
    Question 2
-/
begin
    todo,
end

lemma exercise.question3 (A : Type) (R : set (A × A)) (H1 : relation_equivalence R) (a b : A) :
classe_equivalence R H1 a ≠ classe_equivalence R H1 b → classe_equivalence R H1 a ∩ classe_equivalence R H1 b = ∅ :=
/- dEAduction
PrettyName
    Question 3
-/
begin
    todo,
end

lemma exercise.question5 (A : Type) (R : set (A × A)) (H1 : relation_equivalence R) :
partition {A₁ | ∃x, A₁ = classe_equivalence R H1 x} :=
/- dEAduction
PrettyName
    Question 5
-/
begin
    todo,
end

end exercice8

-- namespace exercice15
-- /- dEAduction
-- PrettyName
--     Exercice 15
-- -/

-- -- TODO: intégrer les defs pour applications (composition, id, bijective)
-- lemma exercise.question (X : Type) (f : X → X) :
-- ((composition f f) = id : X → X) → bijective f:=
-- /- dEAduction
-- PrettyName
--     Question 1
-- -/
-- begin
--     todo,
-- end
-- end exercice15

namespace exercice22
/- dEAduction
PrettyName
    Exercice 22
-/

lemma exercise.question1 (X Y : Type) (f : X → Y) (R : set (X × X)) (H1 : ∀x x', (x, x') ∈ R ↔ f x = f x') :
relation_equivalence R :=
/- dEAduction
PrettyName
    Question 1
-/
begin
    todo,
end

lemma exercise.question3 (X Y : Type) (f : X → Y) (R : set (X × X)) (H1 : ∀x x', (x, x') ∈ R ↔ f x = f x')
(H2: relation_equivalence R) :
∀x y, x ∈ classe_equivalence R H2 y → classe_equivalence R H2 x = classe_equivalence R H2 y :=
/- dEAduction
PrettyName
    Question 3
-/
begin
    todo,
end

-- lemma exercise.question41 (E F : Type) (f : set (E × F)) (H1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (S : set (E × (set E))) (h6 : ∀x y, relation.image S x y ↔ y = classe_equivalence Rf h3 x) :
-- relation.injective S ∨ ¬relation.injective S :=
-- /- dEAduction
-- PrettyName
--     ** Question 4.1
-- -/
-- begin
--     todo,
-- end

-- lemma exercise.question42 (E F : Type) (f : set (E × F)) (H1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (S : set (E × (set E))) (h6 : ∀x y, relation.image S x y ↔ y = classe_equivalence Rf h3 x) :
-- relation.surjective S ∨ ¬relation.surjective S :=
-- /- dEAduction
-- PrettyName
--     ** Question 4.2
-- -/
-- begin
--     todo,
-- end

-- lemma exercise.question5 (E F : Type) (f : set (E × F)) (H1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (f' : set ((set E) × F)) (h6 : ∀X y, (X, y) ∈ f' ↔ ∃x ∈ X, relation.image f x y) :
-- application f' :=
-- /- dEAduction
-- PrettyName
--     ** Question 5
-- -/
-- begin
--     todo,
-- end

-- lemma exercise.question61 (E F : Type) (f : set (E × F)) (H1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (f' : set ((set E) × F)) (h6 : ∀X y, (X, y) ∈ f' ↔ ∃x ∈ X, relation.image f x y) :
-- relation.injective f' ∨ ¬ relation.injective f' :=
-- /- dEAduction
-- PrettyName
--     ** Question 6.1
-- -/
-- begin
--     todo,
-- end

-- lemma exercise.question62 (E F : Type) (f : set (E × F)) (H1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (f' : set ((set E) × F)) (h6 : ∀X y, (X, y) ∈ f' ↔ ∃x ∈ X, relation.image f x y) :
-- relation.injective f' ∨ ¬ relation.injective f' :=
-- /- dEAduction
-- PrettyName
--     ** Question 6.2
-- -/
-- begin
--     todo,
-- end

end exercice22

end exercices

end math_discretes
end course


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.specific_limits
import analysis.asymptotics.asymptotics

/-!
# The group of units of a complete normed ring

This file contains the basic theory for the group of units (invertible elements) of a complete
normed ring (Banach algebras being a notable special case).

## Main results

The constructions `one_sub`, `add` and `unit_of_nearby` state, in varying forms, that perturbations
of a unit are units.  The latter two are not stated in their optimal form; more precise versions
would use the spectral radius.

The first main result is `is_open`:  the group of units of a complete normed ring is an open subset
of the ring.

The function `inverse` (defined in `algebra.ring`), for a ring `R`, sends `a : R` to `a⁻¹` if `a` is
a unit and 0 if not.  The other major results of this file (notably `inverse_add`,
`inverse_add_norm` and `inverse_add_norm_diff_nth_order`) cover the asymptotic properties of
`inverse (x + t)` as `t → 0`.

-/

noncomputable theory
open_locale topological_space
variables {R : Type*} [normed_ring R] [complete_space R]

namespace units

/-- In a complete normed ring, a perturbation of `1` by an element `t` of distance less than `1`
from `1` is a unit.  Here we construct its `units` structure.  -/
def one_sub (t : R) (h : ∥t∥ < 1) : units R :=
{ val := 1 - t,
  inv := ∑' n : ℕ, t ^ n,
  val_inv := mul_neg_geom_series t h,
  inv_val := geom_series_mul_neg t h }

@[simp] lemma one_sub_coe (t : R) (h : ∥t∥ < 1) : ↑(one_sub t h) = 1 - t := rfl

/-- In a complete normed ring, a perturbation of a unit `x` by an element `t` of distance less than
`∥x⁻¹∥⁻¹` from `x` is a unit.  Here we construct its `units` structure. -/
def add (x : units R) (t : R) (h : ∥t∥ < ∥(↑x⁻¹ : R)∥⁻¹) : units R :=
x * (units.one_sub (-(↑x⁻¹ * t))
begin
  nontriviality R using [zero_lt_one],
  have hpos : 0 < ∥(↑x⁻¹ : R)∥ := units.norm_pos x⁻¹,
  calc ∥-(↑x⁻¹ * t)∥
      = ∥↑x⁻¹ * t∥                    : by { rw norm_neg }
  ... ≤ ∥(↑x⁻¹ : R)∥ * ∥t∥            : norm_mul_le ↑x⁻¹ _
  ... < ∥(↑x⁻¹ : R)∥ * ∥(↑x⁻¹ : R)∥⁻¹ : by nlinarith only [h, hpos]
  ... = 1                             : mul_inv_cancel (ne_of_gt hpos)
end)

@[simp] lemma add_coe (x : units R) (t : R) (h : ∥t∥ < ∥(↑x⁻¹ : R)∥⁻¹) :
  ((x.add t h) : R) = x + t := by { unfold units.add, simp [mul_add] }

/-- In a complete normed ring, an element `y` of distance less than `∥x⁻¹∥⁻¹` from `x` is a unit.
Here we construct its `units` structure. -/
def unit_of_nearby (x : units R) (y : R) (h : ∥y - x∥ < ∥(↑x⁻¹ : R)∥⁻¹) : units R :=
x.add ((y : R) - x) h

@[simp] lemma unit_of_nearby_coe (x : units R) (y : R) (h : ∥y - x∥ < ∥(↑x⁻¹ : R)∥⁻¹) :
  ↑(x.unit_of_nearby y h) = y := by { unfold units.unit_of_nearby, simp }

/-- The group of units of a complete normed ring is an open subset of the ring. -/
protected lemma is_open : is_open {x : R | is_unit x} :=
begin
  nontriviality R,
  apply metric.is_open_iff.mpr,
  rintros x' ⟨x, rfl⟩,
  refine ⟨∥(↑x⁻¹ : R)∥⁻¹, inv_pos.mpr (units.norm_pos x⁻¹), _⟩,
  intros y hy,
  rw [metric.mem_ball, dist_eq_norm] at hy,
  exact ⟨x.unit_of_nearby y hy, unit_of_nearby_coe _ _ _⟩
end

protected lemma nhds (x : units R) : {x : R | is_unit x} ∈ 𝓝 (x : R) :=
mem_nhds_sets units.is_open x.is_unit

end units

namespace normed_ring
open_locale classical big_operators
open asymptotics filter metric finset ring

lemma inverse_one_sub (t : R) (h : ∥t∥ < 1) : inverse (1 - t) = ↑(units.one_sub t h)⁻¹ :=
by rw [← inverse_unit (units.one_sub t h), units.one_sub_coe]

/-- The formula `inverse (x + t) = inverse (1 + x⁻¹ * t) * x⁻¹` holds for `t` sufficiently small. -/
lemma inverse_add (x : units R) :
  ∀ᶠ t in (𝓝 0), inverse ((x : R) + t) = inverse (1 + ↑x⁻¹ * t) * ↑x⁻¹ :=
begin
  nontriviality R,
  rw [eventually_iff, mem_nhds_iff],
  have hinv : 0 < ∥(↑x⁻¹ : R)∥⁻¹, by cancel_denoms,
  use [∥(↑x⁻¹ : R)∥⁻¹, hinv],
  intros t ht,
  simp only [mem_ball, dist_zero_right] at ht,
  have ht' : ∥-↑x⁻¹ * t∥ < 1,
  { refine lt_of_le_of_lt (norm_mul_le _ _) _,
    rw norm_neg,
    refine lt_of_lt_of_le (mul_lt_mul_of_pos_left ht x⁻¹.norm_pos) _,
    cancel_denoms },
  have hright := inverse_one_sub (-↑x⁻¹ * t) ht',
  have hleft := inverse_unit (x.add t ht),
  simp only [← neg_mul_eq_neg_mul, sub_neg_eq_add] at hright,
  simp only [units.add_coe] at hleft,
  simp [hleft, hright, units.add]
end

lemma inverse_one_sub_nth_order (n : ℕ) :
  ∀ᶠ t in (𝓝 0), inverse ((1:R) - t) = (∑ i in range n, t ^ i) + (t ^ n) * inverse (1 - t) :=
begin
  simp only [eventually_iff, mem_nhds_iff],
  use [1, by norm_num],
  intros t ht,
  simp only [mem_ball, dist_zero_right] at ht,
  simp only [inverse_one_sub t ht, set.mem_set_of_eq],
  have h : 1 = ((range n).sum (λ i, t ^ i)) * (units.one_sub t ht) + t ^ n,
  { simp only [units.one_sub_coe],
    rw [← geom_sum, geom_sum_mul_neg],
    simp },
  rw [← one_mul ↑(units.one_sub t ht)⁻¹, h, add_mul],
  congr,
  { rw [mul_assoc, (units.one_sub t ht).mul_inv],
    simp },
  { simp only [units.one_sub_coe],
    rw [← add_mul, ← geom_sum, geom_sum_mul_neg],
    simp }
end

/-- The formula
`inverse (x + t) = (∑ i in range n, (- x⁻¹ * t) ^ i) * x⁻¹ + (- x⁻¹ * t) ^ n * inverse (x + t)`
holds for `t` sufficiently small. -/
lemma inverse_add_nth_order (x : units R) (n : ℕ) :
  ∀ᶠ t in (𝓝 0), inverse ((x : R) + t)
  = (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹ + (- ↑x⁻¹ * t) ^ n * inverse (x + t) :=
begin
  refine (inverse_add x).mp _,
  have hzero : tendsto (λ (t : R), - ↑x⁻¹ * t) (𝓝 0) (𝓝 0),
  { convert ((mul_left_continuous (- (↑x⁻¹ : R))).tendsto 0).comp tendsto_id,
    simp },
  refine (hzero.eventually (inverse_one_sub_nth_order n)).mp (eventually_of_forall _),
  simp only [neg_mul_eq_neg_mul_symm, sub_neg_eq_add],
  intros t h1 h2,
  have h := congr_arg (λ (a : R), a * ↑x⁻¹) h1,
  dsimp at h,
  convert h,
  rw [add_mul, mul_assoc],
  simp [h2.symm]
end

lemma inverse_one_sub_norm : is_O (λ t, inverse ((1:R) - t)) (λ t, (1:ℝ)) (𝓝 (0:R)) :=
begin
  simp only [is_O, is_O_with, eventually_iff, mem_nhds_iff],
  refine ⟨∥(1:R)∥ + 1, (2:ℝ)⁻¹, by norm_num, _⟩,
  intros t ht,
  simp only [ball, dist_zero_right, set.mem_set_of_eq] at ht,
  have ht' : ∥t∥ < 1,
  { have : (2:ℝ)⁻¹ < 1 := by cancel_denoms,
    linarith },
  simp only [inverse_one_sub t ht', norm_one, mul_one, set.mem_set_of_eq],
  change ∥∑' n : ℕ, t ^ n∥ ≤ _,
  have := normed_ring.tsum_geometric_of_norm_lt_1 t ht',
  have : (1 - ∥t∥)⁻¹ ≤ 2,
  { rw ← inv_inv' (2:ℝ),
    refine inv_le_inv_of_le (by norm_num) _,
    have : (2:ℝ)⁻¹ + (2:ℝ)⁻¹ = 1 := by ring,
    linarith },
  linarith
end

/-- The function `λ t, inverse (x + t)` is O(1) as `t → 0`. -/
lemma inverse_add_norm (x : units R) : is_O (λ t, inverse (↑x + t)) (λ t, (1:ℝ)) (𝓝 (0:R)) :=
begin
  nontriviality R,
  simp only [is_O_iff, norm_one, mul_one],
  cases is_O_iff.mp (@inverse_one_sub_norm R _ _) with C hC,
  use C * ∥((x⁻¹:units R):R)∥,
  have hzero : tendsto (λ t, - (↑x⁻¹ : R) * t) (𝓝 0) (𝓝 0),
  { convert ((mul_left_continuous (-↑x⁻¹ : R)).tendsto 0).comp tendsto_id,
    simp },
  refine (inverse_add x).mp ((hzero.eventually hC).mp (eventually_of_forall _)),
  intros t bound iden,
  rw iden,
  simp at bound,
  have hmul := norm_mul_le (inverse (1 + ↑x⁻¹ * t)) ↑x⁻¹,
  nlinarith [norm_nonneg (↑x⁻¹ : R)]
end

/-- The function
`λ t, inverse (x + t) - (∑ i in range n, (- x⁻¹ * t) ^ i) * x⁻¹`
is `O(t ^ n)` as `t → 0`. -/
lemma inverse_add_norm_diff_nth_order (x : units R) (n : ℕ) :
  is_O (λ (t : R), inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹)
  (λ t, ∥t∥ ^ n) (𝓝 (0:R)) :=
begin
  by_cases h : n = 0,
  { simpa [h] using inverse_add_norm x },
  have hn : 0 < n := nat.pos_of_ne_zero h,
  simp [is_O_iff],
  cases (is_O_iff.mp (inverse_add_norm x)) with C hC,
  use C * ∥(1:ℝ)∥ * ∥(↑x⁻¹ : R)∥ ^ n,
  have h : eventually_eq (𝓝 (0:R))
    (λ t, inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹)
    (λ t, ((- ↑x⁻¹ * t) ^ n) * inverse (x + t)),
  { refine (inverse_add_nth_order x n).mp (eventually_of_forall _),
    intros t ht,
    convert congr_arg (λ a, a - (range n).sum (pow (-↑x⁻¹ * t)) * ↑x⁻¹) ht,
    simp },
  refine h.mp (hC.mp (eventually_of_forall _)),
  intros t _ hLHS,
  simp only [neg_mul_eq_neg_mul_symm] at hLHS,
  rw hLHS,
  refine le_trans (norm_mul_le _ _ ) _,
  have h' : ∥(-(↑x⁻¹ * t)) ^ n∥ ≤ ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n,
  { calc ∥(-(↑x⁻¹ * t)) ^ n∥ ≤ ∥(-(↑x⁻¹ * t))∥ ^ n : norm_pow_le' _ hn
    ... = ∥↑x⁻¹ * t∥ ^ n : by rw norm_neg
    ... ≤ (∥(↑x⁻¹ : R)∥ * ∥t∥) ^ n : _
    ... =  ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n : mul_pow _ _ n,
    exact pow_le_pow_of_le_left (norm_nonneg _) (norm_mul_le ↑x⁻¹ t) n },
  have h'' : 0 ≤ ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n,
  { refine mul_nonneg _ _;
    exact pow_nonneg (norm_nonneg _) n },
  nlinarith [norm_nonneg (inverse (↑x + t))],
end

/-- The function `λ t, inverse (x + t) - x⁻¹` is `O(t)` as `t → 0`. -/
lemma inverse_add_norm_diff_first_order (x : units R) :
  is_O (λ t, inverse (↑x + t) - ↑x⁻¹) (λ t, ∥t∥) (𝓝 (0:R)) :=
by { convert inverse_add_norm_diff_nth_order x 1; simp }

/-- The function
`λ t, inverse (x + t) - x⁻¹ + x⁻¹ * t * x⁻¹`
is `O(t ^ 2)` as `t → 0`. -/
lemma inverse_add_norm_diff_second_order (x : units R) :
  is_O (λ t, inverse (↑x + t) - ↑x⁻¹ + ↑x⁻¹ * t * ↑x⁻¹) (λ t, ∥t∥ ^ 2) (𝓝 (0:R)) :=
begin
  convert inverse_add_norm_diff_nth_order x 2,
  ext t,
  simp only [range_succ, range_one, sum_insert, mem_singleton, sum_singleton, not_false_iff,
    one_ne_zero, pow_zero, add_mul],
  abel,
  simp
end

/-- The function `inverse` is continuous at each unit of `R`. -/
lemma inverse_continuous_at (x : units R) : continuous_at inverse (x : R) :=
begin
  have h_is_o : is_o (λ (t : R), ∥inverse (↑x + t) - ↑x⁻¹∥) (λ (t : R), (1:ℝ)) (𝓝 0),
  { refine is_o_norm_left.mpr ((inverse_add_norm_diff_first_order x).trans_is_o _),
    exact is_o_norm_left.mpr (is_o_id_const one_ne_zero) },
  have h_lim : tendsto (λ (y:R), y - x) (𝓝 x) (𝓝 0),
  { refine tendsto_zero_iff_norm_tendsto_zero.mpr _,
    exact tendsto_iff_norm_tendsto_zero.mp tendsto_id },
  simp only [continuous_at],
  rw [tendsto_iff_norm_tendsto_zero, inverse_unit],
  convert h_is_o.tendsto_0.comp h_lim,
  ext, simp
end

end normed_ring

namespace units
open opposite filter normed_ring

/-- In a normed ring, the coercion from `units R` (equipped with the induced topology from the
embedding in `R × R`) to `R` is an open map. -/
lemma is_open_map_coe : is_open_map (coe : units R → R) :=
begin
  rw is_open_map_iff_nhds_le,
  intros x s,
  rw [mem_map, mem_nhds_induced],
  rintros ⟨t, ht, hts⟩,
  obtain ⟨u, hu, v, hv, huvt⟩ :
    ∃ (u : set R), u ∈ 𝓝 ↑x ∧ ∃ (v : set Rᵒᵖ), v ∈ 𝓝 (opposite.op ↑x⁻¹) ∧ u.prod v ⊆ t,
  { simpa [embed_product, mem_nhds_prod_iff] using ht },
  have : u ∩ (op ∘ ring.inverse) ⁻¹' v ∩ (set.range (coe : units R → R)) ∈ 𝓝 ↑x,
  { refine inter_mem_sets (inter_mem_sets hu _) (units.nhds x),
    refine (continuous_op.continuous_at.comp (inverse_continuous_at x)).preimage_mem_nhds _,
    simpa using hv },
  refine mem_sets_of_superset this _,
  rintros _ ⟨⟨huy, hvy⟩, ⟨y, rfl⟩⟩,
  have : embed_product R y ∈ u.prod v := ⟨huy, by simpa using hvy⟩,
  simpa using hts (huvt this)
end

/-- In a normed ring, the coercion from `units R` (equipped with the induced topology from the
embedding in `R × R`) to `R` is an open embedding. -/
lemma open_embedding_coe : open_embedding (coe : units R → R) :=
open_embedding_of_continuous_injective_open continuous_coe ext is_open_map_coe

end units


/-
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

/-!
# 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] polynomial R)`.
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 (polynomial R) ≃ₐ[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 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 bare function underlying `A ⊗[R] polynomial R →ₐ[R] polynomial A`, on pure tensors.
-/
def to_fun (a : A) (p : polynomial R) : polynomial A :=
p.sum (λ n r, monomial n (a * algebra_map R A r))

/--
(Implementation detail).
The function underlying `A ⊗[R] polynomial R →ₐ[R] polynomial A`,
as a linear map in the second factor.
-/
def to_fun_linear_right (a : A) : polynomial R →ₗ[R] polynomial A :=
{ to_fun := to_fun R A a,
  map_smul' := λ r p,
  begin
    dsimp [to_fun],
    rw finsupp.sum_smul_index,
    { dsimp [finsupp.sum],
      rw finset.smul_sum,
      apply finset.sum_congr rfl,
      intros k hk,
      rw [monomial_eq_smul_X, monomial_eq_smul_X, algebra.smul_def, ← C_mul', ← C_mul',
          ← mul_assoc],
      congr' 1,
      rw [← algebra.commutes, ← algebra.commutes],
      simp only [ring_hom.map_mul, polynomial.algebra_map_apply, mul_assoc], },
    { intro i, simp only [ring_hom.map_zero, mul_zero, monomial_zero_right] },
  end,
  map_add' := λ p q,
  begin
    simp only [to_fun],
    rw finsupp.sum_add_index,
    { simp only [monomial_zero_right, forall_const, ring_hom.map_zero, mul_zero], },
    { intros i r s, simp only [ring_hom.map_add, mul_add, monomial_add], },
  end, }

/--
(Implementation detail).
The function underlying `A ⊗[R] polynomial R →ₐ[R] polynomial A`,
as a bilinear function of two arguments.
-/
def to_fun_bilinear : A →ₗ[R] polynomial R →ₗ[R] polynomial A :=
{ to_fun := to_fun_linear_right R A,
  map_smul' := by {
    intros, unfold to_fun_linear_right,
    congr, simp only [linear_map.coe_mk],
    unfold to_fun finsupp.sum,
    simp_rw [finset.smul_sum, smul_monomial,  ← algebra.smul_mul_assoc],
    refl },
  map_add' := by {
    intros, unfold to_fun_linear_right,
    congr, simp only [linear_map.coe_mk],
    unfold to_fun finsupp.sum,
    simp_rw [← finset.sum_add_distrib, ← monomial_add, ← add_mul],
    refl } }

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

-- 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 : polynomial R) (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₂ : polynomial R) :
  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₂ : polynomial R) :
  (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
  dsimp [to_fun_linear],
  simp only [lift.tmul],
  dsimp [to_fun_bilinear, to_fun_linear_right, to_fun],
  ext k,
  -- TODO This is a bit annoying: the polynomial API is breaking down.
  have apply_eq_coeff : ∀ {p : ℕ →₀ R} {n : ℕ}, p n = coeff p n := by { intros, refl },
  simp_rw [coeff_sum, coeff_monomial, finsupp.sum, finset.sum_ite_eq', finsupp.mem_support_iff,
    ne.def, coeff_mul, finset_sum_coeff, coeff_monomial,
    finset.sum_ite_eq', finsupp.mem_support_iff, ne.def,
    mul_ite, mul_zero, ite_mul, zero_mul, apply_eq_coeff],
  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 :=
begin
  dsimp [to_fun_linear],
  simp only [lift.tmul],
  dsimp [to_fun_bilinear, to_fun_linear_right, to_fun],
  rw [← C_1, ←monomial_zero_left],
  refine (finsupp.sum_single_index _).trans _; simp [algebra_map_apply]
end

/--
(Implementation detail).
The algebra homomorphism `A ⊗[R] polynomial R →ₐ[R] polynomial A`.
-/
def to_fun_alg_hom : A ⊗[R] polynomial R →ₐ[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 : polynomial R) :
  to_fun_alg_hom R A (a ⊗ₜ[R] p) = p.sum (λ n r, monomial n (a * (algebra_map R A) r)) :=
by simp [to_fun_alg_hom, to_fun_linear, to_fun_bilinear, to_fun_linear_right, to_fun]

/--
(Implementation detail.)

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

@[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 : polynomial R)) ^ n :=
eval₂_monomial _ _

lemma left_inv (x : A ⊗ polynomial R) :
  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],
    rw [finsupp.sum, ←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 : polynomial A) :
  (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],
    dsimp [monomial],
    rw [finsupp.sum_single_index]; simp, }
end

/--
(Implementation detail)

The equivalence, ignoring the algebra structure, `(A ⊗[R] polynomial R) ≃ polynomial A`.
-/
def equiv : (A ⊗[R] polynomial R) ≃ 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] polynomial R)`.
-/
def poly_equiv_tensor : polynomial A ≃ₐ[R] (A ⊗[R] polynomial R) :=
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 : polynomial A) :
  poly_equiv_tensor R A p =
    p.eval₂ (include_left : A →ₐ[R] A ⊗[R] polynomial R) ((1 : A) ⊗ₜ[R] (X : polynomial R)) :=
rfl

@[simp]
lemma poly_equiv_tensor_symm_apply_tmul (a : A) (p : polynomial R) :
  (poly_equiv_tensor R A).symm (a ⊗ₜ p) = p.sum (λ n r, monomial n (a * algebra_map R A r)) :=
begin
  simp [poly_equiv_tensor, to_fun_alg_hom, alg_hom_of_linear_map_tensor_product, to_fun_linear],
  refl,
end

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 (polynomial R) ≃ₐ[R] polynomial (matrix n n R) :=
(((matrix_equiv_tensor R (polynomial R) 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 : polynomial R) (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 (polynomial R)) (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 : polynomial (matrix n n R)) (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 : polynomial R) :
  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,
    smul_apply, mat_poly_equiv_coeff_apply],
  split_ifs; simp,
end


import MyNat.Definition
import MyNat.Inequality -- le_iff_exists_add
import AdvancedAdditionWorld.Level1 --  succ_inj
import AdvancedAdditionWorld.Level9 --  zero_ne_succ
namespace MyNat
open MyNat

/-!

# Inequality world.

## Level 13: `not_succ_le_self`

Turns out that `¬ P` is *by definition* `P → false`, so you can just
start this one with `intro h` if you like.

##  Lemma : not_succ_le_self
For all naturals `a`, `succ a` is not at most `a`.
-/
theorem not_succ_le_self (a : MyNat) : ¬ (succ a ≤ a) := by
  intro h
  cases h with
  | _ c h =>
    induction a with
    | zero =>
      rw [succ_add] at h
      exact zero_ne_succ _ h
    | succ d hd =>
      rw [succ_add] at h
      apply hd
      apply succ_inj
      exact h

/-!

## Pro tip:

The `conv` tactic allows you to perform targeted rewriting on a goal or hypothesis, by focusing
on particular subexpressions.

```
  conv =>
    lhs
    rw hc
```

This is an incantation which rewrites `hc` only on the left hand side of the goal.
You didn't need to use `conv` in the above proof
but it's a helpful trick when `rw` is rewriting too much.

For a deeper discussion on `conv` see [Conversion Tactic Mode](https://leanprover.github.io/theorem_proving_in_lean4/conv.html)

Next up [Level 14](./Level14.lean.md)
-/


/-
Copyright (c) 2021 Chris Hughes, Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Junyan Xu
-/
import data.polynomial.basic
import set_theory.cardinal.ordinal
/-!
# Cardinality of Polynomial Ring

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

The reuslt in this file is that the cardinality of `R[X]` is at most the maximum
of `#R` and `ℵ₀`.
-/
universe u

open_locale cardinal polynomial
open cardinal

namespace polynomial

@[simp] lemma cardinal_mk_eq_max {R : Type u} [semiring R] [nontrivial R] : #R[X] = max (#R) ℵ₀ :=
(to_finsupp_iso R).to_equiv.cardinal_eq.trans $
  by { rw [add_monoid_algebra, mk_finsupp_lift_of_infinite, lift_uzero, max_comm], refl }

lemma cardinal_mk_le_max {R : Type u} [semiring R] : #R[X] ≤ max (#R) ℵ₀ :=
begin
  casesI subsingleton_or_nontrivial R,
  { exact (mk_eq_one _).trans_le (le_max_of_le_right one_le_aleph_0) },
  { exact cardinal_mk_eq_max.le },
end

end polynomial


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

! This file was ported from Lean 3 source module measure_theory.measure.with_density_vector_measure
! leanprover-community/mathlib commit d1bd9c5df2867c1cb463bc6364446d57bdd9f7f1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.VectorMeasure
import Mathbin.MeasureTheory.Function.AeEqOfIntegral

/-!

# Vector measure defined by an integral

Given a measure `μ` and an integrable function `f : α → E`, we can define a vector measure `v` such
that for all measurable set `s`, `v i = ∫ x in s, f x ∂μ`. This definition is useful for
the Radon-Nikodym theorem for signed measures.

## Main definitions

* `measure_theory.measure.with_densityᵥ`: the vector measure formed by integrating a function `f`
  with respect to a measure `μ` on some set if `f` is integrable, and `0` otherwise.

-/

noncomputable section

open Classical MeasureTheory NNReal ENNReal

variable {α β : Type _} {m : MeasurableSpace α}

namespace MeasureTheory

open TopologicalSpace

variable {μ ν : Measure α}

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]

/-- Given a measure `μ` and an integrable function `f`, `μ.with_densityᵥ f` is
the vector measure which maps the set `s` to `∫ₛ f ∂μ`. -/
def Measure.withDensityᵥ {m : MeasurableSpace α} (μ : Measure α) (f : α → E) : VectorMeasure α E :=
  if hf : Integrable f μ then
    { measureOf' := fun s => if MeasurableSet s then ∫ x in s, f x ∂μ else 0
      empty' := by simp
      not_measurable' := fun s hs => if_neg hs
      m_Union' := fun s hs₁ hs₂ =>
        by
        convert has_sum_integral_Union hs₁ hs₂ hf.integrable_on
        · ext n
          rw [if_pos (hs₁ n)]
        · rw [if_pos (MeasurableSet.unionᵢ hs₁)] }
  else 0
#align measure_theory.measure.with_densityᵥ MeasureTheory.Measure.withDensityᵥ

open Measure

include m

variable {f g : α → E}

theorem withDensityᵥ_apply (hf : Integrable f μ) {s : Set α} (hs : MeasurableSet s) :
    μ.withDensityᵥ f s = ∫ x in s, f x ∂μ :=
  by
  rw [with_densityᵥ, dif_pos hf]
  exact dif_pos hs
#align measure_theory.with_densityᵥ_apply MeasureTheory.withDensityᵥ_apply

@[simp]
theorem withDensityᵥ_zero : μ.withDensityᵥ (0 : α → E) = 0 :=
  by
  ext1 s hs
  erw [with_densityᵥ_apply (integrable_zero α E μ) hs]
  simp
#align measure_theory.with_densityᵥ_zero MeasureTheory.withDensityᵥ_zero

@[simp]
theorem withDensityᵥ_neg : μ.withDensityᵥ (-f) = -μ.withDensityᵥ f :=
  by
  by_cases hf : integrable f μ
  · ext1 i hi
    rw [vector_measure.neg_apply, with_densityᵥ_apply hf hi, ← integral_neg,
      with_densityᵥ_apply hf.neg hi]
    rfl
  · rw [with_densityᵥ, with_densityᵥ, dif_neg hf, dif_neg, neg_zero]
    rwa [integrable_neg_iff]
#align measure_theory.with_densityᵥ_neg MeasureTheory.withDensityᵥ_neg

theorem withDensityᵥ_neg' : (μ.withDensityᵥ fun x => -f x) = -μ.withDensityᵥ f :=
  withDensityᵥ_neg
#align measure_theory.with_densityᵥ_neg' MeasureTheory.withDensityᵥ_neg'

@[simp]
theorem withDensityᵥ_add (hf : Integrable f μ) (hg : Integrable g μ) :
    μ.withDensityᵥ (f + g) = μ.withDensityᵥ f + μ.withDensityᵥ g :=
  by
  ext1 i hi
  rw [with_densityᵥ_apply (hf.add hg) hi, vector_measure.add_apply, with_densityᵥ_apply hf hi,
    with_densityᵥ_apply hg hi]
  simp_rw [Pi.add_apply]
  rw [integral_add] <;> rw [← integrable_on_univ]
  · exact hf.integrable_on.restrict MeasurableSet.univ
  · exact hg.integrable_on.restrict MeasurableSet.univ
#align measure_theory.with_densityᵥ_add MeasureTheory.withDensityᵥ_add

theorem withDensityᵥ_add' (hf : Integrable f μ) (hg : Integrable g μ) :
    (μ.withDensityᵥ fun x => f x + g x) = μ.withDensityᵥ f + μ.withDensityᵥ g :=
  withDensityᵥ_add hf hg
#align measure_theory.with_densityᵥ_add' MeasureTheory.withDensityᵥ_add'

@[simp]
theorem withDensityᵥ_sub (hf : Integrable f μ) (hg : Integrable g μ) :
    μ.withDensityᵥ (f - g) = μ.withDensityᵥ f - μ.withDensityᵥ g := by
  rw [sub_eq_add_neg, sub_eq_add_neg, with_densityᵥ_add hf hg.neg, with_densityᵥ_neg]
#align measure_theory.with_densityᵥ_sub MeasureTheory.withDensityᵥ_sub

theorem withDensityᵥ_sub' (hf : Integrable f μ) (hg : Integrable g μ) :
    (μ.withDensityᵥ fun x => f x - g x) = μ.withDensityᵥ f - μ.withDensityᵥ g :=
  withDensityᵥ_sub hf hg
#align measure_theory.with_densityᵥ_sub' MeasureTheory.withDensityᵥ_sub'

@[simp]
theorem withDensityᵥ_smul {𝕜 : Type _} [NontriviallyNormedField 𝕜] [NormedSpace 𝕜 E]
    [SMulCommClass ℝ 𝕜 E] (f : α → E) (r : 𝕜) : μ.withDensityᵥ (r • f) = r • μ.withDensityᵥ f :=
  by
  by_cases hf : integrable f μ
  · ext1 i hi
    rw [with_densityᵥ_apply (hf.smul r) hi, vector_measure.smul_apply, with_densityᵥ_apply hf hi, ←
      integral_smul r f]
    rfl
  · by_cases hr : r = 0
    · rw [hr, zero_smul, zero_smul, with_densityᵥ_zero]
    · rw [with_densityᵥ, with_densityᵥ, dif_neg hf, dif_neg, smul_zero]
      rwa [integrable_smul_iff hr f]
#align measure_theory.with_densityᵥ_smul MeasureTheory.withDensityᵥ_smul

theorem withDensityᵥ_smul' {𝕜 : Type _} [NontriviallyNormedField 𝕜] [NormedSpace 𝕜 E]
    [SMulCommClass ℝ 𝕜 E] (f : α → E) (r : 𝕜) :
    (μ.withDensityᵥ fun x => r • f x) = r • μ.withDensityᵥ f :=
  withDensityᵥ_smul f r
#align measure_theory.with_densityᵥ_smul' MeasureTheory.withDensityᵥ_smul'

theorem Measure.withDensityᵥAbsolutelyContinuous (μ : Measure α) (f : α → ℝ) :
    μ.withDensityᵥ f ≪ᵥ μ.toEnnrealVectorMeasure :=
  by
  by_cases hf : integrable f μ
  · refine' vector_measure.absolutely_continuous.mk fun i hi₁ hi₂ => _
    rw [to_ennreal_vector_measure_apply_measurable hi₁] at hi₂
    rw [with_densityᵥ_apply hf hi₁, measure.restrict_zero_set hi₂, integral_zero_measure]
  · rw [with_densityᵥ, dif_neg hf]
    exact vector_measure.absolutely_continuous.zero _
#align measure_theory.measure.with_densityᵥ_absolutely_continuous MeasureTheory.Measure.withDensityᵥAbsolutelyContinuous

/-- Having the same density implies the underlying functions are equal almost everywhere. -/
theorem Integrable.ae_eq_of_withDensityᵥ_eq {f g : α → E} (hf : Integrable f μ)
    (hg : Integrable g μ) (hfg : μ.withDensityᵥ f = μ.withDensityᵥ g) : f =ᵐ[μ] g :=
  by
  refine' hf.ae_eq_of_forall_set_integral_eq f g hg fun i hi _ => _
  rw [← with_densityᵥ_apply hf hi, hfg, with_densityᵥ_apply hg hi]
#align measure_theory.integrable.ae_eq_of_with_densityᵥ_eq MeasureTheory.Integrable.ae_eq_of_withDensityᵥ_eq

theorem WithDensityᵥEq.congr_ae {f g : α → E} (h : f =ᵐ[μ] g) :
    μ.withDensityᵥ f = μ.withDensityᵥ g :=
  by
  by_cases hf : integrable f μ
  · ext (i hi)
    rw [with_densityᵥ_apply hf hi, with_densityᵥ_apply (hf.congr h) hi]
    exact integral_congr_ae (ae_restrict_of_ae h)
  · have hg : ¬integrable g μ := by
      intro hg
      exact hf (hg.congr h.symm)
    rw [with_densityᵥ, with_densityᵥ, dif_neg hf, dif_neg hg]
#align measure_theory.with_densityᵥ_eq.congr_ae MeasureTheory.WithDensityᵥEq.congr_ae

theorem Integrable.withDensityᵥ_eq_iff {f g : α → E} (hf : Integrable f μ) (hg : Integrable g μ) :
    μ.withDensityᵥ f = μ.withDensityᵥ g ↔ f =ᵐ[μ] g :=
  ⟨fun hfg => hf.ae_eq_of_withDensityᵥ_eq hg hfg, fun h => WithDensityᵥEq.congr_ae h⟩
#align measure_theory.integrable.with_densityᵥ_eq_iff MeasureTheory.Integrable.withDensityᵥ_eq_iff

section SignedMeasure

theorem withDensityᵥ_toReal {f : α → ℝ≥0∞} (hfm : AeMeasurable f μ) (hf : (∫⁻ x, f x ∂μ) ≠ ∞) :
    (μ.withDensityᵥ fun x => (f x).toReal) =
      @toSignedMeasure α _ (μ.withDensity f) (isFiniteMeasureWithDensity hf) :=
  by
  have hfi := integrable_to_real_of_lintegral_ne_top hfm hf
  ext (i hi)
  rw [with_densityᵥ_apply hfi hi, to_signed_measure_apply_measurable hi, with_density_apply _ hi,
    integral_to_real hfm.restrict]
  refine' ae_lt_top' hfm.restrict (ne_top_of_le_ne_top hf _)
  conv_rhs => rw [← set_lintegral_univ]
  exact lintegral_mono_set (Set.subset_univ _)
#align measure_theory.with_densityᵥ_to_real MeasureTheory.withDensityᵥ_toReal

theorem withDensityᵥ_eq_withDensity_pos_part_sub_withDensity_neg_part {f : α → ℝ}
    (hfi : Integrable f μ) :
    μ.withDensityᵥ f =
      @toSignedMeasure α _ (μ.withDensity fun x => ENNReal.ofReal <| f x)
          (isFiniteMeasureWithDensityOfReal hfi.2) -
        @toSignedMeasure α _ (μ.withDensity fun x => ENNReal.ofReal <| -f x)
          (isFiniteMeasureWithDensityOfReal hfi.neg.2) :=
  by
  ext (i hi)
  rw [with_densityᵥ_apply hfi hi,
    integral_eq_lintegral_pos_part_sub_lintegral_neg_part hfi.integrable_on,
    vector_measure.sub_apply, to_signed_measure_apply_measurable hi,
    to_signed_measure_apply_measurable hi, with_density_apply _ hi, with_density_apply _ hi]
#align measure_theory.with_densityᵥ_eq_with_density_pos_part_sub_with_density_neg_part MeasureTheory.withDensityᵥ_eq_withDensity_pos_part_sub_withDensity_neg_part

theorem Integrable.withDensityᵥ_trim_eq_integral {m m0 : MeasurableSpace α} {μ : Measure α}
    (hm : m ≤ m0) {f : α → ℝ} (hf : Integrable f μ) {i : Set α} (hi : measurable_set[m] i) :
    (μ.withDensityᵥ f).trim hm i = ∫ x in i, f x ∂μ := by
  rw [vector_measure.trim_measurable_set_eq hm hi, with_densityᵥ_apply hf (hm _ hi)]
#align measure_theory.integrable.with_densityᵥ_trim_eq_integral MeasureTheory.Integrable.withDensityᵥ_trim_eq_integral

theorem Integrable.withDensityᵥTrimAbsolutelyContinuous {m m0 : MeasurableSpace α} {μ : Measure α}
    (hm : m ≤ m0) (hfi : Integrable f μ) :
    (μ.withDensityᵥ f).trim hm ≪ᵥ (μ.trim hm).toEnnrealVectorMeasure :=
  by
  refine' vector_measure.absolutely_continuous.mk fun j hj₁ hj₂ => _
  rw [measure.to_ennreal_vector_measure_apply_measurable hj₁, trim_measurable_set_eq hm hj₁] at hj₂
  rw [vector_measure.trim_measurable_set_eq hm hj₁, with_densityᵥ_apply hfi (hm _ hj₁)]
  simp only [measure.restrict_eq_zero.mpr hj₂, integral_zero_measure]
#align measure_theory.integrable.with_densityᵥ_trim_absolutely_continuous MeasureTheory.Integrable.withDensityᵥTrimAbsolutelyContinuous

end SignedMeasure

end MeasureTheory


import algebra.group algebra.group_power

variables {G: Type*} (a b : G)

@[symm] theorem gpow_add' {G : Type*} [group G] (a : G) (i : ℤ): a^(i + 1) = a * a^i :=
by rw [add_comm, gpow_add]; simp

@[symm] theorem gpow_add'' {G : Type*} [group G] (a : G) (i : ℤ): a^(i + 1) = a^i * a :=
by rw [gpow_add]; simp

def Q04H {G : Type*} [group G] (a b : G) (i : ℤ): Prop :=
(a * b)^i = a^i * b^i

theorem Q04Alt [group G]
(H : ∀ a b : G,
∃ i : ℤ, (Q04H a b i) ∧ (Q04H a b (i + 1)) ∧ (Q04H a b (i + 1 + 1)) ) :
∀ a b : G, a * b = b * a := λ a b : G,
exists.elim (H a b)
(λ i Hi,
have H1 : b * a^i = a^i * b, from
    have H10 : (a * b)^(i + 1) = a^(i + 1) * b^(i + 1), from Hi.2.1,
    have H11 : (a*b) * (a*b)^i = (a * a^i) * (b * b^i),
        by {rw [(gpow_add' (a*b) i).symm, (gpow_add' a i).symm, (gpow_add' b i).symm], exact H10},
    have H12 : a * ( b * (a*b)^i) = a * (a^i * (b * b^i)),
        by {rw [mul_assoc, mul_assoc] at H11, exact H11},
    have H13 : b * (a*b)^i = a^i * (b * b^i), from mul_left_cancel H12,
    have H14 : b * (a^i * b^i) = a^i * (b * b^i), from Hi.1 ▸ H13,
    have H15 : b * a^i * b^i = a^i * b * b^i, from by {rw [mul_assoc, mul_assoc], exact H14},
(mul_right_inj (b^i)).mp H15,

show a * b = b * a, from
    have H20 : a * b * (a * b)^(i+1) =  a * a^(i+1) * (b * b^(i+1)),
        by {rw [(gpow_add' (a*b) (i+1)).symm, (gpow_add' a (i+1)).symm, (gpow_add' b (i+1)).symm], exact Hi.2.2},
    have H21 : a * b * (a^(i+1)*b^(i+1)) = a * a^(i+1) * (b * b^(i+1)), from Hi.2.1 ▸ H20,
    have H22 : a * b * a^(i+1) * b^(i+1) = a * a^(i+1) * b * b^(i+1),
        by {conv {to_lhs, rw [mul_assoc]}, conv {to_rhs, rw [mul_assoc]}, exact H21},
    have H23 : a * b * a^(i+1) = a * a^(i+1) * b, from mul_right_cancel H22,
    have H24 : a * (b * a^(i+1)) = a * (a^(i+1) * b), by {rw [mul_assoc, mul_assoc] at H23; exact H23},
    have H25 : b * a^(i+1) = a^(i+1) * b, from mul_left_cancel H24,
    have H26 : b * (a^i * a) = (a^i * a) * b, from (gpow_add'' a i) ▸ H25,
    have H27 : b * a^i * a = a^i * a * b, by {rw [mul_assoc], exact H26},
    have H28 : a^i * b * a = a^i * a * b, from H1 ▸ H27,
    have H29 : a^i * (b * a) = a^i * (a * b), by {rw [mul_assoc, mul_assoc] at H28, exact H28},
    have H30 : b * a = a * b, from mul_left_cancel H29,
H30.symm )

/-
theorem Q04AltAlt [group G] :
(∀ a b : G,
(∃ i : ℤ, (Q04H a b i) ∧ (Q04H a b (i + 1)) ∧ (Q04H a b (i + 2))))
→ ∀ a b : G, a * b = b * a :=
begin
    intro H0,
    intros a b,
    apply exists.elim (H0 a b),
    intros i Hi,
    unfold Q04H at Hi,
    have H1 : a^i * b = b * a^i,
        apply (mul_right_inj (b^i)).1,
        apply eq.symm,
        rw mul_assoc,
        rw ←(Hi.1),
        apply (mul_left_inj (a)).1,
        rw [←mul_assoc, ←mul_assoc, ←mul_assoc],
        rw [←gpow_add', ←gpow_add', mul_assoc, ←gpow_add'],
    from Hi.2.1,

    let H3  : _ ^ ( i + ( 1 + 1)) = _ := Hi.2.2,
    rw ←add_assoc at H3,
    rw gpow_add' at H3,
    rw (show i + 2 = (i + 1) + 1, by rw [add_assoc];refl) at H3,
    conv at H3 begin
      to_rhs,
      rw gpow_add',
    end,
    rw gpow_add' at H3,
    rw [mul_assoc, mul_assoc a (a^(i + 1))] at H3,
    rw mul_left_inj at H3,
    rw Hi.1 at H3,
    rw (gpow_add' b ) at H3,
    rw (gpow_add' b ) at H3,
    repeat {rw [←mul_assoc] at H3},
    rw mul_right_inj at H3,
    rw (gpow_add' a) at H3,
    rw mul_assoc (a) at H3,
    rw (H1) at H3,
    rw [mul_assoc a] at H3,
    rw mul_assoc b (a^i) b at H3,
    rw H1 at H3,
    repeat {rw [←mul_assoc] at H3},
    rw mul_right_inj at H3,
    rw mul_right_inj at H3,
    rw H3,
end -/