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

/-!
# Tangent cone

In this file, we define two predicates `unique_diff_within_at 𝕜 s x` and `unique_diff_on 𝕜 s`
ensuring that, if a function has two derivatives, then they have to coincide. As a direct
definition of this fact (quantifying on all target types and all functions) would depend on
universes, we use a more intrinsic definition: if all the possible tangent directions to the set
`s` at the point `x` span a dense subset of the whole subset, it is easy to check that the
derivative has to be unique.

Therefore, we introduce the set of all tangent directions, named `tangent_cone_at`,
and express `unique_diff_within_at` and `unique_diff_on` in terms of it.
One should however think of this definition as an implementation detail: the only reason to
introduce the predicates `unique_diff_within_at` and `unique_diff_on` is to ensure the uniqueness
of the derivative. This is why their names reflect their uses, and not how they are defined.

## Implementation details

Note that this file is imported by `fderiv.lean`. Hence, derivatives are not defined yet. The
property of uniqueness of the derivative is therefore proved in `fderiv.lean`, but based on the
properties of the tangent cone we prove here.
-/

variables (𝕜 : Type*) [nontrivially_normed_field 𝕜]

open filter set
open_locale topology

section tangent_cone

variables {E : Type*} [add_comm_monoid E] [module 𝕜 E] [topological_space E]

/-- The set of all tangent directions to the set `s` at the point `x`. -/
def tangent_cone_at (s : set E) (x : E) : set E :=
{y : E | ∃(c : ℕ → 𝕜) (d : ℕ → E), (∀ᶠ n in at_top, x + d n ∈ s) ∧
  (tendsto (λn, ‖c n‖) at_top at_top) ∧ (tendsto (λn, c n • d n) at_top (𝓝 y))}

/-- A property ensuring that the tangent cone to `s` at `x` spans a dense subset of the whole space.
The main role of this property is to ensure that the differential within `s` at `x` is unique,
hence this name. The uniqueness it asserts is proved in `unique_diff_within_at.eq` in `fderiv.lean`.
To avoid pathologies in dimension 0, we also require that `x` belongs to the closure of `s` (which
is automatic when `E` is not `0`-dimensional).
 -/
@[mk_iff] structure unique_diff_within_at (s : set E) (x : E) : Prop :=
(dense_tangent_cone : dense ((submodule.span 𝕜 (tangent_cone_at 𝕜 s x)) : set E))
(mem_closure : x ∈ closure s)

/-- A property ensuring that the tangent cone to `s` at any of its points spans a dense subset of
the whole space.  The main role of this property is to ensure that the differential along `s` is
unique, hence this name. The uniqueness it asserts is proved in `unique_diff_on.eq` in
`fderiv.lean`. -/
def unique_diff_on (s : set E) : Prop :=
∀x ∈ s, unique_diff_within_at 𝕜 s x

end tangent_cone

variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
variables {G : Type*} [normed_add_comm_group G] [normed_space ℝ G]
variables {𝕜} {x y : E} {s t : set E}

section tangent_cone
/- This section is devoted to the properties of the tangent cone. -/

open normed_field

lemma tangent_cone_univ : tangent_cone_at 𝕜 univ x = univ :=
begin
  refine univ_subset_iff.1 (λy hy, _),
  rcases exists_one_lt_norm 𝕜 with ⟨w, hw⟩,
  refine ⟨λn, w^n, λn, (w^n)⁻¹ • y, univ_mem' (λn, mem_univ _),  _, _⟩,
  { simp only [norm_pow],
    exact tendsto_pow_at_top_at_top_of_one_lt hw },
  { convert tendsto_const_nhds,
    ext n,
    have : w ^ n * (w ^ n)⁻¹ = 1,
    { apply mul_inv_cancel,
      apply pow_ne_zero,
      simpa [norm_eq_zero] using (ne_of_lt (lt_trans zero_lt_one hw)).symm },
    rw [smul_smul, this, one_smul] }
end

lemma tangent_cone_mono (h : s ⊆ t) :
  tangent_cone_at 𝕜 s x ⊆ tangent_cone_at 𝕜 t x :=
begin
  rintros y ⟨c, d, ds, ctop, clim⟩,
  exact ⟨c, d, mem_of_superset ds (λn hn, h hn), ctop, clim⟩
end

/-- Auxiliary lemma ensuring that, under the assumptions defining the tangent cone,
the sequence `d` tends to 0 at infinity. -/
lemma tangent_cone_at.lim_zero {α : Type*} (l : filter α) {c : α → 𝕜} {d : α → E}
  (hc : tendsto (λn, ‖c n‖) l at_top) (hd : tendsto (λn, c n • d n) l (𝓝 y)) :
  tendsto d l (𝓝 0) :=
begin
  have A : tendsto (λn, ‖c n‖⁻¹) l (𝓝 0) := tendsto_inv_at_top_zero.comp hc,
  have B : tendsto (λn, ‖c n • d n‖) l (𝓝 ‖y‖) :=
    (continuous_norm.tendsto _).comp hd,
  have C : tendsto (λn, ‖c n‖⁻¹ * ‖c n • d n‖) l (𝓝 (0 * ‖y‖)) := A.mul B,
  rw zero_mul at C,
  have : ∀ᶠ n in l, ‖c n‖⁻¹ * ‖c n • d n‖ = ‖d n‖,
  { apply (eventually_ne_of_tendsto_norm_at_top hc 0).mono (λn hn, _),
    rw [norm_smul, ← mul_assoc, inv_mul_cancel, one_mul],
    rwa [ne.def, norm_eq_zero] },
  have D : tendsto (λ n, ‖d n‖) l (𝓝 0) :=
    tendsto.congr' this C,
  rw tendsto_zero_iff_norm_tendsto_zero,
  exact D
end

lemma tangent_cone_mono_nhds (h : 𝓝[s] x ≤ 𝓝[t] x) :
  tangent_cone_at 𝕜 s x ⊆ tangent_cone_at 𝕜 t x :=
begin
  rintros y ⟨c, d, ds, ctop, clim⟩,
  refine ⟨c, d, _, ctop, clim⟩,
  suffices : tendsto (λ n, x + d n) at_top (𝓝[t] x),
    from tendsto_principal.1 (tendsto_inf.1 this).2,
  refine (tendsto_inf.2 ⟨_, tendsto_principal.2 ds⟩).mono_right h,
  simpa only [add_zero] using tendsto_const_nhds.add (tangent_cone_at.lim_zero at_top ctop clim)
end

/-- Tangent cone of `s` at `x` depends only on `𝓝[s] x`. -/
lemma tangent_cone_congr (h : 𝓝[s] x = 𝓝[t] x) :
  tangent_cone_at 𝕜 s x = tangent_cone_at 𝕜 t x :=
subset.antisymm
  (tangent_cone_mono_nhds $ le_of_eq h)
  (tangent_cone_mono_nhds $ le_of_eq h.symm)

/-- Intersecting with a neighborhood of the point does not change the tangent cone. -/
lemma tangent_cone_inter_nhds (ht : t ∈ 𝓝 x) :
  tangent_cone_at 𝕜 (s ∩ t) x = tangent_cone_at 𝕜 s x :=
tangent_cone_congr (nhds_within_restrict' _ ht).symm

/-- The tangent cone of a product contains the tangent cone of its left factor. -/
lemma subset_tangent_cone_prod_left {t : set F} {y : F} (ht : y ∈ closure t) :
  linear_map.inl 𝕜 E F '' (tangent_cone_at 𝕜 s x) ⊆ tangent_cone_at 𝕜 (s ×ˢ t) (x, y) :=
begin
  rintros _ ⟨v, ⟨c, d, hd, hc, hy⟩, rfl⟩,
  have : ∀n, ∃d', y + d' ∈ t ∧ ‖c n • d'‖ < ((1:ℝ)/2)^n,
  { assume n,
    rcases mem_closure_iff_nhds.1 ht _ (eventually_nhds_norm_smul_sub_lt (c n) y
      (pow_pos one_half_pos n)) with ⟨z, hz, hzt⟩,
    exact ⟨z - y, by simpa using hzt, by simpa using hz⟩ },
  choose d' hd' using this,
  refine ⟨c, λn, (d n, d' n), _, hc, _⟩,
  show ∀ᶠ n in at_top, (x, y) + (d n, d' n) ∈ s ×ˢ t,
  { filter_upwards [hd] with n hn,
    simp [hn, (hd' n).1] },
  { apply tendsto.prod_mk_nhds hy _,
    refine squeeze_zero_norm (λn, (hd' n).2.le) _,
    exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one }
end

/-- The tangent cone of a product contains the tangent cone of its right factor. -/
lemma subset_tangent_cone_prod_right {t : set F} {y : F}
  (hs : x ∈ closure s) :
  linear_map.inr 𝕜 E F '' (tangent_cone_at 𝕜 t y) ⊆ tangent_cone_at 𝕜 (s ×ˢ t) (x, y) :=
begin
  rintros _ ⟨w, ⟨c, d, hd, hc, hy⟩, rfl⟩,
  have : ∀n, ∃d', x + d' ∈ s ∧ ‖c n • d'‖ < ((1:ℝ)/2)^n,
  { assume n,
    rcases mem_closure_iff_nhds.1 hs _ (eventually_nhds_norm_smul_sub_lt (c n) x
      (pow_pos one_half_pos n)) with ⟨z, hz, hzs⟩,
    exact ⟨z - x, by simpa using hzs, by simpa using hz⟩ },
  choose d' hd' using this,
  refine ⟨c, λn, (d' n, d n), _, hc, _⟩,
  show ∀ᶠ n in at_top, (x, y) + (d' n, d n) ∈ s ×ˢ t,
  { filter_upwards [hd] with n hn,
    simp [hn, (hd' n).1] },
  { apply tendsto.prod_mk_nhds _ hy,
    refine squeeze_zero_norm (λn, (hd' n).2.le) _,
    exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one }
end

/-- The tangent cone of a product contains the tangent cone of each factor. -/
lemma maps_to_tangent_cone_pi {ι : Type*} [decidable_eq ι] {E : ι → Type*}
  [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)]
  {s : Π i, set (E i)} {x : Π i, E i} {i : ι} (hi : ∀ j ≠ i, x j ∈ closure (s j)) :
  maps_to (linear_map.single i : E i →ₗ[𝕜] Π j, E j) (tangent_cone_at 𝕜 (s i) (x i))
    (tangent_cone_at 𝕜 (set.pi univ s) x) :=
begin
  rintros w ⟨c, d, hd, hc, hy⟩,
  have : ∀ n (j ≠ i), ∃ d', x j + d' ∈ s j ∧ ‖c n • d'‖ < (1 / 2 : ℝ) ^ n,
  { assume n j hj,
    rcases mem_closure_iff_nhds.1 (hi j hj) _ (eventually_nhds_norm_smul_sub_lt (c n) (x j)
      (pow_pos one_half_pos n)) with ⟨z, hz, hzs⟩,
    exact ⟨z - x j, by simpa using hzs, by simpa using hz⟩ },
  choose! d' hd's hcd',
  refine ⟨c, λ n, function.update (d' n) i (d n), hd.mono (λ n hn j hj', _), hc,
    tendsto_pi_nhds.2 $ λ j, _⟩,
  { rcases em (j = i) with rfl|hj; simp * },
  { rcases em (j = i) with rfl|hj,
    { simp [hy] },
    { suffices : tendsto (λ n, c n • d' n j) at_top (𝓝 0), by simpa [hj],
      refine squeeze_zero_norm (λ n, (hcd' n j hj).le) _,
      exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one } }
end

/-- If a subset of a real vector space contains an open segment, then the direction of this
segment belongs to the tangent cone at its endpoints. -/
lemma mem_tangent_cone_of_open_segment_subset {s : set G} {x y : G} (h : open_segment ℝ x y ⊆ s) :
  y - x ∈ tangent_cone_at ℝ s x :=
begin
  let c := λn:ℕ, (2:ℝ)^(n+1),
  let d := λn:ℕ, (c n)⁻¹ • (y-x),
  refine ⟨c, d, filter.univ_mem' (λn, h _), _, _⟩,
  show x + d n ∈ open_segment ℝ x y,
  { rw open_segment_eq_image,
    refine ⟨(c n)⁻¹, ⟨_, _⟩, _⟩,
    { rw inv_pos, apply pow_pos, norm_num },
    { apply inv_lt_one, apply one_lt_pow _ (nat.succ_ne_zero _), norm_num },
    { simp only [d, sub_smul, smul_sub, one_smul], abel } },
  show filter.tendsto (λ (n : ℕ), ‖c n‖) filter.at_top filter.at_top,
  { have : (λ (n : ℕ), ‖c n‖) = c,
      by { ext n, exact abs_of_nonneg (pow_nonneg (by norm_num) _) },
    rw this,
    exact (tendsto_pow_at_top_at_top_of_one_lt (by norm_num)).comp (tendsto_add_at_top_nat 1) },
  show filter.tendsto (λ (n : ℕ), c n • d n) filter.at_top (𝓝 (y - x)),
  { have : (λ (n : ℕ), c n • d n) = (λn, y - x),
    { ext n,
      simp only [d, smul_smul],
      rw [mul_inv_cancel, one_smul],
      exact pow_ne_zero _ (by norm_num) },
    rw this,
    apply tendsto_const_nhds }
end

/-- If a subset of a real vector space contains a segment, then the direction of this
segment belongs to the tangent cone at its endpoints. -/
lemma mem_tangent_cone_of_segment_subset {s : set G} {x y : G} (h : segment ℝ x y ⊆ s) :
  y - x ∈ tangent_cone_at ℝ s x :=
mem_tangent_cone_of_open_segment_subset ((open_segment_subset_segment ℝ x y).trans h)

end tangent_cone

section unique_diff
/-!
### Properties of `unique_diff_within_at` and `unique_diff_on`

This section is devoted to properties of the predicates
`unique_diff_within_at` and `unique_diff_on`. -/

lemma unique_diff_on.unique_diff_within_at {s : set E} {x} (hs : unique_diff_on 𝕜 s) (h : x ∈ s) :
  unique_diff_within_at 𝕜 s x :=
hs x h

lemma unique_diff_within_at_univ : unique_diff_within_at 𝕜 univ x :=
by { rw [unique_diff_within_at_iff, tangent_cone_univ], simp }

lemma unique_diff_on_univ : unique_diff_on 𝕜 (univ : set E) :=
λx hx, unique_diff_within_at_univ

lemma unique_diff_on_empty : unique_diff_on 𝕜 (∅ : set E) :=
λ x hx, hx.elim

lemma unique_diff_within_at.mono_nhds (h : unique_diff_within_at 𝕜 s x)
  (st : 𝓝[s] x ≤ 𝓝[t] x) :
  unique_diff_within_at 𝕜 t x :=
begin
  simp only [unique_diff_within_at_iff] at *,
  rw [mem_closure_iff_nhds_within_ne_bot] at h ⊢,
  exact ⟨h.1.mono $ submodule.span_mono $ tangent_cone_mono_nhds st,
    h.2.mono st⟩
end

lemma unique_diff_within_at.mono (h : unique_diff_within_at 𝕜 s x) (st : s ⊆ t) :
  unique_diff_within_at 𝕜 t x :=
h.mono_nhds $ nhds_within_mono _ st

lemma unique_diff_within_at_congr (st : 𝓝[s] x = 𝓝[t] x) :
  unique_diff_within_at 𝕜 s x ↔ unique_diff_within_at 𝕜 t x :=
⟨λ h, h.mono_nhds $ le_of_eq st, λ h, h.mono_nhds $ le_of_eq st.symm⟩

lemma unique_diff_within_at_inter (ht : t ∈ 𝓝 x) :
  unique_diff_within_at 𝕜 (s ∩ t) x ↔ unique_diff_within_at 𝕜 s x :=
unique_diff_within_at_congr $ (nhds_within_restrict' _ ht).symm

lemma unique_diff_within_at.inter (hs : unique_diff_within_at 𝕜 s x) (ht : t ∈ 𝓝 x) :
  unique_diff_within_at 𝕜 (s ∩ t) x :=
(unique_diff_within_at_inter ht).2 hs

lemma unique_diff_within_at_inter' (ht : t ∈ 𝓝[s] x) :
  unique_diff_within_at 𝕜 (s ∩ t) x ↔ unique_diff_within_at 𝕜 s x :=
unique_diff_within_at_congr $ (nhds_within_restrict'' _ ht).symm

lemma unique_diff_within_at.inter' (hs : unique_diff_within_at 𝕜 s x) (ht : t ∈ 𝓝[s] x) :
  unique_diff_within_at 𝕜 (s ∩ t) x :=
(unique_diff_within_at_inter' ht).2 hs

lemma unique_diff_within_at_of_mem_nhds (h : s ∈ 𝓝 x) : unique_diff_within_at 𝕜 s x :=
by simpa only [univ_inter] using unique_diff_within_at_univ.inter h

lemma is_open.unique_diff_within_at (hs : is_open s) (xs : x ∈ s) : unique_diff_within_at 𝕜 s x :=
unique_diff_within_at_of_mem_nhds (is_open.mem_nhds hs xs)

lemma unique_diff_on.inter (hs : unique_diff_on 𝕜 s) (ht : is_open t) : unique_diff_on 𝕜 (s ∩ t) :=
λx hx, (hs x hx.1).inter (is_open.mem_nhds ht hx.2)

lemma is_open.unique_diff_on (hs : is_open s) : unique_diff_on 𝕜 s :=
λx hx, is_open.unique_diff_within_at hs hx

/-- The product of two sets of unique differentiability at points `x` and `y` has unique
differentiability at `(x, y)`. -/
lemma unique_diff_within_at.prod {t : set F} {y : F}
  (hs : unique_diff_within_at 𝕜 s x) (ht : unique_diff_within_at 𝕜 t y) :
  unique_diff_within_at 𝕜 (s ×ˢ t) (x, y) :=
begin
  rw [unique_diff_within_at_iff] at ⊢ hs ht,
  rw [closure_prod_eq],
  refine ⟨_, hs.2, ht.2⟩,
  have : _ ≤ submodule.span 𝕜 (tangent_cone_at 𝕜 (s ×ˢ t) (x, y)) :=
    submodule.span_mono (union_subset (subset_tangent_cone_prod_left ht.2)
      (subset_tangent_cone_prod_right hs.2)),
  rw [linear_map.span_inl_union_inr, set_like.le_def] at this,
  exact (hs.1.prod ht.1).mono this
end

lemma unique_diff_within_at.univ_pi (ι : Type*) [finite ι] (E : ι → Type*)
  [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (x : Π i, E i) (h : ∀ i, unique_diff_within_at 𝕜 (s i) (x i)) :
  unique_diff_within_at 𝕜 (set.pi univ s) x :=
begin
  classical,
  simp only [unique_diff_within_at_iff, closure_pi_set] at h ⊢,
  refine ⟨(dense_pi univ (λ i _, (h i).1)).mono _, λ i _, (h i).2⟩,
  norm_cast,
  simp only [← submodule.supr_map_single, supr_le_iff, linear_map.map_span, submodule.span_le,
    ← maps_to'],
  exact λ i, (maps_to_tangent_cone_pi $ λ j hj, (h j).2).mono subset.rfl submodule.subset_span
end

lemma unique_diff_within_at.pi (ι : Type*) [finite ι] (E : ι → Type*)
  [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (x : Π i, E i) (I : set ι)
  (h : ∀ i ∈ I, unique_diff_within_at 𝕜 (s i) (x i)) :
  unique_diff_within_at 𝕜 (set.pi I s) x :=
begin
  classical,
  rw [← set.univ_pi_piecewise],
  refine unique_diff_within_at.univ_pi _ _ _ _ (λ i, _),
  by_cases hi : i ∈ I; simp [*, unique_diff_within_at_univ],
end

/-- The product of two sets of unique differentiability is a set of unique differentiability. -/
lemma unique_diff_on.prod {t : set F} (hs : unique_diff_on 𝕜 s) (ht : unique_diff_on 𝕜 t) :
  unique_diff_on 𝕜 (s ×ˢ t) :=
λ ⟨x, y⟩ h, unique_diff_within_at.prod (hs x h.1) (ht y h.2)

/-- The finite product of a family of sets of unique differentiability is a set of unique
differentiability. -/
lemma unique_diff_on.pi (ι : Type*) [finite ι] (E : ι → Type*)
  [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (I : set ι) (h : ∀ i ∈ I, unique_diff_on 𝕜 (s i)) :
  unique_diff_on 𝕜 (set.pi I s) :=
λ x hx, unique_diff_within_at.pi _ _ _ _ _ $ λ i hi, h i hi (x i) (hx i hi)

/-- The finite product of a family of sets of unique differentiability is a set of unique
differentiability. -/
lemma unique_diff_on.univ_pi (ι : Type*) [finite ι] (E : ι → Type*)
  [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (h : ∀ i, unique_diff_on 𝕜 (s i)) :
  unique_diff_on 𝕜 (set.pi univ s) :=
unique_diff_on.pi _ _ _ _ $ λ i _, h i

/-- In a real vector space, a convex set with nonempty interior is a set of unique
differentiability at every point of its closure. -/
theorem unique_diff_within_at_convex {s : set G} (conv : convex ℝ s) (hs : (interior s).nonempty)
  {x : G} (hx : x ∈ closure s) : unique_diff_within_at ℝ s x :=
begin
  rcases hs with ⟨y, hy⟩,
  suffices : y - x ∈ interior (tangent_cone_at ℝ s x),
  { refine ⟨dense.of_closure _, hx⟩,
    simp [(submodule.span ℝ (tangent_cone_at ℝ s x)).eq_top_of_nonempty_interior'
      ⟨y - x, interior_mono submodule.subset_span this⟩] },
  rw [mem_interior_iff_mem_nhds],
  replace hy : interior s ∈ 𝓝 y := is_open.mem_nhds is_open_interior hy,
  apply mem_of_superset ((is_open_map_sub_right x).image_mem_nhds hy),
  rintros _ ⟨z, zs, rfl⟩,
  refine mem_tangent_cone_of_open_segment_subset (subset.trans _ interior_subset),
  exact conv.open_segment_closure_interior_subset_interior hx zs,
end

/-- In a real vector space, a convex set with nonempty interior is a set of unique
differentiability. -/
theorem unique_diff_on_convex {s : set G} (conv : convex ℝ s) (hs : (interior s).nonempty) :
  unique_diff_on ℝ s :=
λ x xs, unique_diff_within_at_convex conv hs (subset_closure xs)

lemma unique_diff_on_Ici (a : ℝ) : unique_diff_on ℝ (Ici a) :=
unique_diff_on_convex (convex_Ici a) $ by simp only [interior_Ici, nonempty_Ioi]

lemma unique_diff_on_Iic (a : ℝ) : unique_diff_on ℝ (Iic a) :=
unique_diff_on_convex (convex_Iic a) $ by simp only [interior_Iic, nonempty_Iio]

lemma unique_diff_on_Ioi (a : ℝ) : unique_diff_on ℝ (Ioi a) :=
is_open_Ioi.unique_diff_on

lemma unique_diff_on_Iio (a : ℝ) : unique_diff_on ℝ (Iio a) :=
is_open_Iio.unique_diff_on

lemma unique_diff_on_Icc {a b : ℝ} (hab : a < b) : unique_diff_on ℝ (Icc a b) :=
unique_diff_on_convex (convex_Icc a b) $ by simp only [interior_Icc, nonempty_Ioo, hab]

lemma unique_diff_on_Ico (a b : ℝ) : unique_diff_on ℝ (Ico a b) :=
if hab : a < b
then unique_diff_on_convex (convex_Ico a b) $ by simp only [interior_Ico, nonempty_Ioo, hab]
else by simp only [Ico_eq_empty hab, unique_diff_on_empty]

lemma unique_diff_on_Ioc (a b : ℝ) : unique_diff_on ℝ (Ioc a b) :=
if hab : a < b
then unique_diff_on_convex (convex_Ioc a b) $ by simp only [interior_Ioc, nonempty_Ioo, hab]
else by simp only [Ioc_eq_empty hab, unique_diff_on_empty]

lemma unique_diff_on_Ioo (a b : ℝ) : unique_diff_on ℝ (Ioo a b) :=
is_open_Ioo.unique_diff_on

/-- The real interval `[0, 1]` is a set of unique differentiability. -/
lemma unique_diff_on_Icc_zero_one : unique_diff_on ℝ (Icc (0:ℝ) 1) :=
unique_diff_on_Icc zero_lt_one

lemma unique_diff_within_at_Ioo {a b t : ℝ} (ht : t ∈ set.Ioo a b) :
  unique_diff_within_at ℝ (set.Ioo a b) t :=
is_open.unique_diff_within_at is_open_Ioo ht

lemma unique_diff_within_at_Ioi (a : ℝ) : unique_diff_within_at ℝ (Ioi a) a :=
unique_diff_within_at_convex (convex_Ioi a) (by simp) (by simp)

lemma unique_diff_within_at_Iio (a : ℝ) : unique_diff_within_at ℝ (Iio a) a :=
unique_diff_within_at_convex (convex_Iio a) (by simp) (by simp)

end unique_diff


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.ring_exp
import Mathlib.tactic.chain
import Mathlib.algebra.monoid_algebra
import Mathlib.data.finset.sort
import Mathlib.PostPort

universes u_1 u

namespace Mathlib

/-!
# Theory of univariate polynomials

Polynomials are represented as `add_monoid_algebra R ℕ`, where `R` is a commutative semiring.
In this file, we define `polynomial`, provide basic instances, and prove an `ext` lemma.
-/

/-- `polynomial R` is the type of univariate polynomials over `R`.

Polynomials should be seen as (semi-)rings with the additional constructor `X`.
The embedding from `R` is called `C`. -/
def polynomial (R : Type u_1) [semiring R] := add_monoid_algebra R ℕ

namespace polynomial

protected instance inhabited {R : Type u} [semiring R] : Inhabited (polynomial R) :=
  add_monoid_algebra.inhabited R ℕ

protected instance semiring {R : Type u} [semiring R] : semiring (polynomial R) :=
  add_monoid_algebra.semiring

protected instance semimodule {R : Type u} [semiring R] {S : Type u_1} [semiring S]
    [semimodule S R] : semimodule S (polynomial R) :=
  add_monoid_algebra.semimodule

protected instance unique {R : Type u} [semiring R] [subsingleton R] : unique (polynomial R) :=
  add_monoid_algebra.unique

@[simp] theorem support_zero {R : Type u} [semiring R] : finsupp.support 0 = ∅ := rfl

/-- `monomial s a` is the monomial `a * X^s` -/
def monomial {R : Type u} [semiring R] (n : ℕ) : linear_map R R (polynomial R) := finsupp.lsingle n

theorem monomial_zero_right {R : Type u} [semiring R] (n : ℕ) : coe_fn (monomial n) 0 = 0 :=
  finsupp.single_zero

theorem monomial_def {R : Type u} [semiring R] (n : ℕ) (a : R) :
    coe_fn (monomial n) a = finsupp.single n a :=
  rfl

theorem monomial_add {R : Type u} [semiring R] (n : ℕ) (r : R) (s : R) :
    coe_fn (monomial n) (r + s) = coe_fn (monomial n) r + coe_fn (monomial n) s :=
  finsupp.single_add

theorem monomial_mul_monomial {R : Type u} [semiring R] (n : ℕ) (m : ℕ) (r : R) (s : R) :
    coe_fn (monomial n) r * coe_fn (monomial m) s = coe_fn (monomial (n + m)) (r * s) :=
  add_monoid_algebra.single_mul_single

theorem smul_monomial {R : Type u} [semiring R] {S : Type u_1} [semiring S] [semimodule S R] (a : S)
    (n : ℕ) (b : R) : a • coe_fn (monomial n) b = coe_fn (monomial n) (a • b) :=
  finsupp.smul_single a n b

/-- `X` is the polynomial variable (aka indeterminant). -/
def X {R : Type u} [semiring R] : polynomial R := coe_fn (monomial 1) 1

/-- `X` commutes with everything, even when the coefficients are noncommutative. -/
theorem X_mul {R : Type u} [semiring R] {p : polynomial R} : X * p = p * X := sorry

theorem X_pow_mul {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} : X ^ n * p = p * X ^ n :=
  sorry

theorem X_pow_mul_assoc {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} {n : ℕ} :
    p * X ^ n * q = p * q * X ^ n :=
  sorry

theorem commute_X {R : Type u} [semiring R] (p : polynomial R) : commute X p := X_mul

/-- coeff p n is the coefficient of X^n in p -/
def coeff {R : Type u} [semiring R] (p : polynomial R) : ℕ → R := ⇑p

@[simp] theorem coeff_mk {R : Type u} [semiring R] (s : finset ℕ) (f : ℕ → R)
    (h : ∀ (a : ℕ), a ∈ s ↔ f a ≠ 0) : coeff (finsupp.mk s f h) = f :=
  rfl

theorem coeff_monomial {R : Type u} {a : R} {m : ℕ} {n : ℕ} [semiring R] :
    coeff (coe_fn (monomial n) a) m = ite (n = m) a 0 :=
  sorry

@[simp] theorem coeff_zero {R : Type u} [semiring R] (n : ℕ) : coeff 0 n = 0 := rfl

@[simp] theorem coeff_one_zero {R : Type u} [semiring R] : coeff 1 0 = 1 := coeff_monomial

@[simp] theorem coeff_X_one {R : Type u} [semiring R] : coeff X 1 = 1 := coeff_monomial

@[simp] theorem coeff_X_zero {R : Type u} [semiring R] : coeff X 0 = 0 := coeff_monomial

theorem coeff_X {R : Type u} {n : ℕ} [semiring R] : coeff X n = ite (1 = n) 1 0 := coeff_monomial

theorem coeff_X_of_ne_one {R : Type u} [semiring R] {n : ℕ} (hn : n ≠ 1) : coeff X n = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coeff X n = 0)) coeff_X))
    (eq.mpr (id (Eq._oldrec (Eq.refl (ite (1 = n) 1 0 = 0)) (if_neg (ne.symm hn)))) (Eq.refl 0))

theorem ext_iff {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} :
    p = q ↔ ∀ (n : ℕ), coeff p n = coeff q n :=
  finsupp.ext_iff

theorem ext {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} :
    (∀ (n : ℕ), coeff p n = coeff q n) → p = q :=
  finsupp.ext

theorem add_hom_ext' {R : Type u} [semiring R] {M : Type u_1} [add_monoid M] {f : polynomial R →+ M}
    {g : polynomial R →+ M}
    (h :
      ∀ (n : ℕ),
        add_monoid_hom.comp f (linear_map.to_add_monoid_hom (monomial n)) =
          add_monoid_hom.comp g (linear_map.to_add_monoid_hom (monomial n))) :
    f = g :=
  finsupp.add_hom_ext' h

theorem add_hom_ext {R : Type u} [semiring R] {M : Type u_1} [add_monoid M] {f : polynomial R →+ M}
    {g : polynomial R →+ M}
    (h : ∀ (n : ℕ) (a : R), coe_fn f (coe_fn (monomial n) a) = coe_fn g (coe_fn (monomial n) a)) :
    f = g :=
  finsupp.add_hom_ext h

theorem lhom_ext' {R : Type u} [semiring R] {M : Type u_1} [add_comm_monoid M] [semimodule R M]
    {f : linear_map R (polynomial R) M} {g : linear_map R (polynomial R) M}
    (h : ∀ (n : ℕ), linear_map.comp f (monomial n) = linear_map.comp g (monomial n)) : f = g :=
  finsupp.lhom_ext' h

-- this has the same content as the subsingleton

theorem eq_zero_of_eq_zero {R : Type u} [semiring R] (h : 0 = 1) (p : polynomial R) : p = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (p = 0)) (Eq.symm (one_smul R p))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 • p = 0)) (Eq.symm h)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 • p = 0)) (zero_smul R p))) (Eq.refl 0)))

theorem support_monomial {R : Type u} [semiring R] (n : ℕ) (a : R) (H : a ≠ 0) :
    finsupp.support (coe_fn (monomial n) a) = singleton n :=
  finsupp.support_single_ne_zero H

theorem support_monomial' {R : Type u} [semiring R] (n : ℕ) (a : R) :
    finsupp.support (coe_fn (monomial n) a) ⊆ singleton n :=
  finsupp.support_single_subset

theorem X_pow_eq_monomial {R : Type u} [semiring R] (n : ℕ) : X ^ n = coe_fn (monomial n) 1 := sorry

theorem support_X_pow {R : Type u} [semiring R] (H : ¬1 = 0) (n : ℕ) :
    finsupp.support (X ^ n) = singleton n :=
  sorry

theorem support_X_empty {R : Type u} [semiring R] (H : 1 = 0) : finsupp.support X = ∅ := sorry

theorem support_X {R : Type u} [semiring R] (H : ¬1 = 0) : finsupp.support X = singleton 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (finsupp.support X = singleton 1)) (Eq.symm (pow_one X))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (finsupp.support (X ^ 1) = singleton 1)) (support_X_pow H 1)))
      (Eq.refl (singleton 1)))

protected instance comm_semiring {R : Type u} [comm_semiring R] : comm_semiring (polynomial R) :=
  add_monoid_algebra.comm_semiring

protected instance ring {R : Type u} [ring R] : ring (polynomial R) := add_monoid_algebra.ring

@[simp] theorem coeff_neg {R : Type u} [ring R] (p : polynomial R) (n : ℕ) :
    coeff (-p) n = -coeff p n :=
  rfl

@[simp] theorem coeff_sub {R : Type u} [ring R] (p : polynomial R) (q : polynomial R) (n : ℕ) :
    coeff (p - q) n = coeff p n - coeff q n :=
  rfl

protected instance comm_ring {R : Type u} [comm_ring R] : comm_ring (polynomial R) :=
  add_monoid_algebra.comm_ring

protected instance nontrivial {R : Type u} [semiring R] [nontrivial R] :
    nontrivial (polynomial R) :=
  add_monoid_algebra.nontrivial

theorem X_ne_zero {R : Type u} [semiring R] [nontrivial R] : X ≠ 0 := sorry

protected instance has_repr {R : Type u} [semiring R] [has_repr R] : has_repr (polynomial R) :=
  sorry

end Mathlib


import group_theory.subgroup
import data.nat.basic

def normal_in {G : Type*} [group G] (N H : subgroup G) : Prop :=
∀ n, n ∈ N → ∀ h, h ∈ H → h * n * h⁻¹ ∈ N

infix ` ◃ `:50 := normal_in

section normal_in

variables {G : Type*} [group G]

theorem normal_in_top {N : subgroup G} : N ◃ ⊤ ↔ N.normal :=
⟨λ h, ⟨λ n hn g, h n hn g (subgroup.mem_top _)⟩, λ h n hn g hg, h.conj_mem n hn g⟩

end normal_in

structure normal_series (G : Type*) [group G] :=
(series : list (subgroup G))
(nonempty : series ≠ [])
(head : series.head = ⊥)
(last : series.last nonempty = ⊤)
(normal : ∀ (i : ℕ) (h : i + 1 < series.length),
  series.nth_le i (nat.lt_of_succ_lt h) ◃ series.nth_le (i + 1) h)

variables {G : Type*} [group G]
variable σ : normal_series G

#check σ.normal

namespace normal_series

end normal_series


import .affine_space_type
import .affine_frame
import data.real.basic

def reals_as_affine_space := affine_space_type
    ℝ
    ℝ
    ℝ

#check reals_as_affine_space

def reals_as_affine_space_1 : reals_as_affine_space  := ⟨⟩
def reals_as_affine_space_2 : reals_as_affine_space  := ⟨⟩

example : reals_as_affine_space_1 = reals_as_affine_space_2 := rfl

def a_frame : affine_frame ℝ ℝ ℝ (fin 1) :=
⟨(0 : ℝ),
(λ (n : fin 1), 1),
sorry ⟩

/-
A few things to note:

(1) We can specialize our generic affine_space_type definition
(2) We can't instantiate disjoint affine space of the same type
(3) Can we express news points and vectors in terms of this frame?
-/


def dividend := 2^65
def divisor := 2^33+1

def correctQuot := 2^32-1
def correctRem := 2^32+1
def wrongRem := 1

theorem correct₁ : dividend / divisor = correctQuot := rfl
theorem correct₂ : dividend = divisor * correctQuot + correctRem := rfl

theorem wrong : dividend % divisor = wrongRem := rfl

theorem unsound : False := by
  have : wrongRem = correctRem := by
    have h := Nat.div_add_mod dividend divisor
    rw [wrong, correct₁, correct₂] at h
    apply Nat.add_left_cancel h
  contradiction


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.constructions.borel_space
import dynamics.ergodic.measure_preserving
import combinatorics.pigeonhole

/-!
# Conservative systems

In this file we define `f : α → α` to be a *conservative* system w.r.t a measure `μ` if `f` is
non-singular (`measure_theory.quasi_measure_preserving`) and for every measurable set `s` of
positive measure at least one point `x ∈ s` returns back to `s` after some number of iterations of
`f`. There are several properties that look like they are stronger than this one but actually follow
from it:

* `measure_theory.conservative.frequently_measure_inter_ne_zero`,
  `measure_theory.conservative.exists_gt_measure_inter_ne_zero`: if `μ s ≠ 0`, then for infinitely
  many `n`, the measure of `s ∩ (f^[n]) ⁻¹' s` is positive.

* `measure_theory.conservative.measure_mem_forall_ge_image_not_mem_eq_zero`,
  `measure_theory.conservative.ae_mem_imp_frequently_image_mem`: a.e. every point of `s` visits `s`
  infinitely many times (Poincaré recurrence theorem).

We also prove the topological Poincaré recurrence theorem
`measure_theory.conservative.ae_frequently_mem_of_mem_nhds`. Let `f : α → α` be a conservative
dynamical system on a topological space with second countable topology and measurable open
sets. Then almost every point `x : α` is recurrent: it visits every neighborhood `s ∈ 𝓝 x`
infinitely many times.

## Tags

conservative dynamical system, Poincare recurrence theorem
-/

noncomputable theory

open classical set filter measure_theory finset function topological_space
open_locale classical topological_space

variables {ι : Type*} {α : Type*} [measurable_space α] {f : α → α} {s : set α} {μ : measure α}

namespace measure_theory

open measure

/-- We say that a non-singular (`measure_theory.quasi_measure_preserving`) self-map is
*conservative* if for any measurable set `s` of positive measure there exists `x ∈ s` such that `x`
returns back to `s` under some iteration of `f`. -/
structure conservative (f : α → α) (μ : measure α . volume_tac)
  extends quasi_measure_preserving f μ μ : Prop :=
(exists_mem_image_mem : ∀ ⦃s⦄, measurable_set s → μ s ≠ 0 → ∃ (x ∈ s) (m ≠ 0), f^[m] x ∈ s)

/-- A self-map preserving a finite measure is conservative. -/
protected lemma measure_preserving.conservative [is_finite_measure μ]
  (h : measure_preserving f μ μ) :
  conservative f μ :=
⟨h.quasi_measure_preserving, λ s hsm h0, h.exists_mem_image_mem hsm h0⟩

namespace conservative

/-- The identity map is conservative w.r.t. any measure. -/
protected lemma id (μ : measure α) : conservative id μ :=
{ to_quasi_measure_preserving := quasi_measure_preserving.id μ,
  exists_mem_image_mem := λ s hs h0, let ⟨x, hx⟩ := nonempty_of_measure_ne_zero h0 in
    ⟨x, hx, 1, one_ne_zero, hx⟩ }

/-- If `f` is a conservative map and `s` is a measurable set of nonzero measure, then
for infinitely many values of `m` a positive measure of points `x ∈ s` returns back to `s`
after `m` iterations of `f`. -/
lemma frequently_measure_inter_ne_zero (hf : conservative f μ) (hs : measurable_set s)
  (h0 : μ s ≠ 0) :
  ∃ᶠ m in at_top, μ (s ∩ (f^[m]) ⁻¹' s) ≠ 0 :=
begin
  by_contra H, simp only [not_frequently, eventually_at_top, ne.def, not_not] at H,
  rcases H with ⟨N, hN⟩,
  induction N with N ihN,
  { apply h0, simpa using hN 0 le_rfl },
  rw [imp_false] at ihN, push_neg at ihN,
  rcases ihN with ⟨n, hn, hμn⟩,
  set T := s ∩ ⋃ n ≥ N + 1, (f^[n]) ⁻¹' s,
  have hT : measurable_set T,
    from hs.inter (measurable_set.bUnion (countable_encodable _)
      (λ _ _, hf.measurable.iterate _ hs)),
  have hμT : μ T = 0,
  { convert (measure_bUnion_null_iff $ countable_encodable _).2 hN,
    rw ← set.inter_bUnion, refl },
  have : μ ((s ∩ (f^[n]) ⁻¹' s) \ T) ≠ 0, by rwa [measure_diff_null hμT],
  rcases hf.exists_mem_image_mem ((hs.inter (hf.measurable.iterate n hs)).diff hT) this
    with ⟨x, ⟨⟨hxs, hxn⟩, hxT⟩, m, hm0, ⟨hxms, hxm⟩, hxx⟩,
  refine hxT ⟨hxs, mem_bUnion_iff.2 ⟨n + m, _, _⟩⟩,
  { exact add_le_add hn (nat.one_le_of_lt $ pos_iff_ne_zero.2 hm0) },
  { rwa [set.mem_preimage, ← iterate_add_apply] at hxm }
end

/-- If `f` is a conservative map and `s` is a measurable set of nonzero measure, then
for an arbitrarily large `m` a positive measure of points `x ∈ s` returns back to `s`
after `m` iterations of `f`. -/
lemma exists_gt_measure_inter_ne_zero (hf : conservative f μ) (hs : measurable_set s) (h0 : μ s ≠ 0)
  (N : ℕ) :
  ∃ m > N, μ (s ∩ (f^[m]) ⁻¹' s) ≠ 0 :=
let ⟨m, hm, hmN⟩ :=
  ((hf.frequently_measure_inter_ne_zero hs h0).and_eventually (eventually_gt_at_top N)).exists
in ⟨m, hmN, hm⟩

/-- Poincaré recurrence theorem: given a conservative map `f` and a measurable set `s`, the set
of points `x ∈ s` such that `x` does not return to `s` after `≥ n` iterations has measure zero. -/
lemma measure_mem_forall_ge_image_not_mem_eq_zero (hf : conservative f μ) (hs : measurable_set s)
  (n : ℕ) :
  μ {x ∈ s | ∀ m ≥ n, f^[m] x ∉ s} = 0 :=
begin
  by_contradiction H,
  have : measurable_set (s ∩ {x | ∀ m ≥ n, f^[m] x ∉ s}),
  { simp only [set_of_forall, ← compl_set_of],
    exact hs.inter (measurable_set.bInter (countable_encodable _)
      (λ m _, hf.measurable.iterate m hs.compl)) },
  rcases (hf.exists_gt_measure_inter_ne_zero this H) n with ⟨m, hmn, hm⟩,
  rcases nonempty_of_measure_ne_zero hm with ⟨x, ⟨hxs, hxn⟩, hxm, -⟩,
  exact hxn m hmn.lt.le hxm
end

/-- Poincaré recurrence theorem: given a conservative map `f` and a measurable set `s`,
almost every point `x ∈ s` returns back to `s` infinitely many times. -/
lemma ae_mem_imp_frequently_image_mem (hf : conservative f μ) (hs : measurable_set s) :
  ∀ᵐ x ∂μ, x ∈ s → ∃ᶠ n in at_top, (f^[n] x) ∈ s :=
begin
  simp only [frequently_at_top, @forall_swap (_ ∈ s), ae_all_iff],
  intro n,
  filter_upwards [measure_zero_iff_ae_nmem.1 (hf.measure_mem_forall_ge_image_not_mem_eq_zero hs n)],
  simp
end

lemma inter_frequently_image_mem_ae_eq (hf : conservative f μ) (hs : measurable_set s) :
  (s ∩ {x | ∃ᶠ n in at_top, f^[n] x ∈ s} : set α) =ᵐ[μ] s :=
inter_eventually_eq_left.2 $ hf.ae_mem_imp_frequently_image_mem hs

/-- Poincaré recurrence theorem: if `f` is a conservative dynamical system and `s` is a measurable
set, then for `μ`-a.e. `x`, if the orbit of `x` visits `s` at least once, then it visits `s`
infinitely many times.  -/
lemma ae_forall_image_mem_imp_frequently_image_mem (hf : conservative f μ) (hs : measurable_set s) :
  ∀ᵐ x ∂μ, ∀ k, f^[k] x ∈ s → ∃ᶠ n in at_top, (f^[n] x) ∈ s :=
begin
  refine ae_all_iff.2 (λ k, _),
  refine (hf.ae_mem_imp_frequently_image_mem (hf.measurable.iterate k hs)).mono (λ x hx hk, _),
  rw [← map_add_at_top_eq_nat k, frequently_map],
  refine (hx hk).mono (λ n hn, _),
  rwa [add_comm, iterate_add_apply]
end

/-- If `f` is a conservative self-map and `s` is a measurable set of positive measure, then
`μ.ae`-frequently we have `x ∈ s` and `s` returns to `s` under infinitely many iterations of `f`. -/
lemma frequently_ae_mem_and_frequently_image_mem (hf : conservative f μ) (hs : measurable_set s)
  (h0 : μ s ≠ 0) :
  ∃ᵐ x ∂μ, x ∈ s ∧ ∃ᶠ n in at_top, (f^[n] x) ∈ s :=
((frequently_ae_mem_iff.2 h0).and_eventually (hf.ae_mem_imp_frequently_image_mem hs)).mono $ λ x hx,
  ⟨hx.1, hx.2 hx.1⟩

/-- Poincaré recurrence theorem. Let `f : α → α` be a conservative dynamical system on a topological
space with second countable topology and measurable open sets. Then almost every point `x : α`
is recurrent: it visits every neighborhood `s ∈ 𝓝 x` infinitely many times. -/
lemma ae_frequently_mem_of_mem_nhds [topological_space α] [second_countable_topology α]
  [opens_measurable_space α] {f : α → α} {μ : measure α} (h : conservative f μ) :
  ∀ᵐ x ∂μ, ∀ s ∈ 𝓝 x, ∃ᶠ n in at_top, f^[n] x ∈ s :=
begin
  have : ∀ s ∈ countable_basis α, ∀ᵐ x ∂μ, x ∈ s → ∃ᶠ n in at_top, (f^[n] x) ∈ s,
    from λ s hs, h.ae_mem_imp_frequently_image_mem
      (is_open_of_mem_countable_basis hs).measurable_set,
  refine ((ae_ball_iff $ countable_countable_basis α).2 this).mono (λ x hx s hs, _),
  rcases (is_basis_countable_basis α).mem_nhds_iff.1 hs with ⟨o, hoS, hxo, hos⟩,
  exact (hx o hoS hxo).mono (λ n hn, hos hn)
end

/-- Iteration of a conservative system is a conservative system. -/
protected lemma iterate (hf : conservative f μ) (n : ℕ) : conservative (f^[n]) μ :=
begin
  cases n, { exact conservative.id μ }, -- Discharge the trivial case `n = 0`
  refine ⟨hf.1.iterate _, λ s hs hs0, _⟩,
  rcases (hf.frequently_ae_mem_and_frequently_image_mem hs hs0).exists with ⟨x, hxs, hx⟩,
  /- We take a point `x ∈ s` such that `f^[k] x ∈ s` for infinitely many values of `k`,
  then we choose two of these values `k < l` such that `k ≡ l [MOD (n + 1)]`.
  Then `f^[k] x ∈ s` and `(f^[n + 1])^[(l - k) / (n + 1)] (f^[k] x) = f^[l] x ∈ s`. -/
  rw nat.frequently_at_top_iff_infinite at hx,
  rcases nat.exists_lt_modeq_of_infinite hx n.succ_pos with ⟨k, hk, l, hl, hkl, hn⟩,
  set m := (l - k) / (n + 1),
  have : (n + 1) * m = l - k,
  { apply nat.mul_div_cancel',
    exact (nat.modeq_iff_dvd' hkl.le).1 hn },
  refine ⟨f^[k] x, hk, m, _, _⟩,
  { intro hm,
    rw [hm, mul_zero, eq_comm, tsub_eq_zero_iff_le] at this,
    exact this.not_lt hkl },
  { rwa [← iterate_mul, this, ← iterate_add_apply, tsub_add_cancel_of_le],
    exact hkl.le }
end

end conservative

end measure_theory


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl
-/
import algebra.group.hom_instances
import topology.uniform_space.completion
import topology.algebra.uniform_group

/-!
# Completion of topological groups:

This files endows the completion of a topological abelian group with a group structure.
More precisely the instance `uniform_space.completion.add_group` builds an abelian group structure
on the completion of an abelian group endowed with a compatible uniform structure.
Then the instance `uniform_space.completion.uniform_add_group` proves this group structure is
compatible with the completed uniform structure. The compatibility condition is `uniform_add_group`.

## Main declarations:

Beyond the instances explained above (that don't have to be explicitly invoked),
the main constructions deal with continuous group morphisms.

* `add_monoid_hom.extension`: extends a continuous group morphism from `G`
  to a complete separated group `H` to `completion G`.
* `add_monoid_hom.completion`: promotes a continuous group morphism
  from `G` to `H` into a continuous group morphism
  from `completion G` to `completion H`.
-/

noncomputable theory

universes u v

section group
open uniform_space Cauchy filter set
variables {α : Type u} [uniform_space α]

instance [has_zero α] : has_zero (completion α) := ⟨(0 : α)⟩
instance [has_neg α] : has_neg (completion α) := ⟨completion.map (λa, -a : α → α)⟩
instance [has_add α] : has_add (completion α) := ⟨completion.map₂ (+)⟩
instance [has_sub α] : has_sub (completion α) := ⟨completion.map₂ has_sub.sub⟩

@[norm_cast]
lemma uniform_space.completion.coe_zero [has_zero α] : ((0 : α) : completion α) = 0 := rfl
end group

namespace uniform_space.completion
section uniform_add_group
open uniform_space uniform_space.completion
variables {α : Type*} [uniform_space α] [add_group α] [uniform_add_group α]

@[norm_cast]
lemma coe_neg (a : α) : ((- a : α) : completion α) = - a :=
(map_coe uniform_continuous_neg a).symm

@[norm_cast]
lemma coe_sub (a b : α) : ((a - b : α) : completion α) = a - b :=
(map₂_coe_coe a b has_sub.sub uniform_continuous_sub).symm

@[norm_cast]
lemma coe_add (a b : α) : ((a + b : α) : completion α) = a + b :=
(map₂_coe_coe a b (+) uniform_continuous_add).symm

instance : add_monoid (completion α) :=
{ zero_add     := assume a, completion.induction_on a
   (is_closed_eq (continuous_map₂ continuous_const continuous_id) continuous_id)
    (assume a, show 0 + (a : completion α) = a, by rw_mod_cast zero_add),
  add_zero     := assume a, completion.induction_on a
    (is_closed_eq (continuous_map₂ continuous_id continuous_const) continuous_id)
    (assume a, show (a : completion α) + 0 = a, by rw_mod_cast add_zero),
  add_assoc    := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous_map₂
        (continuous_map₂ continuous_fst (continuous_fst.comp continuous_snd))
        (continuous_snd.comp continuous_snd))
      (continuous_map₂ continuous_fst
        (continuous_map₂
          (continuous_fst.comp continuous_snd)
          (continuous_snd.comp continuous_snd))))
    (assume a b c, show (a : completion α) + b + c = a + (b + c),
      by repeat { rw_mod_cast add_assoc }),
  .. completion.has_zero, .. completion.has_neg, ..completion.has_add, .. completion.has_sub }

instance : sub_neg_monoid (completion α) :=
{ sub_eq_add_neg := λ a b, completion.induction_on₂ a b
    (is_closed_eq (continuous_map₂ continuous_fst continuous_snd)
      (continuous_map₂ continuous_fst (continuous_map.comp continuous_snd)))
   (λ a b, by exact_mod_cast congr_arg coe (sub_eq_add_neg a b)),
  .. completion.add_monoid, .. completion.has_neg, .. completion.has_sub }

instance : add_group (completion α) :=
{ add_left_neg := assume a, completion.induction_on a
    (is_closed_eq (continuous_map₂ completion.continuous_map continuous_id) continuous_const)
    (assume a, show - (a : completion α) + a = 0, by { rw_mod_cast add_left_neg, refl }),
  .. completion.sub_neg_monoid }

instance : uniform_add_group (completion α) :=
⟨uniform_continuous_map₂ has_sub.sub⟩

/-- The map from a group to its completion as a group hom. -/
@[simps] def to_compl : α →+ completion α :=
{ to_fun := coe,
  map_add' := coe_add,
  map_zero' := coe_zero }

lemma continuous_to_compl : continuous (to_compl : α → completion α) :=
continuous_coe α

variables {β : Type v} [uniform_space β] [add_group β] [uniform_add_group β]

instance {α : Type u} [uniform_space α] [add_comm_group α] [uniform_add_group α] :
  add_comm_group (completion α) :=
{ add_comm  := assume a b, completion.induction_on₂ a b
    (is_closed_eq (continuous_map₂ continuous_fst continuous_snd)
      (continuous_map₂ continuous_snd continuous_fst))
    (assume x y, by { change ↑x + ↑y = ↑y + ↑x, rw [← coe_add, ← coe_add, add_comm]}),
  .. completion.add_group }

end uniform_add_group

end uniform_space.completion

section add_monoid_hom
variables {α β : Type*} [uniform_space α] [add_group α] [uniform_add_group α]
                        [uniform_space β] [add_group β] [uniform_add_group β]

open uniform_space uniform_space.completion

/-- Extension to the completion of a continuous group hom. -/
def add_monoid_hom.extension [complete_space β] [separated_space β] (f : α →+ β)
  (hf : continuous f) : completion α →+ β :=
have hf : uniform_continuous f, from uniform_continuous_of_continuous hf,
{ to_fun := completion.extension f,
  map_zero' := by rw [← coe_zero, extension_coe hf, f.map_zero],
  map_add' := assume a b, completion.induction_on₂ a b
  (is_closed_eq
    (continuous_extension.comp continuous_add)
    ((continuous_extension.comp continuous_fst).add (continuous_extension.comp continuous_snd)))
  (λ a b, by rw_mod_cast [extension_coe hf, extension_coe hf, extension_coe hf,
    f.map_add]) }

lemma add_monoid_hom.extension_coe [complete_space β] [separated_space β] (f : α →+ β)
  (hf : continuous f) (a : α) : f.extension hf a = f a :=
extension_coe (uniform_continuous_of_continuous hf) a

@[continuity]
lemma add_monoid_hom.continuous_extension [complete_space β] [separated_space β] (f : α →+ β)
  (hf : continuous f) : continuous (f.extension hf) :=
continuous_extension

/-- Completion of a continuous group hom, as a group hom. -/
def add_monoid_hom.completion (f : α →+ β) (hf : continuous f) : completion α →+ completion β :=
(to_compl.comp f).extension (continuous_to_compl.comp hf)

@[continuity]
lemma add_monoid_hom.continuous_completion (f : α →+ β)
  (hf : continuous f) : continuous (f.completion hf : completion α → completion β) :=
continuous_map

lemma add_monoid_hom.completion_coe (f : α →+ β)
  (hf : continuous f) (a : α) : f.completion hf a = f a :=
map_coe (uniform_continuous_of_continuous hf) a

lemma add_monoid_hom.completion_zero : (0 : α →+ β).completion continuous_const = 0 :=
begin
  ext x,
  apply completion.induction_on x,
  { apply is_closed_eq ((0 : α →+ β).continuous_completion continuous_const),
    simp [continuous_const] },
  { intro a,
    simp [(0 : α →+ β).completion_coe continuous_const, coe_zero] }
end

lemma add_monoid_hom.completion_add {γ : Type*} [add_comm_group γ] [uniform_space γ]
  [uniform_add_group γ] (f g : α →+ γ) (hf : continuous f) (hg : continuous g) :
  (f + g).completion (hf.add hg) = f.completion hf + g.completion hg :=
begin
  have hfg := hf.add hg,
  ext x,
  apply completion.induction_on x,
  { exact is_closed_eq ((f+g).continuous_completion hfg)
    ((f.continuous_completion hf).add (g.continuous_completion hg)) },
  { intro a,
    simp [(f+g).completion_coe hfg, coe_add, f.completion_coe hf, g.completion_coe hg] }
end

end add_monoid_hom


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen

! This file was ported from Lean 3 source module ring_theory.localization.away
! leanprover-community/mathlib commit 831c494092374cfe9f50591ed0ac81a25efc5b86
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.AdjoinRoot
import Mathbin.RingTheory.Localization.Basic

/-!
# Localizations away from an element

## Main definitions

 * `is_localization.away (x : R) S` expresses that `S` is a localization away from `x`, as an
   abbreviation of `is_localization (submonoid.powers x) S`

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/

section CommSemiring

variable {R : Type _} [CommSemiring R] (M : Submonoid R) {S : Type _} [CommSemiring S]

variable [Algebra R S] {P : Type _} [CommSemiring P]

namespace IsLocalization

section Away

variable (x : R)

/-- Given `x : R`, the typeclass `is_localization.away x S` states that `S` is
isomorphic to the localization of `R` at the submonoid generated by `x`. -/
abbrev Away (S : Type _) [CommSemiring S] [Algebra R S] :=
  IsLocalization (Submonoid.powers x) S
#align is_localization.away IsLocalization.Away

namespace Away

variable [IsLocalization.Away x S]

/-- Given `x : R` and a localization map `F : R →+* S` away from `x`, `inv_self` is `(F x)⁻¹`. -/
noncomputable def invSelf : S :=
  mk' S (1 : R) ⟨x, Submonoid.mem_powers _⟩
#align is_localization.away.inv_self IsLocalization.Away.invSelf

@[simp]
theorem mul_invSelf : algebraMap R S x * invSelf x = 1 :=
  by
  convert IsLocalization.mk'_mul_mk'_eq_one _ 1
  symm
  apply IsLocalization.mk'_one
#align is_localization.away.mul_inv_self IsLocalization.Away.mul_invSelf

variable {g : R →+* P}

/-- Given `x : R`, a localization map `F : R →+* S` away from `x`, and a map of `comm_semiring`s
`g : R →+* P` such that `g x` is invertible, the homomorphism induced from `S` to `P` sending
`z : S` to `g y * (g x)⁻ⁿ`, where `y : R, n : ℕ` are such that `z = F y * (F x)⁻ⁿ`. -/
noncomputable def lift (hg : IsUnit (g x)) : S →+* P :=
  IsLocalization.lift fun y : Submonoid.powers x =>
    show IsUnit (g y.1) by
      obtain ⟨n, hn⟩ := y.2
      rw [← hn, g.map_pow]
      exact IsUnit.map (powMonoidHom n : P →* P) hg
#align is_localization.away.lift IsLocalization.Away.lift

@[simp]
theorem AwayMap.lift_eq (hg : IsUnit (g x)) (a : R) : lift x hg ((algebraMap R S) a) = g a :=
  lift_eq _ _
#align is_localization.away.away_map.lift_eq IsLocalization.Away.AwayMap.lift_eq

@[simp]
theorem AwayMap.lift_comp (hg : IsUnit (g x)) : (lift x hg).comp (algebraMap R S) = g :=
  lift_comp _
#align is_localization.away.away_map.lift_comp IsLocalization.Away.AwayMap.lift_comp

/-- Given `x y : R` and localizations `S`, `P` away from `x` and `x * y`
respectively, the homomorphism induced from `S` to `P`. -/
noncomputable def awayToAwayRight (y : R) [Algebra R P] [IsLocalization.Away (x * y) P] : S →+* P :=
  lift x <|
    show IsUnit ((algebraMap R P) x) from
      isUnit_of_mul_eq_one ((algebraMap R P) x) (mk' P y ⟨x * y, Submonoid.mem_powers _⟩) <| by
        rw [mul_mk'_eq_mk'_of_mul, mk'_self]
#align is_localization.away.away_to_away_right IsLocalization.Away.awayToAwayRight

variable (S) (Q : Type _) [CommSemiring Q] [Algebra P Q]

/-- Given a map `f : R →+* S` and an element `r : R`, we may construct a map `Rᵣ →+* Sᵣ`. -/
noncomputable def map (f : R →+* P) (r : R) [IsLocalization.Away r S]
    [IsLocalization.Away (f r) Q] : S →+* Q :=
  IsLocalization.map Q f
    (show Submonoid.powers r ≤ (Submonoid.powers (f r)).comap f
      by
      rintro x ⟨n, rfl⟩
      use n
      simp)
#align is_localization.away.map IsLocalization.Away.map

end Away

end Away

variable [IsLocalization M S]

section AtUnits

variable (R) (S) (M)

/-- The localization at a module of units is isomorphic to the ring -/
noncomputable def atUnits (H : ∀ x : M, IsUnit (x : R)) : R ≃ₐ[R] S :=
  by
  refine' AlgEquiv.ofBijective (Algebra.ofId R S) ⟨_, _⟩
  · intro x y hxy
    obtain ⟨c, eq⟩ := (IsLocalization.eq_iff_exists M S).mp hxy
    obtain ⟨u, hu⟩ := H c
    rwa [← hu, Units.mul_right_inj] at eq
  · intro y
    obtain ⟨⟨x, s⟩, eq⟩ := IsLocalization.surj M y
    obtain ⟨u, hu⟩ := H s
    use x * u.inv
    dsimp only [Algebra.ofId, RingHom.toFun_eq_coe, AlgHom.coe_mks]
    rw [RingHom.map_mul, ← Eq, ← hu, mul_assoc, ← RingHom.map_mul]
    simp
#align is_localization.at_units IsLocalization.atUnits

/-- The localization away from a unit is isomorphic to the ring -/
noncomputable def atUnit (x : R) (e : IsUnit x) [IsLocalization.Away x S] : R ≃ₐ[R] S :=
  by
  apply at_units R (Submonoid.powers x)
  rintro ⟨xn, n, hxn⟩
  obtain ⟨u, hu⟩ := e
  rw [isUnit_iff_exists_inv]
  use u.inv ^ n
  simp [← hxn, ← hu, ← mul_pow]
#align is_localization.at_unit IsLocalization.atUnit

/-- The localization at one is isomorphic to the ring. -/
noncomputable def atOne [IsLocalization.Away (1 : R) S] : R ≃ₐ[R] S :=
  @atUnit R _ S _ _ (1 : R) isUnit_one _
#align is_localization.at_one IsLocalization.atOne

theorem away_of_isUnit_of_bijective {R : Type _} (S : Type _) [CommRing R] [CommRing S]
    [Algebra R S] {r : R} (hr : IsUnit r) (H : Function.Bijective (algebraMap R S)) :
    IsLocalization.Away r S :=
  { map_units := by
      rintro ⟨_, n, rfl⟩
      exact (algebraMap R S).isUnit_map (hr.pow _)
    surj := fun z => by
      obtain ⟨z', rfl⟩ := H.2 z
      exact ⟨⟨z', 1⟩, by simp⟩
    eq_iff_exists := fun x y => by
      erw [H.1.eq_iff]
      constructor
      · rintro rfl
        exact ⟨1, rfl⟩
      · rintro ⟨⟨_, n, rfl⟩, e⟩
        exact (hr.pow _).mul_right_inj.mp e }
#align is_localization.away_of_is_unit_of_bijective IsLocalization.away_of_isUnit_of_bijective

end AtUnits

end IsLocalization

namespace Localization

open IsLocalization

variable {M}

/-- Given a map `f : R →+* S` and an element `r : R`, such that `f r` is invertible,
  we may construct a map `Rᵣ →+* S`. -/
noncomputable abbrev awayLift (f : R →+* P) (r : R) (hr : IsUnit (f r)) :
    Localization.Away r →+* P :=
  IsLocalization.Away.lift r hr
#align localization.away_lift Localization.awayLift

/-- Given a map `f : R →+* S` and an element `r : R`, we may construct a map `Rᵣ →+* Sᵣ`. -/
noncomputable abbrev awayMap (f : R →+* P) (r : R) :
    Localization.Away r →+* Localization.Away (f r) :=
  IsLocalization.Away.map _ _ f r
#align localization.away_map Localization.awayMap

end Localization

end CommSemiring

open Polynomial AdjoinRoot Localization

variable {R : Type _} [CommRing R]

attribute [local instance] IsLocalization.algHom_subsingleton AdjoinRoot.algHom_subsingleton

/-- The `R`-`alg_equiv` between the localization of `R` away from `r` and
    `R` with an inverse of `r` adjoined. -/
noncomputable def Localization.awayEquivAdjoin (r : R) : Away r ≃ₐ[R] AdjoinRoot (C r * X - 1) :=
  AlgEquiv.ofAlgHom
    { awayLift _ r _ with
      commutes' :=
        IsLocalization.Away.AwayMap.lift_eq r (isUnit_of_mul_eq_one _ _ <| root_is_inv r) }
    (liftHom _ (IsLocalization.Away.invSelf r) <| by
      simp only [map_sub, map_mul, aeval_C, aeval_X, IsLocalization.Away.mul_invSelf, aeval_one,
        sub_self])
    (Subsingleton.elim _ _) (Subsingleton.elim _ _)
#align localization.away_equiv_adjoin Localization.awayEquivAdjoin

theorem IsLocalization.adjoin_inv (r : R) : IsLocalization.Away r (AdjoinRoot <| C r * X - 1) :=
  IsLocalization.isLocalization_of_algEquiv _ (Localization.awayEquivAdjoin r)
#align is_localization.adjoin_inv IsLocalization.adjoin_inv

theorem IsLocalization.Away.finitePresentation (r : R) {S} [CommRing S] [Algebra R S]
    [IsLocalization.Away r S] : Algebra.FinitePresentation R S :=
  (AdjoinRoot.finitePresentation _).Equiv <|
    (Localization.awayEquivAdjoin r).symm.trans <| IsLocalization.algEquiv (Submonoid.powers r) _ _
#align is_localization.away.finite_presentation IsLocalization.Away.finitePresentation


import data.fintype data.nat.modeq data.fintype data.set.finite data.nat.prime set_theory.cardinal algebra.ordered_ring
universe u
variable α : Type u
local attribute [instance,priority 0] classical.prop_decidable
noncomputable theory
open nat fintype

instance fintype_subtype_of_fintype (p : α → Prop) [fintype α] : fintype {a // p a}:=begin
  cases _inst_1,
  let s := finset.filter p elems,
  have : ∀ a : α, a ∈ s ↔ p a,
    assume a,simp[s],split,
    exact λ h,h.right,
    exact λ h, ⟨complete a, h⟩,
  exact set.fintype_of_finset s this,
end

lemma fintype_of_injective {α β : Type u} {f : α → β} [fintype β] (h: function.injective f) : fintype α := begin
  unfold function.injective at h,
  have h₁: cardinal.mk α ≤ cardinal.mk β,
    split,split,swap,exact f,exact h,
  have h₂:= cardinal.fintype_card β,
  have h₃:= cardinal.nat_lt_omega (card β),rw h₂ at h₁,
  have h₄ :=lt_of_le_of_lt h₁ h₃,
  rw cardinal.lt_omega_iff_fintype at h₄,
  exact classical.choice h₄,
end

theorem nodup_pair : ∀ a b : α, a ≠ b → list.nodup [a, b] := by simp [list.nodup]

def pair_finset (a b : α) (h : a ≠ b) : finset α := ⟨[a, b], nodup_pair α a b h⟩

theorem involution_parity {α : Type u} {f : α → α} [fintype α] : (∀ x : α, f x ≠ x) → (∀ x : α, f (f x) = x) → 2 ∣ card α := begin
 assume hs hf,
 let s := λ (a : α), pair_finset α a (f a) (hs a).symm,
 have : ∀ u : finset α,  (∀ x : α, x ∈ u → f x ∈ u) → 2 ∣ finset.card u,
  assume u,
  apply finset.strong_induction_on u,
  assume u ht hu,
  cases classical.em (u = finset.empty),
  rw h,simp [finset.card,finset.empty],
  have := finset.exists_mem_of_ne_empty h,
  cases this with x hx,
  let t₁ := s x,
  let t₂ := @set.finite.to_finset α {x | x ∉ t₁ ∧ x ∈ u} ⟨fintype_subtype_of_fintype _ _ ⟩,
  have h2t₂:∀ x : α, x ∈ u → (x ∉ t₁ ↔ x ∈ t₂),
   simp [t₂],assume x hx,exact ⟨λ h,⟨h,hx⟩,λ h,h.left⟩,
  have hxt₁ : x ∈ t₁,
   simp[t₁,s],simp[pair_finset],
  have hfxt₁ : f x ∈ t₁,
   simp[t₁,s,pair_finset],
  have ht₂u : t₂ ⊂ u,
   unfold has_ssubset.ssubset,
   rw finset.subset_iff,
   split, simp[t₂],
   rw [finset.subset_iff,classical.not_forall],
   existsi x,
   rw not_imp,split, exact hx,
   have:=iff.mpr not_not hxt₁,
   exact iff.mp (iff_false_left this) (h2t₂ x hx),
  have h2t₂:(∀ (x : α), x ∈ t₂ → f x ∈ t₂),
   simp[t₂],
   assume x₁ hx₁ hx₁u,split,
   assume hfx₁,
   simp[t₁,s,pair_finset] at hx₁ hfx₁,
   cases hfx₁,
   have := hf x₁,rw hfx₁ at this,
   simp [this.symm] at hx₁,trivial,
   have:=hf x,rw ←hfx₁ at this,
   have j:=hf x₁, rw j at this,
   simp [this] at hx₁, trivial,
   exact hu x₁ hx₁u,
  have:= ht t₂ ht₂u h2t₂,
  have huc : u = insert (f x) (insert x t₂),
   rw finset.ext,
   assume a,split,simp [t₂],
   cases classical.em (a ∈ t₁),
   simp [t₁,s,pair_finset] at h_1,
   assume h_2,
   cases h_1,simp[h_1],
   simp[h_1],simp[h_1],
   assume h, simp[h],
   simp[t₂],assume h,
   cases h,rwa h_1,
   cases h_1,
   rw h_1,exact hu x hx,
   exact h_1.right,
  have hxt₂ : x ∉ t₂,
   simp[t₂],assume h,
   exact absurd hxt₁ h,
  have hfxt₂ : f x ∉ insert x t₂,
   simp[t₂],assume h,
   cases h,
   exact absurd h_1 (hs x),
   exact absurd hfxt₁ h_1.left,
  rw huc,
  rw [finset.card_insert_of_not_mem hfxt₂,finset.card_insert_of_not_mem hxt₂],
  simp,exact iff.mp (nat.dvd_add_iff_right this) (by simp),
 unfold card finset.univ, cases _inst_1,
 have helems: (∀ (x : α), x ∈ elems → f x ∈ elems) := λ x hx, complete (f x),
 have := this elems helems,simp [this],
end
open nat
def S (p :ℕ) : set (ℕ × ℕ × ℕ) := {x | ((x.1) * (x.1) + 4 * x.2.1 * x.2.2 = ↑p) ∧ 0 < x.1 ∧ 0 < x.2.1 ∧ 0 < x.2.2}
instance fintype_S (p :ℕ) : fintype (S p) := begin
  have hv : ∀ v : ℕ × ℕ × ℕ, v ∈ S p → v.1 < p + 1 ∧ v.2.1 < p + 1 ∧ v.2.2 < (p+1) := λ ⟨x, y, z⟩,begin
    assume h, simp [S] at h,simp,split,
    suffices : x ≤ p,
      exact lt_succ_of_le this,
    cases x,exact absurd h.right.left dec_trivial,rw ←h.left,
    rw [mul_succ,add_comm (succ x * x),add_assoc],
    exact le_add_right _ _,split,
    suffices : y ≤ p,
      exact lt_succ_of_le this,
    cases z,exact absurd h.right.right.right dec_trivial,
    rw [←h.left,mul_succ,succ_mul 3 y,←add_assoc,←add_assoc],
    exact le_add_left _ _,
    suffices : z ≤ p,
      exact lt_succ_of_le this,
    rw [mul_right_comm 4] at h,
    cases y,exact absurd h.right.right.left dec_trivial,
    rw [←h.left,mul_succ,succ_mul 3 z,←add_assoc,←add_assoc],
    exact le_add_left _ _,
  end,
  let f : S p → fin (p+1) × fin (p+1) × fin (p+1) := λ v,⟨⟨v.val.1, (hv v.val v.property).left⟩, ⟨v.val.2.1, (hv v.val v.property).right.left⟩, ⟨v.val.2.2, (hv v.val v.property).right.right⟩⟩,
  have hf : function.injective f,
    assume a b,cases a with a ha, cases b with b hb,
    cases a with a₁ a₂,cases a₂ with a₂ a₃,
    cases b with b₁ b₂,cases b₂ with b₂ b₃,
    simp [f],assume h1 h2 h3,
    have h1 : (⟨a₁, _⟩ : fin (p+1)).val = (⟨b₁, _⟩ : fin (p+1)).val,rw h1,simp at h1,
    have h2 : (⟨a₂, _⟩ : fin (p+1)).val = (⟨b₂, _⟩ : fin (p+1)).val,rw h2,simp at h2,
    have h3 : (⟨a₃, _⟩ : fin (p+1)).val = (⟨b₃, _⟩ : fin (p+1)).val,rw h3,simp at h3,
    simp[h1,h2,h3],
  exact fintype_of_injective hf,
end
def f₁ : (ℕ × ℕ × ℕ) → (ℕ × ℕ × ℕ) := λ ⟨x, y, z⟩, (x, z, y)
def f₂ : (ℕ × ℕ × ℕ) → (ℕ × ℕ × ℕ) := λ ⟨x, y, z⟩, if x + z < y then (x + 2 * z, z, int.nat_abs ((↑y:ℤ) - ↑x - ↑z)) else (if 2 * y < x then (int.nat_abs (↑x - (2:ℤ) * ↑y), int.nat_abs (↑x - ↑y + ↑z), y) else (int.nat_abs (2 * ↑y - ↑x), y, int.nat_abs(x - y + z)))
lemma f₁_S {p : ℕ} : ∀ x : (ℕ × ℕ × ℕ), x ∈ S p → f₁ x ∈ S p := λ ⟨x, y, z⟩, begin
 simp[S,f₁],rw mul_assoc 4, rw[mul_comm y, ←mul_assoc],assume h hx0 hy0 hz0,exact ⟨h,hx0,hz0,hy0⟩,
end
lemma f₁_invo_on_S {p : ℕ} : ∀ x : (ℕ × ℕ × ℕ), x ∈ S p → f₁ (f₁ x) = x := λ ⟨x, y, z⟩, by simp[f₁]
lemma sub_sub' (a:ℕ) {b c : ℕ} : c ≤ b → b ≤ a → a - (b - c) = (a - b) + c := begin
  assume h h₁,rw [←int.coe_nat_eq_coe_nat_iff,int.coe_nat_add,int.coe_nat_sub,int.coe_nat_sub,int.coe_nat_sub],simp,
  assumption,assumption,exact le_trans (sub_le b c) h₁,
end
lemma eq_one_of_mul_eq_self : ∀ a b :ℕ, a > 0 → a * b = a → b = 1:=begin
  assume a b ha hab,cases b,simp at hab,rw ←hab at ha,exact absurd ha dec_trivial,
  cases b,reflexivity,rw mul_succ at hab,
  have :a * succ b + a - a = a -a,rw hab,
  rw [nat.add_sub_cancel,nat.sub_self] at this,
  have:=eq_zero_of_mul_eq_zero this,cases this,
  rw this_1 at ha,exact absurd ha dec_trivial,
  rw this_1,
end
lemma prime_not_square {n :ℕ} : ¬ prime (n^2):=begin
  assume hn,
  unfold pow prime at hn,simp at hn,
  have := hn.right n (dvd_mul_left n n),
  cases this,rw this at hn, simp at hn,
  exact absurd hn dec_trivial,rw ← this at hn,
  have h1 := prime.pos hn,
  have := eq_one_of_mul_eq_self n n h1 this.symm,
  rw this at hn,
  exact absurd hn.left dec_trivial,
end
lemma f₂_S {p: ℕ} (hp : prime p) (hp1 : p ≡ 1 [MOD 4]) : ∀ x : (ℕ × ℕ × ℕ), x ∈ S p → f₂ x ∈ S p := λ ⟨x, y, z⟩, begin
  unfold f₂ S,assume h,simp at h,
  have gx : -(2 * ((↑x:ℤ) * ↑y)) + (-(2 * (↑x * ↑y))) = - (4 * ((↑x:ℤ) * ↑y)),
    rw [←neg_add,←mul_add (2:ℤ)],
    have : (↑x * ↑y + ↑x * ↑y:ℤ) = 2 * (↑x * ↑y),
      rw [(dec_trivial : (2:ℤ) = 1 + 1),add_mul,one_mul],
    rw [this,←mul_assoc,(dec_trivial : (2:ℤ) * 2 = 4)],

  cases classical.em (x + z < y),
  simp[h_1],split,rw ←h.left,
  have hx : (x + 2 * z) * (x + 2 * z) = x * x + 4 * x * z + 4 * z * z,
    rw[mul_add,add_mul,add_mul],simp[mul_comm,mul_assoc,mul_left_comm],
    rw [(dec_trivial : 2 * 2 = 4),← add_assoc,←mul_assoc x,←add_mul],
    have : x * z + x * z = x * z * 2,rw [mul_succ,mul_one],
    rw this,rw [mul_assoc(x * z),(dec_trivial : 2 * 2 = 4),mul_assoc],
  rw hx,rw [←neg_add,←int.coe_nat_add,←sub_eq_add_neg,←int.coe_nat_sub (le_of_lt h_1),int.nat_abs_of_nat],
  rw [←nat.sub_sub],
  rw [nat.mul_sub_left_distrib,nat.mul_sub_left_distrib],
  simp[mul_comm,mul_assoc,mul_left_comm],rw[add_comm (z *(z *4)),eq_comm,←add_assoc,←@nat.sub_eq_iff_eq_add _ (z * (z*4)),add_comm (x * (z * 4)),←@nat.sub_eq_iff_eq_add _ (x * (z*4)),nat.sub_sub,nat.sub_sub,add_comm],
  rw ←nat.mul_sub_right_distrib,rw mul_le_mul_right (show z * 4 > 0, from mul_pos h.right.right.right dec_trivial),rw nat.le_sub_right_iff_add_le,exact le_of_lt h_1,
  exact le_of_lt (lt_of_le_of_lt (le_add_left z x) h_1),
  rw _root_.mul_le_mul_right,exact le_of_lt (lt_of_le_of_lt (le_add_left z x) h_1),
  exact mul_pos h.right.right.right dec_trivial,split,
  exact lt_of_lt_of_le h.right.left (le_add_right _ _),split,
  exact h.right.right.right,
  have := nat.sub_pos_of_lt h_1,
  rwa [←neg_add,←int.coe_nat_add,←sub_eq_add_neg,←int.coe_nat_sub (le_of_lt h_1),int.nat_abs_of_nat],
  simp [h_1],
  have hxzy : 0 < ((↑x + (↑z + -↑y)): ℤ),
    rw ←add_assoc, rw ←sub_lt_iff,simp,rw[←int.coe_nat_add,int.coe_nat_lt],cases (lt_or_eq_of_le (le_of_not_gt h_1)),
    assumption,rw h_2 at h,
    have : p= (x + 2 * z)^2,simp [pow],
      rw[add_mul,mul_add,mul_add],rw ←h.left,
      simp,rw [mul_add,add_mul],
      have : 2 * z * (2 * z) = 4 * z * z,
        rw [mul_left_comm,←mul_assoc,←mul_assoc,(dec_trivial : 2 * 2 = 4)],rw this,
      rw ←add_assoc,
      have : x * (2 * z) + 2 * z * x = 4 * x * z,
        rw [mul_left_comm], rw mul_comm x,rw ←mul_assoc, rw ←mul_add,
        have: x + x = 2 * x,rw succ_mul,simp,
        rw this,rw mul_left_comm,rw[←mul_assoc,←mul_assoc, (dec_trivial : 2 * 2 = 4)],rw mul_right_comm,
      rw this,
    rw this at hp,exact absurd hp prime_not_square,
  cases classical.em (2 * y < x),
  have hx2y : 0 < (↑x + -(2 * ↑y): ℤ),
    rw ←sub_lt_iff,simp,have :(2:ℤ) = ↑(2:ℕ),simp,exact dec_trivial,
    rw [this,←int.coe_nat_mul,int.coe_nat_lt],exact h_2,
  simp [h_2],
  split,rw ←h.left,
  rw [←int.coe_nat_eq_coe_nat_iff,int.coe_nat_add,int.coe_nat_mul,int.coe_nat_mul,int.coe_nat_add,int.coe_nat_mul,int.coe_nat_mul,int.coe_nat_mul,int.coe_nat_mul],
  have h_11 := le_of_not_gt h_1,
  rw int.nat_abs_of_nonneg (int.le_of_lt hxzy),rw int.nat_abs_of_nonneg (int.le_of_lt hx2y),
  rw [mul_add,mul_add,mul_add,add_mul,add_mul,add_mul,add_mul],have : (4:ℤ) = ↑(4 : ℕ),simp,exact dec_trivial, rw ←this,
  rw [←add_assoc (↑x * ↑x + -(2 * ↑y) * ↑x:ℤ)],
  simp[mul_comm,mul_assoc,mul_left_comm],
  rw [←add_assoc,gx,neg_add_cancel_left,←mul_assoc (2:ℤ),(dec_trivial : (2:ℤ)*2=4),neg_add_self,add_zero],
  rw [←int.coe_nat_lt,←int.coe_nat_lt,int.coe_nat_zero],
  rw int.nat_abs_of_nonneg (int.le_of_lt hxzy),rw int.nat_abs_of_nonneg (int.le_of_lt hx2y),simp [hx2y,hxzy],exact h.right.right.left,
  simp[h_1,h_2,h.right.right.left],
  rw [←int.coe_nat_lt,←int.coe_nat_lt,int.coe_nat_zero],rw int.nat_abs_of_nonneg (int.le_of_lt hxzy),simp[hxzy],
  have hx2y :0 < (-↑x + 2 * ↑y:ℤ),
    rw add_comm,rw ←sub_lt_iff,simp,
    cases lt_or_eq_of_le (le_of_not_gt h_2),have : ↑(2:ℕ) = (2:ℤ), simp,exact dec_trivial,
    rw ←this,rwa [←int.coe_nat_mul,int.coe_nat_lt],
    rw [h_3,mul_left_comm,←mul_assoc,←mul_assoc, (dec_trivial : 2 * 2 = 4), ←mul_add,mul_assoc] at h,
    have:=dvd_mul_right 4 (y * (y + z)),rw ←modeq.modeq_zero_iff at this,rw h.left at this,
    have := this.symm.trans hp1, exact absurd this dec_trivial,
  rw [←int.coe_nat_lt,int.coe_nat_zero],rw int.nat_abs_of_nonneg (int.le_of_lt hx2y),
  simp[hx2y],
  rw[←int.coe_nat_eq_coe_nat_iff,int.coe_nat_add,int.coe_nat_mul,int.coe_nat_mul,int.coe_nat_mul],
  rw [int.nat_abs_of_nonneg (int.le_of_lt hxzy),int.nat_abs_of_nonneg (int.le_of_lt hx2y)],
  rw (dec_trivial : ↑4 = (4: ℤ )),
  rw [← h.left,int.coe_nat_add,int.coe_nat_mul,int.coe_nat_mul,int.coe_nat_mul,mul_add,mul_add,mul_add,add_mul,add_mul],
  have : (2:ℤ) * (↑y: ℤ) * (2 * ↑y)  = 4 * ↑y * ↑y,
    rw [mul_left_comm, ←mul_assoc, ←mul_assoc, (dec_trivial : (2:ℤ) * 2 = 4)],
  rw this,
  have : (2:ℤ) * ↑y * -↑x + (-↑x * (2 * ↑y)) = -(4 * ↑x * ↑y),
    simp[mul_comm,mul_assoc,mul_left_comm],rw [←neg_add,←mul_add],
    have : (↑x : ℤ) * ↑ y + ↑x * ↑y = 2 * (↑x * ↑y),
      rw [←one_mul ((↑x:ℤ) * ↑y),←add_mul, (dec_trivial : (1:ℤ) + 1 = 2)],
      simp,
    rw [this,←mul_assoc,(dec_trivial : (2:ℤ) * 2 = 4)],
  rw [add_assoc (-(↑x:ℤ) * -↑x),←add_assoc ((2:ℤ) * ↑y * -↑x),this,←add_assoc ( (4:ℤ) * ↑y * ↑x)],rw ←(dec_trivial : (4 :ℤ)= ↑(4:ℕ) ),
  simp[mul_comm,mul_assoc,mul_left_comm],rw [add_comm ((4:ℤ) * (↑y * ↑z)),add_neg_cancel_left],
end
lemma f₂_invo_on_S {p: ℕ} : ∀ x : (ℕ × ℕ × ℕ), x ∈ S p → f₂ (f₂ x) = x:= λ⟨x,y,z⟩,begin
  assume h,unfold f₂, simp,simp [S] at h,
  cases classical.em (x + z < y),
  simp[h_1],unfold f₂._match_1,
  cases classical.em (x + 2 * z + int.nat_abs (↑y + (-↑x + -↑z)) < z),
  simp [h_2],
  rw [←neg_add,←int.coe_nat_add,←sub_eq_add_neg,←int.coe_nat_sub (le_of_lt h_1),int.nat_abs_of_nat] at *,
  exfalso,
  rw [succ_mul,one_mul,add_left_comm] at h_2,simp only [add_assoc] at h_2,
  exact not_lt_of_ge (le_add_right z (x + (z + (y - (x + z))))) h_2,
  simp[h_2],simp[h.right.left],rw [(dec_trivial : (1:ℤ)+1 =2),add_neg_self,add_zero,int.nat_abs_of_nat],simp [(rfl:x=x)],

  rw [←neg_add,←int.coe_nat_add,←sub_eq_add_neg,←int.coe_nat_sub (le_of_lt h_1),int.nat_abs_of_nat,int.coe_nat_sub (le_of_lt h_1),int.coe_nat_add],
  rw [(dec_trivial : (2:ℤ)=1+1),add_mul,one_mul,add_assoc (↑z:ℤ),add_neg_cancel_left,sub_eq_add_neg,add_comm (↑y:ℤ),←add_assoc (↑x:ℤ),add_neg_cancel_left,int.nat_abs_of_nat],
  simp[h_1],
  have h_11:=le_of_not_gt h_1,
  cases classical.em (2 * y < x),
  simp[h_2],unfold f₂._match_1,
  have h_3 : int.nat_abs (↑x + -(2 * ↑y)) + y < int.nat_abs (↑x + (↑z + -↑y)),
    rw[←sub_eq_add_neg,(dec_trivial : (2:ℤ)= ↑2),←int.coe_nat_mul,←int.coe_nat_sub (le_of_lt h_2),int.nat_abs_of_nat,←sub_eq_add_neg,add_sub,←int.coe_nat_add,←int.coe_nat_sub h_11,int.nat_abs_of_nat,←nat.sub_add_comm(le_of_lt h_2),succ_mul,one_mul,←nat.sub_sub,nat.add_sub_cancel,nat.lt_sub_left_iff_add_lt h_11,←nat.add_sub_assoc,nat.add_sub_cancel_left],
    rw lt_add_iff_pos_right,exact h.right.right.right,
    rw [succ_mul,one_mul] at h_2,
    exact le_trans (le_add_left y y) (le_of_lt h_2),
  simp[h_3],
  rw[←sub_eq_add_neg,(dec_trivial : (2:ℤ)= ↑2),←int.coe_nat_mul,←int.coe_nat_sub (le_of_lt h_2),int.nat_abs_of_nat,←nat.add_sub_assoc (le_of_lt h_2),nat.add_sub_cancel_left],simp[(rfl:x=x)],
  rw [←sub_eq_add_neg (↑z:ℤ),←add_sub_assoc,←int.coe_nat_add,←int.coe_nat_sub h_11,int.nat_abs_of_nat,int.coe_nat_sub,succ_mul,one_mul,int.coe_nat_add,int.coe_nat_sub h_11,int.coe_nat_add],simp,
  rw[add_comm,add_assoc],simp,exact le_of_lt h_2,simp[h_2],
  unfold f₂._match_1,
  have h_21:=le_of_not_gt h_2,
  have h_211 : x ≤ y + y,
    rwa [succ_mul,one_mul]at h_21,
  rw[←sub_eq_add_neg,(dec_trivial : (2:ℤ)= ↑2),←int.coe_nat_mul,←int.coe_nat_sub h_21,int.nat_abs_of_nat,←sub_eq_add_neg,←add_sub_assoc,←int.coe_nat_add,←int.coe_nat_sub h_11,int.nat_abs_of_nat,succ_mul,one_mul,←nat.add_sub_assoc h_11,←nat.sub_add_comm h_211,add_comm x,←add_assoc,nat.add_sub_cancel,add_right_comm,nat.add_sub_cancel],
  simp[not_lt_of_ge (le_add_right y z)],simp[not_lt_of_ge (sub_le (y+y) x)],
  rw[int.coe_nat_sub h_211,int.coe_nat_add,int.coe_nat_sub h_11],simp,rw [add_comm((↑z:ℤ)), add_neg_cancel_left,int.nat_abs_of_nat],
end
lemma f₂_fixed_point {p : ℕ} (hp : prime p) (hp1 : p ≡ 1 [MOD 4]) : ∃! x : (ℕ × ℕ × ℕ), x ∈ S p ∧ f₂ x = x := begin
  existsi (1,1,(p/4)),simp [S],unfold modeq at hp1,simp[(dec_trivial:1%4=1)] at hp1,
  have hp₁:=mod_add_div p 4,rw hp1 at hp₁,simp[hp₁],
  simp[(dec_trivial : 0<1)],
  have : 0 < p / 4,
    apply by_contradiction,
    assume h,have h₁:=eq_zero_of_le_zero (le_of_not_gt h),simp[h₁] at hp₁,rw ←hp₁ at hp,
    exact absurd (prime.gt_one hp) dec_trivial,
  simp[this],unfold f₂,
  have : ¬(1 + p / 4 < 1),
    rw [one_add],assume h,
    have:=lt_of_succ_lt_succ h,
    exact not_lt_of_ge (zero_le (p/4)) this,
  simp[this],
  simp[(dec_trivial:¬2<1)],
  simp[(dec_trivial:int.nat_abs (2 + -1) = 1)],
  assume x y,cases y with y z,simp,
  assume h hx hy hz,
  unfold f₂._match_1,
  assume hb,
  cases classical.em (x + z < y),
  simp[h_1] at hb,rw ←add_zero x at hb,
  have:=add_left_cancel hb.left,
  rw [succ_mul,one_mul] at this,
  have:=eq_zero_of_add_eq_zero this,rw this.left at hz,
  exact absurd hz dec_trivial,simp[h_1] at hb,
  cases classical.em (2 * y < x),
  simp [h_2] at hb,
  rw [(dec_trivial : (2:ℤ) = ↑2),←int.coe_nat_mul,←sub_eq_add_neg,←int.coe_nat_sub (le_of_lt h_2),int.nat_abs_of_nat] at hb,
  rw nat.sub_eq_iff_eq_add (le_of_lt h_2) at hb,
  rw [←add_zero x] at hb,
  have:=add_left_cancel hb.left,
  rw [succ_mul,one_mul] at this,
  have:=eq_zero_of_add_eq_zero this.symm,rw this.left at hy,
  exact absurd hy dec_trivial,
  simp[h_2] at hb,
  have h_3 := le_of_not_gt h_2,
  rw [(dec_trivial : (2:ℤ) = ↑2),←int.coe_nat_mul,←sub_eq_add_neg,←int.coe_nat_sub h_3,int.nat_abs_of_nat] at hb,
  rw nat.sub_eq_iff_eq_add h_3 at hb,
  have hyx : y=x,
    have : 2 * y = 2 * x,
      rw [succ_mul 1 x,one_mul] , exact hb.left,
    have : (2 * y) / 2 = (2 * x) / 2,
      rw this,
    rwa [nat.mul_div_cancel_left _ (dec_trivial:2>0),nat.mul_div_cancel_left _ (dec_trivial:2>0)] at this,
  rw [hyx, mul_comm 4,mul_assoc,←mul_add] at h,
  have:=dvd_mul_right x (x + 4 * z),rw h at this,have:=hp.right x this,
  cases this,rw hyx, simp[this_1],rw this_1 at h,simp at h,rw ←hp₁ at h,simp at h,
  have : (4*z)/4 = (4*(p/4)/4),
    rw h,
  rwa [nat.mul_div_cancel_left _ (dec_trivial:4>0),nat.mul_div_cancel_left _ (dec_trivial:4>0)] at this,
  rw this_1 at h,
  exfalso,
  have:=eq_one_of_mul_eq_self p (p+4*z) (prime.pos hp) h,
  have h:= le_add_right p (4*z),rw this at h,
  exact absurd h (not_le_of_gt (prime.gt_one hp)),
end
theorem fermat_sum_two_squares {p : ℕ} : prime p → p ≡ 1 [MOD 4] → ∃ a b : ℕ, a^2 + b^2 = p := begin
  assume hp hp1,have : card (S p) ≡ 1 [MOD 2],
  cases (f₂_fixed_point hp hp1) with x hx,
  let s := {y : (ℕ × ℕ × ℕ) | y ≠ x ∧ y ∈ S p},
  have is : fintype s,
    let f : {y : (ℕ × ℕ × ℕ) | y ≠ x ∧ y ∈ S p} → S p := λ y, ⟨y,begin cases y,simp at y_property,simp[subtype.coe_mk],exact y_property.right,end⟩,
    have : function.injective f,
      assume a b,simp[f],cases a, cases b,simp [subtype.coe_mk],
    simp[s],
    exact fintype_of_injective this,
  have hx₁:(x ∈ S p ∧ f₂ x = x) ∧ ∀ (y : ℕ × ℕ × ℕ), ( y ∈ S p ∧ f₂ y = y) → y = x := hx,clear hx,
  let f₂' : {y : (ℕ × ℕ × ℕ) | y ≠ x ∧ y ∈ S p} → {y : (ℕ × ℕ × ℕ) | y ≠ x ∧ y ∈ S p} := λ y, ⟨f₂ y,begin simp,split,
    intro,have:= hx₁.left.right,rw ←a at this,cases y,
    simp only [subtype.coe_mk] at *,simp at y_property,
    have t₁:= f₂_invo_on_S y_val y_property.right,rw [←this,t₁] at a,exact y_property.left a,
    cases y,simp at y_property,
    simp[subtype.coe_mk],exact f₂_S hp hp1 y_val y_property.right,
      end⟩,
    have hf₁1: ∀ y : ↥{y : ℕ × ℕ × ℕ | y ≠ x ∧ y ∈ S p}, f₂' y ≠ y,
      assume y,
      cases y,simp[subtype.coe_mk],simp at y_property,assume hy,
      exact y_property.left (hx₁.right y_val ⟨y_property.right, hy⟩),
    have hf₁2: ∀ y : ↥{y : ℕ × ℕ × ℕ | y ≠ x ∧ y ∈ S p}, f₂' (f₂' y) = y,
      assume y,cases y, simp[subtype.coe_mk,f₂'],
      exact f₂_invo_on_S y_val y_property.right,
    have := involution_parity hf₁1 hf₁2,
    have hx₂ : x ∉ {y : ℕ × ℕ × ℕ | y ≠ x ∧ y ∈ S p},
      simp,
    have i : set.finite s := ⟨is⟩,
    let i₁ := set.finite.to_finset i,
    have hx₂ : x ∉ i₁, simp [i₁],
    have hi₁:=finset.card_insert_of_not_mem hx₂,
    have hi₁2 : ∀ y :  ℕ × ℕ × ℕ , y ∈ i₁ ↔ y ∈ s,assume y,
      simp [i₁],
    have h := set.card_fintype_of_finset' i₁ hi₁2,
    rw ←h at hi₁,
    have h₂: ∀ y : ℕ × ℕ × ℕ, y ∈ insert x i₁ ↔ y ∈ S p,assume y,simp,
      split,
      assume h,cases h,
      rw h_1, exact hx₁.left.left,
      exact h_1.right,
      assume h,
      cases classical.em (y=x),
      exact or.inl h_1,
      exact or.inr ⟨h_1,h⟩,
    rw ←set.card_fintype_of_finset' _ h₂ at hi₁,rw hi₁,
    suffices h : card ↥s ≡ 0 [MOD 2],
    exact modeq.modeq_add h (modeq.refl 1),
    rw modeq.modeq_zero_iff,simp[s],
    exact this,
  let f₁' : (S p) →  S p := λ y, ⟨f₁ (↑y : ℕ × ℕ × ℕ),begin cases y,simp [subtype.coe_mk],
    exact f₁_S y_val y_property,
  end⟩,
  have hf₁_invo : ∀ y : S p, f₁' (f₁' y) = y,
    assume y, cases y,
    simp [f₁'],exact f₁_invo_on_S y_val y_property,
  have : ∃ y : S p, f₁' y = y,
    apply by_contradiction,
    assume h, rw not_exists at h,
    have h₃:=involution_parity h hf₁_invo,
    rw ←modeq.modeq_zero_iff at h₃,
    have:=this.symm.trans h₃,
    simp[modeq,(dec_trivial : ¬1%2=0)] at this,
    trivial,
  cases this with x hx,
  cases x with x hx₁,
  cases x with x y,
  cases y with y z,
  simp [S] at hx₁,
  existsi [x, 2*y],
  unfold pow,
  simp [f₁',f₁] at hx,
  rw [←hx₁.left,hx.left],
  simp,rw [mul_left_comm (2*y),←mul_assoc,←mul_assoc,(dec_trivial : 2 * 2 = 4)],
end
#print axioms fermat_sum_two_squares


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne

! This file was ported from Lean 3 source module analysis.special_functions.exp_deriv
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.Inverse
import Mathbin.Analysis.Complex.RealDeriv
import Mathbin.Analysis.SpecialFunctions.Exp

/-!
# Complex and real exponential

In this file we prove that `complex.exp` and `real.exp` are infinitely smooth functions.

## Tags

exp, derivative
-/

noncomputable section

open Filter Asymptotics Set Function

open Classical Topology

namespace Complex

variable {𝕜 : Type _} [NontriviallyNormedField 𝕜] [NormedAlgebra 𝕜 ℂ]

/-- The complex exponential is everywhere differentiable, with the derivative `exp x`. -/
theorem hasDerivAt_exp (x : ℂ) : HasDerivAt exp (exp x) x :=
  by
  rw [hasDerivAt_iff_isOCat_nhds_zero]
  have : (1 : ℕ) < 2 := by norm_num
  refine' (is_O.of_bound ‖exp x‖ _).trans_isOCat (is_o_pow_id this)
  filter_upwards [Metric.ball_mem_nhds (0 : ℂ) zero_lt_one]
  simp only [Metric.mem_ball, dist_zero_right, norm_pow]
  exact fun z hz => exp_bound_sq x z hz.le
#align complex.has_deriv_at_exp Complex.hasDerivAt_exp

theorem differentiable_exp : Differentiable 𝕜 exp := fun x =>
  (hasDerivAt_exp x).DifferentiableAt.restrictScalars 𝕜
#align complex.differentiable_exp Complex.differentiable_exp

theorem differentiableAt_exp {x : ℂ} : DifferentiableAt 𝕜 exp x :=
  differentiable_exp x
#align complex.differentiable_at_exp Complex.differentiableAt_exp

@[simp]
theorem deriv_exp : deriv exp = exp :=
  funext fun x => (hasDerivAt_exp x).deriv
#align complex.deriv_exp Complex.deriv_exp

@[simp]
theorem iter_deriv_exp : ∀ n : ℕ, (deriv^[n]) exp = exp
  | 0 => rfl
  | n + 1 => by rw [iterate_succ_apply, deriv_exp, iter_deriv_exp n]
#align complex.iter_deriv_exp Complex.iter_deriv_exp

theorem contDiff_exp : ∀ {n}, ContDiff 𝕜 n exp :=
  by
  refine' contDiff_all_iff_nat.2 fun n => _
  have : ContDiff ℂ (↑n) exp := by
    induction' n with n ihn
    · exact contDiff_zero.2 continuous_exp
    · rw [contDiff_succ_iff_deriv]
      use differentiable_exp
      rwa [deriv_exp]
  exact this.restrict_scalars 𝕜
#align complex.cont_diff_exp Complex.contDiff_exp

theorem hasStrictDerivAt_exp (x : ℂ) : HasStrictDerivAt exp (exp x) x :=
  contDiff_exp.ContDiffAt.has_strict_deriv_at' (hasDerivAt_exp x) le_rfl
#align complex.has_strict_deriv_at_exp Complex.hasStrictDerivAt_exp

theorem hasStrictFderivAt_exp_real (x : ℂ) : HasStrictFderivAt exp (exp x • (1 : ℂ →L[ℝ] ℂ)) x :=
  (hasStrictDerivAt_exp x).complexToReal_fderiv
#align complex.has_strict_fderiv_at_exp_real Complex.hasStrictFderivAt_exp_real

theorem isOpenMap_exp : IsOpenMap exp :=
  open_map_of_strict_deriv hasStrictDerivAt_exp exp_ne_zero
#align complex.is_open_map_exp Complex.isOpenMap_exp

end Complex

section

variable {𝕜 : Type _} [NontriviallyNormedField 𝕜] [NormedAlgebra 𝕜 ℂ] {f : 𝕜 → ℂ} {f' : ℂ} {x : 𝕜}
  {s : Set 𝕜}

theorem HasStrictDerivAt.cexp (hf : HasStrictDerivAt f f' x) :
    HasStrictDerivAt (fun x => Complex.exp (f x)) (Complex.exp (f x) * f') x :=
  (Complex.hasStrictDerivAt_exp (f x)).comp x hf
#align has_strict_deriv_at.cexp HasStrictDerivAt.cexp

theorem HasDerivAt.cexp (hf : HasDerivAt f f' x) :
    HasDerivAt (fun x => Complex.exp (f x)) (Complex.exp (f x) * f') x :=
  (Complex.hasDerivAt_exp (f x)).comp x hf
#align has_deriv_at.cexp HasDerivAt.cexp

theorem HasDerivWithinAt.cexp (hf : HasDerivWithinAt f f' s x) :
    HasDerivWithinAt (fun x => Complex.exp (f x)) (Complex.exp (f x) * f') s x :=
  (Complex.hasDerivAt_exp (f x)).comp_hasDerivWithinAt x hf
#align has_deriv_within_at.cexp HasDerivWithinAt.cexp

theorem derivWithin_cexp (hf : DifferentiableWithinAt 𝕜 f s x) (hxs : UniqueDiffWithinAt 𝕜 s x) :
    derivWithin (fun x => Complex.exp (f x)) s x = Complex.exp (f x) * derivWithin f s x :=
  hf.HasDerivWithinAt.cexp.derivWithin hxs
#align deriv_within_cexp derivWithin_cexp

@[simp]
theorem deriv_cexp (hc : DifferentiableAt 𝕜 f x) :
    deriv (fun x => Complex.exp (f x)) x = Complex.exp (f x) * deriv f x :=
  hc.HasDerivAt.cexp.deriv
#align deriv_cexp deriv_cexp

end

section

variable {𝕜 : Type _} [NontriviallyNormedField 𝕜] [NormedAlgebra 𝕜 ℂ] {E : Type _}
  [NormedAddCommGroup E] [NormedSpace 𝕜 E] {f : E → ℂ} {f' : E →L[𝕜] ℂ} {x : E} {s : Set E}

theorem HasStrictFderivAt.cexp (hf : HasStrictFderivAt f f' x) :
    HasStrictFderivAt (fun x => Complex.exp (f x)) (Complex.exp (f x) • f') x :=
  (Complex.hasStrictDerivAt_exp (f x)).comp_hasStrictFderivAt x hf
#align has_strict_fderiv_at.cexp HasStrictFderivAt.cexp

theorem HasFderivWithinAt.cexp (hf : HasFderivWithinAt f f' s x) :
    HasFderivWithinAt (fun x => Complex.exp (f x)) (Complex.exp (f x) • f') s x :=
  (Complex.hasDerivAt_exp (f x)).comp_hasFderivWithinAt x hf
#align has_fderiv_within_at.cexp HasFderivWithinAt.cexp

theorem HasFderivAt.cexp (hf : HasFderivAt f f' x) :
    HasFderivAt (fun x => Complex.exp (f x)) (Complex.exp (f x) • f') x :=
  hasFderivWithinAt_univ.1 <| hf.HasFderivWithinAt.cexp
#align has_fderiv_at.cexp HasFderivAt.cexp

theorem DifferentiableWithinAt.cexp (hf : DifferentiableWithinAt 𝕜 f s x) :
    DifferentiableWithinAt 𝕜 (fun x => Complex.exp (f x)) s x :=
  hf.HasFderivWithinAt.cexp.DifferentiableWithinAt
#align differentiable_within_at.cexp DifferentiableWithinAt.cexp

@[simp]
theorem DifferentiableAt.cexp (hc : DifferentiableAt 𝕜 f x) :
    DifferentiableAt 𝕜 (fun x => Complex.exp (f x)) x :=
  hc.HasFderivAt.cexp.DifferentiableAt
#align differentiable_at.cexp DifferentiableAt.cexp

theorem DifferentiableOn.cexp (hc : DifferentiableOn 𝕜 f s) :
    DifferentiableOn 𝕜 (fun x => Complex.exp (f x)) s := fun x h => (hc x h).cexp
#align differentiable_on.cexp DifferentiableOn.cexp

@[simp]
theorem Differentiable.cexp (hc : Differentiable 𝕜 f) :
    Differentiable 𝕜 fun x => Complex.exp (f x) := fun x => (hc x).cexp
#align differentiable.cexp Differentiable.cexp

theorem ContDiff.cexp {n} (h : ContDiff 𝕜 n f) : ContDiff 𝕜 n fun x => Complex.exp (f x) :=
  Complex.contDiff_exp.comp h
#align cont_diff.cexp ContDiff.cexp

theorem ContDiffAt.cexp {n} (hf : ContDiffAt 𝕜 n f x) :
    ContDiffAt 𝕜 n (fun x => Complex.exp (f x)) x :=
  Complex.contDiff_exp.ContDiffAt.comp x hf
#align cont_diff_at.cexp ContDiffAt.cexp

theorem ContDiffOn.cexp {n} (hf : ContDiffOn 𝕜 n f s) :
    ContDiffOn 𝕜 n (fun x => Complex.exp (f x)) s :=
  Complex.contDiff_exp.comp_contDiffOn hf
#align cont_diff_on.cexp ContDiffOn.cexp

theorem ContDiffWithinAt.cexp {n} (hf : ContDiffWithinAt 𝕜 n f s x) :
    ContDiffWithinAt 𝕜 n (fun x => Complex.exp (f x)) s x :=
  Complex.contDiff_exp.ContDiffAt.comp_contDiffWithinAt x hf
#align cont_diff_within_at.cexp ContDiffWithinAt.cexp

end

namespace Real

variable {x y z : ℝ}

theorem hasStrictDerivAt_exp (x : ℝ) : HasStrictDerivAt exp (exp x) x :=
  (Complex.hasStrictDerivAt_exp x).real_of_complex
#align real.has_strict_deriv_at_exp Real.hasStrictDerivAt_exp

theorem hasDerivAt_exp (x : ℝ) : HasDerivAt exp (exp x) x :=
  (Complex.hasDerivAt_exp x).real_of_complex
#align real.has_deriv_at_exp Real.hasDerivAt_exp

theorem contDiff_exp {n} : ContDiff ℝ n exp :=
  Complex.contDiff_exp.real_of_complex
#align real.cont_diff_exp Real.contDiff_exp

theorem differentiable_exp : Differentiable ℝ exp := fun x => (hasDerivAt_exp x).DifferentiableAt
#align real.differentiable_exp Real.differentiable_exp

theorem differentiableAt_exp : DifferentiableAt ℝ exp x :=
  differentiable_exp x
#align real.differentiable_at_exp Real.differentiableAt_exp

@[simp]
theorem deriv_exp : deriv exp = exp :=
  funext fun x => (hasDerivAt_exp x).deriv
#align real.deriv_exp Real.deriv_exp

@[simp]
theorem iter_deriv_exp : ∀ n : ℕ, (deriv^[n]) exp = exp
  | 0 => rfl
  | n + 1 => by rw [iterate_succ_apply, deriv_exp, iter_deriv_exp n]
#align real.iter_deriv_exp Real.iter_deriv_exp

end Real

section

/-! Register lemmas for the derivatives of the composition of `real.exp` with a differentiable
function, for standalone use and use with `simp`. -/

variable {f : ℝ → ℝ} {f' x : ℝ} {s : Set ℝ}

theorem HasStrictDerivAt.exp (hf : HasStrictDerivAt f f' x) :
    HasStrictDerivAt (fun x => Real.exp (f x)) (Real.exp (f x) * f') x :=
  (Real.hasStrictDerivAt_exp (f x)).comp x hf
#align has_strict_deriv_at.exp HasStrictDerivAt.exp

theorem HasDerivAt.exp (hf : HasDerivAt f f' x) :
    HasDerivAt (fun x => Real.exp (f x)) (Real.exp (f x) * f') x :=
  (Real.hasDerivAt_exp (f x)).comp x hf
#align has_deriv_at.exp HasDerivAt.exp

theorem HasDerivWithinAt.exp (hf : HasDerivWithinAt f f' s x) :
    HasDerivWithinAt (fun x => Real.exp (f x)) (Real.exp (f x) * f') s x :=
  (Real.hasDerivAt_exp (f x)).comp_hasDerivWithinAt x hf
#align has_deriv_within_at.exp HasDerivWithinAt.exp

theorem derivWithin_exp (hf : DifferentiableWithinAt ℝ f s x) (hxs : UniqueDiffWithinAt ℝ s x) :
    derivWithin (fun x => Real.exp (f x)) s x = Real.exp (f x) * derivWithin f s x :=
  hf.HasDerivWithinAt.exp.derivWithin hxs
#align deriv_within_exp derivWithin_exp

@[simp]
theorem deriv_exp (hc : DifferentiableAt ℝ f x) :
    deriv (fun x => Real.exp (f x)) x = Real.exp (f x) * deriv f x :=
  hc.HasDerivAt.exp.deriv
#align deriv_exp deriv_exp

end

section

/-! Register lemmas for the derivatives of the composition of `real.exp` with a differentiable
function, for standalone use and use with `simp`. -/

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ} {x : E}
  {s : Set E}

theorem ContDiff.exp {n} (hf : ContDiff ℝ n f) : ContDiff ℝ n fun x => Real.exp (f x) :=
  Real.contDiff_exp.comp hf
#align cont_diff.exp ContDiff.exp

theorem ContDiffAt.exp {n} (hf : ContDiffAt ℝ n f x) : ContDiffAt ℝ n (fun x => Real.exp (f x)) x :=
  Real.contDiff_exp.ContDiffAt.comp x hf
#align cont_diff_at.exp ContDiffAt.exp

theorem ContDiffOn.exp {n} (hf : ContDiffOn ℝ n f s) : ContDiffOn ℝ n (fun x => Real.exp (f x)) s :=
  Real.contDiff_exp.comp_contDiffOn hf
#align cont_diff_on.exp ContDiffOn.exp

theorem ContDiffWithinAt.exp {n} (hf : ContDiffWithinAt ℝ n f s x) :
    ContDiffWithinAt ℝ n (fun x => Real.exp (f x)) s x :=
  Real.contDiff_exp.ContDiffAt.comp_contDiffWithinAt x hf
#align cont_diff_within_at.exp ContDiffWithinAt.exp

theorem HasFderivWithinAt.exp (hf : HasFderivWithinAt f f' s x) :
    HasFderivWithinAt (fun x => Real.exp (f x)) (Real.exp (f x) • f') s x :=
  (Real.hasDerivAt_exp (f x)).comp_hasFderivWithinAt x hf
#align has_fderiv_within_at.exp HasFderivWithinAt.exp

theorem HasFderivAt.exp (hf : HasFderivAt f f' x) :
    HasFderivAt (fun x => Real.exp (f x)) (Real.exp (f x) • f') x :=
  (Real.hasDerivAt_exp (f x)).comp_hasFderivAt x hf
#align has_fderiv_at.exp HasFderivAt.exp

theorem HasStrictFderivAt.exp (hf : HasStrictFderivAt f f' x) :
    HasStrictFderivAt (fun x => Real.exp (f x)) (Real.exp (f x) • f') x :=
  (Real.hasStrictDerivAt_exp (f x)).comp_hasStrictFderivAt x hf
#align has_strict_fderiv_at.exp HasStrictFderivAt.exp

theorem DifferentiableWithinAt.exp (hf : DifferentiableWithinAt ℝ f s x) :
    DifferentiableWithinAt ℝ (fun x => Real.exp (f x)) s x :=
  hf.HasFderivWithinAt.exp.DifferentiableWithinAt
#align differentiable_within_at.exp DifferentiableWithinAt.exp

@[simp]
theorem DifferentiableAt.exp (hc : DifferentiableAt ℝ f x) :
    DifferentiableAt ℝ (fun x => Real.exp (f x)) x :=
  hc.HasFderivAt.exp.DifferentiableAt
#align differentiable_at.exp DifferentiableAt.exp

theorem DifferentiableOn.exp (hc : DifferentiableOn ℝ f s) :
    DifferentiableOn ℝ (fun x => Real.exp (f x)) s := fun x h => (hc x h).exp
#align differentiable_on.exp DifferentiableOn.exp

@[simp]
theorem Differentiable.exp (hc : Differentiable ℝ f) : Differentiable ℝ fun x => Real.exp (f x) :=
  fun x => (hc x).exp
#align differentiable.exp Differentiable.exp

theorem fderivWithin_exp (hf : DifferentiableWithinAt ℝ f s x) (hxs : UniqueDiffWithinAt ℝ s x) :
    fderivWithin ℝ (fun x => Real.exp (f x)) s x = Real.exp (f x) • fderivWithin ℝ f s x :=
  hf.HasFderivWithinAt.exp.fderivWithin hxs
#align fderiv_within_exp fderivWithin_exp

@[simp]
theorem fderiv_exp (hc : DifferentiableAt ℝ f x) :
    fderiv ℝ (fun x => Real.exp (f x)) x = Real.exp (f x) • fderiv ℝ f x :=
  hc.HasFderivAt.exp.fderiv
#align fderiv_exp fderiv_exp

end


/-
Copyright © 2021 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri, Heather Macbeth
-/

import geometry.manifold.smooth_manifold_with_corners
import analysis.normed_space.units

/-!
# Units of a normed algebra

This file is a stub, containing a construction of the charted space structure on the group of units
of a complete normed ring `R`, and of the smooth manifold structure on the group of units of a
complete normed `𝕜`-algebra `R`.

This manifold is actually a Lie group, which eventually should be the main result of this file.

An important special case of this construction is the general linear group.  For a normed space `V`
over a field `𝕜`, the `𝕜`-linear endomorphisms of `V` are a normed `𝕜`-algebra (see
`continuous_linear_map.to_normed_algebra`), so this construction provides a Lie group structure on
its group of units, the general linear group GL(`𝕜`, `V`).

## TODO

The Lie group instance requires the following fields:
```
instance : lie_group 𝓘(𝕜, R) Rˣ :=
{ smooth_mul := sorry,
  smooth_inv := sorry,
  ..units.smooth_manifold_with_corners }
```

The ingredients needed for the construction are
* smoothness of multiplication and inversion in the charts, i.e. as functions on the normed
  `𝕜`-space `R`:  see `times_cont_diff_at_ring_inverse` for the inversion result, and
  `times_cont_diff_mul` (needs to be generalized from field to algebra) for the multiplication
  result
* for an open embedding `f`, whose domain is equipped with the induced manifold structure
  `f.singleton_smooth_manifold_with_corners`, characterization of smoothness of functions to/from
  this manifold in terms of smoothness in the target space.  See the pair of lemmas
  `times_cont_mdiff_coe_sphere` and `times_cont_mdiff.cod_restrict_sphere` for a model.
None of this should be particularly difficult.

-/

noncomputable theory

open_locale manifold

namespace units

variables {R : Type*} [normed_ring R] [complete_space R]

instance : charted_space R Rˣ := open_embedding_coe.singleton_charted_space

lemma chart_at_apply {a : Rˣ} {b : Rˣ} : chart_at R a b = b := rfl
lemma chart_at_source {a : Rˣ} : (chart_at R a).source = set.univ := rfl

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [normed_algebra 𝕜 R]

instance : smooth_manifold_with_corners 𝓘(𝕜, R) Rˣ :=
open_embedding_coe.singleton_smooth_manifold_with_corners 𝓘(𝕜, R)

end units


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison

! This file was ported from Lean 3 source module category_theory.preadditive.yoneda.projective
! leanprover-community/mathlib commit f8d8465c3c392a93b9ed226956e26dee00975946
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Preadditive.Yoneda.Basic
import Mathbin.CategoryTheory.Preadditive.Projective
import Mathbin.Algebra.Category.Group.EpiMono
import Mathbin.Algebra.Category.Module.EpiMono

/-!
An object is projective iff the preadditive coyoneda functor on it preserves epimorphisms.
-/

universe v u

open Opposite

namespace CategoryTheory

variable {C : Type u} [Category.{v} C]

section Preadditive

variable [Preadditive C]

namespace Projective

theorem projective_iff_preservesEpimorphisms_preadditiveCoyoneda_obj (P : C) :
    Projective P ↔ (preadditiveCoyoneda.obj (op P)).PreservesEpimorphisms :=
  by
  rw [projective_iff_preserves_epimorphisms_coyoneda_obj]
  refine' ⟨fun h : (preadditive_coyoneda.obj (op P) ⋙ forget _).PreservesEpimorphisms => _, _⟩
  ·
    exact
      functor.preserves_epimorphisms_of_preserves_of_reflects (preadditive_coyoneda.obj (op P))
        (forget _)
  · intro
    exact (inferInstance : (preadditive_coyoneda.obj (op P) ⋙ forget _).PreservesEpimorphisms)
#align category_theory.projective.projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj CategoryTheory.Projective.projective_iff_preservesEpimorphisms_preadditiveCoyoneda_obj

theorem projective_iff_preservesEpimorphisms_preadditive_coyoneda_obj' (P : C) :
    Projective P ↔ (preadditiveCoyonedaObj (op P)).PreservesEpimorphisms :=
  by
  rw [projective_iff_preserves_epimorphisms_coyoneda_obj]
  refine' ⟨fun h : (preadditive_coyoneda_obj (op P) ⋙ forget _).PreservesEpimorphisms => _, _⟩
  ·
    exact
      functor.preserves_epimorphisms_of_preserves_of_reflects (preadditive_coyoneda_obj (op P))
        (forget _)
  · intro
    exact (inferInstance : (preadditive_coyoneda_obj (op P) ⋙ forget _).PreservesEpimorphisms)
#align category_theory.projective.projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj' CategoryTheory.Projective.projective_iff_preservesEpimorphisms_preadditive_coyoneda_obj'

end Projective

end Preadditive

end CategoryTheory


theorem add_left_cancel (t a b : mynat) : t + a = t + b → a = b :=
begin
rw add_comm, rw add_comm t b,
exact add_right_cancel a t b,
end