/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.linarith.verification
import Mathlib.tactic.linarith.preprocessing
import Mathlib.PostPort

namespace Mathlib

/-!
# `linarith`: solving linear arithmetic goals

`linarith` is a tactic for solving goals with linear arithmetic.

Suppose we have a set of hypotheses in `n` variables
`S = {a₁x₁ + a₂x₂ + ... + aₙxₙ R b₁x₁ + b₂x₂ + ... + bₙxₙ}`,
where `R ∈ {<, ≤, =, ≥, >}`.
Our goal is to determine if the inequalities in `S` are jointly satisfiable, that is, if there is
an assignment of values to `x₁, ..., xₙ` such that every inequality in `S` is true.

Specifically, we aim to show that they are *not* satisfiable. This amounts to proving a
contradiction. If our goal is also a linear inequality, we negate it and move it to a hypothesis
before trying to prove `false`.

When the inequalities are over a dense linear order, `linarith` is a decision procedure: it will
prove `false` if and only if the inequalities are unsatisfiable. `linarith` will also run on some
types like `ℤ` that are not dense orders, but it will fail to prove `false` on some unsatisfiable
problems. It will run over concrete types like `ℕ`, `ℚ`, and `ℝ`, as well as abstract types that
are instances of `linear_ordered_comm_ring`.

## Algorithm sketch

First, the inequalities in the set `S` are rearranged into the form `tᵢ Rᵢ 0`, where
`Rᵢ ∈ {<, ≤, =}` and each `tᵢ` is of the form `∑ cⱼxⱼ`.

`linarith` uses an untrusted oracle to search for a certificate of unsatisfiability.
The oracle searches for a list of natural number coefficients `kᵢ` such that `∑ kᵢtᵢ = 0`, where for
at least one `i`, `kᵢ > 0` and `Rᵢ = <`.

Given a list of such coefficients, `linarith` verifies that `∑ kᵢtᵢ = 0` using a normalization
tactic such as `ring`. It proves that `∑ kᵢtᵢ < 0` by transitivity, since each component of the sum
is either equal to, less than or equal to, or less than zero by hypothesis. This produces a
contradiction.

## Preprocessing

`linarith` does some basic preprocessing before running. Most relevantly, inequalities over natural
numbers are cast into inequalities about integers, and rational division by numerals is canceled
into multiplication. We do this so that we can guarantee the coefficients in the certificate are
natural numbers, which allows the tactic to solve goals over types that are not fields.

Preprocessors are allowed to branch, that is, to case split on disjunctions. `linarith` will succeed
overall if it succeeds in all cases. This leads to exponential blowup in the number of `linarith`
calls, and should be used sparingly. The default preprocessor set does not include case splits.

## Fourier-Motzkin elimination

The oracle implemented to search for certificates uses Fourier-Motzkin variable elimination.
This technique transorms a set of inequalities in `n` variables to an equisatisfiable set in `n - 1`
variables. Once all variables have been eliminated, we conclude that the original set was
unsatisfiable iff the comparison `0 < 0` is in the resulting set.

While performing this elimination, we track the history of each derived comparison. This allows us
to represent any comparison at any step as a positive combination of comparisons from the original
set. In particular, if we derive `0 < 0`, we can find our desired list of coefficients
by counting how many copies of each original comparison appear in the history.

## Implementation details

`linarith` homogenizes numerical constants: the expression `1` is treated as a variable `t₀`.

Often `linarith` is called on goals that have comparison hypotheses over multiple types. This
creates multiple `linarith` problems, each of which is handled separately; the goal is solved as
soon as one problem is found to be contradictory.

Disequality hypotheses `t ≠ 0` do not fit in this pattern. `linarith` will attempt to prove equality
goals by splitting them into two weak inequalities and running twice. But it does not split
disequality hypotheses, since this would lead to a number of runs exponential in the number of
disequalities in the context.

The Fourier-Motzkin oracle is very modular. It can easily be replaced with another function of type
`certificate_oracle := list comp → ℕ → tactic (rb_map ℕ ℕ)`,
which takes a list of comparisons and the largest variable
index appearing in those comparisons, and returns a map from comparison indices to coefficients.
An alternate oracle can be specified in the `linarith_config` object.

A variant, `nlinarith`, adds an extra preprocessing step to handle some basic nonlinear goals.
There is a hook in the `linarith_config` configuration object to add custom preprocessing routines.

The certificate checking step is *not* by reflection. `linarith` converts the certificate into a
proof term of type `false`.

Some of the behavior of `linarith` can be inspected with the option
`set_option trace.linarith true`.
Because the variable elimination happens outside the tactic monad, we cannot trace intermediate
steps there.

## File structure

The components of `linarith` are spread between a number of files for the sake of organization.

* `lemmas.lean` contains proofs of some arithmetic lemmas that are used in preprocessing and in
  verification.
* `datatypes.lean` contains data structures that are used across multiple files, along with some
  useful auxiliary functions.
* `preprocessing.lean` contains functions used at the beginning of the tactic to transform
  hypotheses into a shape suitable for the main routine.
* `parsing.lean` contains functions used to compute the linear structure of an expression.
* `elimination.lean` contains the Fourier-Motzkin elimination routine.
* `verification.lean` contains the certificate checking functions that produce a proof of `false`.
* `frontend.lean` contains the control methods and user-facing components of the tactic.

## Tags

linarith, nlinarith, lra, nra, Fourier Motzkin, linear arithmetic, linear programming
-/

namespace linarith

/-! ### Control -/

/--
If `e` is a comparison `a R b` or the negation of a comparison `¬ a R b`, found in the target,
`get_contr_lemma_name_and_type e` returns the name of a lemma that will change the goal to an
implication, along with the type of `a` and `b`.

For example, if `e` is `(a : ℕ) < b`, returns ``(`lt_of_not_ge, ℕ)``.
-/
/--
`apply_contr_lemma` inspects the target to see if it can be moved to a hypothesis by negation.
For example, a goal `⊢ a ≤ b` can become `a > b ⊢ false`.
If this is the case, it applies the appropriate lemma and introduces the new hypothesis.
It returns the type of the terms in the comparison (e.g. the type of `a` and `b` above) and the
newly introduced local constant.
Otherwise returns `none`.
-/
/--
`partition_by_type l` takes a list `l` of proofs of comparisons. It sorts these proofs by
the type of the variables in the comparison, e.g. `(a : ℚ) < 1` and `(b : ℤ) > c` will be separated.
Returns a map from a type to a list of comparisons over that type.
-/
/--
Given a list `ls` of lists of proofs of comparisons, `try_linarith_on_lists cfg ls` will try to
prove `false` by calling `linarith` on each list in succession. It will stop at the first proof of
`false`, and fail if no contradiction is found with any list.
-/
/--
Given a list `hyps` of proofs of comparisons, `run_linarith_on_pfs cfg hyps pref_type`
preprocesses `hyps` according to the list of preprocessors in `cfg`.
This results in a list of branches (typically only one),
each of which must succeed in order to close the goal.

In each branch, we partition the  list of hypotheses by type, and run `linarith` on each class
in the partition; one of these must succeed in order for `linarith` to succeed on this branch.
If `pref_type` is given, it will first use the class of proofs of comparisons over that type.
-/
/--
`filter_hyps_to_type restr_type hyps` takes a list of proofs of comparisons `hyps`, and filters it
to only those that are comparisons over the type `restr_type`.
-/
/-- A hack to allow users to write `{restr_type := ℚ}` in configuration structures. -/
end linarith

/-! ### User facing functions -/

/--
`linarith reduce_semi only_on hyps cfg` tries to close the goal using linear arithmetic. It fails
if it does not succeed at doing this.

* If `reduce_semi` is true, it will unfold semireducible definitions when trying to match atomic
expressions.
* `hyps` is a list of proofs of comparisons to include in the search.
* If `only_on` is true, the search will be restricted to `hyps`. Otherwise it will use all
  comparisons in the local context.
-/
-- if the target is an equality, we run `linarith` twice, to prove ≤ and ≥.

/- If we are proving a comparison goal (and not just `false`), we consider the type of the
   elements in the comparison to be the "preferred" type. That is, if we find comparison
   hypotheses in multiple types, we will run `linarith` on the goal type first.
   In this case we also recieve a new variable from moving the goal to a hypothesis.
   Otherwise, there is no preferred type and no new variable; we simply change the goal to `false`. -/

/--
Tries to prove a goal of `false` by linear arithmetic on hypotheses.
If the goal is a linear (in)equality, tries to prove it by contradiction.
If the goal is not `false` or an inequality, applies `exfalso` and tries linarith on the
hypotheses.

* `linarith` will use all relevant hypotheses in the local context.
* `linarith [t1, t2, t3]` will add proof terms t1, t2, t3 to the local context.
* `linarith only [h1, h2, h3, t1, t2, t3]` will use only the goal (if relevant), local hypotheses
  `h1`, `h2`, `h3`, and proofs `t1`, `t2`, `t3`. It will ignore the rest of the local context.
* `linarith!` will use a stronger reducibility setting to identify atoms.

Config options:
* `linarith {exfalso := ff}` will fail on a goal that is neither an inequality nor `false`
* `linarith {restrict_type := T}` will run only on hypotheses that are inequalities over `T`
* `linarith {discharger := tac}` will use `tac` instead of `ring` for normalization.
  Options: `ring2`, `ring SOP`, `simp`
* `linarith {split_hypotheses := ff}` will not destruct conjunctions in the context.
-/
/--
`linarith` attempts to find a contradiction between hypotheses that are linear (in)equalities.
Equivalently, it can prove a linear inequality by assuming its negation and proving `false`.

In theory, `linarith` should prove any goal that is true in the theory of linear arithmetic over
the rationals. While there is some special handling for non-dense orders like `nat` and `int`,
this tactic is not complete for these theories and will not prove every true goal. It will solve
goals over arbitrary types that instantiate `linear_ordered_comm_ring`.

An example:
```lean
example (x y z : ℚ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0)
        (h3 : 12*y - 4* z < 0)  : false :=
by linarith
```

`linarith` will use all appropriate hypotheses and the negation of the goal, if applicable.

`linarith [t1, t2, t3]` will additionally use proof terms `t1, t2, t3`.

`linarith only [h1, h2, h3, t1, t2, t3]` will use only the goal (if relevant), local hypotheses
`h1`, `h2`, `h3`, and proofs `t1`, `t2`, `t3`. It will ignore the rest of the local context.

`linarith!` will use a stronger reducibility setting to try to identify atoms. For example,
```lean
example (x : ℚ) : id x ≥ x :=
by linarith
```
will fail, because `linarith` will not identify `x` and `id x`. `linarith!` will.
This can sometimes be expensive.

`linarith {discharger := tac, restrict_type := tp, exfalso := ff}` takes a config object with five
optional arguments:
* `discharger` specifies a tactic to be used for reducing an algebraic equation in the
  proof stage. The default is `ring`. Other options currently include `ring SOP` or `simp` for basic
  problems.
* `restrict_type` will only use hypotheses that are inequalities over `tp`. This is useful
  if you have e.g. both integer and rational valued inequalities in the local context, which can
  sometimes confuse the tactic.
* `transparency` controls how hard `linarith` will try to match atoms to each other. By default
  it will only unfold `reducible` definitions.
* If `split_hypotheses` is true, `linarith` will split conjunctions in the context into separate
  hypotheses.
* If `exfalso` is false, `linarith` will fail when the goal is neither an inequality nor `false`.
  (True by default.)

A variant, `nlinarith`, does some basic preprocessing to handle some nonlinear goals.

The option `set_option trace.linarith true` will trace certain intermediate stages of the `linarith`
routine.
-/
/--
An extension of `linarith` with some preprocessing to allow it to solve some nonlinear arithmetic
problems. (Based on Coq's `nra` tactic.) See `linarith` for the available syntax of options,
which are inherited by `nlinarith`; that is, `nlinarith!` and `nlinarith only [h1, h2]` all work as
in `linarith`. The preprocessing is as follows:

* For every subterm `a ^ 2` or `a * a` in a hypothesis or the goal,
  the assumption `0 ≤ a ^ 2` or `0 ≤ a * a` is added to the context.
* For every pair of hypotheses `a1 R1 b1`, `a2 R2 b2` in the context, `R1, R2 ∈ {<, ≤, =}`,
  the assumption `0 R' (b1 - a1) * (b2 - a2)` is added to the context (non-recursively),
  where `R ∈ {<, ≤, =}` is the appropriate comparison derived from `R1, R2`.
-/


/- Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------
# Gaussian Integers
Sina Hazratpour
Adopted from Mathematics in Lean (by Avigad et al)
https://leanprover-community.github.io/mathematics_in_lean/06_Abstract_Algebra.html#building-the-gaussian-integers
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import ..prooflab
import .lec11_type_classes

import data.int.basic

namespace PROOFS
namespace STR

universe u

#check has_zero

class with_zero_str (X : Type u) := (zero [] : X)

#check with_zero_str
#check with_zero_str ℕ

instance : with_zero_str ℕ := ⟨ nat.zero ⟩
instance : with_zero_str bool := ⟨ ff ⟩

#check @with_zero_str.zero

instance with_zero_product {A B : Type u} [with_zero_str A] [with_zero_str B] :
  with_zero_str (A × B) :=
{
  zero := (with_zero_str.zero A, with_zero_str.zero B),
}

#eval with_zero_str.zero (bool × ℕ)

/-! Gaussian Integers -/

/-
https://en.wikipedia.org/wiki/Gaussian_integer
-/

@[ext]
structure gaussian_int :=
(re : ℤ)
(im : ℤ)

#check gaussian_int

notation ` ℤ[i] ` := gaussian_int

instance : has_repr ℤ[i] :=
{ repr := λ x,  repr x.re ++ "+" ++ "i" ++  repr x.im}

/- We prove some basic facts about Gaussian integers in the following namespace
-/

namespace gaussian_int

def zero : ℤ[i]  :=
{
  re := 0,
  im := 0,
}

#check zero -- ⟨0,0⟩

instance : has_zero ℤ[i]  := ⟨ ⟨0 ,0 ⟩  ⟩ -- we show that the Gaussian integers have zero by providing an instance of type class `has_zero`

#check zero -- Lean automatically understands this as `gaussian_int.zero`.
#check nat.zero

#check mul_zero -- this takes advantage zero as an instance of has_zero ℤ[i]  rather than `zero` defined at the top of the namespace.

instance : has_one ℤ[i]  :=  ⟨ ⟨1, 0⟩  ⟩

instance : has_mul ℤ[i]  := ⟨ λ x, λ y, ⟨x.re * y.re - x.im * y.im, x.re * y.im + x.im * y.re⟩  ⟩

#eval zero * zero -- this works because we have instances of `has_zero` and `mul_zero`.
#eval (⟨1, 0⟩ : ℤ[i]) * ⟨0 , 1⟩
#eval (⟨1, 0⟩ : ℤ[i]) * ⟨0 , 2⟩
#eval (⟨1, 0⟩ : ℤ[i]) * ⟨0 , 3⟩

/-
0+i6
-/
#eval (⟨2, 0⟩ : ℤ[i]) * ⟨0 , 3⟩

instance : has_add ℤ[i]  := ⟨λ x y, ⟨x.re + y.re, x.im + y.im⟩⟩

#eval (⟨2, 0⟩ : ℤ[i]) + ⟨0 , 3⟩

instance : has_neg ℤ[i]  := ⟨ λ x , ⟨ - x.re, - x.im⟩  ⟩

#eval - (⟨2, 0⟩ : ℤ[i])

lemma zero_def :
  (0 : ℤ[i]) = ⟨0, 0⟩ :=
begin
  refl,
end

#check has_zero.zero

@[simp]
lemma zero_re_def :
  (0 :ℤ[i]).re = 0 :=
begin
  refl,
end

@[simp]
lemma zero_im_def :
  (0 :ℤ[i]).im = 0 :=
begin
  refl,
end

@[simp]
lemma one_def :
  (1 :ℤ[i]) = ⟨1, 0⟩ :=
begin
  refl,
end

@[simp]
lemma one_re_def :
  (1 :ℤ[i]).re = 1 :=
begin
  refl,
end

@[simp]
lemma one_im_def :
  (1 :ℤ[i]).im = 0 :=
begin
  refl,
end

theorem add_def (x y : ℤ[i]) :
  x + y = ⟨x.re + y.re, x.im + y.im⟩ :=
begin
 refl,
end

theorem neg_def (x : ℤ[i]) :
  -x = ⟨-x.re, -x.im⟩ :=
begin
  refl,
end

@[simp]
theorem mul_def (x y : ℤ[i]) :
  x * y = ⟨x.re * y.re - x.im * y.im, x.re * y.im + x.im * y.re⟩ :=
begin
  refl,
end

@[simp]
theorem add_re_def (x y : ℤ[i]) :
  (x + y).re = x.re + y.re :=
begin
  refl,
end

@[simp]
theorem add_im_def (x y : ℤ[i]) :
  (x + y).im = x.im + y.im :=
begin
  refl,
end

@[simp]
theorem mul_re_def (x y : ℤ[i]) :
  (x * y).re = x.re * y.re - x.im * y.im:=
begin
  refl,
end

@[simp]
theorem mul_im_def (x y : ℤ[i]) :
  (x * y).im = x.re * y.im + x.im * y.re:=
begin
  refl,
end

lemma add_assoc (x y z : ℤ[i]) :
  (x + y) + z = x + (y + z) :=
begin
   ext, -- By extensionality, we have to prove that the real part and the imaginary part of the two sides of the goal are equal. We reduce the problem to the problem of associativity of addition of integers.
   {repeat {rw add_re_def}, -- we took the real part of the sums separately and then we added them together,
    rw add_assoc,
   },
   -- {simp, rw add_assoc},-- to this end, we use
   --{rw add_def, unfold gaussian_int.im, rw add_assoc},
   {
    apply add_assoc,
   }
end

lemma mul_assoc (x y z : ℤ[i]) :
  (x * y) * z = x * (y * z) :=
begin
   ext, -- we are trying to show an equality of two instances of the structure `guassian_int`.
   repeat {rw mul_def},
   repeat {simp},
   {
    ring_nf, -- we proved this by using distributivity of mult over addition of integers which are all part of `ring` tactic.
   },
   {
    ring_nf, -- we proved this by using distributivity of mult over addition of integers which are all part of `ring` tactic.
   },
end

lemma mul_add_distrib (a b c : ℤ[i]) :
  a * (b + c) = a * b + a * c :=
begin
  ext,
  repeat{simp},  -- works because of the lemma `mul_re_def` and `add_def`
  repeat{ring_nf},
    --rw [mul_re_def, add_def],
end

lemma mul_add_distrib_alt (a b c : ℤ[i]) :
  a * (b + c) = a * b + a * c :=
begin
  ext,
  repeat{simp; ring_nf}, -- works because of the lemma `mul_re_def` and `add_def`
end

lemma add_mul_distrib (a b c : ℤ[i]) :
  (a + b) * c = a * c + b * c :=
begin
  ext,
  repeat{simp; ring_nf},
end

lemma add_comm (a b : ℤ[i]) :
   a + b = b + a :=
begin
  ext, --
  {
    repeat{rw add_re_def}, -- we want to reduce the addition of guassian integers to the addition of integers
    rw add_comm,
  },
  {
     repeat{rw add_im_def}, -- we want to reduce the addition of guassian integers to the addition of integers
    rw add_comm,
  },
end

lemma mul_comm (a b : ℤ[i]) :
  a * b = b * a :=
begin
  ext,
  { simp [mul_comm], },
  {simp [mul_comm], ring_nf, }
end

lemma add_zero (a : ℤ[i]) :
  a + 0 = a :=
begin
  ext,
  {
    simp,
  },
  {
    apply add_zero,
  },
end

lemma zero_add (a : ℤ[i]) :
  0 + a = a :=
begin
  ext a,
  repeat {apply zero_add},
end

lemma mul_one (a : ℤ[i]) :
   a * 1 = a :=
begin
  ext a,
  --repeat {apply  mul_one},
  repeat {simp},
end

lemma one_mul (a : ℤ[i]) :
  1 * a = a :=
begin
  ext,
   repeat {simp},
end

end gaussian_int

-- the structure of multiplicative semigroup: A semigroup structure consists of a binary operation (called multiplication) such that the operation is __associative__.

class mult_semigroup_str (S : Type u) extends has_mul S :=
(mul_assoc : ∀ a b c : S, (a * b) * c = a * (b * c))

-- the structure of additive semigroup
class additive_semigroup_str (S : Type u) extends has_add S :=
(add_assoc : ∀ a b c : S, (a + b) + c = a + (b + c))

instance : mult_semigroup_str ℕ :=
{
  -- mul := λ x, λ y, x * y,
  mul := has_mul.mul,
  mul_assoc := nat.mul_assoc,
}

instance : additive_semigroup_str ℕ :=
{
  add := λ x, λ y, x + y,
  add_assoc := nat.add_assoc,
}

#check 10 * 2
#check (10 : ℤ[i]) * 2
#eval (10 : ℤ[i]) * 2

#eval 10 * 2
#eval (⟨1,2⟩ : ℤ[i] ) * ⟨3,4⟩

instance : mult_semigroup_str ℤ  :=
{
  mul := has_mul.mul, -- we retrieve the defintion of multiplication of ℤ[i] from the instance of the class `has_mul`.
  mul_assoc := by {intros x y z, rw int.mul_assoc},
}

instance : mult_semigroup_str ℤ[i]  :=
{
  mul := has_mul.mul, -- we retrieve the defintion of multiplication of ℤ[i] from the instance of the class `has_mul`.
  mul_assoc := by {intros x y z, rw gaussian_int.mul_assoc},
}

instance : additive_semigroup_str ℤ[i]  :=
{
  add := has_add.add,
  add_assoc := by {intros x y z, rw gaussian_int.add_assoc},
}

/- A __monoid__ is a type equipped with an associative binary operation and an identity element. -/

class mult_monoid_str  (M : Type u) extends mult_semigroup_str M, has_one M :=
(mul_one :  ∀ a : M, a * 1 = a )
(one_mul : ∀ a : M, 1 * a = a )

class additive_monoid_str  (M : Type u) extends additive_semigroup_str M, has_zero M :=
(add_zero :  ∀ a : M, a + 0 = a )
(zero_add : ∀ a : M, 0 + a = a )

def npower {M : Type u} [mult_monoid_str M] : ℕ → M → M
  | 0 m := 1
  | (n + 1) m := m * (npower n m)

instance : mult_monoid_str ℕ  :=
{
  mul_one :=  by { intro a, rw nat.mul_one, },
  one_mul :=  by { intro a, rw nat.one_mul, },
}

instance : mult_monoid_str ℤ  :=
{
  mul_one :=  by { intro a, rw int.mul_one, },
  one_mul :=  by { intro a, rw int.one_mul, },
}

-- __API__ for mul_monoid_str (capturing the core properties of the structure, but specification independent-- however you define monoid structure the following statements must be true about it)
@[simp]
lemma mult_mon_assoc {M : Type u} [mult_monoid_str M] (x y z : M) :
  x * y * z = x * (y * z) :=
begin
  apply mult_monoid_str.to_mult_semigroup_str.mul_assoc,
end

@[simp]
lemma mult_mon_mul_one {M : Type u} [mult_monoid_str M] (x : M) :
  x * 1 = x  :=
begin
  apply mult_monoid_str.mul_one,
end

@[simp]
lemma mult_mon_one_mul {M : Type u} [mult_monoid_str M] (x : M) :
  1 * x = x  :=
begin
  apply mult_monoid_str.one_mul,
end

@[simp]
lemma add_mon_zero_add {M : Type u} [additive_monoid_str M] (x : M) :
  0 + x = x  :=
begin
  apply additive_monoid_str.zero_add,
end

-- instance : mult_monoid_str ℤ[i] :=
-- { mul := _,
--   mul_assoc := _,
--   one := _,
--   mul_one := _,
--   one_mul := _ }

/- We don't have to provide instances of `mul`, `mul_assoc` and `one` becasue they have been provided before as instances of `mult_semigroup ℤ[i]` and `has_one ℤ[i]` respectively. -/

instance : mult_monoid_str ℤ[i]  :=
{
  mul_one :=  by { intro a, rw gaussian_int.mul_one, },
  one_mul :=  by { intro a, rw gaussian_int.one_mul, },
}

instance : additive_monoid_str ℤ[i] :=
{
  add_zero := by { intro a, rw gaussian_int.add_zero, },
  zero_add := by { intro a, rw gaussian_int.zero_add, },
}

/-
0+i2
-/

#eval npower 2 (⟨1, 1⟩ : ℤ[i])

end STR
end PROOFS


/-
Copyright (c) 2022/09 Daniil Homza. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Daniil Homza
-/
import probability.variance
--import probability.notation ???
/-!
# The Weak law of Large number

We prove the `Weak Law of Large number`. The proof is well-known and
based on Chebyshev Inequality

(meas_ge_le_variance_div_sq in probability.variance)

ℙ {ω | c ≤ |X ω - 𝔼[X]|} ≤ ennreal.of_real (Var[X] / c ^ 2)

Proof will be consist of calculating of expected value
and variance of (∑ i in range m, X i) and appling Chebyshev inequality
in that case.

We proof that for sequencese of random variable with
𝔼[X_i]=𝔼[X_j], Var[X_i]=Var[X_j] we have

* `exp_sum` : expected value of a sum `𝔼[(∑ i in range m, X i)] = m*𝔼[(X 0)]`
* `var_sum`: variance of a sum of independent r.v. `Var[(∑ i in range m, X i)] = m*Var[(X 0)]`
* `weak_law`: Weak Law of Large number
`tendsto (λ (n : ℕ), ℙ {ω | c*n ≤|(∑ i in range n, X i ) ω - n*𝔼[(X 0)]|}) at_top (𝓝 0)`

Note that Weak_Law has no assumption on identical distribution of `X i`.

## Implementation

We follow the proof by book
Oliver C. Ibe,
in Fundamentals of Applied Probability and Random Processes (Second Edition), 2014
Proposition 6.1.

### Usefull definition

`ℙ - \ bp` - probability measure (probability)
`𝔼 - \ bbE` - Expected value
`∀ = \ forall` - for all
`∃ - \ ex` - exists
`λ = \ la` - lambda (lambda calculus)
`ℕ = \ Nat` - natural number(include 0)
`ω = \ om` - omega, member of probability space(event)
`𝓝 = \ nhds` - neighborhoods (in topological space)
-/

open measure_theory filter finset

noncomputable theory

open_locale topological_space big_operators probability_theory

-- topological space is responsible to nieghborhoods in weak_law theorem

-- big operators is responsible to sum

/- ennreal The extended nonnegative real numbers. This is usually denoted [0, ∞],
 and is relevant as the codomain of a measure. -/

/- nnreal In this file we define nnreal (notation: ℝ≥0)
 to be the type of non-negative real numbers, a.k.a. the interval [0, ∞) -/

namespace probability_theory

variables {Ω : Type*} [measure_space Ω] [is_probability_measure (ℙ : measure Ω)]{ω:Ω}{c:ℝ}

/-- Chebyshev inequality can be aplpied for sum of random variables with appropriate
expected value and variance  -/

lemma sum_cheb {X : ℕ → Ω → ℝ}
(hint : ∀ i, integrable (X i)) (hindep : pairwise (λ i j, indep_fun (X i) (X j)))
(same_exp: ∀ (m:ℕ), 𝔼[(X m)] = 𝔼[(X 0)]) (same_var: ∀ (m:ℕ), Var[(X m)]=Var[(X 0)])
(hs : ∀ i, mem_ℒp (X i) 2) (hc : 0 < c):
 ∀ (m:ℕ), (m>0) -> (ℙ {ω | c*m ≤ |(∑ i in range m, X i ) ω - m*𝔼[(X 0)]|}) ≤ ennreal.of_real (Var[(X 0)] / (c^2*m)):=
begin
  have exp_sum: ∀ (m:ℕ), 𝔼[(∑ i in range m, X i)] = m*𝔼[(X 0)],
    begin

    have sum_exp: ∀ (m:ℕ), 𝔼[(∑ i in range m, X i)] = ∑ i in range m, 𝔼[(X i)],
      begin
      intro m,
      simp[integral_finset_sum, hint],
      end,
    intro m,
    rw sum_exp,
    simp only[same_exp],
    simp,
    end,

  have var_sum: ∀ cl(m:ℕ), Var[(∑ i in range m, X i)] = m*Var[(X 0)],
    begin

    have sum_var: ∀ (m:ℕ), Var[(∑ i in range m, X i)] = ∑ i in range m, Var[(X i)],
      begin
      intro m,
      rw indep_fun.variance_sum,
      intros i im,
      specialize hs i,
      exact hs,
      intros i j p pr prn,
      specialize hindep i p prn,
      exact hindep,
      end,
    intro m,
    simp[sum_var,same_var],
    end,

  have simplif_eq: ∀ (m:ℕ), (m>0) -> ennreal.of_real (Var[(X 0)] / (c^2*m))=ennreal.of_real((Var[(X 0)]* m) / (c*m) ^ 2):=
    begin
    intros m mp,
    rw [← div_inv_eq_mul Var[X 0], div_div],
    congrm ennreal.of_real (Var[X 0] / _),
    ring_nf,
    congrm (_*c^2),
    rw ← div_eq_inv_mul,
    rw pow_two,
    simp[mul_div_cancel'''],
    end,
  have int2: ∀ (m:ℕ), mem_ℒp (∑ i in range m, X i ) 2,
    intro m,
    ring_nf,
    refine mem_ℒp_finset_sum' (range m) _,
    intros i ip,
    specialize hs i,
    exact hs,

  have ineq: ∀ (m:ℕ), (m>0) -> (ℙ {ω | c*m ≤ |(∑ i in range m, X i ) ω - m*𝔼[(X 0)]|}) ≤ ennreal.of_real (Var[(∑ i in range m, X i)] / (c*m) ^ 2),
    begin
    intros m mp,
    have C: ∀ (m:ℕ), (m>0) -> 0<c*m,
      intros m mp,
      simp[hc, mp],
      exact mp,
      specialize C m mp,
      specialize exp_sum m,
      rw ← exp_sum,
      specialize int2 m,
      apply meas_ge_le_variance_div_sq,
      exact int2,
      exact C,
    end,

  have B: ∀ (m:ℕ), Var[(∑ i in range m, X i)] = Var[(X 0)]*m,
    begin
    intro m,
    specialize var_sum m,
    rw var_sum,
   finish,
    end,
  intros m mp,
  specialize var_sum m,
  specialize ineq m mp,
  specialize simplif_eq m mp,
    specialize B m,
  rw simplif_eq,
  rw ← B,
  exact ineq,
end

theorem weak_law {X : ℕ → Ω → ℝ}
(hint : ∀ i, integrable (X i)) (hindep : pairwise (λ i j, indep_fun (X i) (X j)))
(same_exp: ∀ (m:ℕ), 𝔼[(X m)] = 𝔼[(X 0)]) (same_var: ∀ (m:ℕ), Var[(X m)]=Var[(X 0)])
(hs : ∀ i, mem_ℒp (X i) 2)(hc : 0 < c):
tendsto (λ (n : ℕ), ℙ {ω | c*n ≤|(∑ i in range n, X i ) ω - n*𝔼[(X 0)]|}) at_top (𝓝 0) :=
begin

rw ennreal.tendsto_at_top_zero,
intros e e_pos,
let N:= nat.ceil(Var[(X 0)]/(c^2*(ennreal.to_real(e)))),

have A: let N := ⌈Var[X 0] / (c ^ 2 * e.to_real)⌉₊ in ∀ (n: ℕ) (n_pos : n ≥ N),
    ennreal.of_real (Var[(X 0)]/(c^2*n)) ≤ e :=
begin
  intros N n hn,
  -- annoying special case n = 0
  rcases nat.eq_zero_or_pos n with (rfl | hn0), { simp, },
  -- annoying special case e    = ∞
  rcases eq_top_or_lt_top e with (rfl | he), { simp, },
  -- using N just makes things more annoying. Why not just not define N at all?
  change ⌈ _ ⌉₊ ≤ n at hn,
  -- get rid of ceiling
  rw nat.ceil_le at hn,
  -- get rid of ennreal stuff in goal
  apply ennreal.of_real_le_of_le_to_real,
  -- clear denominators (will show they're positive later)
  rw div_le_iff at hn ⊢,
  { -- main goal now easy
    convert hn using 1,
    ring, },
  { -- positivity side goal: a bit annoying that I need to use theorems and not tactics here
    exact mul_pos (pow_pos hc 2) (by exact_mod_cast hn0), },
  { -- second positivity side goal: here we still have to deal with e
    refine mul_pos (pow_pos hc 2) _,
    rw ennreal.to_real_pos_iff,
    exact ⟨e_pos, he⟩, },
end,

have sum_cheb1: ∀ (n:ℕ), (n>0) -> (ℙ {ω | c*n ≤ |(∑ i in range n, X i ) ω - n*𝔼[(X 0)]|}) ≤ ennreal.of_real (Var[(X 0)] / (c^2*n)):=
begin
  exact (sum_cheb hint hindep same_exp same_var hs hc),
end,
rcases nat.eq_zero_or_pos N with h1 | h2,
use 1,
intros n n1,
have n0: n>0,
  simp[n1],
  rcases nat.eq_zero_or_pos n with q1 | q2,
  exfalso,
  rw q1 at n1,
  finish using n1,
  exact q2,
  specialize sum_cheb1 n n0,
  apply le_trans sum_cheb1,
  have t0: n≥N,
  rw h1,
  simp[n0],
  specialize A n t0,
  exact A,
  use N,
  intros n nbigN,
  have n0: n>0,
  rcases nat.eq_zero_or_pos n with s1 | s2,
  exfalso,
  rw s1 at nbigN,
  have r0: 0<0,
  exact (lt_of_lt_of_le h2 nbigN),
  finish using r0,
  exact s2,
  specialize sum_cheb1 n n0,
  apply le_trans sum_cheb1,
  specialize A n nbigN,
  exact A,

end
end probability_theory


/-
Copyright (c) 2022 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller, Vincent Beffara
-/
import combinatorics.simple_graph.connectivity
import data.nat.lattice

/-!
# Graph metric

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

This module defines the `simple_graph.dist` function, which takes
pairs of vertices to the length of the shortest walk between them.

## Main definitions

- `simple_graph.dist` is the graph metric.

## Todo

- Provide an additional computable version of `simple_graph.dist`
  for when `G` is connected.

- Evaluate `nat` vs `enat` for the codomain of `dist`, or potentially
  having an additional `edist` when the objects under consideration are
  disconnected graphs.

- When directed graphs exist, a directed notion of distance,
  likely `enat`-valued.

## Tags

graph metric, distance

-/

namespace simple_graph
variables {V : Type*} (G : simple_graph V)

/-! ## Metric -/

/-- The distance between two vertices is the length of the shortest walk between them.
If no such walk exists, this uses the junk value of `0`. -/
noncomputable
def dist (u v : V) : ℕ := Inf (set.range (walk.length : G.walk u v → ℕ))

variables {G}

protected
lemma reachable.exists_walk_of_dist {u v : V} (hr : G.reachable u v) :
  ∃ (p : G.walk u v), p.length = G.dist u v :=
nat.Inf_mem (set.range_nonempty_iff_nonempty.mpr hr)

protected
lemma connected.exists_walk_of_dist (hconn : G.connected) (u v : V) :
  ∃ (p : G.walk u v), p.length = G.dist u v :=
(hconn u v).exists_walk_of_dist

lemma dist_le {u v : V} (p : G.walk u v) : G.dist u v ≤ p.length := nat.Inf_le ⟨p, rfl⟩

@[simp]
lemma dist_eq_zero_iff_eq_or_not_reachable {u v : V} : G.dist u v = 0 ↔ u = v ∨ ¬ G.reachable u v :=
by simp [dist, nat.Inf_eq_zero, reachable]

lemma dist_self {v : V} : dist G v v = 0 := by simp

protected
lemma reachable.dist_eq_zero_iff {u v : V} (hr : G.reachable u v) :
  G.dist u v = 0 ↔ u = v := by simp [hr]

protected
lemma reachable.pos_dist_of_ne {u v : V} (h : G.reachable u v) (hne : u ≠ v) : 0 < G.dist u v :=
nat.pos_of_ne_zero (by simp [h, hne])

protected
lemma connected.dist_eq_zero_iff (hconn : G.connected) {u v : V} :
  G.dist u v = 0 ↔ u = v := by simp [hconn u v]

protected
lemma connected.pos_dist_of_ne {u v : V} (hconn : G.connected) (hne : u ≠ v) : 0 < G.dist u v :=
nat.pos_of_ne_zero (by simp [hconn.dist_eq_zero_iff, hne])

lemma dist_eq_zero_of_not_reachable {u v : V} (h : ¬ G.reachable u v) : G.dist u v = 0 :=
by simp [h]

lemma nonempty_of_pos_dist {u v : V} (h : 0 < G.dist u v) :
  (set.univ : set (G.walk u v)).nonempty :=
by simpa [set.range_nonempty_iff_nonempty, set.nonempty_iff_univ_nonempty]
     using nat.nonempty_of_pos_Inf h

protected
lemma connected.dist_triangle (hconn : G.connected) {u v w : V} :
  G.dist u w ≤ G.dist u v + G.dist v w :=
begin
  obtain ⟨p, hp⟩ := hconn.exists_walk_of_dist u v,
  obtain ⟨q, hq⟩ := hconn.exists_walk_of_dist v w,
  rw [← hp, ← hq, ← walk.length_append],
  apply dist_le,
end

private

lemma dist_comm {u v : V} : G.dist u v = G.dist v u :=
begin
  by_cases h : G.reachable u v,
  { apply le_antisymm (dist_comm_aux h) (dist_comm_aux h.symm), },
  { have h' : ¬ G.reachable v u := λ h', absurd h'.symm h,
    simp [h, h', dist_eq_zero_of_not_reachable], },
end

end simple_graph


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import field_theory.finite.basic

/-!
# IMO 2005 Q4

Problem: Determine all positive integers relatively prime to all the terms of the infinite sequence
`a n = 2 ^ n + 3 ^ n + 6 ^ n − 1`, for `n ≥ 1`.

This is quite an easy problem, in which the key point is a modular arithmetic calculation with
the sequence `a n` relative to an arbitrary prime.
-/

/-- The sequence considered in the problem, `2 ^ n + 3 ^ n + 6 ^ n - 1`. -/
def a (n : ℕ) : ℤ := 2 ^ n + 3 ^ n + 6 ^ n - 1

/-- Key lemma (a modular arithmetic calculation):  Given a prime `p` other than `2` or `3`, the
`p - 2`th term of the sequence has `p` as a factor. -/
lemma find_specified_factor {p : ℕ} (hp : nat.prime p) (hp' : is_coprime (6:ℤ) p) :
  ↑p ∣ a (p - 2) :=
begin
  rw [← int.modeq_zero_iff_dvd],
  -- Since `p` and `6` are coprime, `6` has an inverse mod `p`
  obtain ⟨b, hb⟩ : ∃ (b : ℤ), 6 * b ≡ 1 [ZMOD p],
  { refine int.mod_coprime _,
    exact nat.is_coprime_iff_coprime.mp hp' },
  -- Also since `p` is coprime to `6`, it's coprime to `2` and `3`
  have hp₂ : is_coprime (2:ℤ) p := (id hp' : is_coprime (3 * 2 : ℤ) p).of_mul_left_right,
  have hp₃ : is_coprime (3:ℤ) p := (id hp' : is_coprime (2 * 3 : ℤ) p).of_mul_left_right,
  -- Slightly painful nat-subtraction calculation
  have hp_sub_one : p - 1 = (p - 2) + 1,
  { have : 1 ≤ p - 1 := le_tsub_of_add_le_right hp.two_le,
    conv_lhs { rw ← nat.sub_add_cancel this },
    refl },
  -- Main calculation: `6 * a (p - 2)` is a multiple of `p`
  have H : (6:ℤ) * a (p - 2) ≡ 0 [ZMOD p],
  calc (6:ℤ) * a (p - 2)
      = 3 * 2 ^ (p - 1) + 2 * 3 ^ (p - 1) + 6 ^ (p - 1) - 6 :
  by { simp only [a, mul_add, mul_sub, hp_sub_one, pow_succ], ring, }
  ... ≡ 3 * 1 + 2 * 1 + 1 - 6 [ZMOD p] : -- At this step we use Fermat's little theorem
  by { apply_rules [int.modeq.sub_right, int.modeq.add, int.modeq.mul_left,
    int.modeq.pow_card_sub_one_eq_one hp] }
  ... = 0 : by norm_num,
  -- Since `6` has an inverse mod `p`, `a (p - 2)` itself is a multiple of `p`
  calc (a (p - 2) : ℤ) = 1 * a (p - 2) : by ring
  ... ≡ (6 * b) * a (p - 2) [ZMOD p] : int.modeq.mul_right _ hb.symm
  ... = b * (6 * a (p - 2)) : by ring
  ... ≡ b * 0 [ZMOD p] : int.modeq.mul_left _ H
  ... = 0 : by ring,
end

/-- Main statement:  The only positive integer coprime to all terms of the sequence `a` is `1`. -/
theorem imo2005_p4 {k : ℕ} (hk : 0 < k) : (∀ n : ℕ, 1 ≤ n → is_coprime (a n) k) ↔ k = 1 :=
begin
  split, rotate,
  { -- The property is clearly true for `k = 1`
    rintros rfl n hn,
    exact is_coprime_one_right },
  intros h,
  -- Conversely, suppose `k` is a number with the property, and let `p` be `k.min_fac` (by
  -- definition this is the minimal prime factor of `k` if `k ≠ 1`, and otherwise `1`.
  let p := k.min_fac,
  -- Testing the special property of `k` for `48`, the second term of the sequence, we see that `p`
  -- is coprime to `6`.
  have hp₆ : is_coprime (6:ℤ) p,
  { refine is_coprime.of_coprime_of_dvd_right _ (int.coe_nat_dvd.mpr k.min_fac_dvd),
    exact (id (h 2 one_le_two) : is_coprime (8 * 6 : ℤ) k).of_mul_left_right, },
  -- In particular `p` is coprime to `2` (we record the `nat.coprime` version since that's what's
  -- needed later).
  have hp₂ : nat.coprime 2 p,
  { rw ← nat.is_coprime_iff_coprime,
    exact (id hp₆ : is_coprime (3 * 2 : ℤ) p).of_mul_left_right },
  -- Suppose for the sake of contradiction that `k ≠ 1`.  Then `p` is genuinely a prime factor of
  -- `k`.
  by_contra hk',
  have hp : nat.prime p := nat.min_fac_prime hk',
  -- So `3 ≤ p`
  have hp₃ : 3 ≤ p,
  { have : 2 ≠ p := by rwa nat.coprime_primes (by norm_num : nat.prime 2) hp at hp₂,
    apply nat.lt_of_le_and_ne hp.two_le this, },
  -- Testing the special property of `k` for the `p - 2`th term of the sequence, we see that `p` is
  -- coprime to `a (p - 2)`.
  have : is_coprime ↑p (a (p - 2)),
  { refine ((h (p - 2) _).of_coprime_of_dvd_right (int.coe_nat_dvd.mpr k.min_fac_dvd)).symm,
    exact le_tsub_of_add_le_right hp₃ },
  rw (nat.prime_iff_prime_int.mp hp).coprime_iff_not_dvd at this,
  -- But also, by our previous lemma, `p` divides `a (p - 2)`.
  have : ↑p ∣ a (p - 2) := find_specified_factor hp hp₆,
  -- Contradiction!
  contradiction,
end


import analysis.calculus.bump_function_inner
import measure_theory.integral.periodic
import loops.surrounding
import loops.delta_mollifier

import to_mathlib.partition2
import to_mathlib.analysis.cont_diff

/-!
# The reparametrization lemma

This file contains a proof of Gromov's parametric reparametrization lemma. It concerns the behaviour
of the average value of a loop `γ : S¹ → F` when the loop is reparametrized by precomposing with a
diffeomorphism `S¹ → S¹`.

Given a loop `γ : S¹ → F` for some real vector space `F`, one may integrate to obtain its average
`∫ x in 0..1, (γ x)` in `F`. Although this average depends on the loop's parametrization, it
satisfies a contraint that depends only on the image of the loop: the average is contained in the
convex hull of the image of `γ`. The non-parametric version of the reparametrization lemma says that
conversely, given any point `g` in the interior of the convex hull of the image of `γ`, one may find
a reparametrization of `γ` whose average is `g`.

The reparametrization lemma thus allows one to reduce the problem of constructing a loop whose
average is a given point, to the problem of constructing a loop subject to a condition that depends
only on its image.

In fact the reparametrization lemma holds parametrically. Given a smooth family of loops:
`γ : E × S¹ → F`, `(x, t) ↦ γₓ t`, together with a smooth function `g : E → F`, such that `g x` is
contained in the interior of the convex hull of the image of `γₓ` for all `x`, there exists a smooth
family of diffeomorphism `φ : E × S¹ → S¹`, `(x, t) ↦ φₓ t` such that the average of `γₓ ∘ φₓ` is
`g x` for all `x`.

The idea of the proof is simple: since `g x` is contained in the interior of the convex hull of
the image of `γₓ` one may find `t₀, t₁, ..., tₙ` and barycentric coordinates `w₀, w₁, ..., wₙ` such
that `g x = ∑ᵢ wᵢ • γₓ(tᵢ)`. If there were no smoothness requirement on `φₓ` one could define
it to be a step function which spends time `wᵢ` at each `tᵢ`. However because there is a smoothness
condition, one rounds off the corners of the would-be step function by using a "delta mollifier"
(an approximation to a Dirac delta function).

The above construction works locally in the neighbourhood of any `x` in `E` and one uses a partition
of unity to globalise all the local solutions into the required family: `φ : E × S¹ → S¹`.

The key ingredients are theories of calculus, convex hulls, barycentric coordinates,
existence of delta mollifiers, partitions of unity, and the inverse function theorem.
-/

noncomputable theory

open set function measure_theory interval_integral filter
open_locale topology unit_interval manifold big_operators

variables {E F : Type*}
variables [normed_add_comm_group F] [normed_space ℝ F] [finite_dimensional ℝ F]
variables [measurable_space F] [borel_space F]

local notation `ι` := fin (finite_dimensional.finrank ℝ F + 1)

section metric_space

variables [metric_space E] [locally_compact_space E]

lemma loop.tendsto_mollify_apply
  (γ : E → loop F) (h : continuous ↿γ) (x : E) (t : ℝ) :
  tendsto (λ (z : E × ℕ), (γ z.1).mollify z.2 t) ((𝓝 x).prod at_top) (𝓝 (γ x t)) :=
begin
  have hγ : ∀ x, continuous (γ x) := λ x, h.comp $ continuous.prod.mk _,
  have h2γ : ∀ x, continuous (λ z, γ z x) := λ x, h.comp $ continuous.prod.mk_left _,
  simp_rw [loop.mollify_eq_convolution _ (hγ _)],
  rw [← add_zero (γ x t)],
  refine tendsto.add _ _,
  { rw [← one_smul ℝ (γ x t)],
    refine (tendsto_self_div_add_at_top_nhds_1_nat.comp tendsto_snd).smul _,
    refine cont_diff_bump.convolution_tendsto_right _ _ _ tendsto_const_nhds,
    { simp_rw [bump], norm_cast,
      exact ((tendsto_add_at_top_iff_nat 2).2 (tendsto_const_div_at_top_nhds_0_nat 1)).comp
        tendsto_snd },
    { exact eventually_of_forall (λ x, (hγ _).ae_strongly_measurable) },
    { have := h.tendsto (x, t),
      rw [nhds_prod_eq] at this,
      exact this.comp ((tendsto_fst.comp tendsto_fst).prod_mk tendsto_snd) } },
  { rw [← zero_smul ℝ (_ : F)],
    have : continuous (λ z, interval_integral (γ z) 0 1 volume) :=
      continuous_parametric_interval_integral_of_continuous (by apply h) continuous_const,
    exact (tendsto_one_div_add_at_top_nhds_0_nat.comp tendsto_snd).smul
      ((this.tendsto x).comp tendsto_fst) }
end

end metric_space

variables [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]

/-- Given a smooth function `g : E → F` between normed vector spaces, a smooth surrounding family
is a smooth family of loops `E → loop F`, `x ↦ γₓ` such that `γₓ` surrounds `g x` for all `x`. -/
@[nolint has_nonempty_instance]
structure smooth_surrounding_family (g : E → F) :=
(smooth_surrounded : 𝒞 ∞ g)
(to_fun : E → loop F)
(smooth : 𝒞 ∞ ↿to_fun)
(surrounds : ∀ x, (to_fun x).surrounds $ g x)

namespace smooth_surrounding_family

variables {g : E → F} (γ : smooth_surrounding_family g) (x y : E)

instance : has_coe_to_fun (smooth_surrounding_family g) (λ _, E → loop F) := ⟨to_fun⟩

protected lemma continuous : continuous (γ x) :=
begin
  apply continuous_uncurry_left x,
  exact γ.smooth.continuous,
end

include γ x

/-- Given `γ : smooth_surrounding_family g` and `x : E`, `γ.surrounding_parameters_at x` are the
`tᵢ : ℝ`, for `i = 0, 1, ..., dim F` such that `γ x tᵢ` surround `g x`. -/
def surrounding_parameters_at : ι → ℝ := classical.some (γ.surrounds x)

/-- Given `γ : smooth_surrounding_family g` and `x : E`, `γ.surrounding_points_at x` are the
points `γ x tᵢ` surrounding `g x` for parameters `tᵢ : ℝ`, `i = 0, 1, ..., dim F` (defined
by `γ.surrounding_parameters_at x`). -/
def surrounding_points_at : ι → F := γ x ∘ γ.surrounding_parameters_at x

/-- Given `γ : smooth_surrounding_family g` and `x : E`, `γ.surrounding_weights_at x` are the
barycentric coordinates of `g x` wrt to the points `γ x tᵢ`, for parameters `tᵢ : ℝ`,
`i = 0, 1, ..., dim F` (defined by `γ.surrounding_parameters_at x`). -/
def surrounding_weights_at : ι → ℝ := classical.some (classical.some_spec (γ.surrounds x))

lemma surround_pts_points_weights_at :
  surrounding_pts (g x) (γ.surrounding_points_at x) (γ.surrounding_weights_at x) :=
classical.some_spec _

/-- Note that we are mollifying the loop `γ y` at the surrounding parameters for `γ x`. -/
def approx_surrounding_points_at (n : ℕ) (i : ι) : F :=
(γ y).mollify n (γ.surrounding_parameters_at x i)

lemma approx_surrounding_points_at_smooth (n : ℕ) :
  𝒞 ∞ (λ y, γ.approx_surrounding_points_at x y n) :=
begin
  refine cont_diff_pi.mpr (λ i, _),
  suffices : 𝒞 ∞ (λy, ∫ s in 0..1, delta_mollifier n (γ.surrounding_parameters_at x i) s • γ y s),
  { simpa [approx_surrounding_points_at, loop.mollify], },
  refine cont_diff_parametric_integral_of_cont_diff (cont_diff.smul _ γ.smooth) 0 1,
  exact delta_mollifier_smooth.snd',
end

/-- The key property from which it should be easy to construct `local_centering_density`,
`local_centering_density_nhd` etc below. -/
lemma eventually_exists_surrounding_pts_approx_surrounding_points_at :
  ∀ᶠ (z : E × ℕ) in (𝓝 x).prod at_top,
  ∃ w, surrounding_pts (g z.1) (γ.approx_surrounding_points_at x z.1 z.2) w :=
begin
  let a : ι → E × ℕ → F := λ i z, γ.approx_surrounding_points_at x z.1 z.2 i,
  suffices : ∀ i, tendsto (a i) ((𝓝 x).prod at_top) (𝓝 (γ.surrounding_points_at x i)),
  { have hg : tendsto (λ (z : E × ℕ), g z.fst) ((𝓝 x).prod at_top) (𝓝 (g x)) :=
      tendsto.comp γ.smooth_surrounded.continuous.continuous_at tendsto_fst,
    exact eventually_surrounding_pts_of_tendsto_of_tendsto'
      ⟨_, γ.surround_pts_points_weights_at x⟩ this hg, },
  intros i,
  let t := γ.surrounding_parameters_at x i,
  change tendsto (λ (z : E × ℕ), (γ z.1).mollify z.2 t) ((𝓝 x).prod at_top) (𝓝 (γ x t)),
  exact loop.tendsto_mollify_apply γ γ.smooth.continuous x t,
end

/-- This is an auxiliary definition to help construct `centering_density` below.

Given `x : E`, it represents a smooth probability distribution on the circle with the property that:
`∫ s in 0..1, γ.local_centering_density x y s • γ y s = g y`
for all `y` in a neighbourhood of `x` (see `local_centering_density_average` below). -/
def local_centering_density [decidable_pred (∈ affine_bases ι ℝ F)] : E → ℝ → ℝ := λ y,
begin
  choose n hn₁ hn₂ using filter.eventually_iff_exists_mem.mp
    (γ.eventually_exists_surrounding_pts_approx_surrounding_points_at x),
  choose u hu v hv huv using mem_prod_iff.mp hn₁,
  choose m hmv using mem_at_top_sets.mp hv,
  exact ∑ i, (eval_barycentric_coords ι ℝ F (g y) (γ.approx_surrounding_points_at x y m) i) •
    (delta_mollifier m (γ.surrounding_parameters_at x i)),
end

/-- This is an auxiliary definition to help construct `centering_density` below. -/
def local_centering_density_mp : ℕ :=
begin
  choose n hn₁ hn₂ using filter.eventually_iff_exists_mem.mp
    (γ.eventually_exists_surrounding_pts_approx_surrounding_points_at x),
  choose u hu v hv huv using mem_prod_iff.mp hn₁,
  choose m hmv using mem_at_top_sets.mp hv,
  exact m,
end

lemma local_centering_density_spec [decidable_pred (∈ affine_bases ι ℝ F)] :
  γ.local_centering_density x y =
  ∑ i, (eval_barycentric_coords ι ℝ F (g y)
    (γ.approx_surrounding_points_at x y (γ.local_centering_density_mp x)) i) •
    (delta_mollifier (γ.local_centering_density_mp x) (γ.surrounding_parameters_at x i)) :=
rfl

/-- This is an auxiliary definition to help construct `centering_density` below. -/
def local_centering_density_nhd : set E :=
begin
  choose n hn₁ hn₂ using filter.eventually_iff_exists_mem.mp
    (γ.eventually_exists_surrounding_pts_approx_surrounding_points_at x),
  choose u hu v hv huv using mem_prod_iff.mp hn₁,
  exact (interior u),
end

omit γ x

lemma local_centering_density_nhd_is_open :
  is_open $ γ.local_centering_density_nhd x :=
is_open_interior

lemma local_centering_density_nhd_self_mem :
  x ∈ γ.local_centering_density_nhd x :=
begin
  let h := filter.eventually_iff_exists_mem.mp
    (γ.eventually_exists_surrounding_pts_approx_surrounding_points_at x),
  exact mem_interior_iff_mem_nhds.mpr (classical.some (classical.some_spec (mem_prod_iff.mp
    (classical.some (classical.some_spec h))))),
end

-- unused
lemma local_centering_density_nhd_covers :
  univ ⊆ ⋃ x, γ.local_centering_density_nhd x :=
λ x hx, mem_Union.mpr ⟨x, γ.local_centering_density_nhd_self_mem x⟩

lemma approx_surrounding_points_at_of_local_centering_density_nhd
  (hy : y ∈ γ.local_centering_density_nhd x) : ∃ w,
  surrounding_pts (g y) (γ.approx_surrounding_points_at x y (γ.local_centering_density_mp x)) w :=
begin
  let h := filter.eventually_iff_exists_mem.mp
    (γ.eventually_exists_surrounding_pts_approx_surrounding_points_at x),
  let nn := classical.some h,
  let hnn := mem_prod_iff.mp (classical.some (classical.some_spec h)),
  let n := classical.some hnn,
  let hn := classical.some_spec hnn,
  change y ∈ interior n at hy,
  let v := classical.some (classical.some_spec hn),
  let hv : v ∈ at_top := classical.some (classical.some_spec (classical.some_spec hn)),
  let m := classical.some (mem_at_top_sets.mp hv),
  let hm := classical.some_spec (mem_at_top_sets.mp hv),
  change ∃ w, surrounding_pts (g y) (γ.approx_surrounding_points_at x y m) w,
  suffices : (y, m) ∈ nn,
  { exact classical.some_spec (classical.some_spec h) _ this, },
  apply classical.some_spec (classical.some_spec (classical.some_spec hn)),
  change y ∈ n ∧ m ∈ v,
  exact ⟨interior_subset hy, hm _ (le_refl _)⟩,
end

lemma approx_surrounding_points_at_mem_affine_bases (hy : y ∈ γ.local_centering_density_nhd x) :
  γ.approx_surrounding_points_at x y (γ.local_centering_density_mp x) ∈ affine_bases ι ℝ F :=
(classical.some_spec
  (γ.approx_surrounding_points_at_of_local_centering_density_nhd x y hy)).mem_affine_bases

variables [decidable_pred (∈ affine_bases ι ℝ F)]

@[simp] lemma local_centering_density_pos (hy : y ∈ γ.local_centering_density_nhd x) (t : ℝ) :
  0 < γ.local_centering_density x y t :=
begin
  simp only [γ.local_centering_density_spec x, fintype.sum_apply, pi.smul_apply,
    algebra.id.smul_eq_mul],
  refine finset.sum_pos (λ i hi, _) finset.univ_nonempty,
  refine mul_pos _ (delta_mollifier_pos _),
  obtain ⟨w, hw⟩ := γ.approx_surrounding_points_at_of_local_centering_density_nhd x y hy,
  convert hw.w_pos i,
  rw ← hw.coord_eq_w,
  simp [eval_barycentric_coords, γ.approx_surrounding_points_at_mem_affine_bases x y hy],
end

lemma local_centering_density_periodic :
  periodic (γ.local_centering_density x y) 1 :=
finset.univ.periodic_sum $ λ i hi, periodic.smul delta_mollifier_periodic _

lemma local_centering_density_smooth_on :
  smooth_on ↿(γ.local_centering_density x) $
    (γ.local_centering_density_nhd x) ×ˢ (univ : set ℝ) :=
begin
  let h₀ := (λ (yt : E × ℝ) (hyt : yt ∈ (γ.local_centering_density_nhd x) ×ˢ (univ : set ℝ)),
    congr_fun (γ.local_centering_density_spec x yt.fst) yt.snd),
  refine cont_diff_on.congr _ h₀,
  simp only [fintype.sum_apply, pi.smul_apply, algebra.id.smul_eq_mul],
  refine cont_diff_on.sum (λ i hi, cont_diff_on.mul _ (cont_diff.cont_diff_on _)),
  { let w : F × (ι → F) → ℝ := λ z, eval_barycentric_coords ι ℝ F z.1 z.2 i,
    let z : E → F × (ι → F) :=
      (prod.map g (λ y, γ.approx_surrounding_points_at x y (γ.local_centering_density_mp x))) ∘
      (λ x, (x, x)),
    change smooth_on ((w ∘ z) ∘ prod.fst) (γ.local_centering_density_nhd x ×ˢ univ),
    rw prod_univ,
    refine cont_diff_on.comp _ cont_diff_fst.cont_diff_on subset.rfl,
    have h₁ := smooth_barycentric ι ℝ F (fintype.card_fin _),
    have h₂ : 𝒞 ∞ (eval i : (ι → ℝ) → ℝ) := cont_diff_apply _ _ i,
    refine (h₂.comp_cont_diff_on h₁).comp _ _,
    { have h₃ := (diag_preimage_prod_self (γ.local_centering_density_nhd x)).symm.subset,
      refine cont_diff_on.comp _ (cont_diff_id.prod cont_diff_id).cont_diff_on h₃,
      refine (γ.smooth_surrounded).cont_diff_on.prod_map (cont_diff.cont_diff_on _),
      exact γ.approx_surrounding_points_at_smooth x _, },
    { intros y hy,
      simp [z, γ.approx_surrounding_points_at_mem_affine_bases x y hy], }, },
  { exact delta_mollifier_smooth.comp cont_diff_snd, },
end

lemma local_centering_density_continuous (hy : y ∈ γ.local_centering_density_nhd x) :
  continuous (λ t, γ.local_centering_density x y t) :=
begin
  refine continuous_iff_continuous_at.mpr (λ t, _),
  have hyt : γ.local_centering_density_nhd x ×ˢ univ ∈ 𝓝 (y, t) :=
    mem_nhds_prod_iff'.mpr ⟨γ.local_centering_density_nhd x, univ,
      γ.local_centering_density_nhd_is_open x, hy, is_open_univ, mem_univ t, rfl.subset⟩,
  exact ((γ.local_centering_density_smooth_on x).continuous_on.continuous_at hyt).comp
    (continuous.prod.mk y).continuous_at,
end

@[simp] lemma local_centering_density_integral_eq_one (hy : y ∈ γ.local_centering_density_nhd x) :
  ∫ s in 0..1, γ.local_centering_density x y s = 1 :=
begin
  let n := γ.local_centering_density_mp x,
  simp only [γ.local_centering_density_spec x, prod.forall, exists_prop, gt_iff_lt,
    fintype.sum_apply, pi.smul_apply, algebra.id.smul_eq_mul, finset.sum_smul],
  rw interval_integral.integral_finset_sum,
  { have h : γ.approx_surrounding_points_at x y n ∈ affine_bases ι ℝ F :=
      γ.approx_surrounding_points_at_mem_affine_bases x y hy,
    simp_rw [← smul_eq_mul, interval_integral.integral_smul, delta_mollifier_integral_eq_one,
      algebra.id.smul_eq_mul, mul_one, eval_barycentric_coords_apply_of_mem_bases ι ℝ F (g y) h,
      affine_basis.coords_apply, affine_basis.sum_coord_apply_eq_one], },
  { simp_rw ← smul_eq_mul,
    refine λ i hi, (continuous.const_smul _ _).interval_integrable 0 1,
    exact delta_mollifier_smooth.continuous, },
end

@[simp] lemma local_centering_density_average (hy : y ∈ γ.local_centering_density_nhd x) :
  ∫ s in 0..1, γ.local_centering_density x y s • γ y s = g y :=
begin
  let n := γ.local_centering_density_mp x,
  simp only [γ.local_centering_density_spec x, prod.forall, exists_prop, gt_iff_lt,
    fintype.sum_apply, pi.smul_apply, algebra.id.smul_eq_mul, finset.sum_smul],
  rw interval_integral.integral_finset_sum,
  { simp_rw [mul_smul, interval_integral.integral_smul],
    change ∑ i, _ • (γ.approx_surrounding_points_at x y n i) = _,
    have h : γ.approx_surrounding_points_at x y n ∈ affine_bases ι ℝ F :=
      γ.approx_surrounding_points_at_mem_affine_bases x y hy,
    erw [eval_barycentric_coords_apply_of_mem_bases ι ℝ F (g y) h],
    simp only [affine_basis.coords_apply],
    exact affine_basis.linear_combination_coord_eq_self _ _, },
  { simp_rw mul_smul,
    refine λ i hi, ((continuous.smul _ (γ.continuous y)).const_smul _).interval_integrable 0 1,
    exact delta_mollifier_smooth.continuous, },
end

/-- Given `γ : smooth_surrounding_family g`, together with a point `x : E` and a map `f : ℝ → ℝ`,
`γ.is_centering_density x f` is the proposition that `f` is periodic, strictly positive, and
has integral one and that the average of `γₓ` with respect to the measure that `f` defines on
the circle is `g x`.

The continuity assumption is just a legacy convenience and should be dropped. -/
structure is_centering_density (x : E) (f : ℝ → ℝ) : Prop :=
(pos : ∀ t, 0 < f t)
(periodic : periodic f 1)
(integral_one : ∫ s in 0..1, f s = 1)
(average : ∫ s in 0..1, f s • γ x s = g x)
(continuous : continuous f) -- Can drop if/when have `interval_integrable.smul_continuous_on`

lemma is_centering_density_convex (x : E) : convex ℝ { f | γ.is_centering_density x f} :=
begin
  classical,
  rintros f ⟨hf₁, hf₂, hf₃, hf₄, hf₅⟩ k ⟨hk₁, hk₂, hk₃, hk₄, hk₅⟩ a b ha hb hab,
  have hf₆ : interval_integrable f volume 0 1,
  { apply interval_integrable_of_integral_ne_zero, rw hf₃, exact one_ne_zero, },
  have hf₇ : interval_integrable (f • γ x) volume 0 1 :=
    (hf₅.smul (γ.continuous x)).interval_integrable 0 1,
  have hk₆ : interval_integrable k volume 0 1,
  { apply interval_integrable_of_integral_ne_zero, rw hk₃, exact one_ne_zero, },
  have hk₇ : interval_integrable (k • γ x) volume 0 1 :=
    (hk₅.smul (γ.continuous x)).interval_integrable 0 1,
  exact
  { pos := λ t, convex_Ioi (0 : ℝ) (hf₁ t) (hk₁ t) ha hb hab,
    periodic := (hf₂.smul a).add (hk₂.smul b),
    integral_one :=
    begin
      simp_rw pi.add_apply,
      rw interval_integral.integral_add (hf₆.smul a) (hk₆.smul b),
      simp [interval_integral.integral_smul, hf₃, hk₃, hab],
    end,
    average :=
    begin
      simp_rw [pi.add_apply, pi.smul_apply, add_smul, smul_assoc],
      erw interval_integral.integral_add (hf₇.smul a) (hk₇.smul b),
      simp [interval_integral.integral_smul, ← add_smul, hf₄, hk₄, hab],
    end,
    continuous := continuous.add (hf₅.const_smul a) (hk₅.const_smul b) },
end

lemma exists_smooth_is_centering_density (x : E) : ∃ (U ∈ 𝓝 x) (f : E → ℝ → ℝ),
    smooth_on (uncurry f) (U ×ˢ (univ : set ℝ)) ∧ ∀ y ∈ U, γ.is_centering_density y (f y) :=
⟨γ.local_centering_density_nhd x,
  mem_nhds_iff.mpr
    ⟨_,
     subset.rfl,
     γ.local_centering_density_nhd_is_open x,
     γ.local_centering_density_nhd_self_mem x⟩,
  γ.local_centering_density x,
  γ.local_centering_density_smooth_on x,
  λ y hy, ⟨γ.local_centering_density_pos x y hy,
           γ.local_centering_density_periodic x y,
           γ.local_centering_density_integral_eq_one x y hy,
           γ.local_centering_density_average x y hy,
           γ.local_centering_density_continuous x y hy⟩⟩

/-- This the key construction. It represents a smooth probability distribution on the circle with
the property that:
`∫ s in 0..1, γ.centering_density x s • γ x s = g x`
for all `x : E` (see `centering_density_average` below). -/
def centering_density : E → ℝ → ℝ :=
classical.some
  (exists_cont_diff_of_convex₂ γ.is_centering_density_convex γ.exists_smooth_is_centering_density)

lemma centering_density_smooth :
  𝒞 ∞ $ uncurry (λ x t, γ.centering_density x t) :=
(classical.some_spec $
  exists_cont_diff_of_convex₂ γ.is_centering_density_convex γ.exists_smooth_is_centering_density).1

lemma is_centering_density_centering_density (x : E) :
  γ.is_centering_density x (γ.centering_density x) :=
(classical.some_spec $
  exists_cont_diff_of_convex₂ γ.is_centering_density_convex γ.exists_smooth_is_centering_density).2 x

@[simp] lemma centering_density_pos (t : ℝ) :
  0 < γ.centering_density x t :=
(γ.is_centering_density_centering_density x).pos t

lemma centering_density_periodic :
  periodic (γ.centering_density x) 1 :=
(γ.is_centering_density_centering_density x).periodic

@[simp] lemma centering_density_integral_eq_one :
  ∫ s in 0..1, γ.centering_density x s = 1 :=
(γ.is_centering_density_centering_density x).integral_one

@[simp] lemma centering_density_average :
  ∫ s in 0..1, γ.centering_density x s • γ x s = g x :=
(γ.is_centering_density_centering_density x).average

lemma centering_density_continuous :
  continuous (γ.centering_density x) :=
begin
  apply continuous_uncurry_left x,
  exact γ.centering_density_smooth.continuous,
end

lemma centering_density_interval_integrable (t₁ t₂ : ℝ) :
  interval_integrable (γ.centering_density x) volume t₁ t₂ :=
(γ.centering_density_continuous x).interval_integrable t₁ t₂

@[simp] lemma integral_add_one_centering_density (t : ℝ) :
  ∫ s in 0..t+1, γ.centering_density x s = (∫ s in 0..t, γ.centering_density x s) + 1 :=
begin
  have h₁ := γ.centering_density_interval_integrable x 0 t,
  have h₂ := γ.centering_density_interval_integrable x t (t + 1),
  simp [← integral_add_adjacent_intervals h₁ h₂,
    (γ.centering_density_periodic x).interval_integral_add_eq t 0],
end

lemma deriv_integral_centering_density_pos (t : ℝ) :
  0 < deriv (λ t, ∫ s in 0..t, γ.centering_density x s) t :=
begin
  rw interval_integral.deriv_integral_right (γ.centering_density_interval_integrable _ _ _)
    ((γ.centering_density_continuous x).strongly_measurable_at_filter volume (𝓝 t))
    (centering_density_continuous γ x).continuous_at,
  exact centering_density_pos γ x t
end

lemma strict_mono_integral_centering_density :
  strict_mono $ λ t, ∫ s in 0..t, γ.centering_density x s :=
strict_mono_of_deriv_pos (γ.deriv_integral_centering_density_pos x)

lemma surjective_integral_centering_density :
  surjective $ λ t, ∫ s in 0..t, γ.centering_density x s :=
begin
  have : continuous (λ t, ∫ s in 0..t, γ.centering_density x s),
  { exact continuous_primitive (γ.centering_density_interval_integrable x) 0, },
  exact equivariant_map.surjective
    ⟨λ t, ∫ s in 0..t, γ.centering_density x s, γ.integral_add_one_centering_density x⟩ this
end

/-- Given `γ : smooth_surrounding_family g`, `x ↦ γ.reparametrize x` is a smooth family of
diffeomorphisms of the circle such that reparametrizing `γₓ` by `γ.reparametrize x` gives a loop
with average `g x`.

This is the key construction and the main "output" of the reparametrization lemma. -/
def reparametrize : E → equivariant_equiv := λ x,
({ to_fun := λ t, ∫ s in 0..t, γ.centering_density x s,
  inv_fun := (strict_mono.order_iso_of_surjective _
    (γ.strict_mono_integral_centering_density x)
    (γ.surjective_integral_centering_density x)).symm,
  left_inv := strict_mono.order_iso_of_surjective_symm_apply_self _ _ _,
  right_inv := λ t, strict_mono.order_iso_of_surjective_self_symm_apply _ _ _ t,
  map_zero' := integral_same,
  eqv' := γ.integral_add_one_centering_density x, } : equivariant_equiv).symm

-- unused
lemma coe_reparametrize_symm :
  ((γ.reparametrize x).symm : ℝ → ℝ) = λ t, ∫ s in 0..t, γ.centering_density x s :=
rfl

-- unused
lemma reparametrize_symm_apply (t : ℝ) :
  (γ.reparametrize x).symm t = ∫ s in 0..t, γ.centering_density x s :=
rfl

-- unused
@[simp] lemma integral_reparametrize (t : ℝ) :
  ∫ s in 0..(γ.reparametrize x t), γ.centering_density x s = t :=
by simp [← reparametrize_symm_apply]

lemma has_deriv_at_reparametrize_symm (s : ℝ) :
  has_deriv_at (γ.reparametrize x).symm (γ.centering_density x s) s :=
integral_has_deriv_at_right
  (γ.centering_density_interval_integrable x 0 s)
  ((γ.centering_density_continuous x).strongly_measurable_at_filter _ _)
  (γ.centering_density_continuous x).continuous_at

lemma reparametrize_smooth :
  -- 𝒞 ∞ ↿γ.reparametrize :=
  𝒞 ∞ $ uncurry (λ x t, γ.reparametrize x t) :=
begin
  let f : E → ℝ → ℝ := λ x t, ∫ s in 0..t, γ.centering_density x s,
  change 𝒞 ⊤ (λ p : E × ℝ, (strict_mono.order_iso_of_surjective (f p.1) _ _).symm p.2),
  apply cont_diff_parametric_symm_of_deriv_pos,
  { exact cont_diff_parametric_primitive_of_cont_diff'' γ.centering_density_smooth 0 },
  { exact λ x, deriv_integral_centering_density_pos γ x }
end

@[simp] lemma reparametrize_average :
  ((γ x).reparam $ (γ.reparametrize x).equivariant_map).average = g x :=
begin
  change ∫ (s : ℝ) in 0..1, γ x (γ.reparametrize x s) = g x,
  have h₁ : ∀ s,
    s ∈ uIcc 0 (1 : ℝ) → has_deriv_at (γ.reparametrize x).symm (γ.centering_density x s) s :=
    λ s hs, γ.has_deriv_at_reparametrize_symm x s,
  have h₂ : continuous_on (λ s, γ.centering_density x s) (uIcc 0 1) :=
    (γ.centering_density_continuous x).continuous_on,
  have h₃ : continuous (λ s, γ x (γ.reparametrize x s)) :=
    (γ.continuous x).comp (continuous_uncurry_left x γ.reparametrize_smooth.continuous),
  rw [← (γ.reparametrize x).symm.map_zero, ← (γ.reparametrize x).symm.map_one,
    ← integral_comp_smul_deriv h₁ h₂ h₃],
  simp,
end

end smooth_surrounding_family


import galois.tactic
       galois.list.take_drop_lemmas

namespace nat

lemma lt_succ_ne_lt (a b : ℕ) :
  a < nat.succ b →  a ≠ b → a < b :=
begin
intros lt ne,
cases lt with x succ_lt,
{ contradiction, },
{ exact succ_lt, }
end

lemma pos_subtract (n k : ℕ)
  (Hn : 0 < n) (Hk : 0 < k)
  : (n - k) < n
:= begin
cases n, exfalso, apply (@@lt_irrefl _ _), apply Hn,
cases k, exfalso, apply (@@lt_irrefl _ _), apply Hk,
rename a n, rename a_1 k, clear Hn Hk,
rw nat.succ_sub_succ,
apply lt_of_le_of_lt, apply nat.sub_le_sub_left,
apply nat.zero_le, rw nat.sub_zero,
apply nat.lt_succ_self
end

lemma le_of_div_succ
  {n k p : ℕ}
  (H : n / k = nat.succ p)
 : k ≤ n
:=
begin
rw nat.div_def at H,
by_cases ((0 < k ∧ k ≤ n)) with h; simp [h] at H,
{ cases h,
  assumption,
},
{
  contradiction,
}
end

lemma drop_drops_one : forall index drop_size,
drop_size ≠ 0 →
drop_size ≤ index ->
index / drop_size = ((index - drop_size) / drop_size) + 1 :=
begin
intros, rw nat.div_def,
by_cases (0 < drop_size ∧ drop_size ≤ index) with h;
simp [h],
{
  exfalso, apply h,
  split,
  { destruct drop_size; intros; subst drop_size,
    {
      contradiction,
    },
    {
      simp [nat.lt_is_succ_le], have e : (nat.succ a_2) = 1 + a_2, simp,
        rw e, apply nat.le_add_right
    }
  },
  {
   assumption,
  }
}
end

lemma drops_decreases : forall drop_size index,
drop_size ≠ 0 →
drop_size ≤ index ->
((index - drop_size) / drop_size) < index /drop_size :=
begin
intros,
rw (drop_drops_one index); try {assumption},
apply nat.lt.base,
end

lemma lt_of_div_succ_2
  {n k p : ℕ}
  (H : n / k = p.succ)
 : (n - k) / k = p
:=
begin
cases k with k, simp at *, contradiction,
have dps := drop_drops_one n (nat.succ k),
have neO : nat.succ k ≠ 0, {contradiction},
specialize dps neO,
clear neO,
specialize dps (nat.le_of_div_succ H),
rw dps at H, rw <- nat.succ_eq_add_one at H,
injection H
end

lemma sub_le_le (m n k : ℕ)
 (Hmn : m ≤ n)
 (H : m ≤ k)
 : m + (n - k) ≤ n
:= begin
induction H,
apply le_of_eq,
apply nat.add_sub_of_le, assumption,
rw nat.sub_succ, apply le_trans,
tactic.swap, apply ih_1,
apply nat.add_le_add_left,
apply nat.pred_le,
end

lemma sub_pos_le (n k : ℕ) (Hk : 0 < k) (Hn : 0 < n)
  : n - k + 1 ≤ n
:= begin
cases k, exfalso, apply nat.lt_irrefl, assumption,
rw nat.sub_succ,
rw nat.add_comm,
rw nat.one_add,
cases n, exfalso, apply nat.lt_irrefl, assumption,
rename a k, rename a_1 n,
apply nat.succ_le_succ,
clear Hk Hn,
apply le_trans,
apply nat.pred_le_pred,
apply nat.sub_le,
apply le_refl,
end

lemma sub_1_succ : forall (n b : ℕ),
n - 1 - b = n - nat.succ b :=
begin
intros n,
induction n; intros,
{ dsimp, cases b,
  {refl},
  { simp }
},
{
  simp,
}
end

lemma lt_succ_both : forall a b, nat.succ a < nat.succ b -> a < b :=
begin
intros,  simp [nat.lt_is_succ_le, nat.succ_le_succ_iff] at *, apply a_1,
end

lemma max_subtract : forall (a b : nat),
(max a b) - b = a - b :=
begin
intros a b, unfold max,
apply (if H : a ≤ b then _ else _),
{ rw (if_pos H), rw nat.sub_eq_zero_of_le,
  rw nat.sub_eq_zero_of_le, assumption,
  apply le_refl,
 },
{ rw (if_neg H), }
end

lemma mul_2_add {n : nat} : n * 2 = n + n
:= begin
induction n, simp,
dsimp [has_mul.mul, nat.mul],
simp,
end

lemma le_add_r {x y : nat} : x ≤ x + y
:= begin
induction y, simp,
apply le_trans, assumption,
apply nat.add_le_add_left, constructor,
constructor,
end

lemma le_add_compat {x y x' y' : nat}
  (Hx : x ≤ x') (Hy : y ≤ y') : x + y ≤ x' + y'
:= begin
induction Hx, apply nat.add_le_add_left, assumption,
apply le_trans, apply ih_1,
simp, apply nat.add_le_add_left, constructor,
constructor,
end

lemma max_same (n : ℕ) : max n n = n
:= begin
unfold max, rw (if_pos (le_refl n)),
end

lemma max_add {m n k : ℕ} : max (m + k) (n + k) = max m n + k
:= begin
unfold max,
apply (if H : m ≤ n then _ else _),
rw (if_pos H), rw if_pos,
apply nat.add_le_add_right, assumption,
rw (if_neg H), rw if_neg,
intros contra, apply H, rw ← nat.add_le_add_iff_le_right,
assumption,
end

lemma neg_le_le (x y : ℕ) (H : ¬ x ≤ y)
  : y ≤ x
:= begin
apply (if H' : y ≤ x then _ else _),
assumption, exfalso,
have H1 := @nat.le_total x y,
induction H1; contradiction,
end

lemma max_mono {x y x' y' : ℕ} (Hx : x ≤ x') (Hy : y ≤ y')
  : max x y ≤ max x' y'
:= begin
unfold max,
apply (if H : x ≤ y then _ else _),
{ rw (if_pos H),
  apply (if H' : x' ≤ y' then _ else _),
  rw (if_pos H'), assumption,
  rw (if_neg H'), apply le_trans, assumption,
  apply nat.neg_le_le, assumption,
},
{ rw (if_neg H),
  apply (if H' : x' ≤ y' then _ else _),
  rw (if_pos H'), apply le_trans; assumption,
  rw (if_neg H'), assumption,
}
end

lemma max_0_r (x : ℕ) : max x 0 = x
:= begin
unfold max,
apply (if H : x ≤ 0 then _ else _),
rw (if_pos H), symmetry, rw ← nat.le_zero_iff,
assumption, rw if_neg, assumption,
end

end nat


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

! This file was ported from Lean 3 source module category_theory.essentially_small
! leanprover-community/mathlib commit f7707875544ef1f81b32cb68c79e0e24e45a0e76
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Small.Basic
import Mathlib.CategoryTheory.Category.ULift
import Mathlib.CategoryTheory.Skeletal
import Mathlib.Tactic.Constructor

/-!
# Essentially small categories.

A category given by `(C : Type u) [Category.{v} C]` is `w`-essentially small
if there exists a `SmallModel C : Type w` equipped with `[SmallCategory (SmallModel C)]`.

A category is `w`-locally small if every hom type is `w`-small.

The main theorem here is that a category is `w`-essentially small iff
the type `Skeleton C` is `w`-small, and `C` is `w`-locally small.
-/

universe w v v' u u'

open CategoryTheory

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

namespace CategoryTheory

/-- A category is `EssentiallySmall.{w}` if there exists
an equivalence to some `S : Type w` with `[SmallCategory S]`. -/
class EssentiallySmall (C : Type u) [Category.{v} C] : Prop where
  /-- An essentially small category is equivalent to some small category. -/
  equiv_smallCategory : ∃ (S : Type w) (_ : SmallCategory S), Nonempty (C ≌ S)
#align category_theory.essentially_small CategoryTheory.EssentiallySmall

/-- Constructor for `EssentiallySmall C` from an explicit small category witness. -/
theorem EssentiallySmall.mk' {C : Type u} [Category.{v} C] {S : Type w} [SmallCategory S]
    (e : C ≌ S) : EssentiallySmall.{w} C :=
  ⟨⟨S, _, ⟨e⟩⟩⟩
#align category_theory.essentially_small.mk' CategoryTheory.EssentiallySmall.mk'

/-- An arbitrarily chosen small model for an essentially small category.
-/
--@[nolint has_nonempty_instance]
def SmallModel (C : Type u) [Category.{v} C] [EssentiallySmall.{w} C] : Type w :=
  Classical.choose (@EssentiallySmall.equiv_smallCategory C _ _)
#align category_theory.small_model CategoryTheory.SmallModel

noncomputable instance smallCategorySmallModel (C : Type u) [Category.{v} C]
    [EssentiallySmall.{w} C] : SmallCategory (SmallModel C) :=
  Classical.choose (Classical.choose_spec (@EssentiallySmall.equiv_smallCategory C _ _))
#align category_theory.small_category_small_model CategoryTheory.smallCategorySmallModel

/-- The (noncomputable) categorical equivalence between
an essentially small category and its small model.
-/
noncomputable def equivSmallModel (C : Type u) [Category.{v} C] [EssentiallySmall.{w} C] :
    C ≌ SmallModel C :=
  Nonempty.some
    (Classical.choose_spec (Classical.choose_spec (@EssentiallySmall.equiv_smallCategory C _ _)))
#align category_theory.equiv_small_model CategoryTheory.equivSmallModel

theorem essentiallySmall_congr {C : Type u} [Category.{v} C] {D : Type u'} [Category.{v'} D]
    (e : C ≌ D) : EssentiallySmall.{w} C ↔ EssentiallySmall.{w} D := by
  fconstructor
  · rintro ⟨S, 𝒮, ⟨f⟩⟩
    skip
    exact EssentiallySmall.mk' (e.symm.trans f)
  · rintro ⟨S, 𝒮, ⟨f⟩⟩
    skip
    exact EssentiallySmall.mk' (e.trans f)
#align category_theory.essentially_small_congr CategoryTheory.essentiallySmall_congr

theorem Discrete.essentiallySmallOfSmall {α : Type u} [Small.{w} α] :
    EssentiallySmall.{w} (Discrete α) :=
  ⟨⟨Discrete (Shrink α), ⟨inferInstance, ⟨Discrete.equivalence (equivShrink _)⟩⟩⟩⟩
#align category_theory.discrete.essentially_small_of_small CategoryTheory.Discrete.essentiallySmallOfSmall

theorem essentiallySmallSelf : EssentiallySmall.{max w v u} C :=
  EssentiallySmall.mk' (AsSmall.equiv : C ≌ AsSmall.{w} C)
#align category_theory.essentially_small_self CategoryTheory.essentiallySmallSelf

/-- A category is `w`-locally small if every hom set is `w`-small.

See `ShrinkHoms C` for a category instance where every hom set has been replaced by a small model.
-/
class LocallySmall (C : Type u) [Category.{v} C] : Prop where
  /-- A locally small category has small hom-types. -/
  hom_small : ∀ X Y : C, Small.{w} (X ⟶ Y) := by infer_instance
#align category_theory.locally_small CategoryTheory.LocallySmall

instance (C : Type u) [Category.{v} C] [LocallySmall.{w} C] (X Y : C) : Small (X ⟶ Y) :=
  LocallySmall.hom_small X Y

theorem locallySmall_congr {C : Type u} [Category.{v} C] {D : Type u'} [Category.{v'} D]
    (e : C ≌ D) : LocallySmall.{w} C ↔ LocallySmall.{w} D := by
  fconstructor
  · rintro ⟨L⟩
    fconstructor
    intro X Y
    specialize L (e.inverse.obj X) (e.inverse.obj Y)
    refine' (small_congr _).mpr L
    exact equivOfFullyFaithful e.inverse
  · rintro ⟨L⟩
    fconstructor
    intro X Y
    specialize L (e.functor.obj X) (e.functor.obj Y)
    refine' (small_congr _).mpr L
    exact equivOfFullyFaithful e.functor
#align category_theory.locally_small_congr CategoryTheory.locallySmall_congr

instance (priority := 100) locallySmall_self (C : Type u) [Category.{v} C] : LocallySmall.{v} C
    where
#align category_theory.locally_small_self CategoryTheory.locallySmall_self

instance (priority := 100) locallySmall_of_essentiallySmall (C : Type u) [Category.{v} C]
    [EssentiallySmall.{w} C] : LocallySmall.{w} C :=
  (locallySmall_congr (equivSmallModel C)).mpr (CategoryTheory.locallySmall_self _)
#align category_theory.locally_small_of_essentially_small CategoryTheory.locallySmall_of_essentiallySmall

/-- We define a type alias `ShrinkHoms C` for `C`. When we have `LocallySmall.{w} C`,
we'll put a `Category.{w}` instance on `ShrinkHoms C`.
-/
--@[nolint has_nonempty_instance]
def ShrinkHoms (C : Type u) :=
  C
#align category_theory.shrink_homs CategoryTheory.ShrinkHoms

namespace ShrinkHoms

section

variable {C' : Type _}

-- a fresh variable with no category instance attached
/-- Help the typechecker by explicitly translating from `C` to `ShrinkHoms C`. -/
def toShrinkHoms {C' : Type _} (X : C') : ShrinkHoms C' :=
  X
#align category_theory.shrink_homs.to_shrink_homs CategoryTheory.ShrinkHoms.toShrinkHoms

/-- Help the typechecker by explicitly translating from `ShrinkHoms C` to `C`. -/
def fromShrinkHoms {C' : Type _} (X : ShrinkHoms C') : C' :=
  X
#align category_theory.shrink_homs.from_shrink_homs CategoryTheory.ShrinkHoms.fromShrinkHoms

@[simp]
theorem to_from (X : C') : fromShrinkHoms (toShrinkHoms X) = X :=
  rfl
#align category_theory.shrink_homs.to_from CategoryTheory.ShrinkHoms.to_from

@[simp]
theorem from_to (X : ShrinkHoms C') : toShrinkHoms (fromShrinkHoms X) = X :=
  rfl
#align category_theory.shrink_homs.from_to CategoryTheory.ShrinkHoms.from_to

end

variable [LocallySmall.{w} C]

@[simps]
noncomputable instance : Category.{w} (ShrinkHoms C)
    where
  Hom X Y := Shrink (fromShrinkHoms X ⟶ fromShrinkHoms Y)
  id X := equivShrink _ (𝟙 (fromShrinkHoms X))
  comp f g := equivShrink _ ((equivShrink _).symm f ≫ (equivShrink _).symm g)

/-- Implementation of `ShrinkHoms.equivalence`. -/
@[simps]
noncomputable def functor : C ⥤ ShrinkHoms C
    where
  obj X := toShrinkHoms X
  map {X Y} f := equivShrink (X ⟶ Y) f
#align category_theory.shrink_homs.functor CategoryTheory.ShrinkHoms.functor

/-- Implementation of `ShrinkHoms.equivalence`. -/
@[simps]
noncomputable def inverse : ShrinkHoms C ⥤ C
    where
  obj X := fromShrinkHoms X
  map {X Y} f := (equivShrink (fromShrinkHoms X ⟶ fromShrinkHoms Y)).symm f
#align category_theory.shrink_homs.inverse CategoryTheory.ShrinkHoms.inverse

/-- The categorical equivalence between `C` and `ShrinkHoms C`, when `C` is locally small.
-/
@[simps!]
noncomputable def equivalence : C ≌ ShrinkHoms C :=
  Equivalence.mk (functor C) (inverse C)
    (NatIso.ofComponents (fun X => Iso.refl X) <| by simp)
    (NatIso.ofComponents (fun X => Iso.refl X) <| by simp)
#align category_theory.shrink_homs.equivalence CategoryTheory.ShrinkHoms.equivalence

end ShrinkHoms

/-- A category is essentially small if and only if
the underlying type of its skeleton (i.e. the "set" of isomorphism classes) is small,
and it is locally small.
-/
theorem essentiallySmall_iff (C : Type u) [Category.{v} C] :
    EssentiallySmall.{w} C ↔ Small.{w} (Skeleton C) ∧ LocallySmall.{w} C := by
  -- This theorem is the only bit of real work in this file.
  fconstructor
  · intro h
    fconstructor
    · rcases h with ⟨S, 𝒮, ⟨e⟩⟩
      skip
      refine' ⟨⟨Skeleton S, ⟨_⟩⟩⟩
      exact e.skeletonEquiv
    · skip
      infer_instance
  · rintro ⟨⟨S, ⟨e⟩⟩, L⟩
    skip
    let e' := (ShrinkHoms.equivalence C).skeletonEquiv.symm
    letI : Category S := InducedCategory.category (e'.trans e).symm
    refine' ⟨⟨S, this, ⟨_⟩⟩⟩
    refine' (ShrinkHoms.equivalence C).trans <|
      (skeletonEquivalence (ShrinkHoms C)).symm.trans
        ((inducedFunctor (e'.trans e).symm).asEquivalence.symm)
#align category_theory.essentially_small_iff CategoryTheory.essentiallySmall_iff

/-- Any thin category is locally small.
-/
instance (priority := 100) locallySmall_of_thin {C : Type u} [Category.{v} C] [Quiver.IsThin C] :
    LocallySmall.{w} C where
#align category_theory.locally_small_of_thin CategoryTheory.locallySmall_of_thin

/--
A thin category is essentially small if and only if the underlying type of its skeleton is small.
-/
theorem essentiallySmall_iff_of_thin {C : Type u} [Category.{v} C] [Quiver.IsThin C] :
    EssentiallySmall.{w} C ↔ Small.{w} (Skeleton C) := by
  simp [essentiallySmall_iff, CategoryTheory.locallySmall_of_thin]
#align category_theory.essentially_small_iff_of_thin CategoryTheory.essentiallySmall_iff_of_thin

end CategoryTheory