/-
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
-/
import topology.continuous_on
import topology.separation
import group_theory.submonoid.operations
import algebra.group.prod
import algebra.pointwise
import algebra.big_operators.finprod

/-!
# Theory of topological monoids

In this file we define mixin classes `has_continuous_mul` and `has_continuous_add`. While in many
applications the underlying type is a monoid (multiplicative or additive), we do not require this in
the definitions.
-/

universes u v
open classical set filter topological_space
open_locale classical topological_space big_operators pointwise

variables {ι α X M N : Type*} [topological_space X]

@[to_additive]
lemma continuous_one [topological_space M] [has_one M] : continuous (1 : X → M) :=
@continuous_const _ _ _ _ 1

/-- Basic hypothesis to talk about a topological additive monoid or a topological additive
semigroup. A topological additive monoid over `M`, for example, is obtained by requiring both the
instances `add_monoid M` and `has_continuous_add M`. -/
class has_continuous_add (M : Type u) [topological_space M] [has_add M] : Prop :=
(continuous_add : continuous (λ p : M × M, p.1 + p.2))

/-- Basic hypothesis to talk about a topological monoid or a topological semigroup.
A topological monoid over `M`, for example, is obtained by requiring both the instances `monoid M`
and `has_continuous_mul M`. -/
@[to_additive]
class has_continuous_mul (M : Type u) [topological_space M] [has_mul M] : Prop :=
(continuous_mul : continuous (λ p : M × M, p.1 * p.2))

section has_continuous_mul

variables [topological_space M] [has_mul M] [has_continuous_mul M]

@[to_additive]
lemma continuous_mul : continuous (λp:M×M, p.1 * p.2) :=
has_continuous_mul.continuous_mul

@[continuity, to_additive]
lemma continuous.mul {f g : X → M} (hf : continuous f) (hg : continuous g) :
  continuous (λx, f x * g x) :=
continuous_mul.comp (hf.prod_mk hg : _)

@[to_additive]
lemma continuous_mul_left (a : M) : continuous (λ b:M, a * b) :=
continuous_const.mul continuous_id

@[to_additive]
lemma continuous_mul_right (a : M) : continuous (λ b:M, b * a) :=
continuous_id.mul continuous_const

@[to_additive]
lemma continuous_on.mul {f g : X → M} {s : set X} (hf : continuous_on f s)
  (hg : continuous_on g s) :
  continuous_on (λx, f x * g x) s :=
(continuous_mul.comp_continuous_on (hf.prod hg) : _)

@[to_additive]
lemma tendsto_mul {a b : M} : tendsto (λp:M×M, p.fst * p.snd) (𝓝 (a, b)) (𝓝 (a * b)) :=
continuous_iff_continuous_at.mp has_continuous_mul.continuous_mul (a, b)

@[to_additive]
lemma filter.tendsto.mul {f g : α → M} {x : filter α} {a b : M}
  (hf : tendsto f x (𝓝 a)) (hg : tendsto g x (𝓝 b)) :
  tendsto (λx, f x * g x) x (𝓝 (a * b)) :=
tendsto_mul.comp (hf.prod_mk_nhds hg)

@[to_additive]
lemma filter.tendsto.const_mul (b : M) {c : M} {f : α → M} {l : filter α}
  (h : tendsto (λ (k:α), f k) l (𝓝 c)) : tendsto (λ (k:α), b * f k) l (𝓝 (b * c)) :=
tendsto_const_nhds.mul h

@[to_additive]
lemma filter.tendsto.mul_const (b : M) {c : M} {f : α → M} {l : filter α}
  (h : tendsto (λ (k:α), f k) l (𝓝 c)) : tendsto (λ (k:α), f k * b) l (𝓝 (c * b)) :=
h.mul tendsto_const_nhds

@[to_additive]
lemma continuous_at.mul {f g : X → M} {x : X} (hf : continuous_at f x) (hg : continuous_at g x) :
  continuous_at (λx, f x * g x) x :=
hf.mul hg

@[to_additive]
lemma continuous_within_at.mul {f g : X → M} {s : set X} {x : X} (hf : continuous_within_at f s x)
  (hg : continuous_within_at g s x) :
  continuous_within_at (λx, f x * g x) s x :=
hf.mul hg

@[to_additive]
instance [topological_space N] [has_mul N] [has_continuous_mul N] : has_continuous_mul (M × N) :=
⟨((continuous_fst.comp continuous_fst).mul (continuous_fst.comp continuous_snd)).prod_mk
 ((continuous_snd.comp continuous_fst).mul (continuous_snd.comp continuous_snd))⟩

@[to_additive]
instance pi.has_continuous_mul {C : ι → Type*} [∀ i, topological_space (C i)]
  [∀ i, has_mul (C i)] [∀ i, has_continuous_mul (C i)] : has_continuous_mul (Π i, C i) :=
{ continuous_mul := continuous_pi (λ i, continuous.mul
    ((continuous_apply i).comp continuous_fst) ((continuous_apply i).comp continuous_snd)) }

/-- A version of `pi.has_continuous_mul` for non-dependent functions. It is needed because sometimes
Lean fails to use `pi.has_continuous_mul` for non-dependent functions. -/
@[to_additive "A version of `pi.has_continuous_add` for non-dependent functions. It is needed
because sometimes Lean fails to use `pi.has_continuous_add` for non-dependent functions."]
instance pi.has_continuous_mul' : has_continuous_mul (ι → M) :=
pi.has_continuous_mul

@[priority 100, to_additive]
instance has_continuous_mul_of_discrete_topology [topological_space N]
  [has_mul N] [discrete_topology N] : has_continuous_mul N :=
⟨continuous_of_discrete_topology⟩

open_locale filter

open function

@[to_additive]
lemma has_continuous_mul.of_nhds_one {M : Type u} [monoid M] [topological_space M]
  (hmul : tendsto (uncurry ((*) : M → M → M)) (𝓝 1 ×ᶠ 𝓝 1) $ 𝓝 1)
  (hleft : ∀ x₀ : M, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1))
  (hright : ∀ x₀ : M, 𝓝 x₀ = map (λ x, x*x₀) (𝓝 1)) : has_continuous_mul M :=
⟨begin
    rw continuous_iff_continuous_at,
    rintros ⟨x₀, y₀⟩,
    have key : (λ p : M × M, x₀ * p.1 * (p.2 * y₀)) = ((λ x, x₀*x) ∘ (λ x, x*y₀)) ∘ (uncurry (*)),
    { ext p, simp [uncurry, mul_assoc] },
    have key₂ : (λ x, x₀*x) ∘ (λ x, y₀*x) = λ x, (x₀ *y₀)*x,
    { ext x, simp },
    calc map (uncurry (*)) (𝓝 (x₀, y₀))
        = map (uncurry (*)) (𝓝 x₀ ×ᶠ 𝓝 y₀) : by rw nhds_prod_eq
    ... = map (λ (p : M × M), x₀ * p.1 * (p.2 * y₀)) ((𝓝 1) ×ᶠ (𝓝 1))
            : by rw [uncurry, hleft x₀, hright y₀, prod_map_map_eq, filter.map_map]
    ... = map ((λ x, x₀ * x) ∘ λ x, x * y₀) (map (uncurry (*)) (𝓝 1 ×ᶠ 𝓝 1))
            : by { rw [key, ← filter.map_map], }
    ... ≤ map ((λ (x : M), x₀ * x) ∘ λ x, x * y₀) (𝓝 1) : map_mono hmul
    ... = 𝓝 (x₀*y₀) : by rw [← filter.map_map, ← hright, hleft y₀, filter.map_map, key₂, ← hleft]
  end⟩

@[to_additive]
lemma has_continuous_mul_of_comm_of_nhds_one (M : Type u) [comm_monoid M] [topological_space M]
  (hmul : tendsto (uncurry ((*) : M → M → M)) (𝓝 1 ×ᶠ 𝓝 1) (𝓝 1))
  (hleft : ∀ x₀ : M, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1)) : has_continuous_mul M :=
begin
  apply has_continuous_mul.of_nhds_one hmul hleft,
  intros x₀,
  simp_rw [mul_comm, hleft x₀]
end

end has_continuous_mul

section pointwise_limits

variables (M₁ M₂ : Type*) [topological_space M₂] [t2_space M₂]

@[to_additive] lemma is_closed_set_of_map_one [has_one M₁] [has_one M₂] :
  is_closed {f : M₁ → M₂ | f 1 = 1} :=
is_closed_eq (continuous_apply 1) continuous_const

@[to_additive] lemma is_closed_set_of_map_mul [has_mul M₁] [has_mul M₂] [has_continuous_mul M₂] :
  is_closed {f : M₁ → M₂ | ∀ x y, f (x * y) = f x * f y} :=
begin
  simp only [set_of_forall],
  exact is_closed_Inter (λ x, is_closed_Inter (λ y, is_closed_eq (continuous_apply _)
    ((continuous_apply _).mul (continuous_apply _))))
end

variables {M₁ M₂} [mul_one_class M₁] [mul_one_class M₂] [has_continuous_mul M₂]
  {F : Type*} [monoid_hom_class F M₁ M₂] {l : filter α}

/-- Construct a bundled monoid homomorphism `M₁ →* M₂` from a function `f` and a proof that it
belongs to the closure of the range of the coercion from `M₁ →* M₂` (or another type of bundled
homomorphisms that has a `monoid_hom_class` instance) to `M₁ → M₂`. -/
@[to_additive "Construct a bundled additive monoid homomorphism `M₁ →+ M₂` from a function `f`
and a proof that it belongs to the closure of the range of the coercion from `M₁ →+ M₂` (or another
type of bundled homomorphisms that has a `add_monoid_hom_class` instance) to `M₁ → M₂`.",
  simps { fully_applied := ff }]
def monoid_hom_of_mem_closure_range_coe (f : M₁ → M₂)
  (hf : f ∈ closure (range (λ (f : F) (x : M₁), f x))) : M₁ →* M₂ :=
{ to_fun := f,
  map_one' := (is_closed_set_of_map_one M₁ M₂).closure_subset_iff.2 (range_subset_iff.2 map_one) hf,
  map_mul' := (is_closed_set_of_map_mul M₁ M₂).closure_subset_iff.2
    (range_subset_iff.2 map_mul) hf }

/-- Construct a bundled monoid homomorphism from a pointwise limit of monoid homomorphisms. -/
@[to_additive "Construct a bundled additive monoid homomorphism from a pointwise limit of additive
monoid homomorphisms", simps { fully_applied := ff }]
def monoid_hom_of_tendsto (f : M₁ → M₂) (g : α → F) [l.ne_bot]
  (h : tendsto (λ a x, g a x) l (𝓝 f)) : M₁ →* M₂ :=
monoid_hom_of_mem_closure_range_coe f $ mem_closure_of_tendsto h $
  eventually_of_forall $ λ a, mem_range_self _

variables (M₁ M₂)

@[to_additive] lemma monoid_hom.is_closed_range_coe :
  is_closed (range (coe_fn : (M₁ →* M₂) → (M₁ → M₂))) :=
is_closed_of_closure_subset $ λ f hf, ⟨monoid_hom_of_mem_closure_range_coe f hf, rfl⟩

end pointwise_limits

namespace submonoid

@[to_additive] instance [topological_space α] [monoid α] [has_continuous_mul α] (S : submonoid α) :
  has_continuous_mul S :=
{ continuous_mul :=
  begin
    rw embedding_subtype_coe.to_inducing.continuous_iff,
    exact (continuous_subtype_coe.comp continuous_fst).mul
      (continuous_subtype_coe.comp continuous_snd)
  end }

end submonoid

section has_continuous_mul

variables [topological_space M] [monoid M] [has_continuous_mul M]

@[to_additive]
lemma submonoid.top_closure_mul_self_subset (s : submonoid M) :
  (closure (s : set M)) * closure (s : set M) ⊆ closure (s : set M) :=
calc
(closure (s : set M)) * closure (s : set M)
    = (λ p : M × M, p.1 * p.2) '' (closure ((s : set M) ×ˢ (s : set M))) : by simp [closure_prod_eq]
... ⊆ closure ((λ p : M × M, p.1 * p.2) '' ((s : set M) ×ˢ (s : set M))) :
  image_closure_subset_closure_image continuous_mul
... = closure s : by simp [s.coe_mul_self_eq]

@[to_additive]
lemma submonoid.top_closure_mul_self_eq (s : submonoid M) :
  (closure (s : set M)) * closure (s : set M) = closure (s : set M) :=
subset.antisymm
  s.top_closure_mul_self_subset
  (λ x hx, ⟨x, 1, hx, subset_closure s.one_mem, mul_one _⟩)

/-- The (topological-space) closure of a submonoid of a space `M` with `has_continuous_mul` is
itself a submonoid. -/
@[to_additive "The (topological-space) closure of an additive submonoid of a space `M` with
`has_continuous_add` is itself an additive submonoid."]
def submonoid.topological_closure (s : submonoid M) : submonoid M :=
{ carrier := closure (s : set M),
  one_mem' := subset_closure s.one_mem,
  mul_mem' := λ a b ha hb, s.top_closure_mul_self_subset ⟨a, b, ha, hb, rfl⟩ }

@[to_additive]
instance submonoid.topological_closure_has_continuous_mul (s : submonoid M) :
  has_continuous_mul (s.topological_closure) :=
{ continuous_mul :=
  begin
    apply continuous_induced_rng,
    change continuous (λ p : s.topological_closure × s.topological_closure, (p.1 : M) * (p.2 : M)),
    continuity,
  end }

@[to_additive]
lemma submonoid.submonoid_topological_closure (s : submonoid M) :
  s ≤ s.topological_closure :=
subset_closure

@[to_additive]
lemma submonoid.is_closed_topological_closure (s : submonoid M) :
  is_closed (s.topological_closure : set M) :=
by convert is_closed_closure

@[to_additive]
lemma submonoid.topological_closure_minimal
  (s : submonoid M) {t : submonoid M} (h : s ≤ t) (ht : is_closed (t : set M)) :
  s.topological_closure ≤ t :=
closure_minimal h ht

@[to_additive exists_open_nhds_zero_half]
lemma exists_open_nhds_one_split {s : set M} (hs : s ∈ 𝓝 (1 : M)) :
  ∃ V : set M, is_open V ∧ (1 : M) ∈ V ∧ ∀ (v ∈ V) (w ∈ V), v * w ∈ s :=
have ((λa:M×M, a.1 * a.2) ⁻¹' s) ∈ 𝓝 ((1, 1) : M × M),
  from tendsto_mul (by simpa only [one_mul] using hs),
by simpa only [prod_subset_iff] using exists_nhds_square this

@[to_additive exists_nhds_zero_half]
lemma exists_nhds_one_split {s : set M} (hs : s ∈ 𝓝 (1 : M)) :
  ∃ V ∈ 𝓝 (1 : M), ∀ (v ∈ V) (w ∈ V), v * w ∈ s :=
let ⟨V, Vo, V1, hV⟩ := exists_open_nhds_one_split hs
in ⟨V, is_open.mem_nhds Vo V1, hV⟩

@[to_additive exists_nhds_zero_quarter]
lemma exists_nhds_one_split4 {u : set M} (hu : u ∈ 𝓝 (1 : M)) :
  ∃ V ∈ 𝓝 (1 : M),
    ∀ {v w s t}, v ∈ V → w ∈ V → s ∈ V → t ∈ V → v * w * s * t ∈ u :=
begin
  rcases exists_nhds_one_split hu with ⟨W, W1, h⟩,
  rcases exists_nhds_one_split W1 with ⟨V, V1, h'⟩,
  use [V, V1],
  intros v w s t v_in w_in s_in t_in,
  simpa only [mul_assoc] using h _ (h' v v_in w w_in) _ (h' s s_in t t_in)
end

/-- Given a neighborhood `U` of `1` there is an open neighborhood `V` of `1`
such that `VV ⊆ U`. -/
@[to_additive "Given a open neighborhood `U` of `0` there is a open neighborhood `V` of `0`
  such that `V + V ⊆ U`."]
lemma exists_open_nhds_one_mul_subset {U : set M} (hU : U ∈ 𝓝 (1 : M)) :
  ∃ V : set M, is_open V ∧ (1 : M) ∈ V ∧ V * V ⊆ U :=
begin
  rcases exists_open_nhds_one_split hU with ⟨V, Vo, V1, hV⟩,
  use [V, Vo, V1],
  rintros _ ⟨x, y, hx, hy, rfl⟩,
  exact hV _ hx _ hy
end

@[to_additive]
lemma tendsto_list_prod {f : ι → α → M} {x : filter α} {a : ι → M} :
  ∀ l:list ι, (∀i∈l, tendsto (f i) x (𝓝 (a i))) →
    tendsto (λb, (l.map (λc, f c b)).prod) x (𝓝 ((l.map a).prod))
| []       _ := by simp [tendsto_const_nhds]
| (f :: l) h :=
  begin
    simp only [list.map_cons, list.prod_cons],
    exact (h f (list.mem_cons_self _ _)).mul
      (tendsto_list_prod l (assume c hc, h c (list.mem_cons_of_mem _ hc)))
  end

@[to_additive]
lemma continuous_list_prod {f : ι → X → M} (l : list ι)
  (h : ∀i∈l, continuous (f i)) :
  continuous (λa, (l.map (λi, f i a)).prod) :=
continuous_iff_continuous_at.2 $ assume x, tendsto_list_prod l $ assume c hc,
  continuous_iff_continuous_at.1 (h c hc) x

@[continuity, to_additive continuous_nsmul]
lemma continuous_pow : ∀ n : ℕ, continuous (λ a : M, a ^ n)
| 0 := by simpa using continuous_const
| (k+1) := by { simp only [pow_succ], exact continuous_id.mul (continuous_pow _) }

@[continuity, to_additive continuous.nsmul]
lemma continuous.pow {f : X → M} (h : continuous f) (n : ℕ) :
  continuous (λ b, (f b) ^ n) :=
(continuous_pow n).comp h

@[to_additive continuous_on_nsmul]
lemma continuous_on_pow {s : set M} (n : ℕ) : continuous_on (λ x, x ^ n) s :=
(continuous_pow n).continuous_on

@[to_additive continuous_at_nsmul]
lemma continuous_at_pow (x : M) (n : ℕ) : continuous_at (λ x, x ^ n) x :=
(continuous_pow n).continuous_at

@[to_additive filter.tendsto.nsmul]
lemma filter.tendsto.pow {l : filter α} {f : α → M} {x : M} (hf : tendsto f l (𝓝 x)) (n : ℕ) :
  tendsto (λ x, f x ^ n) l (𝓝 (x ^ n)) :=
(continuous_at_pow _ _).tendsto.comp hf

@[to_additive continuous_within_at.nsmul]
lemma continuous_within_at.pow {f : X → M} {x : X} {s : set X} (hf : continuous_within_at f s x)
  (n : ℕ) : continuous_within_at (λ x, f x ^ n) s x :=
hf.pow n

@[to_additive continuous_at.nsmul]
lemma continuous_at.pow {f : X → M} {x : X} (hf : continuous_at f x) (n : ℕ) :
  continuous_at (λ x, f x ^ n) x :=
hf.pow n

@[to_additive continuous_on.nsmul]
lemma continuous_on.pow {f : X → M} {s : set X} (hf : continuous_on f s) (n : ℕ) :
  continuous_on (λ x, f x ^ n) s :=
λ x hx, (hf x hx).pow n

end has_continuous_mul

section op

open mul_opposite

/-- Put the same topological space structure on the opposite monoid as on the original space. -/
instance [_i : topological_space α] : topological_space αᵐᵒᵖ :=
topological_space.induced (unop : αᵐᵒᵖ → α) _i

variables [topological_space α]

lemma continuous_unop : continuous (unop : αᵐᵒᵖ → α) := continuous_induced_dom
lemma continuous_op : continuous (op : α → αᵐᵒᵖ) := continuous_induced_rng continuous_id

variables [monoid α] [has_continuous_mul α]

/-- If multiplication is continuous in the monoid `α`, then it also is in the monoid `αᵐᵒᵖ`. -/
instance : has_continuous_mul αᵐᵒᵖ :=
⟨ let h₁ := @continuous_mul α _ _ _ in
  let h₂ : continuous (λ p : α × α, _) := continuous_snd.prod_mk continuous_fst in
  continuous_induced_rng $ (h₁.comp h₂).comp (continuous_unop.prod_map continuous_unop) ⟩

end op

namespace units

open mul_opposite

variables [topological_space α] [monoid α]

/-- The units of a monoid are equipped with a topology, via the embedding into `α × α`. -/
instance : topological_space αˣ :=
topological_space.induced (embed_product α) (by apply_instance)

lemma continuous_embed_product : continuous (embed_product α) :=
continuous_induced_dom

lemma continuous_coe : continuous (coe : αˣ → α) :=
by convert continuous_fst.comp continuous_induced_dom

variables [has_continuous_mul α]

/-- If multiplication on a monoid is continuous, then multiplication on the units of the monoid,
with respect to the induced topology, is continuous.

Inversion is also continuous, but we register this in a later file, `topology.algebra.group`,
because the predicate `has_continuous_inv` has not yet been defined. -/
instance : has_continuous_mul αˣ :=
⟨ let h := @continuous_mul (α × αᵐᵒᵖ) _ _ _ in
  continuous_induced_rng $ h.comp $ continuous_embed_product.prod_map continuous_embed_product ⟩

end units

section

variables [topological_space M] [comm_monoid M]

@[to_additive]
lemma submonoid.mem_nhds_one (S : submonoid M) (oS : is_open (S : set M)) :
  (S : set M) ∈ 𝓝 (1 : M) :=
is_open.mem_nhds oS S.one_mem

variable [has_continuous_mul M]

@[to_additive]
lemma tendsto_multiset_prod {f : ι → α → M} {x : filter α} {a : ι → M} (s : multiset ι) :
  (∀ i ∈ s, tendsto (f i) x (𝓝 (a i))) →
    tendsto (λb, (s.map (λc, f c b)).prod) x (𝓝 ((s.map a).prod)) :=
by { rcases s with ⟨l⟩, simpa using tendsto_list_prod l }

@[to_additive]
lemma tendsto_finset_prod {f : ι → α → M} {x : filter α} {a : ι → M} (s : finset ι) :
  (∀ i ∈ s, tendsto (f i) x (𝓝 (a i))) → tendsto (λb, ∏ c in s, f c b) x (𝓝 (∏ c in s, a c)) :=
tendsto_multiset_prod _

@[continuity, to_additive]
lemma continuous_multiset_prod {f : ι → X → M} (s : multiset ι) :
  (∀i ∈ s, continuous (f i)) → continuous (λ a, (s.map (λ i, f i a)).prod) :=
by { rcases s with ⟨l⟩, simpa using continuous_list_prod l }

@[continuity, to_additive]
lemma continuous_finset_prod {f : ι → X → M} (s : finset ι) :
  (∀ i ∈ s, continuous (f i)) → continuous (λa, ∏ i in s, f i a) :=
continuous_multiset_prod _

open function

@[to_additive] lemma continuous_finprod {f : ι → X → M} (hc : ∀ i, continuous (f i))
  (hf : locally_finite (λ i, mul_support (f i))) :
  continuous (λ x, ∏ᶠ i, f i x) :=
begin
  refine continuous_iff_continuous_at.2 (λ x, _),
  rcases hf x with ⟨U, hxU, hUf⟩,
  have : continuous_at (λ x, ∏ i in hUf.to_finset, f i x) x,
    from tendsto_finset_prod _ (λ i hi, (hc i).continuous_at),
  refine this.congr (mem_of_superset hxU $ λ y hy, _),
  refine (finprod_eq_prod_of_mul_support_subset _ (λ i hi, _)).symm,
  rw [hUf.coe_to_finset],
  exact ⟨y, hi, hy⟩
end

@[to_additive] lemma continuous_finprod_cond {f : ι → X → M} {p : ι → Prop}
  (hc : ∀ i, p i → continuous (f i)) (hf : locally_finite (λ i, mul_support (f i))) :
  continuous (λ x, ∏ᶠ i (hi : p i), f i x) :=
begin
  simp only [← finprod_subtype_eq_finprod_cond],
  exact continuous_finprod (λ i, hc i i.2) (hf.comp_injective subtype.coe_injective)
end

end

instance additive.has_continuous_add {M} [h : topological_space M] [has_mul M]
  [has_continuous_mul M] : @has_continuous_add (additive M) h _ :=
{ continuous_add := @continuous_mul M _ _ _ }

instance multiplicative.has_continuous_mul {M} [h : topological_space M] [has_add M]
  [has_continuous_add M] : @has_continuous_mul (multiplicative M) h _ :=
{ continuous_mul := @continuous_add M _ _ _ }

section lattice_ops

variables [has_mul M] [has_mul N] {ts : set (topological_space M)}
  (h : Π t ∈ ts, @has_continuous_mul M t _) {ts' : ι → topological_space M}
  (h' : Π i, @has_continuous_mul M (ts' i) _) {t₁ t₂ : topological_space M}
  (h₁ : @has_continuous_mul M t₁ _) (h₂ : @has_continuous_mul M t₂ _)
  {t : topological_space N} [has_continuous_mul N] {F : Type*}
  [mul_hom_class F M N] (f : F)

@[to_additive] lemma has_continuous_mul_Inf :
  @has_continuous_mul M (Inf ts) _ :=
{ continuous_mul := continuous_Inf_rng (λ t ht, continuous_Inf_dom₂ ht ht
  (@has_continuous_mul.continuous_mul M t _ (h t ht))) }

include h'

@[to_additive] lemma has_continuous_mul_infi :
  @has_continuous_mul M (⨅ i, ts' i) _ :=
by {rw ← Inf_range, exact has_continuous_mul_Inf (set.forall_range_iff.mpr h')}

omit h'

include h₁ h₂

@[to_additive] lemma has_continuous_mul_inf :
  @has_continuous_mul M (t₁ ⊓ t₂) _ :=
by {rw inf_eq_infi, refine has_continuous_mul_infi (λ b, _), cases b; assumption}

omit h₁ h₂

@[to_additive] lemma has_continuous_mul_induced :
  @has_continuous_mul M (t.induced f) _ :=
{ continuous_mul :=
    begin
      letI : topological_space M := t.induced f,
      refine continuous_induced_rng _,
      simp_rw [function.comp, map_mul],
      change continuous ((λ p : N × N, p.1 * p.2) ∘ (prod.map f f)),
      exact continuous_mul.comp (continuous_induced_dom.prod_map continuous_induced_dom),
    end }

end lattice_ops


/-
Copyright (c) 2020 Kexing Ying and Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Kevin Buzzard
-/
import .extra
import data.set.finite
import algebra.big_operators
import data.support
import data.finsupp

/-!
# Finite sums over types and sets

γe define sums over types and subsets of types, with no finiteness hypotheses. All infinite
sums are defined to be junk values (i.e. zero). This approach is sometimes easier to use
than `finset.sum` when issues arise with `finset` and `fintype` being data.

## Main definitions

βariables:`

`(α : Type*)`
`(s : set α)`
`(M : Type*) [add_comm_monoid M]`
`(f : α → M)`

Definitions in this file:

* `univ' α : finset α` : `α` as a finset if `α` is finite, and the empty finset otherwise

* `finsum f : M` : the sum of `f x` as `x` ranges over the support of `f`, if it's finite.
   Zero otherwise.

* `finsum_in s f : M` : the sum of `f x` as `x` ranges over the elements of `s` for which `f x ≠ 0`,
  if this is a finite sum. Zero otherwise.

## Notation

* `∑ᶠ i, f i` and `∑ᶠ i : α, f i` for `finsum f`

* `∑ᶠ i in s, f i` for `finsum_in s f`

## Implementation notes

There is no `finprod` right now. This is because `function.support` and `finsupp` etc
are all focussed on 0, and there are no analogous definitions for 1.

## Todo

γe did not add `is_finite (X : Type*) : Prop`, because it is simply `nonempty (fintype X)`.
There is work on `fincard` in the pipeline, which returns the cardinality of `X` if it
is finite, and 0 otherwise.

## Tags

finsum, finsum_in, univ', finiteness
-/

open_locale classical

universes u v w

/-! # finset.univ' -- noncomputable univ (empty set if infinite) -/

namespace finset

/-- `univ' α` is the finset corresponding to all of α if α is finite, and the empty set otherwise.
Note that it is noncomputable -/
noncomputable def univ' (α : Type*) : finset α :=
if h : nonempty (fintype α) then (classical.choice h).elems else ∅

/-- `set.to_finset s` is the finset corresponding to `s` if `s` is finite, and the empty set
    otherwise -/
noncomputable def set.to_finset {α : Type*} (s : set α) : finset α :=
if h : s.finite then h.to_finset else ∅

variable {α : Type*}

/-- `univ' α` is finset.univ if `α` is a fintype. -/
lemma univ'_eq_univ [h : fintype α] : univ' α = univ :=
by convert (dif_pos (nonempty.intro h))

lemma univ'_eq_empty (h : ¬ nonempty (fintype α)) : univ' α = ∅ :=
dif_neg h

@[simp] lemma mem_univ' [h : fintype α] (x : α) : x ∈ univ' α :=
(@univ'_eq_univ _ h).symm ▸ mem_univ _

end finset

/-! # noncomputable finite sums -/

section finsum

variables {α : Type*} {M : Type*} [add_comm_monoid M]

/-- Sum of `f x` as `x` ranges over the elements of the support of `f`, if it's finite. Zero
  otherwise. -/
noncomputable def finsum (f : α → M) : M :=
if h : (function.support f).finite then finset.sum (h.to_finset) f else 0

/-- Sum of `f x` for `x ∈ s`, if `s ∩ f.support` is finite. Zero if it's infinite.  -/
noncomputable def finsum_in (s : set α) (f : α → M) : M :=
finsum (λ x, if x ∈ s then f x else 0)

localized "notation `∑ᶠ` binders `, ` r:(scoped:67 f, finsum f) := r"
  in big_operators

localized "notation `∑ᶠ` binders ` in ` s `, ` r:(scoped:67 f, finsum_in s f) := r"
  in big_operators

open_locale big_operators

lemma finsum_def (f : α → M) :
  ∑ᶠ i : α, f i = if h : (function.support f).finite then finset.sum (h.to_finset) f else 0 := rfl

lemma finsum_in_def (s : set α) (f : α → M) :
  ∑ᶠ i in s, f i = finsum (λ x, if x ∈ s then f x else 0) := rfl

-- function.support doesn't import data.finsupp and vice versa
-- so the lemmas can't go in either place
lemma function.support_eq_support {α : Type*} {β : Type*} [has_zero β] (f : α →₀ β) :
  function.support f = f.support :=
set.ext $ λ x, finsupp.mem_support_iff.symm

namespace finsupp

variables {β : Type*} [has_zero β]

lemma support_finite (f : α →₀ β) : (function.support f).finite :=
by { rw function.support_eq_support, exact f.support.finite_to_set }

/-- The natural `finsupp` induced by the function `f` given that it has finite support. -/
noncomputable def of_support_finite
  {f : α → β} (hf : (function.support f).finite) : α →₀ β :=
{ support := hf.to_finset,
  to_fun := f,
  mem_support_to_fun := λ a, set.finite.mem_to_finset hf }

lemma of_support_finite_def {f : α → β} {hf : (function.support f).finite} :
  (of_support_finite hf : α → β) = f := rfl

end finsupp

lemma finsum_eq_finsupp_sum (f : α →₀ M) : ∑ᶠ i : α, f i = finsupp.sum f (λ x m, m) :=
begin
  rw [finsum_def, dif_pos (finsupp.support_finite f)],
  congr',
  simp
end

lemma finsum_eq_finsupp_sum' (f : α → M) (hf : (function.support f).finite) :
  ∑ᶠ i : α, f i = finsupp.sum (finsupp.of_support_finite hf) (λ x m, m) :=
by rw [← finsum_eq_finsupp_sum, finsupp.of_support_finite_def]

lemma finsum_eq_finset_sum (f : α → M) (hf : (function.support f).finite) :
  ∑ᶠ i : α, f i = finset.sum hf.to_finset f :=
by rw [finsum_def, dif_pos hf]

lemma finsum_eq_finset_sum' [fintype α] (f : α → M) :
  ∑ᶠ i : α, f i = (finset.univ' α).sum f :=
begin
  rw [finsum_def, dif_pos (set.finite.of_fintype (_ : set α))],
  refine finset.sum_subset (λ _ _, finset.mem_univ' _) (λ _ _ hx, _),
    rw set.finite.mem_to_finset at hx,
    exact function.nmem_support.1 (λ h, hx h),
end

lemma finsum_in_eq_finset_sum (f : α → M) {s : set α}
  (hf : (s ∩ function.support f).finite) :
  ∑ᶠ i in s, f i = ∑ i in hf.to_finset, f i :=
begin
  rw [finsum_in_def, finsum_eq_finset_sum],
  { apply finset.sum_congr,
    { ext,
      rw [set.finite.mem_to_finset, set.finite.mem_to_finset, set.mem_inter_iff,
          function.mem_support, function.mem_support],
      split,
      { split_ifs,
        { exact and.intro h },
        { intro h2, exact false.elim (h2 rfl) } },
      { rintro ⟨h1, h2⟩, rwa if_pos h1 } },
    { intros x hx,
      rw set.finite.mem_to_finset at hx,
      exact if_pos hx.1 } },
  { refine set.finite.subset hf (λ x hx, set.mem_inter _ _),
    { rw function.mem_support at hx,
      exact set.mem_of_indicator_ne_zero hx },
    { change x ∈ function.support (s.indicator f) at hx,
      rw set.support_indicator at hx,
      exact hx.2 } },
end

lemma finsum_in_eq_finset_sum'' (f : α → M) (s : set α)
  (hf : (function.support f).finite) :
  ∑ᶠ i in s, f i = (finset.filter (∈ s) hf.to_finset).sum f :=
begin
  rw finsum_in_eq_finset_sum f (set.finite.subset hf (set.inter_subset_right _ _)),
  congr, ext, finish
end

lemma finsum_in_eq_finset_sum' [fintype α] (f : α → M) (s : set α) :
  ∑ᶠ i in s, f i = ∑ i in s.to_finset, f i :=
begin
  rw finsum_in_eq_finset_sum'' f s (set.finite.of_fintype _),
  conv_rhs { rw ← finset.sum_filter_ne_zero },
  exact finset.sum_congr (by ext; finish) (λ _ _, rfl),
end

lemma finsum_in_eq_finset_sum''' (f : α → M) {s : set α} (hs : s.finite) :
  ∑ᶠ i in s, f i = ∑ i in hs.to_finset, f i :=
begin
  rw finsum_in_eq_finset_sum f (set.finite.subset hs (set.inter_subset_left _ _)),
  conv_rhs { rw ← finset.sum_filter_ne_zero },
  refine finset.sum_congr _ (λ _ _, rfl),
  ext, rw [set.finite.to_finset, set.finite.to_finset, finset.mem_filter, set.mem_to_finset,
           set.mem_to_finset, set.mem_inter_iff, function.mem_support]
end

lemma finsum_in_eq_finset_sum'''' (f : α → M) (s : finset α) :
  ∑ᶠ i in ↑s, f i = ∑ i in s, f i :=
begin
  rw [finsum_in_eq_finset_sum''' f (finset.finite_to_set s), set.finite.to_finset],
  congr, ext, simp
end

lemma finsum_in_eq_zero_of_infinite {f : α → M} {s : set α}
  (hs : ¬ (s ∩ function.support f).finite) : ∑ᶠ i in s, f i = 0 :=
begin
  rw [finsum_in_def, finsum_def, dif_neg],
  intro h,
  apply hs,
  convert h,
  exact set.support_indicator.symm,
end

lemma finsum_in_inter_support (f : α → M) (s : set α) :
  ∑ᶠ i in s, f i = ∑ᶠ i in (s ∩ function.support f), f i :=
begin
  rw [finsum_in_def, finsum_in_def],
  congr', ext x, split_ifs with h h1 h2,
  { refl },
  { rw ←function.nmem_support, exact λ h2, h1 ⟨h, h2⟩ },
  { exact false.elim (h h2.1) },
  { refl }
end

lemma finsum_eq_finsum_in_univ (f : α → M) : ∑ᶠ i : α, f i = ∑ᶠ i in set.univ, f i :=
by { rw finsum_in_def, congr, funext, rw if_pos (set.mem_univ _) }

variables {β : Type*} {f g : α → M} {a b : α} {s t : set α}

@[congr]
lemma finsum_in_congr (h₀ : s = t) (h₁ : ∀ x ∈ t, f x = g x) : finsum_in s f = finsum_in t g :=
h₀ ▸ by { rw [finsum_in_def, finsum_in_def], congr', ext x, split_ifs; finish }

/-- The sum on an empty set over any function is zero. -/
@[simp] lemma finsum_in_empty : ∑ᶠ i in ∅, f i = 0 :=
begin
  rw [finsum_in_eq_finset_sum''' _ (set.finite_empty), ← @finset.sum_empty _ _ _ f],
  congr, ext, simp
end

/-- A set `s` is not empty if the sum on `s` is not equal to zero. -/
lemma nonempty_of_finsum_in_ne_zero (h : ∑ᶠ i in s, f i ≠ 0) : s ≠ ∅ :=
λ h', h $ h'.symm ▸ finsum_in_empty

/-- Given `a` and element not in the set `s`, the sum on `insert a s` over the function `f` equals
  the `f a` plus the sum on `s` over `f`. -/
lemma finsum_in_insert (f : α → M) (h : a ∉ s) (hs : s.finite) :
  ∑ᶠ i in insert a s, f i = f a + ∑ᶠ i in s, f i :=
begin
  rw [finsum_in_eq_finset_sum''' f (set.finite.insert a hs), finsum_in_eq_finset_sum''' f hs,
      set.finite.to_finset, set.finite.to_finset, ← finset.sum_insert],
    { congr, ext, simp },
    { rw set.mem_to_finset, exact h }
end

/-- A more general version of `finsum_in_insert` that requires `s ∩ function.support f` instead of
  `s` to be finite. -/
@[simp] lemma finsum_in_insert' (f : α → M) (h : a ∉ s) (hs : (s ∩ function.support f).finite) :
  ∑ᶠ i in insert a s, f i = f a + ∑ᶠ i in s, f i :=
begin
  by_cases ha : a ∈ function.support f,
    { have := finsum_in_insert f
        (show a ∉ s ∩ function.support f, by exact λ h', h h'.1) hs,
      rw [← finsum_in_inter_support] at this,
      rw [← this, finsum_in_inter_support],
      congr, rw [set.insert_inter, set.insert_eq_of_mem ha] },
    { rw [finsum_in_inter_support,
          set.insert_inter_of_not_mem ha,
         ← finsum_in_inter_support, function.nmem_support.1 ha, zero_add] }
end

/-- If `f a = 0` for all `a ∉ s`, then the sum on `insert a s` over the function `f` equals the sum
  on `s` over `f`. -/
lemma finsum_in_insert_of_eq_zero_if_not_mem (h : a ∉ s → f a = 0) :
  ∑ᶠ i in (insert a s), f i = ∑ᶠ i in s, f i :=
begin
  by_cases hs : ((s ∩ function.support f).finite),
    { by_cases hm : a ∈ s,
        { simp_rw set.insert_eq_of_mem hm },
        { rw [finsum_in_insert' f hm hs, h hm, zero_add] } },
    { rw [finsum_in_eq_zero_of_infinite hs, finsum_in_eq_zero_of_infinite],
      intro hs', apply hs,
      by_cases hm : a ∈ function.support f,
        { apply set.finite.subset hs',
          apply set.inter_subset_inter_left,
          apply set.subset_insert },
        { rwa set.insert_inter_of_not_mem hm at hs' } }
end

/-- If `f a = 0`, then the sum on `insert a s` over the function `f` equals the sum on `s` over `f`.
  -/
@[simp] lemma finsum_insert_zero (h : f a = 0) :
  ∑ᶠ i in (insert a s), f i = ∑ᶠ i in s, f i :=
finsum_in_insert_of_eq_zero_if_not_mem (λ _, h)

/-- The sum on a singleton `{a}` over the function `f` is `f a`. -/
@[simp] lemma finsum_singleton : ∑ᶠ i in {a}, f i = f a :=
begin
  rw [finsum_in_eq_finset_sum''' f (set.finite_singleton a), set.finite.to_finset,
      ← @finset.sum_singleton _ _ a f _],
  congr, ext, simp
end

/-- The sum on the set of two unique elements `{a, b}` over the function `f` equals `f a + f b`. -/
@[simp] lemma finsum_pair (h : a ≠ b) : finsum_in {a, b} f = f a + f b :=
begin
  rw [finsum_in_eq_finset_sum''' f (show set.finite {a, b}, by simp),
      set.finite.to_finset, ← finset.sum_pair h],
  congr, ext, simp
end

/-- The sum on the image `g '' s` over the function `f` equals the sum on `s` over `f ∘ g` given `g`
  is injective on `s`. -/
@[simp] lemma finsum_in_image' {s : set β} {g : β → α} (hs : s.finite) (hg : set.inj_on g s) :
  ∑ᶠ j in (g '' s), f j = ∑ᶠ i in s, (f ∘ g) i :=
begin
  rw [finsum_in_eq_finset_sum''' (f ∘ g) hs, finsum_in_eq_finset_sum''' f (set.finite.image g hs),
    ←finset.sum_image
    (λ x hx y hy hxy, hg ((set.finite.mem_to_finset hs).1 hx) ((set.finite.mem_to_finset hs).1 hy) hxy)],
  congr, ext, simp
end

/-- A more general version of `finsum_in_image'` that does not require `s` to be finite. -/
@[simp] lemma finsum_in_image {s : set β} {g : β → α}
  (hg : set.inj_on g s) : finsum_in (g '' s) f = finsum_in s (f ∘ g) :=
begin
  by_cases hs : (g '' s ∩ function.support f).finite,
    { rw [finsum_in_eq_finset_sum _ hs, finsum_in_eq_finset_sum _
            ((set.image_inter_support_finite_iff hg).1 hs),
        ← finsum_in_eq_finset_sum''', ← finsum_in_eq_finset_sum''',
        ← (@finsum_in_image' _ _ _ _ f (s ∩ function.support (f ∘ g)) g
            ((set.image_inter_support_finite_iff hg).1 hs)
          (set.inj_on.mono (set.inter_subset_left s _) hg))],
        { congr, ext y, split,
          { rintro ⟨⟨x, hx, rfl⟩, hy⟩,
            exact ⟨x, ⟨hx, hy⟩, rfl⟩ },
          { rintro ⟨x, ⟨hxs, h2⟩, rfl⟩,
            exact ⟨⟨x, hxs, rfl⟩, h2⟩ } } },
    { rw [finsum_in_eq_zero_of_infinite hs, finsum_in_eq_zero_of_infinite],
      intro hs', apply hs,
      rwa set.image_inter_support_finite_iff hg }
end .

/-- The sum on `s : set α` over `f : α → M` equals the sum on `t : set β` over `g : β → M` if there
  exists some function `e : α → β` that is bijective on `s` to `t` such that for all `x` in `s`,
  `f x = (g ∘ e) x`. -/
lemma finsum_in_eq_of_bij_on {s : set α} {t : set β} {f : α → M} {g : β → M}
  (e : α → β) (he₀ : set.bij_on e s t) (he₁ : ∀ x ∈ s, f x = (g ∘ e) x) :
  ∑ᶠ i in s, f i = ∑ᶠ j in t, g j :=
begin
  rw [(set.bij_on.image_eq he₀).symm, finsum_in_image he₀.2.1],
  exact finsum_in_congr rfl he₁
end

/-- Given finite sets `s` and `t`, the sum on `s ∪ t` over the function `f` plus the sum on `s ∩ t`
  over `f` equals the sum on `s` over `f` plus the sum on `t` over `f`. -/
lemma finsum_in_union_inter (hs : s.finite) (ht : t.finite) :
  ∑ᶠ i in (s ∪ t), f i + ∑ᶠ i in (s ∩ t), f i = ∑ᶠ i in s, f i + ∑ᶠ i in t, f i :=
begin
  rw [finsum_in_eq_finset_sum''' f hs, finsum_in_eq_finset_sum''' f ht,
      finsum_in_eq_finset_sum''' f (set.finite.union hs ht),
      finsum_in_eq_finset_sum''' f (set.finite.subset hs (set.inter_subset_left _ _)),
      set.finite.to_finset],
  convert finset.sum_union_inter,
  { ext,
    rw [set.mem_to_finset, finset.mem_union, set.mem_union],
    simp only [set.finite.mem_to_finset] },
  { ext, simp only [set.mem_inter_eq, set.finite.mem_to_finset, iff_self, finset.mem_inter] },
end

/-- A more general version of `finsum_in_union_inter` that requires `s ∩ function.support f` and
  `t ∩ function.support f` instead of `s` and `t` to be finite. -/
lemma finsum_in_union_inter'
  (hs : (s ∩ function.support f).finite) (ht : (t ∩ function.support f).finite) :
  ∑ᶠ i in (s ∪ t), f i + ∑ᶠ i in (s ∩ t), f i = ∑ᶠ i in s, f i + ∑ᶠ i in t, f i :=
begin
  rw [finsum_in_inter_support f s, finsum_in_inter_support f t,
      finsum_in_inter_support f (s ∪ t), finsum_in_inter_support f (s ∩ t),
      ← finsum_in_union_inter hs ht, set.inter_distrib_right],
  conv_rhs { congr, skip, congr,
    rw [set.inter_assoc, ← set.inter_assoc _ t, set.inter_comm _ t,
        set.inter_assoc, set.inter_self, ← set.inter_assoc] }
end

/-- Given two finite disjoint sets `s` and `t`, the sum on `s ∪ t` over the function `f` equals the
  sum on `s` over `f` plus the sum on `t` over `f`. -/
lemma finsum_in_union (hs : s.finite) (ht : t.finite) (hst : disjoint s t) :
  ∑ᶠ i in (s ∪ t), f i = ∑ᶠ i in s, f i + ∑ᶠ i in t, f i :=
by rw [← finsum_in_union_inter hs ht,
       show s ∩ t = ∅, by exact disjoint_iff.1 hst, finsum_in_empty, add_zero]

/-- A more general version of `finsum_in_union` that requires `s ∩ function.support f` and
  `t ∩ function.support f` instead of `s` and `t` to be finite. -/
lemma finsum_in_union'
  (hs : (s ∩ function.support f).finite) (ht : (t ∩ function.support f).finite)
  (hst : disjoint s t) : ∑ᶠ i in (s ∪ t), f i = ∑ᶠ i in s, f i + ∑ᶠ i in t, f i :=
by rw [← finsum_in_union_inter' hs ht,
       show s ∩ t = ∅, by exact disjoint_iff.1 hst, finsum_in_empty, add_zero]

/-- Given a finite set `t` and a subset `s` of `t`, the sum on `s` over the function `f` plus the
  sum on `t \ s` over `f` equals the sum on `t` over `f`. -/
lemma finsum_in_sdiff (ht : t.finite) (hst : s ⊆ t) :
  ∑ᶠ i in s, f i + ∑ᶠ i in t \ s, f i = ∑ᶠ i in t, f i :=
begin
  conv_rhs { rw ← set.union_diff_cancel hst },
  exact (finsum_in_union (set.finite.subset ht hst)
    (set.finite.subset ht $ set.diff_subset t s) set.disjoint_diff).symm
end

/-- A more general version of `finsum_in_sdiff` that requires `t ∩ function.support f` instead of
  `t` to be finite. -/
lemma finsum_in_sdiff' (ht : (t ∩ function.support f).finite)
  (hst : s ⊆ t) : ∑ᶠ i in s, f i + ∑ᶠ i in t \ s, f i = ∑ᶠ i in t, f i :=
begin
  conv_rhs { rw ← set.union_diff_cancel hst },
  exact (finsum_in_union' (set.finite.subset ht (set.inter_subset_inter_left _ hst))
    (set.finite.subset ht (set.inter_subset_inter (set.diff_subset t s) $ set.subset.refl _))
      set.disjoint_diff).symm
end

/-- Given the function `t : β → set α` in which for all `b : β`, `t b` is finite and for all
  distinct `x y ∈ s`, `t x` and `t y` are disjoint, then the sum on `⋃ x ∈ s, t x` over the
  function `f` equals the sum on `s` over `λ x, finsum_in (t x) f`. -/
lemma finsum_in_bUnion {s : set β} {t : β → set α} (hs : s.finite)
  (ht : ∀ b, (t b).finite) (h : ∀ x ∈ s, ∀ y ∈ s, x ≠ y → disjoint (t x) (t y)) :
  ∑ᶠ i in (⋃ x ∈ s, t x), f i = ∑ᶠ i in s, (∑ᶠ j in (t i), f j) :=
begin
  rw finsum_in_eq_finset_sum''' _ hs,
  rw finsum_in_eq_finset_sum''' f (set.finite.bUnion hs (λ i _, ht i)),
  conv_rhs { congr, skip, funext, rw finsum_in_eq_finset_sum''' f (ht i) },
  convert @finset.sum_bUnion _ _ _ f _ _ hs.to_finset (λ x, (ht x).to_finset)
    (begin
      intros x hx y hy hxy a ha,
      specialize h x ((set.finite.mem_to_finset hs).1 hx) y ((set.finite.mem_to_finset hs).1 hy) hxy,
      apply @h a, simpa using ha
    end),
  ext, rw [finset.mem_bUnion, set.finite.mem_to_finset, set.mem_bUnion_iff],
  split; intro ha; rcases ha with ⟨x, hx₀, hx₁⟩,
    exact ⟨x, (set.finite.mem_to_finset hs).2 hx₀, (set.finite.mem_to_finset (ht _)).2 hx₁⟩,
    exact ⟨x, (set.finite.mem_to_finset hs).1 hx₀, (set.finite.mem_to_finset (ht _)).1 hx₁⟩
end

/-- An alternative version of `finsum_in_bUnion` in which we sum on the a fintype rather than a
  finite set. -/
lemma finsum_in_Union [fintype β] {t : β → set α}
  (ht : ∀ b, (t b).finite) (h : ∀ x y, x ≠ y → disjoint (t x) (t y)) :
  ∑ᶠ i in (⋃ x : β, t x), f i = ∑ᶠ i, (∑ᶠ j in (t i), f j) :=
begin
  rw finsum_eq_finsum_in_univ,
  rw ← finsum_in_bUnion (set.finite.of_fintype _) ht (λ x _ y _, h x y),
    { congr, funext y, simp only [set.Union_pos, set.mem_univ] },
end

/-- An alternative version of `finsum_in_bUnion` in which `t` is a finite set of `set α`s. -/
lemma finsum_in_sUnion {t : set (set α)} (ht₀ : t.finite)
  (ht₁ : ∀ (x : set α), x.finite) (h : ∀ x ∈ t, ∀ y ∈ t, x ≠ y → disjoint x y) :
  ∑ᶠ i in (⋃₀ t), f i = ∑ᶠ s in t, (∑ᶠ i in s, f i) :=
by rw [set.sUnion_eq_bUnion, finsum_in_bUnion ht₀ ht₁ (by simpa)];
  exact finsum_in_congr rfl (λ x hx, dif_pos hx)

/-- Given a subset `t` of the set `s`, such that for all elements of `s` not in `t`, `f x = 0`, the
  sum on `t` over `f` equals the sum on `s` over `f`. -/
lemma finsum_in_eq_finsum_in_of_subset (hst : s ⊆ t)
  (hf : ∀ x : α, x ∈ t \ s → f x = 0) : ∑ᶠ i in s, f i = ∑ᶠ i in t, f i :=
begin
  rw [finsum_in_def, finsum_in_def],
  congr', ext x, split_ifs,
  { refl },
  { exact false.elim (h_1 $ hst h) },
  { exact (hf _ ⟨h_1, h⟩).symm },
  { refl }
end

/-- An alternative version of `finsum_in_eq_finsum_in_of_subset'` where we don't use sdiff. -/
lemma finsum_in_eq_finsum_in_of_subset'
  (ht₀ : t ⊆ s) (ht₁ : ∀ x ∈ s, x ∉ t → f x = 0) :
  ∑ᶠ i in t, f i = ∑ᶠ i in s, f i :=
begin
  refine finsum_in_eq_finsum_in_of_subset ht₀ _,
  intros x hx,
  rw set.mem_diff at hx,
  exact ht₁ x hx.1 hx.2,
end

/-- Given a set `t` thats smaller than `s` but greater than `s ∩ function.support f`, the sum on `t`
  equals the sum on `s`. -/
lemma finsum_in_eq_finsum_in_of_subset''
  (ht₀ : t ⊆ s) (ht₁ : s ∩ function.support f ⊆ t) :
  ∑ᶠ i in t, f i = ∑ᶠ i in s, f i :=
begin
  refine finsum_in_eq_finsum_in_of_subset' ht₀ (λ _ hx₀ hx₁, _),
  rw ← function.nmem_support,
  exact λ hx₂, hx₁ (ht₁ ⟨hx₀, hx₂⟩)
end

/-- Given a finite set `s`, the sum on `s` over `f + g` equals the sum over `f` plus the sum over
  `g`. -/
lemma finsum_in_add_distrib (hs : s.finite) :
  ∑ᶠ i in s, (f + g) i = ∑ᶠ i in s, f i + ∑ᶠ i in s, g i :=
by iterate 3 { rw [finsum_in_eq_finset_sum''' _ hs, set.finite.to_finset] };
  exact finset.sum_add_distrib

/-- A more general version of `finsum_in_distrib` that requires `s ∩ function.support f` and
  `s ∩ function.support g` instead of `s` to be finite. -/
lemma finsum_in_add_distrib'
  (hf : (s ∩ function.support f).finite) (hg : (s ∩ function.support g).finite) :
  ∑ᶠ i in s, (f + g) i = ∑ᶠ i in s, f i + ∑ᶠ i in s, g i :=
begin
  convert @finset.sum_add_distrib _ _ ((hf.to_finset ∪ hg.to_finset).filter s) f g _,
  { rw [←finsum_in_eq_finset_sum'''', finsum_in_inter_support],
    refine finsum_in_eq_finsum_in_of_subset _ _,
    { rintros x ⟨hx₁, hx₂⟩,
      rw [finset.mem_coe, finset.mem_filter],
      refine ⟨_, hx₁⟩,
      by_cases hf : f x = 0,
      { rw [function.mem_support, pi.add_apply, hf, zero_add] at hx₂,
        apply finset.subset_union_right,
        rw set.finite.mem_to_finset,
        exact ⟨hx₁, hx₂⟩ },
      { apply finset.subset_union_left,
        rw set.finite.mem_to_finset,
        exact ⟨hx₁, hf⟩ } },
    { rintros x ⟨hxs, hx⟩,
      rw [finset.mem_coe, finset.mem_filter] at hxs,
      by_contra hfg, exact hx ⟨hxs.2, hfg⟩ } },
  all_goals { rw [← finsum_in_eq_finset_sum'''', finsum_in_inter_support],
              apply finsum_in_eq_finsum_in_of_subset },
  { rintro x ⟨hxs, hxf⟩,
    apply finset.mem_filter.2,
    rw finset.mem_union,
    refine ⟨or.inl _, hxs⟩,
    rw set.finite.mem_to_finset,
    exact ⟨hxs, hxf⟩ },
  { intro x,
    rw set.mem_diff,
    rintro ⟨hx, hnx⟩,
    rw ← function.nmem_support,
    intro hxf,
    exact hnx ⟨(finset.mem_filter.1 hx).2, hxf⟩ },
  { rintro x ⟨hxs, hxg⟩,
    apply finset.mem_filter.2,
    rw finset.mem_union,
    refine ⟨or.inr _, hxs⟩,
    rw set.finite.mem_to_finset,
    exact ⟨hxs, hxg⟩ },
  { intro x,
    rw set.mem_diff,
    rintro ⟨hx, hnx⟩,
    rw ← function.nmem_support,
    intro hxg,
    exact hnx ⟨(finset.mem_filter.1 hx).2, hxg⟩ },
end

/-- Given the support of `f` and `g` are finite, the sum over `f + g` equals the sum over `f` plus
  the sum over `g`. -/
lemma finsum_add_distrib
  (hf : (function.support f).finite) (hg : (function.support g).finite) :
  ∑ᶠ i, (f + g) i = ∑ᶠ i, f i + ∑ᶠ i, g i :=
begin
  rw [finsum_eq_finsum_in_univ, finsum_eq_finsum_in_univ, finsum_eq_finsum_in_univ],
  apply finsum_in_add_distrib',
  { convert hf, simp },
  { convert hg, simp }
end

/-- Given the function `f : α → β → M`, the finite sets `s : set α`, `t : set β`, the sum on `s`
  over `λ x, finsum_in t (λ y, f x y)` equals the sum on `t` over `λ y, finsum_in s (λ x, f x y)`.
  -/
lemma finsum_in_comm {s : set α} {t : set β}
  (f : α → β → M) (hs : s.finite) (ht : t.finite) :
  ∑ᶠ i in s, ∑ᶠ j in t, f i j = ∑ᶠ j in t, ∑ᶠ i in s, f i j :=
begin
  rw [finsum_in_eq_finset_sum''' _ hs, finsum_in_eq_finset_sum''' _ ht],
  conv_lhs { congr, skip, funext, rw finsum_in_eq_finset_sum''' _ ht },
  conv_rhs { congr, skip, funext, rw finsum_in_eq_finset_sum''' _ hs },
  exact finset.sum_comm,
end

/-- Given a monoid homomorphism `g : β → M`, and a function `f : α → β`, the sum on `s` over `g ∘ f`
  equals `g` of the sum on `s` over `f`. -/
lemma finsum_in_hom [add_comm_monoid β] (f : α → β) (g : β →+ M) (hs : s.finite) :
  ∑ᶠ i in s, (g ∘ f) i = g (∑ᶠ j in s, f j) :=
by rw [finsum_in_eq_finset_sum''' _ hs, finsum_in_eq_finset_sum''' _ hs,
       set.finite.to_finset, add_monoid_hom.map_sum]

lemma finsum_in_hom'' [add_comm_monoid β] (f : α → β) (g : β →+ M) (hs : s.finite) :
  ∑ᶠ i in s, g (f i) = g (∑ᶠ j in s, f j) :=
finsum_in_hom f g hs

/-- A more general version of `finsum_in_hom` that requires `s ∩ function.support f` and instead of
  `s` to be finite. -/
lemma finsum_in_hom' [add_comm_monoid β] {f : α → β} (g : β →+ M)
  (h₀ : (s ∩ function.support f).finite) :
  ∑ᶠ i in s, (g ∘ f) i = g (∑ᶠ j in s, f j) :=
begin
  rw [finsum_in_inter_support f, ← finsum_in_hom _ _ h₀],
  symmetry,
  refine finsum_in_eq_finsum_in_of_subset'' (set.inter_subset_left _ _)
    (set.inter_subset_inter_right _ (λ x hgx, _)),
  rw function.mem_support at hgx ⊢,
  intro hfx, refine hgx _, simp only [hfx, function.comp],
  exact add_monoid_hom.map_zero g
end

lemma finsum_in_hom''' [add_comm_monoid β] {f : α → β} (g : β →+ M)
  (h₀ : (s ∩ function.support f).finite) :
  ∑ᶠ i in s, g (f i) = g (∑ᶠ j in s, f j) :=
finsum_in_hom' g h₀

/-- Given a proposition `p` such that for all `x ∈ s, f x ≠ 0 → p x`, the sum on the elements of `s`
  satisfied by `p` equals the sum on `s`. -/
lemma finsum_in_inter_of_ne {p : α → Prop} (hp : ∀ x ∈ s, f x ≠ 0 → p x) :
  ∑ᶠ i in (s ∩ p), f i = ∑ᶠ i in s, f i :=
finsum_in_eq_finsum_in_of_subset'' (set.inter_subset_left _ _)
  (λ _ ⟨hsx, hfx⟩, ⟨hsx, hp _ hsx $ function.mem_support.1 hfx⟩)

/-- Given a proposition `p`, the sum on the elements of `s` satisfied by `p` over `f` equals the sum
  on `s` over the function `λ a, if p a then f a else 0`. -/
lemma finsum_in_inter (p : α → Prop) :
  ∑ᶠ i in (s ∩ p), f i = ∑ᶠ i in s, (λ a, if p a then f a else 0) i :=
begin
  rw ← @finsum_in_inter_of_ne _ _ _ (λ a, if p a then f a else 0) _ p,
  refine finsum_in_congr rfl (λ x ⟨hsx, hxp⟩, (if_pos hxp).symm),
  finish
end .

lemma finsum_in_inter' (p : α → Prop) :
  ∑ᶠ i in (s ∩ p), f i = ∑ᶠ i in s, if p i then f i else 0 :=
finsum_in_inter p

/-- The sum on any set over the zero function equals zero. -/
lemma finsum_in_const_zero (s : set α) : ∑ᶠ i in s, (0 : M) = 0 :=
begin
  rw [finsum_in_def, finsum_def, dif_pos],
    { simp },
    { convert set.finite_empty, ext,
      rw function.mem_support, finish }
end

/-- The sum on the set `s` over the function `f` equals zero if for all `x ∈ s, f x = 0`. -/
lemma finsum_in_const_zero_fun (hf : ∀ x ∈ s, f x = 0) : ∑ᶠ i in s, f i = 0 :=
by { rw ← finsum_in_const_zero s, exact finsum_in_congr rfl hf }

/-- If the sum on `s` over the function `f` is nonzero, then there is some `x ∈ s, f x ≠ 0`. -/
lemma exists_ne_zero_of_finsum_in_ne_zero
  (h : ∑ᶠ i in s, f i ≠ 0) : ∃ x ∈ s, f x ≠ 0 :=
begin
  by_contra h', push_neg at h',
  exact h (finsum_in_const_zero_fun h')
end

/-- To prove a property of a sum, it suffices to prove that the property is additive and holds on
  summands. -/
lemma finsum_in_induction (p : M → Prop) (hp₀ : p 0)
  (hp₁ : ∀ x y, p x → p y → p (x + y)) (hp₂ : ∀ x ∈ s, p $ f x) :
  p (∑ᶠ i in s, f i) :=
begin
  by_cases hs : (s ∩ function.support f).finite,
    { rw [finsum_in_inter_support, finsum_in_eq_finset_sum''' _ hs, set.finite.to_finset],
      refine finset.sum_induction _ p hp₁ hp₀ (λ x hx, hp₂ x _),
      rw set.mem_to_finset at hx, exact hx.1 },
    { exact (finsum_in_eq_zero_of_infinite hs).symm ▸ hp₀ }
end

end finsum


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import algebra.indicator_function
import order.filter.at_top_bot

/-!
# Indicator function and filters

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

Properties of indicator functions involving `=ᶠ` and `≤ᶠ`.

## Tags
indicator, characteristic, filter
-/

variables {α β M E : Type*}

open set filter classical
open_locale filter classical

section has_zero
variables [has_zero M] {s t : set α} {f g : α → M} {a : α} {l : filter α}

lemma indicator_eventually_eq (hf : f =ᶠ[l ⊓ 𝓟 s] g) (hs : s =ᶠ[l] t) :
  indicator s f =ᶠ[l] indicator t g :=
(eventually_inf_principal.1 hf).mp $ hs.mem_iff.mono $ λ x hst hfg,
by_cases (λ hxs : x ∈ s, by simp only [*, hst.1 hxs, indicator_of_mem])
  (λ hxs, by simp only [indicator_of_not_mem hxs, indicator_of_not_mem (mt hst.2 hxs)])

end has_zero

section add_monoid
variables [add_monoid M] {s t : set α} {f g : α → M} {a : α} {l : filter α}

lemma indicator_union_eventually_eq (h : ∀ᶠ a in l, a ∉ s ∩ t) :
  indicator (s ∪ t) f =ᶠ[l] indicator s f + indicator t f :=
h.mono $ λ a ha, indicator_union_of_not_mem_inter ha _

end add_monoid

section order
variables [has_zero β] [preorder β] {s t : set α} {f g : α → β} {a : α} {l : filter α}

lemma indicator_eventually_le_indicator (h : f ≤ᶠ[l ⊓ 𝓟 s] g) :
  indicator s f ≤ᶠ[l] indicator s g :=
(eventually_inf_principal.1 h).mono $ assume a h,
indicator_rel_indicator le_rfl h

end order

lemma monotone.tendsto_indicator {ι} [preorder ι] [has_zero β]
  (s : ι → set α) (hs : monotone s) (f : α → β) (a : α) :
  tendsto (λi, indicator (s i) f a) at_top (pure $ indicator (⋃ i, s i) f a) :=
begin
  by_cases h : ∃i, a ∈ s i,
  { rcases h with ⟨i, hi⟩,
    refine tendsto_pure.2 ((eventually_ge_at_top i).mono $ assume n hn, _),
    rw [indicator_of_mem (hs hn hi) _, indicator_of_mem ((subset_Union _ _) hi) _] },
  { rw [not_exists] at h,
    simp only [indicator_of_not_mem (h _)],
    convert tendsto_const_pure,
    apply indicator_of_not_mem, simpa only [not_exists, mem_Union] }
end

lemma antitone.tendsto_indicator {ι} [preorder ι] [has_zero β]
  (s : ι → set α) (hs : antitone s) (f : α → β) (a : α) :
  tendsto (λi, indicator (s i) f a) at_top (pure $ indicator (⋂ i, s i) f a) :=
begin
  by_cases h : ∃i, a ∉ s i,
  { rcases h with ⟨i, hi⟩,
    refine tendsto_pure.2 ((eventually_ge_at_top i).mono $ assume n hn, _),
    rw [indicator_of_not_mem _ _, indicator_of_not_mem _ _],
    { simp only [mem_Inter, not_forall], exact ⟨i, hi⟩ },
    { assume h, have := hs hn h, contradiction } },
  { push_neg at h,
    simp only [indicator_of_mem, h, (mem_Inter.2 h), tendsto_const_pure] }
end

lemma tendsto_indicator_bUnion_finset {ι} [has_zero β] (s : ι → set α) (f : α → β) (a : α) :
  tendsto (λ (n : finset ι), indicator (⋃i∈n, s i) f a) at_top (pure $ indicator (Union s) f a) :=
begin
  rw Union_eq_Union_finset s,
  refine monotone.tendsto_indicator (λ n : finset ι, ⋃ i ∈ n, s i) _ f a,
  exact λ t₁ t₂, bUnion_subset_bUnion_left
end

lemma filter.eventually_eq.support [has_zero β] {f g : α → β} {l : filter α}
  (h : f =ᶠ[l] g) :
  function.support f =ᶠ[l] function.support g :=
begin
  filter_upwards [h] with x hx,
  rw eq_iff_iff,
  change f x ≠ 0 ↔ g x ≠ 0,
  rw hx,
end

lemma filter.eventually_eq.indicator [has_zero β] {l : filter α} {f g : α → β} {s : set α}
  (hfg : f =ᶠ[l] g) :
  s.indicator f =ᶠ[l] s.indicator g :=
begin
  filter_upwards [hfg] with x hx,
  by_cases x ∈ s,
  { rwa [indicator_of_mem h, indicator_of_mem h] },
  { rw [indicator_of_not_mem h, indicator_of_not_mem h] }
end

lemma filter.eventually_eq.indicator_zero [has_zero β] {l : filter α}
  {f : α → β} {s : set α} (hf : f =ᶠ[l] 0) :
  s.indicator f =ᶠ[l] 0 :=
begin
  refine hf.indicator.trans _,
  rw indicator_zero'
end


universe u v

inductive Vec2 (α : Type u) (β : Type v) : Nat → Type (max u v)
| nil  : Vec2 α β 0
| cons : α → β → forall {n}, Vec2 α β n → Vec2 α β (n+1)

inductive Fin2 : Nat → Type
| zero (n : Nat)              : Fin2 (n+1)
| succ {n : Nat} (s : Fin2 n) : Fin2 (n+1)

theorem test1 {α β} {n} (a₁ a₂ : α) (b₁ b₂ : β) (v w : Vec2 α β n) (h : Vec2.cons a₁ b₁ v = Vec2.cons a₂ b₂ w) : a₁ = a₂ :=
by {
  injection h
}

theorem test2 {α β} {n} (a₁ a₂ : α) (b₁ b₂ : β) (v w : Vec2 α β n) (h : Vec2.cons a₁ b₁ v = Vec2.cons a₂ b₂ w) : v = w :=
by {
  injection h with h1 h2 h3 h4
}

theorem test3 {α β} {n} (a₁ a₂ : α) (b₁ b₂ : β) (v w : Vec2 α β n) (f : Vec2 α β n → Nat) (h : Vec2.cons a₁ b₁ v = Vec2.cons a₂ b₂ w) : f v = f w :=
by {
  injection h with _ _ _ h4;
  rw [h4]
}

theorem test4 {α} (v : Fin2 0) : α :=
by cases v

def test5 {α β} {n} (v : Vec2 α β (n+1)) : α := by
  cases v with
  | cons h1 h2 tail => exact h1

def test6 {α β} {n} (v : Vec2 α β (n+2)) : α := by
  cases v with
  | cons h1 h2 tail => exact h1


/- The Curry-Howard correspondence -/
/- a.k.a. propositions-as-types    -/
/- a.k.a. proofs-as-programs       -/

variables (X Y : Type) (f : X → Y)

variables (P Q : Prop) (hypothesis : P → Q)

#check ∀ x : X, P

variable (P' : X → Prop)

--- --- --- --- --- --- --- --- --- --- --- --- --- ---

variables (G : X → Type) (hG : ∀ x, group (G x))

#check Π x, G x

--- --- --- --- --- --- --- --- --- --- --- --- --- ---

lemma universal : (∀ x, P' x) = (Π x, P' x) :=
begin
  apply eq.refl,
end

lemma subsets_are_just_props :
  { x | P' x } = P' := rfl


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.game.state
import Mathlib.PostPort

namespace Mathlib

/-!
# Domineering as a combinatorial game.

We define the game of Domineering, played on a chessboard of arbitrary shape
(possibly even disconnected).
Left moves by placing a domino vertically, while Right moves by placing a domino horizontally.

This is only a fragment of a full development;
in order to successfully analyse positions we would need some more theorems.
Most importantly, we need a general statement that allows us to discard irrelevant moves.
Specifically to domineering, we need the fact that
disjoint parts of the chessboard give sums of games.
-/

namespace pgame

namespace domineering

/-- The embedding `(x, y) ↦ (x, y+1)`. -/
def shift_up : ℤ × ℤ ↪ ℤ × ℤ :=
  function.embedding.prod_map (function.embedding.refl ℤ) (function.embedding.mk (fun (n : ℤ) => n + 1) sorry)

/-- The embedding `(x, y) ↦ (x+1, y)`. -/
def shift_right : ℤ × ℤ ↪ ℤ × ℤ :=
  function.embedding.prod_map (function.embedding.mk (fun (n : ℤ) => n + 1) sorry) (function.embedding.refl ℤ)

/-- A Domineering board is an arbitrary finite subset of `ℤ × ℤ`. -/
def board :=
  finset (ℤ × ℤ)

/-- Left can play anywhere that a square and the square below it are open. -/
/-- Right can play anywhere that a square and the square to the left are open. -/
def left (b : board) : finset (ℤ × ℤ) :=
  b ∩ finset.map shift_up b

def right (b : board) : finset (ℤ × ℤ) :=
  b ∩ finset.map shift_right b

/-- After Left moves, two vertically adjacent squares are removed from the board. -/
def move_left (b : board) (m : ℤ × ℤ) : board :=
  finset.erase (finset.erase b m) (prod.fst m, prod.snd m - 1)

/-- After Left moves, two horizontally adjacent squares are removed from the board. -/
def move_right (b : board) (m : ℤ × ℤ) : board :=
  finset.erase (finset.erase b m) (prod.fst m - 1, prod.snd m)

theorem card_of_mem_left {b : board} {m : ℤ × ℤ} (h : m ∈ left b) : bit0 1 ≤ finset.card b := sorry

theorem card_of_mem_right {b : board} {m : ℤ × ℤ} (h : m ∈ right b) : bit0 1 ≤ finset.card b := sorry

theorem move_left_card {b : board} {m : ℤ × ℤ} (h : m ∈ left b) : finset.card (move_left b m) + bit0 1 = finset.card b := sorry

theorem move_right_card {b : board} {m : ℤ × ℤ} (h : m ∈ right b) : finset.card (move_right b m) + bit0 1 = finset.card b := sorry

theorem move_left_smaller {b : board} {m : ℤ × ℤ} (h : m ∈ left b) : finset.card (move_left b m) / bit0 1 < finset.card b / bit0 1 := sorry

theorem move_right_smaller {b : board} {m : ℤ × ℤ} (h : m ∈ right b) : finset.card (move_right b m) / bit0 1 < finset.card b / bit0 1 := sorry

/-- The instance describing allowed moves on a Domineering board. -/
protected instance state : state board :=
  state.mk (fun (s : board) => finset.card s / bit0 1) (fun (s : board) => finset.image (move_left s) (left s))
    (fun (s : board) => finset.image (move_right s) (right s)) sorry sorry

end domineering

/-- Construct a pre-game from a Domineering board. -/
def domineering (b : domineering.board) : pgame :=
  of b

/-- All games of Domineering are short, because each move removes two squares. -/
protected instance short_domineering (b : domineering.board) : short (domineering b) :=
  id (pgame.short_of b)

/-- The Domineering board with two squares arranged vertically, in which Left has the only move. -/
def domineering.one : pgame :=
  domineering (list.to_finset [(0, 0), (0, 1)])

/-- The `L` shaped Domineering board, in which Left is exactly half a move ahead. -/
def domineering.L : pgame :=
  domineering (list.to_finset [(0, bit0 1), (0, 1), (0, 0), (1, 0)])

protected instance short_one : short domineering.one :=
  id (pgame.short_domineering (list.to_finset [(0, 0), (0, 1)]))

protected instance short_L : short domineering.L :=
  id (pgame.short_domineering (list.to_finset [(0, bit0 1), (0, 1), (0, 0), (1, 0)]))


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.int.basic
import Mathlib.algebra.field_power
import Mathlib.ring_theory.multiplicity
import Mathlib.data.real.cau_seq
import Mathlib.tactic.ring_exp
import Mathlib.tactic.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# p-adic norm

This file defines the p-adic valuation and the p-adic norm on ℚ.

The p-adic valuation on ℚ is the difference of the multiplicities of `p` in the numerator and
denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
assumptions on p.

The valuation induces a norm on ℚ. This norm is a nonarchimedean absolute value.
It takes values in {0} ∪ {1/p^k | k ∈ ℤ}.

## Notations

This file uses the local notation `/.` for `rat.mk`.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact (prime p)]` as a type class argument.

## References

* [F. Q. Gouêva, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, norm, valuation
-/

/--
For `p ≠ 1`, the p-adic valuation of an integer `z ≠ 0` is the largest natural number `n` such that
p^n divides z.

`padic_val_rat` defines the valuation of a rational `q` to be the valuation of `q.num` minus the
valuation of `q.denom`.
If `q = 0` or `p = 1`, then `padic_val_rat p q` defaults to 0.
-/
def padic_val_rat (p : ℕ) (q : ℚ) : ℤ :=
  dite (q ≠ 0 ∧ p ≠ 1)
    (fun (h : q ≠ 0 ∧ p ≠ 1) =>
      ↑(roption.get (multiplicity (↑p) (rat.num q)) sorry) -
        ↑(roption.get (multiplicity ↑p ↑(rat.denom q)) sorry))
    fun (h : ¬(q ≠ 0 ∧ p ≠ 1)) => 0

/--
A simplification of the definition of `padic_val_rat p q` when `q ≠ 0` and `p` is prime.
-/
theorem padic_val_rat_def (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} (hq : q ≠ 0) :
    padic_val_rat p q =
        ↑(roption.get (multiplicity (↑p) (rat.num q))
              (iff.mpr multiplicity.finite_int_iff
                { left := nat.prime.ne_one hp, right := rat.num_ne_zero_of_ne_zero hq })) -
          ↑(roption.get (multiplicity ↑p ↑(rat.denom q))
              (iff.mpr multiplicity.finite_int_iff
                { left := nat.prime.ne_one hp,
                  right :=
                    eq.mpr
                      (id
                        (Eq.trans
                          ((fun (a a_1 : ℤ) (e_1 : a = a_1) (b b_1 : ℤ) (e_2 : b = b_1) =>
                              congr (congr_arg ne e_1) e_2)
                            (↑(rat.denom q)) (↑(rat.denom q)) (Eq.refl ↑(rat.denom q)) 0 (↑0)
                            (Eq.symm int.coe_nat_zero))
                          (Eq.trans (propext (ne_from_not_eq ↑(rat.denom q) ↑0))
                            ((fun (a a_1 : Prop) (e_1 : a = a_1) => congr_arg Not e_1)
                              (↑(rat.denom q) = ↑0) (rat.denom q = 0) (propext int.coe_nat_inj')))))
                      (eq.mp (propext (ne_from_not_eq (rat.denom q) 0))
                        (rat.denom_ne_zero q)) })) :=
  dif_pos { left := hq, right := nat.prime.ne_one hp }

namespace padic_val_rat

/--
`padic_val_rat p q` is symmetric in `q`.
-/
@[simp] protected theorem neg {p : ℕ} (q : ℚ) : padic_val_rat p (-q) = padic_val_rat p q := sorry

/--
`padic_val_rat p 1` is 0 for any `p`.
-/
@[simp] protected theorem one {p : ℕ} : padic_val_rat p 1 = 0 := sorry

/--
For `p ≠ 0, p ≠ 1, `padic_val_rat p p` is 1.
-/
@[simp] theorem padic_val_rat_self {p : ℕ} (hp : 1 < p) : padic_val_rat p ↑p = 1 := sorry

/--
The p-adic value of an integer `z ≠ 0` is the multiplicity of `p` in `z`.
-/
theorem padic_val_rat_of_int {p : ℕ} (z : ℤ) (hp : p ≠ 1) (hz : z ≠ 0) :
    padic_val_rat p ↑z =
        ↑(roption.get (multiplicity (↑p) z)
            (iff.mpr multiplicity.finite_int_iff { left := hp, right := hz })) :=
  sorry

end padic_val_rat

/--
A convenience function for the case of `padic_val_rat` when both inputs are natural numbers.
-/
def padic_val_nat (p : ℕ) (n : ℕ) : ℕ := int.to_nat (padic_val_rat p ↑n)

/--
`padic_val_nat` is defined as an `int.to_nat` cast; this lemma ensures that the cast is well-behaved.
-/
theorem zero_le_padic_val_rat_of_nat (p : ℕ) (n : ℕ) : 0 ≤ padic_val_rat p ↑n := sorry

/--
`padic_val_rat` coincides with `padic_val_nat`.
-/
@[simp] theorem padic_val_rat_of_nat (p : ℕ) (n : ℕ) : ↑(padic_val_nat p n) = padic_val_rat p ↑n :=
  sorry

/--
A simplification of `padic_val_nat` when one input is prime, by analogy with `padic_val_rat_def`.
-/
theorem padic_val_nat_def {p : ℕ} [hp : fact (nat.prime p)] {n : ℕ} (hn : n ≠ 0) :
    padic_val_nat p n =
        roption.get (multiplicity p n)
          (iff.mpr multiplicity.finite_nat_iff
            { left := nat.prime.ne_one hp, right := iff.mpr bot_lt_iff_ne_bot hn }) :=
  sorry

theorem one_le_padic_val_nat_of_dvd {n : ℕ} {p : ℕ} [prime : fact (nat.prime p)] (nonzero : n ≠ 0)
    (div : p ∣ n) : 1 ≤ padic_val_nat p n :=
  sorry

@[simp] theorem padic_val_nat_zero (m : ℕ) : padic_val_nat m 0 = 0 :=
  eq.mpr (id (Eq.refl (padic_val_nat m 0 = 0))) (Eq.refl (padic_val_nat m 0))

@[simp] theorem padic_val_nat_one (m : ℕ) : padic_val_nat m 1 = 0 := sorry

namespace padic_val_rat

/--
The multiplicity of `p : ℕ` in `a : ℤ` is finite exactly when `a ≠ 0`.
-/
theorem finite_int_prime_iff {p : ℕ} [p_prime : fact (nat.prime p)] {a : ℤ} :
    multiplicity.finite (↑p) a ↔ a ≠ 0 :=
  sorry

/--
A rewrite lemma for `padic_val_rat p q` when `q` is expressed in terms of `rat.mk`.
-/
protected theorem defn (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {n : ℤ} {d : ℤ} (hqz : q ≠ 0)
    (qdf : q = rat.mk n d) :
    padic_val_rat p q =
        ↑(roption.get (multiplicity (↑p) n)
              (iff.mpr multiplicity.finite_int_iff
                { left := ne.symm (ne_of_lt (nat.prime.one_lt p_prime)),
                  right :=
                    fun (hn : n = 0) =>
                      False._oldrec
                        (eq.mp
                          (Eq.trans
                            ((fun (a a_1 : ℚ) (e_1 : a = a_1) (ᾰ ᾰ_1 : ℚ) (e_2 : ᾰ = ᾰ_1) =>
                                congr (congr_arg Eq e_1) e_2)
                              q q (Eq.refl q) (rat.mk n d) 0
                              (Eq.trans
                                ((fun (ᾰ ᾰ_1 : ℤ) (e_1 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℤ) (e_2 : ᾰ_2 = ᾰ_3) =>
                                    congr (congr_arg rat.mk e_1) e_2)
                                  n 0 hn d d (Eq.refl d))
                                (rat.zero_mk d)))
                            (propext (iff_false_intro hqz)))
                          qdf) })) -
          ↑(roption.get (multiplicity (↑p) d)
              (iff.mpr multiplicity.finite_int_iff
                { left := ne.symm (ne_of_lt (nat.prime.one_lt p_prime)),
                  right :=
                    fun (hd : d = 0) =>
                      False._oldrec
                        (eq.mp
                          (Eq.trans
                            ((fun (a a_1 : ℚ) (e_1 : a = a_1) (ᾰ ᾰ_1 : ℚ) (e_2 : ᾰ = ᾰ_1) =>
                                congr (congr_arg Eq e_1) e_2)
                              q q (Eq.refl q) (rat.mk n d) 0
                              (Eq.trans
                                ((fun (ᾰ ᾰ_1 : ℤ) (e_1 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℤ) (e_2 : ᾰ_2 = ᾰ_3) =>
                                    congr (congr_arg rat.mk e_1) e_2)
                                  n n (Eq.refl n) d 0 hd)
                                (rat.mk_zero n)))
                            (propext (iff_false_intro hqz)))
                          qdf) })) :=
  sorry

/--
A rewrite lemma for `padic_val_rat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected theorem mul (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {r : ℚ} (hq : q ≠ 0)
    (hr : r ≠ 0) : padic_val_rat p (q * r) = padic_val_rat p q + padic_val_rat p r :=
  sorry

/--
A rewrite lemma for `padic_val_rat p (q^k) with condition `q ≠ 0`.
-/
protected theorem pow (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} (hq : q ≠ 0) {k : ℕ} :
    padic_val_rat p (q ^ k) = ↑k * padic_val_rat p q :=
  sorry

/--
A rewrite lemma for `padic_val_rat p (q⁻¹)` with condition `q ≠ 0`.
-/
protected theorem inv (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} (hq : q ≠ 0) :
    padic_val_rat p (q⁻¹) = -padic_val_rat p q :=
  sorry

/--
A rewrite lemma for `padic_val_rat p (q / r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected theorem div (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {r : ℚ} (hq : q ≠ 0)
    (hr : r ≠ 0) : padic_val_rat p (q / r) = padic_val_rat p q - padic_val_rat p r :=
  sorry

/--
A condition for `padic_val_rat p (n₁ / d₁) ≤ padic_val_rat p (n₂ / d₂),
in terms of divisibility by `p^n`.
-/
theorem padic_val_rat_le_padic_val_rat_iff (p : ℕ) [p_prime : fact (nat.prime p)] {n₁ : ℤ} {n₂ : ℤ}
    {d₁ : ℤ} {d₂ : ℤ} (hn₁ : n₁ ≠ 0) (hn₂ : n₂ ≠ 0) (hd₁ : d₁ ≠ 0) (hd₂ : d₂ ≠ 0) :
    padic_val_rat p (rat.mk n₁ d₁) ≤ padic_val_rat p (rat.mk n₂ d₂) ↔
        ∀ (n : ℕ), ↑p ^ n ∣ n₁ * d₂ → ↑p ^ n ∣ n₂ * d₁ :=
  sorry

/--
Sufficient conditions to show that the p-adic valuation of `q` is less than or equal to the
p-adic vlauation of `q + r`.
-/
theorem le_padic_val_rat_add_of_le (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {r : ℚ}
    (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q + r ≠ 0) (h : padic_val_rat p q ≤ padic_val_rat p r) :
    padic_val_rat p q ≤ padic_val_rat p (q + r) :=
  sorry

/--
The minimum of the valuations of `q` and `r` is less than or equal to the valuation of `q + r`.
-/
theorem min_le_padic_val_rat_add (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {r : ℚ} (hq : q ≠ 0)
    (hr : r ≠ 0) (hqr : q + r ≠ 0) :
    min (padic_val_rat p q) (padic_val_rat p r) ≤ padic_val_rat p (q + r) :=
  sorry

/-- A finite sum of rationals with positive p-adic valuation has positive p-adic valuation
  (if the sum is non-zero). -/
theorem sum_pos_of_pos (p : ℕ) [p_prime : fact (nat.prime p)] {n : ℕ} {F : ℕ → ℚ}
    (hF : ∀ (i : ℕ), i < n → 0 < padic_val_rat p (F i))
    (hn0 : (finset.sum (finset.range n) fun (i : ℕ) => F i) ≠ 0) :
    0 < padic_val_rat p (finset.sum (finset.range n) fun (i : ℕ) => F i) :=
  sorry

end padic_val_rat

namespace padic_val_nat

/--
A rewrite lemma for `padic_val_nat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected theorem mul (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℕ} {r : ℕ} (hq : q ≠ 0)
    (hr : r ≠ 0) : padic_val_nat p (q * r) = padic_val_nat p q + padic_val_nat p r :=
  sorry

/--
Dividing out by a prime factor reduces the padic_val_nat by 1.
-/
protected theorem div {p : ℕ} [p_prime : fact (nat.prime p)] {b : ℕ} (dvd : p ∣ b) :
    padic_val_nat p (b / p) = padic_val_nat p b - 1 :=
  sorry

end padic_val_nat

/--
If a prime doesn't appear in `n`, `padic_val_nat p n` is `0`.
-/
theorem padic_val_nat_of_not_dvd {p : ℕ} [fact (nat.prime p)] {n : ℕ} (not_dvd : ¬p ∣ n) :
    padic_val_nat p n = 0 :=
  sorry

theorem dvd_of_one_le_padic_val_nat {n : ℕ} {p : ℕ} [prime : fact (nat.prime p)]
    (hp : 1 ≤ padic_val_nat p n) : p ∣ n :=
  sorry

theorem padic_val_nat_primes {p : ℕ} {q : ℕ} [p_prime : fact (nat.prime p)]
    [q_prime : fact (nat.prime q)] (neq : p ≠ q) : padic_val_nat p q = 0 :=
  padic_val_nat_of_not_dvd
    (iff.mp (not_congr (iff.symm (nat.prime_dvd_prime_iff_eq p_prime q_prime))) neq)

protected theorem padic_val_nat.div' {p : ℕ} [p_prime : fact (nat.prime p)] {m : ℕ}
    (cpm : nat.coprime p m) {b : ℕ} (dvd : m ∣ b) : padic_val_nat p (b / m) = padic_val_nat p b :=
  sorry

theorem padic_val_nat_eq_factors_count (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) :
    padic_val_nat p n = list.count p (nat.factors n) :=
  sorry

theorem prod_pow_prime_padic_val_nat (n : ℕ) (hn : n ≠ 0) (m : ℕ) (pr : n < m) :
    (finset.prod (finset.filter nat.prime (finset.range m)) fun (p : ℕ) => p ^ padic_val_nat p n) =
        n :=
  sorry

/--
If `q ≠ 0`, the p-adic norm of a rational `q` is `p ^ (-(padic_val_rat p q))`.
If `q = 0`, the p-adic norm of `q` is 0.
-/
def padic_norm (p : ℕ) (q : ℚ) : ℚ := ite (q = 0) 0 (↑p ^ (-padic_val_rat p q))

namespace padic_norm

/--
Unfolds the definition of the p-adic norm of `q` when `q ≠ 0`.
-/
@[simp] protected theorem eq_fpow_of_nonzero (p : ℕ) {q : ℚ} (hq : q ≠ 0) :
    padic_norm p q = ↑p ^ (-padic_val_rat p q) :=
  sorry

/--
The p-adic norm is nonnegative.
-/
protected theorem nonneg (p : ℕ) (q : ℚ) : 0 ≤ padic_norm p q := sorry

/--
The p-adic norm of 0 is 0.
-/
@[simp] protected theorem zero (p : ℕ) : padic_norm p 0 = 0 := sorry

/--
The p-adic norm of 1 is 1.
-/
@[simp] protected theorem one (p : ℕ) : padic_norm p 1 = 1 := sorry

/--
The p-adic norm of `p` is `1/p` if `p > 1`.

See also `padic_norm.padic_norm_p_of_prime` for a version that assumes `p` is prime.
-/
theorem padic_norm_p {p : ℕ} (hp : 1 < p) : padic_norm p ↑p = 1 / ↑p := sorry

/--
The p-adic norm of `p` is `1/p` if `p` is prime.

See also `padic_norm.padic_norm_p` for a version that assumes `1 < p`.
-/
@[simp] theorem padic_norm_p_of_prime (p : ℕ) [fact (nat.prime p)] : padic_norm p ↑p = 1 / ↑p :=
  padic_norm_p (nat.prime.one_lt _inst_1)

/--
The p-adic norm of `p` is less than 1 if `1 < p`.

See also `padic_norm.padic_norm_p_lt_one_of_prime` for a version assuming `prime p`.
-/
theorem padic_norm_p_lt_one {p : ℕ} (hp : 1 < p) : padic_norm p ↑p < 1 := sorry

/--
The p-adic norm of `p` is less than 1 if `p` is prime.

See also `padic_norm.padic_norm_p_lt_one` for a version assuming `1 < p`.
-/
theorem padic_norm_p_lt_one_of_prime (p : ℕ) [fact (nat.prime p)] : padic_norm p ↑p < 1 :=
  padic_norm_p_lt_one (nat.prime.one_lt _inst_1)

/--
`padic_norm p q` takes discrete values `p ^ -z` for `z : ℤ`.
-/
protected theorem values_discrete (p : ℕ) {q : ℚ} (hq : q ≠ 0) :
    ∃ (z : ℤ), padic_norm p q = ↑p ^ (-z) :=
  sorry

/--
`padic_norm p` is symmetric.
-/
@[simp] protected theorem neg (p : ℕ) (q : ℚ) : padic_norm p (-q) = padic_norm p q := sorry

/--
If `q ≠ 0`, then `padic_norm p q ≠ 0`.
-/
protected theorem nonzero (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} (hq : q ≠ 0) :
    padic_norm p q ≠ 0 :=
  sorry

/--
If the p-adic norm of `q` is 0, then `q` is 0.
-/
theorem zero_of_padic_norm_eq_zero (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ}
    (h : padic_norm p q = 0) : q = 0 :=
  sorry

/--
The p-adic norm is multiplicative.
-/
@[simp] protected theorem mul (p : ℕ) [hp : fact (nat.prime p)] (q : ℚ) (r : ℚ) :
    padic_norm p (q * r) = padic_norm p q * padic_norm p r :=
  sorry

/--
The p-adic norm respects division.
-/
@[simp] protected theorem div (p : ℕ) [hp : fact (nat.prime p)] (q : ℚ) (r : ℚ) :
    padic_norm p (q / r) = padic_norm p q / padic_norm p r :=
  sorry

/--
The p-adic norm of an integer is at most 1.
-/
protected theorem of_int (p : ℕ) [hp : fact (nat.prime p)] (z : ℤ) : padic_norm p ↑z ≤ 1 := sorry

/--
The p-adic norm is nonarchimedean: the norm of `p + q` is at most the max of the norm of `p` and
the norm of `q`.
-/
protected theorem nonarchimedean (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} {r : ℚ} :
    padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
  sorry

/--
The p-adic norm respects the triangle inequality: the norm of `p + q` is at most the norm of `p`
plus the norm of `q`.
-/
theorem triangle_ineq (p : ℕ) [hp : fact (nat.prime p)] (q : ℚ) (r : ℚ) :
    padic_norm p (q + r) ≤ padic_norm p q + padic_norm p r :=
  le_trans (padic_norm.nonarchimedean p)
    (max_le_add_of_nonneg (padic_norm.nonneg p q) (padic_norm.nonneg p r))

/--
The p-adic norm of a difference is at most the max of each component. Restates the archimedean
property of the p-adic norm.
-/
protected theorem sub (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} {r : ℚ} :
    padic_norm p (q - r) ≤ max (padic_norm p q) (padic_norm p r) :=
  sorry

/--
If the p-adic norms of `q` and `r` are different, then the norm of `q + r` is equal to the max of
the norms of `q` and `r`.
-/
theorem add_eq_max_of_ne (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} {r : ℚ}
    (hne : padic_norm p q ≠ padic_norm p r) :
    padic_norm p (q + r) = max (padic_norm p q) (padic_norm p r) :=
  sorry

/--
The p-adic norm is an absolute value: positive-definite and multiplicative, satisfying the triangle
inequality.
-/
protected instance is_absolute_value (p : ℕ) [hp : fact (nat.prime p)] :
    is_absolute_value (padic_norm p) :=
  is_absolute_value.mk (padic_norm.nonneg p)
    (fun (x : ℚ) =>
      { mp := fun (ᾰ : padic_norm p x = 0) => zero_of_padic_norm_eq_zero p ᾰ,
        mpr :=
          fun (ᾰ : x = 0) =>
            eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : ℚ) (e_1 : a = a_1) (ᾰ ᾰ_1 : ℚ) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg Eq e_1) e_2)
                    (padic_norm p x) 0
                    (Eq.trans
                      ((fun (p p_1 : ℕ) (e_1 : p = p_1) (q q_1 : ℚ) (e_2 : q = q_1) =>
                          congr (congr_arg padic_norm e_1) e_2)
                        p p (Eq.refl p) x 0 ᾰ)
                      (padic_norm.zero p))
                    0 0 (Eq.refl 0))
                  (propext (eq_self_iff_true 0))))
              trivial })
    (triangle_ineq p) (padic_norm.mul p)

theorem dvd_iff_norm_le {p : ℕ} [hp : fact (nat.prime p)] {n : ℕ} {z : ℤ} :
    ↑(p ^ n) ∣ z ↔ padic_norm p ↑z ≤ ↑p ^ (-↑n) :=
  sorry

end Mathlib


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Winston Yin

! This file was ported from Lean 3 source module analysis.ODE.picard_lindelof
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Integrals
import Mathbin.Topology.MetricSpace.Contracting

/-!
# Picard-Lindelöf (Cauchy-Lipschitz) Theorem

In this file we prove that an ordinary differential equation $\dot x=v(t, x)$ such that $v$ is
Lipschitz continuous in $x$ and continuous in $t$ has a local solution, see
`exists_forall_deriv_within_Icc_eq_of_is_picard_lindelof`.

As a corollary, we prove that a time-independent locally continuously differentiable ODE has a
local solution.

## Implementation notes

In order to split the proof into small lemmas, we introduce a structure `picard_lindelof` that holds
all assumptions of the main theorem. This structure and lemmas in the `picard_lindelof` namespace
should be treated as private implementation details. This is not to be confused with the `Prop`-
valued structure `is_picard_lindelof`, which holds the long hypotheses of the Picard-Lindelöf
theorem for actual use as part of the public API.

We only prove existence of a solution in this file. For uniqueness see `ODE_solution_unique` and
related theorems in `analysis.ODE.gronwall`.

## Tags

differential equation
-/

open Filter Function Set Metric TopologicalSpace intervalIntegral MeasureTheory

open MeasureTheory.MeasureSpace (volume)

open Filter Topology NNReal ENNReal Nat Interval

noncomputable section

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

/-- `Prop` structure holding the hypotheses of the Picard-Lindelöf theorem.

The similarly named `picard_lindelof` structure is part of the internal API for convenience, so as
not to constantly invoke choice, but is not intended for public use. -/
structure IsPicardLindelof {E : Type _} [NormedAddCommGroup E] (v : ℝ → E → E) (t_min t₀ t_max : ℝ)
  (x₀ : E) (L : ℝ≥0) (R C : ℝ) : Prop where
  ht₀ : t₀ ∈ Icc t_min t_max
  hR : 0 ≤ R
  lipschitz : ∀ t ∈ Icc t_min t_max, LipschitzOnWith L (v t) (closedBall x₀ R)
  cont : ∀ x ∈ closedBall x₀ R, ContinuousOn (fun t : ℝ => v t x) (Icc t_min t_max)
  norm_le : ∀ t ∈ Icc t_min t_max, ∀ x ∈ closedBall x₀ R, ‖v t x‖ ≤ C
  C_mul_le_R : (C : ℝ) * LinearOrder.max (t_max - t₀) (t₀ - t_min) ≤ R
#align is_picard_lindelof IsPicardLindelof

/-- This structure holds arguments of the Picard-Lipschitz (Cauchy-Lipschitz) theorem. It is part of
the internal API for convenience, so as not to constantly invoke choice. Unless you want to use one
of the auxiliary lemmas, use `exists_forall_deriv_within_Icc_eq_of_lipschitz_of_continuous` instead
of using this structure.

The similarly named `is_picard_lindelof` is a bundled `Prop` holding the long hypotheses of the
Picard-Lindelöf theorem as named arguments. It is used as part of the public API.
-/
structure PicardLindelof (E : Type _) [NormedAddCommGroup E] [NormedSpace ℝ E] where
  toFun : ℝ → E → E
  (tMin tMax : ℝ)
  t₀ : Icc t_min t_max
  x₀ : E
  (C r l : ℝ≥0)
  is_pl : IsPicardLindelof to_fun t_min t₀ t_max x₀ L R C
#align picard_lindelof PicardLindelof

namespace PicardLindelof

variable (v : PicardLindelof E)

instance : CoeFun (PicardLindelof E) fun _ => ℝ → E → E :=
  ⟨toFun⟩

instance : Inhabited (PicardLindelof E) :=
  ⟨⟨0, 0, 0, ⟨0, le_rfl, le_rfl⟩, 0, 0, 0, 0,
      { ht₀ := by
          rw [Subtype.coe_mk, Icc_self]
          exact mem_singleton _
        hR := by rfl
        lipschitz := fun t ht => (LipschitzWith.const 0).LipschitzOnWith _
        cont := fun _ _ => by simpa only [Pi.zero_apply] using continuousOn_const
        norm_le := fun t ht x hx => norm_zero.le
        C_mul_le_R := (MulZeroClass.zero_mul _).le }⟩⟩

theorem tMin_le_tMax : v.tMin ≤ v.tMax :=
  v.t₀.2.1.trans v.t₀.2.2
#align picard_lindelof.t_min_le_t_max PicardLindelof.tMin_le_tMax

protected theorem nonempty_Icc : (Icc v.tMin v.tMax).Nonempty :=
  nonempty_Icc.2 v.tMin_le_tMax
#align picard_lindelof.nonempty_Icc PicardLindelof.nonempty_Icc

protected theorem lipschitzOnWith {t} (ht : t ∈ Icc v.tMin v.tMax) :
    LipschitzOnWith v.l (v t) (closedBall v.x₀ v.r) :=
  v.is_pl.lipschitz t ht
#align picard_lindelof.lipschitz_on_with PicardLindelof.lipschitzOnWith

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
protected theorem continuousOn :
    ContinuousOn (uncurry v) (Icc v.tMin v.tMax ×ˢ closedBall v.x₀ v.r) :=
  have : ContinuousOn (uncurry (flip v)) (closedBall v.x₀ v.r ×ˢ Icc v.tMin v.tMax) :=
    continuousOn_prod_of_continuousOn_lipschitz_on _ v.l v.is_pl.cont v.is_pl.lipschitz
  this.comp continuous_swap.ContinuousOn (preimage_swap_prod _ _).symm.Subset
#align picard_lindelof.continuous_on PicardLindelof.continuousOn

theorem norm_le {t : ℝ} (ht : t ∈ Icc v.tMin v.tMax) {x : E} (hx : x ∈ closedBall v.x₀ v.r) :
    ‖v t x‖ ≤ v.C :=
  v.is_pl.norm_le _ ht _ hx
#align picard_lindelof.norm_le PicardLindelof.norm_le

/-- The maximum of distances from `t₀` to the endpoints of `[t_min, t_max]`. -/
def tDist : ℝ :=
  max (v.tMax - v.t₀) (v.t₀ - v.tMin)
#align picard_lindelof.t_dist PicardLindelof.tDist

theorem tDist_nonneg : 0 ≤ v.tDist :=
  le_max_iff.2 <| Or.inl <| sub_nonneg.2 v.t₀.2.2
#align picard_lindelof.t_dist_nonneg PicardLindelof.tDist_nonneg

theorem dist_t₀_le (t : Icc v.tMin v.tMax) : dist t v.t₀ ≤ v.tDist :=
  by
  rw [Subtype.dist_eq, Real.dist_eq]
  cases' le_total t v.t₀ with ht ht
  · rw [abs_of_nonpos (sub_nonpos.2 <| Subtype.coe_le_coe.2 ht), neg_sub]
    exact (sub_le_sub_left t.2.1 _).trans (le_max_right _ _)
  · rw [abs_of_nonneg (sub_nonneg.2 <| Subtype.coe_le_coe.2 ht)]
    exact (sub_le_sub_right t.2.2 _).trans (le_max_left _ _)
#align picard_lindelof.dist_t₀_le PicardLindelof.dist_t₀_le

/-- Projection $ℝ → [t_{\min}, t_{\max}]$ sending $(-∞, t_{\min}]$ to $t_{\min}$ and $[t_{\max}, ∞)$
to $t_{\max}$. -/
def proj : ℝ → Icc v.tMin v.tMax :=
  projIcc v.tMin v.tMax v.tMin_le_tMax
#align picard_lindelof.proj PicardLindelof.proj

theorem proj_coe (t : Icc v.tMin v.tMax) : v.proj t = t :=
  projIcc_val _ _
#align picard_lindelof.proj_coe PicardLindelof.proj_coe

theorem proj_of_mem {t : ℝ} (ht : t ∈ Icc v.tMin v.tMax) : ↑(v.proj t) = t := by
  simp only [proj, proj_Icc_of_mem _ ht, Subtype.coe_mk]
#align picard_lindelof.proj_of_mem PicardLindelof.proj_of_mem

@[continuity]
theorem continuous_proj : Continuous v.proj :=
  continuous_projIcc
#align picard_lindelof.continuous_proj PicardLindelof.continuous_proj

/-- The space of curves $γ \colon [t_{\min}, t_{\max}] \to E$ such that $γ(t₀) = x₀$ and $γ$ is
Lipschitz continuous with constant $C$. The map sending $γ$ to
$\mathbf Pγ(t)=x₀ + ∫_{t₀}^{t} v(τ, γ(τ))\,dτ$ is a contracting map on this space, and its fixed
point is a solution of the ODE $\dot x=v(t, x)$. -/
structure FunSpace where
  toFun : Icc v.tMin v.tMax → E
  map_t₀' : to_fun v.t₀ = v.x₀
  lipschitz' : LipschitzWith v.C to_fun
#align picard_lindelof.fun_space PicardLindelof.FunSpace

namespace FunSpace

variable {v} (f : FunSpace v)

instance : CoeFun (FunSpace v) fun _ => Icc v.tMin v.tMax → E :=
  ⟨toFun⟩

instance : Inhabited v.FunSpace :=
  ⟨⟨fun _ => v.x₀, rfl, (LipschitzWith.const _).weaken (zero_le _)⟩⟩

protected theorem lipschitz : LipschitzWith v.C f :=
  f.lipschitz'
#align picard_lindelof.fun_space.lipschitz PicardLindelof.FunSpace.lipschitz

protected theorem continuous : Continuous f :=
  f.lipschitz.Continuous
#align picard_lindelof.fun_space.continuous PicardLindelof.FunSpace.continuous

/-- Each curve in `picard_lindelof.fun_space` is continuous. -/
def toContinuousMap : v.FunSpace ↪ C(Icc v.tMin v.tMax, E) :=
  ⟨fun f => ⟨f, f.Continuous⟩, fun f g h => by
    cases f
    cases g
    simpa using h⟩
#align picard_lindelof.fun_space.to_continuous_map PicardLindelof.FunSpace.toContinuousMap

instance : MetricSpace v.FunSpace :=
  MetricSpace.induced toContinuousMap toContinuousMap.Injective inferInstance

theorem uniformInducing_toContinuousMap : UniformInducing (@toContinuousMap _ _ _ v) :=
  ⟨rfl⟩
#align picard_lindelof.fun_space.uniform_inducing_to_continuous_map PicardLindelof.FunSpace.uniformInducing_toContinuousMap

theorem range_toContinuousMap :
    range toContinuousMap = { f : C(Icc v.tMin v.tMax, E) | f v.t₀ = v.x₀ ∧ LipschitzWith v.C f } :=
  by
  ext f; constructor
  · rintro ⟨⟨f, hf₀, hf_lip⟩, rfl⟩
    exact ⟨hf₀, hf_lip⟩
  · rcases f with ⟨f, hf⟩
    rintro ⟨hf₀, hf_lip⟩
    exact ⟨⟨f, hf₀, hf_lip⟩, rfl⟩
#align picard_lindelof.fun_space.range_to_continuous_map PicardLindelof.FunSpace.range_toContinuousMap

theorem map_t₀ : f v.t₀ = v.x₀ :=
  f.map_t₀'
#align picard_lindelof.fun_space.map_t₀ PicardLindelof.FunSpace.map_t₀

protected theorem mem_closedBall (t : Icc v.tMin v.tMax) : f t ∈ closedBall v.x₀ v.r :=
  calc
    dist (f t) v.x₀ = dist (f t) (f.toFun v.t₀) := by rw [f.map_t₀']
    _ ≤ v.C * dist t v.t₀ := (f.lipschitz.dist_le_mul _ _)
    _ ≤ v.C * v.tDist := (mul_le_mul_of_nonneg_left (v.dist_t₀_le _) v.C.2)
    _ ≤ v.r := v.is_pl.C_mul_le_R

#align picard_lindelof.fun_space.mem_closed_ball PicardLindelof.FunSpace.mem_closedBall

/-- Given a curve $γ \colon [t_{\min}, t_{\max}] → E$, `v_comp` is the function
$F(t)=v(π t, γ(π t))$, where `π` is the projection $ℝ → [t_{\min}, t_{\max}]$. The integral of this
function is the image of `γ` under the contracting map we are going to define below. -/
def vComp (t : ℝ) : E :=
  v (v.proj t) (f (v.proj t))
#align picard_lindelof.fun_space.v_comp PicardLindelof.FunSpace.vComp

theorem vComp_apply_coe (t : Icc v.tMin v.tMax) : f.vComp t = v t (f t) := by
  simp only [v_comp, proj_coe]
#align picard_lindelof.fun_space.v_comp_apply_coe PicardLindelof.FunSpace.vComp_apply_coe

theorem continuous_vComp : Continuous f.vComp :=
  by
  have := (continuous_subtype_coe.prod_mk f.continuous).comp v.continuous_proj
  refine' ContinuousOn.comp_continuous v.continuous_on this fun x => _
  exact ⟨(v.proj x).2, f.mem_closed_ball _⟩
#align picard_lindelof.fun_space.continuous_v_comp PicardLindelof.FunSpace.continuous_vComp

theorem norm_vComp_le (t : ℝ) : ‖f.vComp t‖ ≤ v.C :=
  v.norm_le (v.proj t).2 <| f.mem_closedBall _
#align picard_lindelof.fun_space.norm_v_comp_le PicardLindelof.FunSpace.norm_vComp_le

theorem dist_apply_le_dist (f₁ f₂ : FunSpace v) (t : Icc v.tMin v.tMax) :
    dist (f₁ t) (f₂ t) ≤ dist f₁ f₂ :=
  @ContinuousMap.dist_apply_le_dist _ _ _ _ _ f₁.toContinuousMap f₂.toContinuousMap _
#align picard_lindelof.fun_space.dist_apply_le_dist PicardLindelof.FunSpace.dist_apply_le_dist

theorem dist_le_of_forall {f₁ f₂ : FunSpace v} {d : ℝ} (h : ∀ t, dist (f₁ t) (f₂ t) ≤ d) :
    dist f₁ f₂ ≤ d :=
  (@ContinuousMap.dist_le_iff_of_nonempty _ _ _ _ _ f₁.toContinuousMap f₂.toContinuousMap _
        v.nonempty_Icc.to_subtype).2
    h
#align picard_lindelof.fun_space.dist_le_of_forall PicardLindelof.FunSpace.dist_le_of_forall

instance [CompleteSpace E] : CompleteSpace v.FunSpace :=
  by
  refine'
    (completeSpace_iff_isComplete_range uniform_inducing_to_continuous_map).2
      (IsClosed.isComplete _)
  rw [range_to_continuous_map, set_of_and]
  refine' (isClosed_eq (ContinuousMap.continuous_eval_const _) continuous_const).inter _
  have : IsClosed { f : Icc v.t_min v.t_max → E | LipschitzWith v.C f } :=
    isClosed_setOf_lipschitzWith v.C
  exact this.preimage ContinuousMap.continuous_coe

theorem intervalIntegrableVComp (t₁ t₂ : ℝ) : IntervalIntegrable f.vComp volume t₁ t₂ :=
  f.continuous_vComp.IntervalIntegrable _ _
#align picard_lindelof.fun_space.interval_integrable_v_comp PicardLindelof.FunSpace.intervalIntegrableVComp

variable [CompleteSpace E]

/-- The Picard-Lindelöf operator. This is a contracting map on `picard_lindelof.fun_space v` such
that the fixed point of this map is the solution of the corresponding ODE.

More precisely, some iteration of this map is a contracting map. -/
def next (f : FunSpace v) : FunSpace v
    where
  toFun t := v.x₀ + ∫ τ : ℝ in v.t₀..t, f.vComp τ
  map_t₀' := by rw [integral_same, add_zero]
  lipschitz' :=
    LipschitzWith.of_dist_le_mul fun t₁ t₂ =>
      by
      rw [dist_add_left, dist_eq_norm,
        integral_interval_sub_left (f.interval_integrable_v_comp _ _)
          (f.interval_integrable_v_comp _ _)]
      exact norm_integral_le_of_norm_le_const fun t ht => f.norm_v_comp_le _
#align picard_lindelof.fun_space.next PicardLindelof.FunSpace.next

theorem next_apply (t : Icc v.tMin v.tMax) : f.next t = v.x₀ + ∫ τ : ℝ in v.t₀..t, f.vComp τ :=
  rfl
#align picard_lindelof.fun_space.next_apply PicardLindelof.FunSpace.next_apply

theorem hasDerivWithinAt_next (t : Icc v.tMin v.tMax) :
    HasDerivWithinAt (f.next ∘ v.proj) (v t (f t)) (Icc v.tMin v.tMax) t :=
  by
  haveI : Fact ((t : ℝ) ∈ Icc v.t_min v.t_max) := ⟨t.2⟩
  simp only [(· ∘ ·), next_apply]
  refine' HasDerivWithinAt.const_add _ _
  have :
    HasDerivWithinAt (fun t : ℝ => ∫ τ in v.t₀..t, f.v_comp τ) (f.v_comp t) (Icc v.t_min v.t_max)
      t :=
    integral_has_deriv_within_at_right (f.interval_integrable_v_comp _ _)
      (f.continuous_v_comp.strongly_measurable_at_filter _ _)
      f.continuous_v_comp.continuous_within_at
  rw [v_comp_apply_coe] at this
  refine' this.congr_of_eventually_eq_of_mem _ t.coe_prop
  filter_upwards [self_mem_nhdsWithin]with _ ht'
  rw [v.proj_of_mem ht']
#align picard_lindelof.fun_space.has_deriv_within_at_next PicardLindelof.FunSpace.hasDerivWithinAt_next

theorem dist_next_apply_le_of_le {f₁ f₂ : FunSpace v} {n : ℕ} {d : ℝ}
    (h : ∀ t, dist (f₁ t) (f₂ t) ≤ (v.l * |t - v.t₀|) ^ n / n ! * d) (t : Icc v.tMin v.tMax) :
    dist (next f₁ t) (next f₂ t) ≤ (v.l * |t - v.t₀|) ^ (n + 1) / (n + 1)! * d :=
  by
  simp only [dist_eq_norm, next_apply, add_sub_add_left_eq_sub, ←
    intervalIntegral.integral_sub (interval_integrable_v_comp _ _ _)
      (interval_integrable_v_comp _ _ _),
    norm_integral_eq_norm_integral_Ioc] at *
  calc
    ‖∫ τ in Ι (v.t₀ : ℝ) t, f₁.v_comp τ - f₂.v_comp τ‖ ≤
        ∫ τ in Ι (v.t₀ : ℝ) t, v.L * ((v.L * |τ - v.t₀|) ^ n / n ! * d) :=
      by
      refine' norm_integral_le_of_norm_le (Continuous.integrableOnUIoc _) _
      · continuity
      · refine' (ae_restrict_mem measurableSet_Ioc).mono fun τ hτ => _
        refine'
          (v.lipschitz_on_with (v.proj τ).2).norm_sub_le_of_le (f₁.mem_closed_ball _)
            (f₂.mem_closed_ball _) ((h _).trans_eq _)
        rw [v.proj_of_mem]
        exact uIcc_subset_Icc v.t₀.2 t.2 <| Ioc_subset_Icc_self hτ
    _ = (v.L * |t - v.t₀|) ^ (n + 1) / (n + 1)! * d := _

  simp_rw [mul_pow, div_eq_mul_inv, mul_assoc, MeasureTheory.integral_mul_left,
    MeasureTheory.integral_mul_right, integral_pow_abs_sub_uIoc, div_eq_mul_inv, pow_succ (v.L : ℝ),
    Nat.factorial_succ, Nat.cast_mul, Nat.cast_succ, mul_inv, mul_assoc]
#align picard_lindelof.fun_space.dist_next_apply_le_of_le PicardLindelof.FunSpace.dist_next_apply_le_of_le

theorem dist_iterate_next_apply_le (f₁ f₂ : FunSpace v) (n : ℕ) (t : Icc v.tMin v.tMax) :
    dist ((next^[n]) f₁ t) ((next^[n]) f₂ t) ≤ (v.l * |t - v.t₀|) ^ n / n ! * dist f₁ f₂ :=
  by
  induction' n with n ihn generalizing t
  · rw [pow_zero, Nat.factorial_zero, Nat.cast_one, div_one, one_mul]
    exact dist_apply_le_dist f₁ f₂ t
  · rw [iterate_succ_apply', iterate_succ_apply']
    exact dist_next_apply_le_of_le ihn _
#align picard_lindelof.fun_space.dist_iterate_next_apply_le PicardLindelof.FunSpace.dist_iterate_next_apply_le

theorem dist_iterate_next_le (f₁ f₂ : FunSpace v) (n : ℕ) :
    dist ((next^[n]) f₁) ((next^[n]) f₂) ≤ (v.l * v.tDist) ^ n / n ! * dist f₁ f₂ :=
  by
  refine' dist_le_of_forall fun t => (dist_iterate_next_apply_le _ _ _ _).trans _
  have : 0 ≤ dist f₁ f₂ := dist_nonneg
  have : |(t - v.t₀ : ℝ)| ≤ v.t_dist := v.dist_t₀_le t
  mono* <;> simp only [Nat.cast_nonneg, mul_nonneg, NNReal.coe_nonneg, abs_nonneg, *]
#align picard_lindelof.fun_space.dist_iterate_next_le PicardLindelof.FunSpace.dist_iterate_next_le

end FunSpace

variable [CompleteSpace E]

section

theorem exists_contracting_iterate :
    ∃ (N : ℕ)(K : _), ContractingWith K ((FunSpace.next : v.FunSpace → v.FunSpace)^[N]) :=
  by
  rcases((Real.tendsto_pow_div_factorial_atTop (v.L * v.t_dist)).Eventually
        (gt_mem_nhds zero_lt_one)).exists with
    ⟨N, hN⟩
  have : (0 : ℝ) ≤ (v.L * v.t_dist) ^ N / N ! :=
    div_nonneg (pow_nonneg (mul_nonneg v.L.2 v.t_dist_nonneg) _) (Nat.cast_nonneg _)
  exact
    ⟨N, ⟨_, this⟩, hN, LipschitzWith.of_dist_le_mul fun f g => fun_space.dist_iterate_next_le f g N⟩
#align picard_lindelof.exists_contracting_iterate PicardLindelof.exists_contracting_iterate

theorem exists_fixed : ∃ f : v.FunSpace, f.next = f :=
  let ⟨N, K, hK⟩ := exists_contracting_iterate v
  ⟨_, hK.isFixedPt_fixedPoint_iterate⟩
#align picard_lindelof.exists_fixed PicardLindelof.exists_fixed

end

/-- Picard-Lindelöf (Cauchy-Lipschitz) theorem. Use
`exists_forall_deriv_within_Icc_eq_of_is_picard_lindelof` instead for the public API. -/
theorem exists_solution :
    ∃ f : ℝ → E,
      f v.t₀ = v.x₀ ∧
        ∀ t ∈ Icc v.tMin v.tMax, HasDerivWithinAt f (v t (f t)) (Icc v.tMin v.tMax) t :=
  by
  rcases v.exists_fixed with ⟨f, hf⟩
  refine' ⟨f ∘ v.proj, _, fun t ht => _⟩
  · simp only [(· ∘ ·), proj_coe, f.map_t₀]
  · simp only [(· ∘ ·), v.proj_of_mem ht]
    lift t to Icc v.t_min v.t_max using ht
    simpa only [hf, v.proj_coe] using f.has_deriv_within_at_next t
#align picard_lindelof.exists_solution PicardLindelof.exists_solution

end PicardLindelof

theorem IsPicardLindelof.norm_le₀ {E : Type _} [NormedAddCommGroup E] {v : ℝ → E → E}
    {t_min t₀ t_max : ℝ} {x₀ : E} {C R : ℝ} {L : ℝ≥0}
    (hpl : IsPicardLindelof v t_min t₀ t_max x₀ L R C) : ‖v t₀ x₀‖ ≤ C :=
  hpl.norm_le t₀ hpl.ht₀ x₀ <| mem_closedBall_self hpl.hR
#align is_picard_lindelof.norm_le₀ IsPicardLindelof.norm_le₀

/-- Picard-Lindelöf (Cauchy-Lipschitz) theorem. -/
theorem exists_forall_deriv_within_Icc_eq_of_isPicardLindelof [CompleteSpace E] {v : ℝ → E → E}
    {t_min t₀ t_max : ℝ} (x₀ : E) {C R : ℝ} {L : ℝ≥0}
    (hpl : IsPicardLindelof v t_min t₀ t_max x₀ L R C) :
    ∃ f : ℝ → E,
      f t₀ = x₀ ∧ ∀ t ∈ Icc t_min t_max, HasDerivWithinAt f (v t (f t)) (Icc t_min t_max) t :=
  by
  lift C to ℝ≥0 using (norm_nonneg _).trans hpl.norm_le₀
  lift t₀ to Icc t_min t_max using hpl.ht₀
  exact
    PicardLindelof.exists_solution
      ⟨v, t_min, t_max, t₀, x₀, C, ⟨R, hpl.hR⟩, L, { hpl with ht₀ := t₀.property }⟩
#align exists_forall_deriv_within_Icc_eq_of_is_picard_lindelof exists_forall_deriv_within_Icc_eq_of_isPicardLindelof

variable [ProperSpace E] {v : E → E} (t₀ : ℝ) (x₀ : E)

/-- A time-independent, locally continuously differentiable ODE satisfies the hypotheses of the
  Picard-Lindelöf theorem. -/
theorem exists_isPicardLindelof_const_of_contDiffOn_nhds {s : Set E} (hv : ContDiffOn ℝ 1 v s)
    (hs : s ∈ 𝓝 x₀) :
    ∃ ε > (0 : ℝ), ∃ L R C, IsPicardLindelof (fun t => v) (t₀ - ε) t₀ (t₀ + ε) x₀ L R C :=
  by
  -- extract Lipschitz constant
  obtain ⟨L, s', hs', hlip⟩ :=
    ContDiffAt.exists_lipschitzOnWith ((hv.cont_diff_within_at (mem_of_mem_nhds hs)).ContDiffAt hs)
  -- radius of closed ball in which v is bounded
  obtain ⟨r, hr : 0 < r, hball⟩ := metric.mem_nhds_iff.mp (inter_sets (𝓝 x₀) hs hs')
  have hr' := (half_pos hr).le
  obtain ⟨C, hC⟩ :=
    (is_compact_closed_ball x₀ (r / 2)).bddAbove_image
      (-- uses proper_space E
        hv.continuous_on.norm.mono
        (subset_inter_iff.mp ((closed_ball_subset_ball (half_lt_self hr)).trans hball)).left)
  have hC' : 0 ≤ C := by
    apply (norm_nonneg (v x₀)).trans
    apply hC
    exact ⟨x₀, ⟨mem_closed_ball_self hr', rfl⟩⟩
  set ε := if C = 0 then 1 else r / 2 / C with hε
  have hε0 : 0 < ε := by
    rw [hε]
    split_ifs
    · exact zero_lt_one
    · exact div_pos (half_pos hr) (lt_of_le_of_ne hC' (Ne.symm h))
  refine' ⟨ε, hε0, L, r / 2, C, _⟩
  exact
    { ht₀ := by
        rw [← Real.closedBall_eq_Icc]
        exact mem_closed_ball_self hε0.le
      hR := (half_pos hr).le
      lipschitz := fun t ht =>
        hlip.mono
          (subset_inter_iff.mp (subset_trans (closed_ball_subset_ball (half_lt_self hr)) hball)).2
      cont := fun x hx => continuousOn_const
      norm_le := fun t ht x hx => hC ⟨x, hx, rfl⟩
      C_mul_le_R := by
        rw [add_sub_cancel', sub_sub_cancel, max_self, mul_ite, mul_one]
        split_ifs
        · rwa [← h] at hr'
        · exact (mul_div_cancel' (r / 2) h).le }
#align exists_is_picard_lindelof_const_of_cont_diff_on_nhds exists_isPicardLindelof_const_of_contDiffOn_nhds

/-- A time-independent, locally continuously differentiable ODE admits a solution in some open
interval. -/
theorem exists_forall_deriv_at_Ioo_eq_of_contDiffOn_nhds {s : Set E} (hv : ContDiffOn ℝ 1 v s)
    (hs : s ∈ 𝓝 x₀) :
    ∃ ε > (0 : ℝ),
      ∃ f : ℝ → E, f t₀ = x₀ ∧ ∀ t ∈ Ioo (t₀ - ε) (t₀ + ε), f t ∈ s ∧ HasDerivAt f (v (f t)) t :=
  by
  obtain ⟨ε, hε, L, R, C, hpl⟩ := exists_isPicardLindelof_const_of_contDiffOn_nhds t₀ x₀ hv hs
  obtain ⟨f, hf1, hf2⟩ := exists_forall_deriv_within_Icc_eq_of_isPicardLindelof x₀ hpl
  have hf2' : ∀ t ∈ Ioo (t₀ - ε) (t₀ + ε), HasDerivAt f (v (f t)) t := fun t ht =>
    (hf2 t (Ioo_subset_Icc_self ht)).HasDerivAt (Icc_mem_nhds ht.1 ht.2)
  have h : f ⁻¹' s ∈ 𝓝 t₀ :=
    by
    have := hf2' t₀ (mem_Ioo.mpr ⟨sub_lt_self _ hε, lt_add_of_pos_right _ hε⟩)
    apply ContinuousAt.preimage_mem_nhds this.continuous_at
    rw [hf1]
    exact hs
  rw [Metric.mem_nhds_iff] at h
  obtain ⟨r, hr1, hr2⟩ := h
  refine'
    ⟨min r ε, lt_min hr1 hε, f, hf1, fun t ht =>
      ⟨_,
        hf2' t
          (mem_of_mem_of_subset ht
            (Ioo_subset_Ioo (sub_le_sub_left (min_le_right _ _) _)
              (add_le_add_left (min_le_right _ _) _)))⟩⟩
  rw [← Set.mem_preimage]
  apply Set.mem_of_mem_of_subset _ hr2
  apply Set.mem_of_mem_of_subset ht
  rw [← Real.ball_eq_Ioo]
  exact Metric.ball_subset_ball (min_le_left _ _)
#align exists_forall_deriv_at_Ioo_eq_of_cont_diff_on_nhds exists_forall_deriv_at_Ioo_eq_of_contDiffOn_nhds

/-- A time-independent, continuously differentiable ODE admits a solution in some open interval. -/
theorem exists_forall_deriv_at_Ioo_eq_of_contDiff (hv : ContDiff ℝ 1 v) :
    ∃ ε > (0 : ℝ), ∃ f : ℝ → E, f t₀ = x₀ ∧ ∀ t ∈ Ioo (t₀ - ε) (t₀ + ε), HasDerivAt f (v (f t)) t :=
  let ⟨ε, hε, f, hf1, hf2⟩ :=
    exists_forall_deriv_at_Ioo_eq_of_contDiffOn_nhds t₀ x₀ hv.ContDiffOn
      (IsOpen.mem_nhds isOpen_univ (mem_univ _))
  ⟨ε, hε, f, hf1, fun t ht => (hf2 t ht).2⟩
#align exists_forall_deriv_at_Ioo_eq_of_cont_diff exists_forall_deriv_at_Ioo_eq_of_contDiff


-- M40002 (Analysis I) Chapter 7. Darboux Integration

import M40002.M40002_C6

namespace M40002

variables {a₁ a₂ : ℝ}

-- Definition of partitions
structure darboux_partition (n : ℕ) (a b : ℝ) :=
(xₖ : ℕ → ℝ)
(seq_min : xₖ 0 = a)
(seq_max : xₖ n = b)
(increasing : strict_mono xₖ)

#check darboux_partition

--theorem lower_inf_exists {n : ℕ} {a b : ℝ} (f : ℝ → ℝ) (xₖ : darboux_partition n a b) : ∀ i ∈ finset.range n, ∃ l : ℝ, inf {t : ℝ | xₖ i < t ∧ }

end M40002