/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Alexander Bentkamp
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.linear_independent
import Mathlib.linear_algebra.projection
import Mathlib.data.fintype.card
import Mathlib.PostPort

universes u_1 u_3 u_5 u_2 u_6 u_7 u_4 u u_8 u_9 u_10 u_11

namespace Mathlib

/-!

# Bases

This file defines bases in a module or vector space.

It is inspired by Isabelle/HOL's linear algebra, and hence indirectly by HOL Light.

## Main definitions

All definitions are given for families of vectors, i.e. `v : ι → M` where `M` is the module or
vector space and `ι : Type*` is an arbitrary indexing type.

* `is_basis R v` states that the vector family `v` is a basis, i.e. it is linearly independent and
  spans the entire space.

* `is_basis.repr hv x` is the basis version of `linear_independent.repr hv x`. It returns the
  linear combination representing `x : M` on a basis `v` of `M` (using classical choice).
  The argument `hv` must be a proof that `is_basis R v`. `is_basis.repr hv` is given as a linear
  map as well.

* `is_basis.constr hv f` constructs a linear map `M₁ →ₗ[R] M₂` given the values `f : ι → M₂` at the
  basis `v : ι → M₁`, given `hv : is_basis R v`.

## Main statements

* `is_basis.ext` states that two linear maps are equal if they coincide on a basis.

* `exists_is_basis` states that every vector space has a basis.

## Implementation notes

We use families instead of sets because it allows us to say that two identical vectors are linearly
dependent. For bases, this is useful as well because we can easily derive ordered bases by using an
ordered index type `ι`.

## Tags

basis, bases

-/

/-- A family of vectors is a basis if it is linearly independent and all vectors are in the span. -/
def is_basis {ι : Type u_1} (R : Type u_3) {M : Type u_5} (v : ι → M) [ring R] [add_comm_group M] [module R M] :=
  linear_independent R v ∧ submodule.span R (set.range v) = ⊤

theorem is_basis.mem_span {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) (x : M) : x ∈ submodule.span R (set.range v) :=
  iff.mp submodule.eq_top_iff' (and.right hv)

theorem is_basis.comp {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) (f : ι' → ι) (hf : function.bijective f) : is_basis R (v ∘ f) := sorry

theorem is_basis.injective {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] [nontrivial R] (hv : is_basis R v) : function.injective v :=
  fun (x y : ι) (h : v x = v y) => linear_independent.injective (and.left hv) h

theorem is_basis.range {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) : is_basis R fun (x : ↥(set.range v)) => ↑x := sorry

/-- Given a basis, any vector can be written as a linear combination of the basis vectors. They are
given by this linear map. This is one direction of `module_equiv_finsupp`. -/
def is_basis.repr {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) : linear_map R M (ι →₀ R) :=
  linear_map.comp (linear_independent.repr sorry)
    (linear_map.cod_restrict (submodule.span R (set.range v)) linear_map.id (is_basis.mem_span hv))

theorem is_basis.total_repr {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) (x : M) : coe_fn (finsupp.total ι M R v) (coe_fn (is_basis.repr hv) x) = x :=
  linear_independent.total_repr (and.left hv) { val := x, property := is_basis.mem_span hv x }

theorem is_basis.total_comp_repr {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) : linear_map.comp (finsupp.total ι M R v) (is_basis.repr hv) = linear_map.id :=
  linear_map.ext (is_basis.total_repr hv)

theorem is_basis.ext {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {f : linear_map R M M'} {g : linear_map R M M'} (hv : is_basis R v) (h : ∀ (i : ι), coe_fn f (v i) = coe_fn g (v i)) : f = g :=
  linear_map.ext_on_range (and.right hv) h

theorem is_basis.repr_ker {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) : linear_map.ker (is_basis.repr hv) = ⊥ :=
  iff.mpr linear_map.ker_eq_bot (function.left_inverse.injective (is_basis.total_repr hv))

theorem is_basis.repr_range {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) : linear_map.range (is_basis.repr hv) = finsupp.supported R R set.univ := sorry

theorem is_basis.repr_total {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) (x : ι →₀ R) (hx : x ∈ finsupp.supported R R set.univ) : coe_fn (is_basis.repr hv) (coe_fn (finsupp.total ι M R v) x) = x := sorry

theorem is_basis.repr_eq_single {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) {i : ι} : coe_fn (is_basis.repr hv) (v i) = finsupp.single i 1 := sorry

@[simp] theorem is_basis.repr_self_apply {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) (i : ι) (j : ι) : coe_fn (coe_fn (is_basis.repr hv) (v i)) j = ite (i = j) 1 0 := sorry

theorem is_basis.repr_eq_iff {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) {f : linear_map R M (ι →₀ R)} : is_basis.repr hv = f ↔ ∀ (i : ι), coe_fn f (v i) = finsupp.single i 1 := sorry

theorem is_basis.repr_apply_eq {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) {f : M → ι → R} (hadd : ∀ (x y : M), f (x + y) = f x + f y) (hsmul : ∀ (c : R) (x : M), f (c • x) = c • f x) (f_eq : ∀ (i : ι), f (v i) = ⇑(finsupp.single i 1)) (x : M) (i : ι) : coe_fn (coe_fn (is_basis.repr hv) x) i = f x i := sorry

theorem is_basis.range_repr_self {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) (i : ι) : coe_fn (is_basis.repr (is_basis.range hv)) (v i) = finsupp.single { val := v i, property := set.mem_range_self i } 1 := sorry

@[simp] theorem is_basis.range_repr {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] {x : M} (hv : is_basis R v) (i : ι) : coe_fn (coe_fn (is_basis.repr (is_basis.range hv)) x) { val := v i, property := set.mem_range_self i } =
  coe_fn (coe_fn (is_basis.repr hv) x) i := sorry

/-- Construct a linear map given the value at the basis. -/
def is_basis.constr {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] (hv : is_basis R v) (f : ι → M') : linear_map R M M' :=
  linear_map.comp (finsupp.total M' M' R id) (linear_map.comp (finsupp.lmap_domain R R f) (is_basis.repr hv))

theorem is_basis.constr_apply {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] (hv : is_basis R v) (f : ι → M') (x : M) : coe_fn (is_basis.constr hv f) x = finsupp.sum (coe_fn (is_basis.repr hv) x) fun (b : ι) (a : R) => a • f b := sorry

@[simp] theorem constr_basis {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {f : ι → M'} {i : ι} (hv : is_basis R v) : coe_fn (is_basis.constr hv f) (v i) = f i := sorry

theorem constr_eq {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {g : ι → M'} {f : linear_map R M M'} (hv : is_basis R v) (h : ∀ (i : ι), g i = coe_fn f (v i)) : is_basis.constr hv g = f :=
  is_basis.ext hv fun (i : ι) => Eq.trans (constr_basis hv) (h i)

theorem constr_self {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] (hv : is_basis R v) (f : linear_map R M M') : (is_basis.constr hv fun (i : ι) => coe_fn f (v i)) = f :=
  constr_eq hv fun (x : ι) => rfl

theorem constr_zero {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] (hv : is_basis R v) : (is_basis.constr hv fun (i : ι) => 0) = 0 :=
  constr_eq hv fun (x : ι) => rfl

theorem constr_add {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {g : ι → M'} {f : ι → M'} (hv : is_basis R v) : (is_basis.constr hv fun (i : ι) => f i + g i) = is_basis.constr hv f + is_basis.constr hv g := sorry

theorem constr_neg {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {f : ι → M'} (hv : is_basis R v) : (is_basis.constr hv fun (i : ι) => -f i) = -is_basis.constr hv f := sorry

theorem constr_sub {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] (hv : is_basis R v) {g : ι → M'} {f : ι → M'} (hs : is_basis R v) : (is_basis.constr hv fun (i : ι) => f i - g i) = is_basis.constr hs f - is_basis.constr hs g := sorry

-- this only works on functions if `R` is a commutative ring

theorem constr_smul {ι : Type u_1} {R : Type u_2} {M : Type u_3} [comm_ring R] [add_comm_group M] [module R M] {v : ι → R} {f : ι → M} {a : R} (hv : is_basis R v) : (is_basis.constr hv fun (b : ι) => a • f b) = a • is_basis.constr hv f := sorry

theorem constr_range {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] [Nonempty ι] (hv : is_basis R v) {f : ι → M'} : linear_map.range (is_basis.constr hv f) = submodule.span R (set.range f) := sorry

/-- Canonical equivalence between a module and the linear combinations of basis vectors. -/
def module_equiv_finsupp {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) : linear_equiv R M (ι →₀ R) :=
  linear_equiv.symm
    (linear_equiv.trans (linear_independent.total_equiv sorry)
      (linear_equiv.of_top (submodule.span R (set.range v)) sorry))

@[simp] theorem module_equiv_finsupp_apply_basis {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) (i : ι) : coe_fn (module_equiv_finsupp hv) (v i) = finsupp.single i 1 := sorry

/-- Isomorphism between the two modules, given two modules `M` and `M'` with respective bases
`v` and `v'` and a bijection between the indexing sets of the two bases. -/
def linear_equiv_of_is_basis {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5} {M' : Type u_6} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {v : ι → M} {v' : ι' → M'} (hv : is_basis R v) (hv' : is_basis R v') (e : ι ≃ ι') : linear_equiv R M M' :=
  linear_equiv.mk (linear_map.to_fun (is_basis.constr hv (v' ∘ ⇑e))) sorry sorry
    ⇑(is_basis.constr hv' (v ∘ ⇑(equiv.symm e))) sorry sorry

/-- Isomorphism between the two modules, given two modules `M` and `M'` with respective bases
`v` and `v'` and a bijection between the two bases. -/
def linear_equiv_of_is_basis' {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5} {M' : Type u_6} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {v : ι → M} {v' : ι' → M'} (f : M → M') (g : M' → M) (hv : is_basis R v) (hv' : is_basis R v') (hf : ∀ (i : ι), f (v i) ∈ set.range v') (hg : ∀ (i : ι'), g (v' i) ∈ set.range v) (hgf : ∀ (i : ι), g (f (v i)) = v i) (hfg : ∀ (i : ι'), f (g (v' i)) = v' i) : linear_equiv R M M' :=
  linear_equiv.mk (linear_map.to_fun (is_basis.constr hv (f ∘ v))) sorry sorry ⇑(is_basis.constr hv' (g ∘ v')) sorry sorry

@[simp] theorem linear_equiv_of_is_basis_comp {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {M'' : Type u_7} [ring R] [add_comm_group M] [add_comm_group M'] [add_comm_group M''] [module R M] [module R M'] [module R M''] {ι'' : Type u_4} {v : ι → M} {v' : ι' → M'} {v'' : ι'' → M''} (hv : is_basis R v) (hv' : is_basis R v') (hv'' : is_basis R v'') (e : ι ≃ ι') (f : ι' ≃ ι'') : linear_equiv.trans (linear_equiv_of_is_basis hv hv' e) (linear_equiv_of_is_basis hv' hv'' f) =
  linear_equiv_of_is_basis hv hv'' (equiv.trans e f) := sorry

@[simp] theorem linear_equiv_of_is_basis_refl {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : is_basis R v) : linear_equiv_of_is_basis hv hv (equiv.refl ι) = linear_equiv.refl R M := sorry

theorem linear_equiv_of_is_basis_trans_symm {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] (hv : is_basis R v) (e : ι ≃ ι') {v' : ι' → M'} (hv' : is_basis R v') : linear_equiv.trans (linear_equiv_of_is_basis hv hv' e) (linear_equiv_of_is_basis hv' hv (equiv.symm e)) =
  linear_equiv.refl R M := sorry

theorem linear_equiv_of_is_basis_symm_trans {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] (hv : is_basis R v) (e : ι ≃ ι') {v' : ι' → M'} (hv' : is_basis R v') : linear_equiv.trans (linear_equiv_of_is_basis hv' hv (equiv.symm e)) (linear_equiv_of_is_basis hv hv' e) =
  linear_equiv.refl R M' := sorry

theorem is_basis_inl_union_inr {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5} {M' : Type u_6} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {v : ι → M} {v' : ι' → M'} (hv : is_basis R v) (hv' : is_basis R v') : is_basis R (sum.elim (⇑(linear_map.inl R M M') ∘ v) (⇑(linear_map.inr R M M') ∘ v')) := sorry

theorem is_basis_singleton_one {ι : Type u_1} (R : Type u_2) [unique ι] [ring R] : is_basis R fun (_x : ι) => 1 := sorry

protected theorem linear_equiv.is_basis {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] (hs : is_basis R v) (f : linear_equiv R M M') : is_basis R (⇑f ∘ v) := sorry

theorem is_basis_span {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] (hs : linear_independent R v) : is_basis R fun (i : ι) => { val := v i, property := submodule.subset_span (set.mem_range_self i) } := sorry

theorem is_basis_empty {ι : Type u_1} {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M] [module R M] (h_empty : ¬Nonempty ι) (h : ∀ (x : M), x = 0) : is_basis R fun (x : ι) => 0 := sorry

theorem is_basis_empty_bot {ι : Type u_1} {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M] [module R M] (h_empty : ¬Nonempty ι) : is_basis R fun (_x : ι) => 0 :=
  is_basis_empty h_empty fun (x : ↥⊥) => iff.mpr subtype.ext_iff_val (iff.mp (submodule.mem_bot R) (subtype.mem x))

/-- A module over `R` with a finite basis is linearly equivalent to functions from its basis to `R`.
-/
def is_basis.equiv_fun {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] [fintype ι] (h : is_basis R v) : linear_equiv R M (ι → R) :=
  linear_equiv.trans (module_equiv_finsupp h)
    (linear_equiv.mk finsupp.to_fun sorry sorry (equiv.inv_fun finsupp.equiv_fun_on_fintype) sorry sorry)

/-- A module over a finite ring that admits a finite basis is finite. -/
def module.fintype_of_fintype {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] [fintype ι] (h : is_basis R v) [fintype R] : fintype M :=
  fintype.of_equiv (ι → R) (equiv.symm (linear_equiv.to_equiv (is_basis.equiv_fun h)))

theorem module.card_fintype {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] [fintype ι] (h : is_basis R v) [fintype R] [fintype M] : fintype.card M = fintype.card R ^ fintype.card ι :=
  Eq.trans (fintype.card_congr (linear_equiv.to_equiv (is_basis.equiv_fun h))) fintype.card_fun

/-- Given a basis `v` indexed by `ι`, the canonical linear equivalence between `ι → R` and `M` maps
a function `x : ι → R` to the linear combination `∑_i x i • v i`. -/
@[simp] theorem is_basis.equiv_fun_symm_apply {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] [fintype ι] (h : is_basis R v) (x : ι → R) : coe_fn (linear_equiv.symm (is_basis.equiv_fun h)) x = finset.sum finset.univ fun (i : ι) => x i • v i := sorry

theorem is_basis.equiv_fun_apply {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] [fintype ι] (h : is_basis R v) (u : M) : coe_fn (is_basis.equiv_fun h) u = ⇑(coe_fn (is_basis.repr h) u) :=
  rfl

theorem is_basis.equiv_fun_total {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] [fintype ι] (h : is_basis R v) (u : M) : (finset.sum finset.univ fun (i : ι) => coe_fn (is_basis.equiv_fun h) u i • v i) = u := sorry

@[simp] theorem is_basis.equiv_fun_self {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] [fintype ι] (h : is_basis R v) (i : ι) (j : ι) : coe_fn (is_basis.equiv_fun h) (v i) j = ite (i = j) 1 0 := sorry

@[simp] theorem is_basis.constr_apply_fintype {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] [fintype ι] (h : is_basis R v) (f : ι → M') (x : M) : coe_fn (is_basis.constr h f) x = finset.sum finset.univ fun (i : ι) => coe_fn (is_basis.equiv_fun h) x i • f i := sorry

theorem exists_subset_is_basis {K : Type u_4} {V : Type u} [field K] [add_comm_group V] [vector_space K V] {s : set V} (hs : linear_independent K fun (x : ↥s) => ↑x) : ∃ (b : set V), s ⊆ b ∧ is_basis K coe := sorry

theorem exists_sum_is_basis {ι : Type u_1} {K : Type u_4} {V : Type u} [field K] [add_comm_group V] [vector_space K V] {v : ι → V} (hs : linear_independent K v) : ∃ (ι' : Type u), ∃ (v' : ι' → V), is_basis K (sum.elim v v') := sorry

theorem exists_is_basis (K : Type u_4) (V : Type u) [field K] [add_comm_group V] [vector_space K V] : ∃ (b : set V), is_basis K fun (i : ↥b) => ↑i := sorry

theorem linear_map.exists_left_inverse_of_injective {K : Type u_4} {V : Type u} {V' : Type u_8} [field K] [add_comm_group V] [add_comm_group V'] [vector_space K V] [vector_space K V'] (f : linear_map K V V') (hf_inj : linear_map.ker f = ⊥) : ∃ (g : linear_map K V' V), linear_map.comp g f = linear_map.id := sorry

theorem submodule.exists_is_compl {K : Type u_4} {V : Type u} [field K] [add_comm_group V] [vector_space K V] (p : submodule K V) : ∃ (q : submodule K V), is_compl p q := sorry

theorem linear_map.exists_right_inverse_of_surjective {K : Type u_4} {V : Type u} {V' : Type u_8} [field K] [add_comm_group V] [add_comm_group V'] [vector_space K V] [vector_space K V'] (f : linear_map K V V') (hf_surj : linear_map.range f = ⊤) : ∃ (g : linear_map K V' V), linear_map.comp f g = linear_map.id := sorry

theorem quotient_prod_linear_equiv {K : Type u_4} {V : Type u} [field K] [add_comm_group V] [vector_space K V] (p : submodule K V) : Nonempty (linear_equiv K (submodule.quotient p × ↥p) V) := sorry

theorem vector_space.card_fintype (K : Type u_4) (V : Type u) [field K] [add_comm_group V] [vector_space K V] [fintype K] [fintype V] : ∃ (n : ℕ), fintype.card V = fintype.card K ^ n :=
  exists.elim (exists_is_basis K V)
    fun (b : set V) (hb : is_basis K fun (i : ↥b) => ↑i) => Exists.intro (fintype.card ↥b) (module.card_fintype hb)

namespace pi

theorem linear_independent_std_basis {R : Type u_3} {η : Type u_9} {ιs : η → Type u_10} {Ms : η → Type u_11} [ring R] [(i : η) → add_comm_group (Ms i)] [(i : η) → module R (Ms i)] [DecidableEq η] (v : (j : η) → ιs j → Ms j) (hs : ∀ (i : η), linear_independent R (v i)) : linear_independent R
  fun (ji : sigma fun (j : η) => ιs j) =>
    coe_fn (linear_map.std_basis R Ms (sigma.fst ji)) (v (sigma.fst ji) (sigma.snd ji)) := sorry

theorem is_basis_std_basis {R : Type u_3} {η : Type u_9} {ιs : η → Type u_10} {Ms : η → Type u_11} [ring R] [(i : η) → add_comm_group (Ms i)] [(i : η) → module R (Ms i)] [fintype η] [DecidableEq η] (s : (j : η) → ιs j → Ms j) (hs : ∀ (j : η), is_basis R (s j)) : is_basis R
  fun (ji : sigma fun (j : η) => ιs j) =>
    coe_fn (linear_map.std_basis R Ms (sigma.fst ji)) (s (sigma.fst ji) (sigma.snd ji)) := sorry

theorem is_basis_fun₀ (R : Type u_3) (η : Type u_9) [ring R] [fintype η] [DecidableEq η] : is_basis R fun (ji : sigma fun (j : η) => Unit) => coe_fn (linear_map.std_basis R (fun (i : η) => R) (sigma.fst ji)) 1 :=
  is_basis_std_basis (fun (_x : η) (_x : Unit) => 1) fun (i : η) => is_basis_singleton_one R

theorem is_basis_fun (R : Type u_3) (η : Type u_9) [ring R] [fintype η] [DecidableEq η] : is_basis R fun (i : η) => coe_fn (linear_map.std_basis R (fun (i : η) => R) i) 1 := sorry

@[simp] theorem is_basis_fun_repr (R : Type u_3) (η : Type u_9) [ring R] [fintype η] [DecidableEq η] (x : η → R) (i : η) : coe_fn (coe_fn (is_basis.repr (is_basis_fun R η)) x) i = x i := sorry


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open_cover A),
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  have h1 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_cover C ∧ is_locally_finite C ∧ is_refinement A C, from by {
    -- First, we define a collection of pen balls.
    -- Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$ centered at 0.
    let B : ℕ → set (euclidean_space ℝ (fin n)) := λ m, {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)), y ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x = y},
    have hB : ∀ m : ℕ, B m ⊆ (euclidean_space ℝ (fin n)), from by {
      assume m : ℕ,
      assume x : euclidean_space ℝ (fin n),
      assume hx : x ∈ B m,
      show x ∈ (euclidean_space ℝ (fin n)), from by {
        cases hx with y hy,
        cases hy with hy1 hy2,
        show x ∈ (euclidean_space ℝ (fin n)), from by {
          rw ← hy2,
          apply set.mem_of_mem_ball,
          exact hy1,
        },
      },
    },
    have hB0 : B 0 = ∅, from by {
      apply set.eq_empty_iff_forall_not_mem.mpr,
      assume x : euclidean_space ℝ (fin n),
      assume hx : x ∈ B 0,
      cases hx with y hy,
      cases hy with hy1 hy2,
      have h3 : y ∈ (ball (0 : euclidean_space ℝ (fin n)) 0), from by {
        rw ← hy2,
        exact hx,
      },
      have h4 : y = (0 : euclidean_space ℝ (fin n)), from by {
        apply ball_eq_zero,
        exact h3,
      },
      have h5 : x = (0 : euclidean_space ℝ (fin n)), from by {
        rw ← hy2,
        exact h4,
      },
      have h6 : x ∉ (euclidean_space ℝ (fin n) \ {0}), from by {
        apply set.not_mem_of_mem_diff,
        split,
        exact hx,
        apply set.not_mem_singleton,
        exact h5,
      },
      show false, from by {
        apply h6,
        apply set.mem_univ,
      },
    },
    have hB1 : ∀ m : ℕ, B (m+1) = (euclidean_space ℝ (fin n)) \ (B m), from by {
      assume m : ℕ,
      apply set.eq_of_subset_of_subset,
      assume x : euclidean_space ℝ (fin n),
      assume hx : x ∈ B (m+1),
      cases hx with y hy,
      cases hy with hy1 hy2,
      have h3 : y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m+1)), from by {
        rw ← hy2,
        exact hx,
      },
      have h4 : y ∉ (ball (0 : euclidean_space ℝ (fin n)) m), from by {
        apply ball_not_mem_of_ball_lt,
        exact h3,
      },
      have h5 : y ∉ B m, from by {
        assume h6 : y ∈ B m,
        cases h6 with z hz,
        cases hz with hz1 hz2,
        have h7 : z ∈ (ball (0 : euclidean_space ℝ (fin n)) m), from by {
          rw ← hz2,
          exact hz1,
        },
        show false, from by {
          apply h4,
          exact h7,
        },
      },
      have h6 : y ∈ (euclidean_space ℝ (fin n)) \ (B m), from by {
        apply set.mem_diff,
        split,
        exact hy1,
        exact h5,
      },
      have h7 : x ∈ (euclidean_space ℝ (fin n)) \ (B m), from by {
        rw ← hy2,
        exact h6,
      },
      show x ∈ (euclidean_space ℝ (fin n)) \ (B m), from by {
        apply set.mem_diff,
        split,
        exact hx,
        exact h7,
      },
      assume x : euclidean_space ℝ (fin n),
      assume hx : x ∈ (euclidean_space ℝ (fin n)) \ (B m),
      cases hx with hx1 hx2,
      have h3 : x ∈ (euclidean_space ℝ (fin n)), from by {
        apply set.mem_diff,
        split,
        exact hx1,
        exact hx2,
      },
      have h4 : ∃ (y : euclidean_space ℝ (fin n)), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m+1)) ∧ x = y, from by {
        use x,
        split,
        exact h3,
        refl,
      },
      show x ∈ B (m+1), from by {
        apply set.mem_of_mem_ball,
        exact h4,
      },
    },
    have hB2 : ∀ m : ℕ, B m = (euclidean_space ℝ (fin n)) \ (B (m-1)), from by {
      assume m : ℕ,
      induction m with m hm,
      show B 0 = (euclidean_space ℝ (fin n)) \ (B (-1)), from by {
        rw hB0,
        rw set.diff_empty,
        refl,
      },
      show B (m+1) = (euclidean_space ℝ (fin n)) \ (B m), from by {
        rw hB1,
        rw hm,
        refl,
      },
    },
    have hB3 : ∀ m : ℕ, B m = (euclidean_space ℝ (fin n)) \ (B (m-1)), from by {
      assume m : ℕ,
      induction m with m hm,
      show B 0 = (euclidean_space ℝ (fin n)) \ (B (-1)), from by {
        rw hB0,
        rw set.diff_empty,
        refl,
      },
      show B (m+1) = (euclidean_space ℝ (fin n)) \ (B m), from by {
        rw hB1,
        rw hm,
        refl,
      },
    },
    have hB4 : ∀ m : ℕ, B m = (euclidean_space ℝ (fin n)) \ (B (m-1)), from by {
      assume m : ℕ,
      induction m with m hm,
      show B 0 = (euclidean_space ℝ (fin n)) \ (
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import Mathlib.Data.Nat.Basic
import Mathlib.Data.Fin.Basic
import Mathlib.Algebra.Group.Defs
import Mathlib.Algebra.GroupWithZero.Defs
import Mathlib.Algebra.Ring.Basic
import Mathlib.Data.ZMod.Defs

lemma UInt8.val_eq_of_lt {a : Nat} : a < UInt8.size -> (ofNat a).val = a := Nat.mod_eq_of_lt

lemma UInt16.val_eq_of_lt {a : Nat} : a < UInt16.size -> (ofNat a).val = a := Nat.mod_eq_of_lt

lemma UInt32.val_eq_of_lt {a : Nat} : a < UInt32.size -> (ofNat a).val = a := Nat.mod_eq_of_lt

lemma UInt64.val_eq_of_lt {a : Nat} : a < UInt64.size -> (ofNat a).val = a := Nat.mod_eq_of_lt

lemma USize.val_eq_of_lt {a : Nat} : a < USize.size -> (ofNat a).val = a := Nat.mod_eq_of_lt

instance UInt8.neZero : NeZero UInt8.size := ⟨by decide⟩

instance UInt16.neZero : NeZero UInt16.size := ⟨by decide⟩

instance UInt32.neZero : NeZero UInt32.size := ⟨by decide⟩

instance UInt64.neZero : NeZero UInt64.size := ⟨by decide⟩

instance USize.neZero : NeZero  USize.size := NeZero.of_pos usize_size_gt_zero

example : (0 : UInt8) = ⟨0⟩ := rfl

set_option hygiene false in
run_cmd
  for typeName in [`UInt8, `UInt16, `UInt32, `UInt64, `USize].map Lean.mkIdent do
  Lean.Elab.Command.elabCommand (← `(
    namespace $typeName
      instance : Inhabited $typeName where
        default := 0

      instance : Neg $typeName where
        neg a := mk (-a.val)

      instance : Pow $typeName ℕ where
        pow a n := mk (a.val ^ n)

      instance : SMul ℕ $typeName where
        smul n a := mk (n • a.val)

      instance : SMul ℤ $typeName where
        smul z a := mk (z • a.val)

      instance : NatCast $typeName where
        natCast n := mk n

      instance : IntCast $typeName where
        intCast z := mk z

      lemma zero_def : (0 : $typeName) = ⟨0⟩ := rfl

      lemma one_def : (1 : $typeName) = ⟨1⟩ := rfl

      lemma neg_def (a : $typeName) : -a = ⟨-a.val⟩ := rfl

      lemma sub_def (a b : $typeName) : a - b = ⟨a.val - b.val⟩ := rfl

      lemma mul_def (a b : $typeName) : a * b = ⟨a.val * b.val⟩ := rfl

      lemma mod_def (a b : $typeName) : a % b = ⟨a.val % b.val⟩ := rfl

      lemma add_def (a b : $typeName) : a + b = ⟨a.val + b.val⟩ := rfl

      lemma pow_def (a : $typeName) (n : ℕ) : a ^ n = ⟨a.val ^ n⟩ := rfl

      lemma nsmul_def (n : ℕ) (a : $typeName) : n • a = ⟨n • a.val⟩ := rfl

      lemma zsmul_def (z : ℤ) (a : $typeName) : z • a = ⟨z • a.val⟩ := rfl

      lemma natCast_def (n : ℕ) : (n : $typeName) = ⟨n⟩ := rfl

      lemma intCast_def (z : ℤ) : (z : $typeName) = ⟨z⟩ := rfl

      lemma eq_of_val_eq : ∀ {a b : $typeName}, a.val = b.val -> a = b
      | ⟨_⟩, ⟨_⟩, h => congrArg mk h

      lemma val_injective : Function.Injective val := @eq_of_val_eq

      lemma val_eq_of_eq : ∀ {a b : $typeName}, a = b -> a.val = b.val
      | ⟨_⟩, ⟨_⟩, h => congrArg val h

      @[simp] lemma mk_val_eq : ∀ (a : $typeName), mk a.val = a
      | ⟨_, _⟩ => rfl

      instance : CommRing $typeName :=
        Function.Injective.commRing val val_injective
          rfl rfl (fun _ _ => rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
          (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ => rfl) (fun _ => rfl)

    end $typeName
  ))

namespace UInt8

/-- Is this an uppercase ASCII letter? -/
def isUpper (c : UInt8) : Bool :=
  c ≥ 65 && c ≤ 90

/-- Is this a lowercase ASCII letter? -/
def isLower (c : UInt8) : Bool :=
  c ≥ 97 && c ≤ 122

/-- Is this an alphabetic ASCII character? -/
def isAlpha (c : UInt8) : Bool :=
  c.isUpper || c.isLower

/-- Is this an ASCII digit character? -/
def isDigit (c : UInt8) : Bool :=
  c ≥ 48 && c ≤ 57

/-- Is this an alphanumeric ASCII character? -/
def isAlphanum (c : UInt8) : Bool :=
  c.isAlpha || c.isDigit

theorem toChar_aux (n : Nat) (h : n < size) : Nat.isValidChar (UInt32.ofNat n).1 := by
  rw [UInt32.val_eq_of_lt]
  exact Or.inl $ Nat.lt_trans h $ by decide
  exact Nat.lt_trans h $ by decide

/-- The numbers from 0 to 256 are all valid UTF-8 characters, so we can embed one in the other. -/
def toChar (n : UInt8) : Char := ⟨n.toUInt32, toChar_aux n.1 n.1.2⟩

end UInt8


/-
Copyright (c) 2022 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import data.fintype.powerset
import data.fintype.prod
import data.fintype.sigma
import data.fintype.sum
import data.fintype.vector

/-!
# Finite types

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

In this file we prove some theorems about `finite` and provide some instances. This typeclass is a
`Prop`-valued counterpart of the typeclass `fintype`. See more details in the file where `finite` is
defined.

## Main definitions

* `fintype.finite`, `finite.of_fintype` creates a `finite` instance from a `fintype` instance. The
  former lemma takes `fintype α` as an explicit argument while the latter takes it as an instance
  argument.
* `fintype.of_finite` noncomputably creates a `fintype` instance from a `finite` instance.

## Implementation notes

There is an apparent duplication of many `fintype` instances in this module,
however they follow a pattern: if a `fintype` instance depends on `decidable`
instances or other `fintype` instances, then we need to "lower" the instance
to be a `finite` instance by removing the `decidable` instances and switching
the `fintype` instances to `finite` instances. These are precisely the ones
that cannot be inferred using `finite.of_fintype`. (However, when using
`open_locale classical` or the `classical` tactic the instances relying only
on `decidable` instances will give `finite` instances.) In the future we might
consider writing automation to create these "lowered" instances.

## Tags

finiteness, finite types
-/

noncomputable theory
open_locale classical

variables {α β γ : Type*}

namespace finite

@[priority 100] -- see Note [lower instance priority]
instance of_subsingleton {α : Sort*} [subsingleton α] : finite α :=
of_injective (function.const α ()) $ function.injective_of_subsingleton _

@[nolint instance_priority] -- Higher priority for `Prop`s
instance prop (p : Prop) : finite p := finite.of_subsingleton

instance [finite α] [finite β] : finite (α × β) :=
by { haveI := fintype.of_finite α, haveI := fintype.of_finite β, apply_instance }

instance {α β : Sort*} [finite α] [finite β] : finite (pprod α β) :=
of_equiv _ equiv.pprod_equiv_prod_plift.symm

lemma prod_right (α) [finite (α × β)] [nonempty α] : finite β :=
of_surjective (prod.snd : α × β → β) prod.snd_surjective

instance [finite α] [finite β] : finite (α ⊕ β) :=
by { haveI := fintype.of_finite α, haveI := fintype.of_finite β, apply_instance }

lemma sum_left (β) [finite (α ⊕ β)] : finite α :=
of_injective (sum.inl : α → α ⊕ β) sum.inl_injective

lemma sum_right (α) [finite (α ⊕ β)] : finite β :=
of_injective (sum.inr : β → α ⊕ β) sum.inr_injective

instance {β : α → Type*} [finite α] [Π a, finite (β a)] : finite (Σ a, β a) :=
by { letI := fintype.of_finite α, letI := λ a, fintype.of_finite (β a), apply_instance }

instance {ι : Sort*} {π : ι → Sort*} [finite ι] [Π i, finite (π i)] : finite (Σ' i, π i) :=
of_equiv _ (equiv.psigma_equiv_sigma_plift π).symm

instance [finite α] : finite (set α) := by { casesI nonempty_fintype α, apply_instance }

end finite

/-- This instance also provides `[finite s]` for `s : set α`. -/
instance subtype.finite {α : Sort*} [finite α] {p : α → Prop} : finite {x // p x} :=
finite.of_injective coe subtype.coe_injective

instance pi.finite {α : Sort*} {β : α → Sort*} [finite α] [∀ a, finite (β a)] : finite (Π a, β a) :=
begin
  haveI := fintype.of_finite (plift α),
  haveI := λ a, fintype.of_finite (plift (β a)),
  exact finite.of_equiv (Π (a : plift α), plift (β (equiv.plift a)))
    (equiv.Pi_congr equiv.plift (λ _, equiv.plift)),
end

instance vector.finite {α : Type*} [finite α] {n : ℕ} : finite (vector α n) :=
by { haveI := fintype.of_finite α, apply_instance }

instance quot.finite {α : Sort*} [finite α] (r : α → α → Prop) : finite (quot r) :=
finite.of_surjective _ (surjective_quot_mk r)

instance quotient.finite {α : Sort*} [finite α] (s : setoid α) : finite (quotient s) :=
quot.finite _

instance function.embedding.finite {α β : Sort*} [finite β] : finite (α ↪ β) :=
begin
  casesI is_empty_or_nonempty (α ↪ β) with _ h,
  { apply_instance, },
  { refine h.elim (λ f, _),
    haveI : finite α := finite.of_injective _ f.injective,
    exact finite.of_injective _ fun_like.coe_injective },
end

instance equiv.finite_right {α β : Sort*} [finite β] : finite (α ≃ β) :=
finite.of_injective equiv.to_embedding $ λ e₁ e₂ h, equiv.ext $
  by convert fun_like.congr_fun h

instance equiv.finite_left {α β : Sort*} [finite α] : finite (α ≃ β) :=
finite.of_equiv _ ⟨equiv.symm, equiv.symm, equiv.symm_symm, equiv.symm_symm⟩

instance [finite α] {n : ℕ} : finite (sym α n) :=
by { haveI := fintype.of_finite α, apply_instance }


import model_theory.substructures
import model_theory.bundled

--OUTPUT 1
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- For each $n$, let $\mathbf A_n$ be the formula:
  let A : ℕ → L.formula,
  -- $\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$
  have h1 : ∀ n : ℕ, A n = L.exists (L.var 1) (L.exists (L.var 2) (L.exists (L.var 3) (L.exists (L.var 4) (L.exists (L.var 5) (L.exists (L.var 6) (L.exists (L.var 7) (L.exists (L.var 8) (L.exists (L.var 9) (L.exists (L.var 10) (L.exists (L.var 11) (L.exists (L.var 12) (L.exists (L.var 13) (L.exists (L.var 14) (L.exists (L.var 15) (L.exists (L.var 16) (L.exists (L.var 17) (L.exists (L.var 18) (L.exists (L.var 19) (L.exists (L.var 20) (L.exists (L.var 21) (L.exists (L.var 22) (L.exists (L.var 23) (L.exists (L.var 24) (L.exists (L.var 25) (L.exists (L.var 26) (L.exists (L.var 27) (L.exists (L.var 28) (L.exists (L.var 29) (L.exists (L.var 30) (L.exists (L.var 31) (L.exists (L.var 32) (L.exists (L.var 33) (L.exists (L.var 34) (L.exists (L.var 35) (L.exists (L.var 36) (L.exists (L.var 37) (L.exists (L.var 38) (L.exists (L.var 39) (L.exists (L.var 40) (L.exists (L.var 41) (L.exists (L.var 42) (L.exists (L.var 43) (L.exists (L.var 44) (L.exists (L.var 45) (L.exists (L.var 46) (L.exists (L.var 47) (L.exists (L.var 48) (L.exists (L.var 49) (L.exists (L.var 50) (L.exists (L.var 51) (L.exists (L.var 52) (L.exists (L.var 53) (L.exists (L.var 54) (L.exists (L.var 55) (L.exists (L.var 56) (L.exists (L.var 57) (L.exists (L.var 58) (L.exists (L.var 59) (L.exists (L.var 60) (L.exists (L.var 61) (L.exists (L.var 62) (L.exists (L.var 63) (L.exists (L.var 64) (L.exists (L.var 65) (L.exists (L.var 66) (L.exists (L.var 67) (L.exists (L.var 68) (L.exists (L.var 69) (L.exists (L.var 70) (L.exists (L.var 71) (L.exists (L.var 72) (L.exists (L.var 73) (L.exists (L.var 74) (L.exists (L.var 75) (L.exists (L.var 76) (L.exists (L.var 77) (L.exists (L.var 78) (L.exists (L.var 79) (L.exists (L.var 80) (L.exists (L.var 81) (L.exists (L.var 82) (L.exists (L.var 83) (L.exists (L.var 84) (L.exists (L.var 85) (L.exists (L.var 86) (L.exists (L.var 87) (L.exists (L.var 88) (L.exists (L.var 89) (L.exists (L.var 90) (L.exists (L.var 91) (L.exists (L.var 92) (L.exists (L.var 93) (L.exists (L.var 94) (L.exists (L.var 95) (L.exists (L.var 96) (L.exists (L.var 97) (L.exists (L.var 98) (L.exists (L.var 99) (L.exists (L.var 100) (L.exists (L.var 101) (L.exists (L.var 102) (L.exists (L.var 103) (L.exists (L.var 104) (L.exists (L.var 105) (L.exists (L.var 106) (L.exists (L.var 107) (L.exists (L.var 108) (L.exists (L.var 109) (L.exists (L.var 110) (L.exists (L.var 111) (L.exists (L.var 112) (L.exists (L.var 113) (L.exists (L.var 114) (L.exists (L.var 115) (L.exists (L.var 116) (L.exists (L.var 117) (L.exists (L.var 118) (L.exists (L.var 119) (L.exists (L.var 120) (L.exists (L.var 121) (L.exists (L.var 122) (L.exists (L.var 123) (L.exists (L.var 124) (L.exists (L.var 125) (L.exists (L.var 126) (L.exists (L.var 127) (L.exists (L.var 128) (L.exists (L.var 129) (L.exists (L.var 130) (L.exists (L.var 131) (L.exists (L.var 132) (L.exists (L.var 133) (L.exists (L.var 134) (L.exists (L.var 135) (L.exists (L.var 136) (L.exists (L.var 137) (L.exists (L.var 138) (L.exists (L.var 139) (L.exists (L.var 140) (L.exists (L.var 141) (L.exists (L.var 142) (L.exists (L.var 143) (L.exists (L.var 144) (L.exists (L.var 145) (L.exists (L.var 146) (L.exists (L.var 147) (L.exists (L.var 148) (L.exists (L.var 149) (L.exists (L.var 150) (L.exists (L.var 151) (L.exists (L.var 152) (L.exists (L.var 153) (L.exists (L.var 154) (L.exists (L.var 155) (L.exists (L.var 156) (L.exists (L.var 157) (L.exists (L.var 158) (L.exists (L.var 159) (L.exists (L.var 160) (L.exists (L.var 161) (L.exists (L.var 162) (L.exists (L.var 163) (L.exists (L.var 164) (L.exists (L.var 165) (L.exists (L.var 166) (L.exists (L.var 167) (L.exists (L.var 168) (L.exists (L.var 169) (L.exists (L.var 170) (L.exists (L.var 171) (
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Overflow theorem
Let $F$ be a set of first-order formulas which has finite models of arbitrarily large size. Then $F$ has an infinite model.
`proof`
For each $n$, let $\mathbf A_n$ be the formula:

$\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$

Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.

Take:
$$ \Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i $$

Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.

From the Compactness Theorem, $\Gamma$ is satisfiable in some model $\mathbf{M}$.

But since $\mathbf{M} \models A_i$ for each $i$, $\mathbf{M}$ must be infinite.

So $F$ has an infinite model.

QED
-/
theorem  overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import category_theory.sites.sheaf

/-!
# Cover-preserving functors between sites.

We define cover-preserving functors between sites as functors that push covering sieves to
covering sieves. A cover-preserving and compatible-preserving functor `G : C ⥤ D` then pulls
sheaves on `D` back to sheaves on `C` via `G.op ⋙ -`.

## Main definitions

* `category_theory.cover_preserving`: a functor between sites is cover-preserving if it
pushes covering sieves to covering sieves
* `category_theory.compatible_preserving`: a functor between sites is compatible-preserving
if it pushes compatible families of elements to compatible families.
* `category_theory.pullback_sheaf` : the pullback of a sheaf along a cover-preserving and
compatible-preserving functor.
* `category_theory.sites.pullback` : the induced functor `Sheaf K A ⥤ Sheaf J A` for a
cover-preserving and compatible-preserving functor `G : (C, J) ⥤ (D, K)`.

## Main results

- `category_theory.sites.whiskering_left_is_sheaf_of_cover_preserving`: If `G : C ⥤ D` is
cover-preserving and compatible-preserving, then `G ⋙ -` (`uᵖ`) as a functor
`(Dᵒᵖ ⥤ A) ⥤ (Cᵒᵖ ⥤ A)` of presheaves maps sheaves to sheaves.

## References

* [Elephant]: *Sketches of an Elephant*, P. T. Johnstone: C2.3.
* https://stacks.math.columbia.edu/tag/00WW

-/

universes w v₁ v₂ v₃ u₁ u₂ u₃
noncomputable theory

open category_theory
open opposite
open category_theory.presieve.family_of_elements
open category_theory.presieve
open category_theory.limits

namespace category_theory
variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]
variables {A : Type u₃} [category.{v₃} A]
variables (J : grothendieck_topology C) (K : grothendieck_topology D)
variables {L : grothendieck_topology A}

/--
A functor `G : (C, J) ⥤ (D, K)` between sites is *cover-preserving*
if for all covering sieves `R` in `C`, `R.pushforward_functor G` is a covering sieve in `D`.
-/
@[nolint has_inhabited_instance]
structure cover_preserving (G : C ⥤ D) : Prop :=
(cover_preserve : ∀ {U : C} {S : sieve U} (hS : S ∈ J U), S.functor_pushforward G ∈ K (G.obj U))

/-- The identity functor on a site is cover-preserving. -/
lemma id_cover_preserving : cover_preserving J J (𝟭 _) := ⟨λ U S hS, by simpa using hS⟩

variables (J) (K)

/-- The composition of two cover-preserving functors is cover-preserving. -/
lemma cover_preserving.comp {F} (hF : cover_preserving J K F) {G} (hG : cover_preserving K L G) :
  cover_preserving J L (F ⋙ G) := ⟨λ U S hS,
begin
  rw sieve.functor_pushforward_comp,
  exact hG.cover_preserve (hF.cover_preserve hS)
end⟩

/--
A functor `G : (C, J) ⥤ (D, K)` between sites is called compatible preserving if for each
compatible family of elements at `C` and valued in `G.op ⋙ ℱ`, and each commuting diagram
`f₁ ≫ G.map g₁ = f₂ ≫ G.map g₂`, `x g₁` and `x g₂` coincide when restricted via `fᵢ`.
This is actually stronger than merely preserving compatible families because of the definition of
`functor_pushforward` used.
-/
@[nolint has_inhabited_instance]
structure compatible_preserving (K : grothendieck_topology D) (G : C ⥤ D) : Prop :=
(compatible :
  ∀ (ℱ : SheafOfTypes.{w} K) {Z} {T : presieve Z}
    {x : family_of_elements (G.op ⋙ ℱ.val) T} (h : x.compatible)
    {Y₁ Y₂} {X} (f₁ : X ⟶ G.obj Y₁) (f₂ : X ⟶ G.obj Y₂) {g₁ : Y₁ ⟶ Z} {g₂ : Y₂ ⟶ Z}
    (hg₁ : T g₁) (hg₂ : T g₂) (eq : f₁ ≫ G.map g₁ = f₂ ≫ G.map g₂),
      ℱ.val.map f₁.op (x g₁ hg₁) = ℱ.val.map f₂.op (x g₂ hg₂))

variables {J K} {G : C ⥤ D} (hG : compatible_preserving.{w} K G) (ℱ : SheafOfTypes.{w} K) {Z : C}
variables {T : presieve Z} {x : family_of_elements (G.op ⋙ ℱ.val) T} (h : x.compatible)

include h hG

/-- `compatible_preserving` functors indeed preserve compatible families. -/
lemma presieve.family_of_elements.compatible.functor_pushforward :
  (x.functor_pushforward G).compatible :=
begin
  rintros Z₁ Z₂ W g₁ g₂ f₁' f₂' H₁ H₂ eq,
  unfold family_of_elements.functor_pushforward,
  rcases get_functor_pushforward_structure H₁ with ⟨X₁, f₁, h₁, hf₁, rfl⟩,
  rcases get_functor_pushforward_structure H₂ with ⟨X₂, f₂, h₂, hf₂, rfl⟩,
  suffices : ℱ.val.map (g₁ ≫ h₁).op (x f₁ hf₁) = ℱ.val.map (g₂ ≫ h₂).op (x f₂ hf₂),
    simpa using this,
  apply hG.compatible ℱ h _ _ hf₁ hf₂,
  simpa using eq
end

@[simp] lemma compatible_preserving.apply_map {Y : C} {f : Y ⟶ Z} (hf : T f) :
  x.functor_pushforward G (G.map f) (image_mem_functor_pushforward G T hf) = x f hf :=
begin
  unfold family_of_elements.functor_pushforward,
  rcases e₁ : get_functor_pushforward_structure (image_mem_functor_pushforward G T hf) with
    ⟨X, g, f', hg, eq⟩,
  simpa using hG.compatible ℱ h f' (𝟙 _) hg hf (by simp[eq])
end

omit h hG

/--
If `G` is cover-preserving and compatible-preserving,
then `G.op ⋙ _` pulls sheaves back to sheaves.

This result is basically https://stacks.math.columbia.edu/tag/00WW.
-/
theorem pullback_is_sheaf_of_cover_preserving {G : C ⥤ D} (hG₁ : compatible_preserving.{v₃} K G)
  (hG₂ : cover_preserving J K G) (ℱ : Sheaf K A) :
  presheaf.is_sheaf J (G.op ⋙ ℱ.val) :=
begin
  intros X U S hS x hx,
  change family_of_elements (G.op ⋙ ℱ.val ⋙ coyoneda.obj (op X)) _ at x,
  let H := ℱ.2 X _ (hG₂.cover_preserve hS),
  let hx' := hx.functor_pushforward hG₁ (sheaf_over ℱ X),
  split, swap,
  { apply H.amalgamate (x.functor_pushforward G),
    exact hx' },
  split,
  { intros V f hf,
    convert H.is_amalgamation hx' (G.map f) (image_mem_functor_pushforward G S hf),
    rw hG₁.apply_map (sheaf_over ℱ X) hx },
  { intros y hy,
    refine H.is_separated_for _ y _ _
      (H.is_amalgamation (hx.functor_pushforward hG₁ (sheaf_over ℱ X))),
    rintros V f ⟨Z, f', g', h, rfl⟩,
    erw family_of_elements.comp_of_compatible (S.functor_pushforward G)
      hx' (image_mem_functor_pushforward G S h) g',
    dsimp at ⊢ hy,
    simp [hG₁.apply_map (sheaf_over ℱ X) hx h, ←hy f' h] }
end

/-- The pullback of a sheaf along a cover-preserving and compatible-preserving functor. -/
def pullback_sheaf {G : C ⥤ D} (hG₁ : compatible_preserving K G)
  (hG₂ : cover_preserving J K G) (ℱ : Sheaf K A) : Sheaf J A :=
⟨G.op ⋙ ℱ.val, pullback_is_sheaf_of_cover_preserving hG₁ hG₂ ℱ⟩

variable (A)

/--
The induced functor from `Sheaf K A ⥤ Sheaf J A` given by `G.op ⋙ _`
if `G` is cover-preserving and compatible-preserving.
-/
@[simps] def sites.pullback {G : C ⥤ D} (hG₁ : compatible_preserving K G)
  (hG₂ : cover_preserving J K G) : Sheaf K A ⥤ Sheaf J A :=
{ obj := λ ℱ, pullback_sheaf hG₁ hG₂ ℱ,
  map := λ _ _ f, (((whiskering_left _ _ _).obj G.op)).map f,
  map_id' := λ ℱ, (((whiskering_left _ _ _).obj G.op)).map_id ℱ.val,
  map_comp' := λ _ _ _ f g, (((whiskering_left _ _ _).obj G.op)).map_comp f g }

end category_theory


import local.dual_pair
import local.ample_set
import global.one_jet_sec
import global.smooth_embedding
set_option trace.filter_inst_type true

/-!
# First order partial differential relations for maps between manifolds

This file contains fundamental definitions about first order partial differential relations
for maps between manifolds and relating them to the local story of first order partial differential
relations for maps between vector spaces.

Given manifolds `M` and `M'` modelled on `I` and `I'`, a first order partial differential relation
for maps from `M` to `M'` is a set in the 1-jet bundle J¹(M, M'), also known as
`one_jet_bundle I M I' M'`.
-/

noncomputable theory

open set function filter (hiding map_smul) charted_space smooth_manifold_with_corners
open_locale topology manifold bundle

section defs
/-! ## Fundamental definitions -/

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]
{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]
{G : Type*} [topological_space G] (J : model_with_corners ℝ F G)
(N : Type*) [topological_space N] [charted_space G N] [smooth_manifold_with_corners J N]
{F' : Type*} [normed_add_comm_group F'] [normed_space ℝ F']
{G' : Type*} [topological_space G'] (J' : model_with_corners ℝ F' G')
(N' : Type*) [topological_space N'] [charted_space G' N'] [smooth_manifold_with_corners J' N']
{EP : Type*} [normed_add_comm_group EP] [normed_space ℝ EP]
{HP : Type*} [topological_space HP] (IP : model_with_corners ℝ EP HP)
(P : Type*) [topological_space P] [charted_space HP P] [smooth_manifold_with_corners IP P]
{EX : Type*} [normed_add_comm_group EX] [normed_space ℝ EX]
{HX : Type*} [topological_space HX] {IX : model_with_corners ℝ EX HX}
-- note: X is a metric space
{X : Type*} [metric_space X] [charted_space HX X] [smooth_manifold_with_corners IX X]

local notation `TM` := tangent_space I
local notation `TM'` := tangent_space I'

/-- A first-order differential relation for maps from `M` to `N` is a subset of the 1-jet bundle. -/
@[reducible] def rel_mfld := set (one_jet_bundle I M I' M')

variables {I M I' M'} {R : rel_mfld I M I' M'}

/-- A formal solution to a local relation `R` over a set `U`. -/
@[ext] structure formal_sol (R : rel_mfld I M I' M') extends
  to_one_jet_sec : one_jet_sec I M I' M' :=
(is_sol' : ∀ x : M, to_one_jet_sec x ∈ R)

instance (R : rel_mfld I M I' M') :
  has_coe_to_fun (formal_sol R) (λ S, M → one_jet_bundle I M I' M') :=
⟨λ F, F.to_one_jet_sec⟩

def mk_formal_sol (F : M → one_jet_bundle I M I' M') (hsec : ∀ x, (F x).1.1 = x)
(hsol : ∀ x, F x ∈ R)
(hsmooth : smooth I ((I.prod I').prod 𝓘(ℝ, E →L[ℝ] E')) F) : formal_sol R :=
{ bs := λ m, (F m).1.2,
  ϕ := λ m, (F m).2,
  smooth' := begin
    convert hsmooth,
    ext x,
    rw hsec,
    all_goals { refl }
  end,
  is_sol' := λ m, begin
    convert hsol m,
    refine one_jet_bundle.ext _ _ _,
    rw hsec,
    all_goals { refl }
    end}

@[simp]
lemma mk_formal_sol_apply (F : M → one_jet_bundle I M I' M') (hsec : ∀ x, (F x).1.1 = x)
(hsol : ∀ x, F x ∈ R)
(hsmooth : smooth I ((I.prod I').prod 𝓘(ℝ, E →L[ℝ] E')) ↿F)  :
  (mk_formal_sol F hsec hsol hsmooth : M → one_jet_bundle I M I' M') = F :=
begin
  ext x ; try { refl },
  rw hsec,
  refl
end

@[simp]
lemma mk_formal_sol_bs_apply (F : M → one_jet_bundle I M I' M') (hsec : ∀ x, (F x).1.1 = x)
(hsol : ∀ x, F x ∈ R)
(hsmooth : smooth I ((I.prod I').prod 𝓘(ℝ, E →L[ℝ] E')) ↿F)  (x : M) :
  (mk_formal_sol F hsec hsol hsmooth).bs x = (F x).1.2 :=
rfl

namespace formal_sol

@[simp]
lemma coe_mk {S : one_jet_sec I M I' M'} {h : ∀ x, S x ∈ R} {x : M} : formal_sol.mk S h x = S x :=
rfl

lemma coe_inj_iff {S T : formal_sol R} : S = T ↔ ∀ x, S x = T x :=
begin
  split,
  { rintro rfl x, refl },
  { intros h, ext : 3, show (S x).1.2 = (T x).1.2, rw [h],
    apply heq_of_eq, ext1, show (S x).2 = (T x).2, rw [h] }
end

lemma coe_inj {S T : formal_sol R} (h : ∀ x, S x = T x) : S = T :=
coe_inj_iff.mpr h

@[simp] lemma to_one_jet_sec_coe (S : formal_sol R) {x : M} : S.to_one_jet_sec x = S x := rfl

lemma is_sol (F : formal_sol R) : ∀ x, F x ∈ R :=
F.is_sol'

lemma coe_apply (F : formal_sol R) (x : M) : F x = ⟨(x, F.bs x), (F.ϕ x)⟩ := rfl
lemma fst_eq (F : formal_sol R) (x : M) : (F x).1 = (x, F.bs x) := rfl
lemma snd_eq (F : formal_sol R) (x : M) : (F x).2 = F.ϕ x := rfl
lemma is_sec (F : formal_sol R) (x : M) : (F x).1.1 = x := rfl
lemma bs_eq (F : formal_sol R) (x : M) : F.bs x = (F x).1.2 := rfl

end formal_sol

/-! ## Ampleness -/

/-- The slice `R(σ,p)`. -/
def rel_mfld.slice (R : rel_mfld I M I' M') (σ : one_jet_bundle I M I' M')
  (p : dual_pair $ TM σ.1.1) : set (TM' σ.1.2) :=
{w : TM' σ.1.2 | one_jet_bundle.mk σ.1.1 σ.1.2 (p.update σ.2 w) ∈ R}

/-- For some reason `rw [mem_set_of_eq]` fails after unfolding `slice`,
but rewriting with this lemma works. -/
lemma mem_slice {R : rel_mfld I M I' M'} {σ : one_jet_bundle I M I' M'}
  {p : dual_pair $ TM σ.1.1} {w : TM' σ.1.2} :
  w ∈ R.slice σ p ↔ one_jet_bundle.mk σ.1.1 σ.1.2 (p.update σ.2 w) ∈ R :=
iff.rfl

lemma slice_mk_update {R : rel_mfld I M I' M'} {σ : one_jet_bundle I M I' M'}
  {p : dual_pair $ TM σ.1.1} (x : E') :
  R.slice (one_jet_bundle.mk σ.1.1 σ.1.2 (p.update σ.2 x)) p = (R.slice σ p : set E') :=
begin
  ext1 w,
  dsimp only [mem_slice],
  congr' 3,
  simp_rw [one_jet_bundle_mk_snd, p.update_update],
end

/-- A differential relation is ample if all its slices are ample sets. -/
def rel_mfld.ample (R : rel_mfld I M I' M') : Prop :=
∀ ⦃σ : one_jet_bundle I M I' M'⦄ (p : dual_pair $ TM σ.1.1), ample_set (R.slice σ p)

lemma rel_mfld.ample_iff (R : rel_mfld I M I' M') : R.ample ↔
  ∀ ⦃σ : one_jet_bundle I M I' M'⦄ (p : dual_pair $ TM σ.1.1), σ ∈ R → ample_set (R.slice σ p) :=
begin
  simp_rw [rel_mfld.ample],
  refine ⟨λ h σ p _, h p, λ h σ p x hx, _⟩,
  have := @h (one_jet_bundle.mk σ.1.1 σ.1.2 (p.update σ.2 x)) p hx,
  rw [slice_mk_update] at this,
  exact this x hx
end

/-! ## Families of formal solutions. -/

/-- A family of formal solutions indexed by manifold `N` is a function from `N` into formal
  solutions in such a way that the function is smooth as a function of all arguments. -/
@[ext] structure family_formal_sol (R : rel_mfld I M I' M') extends
  to_family_one_jet_sec : family_one_jet_sec I M I' M' J N :=
(is_sol' : ∀ (t : N) (x : M), to_family_one_jet_sec t x ∈ R)

instance : has_coe_to_fun (family_formal_sol J N R) (λ S, N → formal_sol R) :=
⟨λ S t, ⟨S.to_family_one_jet_sec t, S.is_sol' t⟩⟩

namespace family_formal_sol

variables {J N J' N'}

@[simp]
lemma coe_mk {S : family_one_jet_sec I M I' M' J N} {h : ∀ t x, S t x ∈ R} {t : N} {x : M} :
  family_formal_sol.mk S h t x = S t x :=
rfl

lemma coe_mk_to_one_jet_sec {S : family_one_jet_sec I M I' M' J N} {h : ∀ t x, S t x ∈ R} {t : N} :
  (family_formal_sol.mk S h t).to_one_jet_sec = S t :=
rfl

lemma to_family_one_jet_sec_coe (S : family_formal_sol J N R) {t : N} {x : M} :
  S.to_family_one_jet_sec t x = S t x :=
rfl

@[simp]
lemma to_family_one_jet_sec_eq (S : family_formal_sol J N R) {t : N} :
  S.to_family_one_jet_sec t = (S t).to_one_jet_sec :=
rfl

lemma is_sol (S : family_formal_sol J N R) {t : N} {x : M} : S t x ∈ R :=
S.is_sol' t x

/-- Reindex a family along a smooth function `f`. -/
def reindex (S : family_formal_sol J' N' R) (f : C^∞⟮J, N; J', N'⟯) :
  family_formal_sol J N R :=
⟨S.to_family_one_jet_sec.reindex f, λ t, S.is_sol' (f t)⟩

end family_formal_sol

/-! ## Homotopies of formal solutions. -/

/-- A homotopy of formal solutions is a family indexed by `ℝ` -/
@[reducible] def htpy_formal_sol (R : rel_mfld I M I' M') := family_formal_sol 𝓘(ℝ, ℝ) ℝ R

def mk_htpy_formal_sol (F : ℝ → M → one_jet_bundle I M I' M') (hsec : ∀ t x, (F t x).1.1 = x)
(hsol : ∀ t x, F t x ∈ R)
(hsmooth : smooth (𝓘(ℝ).prod I) ((I.prod I').prod 𝓘(ℝ, E →L[ℝ] E')) ↿F) : htpy_formal_sol R :=
{ bs := λ t m, (F t m).1.2,
  ϕ := λ t m, (F t m).2,
  smooth' := begin
    convert hsmooth,
    ext ⟨t, x⟩,
    exact (hsec t x).symm,
    all_goals { refl }
  end,
  is_sol' := λ t m, begin
    convert hsol t m,
    refine  one_jet_bundle.ext _ _ _,
    rw hsec,
    all_goals { refl }
    end}

@[simp]
lemma mk_htpy_formal_sol_apply (F : ℝ → M → one_jet_bundle I M I' M') (hsec : ∀ t x, (F t x).1.1 = x)
(hsol : ∀ t x, F t x ∈ R)
(hsmooth : smooth (𝓘(ℝ).prod I) ((I.prod I').prod 𝓘(ℝ, E →L[ℝ] E')) ↿F) (t : ℝ) :
  (mk_htpy_formal_sol F hsec hsol hsmooth t : M → one_jet_bundle I M I' M') = F t :=
begin
  ext x ; try { refl },
  rw hsec,
  refl
end

/-- The constant homotopy of formal solution associated to a formal solution. -/
def formal_sol.const_htpy (F : formal_sol R) : htpy_formal_sol R :=
{ bs := λ t, F.bs,
  ϕ := λ t, F.ϕ,
  smooth' := F.smooth.comp smooth_snd,
  is_sol' := λ t, F.is_sol }

variable (R)

/-- The empty homotopy of formal solution associated to any relation whose source manifold
is empty. This is required to avoid a silly nonemptyness assumption in the main theorems. -/
def empty_htpy_formal_sol [is_empty M] : htpy_formal_sol R :=
{ bs := λ t x, (is_empty.false x).elim,
  ϕ :=  λ t x, (is_empty.false x).elim,
  smooth' := λ ⟨t, x⟩, (is_empty.false x).elim,
  is_sol' := λ t x, (is_empty.false x).elim }

/-! ## The h-principle -/

variables {P}

/-- A relation `R` satisfies the (non-parametric) relative C⁰-dense h-principle w.r.t. a subset
`C` of the domain if for every formal solution `𝓕₀` that is holonomic near `C`
there is a homotopy between `𝓕₀` and a holonomic solution that is constant near `C` and
`ε`-close to `𝓕₀`. This is a temporary version with a slightly weaker conclusion.
The weak version has `∀ x ∈ C, ∀ t : ℝ, 𝓕 t x = 𝓕₀ x` while the strong one has
`∀ᶠ x near C, ∀ t, 𝓕 t x = 𝓕₀ x`. The strong version is easy to derive from the weak one
if we prove the weak one for *all* closed sets, see `rel_mfld.satisfies_h_principle_of_weak`
below. The reason why the weak one is more convenient for us is we will prove
the h-principle using a sequence of homotopy of formal solutions and we don't
want to keep control of a fixed neighborhood of `C` independant from the sequence index. -/
def rel_mfld.satisfies_h_principle_weak (R : rel_mfld I M IX X) (C : set M) (ε : M → ℝ) : Prop :=
∀ 𝓕₀ : formal_sol R, (∀ᶠ x in 𝓝ˢ C, 𝓕₀.to_one_jet_sec.is_holonomic_at x) →
∃ 𝓕 : htpy_formal_sol R, (∀ x : M, 𝓕 0 x = 𝓕₀ x) ∧
  (𝓕 1).to_one_jet_sec.is_holonomic ∧
  (∀ x ∈ C, ∀ t : ℝ, 𝓕 t x = 𝓕₀ x) ∧
  (∀ (t : ℝ) (x : M), dist ((𝓕 t).bs x) (𝓕₀.bs x) ≤ ε x)

/-- A relation `R` satisfies the (non-parametric) relative C⁰-dense h-principle w.r.t. a subset
`C` of the domain if for every formal solution `𝓕₀` that is holonomic near `C`
there is a homotopy between `𝓕₀` and a holonomic solution that is constant near `C` and
`ε`-close to `𝓕₀`. -/
def rel_mfld.satisfies_h_principle (R : rel_mfld I M IX X) (C : set M) (ε : M → ℝ) : Prop :=
∀ 𝓕₀ : formal_sol R, (∀ᶠ x in 𝓝ˢ C, 𝓕₀.to_one_jet_sec.is_holonomic_at x) →
∃ 𝓕 : htpy_formal_sol R, (∀ x : M, 𝓕 0 x = 𝓕₀ x) ∧
  (𝓕 1).to_one_jet_sec.is_holonomic ∧
  (∀ᶠ x near C, ∀ t, 𝓕 t x = 𝓕₀ x) ∧
  (∀ (t : ℝ) (x : M), dist ((𝓕 t).bs x) (𝓕₀.bs x) ≤ ε x)

lemma rel_mfld.satisfies_h_principle_of_weak
  [finite_dimensional ℝ E] [t2_space M] [sigma_compact_space M]
  {R : rel_mfld I M IX X} {ε : M → ℝ} {C : set M} (hC : is_closed C)
  (h : ∀ A : set M, is_closed A → R.satisfies_h_principle_weak A ε) : R.satisfies_h_principle C ε :=
begin
  haveI := manifold_with_corners.metrizable_space I M,
  letI : metric_space M := topological_space.metrizable_space_metric M,
  intros 𝓕₀ h𝓕₀,
  obtain ⟨C', hCC', hC', h𝓕₀C'⟩ := h𝓕₀.closed_neighborhood hC,
  obtain ⟨𝓕, h1, h2, h3, h4⟩ := h C' hC' 𝓕₀ h𝓕₀C',
  exact ⟨𝓕, h1, h2, eventually_of_mem hCC' h3, h4⟩
end

/-- A relation `R` satisfies the parametric relative C⁰-dense h-principle w.r.t. manifold `P`,
`C ⊆ P × M` and `ε : M → ℝ` if for every family of
formal solutions `𝓕₀` indexed by a manifold with boundary `P` that is holonomic near `C`,
there is a homotopy `𝓕` between `𝓕₀` and a holonomic solution,
in such a way that `𝓕` is constant near `C` and `ε`-close to `𝓕₀`.
-/
def rel_mfld.satisfies_h_principle_with (R : rel_mfld I M IX X) (C : set (P × M)) (ε : M → ℝ) :
  Prop :=
∀ 𝓕₀ : family_formal_sol IP P R, -- given a family of formal solutions with parameters in `P`
(∀ᶠ (p : P × M) in 𝓝ˢ C, (𝓕₀ p.1).to_one_jet_sec.is_holonomic_at p.2) → -- holonomic near `C`
∃ 𝓕 : family_formal_sol (𝓘(ℝ, ℝ).prod IP) (ℝ × P) R, -- then there is a homotopy of such families
  (∀ (s : P) (x : M), 𝓕 (0, s) x = 𝓕₀ s x) ∧ -- that agrees on `t = 0`
  (∀ (s : P), (𝓕 (1, s)).to_one_jet_sec.is_holonomic) ∧ -- is holonomic everywhere for `t = 1`
  (∀ᶠ (p : P × M) in 𝓝ˢ C, ∀ t : ℝ, 𝓕 (t, p.1) p.2 = 𝓕₀ p.1 p.2) ∧ -- and agrees near `C`
  (∀ (t : ℝ) (s : P) (x : M), dist ((𝓕 (t, s)).bs x) ((𝓕₀ s).bs x) ≤ ε x) -- and close to `𝓕₀`.

variables {IP}

/-- If a relation satisfies the parametric relative C⁰-dense h-principle wrt some data
then we can forget the homotopy and get a family of solutions from every
family of formal solutions. -/
lemma rel_mfld.satisfies_h_principle_with.bs {R : rel_mfld I M IX X} {C : set (P × M)}
  {ε : M → ℝ} (h : R.satisfies_h_principle_with IP C ε) (𝓕₀ : family_formal_sol IP P R)
  (h2 : ∀ᶠ (p : P × M) in 𝓝ˢ C, (𝓕₀ p.1).to_one_jet_sec.is_holonomic_at p.2) :
  ∃ f : P → M → X,
    (smooth (IP.prod I) IX $ uncurry f) ∧
    (∀ᶠ (p : P × M) in 𝓝ˢ C, f p.1 p.2 = 𝓕₀.bs p.1 p.2) ∧
    (∀ p m, dist (f p m) ((𝓕₀ p).bs m) ≤ ε m) ∧
    (∀ p m, one_jet_ext I IX (f p) m ∈ R) :=
begin
  rcases h 𝓕₀ h2  with ⟨𝓕, h₁, h₂, h₃, h₄⟩,
  refine ⟨λ s, (𝓕 (1, s)).bs, _, _, _, _⟩,
  { have := 𝓕.to_family_one_jet_sec.smooth,
    let j : C^∞⟮IP, P ; 𝓘(ℝ, ℝ).prod IP, ℝ × P⟯ := ⟨λ p, (1, p),
                                                    smooth.prod_mk smooth_const smooth_id⟩,
    rw show uncurry (λ s, (𝓕 (1, s)).bs) = prod.snd ∘ π (one_jet_space I IX) ∘
                                            (λ (p : P × M), 𝓕.reindex j p.1 p.2),
    by { ext, refl },
    exact (𝓕.reindex j).to_family_one_jet_sec.smooth_bs },
  { apply h₃.mono,
    intros x hx,
    simp_rw [one_jet_sec.bs_eq, formal_sol.to_one_jet_sec_coe, hx, family_one_jet_sec.bs_eq,
      𝓕₀.to_family_one_jet_sec_coe] },
  { intros p m,
    apply h₄ },
  { intros p m,
    suffices : one_jet_ext I IX (𝓕 (1, p)).bs m = ((𝓕.to_family_one_jet_sec) (1, p)) m,
    { rw this,
      exact 𝓕.is_sol' (1, p) m },
    exact one_jet_sec.is_holonomic_at_iff.mp (h₂ p m) },
end

end defs

section open_smooth_embedding
/-! ## Localisation of one jet sections

In order to use the local story of convex integration, we need a way to turn a
one jet section into local ones, then apply the local story to build a homotopy of one jets section
and transfer back to the original manifolds. There is a dissymetry here: we use
maps from whole vector spaces to open sets in manifold.

The global manifolds are called `M` and `N'`. We don't assume the local ones are vector spaces,
there are manifolds `X` and `Y` that will be vector spaces in the next section.
-/
variables
  {EX : Type*} [normed_add_comm_group EX] [normed_space ℝ EX]
  {HX : Type*} [topological_space HX] {IX : model_with_corners ℝ EX HX}
  {X : Type*} [topological_space X] [charted_space HX X] [smooth_manifold_with_corners IX X]

  {EM : Type*} [normed_add_comm_group EM] [normed_space ℝ EM]
  {HM : Type*} [topological_space HM] {IM : model_with_corners ℝ EM HM}
  {M : Type*} [topological_space M] [charted_space HM M] [smooth_manifold_with_corners IM M]

  {EY : Type*} [normed_add_comm_group EY] [normed_space ℝ EY]
  {HY : Type*} [topological_space HY] {IY : model_with_corners ℝ EY HY}
  {Y : Type*} [topological_space Y] [charted_space HY Y] [smooth_manifold_with_corners IY Y]

  {EN : Type*} [normed_add_comm_group EN] [normed_space ℝ EN]
  {HN : Type*} [topological_space HN] {IN : model_with_corners ℝ EN HN}
  {N : Type*} [topological_space N] [charted_space HN N] [smooth_manifold_with_corners IN N]

  (F : one_jet_sec IM M IN N)
  (φ : open_smooth_embedding IX X IM M) (ψ : open_smooth_embedding IY Y IN N)
  {R : rel_mfld IM M IN N}

local notation `TM` := tangent_space IM
local notation `TN` := tangent_space IN
local notation `TX` := tangent_space IX
local notation `TY` := tangent_space IY

local notation `J¹XY` := one_jet_bundle IX X IY Y
local notation `J¹MN` := one_jet_bundle IM M IN N
local notation `IXY` := (IX.prod IY).prod 𝓘(ℝ, EX →L[ℝ] EY)
local notation `IMN` := (IM.prod IN).prod 𝓘(ℝ, EM →L[ℝ] EN)

/-! ## Transfer from J¹(X, Y) to J¹(M, N) and localized relations -/

/-- Transfer map between one jet bundles induced by open smooth embedding into the source and
targets. -/
@[simps fst_fst fst_snd]
def open_smooth_embedding.transfer : one_jet_bundle IX X IY Y → one_jet_bundle IM M IN N :=
one_jet_bundle.map IY IN φ ψ (λ x, (φ.fderiv x).symm)

lemma open_smooth_embedding.smooth_transfer :
  smooth ((IX.prod IY).prod 𝓘(ℝ, EX →L[ℝ] EY))
  ((IM.prod IN).prod 𝓘(ℝ, EM →L[ℝ] EN)) (φ.transfer ψ) :=
begin
  intro x,
  refine smooth_at.one_jet_bundle_map (φ.smooth_to.smooth_at.comp _ smooth_at_snd)
    (ψ.smooth_to.smooth_at.comp _ smooth_at_snd) _ smooth_at_id,
  have := cont_mdiff_at.mfderiv''' (λ x, φ.inv_fun) (λ x : one_jet_bundle IX X IY Y, φ x.1.1)
    ((φ.smooth_at_inv $ _).comp (x, φ x.1.1) smooth_at_snd)
    (φ.smooth_to.smooth_at.comp x (smooth_one_jet_bundle_proj.fst x)) le_top,
  { simp_rw [φ.left_inv] at this, exact this },
  exact mem_range_self _,
end

lemma one_jet_bundle.continuous_transfer : continuous (φ.transfer ψ) :=
(open_smooth_embedding.smooth_transfer _ _).continuous

lemma open_smooth_embedding.range_transfer : range (φ.transfer ψ) =
  π (one_jet_space IM IN) ⁻¹' (range φ ×ˢ range ψ) :=
begin
  ext σ, split,
  { rintro ⟨σ, rfl⟩, exact mk_mem_prod (mem_range_self _) (mem_range_self _) },
  { rcases σ with ⟨⟨x, y⟩, τ⟩,
    rintro ⟨⟨x, rfl⟩ : x ∈ range φ, ⟨y, rfl⟩ : y ∈ range ψ⟩,
    refine ⟨⟨(x, y), ((ψ.fderiv y).symm : tangent_space IN (ψ y) →L[ℝ] tangent_space IY y) ∘L τ ∘L
      (φ.fderiv x : tangent_space IX x →L[ℝ] tangent_space IM (φ x))⟩, _⟩,
    ext _, { refl }, { refl },
    ext1 v,
    dsimp only [open_smooth_embedding.transfer, one_jet_bundle.map, one_jet_bundle.mk],
    simp_rw [continuous_linear_map.comp_apply, ← ψ.fderiv_coe, continuous_linear_equiv.coe_coe,
      (φ.fderiv x).apply_symm_apply, (ψ.fderiv y).apply_symm_apply] }
end

lemma open_smooth_embedding.is_open_range_transfer : is_open (range (φ.transfer ψ)) :=
begin
  rw [φ.range_transfer ψ],
  exact (φ.is_open_range.prod ψ.is_open_range).preimage one_jet_bundle_proj_continuous,
end

/-- localize a relation -/
def rel_mfld.localize (R : rel_mfld IM M IN N) : rel_mfld IX X IY Y :=
φ.transfer ψ ⁻¹' R

/-- Ampleness survives localization -/
lemma rel_mfld.ample.localize (hR : R.ample) : (R.localize φ ψ).ample :=
begin
  intros x p,
  have : (rel_mfld.localize φ ψ R).slice x p =
    (ψ.fderiv x.1.2).symm '' R.slice (φ.transfer ψ x) (p.map (φ.fderiv x.1.1)),
  { ext v,
    simp_rw [rel_mfld.localize, continuous_linear_equiv.image_symm_eq_preimage, mem_preimage,
      mem_slice, mem_preimage],
    dsimp only [open_smooth_embedding.transfer, one_jet_bundle.map, one_jet_bundle_mk_fst,
      one_jet_bundle_mk_snd],
    simp_rw [p.map_update_comp_right, ← p.update_comp_left, one_jet_bundle.mk, ← ψ.fderiv_coe,
      continuous_linear_equiv.coe_coe] },
  rw [this],
  exact (hR _).image (ψ.fderiv x.1.2).symm
end

/-! ## Localized 1-jet sections -/

/-- Localize a one-jet section in two open embeddings.
  It maps `x` to `(x, y, (D_y(g))⁻¹ ∘ F_φ(φ x) ∘ D_x(φ))` where `y : M := g⁻¹(F_{bs}(φ x))`. -/
@[simps] def one_jet_sec.localize (hF : range (F.bs ∘ φ) ⊆ range ψ) :
  one_jet_sec IX X IY Y :=
{ bs := λ x, ψ.inv_fun (F.bs $ φ x),
  ϕ := λ x, let y := ψ.inv_fun (F.bs $ φ x) in
  (↑(ψ.fderiv y).symm : TN (ψ y) →L[ℝ] TY y) ∘L ((F $ φ x).2 ∘L (φ.fderiv x : TX x →L[ℝ] TM (φ x))),
  smooth' := begin
    simp_rw [φ.fderiv_coe, ψ.fderiv_symm_coe,
      mfderiv_congr_point (ψ.right_inv (hF $ mem_range_self _))],
    refine smooth.one_jet_comp IN (λ x', F.bs (φ x')) _ _,
    { exact λ x, (ψ.smooth_at_inv $ hF $ mem_range_self x).one_jet_ext.comp _
        (F.smooth_bs.comp φ.smooth_to).cont_mdiff_at },
    apply smooth.one_jet_comp IM φ (F.smooth_eta.comp φ.smooth_to) φ.smooth_to.one_jet_ext
  end }

lemma transfer_localize (hF : range (F.bs ∘ φ) ⊆ range ψ) (x : X) :
  φ.transfer ψ (F.localize φ ψ hF x) = F (φ x) :=
begin
  rw [one_jet_sec.coe_apply, one_jet_sec.localize_bs, one_jet_sec.localize_ϕ,
    open_smooth_embedding.transfer, one_jet_bundle.map],
  dsimp only [one_jet_bundle.mk],
  ext,
  { refl },
  { simp_rw [ψ.right_inv (hF $ mem_range_self x), function.comp_apply, F.bs_eq] },
  { simp_rw [← ψ.fderiv_coe, continuous_linear_map.comp_apply, continuous_linear_equiv.coe_coe,
      continuous_linear_equiv.apply_symm_apply] },
end

lemma one_jet_sec.localize_bs_fun (hF : range (F.bs ∘ φ) ⊆ range ψ) :
  (F.localize φ ψ hF).bs = ψ.inv_fun ∘ F.bs ∘ φ :=
rfl

lemma one_jet_sec.localize_mem_iff (hF : range (F.bs ∘ φ) ⊆ range ψ) {x : X} :
  F.localize φ ψ hF x ∈ R.localize φ ψ ↔ F (φ x) ∈ R :=
by rw [rel_mfld.localize, mem_preimage, transfer_localize F φ ψ hF]

lemma is_holonomic_at_localize_iff (hF : range (F.bs ∘ φ) ⊆ range ψ) (x : X) :
  (F.localize φ ψ hF).is_holonomic_at x ↔ F.is_holonomic_at (φ x)  :=
begin
  have : mfderiv IX IY (ψ.inv_fun ∘ F.bs ∘ φ) x =
    (ψ.fderiv (ψ.inv_fun (F.bs (φ x)))).symm.to_continuous_linear_map.comp
    ((mfderiv IM IN F.bs (φ x)).comp (φ.fderiv x).to_continuous_linear_map),
  { have h1 : mdifferentiable_at IN IY ψ.inv_fun (F.bs (φ x)) :=
      (ψ.smooth_at_inv $ hF $ mem_range_self _).mdifferentiable_at,
    have h2 : mdifferentiable_at IM IN F.bs (φ x) := F.smooth_bs.mdifferentiable_at,
    have h3 : mdifferentiable_at IX IM φ x := φ.smooth_to.mdifferentiable_at,
    rw [mfderiv_comp x h1 (h2.comp x h3), mfderiv_comp x h2 h3,
      ← ψ.fderiv_symm_coe' (hF $ mem_range_self _)],
    refl, },
  simp_rw [one_jet_sec.is_holonomic_at],
  rw [mfderiv_congr (F.localize_bs_fun φ ψ hF), one_jet_sec.snd_eq, F.localize_ϕ, this],
  simp_rw [continuous_linear_equiv.coe_def_rev,
    continuous_linear_equiv.cancel_left, continuous_linear_equiv.cancel_right]
end

/-! ## From embeddings `X ↪ M` and `Y ↪ N` to `J¹(X, Y) ↪ J¹(M, N)` -/

-- very slow to elaborate :-(
@[simps]
def one_jet_bundle.embedding : open_smooth_embedding IXY J¹XY IMN J¹MN :=
{ to_fun := φ.transfer ψ,
  inv_fun := one_jet_bundle.map IN IY φ.inv_fun ψ.inv_fun
    (λ x, (φ.fderiv $ φ.inv_fun x : TX (φ.inv_fun x) →L[ℝ] TM (φ $ φ.inv_fun x))),
  left_inv' := λ σ, begin
    rw [open_smooth_embedding.transfer, one_jet_bundle.map_map
      ψ.smooth_at_inv'.mdifferentiable_at ψ.smooth_to.smooth_at.mdifferentiable_at],
    conv_rhs { rw [← one_jet_bundle.map_id σ] },
    congr' 1,
    { rw [open_smooth_embedding.inv_fun_comp_coe] },
    { rw [open_smooth_embedding.inv_fun_comp_coe] },
    { ext x v, simp_rw [continuous_linear_map.comp_apply],
      convert (φ.fderiv x).symm_apply_apply v,
      simp_rw [φ.left_inv] }
  end,
  is_open_range := φ.is_open_range_transfer ψ,
  smooth_to := φ.smooth_transfer ψ,
  smooth_inv := begin
    rintro _ ⟨x, rfl⟩,
    refine (smooth_at.one_jet_bundle_map _ _ _ smooth_at_id).smooth_within_at,
    { refine ((φ.smooth_at_inv _).comp _ smooth_at_snd), exact mem_range_self _ },
    { refine ((ψ.smooth_at_inv _).comp _ smooth_at_snd), exact mem_range_self _ },
    have := cont_mdiff_at.mfderiv''' (λ x, φ) (λ x : one_jet_bundle IM M IN N, φ.inv_fun x.1.1)
      (φ.smooth_to.smooth_at.comp _ smooth_at_snd)
      ((φ.smooth_at_inv _).comp _ (smooth_one_jet_bundle_proj.fst (φ.transfer ψ x))) le_top,
    { dsimp only [id],
      simp_rw [φ.left_inv] at this,
      refine this.congr_of_eventually_eq _,
      refine filter.eventually_of_mem ((φ.is_open_range_transfer ψ).mem_nhds (mem_range_self _)) _,
      rw [φ.range_transfer ψ],
      rintro ⟨⟨x, y⟩, τ⟩ ⟨⟨x, rfl⟩ : x ∈ range φ, ⟨y, rfl⟩ : y ∈ range ψ⟩,
      simp_rw [in_coordinates_core, φ.transfer_fst_fst, φ.left_inv],
      refl },
    exact mem_range_self _,
  end }

/-! ## Updating 1-jet sections and formal solutions -/

local notation `JΘ` := φ.update (one_jet_bundle.embedding φ ψ)

variables {K : set X}

namespace open_smooth_embedding

lemma Jupdate_aux (F : one_jet_sec IM M IN N) (G : one_jet_sec IX X IY Y)
  (m : M) : (JΘ F G m).1.1 = m :=
begin
  simp_rw [open_smooth_embedding.update], split_ifs,
  { rcases h with ⟨x, rfl⟩,
    simp_rw [one_jet_bundle.embedding_to_fun, φ.transfer_fst_fst, φ.left_inv, G.fst_eq] },
  { refl }
end

variables [t2_space M]

/-- Update a global homotopy of 1-jet-sections `F` using a local one `G`. -/
def Jupdate
  (F : one_jet_sec IM M IN N) (G : htpy_one_jet_sec IX X IY Y)
  (hK : is_compact K)
  (hFG : ∀ t, ∀ x ∉ K, F (φ x) = (one_jet_bundle.embedding φ ψ) (G t x)) :
  htpy_one_jet_sec IM M IN N :=
begin
  refine family_one_jet_sec.mk' (λ t, JΘ F (G t)) (λ t, (φ.Jupdate_aux ψ F (G t))) _,
  refine φ.smooth_update _ _ _ (hK.image φ.continuous).is_closed _ _ smooth_snd (λ x, hFG x.1),
  { exact F.smooth.comp smooth_snd },
  { exact G.smooth.comp (smooth_fst.prod_map smooth_id) },
end

lemma Jupdate_apply {F : one_jet_sec IM M IN N} {G : htpy_one_jet_sec IX X IY Y}
  (hK : is_compact K)
  (hFG : ∀ t, ∀ x ∉ K, F (φ x) = (one_jet_bundle.embedding φ ψ) (G t x)) (t : ℝ) (m : M) :
  φ.Jupdate ψ F G hK hFG t m = JΘ F (G t) m :=
by { ext, exact (φ.Jupdate_aux ψ F (G t) m).symm, refl, refl }

lemma Jupdate_bs (F : one_jet_sec IM M IN N)
  (G : htpy_one_jet_sec IX X IY Y) (t : ℝ)
  (hK : is_compact K) (hFG : ∀ t, ∀ x ∉ K, F (φ x) = one_jet_bundle.embedding φ ψ (G t x)) :
  (open_smooth_embedding.Jupdate φ ψ F G hK hFG t).bs =
  open_smooth_embedding.update φ ψ F.bs (G t).bs :=
begin
  classical,
  ext x,
  change (if x ∈ range φ then φ.transfer ψ (G t (φ.inv_fun x)) else F x).1.2 =
    if x ∈ range φ then _ else _,
  split_ifs ; refl,
end

lemma Jupdate_localize {F : one_jet_sec IM M IN N} {G : htpy_one_jet_sec IX X IY Y}
  (hK : is_compact K)
  (hFG : ∀ t, ∀ x ∉ K, F (φ x) = (one_jet_bundle.embedding φ ψ) (G t x)) (t : ℝ)
  (rg : range ((φ.Jupdate ψ F G hK hFG t).bs ∘ φ) ⊆ range ψ) (x : X) :
  (φ.Jupdate ψ F G hK hFG t).localize φ ψ rg x = G t x :=
begin
  have foo : ψ.inv_fun ((φ.Jupdate ψ F G hK hFG t).bs (φ x)) = (G t).bs x,
  { simp_rw [Jupdate_bs, open_smooth_embedding.update_apply_embedding,
    open_smooth_embedding.left_inv] },
  ext,
  refl,
  { exact foo },
  { simp_rw [one_jet_sec.snd_eq, one_jet_sec.localize_ϕ],
    rw [foo],
    change (ψ.fderiv ((G t).bs x)).symm ((JΘ F (G t) (φ x)).2 (φ.fderiv x x_1)) =
      ((G t).ϕ x) x_1,
    rw φ.update_apply_embedding,
    change (ψ.fderiv ((G t).bs x)).symm (ψ.fderiv ((G t).bs x) $ (G t).ϕ x $
      (φ.fderiv x).symm $ φ.fderiv x x_1) = ((G t).ϕ x x_1),
    simp_rw [continuous_linear_equiv.symm_apply_apply] },
end

/-- Update a global formal solutions `F` using a homotopy of local ones `G`. -/
def update_formal_sol (F : formal_sol R)
  (G : htpy_formal_sol (R.localize φ ψ))
  (hK : is_compact K) (hFG : ∀ t, ∀ x ∉ K, F (φ x) = (one_jet_bundle.embedding φ ψ) (G t x)) :
  htpy_formal_sol R :=
{ to_family_one_jet_sec := φ.Jupdate ψ F.to_one_jet_sec G.to_family_one_jet_sec hK hFG,
  is_sol' := λ t x, begin
    simp_rw [Jupdate_apply, open_smooth_embedding.update, one_jet_bundle.embedding_to_fun],
    split_ifs,
    { exact G.is_sol },
    { exact F.is_sol x }
  end }

lemma update_formal_sol_apply {F : formal_sol R}
  {G : htpy_formal_sol (R.localize φ ψ)}
  (hK : is_compact K)
  (hFG : ∀ t, ∀ x ∉ K, F (φ x) = (one_jet_bundle.embedding φ ψ) (G t x)) (t x) :
  φ.update_formal_sol ψ F G hK hFG t x = ⟨⟨x, (JΘ F (G t) x).1.2⟩, (JΘ F (G t) x).2⟩ :=
rfl

lemma update_formal_sol_bs' {F : formal_sol R}
  {G : htpy_formal_sol (R.localize φ ψ)}
  (hK : is_compact K)
  (hFG : ∀ t, ∀ x ∉ K, F (φ x) = (one_jet_bundle.embedding φ ψ) (G t x)) (t) :
(φ.update_formal_sol ψ F G hK hFG t).bs = λ x, (JΘ F (G t) x).1.2 :=
rfl

lemma update_formal_sol_bs {F : formal_sol R}
  {G : htpy_formal_sol (R.localize φ ψ)}
  (hK : is_compact K)
  (hFG : ∀ t, ∀ x ∉ K, F (φ x) = (one_jet_bundle.embedding φ ψ) (G t x)) (t) :
(φ.update_formal_sol ψ F G hK hFG t).bs = φ.update ψ F.bs (G t).bs :=
begin
  rw update_formal_sol_bs',
  ext x,
  by_cases hx : x ∈ range φ,
  { simp only [hx, update_of_mem_range, one_jet_bundle.embedding_to_fun, transfer_fst_snd],
    refl },
  { rw [update_of_nmem_range, update_of_nmem_range],
    refl,
    exacts [hx, hx] },
end

@[simp]
lemma update_formal_sol_apply_of_mem {F : formal_sol R}
  {G : htpy_formal_sol (R.localize φ ψ)}
  (hK : is_compact K) (hFG : ∀ t, ∀ x ∉ K, F (φ x) = (one_jet_bundle.embedding φ ψ) (G t x)) (t)
  {m} (hx : m ∈ range φ) :
  φ.update_formal_sol ψ F G hK hFG t m = φ.transfer ψ (G t $ φ.inv_fun m) :=
begin
  rw [update_formal_sol_apply, φ.update_of_mem_range _ _ _ hx],
  ext,
  { change m = φ (φ.inv_fun m),
    rw φ.right_inv hx },
  refl,
  refl
end

@[simp]
lemma update_formal_sol_apply_image {F : formal_sol R}
  {G : htpy_formal_sol (R.localize φ ψ)}
  (hK : is_compact K) (hFG : ∀ t, ∀ x ∉ K, F (φ x) = (one_jet_bundle.embedding φ ψ) (G t x)) (t)
  {x} :
φ.update_formal_sol ψ F G hK hFG t (φ x) = φ.transfer ψ (G t x) :=
begin
 rw [open_smooth_embedding.update_formal_sol_apply_of_mem, φ.left_inv],
 exact mem_range_self x,
end

end open_smooth_embedding
end open_smooth_embedding


import classes.context_free.basics.toolbox
import utilities.language_operations

variables {T₁ T₂ N : Type}

private def sT₂_of_sT₁ (π : equiv T₁ T₂) : (symbol T₁ N) → (symbol T₂ N)
| (symbol.terminal t) := symbol.terminal (π.to_fun t)
| (symbol.nonterminal n) := symbol.nonterminal n

private def sT₁_of_sT₂ (π : equiv T₁ T₂) : (symbol T₂ N) → (symbol T₁ N)
| (symbol.terminal t) := symbol.terminal (π.inv_fun t)
| (symbol.nonterminal n) := symbol.nonterminal n

private def lsT₂_of_lsT₁ (π : equiv T₁ T₂) : list (symbol T₁ N) → list (symbol T₂ N) :=
list.map (sT₂_of_sT₁ π)

private def lsT₁_of_lsT₂ (π : equiv T₁ T₂) : list (symbol T₂ N) → list (symbol T₁ N) :=
list.map (sT₁_of_sT₂ π)

/-- The class of context-free languages is closed under bijection between terminal alphabets. -/
theorem CF_of_bijemap_CF (π : equiv T₁ T₂) (L : language T₁) :
  is_CF L  →  is_CF (bijemap_lang L π)  :=
begin
  rintro ⟨g, hg⟩,

  let g' : CF_grammar T₂ := CF_grammar.mk g.nt g.initial (list.map (
      λ r : g.nt × (list (symbol T₁ g.nt)), (r.fst, lsT₂_of_lsT₁ π r.snd)
    ) g.rules),
  use g',

  apply set.eq_of_subset_of_subset,
  {
    intros w hw,
    unfold bijemap_lang,
    change list.map π.inv_fun w ∈ L,
    rw ←hg,

    unfold CF_language at hw ⊢,
    rw set.mem_set_of_eq at hw ⊢,
    unfold CF_generates at hw ⊢,
    unfold CF_generates_str at hw ⊢,

    have deri_of_deri :
      ∀ v : list (symbol T₂ g'.nt),
        CF_derives g' [symbol.nonterminal g'.initial] v →
          CF_derives g [symbol.nonterminal g.initial] (lsT₁_of_lsT₂ π v),
    {
      intros v hv,
      induction hv with u v trash orig ih,
      {
        apply CF_deri_self,
      },
      apply CF_deri_of_deri_tran,
      {
        exact ih,
      },
      rcases orig with ⟨r, r_in, x, y, bef, aft⟩,
      let r₁ := (r.fst, lsT₁_of_lsT₂ π r.snd),
      let x₁ := lsT₁_of_lsT₂ π x,
      let y₁ := lsT₁_of_lsT₂ π y,
      use r₁,
      split,
      {
        change (r.fst, lsT₁_of_lsT₂ π r.snd) ∈ g.rules,
        rw [list.mem_map, prod.exists] at r_in,
        rcases r_in with ⟨a, b, ab_in, ab_eq⟩,
        have a_eq : a = r.fst :=
          (congr_arg prod.fst ab_eq).congr_right.mp rfl,
        have b_eq : lsT₂_of_lsT₁ π b = r.snd :=
          (congr_arg prod.snd ab_eq).congr_right.mp rfl,
        rw a_eq at ab_in,
        convert ab_in,
        rw ←b_eq,
        unfold lsT₁_of_lsT₂,
        unfold lsT₂_of_lsT₁,
        rw list.map_map,
        ext1,
        rw list.nth_map,
        cases (b.nth n),
        {
          -- none = none
          refl,
        },
        cases val, swap,
        {
          -- nonterminal = nonterminal
          refl,
        },
        {
          -- (sT₁_of_sT₂ π ∘ sT₂_of_sT₁ π) terminal = terminal
          simp [sT₂_of_sT₁, sT₁_of_sT₂, equiv.left_inv],
        }
      },
      use x₁,
      use y₁,
      split,
      {
        rw bef,
        unfold lsT₁_of_lsT₂,
        rw list.map_append,
        rw list.map_append,
        refl,
      },
      {
        rw aft,
        unfold lsT₁_of_lsT₂,
        rw list.map_append,
        rw list.map_append,
        refl,
      },
    },
    specialize deri_of_deri (list.map symbol.terminal w) hw,
    unfold lsT₁_of_lsT₂ at deri_of_deri,
    rw list.map_map at *,
    convert deri_of_deri,
  },
  {
    intros w hw,
    unfold bijemap_lang at hw,
    change list.map π.inv_fun w ∈ L at hw,
    rw ←hg at hw,
    unfold CF_language at hw,
    rw set.mem_set_of_eq at hw,
    unfold CF_generates at hw,
    rw list.map_map at hw,
    unfold CF_generates_str at hw,

    unfold CF_language,
    change CF_generates_str g' (list.map symbol.terminal w),
    unfold CF_generates_str,

    have deri_of_deri :
      ∀ v : list (symbol T₁ g.nt),
        CF_derives g [symbol.nonterminal g.initial] v →
          CF_derives g' [symbol.nonterminal g'.initial] (lsT₂_of_lsT₁ π v),
    {
      intros v hv,
      induction hv with u v trash orig ih,
      {
        apply CF_deri_self,
      },
      apply CF_deri_of_deri_tran,
      {
        exact ih,
      },
      rcases orig with ⟨r, r_in, x, y, bef, aft⟩,
      let r₂ := (r.fst, lsT₂_of_lsT₁ π r.snd),
      let x₂ := lsT₂_of_lsT₁ π x,
      let y₂ := lsT₂_of_lsT₁ π y,
      use r₂,
      split,
      {
        rw [list.mem_map, prod.exists],
        use r.fst,
        use r.snd,
        split,
        {
          convert r_in,
          exact prod.ext rfl rfl,
        },
        split;
        refl,
      },
      use x₂,
      use y₂,
      split,
      {
        rw bef,
        unfold lsT₂_of_lsT₁,
        rw list.map_append,
        rw list.map_append,
        refl,
      },
      {
        rw aft,
        unfold lsT₂_of_lsT₁,
        rw list.map_append,
        rw list.map_append,
        refl,
      },
    },
    specialize deri_of_deri (list.map (symbol.terminal ∘ π.inv_fun) w) hw,
    rw lsT₂_of_lsT₁ at deri_of_deri,
    rw list.map_map at deri_of_deri,
    convert deri_of_deri,
    ext1,
    change symbol.terminal x = sT₂_of_sT₁ π (symbol.terminal (π.inv_fun x)),
    unfold sT₂_of_sT₁,
    rw equiv.right_inv,
  },
end