/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module topology.partial
! leanprover-community/mathlib commit 34ee86e6a59d911a8e4f89b68793ee7577ae79c7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.ContinuousOn
import Mathbin.Order.Filter.Partial

/-!
# Partial functions and topological spaces

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

In this file we prove properties of `filter.ptendsto` etc in topological spaces. We also introduce
`pcontinuous`, a version of `continuous` for partially defined functions.
-/

open Filter

open Topology

variable {α β : Type _} [TopologicalSpace α]

#print rtendsto_nhds /-
theorem rtendsto_nhds {r : Rel β α} {l : Filter β} {a : α} :
    Rtendsto r l (𝓝 a) ↔ ∀ s, IsOpen s → a ∈ s → r.Core s ∈ l :=
  all_mem_nhds_filter _ _ (fun s t => id) _
#align rtendsto_nhds rtendsto_nhds
-/

#print rtendsto'_nhds /-
theorem rtendsto'_nhds {r : Rel β α} {l : Filter β} {a : α} :
    Rtendsto' r l (𝓝 a) ↔ ∀ s, IsOpen s → a ∈ s → r.Preimage s ∈ l :=
  by
  rw [rtendsto'_def]
  apply all_mem_nhds_filter
  apply Rel.preimage_mono
#align rtendsto'_nhds rtendsto'_nhds
-/

#print ptendsto_nhds /-
theorem ptendsto_nhds {f : β →. α} {l : Filter β} {a : α} :
    Ptendsto f l (𝓝 a) ↔ ∀ s, IsOpen s → a ∈ s → f.Core s ∈ l :=
  rtendsto_nhds
#align ptendsto_nhds ptendsto_nhds
-/

#print ptendsto'_nhds /-
theorem ptendsto'_nhds {f : β →. α} {l : Filter β} {a : α} :
    Ptendsto' f l (𝓝 a) ↔ ∀ s, IsOpen s → a ∈ s → f.Preimage s ∈ l :=
  rtendsto'_nhds
#align ptendsto'_nhds ptendsto'_nhds
-/

/-! ### Continuity and partial functions -/

variable [TopologicalSpace β]

#print Pcontinuous /-
/-- Continuity of a partial function -/
def Pcontinuous (f : α →. β) :=
  ∀ s, IsOpen s → IsOpen (f.Preimage s)
#align pcontinuous Pcontinuous
-/

/- warning: open_dom_of_pcontinuous -> open_dom_of_pcontinuous is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β] {f : PFun.{u1, u2} α β}, (Pcontinuous.{u1, u2} α β _inst_1 _inst_2 f) -> (IsOpen.{u1} α _inst_1 (PFun.Dom.{u1, u2} α β f))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β] {f : PFun.{u2, u1} α β}, (Pcontinuous.{u2, u1} α β _inst_1 _inst_2 f) -> (IsOpen.{u2} α _inst_1 (PFun.Dom.{u2, u1} α β f))
Case conversion may be inaccurate. Consider using '#align open_dom_of_pcontinuous open_dom_of_pcontinuousₓ'. -/
theorem open_dom_of_pcontinuous {f : α →. β} (h : Pcontinuous f) : IsOpen f.Dom := by
  rw [← PFun.preimage_univ] <;> exact h _ isOpen_univ
#align open_dom_of_pcontinuous open_dom_of_pcontinuous

/- warning: pcontinuous_iff' -> pcontinuous_iff' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β] {f : PFun.{u1, u2} α β}, Iff (Pcontinuous.{u1, u2} α β _inst_1 _inst_2 f) (forall {x : α} {y : β}, (Membership.Mem.{u2, u2} β (Part.{u2} β) (Part.hasMem.{u2} β) y (f x)) -> (Filter.Ptendsto'.{u1, u2} α β f (nhds.{u1} α _inst_1 x) (nhds.{u2} β _inst_2 y)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β] {f : PFun.{u2, u1} α β}, Iff (Pcontinuous.{u2, u1} α β _inst_1 _inst_2 f) (forall {x : α} {y : β}, (Membership.mem.{u1, u1} β (Part.{u1} β) (Part.instMembershipPart.{u1} β) y (f x)) -> (Filter.Ptendsto'.{u2, u1} α β f (nhds.{u2} α _inst_1 x) (nhds.{u1} β _inst_2 y)))
Case conversion may be inaccurate. Consider using '#align pcontinuous_iff' pcontinuous_iff'ₓ'. -/
theorem pcontinuous_iff' {f : α →. β} :
    Pcontinuous f ↔ ∀ {x y} (h : y ∈ f x), Ptendsto' f (𝓝 x) (𝓝 y) :=
  by
  constructor
  · intro h x y h'
    simp only [ptendsto'_def, mem_nhds_iff]
    rintro s ⟨t, tsubs, opent, yt⟩
    exact ⟨f.preimage t, PFun.preimage_mono _ tsubs, h _ opent, ⟨y, yt, h'⟩⟩
  intro hf s os
  rw [isOpen_iff_nhds]
  rintro x ⟨y, ys, fxy⟩ t
  rw [mem_principal]
  intro (h : f.preimage s ⊆ t)
  change t ∈ 𝓝 x
  apply mem_of_superset _ h
  have h' : ∀ s ∈ 𝓝 y, f.preimage s ∈ 𝓝 x := by
    intro s hs
    have : ptendsto' f (𝓝 x) (𝓝 y) := hf fxy
    rw [ptendsto'_def] at this
    exact this s hs
  show f.preimage s ∈ 𝓝 x
  apply h'
  rw [mem_nhds_iff]
  exact ⟨s, Set.Subset.refl _, os, ys⟩
#align pcontinuous_iff' pcontinuous_iff'

/- warning: continuous_within_at_iff_ptendsto_res -> continuousWithinAt_iff_ptendsto_res is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β] (f : α -> β) {x : α} {s : Set.{u1} α}, Iff (ContinuousWithinAt.{u1, u2} α β _inst_1 _inst_2 f s x) (Filter.Ptendsto.{u1, u2} α β (PFun.res.{u1, u2} α β f s) (nhds.{u1} α _inst_1 x) (nhds.{u2} β _inst_2 (f x)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β] (f : α -> β) {x : α} {s : Set.{u2} α}, Iff (ContinuousWithinAt.{u2, u1} α β _inst_1 _inst_2 f s x) (Filter.Ptendsto.{u2, u1} α β (PFun.res.{u2, u1} α β f s) (nhds.{u2} α _inst_1 x) (nhds.{u1} β _inst_2 (f x)))
Case conversion may be inaccurate. Consider using '#align continuous_within_at_iff_ptendsto_res continuousWithinAt_iff_ptendsto_resₓ'. -/
theorem continuousWithinAt_iff_ptendsto_res (f : α → β) {x : α} {s : Set α} :
    ContinuousWithinAt f s x ↔ Ptendsto (PFun.res f s) (𝓝 x) (𝓝 (f x)) :=
  tendsto_iff_ptendsto _ _ _ _
#align continuous_within_at_iff_ptendsto_res continuousWithinAt_iff_ptendsto_res


/-
The Sinz at-most-one encoding.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import data.list.basic
import cnf.cnf
import cnf.gensym
import cnf.encoding
import cardinality.distinct
import cardinality.amk
import cardinality.alk

variables {V : Type*} [inhabited V] [decidable_eq V]

namespace sinz_amk

open list
open literal
open cnf
open clause
open assignment
open distinct
open prod
open gensym
open encoding
open amk
open alk
open nat

def S (g : gensym V) (l : list (literal V)) (r c : nat) : V :=
  g.nth ((r * length l) + c)

theorem S_not_mem_vars {g : gensym V} {l : list (literal V)}
  (hdis : disjoint g.stock (clause.vars l)) :
  ∀ (r c : nat), S g l r c ∉ clause.vars l :=
begin
  intros r c,
  rw S,
  have h₁ := set.disjoint_left.mp hdis,
  have h₂ := (nth_mem_stock g (r * length l + c)),
  exact h₁ h₂
end

def signal_row_prop (k : nat) (g : gensym V) (l : list (literal V)) (r c : nat) : cnf V :=
  ite (r < k + 1 ∧ c < length l - 1)
  [[Neg (S g l r c), Pos (S g l r (c + 1))]] []

def first_prop (g : gensym V) (l : list (literal V)) (r c : nat) : cnf V :=
  if hidx : (r = 0 ∧ c < length l) then
    [[(l.nth_le c hidx.2).flip, Pos (S g l 0 c)]]
  else []

def inc_prop (k : nat) (g : gensym V) (l : list (literal V)) (r c : nat) : cnf V :=
  if hidx : (r < k ∧ c < length l - 1 ∧ c + 1 < length l) then
    [[(l.nth_le (c + 1) hidx.2.2).flip, Neg (S g l r c), Pos (S g l (r + 1) (c + 1))]]
  else []

def sinz_amk (k : nat) (g : gensym V) (l : list (literal V)) : cnf V :=
if k ≤ 1 ∨ length l ≤ k then [] else
join ((range (k + 1)).map (λ i, join
    ((range (length l)).map (λ j,
      signal_row_prop k g l i j ++
      first_prop g l i j ++
      inc_prop k g l i j))
  )) ++ [[Neg (S g l k (length l - 1))]]

lemma helper {k c n : nat} : 1 < k → k < n → c < n - 1 → c < n :=
begin
  intros hk hn hc,
  rcases exists_eq_add_of_lt (lt_trans hk hn) with ⟨m, hm⟩,
  subst hm,
  simp at hc,
  exact lt_succ_of_lt hc
end

theorem signal_row_prop_mem {k r c : nat} {l : list (literal V)}
  (hk : k > 1) (hl : length l > k) (g : gensym V)
  (hr : r < k + 1) (hc : c < length l - 1) :
  [Neg (S g l r c), Pos (S g l r (c + 1))] ∈ sinz_amk k g l :=
begin
  rw sinz_amk,
  simp [not_le.mpr hl, not_le.mpr hk],
  use [r, hr, c, helper hk hl hc],
  left,
  rw signal_row_prop,
  simp [hr, hc]
end

theorem first_prop_mem {k c : nat} {l : list (literal V)}
  (hk : k > 1) (hl : length l > k) (g : gensym V)
  (hc : c < length l) :
  [(l.nth_le c hc).flip, Pos (S g l 0 c)] ∈ sinz_amk k g l :=
begin
  rw sinz_amk,
  simp [not_le.mpr hl, not_le.mpr hk],
  use 0,
  simp,
  use [c, hc],
  right, left,
  rw first_prop,
  simp [hc]
end

theorem inc_prop_mem {k r c : nat} {l : list (literal V)}
  (hk : k > 1) (hl : length l > k) (g : gensym V)
  (hr : r < k) (hc₁ : c < length l - 1) (hc₂ : c + 1 < length l) :
  [(l.nth_le (c + 1) hc₂).flip, Neg (S g l r c), Pos (S g l (r + 1) (c + 1))] ∈ sinz_amk k g l :=
begin
  rw sinz_amk,
  simp [not_le.mpr hk, not_le.mpr hl],
  use [r, lt_succ_of_lt hr, c, lt_of_succ_lt hc₂],
  right, right,
  rw inc_prop,
  simp [hr, hc₁, hc₂]
end

-- First arg is row, second is col in (k + 1) × |l| matrix
def signal_truth (l : list (literal V))
  (g : gensym V) (τ : assignment V) : nat → nat → bool
| 0       0       := l.head.eval τ
| 0       (c + 1) := if h : (c + 1) < length l then
                      (l.nth_le (c + 1) h).eval τ || signal_truth 0 c
                     else ff
| (r + 1) 0       := ff
| (r + 1) (c + 1) := if h : (c + 1) < length l then
                      ((l.nth_le (c + 1) h).eval τ ∧ signal_truth r c) ||
                       signal_truth (r + 1) c
                     else ff

def rc_from_var (l : list (literal V)) (g : gensym V) (v : V) : nat → nat → (nat × nat)
| 0       0       := ⟨0, 0⟩
| 0       (c + 1) := if v = g.nth (c + 1) then ⟨0, c + 1⟩ else rc_from_var 0 c
| (r + 1) 0       := if v = g.nth ((r + 1) * length l) then ⟨r + 1, 0⟩
                     else rc_from_var r (length l - 1)
| (r + 1) (c + 1) := if v = g.nth ((r + 1) * length l + c + 1) then ⟨r + 1, c + 1⟩
                     else rc_from_var (r + 1) c

def sinz_tau (k : nat) (l : list (literal V))
  (g : gensym V) (τ : assignment V) : assignment V :=
  λ v, if v ∈ clause.vars l then τ v else
         signal_truth l g τ (rc_from_var l g v k (length l - 1)).1 (rc_from_var l g v k (length l - 1)).2

lemma help {a b c : nat} : b ≤ c → a + b ≤ a + c :=
begin
  exact (add_le_add_iff_left a).mpr
end

theorem rc_helper {r r' c c' : nat} (g : gensym V) {l : list (literal V)} :
  r ≤ r' → c < length l → c' < length l →
  (r = r' → c ≤ c') →
  rc_from_var l g (S g l r c) r' c' = ⟨r, c⟩ :=
begin
  intros hr hc hc' hreq,
  have hrc : (r * length l + c) ≤ (r' * length l + c'),
  { rcases eq_or_lt_of_le hr with ⟨rfl | hr⟩,
    { exact add_le_add_left (hreq h) _ },
    { rcases exists_eq_add_of_lt h with ⟨m, hm⟩,
      simp [hm, add_mul, add_assoc],
      rw [add_comm, add_assoc],
      exact le_add_right (le_of_lt hc) } },
  induction r' with r' ihr generalizing c',
  { simp at hr,
    subst hr,
    induction c' with c' ihc; simp at hrc,
    { subst hrc,
      simp [rc_from_var] },
    { rcases eq_or_lt_of_le hrc with (rfl | hrc),
      { simp [rc_from_var, S] },
      { simp at ihc,
        rw ← ihc (lt_of_succ_lt hc') (le_of_lt_succ hrc) (le_of_lt_succ hrc),
        have : c ≠ c' + 1, from ne_of_lt hrc,
        simp [rc_from_var, S, nth_ne_of_ne this] } } },
  { rcases eq_or_lt_of_le hr with (rfl | hr),
    { induction c' with c' ihc;
      simp at hrc,
      { simp [rc_from_var, hrc, S] },
      { have ihred := ihc (lt_of_succ_lt hc'),
        simp at ihred,
        rcases eq_or_lt_of_le hrc with (rfl | hrc),
        { simp [rc_from_var, S, add_assoc] },
        { rw ← ihred (le_of_lt_succ hrc),
          have : (r' + 1) * l.length + c ≠ (r' + 1) * l.length + c' + 1,
          { intro heq,
            rw add_assoc at heq,
            have := add_left_cancel heq,
            rw this at hrc,
            exact nat.lt_asymm hrc hrc },
          simp [rc_from_var, S, nth_ne_of_ne this], exact le_of_lt_succ hrc } } },
    { have hlen : length l - 1 < length l,
      { cases l with l₁ ls,
        { simp at hc', contradiction },
        { simp } },
      have : c ≤ length l - 1,
      { cases l with l₁ ls,
        { simp at hc, contradiction },
        { simp at hc |-, exact le_of_lt_succ hc } },
      have ihred := ihr (le_of_lt_succ hr) hlen (imp_intro this),
      induction c' with c' ihc,
      { have : r * l.length + c ≠ (r' + 1) * l.length,
        { rcases exists_eq_add_of_lt hr with ⟨m, hm⟩,
          intro heq,
          simp [← succ_eq_add_one, hm] at heq,
          rw [succ_mul, add_mul, add_assoc] at heq,
          have heqc := add_left_cancel_iff.mp heq,
          have : l.length ≤ m * l.length + l.length, from le_add_self,
          have := lt_of_lt_of_le hc this,
          exact absurd heqc (ne_of_lt this) },
        simp [rc_from_var, S, nth_ne_of_ne this],
        rw ← S,
        apply ihred,
        have h₁ : r * l.length ≤ r' * l.length,
        { exact nat.mul_le_mul_right _ (le_of_lt_succ hr) },
        have h₂ : c ≤ l.length - 1,
        { cases l with l₁ ls,
          { simp at hc, contradiction },
          { simp at hc, exact le_of_lt_succ hc } },
        exact add_le_add h₁ h₂, },
      { have : r * l.length + c ≤ (r' + 1) * l.length + c',
        { rw [add_mul, add_assoc],
          apply add_le_add,
          { exact nat.mul_le_mul_right _ (le_of_lt_succ hr) },
          { rw one_mul,
            exact le_add_right (le_of_lt hc) } },
        have himp : r = r' + 1 → c ≤ c',
        { rintro rfl,
          exact (add_le_add_iff_left ((r' + 1) * l.length)).mp this },
        rw ← ihc (lt_of_succ_lt hc') himp,
        have : r * l.length + c ≠ (r' + 1) * l.length + c' + 1,
        { exact ne_of_lt (lt_succ_of_le this) },
        simp [rc_from_var, S, nth_ne_of_ne this], exact this } } }
end

theorem rc_helper' {r r' c c' : nat} (g : gensym V) {l : list (literal V)} :
  r ≤ r' → c < length l → c' < length l → c ≤ c' →
  rc_from_var l g (S g l r c) r' c' = ⟨r, c⟩ :=
assume hr hc hc' hle, rc_helper g hr hc hc' (imp_intro hle)

-- Forward direction --
lemma sub_helper {n m : nat} : n < m → m - 1 < m :=
begin
  intro h,
  cases m,
  { simp at h, contradiction },
  { simp, exact lt_succ_self m }
end

theorem signal_semantics {k r c : nat} (hk : k > 1) {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l))
  (hr : r < k + 1) (hc : c < length l) :
  ∀ {τ : assignment V},
  (signal_truth l g τ r c) = tt ↔ (alk.eval (r + 1) τ (l.take (c + 1))) = tt :=
begin
  intro τ,
  induction r with r ihr generalizing c,
  { induction c with c ihc,
    { simp [signal_truth, take_one_of_ne_nil (ne_nil_of_length_pos hc),
        alk.eval, alk, bool_symm] },
    { simp [signal_truth, hc],
      split,
      { rintros (hs | hs),
        { rw eval_take_tail_pos hc hs,
          exact eval_zero _ _ },
        { have ihred := (ihc (lt_of_succ_lt hc)).mp hs,
          have := take_sublist_of_le (le_succ (c + 1)) l,
          exact eval_tt_of_sublist_of_eval_tt this ihred } },
      { intro hl,
        cases h : (l.nth_le (c + 1) _).eval τ,
        { rw eval_take_tail_neg hc h at hl,
          exact or.inr ((ihc (lt_of_succ_lt hc)).mpr hl) },
        { simp only [eq_self_iff_true, true_or] } } } },
  {
    induction c with c ihc,
    { simp [signal_truth, take_one_of_ne_nil (ne_nil_of_length_pos hc),
        alk.eval, alk, bool_symm],
      cases h : literal.eval τ l.head; { simp } },
    {
      simp [signal_truth, hc],
      split,
      { rintros (⟨hs₁, hs₂⟩ | hs),
        { rw eval_take_tail_pos hc hs₁,
          exact (ihr (lt_of_succ_lt hr) (lt_of_succ_lt hc)).mp hs₂ },
        { have ihred := (ihc (lt_of_succ_lt hc)).mp hs,
          have : take (c + 1) l <+ take (c + 1 + 1) l,
          { exact take_sublist_of_le (le_succ (c + 1)) _ },
          exact eval_tt_of_sublist_of_eval_tt this ihred } },
      { intro hl,
        cases h : (l.nth_le (c + 1) _).eval τ,
        { rw eval_take_tail_neg hc h at hl,
          exact or.inr ((ihc (lt_of_succ_lt hc)).mpr hl) },
        { rw eval_take_tail_pos hc h at hl,
          exact or.inl ⟨rfl, (ihr (lt_of_succ_lt hr) (lt_of_succ_lt hc)).mpr hl⟩ } } } }
end

theorem sr_eval_tt_st {k r c : nat} (hk : k > 1) {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l))
  (hr : r < k + 1) (hc : c < length l - 1) :
  ∀ (τ : assignment V), (signal_row_prop k g l r c).eval (sinz_tau k l g τ) = tt :=
begin
  intro τ,
  rw eval_tt_iff_forall_clause_eval_tt,
  intros cl hcl,
  simp [signal_row_prop, hr, hc] at hcl,
  subst hcl,
  rw eval_tt_iff_exists_literal_eval_tt,
  cases hs : (sinz_tau k l g τ) (S g l r c),
  { use Neg (S g l r c), simp [literal.eval, hs] },
  { use Pos (S g l r (c + 1)),
    have hc' : c + 1 < length l,
    { cases l with l₁ ls,
      { simp at hc, contradiction },
      { cases ls with l₂ ls,
        { simp at hc, contradiction },
        { simp at hc, simp [hc] } } },
    have hc'' : c < length l, from lt_of_succ_lt hc',
    have hc''' : c + 1 ≤ length l - 1,
    { cases l with l₁ ls,
      { simp at hc'', contradiction },
      { simp at hc' |-, exact succ_le_of_lt hc' } },
    simp [literal.eval, sinz_tau, S_not_mem_vars hdis,
      rc_helper g (le_of_lt_succ hr) hc' (sub_helper hc'') (imp_intro hc''')],
    simp [sinz_tau, S_not_mem_vars hdis] at hs,
    rw rc_helper g (le_of_lt_succ hr) hc'' (sub_helper hc'')
      (imp_intro (le_of_succ_le hc''')) at hs,
    simp at hs,
    cases r; { simp [signal_truth, hc'], exact or.inr hs } }
end

theorem fp_eval_tt_st {k r c : nat} (hk : k > 1) {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l))
  (hr : r < k + 1) (hc : c < length l) :
  ∀ (τ : assignment V), (first_prop g l r c).eval (sinz_tau k l g τ) = tt :=
begin
  intro τ,
  rw eval_tt_iff_forall_clause_eval_tt,
  intros cl hcl,
  cases r,
  { simp [first_prop, hc] at hcl,
    subst hcl,
    rw eval_tt_iff_exists_literal_eval_tt,
    cases hl : (l.nth_le c hc).eval τ,
    { use (l.nth_le c hc).flip,
      have hmem := mem_vars_of_mem (nth_le_mem l c hc),
      cases l.nth_le c hc;
      { rw var at hmem,
        rw literal.eval at hl,
        simp [eval_flip, hl, sinz_tau, literal.eval, hmem] } },
    { use Pos (S g l 0 c),
      simp [literal.eval, sinz_tau, S_not_mem_vars hdis],
      have : c ≤ length l - 1,
      { cases l with l₁ ls,
        { simp at hc, contradiction },
        { simp at hc |-, exact le_of_lt_succ hc } },
      rw rc_helper g (le_of_lt_succ hr) hc (sub_helper hc) (imp_intro this),
      cases c,
      { rw signal_truth,
        rw nth_le_zero at hl,
        exact hl },
      { rw signal_truth,
        simp [hc], exact or.inl hl } } },
  { simp [first_prop, hc] at hcl, contradiction }
end

theorem ip_eval_tt_st {k r c : nat} (hk : k > 1) {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l))
  (hr : r < k) (hc : c < length l - 1) :
  ∀ (τ : assignment V), (inc_prop k g l r c).eval (sinz_tau k l g τ) = tt :=
begin
  intro τ,
  rw eval_tt_iff_forall_clause_eval_tt,
  intros cl hcl,
  rw inc_prop at hcl,
  have hc' : c + 1 < length l,
  { cases l with l₁ ls,
    { simp at hc, contradiction },
    { cases ls with l₂ ls,
      { simp at hc, contradiction },
      { simp at hc, simp [hc] } } },
  simp [hr, hc, hc'] at hcl,
  subst hcl,
  rw eval_tt_iff_exists_literal_eval_tt,
  cases hs₁ : (l.nth_le _ hc').eval (sinz_tau k l g τ),
  { use (l.nth_le _ hc').flip,
    simp [eval_flip, hs₁] },
  { cases hs₂ : (sinz_tau k l g τ) (S g l r c),
    { use Neg (S g l r c), simp [literal.eval, hs₂] },
    { use Pos (S g l (r + 1) (c + 1)),
      have hmem := mem_vars_of_mem (nth_le_mem l _ hc'),
      simp [literal.eval, hs₂],
      simp [sinz_tau, S_not_mem_vars hdis] at hs₂ |-,
      rw rc_helper g (le_of_lt hr) (lt_of_succ_lt hc') (sub_helper hc')
         (imp_intro (le_of_lt hc)) at hs₂,
      simp at hs₂,
      have : c + 1 ≤ length l - 1,
      { cases l with l₁ ls,
        { simp at hc', contradiction },
        { simp at hc |-, exact succ_le_of_lt hc } },
      rw rc_helper g (succ_le_of_lt hr) hc' (sub_helper hc') (imp_intro this),
      rw signal_truth,
      simp [hc'],
      cases l.nth_le _ hc';
      { rw var at hmem,
        simp [sinz_tau, literal.eval, hmem] at hs₁,
        simp [literal.eval],
        exact or.inl ⟨hs₁, hs₂⟩ } } }
end

theorem sinz_forward {k : nat} (hk : k > 1) {τ} {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l)) :
  amk.eval k τ l = tt → (sinz_amk k g l).eval (sinz_tau k l g τ) = tt :=
begin
  intro hmk,
  rw eval_tt_iff_forall_clause_eval_tt,
  intros cl hcl,
  by_cases hl : length l > k,
  { simp [sinz_amk, not_le.mpr hk, not_le.mpr hl] at hcl,
    rcases hcl with (⟨r, hr, c, hc, hmem⟩ | rfl),
    { rcases hmem with (hmem | hmem | hmem),
      { by_cases hc' : c < length l - 1,
        { have := sr_eval_tt_st hk hdis hr hc' τ,
          exact eval_tt_iff_forall_clause_eval_tt.mp this _ hmem },
        { simp [signal_row_prop, hr, hc'] at hmem, contradiction } },
      { have := fp_eval_tt_st hk hdis hr hc τ,
        exact eval_tt_iff_forall_clause_eval_tt.mp this _ hmem },
      { by_cases hc' : c < length l - 1,
        { by_cases hr' : r < k,
          { have := ip_eval_tt_st hk hdis hr' hc' τ,
          exact eval_tt_iff_forall_clause_eval_tt.mp this _ hmem },
          { simp [inc_prop, hr'] at hmem, contradiction } },
        { simp [inc_prop, hc'] at hmem, contradiction } } },
    { have : length l - 1 < length l,
      { rcases exists_eq_add_of_lt (lt_trans hk hl) with ⟨m, hm⟩,
        simp [hm] },
      simp [eval_tt_iff_exists_literal_eval_tt, literal.eval,
        sinz_tau, S_not_mem_vars hdis],
      rw rc_helper g (le_refl k) this this (imp_intro (le_refl _)),
      rw amk_eval_eq_alk_succ_eval at hmk,
      simp at hmk,
      have hmt := mt (signal_semantics hk hdis (lt_succ_self k) this).mp,
      have : length l - 1 + 1 = length l,
      { rcases exists_eq_add_of_lt (lt_trans hk hl) with ⟨m, hm⟩,
        simp [hm] },
      simp [this] at hmt,
      exact hmt hmk } },
  { simp [sinz_amk, not_lt.mp hl] at hcl, contradiction }
end

-- Reverse direction --

theorem sr_eval_tt {τ} {k r c : nat} {g : gensym V} {l : list (literal V)}
  (hk : k > 1) (hl : length l > k)
  (hdis : disjoint g.stock (clause.vars l))
  (hr : r < k + 1) (hc : c < length l - 1) :
  (sinz_amk k g l).eval τ = tt →
  τ (S g l r c) = tt → ∀ {c₂ : nat}, (c₂ > c ∧ c₂ < length l) → τ (S g l r c₂) = tt :=
begin
  rintros hs ht c₂ ⟨hgt, hcl⟩,
  induction c₂ with c₂ ih,
  { linarith },
  { by_cases hcc : c = c₂,
    { subst hcc,
      have := signal_row_prop_mem hk hl g hr hc,
      have := eval_tt_iff_forall_clause_eval_tt.mp hs _ this,
      simp [eval_tt_iff_exists_literal_eval_tt] at this,
      rcases this with (hl | hl),
      { rw [literal.eval, ht] at hl, contradiction },
      { rw literal.eval at hl, exact hl } },
    { have := lt_of_le_of_ne (le_of_lt_succ hgt) hcc,
      have ihred := ih this (lt_of_succ_lt hcl),
      have : c₂ < l.length - 1,
      { rcases exists_eq_add_of_lt (lt_trans hk hl) with ⟨m, hm⟩,
        simp [hm] at hcl |-,
        exact succ_lt_succ_iff.mp hcl },
      have := signal_row_prop_mem hk hl g hr this,
      have := eval_tt_iff_forall_clause_eval_tt.mp hs _ this,
      simp [eval_tt_iff_exists_literal_eval_tt] at this,
      rcases this with (hl | hl),
      { simp [literal.eval, ihred] at hl, contradiction },
      { rw [literal.eval] at hl, exact hl } } }
end

theorem fp_eval_tt {τ} {k r c : nat} {g : gensym V} {l : list (literal V)}
  (hk : k > 1) (hl : length l > k)
  (hdis : disjoint g.stock (clause.vars l))
  (hr : r < k + 1) (hc : c < length l) :
  (sinz_amk k g l).eval τ = tt →
  alk.eval (r + 1) τ (l.take (c + 1)) = tt → τ (S g l r c) = tt :=
begin
  intros hs hlk,
  induction c with c ih generalizing r,
  { cases l with l ls,
    { rw length at hc, exact absurd hc (gt_irrefl _) },
    { simp [alk.eval, alk] at hlk,
      cases hlit : l.eval τ,
      { simp [hlit] at hlk, contradiction },
      { simp [hlit] at hlk,
        subst hlk,
        rw eval_tt_iff_forall_clause_eval_tt at hs,
        have := hs _ (first_prop_mem hk hl g hc),
        simp [eval_tt_iff_exists_literal_eval_tt] at this,
        rcases this with (hl | hl),
        { rw [eval_flip, hlit] at hl, contradiction },
        { rw literal.eval at hl, exact hl } } } },
  { have hc' : c < length l - 1,
    { rcases exists_eq_add_of_lt (lt_trans hk hl) with ⟨m, hm⟩,
      simp [hm] at hc |-,
      exact succ_lt_succ_iff.mp hc },
    cases hx : literal.eval τ (l.nth_le _ hc),
    { rw eval_take_tail_neg hc hx at hlk,
      have ihred := ih (lt_of_succ_lt hc) hr hlk,
      exact sr_eval_tt hk hl hdis hr hc' hs ihred ⟨lt_succ_self c, hc⟩ },
    { rw eval_take_tail_pos hc hx at hlk,
      rw eval_tt_iff_forall_clause_eval_tt at hs,
      cases r,
      { have := hs _ (first_prop_mem hk hl g hc),
        simp [eval_tt_iff_exists_literal_eval_tt] at this,
        rcases this with (hl | hl),
        { simp [eval_flip, hx] at hl, contradiction },
        { rw literal.eval at hl, exact hl } },
      { have ihred := ih (lt_of_succ_lt hc) (lt_of_succ_lt hr) hlk,
        have := hs _ (inc_prop_mem hk hl g (succ_lt_succ_iff.mp hr) hc' hc),
        simp [eval_tt_iff_exists_literal_eval_tt] at this,
        rcases this with (hl | hl | hl),
        { rw [eval_flip, hx] at hl, contradiction },
        { rw [literal.eval, ihred] at hl, contradiction },
        { rw literal.eval at hl, exact hl } } } }
end

theorem sinz_reverse {k : nat} (hk : k > 1) {τ} {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l)) :
  (sinz_amk k g l).eval τ = tt → amk.eval k τ l = tt :=
begin
  intro hs,
  have hs_copy := hs,
  by_cases hl : length l > k,
  { simp [sinz_amk, not_le.mpr hk, not_le.mpr hl,
      eval_tt_iff_forall_clause_eval_tt] at hs,
    have := hs _ (or.inr rfl),
    simp [eval_tt_iff_exists_literal_eval_tt, literal.eval] at this,
    have hl' : length l - 1 < length l,
    { rcases exists_eq_add_of_lt (lt_trans hk hl) with ⟨m, hm⟩,
      simp [hm] },
    have hl'' : length l - 1 + 1 = length l,
    { rcases exists_eq_add_of_lt (lt_trans hk hl) with ⟨m, hm⟩,
      simp [hm] },
    have hmt := mt (fp_eval_tt hk hl hdis (lt_succ_self k) hl' hs_copy),
    simp at hmt,
    have := hmt this,
    simp [hl''] at this,
    have hamkalk := amk_eval_eq_alk_succ_eval k τ l,
    rw [this, bool.bnot_ff] at hamkalk,
    exact hamkalk },
  { exact eval_tt_of_ge_length (not_lt.mp hl) _ }
end

theorem sinz_amk_encodes_amk {k : nat} (hk : k > 1) {l : list (literal V)} {g : gensym V}
  (hdis : disjoint g.stock (clause.vars l)) :
  encodes (amk k) (sinz_amk k g l) l :=
begin
  intro τ, split,
  { intro hmk,
    use sinz_tau k l g τ,
    split,
    { exact sinz_forward hk hdis hmk },
    { intros v hv, simp [sinz_tau, hv] } },
  { rintros ⟨σ, hs, heqod⟩,
    rw [← amk.eval, eval_eq_amk_of_eqod _ heqod],
    exact sinz_reverse hk hdis hs }
end

end sinz_amk


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll, Frédéric Dupuis, Heather Macbeth

! This file was ported from Lean 3 source module analysis.inner_product_space.symmetric
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Basic
import Mathbin.Analysis.NormedSpace.Banach
import Mathbin.LinearAlgebra.SesquilinearForm

/-!
# Symmetric linear maps in an inner product space

This file defines and proves basic theorems about symmetric **not necessarily bounded** operators
on an inner product space, i.e linear maps `T : E → E` such that `∀ x y, ⟪T x, y⟫ = ⟪x, T y⟫`.

In comparison to `is_self_adjoint`, this definition works for non-continuous linear maps, and
doesn't rely on the definition of the adjoint, which allows it to be stated in non-complete space.

## Main definitions

* `linear_map.is_symmetric`: a (not necessarily bounded) operator on an inner product space is
symmetric, if for all `x`, `y`, we have `⟪T x, y⟫ = ⟪x, T y⟫`

## Main statements

* `is_symmetric.continuous`: if a symmetric operator is defined on a complete space, then
  it is automatically continuous.

## Tags

self-adjoint, symmetric
-/

open IsROrC

open ComplexConjugate

variable {𝕜 E E' F G : Type _} [IsROrC 𝕜]

variable [NormedAddCommGroup E] [InnerProductSpace 𝕜 E]

variable [NormedAddCommGroup F] [InnerProductSpace 𝕜 F]

variable [NormedAddCommGroup G] [InnerProductSpace 𝕜 G]

variable [NormedAddCommGroup E'] [InnerProductSpace ℝ E']

-- mathport name: «expr⟪ , ⟫»
local notation "⟪" x ", " y "⟫" => @inner 𝕜 _ _ x y

namespace LinearMap

/-! ### Symmetric operators -/

/-- A (not necessarily bounded) operator on an inner product space is symmetric, if for all
`x`, `y`, we have `⟪T x, y⟫ = ⟪x, T y⟫`. -/
def IsSymmetric (T : E →ₗ[𝕜] E) : Prop :=
  ∀ x y, ⟪T x, y⟫ = ⟪x, T y⟫
#align linear_map.is_symmetric LinearMap.IsSymmetric

section Real

variable ()

/-- An operator `T` on an inner product space is symmetric if and only if it is
`linear_map.is_self_adjoint` with respect to the sesquilinear form given by the inner product. -/
theorem isSymmetric_iff_sesq_form (T : E →ₗ[𝕜] E) :
    T.IsSymmetric ↔ @LinearMap.IsSelfAdjoint 𝕜 E _ _ _ (starRingEnd 𝕜) sesqFormOfInner T :=
  ⟨fun h x y => (h y x).symm, fun h x y => (h y x).symm⟩
#align linear_map.is_symmetric_iff_sesq_form LinearMap.isSymmetric_iff_sesq_form

end Real

theorem IsSymmetric.conj_inner_sym {T : E →ₗ[𝕜] E} (hT : IsSymmetric T) (x y : E) :
    conj ⟪T x, y⟫ = ⟪T y, x⟫ := by rw [hT x y, inner_conj_symm]
#align linear_map.is_symmetric.conj_inner_sym LinearMap.IsSymmetric.conj_inner_sym

@[simp]
theorem IsSymmetric.apply_clm {T : E →L[𝕜] E} (hT : IsSymmetric (T : E →ₗ[𝕜] E)) (x y : E) :
    ⟪T x, y⟫ = ⟪x, T y⟫ :=
  hT x y
#align linear_map.is_symmetric.apply_clm LinearMap.IsSymmetric.apply_clm

theorem isSymmetric_zero : (0 : E →ₗ[𝕜] E).IsSymmetric := fun x y =>
  (inner_zero_right x : ⟪x, 0⟫ = 0).symm ▸ (inner_zero_left y : ⟪0, y⟫ = 0)
#align linear_map.is_symmetric_zero LinearMap.isSymmetric_zero

theorem isSymmetric_id : (LinearMap.id : E →ₗ[𝕜] E).IsSymmetric := fun x y => rfl
#align linear_map.is_symmetric_id LinearMap.isSymmetric_id

theorem IsSymmetric.add {T S : E →ₗ[𝕜] E} (hT : T.IsSymmetric) (hS : S.IsSymmetric) :
    (T + S).IsSymmetric := by
  intro x y
  rw [LinearMap.add_apply, inner_add_left, hT x y, hS x y, ← inner_add_right]
  rfl
#align linear_map.is_symmetric.add LinearMap.IsSymmetric.add

/-- The **Hellinger--Toeplitz theorem**: if a symmetric operator is defined on a complete space,
  then it is automatically continuous. -/
theorem IsSymmetric.continuous [CompleteSpace E] {T : E →ₗ[𝕜] E} (hT : IsSymmetric T) :
    Continuous T :=
  by
  -- We prove it by using the closed graph theorem
  refine' T.continuous_of_seq_closed_graph fun u x y hu hTu => _
  rw [← sub_eq_zero, ← @inner_self_eq_zero 𝕜]
  have hlhs : ∀ k : ℕ, ⟪T (u k) - T x, y - T x⟫ = ⟪u k - x, T (y - T x)⟫ :=
    by
    intro k
    rw [← T.map_sub, hT]
  refine' tendsto_nhds_unique ((hTu.sub_const _).inner tendsto_const_nhds) _
  simp_rw [hlhs]
  rw [← inner_zero_left (T (y - T x))]
  refine' Filter.Tendsto.inner _ tendsto_const_nhds
  rw [← sub_self x]
  exact hu.sub_const _
#align linear_map.is_symmetric.continuous LinearMap.IsSymmetric.continuous

/-- For a symmetric operator `T`, the function `λ x, ⟪T x, x⟫` is real-valued. -/
@[simp]
theorem IsSymmetric.coe_reApplyInnerSelf_apply {T : E →L[𝕜] E} (hT : IsSymmetric (T : E →ₗ[𝕜] E))
    (x : E) : (T.reApplyInnerSelf x : 𝕜) = ⟪T x, x⟫ :=
  by
  rsuffices ⟨r, hr⟩ : ∃ r : ℝ, ⟪T x, x⟫ = r
  · simp [hr, T.re_apply_inner_self_apply]
  rw [← eq_conj_iff_real]
  exact hT.conj_inner_sym x x
#align linear_map.is_symmetric.coe_re_apply_inner_self_apply LinearMap.IsSymmetric.coe_reApplyInnerSelf_apply

/-- If a symmetric operator preserves a submodule, its restriction to that submodule is
symmetric. -/
theorem IsSymmetric.restrict_invariant {T : E →ₗ[𝕜] E} (hT : IsSymmetric T) {V : Submodule 𝕜 E}
    (hV : ∀ v ∈ V, T v ∈ V) : IsSymmetric (T.restrict hV) := fun v w => hT v w
#align linear_map.is_symmetric.restrict_invariant LinearMap.IsSymmetric.restrict_invariant

theorem IsSymmetric.restrictScalars {T : E →ₗ[𝕜] E} (hT : T.IsSymmetric) :
    @LinearMap.IsSymmetric ℝ E _ _ (InnerProductSpace.isROrCToReal 𝕜 E)
      (@LinearMap.restrictScalars ℝ 𝕜 _ _ _ _ _ _ (InnerProductSpace.isROrCToReal 𝕜 E).toModule
        (InnerProductSpace.isROrCToReal 𝕜 E).toModule _ _ _ T) :=
  fun x y => by simp [hT x y, real_inner_eq_re_inner, LinearMap.coe_restrictScalars]
#align linear_map.is_symmetric.restrict_scalars LinearMap.IsSymmetric.restrictScalars

section Complex

variable {V : Type _} [NormedAddCommGroup V] [InnerProductSpace ℂ V]

/-- A linear operator on a complex inner product space is symmetric precisely when
`⟪T v, v⟫_ℂ` is real for all v.-/
theorem isSymmetric_iff_inner_map_self_real (T : V →ₗ[ℂ] V) :
    IsSymmetric T ↔ ∀ v : V, conj ⟪T v, v⟫_ℂ = ⟪T v, v⟫_ℂ :=
  by
  constructor
  · intro hT v
    apply is_symmetric.conj_inner_sym hT
  · intro h x y
    nth_rw 2 [← inner_conj_symm]
    nth_rw 2 [inner_map_polarization]
    simp only [starRingEnd_apply, star_div', star_sub, star_add, star_mul]
    simp only [← starRingEnd_apply]
    rw [h (x + y), h (x - y), h (x + Complex.I • y), h (x - Complex.I • y)]
    simp only [Complex.conj_I]
    rw [inner_map_polarization']
    norm_num
    ring
#align linear_map.is_symmetric_iff_inner_map_self_real LinearMap.isSymmetric_iff_inner_map_self_real

end Complex

end LinearMap


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.adjunction.limits
import category_theory.adjunction.opposites
import category_theory.elements
import category_theory.limits.functor_category
import category_theory.limits.kan_extension
import category_theory.limits.shapes.terminal
import category_theory.limits.types

/-!
# Colimit of representables

This file constructs an adjunction `yoneda_adjunction` between `(Cᵒᵖ ⥤ Type u)` and `ℰ` given a
functor `A : C ⥤ ℰ`, where the right adjoint sends `(E : ℰ)` to `c ↦ (A.obj c ⟶ E)` (provided `ℰ`
has colimits).

This adjunction is used to show that every presheaf is a colimit of representables.

Further, the left adjoint `colimit_adj.extend_along_yoneda : (Cᵒᵖ ⥤ Type u) ⥤ ℰ` satisfies
`yoneda ⋙ L ≅ A`, that is, an extension of `A : C ⥤ ℰ` to `(Cᵒᵖ ⥤ Type u) ⥤ ℰ` through
`yoneda : C ⥤ Cᵒᵖ ⥤ Type u`. It is the left Kan extension of `A` along the yoneda embedding,
sometimes known as the Yoneda extension, as proved in `extend_along_yoneda_iso_Kan`.

`unique_extension_along_yoneda` shows `extend_along_yoneda` is unique amongst cocontinuous functors
with this property, establishing the presheaf category as the free cocompletion of a small category.

## Tags
colimit, representable, presheaf, free cocompletion

## References
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]
* https://ncatlab.org/nlab/show/Yoneda+extension
-/

namespace category_theory

noncomputable theory

open category limits
universes u₁ u₂

variables {C : Type u₁} [small_category C]
variables {ℰ : Type u₂} [category.{u₁} ℰ]
variable (A : C ⥤ ℰ)

namespace colimit_adj

/--
The functor taking `(E : ℰ) (c : Cᵒᵖ)` to the homset `(A.obj C ⟶ E)`. It is shown in `L_adjunction`
that this functor has a left adjoint (provided `E` has colimits) given by taking colimits over
categories of elements.
In the case where `ℰ = Cᵒᵖ ⥤ Type u` and `A = yoneda`, this functor is isomorphic to the identity.

Defined as in [MM92], Chapter I, Section 5, Theorem 2.
-/
@[simps]
def restricted_yoneda : ℰ ⥤ (Cᵒᵖ ⥤ Type u₁) :=
yoneda ⋙ (whiskering_left _ _ (Type u₁)).obj (functor.op A)

/--
The functor `restricted_yoneda` is isomorphic to the identity functor when evaluated at the yoneda
embedding.
-/
def restricted_yoneda_yoneda : restricted_yoneda (yoneda : C ⥤ Cᵒᵖ ⥤ Type u₁) ≅ 𝟭 _ :=
nat_iso.of_components
(λ P, nat_iso.of_components (λ X, yoneda_sections_small X.unop _)
  (λ X Y f, funext $ λ x,
  begin
    dsimp,
    rw ← functor_to_types.naturality _ _ x f (𝟙 _),
    dsimp,
    simp,
  end))
(λ _ _ _, rfl)

/--
(Implementation). The equivalence of homsets which helps construct the left adjoint to
`colimit_adj.restricted_yoneda`.
It is shown in `restrict_yoneda_hom_equiv_natural` that this is a natural bijection.
-/
def restrict_yoneda_hom_equiv (P : Cᵒᵖ ⥤ Type u₁) (E : ℰ)
  {c : cocone ((category_of_elements.π P).left_op ⋙ A)} (t : is_colimit c) :
  (c.X ⟶ E) ≃ (P ⟶ (restricted_yoneda A).obj E) :=
((ulift_trivial _).symm ≪≫ t.hom_iso' E).to_equiv.trans
{ to_fun := λ k,
  { app := λ c p, k.1 (opposite.op ⟨_, p⟩),
    naturality' := λ c c' f, funext $ λ p,
      (k.2 (quiver.hom.op ⟨f, rfl⟩ :
              (opposite.op ⟨c', P.map f p⟩ : P.elementsᵒᵖ) ⟶ opposite.op ⟨c, p⟩)).symm },
  inv_fun := λ τ,
  { val := λ p, τ.app p.unop.1 p.unop.2,
    property := λ p p' f,
    begin
      simp_rw [← f.unop.2],
      apply (congr_fun (τ.naturality f.unop.1) p'.unop.2).symm,
    end },
  left_inv :=
  begin
    rintro ⟨k₁, k₂⟩,
    ext,
    dsimp,
    congr' 1,
    simp,
  end,
  right_inv :=
  begin
    rintro ⟨_, _⟩,
    refl,
  end }

/--
(Implementation). Show that the bijection in `restrict_yoneda_hom_equiv` is natural (on the right).
-/
lemma restrict_yoneda_hom_equiv_natural (P : Cᵒᵖ ⥤ Type u₁) (E₁ E₂ : ℰ) (g : E₁ ⟶ E₂)
  {c : cocone _} (t : is_colimit c) (k : c.X ⟶ E₁) :
restrict_yoneda_hom_equiv A P E₂ t (k ≫ g) =
  restrict_yoneda_hom_equiv A P E₁ t k ≫ (restricted_yoneda A).map g :=
begin
  ext _ X p,
  apply (assoc _ _ _).symm,
end

variables [has_colimits ℰ]

/--
The left adjoint to the functor `restricted_yoneda` (shown in `yoneda_adjunction`). It is also an
extension of `A` along the yoneda embedding (shown in `is_extension_along_yoneda`), in particular
it is the left Kan extension of `A` through the yoneda embedding.
-/
def extend_along_yoneda : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ :=
adjunction.left_adjoint_of_equiv
  (λ P E, restrict_yoneda_hom_equiv A P E (colimit.is_colimit _))
  (λ P E E' g, restrict_yoneda_hom_equiv_natural A P E E' g _)

@[simp]
lemma extend_along_yoneda_obj (P : Cᵒᵖ ⥤ Type u₁) : (extend_along_yoneda A).obj P =
colimit ((category_of_elements.π P).left_op ⋙ A) := rfl

lemma extend_along_yoneda_map {X Y : Cᵒᵖ ⥤ Type u₁} (f : X ⟶ Y) :
  (extend_along_yoneda A).map f = colimit.pre ((category_of_elements.π Y).left_op ⋙ A)
    (category_of_elements.map f).op :=
begin
  ext J,
  erw colimit.ι_pre ((category_of_elements.π Y).left_op ⋙ A) (category_of_elements.map f).op,
  dsimp only [extend_along_yoneda, restrict_yoneda_hom_equiv,
    is_colimit.hom_iso', is_colimit.hom_iso, ulift_trivial],
  simpa
end

/--
Show `extend_along_yoneda` is left adjoint to `restricted_yoneda`.

The construction of [MM92], Chapter I, Section 5, Theorem 2.
-/
def yoneda_adjunction : extend_along_yoneda A ⊣ restricted_yoneda A :=
adjunction.adjunction_of_equiv_left _ _

/--
The initial object in the category of elements for a representable functor. In `is_initial` it is
shown that this is initial.
-/
def elements.initial (A : C) : (yoneda.obj A).elements :=
⟨opposite.op A, 𝟙 _⟩

/--
Show that `elements.initial A` is initial in the category of elements for the `yoneda` functor.
-/
def is_initial (A : C) : is_initial (elements.initial A) :=
{ desc := λ s, ⟨s.X.2.op, comp_id _⟩,
  uniq' := λ s m w,
  begin
    simp_rw ← m.2,
    dsimp [elements.initial],
    simp,
  end,
  fac' := by rintros s ⟨⟨⟩⟩, }

/--
`extend_along_yoneda A` is an extension of `A` to the presheaf category along the yoneda embedding.
`unique_extension_along_yoneda` shows it is unique among functors preserving colimits with this
property (up to isomorphism).

The first part of [MM92], Chapter I, Section 5, Corollary 4.
See Property 1 of <https://ncatlab.org/nlab/show/Yoneda+extension#properties>.
-/
def is_extension_along_yoneda : (yoneda : C ⥤ Cᵒᵖ ⥤ Type u₁) ⋙ extend_along_yoneda A ≅ A :=
nat_iso.of_components
(λ X, (colimit.is_colimit _).cocone_point_unique_up_to_iso
      (colimit_of_diagram_terminal (terminal_op_of_initial (is_initial _)) _))
begin
  intros X Y f,
  change (colimit.desc _ ⟨_, _⟩ ≫ colimit.desc _ _) = colimit.desc _ _ ≫ _,
  apply colimit.hom_ext,
  intro j,
  rw [colimit.ι_desc_assoc, colimit.ι_desc_assoc],
  change (colimit.ι _ _ ≫ 𝟙 _) ≫ colimit.desc _ _ = _,
  rw [comp_id, colimit.ι_desc],
  dsimp,
  rw ← A.map_comp,
  congr' 1,
end

/-- See Property 2 of https://ncatlab.org/nlab/show/Yoneda+extension#properties. -/
instance : preserves_colimits (extend_along_yoneda A) :=
(yoneda_adjunction A).left_adjoint_preserves_colimits

/--
Show that the images of `X` after `extend_along_yoneda` and `Lan yoneda` are indeed isomorphic.
This follows from `category_theory.category_of_elements.costructured_arrow_yoneda_equivalence`.
-/
@[simps] def extend_along_yoneda_iso_Kan_app (X) :
  (extend_along_yoneda A).obj X ≅ ((Lan yoneda : (_ ⥤ ℰ) ⥤ _).obj A).obj X :=
let eq := category_of_elements.costructured_arrow_yoneda_equivalence X in
{ hom := colimit.pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A X) eq.functor,
  inv := colimit.pre ((category_of_elements.π X).left_op ⋙ A) eq.inverse,
  hom_inv_id' :=
  begin
    erw colimit.pre_pre ((category_of_elements.π X).left_op ⋙ A) eq.inverse,
    transitivity colimit.pre ((category_of_elements.π X).left_op ⋙ A) (𝟭 _),
    congr,
    { exact congr_arg functor.op (category_of_elements.from_to_costructured_arrow_eq X) },
    { ext, simp only [colimit.ι_pre], erw category.comp_id, congr }
  end,
  inv_hom_id' :=
  begin
    erw colimit.pre_pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A X) eq.functor,
    transitivity colimit.pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A X) (𝟭 _),
    congr,
    { exact category_of_elements.to_from_costructured_arrow_eq X },
    { ext, simp only [colimit.ι_pre], erw category.comp_id, congr }
  end }

/--
Verify that `extend_along_yoneda` is indeed the left Kan extension along the yoneda embedding.
-/
@[simps]
def extend_along_yoneda_iso_Kan : extend_along_yoneda A ≅ (Lan yoneda : (_ ⥤ ℰ) ⥤ _).obj A :=
nat_iso.of_components (extend_along_yoneda_iso_Kan_app A)
begin
  intros X Y f, simp,
  rw extend_along_yoneda_map,
  erw colimit.pre_pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A Y) (costructured_arrow.map f),
  erw colimit.pre_pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A Y)
    (category_of_elements.costructured_arrow_yoneda_equivalence Y).functor,
  congr' 1,
  apply category_of_elements.costructured_arrow_yoneda_equivalence_naturality,
end

/-- extending `F ⋙ yoneda` along the yoneda embedding is isomorphic to `Lan F.op`. -/
@[simps] def extend_of_comp_yoneda_iso_Lan {D : Type u₁} [small_category D] (F : C ⥤ D) :
  extend_along_yoneda (F ⋙ yoneda) ≅ Lan F.op :=
adjunction.nat_iso_of_right_adjoint_nat_iso
  (yoneda_adjunction (F ⋙ yoneda))
  (Lan.adjunction (Type u₁) F.op)
  (iso_whisker_right curried_yoneda_lemma' ((whiskering_left Cᵒᵖ Dᵒᵖ (Type u₁)).obj F.op : _))

end colimit_adj

open colimit_adj

/-- `F ⋙ yoneda` is naturally isomorphic to `yoneda ⋙ Lan F.op`. -/
@[simps] def comp_yoneda_iso_yoneda_comp_Lan {D : Type u₁} [small_category D] (F : C ⥤ D) :
  F ⋙ yoneda ≅ yoneda ⋙ Lan F.op :=
(is_extension_along_yoneda (F ⋙ yoneda)).symm ≪≫
  iso_whisker_left yoneda (extend_of_comp_yoneda_iso_Lan F)

/--
Since `extend_along_yoneda A` is adjoint to `restricted_yoneda A`, if we use `A = yoneda`
then `restricted_yoneda A` is isomorphic to the identity, and so `extend_along_yoneda A` is as well.
-/
def extend_along_yoneda_yoneda : extend_along_yoneda (yoneda : C ⥤ _) ≅ 𝟭 _ :=
adjunction.nat_iso_of_right_adjoint_nat_iso
  (yoneda_adjunction _)
  adjunction.id
  restricted_yoneda_yoneda

/--
A functor to the presheaf category in which everything in the image is representable (witnessed
by the fact that it factors through the yoneda embedding).
`cocone_of_representable` gives a cocone for this functor which is a colimit and has point `P`.
-/
-- Maybe this should be reducible or an abbreviation?
def functor_to_representables (P : Cᵒᵖ ⥤ Type u₁) :
  (P.elements)ᵒᵖ ⥤ Cᵒᵖ ⥤ Type u₁ :=
(category_of_elements.π P).left_op ⋙ yoneda

/--
This is a cocone with point `P` for the functor `functor_to_representables P`. It is shown in
`colimit_of_representable P` that this cocone is a colimit: that is, we have exhibited an arbitrary
presheaf `P` as a colimit of representables.

The construction of [MM92], Chapter I, Section 5, Corollary 3.
-/
def cocone_of_representable (P : Cᵒᵖ ⥤ Type u₁) :
  cocone (functor_to_representables P) :=
cocone.extend (colimit.cocone _) (extend_along_yoneda_yoneda.hom.app P)

@[simp] lemma cocone_of_representable_X (P : Cᵒᵖ ⥤ Type u₁) :
  (cocone_of_representable P).X = P :=
rfl

/-- An explicit formula for the legs of the cocone `cocone_of_representable`. -/
-- Marking this as a simp lemma seems to make things more awkward.
lemma cocone_of_representable_ι_app (P : Cᵒᵖ ⥤ Type u₁) (j : (P.elements)ᵒᵖ):
  (cocone_of_representable P).ι.app j = (yoneda_sections_small _ _).inv j.unop.2 :=
colimit.ι_desc _ _

/-- The legs of the cocone `cocone_of_representable` are natural in the choice of presheaf. -/
lemma cocone_of_representable_naturality {P₁ P₂ : Cᵒᵖ ⥤ Type u₁} (α : P₁ ⟶ P₂)
  (j : (P₁.elements)ᵒᵖ) :
  (cocone_of_representable P₁).ι.app j ≫ α =
    (cocone_of_representable P₂).ι.app ((category_of_elements.map α).op.obj j) :=
begin
  ext T f,
  simpa [cocone_of_representable_ι_app] using functor_to_types.naturality _ _ α f.op _,
end

/--
The cocone with point `P` given by `the_cocone` is a colimit: that is, we have exhibited an
arbitrary presheaf `P` as a colimit of representables.

The result of [MM92], Chapter I, Section 5, Corollary 3.
-/
def colimit_of_representable (P : Cᵒᵖ ⥤ Type u₁) : is_colimit (cocone_of_representable P) :=
begin
  apply is_colimit.of_point_iso (colimit.is_colimit (functor_to_representables P)),
  change is_iso (colimit.desc _ (cocone.extend _ _)),
  rw [colimit.desc_extend, colimit.desc_cocone],
  apply_instance,
end

/--
Given two functors L₁ and L₂ which preserve colimits, if they agree when restricted to the
representable presheaves then they agree everywhere.
-/
def nat_iso_of_nat_iso_on_representables (L₁ L₂ : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ)
  [preserves_colimits L₁] [preserves_colimits L₂]
  (h : yoneda ⋙ L₁ ≅ yoneda ⋙ L₂) : L₁ ≅ L₂ :=
begin
  apply nat_iso.of_components _ _,
  { intro P,
    refine (is_colimit_of_preserves L₁ (colimit_of_representable P)).cocone_points_iso_of_nat_iso
           (is_colimit_of_preserves L₂ (colimit_of_representable P)) _,
    apply functor.associator _ _ _ ≪≫ _,
    exact iso_whisker_left (category_of_elements.π P).left_op h },
  { intros P₁ P₂ f,
    apply (is_colimit_of_preserves L₁ (colimit_of_representable P₁)).hom_ext,
    intro j,
    dsimp only [id.def, is_colimit.cocone_points_iso_of_nat_iso_hom, iso_whisker_left_hom],
    have :
      (L₁.map_cocone (cocone_of_representable P₁)).ι.app j ≫ L₁.map f =
      (L₁.map_cocone (cocone_of_representable P₂)).ι.app ((category_of_elements.map f).op.obj j),
    { dsimp,
      rw [← L₁.map_comp, cocone_of_representable_naturality],
      refl },
    rw [reassoc_of this, is_colimit.ι_map_assoc, is_colimit.ι_map],
    dsimp,
    rw [← L₂.map_comp, cocone_of_representable_naturality],
    refl }
end

variable [has_colimits ℰ]

/--
Show that `extend_along_yoneda` is the unique colimit-preserving functor which extends `A` to
the presheaf category.

The second part of [MM92], Chapter I, Section 5, Corollary 4.
See Property 3 of https://ncatlab.org/nlab/show/Yoneda+extension#properties.
-/
def unique_extension_along_yoneda (L : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) (hL : yoneda ⋙ L ≅ A)
  [preserves_colimits L] :
  L ≅ extend_along_yoneda A :=
nat_iso_of_nat_iso_on_representables _ _ (hL ≪≫ (is_extension_along_yoneda _).symm)

/--
If `L` preserves colimits and `ℰ` has them, then it is a left adjoint. This is a special case of
`is_left_adjoint_of_preserves_colimits` used to prove that.
-/
def is_left_adjoint_of_preserves_colimits_aux (L : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) [preserves_colimits L] :
  is_left_adjoint L :=
{ right := restricted_yoneda (yoneda ⋙ L),
  adj := (yoneda_adjunction _).of_nat_iso_left
            ((unique_extension_along_yoneda _ L (iso.refl _)).symm) }

/--
If `L` preserves colimits and `ℰ` has them, then it is a left adjoint. Note this is a (partial)
converse to `left_adjoint_preserves_colimits`.
-/
def is_left_adjoint_of_preserves_colimits (L : (C ⥤ Type u₁) ⥤ ℰ) [preserves_colimits L] :
  is_left_adjoint L :=
let e : (_ ⥤ Type u₁) ≌ (_ ⥤ Type u₁) := (op_op_equivalence C).congr_left,
    t := is_left_adjoint_of_preserves_colimits_aux (e.functor ⋙ L : _)
in by exactI adjunction.left_adjoint_of_nat_iso (e.inv_fun_id_assoc _)

end category_theory


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.analytic.composition
import tactic.congrm
/-!

# Inverse of analytic functions

We construct the left and right inverse of a formal multilinear series with invertible linear term,
we prove that they coincide and study their properties (notably convergence).

## Main statements

* `p.left_inv i`: the formal left inverse of the formal multilinear series `p`,
  for `i : E ≃L[𝕜] F` which coincides with `p₁`.
* `p.right_inv i`: the formal right inverse of the formal multilinear series `p`,
  for `i : E ≃L[𝕜] F` which coincides with `p₁`.
* `p.left_inv_comp` says that `p.left_inv i` is indeed a left inverse to `p` when `p₁ = i`.
* `p.right_inv_comp` says that `p.right_inv i` is indeed a right inverse to `p` when `p₁ = i`.
* `p.left_inv_eq_right_inv`: the two inverses coincide.
* `p.radius_right_inv_pos_of_radius_pos`: if a power series has a positive radius of convergence,
  then so does its inverse.

-/

open_locale big_operators classical topological_space
open finset filter

namespace formal_multilinear_series

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

/-! ### The left inverse of a formal multilinear series -/

/-- The left inverse of a formal multilinear series, where the `n`-th term is defined inductively
in terms of the previous ones to make sure that `(left_inv p i) ∘ p = id`. For this, the linear term
`p₁` in `p` should be invertible. In the definition, `i` is a linear isomorphism that should
coincide with `p₁`, so that one can use its inverse in the construction. The definition does not
use that `i = p₁`, but proofs that the definition is well-behaved do.

The `n`-th term in `q ∘ p` is `∑ qₖ (p_{j₁}, ..., p_{jₖ})` over `j₁ + ... + jₖ = n`. In this
expression, `qₙ` appears only once, in `qₙ (p₁, ..., p₁)`. We adjust the definition so that this
term compensates the rest of the sum, using `i⁻¹` as an inverse to `p₁`.

These formulas only make sense when the constant term `p₀` vanishes. The definition we give is
general, but it ignores the value of `p₀`.
-/
noncomputable def left_inv (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  formal_multilinear_series 𝕜 F E
| 0     := 0
| 1     := (continuous_multilinear_curry_fin1 𝕜 F E).symm i.symm
| (n+2) := - ∑ c : {c : composition (n+2) // c.length < n + 2},
      have (c : composition (n+2)).length < n+2 := c.2,
      (left_inv (c : composition (n+2)).length).comp_along_composition
        (p.comp_continuous_linear_map i.symm) c

@[simp] lemma left_inv_coeff_zero (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.left_inv i 0 = 0 := by rw left_inv

@[simp] lemma left_inv_coeff_one (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.left_inv i 1 = (continuous_multilinear_curry_fin1 𝕜 F E).symm i.symm := by rw left_inv

/-- The left inverse does not depend on the zeroth coefficient of a formal multilinear
series. -/
lemma left_inv_remove_zero (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.remove_zero.left_inv i = p.left_inv i :=
begin
  ext1 n,
  induction n using nat.strong_rec' with n IH,
  cases n, { simp }, -- if one replaces `simp` with `refl`, the proof times out in the kernel.
  cases n, { simp }, -- TODO: why?
  simp only [left_inv, neg_inj],
  refine finset.sum_congr rfl (λ c cuniv, _),
  rcases c with ⟨c, hc⟩,
  ext v,
  dsimp,
  simp [IH _ hc],
end

/-- The left inverse to a formal multilinear series is indeed a left inverse, provided its linear
term is invertible. -/
lemma left_inv_comp (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (h : p 1 = (continuous_multilinear_curry_fin1 𝕜 E F).symm i) :
  (left_inv p i).comp p = id 𝕜 E :=
begin
  ext n v,
  cases n,
  { simp only [left_inv, continuous_multilinear_map.zero_apply, id_apply_ne_one, ne.def,
      not_false_iff, zero_ne_one, comp_coeff_zero']},
  cases n,
  { simp only [left_inv, comp_coeff_one, h, id_apply_one, continuous_linear_equiv.coe_apply,
      continuous_linear_equiv.symm_apply_apply, continuous_multilinear_curry_fin1_symm_apply] },
  have A : (finset.univ : finset (composition (n+2)))
    = {c | composition.length c < n + 2}.to_finset ∪ {composition.ones (n+2)},
  { refine subset.antisymm (λ c hc, _) (subset_univ _),
    by_cases h : c.length < n + 2,
    { simp [h] },
    { simp [composition.eq_ones_iff_le_length.2 (not_lt.1 h)] } },
  have B : disjoint ({c | composition.length c < n + 2} : set (composition (n + 2))).to_finset
    {composition.ones (n+2)}, by simp,
  have C : (p.left_inv i (composition.ones (n + 2)).length)
    (λ (j : fin (composition.ones n.succ.succ).length), p 1 (λ k,
      v ((fin.cast_le (composition.length_le _)) j)))
    = p.left_inv i (n+2) (λ (j : fin (n+2)), p 1 (λ k, v j)),
  { apply formal_multilinear_series.congr _ (composition.ones_length _) (λ j hj1 hj2, _),
    exact formal_multilinear_series.congr _ rfl (λ k hk1 hk2, by congr) },
  have D : p.left_inv i (n+2) (λ (j : fin (n+2)), p 1 (λ k, v j)) =
    - ∑ (c : composition (n + 2)) in {c : composition (n + 2) | c.length < n + 2}.to_finset,
        (p.left_inv i c.length) (p.apply_composition c v),
  { simp only [left_inv, continuous_multilinear_map.neg_apply, neg_inj,
      continuous_multilinear_map.sum_apply],
    convert (sum_to_finset_eq_subtype (λ (c : composition (n+2)), c.length < n+2)
      (λ (c : composition (n+2)), (continuous_multilinear_map.comp_along_composition
        (p.comp_continuous_linear_map ↑(i.symm)) c (p.left_inv i c.length))
          (λ (j : fin (n + 2)), p 1 (λ (k : fin 1), v j)))).symm.trans _,
    simp only [comp_continuous_linear_map_apply_composition,
      continuous_multilinear_map.comp_along_composition_apply],
    congr,
    ext c,
    congr,
    ext k,
    simp [h] },
  simp [formal_multilinear_series.comp, show n + 2 ≠ 1, by dec_trivial, A, finset.sum_union B,
    apply_composition_ones, C, D],
end

/-! ### The right inverse of a formal multilinear series -/

/-- The right inverse of a formal multilinear series, where the `n`-th term is defined inductively
in terms of the previous ones to make sure that `p ∘ (right_inv p i) = id`. For this, the linear
term `p₁` in `p` should be invertible. In the definition, `i` is a linear isomorphism that should
coincide with `p₁`, so that one can use its inverse in the construction. The definition does not
use that `i = p₁`, but proofs that the definition is well-behaved do.

The `n`-th term in `p ∘ q` is `∑ pₖ (q_{j₁}, ..., q_{jₖ})` over `j₁ + ... + jₖ = n`. In this
expression, `qₙ` appears only once, in `p₁ (qₙ)`. We adjust the definition of `qₙ` so that this
term compensates the rest of the sum, using `i⁻¹` as an inverse to `p₁`.

These formulas only make sense when the constant term `p₀` vanishes. The definition we give is
general, but it ignores the value of `p₀`.
-/
noncomputable def right_inv (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  formal_multilinear_series 𝕜 F E
| 0     := 0
| 1     := (continuous_multilinear_curry_fin1 𝕜 F E).symm i.symm
| (n+2) :=
    let q : formal_multilinear_series 𝕜 F E := λ k, if h : k < n + 2 then right_inv k else 0 in
    - (i.symm : F →L[𝕜] E).comp_continuous_multilinear_map ((p.comp q) (n+2))

@[simp] lemma right_inv_coeff_zero (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.right_inv i 0 = 0 := by rw right_inv

@[simp] lemma right_inv_coeff_one (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.right_inv i 1 = (continuous_multilinear_curry_fin1 𝕜 F E).symm i.symm := by rw right_inv

/-- The right inverse does not depend on the zeroth coefficient of a formal multilinear
series. -/
lemma right_inv_remove_zero (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) :
  p.remove_zero.right_inv i = p.right_inv i :=
begin
  ext1 n,
  induction n using nat.strong_rec' with n IH,
  rcases n with _|_|n,
  { simp only [right_inv_coeff_zero] },
  { simp only [right_inv_coeff_one] },
  simp only [right_inv, neg_inj],
  rw remove_zero_comp_of_pos _ _ (add_pos_of_nonneg_of_pos (n.zero_le) zero_lt_two),
  congrm i.symm.to_continuous_linear_map.comp_continuous_multilinear_map (p.comp (λ k, _) _),
  by_cases hk : k < n+2; simp [hk, IH]
end

lemma comp_right_inv_aux1 {n : ℕ} (hn : 0 < n)
  (p : formal_multilinear_series 𝕜 E F) (q : formal_multilinear_series 𝕜 F E) (v : fin n → F) :
  p.comp q n v =
    (∑ (c : composition n) in {c : composition n | 1 < c.length}.to_finset,
      p c.length (q.apply_composition c v)) + p 1 (λ i, q n v) :=
begin
  have A : (finset.univ : finset (composition n))
    = {c | 1 < composition.length c}.to_finset ∪ {composition.single n hn},
  { refine subset.antisymm (λ c hc, _) (subset_univ _),
    by_cases h : 1 < c.length,
    { simp [h] },
    { have : c.length = 1,
        by { refine (eq_iff_le_not_lt.2 ⟨ _, h⟩).symm, exact c.length_pos_of_pos hn },
      rw ← composition.eq_single_iff_length hn at this,
      simp [this] } },
  have B : disjoint ({c | 1 < composition.length c} : set (composition n)).to_finset
    {composition.single n hn}, by simp,
  have C : p (composition.single n hn).length
              (q.apply_composition (composition.single n hn) v)
            = p 1 (λ (i : fin 1), q n v),
  { apply p.congr (composition.single_length hn) (λ j hj1 hj2, _),
    simp [apply_composition_single] },
  simp [formal_multilinear_series.comp, A, finset.sum_union B, C],
end

lemma comp_right_inv_aux2
  (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) (n : ℕ) (v : fin (n + 2) → F) :
  ∑ (c : composition (n + 2)) in {c : composition (n + 2) | 1 < c.length}.to_finset,
    p c.length (apply_composition (λ (k : ℕ), ite (k < n + 2) (p.right_inv i k) 0) c v) =
  ∑ (c : composition (n + 2)) in {c : composition (n + 2) | 1 < c.length}.to_finset,
    p c.length ((p.right_inv i).apply_composition c v) :=
begin
  have N : 0 < n + 2, by dec_trivial,
  refine sum_congr rfl (λ c hc, p.congr rfl (λ j hj1 hj2, _)),
  have : ∀ k, c.blocks_fun k < n + 2,
  { simp only [set.mem_to_finset, set.mem_set_of_eq] at hc,
    simp [← composition.ne_single_iff N, composition.eq_single_iff_length, ne_of_gt hc] },
  simp [apply_composition, this],
end

/-- The right inverse to a formal multilinear series is indeed a right inverse, provided its linear
term is invertible and its constant term vanishes. -/
lemma comp_right_inv (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (h : p 1 = (continuous_multilinear_curry_fin1 𝕜 E F).symm i) (h0 : p 0 = 0) :
  p.comp (right_inv p i) = id 𝕜 F :=
begin
  ext n v,
  cases n,
  { simp only [h0, continuous_multilinear_map.zero_apply, id_apply_ne_one, ne.def, not_false_iff,
      zero_ne_one, comp_coeff_zero']},
  cases n,
  { simp only [comp_coeff_one, h, right_inv, continuous_linear_equiv.apply_symm_apply, id_apply_one,
      continuous_linear_equiv.coe_apply, continuous_multilinear_curry_fin1_symm_apply] },
  have N : 0 < n+2, by dec_trivial,
  simp [comp_right_inv_aux1 N, h, right_inv, lt_irrefl n, show n + 2 ≠ 1, by dec_trivial,
        ← sub_eq_add_neg, sub_eq_zero, comp_right_inv_aux2],
end

lemma right_inv_coeff (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) (n : ℕ) (hn : 2 ≤ n) :
  p.right_inv i n = - (i.symm : F →L[𝕜] E).comp_continuous_multilinear_map
    (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition n)),
      p.comp_along_composition (p.right_inv i) c) :=
begin
  cases n, { exact false.elim (zero_lt_two.not_le hn) },
  cases n, { exact false.elim (one_lt_two.not_le hn) },
  simp only [right_inv, neg_inj],
  congr' 1,
  ext v,
  have N : 0 < n + 2, by dec_trivial,
  have : (p 1) (λ (i : fin 1), 0) = 0 := continuous_multilinear_map.map_zero _,
  simp [comp_right_inv_aux1 N, lt_irrefl n, this, comp_right_inv_aux2]
end

/-! ### Coincidence of the left and the right inverse -/

private lemma left_inv_eq_right_inv_aux (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (h : p 1 = (continuous_multilinear_curry_fin1 𝕜 E F).symm i) (h0 : p 0 = 0) :
  left_inv p i = right_inv p i := calc
left_inv p i = (left_inv p i).comp (id 𝕜 F) : by simp
... = (left_inv p i).comp (p.comp (right_inv p i)) : by rw comp_right_inv p i h h0
... = ((left_inv p i).comp p).comp (right_inv p i) : by rw comp_assoc
... = (id 𝕜 E).comp (right_inv p i) : by rw left_inv_comp p i h
... = right_inv p i : by simp

/-- The left inverse and the right inverse of a formal multilinear series coincide. This is not at
all obvious from their definition, but it follows from uniqueness of inverses (which comes from the
fact that composition is associative on formal multilinear series). -/
theorem left_inv_eq_right_inv (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (h : p 1 = (continuous_multilinear_curry_fin1 𝕜 E F).symm i) :
  left_inv p i = right_inv p i := calc
left_inv p i = left_inv p.remove_zero i : by rw left_inv_remove_zero
... = right_inv p.remove_zero i : by { apply left_inv_eq_right_inv_aux; simp [h] }
... = right_inv p i : by rw right_inv_remove_zero

/-!
### Convergence of the inverse of a power series

Assume that `p` is a convergent multilinear series, and let `q` be its (left or right) inverse.
Using the left-inverse formula gives
$$
q_n = - (p_1)^{-n} \sum_{k=0}^{n-1} \sum_{i_1 + \dotsc + i_k = n} q_k (p_{i_1}, \dotsc, p_{i_k}).
$$
Assume for simplicity that we are in dimension `1` and `p₁ = 1`. In the formula for `qₙ`, the term
`q_{n-1}` appears with a multiplicity of `n-1` (choosing the index `i_j` for which `i_j = 2` while
all the other indices are equal to `1`), which indicates that `qₙ` might grow like `n!`. This is
bad for summability properties.

It turns out that the right-inverse formula is better behaved, and should instead be used for this
kind of estimate. It reads
$$
q_n = - (p_1)^{-1} \sum_{k=2}^n \sum_{i_1 + \dotsc + i_k = n} p_k (q_{i_1}, \dotsc, q_{i_k}).
$$
Here, `q_{n-1}` can only appear in the term with `k = 2`, and it only appears twice, so there is
hope this formula can lead to an at most geometric behavior.

Let `Qₙ = ∥qₙ∥`. Bounding `∥pₖ∥` with `C r^k` gives an inequality
$$
Q_n ≤ C' \sum_{k=2}^n r^k \sum_{i_1 + \dotsc + i_k = n} Q_{i_1} \dotsm Q_{i_k}.
$$

This formula is not enough to prove by naive induction on `n` a bound of the form `Qₙ ≤ D R^n`.
However, assuming that the inequality above were an equality, one could get a formula for the
generating series of the `Qₙ`:

$$
\begin{align}
Q(z) & := \sum Q_n z^n = Q_1 z + C' \sum_{2 \leq k \leq n} \sum_{i_1 + \dotsc + i_k = n}
  (r z^{i_1} Q_{i_1}) \dotsm (r z^{i_k} Q_{i_k})
\\ & = Q_1 z + C' \sum_{k = 2}^\infty (\sum_{i_1 \geq 1} r z^{i_1} Q_{i_1})
  \dotsm (\sum_{i_k \geq 1} r z^{i_k} Q_{i_k})
\\ & = Q_1 z + C' \sum_{k = 2}^\infty (r Q(z))^k
= Q_1 z + C' (r Q(z))^2 / (1 - r Q(z)).
\end{align}
$$

One can solve this formula explicitly. The solution is analytic in a neighborhood of `0` in `ℂ`,
hence its coefficients grow at most geometrically (by a contour integral argument), and therefore
the original `Qₙ`, which are bounded by these ones, are also at most geometric.

This classical argument is not really satisfactory, as it requires an a priori bound on a complex
analytic function. Another option would be to compute explicitly its terms (with binomial
coefficients) to obtain an explicit geometric bound, but this would be very painful.

Instead, we will use the above intuition, but in a slightly different form, with finite sums and an
induction. I learnt this trick in [pöschel2017siegelsternberg]. Let
$S_n = \sum_{k=1}^n Q_k a^k$ (where `a` is a positive real parameter to be chosen suitably small).
The above computation but with finite sums shows that

$$
S_n \leq Q_1 a + C' \sum_{k=2}^n (r S_{n-1})^k.
$$

In particular, $S_n \leq Q_1 a + C' (r S_{n-1})^2 / (1- r S_{n-1})$.
Assume that $S_{n-1} \leq K a$, where `K > Q₁` is fixed and `a` is small enough so that
`r K a ≤ 1/2` (to control the denominator). Then this equation gives a bound
$S_n \leq Q_1 a + 2 C' r^2 K^2 a^2$.
If `a` is small enough, this is bounded by `K a` as the second term is quadratic in `a`, and
therefore negligible.

By induction, we deduce `Sₙ ≤ K a` for all `n`, which gives in particular the fact that `aⁿ Qₙ`
remains bounded.
-/

/-- First technical lemma to control the growth of coefficients of the inverse. Bound the explicit
expression for `∑_{k<n+1} aᵏ Qₖ` in terms of a sum of powers of the same sum one step before,
in a general abstract setup. -/
lemma radius_right_inv_pos_of_radius_pos_aux1
  (n : ℕ) (p : ℕ → ℝ) (hp : ∀ k, 0 ≤ p k) {r a : ℝ} (hr : 0 ≤ r) (ha : 0 ≤ a) :
  ∑ k in Ico 2 (n + 1), a ^ k *
      (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
          r ^ c.length * ∏ j, p (c.blocks_fun j))
  ≤ ∑ j in Ico 2 (n + 1), r ^ j * (∑ k in Ico 1 n, a ^ k * p k) ^ j :=
calc
∑ k in Ico 2 (n + 1), a ^ k *
  (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
      r ^ c.length * ∏ j, p (c.blocks_fun j))
= ∑ k in Ico 2 (n + 1),
  (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
      ∏ j, r * (a ^ (c.blocks_fun j) * p (c.blocks_fun j))) :
begin
  simp_rw [mul_sum],
  apply sum_congr rfl (λ k hk, _),
  apply sum_congr rfl (λ c hc, _),
  rw [prod_mul_distrib, prod_mul_distrib, prod_pow_eq_pow_sum, composition.sum_blocks_fun,
      prod_const, card_fin],
  ring,
end
... ≤ ∑ d in comp_partial_sum_target 2 (n + 1) n,
        ∏ (j : fin d.2.length), r * (a ^ d.2.blocks_fun j * p (d.2.blocks_fun j)) :
begin
  rw sum_sigma',
  refine sum_le_sum_of_subset_of_nonneg _ (λ x hx1 hx2,
    prod_nonneg (λ j hj, mul_nonneg hr (mul_nonneg (pow_nonneg ha _) (hp _)))),
  rintros ⟨k, c⟩ hd,
  simp only [set.mem_to_finset, mem_Ico, mem_sigma, set.mem_set_of_eq] at hd,
  simp only [mem_comp_partial_sum_target_iff],
  refine ⟨hd.2, c.length_le.trans_lt hd.1.2, λ j, _⟩,
  have : c ≠ composition.single k (zero_lt_two.trans_le hd.1.1),
    by simp [composition.eq_single_iff_length, ne_of_gt hd.2],
  rw composition.ne_single_iff at this,
  exact (this j).trans_le (nat.lt_succ_iff.mp hd.1.2)
end
... = ∑ e in comp_partial_sum_source 2 (n+1) n, ∏ (j : fin e.1), r * (a ^ e.2 j * p (e.2 j)) :
begin
  symmetry,
  apply comp_change_of_variables_sum,
  rintros ⟨k, blocks_fun⟩ H,
  have K : (comp_change_of_variables 2 (n + 1) n ⟨k, blocks_fun⟩ H).snd.length = k, by simp,
  congr' 2; try { rw K },
  rw fin.heq_fun_iff K.symm,
  assume j,
  rw comp_change_of_variables_blocks_fun,
end
... = ∑ j in Ico 2 (n+1), r ^ j * (∑ k in Ico 1 n, a ^ k * p k) ^ j :
begin
  rw [comp_partial_sum_source, ← sum_sigma' (Ico 2 (n + 1))
    (λ (k : ℕ), (fintype.pi_finset (λ (i : fin k), Ico 1 n) : finset (fin k → ℕ)))
    (λ n e, ∏ (j : fin n), r * (a ^ e j * p (e j)))],
  apply sum_congr rfl (λ j hj, _),
  simp only [← @multilinear_map.mk_pi_algebra_apply ℝ (fin j) _ _ ℝ],
  simp only [← multilinear_map.map_sum_finset (multilinear_map.mk_pi_algebra ℝ (fin j) ℝ)
    (λ k (m : ℕ), r * (a ^ m * p m))],
  simp only [multilinear_map.mk_pi_algebra_apply],
  dsimp,
  simp [prod_const, ← mul_sum, mul_pow],
end

/-- Second technical lemma to control the growth of coefficients of the inverse. Bound the explicit
expression for `∑_{k<n+1} aᵏ Qₖ` in terms of a sum of powers of the same sum one step before,
in the specific setup we are interesting in, by reducing to the general bound in
`radius_right_inv_pos_of_radius_pos_aux1`. -/
lemma radius_right_inv_pos_of_radius_pos_aux2
  {n : ℕ} (hn : 2 ≤ n + 1) (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  {r a C : ℝ} (hr : 0 ≤ r) (ha : 0 ≤ a) (hC : 0 ≤ C) (hp : ∀ n, ∥p n∥ ≤ C * r ^ n) :
   (∑ k in Ico 1 (n + 1), a ^ k * ∥p.right_inv i k∥) ≤
     ∥(i.symm : F →L[𝕜] E)∥ * a + ∥(i.symm : F →L[𝕜] E)∥ * C * ∑ k in Ico 2 (n + 1),
      (r * ((∑ j in Ico 1 n, a ^ j * ∥p.right_inv i j∥))) ^ k :=
let I := ∥(i.symm : F →L[𝕜] E)∥ in calc
∑ k in Ico 1 (n + 1), a ^ k * ∥p.right_inv i k∥
    = a * I + ∑ k in Ico 2 (n + 1), a ^ k * ∥p.right_inv i k∥ :
by simp only [linear_isometry_equiv.norm_map, pow_one, right_inv_coeff_one,
              nat.Ico_succ_singleton, sum_singleton, ← sum_Ico_consecutive _ one_le_two hn]
... = a * I + ∑ k in Ico 2 (n + 1), a ^ k *
        ∥(i.symm : F →L[𝕜] E).comp_continuous_multilinear_map
          (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
            p.comp_along_composition (p.right_inv i) c)∥ :
begin
  congr' 1,
  apply sum_congr rfl (λ j hj, _),
  rw [right_inv_coeff _ _ _ (mem_Ico.1 hj).1, norm_neg],
end
... ≤ a * ∥(i.symm : F →L[𝕜] E)∥ + ∑ k in Ico 2 (n + 1), a ^ k * (I *
      (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
        C * r ^ c.length * ∏ j, ∥p.right_inv i (c.blocks_fun j)∥)) :
begin
  apply_rules [add_le_add, le_refl, sum_le_sum (λ j hj, _), mul_le_mul_of_nonneg_left,
    pow_nonneg, ha],
  apply (continuous_linear_map.norm_comp_continuous_multilinear_map_le _ _).trans,
  apply mul_le_mul_of_nonneg_left _ (norm_nonneg _),
  apply (norm_sum_le _ _).trans,
  apply sum_le_sum (λ c hc, _),
  apply (comp_along_composition_norm _ _ _).trans,
  apply mul_le_mul_of_nonneg_right (hp _),
  exact prod_nonneg (λ j hj, norm_nonneg _),
end
... = I * a + I * C * ∑ k in Ico 2 (n + 1), a ^ k *
  (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)),
      r ^ c.length * ∏ j, ∥p.right_inv i (c.blocks_fun j)∥) :
begin
  simp_rw [mul_assoc C, ← mul_sum, ← mul_assoc, mul_comm _ (∥↑i.symm∥), mul_assoc, ← mul_sum,
    ← mul_assoc, mul_comm _ C, mul_assoc, ← mul_sum],
  ring,
end
... ≤ I * a + I * C * ∑ k in Ico 2 (n+1), (r * ((∑ j in Ico 1 n, a ^ j * ∥p.right_inv i j∥))) ^ k :
begin
  apply_rules [add_le_add, le_refl, mul_le_mul_of_nonneg_left, norm_nonneg, hC, mul_nonneg],
  simp_rw [mul_pow],
  apply radius_right_inv_pos_of_radius_pos_aux1 n (λ k, ∥p.right_inv i k∥)
    (λ k, norm_nonneg _) hr ha,
end

/-- If a a formal multilinear series has a positive radius of convergence, then its right inverse
also has a positive radius of convergence. -/
theorem radius_right_inv_pos_of_radius_pos (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F)
  (hp : 0 < p.radius) : 0 < (p.right_inv i).radius :=
begin
  obtain ⟨C, r, Cpos, rpos, ple⟩ : ∃ C r (hC : 0 < C) (hr : 0 < r), ∀ (n : ℕ), ∥p n∥ ≤ C * r ^ n :=
    le_mul_pow_of_radius_pos p hp,
  let I := ∥(i.symm : F →L[𝕜] E)∥,
  -- choose `a` small enough to make sure that `∑_{k ≤ n} aᵏ Qₖ` will be controllable by
  -- induction
  obtain ⟨a, apos, ha1, ha2⟩ : ∃ a (apos : 0 < a),
    (2 * I * C * r^2 * (I + 1) ^ 2 * a ≤ 1) ∧ (r * (I + 1) * a ≤ 1/2),
  { have : tendsto (λ a, 2 * I * C * r^2 * (I + 1) ^ 2 * a) (𝓝 0)
      (𝓝 (2 * I * C * r^2 * (I + 1) ^ 2 * 0)) := tendsto_const_nhds.mul tendsto_id,
    have A : ∀ᶠ a in 𝓝 0, 2 * I * C * r^2 * (I + 1) ^ 2 * a < 1,
      by { apply (tendsto_order.1 this).2, simp [zero_lt_one] },
    have : tendsto (λ a, r * (I + 1) * a) (𝓝 0)
      (𝓝 (r * (I + 1) * 0)) := tendsto_const_nhds.mul tendsto_id,
    have B : ∀ᶠ a in 𝓝 0, r * (I + 1) * a < 1/2,
      by { apply (tendsto_order.1 this).2, simp [zero_lt_one] },
    have C : ∀ᶠ a in 𝓝[>] (0 : ℝ), (0 : ℝ) < a,
      by { filter_upwards [self_mem_nhds_within] with _ ha using ha },
    rcases (C.and ((A.and B).filter_mono inf_le_left)).exists with ⟨a, ha⟩,
    exact ⟨a, ha.1, ha.2.1.le, ha.2.2.le⟩ },
  -- check by induction that the partial sums are suitably bounded, using the choice of `a` and the
  -- inductive control from Lemma `radius_right_inv_pos_of_radius_pos_aux2`.
  let S := λ n, ∑ k in Ico 1 n, a ^ k * ∥p.right_inv i k∥,
  have IRec : ∀ n, 1 ≤ n → S n ≤ (I + 1) * a,
  { apply nat.le_induction,
    { simp only [S],
      rw [Ico_eq_empty_of_le (le_refl 1), sum_empty],
      exact mul_nonneg (add_nonneg (norm_nonneg _) zero_le_one) apos.le },
    { assume n one_le_n hn,
      have In : 2 ≤ n + 1, by linarith,
      have Snonneg : 0 ≤ S n :=
        sum_nonneg (λ x hx, mul_nonneg (pow_nonneg apos.le _) (norm_nonneg _)),
      have rSn : r * S n ≤ 1/2 := calc
        r * S n ≤ r * ((I+1) * a) : mul_le_mul_of_nonneg_left hn rpos.le
        ... ≤ 1/2 : by rwa [← mul_assoc],
      calc S (n + 1) ≤ I * a + I * C * ∑ k in Ico 2 (n + 1), (r * S n)^k :
         radius_right_inv_pos_of_radius_pos_aux2 In p i rpos.le apos.le Cpos.le ple
      ... = I * a + I * C * (((r * S n) ^ 2 - (r * S n) ^ (n + 1)) / (1 - r * S n)) :
        by { rw geom_sum_Ico' _ In, exact ne_of_lt (rSn.trans_lt (by norm_num)) }
      ... ≤ I * a + I * C * ((r * S n) ^ 2 / (1/2)) :
        begin
          apply_rules [add_le_add, le_refl, mul_le_mul_of_nonneg_left, mul_nonneg, norm_nonneg,
            Cpos.le],
          refine div_le_div (sq_nonneg _) _ (by norm_num) (by linarith),
          simp only [sub_le_self_iff],
          apply pow_nonneg (mul_nonneg rpos.le Snonneg),
        end
      ... = I * a + 2 * I * C * (r * S n) ^ 2 : by ring
      ... ≤ I * a + 2 * I * C * (r * ((I + 1) * a)) ^ 2 :
        by apply_rules [add_le_add, le_refl, mul_le_mul_of_nonneg_left, mul_nonneg, norm_nonneg,
            Cpos.le, zero_le_two, pow_le_pow_of_le_left, rpos.le]
      ... = (I + 2 * I * C * r^2 * (I + 1) ^ 2 * a) * a : by ring
      ... ≤ (I + 1) * a :
        by apply_rules [mul_le_mul_of_nonneg_right, apos.le, add_le_add, le_refl] } },
  -- conclude that all coefficients satisfy `aⁿ Qₙ ≤ (I + 1) a`.
  let a' : nnreal := ⟨a, apos.le⟩,
  suffices H : (a' : ennreal) ≤ (p.right_inv i).radius,
    by { apply lt_of_lt_of_le _ H, exact_mod_cast apos },
  apply le_radius_of_bound _ ((I + 1) * a) (λ n, _),
  by_cases hn : n = 0,
  { have : ∥p.right_inv i n∥ = ∥p.right_inv i 0∥, by congr; try { rw hn },
    simp only [this, norm_zero, zero_mul, right_inv_coeff_zero],
    apply_rules [mul_nonneg, add_nonneg, norm_nonneg, zero_le_one, apos.le] },
  { have one_le_n : 1 ≤ n := bot_lt_iff_ne_bot.2 hn,
    calc ∥p.right_inv i n∥ * ↑a' ^ n = a ^ n * ∥p.right_inv i n∥ : mul_comm _ _
    ... ≤ ∑ k in Ico 1 (n + 1), a ^ k * ∥p.right_inv i k∥ :
      begin
        have : ∀ k ∈ Ico 1 (n + 1), 0 ≤ a ^ k * ∥p.right_inv i k∥ :=
          λ k hk, mul_nonneg (pow_nonneg apos.le _) (norm_nonneg _),
        exact single_le_sum this (by simp [one_le_n]),
      end
    ... ≤ (I + 1) * a : IRec (n + 1) (by dec_trivial) }
end

end formal_multilinear_series


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.normed_space.basic

/-!
# Extended norm

In this file we define a structure `enorm 𝕜 V` representing an extended norm (i.e., a norm that can
take the value `∞`) on a vector space `V` over a normed field `𝕜`. We do not use `class` for
an `enorm` because the same space can have more than one extended norm. For example, the space of
measurable functions `f : α → ℝ` has a family of `L_p` extended norms.

We prove some basic inequalities, then define

* `emetric_space` structure on `V` corresponding to `e : enorm 𝕜 V`;
* the subspace of vectors with finite norm, called `e.finite_subspace`;
* a `normed_space` structure on this space.

The last definition is an instance because the type involves `e`.

## Implementation notes

We do not define extended normed groups. They can be added to the chain once someone will need them.

## Tags

normed space, extended norm
-/

local attribute [instance, priority 1001] classical.prop_decidable
open_locale ennreal

/-- Extended norm on a vector space. As in the case of normed spaces, we require only
`∥c • x∥ ≤ ∥c∥ * ∥x∥` in the definition, then prove an equality in `map_smul`. -/
structure enorm (𝕜 : Type*) (V : Type*) [normed_field 𝕜] [add_comm_group V] [module 𝕜 V] :=
(to_fun : V → ℝ≥0∞)
(eq_zero' : ∀ x, to_fun x = 0 → x = 0)
(map_add_le' : ∀ x y : V, to_fun (x + y) ≤ to_fun x + to_fun y)
(map_smul_le' : ∀ (c : 𝕜) (x : V), to_fun (c • x) ≤ nnnorm c * to_fun x)

namespace enorm

variables {𝕜 : Type*} {V : Type*} [normed_field 𝕜] [add_comm_group V] [module 𝕜 V]
  (e : enorm 𝕜 V)

instance : has_coe_to_fun (enorm 𝕜 V) := ⟨_, enorm.to_fun⟩

lemma coe_fn_injective : function.injective (λ (e : enorm 𝕜 V) (x : V), e x) :=
λ e₁ e₂ h, by cases e₁; cases e₂; congr; exact h

@[ext] lemma ext {e₁ e₂ : enorm 𝕜 V} (h : ∀ x, e₁ x = e₂ x) : e₁ = e₂ :=
coe_fn_injective $ funext h

lemma ext_iff {e₁ e₂ : enorm 𝕜 V} : e₁ = e₂ ↔ ∀ x, e₁ x = e₂ x :=
⟨λ h x, h ▸ rfl, ext⟩

@[simp, norm_cast] lemma coe_inj {e₁ e₂ : enorm 𝕜 V} : ⇑e₁ = e₂ ↔ e₁ = e₂ :=
coe_fn_injective.eq_iff

@[simp] lemma map_smul (c : 𝕜) (x : V) : e (c • x) = nnnorm c * e x :=
le_antisymm (e.map_smul_le' c x) $
begin
  by_cases hc : c = 0, { simp [hc] },
  calc (nnnorm c : ℝ≥0∞) * e x = nnnorm c * e (c⁻¹ • c • x) : by rw [inv_smul_smul' hc]
  ... ≤ nnnorm c * (nnnorm (c⁻¹) * e (c • x)) : _
  ... = e (c • x) : _,
  { exact ennreal.mul_le_mul (le_refl _) (e.map_smul_le' _ _) },
  { rw [← mul_assoc, normed_field.nnnorm_inv, ennreal.coe_inv,
     ennreal.mul_inv_cancel _ ennreal.coe_ne_top, one_mul]; simp [hc] }
end

@[simp] lemma map_zero : e 0 = 0 :=
by { rw [← zero_smul 𝕜 (0:V), e.map_smul], norm_num }

@[simp] lemma eq_zero_iff {x : V} : e x = 0 ↔ x = 0 :=
⟨e.eq_zero' x, λ h, h.symm ▸ e.map_zero⟩

@[simp] lemma map_neg (x : V) : e (-x) = e x :=
calc e (-x) = nnnorm (-1:𝕜) * e x : by rw [← map_smul, neg_one_smul]
        ... = e x                 : by simp

lemma map_sub_rev (x y : V) : e (x - y) = e (y - x) :=
by rw [← neg_sub, e.map_neg]

lemma map_add_le (x y : V) : e (x + y) ≤ e x + e y := e.map_add_le' x y

lemma map_sub_le (x y : V) : e (x - y) ≤ e x + e y :=
calc e (x - y) = e (x + -y)   : by rw sub_eq_add_neg
           ... ≤ e x + e (-y) : e.map_add_le x (-y)
           ... = e x + e y    : by rw [e.map_neg]

instance : partial_order (enorm 𝕜 V) :=
{ le := λ e₁ e₂, ∀ x, e₁ x ≤ e₂ x,
  le_refl := λ e x, le_refl _,
  le_trans := λ e₁ e₂ e₃ h₁₂ h₂₃ x, le_trans (h₁₂ x) (h₂₃ x),
  le_antisymm := λ e₁ e₂ h₁₂ h₂₁, ext $ λ x, le_antisymm (h₁₂ x) (h₂₁ x) }

/-- The `enorm` sending each non-zero vector to infinity. -/
noncomputable instance : has_top (enorm 𝕜 V) :=
⟨{ to_fun := λ x, if x = 0 then 0 else ⊤,
   eq_zero' := λ x, by { split_ifs; simp [*] },
   map_add_le' := λ x y,
     begin
       split_ifs with hxy hx hy hy hx hy hy; try { simp [*] },
       simpa [hx, hy] using hxy
     end,
   map_smul_le' := λ c x,
     begin
       split_ifs with hcx hx hx; simp only [smul_eq_zero, not_or_distrib] at hcx,
       { simp only [mul_zero, le_refl] },
       { have : c = 0, by tauto,
         simp [this] },
       { tauto },
       { simp [hcx.1] }
     end }⟩

noncomputable instance : inhabited (enorm 𝕜 V) := ⟨⊤⟩

lemma top_map {x : V} (hx : x ≠ 0) : (⊤ : enorm 𝕜 V) x = ⊤ := if_neg hx

noncomputable instance : semilattice_sup_top (enorm 𝕜 V) :=
{ le := (≤),
  lt := (<),
  top := ⊤,
  le_top := λ e x, if h : x = 0 then by simp [h] else by simp [top_map h],
  sup := λ e₁ e₂,
  { to_fun := λ x, max (e₁ x) (e₂ x),
    eq_zero' := λ x h, e₁.eq_zero_iff.1 (ennreal.max_eq_zero_iff.1 h).1,
    map_add_le' := λ x y, max_le
      (le_trans (e₁.map_add_le _ _) $ add_le_add (le_max_left _ _) (le_max_left _ _))
      (le_trans (e₂.map_add_le _ _) $ add_le_add (le_max_right _ _) (le_max_right _ _)),
    map_smul_le' := λ c x, le_of_eq $ by simp only [map_smul, ennreal.mul_max] },
  le_sup_left := λ e₁ e₂ x, le_max_left _ _,
  le_sup_right := λ e₁ e₂ x, le_max_right _ _,
  sup_le := λ e₁ e₂ e₃ h₁ h₂ x, max_le (h₁ x) (h₂ x),
  .. enorm.partial_order }

@[simp, norm_cast]

@[norm_cast]
lemma max_map (e₁ e₂ : enorm 𝕜 V) (x : V) : (e₁ ⊔ e₂) x = max (e₁ x) (e₂ x) := rfl

/-- Structure of an `emetric_space` defined by an extended norm. -/
def emetric_space : emetric_space V :=
{ edist := λ x y, e (x - y),
  edist_self := λ x, by simp,
  eq_of_edist_eq_zero := λ x y, by simp [sub_eq_zero],
  edist_comm := e.map_sub_rev,
  edist_triangle := λ x y z,
    calc e (x - z) = e ((x - y) + (y - z)) : by rw [sub_add_sub_cancel]
               ... ≤ e (x - y) + e (y - z) : e.map_add_le (x - y) (y - z) }

/-- The subspace of vectors with finite enorm. -/
def finite_subspace : subspace 𝕜 V :=
{ carrier   := {x | e x < ⊤},
  zero_mem' := by simp,
  add_mem'  := λ x y hx hy, lt_of_le_of_lt (e.map_add_le x y) (ennreal.add_lt_top.2 ⟨hx, hy⟩),
  smul_mem' := λ c x hx,
    calc e (c • x) = nnnorm c * e x : e.map_smul c x
               ... < ⊤              : ennreal.mul_lt_top ennreal.coe_lt_top hx }

/-- Metric space structure on `e.finite_subspace`. We use `emetric_space.to_metric_space_of_dist`
to ensure that this definition agrees with `e.emetric_space`. -/
instance : metric_space e.finite_subspace :=
begin
  letI := e.emetric_space,
  refine emetric_space.to_metric_space_of_dist _ (λ x y, _) (λ x y, rfl),
  change e (x - y) ≠ ⊤,
  rw [← ennreal.lt_top_iff_ne_top],
  exact lt_of_le_of_lt (e.map_sub_le x y) (ennreal.add_lt_top.2 ⟨x.2, y.2⟩)
end

lemma finite_dist_eq (x y : e.finite_subspace) : dist x y = (e (x - y)).to_real := rfl

lemma finite_edist_eq (x y : e.finite_subspace) : edist x y = e (x - y) := rfl

/-- Normed group instance on `e.finite_subspace`. -/
instance : normed_group e.finite_subspace :=
{ norm := λ x, (e x).to_real,
  dist_eq := λ x y, rfl }

lemma finite_norm_eq (x : e.finite_subspace) : ∥x∥ = (e x).to_real := rfl

/-- Normed space instance on `e.finite_subspace`. -/
instance : normed_space 𝕜 e.finite_subspace :=
{ norm_smul_le := λ c x, le_of_eq $ by simp [finite_norm_eq, ennreal.to_real_mul] }

end enorm


/-
Copyright (c) 2022 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Alex J. Best
-/
import linear_algebra.pi
import linear_algebra.quotient

/-!
# Submodule quotients and direct sums

This file contains some results on the quotient of a module by a direct sum of submodules,
and the direct sum of quotients of modules by submodules.

# Main definitions

 * `submodule.pi_quotient_lift`: create a map out of the direct sum of quotients
 * `submodule.quotient_pi_lift`: create a map out of the quotient of a direct sum
 * `submodule.quotient_pi`: the quotient of a direct sum is the direct sum of quotients.

-/

namespace submodule

open linear_map

variables {ι R : Type*} [comm_ring R]
variables {Ms : ι → Type*} [∀ i, add_comm_group (Ms i)] [∀ i, module R (Ms i)]
variables {N : Type*} [add_comm_group N] [module R N]
variables {Ns : ι → Type*} [∀ i, add_comm_group (Ns i)] [∀ i, module R (Ns i)]

/-- Lift a family of maps to the direct sum of quotients. -/
def pi_quotient_lift [fintype ι] [decidable_eq ι]
  (p : ∀ i, submodule R (Ms i)) (q : submodule R N)
  (f : Π i, Ms i →ₗ[R] N) (hf : ∀ i, p i ≤ q.comap (f i)) :
  (Π i, (Ms i ⧸ p i)) →ₗ[R] (N ⧸ q) :=
lsum R (λ i, (Ms i ⧸ (p i))) R (λ i, (p i).mapq q (f i) (hf i))

@[simp] lemma pi_quotient_lift_mk [fintype ι] [decidable_eq ι]
  (p : ∀ i, submodule R (Ms i)) (q : submodule R N)
  (f : Π i, Ms i →ₗ[R] N) (hf : ∀ i, p i ≤ q.comap (f i)) (x : Π i, Ms i) :
  pi_quotient_lift p q f hf (λ i, quotient.mk (x i)) =
    quotient.mk (lsum _ _ R f x) :=
by rw [pi_quotient_lift, lsum_apply, sum_apply, ← mkq_apply, lsum_apply, sum_apply, _root_.map_sum];
   simp only [coe_proj, mapq_apply, mkq_apply, comp_apply]

@[simp] lemma pi_quotient_lift_single [fintype ι] [decidable_eq ι]
  (p : ∀ i, submodule R (Ms i)) (q : submodule R N)
  (f : Π i, Ms i →ₗ[R] N) (hf : ∀ i, p i ≤ q.comap (f i)) (i) (x : Ms i ⧸ p i) :
  pi_quotient_lift p q f hf (pi.single i x) =
    mapq _ _ (f i) (hf i) x :=
begin
  simp_rw [pi_quotient_lift, lsum_apply, sum_apply,
           comp_apply, proj_apply],
  rw finset.sum_eq_single i,
  { rw pi.single_eq_same },
  { rintros j - hj, rw [pi.single_eq_of_ne hj, _root_.map_zero] },
  { intros, have := finset.mem_univ i, contradiction },
end

/-- Lift a family of maps to a quotient of direct sums. -/
def quotient_pi_lift
  (p : ∀ i, submodule R (Ms i))
  (f : Π i, Ms i →ₗ[R] Ns i) (hf : ∀ i, p i ≤ ker (f i)) :
  ((Π i, Ms i) ⧸ pi set.univ p) →ₗ[R] Π i, Ns i :=
(pi set.univ p).liftq (linear_map.pi (λ i, (f i).comp (proj i))) $
λ x hx, mem_ker.mpr $
by { ext i, simpa using hf i (mem_pi.mp hx i (set.mem_univ i)) }

@[simp] lemma quotient_pi_lift_mk
  (p : ∀ i, submodule R (Ms i))
  (f : Π i, Ms i →ₗ[R] Ns i) (hf : ∀ i, p i ≤ ker (f i)) (x : Π i, Ms i) :
  quotient_pi_lift p f hf (quotient.mk x) = λ i, f i (x i) :=
rfl

/-- The quotient of a direct sum is the direct sum of quotients. -/
@[simps] def quotient_pi [fintype ι] [decidable_eq ι]
  (p : ∀ i, submodule R (Ms i)) :
  ((Π i, Ms i) ⧸ pi set.univ p) ≃ₗ[R] Π i, Ms i ⧸ p i :=
{ to_fun := quotient_pi_lift p (λ i, (p i).mkq) (λ i, by simp),
  inv_fun := pi_quotient_lift p (pi set.univ p)
    single (λ i, le_comap_single_pi p),
  left_inv := λ x, quotient.induction_on' x (λ x',
    by simp_rw [quotient.mk'_eq_mk, quotient_pi_lift_mk, mkq_apply,
                pi_quotient_lift_mk, lsum_single, id_apply]),
  right_inv := begin
    rw [function.right_inverse_iff_comp, ← coe_comp, ← @id_coe R],
    refine congr_arg _ (pi_ext (λ i x, quotient.induction_on' x (λ x', funext $ λ j, _))),
    rw [comp_apply, pi_quotient_lift_single, quotient.mk'_eq_mk, mapq_apply,
        quotient_pi_lift_mk, id_apply],
    by_cases hij : i = j; simp only [mkq_apply, coe_single],
    { subst hij, simp only [pi.single_eq_same] },
    { simp only [pi.single_eq_of_ne (ne.symm hij), quotient.mk_zero] },
  end,
  .. quotient_pi_lift p (λ i, (p i).mkq) (λ i, by simp) }

end submodule


/-
Copyright (c) 2019 Johan Commelin All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import topology.opens
import topology.algebra.ring
/-!
# Open subgroups of a topological groups

This files builds the lattice `open_subgroup G` of open subgroups in a topological group `G`,
and its additive version `open_add_subgroup`.  This lattice has a top element, the subgroup of all
elements, but no bottom element in general. The trivial subgroup which is the natural candidate
bottom has no reason to be open (this happens only in discrete groups).

Note that this notion is especially relevant in a non-archimedean context, for instance for
`p`-adic groups.

## Main declarations

* `open_subgroup.is_closed`: An open subgroup is automatically closed.
* `subgroup.is_open_mono`: A subgroup containing an open subgroup is open.
                           There are also versions for additive groups, submodules and ideals.
* `open_subgroup.comap`: Open subgroups can be pulled back by a continuous group morphism.

## TODO
* Prove that the identity component of a locally path connected group is an open subgroup.
  Up to now this file is really geared towards non-archimedean algebra, not Lie groups.
-/

open topological_space
open_locale topological_space

/-- The type of open subgroups of a topological additive group. -/
@[ancestor add_subgroup]
structure open_add_subgroup  (G : Type*) [add_group G] [topological_space G]
  extends add_subgroup G :=
(is_open' : is_open carrier)

/-- The type of open subgroups of a topological group. -/
@[ancestor subgroup, to_additive]
structure open_subgroup (G : Type*) [group G] [topological_space G] extends subgroup G :=
(is_open' : is_open carrier)

/-- Reinterpret an `open_subgroup` as a `subgroup`. -/
add_decl_doc open_subgroup.to_subgroup

/-- Reinterpret an `open_add_subgroup` as an `add_subgroup`. -/
add_decl_doc open_add_subgroup.to_add_subgroup

-- Tell Lean that `open_add_subgroup` is a namespace
namespace open_add_subgroup
end open_add_subgroup

namespace open_subgroup
open function topological_space
variables {G : Type*} [group G] [topological_space G]
variables {U V : open_subgroup G} {g : G}

@[to_additive]
instance has_coe_set : has_coe_t (open_subgroup G) (set G) := ⟨λ U, U.1⟩

@[to_additive]
instance : has_mem G (open_subgroup G) := ⟨λ g U, g ∈ (U : set G)⟩

@[to_additive]
instance has_coe_subgroup : has_coe_t (open_subgroup G) (subgroup G) := ⟨to_subgroup⟩

@[to_additive]
instance has_coe_opens : has_coe_t (open_subgroup G) (opens G) := ⟨λ U, ⟨U, U.is_open'⟩⟩

@[simp, norm_cast, to_additive] lemma mem_coe : g ∈ (U : set G) ↔ g ∈ U := iff.rfl
@[simp, norm_cast, to_additive] lemma mem_coe_opens : g ∈ (U : opens G) ↔ g ∈ U := iff.rfl
@[simp, norm_cast, to_additive]
lemma mem_coe_subgroup : g ∈ (U : subgroup G) ↔ g ∈ U := iff.rfl

@[to_additive] lemma coe_injective : injective (coe : open_subgroup G → set G) :=
by { rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨h⟩, congr, }

@[ext, to_additive]
lemma ext (h : ∀ x, x ∈ U ↔ x ∈ V) : (U = V) := coe_injective $ set.ext h

@[to_additive]
lemma ext_iff : (U = V) ↔ (∀ x, x ∈ U ↔ x ∈ V) := ⟨λ h x, h ▸ iff.rfl, ext⟩

variable (U)
@[to_additive]
protected lemma is_open : is_open (U : set G) := U.is_open'

@[to_additive]
protected lemma one_mem : (1 : G) ∈ U := U.one_mem'

@[to_additive]
protected lemma inv_mem {g : G} (h : g ∈ U) : g⁻¹ ∈ U := U.inv_mem' h

@[to_additive]
protected lemma mul_mem {g₁ g₂ : G} (h₁ : g₁ ∈ U) (h₂ : g₂ ∈ U) : g₁ * g₂ ∈ U := U.mul_mem' h₁ h₂

@[to_additive]
lemma mem_nhds_one : (U : set G) ∈ 𝓝 (1 : G) :=
is_open.mem_nhds U.is_open U.one_mem
variable {U}

@[to_additive]
instance : has_top (open_subgroup G) := ⟨{ is_open' := is_open_univ, .. (⊤ : subgroup G) }⟩

@[to_additive]
instance : inhabited (open_subgroup G) := ⟨⊤⟩

@[to_additive]
lemma is_closed [has_continuous_mul G] (U : open_subgroup G) : is_closed (U : set G) :=
begin
  apply is_open_compl_iff.1,
  refine is_open_iff_forall_mem_open.2 (λ x hx, ⟨(λ y, y * x⁻¹) ⁻¹' U, _, _, _⟩),
  { intros u hux,
    simp only [set.mem_preimage, set.mem_compl_iff, mem_coe] at hux hx ⊢,
    refine mt (λ hu, _) hx,
    convert U.mul_mem (U.inv_mem hux) hu,
    simp },
  { exact U.is_open.preimage (continuous_mul_right _) },
  { simp [U.one_mem] }
end

section
variables {H : Type*} [group H] [topological_space H]

/-- The product of two open subgroups as an open subgroup of the product group. -/
@[to_additive "The product of two open subgroups as an open subgroup of the product group."]
def prod (U : open_subgroup G) (V : open_subgroup H) : open_subgroup (G × H) :=
{ carrier := (U : set G).prod (V : set H),
  is_open' := U.is_open.prod V.is_open,
  .. (U : subgroup G).prod (V : subgroup H) }

end

@[to_additive]
instance : partial_order (open_subgroup G) :=
{ le := λ U V, ∀ ⦃x⦄, x ∈ U → x ∈ V,
  .. partial_order.lift (coe : open_subgroup G → set G) coe_injective }

@[to_additive]
instance : semilattice_inf (open_subgroup G) :=
{ inf := λ U V, { is_open' := is_open.inter U.is_open V.is_open, .. (U : subgroup G) ⊓ V },
  inf_le_left := λ U V, set.inter_subset_left _ _,
  inf_le_right := λ U V, set.inter_subset_right _ _,
  le_inf := λ U V W hV hW, set.subset_inter hV hW,
  ..open_subgroup.partial_order }

@[to_additive]
instance : order_top (open_subgroup G) :=
{ top := ⊤,
  le_top := λ U, set.subset_univ _ }

@[simp, norm_cast, to_additive] lemma coe_inf : (↑(U ⊓ V) : set G) = (U : set G) ∩ V := rfl

@[simp, norm_cast, to_additive] lemma coe_subset : (U : set G) ⊆ V ↔ U ≤ V := iff.rfl

@[simp, norm_cast, to_additive] lemma coe_subgroup_le :
(U : subgroup G) ≤ (V : subgroup G) ↔ U ≤ V := iff.rfl

variables {N : Type*} [group N] [topological_space N]

/-- The preimage of an `open_subgroup` along a continuous `monoid` homomorphism
  is an `open_subgroup`. -/
@[to_additive "The preimage of an `open_add_subgroup` along a continuous `add_monoid` homomorphism
is an `open_add_subgroup`."]
def comap (f : G →* N)
  (hf : continuous f) (H : open_subgroup N) : open_subgroup G :=
{ is_open' := H.is_open.preimage hf,
  .. (H : subgroup N).comap f }

@[simp, to_additive]
lemma coe_comap (H : open_subgroup N) (f : G →* N) (hf : continuous f) :
  (H.comap f hf : set G) = f ⁻¹' H := rfl

@[simp, to_additive]
lemma mem_comap {H : open_subgroup N} {f : G →* N} {hf : continuous f} {x : G} :
  x ∈ H.comap f hf ↔ f x ∈ H := iff.rfl

@[to_additive]
lemma comap_comap {P : Type*} [group P] [topological_space P]
  (K : open_subgroup P) (f₂ : N →* P) (hf₂ : continuous f₂) (f₁ : G →* N) (hf₁ : continuous f₁) :
  (K.comap f₂ hf₂).comap f₁ hf₁ = K.comap (f₂.comp f₁) (hf₂.comp hf₁) :=
rfl

end open_subgroup

namespace subgroup

variables {G : Type*} [group G] [topological_space G] [has_continuous_mul G] (H : subgroup G)

@[to_additive]
lemma is_open_of_mem_nhds {g : G} (hg : (H : set G) ∈ 𝓝 g) :
  is_open (H : set G) :=
begin
  simp only [is_open_iff_mem_nhds, set_like.mem_coe] at hg ⊢,
  intros x hx,
  have : filter.tendsto (λ y, y * (x⁻¹ * g)) (𝓝 x) (𝓝 $ x * (x⁻¹ * g)) :=
    (continuous_id.mul continuous_const).tendsto _,
  rw [mul_inv_cancel_left] at this,
  have := filter.mem_map'.1 (this hg),
  replace hg : g ∈ H := set_like.mem_coe.1 (mem_of_mem_nhds hg),
  simp only [set_like.mem_coe, H.mul_mem_cancel_right (H.mul_mem (H.inv_mem hx) hg)] at this,
  exact this
end

@[to_additive]
lemma is_open_of_open_subgroup {U : open_subgroup G} (h : U.1 ≤ H) :
  is_open (H : set G) :=
H.is_open_of_mem_nhds (filter.mem_of_superset U.mem_nhds_one h)

@[to_additive]

end subgroup

namespace open_subgroup

variables {G : Type*} [group G] [topological_space G] [has_continuous_mul G]

@[to_additive]
instance : semilattice_sup (open_subgroup G) :=
{ sup := λ U V,
  { is_open' := show is_open (((U : subgroup G) ⊔ V : subgroup G) : set G),
    from subgroup.is_open_mono le_sup_left U.is_open,
    .. ((U : subgroup G) ⊔ V) },
  le_sup_left := λ U V, coe_subgroup_le.1 le_sup_left,
  le_sup_right := λ U V, coe_subgroup_le.1 le_sup_right,
  sup_le := λ U V W hU hV, coe_subgroup_le.1 (sup_le hU hV),
  ..open_subgroup.semilattice_inf }

@[to_additive]
instance : lattice (open_subgroup G) :=
{ ..open_subgroup.semilattice_sup, ..open_subgroup.semilattice_inf }

end open_subgroup

namespace submodule
open open_add_subgroup
variables {R : Type*} {M : Type*} [comm_ring R]
variables [add_comm_group M] [topological_space M] [topological_add_group M] [module R M]

lemma is_open_mono {U P : submodule R M} (h : U ≤ P) (hU : is_open (U : set M)) :
  is_open (P : set M) :=
@add_subgroup.is_open_mono M _ _ _ U.to_add_subgroup P.to_add_subgroup h hU

end submodule

namespace ideal
variables {R : Type*} [comm_ring R]
variables [topological_space R] [topological_ring R]

lemma is_open_of_open_subideal {U I : ideal R} (h : U ≤ I) (hU : is_open (U : set R)) :
  is_open (I : set R) :=
submodule.is_open_mono h hU

end ideal


-- vim: ts=2 sw=0 sts=-1 et ai tw=70

import ..logic
import .functions

namespace hidden
namespace myset

universes u v w

open myset

variables {α : Type u} {β : Type v} {γ : Type w}

section definitions
  variables (s : myset α) (t : myset β)

  def card_le : Prop :=
  ∃ f : α → β, ∃ h: well_defined s t f, (injective h)
  def card_ge : Prop :=
  ∃ f : α → β, ∃ h: well_defined s t f, (surjective h)
  -- of same cardinality
  def equinumerous : Prop :=
  ∃ f : α → β, ∃ h: well_defined s t f, (bijective h)

end definitions

-- The trivial function from a set to itself is well defined
theorem trivial_well_defined (s : myset α):
well_defined s s (λ a, a) :=
begin
  intro a,
  assume h,
  assumption,
end
theorem trivial_injective (s : myset α):
injective (trivial_well_defined s) :=
begin
  intros a₁ a₂,
  assume h₁ h₂ hneq,
  assumption,
end
theorem trivial_surjective (s : myset α):
surjective (trivial_well_defined s) :=
begin
  intro a,
  assume h,
  existsi a,
  split,
    from h,
  refl,
end

@[refl]
theorem card_le_refl (s : myset α) :
card_le s s :=
begin
  let f := (λ a : α, a),
  let h := trivial_well_defined s,
  existsi f,
  existsi h,
  from trivial_injective s,
end
@[refl]
theorem card_ge_refl (s : myset α) :
card_ge s s :=
begin
  let f := (λ a : α, a),
  let h := trivial_well_defined s,
  existsi f,
  existsi h,
  from trivial_surjective s,
end
@[refl]
theorem equinumerous_refl (s : myset α) :
equinumerous s s :=
begin
  let f := (λ a : α, a),
  have h := trivial_well_defined s,
  existsi f,
  existsi h,
  split,
    from trivial_injective s,
  from trivial_surjective s,
end

@[symm]
theorem equinumerous_symm (s : myset α) (t : myset β) :
equinumerous s t → equinumerous t s := sorry

@[trans]
theorem equinumerous_trans (r : myset α) (s : myset β) (t : myset γ) :
equinumerous r s → equinumerous s t → equinumerous r t :=
begin
  assume hrs hst,
  cases hrs with f hf,
  cases hf with hwf hf,
  cases hst with g hg,
  cases hg with hwg hg,
  existsi g ∘ f,
  existsi composition_well_defined hwf hwg,
  from bij_bij hwf hwg hf hg,
end

section -- for classical logic
open classical
local attribute [instance] prop_decidable

theorem card_ne_power_set (s : myset α) :
¬equinumerous s (power_set s) :=
begin
  assume heq,
  cases heq with f hf,
  cases hf with hwell hbi,
  cases hbi with hinj hsurj,
  suffices hcontra : ∃ t : myset α, t ∈ (power_set s) ∧
                     ∀ a : α, a ∈ s → f a ≠ t, {
    cases hcontra with t ht,
    cases hsurj t ht.left with preim hpreim,
    from ht.right preim hpreim.left hpreim.right,
  },
  let t := λ a : α, a ∈ s ∧ ¬(a ∈ f a),
  existsi t,
  split, {
    intro a,
    assume hta,
    from hta.left,
  }, {
    intro a,
    assume h heq,
    have hnta : ¬(t a), {
      assume hta,
      have haninfa := hta.right,
      rw heq at haninfa,
      contradiction,
    },
    have hta : t a, {
      rw not_and at hnta,
      have hnin := hnta h,
      rw [not_not, heq] at hnin,
      from hnin,
    },
    contradiction,
  },
end
end -- for classical logic

theorem schroeder_bernstein_theorem
{s : myset α} {t : myset β}:
card_le s t → card_ge s t → equinumerous s t := sorry

variables {r : myset α} {s : myset β} {t : myset γ}
variables {f : α → β} (hwf : well_defined r s f)

include hwf

def restriction (r': myset α):
r' ⊆ r → (α → β) := (λ _ a, f a)

omit hwf

theorem restriction_well_defined
(r': myset α) (hrss: r' ⊆ r):
well_defined r' s (restriction hwf r' hrss) :=
begin
  intro a,
  assume har',
  apply hwf,
  apply hrss,
  from har',
end

-- this can probably be shorter but I keep getting confused by all the
-- definitions
theorem restriction_injective
(r': myset α) (hrss: r' ⊆ r)
(hif: injective hwf):
injective (restriction_well_defined hwf r' hrss) :=
begin
  intros a b,
  assume har' hbr' hrarb,
  apply hif _ _ _ _ _, {
    from hrss _ har',
  }, {
    from hrss _ hbr',
  }, {
    from hrarb,
  },
end

end myset
end hidden