/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl

Continuous linear functions -- functions between normed vector spaces which are bounded and linear.
-/
import analysis.normed_space.multilinear

noncomputable theory
open_locale classical big_operators topological_space

open filter (tendsto)
open metric

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
variables {E : Type*} [normed_group E] [normed_space 𝕜 E]
variables {F : Type*} [normed_group F] [normed_space 𝕜 F]
variables {G : Type*} [normed_group G] [normed_space 𝕜 G]

/-- A function `f` satisfies `is_bounded_linear_map 𝕜 f` if it is linear and satisfies the
inequality `∥ f x ∥ ≤ M * ∥ x ∥` for some positive constant `M`. -/
structure is_bounded_linear_map (𝕜 : Type*) [normed_field 𝕜]
  {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {F : Type*} [normed_group F] [normed_space 𝕜 F] (f : E → F)
  extends is_linear_map 𝕜 f : Prop :=
(bound : ∃ M, 0 < M ∧ ∀ x : E, ∥ f x ∥ ≤ M * ∥ x ∥)

lemma is_linear_map.with_bound
  {f : E → F} (hf : is_linear_map 𝕜 f) (M : ℝ) (h : ∀ x : E, ∥ f x ∥ ≤ M * ∥ x ∥) :
  is_bounded_linear_map 𝕜 f :=
⟨ hf, classical.by_cases
  (assume : M ≤ 0, ⟨1, zero_lt_one, assume x,
    le_trans (h x) $ mul_le_mul_of_nonneg_right (le_trans this zero_le_one) (norm_nonneg x)⟩)
  (assume : ¬ M ≤ 0, ⟨M, lt_of_not_ge this, h⟩)⟩

/-- A continuous linear map satisfies `is_bounded_linear_map` -/
lemma continuous_linear_map.is_bounded_linear_map (f : E →L[𝕜] F) : is_bounded_linear_map 𝕜 f :=
{ bound := f.bound,
  ..f.to_linear_map.is_linear }

namespace is_bounded_linear_map

/-- Construct a linear map from a function `f` satisfying `is_bounded_linear_map 𝕜 f`. -/
def to_linear_map (f : E → F) (h : is_bounded_linear_map 𝕜 f) : E →ₗ[𝕜] F :=
(is_linear_map.mk' _ h.to_is_linear_map)

/-- Construct a continuous linear map from is_bounded_linear_map -/
def to_continuous_linear_map {f : E → F} (hf : is_bounded_linear_map 𝕜 f) : E →L[𝕜] F :=
{ cont := let ⟨C, Cpos, hC⟩ := hf.bound in linear_map.continuous_of_bound _ C hC,
  ..to_linear_map f hf}

lemma zero : is_bounded_linear_map 𝕜 (λ (x:E), (0:F)) :=
(0 : E →ₗ F).is_linear.with_bound 0 $ by simp [le_refl]

lemma id : is_bounded_linear_map 𝕜 (λ (x:E), x) :=
linear_map.id.is_linear.with_bound 1 $ by simp [le_refl]

lemma fst : is_bounded_linear_map 𝕜 (λ x : E × F, x.1) :=
begin
  refine (linear_map.fst 𝕜 E F).is_linear.with_bound 1 (λx, _),
  rw one_mul,
  exact le_max_left _ _
end

lemma snd : is_bounded_linear_map 𝕜 (λ x : E × F, x.2) :=
begin
  refine (linear_map.snd 𝕜 E F).is_linear.with_bound 1 (λx, _),
  rw one_mul,
  exact le_max_right _ _
end

variables { f g : E → F }

lemma smul (c : 𝕜) (hf : is_bounded_linear_map 𝕜 f) :
  is_bounded_linear_map 𝕜 (λ e, c • f e) :=
let ⟨hlf, M, hMp, hM⟩ := hf in
(c • hlf.mk' f).is_linear.with_bound (∥c∥ * M) $ assume x,
  calc ∥c • f x∥ = ∥c∥ * ∥f x∥ : norm_smul c (f x)
  ... ≤ ∥c∥ * (M * ∥x∥)        : mul_le_mul_of_nonneg_left (hM _) (norm_nonneg _)
  ... = (∥c∥ * M) * ∥x∥        : (mul_assoc _ _ _).symm

lemma neg (hf : is_bounded_linear_map 𝕜 f) :
  is_bounded_linear_map 𝕜 (λ e, -f e) :=
begin
  rw show (λ e, -f e) = (λ e, (-1 : 𝕜) • f e), { funext, simp },
  exact smul (-1) hf
end

lemma add (hf : is_bounded_linear_map 𝕜 f) (hg : is_bounded_linear_map 𝕜 g) :
  is_bounded_linear_map 𝕜 (λ e, f e + g e) :=
let ⟨hlf, Mf, hMfp, hMf⟩ := hf in
let ⟨hlg, Mg, hMgp, hMg⟩ := hg in
(hlf.mk' _ + hlg.mk' _).is_linear.with_bound (Mf + Mg) $ assume x,
  calc ∥f x + g x∥ ≤ Mf * ∥x∥ + Mg * ∥x∥ : norm_add_le_of_le (hMf x) (hMg x)
               ... ≤ (Mf + Mg) * ∥x∥     : by rw add_mul

lemma sub (hf : is_bounded_linear_map 𝕜 f) (hg : is_bounded_linear_map 𝕜 g) :
  is_bounded_linear_map 𝕜 (λ e, f e - g e) :=
by simpa [sub_eq_add_neg] using add hf (neg hg)

lemma comp {g : F → G}
  (hg : is_bounded_linear_map 𝕜 g) (hf : is_bounded_linear_map 𝕜 f) :
  is_bounded_linear_map 𝕜 (g ∘ f) :=
(hg.to_continuous_linear_map.comp hf.to_continuous_linear_map).is_bounded_linear_map

protected lemma tendsto (x : E) (hf : is_bounded_linear_map 𝕜 f) :
  tendsto f (𝓝 x) (𝓝 (f x)) :=
let ⟨hf, M, hMp, hM⟩ := hf in
tendsto_iff_norm_tendsto_zero.2 $
  squeeze_zero (assume e, norm_nonneg _)
    (assume e,
      calc ∥f e - f x∥ = ∥hf.mk' f (e - x)∥ : by rw (hf.mk' _).map_sub e x; refl
                   ... ≤ M * ∥e - x∥        : hM (e - x))
    (suffices tendsto (λ (e : E), M * ∥e - x∥) (𝓝 x) (𝓝 (M * 0)), by simpa,
      tendsto_const_nhds.mul (tendsto_norm_sub_self _))

lemma continuous (hf : is_bounded_linear_map 𝕜 f) : continuous f :=
continuous_iff_continuous_at.2 $ λ _, hf.tendsto _

lemma lim_zero_bounded_linear_map (hf : is_bounded_linear_map 𝕜 f) :
  tendsto f (𝓝 0) (𝓝 0) :=
(hf.1.mk' _).map_zero ▸ continuous_iff_continuous_at.1 hf.continuous 0

section
open asymptotics filter

theorem is_O_id {f : E → F} (h : is_bounded_linear_map 𝕜 f) (l : filter E) :
  is_O f (λ x, x) l :=
let ⟨M, hMp, hM⟩ := h.bound in is_O.of_bound _ (mem_sets_of_superset univ_mem_sets (λ x _, hM x))

theorem is_O_comp {E : Type*} {g : F → G} (hg : is_bounded_linear_map 𝕜 g)
  {f : E → F} (l : filter E) : is_O (λ x', g (f x')) f l :=
(hg.is_O_id ⊤).comp_tendsto le_top

theorem is_O_sub {f : E → F} (h : is_bounded_linear_map 𝕜 f)
  (l : filter E) (x : E) : is_O (λ x', f (x' - x)) (λ x', x' - x) l :=
is_O_comp h l

end

end is_bounded_linear_map

section
variables {ι : Type*} [decidable_eq ι] [fintype ι]

/-- Taking the cartesian product of two continuous multilinear maps
is a bounded linear operation. -/
lemma is_bounded_linear_map_prod_multilinear
  {E : ι → Type*} [∀i, normed_group (E i)] [∀i, normed_space 𝕜 (E i)] :
  is_bounded_linear_map 𝕜
  (λ p : (continuous_multilinear_map 𝕜 E F) × (continuous_multilinear_map 𝕜 E G), p.1.prod p.2) :=
{ map_add := λ p₁ p₂, by { ext1 m, refl },
  map_smul := λ c p, by { ext1 m, refl },
  bound := ⟨1, zero_lt_one, λ p, begin
    rw one_mul,
    apply continuous_multilinear_map.op_norm_le_bound _ (norm_nonneg _) (λ m, _),
    rw [continuous_multilinear_map.prod_apply, norm_prod_le_iff],
    split,
    { exact le_trans (p.1.le_op_norm m)
        (mul_le_mul_of_nonneg_right (norm_fst_le p) (finset.prod_nonneg (λ i hi, norm_nonneg _))) },
    { exact le_trans (p.2.le_op_norm m)
        (mul_le_mul_of_nonneg_right (norm_snd_le p) (finset.prod_nonneg (λ i hi, norm_nonneg _))) },
  end⟩ }

/-- Given a fixed continuous linear map `g`, associating to a continuous multilinear map `f` the
continuous multilinear map `f (g m₁, ..., g mₙ)` is a bounded linear operation. -/
lemma is_bounded_linear_map_continuous_multilinear_map_comp_linear (g : G →L[𝕜] E) :
  is_bounded_linear_map 𝕜 (λ f : continuous_multilinear_map 𝕜 (λ (i : ι), E) F,
    f.comp_continuous_linear_map (λ _, g)) :=
begin
  refine is_linear_map.with_bound ⟨λ f₁ f₂, by { ext m, refl }, λ c f, by { ext m, refl }⟩
    (∥g∥ ^ (fintype.card ι)) (λ f, _),
  apply continuous_multilinear_map.op_norm_le_bound _ _ (λ m, _),
  { apply_rules [mul_nonneg, pow_nonneg, norm_nonneg] },
  calc ∥f (g ∘ m)∥ ≤
    ∥f∥ * ∏ i, ∥g (m i)∥ : f.le_op_norm _
    ... ≤ ∥f∥ * ∏ i, (∥g∥ * ∥m i∥) : begin
      apply mul_le_mul_of_nonneg_left _ (norm_nonneg _),
      exact finset.prod_le_prod (λ i hi, norm_nonneg _) (λ i hi, g.le_op_norm _)
    end
    ... = ∥g∥ ^ fintype.card ι * ∥f∥ * ∏ i, ∥m i∥ :
      by { simp [finset.prod_mul_distrib, finset.card_univ], ring }
end

end

section bilinear_map

variable (𝕜)

/-- A map `f : E × F → G` satisfies `is_bounded_bilinear_map 𝕜 f` if it is bilinear and
continuous. -/
structure is_bounded_bilinear_map (f : E × F → G) : Prop :=
(add_left   : ∀(x₁ x₂ : E) (y : F), f (x₁ + x₂, y) = f (x₁, y) + f (x₂, y))
(smul_left  : ∀(c : 𝕜) (x : E) (y : F), f (c • x, y) = c • f (x,y))
(add_right  : ∀(x : E) (y₁ y₂ : F), f (x, y₁ + y₂) = f (x, y₁) + f (x, y₂))
(smul_right : ∀(c : 𝕜) (x : E) (y : F), f (x, c • y) = c • f (x,y))
(bound      : ∃C>0, ∀(x : E) (y : F), ∥f (x, y)∥ ≤ C * ∥x∥ * ∥y∥)

variable {𝕜}
variable {f : E × F → G}

lemma continuous_linear_map.is_bounded_bilinear_map (f : E →L[𝕜] F →L[𝕜] G) :
  is_bounded_bilinear_map 𝕜 (λ x : E × F, f x.1 x.2) :=
{ add_left := λ x₁ x₂ y, by rw [f.map_add, continuous_linear_map.add_apply],
  smul_left := λ c x y, by rw [f.map_smul _, continuous_linear_map.smul_apply],
  add_right := λ x, (f x).map_add,
  smul_right := λ c x y, (f x).map_smul c y,
  bound := ⟨max ∥f∥ 1, zero_lt_one.trans_le (le_max_right _ _),
    λ x y, (f.le_op_norm₂ x y).trans $
      by apply_rules [mul_le_mul_of_nonneg_right, norm_nonneg, le_max_left]⟩ }

protected lemma is_bounded_bilinear_map.is_O (h : is_bounded_bilinear_map 𝕜 f) :
  asymptotics.is_O f (λ p : E × F, ∥p.1∥ * ∥p.2∥) ⊤ :=
let ⟨C, Cpos, hC⟩ := h.bound in asymptotics.is_O.of_bound _ $
filter.eventually_of_forall $ λ ⟨x, y⟩, by simpa [mul_assoc] using hC x y

lemma is_bounded_bilinear_map.is_O_comp {α : Type*} (H : is_bounded_bilinear_map 𝕜 f)
  {g : α → E} {h : α → F} {l : filter α} :
  asymptotics.is_O (λ x, f (g x, h x)) (λ x, ∥g x∥ * ∥h x∥) l :=
H.is_O.comp_tendsto le_top

protected lemma is_bounded_bilinear_map.is_O' (h : is_bounded_bilinear_map 𝕜 f) :
  asymptotics.is_O f (λ p : E × F, ∥p∥ * ∥p∥) ⊤ :=
h.is_O.trans (asymptotics.is_O_fst_prod'.norm_norm.mul asymptotics.is_O_snd_prod'.norm_norm)

lemma is_bounded_bilinear_map.map_sub_left (h : is_bounded_bilinear_map 𝕜 f) {x y : E} {z : F} :
  f (x - y, z) = f (x, z) -  f(y, z) :=
calc f (x - y, z) = f (x + (-1 : 𝕜) • y, z) : by simp [sub_eq_add_neg]
... = f (x, z) + (-1 : 𝕜) • f (y, z) : by simp only [h.add_left, h.smul_left]
... = f (x, z) - f (y, z) : by simp [sub_eq_add_neg]

lemma is_bounded_bilinear_map.map_sub_right (h : is_bounded_bilinear_map 𝕜 f) {x : E} {y z : F} :
  f (x, y - z) = f (x, y) - f (x, z) :=
calc f (x, y - z) = f (x, y + (-1 : 𝕜) • z) : by simp [sub_eq_add_neg]
... = f (x, y) + (-1 : 𝕜) • f (x, z) : by simp only [h.add_right, h.smul_right]
... = f (x, y) - f (x, z) : by simp [sub_eq_add_neg]

lemma is_bounded_bilinear_map.is_bounded_linear_map_left (h : is_bounded_bilinear_map 𝕜 f) (y : F) :
  is_bounded_linear_map 𝕜 (λ x, f (x, y)) :=
{ map_add  := λ x x', h.add_left _ _ _,
  map_smul := λ c x, h.smul_left _ _ _,
  bound    := begin
    rcases h.bound with ⟨C, C_pos, hC⟩,
    refine ⟨C * (∥y∥ + 1), mul_pos C_pos (lt_of_lt_of_le (zero_lt_one) (by simp)), λ x, _⟩,
    have : ∥y∥ ≤ ∥y∥ + 1, by simp [zero_le_one],
    calc ∥f (x, y)∥ ≤ C * ∥x∥ * ∥y∥ : hC x y
    ... ≤ C * ∥x∥ * (∥y∥ + 1) :
      by apply_rules [norm_nonneg, mul_le_mul_of_nonneg_left, le_of_lt C_pos, mul_nonneg]
    ... = C * (∥y∥ + 1) * ∥x∥ : by ring
  end }

lemma is_bounded_bilinear_map.is_bounded_linear_map_right
  (h : is_bounded_bilinear_map 𝕜 f) (x : E) :
  is_bounded_linear_map 𝕜 (λ y, f (x, y)) :=
{ map_add  := λ y y', h.add_right _ _ _,
  map_smul := λ c y, h.smul_right _ _ _,
  bound    := begin
    rcases h.bound with ⟨C, C_pos, hC⟩,
    refine ⟨C * (∥x∥ + 1), mul_pos C_pos (lt_of_lt_of_le (zero_lt_one) (by simp)), λ y, _⟩,
    have : ∥x∥ ≤ ∥x∥ + 1, by simp [zero_le_one],
    calc ∥f (x, y)∥ ≤ C * ∥x∥ * ∥y∥ : hC x y
    ... ≤ C * (∥x∥ + 1) * ∥y∥ :
      by apply_rules [mul_le_mul_of_nonneg_right, norm_nonneg, mul_le_mul_of_nonneg_left,
                      le_of_lt C_pos]
  end }

lemma is_bounded_bilinear_map_smul {𝕜' : Type*} [normed_field 𝕜']
  [normed_algebra 𝕜 𝕜'] {E : Type*} [normed_group E] [normed_space 𝕜 E] [normed_space 𝕜' E]
  [is_scalar_tower 𝕜 𝕜' E] :
  is_bounded_bilinear_map 𝕜 (λ (p : 𝕜' × E), p.1 • p.2) :=
{ add_left   := add_smul,
  smul_left  := λ c x y, by simp [smul_assoc],
  add_right  := smul_add,
  smul_right := λ c x y, by simp [smul_assoc, smul_algebra_smul_comm],
  bound      := ⟨1, zero_lt_one, λ x y, by simp [norm_smul] ⟩ }

lemma is_bounded_bilinear_map_mul :
  is_bounded_bilinear_map 𝕜 (λ (p : 𝕜 × 𝕜), p.1 * p.2) :=
by simp_rw ← smul_eq_mul; exact is_bounded_bilinear_map_smul

lemma is_bounded_bilinear_map_comp :
  is_bounded_bilinear_map 𝕜 (λ(p : (E →L[𝕜] F) × (F →L[𝕜] G)), p.2.comp p.1) :=
{ add_left := λx₁ x₂ y, begin
      ext z,
      change y (x₁ z + x₂ z) = y (x₁ z) + y (x₂ z),
      rw y.map_add
    end,
  smul_left := λc x y, begin
      ext z,
      change y (c • (x z)) = c • y (x z),
      rw continuous_linear_map.map_smul
    end,
  add_right := λx y₁ y₂, rfl,
  smul_right := λc x y, rfl,
  bound := ⟨1, zero_lt_one, λx y, calc
    ∥continuous_linear_map.comp ((x, y).snd) ((x, y).fst)∥
      ≤ ∥y∥ * ∥x∥ : continuous_linear_map.op_norm_comp_le _ _
    ... = 1 * ∥x∥ * ∥ y∥ : by ring ⟩ }

lemma continuous_linear_map.is_bounded_linear_map_comp_left (g : continuous_linear_map 𝕜 F G) :
  is_bounded_linear_map 𝕜 (λ(f : E →L[𝕜] F), continuous_linear_map.comp g f) :=
is_bounded_bilinear_map_comp.is_bounded_linear_map_left _

lemma continuous_linear_map.is_bounded_linear_map_comp_right (f : continuous_linear_map 𝕜 E F) :
  is_bounded_linear_map 𝕜 (λ(g : F →L[𝕜] G), continuous_linear_map.comp g f) :=
is_bounded_bilinear_map_comp.is_bounded_linear_map_right _

lemma is_bounded_bilinear_map_apply :
  is_bounded_bilinear_map 𝕜 (λp : (E →L[𝕜] F) × E, p.1 p.2) :=
{ add_left   := by simp,
  smul_left  := by simp,
  add_right  := by simp,
  smul_right := by simp,
  bound      := ⟨1, zero_lt_one, by simp [continuous_linear_map.le_op_norm]⟩ }

/-- The function `continuous_linear_map.smul_right`, associating to a continuous linear map
`f : E → 𝕜` and a scalar `c : F` the tensor product `f ⊗ c` as a continuous linear map from `E` to
`F`, is a bounded bilinear map. -/
lemma is_bounded_bilinear_map_smul_right :
  is_bounded_bilinear_map 𝕜
    (λp, (continuous_linear_map.smul_right : (E →L[𝕜] 𝕜) → F → (E →L[𝕜] F)) p.1 p.2) :=
{ add_left   := λm₁ m₂ f, by { ext z, simp [add_smul] },
  smul_left  := λc m f, by { ext z, simp [mul_smul] },
  add_right  := λm f₁ f₂, by { ext z, simp [smul_add] },
  smul_right := λc m f, by { ext z, simp [smul_smul, mul_comm] },
  bound      := ⟨1, zero_lt_one, λm f, by simp⟩ }

/-- The composition of a continuous linear map with a continuous multilinear map is a bounded
bilinear operation. -/
lemma is_bounded_bilinear_map_comp_multilinear {ι : Type*} {E : ι → Type*}
[decidable_eq ι] [fintype ι] [∀i, normed_group (E i)] [∀i, normed_space 𝕜 (E i)] :
  is_bounded_bilinear_map 𝕜 (λ p : (F →L[𝕜] G) × (continuous_multilinear_map 𝕜 E F),
    p.1.comp_continuous_multilinear_map p.2) :=
{ add_left   := λ g₁ g₂ f, by { ext m, refl },
  smul_left  := λ c g f, by { ext m, refl },
  add_right  := λ g f₁ f₂, by { ext m, simp },
  smul_right := λ c g f, by { ext m, simp },
  bound      := ⟨1, zero_lt_one, λ g f, begin
    apply continuous_multilinear_map.op_norm_le_bound _ _ (λm, _),
    { apply_rules [mul_nonneg, zero_le_one, norm_nonneg] },
    calc ∥g (f m)∥ ≤ ∥g∥ * ∥f m∥ : g.le_op_norm _
    ... ≤ ∥g∥ * (∥f∥ * ∏ i, ∥m i∥) :
      mul_le_mul_of_nonneg_left (f.le_op_norm _) (norm_nonneg _)
    ... = 1 * ∥g∥ * ∥f∥ * ∏ i, ∥m i∥ : by ring
    end⟩ }

/-- Definition of the derivative of a bilinear map `f`, given at a point `p` by
`q ↦ f(p.1, q.2) + f(q.1, p.2)` as in the standard formula for the derivative of a product.
We define this function here a bounded linear map from `E × F` to `G`. The fact that this
is indeed the derivative of `f` is proved in `is_bounded_bilinear_map.has_fderiv_at` in
`fderiv.lean`-/

def is_bounded_bilinear_map.linear_deriv (h : is_bounded_bilinear_map 𝕜 f) (p : E × F) :
  (E × F) →ₗ[𝕜] G :=
{ to_fun := λq, f (p.1, q.2) + f (q.1, p.2),
  map_add' := λq₁ q₂, begin
    change f (p.1, q₁.2 + q₂.2) + f (q₁.1 + q₂.1, p.2) =
      f (p.1, q₁.2) + f (q₁.1, p.2) + (f (p.1, q₂.2) + f (q₂.1, p.2)),
    simp [h.add_left, h.add_right], abel
  end,
  map_smul' := λc q, begin
    change f (p.1, c • q.2) + f (c • q.1, p.2) = c • (f (p.1, q.2) + f (q.1, p.2)),
    simp [h.smul_left, h.smul_right, smul_add]
  end }

/-- The derivative of a bounded bilinear map at a point `p : E × F`, as a continuous linear map
from `E × F` to `G`. -/
def is_bounded_bilinear_map.deriv (h : is_bounded_bilinear_map 𝕜 f) (p : E × F) : (E × F) →L[𝕜] G :=
(h.linear_deriv p).mk_continuous_of_exists_bound $ begin
  rcases h.bound with ⟨C, Cpos, hC⟩,
  refine ⟨C * ∥p.1∥ + C * ∥p.2∥, λq, _⟩,
  calc ∥f (p.1, q.2) + f (q.1, p.2)∥
    ≤ C * ∥p.1∥ * ∥q.2∥ + C * ∥q.1∥ * ∥p.2∥ : norm_add_le_of_le (hC _ _) (hC _ _)
  ... ≤ C * ∥p.1∥ * ∥q∥ + C * ∥q∥ * ∥p.2∥ : begin
      apply add_le_add,
      exact mul_le_mul_of_nonneg_left
        (le_max_right _ _) (mul_nonneg (le_of_lt Cpos) (norm_nonneg _)),
      apply mul_le_mul_of_nonneg_right _ (norm_nonneg _),
      exact mul_le_mul_of_nonneg_left (le_max_left _ _) (le_of_lt Cpos),
  end
  ... = (C * ∥p.1∥ + C * ∥p.2∥) * ∥q∥ : by ring
end

@[simp] lemma is_bounded_bilinear_map_deriv_coe (h : is_bounded_bilinear_map 𝕜 f) (p q : E × F) :
  h.deriv p q = f (p.1, q.2) + f (q.1, p.2) := rfl

variables (𝕜)

/-- The function `lmul_left_right : 𝕜' × 𝕜' → (𝕜' →L[𝕜] 𝕜')` is a bounded bilinear map. -/
lemma continuous_linear_map.lmul_left_right_is_bounded_bilinear
  (𝕜' : Type*) [normed_ring 𝕜'] [normed_algebra 𝕜 𝕜'] :
  is_bounded_bilinear_map 𝕜 (λ p : 𝕜' × 𝕜', continuous_linear_map.lmul_left_right 𝕜 𝕜' p.1 p.2) :=
(continuous_linear_map.lmul_left_right 𝕜 𝕜').is_bounded_bilinear_map

variables {𝕜}

/-- Given a bounded bilinear map `f`, the map associating to a point `p` the derivative of `f` at
`p` is itself a bounded linear map. -/
lemma is_bounded_bilinear_map.is_bounded_linear_map_deriv (h : is_bounded_bilinear_map 𝕜 f) :
  is_bounded_linear_map 𝕜 (λp : E × F, h.deriv p) :=
begin
  rcases h.bound with ⟨C, Cpos : 0 < C, hC⟩,
  refine is_linear_map.with_bound ⟨λp₁ p₂, _, λc p, _⟩ (C + C) (λp, _),
  { ext; simp [h.add_left, h.add_right]; abel },
  { ext; simp [h.smul_left, h.smul_right, smul_add] },
  { refine continuous_linear_map.op_norm_le_bound _
      (mul_nonneg (add_nonneg Cpos.le Cpos.le) (norm_nonneg _)) (λq, _),
    calc ∥f (p.1, q.2) + f (q.1, p.2)∥
      ≤ C * ∥p.1∥ * ∥q.2∥ + C * ∥q.1∥ * ∥p.2∥ : norm_add_le_of_le (hC _ _) (hC _ _)
    ... ≤ C * ∥p∥ * ∥q∥ + C * ∥q∥ * ∥p∥ : by apply_rules [add_le_add, mul_le_mul, norm_nonneg,
      le_of_lt Cpos, le_refl, le_max_left, le_max_right, mul_nonneg]
    ... = (C + C) * ∥p∥ * ∥q∥ : by ring },
end

end bilinear_map

/-- A linear isometry preserves the norm. -/
lemma linear_map.norm_apply_of_isometry (f : E →ₗ[𝕜] F) {x : E} (hf : isometry f) : ∥f x∥ = ∥x∥ :=
by { simp_rw [←dist_zero_right, ←f.map_zero], exact isometry.dist_eq hf _ _ }

/-- Construct a continuous linear equiv from
a linear map that is also an isometry with full range. -/
def continuous_linear_equiv.of_isometry (f : E →ₗ[𝕜] F) (hf : isometry f) (hfr : f.range = ⊤) :
  E ≃L[𝕜] F :=
continuous_linear_equiv.of_homothety
(linear_equiv.of_bijective f (linear_map.ker_eq_bot.mpr (isometry.injective hf)) hfr)
1 zero_lt_one (λ _, by simp [one_mul, f.norm_apply_of_isometry hf])


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Mon.limits
import algebra.category.Group.preadditive
import category_theory.over
import category_theory.limits.concrete_category
import category_theory.limits.shapes.concrete_category
import group_theory.subgroup

/-!
# The category of (commutative) (additive) groups has all limits

Further, these limits are preserved by the forgetful functor --- that is,
the underlying types are just the limits in the category of types.

-/

open category_theory
open category_theory.limits

universe u

noncomputable theory

variables {J : Type u} [small_category J]

namespace Group

@[to_additive]
instance group_obj (F : J ⥤ Group) (j) :
  group ((F ⋙ forget Group).obj j) :=
by { change group (F.obj j), apply_instance }

/--
The flat sections of a functor into `Group` form a subgroup of all sections.
-/
@[to_additive
  "The flat sections of a functor into `AddGroup` form an additive subgroup of all sections."]
def sections_subgroup (F : J ⥤ Group) :
  subgroup (Π j, F.obj j) :=
{ carrier := (F ⋙ forget Group).sections,
  inv_mem' := λ a ah j j' f,
  begin
    simp only [forget_map_eq_coe, functor.comp_map, pi.inv_apply, monoid_hom.map_inv, inv_inj],
    dsimp [functor.sections] at ah,
    rw ah f,
  end,
  ..(Mon.sections_submonoid (F ⋙ forget₂ Group Mon)) }

@[to_additive]
instance limit_group (F : J ⥤ Group) :
  group (types.limit_cone (F ⋙ forget Group.{u})).X :=
begin
  change group (sections_subgroup F),
  apply_instance,
end

/--
We show that the forgetful functor `Group ⥤ Mon` creates limits.

All we need to do is notice that the limit point has a `group` instance available,
and then reuse the existing limit.
-/
@[to_additive]
instance (F : J ⥤ Group) : creates_limit F (forget₂ Group Mon.{u}) :=
creates_limit_of_reflects_iso (λ c' t,
{ lifted_cone :=
  { X := Group.of (types.limit_cone (F ⋙ forget Group)).X,
    π :=
    { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ Group Mon.{u}),
      naturality' := (Mon.has_limits.limit_cone (F ⋙ forget₂ _ _)).π.naturality, } },
  valid_lift := by apply is_limit.unique_up_to_iso (Mon.has_limits.limit_cone_is_limit _) t,
  makes_limit := is_limit.of_faithful (forget₂ Group Mon.{u}) (Mon.has_limits.limit_cone_is_limit _)
    (λ s, _) (λ s, rfl) })

/--
A choice of limit cone for a functor into `Group`.
(Generally, you'll just want to use `limit F`.)
-/
@[to_additive "A choice of limit cone for a functor into `Group`.
(Generally, you'll just want to use `limit F`.)"]
def limit_cone (F : J ⥤ Group) : cone F :=
lift_limit (limit.is_limit (F ⋙ (forget₂ Group Mon.{u})))

/--
The chosen cone is a limit cone.
(Generally, you'll just want to use `limit.cone F`.)
-/
@[to_additive "The chosen cone is a limit cone.
(Generally, you'll just want to use `limit.cone F`.)"]
def limit_cone_is_limit (F : J ⥤ Group) : is_limit (limit_cone F) :=
lifted_limit_is_limit _

/-- The category of groups has all limits. -/
@[to_additive]
instance has_limits : has_limits Group :=
{ has_limits_of_shape := λ J 𝒥, by exactI
  { has_limit := λ F, has_limit_of_created F (forget₂ Group Mon) } } -- TODO use the above instead?

/--
The forgetful functor from groups to monoids preserves all limits.
(That is, the underlying monoid could have been computed instead as limits in the category
of monoids.)
-/
@[to_additive AddGroup.forget₂_AddMon_preserves_limits]
instance forget₂_Mon_preserves_limits : preserves_limits (forget₂ Group Mon) :=
{ preserves_limits_of_shape := λ J 𝒥,
  { preserves_limit := λ F, by apply_instance } }

/--
The forgetful functor from groups to types preserves all limits. (That is, the underlying
types could have been computed instead as limits in the category of types.)
-/
@[to_additive]
instance forget_preserves_limits : preserves_limits (forget Group) :=
{ preserves_limits_of_shape := λ J 𝒥, by exactI
  { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ Group Mon) (forget Mon) } }

end Group

namespace CommGroup

@[to_additive]
instance comm_group_obj (F : J ⥤ CommGroup) (j) :
  comm_group ((F ⋙ forget CommGroup).obj j) :=
by { change comm_group (F.obj j), apply_instance }

@[to_additive]
instance limit_comm_group (F : J ⥤ CommGroup) :
  comm_group (types.limit_cone (F ⋙ forget CommGroup.{u})).X :=
@subgroup.to_comm_group (Π j, F.obj j) _
  (Group.sections_subgroup (F ⋙ forget₂ CommGroup Group.{u}))

/--
We show that the forgetful functor `CommGroup ⥤ Group` creates limits.

All we need to do is notice that the limit point has a `comm_group` instance available,
and then reuse the existing limit.
-/
@[to_additive]
instance (F : J ⥤ CommGroup) : creates_limit F (forget₂ CommGroup Group.{u}) :=
creates_limit_of_reflects_iso (λ c' t,
{ lifted_cone :=
  { X := CommGroup.of (types.limit_cone (F ⋙ forget CommGroup)).X,
    π :=
    { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ CommGroup Group.{u} ⋙ forget₂ Group Mon),
      naturality' := (Mon.has_limits.limit_cone _).π.naturality, } },
  valid_lift := by apply is_limit.unique_up_to_iso (Group.limit_cone_is_limit _) t,
  makes_limit := is_limit.of_faithful (forget₂ _ Group.{u} ⋙ forget₂ _ Mon.{u})
    (by apply Mon.has_limits.limit_cone_is_limit _) (λ s, _) (λ s, rfl) })

/--
A choice of limit cone for a functor into `CommGroup`.
(Generally, you'll just want to use `limit F`.)
-/
@[to_additive "A choice of limit cone for a functor into `CommGroup`.
(Generally, you'll just want to use `limit F`.)"]
def limit_cone (F : J ⥤ CommGroup) : cone F :=
lift_limit (limit.is_limit (F ⋙ (forget₂ CommGroup Group.{u})))

/--
The chosen cone is a limit cone.
(Generally, you'll just want to use `limit.cone F`.)
-/
@[to_additive "The chosen cone is a limit cone.
(Generally, you'll just wantto use `limit.cone F`.)"]
def limit_cone_is_limit (F : J ⥤ CommGroup) : is_limit (limit_cone F) :=
lifted_limit_is_limit _

/-- The category of commutative groups has all limits. -/
@[to_additive]
instance has_limits : has_limits CommGroup :=
{ has_limits_of_shape := λ J 𝒥, by exactI
  { has_limit := λ F, has_limit_of_created F (forget₂ CommGroup Group) } }

/--
The forgetful functor from commutative groups to groups preserves all limits.
(That is, the underlying group could have been computed instead as limits in the category
of groups.)
-/
@[to_additive AddCommGroup.forget₂_AddGroup_preserves_limits]
instance forget₂_Group_preserves_limits : preserves_limits (forget₂ CommGroup Group) :=
{ preserves_limits_of_shape := λ J 𝒥,
  { preserves_limit := λ F, by apply_instance } }

/--
An auxiliary declaration to speed up typechecking.
-/
@[to_additive AddCommGroup.forget₂_AddCommMon_preserves_limits_aux
  "An auxiliary declaration to speed up typechecking."]
def forget₂_CommMon_preserves_limits_aux (F : J ⥤ CommGroup) :
  is_limit ((forget₂ CommGroup CommMon).map_cone (limit_cone F)) :=
CommMon.limit_cone_is_limit (F ⋙ forget₂ CommGroup CommMon)

/--
The forgetful functor from commutative groups to commutative monoids preserves all limits.
(That is, the underlying commutative monoids could have been computed instead as limits
in the category of commutative monoids.)
-/
@[to_additive AddCommGroup.forget₂_AddCommMon_preserves_limits]
instance forget₂_CommMon_preserves_limits : preserves_limits (forget₂ CommGroup CommMon) :=
{ preserves_limits_of_shape := λ J 𝒥, by exactI
  { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone
    (limit_cone_is_limit F) (forget₂_CommMon_preserves_limits_aux F) } }

/--
The forgetful functor from commutative groups to types preserves all limits. (That is, the
underlying types could have been computed instead as limits in the category of types.)
-/
@[to_additive AddCommGroup.forget_preserves_limits]
instance forget_preserves_limits : preserves_limits (forget CommGroup) :=
{ preserves_limits_of_shape := λ J 𝒥, by exactI
  { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ CommGroup Group) (forget Group) } }

end CommGroup

namespace AddCommGroup

/--
The categorical kernel of a morphism in `AddCommGroup`
agrees with the usual group-theoretical kernel.
-/
def kernel_iso_ker {G H : AddCommGroup} (f : G ⟶ H) :
  kernel f ≅ AddCommGroup.of f.ker :=
{ hom :=
  { to_fun := λ g, ⟨kernel.ι f g,
    begin
      -- TODO where is this `has_coe_t_aux.coe` coming from? can we prevent it appearing?
      change (kernel.ι f) g ∈ f.ker,
      simp [add_monoid_hom.mem_ker],
    end⟩,
    map_zero' := by { ext, simp, },
    map_add' := λ g g', by { ext, simp, }, },
  inv := kernel.lift f (add_subgroup.subtype f.ker) (by tidy),
  hom_inv_id' := by { apply equalizer.hom_ext _, ext, simp, },
  inv_hom_id' :=
  begin
    apply AddCommGroup.ext,
    simp only [add_monoid_hom.coe_mk, coe_id, coe_comp],
    rintro ⟨x, mem⟩,
    simp,
  end, }.

@[simp]
lemma kernel_iso_ker_hom_comp_subtype {G H : AddCommGroup} (f : G ⟶ H) :
  (kernel_iso_ker f).hom ≫ add_subgroup.subtype f.ker = kernel.ι f :=
by ext; refl

@[simp]
lemma kernel_iso_ker_inv_comp_ι {G H : AddCommGroup} (f : G ⟶ H) :
  (kernel_iso_ker f).inv ≫ kernel.ι f = add_subgroup.subtype f.ker :=
begin
  ext,
  simp [kernel_iso_ker],
end

/--
The categorical kernel inclusion for `f : G ⟶ H`, as an object over `G`,
agrees with the `subtype` map.
-/
@[simps]
def kernel_iso_ker_over {G H : AddCommGroup.{u}} (f : G ⟶ H) :
  over.mk (kernel.ι f) ≅ @over.mk _ _ G (AddCommGroup.of f.ker) (add_subgroup.subtype f.ker) :=
over.iso_mk (kernel_iso_ker f) (by simp)

end AddCommGroup


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.smodeq
import Mathlib.ring_theory.ideal.operations
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Completion of a module with respect to an ideal.

In this file we define the notions of Hausdorff, precomplete, and complete for an `R`-module `M`
with respect to an ideal `I`:

## Main definitions

- `is_Hausdorff I M`: this says that the intersection of `I^n M` is `0`.
- `is_precomplete I M`: this says that every Cauchy sequence converges.
- `is_adic_complete I M`: this says that `M` is Hausdorff and precomplete.
- `Hausdorffification I M`: this is the universal Hausdorff module with a map from `M`.
- `completion I M`: if `I` is finitely generated, then this is the universal complete module (TODO)
  with a map from `M`. This map is injective iff `M` is Hausdorff and surjective iff `M` is
  precomplete.

-/

/-- A module `M` is Hausdorff with respect to an ideal `I` if `⋂ I^n M = 0`. -/
def is_Hausdorff {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M]
    [module R M] :=
  ∀ (x : M), (∀ (n : ℕ), smodeq (I ^ n • ⊤) x 0) → x = 0

/-- A module `M` is precomplete with respect to an ideal `I` if every Cauchy sequence converges. -/
def is_precomplete {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M]
    [module R M] :=
  ∀ (f : ℕ → M),
    (∀ {m n : ℕ}, m ≤ n → smodeq (I ^ m • ⊤) (f m) (f n)) →
      ∃ (L : M), ∀ (n : ℕ), smodeq (I ^ n • ⊤) (f n) L

/-- A module `M` is `I`-adically complete if it is Hausdorff and precomplete. -/
def is_adic_complete {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M]
    [module R M] :=
  is_Hausdorff I M ∧ is_precomplete I M

/-- The Hausdorffification of a module with respect to an ideal. -/
def Hausdorffification {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M]
    [module R M] :=
  submodule.quotient (infi fun (n : ℕ) => I ^ n • ⊤)

/-- The completion of a module with respect to an ideal. This is not necessarily Hausdorff.
In fact, this is only complete if the ideal is finitely generated. -/
def adic_completion {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M]
    [module R M] : submodule R ((n : ℕ) → submodule.quotient (I ^ n • ⊤)) :=
  submodule.mk
    (set_of
      fun (f : (n : ℕ) → submodule.quotient (I ^ n • ⊤)) =>
        ∀ {m n : ℕ},
          m ≤ n →
            coe_fn (submodule.liftq (I ^ n • ⊤) (submodule.mkq (I ^ m • ⊤)) sorry) (f n) = f m)
    sorry sorry sorry

namespace is_Hausdorff

protected instance bot {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] :
    is_Hausdorff ⊥ M :=
  fun (x : M) (hx : ∀ (n : ℕ), smodeq (⊥ ^ n • ⊤) x 0) =>
    eq.mpr (id (Eq.refl (x = 0)))
      (eq.mp
        (Eq.trans
          ((fun (U U_1 : submodule R M) (e_1 : U = U_1) (x x_1 : M) (e_2 : x = x_1) (y y_1 : M)
              (e_3 : y = y_1) => congr (congr (congr_arg smodeq e_1) e_2) e_3)
            (⊥ ^ 1 • ⊤) ⊥
            (Eq.trans
              ((fun (ᾰ ᾰ_1 : ideal R) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : submodule R M) (e_3 : ᾰ_2 = ᾰ_3) =>
                  congr (congr_arg has_scalar.smul e_2) e_3)
                (⊥ ^ 1) ⊥ (pow_one ⊥) ⊤ ⊤ (Eq.refl ⊤))
              (submodule.bot_smul ⊤))
            x x (Eq.refl x) 0 0 (Eq.refl 0))
          (propext smodeq.bot))
        (hx 1))

protected theorem subsingleton {R : Type u_1} [comm_ring R] {M : Type u_2} [add_comm_group M]
    [module R M] (h : is_Hausdorff ⊤ M) : subsingleton M :=
  sorry

protected instance of_subsingleton {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2)
    [add_comm_group M] [module R M] [subsingleton M] : is_Hausdorff I M :=
  fun (x : M) (_x : ∀ (n : ℕ), smodeq (I ^ n • ⊤) x 0) => subsingleton.elim x 0

theorem infi_pow_smul {R : Type u_1} [comm_ring R] {I : ideal R} {M : Type u_2} [add_comm_group M]
    [module R M] (h : is_Hausdorff I M) : (infi fun (n : ℕ) => I ^ n • ⊤) = ⊥ :=
  sorry

end is_Hausdorff

namespace Hausdorffification

/-- The canonical linear map to the Hausdorffification. -/
def of {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] :
    linear_map R M (Hausdorffification I M) :=
  submodule.mkq (infi fun (n : ℕ) => I ^ n • ⊤)

theorem induction_on {R : Type u_1} [comm_ring R] {I : ideal R} {M : Type u_2} [add_comm_group M]
    [module R M] {C : Hausdorffification I M → Prop} (x : Hausdorffification I M)
    (ih : ∀ (x : M), C (coe_fn (of I M) x)) : C x :=
  quotient.induction_on' x ih

protected instance is_Hausdorff {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2)
    [add_comm_group M] [module R M] : is_Hausdorff I (Hausdorffification I M) :=
  sorry

/-- universal property of Hausdorffification: any linear map to a Hausdorff module extends to a
unique map from the Hausdorffification. -/
def lift {R : Type u_1} [comm_ring R] (I : ideal R) {M : Type u_2} [add_comm_group M] [module R M]
    {N : Type u_3} [add_comm_group N] [module R N] [h : is_Hausdorff I N] (f : linear_map R M N) :
    linear_map R (Hausdorffification I M) N :=
  submodule.liftq (infi fun (n : ℕ) => I ^ n • ⊤) f sorry

theorem lift_of {R : Type u_1} [comm_ring R] (I : ideal R) {M : Type u_2} [add_comm_group M]
    [module R M] {N : Type u_3} [add_comm_group N] [module R N] [h : is_Hausdorff I N]
    (f : linear_map R M N) (x : M) : coe_fn (lift I f) (coe_fn (of I M) x) = coe_fn f x :=
  rfl

theorem lift_comp_of {R : Type u_1} [comm_ring R] (I : ideal R) {M : Type u_2} [add_comm_group M]
    [module R M] {N : Type u_3} [add_comm_group N] [module R N] [h : is_Hausdorff I N]
    (f : linear_map R M N) : linear_map.comp (lift I f) (of I M) = f :=
  linear_map.ext fun (_x : M) => rfl

/-- Uniqueness of lift. -/
theorem lift_eq {R : Type u_1} [comm_ring R] (I : ideal R) {M : Type u_2} [add_comm_group M]
    [module R M] {N : Type u_3} [add_comm_group N] [module R N] [h : is_Hausdorff I N]
    (f : linear_map R M N) (g : linear_map R (Hausdorffification I M) N)
    (hg : linear_map.comp g (of I M) = f) : g = lift I f :=
  sorry

end Hausdorffification

namespace is_precomplete

protected instance bot {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] :
    is_precomplete ⊥ M :=
  fun (f : ℕ → M) (hf : ∀ {m n : ℕ}, m ≤ n → smodeq (⊥ ^ m • ⊤) (f m) (f n)) =>
    Exists.intro (f 1)
      fun (n : ℕ) =>
        nat.cases_on n
          (eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (⊥ ^ 0 • ⊤) (f 0) (f 1))) (pow_zero ⊥)))
            (eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (1 • ⊤) (f 0) (f 1))) ideal.one_eq_top))
              (eq.mpr
                (id (Eq._oldrec (Eq.refl (smodeq (⊤ • ⊤) (f 0) (f 1))) (submodule.top_smul ⊤)))
                smodeq.top)))
          fun (n : ℕ) =>
            eq.mpr
              (id
                (Eq._oldrec (Eq.refl (smodeq (⊥ ^ Nat.succ n • ⊤) (f (Nat.succ n)) (f 1)))
                  (eq.mp (Eq._oldrec (Eq.refl (smodeq ⊥ (f 1) (f (n + 1)))) (propext smodeq.bot))
                    (eq.mp
                      (Eq._oldrec (Eq.refl (smodeq (⊥ • ⊤) (f 1) (f (n + 1))))
                        (submodule.bot_smul ⊤))
                      (eq.mp
                        (Eq._oldrec (Eq.refl (smodeq (⊥ ^ 1 • ⊤) (f 1) (f (n + 1)))) (pow_one ⊥))
                        (hf (nat.le_add_left 1 n)))))))
              smodeq.refl

protected instance top {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] :
    is_precomplete ⊤ M :=
  fun (f : ℕ → M) (hf : ∀ {m n : ℕ}, m ≤ n → smodeq (⊤ ^ m • ⊤) (f m) (f n)) =>
    Exists.intro 0
      fun (n : ℕ) =>
        eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (⊤ ^ n • ⊤) (f n) 0)) (ideal.top_pow R n)))
          (eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (⊤ • ⊤) (f n) 0)) (submodule.top_smul ⊤)))
            smodeq.top)

protected instance of_subsingleton {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2)
    [add_comm_group M] [module R M] [subsingleton M] : is_precomplete I M :=
  fun (f : ℕ → M) (hf : ∀ {m n : ℕ}, m ≤ n → smodeq (I ^ m • ⊤) (f m) (f n)) =>
    Exists.intro 0
      fun (n : ℕ) =>
        eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (I ^ n • ⊤) (f n) 0)) (subsingleton.elim (f n) 0)))
          smodeq.refl

end is_precomplete

namespace adic_completion

/-- The canonical linear map to the completion. -/
def of {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] :
    linear_map R M ↥(adic_completion I M) :=
  linear_map.mk
    (fun (x : M) =>
      { val := fun (n : ℕ) => coe_fn (submodule.mkq (I ^ n • ⊤)) x, property := sorry })
    sorry sorry

@[simp] theorem of_apply {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2)
    [add_comm_group M] [module R M] (x : M) (n : ℕ) :
    subtype.val (coe_fn (of I M) x) n = coe_fn (submodule.mkq (I ^ n • ⊤)) x :=
  rfl

/-- Linearly evaluating a sequence in the completion at a given input. -/
def eval {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M]
    (n : ℕ) : linear_map R (↥(adic_completion I M)) (submodule.quotient (I ^ n • ⊤)) :=
  linear_map.mk (fun (f : ↥(adic_completion I M)) => subtype.val f n) sorry sorry

@[simp] theorem coe_eval {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2)
    [add_comm_group M] [module R M] (n : ℕ) :
    ⇑(eval I M n) = fun (f : ↥(adic_completion I M)) => subtype.val f n :=
  rfl

theorem eval_apply {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M]
    [module R M] (n : ℕ) (f : ↥(adic_completion I M)) : coe_fn (eval I M n) f = subtype.val f n :=
  rfl

theorem eval_of {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M]
    [module R M] (n : ℕ) (x : M) :
    coe_fn (eval I M n) (coe_fn (of I M) x) = coe_fn (submodule.mkq (I ^ n • ⊤)) x :=
  rfl

@[simp] theorem eval_comp_of {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2)
    [add_comm_group M] [module R M] (n : ℕ) :
    linear_map.comp (eval I M n) (of I M) = submodule.mkq (I ^ n • ⊤) :=
  rfl

@[simp] theorem range_eval {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2)
    [add_comm_group M] [module R M] (n : ℕ) : linear_map.range (eval I M n) = ⊤ :=
  iff.mpr linear_map.range_eq_top
    fun (x : submodule.quotient (I ^ n • ⊤)) =>
      quotient.induction_on' x fun (x : M) => Exists.intro (coe_fn (of I M) x) rfl

theorem ext {R : Type u_1} [comm_ring R] {I : ideal R} {M : Type u_2} [add_comm_group M]
    [module R M] {x : ↥(adic_completion I M)} {y : ↥(adic_completion I M)}
    (h : ∀ (n : ℕ), coe_fn (eval I M n) x = coe_fn (eval I M n) y) : x = y :=
  subtype.eq (funext h)

protected instance is_Hausdorff {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2)
    [add_comm_group M] [module R M] : is_Hausdorff I ↥(adic_completion I M) :=
  sorry

end adic_completion

namespace is_adic_complete

protected instance bot {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] :
    is_adic_complete ⊥ M :=
  { left := is_Hausdorff.bot M, right := is_precomplete.bot M }

protected theorem subsingleton {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M]
    [module R M] (h : is_adic_complete ⊤ M) : subsingleton M :=
  is_Hausdorff.subsingleton (and.left h)

protected instance of_subsingleton {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2)
    [add_comm_group M] [module R M] [subsingleton M] : is_adic_complete I M :=
  { left := is_Hausdorff.of_subsingleton I M, right := is_precomplete.of_subsingleton I M }

end Mathlib


/-
Copyright (c) 2020 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.dynamics.flow
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5

namespace Mathlib

/-!
# ω-limits

For a function `ϕ : τ → α → β` where `β` is a topological space, we
define the ω-limit under `ϕ` of a set `s` in `α` with respect to
filter `f` on `τ`: an element `y : β` is in the ω-limit of `s` if the
forward images of `s` intersect arbitrarily small neighbourhoods of
`y` frequently "in the direction of `f`".

In practice `ϕ` is often a continuous monoid-act, but the definition
requires only that `ϕ` has a coercion to the appropriate function
type. In the case where `τ` is `ℕ` or `ℝ` and `f` is `at_top`, we
recover the usual definition of the ω-limit set as the set of all `y`
such that there exist sequences `(tₙ)`, `(xₙ)` such that `ϕ tₙ xₙ ⟶ y`
as `n ⟶ ∞`.

## Notations

The `omega_limit` locale provides the localised notation `ω` for
`omega_limit`, as well as `ω⁺` and `ω⁻` for `omega_limit at_top` and
`omega_limit at_bot` respectively for when the acting monoid is
endowed with an order.
-/

/-!
### Definition and notation
-/

/-- The ω-limit of a set `s` under `ϕ` with respect to a filter `f` is
    ⋂ u ∈ f, cl (ϕ u s). -/
def omega_limit {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ)
    (ϕ : τ → α → β) (s : set α) : set β :=
  set.Inter fun (u : set τ) => set.Inter fun (H : u ∈ f) => closure (set.image2 ϕ u s)

/-!
### Elementary properties
-/

theorem omega_limit_def {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (f : filter τ) (ϕ : τ → α → β) (s : set α) :
    omega_limit f ϕ s =
        set.Inter fun (u : set τ) => set.Inter fun (H : u ∈ f) => closure (set.image2 ϕ u s) :=
  rfl

theorem omega_limit_subset_of_tendsto {τ : Type u_1} {α : Type u_2} {β : Type u_3}
    [topological_space β] (ϕ : τ → α → β) (s : set α) {m : τ → τ} {f₁ : filter τ} {f₂ : filter τ}
    (hf : filter.tendsto m f₁ f₂) :
    omega_limit f₁ (fun (t : τ) (x : α) => ϕ (m t) x) s ⊆ omega_limit f₂ ϕ s :=
  sorry

theorem omega_limit_mono_left {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (ϕ : τ → α → β) (s : set α) {f₁ : filter τ} {f₂ : filter τ} (hf : f₁ ≤ f₂) :
    omega_limit f₁ ϕ s ⊆ omega_limit f₂ ϕ s :=
  omega_limit_subset_of_tendsto ϕ s (filter.tendsto_id' hf)

theorem omega_limit_mono_right {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (f : filter τ) (ϕ : τ → α → β) {s₁ : set α} {s₂ : set α} (hs : s₁ ⊆ s₂) :
    omega_limit f ϕ s₁ ⊆ omega_limit f ϕ s₂ :=
  set.bInter_subset_bInter_right
    fun (u : set τ) (hu : u ∈ fun (u : set τ) => u ∈ filter.sets f) =>
      closure_mono (set.image2_subset set.subset.rfl hs)

theorem is_closed_omega_limit {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (f : filter τ) (ϕ : τ → α → β) (s : set α) : is_closed (omega_limit f ϕ s) :=
  is_closed_Inter fun (u : set τ) => is_closed_Inter fun (hu : u ∈ f) => is_closed_closure

theorem maps_to_omega_limit' {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (s : set α) {α' : Type u_4} {β' : Type u_5} [topological_space β'] {f : filter τ}
    {ϕ : τ → α → β} {ϕ' : τ → α' → β'} {ga : α → α'} {s' : set α'} (hs : set.maps_to ga s s')
    {gb : β → β'} (hg : filter.eventually (fun (t : τ) => set.eq_on (gb ∘ ϕ t) (ϕ' t ∘ ga) s) f)
    (hgc : continuous gb) : set.maps_to gb (omega_limit f ϕ s) (omega_limit f ϕ' s') :=
  sorry

theorem maps_to_omega_limit {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (s : set α) {α' : Type u_4} {β' : Type u_5} [topological_space β'] {f : filter τ}
    {ϕ : τ → α → β} {ϕ' : τ → α' → β'} {ga : α → α'} {s' : set α'} (hs : set.maps_to ga s s')
    {gb : β → β'} (hg : ∀ (t : τ) (x : α), gb (ϕ t x) = ϕ' t (ga x)) (hgc : continuous gb) :
    set.maps_to gb (omega_limit f ϕ s) (omega_limit f ϕ' s') :=
  maps_to_omega_limit' s hs (filter.eventually_of_forall fun (t : τ) (x : α) (hx : x ∈ s) => hg t x)
    hgc

theorem omega_limit_image_eq {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (s : set α) {α' : Type u_4} (ϕ : τ → α' → β) (f : filter τ) (g : α → α') :
    omega_limit f ϕ (g '' s) = omega_limit f (fun (t : τ) (x : α) => ϕ t (g x)) s :=
  sorry

theorem omega_limit_preimage_subset {τ : Type u_1} {α : Type u_2} {β : Type u_3}
    [topological_space β] {α' : Type u_4} (ϕ : τ → α' → β) (s : set α') (f : filter τ)
    (g : α → α') : omega_limit f (fun (t : τ) (x : α) => ϕ t (g x)) (g ⁻¹' s) ⊆ omega_limit f ϕ s :=
  maps_to_omega_limit (g ⁻¹' s) (set.maps_to_preimage g s) (fun (t : τ) (x : α) => rfl)
    continuous_id

/-!
### Equivalent definitions of the omega limit

The next few lemmas are various versions of the property
characterising ω-limits:
-/

/-- An element `y` is in the ω-limit set of `s` w.r.t. `f` if the
    preimages of an arbitrary neighbourhood of `y` frequently
    (w.r.t. `f`) intersects of `s`. -/
theorem mem_omega_limit_iff_frequently {τ : Type u_1} {α : Type u_2} {β : Type u_3}
    [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) (y : β) :
    y ∈ omega_limit f ϕ s ↔
        ∀ (n : set β),
          n ∈ nhds y → filter.frequently (fun (t : τ) => set.nonempty (s ∩ ϕ t ⁻¹' n)) f :=
  sorry

/-- An element `y` is in the ω-limit set of `s` w.r.t. `f` if the
    forward images of `s` frequently (w.r.t. `f`) intersect arbitrary
    neighbourhoods of `y`. -/
theorem mem_omega_limit_iff_frequently₂ {τ : Type u_1} {α : Type u_2} {β : Type u_3}
    [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) (y : β) :
    y ∈ omega_limit f ϕ s ↔
        ∀ (n : set β),
          n ∈ nhds y → filter.frequently (fun (t : τ) => set.nonempty (ϕ t '' s ∩ n)) f :=
  sorry

/-- An element `y` is in the ω-limit of `x` w.r.t. `f` if the forward
    images of `x` frequently (w.r.t. `f`) falls within an arbitrary
    neighbourhood of `y`. -/
theorem mem_omega_limit_singleton_iff_map_cluster_point {τ : Type u_1} {α : Type u_2} {β : Type u_3}
    [topological_space β] (f : filter τ) (ϕ : τ → α → β) (x : α) (y : β) :
    y ∈ omega_limit f ϕ (singleton x) ↔ map_cluster_pt y f fun (t : τ) => ϕ t x :=
  sorry

/-!
### Set operations and omega limits
-/

theorem omega_limit_inter {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (f : filter τ) (ϕ : τ → α → β) (s₁ : set α) (s₂ : set α) :
    omega_limit f ϕ (s₁ ∩ s₂) ⊆ omega_limit f ϕ s₁ ∩ omega_limit f ϕ s₂ :=
  set.subset_inter (omega_limit_mono_right f ϕ (set.inter_subset_left s₁ s₂))
    (omega_limit_mono_right f ϕ (set.inter_subset_right s₁ s₂))

theorem omega_limit_Inter {τ : Type u_1} {α : Type u_2} {β : Type u_3} {ι : Type u_4}
    [topological_space β] (f : filter τ) (ϕ : τ → α → β) (p : ι → set α) :
    omega_limit f ϕ (set.Inter fun (i : ι) => p i) ⊆
        set.Inter fun (i : ι) => omega_limit f ϕ (p i) :=
  set.subset_Inter
    fun (i : ι) => omega_limit_mono_right f ϕ (set.Inter_subset (fun (i : ι) => p i) i)

theorem omega_limit_union {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (f : filter τ) (ϕ : τ → α → β) (s₁ : set α) (s₂ : set α) :
    omega_limit f ϕ (s₁ ∪ s₂) = omega_limit f ϕ s₁ ∪ omega_limit f ϕ s₂ :=
  sorry

theorem omega_limit_Union {τ : Type u_1} {α : Type u_2} {β : Type u_3} {ι : Type u_4}
    [topological_space β] (f : filter τ) (ϕ : τ → α → β) (p : ι → set α) :
    (set.Union fun (i : ι) => omega_limit f ϕ (p i)) ⊆
        omega_limit f ϕ (set.Union fun (i : ι) => p i) :=
  sorry

/-!
Different expressions for omega limits, useful for rewrites. In
particular, one may restrict the intersection to sets in `f` which are
subsets of some set `v` also in `f`.
-/

theorem omega_limit_eq_Inter {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (f : filter τ) (ϕ : τ → α → β) (s : set α) :
    omega_limit f ϕ s = set.Inter fun (u : ↥(filter.sets f)) => closure (set.image2 ϕ (↑u) s) :=
  set.bInter_eq_Inter (fun (u : set τ) => u ∈ filter.sets f)
    fun (u : set τ) (H : u ∈ f) => closure (set.image2 ϕ u s)

theorem omega_limit_eq_bInter_inter {τ : Type u_1} {α : Type u_2} {β : Type u_3}
    [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) {v : set τ} (hv : v ∈ f) :
    omega_limit f ϕ s =
        set.Inter
          fun (u : set τ) => set.Inter fun (H : u ∈ f) => closure (set.image2 ϕ (u ∩ v) s) :=
  sorry

theorem omega_limit_eq_Inter_inter {τ : Type u_1} {α : Type u_2} {β : Type u_3}
    [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) {v : set τ} (hv : v ∈ f) :
    omega_limit f ϕ s = set.Inter fun (u : ↥(filter.sets f)) => closure (set.image2 ϕ (↑u ∩ v) s) :=
  sorry

theorem omega_limit_subset_closure_fw_image {τ : Type u_1} {α : Type u_2} {β : Type u_3}
    [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) {u : set τ} (hu : u ∈ f) :
    omega_limit f ϕ s ⊆ closure (set.image2 ϕ u s) :=
  sorry

/-!
### `ω-limits and compactness
-/

/-- A set is eventually carried into any open neighbourhood of its ω-limit:
if `c` is a compact set such that `closure {ϕ t x | t ∈ v, x ∈ s} ⊆ c` for some `v ∈ f`
and `n` is an open neighbourhood of `ω f ϕ s`, then for some `u ∈ f` we have
`closure {ϕ t x | t ∈ u, x ∈ s} ⊆ n`. -/
theorem eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset'
    {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ)
    (ϕ : τ → α → β) (s : set α) {c : set β} (hc₁ : is_compact c)
    (hc₂ : ∃ (v : set τ), ∃ (H : v ∈ f), closure (set.image2 ϕ v s) ⊆ c) {n : set β}
    (hn₁ : is_open n) (hn₂ : omega_limit f ϕ s ⊆ n) :
    ∃ (u : set τ), ∃ (H : u ∈ f), closure (set.image2 ϕ u s) ⊆ n :=
  sorry

/-- A set is eventually carried into any open neighbourhood of its ω-limit:
if `c` is a compact set such that `closure {ϕ t x | t ∈ v, x ∈ s} ⊆ c` for some `v ∈ f`
and `n` is an open neighbourhood of `ω f ϕ s`, then for some `u ∈ f` we have
`closure {ϕ t x | t ∈ u, x ∈ s} ⊆ n`. -/
theorem eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset
    {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ)
    (ϕ : τ → α → β) (s : set α) [t2_space β] {c : set β} (hc₁ : is_compact c)
    (hc₂ : filter.eventually (fun (t : τ) => set.maps_to (ϕ t) s c) f) {n : set β} (hn₁ : is_open n)
    (hn₂ : omega_limit f ϕ s ⊆ n) : ∃ (u : set τ), ∃ (H : u ∈ f), closure (set.image2 ϕ u s) ⊆ n :=
  sorry

theorem eventually_maps_to_of_is_compact_absorbing_of_is_open_of_omega_limit_subset {τ : Type u_1}
    {α : Type u_2} {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α)
    [t2_space β] {c : set β} (hc₁ : is_compact c)
    (hc₂ : filter.eventually (fun (t : τ) => set.maps_to (ϕ t) s c) f) {n : set β} (hn₁ : is_open n)
    (hn₂ : omega_limit f ϕ s ⊆ n) : filter.eventually (fun (t : τ) => set.maps_to (ϕ t) s n) f :=
  sorry

theorem eventually_closure_subset_of_is_open_of_omega_limit_subset {τ : Type u_1} {α : Type u_2}
    {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α)
    [compact_space β] {v : set β} (hv₁ : is_open v) (hv₂ : omega_limit f ϕ s ⊆ v) :
    ∃ (u : set τ), ∃ (H : u ∈ f), closure (set.image2 ϕ u s) ⊆ v :=
  eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset' f ϕ s
    compact_univ
    (Exists.intro set.univ
      (Exists.intro filter.univ_mem_sets (set.subset_univ (closure (set.image2 ϕ set.univ s)))))
    hv₁ hv₂

theorem eventually_maps_to_of_is_open_of_omega_limit_subset {τ : Type u_1} {α : Type u_2}
    {β : Type u_3} [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α)
    [compact_space β] {v : set β} (hv₁ : is_open v) (hv₂ : omega_limit f ϕ s ⊆ v) :
    filter.eventually (fun (t : τ) => set.maps_to (ϕ t) s v) f :=
  sorry

/-- The ω-limit of a nonempty set w.r.t. a nontrivial filter is nonempty. -/
theorem nonempty_omega_limit_of_is_compact_absorbing {τ : Type u_1} {α : Type u_2} {β : Type u_3}
    [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) [filter.ne_bot f] {c : set β}
    (hc₁ : is_compact c) (hc₂ : ∃ (v : set τ), ∃ (H : v ∈ f), closure (set.image2 ϕ v s) ⊆ c)
    (hs : set.nonempty s) : set.nonempty (omega_limit f ϕ s) :=
  sorry

theorem nonempty_omega_limit {τ : Type u_1} {α : Type u_2} {β : Type u_3} [topological_space β]
    (f : filter τ) (ϕ : τ → α → β) (s : set α) [compact_space β] [filter.ne_bot f]
    (hs : set.nonempty s) : set.nonempty (omega_limit f ϕ s) :=
  nonempty_omega_limit_of_is_compact_absorbing f ϕ s compact_univ
    (Exists.intro set.univ
      (Exists.intro filter.univ_mem_sets (set.subset_univ (closure (set.image2 ϕ set.univ s)))))
    hs

/-!
### ω-limits of Flows by a Monoid
-/

namespace flow

theorem is_invariant_omega_limit {τ : Type u_1} [topological_space τ] [add_monoid τ]
    [has_continuous_add τ] {α : Type u_2} [topological_space α] (f : filter τ) (ϕ : flow τ α)
    (s : set α) (hf : ∀ (t : τ), filter.tendsto (Add.add t) f f) :
    is_invariant (⇑ϕ) (omega_limit f (⇑ϕ) s) :=
  sorry

theorem omega_limit_image_subset {τ : Type u_1} [topological_space τ] [add_monoid τ]
    [has_continuous_add τ] {α : Type u_2} [topological_space α] (f : filter τ) (ϕ : flow τ α)
    (s : set α) (t : τ) (ht : filter.tendsto (fun (_x : τ) => _x + t) f f) :
    omega_limit f (⇑ϕ) (coe_fn ϕ t '' s) ⊆ omega_limit f (⇑ϕ) s :=
  sorry

end flow

/-!
### ω-limits of Flows by a Group
-/

namespace flow

/-- the ω-limit of a forward image of `s` is the same as the ω-limit of `s`. -/
@[simp] theorem omega_limit_image_eq {τ : Type u_1} [topological_space τ] [add_comm_group τ]
    [topological_add_group τ] {α : Type u_2} [topological_space α] (f : filter τ) (ϕ : flow τ α)
    (s : set α) (hf : ∀ (t : τ), filter.tendsto (fun (_x : τ) => _x + t) f f) (t : τ) :
    omega_limit f (⇑ϕ) (coe_fn ϕ t '' s) = omega_limit f (⇑ϕ) s :=
  sorry

theorem omega_limit_omega_limit {τ : Type u_1} [topological_space τ] [add_comm_group τ]
    [topological_add_group τ] {α : Type u_2} [topological_space α] (f : filter τ) (ϕ : flow τ α)
    (s : set α) (hf : ∀ (t : τ), filter.tendsto (Add.add t) f f) :
    omega_limit f (⇑ϕ) (omega_limit f (⇑ϕ) s) ⊆ omega_limit f (⇑ϕ) s :=
  sorry

end Mathlib


import Lean.Data.Json
import Mathlib.Data.Nat.Basic
import Mathlib.Init.Algebra.Order
import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Data.Int.Basic
import Mathlib.Tactic.LibrarySearch
import Mathlib.Tactic.SimpRw
import Mathlib.Data.Equiv.Basic
import Mathlib.Init.Data.Int.Order
import Timelib.Date.Year

open Lean

/-
This ends up being easier to use than a Nat restricted to `1 <= n <= 12`,
because we can define functions using the recursor without having to discharge
the edge cases of 0 and n > 12
-/
inductive Month
| january
| february
| march
| april
| may
| june
| july
| august
| september
| october
| november
| december
deriving Repr

@[reducible]
def Month.toNat : Month → Nat
| january => 1
| february => 2
| march => 3
| april => 4
| may => 5
| june => 6
| july => 7
| august => 8
| september => 9
| october => 10
| november => 11
| december => 12

instance : OfNat Month (nat_lit 1) := ⟨Month.january⟩
instance : OfNat Month (nat_lit 2) := ⟨Month.february⟩
instance : OfNat Month (nat_lit 3) := ⟨Month.march⟩
instance : OfNat Month (nat_lit 4) := ⟨Month.april⟩
instance : OfNat Month (nat_lit 5) := ⟨Month.may⟩
instance : OfNat Month (nat_lit 6) := ⟨Month.june⟩
instance : OfNat Month (nat_lit 7) := ⟨Month.july⟩
instance : OfNat Month (nat_lit 8) := ⟨Month.august⟩
instance : OfNat Month (nat_lit 9) := ⟨Month.september⟩
instance : OfNat Month (nat_lit 10) := ⟨Month.october⟩
instance : OfNat Month (nat_lit 11) := ⟨Month.november⟩
instance : OfNat Month (nat_lit 12) := ⟨Month.december⟩

def Month.ofNat? : Nat → Option Month
| 1 => some 1
| 2 => some 2
| 3 => some 3
| 4 => some 4
| 5 => some 5
| 6 => some 6
| 7 => some 7
| 8 => some 8
| 9 => some 9
| 10 => some 10
| 11 => some 11
| 12 => some 12
| _ => none

instance : ToJson Month where
  toJson := ToJson.toJson ∘ Month.toNat

instance : FromJson Month where
  fromJson? j := do
    let n ← j.getNat?
    match Month.ofNat? n with
    | none => throw s!"Month must be between 1 and 12; got {n}"
    | some m => .ok m

theorem Month.toNat.injective (m₁ m₂ : Month) (h : m₁.toNat = m₂.toNat) : m₁ = m₂ := by
  cases m₁ <;> (cases m₂ <;> (cases h; try rfl))

instance : LE Month where
  le := InvImage Nat.le Month.toNat

instance : LT Month where
  lt := InvImage Nat.lt Month.toNat

theorem Month.le_def {m m' : Month} : (m <= m') = (m.toNat <= m'.toNat) := rfl
theorem Month.lt_def {m m' : Month} : (m < m') = (m.toNat < m'.toNat) := rfl

instance instDecidableLEMonth (m m' : Month) : Decidable (m <= m') := inferInstanceAs (Decidable (m.toNat <= m'.toNat))
instance instDecidableLTMonth (m m' : Month) : Decidable (m < m') := inferInstanceAs (Decidable  (m.toNat < m'.toNat))

instance : LinearOrder Month where
  le_refl (a) := le_refl a.toNat
  le_trans (a b c) := Nat.le_trans
  lt_iff_le_not_le (a b) := Nat.lt_iff_le_not_le
  le_antisymm (a b h1 h2) := by
    apply Month.toNat.injective
    exact le_antisymm h1 h2
  le_total := by simp [Month.le_def, le_total]
  decidable_le := inferInstance

instance : Ord Month := ⟨fun m₁ m₂ => compareOfLessAndEq m₁ m₂⟩

@[reducible] def Month.numDays (year : Year) : ∀ (month : Month), Nat
| february => if year.isLeapYear then 29 else 28
| april => 30
| june => 30
| september => 30
| november => 30
| _ => 31

theorem Month.numDays_pos (month : Month) (year : Year) : 0 < month.numDays year := by
  simp only [Month.numDays]
  by_cases hy : year.isLeapYear
  case pos => split <;> simp [hy, if_true]
  case neg => split <;> simp [hy, if_false]

theorem Month.numDays_lt_numDaysInGregorianYear (month : Month) (year : Year) : month.numDays year < year.numDaysInGregorianYear := by
  simp only [Month.numDays, Year.numDaysInGregorianYear]
  by_cases hy : year.isLeapYear
  case pos => split <;> simp [hy, if_true]
  case neg => split <;> simp [hy, if_false]

theorem Month.numDays_lt_31 (month : Month) (year : Year) : month.numDays year <= 31 := by
  simp only [Month.numDays, Year.numDaysInGregorianYear]
  by_cases hy : year.isLeapYear
  case pos => split <;> simp [hy, if_true]
  case neg => split <;> simp [hy, if_false]


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Jeremy Avigad, Haitao Zhang
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.prod
import Mathlib.Lean3Lib.init.funext
import Mathlib.Lean3Lib.init.logic

universes u₁ u₂ u₃ u₄

namespace Mathlib

/-!
# General operations on functions
-/

namespace function

/-- Composition of functions: `(f ∘ g) x = f (g x)`. -/
def comp {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} (f : β → φ) (g : α → β) : α → φ :=
  fun (x : α) => f (g x)

/-- Composition of dependent functions: `(f ∘' g) x = f (g x)`, where type of `g x` depends on `x`
and type of `f (g x)` depends on `x` and `g x`. -/
def dcomp {α : Sort u₁} {β : α → Sort u₂} {φ : {x : α} → β x → Sort u₃} (f : {x : α} → (y : β x) → φ y) (g : (x : α) → β x) (x : α) : φ (g x) :=
  f (g x)

infixr:90 " ∘ " => Mathlib.function.comp

infixr:80 " ∘' " => Mathlib.function.dcomp

def comp_right {α : Sort u₁} {β : Sort u₂} (f : β → β → β) (g : α → β) : β → α → β :=
  fun (b : β) (a : α) => f b (g a)

def comp_left {α : Sort u₁} {β : Sort u₂} (f : β → β → β) (g : α → β) : α → β → β :=
  fun (a : α) (b : β) => f (g a) b

/-- Given functions `f : β → β → φ` and `g : α → β`, produce a function `α → α → φ` that evaluates
`g` on each argument, then applies `f` to the results. Can be used, e.g., to transfer a relation
from `β` to `α`. -/
def on_fun {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} (f : β → β → φ) (g : α → β) : α → α → φ :=
  fun (x y : α) => f (g x) (g y)

def combine {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} {δ : Sort u₄} {ζ : Sort u₁} (f : α → β → φ) (op : φ → δ → ζ) (g : α → β → δ) : α → β → ζ :=
  fun (x : α) (y : β) => op (f x y) (g x y)

/-- Constant `λ _, a`. -/
def const {α : Sort u₁} (β : Sort u₂) (a : α) : β → α :=
  fun (x : β) => a

def swap {α : Sort u₁} {β : Sort u₂} {φ : α → β → Sort u₃} (f : (x : α) → (y : β) → φ x y) (y : β) (x : α) : φ x y :=
  f x y

def app {α : Sort u₁} {β : α → Sort u₂} (f : (x : α) → β x) (x : α) : β x :=
  f x

infixl:2 " on " => Mathlib.function.on_fun

theorem left_id {α : Sort u₁} {β : Sort u₂} (f : α → β) : id ∘ f = f :=
  rfl

theorem right_id {α : Sort u₁} {β : Sort u₂} (f : α → β) : f ∘ id = f :=
  rfl

@[simp] theorem comp_app {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} (f : β → φ) (g : α → β) (a : α) : comp f g a = f (g a) :=
  rfl

theorem comp.assoc {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} {δ : Sort u₄} (f : φ → δ) (g : β → φ) (h : α → β) : (f ∘ g) ∘ h = f ∘ g ∘ h :=
  rfl

@[simp] theorem comp.left_id {α : Sort u₁} {β : Sort u₂} (f : α → β) : id ∘ f = f :=
  rfl

@[simp] theorem comp.right_id {α : Sort u₁} {β : Sort u₂} (f : α → β) : f ∘ id = f :=
  rfl

theorem comp_const_right {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} (f : β → φ) (b : β) : f ∘ const α b = const α (f b) :=
  rfl

/-- A function `f : α → β` is called injective if `f x = f y` implies `x = y`. -/
def injective {α : Sort u₁} {β : Sort u₂} (f : α → β) :=
  ∀ {a₁ a₂ : α}, f a₁ = f a₂ → a₁ = a₂

theorem injective.comp {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} {g : β → φ} {f : α → β} (hg : injective g) (hf : injective f) : injective (g ∘ f) :=
  fun (a₁ a₂ : α) (h : comp g f a₁ = comp g f a₂) => hf (hg h)

/-- A function `f : α → β` is calles surjective if every `b : β` is equal to `f a`
for some `a : α`. -/
def surjective {α : Sort u₁} {β : Sort u₂} (f : α → β) :=
  ∀ (b : β), ∃ (a : α), f a = b

theorem surjective.comp {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} {g : β → φ} {f : α → β} (hg : surjective g) (hf : surjective f) : surjective (g ∘ f) := sorry

/-- A function is called bijective if it is both injective and surjective. -/
def bijective {α : Sort u₁} {β : Sort u₂} (f : α → β) :=
  injective f ∧ surjective f

theorem bijective.comp {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} {g : β → φ} {f : α → β} : bijective g → bijective f → bijective (g ∘ f) := sorry

/-- `left_inverse g f` means that g is a left inverse to f. That is, `g ∘ f = id`. -/
def left_inverse {α : Sort u₁} {β : Sort u₂} (g : β → α) (f : α → β) :=
  ∀ (x : α), g (f x) = x

/-- `has_left_inverse f` means that `f` has an unspecified left inverse. -/
def has_left_inverse {α : Sort u₁} {β : Sort u₂} (f : α → β) :=
  ∃ (finv : β → α), left_inverse finv f

/-- `right_inverse g f` means that g is a right inverse to f. That is, `f ∘ g = id`. -/
def right_inverse {α : Sort u₁} {β : Sort u₂} (g : β → α) (f : α → β) :=
  left_inverse f g

/-- `has_right_inverse f` means that `f` has an unspecified right inverse. -/
def has_right_inverse {α : Sort u₁} {β : Sort u₂} (f : α → β) :=
  ∃ (finv : β → α), right_inverse finv f

theorem left_inverse.injective {α : Sort u₁} {β : Sort u₂} {g : β → α} {f : α → β} : left_inverse g f → injective f :=
  fun (h : left_inverse g f) (a b : α) (faeqfb : f a = f b) =>
    Eq.trans (Eq.trans (Eq.symm (h a)) (congr_arg g faeqfb)) (h b)

theorem has_left_inverse.injective {α : Sort u₁} {β : Sort u₂} {f : α → β} : has_left_inverse f → injective f :=
  fun (h : has_left_inverse f) =>
    exists.elim h fun (finv : β → α) (inv : left_inverse finv f) => left_inverse.injective inv

theorem right_inverse_of_injective_of_left_inverse {α : Sort u₁} {β : Sort u₂} {f : α → β} {g : β → α} (injf : injective f) (lfg : left_inverse f g) : right_inverse f g :=
  fun (x : α) => (fun (h : f (g (f x)) = f x) => injf h) (lfg (f x))

theorem right_inverse.surjective {α : Sort u₁} {β : Sort u₂} {f : α → β} {g : β → α} (h : right_inverse g f) : surjective f :=
  fun (y : β) => Exists.intro (g y) (h y)

theorem has_right_inverse.surjective {α : Sort u₁} {β : Sort u₂} {f : α → β} : has_right_inverse f → surjective f :=
  fun (ᾰ : has_right_inverse f) =>
    Exists.dcases_on ᾰ
      fun (ᾰ_w : β → α) (ᾰ_h : right_inverse ᾰ_w f) => idRhs (surjective f) (right_inverse.surjective ᾰ_h)

theorem left_inverse_of_surjective_of_right_inverse {α : Sort u₁} {β : Sort u₂} {f : α → β} {g : β → α} (surjf : surjective f) (rfg : right_inverse f g) : left_inverse f g :=
  fun (y : β) =>
    exists.elim (surjf y) fun (x : α) (hx : f x = y) => Eq.trans (Eq.trans (hx ▸ rfl) (Eq.symm (rfg x) ▸ rfl)) hx

theorem injective_id {α : Sort u₁} : injective id :=
  fun (a₁ a₂ : α) (h : id a₁ = id a₂) => h

theorem surjective_id {α : Sort u₁} : surjective id :=
  fun (a : α) => Exists.intro a rfl

theorem bijective_id {α : Sort u₁} : bijective id :=
  { left := injective_id, right := surjective_id }

end function

namespace function

/-- Interpret a function on `α × β` as a function with two arguments. -/
def curry {α : Type u₁} {β : Type u₂} {φ : Type u₃} : (α × β → φ) → α → β → φ :=
  fun (f : α × β → φ) (a : α) (b : β) => f (a, b)

/-- Interpret a function with two arguments as a function on `α × β` -/
def uncurry {α : Type u₁} {β : Type u₂} {φ : Type u₃} : (α → β → φ) → α × β → φ :=
  fun (f : α → β → φ) (a : α × β) => f (prod.fst a) (prod.snd a)

@[simp] theorem curry_uncurry {α : Type u₁} {β : Type u₂} {φ : Type u₃} (f : α → β → φ) : curry (uncurry f) = f :=
  rfl

@[simp] theorem uncurry_curry {α : Type u₁} {β : Type u₂} {φ : Type u₃} (f : α × β → φ) : uncurry (curry f) = f := sorry

protected theorem left_inverse.id {α : Type u₁} {β : Type u₂} {g : β → α} {f : α → β} (h : left_inverse g f) : g ∘ f = id :=
  funext h

protected def right_inverse.id {α : Type u₁} {β : Type u₂} {g : β → α} {f : α → β} (h : right_inverse g f) : f ∘ g = id :=
  funext h


/-
When Lean starts, it automatically imports the contents of the library init folder, which includes a number of fundamental definitions and constructions. As a result, most of the examples we present here work “out of the box.”

If you want to use additional files, however, they need to be imported manually, via an import statement at the beginning of a file.
-/
import algebra
import data.real.basic
import data.vector
import tactic.explode
import tactic.find
import tactic.induction
import tactic.linarith
import tactic.rcases
import tactic.rewrite
import tactic.ring_exp
import tactic.tidy
import tactic.where
import topology.basic
import topology.category.Top
import category_theory.category.basic
import tactic.polyrith

namespace PROOFS

/-! ## Structured Proofs -/

notation `fix ` binders `, ` r:(scoped f, f) := r

/-! ## Logical Connectives -/

meta def tactic.dec_trivial := `[exact dec_trivial]

lemma not_def (a : Prop) :
  ¬ a ↔ a → false :=
by refl

@[simp] lemma not_not_iff (a : Prop) [decidable a] :
  ¬¬ a ↔ a :=
by by_cases a; simp [h]

@[simp] lemma and_imp_distrib (a b c : Prop) :
  (a ∧ b → c) ↔ (a → b → c) :=
iff.intro
  (assume h ha hb, h ⟨ha, hb⟩)
  (assume h ⟨ha, hb⟩, h ha hb)

@[simp] lemma or_imp_distrib {a b c : Prop} :
  a ∨ b → c ↔ (a → c) ∧ (b → c) :=
iff.intro
  (assume h,
   ⟨assume ha, h (or.intro_left _ ha), assume hb, h (or.intro_right _ hb)⟩)
  (assume ⟨ha, hb⟩ h, match h with or.inl h := ha h | or.inr h := hb h end)

@[simp] lemma exists_imp_distrib {α : Sort*} {p : α → Prop} {a : Prop} :
  ((∃x, p x) → a) ↔ (∀x, p x → a) :=
iff.intro
  (assume h hp ha, h ⟨hp, ha⟩)
  (assume h ⟨hp, ha⟩, h hp ha)

lemma and_exists {α : Sort*} {p : α → Prop} {a : Prop} :
  (a ∧ (∃x, p x)) ↔ (∃x, a ∧ p x) :=
iff.intro
  (assume ⟨ha, x, hp⟩, ⟨x, ha, hp⟩)
  (assume ⟨x, ha, hp⟩, ⟨ha, x, hp⟩)

@[simp] lemma exists_false {α : Sort*} :
  (∃x : α, false) ↔ false :=
iff.intro (assume ⟨a, f⟩, f) (assume h, h.elim)

/-! ## Natural Numbers -/

attribute [simp] nat.add

/-! ## Integers -/

@[simp] lemma int.neg_comp_neg :
  int.neg ∘ int.neg = id :=
begin
  apply funext,
  apply neg_neg
end

/-! ## Reflexive Transitive Closure -/

namespace rtc

inductive star {α : Sort*} (r : α → α → Prop) (a : α) : α → Prop
| refl {}    : star a
| tail {b c} : star b → r b c → star c

attribute [refl] star.refl

namespace star

variables {α : Sort*} {r : α → α → Prop} {a b c d : α}

@[trans] lemma trans (hab : star r a b) (hbc : star r b c) :
  star r a c :=
begin
  induction' hbc,
  case refl {
    assumption },
  case tail : c d hbc hcd hac {
    exact (tail (hac hab)) hcd }
end

lemma single (hab : r a b) :
  star r a b :=
refl.tail hab

lemma head (hab : r a b) (hbc : star r b c) :
  star r a c :=
begin
  induction' hbc,
  case refl {
    exact (tail refl) hab },
  case tail : c d hbc hcd hac {
    exact (tail (hac hab)) hcd }
end

lemma head_induction_on {α : Sort*} {r : α → α → Prop} {b : α}
  {P : ∀a : α, star r a b → Prop} {a : α} (h : star r a b)
  (refl : P b refl)
  (head : ∀{a c} (h' : r a c) (h : star r c b), P c h → P a (h.head h')) :
  P a h :=
begin
  induction' h,
  case refl {
    exact refl },
  case tail : b c hab hbc ih {
    apply ih,
    show P b _, from
      head hbc _ refl,
    show ∀a a', r a a' → star r a' b → P a' _ → P a _, from
      assume a a' hab hbc, head hab _ }
end

lemma trans_induction_on {α : Sort*} {r : α → α → Prop}
    {p : ∀{a b : α}, star r a b → Prop} {a b : α} (h : star r a b)
    (ih₁ : ∀a, @p a a refl) (ih₂ : ∀{a b} (h : r a b), p (single h))
    (ih₃ : ∀{a b c} (h₁ : star r a b) (h₂ : star r b c), p h₁ →
       p h₂ → p (h₁.trans h₂)) :
  p h :=
begin
  induction' h,
  case refl {
    exact ih₁ a },
  case tail : b c hab hbc ih {
    exact ih₃ hab (single hbc) (ih ih₁ @ih₂ @ih₃) (ih₂ hbc) }
end

lemma lift {β : Sort*} {s : β → β → Prop} (f : α → β)
  (h : ∀a b, r a b → s (f a) (f b)) (hab : star r a b) :
  star s (f a) (f b) :=
hab.trans_induction_on
  (assume a, refl)
  (assume a b, single ∘ h _ _)
  (assume a b c _ _, trans)

lemma mono {p : α → α → Prop} :
  (∀a b, r a b → p a b) → star r a b → star p a b :=
lift id

lemma star_star_eq :
  star (star r) = star r :=
funext
  (assume a,
   funext
     (assume b,
      propext (iff.intro
        (assume h,
         begin
           induction' h,
           { refl },
           { transitivity;
               assumption }
         end)
        (star.mono (assume a b,
           single)))))

end star

end rtc

export rtc

/-! ## States -/

def state : Type :=
string → ℕ

def state.update (name : string) (val : ℕ) (s : state) : state :=
λname', if name' = name then val else s name'

notation s `{` name ` ↦ ` val `}` := state.update name val s

instance : has_emptyc state :=
{ emptyc := λ_, 0 }

@[simp] lemma update_apply (name : string) (val : ℕ) (s : state) :
  s{name ↦ val} name = val :=
if_pos rfl

@[simp] lemma update_apply_ne (name name' : string) (val : ℕ) (s : state)
    (h : name' ≠ name . tactic.dec_trivial) :
  s{name ↦ val} name' = s name' :=
if_neg h

@[simp] lemma update_override (name : string) (val₁ val₂ : ℕ) (s : state) :
  s{name ↦ val₂}{name ↦ val₁} = s{name ↦ val₁} :=
begin
  apply funext,
  intro name',
  by_cases name' = name;
    simp [h]
end

@[simp] lemma update_swap (name₁ name₂ : string) (val₁ val₂ : ℕ) (s : state)
    (h : name₁ ≠ name₂ . tactic.dec_trivial) :
  s{name₂ ↦ val₂}{name₁ ↦ val₁} = s{name₁ ↦ val₁}{name₂ ↦ val₂} :=
begin
  apply funext,
  intro name',
  by_cases name' = name₁;
    by_cases name' = name₂;
    simp * at *
end

@[simp] lemma update_id (name : string) (s : state) :
  s{name ↦ s name} = s :=
begin
  apply funext,
  intro name',
  by_cases name' = name;
    simp * at *
end

@[simp] lemma update_same_const (name : string) (val : ℕ) :
  (λ_, val){name ↦ val} = (λ_, val) :=
by apply funext; simp

example (s : state) :
  s{"a" ↦ 0}{"a" ↦ 2} = s{"a" ↦ 2} :=
by simp

example (s : state) :
  s{"a" ↦ 0}{"b" ↦ 2} = s{"b" ↦ 2}{"a" ↦ 0} :=
by simp

example (s : state) :
  s{"a" ↦ s "a"}{"b" ↦ 0} = s{"b" ↦ 0} :=
by simp

/-! ## Relations -/

def Id {α : Type} : set (α × α) :=
{ab | prod.snd ab = prod.fst ab}

@[simp] lemma mem_Id {α : Type} (a b : α) :
  (a, b) ∈ @Id α ↔ b = a :=
by refl

def comp {α : Type} (r₁ r₂ : set (α × α)) : set (α × α) :=
{ac | ∃b, (prod.fst ac, b) ∈ r₁ ∧ (b, prod.snd ac) ∈ r₂}

infixl ` ◯ ` : 90 := comp

@[simp] lemma mem_comp {α : Type} (r₁ r₂ : set (α × α))
    (a b : α) :
  (a, b) ∈ r₁ ◯ r₂ ↔ (∃c, (a, c) ∈ r₁ ∧ (c, b) ∈ r₂) :=
by refl

def restrict {α : Type} (r : set (α × α)) (p : α → Prop) :
  set (α × α) :=
{ab | ab ∈ r ∧ p (prod.fst ab)}

infixl ` ⇃ ` : 90 := restrict

@[simp] lemma mem_restrict {α : Type} (r : set (α × α))
    (p : α → Prop) (a b : α) :
  (a, b) ∈ r ⇃ p ↔ (a, b) ∈ r ∧ p a :=
by refl

/-! ## Setoids -/

def equivalence_rel : Type → Type :=
setoid

end PROOFS


import recover

-- We are given two fields, `K` and `F`
variables {K F : Type*} [field K] [field F]

open module finite_dimensional
open_locale tensor_product

/-
NOTE: This introduces notation `[a]ₘ` for `a : Kˣ`, where `[a]ₘ` is the element of
the base-change `F ⊗[ℤ] (additive Kˣ)` corresponding to `a`.
-/
notation `[`:max a`]ₘ`:max := 1 ⊗ₜ (additive.of_mul a)

lemma one_tmul_mul (a b : Kˣ) : ([a * b]ₘ : F ⊗[ℤ] additive Kˣ) =
  [a]ₘ + [b]ₘ :=
tensor_product.tmul_add _ _ _

lemma one_tmul_inv (a : Kˣ) : ([a⁻¹]ₘ : F ⊗[ℤ] additive Kˣ) = - [a]ₘ :=
tensor_product.tmul_neg _ _

/-
We consider the weak topology on `dual F (F ⊗[ℤ] additive Kˣ)`.
This is just the pointwise convergence topology, i.e. the topology
induced by the product topology on the type of functions `F ⊗[ℤ] additive Kˣ → F`
where `F` is given the discrete topology.
-/
def module.dual.weak_topology :
  topological_space (dual F (F ⊗[ℤ] additive Kˣ)) :=
topological_space.induced (λ e a, e a) $
(@Pi.topological_space (F ⊗[ℤ] additive Kˣ) (λ _, F) $ λ a, ⊥)

/-
We only activate this topological space instance for this file.
-/
local attribute [instance]
  module.dual.weak_topology

/-
The converse to the main theorem about alternating pairs.
This is a simple result, and we prove it without many dependencies from the imports.
-/
theorem valuation_implies_alternating
  -- Given submodules `I` and `D` of `dual F (F ⊗[ℤ] additive Kˣ)`
  (D I : submodule F (dual F (F ⊗[ℤ] additive Kˣ)))
  -- which are closed with respect to the topology mentioned above,
  (hDclosed : is_closed (D : set (dual F (F ⊗[ℤ] additive Kˣ))))
  (hIclosed : is_closed (I : set (dual F (F ⊗[ℤ] additive Kˣ))))
  -- and a valuation ring of `K`
  (R : valuation_subring K)
  -- satisfying (1) `I ≤ D`;
  (le : I ≤ D)
  -- (2) the elements of `D` act trivially on `-1 : Kˣ`;
  (hnegone : ∀ (f : dual F (F ⊗[ℤ] additive Kˣ)) (hf : f ∈ D), f [-1]ₘ = 0)
  -- (3) the elements of `I` act trivially on the units of `R`;
  (units : ∀ (u : Kˣ) (hu : u ∈ R.unit_group)
    (f : dual F (F ⊗[ℤ] additive Kˣ))
    (hf : f ∈ I), f [u]ₘ = 0)
  -- (4) the elements of `D` act trivially on the principal units of `R`;
  (punits : ∀ (u : Kˣ) (hu : u ∈ R.principal_unit_group)
    (f : dual F (F ⊗[ℤ] additive Kˣ))
    (hf : f ∈ D), f [u]ₘ = 0)
  -- (5) `D/I` is finite dimensional;
  (fd : finite_dimensional F (↥D ⧸ I.comap D.subtype))
  -- (6) and `I` has codimension at most `1` in `D`,
  (codim : finrank F (↥D ⧸ I.comap D.subtype) ≤ 1) :
  -- then any pair of elements of `D` satisfies the alternating condition.
  ∀ (u v : Kˣ) (huv : (u : K) + v = 1)
    (f g : dual F (F ⊗[ℤ] additive Kˣ))
    (hf : f ∈ D) (hg : g ∈ D),
    f [u]ₘ * g [v]ₘ = f [v]ₘ * g [u]ₘ :=
begin
  intros u v huv f g hf hg,
  resetI, rw finrank_le_one_iff at codim,
  obtain ⟨⟨e,he⟩,hhe⟩ := codim,
  let f' : D := ⟨f,hf⟩,
  let g' : D := ⟨g,hg⟩,
  obtain ⟨cf,hcf⟩ := hhe (submodule.mkq _ f'),
  obtain ⟨cg,hcg⟩ := hhe (submodule.mkq _ g'),
  simp only [submodule.quotient.quot_mk_eq_mk, ← submodule.mkq_apply] at hcf hcg,
  rw [← sub_eq_zero, ← linear_map.map_smul, ← linear_map.map_sub,
    submodule.mkq_apply, submodule.quotient.mk_eq_zero] at hcf hcg,
  simp only [submodule.mem_comap, submodule.coe_subtype, submodule.coe_sub,
    submodule.coe_smul_of_tower, submodule.coe_mk] at hcg hcf,
  have hfI : ∀ (t : Kˣ) (ht : t ∈ R.unit_group), f [t]ₘ = cf • e [t]ₘ,
  { intros t ht, symmetry, rw ← sub_eq_zero,
    rw [← linear_map.smul_apply, ← linear_map.sub_apply], exact units t ht _ hcf },
  have hgI : ∀ (t : Kˣ) (ht : t ∈ R.unit_group),
    g [t]ₘ = cg • e [t]ₘ,
  { intros t ht, symmetry, rw ← sub_eq_zero,
    rw [← linear_map.smul_apply, ← linear_map.sub_apply], exact units t ht _ hcg },
  by_cases hunituv : u ∈ R.unit_group ∧ v ∈ R.unit_group,
  { cases hunituv with huu hvu,
    rw [hfI _ huu, hgI _ huu, hfI _ hvu, hgI _ hvu],
    simp_rw [smul_eq_mul], ring },
  push_neg at hunituv,
  by_cases huu : u ∈ R.unit_group,
  { have hvu : u ∈ R.principal_unit_group,
    { rw valuation_subring.mem_principal_unit_group_iff_mem,
      rw valuation_subring.mem_nonunits_iff_mem_and_nmem,
      rw valuation_subring.mem_unit_group_iff_mem_and_inv_mem at huu,
      split, exact R.sub_mem huu.1 R.one_mem,
      intro c, apply hunituv _,
      swap, rwa valuation_subring.mem_unit_group_iff_mem_and_inv_mem,
      obtain ⟨w,hw⟩ := c, convert R.neg_mem_units hw.1,
      ext, push_cast, rw hw.2, rw neg_sub, convert (congr_arg (λ e : K, e - u) huv), ring },
    rw [punits u hvu f hf, punits u hvu g hg, zero_mul, mul_zero] },
  rw valuation_subring.mem_unit_group_iff_mem_and_inv_mem at huu, push_neg at huu,
  by_cases huR : (u : K) ∈ R,
  { have hvu : v ∈ R.principal_unit_group,
    { rw valuation_subring.mem_principal_unit_group_iff_mem,
      rw valuation_subring.mem_nonunits_iff_mem_and_nmem,
      split, convert R.neg_mem _ huR, rwa [sub_eq_iff_eq_add, eq_neg_add_iff_add_eq],
      intro c, apply huu huR, obtain ⟨w,hw⟩ := c,
      have := (R.neg_mem_units hw.1), rw valuation_subring.mem_unit_group_iff_mem_and_inv_mem at this,
      convert this.2,
      ext, push_cast, rwa [hw.2, neg_sub, eq_sub_iff_add_eq] },
    rw [punits v hvu f hf, punits v hvu g hg, zero_mul, mul_zero] },
  { have huu : (u : K)⁻¹ ∈ R,
    { cases R.mem_or_inv_mem (u : K), contradiction, assumption },
    have huz : (u : K) ≠ 0,
    { intro c, apply huR, rw c, apply R.zero_mem },
    have huv' : -(u⁻¹ * v) ∈ R.principal_unit_group,
    { rw valuation_subring.mem_principal_unit_group_iff_mem,
      rw valuation_subring.mem_nonunits_iff_mem_and_nmem,
      split, push_cast, rw ← neg_add', apply R.neg_mem,
      have : (u : K) + v ∈ R, rw huv, apply R.one_mem,
      convert R.mul_mem _ _ huu this, field_simp, ring,
      intro c, apply huR,
      obtain ⟨w,hw1,hw2⟩ := c, push_cast at hw2, field_simp at hw2,
      rw [← neg_add', add_comm, huv] at hw2,
      have : (w : K) * u ∈ R, rw hw2, apply R.neg_mem, apply R.one_mem,
      erw valuation_subring.mem_unit_group_iff_mem_and_inv_mem at hw1,
      convert R.mul_mem _ _ this hw1.2, field_simp [w.ne_zero], ring },
    have hfuv : f [u]ₘ = f [v]ₘ,
    { symmetry, rw [← sub_eq_zero, ← f.map_sub, sub_eq_add_neg, ← one_tmul_inv,
        ← one_tmul_mul, mul_comm],
      have := punits _ huv' f hf,
      rwa [neg_eq_neg_one_mul, one_tmul_mul, f.map_add, hnegone f hf, zero_add] at this },
    have hguv : g [u]ₘ = g [v]ₘ,
    { symmetry, rw [← sub_eq_zero, ← g.map_sub, sub_eq_add_neg, ← one_tmul_inv,
        ← one_tmul_mul, mul_comm],
      have := punits _ huv' g hg,
      rwa [neg_eq_neg_one_mul, one_tmul_mul, g.map_add, hnegone g hg, zero_add] at this },
    simp only [hfuv, hguv, mul_comm] }
end


import .lang
import .forget
import .free_ralg
import .ualg

namespace lang_hom

variables {L0 : lang} {L1 : lang} (ι : L0 →# L1)
variables (A : Type*) [has_app L0 A]

-- goal is to construct the free has_app L1
-- compatible with the has_app L0

namespace fron -- ι.fron A
open lang
include ι
inductive rel : (L1.free A) → (L1.free A) → Prop
| of {n} (as : ftuple A n) (t : L0 n) :
    rel (applyo (ι t) (as.map (free.univ L1 A))) (free.univ L1 A (applyo t as))
| refl (a) : rel a a
| symm (a b) : rel a b → rel b a
| trans (a b c) : rel a b → rel b c → rel a c
| compat {n} {t : L1 n} {as bs : ftuple (L1.free A) n} :
    (∀ i, rel (as i) (bs i)) → rel (applyo t as) (applyo t bs)

def setoid : setoid (L1.free A) := ⟨rel ι A, rel.refl, rel.symm, rel.trans⟩
end fron

def fron := quotient (fron.setoid ι A)

namespace fron

instance : has_app L1 (ι.fron A) :=
{ app := λ n t, by letI := fron.setoid ι A; exact ftuple.quotient_lift
  (λ as, ⟦applyo t as⟧)
  (λ as bs hyp, quotient.sound $ rel.compat hyp) }

instance : compat ι (ι.fron A) := ι.forget_along (ι.fron A)

def quot : L1.free A →$[L1] (ι.fron A) :=
{ to_fn := by letI := fron.setoid ι A; exact λ a, ⟦a⟧,
  applyo_map' :=
  begin
    intros n t as,
    dsimp only [],
    letI := fron.setoid ι A,
    change ftuple.quotient_lift _ _ _ = _,
    rw ftuple.quotient_lift_beta,
  end }

def univ : A →$[L0] (ι.fron A) :=
{ to_fn := by letI := fron.setoid ι A; exact λ a, ⟦lang.free.univ L1 A a⟧,
  applyo_map' :=
  begin
    intros n t as,
    letI := fron.setoid ι A,
    dsimp only [],
    change applyo t ((as.map (lang.free.univ L1 A)).map (quot ι A)) = _,
    simp_rw compat.compat,
    rw ralg_hom.applyo_map,
    apply quotient.sound,
    apply rel.of,
  end }

variable {A}
def lift {B : Type*} [has_app L1 B] [compat ι B] (f : A →$[L0] B) :
  ι.fron A →$[L1] B :=
{ to_fn := by letI := fron.setoid ι A; exact quotient.lift (lang.free.lift L1 f)
  begin
    intros a b h,
    induction h,
    { change _ = f _,
      rw ←ralg_hom.applyo_map,
      rw [←ftuple.map_map,lang.free.univ_comp_lift],
      rw ←ralg_hom.applyo_map,
      rw compat.compat },
    repeat {cc},
    { dsimp only [] at h_ih,
      simp_rw ←ralg_hom.applyo_map,
      apply congr_arg,
      ext,
      apply h_ih},
  end,
  applyo_map' :=
  begin
    intros n t as,
    letI := fron.setoid ι A,
    dsimp only [],
    change _ = quotient.lift _ _ _,
    rcases ftuple.exists_rep as quotient.exists_rep with ⟨as,rfl⟩,
    change _ = quotient.lift _ _ (applyo  _ (as.map (quot ι A))),
    simp_rw ralg_hom.applyo_map,
    erw quotient.lift_beta,
    simp_rw ←ralg_hom.applyo_map,
    apply congr_arg,
    ext,
    simp only [ftuple.map_eval,quotient.lift_beta],
  end }

theorem univ_comp_lift {B : Type*} [has_app L1 B] [compat ι B] (f : A →$[L0] B) :
  (univ ι A).comp ((lift ι f).drop ι) = f :=
  by {ext, refl}

open lang
theorem lift_unique {B : Type*} [has_app L1 B] [compat ι B] (f : A →$[L0] B)
  (g : ι.fron A →$[L1] B) : (univ ι A).comp (g.drop ι) = f → g = lift ι f :=
begin
  intro hyp,
  ext,
  letI := fron.setoid ι A,
  have : ∃ y : L1.free A, (quot ι A) y = x, by apply quotient.exists_rep,
  rcases this with ⟨y,rfl⟩,
  change _ = free.lift _ _ y,
  induction y with _ n t as ind,
  { change _ = f y,
    rw ←hyp,
    refl },
  { change _ = (free.lift L1 f) (applyo t as),
    change g ( (quot ι A) (applyo t as)) = _,
    simp_rw ←ralg_hom.applyo_map,
    apply congr_arg,
    ext,
    apply ind }
end

end fron

end lang_hom


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

namespace Mathlib

namespace tactic.interactive

/--
`show_term { tac }` runs the tactic `tac`,
and then prints the term that was constructed.

This is useful for
* constructing term mode proofs from tactic mode proofs, and
* understanding what tactics are doing, and how metavariables are handled.

As an example, in
```
example {P Q R : Prop} (h₁ : Q → P) (h₂ : R) (h₃ : R → Q) : P ∧ R :=
by show_term { tauto }
```
the term mode proof `⟨h₁ (h₃ h₂), eq.mpr rfl h₂⟩` produced by `tauto` will be printed.

As another example, if the goal is `ℕ × ℕ`, `show_term { split, exact 0 }` will
print `refine (0, _)`, and afterwards there will be one remaining goal (of type `ℕ`).
This indicates that `split, exact 0` partially filled in the original metavariable,
but created a new metavariable for the resulting sub-goal.
-/