import tactic.linarith
import algebra.order.with_zero
import topology.locally_finite
import data.fin.interval
import data.fin.succ_pred

import to_mathlib.set_theory.cardinal.basic

/-!
# Indexing types

This is a stupid file introducing a type class for types that will index
locally finite covers of (paracompact) manifolds without having
to discuss according to compactness. The only intended instances
are `ℕ` and `fin (n+1)`.

It also includes a lemma about locally finite cover that doesn't require an indexing
index type but will be used with one.
-/

open set

class indexing (α : Type*) [linear_order α] :=
(from_nat : ℕ → α)
(to_nat : α → ℕ)
(mono_from : monotone from_nat)
(from_to : ∀ a, from_nat (to_nat a) = a)

@[priority 100]
instance indexing.has_coe (α : Type*) [linear_order α] [indexing α] : has_coe ℕ α :=
⟨indexing.from_nat⟩

@[simp]
lemma indexing.coe_to {α : Type*} [linear_order α] [indexing α] (i : α) :
  ((indexing.to_nat i) : α) = i :=
indexing.from_to i

lemma indexing.coe_mono {α : Type*} [linear_order α] [indexing α] {i j : ℕ} (h : i ≤ j) :
  (i : α) ≤ j :=
indexing.mono_from h

instance indexing.nonempty (α : Type*) [linear_order α] [indexing α] : nonempty α :=
⟨indexing.from_nat 0⟩

instance : indexing ℕ :=
{ from_nat := id,
  to_nat := id,
  mono_from := monotone_id,
  from_to := λ n, rfl }

def fin.indexing (n : ℕ) : indexing (fin $ n + 1) :=
{ from_nat := λ k, if h : k < n + 1 then ⟨k, h⟩ else fin.last n,
  to_nat := coe,
  mono_from := λ k l hkl, begin
    dsimp [fin.of_nat],
    split_ifs ; try { simp [fin.le_last] };
    linarith,
  end,
  from_to := begin
    rintros ⟨k, hk⟩,
    erw dif_pos hk,
    refl
  end }

local attribute [instance] fin.indexing
open_locale topology

/-- Our model indexing type depending on `n : ℕ` is `ℕ` if `n = 0` and `fin n` otherwise-/
def index_type (n : ℕ) : Type :=
nat.cases_on n ℕ (λ k, fin $ k + 1)

@[simp] lemma index_type_zero : index_type 0 = ℕ := rfl

@[simp] lemma index_type_succ (n : ℕ) : index_type (n + 1) = fin (n + 1) := rfl

@[simp] lemma index_type_of_zero_lt {n : ℕ} (h : 0 < n) : index_type n = fin n :=
by rw [← nat.succ_pred_eq_of_pos h, index_type_succ]

instance (n : ℕ) : linear_order (index_type n) :=
nat.cases_on n nat.linear_order (λ _, fin.linear_order)

instance (n : ℕ) : indexing (index_type n) :=
nat.cases_on n nat.indexing (λ _, fin.indexing _)

instance (n : ℕ) : locally_finite_order (index_type n) :=
nat.cases_on n nat.locally_finite_order (λ _, fin.locally_finite_order _)

instance (n : ℕ) : order_bot (index_type n) :=
nat.cases_on n nat.order_bot (λ k, show order_bot $ fin (k + 1), by apply_instance)

instance (N : ℕ) : has_zero (index_type N) := ⟨indexing.from_nat 0⟩

lemma set.countable_iff_exists_nonempty_index_type_equiv
  {α : Type*} {s : set α} (hne : s.nonempty) :
  s.countable ↔ ∃ n, nonempty (index_type n ≃ s) :=
begin
  -- Huge golfing opportunity.
  cases @set.finite_or_infinite _ s,
  { refine ⟨λ hh, ⟨h.to_finset.card, _⟩, λ _, h.countable⟩,
    have : 0 < h.to_finset.card,
    { rw finset.card_pos, exact (set.finite.to_finset_nonempty h).mpr hne},
    simp only [this, index_type_of_zero_lt],
    have e₁ := fintype.equiv_fin h.to_finset,
    rw [fintype.card_coe, h.coe_sort_to_finset] at e₁,
    exact ⟨e₁.symm⟩, },
  { refine ⟨λ hh, ⟨0, _⟩, _⟩,
    { simp only [index_type_zero],
      obtain ⟨_i⟩ := set.countable_infinite_iff_nonempty_denumerable.mp ⟨hh, h⟩,
      haveI := _i,
      exact ⟨(denumerable.eqv s).symm⟩, },
    { rintros ⟨n, ⟨fn⟩⟩,
      have hn : n = 0,
      { by_contra hn,
        replace hn : 0 < n := zero_lt_iff.mpr hn,
        simp only [hn, index_type_of_zero_lt] at fn,
        exact set.not_infinite.mpr ⟨fintype.of_equiv (fin n) fn⟩ h, },
      simp only [hn, index_type_zero] at fn,
      exact set.countable_iff_exists_injective.mpr ⟨fn.symm, fn.symm.injective⟩, }, },
end

open filter

lemma index_type.lt_or_eq_succ (N n : ℕ) :
  (n : index_type N) < (n+1 : ℕ) ∨ (n : index_type N) = (n+1 : ℕ) :=
begin
  rw or_comm,
  exact eq_or_lt_of_le (indexing.mono_from n.le_succ)
end

lemma index_type.le_or_lt_succ {N n : ℕ} (hn : (n : index_type N) < (n+1 : ℕ)) (j : index_type N) :
  j ≤ n ↔ j < (n + 1 : ℕ) :=
begin
  cases N, { exact nat.lt_succ_iff.symm, },
  refine ⟨λ h, lt_of_le_of_lt h hn, λ h, _⟩,
  clear hn,
  obtain ⟨j, hj⟩ := j,
  change _ ≤ indexing.from_nat n,
  change _ < indexing.from_nat (n + 1) at h,
  unfold indexing.from_nat at ⊢ h,
  rcases lt_trichotomy N n with hNn | rfl | hNn,
  { replace hNn : ¬ (n < N + 1) := by simpa using nat.succ_le_iff.mpr hNn,
    simp only [hNn, not_false_iff, dif_neg],
    exact fin.le_last _ },
  { simpa using nat.lt_succ_iff.mp hj },
  { simp only [hNn, add_lt_add_iff_right, dif_pos, fin.mk_lt_mk] at h,
    simpa only [nat.lt.step hNn, dif_pos, fin.mk_le_mk] using nat.lt_succ_iff.mp h }
end

lemma index_type.not_lt_zero {N : ℕ} (j : index_type N) : ¬ (j < 0) :=
nat.cases_on N nat.not_lt_zero (λ n, fin.not_lt_zero) j


import Rings.Fields
import completeness
import Rings.ToMathlib.finset

namespace Lefschetz

open fol
open Rings
open Fields
open Rings.instances

/-- Lefschetz part 1. Any sentence or its negation can be deduced in ACF₀-/
theorem is_complete'_ACF₀ : is_complete' ACF₀ :=
begin
  sorry
end

/-- Lefschetz part 1. Being true in a model of ACF₀ implies being true for any model of ACF₀-/
theorem is_complete''_ACF₀ : is_complete'' ACF₀ :=
is_complete''_to_is_complete' (is_complete'_ACF₀)

/-- Lefschetz part 3. Any sentence or its negation can be deduced in ACFₚ-/
theorem is_complete'_ACFₚ {p : ℕ} (hp : nat.prime p) : is_complete' (ACFₚ hp) :=
begin
  sorry
end

/-- Lefcschetz part 3. Being true in a model of ACFₚ implies being true for any model of ACFₚ-/
theorem is_complete''_ACFₚ {p : ℕ} (hp : nat.prime p) :
  is_complete'' (ACFₚ hp) :=
is_complete''_to_is_complete' (is_complete'_ACFₚ hp)

/-- Lefchetz part 2. A sentence holds for ACF₀ if and only if it holds for ACFₚ for large enough p -/
theorem characteristic_change_left (ϕ : sentence ring_signature) :
ACF₀ ⊨ ϕ → ∃ (n : ℕ), ∀ {p : ℕ} (hp : nat.prime p), n < p → ACFₚ hp ⊨ ϕ :=
begin
  rw compactness,
  intro hsatis,
  obtain ⟨ fs , hsatis , hsub ⟩ := hsatis,
  classical,
  obtain ⟨ fsACF , fsrange , hunion, hACF , hrange ⟩ :=
    finset.subset_union_elim hsub,
  set fsnat : finset ℕ := finset.preimage fsrange plus_one_ne_zero
      (set.inj_on_of_injective injective_plus_one_ne_zero _) with hfsnat,
  use fsnat.sup id + 1,
  intros p hp hlt M hMx hmodel,
  have _inst_1 : fact (M ⊨ ACF) := ⟨ (models_ACFₚ_iff.mp hmodel).2 ⟩,
  have hchar := @models_ACFₚ_char _ _ _inst_1 _ hmodel,
  apply hsatis hMx,
  rw [← hunion, finset.coe_union, all_realize_sentence_union],
  split,
  {
    apply all_realize_sentence_of_subset _ hACF,
    exact all_realize_sentence_of_subset hmodel ACF_subset_ACFₚ,
  },
  {
    have hSTS :(∀ n : ℕ, n ∈ fsnat → M ⊨ plus_one_ne_zero n) → M ⊨ fsrange,
    {
      classical,
      have hrw0 := finset.image_preimage plus_one_ne_zero fsrange
        (set.inj_on_of_injective injective_plus_one_ne_zero _),
      rw [← hfsnat, finset.filter_mem_set_of_subset_set (λ x hx, (hrange hx).1)]
        at hrw0,
      rw ← hrw0,
      simp only [all_realize_sentence],
      intros hrealize ϕ hϕ,
      simp only [set.mem_preimage, set.mem_image,
        finset.coe_preimage, finset.mem_coe, finset.coe_image] at hϕ,
      obtain ⟨ n , hn , hϕ ⟩ := hϕ,
      rw [← hϕ],
      apply hrealize,
      rw [hfsnat, finset.mem_preimage],
      exact hn,
    },
    apply hSTS,
    intros n hnp,
    rw realize_plus_one_ne_zero,
    have hne_zero_of_le_char :
      ∀ x : ℕ, x.succ < p → (x.succ : M) ≠ 0,
    {
      intros x hx hbot,
      apply nat.succ_ne_zero x,
      have hfield : field M.carrier := @models_ACF_to.Field _ _inst_1,
      apply @ring_char.lt_char_field _ (models_ACF_to.Field),
      { exact hbot },
      rw ← hchar at hx,
      exact hx,
    },
    apply hne_zero_of_le_char _,
    apply lt_of_le_of_lt (nat.succ_le_succ _) hlt,
    exact finset.le_sup hnp,
  },
end

/-- Any ring fact holds in ACF₀ if and only if for all large p it holds for all ACFₚ-/
theorem characteristic_change (ϕ : sentence ring_signature) :
ACF₀ ⊨ ϕ ↔ (∃ (n : ℕ), ∀ {p : ℕ} (hp : nat.prime p), n < p → ACFₚ hp ⊨ ϕ) :=
begin
  split,
  { apply characteristic_change_left },
  {
    intro hn,
    cases is_complete'_ACF₀ ϕ with hsatis hsatis,
    { exact hsatis },
    {
      have hm := characteristic_change_left (∼ ϕ) hsatis,
      cases hn with n hn,
      cases hm with m hm,
      obtain ⟨ p , hle , hp ⟩ := nat.exists_infinite_primes (max n m).succ,
      have hnp : n < p :=
        lt_of_lt_of_le (nat.lt_succ_of_le (le_max_left _ _)) hle,
      have hmp : m < p :=
        lt_of_lt_of_le (nat.lt_succ_of_le (le_max_right _ _)) hle,
      have hS := instances.algebraic_closure_of_zmod_models_ACFₚ hp,
      specialize @hn p hp hnp _ ⟨ 0 ⟩ hS,
      specialize @hm p hp hmp _ ⟨ 0 ⟩ hS,
      simp only [realize_sentence_not] at hm,
      exfalso,
      apply hm hn,
    },
  },
end

end Lefschetz


import geometry.manifold.diffeomorph
import geometry.manifold.algebra.monoid
import geometry.manifold.metrizable
import to_mathlib.analysis.calculus

open bundle set function filter
open_locale manifold topology
noncomputable theory

section charted_space

variables {M H : Type*} [topological_space M] [topological_space H] [charted_space H M]
  (G : structure_groupoid H)

end charted_space

namespace model_with_corners

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
  {H : Type*} [topological_space H]
  {M : Type*} [topological_space M] (f : local_homeomorph M H) (I : model_with_corners 𝕜 E H)

end model_with_corners

-- todo: make `vector_bundle_core.total_space` protected!
namespace vector_bundle_core

variables {𝕜 B F : Type*} [nontrivially_normed_field 𝕜]
  [normed_add_comm_group F] [normed_space 𝕜 F] [topological_space B]
  {ι : Type*} (Z : vector_bundle_core 𝕜 B F ι) {i j : ι}

@[simp, mfld_simps] lemma local_triv_continuous_linear_map_at {b : B} (hb : b ∈ Z.base_set i) :
  (Z.local_triv i).continuous_linear_map_at 𝕜 b = Z.coord_change (Z.index_at b) i b :=
begin
  ext1 v,
  rw [(Z.local_triv i).continuous_linear_map_at_apply 𝕜, (Z.local_triv i).coe_linear_map_at_of_mem],
  exacts [rfl, hb]
end

@[simp, mfld_simps] lemma trivialization_at_continuous_linear_map_at {b₀ b : B}
  (hb : b ∈ (trivialization_at F Z.fiber b₀).base_set) :
  (trivialization_at F Z.fiber b₀).continuous_linear_map_at 𝕜 b =
  Z.coord_change (Z.index_at b) (Z.index_at b₀) b :=
Z.local_triv_continuous_linear_map_at hb

@[simp, mfld_simps] lemma local_triv_symmL {b : B} (hb : b ∈ Z.base_set i) :
  (Z.local_triv i).symmL 𝕜 b = Z.coord_change i (Z.index_at b) b :=
by { ext1 v, rw [(Z.local_triv i).symmL_apply 𝕜, (Z.local_triv i).symm_apply], exacts [rfl, hb] }

@[simp, mfld_simps] lemma trivialization_at_symmL {b₀ b : B}
  (hb : b ∈ (trivialization_at F Z.fiber b₀).base_set) :
  (trivialization_at F Z.fiber b₀).symmL 𝕜 b = Z.coord_change (Z.index_at b₀) (Z.index_at b) b :=
Z.local_triv_symmL hb

@[simp, mfld_simps] lemma trivialization_at_coord_change_eq {b₀ b₁ b : B}
  (hb : b ∈ (trivialization_at F Z.fiber b₀).base_set ∩ (trivialization_at F Z.fiber b₁).base_set)
  (v : F) :
  (trivialization_at F Z.fiber b₀).coord_changeL 𝕜 (trivialization_at F Z.fiber b₁) b v =
  Z.coord_change (Z.index_at b₀) (Z.index_at b₁) b v :=
Z.local_triv_coord_change_eq _ _ hb v

end vector_bundle_core

namespace tangent_bundle

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
{H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]

lemma ext_chart_at_def (x : M) : ext_chart_at I x = (chart_at H x).extend I := rfl

lemma coord_change_at_self {b b' x : F} :
  (tangent_bundle_core 𝓘(𝕜, F) F).coord_change (achart F b) (achart F b') x = 1 :=
by simpa only [tangent_bundle_core_coord_change] with mfld_simps using
    fderiv_within_id unique_diff_within_at_univ

end tangent_bundle

section smooth_manifold_with_corners
open smooth_manifold_with_corners

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
  {E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
  {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
  {F' : Type*} [normed_add_comm_group F'] [normed_space 𝕜 F']
  {H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
  {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
  {G : Type*} [topological_space G] {J : model_with_corners 𝕜 F G}
  {G' : Type*} [topological_space G'] {J' : model_with_corners 𝕜 F' G'}
  {M : Type*} [topological_space M] [charted_space H M]
  {M' : Type*} [topological_space M'] [charted_space H' M']
  {N : Type*} [topological_space N] [charted_space G N]
  {N' : Type*} [topological_space N'] [charted_space G' N']
  {F'' : Type*} [normed_add_comm_group F''] [normed_space 𝕜 F'']
variables {f : M → M'} {m n : ℕ∞} {s : set M} {x x' : M}
-- declare some additional normed spaces, used for fibers of vector bundles
{F₁ : Type*} [normed_add_comm_group F₁] [normed_space 𝕜 F₁]
{F₂ : Type*} [normed_add_comm_group F₂] [normed_space 𝕜 F₂]

variables [smooth_manifold_with_corners I M] [smooth_manifold_with_corners I' M']
  [smooth_manifold_with_corners J N]

-- this can be useful to see where we (ab)use definitional equalities
-- local attribute [irreducible] tangent_space

/-! The two instances below deserve some further thought. For example one might not want the tangent
space at every point to carry a canonical norm.

Note that `dual_pair.update` requires `F` to be a `normed_add_comm_group` (though perhaps we could
get away with `has_continuous_smul` with sufficient extra work).

In `rel_mfld.slice` we use `dual_pair.update` applied to `tangent_space`. If we don't add these
instances, then in fact Lean still accepts the definition. What is going on is that Lean
is unfolding the definition of `tangent_space`, realizing that `tangent_space I x = E` and
`tangent_space I' y = E'` and using the `normed_add_comm_group` instances of these types.
Note that this still uses these instances but at the cost that up to reducible transparency, the
term is not type-correct (in other words: you have to unfold `tangent_space` to realize that the
term is type-correct).

This means that many tactics, like `simp`, `rw`, and `dsimp` fail to rewrite within this term,
because the result is not type correct up to reducible transparancy.

Declaring these instances avoids such problems. -/

instance {x : M} : normed_add_comm_group (tangent_space I x) := by delta_instance tangent_space
instance {x : M} : normed_space 𝕜 (tangent_space I x) := by delta_instance tangent_space

-- lemma tangent_bundle_core_coord_change_achart (x x' : M) (z : H) :
--   (tangent_bundle_core I M).coord_change (achart H x) (achart H x') z =
--   fderiv_within 𝕜 (ext_chart_at I x' ∘ (ext_chart_at I x).symm) (range I) (I z) :=
-- rfl

variables (I)
-- used in tangent_bundle_model_space_chart_at

lemma cont_mdiff_prod {f : M → M' × N'} :
  cont_mdiff I (I'.prod J') n f ↔
  cont_mdiff I I' n (λ x, (f x).1) ∧ cont_mdiff I J' n (λ x, (f x).2) :=
⟨λ h, ⟨h.fst, h.snd⟩, λ h, by { convert h.1.prod_mk h.2, ext x; refl }⟩

lemma cont_mdiff_at_prod {f : M → M' × N'} {x : M} :
  cont_mdiff_at I (I'.prod J') n f x ↔
  cont_mdiff_at I I' n (λ x, (f x).1) x ∧ cont_mdiff_at I J' n (λ x, (f x).2) x :=
⟨λ h, ⟨h.fst, h.snd⟩, λ h, by { convert h.1.prod_mk h.2, ext x; refl }⟩

lemma model_with_corners.fderiv_within_comp_symm (x : H) :
  fderiv_within 𝕜 (I ∘ I.symm) (range I) (I x) = continuous_linear_map.id 𝕜 E :=
begin
  have : fderiv_within 𝕜 (I ∘ I.symm) (range I) (I x) = fderiv_within 𝕜 id (range I) (I x),
  { refine fderiv_within_congr I.unique_diff_at_image (λ y hy, _) (by simp only with mfld_simps),
    exact model_with_corners.right_inv _ hy },
  rwa fderiv_within_id I.unique_diff_at_image at this
end

lemma tangent_bundle_core_coord_change_model_space (x x' : H) (z : H) :
  (tangent_bundle_core I H).coord_change (achart H x) (achart H x') z =
  continuous_linear_map.id 𝕜 E :=
begin
  simp only [tangent_bundle_core_coord_change_achart, ext_chart_at, I.fderiv_within_comp_symm] with mfld_simps,
end

lemma cont_diff_on_coord_change' {e e' : local_homeomorph M H}
  (h : e ∈ atlas H M) (h' : e' ∈ atlas H M) :
  cont_diff_on 𝕜 ⊤ (I ∘ (e.symm ≫ₕ e') ∘ I.symm) (I.symm ⁻¹' (e.symm ≫ₕ e').source ∩ range I) :=
(has_groupoid.compatible (cont_diff_groupoid ⊤ I) h h').1

variables {I}
/-- A congruence lemma for `mfderiv`, (ab)using the fact that `tangent_space I' (f x)` is
definitionally equal to `E'`. -/
lemma mfderiv_congr_point {x' : M} (h : x = x') :
  @eq (E →L[𝕜] E') (mfderiv I I' f x) (mfderiv I I' f x') :=
by subst h

/-- A congruence lemma for `mfderiv`, (ab)using the fact that `tangent_space I' (f x)` is
definitionally equal to `E'`. -/
lemma mfderiv_congr {f' : M → M'} (h : f = f') :
  @eq (E →L[𝕜] E') (mfderiv I I' f x) (mfderiv I I' f' x) :=
by subst h

/-- The derivative of the projection `M × M' → M` is the projection `TM × TM' → TM` -/
lemma mfderiv_fst (x : M × M') :
  mfderiv (I.prod I') I prod.fst x = continuous_linear_map.fst 𝕜 E E' :=
begin
  simp_rw [mfderiv, if_pos smooth_at_fst.mdifferentiable_at, written_in_ext_chart_at,
    ext_chart_at_prod, function.comp, local_equiv.prod_coe, local_equiv.prod_coe_symm],
  have : unique_diff_within_at 𝕜 (range (I.prod I')) (ext_chart_at (I.prod I') x x) :=
  (I.prod I').unique_diff _ (mem_range_self _),
  refine (filter.eventually_eq.fderiv_within_eq this _ _).trans _,
  swap 3,
  { exact (ext_chart_at I x.1).right_inv ((ext_chart_at I x.1).maps_to $
      mem_ext_chart_source I x.1) },
  { refine eventually_of_mem (ext_chart_at_target_mem_nhds_within (I.prod I') x)
      (λ y hy, local_equiv.right_inv _ _),
    rw [ext_chart_at_prod] at hy,
    exact hy.1 },
  exact fderiv_within_fst this,
end

/-- The derivative of the projection `M × M' → M'` is the projection `TM × TM' → TM'` -/
lemma mfderiv_snd (x : M × M') :
  mfderiv (I.prod I') I' prod.snd x = continuous_linear_map.snd 𝕜 E E' :=
begin
  simp_rw [mfderiv, if_pos smooth_at_snd.mdifferentiable_at, written_in_ext_chart_at,
    ext_chart_at_prod, function.comp, local_equiv.prod_coe, local_equiv.prod_coe_symm],
  have : unique_diff_within_at 𝕜 (range (I.prod I')) (ext_chart_at (I.prod I') x x) :=
  (I.prod I').unique_diff _ (mem_range_self _),
  refine (filter.eventually_eq.fderiv_within_eq this _ _).trans _,
  swap 3,
  { exact (ext_chart_at I' x.2).right_inv ((ext_chart_at I' x.2).maps_to $
      mem_ext_chart_source I' x.2) },
  { refine eventually_of_mem (ext_chart_at_target_mem_nhds_within (I.prod I') x)
      (λ y hy, local_equiv.right_inv _ _),
    rw [ext_chart_at_prod] at hy,
    exact hy.2 },
  exact fderiv_within_snd this,
end

lemma mdifferentiable_at.prod_mk {f : N → M} {g : N → M'} {x : N}
  (hf : mdifferentiable_at J I f x)
  (hg : mdifferentiable_at J I' g x) :
  mdifferentiable_at J (I.prod I') (λ x, (f x, g x)) x :=
⟨hf.1.prod hg.1, hf.2.prod hg.2⟩

-- todo: rename differentiable_at.fderiv_within_prod -> differentiable_within_at.fderiv_within_prod
lemma mdifferentiable_at.mfderiv_prod {f : N → M} {g : N → M'} {x : N}
  (hf : mdifferentiable_at J I f x)
  (hg : mdifferentiable_at J I' g x) :
  mfderiv J (I.prod I') (λ x, (f x, g x)) x = (mfderiv J I f x).prod (mfderiv J I' g x) :=
begin
  classical,
  simp_rw [mfderiv, if_pos (hf.prod_mk hg), if_pos hf, if_pos hg],
  exact differentiable_at.fderiv_within_prod hf.2 hg.2 (J.unique_diff _ (mem_range_self _))
end

lemma mfderiv_prod_left {x₀ : M} {y₀ : M'} :
  mfderiv I (I.prod I') (λ x, (x, y₀)) x₀ = continuous_linear_map.inl 𝕜 E E' :=
begin
  refine ((mdifferentiable_at_id I).mfderiv_prod (mdifferentiable_at_const I I')).trans _,
  rw [mfderiv_id, mfderiv_const],
  refl
end

lemma mfderiv_prod_right {x₀ : M} {y₀ : M'} :
  mfderiv I' (I.prod I') (λ y, (x₀, y)) y₀ = continuous_linear_map.inr 𝕜 E E' :=
begin
  refine ((mdifferentiable_at_const I' I).mfderiv_prod (mdifferentiable_at_id I')).trans _,
  rw [mfderiv_id, mfderiv_const],
  refl
end

lemma mfderiv_prod_eq_add {f : N × M → M'} {p : N × M}
  (hf : mdifferentiable_at (J.prod I) I' f p) :
  mfderiv (J.prod I) I' f p =
  (show F × E →L[𝕜] E', from mfderiv (J.prod I) I' (λ (z : N × M), f (z.1, p.2)) p +
  mfderiv (J.prod I) I' (λ (z : N × M), f (p.1, z.2)) p) :=
begin
  dsimp only,
  rw [← @prod.mk.eta _ _ p] at hf,
  rw [mfderiv_comp p (by apply hf) (smooth_fst.prod_mk smooth_const).mdifferentiable_at,
    mfderiv_comp p (by apply hf) (smooth_const.prod_mk smooth_snd).mdifferentiable_at,
    ← continuous_linear_map.comp_add,
    smooth_fst.mdifferentiable_at.mfderiv_prod smooth_const.mdifferentiable_at,
    smooth_const.mdifferentiable_at.mfderiv_prod smooth_snd.mdifferentiable_at,
    mfderiv_fst, mfderiv_snd, mfderiv_const, mfderiv_const],
  symmetry,
  convert continuous_linear_map.comp_id _,
  { exact continuous_linear_map.fst_prod_zero_add_zero_prod_snd },
  simp_rw [prod.mk.eta],
end

-- lemma cont_mdiff_within_at_insert :
--   cont_mdiff_within_at I I' n f (insert x' s) x ↔ cont_mdiff_within_at I I' n f s x :=
-- begin
--   sorry
-- end

-- alias cont_mdiff_within_at_insert ↔ cont_mdiff_within_at.of_insert cont_mdiff_within_at.insert'

-- lemma cont_mdiff_within_at.insert (h : cont_mdiff_within_at I I' n f s x) :
--   cont_mdiff_within_at I I' n f (insert x s) x :=
-- h.insert'

open bundle
variables
  {Z : M → Type*} [topological_space (total_space Z)] [∀ b, topological_space (Z b)]
  [∀ b, add_comm_monoid (Z b)] [∀ b, module 𝕜 (Z b)]
  [fiber_bundle F₁ Z] [vector_bundle 𝕜 F₁ Z] [smooth_vector_bundle F₁ Z I]
  {Z₂ : M' → Type*} [topological_space (total_space Z₂)] [∀ b, topological_space (Z₂ b)]
  [∀ b, add_comm_monoid (Z₂ b)] [∀ b, module 𝕜 (Z₂ b)]
  [fiber_bundle F₂ Z₂] [vector_bundle 𝕜 F₂ Z₂] [smooth_vector_bundle F₂ Z₂ I']

variables (I I' Z Z₂ F₁ F₂)

/-- When `ϕ` is a continuous linear map that changes vectors in charts around `x` to vectors
  in charts around `y`, `in_coordinates' Z Z₂ x₀ x y₀ y ϕ` is a coordinate change of this continuous
  linear map that makes sense from charts around `x₀` to charts around `y₀`
  by composing it with appropriate coordinate changes given by smooth vector bundles `Z` and `Z₂`.
-/
def in_coordinates' (x₀ x : M) (y₀ y : M') (ϕ : Z x →L[𝕜] Z₂ y) : F₁ →L[𝕜] F₂ :=
(trivialization_at F₂ Z₂ y₀).continuous_linear_map_at 𝕜 y ∘L ϕ ∘L
(trivialization_at F₁ Z x₀).symmL 𝕜 x

/-- When `ϕ x` is a continuous linear map that changes vectors in charts around `f x` to vectors
  in charts around `g x`, `in_coordinates I I' f g ϕ x₀ x` is a coordinate change of this continuous
  linear map that makes sense from charts around `f x₀` to charts around `g x₀`
  by composing it with appropriate coordinate changes. -/
def in_coordinates (f : N → M) (g : N → M')
  (ϕ : Π x : N, tangent_space I (f x) →L[𝕜] tangent_space I' (g x)) : N → N → E →L[𝕜] E' :=
λ x₀ x, in_coordinates' E E' (tangent_space I) (tangent_space I') (f x₀) (f x) (g x₀) (g x) (ϕ x)

variables {F₁ F₂}

/-! Todo: use `in_coordinates` instead of `in_coordinates_core`.
These are the same mathematical object, but not equal, since they are defined differently if the
`x` and the `y` are not in the right charts. -/

def in_coordinates_core' {ι₁ ι₂} (Z₁ : vector_bundle_core 𝕜 M F₁ ι₁)
  (Z₂ : vector_bundle_core 𝕜 M' F₂ ι₂) (x₀ x : M) (y₀ y : M') (ϕ : F₁ →L[𝕜] F₂) : F₁ →L[𝕜] F₂ :=
Z₂.coord_change (Z₂.index_at y) (Z₂.index_at y₀) y ∘L ϕ ∘L
  Z₁.coord_change (Z₁.index_at x₀) (Z₁.index_at x) x

def in_coordinates_core (f : N → M) (g : N → M') (ϕ : N → E →L[𝕜] E') :
  N → N → E →L[𝕜] E' :=
λ x₀ x, in_coordinates_core' (tangent_bundle_core I M) (tangent_bundle_core I' M')
  (f x₀) (f x) (g x₀) (g x) (ϕ x)

/-- rewrite `in_coordinates'` using continuous linear equivalences. -/
lemma in_coordinates'_eq (x₀ x : M) (y₀ y : M') (ϕ : Z x →L[𝕜] Z₂ y)
  (hx : x ∈ (trivialization_at F₁ Z x₀).base_set)
  (hy : y ∈ (trivialization_at F₂ Z₂ y₀).base_set) :
  in_coordinates' F₁ F₂ Z Z₂ x₀ x y₀ y ϕ =
  ((trivialization_at F₂ Z₂ y₀).continuous_linear_equiv_at 𝕜 y hy : Z₂ y →L[𝕜] F₂) ∘L ϕ ∘L
  (((trivialization_at F₁ Z x₀).continuous_linear_equiv_at 𝕜 x hx).symm : F₁ →L[𝕜] Z x) :=
begin
  ext,
  simp_rw [in_coordinates', continuous_linear_map.coe_comp', continuous_linear_equiv.coe_coe,
    trivialization.coe_continuous_linear_equiv_at_eq,
    trivialization.symm_continuous_linear_equiv_at_eq]
end

/-- The map `in_coordinates_core'` is trivial on the model spaces -/
lemma in_coordinates_core'_tangent_bundle_core_model_space
  (x₀ x : H) (y₀ y : H') (ϕ : E →L[𝕜] E') :
    in_coordinates_core' (tangent_bundle_core I H) (tangent_bundle_core I' H') x₀ x y₀ y ϕ = ϕ :=
by simp_rw [in_coordinates_core', tangent_bundle_core_index_at,
  tangent_bundle_core_coord_change_model_space,
  continuous_linear_map.id_comp, continuous_linear_map.comp_id]

lemma in_coordinates_core_model_space (f : N → H) (g : N → H') (ϕ : N → E →L[𝕜] E') (x₀ : N) :
    in_coordinates_core I I' f g ϕ x₀ = ϕ :=
by simp_rw [in_coordinates_core, in_coordinates_core'_tangent_bundle_core_model_space]

lemma in_coordinates_core'_eq {ι₁ ι₂} (Z₁ : vector_bundle_core 𝕜 M F₁ ι₁)
  (Z₂ : vector_bundle_core 𝕜 M' F₂ ι₂)
  {x₀ x : M} {y₀ y : M'} (ϕ : F₁ →L[𝕜] F₂)
  (hx : x ∈ Z₁.base_set (Z₁.index_at x₀))
  (hy : y ∈ Z₂.base_set (Z₂.index_at y₀)) :
    in_coordinates' F₁ F₂ Z₁.fiber Z₂.fiber x₀ x y₀ y ϕ =
    in_coordinates_core' Z₁ Z₂ x₀ x y₀ y ϕ :=
by simp_rw [in_coordinates', in_coordinates_core',
    Z₂.trivialization_at_continuous_linear_map_at hy, Z₁.trivialization_at_symmL hx]

variables {I I'}

-- lemma cont_mdiff_within_at.mfderiv {s : set N} {x : N} (f : N → M → M') (g : N → M)
--   (hf : cont_mdiff_within_at (J.prod I) I' n (function.uncurry f) (prod.fst ⁻¹' s) (x, g x))
--   (hg : cont_mdiff_within_at J I m g s x) (hmn : m + 1 ≤ n) (hxs : x ∈ s) :
--   -- todo: remove x ∈ s hypothesis by working with `insert x s` everywhere.
--   cont_mdiff_within_at J 𝓘(𝕜, E →L[𝕜] E') m
--     (in_coordinates_core I I' g (λ x, f x (g x)) (λ x', mfderiv I I' (f x') (g x')) x) s x :=
-- begin
--   have h4f : continuous_within_at (λ x, f x (g x)) s x,
--   { apply continuous_within_at.comp (by apply hf.continuous_within_at)
--       (continuous_within_at_id.prod hg.continuous_within_at),
--     simp_rw [maps_to', image_subset_iff, preimage_preimage, preimage_id] },
--   have h3f := cont_mdiff_within_at_iff_cont_mdiff_on_nhds.mp
--     (hf.of_le $ (self_le_add_left 1 m).trans hmn),
--   have h2f : ∀ᶠ x₂ in 𝓝[s] x, cont_mdiff_at I I' 1 (f x₂) (g x₂),
--   sorry,
--   -- { refine ((continuous_within_at_id.prod hg.continuous_within_at).tendsto.eventually h3f).mono (λ x hx, _),
--   --   exact hx.comp (g x) (cont_mdiff_within_at_const.prod_mk cont_mdiff_within_at_id) },
--   have h2g := hg.continuous_within_at.preimage_mem_nhds_within
--     (ext_chart_at_source_mem_nhds I (g x)),
--   have : cont_diff_within_at 𝕜 m (λ x', fderiv_within 𝕜
--     (ext_chart_at I' (f x (g x)) ∘ f ((ext_chart_at J x).symm x') ∘ (ext_chart_at I (g x)).symm)
--     (range I) (ext_chart_at I (g x) (g ((ext_chart_at J x).symm x'))))
--     ((ext_chart_at J x).symm ⁻¹' s ∩ range J) (ext_chart_at J x x),
--   { rw [cont_mdiff_within_at_iff] at hf hg,
--     simp_rw [function.comp, uncurry, ext_chart_at_prod, local_equiv.prod_coe_symm] at hf ⊢,
--     refine (cont_diff_within_at_fderiv_within _
--       (hg.2.mono_of_mem _) I.unique_diff hmn _ _ _ _).mono_of_mem _,
--     swap 3,
--     { simp_rw [function.comp, ext_chart_at_to_inv], exact hf.2 },
--     { refine (ext_chart_at J x).symm ⁻¹' s ∩ (ext_chart_at J x).target ∩
--         (ext_chart_at J x).symm ⁻¹' (g ⁻¹' (ext_chart_at I (g x)).source) },
--     { refine mem_of_superset self_mem_nhds_within ((inter_subset_left _ _).trans $ _),
--       exact inter_subset_inter_right _ (ext_chart_at_target_subset_range J x) },
--     { simp_rw [mem_inter_iff, mem_preimage, ext_chart_at_to_inv],
--       exact ⟨⟨hxs, local_equiv.maps_to _ (mem_ext_chart_source J x)⟩,
--         mem_ext_chart_source I (g x)⟩ },
--     { simp_rw [model_with_corners.range_prod],
--       rw [inter_assoc, inter_prod],
--       refine inter_subset_inter _ _,
--       { sorry },
--       exact set.prod_mono ((inter_subset_left _ _).trans $ ext_chart_at_target_subset_range J x)
--         subset_rfl },
--     { refine eventually_of_forall (λ x', mem_range_self _) },
--     swap 2,
--     { sorry,
--       -- refine inter_mem (ext_chart_at_target_mem_nhds_within J x) _,
--       -- ext_chart_at_preimage_mem_nhds_within
--       -- refine nhds_within_le_nhds (ext_chart_at_preimage_mem_nhds' _ _ (mem_ext_chart_source J x) _),
--       -- exact hg.1.preimage_mem_nhds (ext_chart_at_source_mem_nhds I (g x))
--       },
--     simp_rw [function.comp, ext_chart_at_to_inv],
--     refine mem_of_superset self_mem_nhds_within _,
--     refine (image_subset_range _ _).trans _,
--     exact range_comp_subset_range (λ a, chart_at H (g x) $ g $ (chart_at G x).symm $ J.symm a) I },
--   have : cont_mdiff_within_at J 𝓘(𝕜, E →L[𝕜] E') m
--     (λ x', fderiv_within 𝕜 (ext_chart_at I' (f x (g x)) ∘ f x' ∘ (ext_chart_at I (g x)).symm)
--     (range I) (ext_chart_at I (g x) (g x'))) s x,
--   { simp_rw [cont_mdiff_within_at_iff_source_of_mem_source (mem_chart_source G x),
--       cont_mdiff_within_at_iff_cont_diff_within_at, function.comp],
--     exact this },
--   have : cont_mdiff_within_at J 𝓘(𝕜, E →L[𝕜] E') m
--     (λ x', fderiv_within 𝕜 (ext_chart_at I' (f x (g x)) ∘ (ext_chart_at I' (f x' (g x'))).symm ∘
--       written_in_ext_chart_at I I' (g x') (f x') ∘ ext_chart_at I (g x') ∘
--       (ext_chart_at I (g x)).symm) (range I) (ext_chart_at I (g x) (g x'))) s x,
--   { refine this.congr_of_eventually_eq _ sorry,
--     filter_upwards [h2g, h2f],
--     intros x₂ hx₂ h2x₂,
--     have : ∀ x' ∈ (ext_chart_at I (g x)).symm ⁻¹' (ext_chart_at I (g x₂)).source ∩
--         (ext_chart_at I (g x)).symm ⁻¹' (f x₂ ⁻¹' (ext_chart_at I' (f x₂ (g x₂))).source),
--       (ext_chart_at I' (f x (g x)) ∘ (ext_chart_at I' (f x₂ (g x₂))).symm ∘
--       written_in_ext_chart_at I I' (g x₂) (f x₂) ∘ ext_chart_at I (g x₂) ∘
--       (ext_chart_at I (g x)).symm) x' =
--       ext_chart_at I' (f x (g x)) (f x₂ ((ext_chart_at I (g x)).symm x')),
--     { rintro x' ⟨hx', h2x'⟩,
--       simp_rw [written_in_ext_chart_at, function.comp_apply],
--       rw [(ext_chart_at I (g x₂)).left_inv hx', (ext_chart_at I' (f x₂ (g x₂))).left_inv h2x'] },
--     refine filter.eventually_eq.fderiv_within_eq_nhds (I.unique_diff _ $ mem_range_self _) _,
--     refine eventually_of_mem (inter_mem _ _) this,
--     { exact ext_chart_at_preimage_mem_nhds' _ _ hx₂ (ext_chart_at_source_mem_nhds I (g x₂)) },
--     refine ext_chart_at_preimage_mem_nhds' _ _ hx₂ _,
--     exact h2x₂.continuous_at.preimage_mem_nhds (ext_chart_at_source_mem_nhds _ _) },
--   /- The conclusion is the same as the following, when unfolding coord_change of
--     `tangent_bundle_core` -/
--   change cont_mdiff_within_at J 𝓘(𝕜, E →L[𝕜] E') m
--     (λ x', (fderiv_within 𝕜 (ext_chart_at I' (f x (g x)) ∘ (ext_chart_at I' (f x' (g x'))).symm)
--         (range I') (ext_chart_at I' (f x' (g x')) (f x' (g x')))).comp
--         ((mfderiv I I' (f x') (g x')).comp (fderiv_within 𝕜 (ext_chart_at I (g x') ∘
--         (ext_chart_at I (g x)).symm) (range I) (ext_chart_at I (g x) (g x'))))) s x,
--   refine this.congr_of_eventually_eq _ sorry,
--   filter_upwards [h2g, h2f,
--     h4f.preimage_mem_nhds_within (ext_chart_at_source_mem_nhds I' (f x (g x)))],
--   intros x₂ hx₂ h2x₂ h3x₂,
--   symmetry,
--   rw [(h2x₂.mdifferentiable_at le_rfl).mfderiv],
--   have hI := (cont_diff_within_at_ext_coord_change I (g x₂) (g x) $
--     local_equiv.mem_symm_trans_source _ hx₂ $ mem_ext_chart_source I (g x₂))
--     .differentiable_within_at le_top,
--   have hI' := (cont_diff_within_at_ext_coord_change I' (f x (g x)) (f x₂ (g x₂)) $
--     local_equiv.mem_symm_trans_source _
--     (mem_ext_chart_source I' (f x₂ (g x₂))) h3x₂).differentiable_within_at le_top,
--   have h3f := (h2x₂.mdifferentiable_at le_rfl).2,
--   refine fderiv_within.comp₃ _ hI' h3f hI _ _ _ _ (I.unique_diff _ $ mem_range_self _),
--   { exact λ x _, mem_range_self _ },
--   { exact λ x _, mem_range_self _ },
--   { simp_rw [written_in_ext_chart_at, function.comp_apply,
--       (ext_chart_at I (g x₂)).left_inv (mem_ext_chart_source I (g x₂))] },
--   { simp_rw [function.comp_apply, (ext_chart_at I (g x)).left_inv hx₂] }
-- end

 -- todo: prove from cont_mdiff_within_at.mfderiv
/-- The appropriate (more general) formulation of `cont_mdiff_at.mfderiv''`. -/
lemma cont_mdiff_at.mfderiv''' {x : N} (f : N → M → M') (g : N → M)
  (hf : cont_mdiff_at (J.prod I) I' n (function.uncurry f) (x, g x))
  (hg : cont_mdiff_at J I m g x) (hmn : m + 1 ≤ n) :
  cont_mdiff_at J 𝓘(𝕜, E →L[𝕜] E') m
    (in_coordinates_core I I' g (λ x, f x (g x)) (λ x', mfderiv I I' (f x') (g x')) x) x :=
begin
  have h4f : continuous_at (λ x, f x (g x)) x,
  { apply continuous_at.comp (by apply hf.continuous_at) (continuous_at_id.prod hg.continuous_at) },
  have h3f := cont_mdiff_at_iff_cont_mdiff_at_nhds.mp (hf.of_le $ (self_le_add_left 1 m).trans hmn),
  have h2f : ∀ᶠ x₂ in 𝓝 x, cont_mdiff_at I I' 1 (f x₂) (g x₂),
  { refine ((continuous_at_id.prod hg.continuous_at).tendsto.eventually h3f).mono (λ x hx, _),
    exact hx.comp (g x) (cont_mdiff_at_const.prod_mk cont_mdiff_at_id) },
  have h2g := hg.continuous_at.preimage_mem_nhds (ext_chart_at_source_mem_nhds I (g x)),
  have : cont_diff_within_at 𝕜 m (λ x', fderiv_within 𝕜
    (ext_chart_at I' (f x (g x)) ∘ f ((ext_chart_at J x).symm x') ∘ (ext_chart_at I (g x)).symm)
    (range I) (ext_chart_at I (g x) (g ((ext_chart_at J x).symm x'))))
    (range J) (ext_chart_at J x x),
  { rw [cont_mdiff_at_iff] at hf hg,
    simp_rw [function.comp, uncurry, ext_chart_at_prod, local_equiv.prod_coe_symm] at hf ⊢,
    refine (cont_diff_within_at_fderiv_within _
      (hg.2.mono_of_mem _) I.unique_diff hmn _ _ _ _).mono_of_mem _,
    swap 3,
    { simp_rw [function.comp, ext_chart_at_to_inv], exact hf.2 },
    { refine (ext_chart_at J x).target ∩
      (λ x', (ext_chart_at J x).symm x') ⁻¹' (g ⁻¹' (ext_chart_at I (g x)).source) },
    { exact mem_of_superset self_mem_nhds_within
        ((inter_subset_left _ _).trans $ ext_chart_at_target_subset_range J x) },
    { simp_rw [mem_inter_iff, mem_preimage, ext_chart_at_to_inv],
      exact ⟨local_equiv.maps_to _ (mem_ext_chart_source J x), mem_ext_chart_source I (g x)⟩ },
    { simp_rw [model_with_corners.range_prod],
      exact set.prod_mono ((inter_subset_left _ _).trans $ ext_chart_at_target_subset_range J x)
        subset_rfl },
    { refine eventually_of_forall (λ x', mem_range_self _) },
    swap 2,
    { refine inter_mem (ext_chart_at_target_mem_nhds_within J x) _,
      refine nhds_within_le_nhds (ext_chart_at_preimage_mem_nhds' _ _ (mem_ext_chart_source J x) _),
      exact hg.1.preimage_mem_nhds (ext_chart_at_source_mem_nhds I (g x)) },
    simp_rw [function.comp, ext_chart_at_to_inv],
    refine mem_of_superset self_mem_nhds_within _,
    refine (image_subset_range _ _).trans _,
    exact range_comp_subset_range (λ a, chart_at H (g x) $ g $ (chart_at G x).symm $ J.symm a) I },
  have : cont_mdiff_at J 𝓘(𝕜, E →L[𝕜] E') m
    (λ x', fderiv_within 𝕜 (ext_chart_at I' (f x (g x)) ∘ f x' ∘ (ext_chart_at I (g x)).symm)
    (range I) (ext_chart_at I (g x) (g x'))) x,
  { simp_rw [cont_mdiff_at_iff_source_of_mem_source (mem_chart_source G x),
      cont_mdiff_within_at_iff_cont_diff_within_at, function.comp],
    exact this },
  have : cont_mdiff_at J 𝓘(𝕜, E →L[𝕜] E') m
    (λ x', fderiv_within 𝕜 (ext_chart_at I' (f x (g x)) ∘ (ext_chart_at I' (f x' (g x'))).symm ∘
      written_in_ext_chart_at I I' (g x') (f x') ∘ ext_chart_at I (g x') ∘
      (ext_chart_at I (g x)).symm) (range I) (ext_chart_at I (g x) (g x'))) x,
  { refine this.congr_of_eventually_eq _,
    filter_upwards [h2g, h2f],
    intros x₂ hx₂ h2x₂,
    have : ∀ x' ∈ (ext_chart_at I (g x)).symm ⁻¹' (ext_chart_at I (g x₂)).source ∩
        (ext_chart_at I (g x)).symm ⁻¹' (f x₂ ⁻¹' (ext_chart_at I' (f x₂ (g x₂))).source),
      (ext_chart_at I' (f x (g x)) ∘ (ext_chart_at I' (f x₂ (g x₂))).symm ∘
      written_in_ext_chart_at I I' (g x₂) (f x₂) ∘ ext_chart_at I (g x₂) ∘
      (ext_chart_at I (g x)).symm) x' =
      ext_chart_at I' (f x (g x)) (f x₂ ((ext_chart_at I (g x)).symm x')),
    { rintro x' ⟨hx', h2x'⟩,
      simp_rw [written_in_ext_chart_at, function.comp_apply],
      rw [(ext_chart_at I (g x₂)).left_inv hx', (ext_chart_at I' (f x₂ (g x₂))).left_inv h2x'] },
    refine filter.eventually_eq.fderiv_within_eq_nhds (I.unique_diff _ $ mem_range_self _) _,
    refine eventually_of_mem (inter_mem _ _) this,
    { exact ext_chart_at_preimage_mem_nhds' _ _ hx₂ (ext_chart_at_source_mem_nhds I (g x₂)) },
    refine ext_chart_at_preimage_mem_nhds' _ _ hx₂ _,
    exact (h2x₂.continuous_at).preimage_mem_nhds (ext_chart_at_source_mem_nhds _ _) },
  /- The conclusion is the same as the following, when unfolding coord_change of
    `tangent_bundle_core` -/
  change cont_mdiff_at J 𝓘(𝕜, E →L[𝕜] E') m
    (λ x', (fderiv_within 𝕜 (ext_chart_at I' (f x (g x)) ∘ (ext_chart_at I' (f x' (g x'))).symm)
        (range I') (ext_chart_at I' (f x' (g x')) (f x' (g x')))).comp
        ((mfderiv I I' (f x') (g x')).comp (fderiv_within 𝕜 (ext_chart_at I (g x') ∘
        (ext_chart_at I (g x)).symm) (range I) (ext_chart_at I (g x) (g x'))))) x,
  refine this.congr_of_eventually_eq _,
  filter_upwards [h2g, h2f,
    h4f.preimage_mem_nhds (ext_chart_at_source_mem_nhds I' (f x (g x)))],
  intros x₂ hx₂ h2x₂ h3x₂,
  symmetry,
  rw [(h2x₂.mdifferentiable_at le_rfl).mfderiv],
  have hI := (cont_diff_within_at_ext_coord_change I (g x₂) (g x) $
    local_equiv.mem_symm_trans_source _ hx₂ $ mem_ext_chart_source I (g x₂))
    .differentiable_within_at le_top,
  have hI' := (cont_diff_within_at_ext_coord_change I' (f x (g x)) (f x₂ (g x₂)) $
    local_equiv.mem_symm_trans_source _
    (mem_ext_chart_source I' (f x₂ (g x₂))) h3x₂).differentiable_within_at le_top,
  have h3f := (h2x₂.mdifferentiable_at le_rfl).2,
  refine fderiv_within.comp₃ _ hI' h3f hI _ _ _ _ (I.unique_diff _ $ mem_range_self _),
  { exact λ x _, mem_range_self _ },
  { exact λ x _, mem_range_self _ },
  { simp_rw [written_in_ext_chart_at, function.comp_apply,
      (ext_chart_at I (g x₂)).left_inv (mem_ext_chart_source I (g x₂))] },
  { simp_rw [function.comp_apply, (ext_chart_at I (g x)).left_inv hx₂] }
end

/-- The map `D_xf(x,y)` is `C^n` as a continuous linear map, assuming that `f` is a `C^(n+1)` map
between manifolds.
We have to insert appropriate coordinate changes to make sense of this statement.
This statement is general enough to work for partial derivatives / functions with parameters. -/
lemma cont_mdiff_at.mfderiv'' (f : M → M → M')
  (hf : cont_mdiff_at (I.prod I) I' n (function.uncurry f) (x, x)) (hmn : m + 1 ≤ n) :
  cont_mdiff_at I 𝓘(𝕜, E →L[𝕜] E') m
    (in_coordinates_core I I' id (λ x, f x x) (λ x', mfderiv I I' (f x') x') x) x :=
hf.mfderiv''' f id cont_mdiff_at_id hmn

/-- The map `mfderiv f` is `C^n` as a continuous linear map, assuming that `f` is `C^(n+1)`.
We have to insert appropriate coordinate changes to make sense of this statement. -/
lemma cont_mdiff_at.mfderiv' {f : M → M'}
  (hf : cont_mdiff_at I I' n f x) (hmn : m + 1 ≤ n) :
  cont_mdiff_at I 𝓘(𝕜, E →L[𝕜] E') m (in_coordinates_core I I' id f (mfderiv I I' f) x) x :=
begin
  have : cont_mdiff_at (I.prod I) I' n (λ x : M × M, f x.2) (x, x) :=
  cont_mdiff_at.comp (x, x) hf cont_mdiff_at_snd,
  apply cont_mdiff_at.mfderiv'' (λ x, f) this hmn
  -- apply cont_mdiff_at.mfderiv''' (λ x, f) id this cont_mdiff_at_id hmn
end

instance has_smooth_add_self : has_smooth_add 𝓘(𝕜, F) F :=
⟨by { convert cont_diff_add.cont_mdiff, exact model_with_corners_self_prod.symm,
  exact charted_space_self_prod }⟩

end smooth_manifold_with_corners

section maps

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
{H : Type*} [topological_space H]
{H' : Type*} [topological_space H']
{G : Type*} [topological_space G]
{G' : Type*} [topological_space G']
{I : model_with_corners 𝕜 E H} {I' : model_with_corners 𝕜 E' H'}
{J : model_with_corners 𝕜 F G} {J' : model_with_corners 𝕜 F G'}

variables {M : Type*} [topological_space M] [charted_space H M]
{M' : Type*} [topological_space M'] [charted_space H' M']
{N : Type*} [topological_space N] [charted_space G N]
{N' : Type*} [topological_space N'] [charted_space G' N']
{n : ℕ∞}
(f : C^∞⟮I, M; J, N⟯)

namespace cont_mdiff_map

/-- The first projection of a product, as a smooth map. -/
def fst : C^n⟮I.prod I', M × M'; I, M⟯ := ⟨prod.fst, cont_mdiff_fst⟩

/-- The second projection of a product, as a smooth map. -/
def snd : C^n⟮I.prod I', M × M'; I', M'⟯ := ⟨prod.snd, cont_mdiff_snd⟩

/-- Given two smooth maps `f` and `g`, this is the smooth map `(x, y) ↦ (f x, g y)`. -/
def prod_mk (f : C^n⟮J, N; I, M⟯) (g : C^n⟮J, N; I', M'⟯) : C^n⟮J, N; I.prod I', M × M'⟯ :=
⟨λ x, (f x, g x), f.2.prod_mk g.2⟩

end cont_mdiff_map

namespace diffeomorph

instance : continuous_map_class (M ≃ₘ⟮I, J⟯ N) M N :=
{ coe := coe_fn,
  coe_injective' := coe_fn_injective,
  map_continuous := λ f, f.continuous }

end diffeomorph

end maps

section
variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
  {H : Type*} [topological_space H] (I : model_with_corners ℝ E H) {M : Type*}
  [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
  {G : Type*} [normed_add_comm_group G] [normed_space ℝ G] [finite_dimensional ℝ G]
  {HG : Type*} [topological_space HG] (IG : model_with_corners ℝ G HG) {N : Type*}
  [topological_space N] [charted_space HG N] [smooth_manifold_with_corners IG N]

def filter.germ.cont_mdiff_at' {x : M} (φ : germ (𝓝 x) N) (n : ℕ∞) : Prop :=
quotient.lift_on' φ (λ f, cont_mdiff_at I IG n f x) (λ f g h, propext begin
  split,
  all_goals { refine λ H, H.congr_of_eventually_eq _ },
  exacts [h.symm, h]
end)
end


/-
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Fin.Basic
import Init.System.Platform

open Nat

@[extern "lean_uint8_of_nat"]
def UInt8.ofNat (n : @& Nat) : UInt8 := ⟨Fin.ofNat n⟩
abbrev Nat.toUInt8 := UInt8.ofNat
@[extern "lean_uint8_to_nat"]
def UInt8.toNat (n : UInt8) : Nat := n.val.val
@[extern c inline "#1 + #2"]
def UInt8.add (a b : UInt8) : UInt8 := ⟨a.val + b.val⟩
@[extern c inline "#1 - #2"]
def UInt8.sub (a b : UInt8) : UInt8 := ⟨a.val - b.val⟩
@[extern c inline "#1 * #2"]
def UInt8.mul (a b : UInt8) : UInt8 := ⟨a.val * b.val⟩
@[extern c inline "#2 == 0 ? 0 : #1 / #2"]
def UInt8.div (a b : UInt8) : UInt8 := ⟨a.val / b.val⟩
@[extern c inline "#2 == 0 ? #1 : #1 % #2"]
def UInt8.mod (a b : UInt8) : UInt8 := ⟨a.val % b.val⟩
@[extern "lean_uint8_modn"]
def UInt8.modn (a : UInt8) (n : @& Nat) : UInt8 := ⟨a.val % n⟩
@[extern c inline "#1 & #2"]
def UInt8.land (a b : UInt8) : UInt8 := ⟨Fin.land a.val b.val⟩
@[extern c inline "#1 | #2"]
def UInt8.lor (a b : UInt8) : UInt8 := ⟨Fin.lor a.val b.val⟩
@[extern c inline "#1 ^ #2"]
def UInt8.xor (a b : UInt8) : UInt8 := ⟨Fin.xor a.val b.val⟩
@[extern c inline "#1 << #2 % 8"]
def UInt8.shiftLeft (a b : UInt8) : UInt8 := ⟨a.val <<< (modn b 8).val⟩
@[extern c inline "#1 >> #2 % 8"]
def UInt8.shiftRight (a b : UInt8) : UInt8 := ⟨a.val >>> (modn b 8).val⟩
def UInt8.lt (a b : UInt8) : Prop := a.val < b.val
def UInt8.le (a b : UInt8) : Prop := a.val ≤ b.val

instance : OfNat UInt8 n   := ⟨UInt8.ofNat n⟩
instance : Add UInt8       := ⟨UInt8.add⟩
instance : Sub UInt8       := ⟨UInt8.sub⟩
instance : Mul UInt8       := ⟨UInt8.mul⟩
instance : Mod UInt8       := ⟨UInt8.mod⟩
instance : HMod UInt8 Nat UInt8 := ⟨UInt8.modn⟩
instance : Div UInt8       := ⟨UInt8.div⟩
instance : LT UInt8        := ⟨UInt8.lt⟩
instance : LE UInt8        := ⟨UInt8.le⟩

@[extern c inline "~ #1"]
def UInt8.complement (a:UInt8) : UInt8 := 0-(a+1)

instance : Complement UInt8 := ⟨UInt8.complement⟩
instance : AndOp UInt8     := ⟨UInt8.land⟩
instance : OrOp UInt8      := ⟨UInt8.lor⟩
instance : Xor UInt8       := ⟨UInt8.xor⟩
instance : ShiftLeft UInt8  := ⟨UInt8.shiftLeft⟩
instance : ShiftRight UInt8 := ⟨UInt8.shiftRight⟩

set_option bootstrap.genMatcherCode false in
@[extern c inline "#1 < #2"]
def UInt8.decLt (a b : UInt8) : Decidable (a < b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))

set_option bootstrap.genMatcherCode false in
@[extern c inline "#1 <= #2"]
def UInt8.decLe (a b : UInt8) : Decidable (a ≤ b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))

instance (a b : UInt8) : Decidable (a < b) := UInt8.decLt a b
instance (a b : UInt8) : Decidable (a ≤ b) := UInt8.decLe a b

@[extern "lean_uint16_of_nat"]
def UInt16.ofNat (n : @& Nat) : UInt16 := ⟨Fin.ofNat n⟩
abbrev Nat.toUInt16 := UInt16.ofNat
@[extern "lean_uint16_to_nat"]
def UInt16.toNat (n : UInt16) : Nat := n.val.val
@[extern c inline "#1 + #2"]
def UInt16.add (a b : UInt16) : UInt16 := ⟨a.val + b.val⟩
@[extern c inline "#1 - #2"]
def UInt16.sub (a b : UInt16) : UInt16 := ⟨a.val - b.val⟩
@[extern c inline "#1 * #2"]
def UInt16.mul (a b : UInt16) : UInt16 := ⟨a.val * b.val⟩
@[extern c inline "#2 == 0 ? 0 : #1 / #2"]
def UInt16.div (a b : UInt16) : UInt16 := ⟨a.val / b.val⟩
@[extern c inline "#2 == 0 ? #1 : #1 % #2"]
def UInt16.mod (a b : UInt16) : UInt16 := ⟨a.val % b.val⟩
@[extern "lean_uint16_modn"]
def UInt16.modn (a : UInt16) (n : @& Nat) : UInt16 := ⟨a.val % n⟩
@[extern c inline "#1 & #2"]
def UInt16.land (a b : UInt16) : UInt16 := ⟨Fin.land a.val b.val⟩
@[extern c inline "#1 | #2"]
def UInt16.lor (a b : UInt16) : UInt16 := ⟨Fin.lor a.val b.val⟩
@[extern c inline "#1 ^ #2"]
def UInt16.xor (a b : UInt16) : UInt16 := ⟨Fin.xor a.val b.val⟩
@[extern c inline "#1 << #2 % 16"]
def UInt16.shiftLeft (a b : UInt16) : UInt16 := ⟨a.val <<< (modn b 16).val⟩
@[extern c inline "#1 >> #2 % 16"]
def UInt16.shiftRight (a b : UInt16) : UInt16 := ⟨a.val >>> (modn b 16).val⟩
def UInt16.lt (a b : UInt16) : Prop := a.val < b.val
def UInt16.le (a b : UInt16) : Prop := a.val ≤ b.val

instance : OfNat UInt16 n   := ⟨UInt16.ofNat n⟩
instance : Add UInt16       := ⟨UInt16.add⟩
instance : Sub UInt16       := ⟨UInt16.sub⟩
instance : Mul UInt16       := ⟨UInt16.mul⟩
instance : Mod UInt16       := ⟨UInt16.mod⟩
instance : HMod UInt16 Nat UInt16 := ⟨UInt16.modn⟩
instance : Div UInt16       := ⟨UInt16.div⟩
instance : LT UInt16        := ⟨UInt16.lt⟩
instance : LE UInt16        := ⟨UInt16.le⟩

@[extern c inline "~ #1"]
def UInt16.complement (a:UInt16) : UInt16 := 0-(a+1)

instance : Complement UInt16 := ⟨UInt16.complement⟩
instance : AndOp UInt16     := ⟨UInt16.land⟩
instance : OrOp UInt16      := ⟨UInt16.lor⟩
instance : Xor UInt16       := ⟨UInt16.xor⟩
instance : ShiftLeft UInt16  := ⟨UInt16.shiftLeft⟩
instance : ShiftRight UInt16 := ⟨UInt16.shiftRight⟩

set_option bootstrap.genMatcherCode false in
@[extern c inline "#1 < #2"]
def UInt16.decLt (a b : UInt16) : Decidable (a < b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))

set_option bootstrap.genMatcherCode false in
@[extern c inline "#1 <= #2"]
def UInt16.decLe (a b : UInt16) : Decidable (a ≤ b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))

instance (a b : UInt16) : Decidable (a < b) := UInt16.decLt a b
instance (a b : UInt16) : Decidable (a ≤ b) := UInt16.decLe a b

@[extern "lean_uint32_of_nat"]
def UInt32.ofNat (n : @& Nat) : UInt32 := ⟨Fin.ofNat n⟩
@[extern "lean_uint32_of_nat"]
def UInt32.ofNat' (n : Nat) (h : n < UInt32.size) : UInt32 := ⟨⟨n, h⟩⟩
abbrev Nat.toUInt32 := UInt32.ofNat
@[extern c inline "#1 + #2"]
def UInt32.add (a b : UInt32) : UInt32 := ⟨a.val + b.val⟩
@[extern c inline "#1 - #2"]
def UInt32.sub (a b : UInt32) : UInt32 := ⟨a.val - b.val⟩
@[extern c inline "#1 * #2"]
def UInt32.mul (a b : UInt32) : UInt32 := ⟨a.val * b.val⟩
@[extern c inline "#2 == 0 ? 0 : #1 / #2"]
def UInt32.div (a b : UInt32) : UInt32 := ⟨a.val / b.val⟩
@[extern c inline "#2 == 0 ? #1 : #1 % #2"]
def UInt32.mod (a b : UInt32) : UInt32 := ⟨a.val % b.val⟩
@[extern "lean_uint32_modn"]
def UInt32.modn (a : UInt32) (n : @& Nat) : UInt32 := ⟨a.val % n⟩
@[extern c inline "#1 & #2"]
def UInt32.land (a b : UInt32) : UInt32 := ⟨Fin.land a.val b.val⟩
@[extern c inline "#1 | #2"]
def UInt32.lor (a b : UInt32) : UInt32 := ⟨Fin.lor a.val b.val⟩
@[extern c inline "#1 ^ #2"]
def UInt32.xor (a b : UInt32) : UInt32 := ⟨Fin.xor a.val b.val⟩
@[extern c inline "#1 << #2 % 32"]
def UInt32.shiftLeft (a b : UInt32) : UInt32 := ⟨a.val <<< (modn b 32).val⟩
@[extern c inline "#1 >> #2 % 32"]
def UInt32.shiftRight (a b : UInt32) : UInt32 := ⟨a.val >>> (modn b 32).val⟩
@[extern c inline "((uint8_t)#1)"]
def UInt32.toUInt8 (a : UInt32) : UInt8 := a.toNat.toUInt8
@[extern c inline "((uint16_t)#1)"]
def UInt32.toUInt16 (a : UInt32) : UInt16 := a.toNat.toUInt16
@[extern c inline "((uint32_t)#1)"]
def UInt8.toUInt32 (a : UInt8) : UInt32 := a.toNat.toUInt32

instance : OfNat UInt32 n   := ⟨UInt32.ofNat n⟩
instance : Add UInt32       := ⟨UInt32.add⟩
instance : Sub UInt32       := ⟨UInt32.sub⟩
instance : Mul UInt32       := ⟨UInt32.mul⟩
instance : Mod UInt32       := ⟨UInt32.mod⟩
instance : HMod UInt32 Nat UInt32 := ⟨UInt32.modn⟩
instance : Div UInt32       := ⟨UInt32.div⟩

@[extern c inline "~ #1"]
def UInt32.complement (a:UInt32) : UInt32 := 0-(a+1)

instance : Complement UInt32 := ⟨UInt32.complement⟩
instance : AndOp UInt32     := ⟨UInt32.land⟩
instance : OrOp UInt32      := ⟨UInt32.lor⟩
instance : Xor UInt32       := ⟨UInt32.xor⟩
instance : ShiftLeft UInt32  := ⟨UInt32.shiftLeft⟩
instance : ShiftRight UInt32 := ⟨UInt32.shiftRight⟩

@[extern "lean_uint64_of_nat"]
def UInt64.ofNat (n : @& Nat) : UInt64 := ⟨Fin.ofNat n⟩
abbrev Nat.toUInt64 := UInt64.ofNat
@[extern "lean_uint64_to_nat"]
def UInt64.toNat (n : UInt64) : Nat := n.val.val
@[extern c inline "#1 + #2"]
def UInt64.add (a b : UInt64) : UInt64 := ⟨a.val + b.val⟩
@[extern c inline "#1 - #2"]
def UInt64.sub (a b : UInt64) : UInt64 := ⟨a.val - b.val⟩
@[extern c inline "#1 * #2"]
def UInt64.mul (a b : UInt64) : UInt64 := ⟨a.val * b.val⟩
@[extern c inline "#2 == 0 ? 0 : #1 / #2"]
def UInt64.div (a b : UInt64) : UInt64 := ⟨a.val / b.val⟩
@[extern c inline "#2 == 0 ? #1 : #1 % #2"]
def UInt64.mod (a b : UInt64) : UInt64 := ⟨a.val % b.val⟩
@[extern "lean_uint64_modn"]
def UInt64.modn (a : UInt64) (n : @& Nat) : UInt64 := ⟨a.val % n⟩
@[extern c inline "#1 & #2"]
def UInt64.land (a b : UInt64) : UInt64 := ⟨Fin.land a.val b.val⟩
@[extern c inline "#1 | #2"]
def UInt64.lor (a b : UInt64) : UInt64 := ⟨Fin.lor a.val b.val⟩
@[extern c inline "#1 ^ #2"]
def UInt64.xor (a b : UInt64) : UInt64 := ⟨Fin.xor a.val b.val⟩
@[extern c inline "#1 << #2 % 64"]
def UInt64.shiftLeft (a b : UInt64) : UInt64 := ⟨a.val <<< (modn b 64).val⟩
@[extern c inline "#1 >> #2 % 64"]
def UInt64.shiftRight (a b : UInt64) : UInt64 := ⟨a.val >>> (modn b 64).val⟩
def UInt64.lt (a b : UInt64) : Prop := a.val < b.val
def UInt64.le (a b : UInt64) : Prop := a.val ≤ b.val
@[extern c inline "((uint8_t)#1)"]
def UInt64.toUInt8 (a : UInt64) : UInt8 := a.toNat.toUInt8
@[extern c inline "((uint16_t)#1)"]
def UInt64.toUInt16 (a : UInt64) : UInt16 := a.toNat.toUInt16
@[extern c inline "((uint32_t)#1)"]
def UInt64.toUInt32 (a : UInt64) : UInt32 := a.toNat.toUInt32
@[extern c inline "((uint64_t)#1)"]
def UInt32.toUInt64 (a : UInt32) : UInt64 := a.toNat.toUInt64

instance : OfNat UInt64 n   := ⟨UInt64.ofNat n⟩
instance : Add UInt64       := ⟨UInt64.add⟩
instance : Sub UInt64       := ⟨UInt64.sub⟩
instance : Mul UInt64       := ⟨UInt64.mul⟩
instance : Mod UInt64       := ⟨UInt64.mod⟩
instance : HMod UInt64 Nat UInt64 := ⟨UInt64.modn⟩
instance : Div UInt64       := ⟨UInt64.div⟩
instance : LT UInt64        := ⟨UInt64.lt⟩
instance : LE UInt64        := ⟨UInt64.le⟩

@[extern c inline "~ #1"]
def UInt64.complement (a:UInt64) : UInt64 := 0-(a+1)

instance : Complement UInt64 := ⟨UInt64.complement⟩
instance : AndOp UInt64     := ⟨UInt64.land⟩
instance : OrOp UInt64      := ⟨UInt64.lor⟩
instance : Xor UInt64       := ⟨UInt64.xor⟩
instance : ShiftLeft UInt64  := ⟨UInt64.shiftLeft⟩
instance : ShiftRight UInt64 := ⟨UInt64.shiftRight⟩

@[extern c inline "(uint64_t)#1"]
def Bool.toUInt64 (b : Bool) : UInt64 := if b then 1 else 0

set_option bootstrap.genMatcherCode false in
@[extern c inline "#1 < #2"]
def UInt64.decLt (a b : UInt64) : Decidable (a < b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))

set_option bootstrap.genMatcherCode false in
@[extern c inline "#1 <= #2"]
def UInt64.decLe (a b : UInt64) : Decidable (a ≤ b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))

instance (a b : UInt64) : Decidable (a < b) := UInt64.decLt a b
instance (a b : UInt64) : Decidable (a ≤ b) := UInt64.decLe a b

theorem usizeSzGt0 : USize.size > 0 :=
  Nat.posPowOfPos System.Platform.numBits (Nat.zeroLtSucc _)

@[extern "lean_usize_of_nat"]
def USize.ofNat (n : @& Nat) : USize := ⟨Fin.ofNat' n usizeSzGt0⟩
abbrev Nat.toUSize := USize.ofNat
@[extern "lean_usize_to_nat"]
def USize.toNat (n : USize) : Nat := n.val.val
@[extern c inline "#1 + #2"]
def USize.add (a b : USize) : USize := ⟨a.val + b.val⟩
@[extern c inline "#1 - #2"]
def USize.sub (a b : USize) : USize := ⟨a.val - b.val⟩
@[extern c inline "#1 * #2"]
def USize.mul (a b : USize) : USize := ⟨a.val * b.val⟩
@[extern c inline "#2 == 0 ? 0 : #1 / #2"]
def USize.div (a b : USize) : USize := ⟨a.val / b.val⟩
@[extern c inline "#2 == 0 ? #1 : #1 % #2"]
def USize.mod (a b : USize) : USize := ⟨a.val % b.val⟩
@[extern "lean_usize_modn"]
def USize.modn (a : USize) (n : @& Nat) : USize := ⟨a.val % n⟩
@[extern c inline "#1 & #2"]
def USize.land (a b : USize) : USize := ⟨Fin.land a.val b.val⟩
@[extern c inline "#1 | #2"]
def USize.lor (a b : USize) : USize := ⟨Fin.lor a.val b.val⟩
@[extern c inline "#1 ^ #2"]
def USize.xor (a b : USize) : USize := ⟨Fin.xor a.val b.val⟩
@[extern c inline "#1 << #2 % (sizeof(size_t) * 8)"]
def USize.shiftLeft (a b : USize) : USize := ⟨a.val <<< (modn b System.Platform.numBits).val⟩
@[extern c inline "#1 >> #2 % (sizeof(size_t) * 8)"]
def USize.shiftRight (a b : USize) : USize := ⟨a.val >>> (modn b System.Platform.numBits).val⟩
@[extern c inline "#1"]
def UInt32.toUSize (a : UInt32) : USize := a.toNat.toUSize
@[extern c inline "((size_t)#1)"]
def UInt64.toUSize (a : UInt64) : USize := a.toNat.toUSize
@[extern c inline "(uint32_t)#1"]
def USize.toUInt32 (a : USize) : UInt32 := a.toNat.toUInt32

def USize.lt (a b : USize) : Prop := a.val < b.val
def USize.le (a b : USize) : Prop := a.val ≤ b.val

instance : OfNat USize n   := ⟨USize.ofNat n⟩
instance : Add USize       := ⟨USize.add⟩
instance : Sub USize       := ⟨USize.sub⟩
instance : Mul USize       := ⟨USize.mul⟩
instance : Mod USize       := ⟨USize.mod⟩
instance : HMod USize Nat USize := ⟨USize.modn⟩
instance : Div USize       := ⟨USize.div⟩
instance : LT USize        := ⟨USize.lt⟩
instance : LE USize        := ⟨USize.le⟩

@[extern c inline "~ #1"]
def USize.complement (a:USize) : USize := 0-(a+1)

instance : Complement USize := ⟨USize.complement⟩
instance : AndOp USize      := ⟨USize.land⟩
instance : OrOp USize       := ⟨USize.lor⟩
instance : Xor USize        := ⟨USize.xor⟩
instance : ShiftLeft USize  := ⟨USize.shiftLeft⟩
instance : ShiftRight USize := ⟨USize.shiftRight⟩

set_option bootstrap.genMatcherCode false in
@[extern c inline "#1 < #2"]
def USize.decLt (a b : USize) : Decidable (a < b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))

set_option bootstrap.genMatcherCode false in
@[extern c inline "#1 <= #2"]
def USize.decLe (a b : USize) : Decidable (a ≤ b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))

instance (a b : USize) : Decidable (a < b) := USize.decLt a b
instance (a b : USize) : Decidable (a ≤ b) := USize.decLe a b

theorem USize.modn_lt {m : Nat} : ∀ (u : USize), m > 0 → USize.toNat (u % m) < m
  | ⟨u⟩, h => Fin.modn_lt u h


import number_theory.padics.padic_norm
import data.real.cau_seq
import analysis.special_functions.exp_log
import analysis.special_functions.pow
import data.nat.prime
import data.nat.basic
import tactic.apply
import tactic.linarith
import topology.metric_space.basic

open is_absolute_value

variables (α: ℝ)

def abvs_equiv {β} [ring β] (abv: β → ℝ) (abv': β → ℝ) [is_absolute_value abv] [is_absolute_value abv'] :=
  ∃ α: ℝ, 0 < α ∧ (λ x: β, (abv x) ^ α) = abv'

theorem abvs_equiv_reflexive {β} [ring β]:
  ∀ (abv: β → ℝ) [is_abv: is_absolute_value abv], @abvs_equiv _ _ abv abv is_abv is_abv :=
begin
  intros abv is_abv,
  use [1, by linarith],
  simp,
end

theorem abvs_equiv_symmetric {β} [ring β]:
  ∀ (abv abv': β → ℝ) [abv_abv: is_absolute_value abv] [abv'_abv: is_absolute_value abv'],
    @abvs_equiv _ _ abv abv' abv_abv abv'_abv → @abvs_equiv _ _ abv' abv abv'_abv abv_abv :=
begin
  intros abv abv' abv_abv abv'_abv p,
  rcases p with ⟨ α, zero_lt_α, hα ⟩,
  use [α⁻¹, by simp [zero_lt_α]],
  ext x,
  have abvx_nonneg: 0 ≤ abv x,
  from @abv_nonneg _ _ _ _ abv abv_abv x,
  symmetry,
  calc abv x = abv x ^ (1: ℝ)          : by rw real.rpow_one
    ... = abv x ^ (α * α⁻¹)            : by { simp [(ne.symm ∘ ne_of_lt) zero_lt_α], }
    ... = (abv x ^ α) ^ (α⁻¹)          : by { rw real.rpow_mul abvx_nonneg, }
    ... = ((λ x, abv x ^ α) x) ^ (α⁻¹) : by simp
    ... = (abv' x) ^ (α⁻¹)             : by rw hα,
end

theorem abvs_equiv_transitive {β} [ring β]:
  ∀ (abv abv' abv'': β → ℝ) [abv_abv: is_absolute_value abv] [abv'_abv: is_absolute_value abv']
      [abv''_abv: is_absolute_value abv''],
    @abvs_equiv _ _ abv abv' abv_abv abv'_abv → @abvs_equiv _ _ abv' abv'' abv'_abv abv''_abv →
      @abvs_equiv _ _ abv abv'' abv_abv abv''_abv :=
begin
  intros abv abv' abv'' abv_abv abv'_abv abv''_abv abv_equiv_abv' abv'_equiv_abv'',
  rcases abv_equiv_abv' with ⟨ α, zero_lt_α, hα ⟩,
  rcases abv'_equiv_abv'' with ⟨ γ, zero_lt_γ, hγ ⟩,
  use [α * γ, by simp [zero_lt_α, zero_lt_γ]],
  ext x,
  have abvx_nonneg: 0 ≤ abv x,
  from @abv_nonneg _ _ _ _ abv abv_abv x,
  rw real.rpow_mul abvx_nonneg,
  rw [← hγ, ← hα],
end


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import linear_algebra.affine_space.affine_map
import algebra.invertible

/-!
# Affine equivalences

In this file we define `affine_equiv k P₁ P₂` (notation: `P₁ ≃ᵃ[k] P₂`) to be the type of affine
equivalences between `P₁` and `P₂, i.e., equivalences such that both forward and inverse maps are
affine maps.

We define the following equivalences:

* `affine_equiv.refl k P`: the identity map as an `affine_equiv`;

* `e.symm`: the inverse map of an `affine_equiv` as an `affine_equiv`;

* `e.trans e'`: composition of two `affine_equiv`s; note that the order follows `mathlib`'s
  `category_theory` convention (apply `e`, then `e'`), not the convention used in function
  composition and compositions of bundled morphisms.

We equip `affine_equiv k P P` with a `group` structure with multiplication corresponding to
composition in `affine_equiv.group`.

## Tags

affine space, affine equivalence
-/

open function set
open_locale affine

/-- An affine equivalence is an equivalence between affine spaces such that both forward
and inverse maps are affine.

We define it using an `equiv` for the map and a `linear_equiv` for the linear part in order
to allow affine equivalences with good definitional equalities. -/
@[nolint has_inhabited_instance]
structure affine_equiv (k P₁ P₂ : Type*) {V₁ V₂ : Type*} [ring k]
  [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
  [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂] extends P₁ ≃ P₂ :=
(linear : V₁ ≃ₗ[k] V₂)
(map_vadd' : ∀ (p : P₁) (v : V₁), to_equiv (v +ᵥ p) = linear v +ᵥ to_equiv p)

notation P₁ ` ≃ᵃ[`:25 k:25 `] `:0 P₂:0 := affine_equiv k P₁ P₂

variables {k P₁ P₂ P₃ P₄ V₁ V₂ V₃ V₄ : Type*} [ring k]
  [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
  [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂]
  [add_comm_group V₃] [module k V₃] [add_torsor V₃ P₃]
  [add_comm_group V₄] [module k V₄] [add_torsor V₄ P₄]

namespace affine_equiv

include V₁ V₂

instance : has_coe_to_fun (P₁ ≃ᵃ[k] P₂) (λ _, P₁ → P₂) := ⟨λ e, e.to_fun⟩

instance : has_coe (P₁ ≃ᵃ[k] P₂) (P₁ ≃ P₂) := ⟨affine_equiv.to_equiv⟩

variables (k P₁)

omit V₂

/-- Identity map as an `affine_equiv`. -/
@[refl] def refl : P₁ ≃ᵃ[k] P₁ :=
{ to_equiv := equiv.refl P₁,
  linear := linear_equiv.refl k V₁,
  map_vadd' := λ _ _, rfl }

@[simp] lemma coe_refl : ⇑(refl k P₁) = id := rfl

lemma refl_apply (x : P₁) : refl k P₁ x = x := rfl

@[simp] lemma to_equiv_refl : (refl k P₁).to_equiv = equiv.refl P₁ := rfl

@[simp] lemma linear_refl : (refl k P₁).linear = linear_equiv.refl k V₁ := rfl

variables {k P₁}

include V₂

@[simp] lemma map_vadd (e : P₁ ≃ᵃ[k] P₂) (p : P₁) (v : V₁) : e (v +ᵥ p) = e.linear v +ᵥ e p :=
e.map_vadd' p v

@[simp] lemma coe_to_equiv (e : P₁ ≃ᵃ[k] P₂) : ⇑e.to_equiv = e := rfl

/-- Reinterpret an `affine_equiv` as an `affine_map`. -/
def to_affine_map (e : P₁ ≃ᵃ[k] P₂) : P₁ →ᵃ[k] P₂ := { to_fun := e, .. e }

instance : has_coe (P₁ ≃ᵃ[k] P₂) (P₁ →ᵃ[k] P₂) := ⟨to_affine_map⟩

@[simp] lemma coe_to_affine_map (e : P₁ ≃ᵃ[k] P₂) :
  (e.to_affine_map : P₁ → P₂) = (e : P₁ → P₂) :=
rfl

@[simp] lemma to_affine_map_mk (f : P₁ ≃ P₂) (f' : V₁ ≃ₗ[k] V₂) (h) :
  to_affine_map (mk f f' h) = ⟨f, f', h⟩ :=
rfl

@[norm_cast, simp] lemma coe_coe (e : P₁ ≃ᵃ[k] P₂) : ((e : P₁ →ᵃ[k] P₂) : P₁ → P₂) = e := rfl

@[simp] lemma linear_to_affine_map (e : P₁ ≃ᵃ[k] P₂) : e.to_affine_map.linear = e.linear := rfl

lemma to_affine_map_injective : injective (to_affine_map : (P₁ ≃ᵃ[k] P₂) → (P₁ →ᵃ[k] P₂)) :=
begin
  rintros ⟨e, el, h⟩ ⟨e', el', h'⟩ H,
  simp only [to_affine_map_mk, equiv.coe_inj, linear_equiv.to_linear_map_inj] at H,
  congr,
  exacts [H.1, H.2]
end

@[simp] lemma to_affine_map_inj {e e' : P₁ ≃ᵃ[k] P₂} :
  e.to_affine_map = e'.to_affine_map ↔ e = e' :=
to_affine_map_injective.eq_iff

@[ext] lemma ext {e e' : P₁ ≃ᵃ[k] P₂} (h : ∀ x, e x = e' x) : e = e' :=
to_affine_map_injective $ affine_map.ext h

lemma coe_fn_injective : @injective (P₁ ≃ᵃ[k] P₂) (P₁ → P₂) coe_fn :=
λ e e' H, ext $ congr_fun H

@[simp, norm_cast] lemma coe_fn_inj {e e' : P₁ ≃ᵃ[k] P₂} : (e : P₁ → P₂) = e' ↔ e = e' :=
coe_fn_injective.eq_iff

lemma to_equiv_injective : injective (to_equiv : (P₁ ≃ᵃ[k] P₂) → (P₁ ≃ P₂)) :=
λ e e' H, ext $ equiv.ext_iff.1 H

@[simp] lemma to_equiv_inj {e e' : P₁ ≃ᵃ[k] P₂} : e.to_equiv = e'.to_equiv ↔ e = e' :=
to_equiv_injective.eq_iff

@[simp] lemma coe_mk (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (h) :
  ((⟨e, e', h⟩ : P₁ ≃ᵃ[k] P₂) : P₁ → P₂) = e :=
rfl

/-- Construct an affine equivalence by verifying the relation between the map and its linear part at
one base point. Namely, this function takes a map `e : P₁ → P₂`, a linear equivalence
`e' : V₁ ≃ₗ[k] V₂`, and a point `p` such that for any other point `p'` we have
`e p' = e' (p' -ᵥ p) +ᵥ e p`. -/
def mk' (e : P₁ → P₂) (e' : V₁ ≃ₗ[k] V₂) (p : P₁) (h : ∀ p' : P₁, e p' = e' (p' -ᵥ p) +ᵥ e p) :
  P₁ ≃ᵃ[k] P₂ :=
{ to_fun := e,
  inv_fun := λ q' : P₂, e'.symm (q' -ᵥ e p) +ᵥ p,
  left_inv := λ p', by simp [h p'],
  right_inv := λ q', by simp [h (e'.symm (q' -ᵥ e p) +ᵥ p)],
  linear := e',
  map_vadd' := λ p' v, by { simp [h p', h (v +ᵥ p'), vadd_vsub_assoc, vadd_vadd] } }

@[simp] lemma coe_mk' (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (p h) : ⇑(mk' e e' p h) = e := rfl
@[simp] lemma linear_mk' (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (p h) :
  (mk' e e' p h).linear = e' := rfl

/-- Inverse of an affine equivalence as an affine equivalence. -/
@[symm] def symm (e : P₁ ≃ᵃ[k] P₂) : P₂ ≃ᵃ[k] P₁ :=
{ to_equiv := e.to_equiv.symm,
  linear := e.linear.symm,
  map_vadd' := λ v p, e.to_equiv.symm.apply_eq_iff_eq_symm_apply.2 $
    by simpa using (e.to_equiv.apply_symm_apply v).symm }

@[simp] lemma symm_to_equiv (e : P₁ ≃ᵃ[k] P₂) : e.to_equiv.symm = e.symm.to_equiv := rfl

@[simp] lemma symm_linear (e : P₁ ≃ᵃ[k] P₂) : e.linear.symm = e.symm.linear := rfl

/-- See Note [custom simps projection] -/
def simps.apply (e : P₁ ≃ᵃ[k] P₂) : P₁ → P₂ := e

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : P₁ ≃ᵃ[k] P₂) : P₂ → P₁ := e.symm

initialize_simps_projections affine_equiv
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, linear → linear as_prefix, -to_equiv)

protected lemma bijective (e : P₁ ≃ᵃ[k] P₂) : bijective e := e.to_equiv.bijective
protected lemma surjective (e : P₁ ≃ᵃ[k] P₂) : surjective e := e.to_equiv.surjective
protected lemma injective (e : P₁ ≃ᵃ[k] P₂) : injective e := e.to_equiv.injective

@[simp] lemma range_eq (e : P₁ ≃ᵃ[k] P₂) : range e = univ := e.surjective.range_eq

@[simp] lemma apply_symm_apply (e : P₁ ≃ᵃ[k] P₂) (p : P₂) : e (e.symm p) = p :=
e.to_equiv.apply_symm_apply p

@[simp] lemma symm_apply_apply (e : P₁ ≃ᵃ[k] P₂) (p : P₁) : e.symm (e p) = p :=
e.to_equiv.symm_apply_apply p

lemma apply_eq_iff_eq_symm_apply (e : P₁ ≃ᵃ[k] P₂) {p₁ p₂} : e p₁ = p₂ ↔ p₁ = e.symm p₂ :=
e.to_equiv.apply_eq_iff_eq_symm_apply

@[simp] lemma apply_eq_iff_eq (e : P₁ ≃ᵃ[k] P₂) {p₁ p₂ : P₁} : e p₁ = e p₂ ↔ p₁ = p₂ :=
e.to_equiv.apply_eq_iff_eq

omit V₂

@[simp] lemma symm_refl : (refl k P₁).symm = refl k P₁ := rfl

include V₂ V₃

/-- Composition of two `affine_equiv`alences, applied left to right. -/
@[trans] def trans (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) : P₁ ≃ᵃ[k] P₃ :=
{ to_equiv := e.to_equiv.trans e'.to_equiv,
  linear := e.linear.trans e'.linear,
  map_vadd' := λ p v, by simp only [linear_equiv.trans_apply, coe_to_equiv, (∘),
    equiv.coe_trans, map_vadd] }

@[simp] lemma coe_trans (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) : ⇑(e.trans e') = e' ∘ e := rfl

lemma trans_apply (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) (p : P₁) : e.trans e' p = e' (e p) := rfl

include V₄

lemma trans_assoc (e₁ : P₁ ≃ᵃ[k] P₂) (e₂ : P₂ ≃ᵃ[k] P₃) (e₃ : P₃ ≃ᵃ[k] P₄) :
  (e₁.trans e₂).trans e₃ = e₁.trans (e₂.trans e₃) :=
ext $ λ _, rfl

omit V₃ V₄

@[simp] lemma trans_refl (e : P₁ ≃ᵃ[k] P₂) : e.trans (refl k P₂) = e :=
ext $ λ _, rfl

@[simp] lemma refl_trans (e : P₁ ≃ᵃ[k] P₂) : (refl k P₁).trans e = e :=
ext $ λ _, rfl

@[simp] lemma self_trans_symm (e : P₁ ≃ᵃ[k] P₂) : e.trans e.symm = refl k P₁ :=
ext e.symm_apply_apply

@[simp] lemma symm_trans_self (e : P₁ ≃ᵃ[k] P₂) : e.symm.trans e = refl k P₂ :=
ext e.apply_symm_apply

@[simp] lemma apply_line_map (e : P₁ ≃ᵃ[k] P₂) (a b : P₁) (c : k) :
  e (affine_map.line_map a b c) = affine_map.line_map (e a) (e b) c :=
e.to_affine_map.apply_line_map a b c

omit V₂

instance : group (P₁ ≃ᵃ[k] P₁) :=
{ one := refl k P₁,
  mul := λ e e', e'.trans e,
  inv := symm,
  mul_assoc := λ e₁ e₂ e₃, trans_assoc _ _ _,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_left_inv := self_trans_symm }

lemma one_def : (1 : P₁ ≃ᵃ[k] P₁) = refl k P₁ := rfl

@[simp] lemma coe_one : ⇑(1 : P₁ ≃ᵃ[k] P₁) = id := rfl

lemma mul_def (e e' : P₁ ≃ᵃ[k] P₁) : e * e' = e'.trans e := rfl

@[simp] lemma coe_mul (e e' : P₁ ≃ᵃ[k] P₁) : ⇑(e * e') = e ∘ e' := rfl

lemma inv_def (e : P₁ ≃ᵃ[k] P₁) : e⁻¹ = e.symm := rfl

/-- `affine_equiv.linear` on automorphisms is a `monoid_hom`. -/
@[simps] def linear_hom : (P₁ ≃ᵃ[k] P₁) →* (V₁ ≃ₗ[k] V₁) :=
{ to_fun := linear,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

/-- The group of `affine_equiv`s are equivalent to the group of units of `affine_map`.

This is the affine version of `linear_map.general_linear_group.general_linear_equiv`. -/
@[simps]
def equiv_units_affine_map : (P₁ ≃ᵃ[k] P₁) ≃* (P₁ →ᵃ[k] P₁)ˣ :=
{ to_fun := λ e, ⟨e, e.symm, congr_arg coe e.symm_trans_self, congr_arg coe e.self_trans_symm⟩,
  inv_fun := λ u,
  { to_fun := (u : P₁ →ᵃ[k] P₁), inv_fun := (↑(u⁻¹) : P₁ →ᵃ[k] P₁),
    left_inv := affine_map.congr_fun u.inv_mul,
    right_inv := affine_map.congr_fun u.mul_inv,
    linear := linear_map.general_linear_group.general_linear_equiv _ _ $
      units.map (by exact affine_map.linear_hom) u,
    map_vadd' := λ _ _, (u : P₁ →ᵃ[k] P₁).map_vadd _ _ },
  left_inv := λ e, affine_equiv.ext $ λ x, rfl,
  right_inv := λ u, units.ext $ affine_map.ext $ λ x, rfl,
  map_mul' := λ e₁ e₂, rfl }

variable (k)

/-- The map `v ↦ v +ᵥ b` as an affine equivalence between a module `V` and an affine space `P` with
tangent space `V`. -/
@[simps]
def vadd_const (b : P₁) : V₁ ≃ᵃ[k] P₁ :=
{ to_equiv := equiv.vadd_const b,
  linear := linear_equiv.refl _ _,
  map_vadd' := λ p v, add_vadd _ _ _ }

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub (p : P₁) : P₁ ≃ᵃ[k] V₁ :=
{ to_equiv := equiv.const_vsub p,
  linear := linear_equiv.neg k,
  map_vadd' := λ p' v, by simp [vsub_vadd_eq_vsub_sub, neg_add_eq_sub] }

@[simp] lemma coe_const_vsub (p : P₁) : ⇑(const_vsub k p) = (-ᵥ) p := rfl

@[simp] lemma coe_const_vsub_symm (p : P₁) : ⇑(const_vsub k p).symm = λ v, -v +ᵥ p := rfl

variable (P₁)

/-- The map `p ↦ v +ᵥ p` as an affine automorphism of an affine space. -/
@[simps]
def const_vadd (v : V₁) : P₁ ≃ᵃ[k] P₁ :=
{ to_equiv := equiv.const_vadd P₁ v,
  linear := linear_equiv.refl _ _,
  map_vadd' := λ p w, vadd_comm _ _ _ }

section homothety

omit V₁

variables {R V P : Type*} [comm_ring R] [add_comm_group V] [module R V] [affine_space V P]
include V

/-- Fixing a point in affine space, homothety about this point gives a group homomorphism from (the
centre of) the units of the scalars into the group of affine equivalences. -/
def homothety_units_mul_hom (p : P) : Rˣ →* P ≃ᵃ[R] P :=
equiv_units_affine_map.symm.to_monoid_hom.comp $ units.map (affine_map.homothety_hom p)

@[simp] lemma coe_homothety_units_mul_hom_apply (p : P) (t : Rˣ) :
  (homothety_units_mul_hom p t : P → P) = affine_map.homothety p (t : R) :=
rfl

@[simp] lemma coe_homothety_units_mul_hom_apply_symm (p : P) (t : Rˣ) :
  ((homothety_units_mul_hom p t).symm : P → P) = affine_map.homothety p (↑t⁻¹ : R) :=
rfl

@[simp] lemma coe_homothety_units_mul_hom_eq_homothety_hom_coe (p : P) :
  (coe : (P ≃ᵃ[R] P) → P →ᵃ[R] P) ∘ homothety_units_mul_hom p =
  (affine_map.homothety_hom p) ∘ (coe : Rˣ → R) :=
funext $ λ _, rfl

end homothety

variable {P₁}
open function

/-- Point reflection in `x` as a permutation. -/
def point_reflection (x : P₁) : P₁ ≃ᵃ[k] P₁ := (const_vsub k x).trans (vadd_const k x)

lemma point_reflection_apply (x y : P₁) : point_reflection k x y = x -ᵥ y +ᵥ x := rfl

@[simp] lemma point_reflection_symm (x : P₁) : (point_reflection k x).symm = point_reflection k x :=
to_equiv_injective $ equiv.point_reflection_symm x

@[simp] lemma to_equiv_point_reflection (x : P₁) :
  (point_reflection k x).to_equiv = equiv.point_reflection x :=
rfl

@[simp] lemma point_reflection_self (x : P₁) : point_reflection k x x = x := vsub_vadd _ _

lemma point_reflection_involutive (x : P₁) : involutive (point_reflection k x : P₁ → P₁) :=
equiv.point_reflection_involutive x

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
lemma point_reflection_fixed_iff_of_injective_bit0 {x y : P₁} (h : injective (bit0 : V₁ → V₁)) :
  point_reflection k x y = y ↔ y = x :=
equiv.point_reflection_fixed_iff_of_injective_bit0 h

lemma injective_point_reflection_left_of_injective_bit0 (h : injective (bit0 : V₁ → V₁)) (y : P₁) :
  injective (λ x : P₁, point_reflection k x y) :=
equiv.injective_point_reflection_left_of_injective_bit0 h y

lemma injective_point_reflection_left_of_module [invertible (2:k)]:
  ∀ y, injective (λ x : P₁, point_reflection k x y) :=
injective_point_reflection_left_of_injective_bit0 k $ λ x y h,
  by rwa [bit0, bit0, ← two_smul k x, ← two_smul k y,
    (is_unit_of_invertible (2:k)).smul_left_cancel] at h

lemma point_reflection_fixed_iff_of_module [invertible (2:k)] {x y : P₁} :
  point_reflection k x y = y ↔ y = x :=
((injective_point_reflection_left_of_module k y).eq_iff' (point_reflection_self k y)).trans eq_comm

end affine_equiv

namespace linear_equiv

/-- Interpret a linear equivalence between modules as an affine equivalence. -/
def to_affine_equiv (e : V₁ ≃ₗ[k] V₂) : V₁ ≃ᵃ[k] V₂ :=
{ to_equiv := e.to_equiv,
  linear := e,
  map_vadd' := λ p v, e.map_add v p }

@[simp] lemma coe_to_affine_equiv (e : V₁ ≃ₗ[k] V₂) : ⇑e.to_affine_equiv = e := rfl

end linear_equiv

namespace affine_map

open affine_equiv

include V₁

lemma line_map_vadd (v v' : V₁) (p : P₁) (c : k) :
  line_map v v' c +ᵥ p = line_map (v +ᵥ p) (v' +ᵥ p) c :=
(vadd_const k p).apply_line_map v v' c

lemma line_map_vsub (p₁ p₂ p₃ : P₁) (c : k) :
  line_map p₁ p₂ c -ᵥ p₃ = line_map (p₁ -ᵥ p₃) (p₂ -ᵥ p₃) c :=
(vadd_const k p₃).symm.apply_line_map p₁ p₂ c

lemma vsub_line_map (p₁ p₂ p₃ : P₁) (c : k) :
  p₁ -ᵥ line_map p₂ p₃ c = line_map (p₁ -ᵥ p₂) (p₁ -ᵥ p₃) c :=
(const_vsub k p₁).apply_line_map p₂ p₃ c

lemma vadd_line_map (v : V₁) (p₁ p₂ : P₁) (c : k) :
  v +ᵥ line_map p₁ p₂ c = line_map (v +ᵥ p₁) (v +ᵥ p₂) c :=
(const_vadd k P₁ v).apply_line_map p₁ p₂ c

variables {R' : Type*} [comm_ring R'] [module R' V₁]

lemma homothety_neg_one_apply (c p : P₁) :
  homothety c (-1:R') p = point_reflection R' c p :=
by simp [homothety_apply, point_reflection_apply]

end affine_map


example (s : ℝ) (s_pos : 0 < s) (s_max : s ≤ 1): (s + 1) ^ (s + 1) / s ^ s ≤ 4 :=
begin
  rw div_le_iff,
  have pow_to_exp1 : 4*s^s = exp(log 4 + s*log s),
    { rw [exp_add, exp_log (show 0 < (4 : ℝ), by norm_num), ← log_rpow s_pos, exp_log],
      apply rpow_pos_of_pos,
      linarith},
  have pow_to_exp2 : (s+1)^(s+1) = exp((s+1) * log(s+1)),
    { rw [← log_rpow (show 0 < s + 1, by linarith), exp_log],
      apply rpow_pos_of_pos,
      linarith},
  { rw [pow_to_exp1, pow_to_exp2],
    rw exp_le_exp,
    have H1 : ∀ {x : ℝ}, 0 < x → 0 < deriv (λ (x : ℝ), (x + 1) * log (x + 1) - x * log x) x,
    { intros x x_pos,
      rw diff_helper,
      rw ← log_div,
      apply log_pos,
      rw one_lt_div,
      linarith,
      all_goals{linarith [x_pos]
      }, -- need to add 0 < x
    },
    have H := convex.strict_mono_of_deriv_pos (convex_Icc 0 1) x_log_x_cont _ _,
    { sorry},
    { apply differentiable_on.sub,
      { apply differentiable_on.mul,
        { apply differentiable_on.add_const differentiable_on_id,},
        { apply differentiable_on.log,
          { apply differentiable_on.add_const differentiable_on_id,},
          { intros x hx,
            rw mem_interior at *,
            -- screams
            sorry},
        },
      },
      { sorry},
    },
    { -- ∀ (x : ℝ), x ∈ interior (Icc 0 1) → 0 < deriv (λ (x : ℝ), (x + 1) * log (x + 1) - x * log x) x
      sorry},

    all_goals{sorry} -- (s + 1) * log (s + 1) ≤ log 4 + s * log s
  },
  { apply rpow_pos_of_pos,
    linarith}
end


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.term
import Mathlib.PostPort

namespace Mathlib

/-
Definition of linear constrain clauses.
-/

namespace omega

/-- (([t₁,...tₘ],[s₁,...,sₙ]) : clause) encodes the constraints
0 = ⟦t₁⟧ ∧ ... ∧ 0 = ⟦tₘ⟧ ∧ 0 ≤ ⟦s₁⟧ ∧ ... ∧ 0 ≤ ⟦sₙ⟧, where
⟦t⟧ is the value of (t : term). -/
def clause :=
  List term × List term

namespace clause

/-- holds v c := clause c holds under valuation v -/
def holds (v : ℕ → ℤ) : clause → Prop :=
  sorry

/-- sat c := there exists a valuation v under which c holds -/
def sat (c : clause) :=
  ∃ (v : ℕ → ℤ), holds v c

/-- unsat c := there is no valuation v under which c holds -/
def unsat (c : clause) :=
  ¬sat c

/-- append two clauses by elementwise appending -/
def append (c1 : clause) (c2 : clause) : clause :=
  (prod.fst c1 ++ prod.fst c2, prod.snd c1 ++ prod.snd c2)

theorem holds_append {v : ℕ → ℤ} {c1 : clause} {c2 : clause} : holds v c1 → holds v c2 → holds v (append c1 c2) := sorry

end clause

/-- There exists a satisfiable clause c in argument -/
def clauses.sat (cs : List clause) :=
  ∃ (c : clause), ∃ (H : c ∈ cs), clause.sat c

/-- There is no satisfiable clause c in argument -/
def clauses.unsat (cs : List clause) :=
  ¬clauses.sat cs

theorem clauses.unsat_nil : clauses.unsat [] := sorry

theorem clauses.unsat_cons (c : clause) (cs : List clause) : clause.unsat c → clauses.unsat cs → clauses.unsat (c :: cs) := sorry


import Smt

theorem disjunctive_syllogism (p q : Bool) : p || q → !p → q := by
  smt
  intro hpq hnp
  cases p <;> simp_all


variable (u w x x' y y' z : Nat) (p : Nat → Prop)

example (h₁ : x + 0 = x') (h₂ : y + 0 = y')
        : x + y + 0 = x' + y' := by
  simp at *
  simp [*]


import NBG.SetTheory.Axioms.Extensionality

-- Classoid
private theorem ClassEqIsEquivalence : @Equivalence Class Class.Eq :=
  { refl := ClassEq.refl, symm := ClassEq.symm, trans := ClassEq.trans }

instance Classoid : Setoid Class where
  r     := Class.Eq
  iseqv := ClassEqIsEquivalence

def Class' : Type u := Quotient Classoid

theorem Classoid.sound {X Y : Class}:
  X ＝ Y → (Quot.mk Class.Eq X) = (Quot.mk Class.Eq Y) :=
fun h => Quot.sound h

theorem Classoid.refl : ∀(X : Class'), X=X := by {
  intro _;
  apply Quot.inductionOn (motive := fun X => X=X);
  intro X;
  apply Classoid.sound;
  exact ClassEq.refl X;
}


lemma one_mul (m : mynat) : 1 * m = m :=
begin
induction m with h hd,
rw mul_zero,
refl,
rw mul_succ,
rw hd,
rw succ_eq_add_one,
refl,
end


import data.qpf.univariate.basic
import control.bifunctor

universes u
variables {F : Type u → Type u} [functor F]

namespace qpf

section box
variables (F)

/-- apply a functor to a set of values. taken from
 [Basil Fürer, Andreas Lochbihler, Joshua Schneider, Dmitriy Traytel *Quotients of Bounded Natural Functors*][fuerer-lochbihler-schneider-traytel2020]
henceforth referred to as the QBNF paper
 -/
def box {α} (A : set α) : set (F α) :=
{ x | ∀ β (f g : α → β), (∀ a ∈ A, f a = g a) → f <$> x = g <$> x }

variables {F}

/--
Alternate notion of support set based on `box`.
Taken from the QBNF paper
-/
def supp' {α} (x : F α) : set α :=
⋂ A ∈ { A : set α | x ∈ box F A}, A

/--
Alternate notion of predicate lifting based on `box`.
Taken from the QBNF paper
-/
def liftp' {α} (x : F α) (p : α → Prop) : Prop :=
∀ a ∈ supp' x, p a

end box

end qpf

namespace ex

/-- polynomial functor isomorph to `α × _` for some `α` -/
def prod.pfunctor (α : Type) : pfunctor :=
⟨ α, λ _, unit ⟩

instance {α} : qpf (prod α) :=
{ P := prod.pfunctor α,
  abs := λ β ⟨a,f⟩, (a, f ()),
  repr := λ β ⟨x,y⟩, ⟨x, λ _, y⟩,
  abs_repr := λ β ⟨x,y⟩, rfl,
  abs_map := λ β γ f ⟨a,g⟩, rfl }

/-- example relation for products -/
def foo.R (α : Type) (x y : bool × α) : Prop :=
x.1 = y.1 ∧ (x.1 → x.2 = y.2)

lemma equivalence_foo.R (α) : equivalence (foo.R α) :=
begin
  refine ⟨_,_,_⟩,
  { intro, exact ⟨rfl,λ _, rfl⟩ },
  { intros x y h, refine ⟨h.1.symm, λ _, (h.2 _).symm⟩,
    rwa h.1 },
  { rintros x y z ⟨ha,ha'⟩ ⟨hb,hb'⟩,
    refine ⟨ha.trans hb, λ hh, _⟩,
    refine (ha' hh).trans (hb' _),
    rwa ← ha }
end

/-- example of a qpf -/
def foo (α : Type) :=
quot $ foo.R α

instance {α} [inhabited α] : inhabited (foo α) := ⟨ quot.mk _ default ⟩

/-- functor operation of `foo` -/
def foo.map {α β} (f : α → β) (x : foo α) : foo β :=
quot.lift_on x (λ x : bool × α, quot.mk (foo.R β) $ f <$> x)
  (λ ⟨a₀,a₁⟩ ⟨b₀,b₁⟩ h, quot.sound ⟨h.1,λ h', show f a₁ = f b₁, from congr_arg f (h.2 h')⟩)

instance : functor foo :=
{ map := @foo.map }

@[simp]
lemma foo.map_mk {α β : Type} (f : α → β) (x : bool × α) :
  (f <$> quot.mk _ x : foo β) = quot.mk _ (f <$> x) :=
by simp [(<$>),foo.map]

noncomputable instance qpf.foo : qpf foo :=
@qpf.quotient_qpf (prod bool) _ ex.prod.qpf foo _ (λ α, quot.mk _) (λ α, quot.out)
  (by simp)
  (by intros; simp)

/-- constructor for `foo` -/
def foo.mk {α} (b : bool) (x : α) : foo α := quot.mk _ (b, x)

@[simp]
lemma foo.map_mk' {α β : Type} (f : α → β) (b : bool) (x : α) :
  f <$> foo.mk b x = foo.mk b (f x) :=
by simp only [foo.mk, foo.map_mk]; refl

@[simp]
lemma foo.map_tt {α : Type} (x y : α) :
  foo.mk tt x = foo.mk tt y ↔ x = y :=
by simp [foo.mk]; split; intro h; [replace h := quot.exact _ h, rw h];
   rw (equivalence_foo.R _).eqv_gen_iff at h;
   exact h.2 rfl

/-- consequence of original definition of `supp`. If there exists more than
one value of type `α`, then the support of `foo.mk ff x` is empty -/
lemma supp_mk_ff₀ {α} (x y : α) (h : ¬ x = y) : functor.supp (foo.mk ff x) = {} :=
begin
  dsimp [functor.supp], ext z, simp, -- split; intro h,
  classical, by_cases x = z,
  { use (λ a, ¬ z = a), subst z,
    dsimp [functor.liftp],
    simp, refine ⟨foo.mk ff ⟨y,h⟩,_⟩,
    simp, apply quot.sound, simp [foo.R] },
  { use (λ a, x = a),
    dsimp [functor.liftp],
    simp [h], use foo.mk ff ⟨x,rfl⟩,
    simp }
end

/-- consequence of original definition of `supp`. If there exists only
one value of type `α`, then the support of `foo.mk ff x` contains that value -/
lemma supp_mk_ff₁ {α} (x : α) (h : ∀ z, x = z) : functor.supp (foo.mk ff x) = {x} :=
begin
  dsimp [functor.supp], ext y, simp, split; intro h',
  { apply @h' (= x), dsimp [functor.liftp],
    use foo.mk ff ⟨x,rfl⟩, refl },
  { introv hp, simp [functor.liftp] at hp,
    rcases hp with ⟨⟨z,z',hz⟩,hp⟩,
    simp at hp, convert hz,
    rw [h'], apply h },
end

/--
Such a QPF is not uniform
-/
lemma foo_not_uniform : ¬ @qpf.is_uniform foo _ qpf.foo :=
begin
  simp only [qpf.is_uniform, foo, qpf.foo, set.image_univ, not_forall, not_imp],
  existsi [bool,ff,ff,λ a : unit, tt,λ a : unit, ff], split,
  { apply quot.sound, simp [foo.R, qpf.abs, prod.qpf._match_1] },
  { simp! only [set.range, set.ext_iff],
    simp only [not_exists, false_iff, bool.forall_bool, eq_self_iff_true, exists_false, not_true,
      and_self, set.mem_set_of_eq, iff_false],
    exact λ h, h () }
end

/-- intuitive consequence of original definition of `supp`. -/
lemma supp_mk_tt {α} (x : α) : functor.supp (foo.mk tt x) = {x} :=
begin
  dsimp [functor.supp], ext y, simp, split; intro h',
  { apply @h' (= x), dsimp [functor.liftp],
    use foo.mk tt ⟨x,rfl⟩, refl },
  { introv hp, simp [functor.liftp] at hp,
    rcases hp with ⟨⟨z,z',hz⟩,hp⟩,
    simp at hp, replace hp := quot.exact _ hp,
    rw (equivalence_foo.R _).eqv_gen_iff at hp,
    rcases hp with ⟨⟨⟩,hp⟩, subst y,
    replace hp := hp rfl, cases hp,
    exact hz }
end

/-- simple consequence of the definition of `supp` from the QBNF paper -/
lemma supp_mk_ff' {α} (x : α) : qpf.supp' (foo.mk ff x) = {} :=
begin
  dsimp [qpf.supp'], ext, simp, dsimp [qpf.box],
  use ∅, simp [foo.mk], intros, apply quot.sound,
  dsimp [foo.R], split, refl, rintro ⟨ ⟩
end

/-- simple consequence of the definition of `supp` from the QBNF paper -/
lemma supp_mk_tt' {α} (x : α) : qpf.supp' (foo.mk tt x) = {x} :=
begin
  dsimp [qpf.supp'], ext, simp, dsimp [qpf.box], split; intro h,
  { specialize h {x} _,
    { clear h, introv hfg, simp, rw hfg, simp },
    { simp at h, assumption }, },
  { introv hfg, subst x_1, classical,
    let f : α → α ⊕ bool := λ x, if x ∈ i then sum.inl x else sum.inr tt,
    let g : α → α ⊕ bool := λ x, if x ∈ i then sum.inl x else sum.inr ff,
    specialize hfg _ f g _,
    { intros, simp [*,f,g,if_pos] },
    { simp [f,g] at hfg, split_ifs at hfg,
      assumption, cases hfg } }
end
end ex