/-
Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pierre-Alexandre Bazin, Scott Morrison
-/
import category_theory.simple
import algebra.category.Module.subobject
import algebra.category.Module.algebra
import ring_theory.simple_module
import linear_algebra.finite_dimensional

/-!
# Simple objects in the category of `R`-modules

We prove simple modules are exactly simple objects in the category of `R`-modules.
-/

variables {R M : Type*} [ring R] [add_comm_group M] [module R M]
open category_theory Module

lemma simple_iff_is_simple_module : simple (of R M) ↔ is_simple_module R M :=
(simple_iff_subobject_is_simple_order _).trans (subobject_Module (of R M)).is_simple_order_iff

lemma simple_iff_is_simple_module' (M : Module R) : simple M ↔ is_simple_module R M :=
(simple.iff_of_iso (of_self_iso M).symm).trans simple_iff_is_simple_module

/-- A simple module is a simple object in the category of modules. -/
instance simple_of_is_simple_module [is_simple_module R M] : simple (of R M) :=
simple_iff_is_simple_module.mpr ‹_›

/-- A simple object in the category of modules is a simple module. -/
instance is_simple_module_of_simple (M : Module R) [simple M] : is_simple_module R M :=
simple_iff_is_simple_module.mp (simple.of_iso (of_self_iso M))

open finite_dimensional

local attribute [instance] module_of_algebra_Module is_scalar_tower_of_algebra_Module

/-- Any `k`-algebra module which is 1-dimensional over `k` is simple. -/
lemma simple_of_finrank_eq_one {k : Type*} [field k] [algebra k R]
  {V : Module R} (h : finrank k V = 1) : simple V :=
(simple_iff_is_simple_module' V).mpr (is_simple_module_of_finrank_eq_one h)


/-
Copyright (c) 2022 Sam van Gool and Jake Levinson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sam van Gool, Jake Levinson
-/

import topology.sheaves.presheaf
import topology.sheaves.stalks
import category_theory.sites.surjective

/-!

# Locally surjective maps of presheaves.

Let `X` be a topological space, `ℱ` and `𝒢` presheaves on `X`, `T : ℱ ⟶ 𝒢` a map.

In this file we formulate two notions for what it means for
`T` to be locally surjective:

  1. For each open set `U`, each section `t : 𝒢(U)` is in the image of `T`
     after passing to some open cover of `U`.

  2. For each `x : X`, the map of *stalks* `Tₓ : ℱₓ ⟶ 𝒢ₓ` is surjective.

We prove that these are equivalent.

-/

universes v u

noncomputable theory

open category_theory
open topological_space
open opposite

namespace Top.presheaf

section locally_surjective

local attribute [instance] concrete_category.has_coe_to_fun
local attribute [instance] concrete_category.has_coe_to_sort

open_locale algebraic_geometry

/-- Let `C` be a concrete category, `X` a topological space. -/
variables {C : Type u} [category.{v} C] [concrete_category.{v} C] {X : Top.{v}}

/-- Let `ℱ, 𝒢 : (opens X)ᵒᵖ ⥤ C` be `C`-valued presheaves on `X`. -/
variables {ℱ 𝒢 : X.presheaf C}

/--
A map of presheaves `T : ℱ ⟶ 𝒢` is **locally surjective** if for any open set `U`,
section `t` over `U`, and `x ∈ U`, there exists an open set `x ∈ V ⊆ U` and a section `s` over `V`
such that `$T_*(s_V) = t|_V$`.

See `is_locally_surjective_iff` below.
-/
def is_locally_surjective (T : ℱ ⟶ 𝒢) :=
  category_theory.is_locally_surjective (opens.grothendieck_topology X) T

lemma is_locally_surjective_iff (T : ℱ ⟶ 𝒢) :
  is_locally_surjective T ↔
    ∀ U t (x ∈ U), ∃ V (ι : V ⟶ U), (∃ s, T.app _ s = t |_ₕ ι) ∧ x ∈ V :=
iff.rfl

section surjective_on_stalks

variables [limits.has_colimits C] [limits.preserves_filtered_colimits (forget C)]

/-- An equivalent condition for a map of presheaves to be locally surjective
is for all the induced maps on stalks to be surjective. -/
lemma locally_surjective_iff_surjective_on_stalks (T : ℱ ⟶ 𝒢) :
  is_locally_surjective T ↔
  ∀ (x : X), function.surjective ((stalk_functor C x).map T) :=
begin
  split; intro hT,
  { /- human proof:
    Let g ∈ Γₛₜ 𝒢 x be a germ. Represent it on an open set U ⊆ X
    as ⟨t, U⟩. By local surjectivity, pass to a smaller open set V
    on which there exists s ∈ Γ_ ℱ V mapping to t |_ V.
    Then the germ of s maps to g -/

    -- Let g ∈ Γₛₜ 𝒢 x be a germ.
    intros x g,
    -- Represent it on an open set U ⊆ X as ⟨t, U⟩.
    obtain ⟨U, hxU, t, rfl⟩ :=  𝒢.germ_exist x g,
    -- By local surjectivity, pass to a smaller open set V
    -- on which there exists s ∈ Γ_ ℱ V mapping to t |_ V.
    rcases hT U t x hxU with ⟨V, ι, ⟨s, h_eq⟩, hxV⟩,

    -- Then the germ of s maps to g.
    use ℱ.germ ⟨x, hxV⟩ s,
    convert stalk_functor_map_germ_apply V ⟨x, hxV⟩ T s,

    simpa [h_eq] using germ_res_apply 𝒢 ι ⟨x,hxV⟩ t, },

  { /- human proof:
    Let U be an open set, t ∈ Γ ℱ U a section, x ∈ U a point.
    By surjectivity on stalks, the germ of t is the image of
    some germ f ∈ Γₛₜ ℱ x. Represent f on some open set V ⊆ X as ⟨s, V⟩.
    Then there is some possibly smaller open set x ∈ W ⊆ V ∩ U on which
    we have T(s) |_ W = t |_ W. -/
    intros U t x hxU,
    set t_x := 𝒢.germ ⟨x, hxU⟩ t with ht_x,
    obtain ⟨s_x, hs_x : ((stalk_functor C x).map T) s_x = t_x⟩ := hT x t_x,
    obtain ⟨V, hxV, s, rfl⟩ := ℱ.germ_exist x s_x,
    -- rfl : ℱ.germ x s = s_x
    have key_W := 𝒢.germ_eq x hxV hxU (T.app _ s) t
      (by { convert hs_x,
            symmetry,
            convert stalk_functor_map_germ_apply _ _ _ s, }),
    obtain ⟨W, hxW, hWV, hWU, h_eq⟩ := key_W,

    refine ⟨W, hWU, ⟨ℱ.map hWV.op s, _⟩, hxW⟩,
    convert h_eq,
    simp only [← comp_apply, T.naturality], },
end

end surjective_on_stalks

end locally_surjective

end Top.presheaf


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.set.pairwise.basic
import order.succ_pred.basic

/-!
# Intervals `Ixx (f x) (f (order.succ x))`

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

In this file we prove

* `monotone.bUnion_Ico_Ioc_map_succ`: if `α` is a linear archimedean succ order and `β` is a linear
  order, then for any monotone function `f` and `m n : α`, the union of intervals
  `set.Ioc (f i) (f (order.succ i))`, `m ≤ i < n`, is equal to `set.Ioc (f m) (f n)`;

* `monotone.pairwise_disjoint_on_Ioc_succ`: if `α` is a linear succ order, `β` is a preorder, and
  `f : α → β` is a monotone function, then the intervals `set.Ioc (f n) (f (order.succ n))` are
  pairwise disjoint.

For the latter lemma, we also prove various order dual versions.
-/

open set order

variables {α β : Type*} [linear_order α]

namespace monotone

/-- If `α` is a linear archimedean succ order and `β` is a linear order, then for any monotone
function `f` and `m n : α`, the union of intervals `set.Ioc (f i) (f (order.succ i))`, `m ≤ i < n`,
is equal to `set.Ioc (f m) (f n)` -/
lemma bUnion_Ico_Ioc_map_succ [succ_order α] [is_succ_archimedean α]
  [linear_order β] {f : α → β} (hf : monotone f) (m n : α) :
  (⋃ i ∈ Ico m n, Ioc (f i) (f (succ i))) = Ioc (f m) (f n) :=
begin
  cases le_total n m with hnm hmn,
  { rw [Ico_eq_empty_of_le hnm, Ioc_eq_empty_of_le (hf hnm), bUnion_empty] },
  { refine succ.rec _ _ hmn,
    { simp only [Ioc_self, Ico_self, bUnion_empty] },
    { intros k hmk ihk,
      rw [← Ioc_union_Ioc_eq_Ioc (hf hmk) (hf $ le_succ _), union_comm, ← ihk],
      by_cases hk : is_max k,
      { rw [hk.succ_eq, Ioc_self, empty_union] },
      { rw [Ico_succ_right_eq_insert_of_not_is_max hmk hk, bUnion_insert] } } }
end

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `set.Ioc (f n) (f (order.succ n))` are pairwise disjoint. -/

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `set.Ico (f n) (f (order.succ n))` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ico_succ [succ_order α] [preorder β] {f : α → β} (hf : monotone f) :
  pairwise (disjoint on (λ n, Ico (f n) (f (succ n)))) :=
(pairwise_disjoint_on _).2 $ λ m n hmn,
  disjoint_iff_inf_le.mpr $ λ x ⟨⟨_, h₁⟩, ⟨h₂, _⟩⟩, h₁.not_le $ (hf $ succ_le_of_lt hmn).trans h₂

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `set.Ioo (f n) (f (order.succ n))` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ioo_succ [succ_order α] [preorder β] {f : α → β} (hf : monotone f) :
  pairwise (disjoint on (λ n, Ioo (f n) (f (succ n)))) :=
hf.pairwise_disjoint_on_Ico_succ.mono $ λ i j h, h.mono Ioo_subset_Ico_self Ioo_subset_Ico_self

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `set.Ioc (f order.pred n) (f n)` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ioc_pred [pred_order α] [preorder β] {f : α → β} (hf : monotone f) :
  pairwise (disjoint on (λ n, Ioc (f (pred n)) (f n))) :=
by simpa only [(∘), dual_Ico] using hf.dual.pairwise_disjoint_on_Ico_succ

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `set.Ico (f order.pred n) (f n)` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ico_pred [pred_order α] [preorder β] {f : α → β} (hf : monotone f) :
  pairwise (disjoint on (λ n, Ico (f (pred n)) (f n))) :=
by simpa only [(∘), dual_Ioc] using hf.dual.pairwise_disjoint_on_Ioc_succ

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `set.Ioo (f order.pred n) (f n)` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ioo_pred [pred_order α] [preorder β] {f : α → β} (hf : monotone f) :
  pairwise (disjoint on (λ n, Ioo (f (pred n)) (f n))) :=
by simpa only [(∘), dual_Ioo] using hf.dual.pairwise_disjoint_on_Ioo_succ

end monotone

namespace antitone

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `set.Ioc (f (order.succ n)) (f n)` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ioc_succ [succ_order α] [preorder β] {f : α → β} (hf : antitone f) :
  pairwise (disjoint on (λ n, Ioc (f (succ n)) (f n))) :=
hf.dual_left.pairwise_disjoint_on_Ioc_pred

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `set.Ico (f (order.succ n)) (f n)` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ico_succ [succ_order α] [preorder β] {f : α → β} (hf : antitone f) :
  pairwise (disjoint on (λ n, Ico (f (succ n)) (f n))) :=
hf.dual_left.pairwise_disjoint_on_Ico_pred

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `set.Ioo (f (order.succ n)) (f n)` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ioo_succ [succ_order α] [preorder β] {f : α → β} (hf : antitone f) :
  pairwise (disjoint on (λ n, Ioo (f (succ n)) (f n))) :=
hf.dual_left.pairwise_disjoint_on_Ioo_pred

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `set.Ioc (f n) (f (order.pred n))` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ioc_pred [pred_order α] [preorder β] {f : α → β} (hf : antitone f) :
  pairwise (disjoint on (λ n, Ioc (f n) (f (pred n)))) :=
hf.dual_left.pairwise_disjoint_on_Ioc_succ

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `set.Ico (f n) (f (order.pred n))` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ico_pred [pred_order α] [preorder β] {f : α → β} (hf : antitone f) :
  pairwise (disjoint on (λ n, Ico (f n) (f (pred n)))) :=
hf.dual_left.pairwise_disjoint_on_Ico_succ

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `set.Ioo (f n) (f (order.pred n))` are pairwise disjoint. -/
lemma pairwise_disjoint_on_Ioo_pred [pred_order α] [preorder β] {f : α → β} (hf : antitone f) :
  pairwise (disjoint on (λ n, Ioo (f n) (f (pred n)))) :=
hf.dual_left.pairwise_disjoint_on_Ioo_succ

end antitone


/-
Copyright (c) 2019 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo
-/

import algebra.pointwise
import analysis.normed_space.basic

/-!
# Seminorms and Local Convexity

This file introduces the following notions, defined for a vector space
over a normed field:

- the subset properties of being `absorbent` and `balanced`,

- a `seminorm`, a function to the reals that is positive-semidefinite,
  absolutely homogeneous, and subadditive.

We prove related properties.

## TODO

Define and show equivalence of two notions of local convexity for a
topological vector space over ℝ or ℂ: that it has a local base of
balanced convex absorbent sets, and that it carries the initial
topology induced by a family of seminorms.

## References
* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]
-/

/-!
### Subset Properties

Absorbent and balanced sets in a vector space over a
nondiscrete normed field.
-/

section

variables
(𝕜 : Type*) [nondiscrete_normed_field 𝕜]
{E : Type*} [add_comm_group E] [module 𝕜 E]

open set normed_field
open_locale topological_space

/-- A set `A` absorbs another set `B` if `B` is contained in scaling
`A` by elements of sufficiently large norms. -/
def absorbs (A B : set E) := ∃ r > 0, ∀ a : 𝕜, r ≤ ∥a∥ → B ⊆ a • A

/-- A set is absorbent if it absorbs every singleton. -/
def absorbent (A : set E) := ∀ x, ∃ r > 0, ∀ a : 𝕜, r ≤ ∥a∥ → x ∈ a • A

/-- A set `A` is balanced if `a • A` is contained in `A` whenever `a`
has norm no greater than one. -/
def balanced (A : set E) := ∀ a : 𝕜, ∥a∥ ≤ 1 → a • A ⊆ A

variables {𝕜} (a : 𝕜) {A : set E}

/-- A balanced set absorbs itself. -/
lemma balanced.absorbs_self (hA : balanced 𝕜 A) : absorbs 𝕜 A A :=
begin
  use [1, zero_lt_one],
  intros a ha x hx,
  rw mem_smul_set_iff_inv_smul_mem,
  { apply hA a⁻¹,
    { rw norm_inv, exact inv_le_one ha },
    { rw mem_smul_set, use [x, hx] }},
  { rw ←norm_pos_iff, calc 0 < 1 : zero_lt_one ... ≤ ∥a∥ : ha, }
end

lemma balanced.univ : balanced 𝕜 (univ : set E) :=
λ a ha, subset_univ _

lemma balanced.union {A₁ A₂ : set E} (hA₁ : balanced 𝕜 A₁) (hA₂ : balanced 𝕜 A₂) :
  balanced 𝕜 (A₁ ∪ A₂) :=
begin
  intros a ha t ht,
  rw [smul_set_union] at ht,
  exact ht.imp (λ x, hA₁ _ ha x) (λ x, hA₂ _ ha x),
end

lemma balanced.inter {A₁ A₂ : set E} (hA₁ : balanced 𝕜 A₁) (hA₂ : balanced 𝕜 A₂) :
  balanced 𝕜 (A₁ ∩ A₂) :=
begin
  rintro a ha _ ⟨x, ⟨hx₁, hx₂⟩, rfl⟩,
  exact ⟨hA₁ _ ha ⟨_, hx₁, rfl⟩, hA₂ _ ha ⟨_, hx₂, rfl⟩⟩,
end

lemma balanced.add {A₁ A₂ : set E} (hA₁ : balanced 𝕜 A₁) (hA₂ : balanced 𝕜 A₂) :
  balanced 𝕜 (A₁ + A₂) :=
begin
  rintro a ha _ ⟨_, ⟨x, y, hx, hy, rfl⟩, rfl⟩,
  rw smul_add,
  exact ⟨_, _, hA₁ _ ha ⟨_, hx, rfl⟩, hA₂ _ ha ⟨_, hy, rfl⟩, rfl⟩,
end

lemma balanced.smul (hA : balanced 𝕜 A) : balanced 𝕜 (a • A) :=
begin
  rintro b hb _ ⟨_, ⟨x, hx, rfl⟩, rfl⟩,
  exact ⟨b • x, hA _ hb ⟨_, hx, rfl⟩, smul_comm _ _ _⟩,
end

lemma absorbent_iff_forall_absorbs_singleton :
  absorbent 𝕜 A ↔ ∀ x, absorbs 𝕜 A {x} :=
by simp [absorbs, absorbent]

/-!
Properties of balanced and absorbing sets in a topological vector space:
-/
variables [topological_space E] [has_continuous_smul 𝕜 E]

/-- Every neighbourhood of the origin is absorbent. -/
lemma absorbent_nhds_zero (hA : A ∈ 𝓝 (0 : E)) : absorbent 𝕜 A :=
begin
  intro x,
  rcases mem_nhds_sets_iff.mp hA with ⟨w, hw₁, hw₂, hw₃⟩,
  have hc : continuous (λ t : 𝕜, t • x), from continuous_id.smul continuous_const,
  rcases metric.is_open_iff.mp (hw₂.preimage hc) 0 (by rwa [mem_preimage, zero_smul])
    with ⟨r, hr₁, hr₂⟩,
  have hr₃, from inv_pos.mpr (half_pos hr₁),
  use [(r/2)⁻¹, hr₃],
  intros a ha₁,
  have ha₂ : 0 < ∥a∥ := hr₃.trans_le ha₁,
  have ha₃ : a ⁻¹ • x ∈ w,
  { apply hr₂,
    rw [metric.mem_ball, dist_zero_right, norm_inv],
    calc ∥a∥⁻¹ ≤ r/2 : (inv_le (half_pos hr₁) ha₂).mp ha₁
    ...       < r : half_lt_self hr₁ },
  rw [mem_smul_set_iff_inv_smul_mem (norm_pos_iff.mp ha₂)],
  exact hw₁ ha₃,
end

/-- The union of `{0}` with the interior of a balanced set
    is balanced. -/
lemma balanced_zero_union_interior (hA : balanced 𝕜 A) :
  balanced 𝕜 ({(0 : E)} ∪ interior A) :=
begin
  intros a ha, by_cases a = 0,
  { rw [h, zero_smul_set],
    exacts [subset_union_left _ _, ⟨0, or.inl rfl⟩] },
  { rw [←image_smul, image_union],
    apply union_subset_union,
    { rw [image_singleton, smul_zero] },
    { calc a • interior A ⊆ interior (a • A) : (is_open_map_smul' h).image_interior_subset A
                      ... ⊆ interior A       : interior_mono (hA _ ha) } }
end

/-- The interior of a balanced set is balanced if it contains the origin. -/
lemma balanced.interior (hA : balanced 𝕜 A) (h : (0 : E) ∈ interior A) :
  balanced 𝕜 (interior A) :=
begin
  rw ←singleton_subset_iff at h,
  rw [←union_eq_self_of_subset_left h],
  exact balanced_zero_union_interior hA,
end

/-- The closure of a balanced set is balanced. -/
lemma balanced.closure (hA : balanced 𝕜 A) : balanced 𝕜 (closure A) :=
assume a ha,
calc _ ⊆ closure (a • A) : image_closure_subset_closure_image (continuous_id.const_smul _)
...    ⊆ _ : closure_mono (hA _ ha)

end

/-!
### Seminorms
-/

/-- A seminorm on a vector space over a normed field is a function to
the reals that is positive semidefinite, positive homogeneous, and
subadditive. -/
structure seminorm (𝕜 : Type*) (E : Type*)
  [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] :=
(to_fun    : E → ℝ)
(smul'     : ∀ (a : 𝕜) (x : E), to_fun (a • x) = ∥a∥ * to_fun x)
(triangle' : ∀ x y : E, to_fun (x + y) ≤ to_fun x + to_fun y)

variables
{𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [add_comm_group E] [module 𝕜 E]

instance : inhabited (seminorm 𝕜 E) :=
⟨{ to_fun     := λ _, 0,
   smul'     := λ _ _, (mul_zero _).symm,
   triangle' := λ x y, by rw add_zero }⟩

instance : has_coe_to_fun (seminorm 𝕜 E) := ⟨_, λ p, p.to_fun⟩

namespace seminorm

variables (p : seminorm 𝕜 E) (c : 𝕜) (x y : E) (r : ℝ)

protected lemma smul : p (c • x) = ∥c∥ * p x := p.smul' _ _
protected lemma triangle : p (x + y) ≤ p x + p y := p.triangle' _ _

@[simp]
protected lemma zero : p 0 = 0 :=
calc p 0 = p ((0 : 𝕜) • 0) : by rw zero_smul
...      = 0 : by rw [p.smul, norm_zero, zero_mul]

@[simp]
protected lemma neg : p (-x) = p x :=
calc p (-x) = p ((-1 : 𝕜) • x) : by rw neg_one_smul
...         = p x : by rw [p.smul, norm_neg, norm_one, one_mul]

lemma nonneg : 0 ≤ p x :=
have h: 0 ≤ 2 * p x, from
calc 0 = p (x + (- x)) : by rw [add_neg_self, p.zero]
...    ≤ p x + p (-x)  : p.triangle _ _
...    = 2 * p x : by rw [p.neg, two_mul],
nonneg_of_mul_nonneg_left h zero_lt_two

lemma sub_rev : p (x - y) = p (y - x) :=
by rw [←neg_sub, p.neg]

/-- The ball of radius `r` at `x` with respect to seminorm `p`
    is the set of elements `y` with `p (y - x) < `r`. -/
def ball (p : seminorm 𝕜 E) (x : E) (r : ℝ) := { y : E | p (y - x) < r }

lemma mem_ball : y ∈ ball p x r ↔ p (y - x) < r :=
iff.rfl

lemma mem_ball_zero : y ∈ ball p 0 r ↔ p y < r :=
by rw [mem_ball, sub_zero]

lemma ball_zero_eq : ball p 0 r = { y : E | p y < r } :=
set.ext $ λ x,by { rw mem_ball_zero, exact iff.rfl }

/-- Seminorm-balls at the origin are balanced. -/
lemma balanced_ball_zero : balanced 𝕜 (ball p 0 r) :=
begin
  rintro a ha x ⟨y, hy, hx⟩,
  rw [mem_ball_zero, ←hx, p.smul],
  calc _ ≤ p y : mul_le_of_le_one_left (p.nonneg _) ha
  ...    < r   : by rwa mem_ball_zero at hy,
end

-- TODO: convexity and absorbent/balanced sets in vector spaces over ℝ

end seminorm

-- TODO: the minkowski functional, topology induced by family of
-- seminorms, local convexity.


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl (CMU)
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.core
import Mathlib.PostPort

universes u

namespace Mathlib

theorem monotonicity.pi {α : Sort u} {p : α → Prop} {q : α → Prop}
    (h : ∀ (a : α), implies (p a) (q a)) : implies (∀ (a : α), p a) (∀ (a : α), q a) :=
  fun (h' : ∀ (a : α), p a) (a : α) => h a (h' a)

theorem monotonicity.imp {p : Prop} {p' : Prop} {q : Prop} {q' : Prop} (h₁ : implies p' q')
    (h₂ : implies q p) : implies (p → p') (q → q') :=
  fun (h : p → p') => h₁ ∘ h ∘ h₂

theorem monotonicity.const (p : Prop) : implies p p := id

theorem monotonicity.true (p : Prop) : implies p True := fun (_x : p) => trivial

theorem monotonicity.false (p : Prop) : implies False p := false.elim

theorem monotonicity.exists {α : Sort u} {p : α → Prop} {q : α → Prop}
    (h : ∀ (a : α), implies (p a) (q a)) : implies (∃ (a : α), p a) (∃ (a : α), q a) :=
  exists_imp_exists h

theorem monotonicity.and {p : Prop} {p' : Prop} {q : Prop} {q' : Prop} (hp : implies p p')
    (hq : implies q q') : implies (p ∧ q) (p' ∧ q') :=
  and.imp hp hq

theorem monotonicity.or {p : Prop} {p' : Prop} {q : Prop} {q' : Prop} (hp : implies p p')
    (hq : implies q q') : implies (p ∨ q) (p' ∨ q') :=
  or.imp hp hq

theorem monotonicity.not {p : Prop} {q : Prop} (h : implies p q) : implies (¬q) (¬p) := mt h

end Mathlib


import tactic
import linear_algebra.basis
import data.complex.basic
import data.polynomial.coeff

variables (F : Type) [field F] (V : Type) [add_comm_group V] [module F V]

section comp
open complex

--exercise 1.1
example (a b : ℝ) (h : a ≠ 0 ∨ b ≠ 0) : ∃ c d : ℝ,
  (1 : ℂ) / (a + b*I) = c + d*I :=
begin
  let z : ℂ := 1/(a + b*I),
  use [z.re, z.im],
  change z = z.re + z.im*I,
  exact (re_add_im z).symm,
end

--Thanks Alex Best for a much better proof of this!
--exercise 1.2
example : ((-1 + (real.sqrt 3 : ℂ)*I)/2)^3 = 1 :=
begin
  field_simp,
  ring_nf,
  norm_num,
  ring_nf,
  norm_cast,
  norm_num,
end

end comp

def subspace' (U : set V) :=
  ((0 : V) ∈ U) ∧
  (∀ u v ∈ U, u + v ∈ U) ∧
  (∀ a : F, ∀ u ∈ U, a•u ∈ U)

--exercise 1.3
example (v : V) : -(-v) = v := neg_neg v

--exercise 1.4
example (a : F) (v : V) (hav : a•v = 0) : a = 0 ∨ v = 0 := smul_eq_zero.mp hav

section ch1_ex5

--exercise 1.5a
example : @subspace' ℝ _ (ℝ × ℝ × ℝ) _ _
  {v : ℝ × ℝ × ℝ | ∃ x₁ x₂ x₃ : ℝ, v = (x₁, x₂, x₃) ∧ x₁ + 2*x₂ + 3*x₃ = 0} :=
begin
  split,
  { --contains 0
    exact ⟨0,0,0, rfl, by simp⟩},
  split,
  { --closed under addition
    rintros _ ⟨x₁, x₂, x₃, rfl, hxs⟩ _ ⟨y₁, y₂, y₃, rfl, hys⟩,
    use [x₁ + y₁, x₂ + y₂, x₃ + y₃],
    exact ⟨rfl, by linarith [hxs, hys]⟩,
  },
  { --closed under scaling
    rintros a _ ⟨x₁, x₂, x₃, rfl, hxs⟩,
    use [a*x₁, a*x₂, a*x₃],
    split,
    {refl,},
    calc --unfortunately, linarith can't solve this
      a * x₁ + 2 * (a * x₂) + 3 * (a * x₃) = a * (x₁ + 2 * x₂ + 3 * x₃) : by linarith
      ... = a * 0 : by rw hxs
      ... = 0 : mul_zero a,
  }
end

--exercise 1.5b
example : ¬ @subspace' ℝ _ (ℝ × ℝ × ℝ) _ _
  {v : ℝ × ℝ × ℝ | ∃ x₁ x₂ x₃ : ℝ, v = (x₁, x₂, x₃) ∧ x₁ + 2*x₂ + 3*x₃ = 4} :=
begin
  rintros ⟨a, h, b⟩, clear a, clear b, --this set is not closed under addition
  specialize h (4,0,0) ⟨4,0,0,rfl,by simp⟩ (4,0,0) ⟨4,0,0,rfl,by simp⟩,
  rcases h with ⟨x₁, x₂, x₃, h1, h⟩,
  simp * at *,
  rcases h1 with ⟨hx₁, hx₂, hx₃⟩,
  linarith,
end

--exercise 1.5c
example : ¬ @subspace' ℝ _ (ℝ × ℝ × ℝ) _ _
  {v : ℝ × ℝ × ℝ | ∃ x₁ x₂ x₃ : ℝ, v = (x₁, x₂, x₃) ∧ x₁*x₂*x₃ = 0} :=
begin
  rintros ⟨a, h, b⟩, clear a, clear b, --this set is not closed under addition
  specialize h (1,0,0) ⟨1,0,0,rfl,by simp⟩ (0,1,1) ⟨0,1,1,rfl,by simp⟩,
  rcases h with ⟨x₁, x₂, x₃, h1, h⟩,
  simp * at *,
  tidy,
end

--exercise 1.5d
example : subspace' ℝ (ℝ × ℝ × ℝ)
  {v : ℝ × ℝ × ℝ | ∃ x₁ x₂ x₃ : ℝ, v = (x₁, x₂, x₃) ∧ x₁ = 5*x₃} :=
begin
  split,
  { --contains 0
    exact ⟨0,0,0, rfl, by simp⟩},
  split,
  { --closed under addition
    rintros _ ⟨x₁, x₂, x₃, rfl, hxs⟩ _ ⟨y₁, y₂, y₃, rfl, hys⟩,
    use [x₁ + y₁, x₂ + y₂, x₃ + y₃],
    exact ⟨rfl, by linarith [hxs, hys]⟩,
  },
  { --closed under scaling
    rintros a _ ⟨x₁, x₂, x₃, rfl, hxs⟩,
    use [a*x₁, a*x₂, a*x₃],
    split,
    {refl,},
    rw hxs,
    rw [← mul_assoc, mul_comm a, mul_assoc],
  }
end

end ch1_ex5

--exercise 1.6
example : ∃ U : set (ℝ × ℝ), (nonempty U ∧
  (∀ u v ∈ U, u + v ∈ U) ∧
  (∀ u ∈ U, -u ∈ U) ∧
  ¬(subspace' ℝ (ℝ × ℝ) U)) :=
begin
  use {v : (ℝ × ℝ) | ∃ n m : ℤ, v = (n,m)},
  split,
  { use [(0,0),0,0], --U is nonempty
    simp only [int.cast_zero],
  },
  split,
  { rintros _ ⟨n₁, n₂, rfl⟩ _ ⟨m₁, m₂, rfl⟩, --U closed under addition
    use [n₁ + m₁, n₂ + m₂],
    simp only [prod.mk_add_mk, int.cast_add],},
  split,
  { rintros _ ⟨n, m, rfl⟩, --U closed under negation
    use [-n, -m],
    simp only [prod.neg_mk, int.cast_neg],},
  { rintros ⟨a, b, h⟩, clear a, clear b,    --but U not closed under scaling
    specialize h (1/2) (1,0) ⟨1,0,by simp⟩, --and is therefore not a subspace
    rcases h with ⟨n, m, hnm⟩,
    rw prod.smul_mk at hnm,
    rw prod.mk.inj_iff at hnm,
    cases hnm with h a, clear a,
    field_simp at h,
    norm_cast at h,
    have h1 := odd_one,
    rw h at h1,
    rw int.odd_iff_not_even at h1,
    apply h1,
    simp,
    --probably a much better way to do this?
  }
end

--exercise 1.7
example : ∃ U : set (ℝ × ℝ), (nonempty U ∧
  (∀ a : ℝ, ∀ u ∈ U, a•u ∈ U) ∧
  ¬(subspace' ℝ (ℝ × ℝ) U)) :=
begin
  use {v : ℝ × ℝ | ∃ x : ℝ, v = (0,x) ∨ v = (x,0)},
  split,
  { use [(0,0),0], --U is nonempty
    left,
    refl,
  },
  split,
  { rintros r u ⟨x, hx⟩, --U closed under scaling
    cases hx,
    { use r*x,
      left,
      simp [hx],},
    { use r*x,
      right,
      simp [hx],},
  },
  { rintros ⟨a, h, b⟩, clear a, clear b,        --but U not closed under addition
    specialize h (1,0) ⟨1,or.intro_right _ rfl⟩ --and is therefore not a subspace
                (0,1) ⟨1,or.intro_left _ rfl⟩,
    cases h with x hx,
    simp at hx,
    exact hx,
  }
end

--exercise 1.8
example (α : Type) (ι : α → set V) (H : ∀ a : α, subspace' F V (ι a)) :
        subspace' F V (⋂ a : α, ι a) :=
begin
  split,
  { rw set.mem_Inter,      --intersection contains 0
    exact λ a, (H a).1,},
  split,
  { intros u hu v hv,      --intersection closed under addition
    rw set.mem_Inter at *,
    exact λ a, (H a).2.1 u (hu a) v (hv a),},
  { intros r u hu,
    rw set.mem_Inter at *, --intersection closed under scaling
    exact λ a, (H a).2.2 r u (hu a),
  }
end

--exercise 1.9
example (U U' : set V) (hU : subspace' F V U) (hU' : subspace' F V U') :
  subspace' F V (U ∪ U') ↔ U ⊆ U' ∨ U' ⊆ U :=
begin
  split,
  { contrapose!,
    repeat {rw set.not_subset_iff_exists_mem_not_mem},
    rintros ⟨⟨x, hxU, hxU'⟩,⟨y, hyU', hyU⟩⟩ h,    --if neither subspace is a subset of the other,
    have hx : x ∈ U ∪ U',                         --we can choose x ∈ U \ U', y ∈ U' \ U
      {left, exact hxU},
    have hy : y ∈ U ∪ U',
      {right, exact hyU'},
    have hxy : x + y ∈ U ∪ U',                    --then x + y ∈ U ∪ U', since U ∪ U' subspace
      {exact h.2.1 x hx y hy},
    cases hxy,
      { apply hyU,                                --but x + y ∈ U → y ∈ U, and x + y ∈ U' → x ∈ U'
        convert hU.2.1 ((-1)•x) (hU.2.2 (-1) x hxU) (x + y) (hxy),
        simp,},
      { apply hxU',
        convert hU'.2.1 ((-1)•y) (hU'.2.2 (-1) y hyU') (x + y) (hxy),
        simp,},
  },
  { intros h,
    cases h,
    { rw set.union_eq_self_of_subset_left h, --if U ⊆ U', then U ∪ U' = U'
      exact hU'},                            --is a subspace
    { rw set.union_eq_self_of_subset_right h,
      exact hU},
  }
end

--exercise 1.10
example (U : set V) (hU : subspace' F V U) : {v | ∃ x y ∈ U, v = x + y} = U :=
begin
  ext a,
  split,
  { rintros ⟨x, hx, y, hy, rfl⟩,
    exact hU.2.1 x hx y hy,},
  { intro ha,
    use [a, ha, 0, hU.1],
    simp,}
end

--exercise 1.11, part i
example (U₁ U₂ : submodule F V) : U₁ ⊔ U₂ = U₂ ⊔ U₁ := sup_comm

--exercise 1.11, part ii
example (U₁ U₂ U₃ : submodule F V) : (U₁ ⊔ U₂) ⊔ U₃ = U₁ ⊔ (U₂ ⊔ U₃) := sup_assoc

--exercise 1.12, part i
example : ∃ U : submodule F V, ∀ U' : submodule F V, U ⊔ U' = U' :=
begin
  use ⊥,
  intro U',
  exact bot_sup_eq,
end

--exercise 1.12, part ii
example : ∀ U : submodule F V, (∃ U' : submodule F V, U ⊔ U' = ⊥) → U = ⊥ :=
begin
  rintros U ⟨U', hU'⟩,
  rw sup_eq_bot_iff at hU',
  exact hU'.left,
end

--exercise 1.13
example : ∃ U₁ U₂ W : submodule F (F × F), (U₁ ⊔ W = U₂ ⊔ W) ∧ (U₁ ≠ U₂) :=
begin
  use [⊥, ⊤, ⊤],
  simp,
  exact bot_ne_top,
end

section direct_sum
local notation U `⊕` W := U ⊔ W = ⊤ ∧ U ⊓ W = ⊥

--exercise 1.14
open polynomial
def U : subspace F (polynomial F) :=  --can these easy proofs be more automated?
{ carrier := {f | ∃ a b : F, f = a•X^2 + b•X^5},
  add_mem' :=
    begin
      rintro f g ⟨a,b,rfl⟩ ⟨c,d,rfl⟩,
      use [a+c,b+d],
      repeat {rw add_smul},
      ring,
    end,
  zero_mem' := ⟨0,0, by simp⟩,
  smul_mem' :=
    begin
      rintro c f ⟨a,b,rfl⟩,
      use [c*a, c*b],
      rw smul_add,
      repeat {rw mul_smul},
    end,}

def W : subspace F (polynomial F) :=
{ carrier := {f | f.coeff 2 = 0 ∧ f.coeff 5 = 0},
  add_mem' :=
    begin
      rintro f g ⟨hf2, hf5⟩ ⟨hg2, hg5⟩,
      split;
      rw coeff_add;
      simp *,
    end,
  zero_mem' := by simp,
  smul_mem' :=
    begin
      rintro c f ⟨hf2, hf5⟩,
      split;
      rw coeff_smul;
      simp *,
    end,}

--the actual problem. This was pretty painful
example : ∃ W : subspace F (polynomial F), (U F) ⊕ W :=
begin
  use W F,
  split,
  { ext,
    split,
    { exact λ _, by triv,},
    { intro a, clear a,
      let a := x.coeff 2,
      let b := x.coeff 5,
      let f := a•X^2 + b•X^5,
      let g := x - f,
      have hx : x = f + g := by simp,
      have hf : f ∈ (U F) := by use [a,b],
      have hg : g ∈ (W F),
      { split;
        simp [g, f, coeff_X_pow],},
      rw hx,
      exact submodule.add_mem_sup hf hg,
    }
  },
  { ext,
    split,
    { rintro ⟨hxU, hxW⟩,
      rcases hxU with ⟨a,b, hx⟩,
      have ha : a = x.coeff 2 := by simp [hx, coeff_X_pow],
      have hb : b = x.coeff 5 := by simp [hx, coeff_X_pow],
      cases hxW with hx1 hx2,
      rw [ha, hb, hx1, hx2] at hx,
      simp [hx],
    },
    { simp,
      rintro rfl,
      exact ⟨(U F).zero_mem, (W F).zero_mem⟩,},
  }
end

--exercise 1.15
def U₁ : submodule F (F × F) :=           --could also define U₁ as span {(1,0)}
{ carrier := {x | x.1 = 0},               --decided not to, since span isn't defined
  add_mem' := λ x y hx hy, by simp * at *,--until ch2
  zero_mem' := by simp,
  smul_mem' := λ c x hx, by simp * at *,
}

def U₂ : submodule F (F × F) :=
{ carrier := {x | x.2 = 0},
  add_mem' := λ x y hx hy, by simp * at *,
  zero_mem' := by simp,
  smul_mem' := λ c x hx, by simp * at *,
}

def W' : submodule F (F × F) :=
{ carrier := {x | x.1 = x.2},
  add_mem' := λ x y hx hy, by simp * at *,
  zero_mem' := by simp,
  smul_mem' := λ c x hx, by simp * at *,
}

example : ∃ U₁ U₂ W : subspace F (F × F), (U₁ ⊕ W) ∧ (U₂ ⊕ W) ∧ (U₁ ≠ U₂) :=
begin
  use [U₁ F, U₂ F, W' F],
  split,
  { split,
    { rw eq_top_iff,    --U₁ + W = V
      rintro ⟨a,b⟩ h, clear h,
      have h1 : ((0 : F), b-a) ∈ U₁ F := by simp [U₁],
      have h2 : (a, a) ∈ W' F := by simp [W'],
      convert submodule.add_mem_sup h1 h2;
      simp,},
    { rw eq_bot_iff,    --and U₁ ∩ W = 0
      rintro ⟨a,b⟩ h,
      simp [U₁, W'] at *,
      rw ←h.2,
      exact ⟨h.1,h.1⟩,
    },
  },
  split,
  { split,
    { rw eq_top_iff,    --U₂ + W = V
      rintro ⟨a,b⟩ h, clear h,
      have h1 : (a-b, (0 : F)) ∈ U₂ F := by simp [U₂],
      have h2 : (b, b) ∈ W' F := by simp [W'],
      convert submodule.add_mem_sup h1 h2;
      simp,},
    { rw eq_bot_iff,    --and U₂ ∩ W = 0
      rintro ⟨a,b⟩ h,
      simp [U₂, W'] at *,
      rw h.2,
      exact ⟨h.1,h.1⟩,},
  },
  { intro h,                --U₁ ≠ U₂ since (0,1) ∈ U₁ \ U₂
    let x : F × F := (0,1),
    have hx : x ∈ U₁ F := by simp [x, U₁],
    rw h at hx,
    simp [x, U₂] at hx,
    exact hx,
  }
end

end direct_sum


/-
Copyright (c) 2022 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning

! This file was ported from Lean 3 source module ring_theory.polynomial.selmer
! leanprover-community/mathlib commit 3e00d81bdcbf77c8188bbd18f5524ddc3ed8cac6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.UnitTrinomial
import Mathbin.RingTheory.Polynomial.GaussLemma
import Mathbin.Tactic.LinearCombination

/-!
# Irreducibility of Selmer Polynomials

This file proves irreducibility of the Selmer polynomials `X ^ n - X - 1`.

## Main results

- `polynomial.selmer_irreducible`: The Selmer polynomials `X ^ n - X - 1` are irreducible.

TODO: Show that the Selmer polynomials have full Galois group.
-/

namespace Polynomial

open Polynomial

variable {n : ℕ}

theorem X_pow_sub_X_sub_one_irreducible_aux (z : ℂ) : ¬(z ^ n = z + 1 ∧ z ^ n + z ^ 2 = 0) :=
  by
  rintro ⟨h1, h2⟩
  replace h3 : z ^ 3 = 1
  · linear_combination (1 - z - z ^ 2 - z ^ n) * h1 + (z ^ n - 2) * h2
  -- thanks polyrith!
  have key : z ^ n = 1 ∨ z ^ n = z ∨ z ^ n = z ^ 2 :=
    by
    rw [← Nat.mod_add_div n 3, pow_add, pow_mul, h3, one_pow, mul_one]
    have : n % 3 < 3 := Nat.mod_lt n zero_lt_three
    interval_cases <;> simp only [h, pow_zero, pow_one, eq_self_iff_true, or_true_iff, true_or_iff]
  have z_ne_zero : z ≠ 0 := fun h =>
    zero_ne_one ((zero_pow zero_lt_three).symm.trans (show (0 : ℂ) ^ 3 = 1 from h ▸ h3))
  rcases key with (key | key | key)
  · exact z_ne_zero (by rwa [key, self_eq_add_left] at h1)
  · exact one_ne_zero (by rwa [key, self_eq_add_right] at h1)
  · exact z_ne_zero (pow_eq_zero (by rwa [key, add_self_eq_zero] at h2))
#align polynomial.X_pow_sub_X_sub_one_irreducible_aux Polynomial.X_pow_sub_X_sub_one_irreducible_aux

theorem x_pow_sub_x_sub_one_irreducible (hn1 : n ≠ 1) : Irreducible (X ^ n - X - 1 : ℤ[X]) :=
  by
  by_cases hn0 : n = 0
  · rw [hn0, pow_zero, sub_sub, add_comm, ← sub_sub, sub_self, zero_sub]
    exact Associated.irreducible ⟨-1, mul_neg_one X⟩ irreducible_X
  have hn : 1 < n := nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨hn0, hn1⟩
  have hp : (X ^ n - X - 1 : ℤ[X]) = trinomial 0 1 n (-1) (-1) 1 := by
    simp only [trinomial, C_neg, C_1] <;> ring
  rw [hp]
  apply is_unit_trinomial.irreducible_of_coprime' ⟨0, 1, n, zero_lt_one, hn, -1, -1, 1, rfl⟩
  rintro z ⟨h1, h2⟩
  apply X_pow_sub_X_sub_one_irreducible_aux z
  rw [trinomial_mirror zero_lt_one hn (-1 : ℤˣ).NeZero (1 : ℤˣ).NeZero] at h2
  simp_rw [trinomial, aeval_add, aeval_mul, aeval_X_pow, aeval_C] at h1 h2
  simp_rw [Units.val_neg, Units.val_one, map_neg, map_one] at h1 h2
  replace h1 : z ^ n = z + 1 := by linear_combination h1
  replace h2 := mul_eq_zero_of_left h2 z
  rw [add_mul, add_mul, add_zero, mul_assoc (-1 : ℂ), ← pow_succ', Nat.sub_add_cancel hn.le] at h2
  rw [h1] at h2⊢
  exact ⟨rfl, by linear_combination -h2⟩
#align polynomial.X_pow_sub_X_sub_one_irreducible Polynomial.x_pow_sub_x_sub_one_irreducible

theorem x_pow_sub_x_sub_one_irreducible_rat (hn1 : n ≠ 1) : Irreducible (X ^ n - X - 1 : ℚ[X]) :=
  by
  by_cases hn0 : n = 0
  · rw [hn0, pow_zero, sub_sub, add_comm, ← sub_sub, sub_self, zero_sub]
    exact Associated.irreducible ⟨-1, mul_neg_one X⟩ irreducible_X
  have hp : (X ^ n - X - 1 : ℤ[X]) = trinomial 0 1 n (-1) (-1) 1 := by
    simp only [trinomial, C_neg, C_1] <;> ring
  have hn : 1 < n := nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨hn0, hn1⟩
  have h :=
    (is_primitive.int.irreducible_iff_irreducible_map_cast _).mp
      (X_pow_sub_X_sub_one_irreducible hn1)
  ·
    rwa [Polynomial.map_sub, Polynomial.map_sub, Polynomial.map_pow, Polynomial.map_one,
      Polynomial.map_X] at h
  · exact hp.symm ▸ (trinomial_monic zero_lt_one hn).IsPrimitive
#align polynomial.X_pow_sub_X_sub_one_irreducible_rat Polynomial.x_pow_sub_x_sub_one_irreducible_rat

end Polynomial


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

! This file was ported from Lean 3 source module topology.continuous_function.polynomial
! leanprover-community/mathlib commit a148d797a1094ab554ad4183a4ad6f130358ef64
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.Polynomial
import Mathbin.Topology.ContinuousFunction.Algebra
import Mathbin.Topology.UnitInterval

/-!
# Constructions relating polynomial functions and continuous functions.

## Main definitions

* `polynomial.to_continuous_map_on p X`: for `X : set R`, interprets a polynomial `p`
  as a bundled continuous function in `C(X, R)`.
* `polynomial.to_continuous_map_on_alg_hom`: the same, as an `R`-algebra homomorphism.
* `polynomial_functions (X : set R) : subalgebra R C(X, R)`: polynomial functions as a subalgebra.
* `polynomial_functions_separates_points (X : set R) : (polynomial_functions X).separates_points`:
  the polynomial functions separate points.

-/

variable {R : Type _}

open Polynomial

namespace Polynomial

section

variable [Semiring R] [TopologicalSpace R] [TopologicalSemiring R]

/--
Every polynomial with coefficients in a topological semiring gives a (bundled) continuous function.
-/
@[simps]
def toContinuousMap (p : R[X]) : C(R, R) :=
  ⟨fun x : R => p.eval x, by continuity⟩
#align polynomial.to_continuous_map Polynomial.toContinuousMap

/-- A polynomial as a continuous function,
with domain restricted to some subset of the semiring of coefficients.

(This is particularly useful when restricting to compact sets, e.g. `[0,1]`.)
-/
@[simps]
def toContinuousMapOn (p : R[X]) (X : Set R) : C(X, R) :=
  ⟨fun x : X => p.toContinuousMap x, by continuity⟩
#align polynomial.to_continuous_map_on Polynomial.toContinuousMapOn

-- TODO some lemmas about when `to_continuous_map_on` is injective?
end

section

variable {α : Type _} [TopologicalSpace α] [CommSemiring R] [TopologicalSpace R]
  [TopologicalSemiring R]

@[simp]
theorem aeval_continuousMap_apply (g : R[X]) (f : C(α, R)) (x : α) :
    ((Polynomial.aeval f) g) x = g.eval (f x) :=
  by
  apply Polynomial.induction_on' g
  · intro p q hp hq
    simp [hp, hq]
  · intro n a
    simp [Pi.pow_apply]
#align polynomial.aeval_continuous_map_apply Polynomial.aeval_continuousMap_apply

end

section

noncomputable section

variable [CommSemiring R] [TopologicalSpace R] [TopologicalSemiring R]

/-- The algebra map from `R[X]` to continuous functions `C(R, R)`.
-/
@[simps]
def toContinuousMapAlgHom : R[X] →ₐ[R] C(R, R)
    where
  toFun p := p.toContinuousMap
  map_zero' := by
    ext
    simp
  map_add' := by
    intros
    ext
    simp
  map_one' := by
    ext
    simp
  map_mul' := by
    intros
    ext
    simp
  commutes' := by
    intros
    ext
    simp [Algebra.algebraMap_eq_smul_one]
#align polynomial.to_continuous_map_alg_hom Polynomial.toContinuousMapAlgHom

/-- The algebra map from `R[X]` to continuous functions `C(X, R)`, for any subset `X` of `R`.
-/
@[simps]
def toContinuousMapOnAlgHom (X : Set R) : R[X] →ₐ[R] C(X, R)
    where
  toFun p := p.toContinuousMapOn X
  map_zero' := by
    ext
    simp
  map_add' := by
    intros
    ext
    simp
  map_one' := by
    ext
    simp
  map_mul' := by
    intros
    ext
    simp
  commutes' := by
    intros
    ext
    simp [Algebra.algebraMap_eq_smul_one]
#align polynomial.to_continuous_map_on_alg_hom Polynomial.toContinuousMapOnAlgHom

end

end Polynomial

section

variable [CommSemiring R] [TopologicalSpace R] [TopologicalSemiring R]

/--
The subalgebra of polynomial functions in `C(X, R)`, for `X` a subset of some topological semiring
`R`.
-/
def polynomialFunctions (X : Set R) : Subalgebra R C(X, R) :=
  (⊤ : Subalgebra R R[X]).map (Polynomial.toContinuousMapOnAlgHom X)
#align polynomial_functions polynomialFunctions

@[simp]
theorem polynomialFunctions_coe (X : Set R) :
    (polynomialFunctions X : Set C(X, R)) = Set.range (Polynomial.toContinuousMapOnAlgHom X) :=
  by
  ext
  simp [polynomialFunctions]
#align polynomial_functions_coe polynomialFunctions_coe

-- TODO:
-- if `f : R → R` is an affine equivalence, then pulling back along `f`
-- induces a normed algebra isomorphism between `polynomial_functions X` and
-- `polynomial_functions (f ⁻¹' X)`, intertwining the pullback along `f` of `C(R, R)` to itself.
theorem polynomialFunctions_separatesPoints (X : Set R) : (polynomialFunctions X).SeparatesPoints :=
  fun x y h =>
  by
  -- We use `polynomial.X`, then clean up.
  refine' ⟨_, ⟨⟨_, ⟨⟨Polynomial.X, ⟨Algebra.mem_top, rfl⟩⟩, rfl⟩⟩, _⟩⟩
  dsimp; simp only [Polynomial.eval_X]
  exact fun h' => h (Subtype.ext h')
#align polynomial_functions_separates_points polynomialFunctions_separatesPoints

open unitInterval

open ContinuousMap

/-- The preimage of polynomials on `[0,1]` under the pullback map by `x ↦ (b-a) * x + a`
is the polynomials on `[a,b]`. -/
theorem polynomialFunctions.comap_compRightAlgHom_iccHomeoI (a b : ℝ) (h : a < b) :
    (polynomialFunctions I).comap (compRightAlgHom ℝ ℝ (iccHomeoI a b h).symm.toContinuousMap) =
      polynomialFunctions (Set.Icc a b) :=
  by
  ext f
  fconstructor
  · rintro ⟨p, ⟨-, w⟩⟩
    rw [FunLike.ext_iff] at w
    dsimp at w
    let q := p.comp ((b - a)⁻¹ • Polynomial.X + Polynomial.C (-a * (b - a)⁻¹))
    refine' ⟨q, ⟨_, _⟩⟩
    · simp
    · ext x
      simp only [neg_mul, RingHom.map_neg, RingHom.map_mul, AlgHom.coe_toRingHom, Polynomial.eval_X,
        Polynomial.eval_neg, Polynomial.eval_C, Polynomial.eval_smul, smul_eq_mul,
        Polynomial.eval_mul, Polynomial.eval_add, Polynomial.coe_aeval_eq_eval,
        Polynomial.eval_comp, Polynomial.toContinuousMapOnAlgHom_apply,
        Polynomial.toContinuousMapOn_apply, Polynomial.toContinuousMap_apply]
      convert w ⟨_, _⟩ <;> clear w
      · -- why does `comm_ring.add` appear here!?
        change x = (iccHomeoI a b h).symm ⟨_ + _, _⟩
        ext
        simp only [iccHomeoI_symm_apply_coe, Subtype.coe_mk]
        replace h : b - a ≠ 0 := sub_ne_zero_of_ne h.ne.symm
        simp only [mul_add]
        field_simp
        ring
      · change _ + _ ∈ I
        rw [mul_comm (b - a)⁻¹, ← neg_mul, ← add_mul, ← sub_eq_add_neg]
        have w₁ : 0 < (b - a)⁻¹ := inv_pos.mpr (sub_pos.mpr h)
        have w₂ : 0 ≤ (x : ℝ) - a := sub_nonneg.mpr x.2.1
        have w₃ : (x : ℝ) - a ≤ b - a := sub_le_sub_right x.2.2 a
        fconstructor
        · exact mul_nonneg w₂ (le_of_lt w₁)
        · rw [← div_eq_mul_inv, div_le_one (sub_pos.mpr h)]
          exact w₃
  · rintro ⟨p, ⟨-, rfl⟩⟩
    let q := p.comp ((b - a) • Polynomial.X + Polynomial.C a)
    refine' ⟨q, ⟨_, _⟩⟩
    · simp
    · ext x
      simp [mul_comm]
#align polynomial_functions.comap_comp_right_alg_hom_Icc_homeo_I polynomialFunctions.comap_compRightAlgHom_iccHomeoI

end


/-
Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn

! This file was ported from Lean 3 source module model_theory.language_map
! leanprover-community/mathlib commit b3951c65c6e797ff162ae8b69eab0063bcfb3d73
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.ModelTheory.Basic

/-!
# Language Maps
Maps between first-order languages in the style of the
[Flypitch project](https://flypitch.github.io/), as well as several important maps between
structures.

## Main Definitions
* A `first_order.language.Lhom`, denoted `L →ᴸ L'`, is a map between languages, sending the symbols
  of one to symbols of the same kind and arity in the other.
* A `first_order.language.Lequiv`, denoted `L ≃ᴸ L'`, is an invertible language homomorphism.
* `first_order.language.with_constants` is defined so that if `M` is an `L.Structure` and
  `A : set M`, `L.with_constants A`, denoted `L[[A]]`, is a language which adds constant symbols for
  elements of `A` to `L`.

## References
For the Flypitch project:
- [J. Han, F. van Doorn, *A formal proof of the independence of the continuum hypothesis*]
[flypitch_cpp]
- [J. Han, F. van Doorn, *A formalization of forcing and the unprovability of
the continuum hypothesis*][flypitch_itp]

-/

universe u v u' v' w w'

namespace FirstOrder

namespace Language

open Structure Cardinal

open Cardinal

variable (L : Language.{u, v}) (L' : Language.{u', v'}) {M : Type w} [L.Structure M]

/-- A language homomorphism maps the symbols of one language to symbols of another. -/
structure Lhom where
  onFunction : ∀ ⦃n⦄, L.Functions n → L'.Functions n
  onRelation : ∀ ⦃n⦄, L.Relations n → L'.Relations n
#align first_order.language.Lhom FirstOrder.Language.Lhom

-- mathport name: «expr →ᴸ »
infixl:10 " →ᴸ " => Lhom

-- \^L
variable {L L'}

namespace Lhom

/-- Defines a map between languages defined with `language.mk₂`. -/
protected def mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v} (φ₀ : c → L'.Constants)
    (φ₁ : f₁ → L'.Functions 1) (φ₂ : f₂ → L'.Functions 2) (φ₁' : r₁ → L'.Relations 1)
    (φ₂' : r₂ → L'.Relations 2) : Language.mk₂ c f₁ f₂ r₁ r₂ →ᴸ L' :=
  ⟨fun n =>
    Nat.casesOn n φ₀ fun n => Nat.casesOn n φ₁ fun n => Nat.casesOn n φ₂ fun _ => PEmpty.elim,
    fun n =>
    Nat.casesOn n PEmpty.elim fun n =>
      Nat.casesOn n φ₁' fun n => Nat.casesOn n φ₂' fun _ => PEmpty.elim⟩
#align first_order.language.Lhom.mk₂ FirstOrder.Language.Lhom.mk₂

variable (ϕ : L →ᴸ L')

/-- Pulls a structure back along a language map. -/
def reduct (M : Type _) [L'.Structure M] : L.Structure M
    where
  funMap n f xs := funMap (ϕ.onFunction f) xs
  rel_map n r xs := RelMap (ϕ.onRelation r) xs
#align first_order.language.Lhom.reduct FirstOrder.Language.Lhom.reduct

/-- The identity language homomorphism. -/
@[simps]
protected def id (L : Language) : L →ᴸ L :=
  ⟨fun n => id, fun n => id⟩
#align first_order.language.Lhom.id FirstOrder.Language.Lhom.id

instance : Inhabited (L →ᴸ L) :=
  ⟨Lhom.id L⟩

/-- The inclusion of the left factor into the sum of two languages. -/
@[simps]
protected def sumInl : L →ᴸ L.Sum L' :=
  ⟨fun n => Sum.inl, fun n => Sum.inl⟩
#align first_order.language.Lhom.sum_inl FirstOrder.Language.Lhom.sumInl

/-- The inclusion of the right factor into the sum of two languages. -/
@[simps]
protected def sumInr : L' →ᴸ L.Sum L' :=
  ⟨fun n => Sum.inr, fun n => Sum.inr⟩
#align first_order.language.Lhom.sum_inr FirstOrder.Language.Lhom.sumInr

variable (L L')

/-- The inclusion of an empty language into any other language. -/
@[simps]
protected def ofIsEmpty [L.IsAlgebraic] [L.IsRelational] : L →ᴸ L' :=
  ⟨fun n => (IsRelational.empty_functions n).elim, fun n => (IsAlgebraic.empty_relations n).elim⟩
#align first_order.language.Lhom.of_is_empty FirstOrder.Language.Lhom.ofIsEmpty

variable {L L'} {L'' : Language}

@[ext]
protected theorem funext {F G : L →ᴸ L'} (h_fun : F.onFunction = G.onFunction)
    (h_rel : F.onRelation = G.onRelation) : F = G :=
  by
  cases' F with Ff Fr
  cases' G with Gf Gr
  simp only [*]
  exact And.intro h_fun h_rel
#align first_order.language.Lhom.funext FirstOrder.Language.Lhom.funext

instance [L.IsAlgebraic] [L.IsRelational] : Unique (L →ᴸ L') :=
  ⟨⟨Lhom.ofIsEmpty L L'⟩, fun _ => Lhom.funext (Subsingleton.elim _ _) (Subsingleton.elim _ _)⟩

theorem mk₂_funext {c f₁ f₂ : Type u} {r₁ r₂ : Type v} {F G : Language.mk₂ c f₁ f₂ r₁ r₂ →ᴸ L'}
    (h0 : ∀ c : (Language.mk₂ c f₁ f₂ r₁ r₂).Constants, F.onFunction c = G.onFunction c)
    (h1 : ∀ f : (Language.mk₂ c f₁ f₂ r₁ r₂).Functions 1, F.onFunction f = G.onFunction f)
    (h2 : ∀ f : (Language.mk₂ c f₁ f₂ r₁ r₂).Functions 2, F.onFunction f = G.onFunction f)
    (h1' : ∀ r : (Language.mk₂ c f₁ f₂ r₁ r₂).Relations 1, F.onRelation r = G.onRelation r)
    (h2' : ∀ r : (Language.mk₂ c f₁ f₂ r₁ r₂).Relations 2, F.onRelation r = G.onRelation r) :
    F = G :=
  Lhom.funext
    (funext fun n =>
      Nat.casesOn n (funext h0) fun n =>
        Nat.casesOn n (funext h1) fun n =>
          Nat.casesOn n (funext h2) fun n => funext fun f => PEmpty.elim f)
    (funext fun n =>
      Nat.casesOn n (funext fun r => PEmpty.elim r) fun n =>
        Nat.casesOn n (funext h1') fun n =>
          Nat.casesOn n (funext h2') fun n => funext fun r => PEmpty.elim r)
#align first_order.language.Lhom.mk₂_funext FirstOrder.Language.Lhom.mk₂_funext

/-- The composition of two language homomorphisms. -/
@[simps]
def comp (g : L' →ᴸ L'') (f : L →ᴸ L') : L →ᴸ L'' :=
  ⟨fun n F => g.1 (f.1 F), fun _ R => g.2 (f.2 R)⟩
#align first_order.language.Lhom.comp FirstOrder.Language.Lhom.comp

-- mathport name: Lhom.comp
local infixl:60 " ∘ " => Lhom.comp

@[simp]
theorem id_comp (F : L →ᴸ L') : Lhom.id L' ∘ F = F :=
  by
  cases F
  rfl
#align first_order.language.Lhom.id_comp FirstOrder.Language.Lhom.id_comp

@[simp]
theorem comp_id (F : L →ᴸ L') : F ∘ Lhom.id L = F :=
  by
  cases F
  rfl
#align first_order.language.Lhom.comp_id FirstOrder.Language.Lhom.comp_id

theorem comp_assoc {L3 : Language} (F : L'' →ᴸ L3) (G : L' →ᴸ L'') (H : L →ᴸ L') :
    F ∘ G ∘ H = F ∘ (G ∘ H) :=
  rfl
#align first_order.language.Lhom.comp_assoc FirstOrder.Language.Lhom.comp_assoc

section SumElim

variable (ψ : L'' →ᴸ L')

/-- A language map defined on two factors of a sum. -/
@[simps]
protected def sumElim : L.Sum L'' →ᴸ L'
    where
  onFunction n := Sum.elim (fun f => ϕ.onFunction f) fun f => ψ.onFunction f
  onRelation n := Sum.elim (fun f => ϕ.onRelation f) fun f => ψ.onRelation f
#align first_order.language.Lhom.sum_elim FirstOrder.Language.Lhom.sumElim

theorem sumElim_comp_inl (ψ : L'' →ᴸ L') : ϕ.sum_elim ψ ∘ Lhom.sumInl = ϕ :=
  Lhom.funext (funext fun _ => rfl) (funext fun _ => rfl)
#align first_order.language.Lhom.sum_elim_comp_inl FirstOrder.Language.Lhom.sumElim_comp_inl

theorem sumElim_comp_inr (ψ : L'' →ᴸ L') : ϕ.sum_elim ψ ∘ Lhom.sumInr = ψ :=
  Lhom.funext (funext fun _ => rfl) (funext fun _ => rfl)
#align first_order.language.Lhom.sum_elim_comp_inr FirstOrder.Language.Lhom.sumElim_comp_inr

theorem sumElim_inl_inr : Lhom.sumInl.sum_elim Lhom.sumInr = Lhom.id (L.Sum L') :=
  Lhom.funext (funext fun _ => Sum.elim_inl_inr) (funext fun _ => Sum.elim_inl_inr)
#align first_order.language.Lhom.sum_elim_inl_inr FirstOrder.Language.Lhom.sumElim_inl_inr

theorem comp_sumElim {L3 : Language} (θ : L' →ᴸ L3) : θ ∘ ϕ.sum_elim ψ = (θ ∘ ϕ).sum_elim (θ ∘ ψ) :=
  Lhom.funext (funext fun n => Sum.comp_elim _ _ _) (funext fun n => Sum.comp_elim _ _ _)
#align first_order.language.Lhom.comp_sum_elim FirstOrder.Language.Lhom.comp_sumElim

end SumElim

section SumMap

variable {L₁ L₂ : Language} (ψ : L₁ →ᴸ L₂)

/-- The map between two sum-languages induced by maps on the two factors. -/
@[simps]
def sumMap : L.Sum L₁ →ᴸ L'.Sum L₂
    where
  onFunction n := Sum.map (fun f => ϕ.onFunction f) fun f => ψ.onFunction f
  onRelation n := Sum.map (fun f => ϕ.onRelation f) fun f => ψ.onRelation f
#align first_order.language.Lhom.sum_map FirstOrder.Language.Lhom.sumMap

@[simp]
theorem sumMap_comp_inl : ϕ.sum_map ψ ∘ Lhom.sumInl = Lhom.sumInl ∘ ϕ :=
  Lhom.funext (funext fun _ => rfl) (funext fun _ => rfl)
#align first_order.language.Lhom.sum_map_comp_inl FirstOrder.Language.Lhom.sumMap_comp_inl

@[simp]
theorem sumMap_comp_inr : ϕ.sum_map ψ ∘ Lhom.sumInr = Lhom.sumInr ∘ ψ :=
  Lhom.funext (funext fun _ => rfl) (funext fun _ => rfl)
#align first_order.language.Lhom.sum_map_comp_inr FirstOrder.Language.Lhom.sumMap_comp_inr

end SumMap

/-- A language homomorphism is injective when all the maps between symbol types are. -/
protected structure Injective : Prop where
  onFunction {n} : Function.Injective fun f : L.Functions n => onFunction ϕ f
  onRelation {n} : Function.Injective fun R : L.Relations n => onRelation ϕ R
#align first_order.language.Lhom.injective FirstOrder.Language.Lhom.Injective

/-- Pulls a `L`-structure along a language map `ϕ : L →ᴸ L'`, and then expands it
  to an `L'`-structure arbitrarily. -/
noncomputable def defaultExpansion (ϕ : L →ᴸ L')
    [∀ (n) (f : L'.Functions n), Decidable (f ∈ Set.range fun f : L.Functions n => onFunction ϕ f)]
    [∀ (n) (r : L'.Relations n), Decidable (r ∈ Set.range fun r : L.Relations n => onRelation ϕ r)]
    (M : Type _) [Inhabited M] [L.Structure M] : L'.Structure M
    where
  funMap n f xs :=
    if h' : f ∈ Set.range fun f : L.Functions n => onFunction ϕ f then funMap h'.some xs
    else default
  rel_map n r xs :=
    if h' : r ∈ Set.range fun r : L.Relations n => onRelation ϕ r then RelMap h'.some xs
    else default
#align first_order.language.Lhom.default_expansion FirstOrder.Language.Lhom.defaultExpansion

/-- A language homomorphism is an expansion on a structure if it commutes with the interpretation of
all symbols on that structure. -/
class IsExpansionOn (M : Type _) [L.Structure M] [L'.Structure M] : Prop where
  map_onFunction : ∀ {n} (f : L.Functions n) (x : Fin n → M), funMap (ϕ.onFunction f) x = funMap f x
  map_onRelation : ∀ {n} (R : L.Relations n) (x : Fin n → M), RelMap (ϕ.onRelation R) x = RelMap R x
#align first_order.language.Lhom.is_expansion_on FirstOrder.Language.Lhom.IsExpansionOn

@[simp]
theorem map_onFunction {M : Type _} [L.Structure M] [L'.Structure M] [ϕ.IsExpansionOn M] {n}
    (f : L.Functions n) (x : Fin n → M) : funMap (ϕ.onFunction f) x = funMap f x :=
  IsExpansionOn.map_onFunction f x
#align first_order.language.Lhom.map_on_function FirstOrder.Language.Lhom.map_onFunction

@[simp]
theorem map_onRelation {M : Type _} [L.Structure M] [L'.Structure M] [ϕ.IsExpansionOn M] {n}
    (R : L.Relations n) (x : Fin n → M) : RelMap (ϕ.onRelation R) x = RelMap R x :=
  IsExpansionOn.map_onRelation R x
#align first_order.language.Lhom.map_on_relation FirstOrder.Language.Lhom.map_onRelation

instance id_isExpansionOn (M : Type _) [L.Structure M] : IsExpansionOn (Lhom.id L) M :=
  ⟨fun _ _ _ => rfl, fun _ _ _ => rfl⟩
#align first_order.language.Lhom.id_is_expansion_on FirstOrder.Language.Lhom.id_isExpansionOn

instance ofIsEmpty_isExpansionOn (M : Type _) [L.Structure M] [L'.Structure M] [L.IsAlgebraic]
    [L.IsRelational] : IsExpansionOn (Lhom.ofIsEmpty L L') M :=
  ⟨fun n => (IsRelational.empty_functions n).elim, fun n => (IsAlgebraic.empty_relations n).elim⟩
#align first_order.language.Lhom.of_is_empty_is_expansion_on FirstOrder.Language.Lhom.ofIsEmpty_isExpansionOn

instance sumElim_isExpansionOn {L'' : Language} (ψ : L'' →ᴸ L') (M : Type _) [L.Structure M]
    [L'.Structure M] [L''.Structure M] [ϕ.IsExpansionOn M] [ψ.IsExpansionOn M] :
    (ϕ.sum_elim ψ).IsExpansionOn M :=
  ⟨fun _ f _ => Sum.casesOn f (by simp) (by simp), fun _ R _ => Sum.casesOn R (by simp) (by simp)⟩
#align first_order.language.Lhom.sum_elim_is_expansion_on FirstOrder.Language.Lhom.sumElim_isExpansionOn

instance sumMap_isExpansionOn {L₁ L₂ : Language} (ψ : L₁ →ᴸ L₂) (M : Type _) [L.Structure M]
    [L'.Structure M] [L₁.Structure M] [L₂.Structure M] [ϕ.IsExpansionOn M] [ψ.IsExpansionOn M] :
    (ϕ.sum_map ψ).IsExpansionOn M :=
  ⟨fun _ f _ => Sum.casesOn f (by simp) (by simp), fun _ R _ => Sum.casesOn R (by simp) (by simp)⟩
#align first_order.language.Lhom.sum_map_is_expansion_on FirstOrder.Language.Lhom.sumMap_isExpansionOn

instance sumInl_isExpansionOn (M : Type _) [L.Structure M] [L'.Structure M] :
    (Lhom.sumInl : L →ᴸ L.Sum L').IsExpansionOn M :=
  ⟨fun _ f _ => rfl, fun _ R _ => rfl⟩
#align first_order.language.Lhom.sum_inl_is_expansion_on FirstOrder.Language.Lhom.sumInl_isExpansionOn

instance sumInr_isExpansionOn (M : Type _) [L.Structure M] [L'.Structure M] :
    (Lhom.sumInr : L' →ᴸ L.Sum L').IsExpansionOn M :=
  ⟨fun _ f _ => rfl, fun _ R _ => rfl⟩
#align first_order.language.Lhom.sum_inr_is_expansion_on FirstOrder.Language.Lhom.sumInr_isExpansionOn

@[simp]
theorem funMap_sumInl [(L.Sum L').Structure M] [(Lhom.sumInl : L →ᴸ L.Sum L').IsExpansionOn M] {n}
    {f : L.Functions n} {x : Fin n → M} : @funMap (L.Sum L') M _ n (Sum.inl f) x = funMap f x :=
  (Lhom.sumInl : L →ᴸ L.Sum L').map_onFunction f x
#align first_order.language.Lhom.fun_map_sum_inl FirstOrder.Language.Lhom.funMap_sumInl

@[simp]
theorem funMap_sumInr [(L'.Sum L).Structure M] [(Lhom.sumInr : L →ᴸ L'.Sum L).IsExpansionOn M] {n}
    {f : L.Functions n} {x : Fin n → M} : @funMap (L'.Sum L) M _ n (Sum.inr f) x = funMap f x :=
  (Lhom.sumInr : L →ᴸ L'.Sum L).map_onFunction f x
#align first_order.language.Lhom.fun_map_sum_inr FirstOrder.Language.Lhom.funMap_sumInr

theorem sumInl_injective : (Lhom.sumInl : L →ᴸ L.Sum L').Injective :=
  ⟨fun n => Sum.inl_injective, fun n => Sum.inl_injective⟩
#align first_order.language.Lhom.sum_inl_injective FirstOrder.Language.Lhom.sumInl_injective

theorem sumInr_injective : (Lhom.sumInr : L' →ᴸ L.Sum L').Injective :=
  ⟨fun n => Sum.inr_injective, fun n => Sum.inr_injective⟩
#align first_order.language.Lhom.sum_inr_injective FirstOrder.Language.Lhom.sumInr_injective

instance (priority := 100) isExpansionOn_reduct (ϕ : L →ᴸ L') (M : Type _) [L'.Structure M] :
    @IsExpansionOn L L' ϕ M (ϕ.reduct M) _ :=
  letI := ϕ.reduct M
  ⟨fun _ f _ => rfl, fun _ R _ => rfl⟩
#align first_order.language.Lhom.is_expansion_on_reduct FirstOrder.Language.Lhom.isExpansionOn_reduct

theorem Injective.isExpansionOn_default {ϕ : L →ᴸ L'}
    [∀ (n) (f : L'.Functions n), Decidable (f ∈ Set.range fun f : L.Functions n => onFunction ϕ f)]
    [∀ (n) (r : L'.Relations n), Decidable (r ∈ Set.range fun r : L.Relations n => onRelation ϕ r)]
    (h : ϕ.Injective) (M : Type _) [Inhabited M] [L.Structure M] :
    @IsExpansionOn L L' ϕ M _ (ϕ.defaultExpansion M) :=
  by
  letI := ϕ.default_expansion M
  refine' ⟨fun n f xs => _, fun n r xs => _⟩
  · have hf : ϕ.on_function f ∈ Set.range fun f : L.functions n => ϕ.on_function f := ⟨f, rfl⟩
    refine' (dif_pos hf).trans _
    rw [h.on_function hf.some_spec]
  · have hr : ϕ.on_relation r ∈ Set.range fun r : L.relations n => ϕ.on_relation r := ⟨r, rfl⟩
    refine' (dif_pos hr).trans _
    rw [h.on_relation hr.some_spec]
#align first_order.language.Lhom.injective.is_expansion_on_default FirstOrder.Language.Lhom.Injective.isExpansionOn_default

end Lhom

/-- A language equivalence maps the symbols of one language to symbols of another bijectively. -/
structure Lequiv (L L' : Language) where
  toLhom : L →ᴸ L'
  invLhom : L' →ᴸ L
  left_inv : inv_Lhom.comp to_Lhom = Lhom.id L
  right_inv : to_Lhom.comp inv_Lhom = Lhom.id L'
#align first_order.language.Lequiv FirstOrder.Language.Lequiv

-- mathport name: «expr ≃ᴸ »
infixl:10 " ≃ᴸ " => Lequiv

-- \^L
namespace Lequiv

variable (L)

/-- The identity equivalence from a first-order language to itself. -/
@[simps]
protected def refl : L ≃ᴸ L :=
  ⟨Lhom.id L, Lhom.id L, Lhom.id_comp _, Lhom.id_comp _⟩
#align first_order.language.Lequiv.refl FirstOrder.Language.Lequiv.refl

variable {L}

instance : Inhabited (L ≃ᴸ L) :=
  ⟨Lequiv.refl L⟩

variable {L'' : Language} (e' : L' ≃ᴸ L'') (e : L ≃ᴸ L')

/-- The inverse of an equivalence of first-order languages. -/
@[simps]
protected def symm : L' ≃ᴸ L :=
  ⟨e.invLhom, e.toLhom, e.right_inv, e.left_inv⟩
#align first_order.language.Lequiv.symm FirstOrder.Language.Lequiv.symm

/-- The composition of equivalences of first-order languages. -/
@[simps, trans]
protected def trans (e : L ≃ᴸ L') (e' : L' ≃ᴸ L'') : L ≃ᴸ L'' :=
  ⟨e'.toLhom.comp e.toLhom, e.invLhom.comp e'.invLhom, by
    rw [Lhom.comp_assoc, ← Lhom.comp_assoc e'.inv_Lhom, e'.left_inv, Lhom.id_comp, e.left_inv], by
    rw [Lhom.comp_assoc, ← Lhom.comp_assoc e.to_Lhom, e.right_inv, Lhom.id_comp, e'.right_inv]⟩
#align first_order.language.Lequiv.trans FirstOrder.Language.Lequiv.trans

end Lequiv

section ConstantsOn

variable (α : Type u')

/-- A language with constants indexed by a type. -/
@[simp]
def constantsOn : Language.{u', 0} :=
  Language.mk₂ α PEmpty PEmpty PEmpty PEmpty
#align first_order.language.constants_on FirstOrder.Language.constantsOn

variable {α}

theorem constantsOn_constants : (constantsOn α).Constants = α :=
  rfl
#align first_order.language.constants_on_constants FirstOrder.Language.constantsOn_constants

instance isAlgebraic_constantsOn : IsAlgebraic (constantsOn α) :=
  Language.isAlgebraic_mk₂
#align first_order.language.is_algebraic_constants_on FirstOrder.Language.isAlgebraic_constantsOn

instance isRelational_constantsOn [ie : IsEmpty α] : IsRelational (constantsOn α) :=
  Language.isRelational_mk₂
#align first_order.language.is_relational_constants_on FirstOrder.Language.isRelational_constantsOn

instance isEmpty_functions_constantsOn_succ {n : ℕ} : IsEmpty ((constantsOn α).Functions (n + 1)) :=
  Nat.casesOn n PEmpty.isEmpty fun n => Nat.casesOn n PEmpty.isEmpty fun _ => PEmpty.isEmpty
#align first_order.language.is_empty_functions_constants_on_succ FirstOrder.Language.isEmpty_functions_constantsOn_succ

theorem card_constantsOn : (constantsOn α).card = (#α) := by simp
#align first_order.language.card_constants_on FirstOrder.Language.card_constantsOn

/-- Gives a `constants_on α` structure to a type by assigning each constant a value. -/
def constantsOn.structure (f : α → M) : (constantsOn α).Structure M :=
  Structure.mk₂ f PEmpty.elim PEmpty.elim PEmpty.elim PEmpty.elim
#align first_order.language.constants_on.Structure FirstOrder.Language.constantsOn.structure

variable {β : Type v'}

/-- A map between index types induces a map between constant languages. -/
def Lhom.constantsOnMap (f : α → β) : constantsOn α →ᴸ constantsOn β :=
  Lhom.mk₂ f PEmpty.elim PEmpty.elim PEmpty.elim PEmpty.elim
#align first_order.language.Lhom.constants_on_map FirstOrder.Language.Lhom.constantsOnMap

theorem constantsOnMap_isExpansionOn {f : α → β} {fα : α → M} {fβ : β → M} (h : fβ ∘ f = fα) :
    @Lhom.IsExpansionOn _ _ (Lhom.constantsOnMap f) M (constantsOn.structure fα)
      (constantsOn.structure fβ) :=
  by
  letI := constants_on.Structure fα
  letI := constants_on.Structure fβ
  exact
    ⟨fun n => Nat.casesOn n (fun F x => (congr_fun h F : _)) fun n F => isEmptyElim F, fun _ R =>
      isEmptyElim R⟩
#align first_order.language.constants_on_map_is_expansion_on FirstOrder.Language.constantsOnMap_isExpansionOn

end ConstantsOn

section WithConstants

variable (L)

section

variable (α : Type w')

/-- Extends a language with a constant for each element of a parameter set in `M`. -/
def withConstants : Language.{max u w', v} :=
  L.Sum (constantsOn α)
#align first_order.language.with_constants FirstOrder.Language.withConstants

-- mathport name: language.with_constants
scoped[FirstOrder] notation:95 L "[[" α "]]" => L.withConstants α

@[simp]
theorem card_withConstants :
    L[[α]].card = Cardinal.lift.{w'} L.card + Cardinal.lift.{max u v} (#α) := by
  rw [with_constants, card_sum, card_constants_on]
#align first_order.language.card_with_constants FirstOrder.Language.card_withConstants

/-- The language map adding constants.  -/
@[simps]
def lhomWithConstants : L →ᴸ L[[α]] :=
  Lhom.sumInl
#align first_order.language.Lhom_with_constants FirstOrder.Language.lhomWithConstants

theorem lhomWithConstants_injective : (L.lhomWithConstants α).Injective :=
  Lhom.sumInl_injective
#align first_order.language.Lhom_with_constants_injective FirstOrder.Language.lhomWithConstants_injective

variable {α}

/-- The constant symbol indexed by a particular element. -/
protected def con (a : α) : L[[α]].Constants :=
  Sum.inr a
#align first_order.language.con FirstOrder.Language.con

variable {L} (α)

/-- Adds constants to a language map.  -/
def Lhom.addConstants {L' : Language} (φ : L →ᴸ L') : L[[α]] →ᴸ L'[[α]] :=
  φ.sum_map (Lhom.id _)
#align first_order.language.Lhom.add_constants FirstOrder.Language.Lhom.addConstants

instance paramsStructure (A : Set α) : (constantsOn A).Structure α :=
  constantsOn.structure coe
#align first_order.language.params_Structure FirstOrder.Language.paramsStructure

variable (L) (α)

/-- The language map removing an empty constant set.  -/
@[simps]
def Lequiv.addEmptyConstants [ie : IsEmpty α] : L ≃ᴸ L[[α]]
    where
  toLhom := lhomWithConstants L α
  invLhom := Lhom.sumElim (Lhom.id L) (Lhom.ofIsEmpty (constantsOn α) L)
  left_inv := by rw [Lhom_with_constants, Lhom.sum_elim_comp_inl]
  right_inv := by
    simp only [Lhom.comp_sum_elim, Lhom_with_constants, Lhom.comp_id]
    exact trans (congr rfl (Subsingleton.elim _ _)) Lhom.sum_elim_inl_inr
#align first_order.language.Lequiv.add_empty_constants FirstOrder.Language.Lequiv.addEmptyConstants

variable {α} {β : Type _}

@[simp]
theorem withConstants_funMap_sum_inl [L[[α]].Structure M] [(lhomWithConstants L α).IsExpansionOn M]
    {n} {f : L.Functions n} {x : Fin n → M} : @funMap (L[[α]]) M _ n (Sum.inl f) x = funMap f x :=
  (lhomWithConstants L α).map_onFunction f x
#align first_order.language.with_constants_fun_map_sum_inl FirstOrder.Language.withConstants_funMap_sum_inl

@[simp]
theorem withConstants_relMap_sum_inl [L[[α]].Structure M] [(lhomWithConstants L α).IsExpansionOn M]
    {n} {R : L.Relations n} {x : Fin n → M} : @RelMap (L[[α]]) M _ n (Sum.inl R) x = RelMap R x :=
  (lhomWithConstants L α).map_onRelation R x
#align first_order.language.with_constants_rel_map_sum_inl FirstOrder.Language.withConstants_relMap_sum_inl

/-- The language map extending the constant set.  -/
def lhomWithConstantsMap (f : α → β) : L[[α]] →ᴸ L[[β]] :=
  Lhom.sumMap (Lhom.id L) (Lhom.constantsOnMap f)
#align first_order.language.Lhom_with_constants_map FirstOrder.Language.lhomWithConstantsMap

@[simp]
theorem Lhom.map_constants_comp_sumInl {f : α → β} :
    (L.lhomWithConstantsMap f).comp Lhom.sumInl = L.lhomWithConstants β := by ext (n f R) <;> rfl
#align first_order.language.Lhom.map_constants_comp_sum_inl FirstOrder.Language.Lhom.map_constants_comp_sumInl

end

open FirstOrder

instance constantsOnSelfStructure : (constantsOn M).Structure M :=
  constantsOn.structure id
#align first_order.language.constants_on_self_Structure FirstOrder.Language.constantsOnSelfStructure

instance withConstantsSelfStructure : L[[M]].Structure M :=
  Language.sumStructure _ _ M
#align first_order.language.with_constants_self_Structure FirstOrder.Language.withConstantsSelfStructure

instance withConstants_self_expansion : (lhomWithConstants L M).IsExpansionOn M :=
  ⟨fun _ _ _ => rfl, fun _ _ _ => rfl⟩
#align first_order.language.with_constants_self_expansion FirstOrder.Language.withConstants_self_expansion

variable (α : Type _) [(constantsOn α).Structure M]

instance withConstantsStructure : L[[α]].Structure M :=
  Language.sumStructure _ _ _
#align first_order.language.with_constants_Structure FirstOrder.Language.withConstantsStructure

instance withConstants_expansion : (L.lhomWithConstants α).IsExpansionOn M :=
  ⟨fun _ _ _ => rfl, fun _ _ _ => rfl⟩
#align first_order.language.with_constants_expansion FirstOrder.Language.withConstants_expansion

instance addEmptyConstants_is_expansion_on' :
    (Lequiv.addEmptyConstants L (∅ : Set M)).toLhom.IsExpansionOn M :=
  L.withConstants_expansion _
#align first_order.language.add_empty_constants_is_expansion_on' FirstOrder.Language.addEmptyConstants_is_expansion_on'

instance addEmptyConstants_symm_isExpansionOn :
    (Lequiv.addEmptyConstants L (∅ : Set M)).symm.toLhom.IsExpansionOn M :=
  Lhom.sumElim_isExpansionOn _ _ _
#align first_order.language.add_empty_constants_symm_is_expansion_on FirstOrder.Language.addEmptyConstants_symm_isExpansionOn

instance addConstants_expansion {L' : Language} [L'.Structure M] (φ : L →ᴸ L') [φ.IsExpansionOn M] :
    (φ.addConstants α).IsExpansionOn M :=
  Lhom.sumMap_isExpansionOn _ _ M
#align first_order.language.add_constants_expansion FirstOrder.Language.addConstants_expansion

@[simp]
theorem withConstants_funMap_sum_inr {a : α} {x : Fin 0 → M} :
    @funMap (L[[α]]) M _ 0 (Sum.inr a : L[[α]].Functions 0) x = L.con a :=
  by
  rw [Unique.eq_default x]
  exact (Lhom.sum_inr : constants_on α →ᴸ L.sum _).map_onFunction _ _
#align first_order.language.with_constants_fun_map_sum_inr FirstOrder.Language.withConstants_funMap_sum_inr

variable {α} (A : Set M)

@[simp]
theorem coe_con {a : A} : (L.con a : M) = a :=
  rfl
#align first_order.language.coe_con FirstOrder.Language.coe_con

variable {A} {B : Set M} (h : A ⊆ B)

instance constantsOnMap_inclusion_isExpansionOn :
    (Lhom.constantsOnMap (Set.inclusion h)).IsExpansionOn M :=
  constantsOnMap_isExpansionOn rfl
#align first_order.language.constants_on_map_inclusion_is_expansion_on FirstOrder.Language.constantsOnMap_inclusion_isExpansionOn

instance map_constants_inclusion_isExpansionOn :
    (L.lhomWithConstantsMap (Set.inclusion h)).IsExpansionOn M :=
  Lhom.sumMap_isExpansionOn _ _ _
#align first_order.language.map_constants_inclusion_is_expansion_on FirstOrder.Language.map_constants_inclusion_isExpansionOn

end WithConstants

end Language

end FirstOrder


/-
Copyright (c) 2022 Hanting Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hanting Zhang
-/
import linear_algebra.affine_space.affine_subspace

/-! # Pointwise instances on `affine_subspace`s

This file provides the additive action `affine_subspace.pointwise_add_action` in the
`pointwise` locale.

-/

open_locale affine pointwise

open set

namespace affine_subspace

variables {k : Type*} [ring k]
variables {V P V₁ P₁ V₂ P₂ : Type*}

variables [add_comm_group V] [module k V] [affine_space V P]
variables [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
variables [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂]

include V

/-- The additive action on an affine subspace corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_add_action : add_action V (affine_subspace k P) :=
{ vadd := λ x S, S.map (affine_equiv.const_vadd k P x),
  zero_vadd := λ p,
    (congr_arg (λ f, p.map f) $ affine_map.ext $ by exact zero_vadd _).trans (p.map_id),
  add_vadd := λ x y p,
    (congr_arg (λ f, p.map f) $ affine_map.ext $ by exact add_vadd _ _).trans (p.map_map _ _).symm }

localized "attribute [instance] affine_subspace.pointwise_add_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_vadd (v : V) (s : affine_subspace k P) :
  ((v +ᵥ s : affine_subspace k P) : set P) = v +ᵥ s := rfl

lemma vadd_mem_pointwise_vadd_iff {v : V} {s : affine_subspace k P} {p : P} :
  v +ᵥ p ∈ v +ᵥ s ↔ p ∈ s :=
vadd_mem_vadd_set_iff

lemma pointwise_vadd_bot (v : V) : v +ᵥ (⊥ : affine_subspace k P) = ⊥ :=
by { ext, simp, }

lemma pointwise_vadd_direction (v : V) (s : affine_subspace k P) :
  (v +ᵥ s).direction = s.direction :=
begin
  unfold has_vadd.vadd,
  rw map_direction,
  exact submodule.map_id _,
end

lemma pointwise_vadd_span (v : V) (s : set P) :
  v +ᵥ affine_span k s = affine_span k (v +ᵥ s) :=
map_span _ s

omit V
include V₁ V₂

lemma map_pointwise_vadd (f : P₁ →ᵃ[k] P₂) (v : V₁) (s : affine_subspace k P₁) :
  (v +ᵥ s).map f = f.linear v +ᵥ s.map f :=
begin
  unfold has_vadd.vadd,
  rw [map_map, map_map],
  congr' 1,
  ext,
  exact f.map_vadd _ _,
end

end affine_subspace


def evenq (n: Nat) : Bool := Nat.mod n 2 = 0

private theorem pack_loop_terminates : (n : Nat) → n / 2 < n.succ
  | 0   => by decide
  | 1   => by decide
  | n+2 => by
    rw [Nat.div_eq]
    split
    · rw [Nat.add_sub_self_right]
      have := pack_loop_terminates n
      calc n/2 + 1 < Nat.succ n + 1   := Nat.add_le_add_right this 1
           _       < Nat.succ (n + 2) := Nat.succ_lt_succ (Nat.succ_lt_succ (Nat.lt_succ_self _))
    · apply Nat.zero_lt_succ

def pack (n: Nat) : List Nat :=
  let rec loop (n : Nat) (acc : Nat) (accs: List Nat) : List Nat :=
    let next (n: Nat) := n / 2;
    match n with
    | Nat.zero => List.cons acc accs
    | n+1 => match evenq n with
      | true => loop (next n) 0 (List.cons acc accs)
      | false => loop (next n) (acc+1) accs
  loop n 0 []
termination_by'
  invImage (fun ⟨n, _, _⟩ => n) Nat.lt_wfRel
decreasing_by
  simp [invImage, InvImage, Prod.lex, sizeOfWFRel, measure, Nat.lt_wfRel]
  apply pack_loop_terminates

#eval pack 27


import analysis.normed_space.basic
import topology.instances.ennreal
import analysis.normed_space.basic
import topology.instances.ennreal
import algebra.archimedean algebra.geom_sum
import data.nat.choose data.complex.basic
import tactic.linarith
import analysis.calculus.deriv
import data.complex.exponential

open finset
open cau_seq
namespace complex
noncomputable theory

lemma is_cau_abs_cos (z : ℂ) : is_cau_seq _root_.abs
  (λ n, (range n).sum (λ m, abs (
      ((-1) ^ m) * z ^ (2 * m ) / nat.fact (2 * m )))) :=
begin
sorry,
end

lemma is_cau_abs_sin (z : ℂ) : is_cau_seq _root_.abs
  (λ n, (range n).sum (λ m, abs (
      ((-1) ^ m) * z ^ (2 * m + 1) / nat.fact (2 * m + 1)))) :=
begin
sorry,
/-
let ⟨n, hn⟩ := exists_nat_gt (abs z) in
have hn0 : (0 : ℝ) < n, from lt_of_le_of_lt (abs_nonneg _) hn,
series_ratio_test n (complex.abs z / n)
(div_nonneg_of_nonneg_of_pos (complex.abs_nonneg _) hn0)
  (by rwa [div_lt_iff hn0, one_mul])
  (λ m hm,
    by rw [abs_abs, abs_abs, nat.fact_succ, pow_succ,
      mul_comm m.succ, nat.cast_mul, ← div_div_eq_div_mul, mul_div_assoc,
      mul_div_right_comm, abs_mul, abs_div, abs_cast_nat];
    exact mul_le_mul_of_nonneg_right
      (div_le_div_of_le_left (abs_nonneg _) hn0
        (nat.cast_le.2 (le_trans hm (nat.le_succ _)))) (abs_nonneg _))
-/
end

lemma is_cau_sin (z : ℂ) :
 is_cau_seq abs (λ n, (range n).sum (λ m,
 ((-1) ^ m) * z ^ (2 * m + 1) / nat.fact (2 * m + 1)))
:=
begin
    exact is_cau_series_of_abv_cau (is_cau_abs_sin z),
end

lemma is_cau_cos (z : ℂ) :
 is_cau_seq abs (λ n, (range n).sum (λ m,
 ((-1) ^ m) * z ^ (2 * m ) / nat.fact (2 * m)))
:=
begin
    exact is_cau_series_of_abv_cau (is_cau_abs_cos z),
end

def sin' (z : ℂ) : cau_seq ℂ complex.abs :=
 ⟨λ n, (range n).sum
 (λ m, ((-1) ^ m) * z ^ (2 * m + 1) / nat.fact (2 * m + 1)),
 is_cau_sin z⟩
def sin1 (z : ℂ) : ℂ := lim (sin' z)

def cos' (z : ℂ) : cau_seq ℂ complex.abs :=
 ⟨λ n, (range n).sum
 (λ m, (-1) ^ m * z ^ (2 * m) / nat.fact (2 * m)),
 is_cau_cos z⟩
def cos1 (z : ℂ) : ℂ := lim (cos' z)

/-
lemma series_arith : --maybe take the first few terms and conjecture that the rest of the series follows?
(λ n)(λ m)
-/

theorem euler : ∀ x, exp (x * I) = cos1 x + sin1 x * I
:=
begin
    intros,

    have partials: ∀ n:ℕ , (exp' (x*I)).1 (2*n+1) =
     (cos' x).1 (n+1) + ((sin' x).1 n) * I,
    {
        intros,
        rw exp',
        simp,
        rw cos',
        simp,
        rw sin',
        simp,

        induction n with n0 hn,
        { -- case n0=0
            simp,
--            simp,
        },
        { -- induction on n0

            rw sum_range_succ _ _, -- takes out last term in cos

            have lastSin :
            sum (range (nat.succ n0)) (λ (x_1 : ℕ), (-1) ^ x_1 * x ^ (1 + 2 * x_1) / ↑(nat.fact (1 + 2 * x_1)))
            =
            (-1) ^ n0 * x ^ (1 + 2 * n0) / ↑(nat.fact (1 + 2 * n0))
            +
            sum (range (n0)) (λ (x_1 : ℕ), (-1) ^ x_1 * x ^ (1 + 2 * x_1) / ↑(nat.fact (1 + 2 * x_1)))
            ,
            {
              rw sum_range_succ _ _,
            },
            rw lastSin,

            have twoFromExp:
            sum (range (nat.succ (2 * nat.succ n0))) (λ (x_1 : ℕ),
            (x * I) ^ x_1 / ↑(nat.fact x_1))
            =
            (x * I) ^ ( 2 * nat.succ n0) / ↑(nat.fact ( 2 * nat.succ n0))+
            sum (range ( 2 * nat.succ n0)) (λ (x_1 : ℕ),
            (x * I) ^ x_1 / ↑(nat.fact x_1))
            ,
            {
              rw sum_range_succ _ ( 2 * nat.succ n0),
            },
            have twoNP1 : 1+ (2 * nat.succ n0) =nat.succ (2 * nat.succ n0)
            ,
            {
              exact add_comm 1 (2 * nat.succ n0),
            },
            rw twoNP1,
            rw twoFromExp,

            have oneFromExp:
            sum (range (2 * nat.succ n0)) (λ (x_1 : ℕ), (x * I) ^ x_1 / ↑(nat.fact x_1))
            =
            (x * I) ^ (1+2 * n0) / ↑(nat.fact (1+2 * n0))
            +
            sum (range (1+ 2 * n0)) (λ (x_1 : ℕ), (x * I) ^ x_1 / ↑(nat.fact x_1))
            ,
            {
              have stupid : 2 * nat.succ n0 = nat.succ(1+2*n0),
              {
                have RRS : nat.succ(1+2*n0) = 1+(1+2*n0) ,
                {
                  --by library_search,
                  sorry,
                },
                rw RRS,

                have realSt : 1+(1+2*n0) = 1+1+2*n0,
                {
                  simp,
                },
                rw realSt,
                exact nat.add_comm (nat.mul 2 n0) 2,
              },
              rw stupid,
              rw sum_range_succ _ (1 + 2 * n0),
            },
            rw oneFromExp,

            rw hn,
            simp,

            --  need (x*I)^(2 n0 )= x^(2n0) (-1)^n0 etc, commutativity

            sorry,
            --ring,

/-
            have l1:
            sum (range (nat.succ n0)) (λ (m : ℕ),
            (x * I) ^ m / ↑(nat.fact m)) =
            (x * I) ^ n0 / ↑(nat.fact n0) +
            sum (range ( n0)) (λ (m : ℕ),
            (x * I) ^ m / ↑(nat.fact m)),
            {
                exact sum_range_succ _ _,
            },

            have l2:
            sum (range (nat.succ n0)) (λ (m : ℕ),
            (-1) ^ m * x ^ (2 * m) / ↑(nat.fact (2 * m))) =
            (-1) ^ n0 * x ^ (2 * n0) / ↑(nat.fact (2 * n0))
            + sum (range ( n0)) (λ (m : ℕ),
            (-1) ^ m * x ^ (2 * m) / ↑(nat.fact (2 * m))),
            {
                exact sum_range_succ _ _,
            },

            rw l1,
            rw l2,
-/
        },
/-
        have sum2 : ∀ f g,  (range n).sum f + (range n).sum g =
        (range n).sum (f+g),
        {
            intros,
            sorry,
        },

        rw sum2 ((cos' x).1)  (λ k, ((sin' x).1 k) * I),
-/
    },

    -- Now: need to take limits on both sides, they're same,
    -- but need to convince Lean that limit of exp' (2n+1) is same as
    -- limit of exp' (n) which is what exp is defined to be

sorry,
 --rw → linarith
end

end complex


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov,
Neil Strickland, Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_with_zero.default
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Divisibility

This file defines the basics of the divisibility relation in the context of `(comm_)` `monoid`s
`(_with_zero)`.

## Main definitions

 * `monoid.has_dvd`

## Implementation notes

The divisibility relation is defined for all monoids, and as such, depends on the order of
  multiplication if the monoid is not commutative. There are two possible conventions for
  divisibility in the noncommutative context, and this relation follows the convention for ordinals,
  so `a | b` is defined as `∃ c, b = a * c`.

## Tags

divisibility, divides
-/

/-- There are two possible conventions for divisibility, which coincide in a `comm_monoid`.
    This matches the convention for ordinals. -/
protected instance monoid_has_dvd {α : Type u_1} [monoid α] : has_dvd α :=
  has_dvd.mk fun (a b : α) => ∃ (c : α), b = a * c

-- TODO: this used to not have c explicit, but that seems to be important

--       for use with tactics, similar to exist.intro

theorem dvd.intro {α : Type u_1} [monoid α] {a : α} {b : α} (c : α) (h : a * c = b) : a ∣ b :=
  exists.intro c (Eq.symm h)

theorem dvd_of_mul_right_eq {α : Type u_1} [monoid α] {a : α} {b : α} (c : α) (h : a * c = b) :
    a ∣ b :=
  dvd.intro

theorem exists_eq_mul_right_of_dvd {α : Type u_1} [monoid α] {a : α} {b : α} (h : a ∣ b) :
    ∃ (c : α), b = a * c :=
  h

theorem dvd.elim {α : Type u_1} [monoid α] {P : Prop} {a : α} {b : α} (H₁ : a ∣ b)
    (H₂ : ∀ (c : α), b = a * c → P) : P :=
  exists.elim H₁ H₂

@[simp] theorem dvd_refl {α : Type u_1} [monoid α] (a : α) : a ∣ a := sorry

theorem dvd_trans {α : Type u_1} [monoid α] {a : α} {b : α} {c : α} (h₁ : a ∣ b) (h₂ : b ∣ c) :
    a ∣ c :=
  sorry

theorem dvd.trans {α : Type u_1} [monoid α] {a : α} {b : α} {c : α} (h₁ : a ∣ b) (h₂ : b ∣ c) :
    a ∣ c :=
  dvd_trans

theorem one_dvd {α : Type u_1} [monoid α] (a : α) : 1 ∣ a := sorry

@[simp] theorem dvd_mul_right {α : Type u_1} [monoid α] (a : α) (b : α) : a ∣ a * b :=
  dvd.intro b rfl

theorem dvd_mul_of_dvd_left {α : Type u_1} [monoid α] {a : α} {b : α} (h : a ∣ b) (c : α) :
    a ∣ b * c :=
  sorry

theorem dvd_of_mul_right_dvd {α : Type u_1} [monoid α] {a : α} {b : α} {c : α} (h : a * b ∣ c) :
    a ∣ c :=
  sorry

theorem dvd.intro_left {α : Type u_1} [comm_monoid α] {a : α} {b : α} (c : α) (h : c * a = b) :
    a ∣ b :=
  dvd.intro c (eq.mp (Eq._oldrec (Eq.refl (c * a = b)) (mul_comm c a)) h)

theorem dvd_of_mul_left_eq {α : Type u_1} [comm_monoid α] {a : α} {b : α} (c : α) (h : c * a = b) :
    a ∣ b :=
  dvd.intro_left

theorem exists_eq_mul_left_of_dvd {α : Type u_1} [comm_monoid α] {a : α} {b : α} (h : a ∣ b) :
    ∃ (c : α), b = c * a :=
  dvd.elim h fun (c : α) (H1 : b = a * c) => exists.intro c (Eq.trans H1 (mul_comm a c))

theorem dvd.elim_left {α : Type u_1} [comm_monoid α] {a : α} {b : α} {P : Prop} (h₁ : a ∣ b)
    (h₂ : ∀ (c : α), b = c * a → P) : P :=
  exists.elim (exists_eq_mul_left_of_dvd h₁) fun (c : α) (h₃ : b = c * a) => h₂ c h₃

@[simp] theorem dvd_mul_left {α : Type u_1} [comm_monoid α] (a : α) (b : α) : a ∣ b * a :=
  dvd.intro b (mul_comm a b)

theorem dvd_mul_of_dvd_right {α : Type u_1} [comm_monoid α] {a : α} {b : α} (h : a ∣ b) (c : α) :
    a ∣ c * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∣ c * b)) (mul_comm c b))) (dvd_mul_of_dvd_left h c)

theorem mul_dvd_mul {α : Type u_1} [comm_monoid α] {a : α} {b : α} {c : α} {d : α} :
    a ∣ b → c ∣ d → a * c ∣ b * d :=
  sorry

theorem mul_dvd_mul_left {α : Type u_1} [comm_monoid α] (a : α) {b : α} {c : α} (h : b ∣ c) :
    a * b ∣ a * c :=
  mul_dvd_mul (dvd_refl a) h

theorem mul_dvd_mul_right {α : Type u_1} [comm_monoid α] {a : α} {b : α} (h : a ∣ b) (c : α) :
    a * c ∣ b * c :=
  mul_dvd_mul h (dvd_refl c)

theorem dvd_of_mul_left_dvd {α : Type u_1} [comm_monoid α] {a : α} {b : α} {c : α} (h : a * b ∣ c) :
    b ∣ c :=
  sorry

theorem eq_zero_of_zero_dvd {α : Type u_1} [monoid_with_zero α] {a : α} (h : 0 ∣ a) : a = 0 :=
  dvd.elim h fun (c : α) (H' : a = 0 * c) => Eq.trans H' (zero_mul c)

/-- Given an element `a` of a commutative monoid with zero, there exists another element whose
    product with zero equals `a` iff `a` equals zero. -/
@[simp] theorem zero_dvd_iff {α : Type u_1} [monoid_with_zero α] {a : α} : 0 ∣ a ↔ a = 0 :=
  { mp := eq_zero_of_zero_dvd,
    mpr := fun (h : a = 0) => eq.mpr (id (Eq._oldrec (Eq.refl (0 ∣ a)) h)) (dvd_refl 0) }

@[simp] theorem dvd_zero {α : Type u_1} [monoid_with_zero α] (a : α) : a ∣ 0 := sorry

/-- Given two elements `b`, `c` of a `cancel_monoid_with_zero` and a nonzero element `a`,
 `a*b` divides `a*c` iff `b` divides `c`. -/
theorem mul_dvd_mul_iff_left {α : Type u_1} [cancel_monoid_with_zero α] {a : α} {b : α} {c : α}
    (ha : a ≠ 0) : a * b ∣ a * c ↔ b ∣ c :=
  sorry

/-- Given two elements `a`, `b` of a commutative `cancel_monoid_with_zero` and a nonzero
  element `c`, `a*c` divides `b*c` iff `a` divides `b`. -/
theorem mul_dvd_mul_iff_right {α : Type u_1} [comm_cancel_monoid_with_zero α] {a : α} {b : α}
    {c : α} (hc : c ≠ 0) : a * c ∣ b * c ↔ a ∣ b :=
  sorry

/-!
### Units in various monoids
-/

namespace units

/-- Elements of the unit group of a monoid represented as elements of the monoid
    divide any element of the monoid. -/
theorem coe_dvd {α : Type u_1} [monoid α] {a : α} {u : units α} : ↑u ∣ a := sorry

/-- In a monoid, an element `a` divides an element `b` iff `a` divides all
    associates of `b`. -/
theorem dvd_mul_right {α : Type u_1} [monoid α] {a : α} {b : α} {u : units α} :
    a ∣ b * ↑u ↔ a ∣ b :=
  sorry

/-- In a monoid, an element a divides an element b iff all associates of `a` divide `b`.-/
theorem mul_right_dvd {α : Type u_1} [monoid α] {a : α} {b : α} {u : units α} :
    a * ↑u ∣ b ↔ a ∣ b :=
  sorry

/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left
    associates of `b`. -/
theorem dvd_mul_left {α : Type u_1} [comm_monoid α] {a : α} {b : α} {u : units α} :
    a ∣ ↑u * b ↔ a ∣ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∣ ↑u * b ↔ a ∣ b)) (mul_comm (↑u) b))) dvd_mul_right

/-- In a commutative monoid, an element `a` divides an element `b` iff all
  left associates of `a` divide `b`.-/
theorem mul_left_dvd {α : Type u_1} [comm_monoid α] {a : α} {b : α} {u : units α} :
    ↑u * a ∣ b ↔ a ∣ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑u * a ∣ b ↔ a ∣ b)) (mul_comm (↑u) a))) mul_right_dvd

end units

namespace is_unit

/-- Units of a monoid divide any element of the monoid. -/
@[simp] theorem dvd {α : Type u_1} [monoid α] {a : α} {u : α} (hu : is_unit u) : u ∣ a :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.coe_dvd hu_h

@[simp] theorem dvd_mul_right {α : Type u_1} [monoid α] {a : α} {b : α} {u : α} (hu : is_unit u) :
    a ∣ b * u ↔ a ∣ b :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.dvd_mul_right hu_h

/-- In a monoid, an element a divides an element b iff all associates of `a` divide `b`.-/
@[simp] theorem mul_right_dvd {α : Type u_1} [monoid α] {a : α} {b : α} {u : α} (hu : is_unit u) :
    a * u ∣ b ↔ a ∣ b :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.mul_right_dvd hu_h

/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left
    associates of `b`. -/
@[simp] theorem dvd_mul_left {α : Type u_1} [comm_monoid α] (a : α) (b : α) (u : α)
    (hu : is_unit u) : a ∣ u * b ↔ a ∣ b :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.dvd_mul_left hu_h

/-- In a commutative monoid, an element `a` divides an element `b` iff all
  left associates of `a` divide `b`.-/
@[simp] theorem mul_left_dvd {α : Type u_1} [comm_monoid α] (a : α) (b : α) (u : α)
    (hu : is_unit u) : u * a ∣ b ↔ a ∣ b :=
  Exists.dcases_on hu fun (u_1 : units α) (hu_h : ↑u_1 = u) => Eq._oldrec units.mul_left_dvd hu_h

end is_unit

/-- `dvd_not_unit a b` expresses that `a` divides `b` "strictly", i.e. that `b` divided by `a` is not a unit. -/
def dvd_not_unit {α : Type u_1} [comm_monoid_with_zero α] (a : α) (b : α) :=
  a ≠ 0 ∧ ∃ (x : α), ¬is_unit x ∧ b = a * x

theorem dvd_not_unit_of_dvd_of_not_dvd {α : Type u_1} [comm_monoid_with_zero α] {a : α} {b : α}
    (hd : a ∣ b) (hnd : ¬b ∣ a) : dvd_not_unit a b :=
  sorry

end Mathlib


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang

! This file was ported from Lean 3 source module topology.sheaves.punit
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Sheaves.SheafCondition.Sites

/-!
# Presheaves on punit

Presheaves on punit satisfy sheaf condition iff its value at empty set is a terminal object.
-/

namespace TopCat.Presheaf

universe u v w

open CategoryTheory CategoryTheory.Limits TopCat Opposite

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

theorem isSheaf_of_isTerminal_of_indiscrete {X : TopCat.{w}} (hind : X.str = ⊤) (F : Presheaf C X)
    (it : IsTerminal <| F.obj <| op ⊥) : F.IsSheaf := fun c U s hs =>
  by
  obtain rfl | hne := eq_or_ne U ⊥
  · intro _ _
    rw [@exists_unique_iff_exists _ ⟨fun _ _ => _⟩]
    · refine' ⟨it.from _, fun U hU hs => is_terminal.hom_ext _ _ _⟩
      rwa [le_bot_iff.1 hU.le]
    · apply it.hom_ext
  · convert presieve.is_sheaf_for_top_sieve _
    rw [← sieve.id_mem_iff_eq_top]
    have := (U.eq_bot_or_top hind).resolve_left hne
    subst this
    obtain he | ⟨⟨x⟩⟩ := isEmpty_or_nonempty X
    · exact (hne <| SetLike.ext'_iff.2 <| Set.univ_eq_empty_iff.2 he).elim
    obtain ⟨U, f, hf, hm⟩ := hs x trivial
    obtain rfl | rfl := U.eq_bot_or_top hind
    · cases hm
    · convert hf
#align Top.presheaf.is_sheaf_of_is_terminal_of_indiscrete TopCat.Presheaf.isSheaf_of_isTerminal_of_indiscrete

theorem isSheaf_iff_isTerminal_of_indiscrete {X : TopCat.{w}} (hind : X.str = ⊤)
    (F : Presheaf C X) : F.IsSheaf ↔ Nonempty (IsTerminal <| F.obj <| op ⊥) :=
  ⟨fun h => ⟨Sheaf.isTerminalOfEmpty ⟨F, h⟩⟩, fun ⟨it⟩ =>
    isSheaf_of_isTerminal_of_indiscrete hind F it⟩
#align Top.presheaf.is_sheaf_iff_is_terminal_of_indiscrete TopCat.Presheaf.isSheaf_iff_isTerminal_of_indiscrete

theorem isSheaf_on_pUnit_of_isTerminal (F : Presheaf C (TopCat.of PUnit))
    (it : IsTerminal <| F.obj <| op ⊥) : F.IsSheaf :=
  isSheaf_of_isTerminal_of_indiscrete (@Subsingleton.elim (TopologicalSpace PUnit) _ _ _) F it
#align Top.presheaf.is_sheaf_on_punit_of_is_terminal TopCat.Presheaf.isSheaf_on_pUnit_of_isTerminal

theorem isSheaf_on_pUnit_iff_isTerminal (F : Presheaf C (TopCat.of PUnit)) :
    F.IsSheaf ↔ Nonempty (IsTerminal <| F.obj <| op ⊥) :=
  ⟨fun h => ⟨Sheaf.isTerminalOfEmpty ⟨F, h⟩⟩, fun ⟨it⟩ => isSheaf_on_pUnit_of_isTerminal F it⟩
#align Top.presheaf.is_sheaf_on_punit_iff_is_terminal TopCat.Presheaf.isSheaf_on_pUnit_iff_isTerminal

end TopCat.Presheaf


import data.real.basic

-- Some obvious theorems I couldn't prove

theorem nat_real_le : ∀(x y : ℕ), x ≤ y → (↑x : ℚ) ≤ (↑y : ℚ) := sorry

theorem nat_real_add : ∀(x y : ℕ), ↑(x + y) = (↑x : ℚ) + ↑y := by {intro, simp}

theorem nat_real_succ : ∀x:ℕ, (↑(nat.succ x) : ℚ) = 1 + ↑x := by {intro x, simp}

theorem nat_real_sub : ∀(x y : ℕ), y ≤ x → ↑(x - y) = (↑x: ℚ) - ↑y := sorry

theorem nat_le_succ_sub : ∀(x y : ℕ), x - y ≤ (nat.succ x) - y := sorry

theorem nat_sub_add : ∀(x y z : ℕ), x - (y + z) = x - y - z := sorry

structure Trace :=
    (C β : ℚ) (D : ℕ) (out inp wst los: ℕ → ℚ)

    (pos_C : C > 0)
    (nonneg_D : D ≥ 0)
    (pos_β : β > 0)

    (constraint_u : ∀t, out t ≤ C * t - wst t)
    (constraint_l : ∀t, out t ≥ C * ↑(t - D) - wst (t - D))

    (cond_waste :
        ∀t, wst t < wst (t + 1)
        → inp (1 + t) - los (1 + t) ≤ C * ↑(1 + t) - wst (1 + t))

    (cond_los :
        ∀t, los t < los (t + 1)
        → inp (1 + t) - los (1 + t) > C * ↑t - wst t + β)

    (max_buf :
        ∀t, inp t - los t ≤ C * ↑t - wst t + β)

    (out_le_inp : ∀t, out t ≤ inp t - los t)

    (monotone_out : monotone out)
    (monotone_inp : monotone inp)
    (monotone_wst : monotone wst)
    (monotone_los : monotone los)

    (zero_out : out 0 = 0)
    (zero_inp : inp 0 = 0)
    (zero_wst : wst 0 = 0)
    (zero_los : los 0 = 0)

-- Useful lemmas
namespace Trace
    def upper (τ : Trace) (t : ℕ) := τ.C * t - τ.wst t
    def lower (τ : Trace) (t : ℕ) := τ.C * ↑(t - τ.D) - τ.wst (t - τ.D)

    lemma out_nonneg : ∀(τ : Trace), ∀(t : ℕ), 0 ≤ τ.out t :=
    begin
        intros τ t,
        induction t,
        rw τ.zero_out, apply (le_trans t_ih),
        apply τ.monotone_out, exact nat.le_succ t_n,
    end

    lemma wst_nonneg : ∀(τ : Trace), ∀(t : ℕ), 0 ≤ τ.wst t :=
    begin
        intros τ t,
        induction t,
        rw τ.zero_wst, apply (le_trans t_ih),
        apply τ.monotone_wst, exact nat.le_succ t_n,
    end

    lemma los_nonneg : ∀(τ : Trace), ∀(t : ℕ), 0 ≤ τ.los t :=
    begin
        intros τ t,
        induction t,
        rw τ.zero_los, apply (le_trans t_ih),
        apply τ.monotone_los, exact nat.le_succ t_n,
    end

    lemma wst_u_bound :
        ∀(τ : Trace), ∀(t : ℕ), τ.wst t ≤ τ.C * ↑t :=
    begin
        intros τ t,
        have h_constraint_u := τ.constraint_u t,
        have h_out_nonneg := τ.out_nonneg t,
        linarith,
    end

    theorem black_line_gap :
      ∀τ : Trace, ∀t, τ.upper t - τ.lower t ≤ τ.C * τ.D :=
    begin
      intros τ t,
      rw Trace.upper, rw Trace.lower,
      by_cases h_t_vs_D : t ≤ τ.D,
      -- Case: t ≤ τ.D
      {
        have t_minus_D := nat.sub_eq_zero_of_le h_t_vs_D,
        rw t_minus_D, rw τ.zero_wst, simp,
        have h₀ := (nat_real_le t τ.D h_t_vs_D),
        have h₁ := Trace.wst_nonneg τ t,
        have h₂ := τ.pos_C,
        have h₃ : 0 ≤ τ.C := begin linarith, end,
        have h₃ := mul_le_mul_of_nonneg_left h₀ h₃,
        linarith,
      },

      -- Case: t > τ.D
      -- Split ↑(t - τ.D)
      simp at h_t_vs_D,
      have h_D_le_t: τ.D ≤ t := begin linarith [h_t_vs_D], end,
      clear h_t_vs_D,
      rw (nat_real_sub t τ.D h_D_le_t),

      -- Cancel τ.C
      rw mul_sub, simp,
      have h : τ.wst (t - τ.D) ≤ τ.wst t
        → τ.wst (t - τ.D) + (-τ.wst t + τ.C * ↑(τ.D)) ≤ τ.C * ↑(τ.D),
      begin intro h, linarith, end,
      apply h, clear h,

      apply τ.monotone_wst,
      exact nat.sub_le t τ.D,
    end

end Trace