/-
Copyright (c) 2019 The Flypitch Project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Jesse Han, Floris van Doorn
-/
import .compactness

open set function nat
universe variable u
namespace fol

local notation h :: t  := dvector.cons h t
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`:0) := l

namespace Language
def Lconstants (α : Type u) : Language :=
⟨λn, nat.rec α (λn ih, pempty) n, λn, pempty⟩

protected def sum (L L' : Language) : Language :=
⟨λn, L.functions n ⊕ L'.functions n, λ n, L.relations n ⊕ L'.relations n⟩

def symbols (L : Language) := (Σl, L.functions l) ⊕ (Σl, L.relations l)
end Language

section
variable {L : Language}

@[simp] def symbols_in_term : ∀{l}, preterm L l → set L.symbols
| _ &k          := ∅
| l (func f)    := {sum.inl ⟨l,f⟩}
| _ (app t₁ t₂) := symbols_in_term t₁ ∪ symbols_in_term t₂

@[simp] def symbols_in_formula : ∀{l}, preformula L l → set L.symbols
| _ falsum       := ∅
| _ (t₁ ≃ t₂)    := symbols_in_term t₁ ∪ symbols_in_term t₂
| l (rel R)      := {sum.inr ⟨l, R⟩}
| _ (apprel f t) := symbols_in_formula f ∪ symbols_in_term t
| _ (f₁ ⟹ f₂)   := symbols_in_formula f₁ ∪ symbols_in_formula f₂
| _ (∀' f)       := symbols_in_formula f

@[simp] lemma symbols_in_term_lift_at (n m) : ∀{l} (t : preterm L l),
  symbols_in_term (t ↑' n # m) = symbols_in_term t
| _ &k          := by by_cases h : m ≤ k; simp [h]
| l (func f)    := rfl
| _ (app t₁ t₂) := by simp*

@[simp] lemma symbols_in_term_lift (n) {l} (t : preterm L l) :
  symbols_in_term (t ↑ n) = symbols_in_term t :=
symbols_in_term_lift_at n 0 t

lemma symbols_in_term_subst (s : term L) (n) : ∀{l} (t : preterm L l),
  symbols_in_term (t[s // n]) ⊆ symbols_in_term t ∪ symbols_in_term s
| _ &k          :=
by apply lt_by_cases n k; intro h;
   simp only [set.empty_subset, fol.symbols_in_term.equations._eqn_1,
     fol.subst_term_var_gt, set.empty_union, fol.lift_term_def, fol.subst_term_var_eq,
     fol.symbols_in_term_lift, h, fol.subst_term_var_lt, set.empty_union]
| _ (func f)    := subset_union_left _ _
| _ (app t₁ t₂) :=
  by { simp; split; refine subset.trans (symbols_in_term_subst _) _;
       simp [subset_union2_left, subset_union2_middle] }

lemma symbols_in_formula_subst : ∀{l} (f : preformula L l) (s : term L) (n),
  symbols_in_formula (f[s // n]) ⊆ symbols_in_formula f ∪ symbols_in_term s
| _ falsum       s n := empty_subset _
| _ (t₁ ≃ t₂)    s n :=
  by { simp; split; refine subset.trans (symbols_in_term_subst _ _ _) _;
       simp [subset_union2_left, subset_union2_middle] }
| _ (rel R)      s n := subset_union_left _ _
| _ (apprel f t) s n :=
  by { simp; split; [refine subset.trans (symbols_in_formula_subst _ _ _) _,
         refine subset.trans (symbols_in_term_subst _ _ _) _];
       simp [subset_union2_left, subset_union2_middle] }
| _ (f₁ ⟹ f₂)   s n :=
  by { simp; split; refine subset.trans (symbols_in_formula_subst _ _ _) _;
       simp [subset_union2_left, subset_union2_middle] }
| _ (∀' f)       s n := symbols_in_formula_subst f _ _

end

-- def symbols_in_prf : ∀{Γ : set $ formula L} {f : formula L} (P : Γ ⊢ f), set L.symbols
-- | Γ f (axm h)              := symbols_in_formula f
-- | Γ (f₁ ⟹ f₂) (impI P)    := symbols_in_prf P ∪ symbols_in_formula f₁
-- | Γ f₂ (impE f₁ P₁ P₂)     := symbols_in_prf P₁ ∪ symbols_in_prf P₂
-- | Γ f (falsumE P)          := symbols_in_prf P ∪ symbols_in_formula f
-- | Γ (∀' f) (allI P)        := symbols_in_prf P
-- | Γ _ (allE₂ f t P)        := symbols_in_prf P ∪ symbols_in_term t
-- | Γ (_ ≃ t) (ref _ _)     := symbols_in_term t
-- | Γ _ (subst₂ s t f P₁ P₂) := symbols_in_prf P₁ ∪ symbols_in_prf P₂

-- def interpolation : ∀{Γ : set $ formula L} {f : formula L} (P : Γ ⊢ f),
--   Σ' (f' : formula L) (P₁ : Γ ⊢ f') (P₂ : {f'} ⊢ f),
--     symbols_in_prf P₁ ⊆ ⋃₀ (symbols_in_formula '' Γ) ∧
--     symbols_in_prf P₂ ⊆ symbols_in_formula f ∧
--     symbols_in_formula f' ⊆ ⋃₀ (symbols_in_formula '' Γ) ∩ symbols_in_formula f :=
-- sorry -- probably the last property follows automatically

structure Lhom (L L' : Language) :=
(on_function : ∀{n}, L.functions n → L'.functions n)
(on_relation : ∀{n}, L.relations n → L'.relations n)

infix ` →ᴸ `:10 := Lhom -- \^L

namespace Lhom
/- -/
variables {L : Language.{u}} {L' : Language.{u}} (ϕ : L →ᴸ L')

def cast1 {L0 L1 : Language} (heq : L0 = L1) : L0 →ᴸ L1 :=
⟨λ n, cast (by rw heq) , λ n, cast (by rw heq)⟩

protected def id (L : Language) : L →ᴸ L :=
⟨λn, id, λ n, id⟩

protected def sum_inl {L L' : Language} : L →ᴸ L.sum L' :=
⟨λn, sum.inl, λ n, sum.inl⟩

protected def sum_inr {L L' : Language} : L' →ᴸ L.sum L' :=
⟨λn, sum.inr, λ n, sum.inr⟩

@[reducible]def comp {L1} {L2} {L3} (g : L2 →ᴸ L3) (f : L1 →ᴸ L2) : L1 →ᴸ L3 :=
begin
--  rcases g with ⟨g1, g2⟩, rcases f with ⟨f1,f2⟩,
--  exact ⟨λn, g1 ∘ f1, λn, g2 ∘ f2⟩
split,
  all_goals{intro n},
  let g1 := g.on_function, let f1 := f.on_function,-- Lean's not letting me "@" g.on_function etc
    exact (@g1 n) ∘ (@f1 n),
  let g2 := g.on_relation, let f2 := f.on_relation,
    exact (@g2 n) ∘ (@f2 n)
end

lemma Lhom_funext {L1} {L2} {F G : L1 →ᴸ L2} (h_fun : F.on_function = G.on_function ) (h_rel : F.on_relation = G.on_relation ) : F = G :=
by {cases F with Ff Fr, cases G with Gf Gr, simp only *, exact and.intro h_fun h_rel}

local infix ` ∘ `:60 := Lhom.comp

@[simp]lemma id_is_left_identity {L1 L2} {F : L1 →ᴸ L2} : (Lhom.id L2) ∘ F = F := by {cases F, refl}

@[simp]lemma trivial_cast1_is_left_identity {L1 L2} {F : L1 →ᴸ L2} :
  (@Lhom.cast1 L2 L2 rfl) ∘ F = F := by {cases F, refl}

@[simp]lemma id_is_right_identity {L1 L2} {F : L1 →ᴸ L2} : F ∘ (Lhom.id L1) = F := by {cases F, refl}

@[simp]lemma trivial_cast1_is_right_identity {L1 L2} {F : L1 →ᴸ L2} :
  F ∘ (@Lhom.cast1 L1 L1 rfl) = F := by {cases F, refl}

structure is_injective : Prop :=
(on_function {n} : injective (on_function ϕ : L.functions n → L'.functions n))
(on_relation {n} : injective (on_relation ϕ : L.relations n → L'.relations n))

class has_decidable_range : Type u :=
(on_function {n} : decidable_pred (range (on_function ϕ : L.functions n → L'.functions n)))
(on_relation {n} : decidable_pred (range (on_relation ϕ : L.relations n → L'.relations n)))

attribute [instance] has_decidable_range.on_function has_decidable_range.on_relation

@[simp] def on_symbol : L.symbols → L'.symbols
| (sum.inl ⟨l, f⟩) := sum.inl ⟨l, ϕ.on_function f⟩
| (sum.inr ⟨l, R⟩) := sum.inr ⟨l, ϕ.on_relation R⟩

@[simp] def on_term : ∀{l}, preterm L l → preterm L' l
| _ &k          := &k
| _ (func f)    := func $ ϕ.on_function f
| _ (app t₁ t₂) := app (on_term t₁) (on_term t₂)

@[simp] lemma on_term_lift_at : ∀{l} (t : preterm L l) (n m : ℕ),
  ϕ.on_term (t ↑' n # m) = ϕ.on_term t ↑' n # m
| _ &k          n m := rfl
| _ (func f)    n m := rfl
| _ (app t₁ t₂) n m := by simp*

@[simp] lemma on_term_lift {l} (n : ℕ) (t : preterm L l) : ϕ.on_term (t ↑ n) = ϕ.on_term t ↑ n :=
ϕ.on_term_lift_at t n 0

@[simp] lemma on_term_subst : ∀{l} (t : preterm L l) (s : term L) (n : ℕ),
  ϕ.on_term (t[s // n]) = ϕ.on_term t[ϕ.on_term s // n]
| _ &k          s n := by apply lt_by_cases k n; intro h; simp only [h,
  subst_term_var_lt, on_term, subst_term_var_eq, on_term_lift, subst_term_var_gt]
| _ (func f)    s n := rfl
| _ (app t₁ t₂) s n := by simp*

@[simp] def on_term_apps : ∀{l} (t : preterm L l) (ts : dvector (term L) l),
  ϕ.on_term (apps t ts) = apps (ϕ.on_term t) (ts.map ϕ.on_term)
| _ t []       := rfl
| _ t (t'::ts) := by simp*

lemma not_mem_symbols_in_term_on_term {s : L'.symbols} (h : s ∉ range (ϕ.on_symbol)) :
  ∀{l} (t : preterm L l), s ∉ symbols_in_term (ϕ.on_term t)
| _ &k          h' := not_mem_empty _ h'
| l (func f)    h' := h ⟨sum.inl ⟨l, f⟩, (eq_of_mem_singleton h').symm⟩
| _ (app t₁ t₂) h' :=
  or.elim h' (not_mem_symbols_in_term_on_term t₁) (not_mem_symbols_in_term_on_term t₂)

@[simp] def on_formula : ∀{l}, preformula L l → preformula L' l
| _ falsum       := falsum
| _ (t₁ ≃ t₂)    := ϕ.on_term t₁ ≃ ϕ.on_term t₂
| _ (rel R)      := rel $ ϕ.on_relation R
| _ (apprel f t) := apprel (on_formula f) $ ϕ.on_term t
| _ (f₁ ⟹ f₂)   := on_formula f₁ ⟹ on_formula f₂
| _ (∀' f)       := ∀' on_formula f

@[simp] lemma on_formula_lift_at : ∀{l} (n m : ℕ) (f : preformula L l),
  ϕ.on_formula (f ↑' n # m) = ϕ.on_formula f ↑' n # m
| _ n m falsum       := rfl
| _ n m (t₁ ≃ t₂)    := by simp
| _ n m (rel R)      := rfl
| _ n m (apprel f t) := by simp*
| _ n m (f₁ ⟹ f₂)   := by simp*
| _ n m (∀' f)       := by simp*

@[simp] lemma on_formula_lift {l} (n : ℕ) (f : preformula L l) :
  ϕ.on_formula (f ↑ n) = ϕ.on_formula f ↑ n :=
ϕ.on_formula_lift_at n 0 f

@[simp] lemma on_formula_subst : ∀{l} (f : preformula L l) (s : term L) (n : ℕ),
  ϕ.on_formula (f[s // n]) = (ϕ.on_formula f)[ϕ.on_term s // n]
| _ falsum       s n := rfl
| _ (t₁ ≃ t₂)    s n := by simp
| _ (rel R)      s n := rfl
| _ (apprel f t) s n := by simp*
| _ (f₁ ⟹ f₂)   s n := by simp*
| _ (∀' f)       s n := by simp*

@[simp] def on_formula_apps_rel : ∀{l} (f : preformula L l) (ts : dvector (term L) l),
  ϕ.on_formula (apps_rel f ts) = apps_rel (ϕ.on_formula f) (ts.map ϕ.on_term)
| _ f []       := rfl
| _ f (t'::ts) := by simp*

lemma not_mem_symbols_in_formula_on_formula {s : L'.symbols} (h : s ∉ range (ϕ.on_symbol)) :
  ∀{l} (f : preformula L l), s ∉ symbols_in_formula (ϕ.on_formula f)
| _ falsum       h' := not_mem_empty _ h'
| _ (t₁ ≃ t₂)    h' := by cases h'; apply not_mem_symbols_in_term_on_term ϕ h _ h'
| l (rel R)      h' := h ⟨sum.inr ⟨l, R⟩, (eq_of_mem_singleton h').symm⟩
| _ (apprel f t) h' :=
  by { cases h', apply not_mem_symbols_in_formula_on_formula _ h',
       apply not_mem_symbols_in_term_on_term ϕ h _ h' }
| _ (f₁ ⟹ f₂)   h' := by cases h'; apply not_mem_symbols_in_formula_on_formula _ h'
| _ (∀' f)       h' := not_mem_symbols_in_formula_on_formula f h'

lemma not_mem_function_in_formula_on_formula {l'} {f' : L'.functions l'}
  (h : f' ∉ range (@on_function _ _ ϕ l')) {l} (f : preformula L l) :
  (sum.inl ⟨l', f'⟩ : L'.symbols) ∉ symbols_in_formula (ϕ.on_formula f) :=
begin
  apply not_mem_symbols_in_formula_on_formula,
  intro h', apply h,
  rcases h' with ⟨⟨n, f⟩ | ⟨n, R⟩, hf₂⟩; dsimp at hf₂; cases hf₂ with hf₂',
  apply mem_range_self
end

@[simp] def on_bounded_term {n} : ∀{l} (t : bounded_preterm L n l), bounded_preterm L' n l
| _ &k           := &k
| _ (bd_func f)  := bd_func $ ϕ.on_function f
| _ (bd_app t s) := bd_app (on_bounded_term t) (on_bounded_term s)

@[simp] def on_bounded_term_fst {n} : ∀{l} (t : bounded_preterm L n l),
  (ϕ.on_bounded_term t).fst = ϕ.on_term t.fst
| _ &k           := rfl
| _ (bd_func f)  := rfl
| _ (bd_app t s) := by dsimp; simp*

lemma on_bounded_term_subst_bounded_term {L0 L1} {F : L0 →ᴸ L1} {c : L0.constants}
  {n n' : ℕ} : Π {l : ℕ} {t : bounded_preterm L0 (n + n' + 1) l},
  F.on_bounded_term (subst_bounded_term t (bd_const c)) =
    subst_bounded_term (F.on_bounded_term t) (bd_const (F.on_function c))
| _ (bd_var k)     :=
begin
  by_cases hkn : k.val < n,
  { simp only [Lhom.on_bounded_term, subst_bounded_term, dif_pos hkn] },
  { by_cases hnk : n < k.val,
    {simp only [Lhom.on_bounded_term, subst_bounded_term, dif_neg hkn,
      dif_pos hnk]},
    {simpa only [Lhom.on_bounded_term, subst_bounded_term, dif_neg hkn,
      dif_neg hnk]},},
end
| _ (bd_func f)    := rfl
| _ (bd_app t₁ t₂) :=
begin
  simp only [Lhom.on_bounded_term, subst_bounded_term],
  split,
  exact on_bounded_term_subst_bounded_term,
  exact on_bounded_term_subst_bounded_term,
end

@[simp] def on_bounded_formula : ∀{n l} (f : bounded_preformula L n l), bounded_preformula L' n l
| _ _ bd_falsum       := ⊥
| _ _ (t₁ ≃ t₂)       := ϕ.on_bounded_term t₁ ≃ ϕ.on_bounded_term t₂
| _ _ (bd_rel R)      := bd_rel $ ϕ.on_relation R
| _ _ (bd_apprel f t) := bd_apprel (on_bounded_formula f) $ ϕ.on_bounded_term t
| _ _ (f₁ ⟹ f₂)      := on_bounded_formula f₁ ⟹ on_bounded_formula f₂
| _ _ (∀' f)          := ∀' on_bounded_formula f

@[simp] def on_bounded_formula_fst : ∀{n l} (f : bounded_preformula L n l),
  (ϕ.on_bounded_formula f).fst = ϕ.on_formula f.fst
| _ _ bd_falsum       := rfl
| _ _ (t₁ ≃ t₂)       := by simp
| _ _ (bd_rel R)      := rfl
| _ _ (bd_apprel f t) := by simp*
| _ _ (f₁ ⟹ f₂)      := by simp*
| _ _ (∀' f)          := by simp*

lemma on_bounded_formula_fst_imp : ∀{n} (f₁ f₂ : bounded_preformula L n 0),
  (ϕ.on_bounded_formula (f₁ ⟹ f₂)).fst = ϕ.on_formula (f₁ ⟹ f₂).fst
:= by simp*

lemma on_bounded_formula_fst_ex : ∀{n} (f : bounded_preformula L (n+1) 0),
  (ϕ.on_bounded_formula (∃' f)).fst = ϕ.on_formula (∃' f).fst
:= by simp*

lemma on_bounded_formula_all {n} (f : bounded_preformula L (n+1) 0) :
  ∀' ϕ.on_bounded_formula f = ϕ.on_bounded_formula (∀' f)
:= by simp*

lemma on_bounded_formula_not {n} (f : bounded_preformula L n 0) :
  bd_not (ϕ.on_bounded_formula f) = ϕ.on_bounded_formula (bd_not f)
:= by simp [bd_not]

lemma on_bounded_formula_ex {n} (f : bounded_preformula L (n+1) 0) :
  ∃' ϕ.on_bounded_formula f = ϕ.on_bounded_formula (∃' f)
:= by simp only [bd_ex, on_bounded_formula_not, on_bounded_formula_all]

lemma on_bounded_term_cast {n} : Π {m l} {t : bounded_preterm L n l} {h : n ≤ m},
  ϕ.on_bounded_term (bounded_preterm.cast h t) =
    bounded_preterm.cast h (ϕ.on_bounded_term t)
| _ _ &k           _ := rfl
| _ _ (bd_func f)  _ := rfl
| _ _ (bd_app t s) _ :=
begin
  rw bounded_preterm.cast,
  rw on_bounded_term,
  rw @on_bounded_term_cast _ _ t,
  rw @on_bounded_term_cast _ _ s,
  refl,
end

lemma on_bounded_formula_cast {L0 L1} {F : L0 →ᴸ L1} :
  Π {n m l} {h : n ≤ m} {ψ : bounded_preformula L0 n l},
      F.on_bounded_formula (bounded_preformula.cast h ψ) =
    bounded_preformula.cast h (F.on_bounded_formula ψ)
| _ _ _ h bd_falsum       := rfl
| _ _ _ h (t₁ ≃ t₂)       :=
by simp only [bounded_preformula.cast, Lhom.on_bounded_formula,
    Lhom.on_bounded_term_cast, eq_self_iff_true, and_self, cast_eq]
| _ _ _ h (bd_rel R)      := rfl
| _ _ _ h (bd_apprel f t) :=
by simp only [bounded_preformula.cast, Lhom.on_bounded_formula,
    Lhom.on_bounded_term_cast, @on_bounded_formula_cast _ _ _ _ f,
    eq_self_iff_true, and_self, cast_eq]
| _ _ _ h (f₁ ⟹ f₂)     :=
by simp only [bounded_preformula.cast, Lhom.on_bounded_formula,
    Lhom.on_bounded_term_cast, @on_bounded_formula_cast _ _ _ _ f₁,
    @on_bounded_formula_cast _ _ _ _ f₂,
    eq_self_iff_true, and_self, cast_eq]
| _ _ _ h (∀' f)          :=
by simp only [bounded_preformula.cast, Lhom.on_bounded_formula,
    @on_bounded_formula_cast _ _ _ _ f]

lemma on_bounded_formula_cast1 : ∀{n l} (f : bounded_preformula L n l),
  ϕ.on_bounded_formula f.cast1
  =
  (ϕ.on_bounded_formula f).cast1
| _ _ bd_falsum       := rfl
| _ _ (t₁ ≃ t₂)       :=
by simp only [bounded_preformula.cast1, bounded_preformula.cast,
    on_bounded_formula, on_bounded_term_cast, eq_self_iff_true, true_and]
| _ _ (bd_rel R)      :=
by simp only [bounded_preformula.cast1, bounded_preformula.cast,
    on_bounded_formula]
| _ _ (bd_apprel f t) :=
begin
  simp only [bounded_preformula.cast1, bounded_preformula.cast,
    on_bounded_formula, on_bounded_term_cast, eq_self_iff_true, and_true],
  exact on_bounded_formula_cast1 f,
end
| _ _ (f₁ ⟹ f₂)      :=
begin
  simp only [bounded_preformula.cast1, bounded_preformula.cast,
  on_bounded_formula],
  split,
  repeat {apply on_bounded_formula_cast1},
end
| _ _ (∀' f)          :=
begin
  simp only [bounded_preformula.cast1, bounded_preformula.cast,
    on_bounded_formula],
  apply on_bounded_formula_cast1,
end

lemma on_bounded_formula_subst_bounded_formula
  {L0 L1} {F : L0 →ᴸ L1} {c : L0.constants}
  : Π {n n' n'' l} {ψ : bounded_preformula L0 n'' l} {h : n + (n' + 1) = n''},
  F.on_bounded_formula (subst_bounded_formula ψ (bd_const c) h) =
  subst_bounded_formula (F.on_bounded_formula ψ) (bd_const (F.on_function c)) h
| _ _ _ _ bd_falsum       rfl := rfl
| _ _ _ _ (t₁ ≃ t₂)       rfl :=
by simp only [Lhom.on_bounded_formula,
  subst_bounded_formula_term, bounded_preformula.cast_eq,
  Lhom.on_bounded_term_cast, on_bounded_term_subst_bounded_term,
  eq_self_iff_true, and_self, cast_eq]
| _ _ _ _ (bd_rel R)      rfl :=
by simp only [subst_bounded_formula, Lhom.on_bounded_formula]
| _ _ _ _ (bd_apprel f t) rfl :=
by simp only [subst_bounded_formula, Lhom.on_bounded_formula,
  @on_bounded_formula_subst_bounded_formula _ _ _ _ f,
  on_bounded_term_subst_bounded_term, eq_self_iff_true, and_self]
| _ _ _ _ (f₁ ⟹ f₂)     rfl :=
by simp only [subst_bounded_formula, Lhom.on_bounded_formula,
  @on_bounded_formula_subst_bounded_formula _ _ _ _ f₁,
  @on_bounded_formula_subst_bounded_formula _ _ _ _ f₂,
  eq_self_iff_true, and_self]
| _ _ _ _ (∀' f)          rfl :=
by simp only [subst_bounded_formula, Lhom.on_bounded_formula,
    bounded_preformula.cast_eq, on_bounded_formula_cast];
   rw ← @on_bounded_formula_subst_bounded_formula _ _ _ _ f

lemma on_bounded_formula_subst0_bounded_formula
  {L0 L1} {F : L0 →ᴸ L1} {c : L0.constants}
  {n l} {ψ : bounded_preformula L0 (n+1) l} :
  F.on_bounded_formula (ψ[bd_const c /0]) =
  (F.on_bounded_formula ψ)[bd_const (F.on_function c) /0] :=
by simp only [subst0_bounded_formula, bounded_preformula.cast_eq,
    on_bounded_formula_cast, on_bounded_formula_subst_bounded_formula]

/- Various lemmas of the shape "on_etc is a functor to Type*" -/
@[simp]lemma comp_on_function {L1} {L2} {L3} (g : L2 →ᴸ L3) (f : L1 →ᴸ L2):
      (g ∘ f).on_function =
      begin intro n, let g1 := g.on_function, let f1 := f.on_function,
      exact function.comp (@g1 n) (@f1 n) end
      := rfl

/- comp_on_function with explicit nat parameter -/
@[simp]lemma comp_on_function' {L1} {L2} {L3} (g : L2 →ᴸ L3) (f : L1 →ᴸ L2) (n):
      @on_function L1 L3 (g ∘ f) n  =
      function.comp (@on_function L2 L3 g n) (@on_function L1 L2 f n)
      := rfl

@[simp]lemma comp_on_relation {L1} {L2} {L3} (g : L2 →ᴸ L3) (f : L1 →ᴸ L2) :
      (g ∘ f).on_relation =
      begin intro n, let g1 := g.on_relation, let f1 := f.on_relation,
      exact function.comp (@g1 n) (@f1 n) end
      := rfl

/- comp_on_relation with explicit nat parameter -/
@[simp]lemma comp_on_relation' {L1} {L2} {L3} (g : L2 →ᴸ L3) (f : L1 →ᴸ L2) (n):
      @on_relation L1 L3 (g ∘ f) n  =
      function.comp (@on_relation L2 L3 g n) (@on_relation L1 L2 f n)
      := rfl

@[simp]lemma comp_on_term {L1} {L2} {L3} {l : ℕ} (g : L2 →ᴸ L3) (f : L1 →ᴸ L2) :
@on_term L1 L3 (g ∘ f) l = function.comp (@on_term L2 L3 g l) (@on_term L1 L2 f l) :=
by {fapply funext, intro x, induction x, tidy}

@[simp]lemma comp_on_formula {L1} {L2} {L3} {l : ℕ}(g : L2 →ᴸ L3) (f : L1 →ᴸ L2) :
@on_formula L1 L3 (g ∘ f) l = function.comp (@on_formula L2 L3 g l) (@on_formula L1 L2 f l) :=
by {fapply funext, intro x, induction x, tidy, all_goals{rw[comp_on_term]} }

@[simp]lemma comp_on_bounded_term {L1} {L2} {L3} {n l : ℕ}(g : L2 →ᴸ L3) (f : L1 →ᴸ L2) :
@on_bounded_term L1 L3 (g ∘ f) n l = function.comp (@on_bounded_term L2 L3 g n l) (@on_bounded_term L1 L2 f n l) :=
funext $ λ _, by tidy

@[simp]lemma comp_on_bounded_formula {L1} {L2} {L3} {n l : ℕ}(g : L2 →ᴸ L3) (f : L1 →ᴸ L2) :
@on_bounded_formula L1 L3 (g ∘ f) n l = function.comp (@on_bounded_formula L2 L3 g n l) (@on_bounded_formula L1 L2 f n l) :=
by {apply funext, intro x, ext, induction x; simp}

lemma id_term {L} : Πl, Π f, (@on_term L L (Lhom.id L) l) f = f
| _ &k          := rfl
| _ (func f)    := rfl
| l (app t₁ t₂) := by simp[id_term (l+1) t₁, id_term 0 t₂]

lemma id_formula {L} : Π l, Π f, (@on_formula L L (Lhom.id L) l) f = f
| _   falsum        := rfl
| _ (t₁ ≃ t₂)         := by simp[id_term]
| _ (rel R)       := rfl
| l (apprel f t)  := by {dsimp, rw[id_formula _ f, id_term _ t]}
| _ (f₁ ⟹ f₂)    := by {dsimp, rw[id_formula _ f₁, id_formula _ f₂]}
| _ (∀' f)        := by {dsimp, rw[id_formula _ f]}

lemma id_bounded_term {L} (n) : Πl, Π f, (@on_bounded_term L L (Lhom.id L) n l) f = f
| _ (bd_var k) := rfl
| _ (bd_func k) := rfl
| l (bd_app t₁ t₂) := by simp[id_bounded_term (l+1) t₁, id_bounded_term 0 t₂]

lemma id_bounded_formula {L} : Π n l, Π f, (@on_bounded_formula L L (Lhom.id L) n l) f = f
| _ _   bd_falsum        := rfl
| _ _ (t₁ ≃ t₂)         := by simp[id_bounded_term]
| _ _ (bd_rel R)       := rfl
| _ l (bd_apprel f t)  := by {dsimp, rw[id_bounded_formula _ _ f, id_bounded_term _ _ t]}
| _ _ (f₁ ⟹ f₂)    := by {dsimp, rw[id_bounded_formula _ _ f₁, id_bounded_formula _ _ f₂]}
| _ _ (∀' f)        := by {dsimp, rw[id_bounded_formula _ _ f]}

@[simp] def on_closed_term (t : closed_term L) : closed_term L' := ϕ.on_bounded_term t
@[simp] def on_sentence (f : sentence L) : sentence L' := ϕ.on_bounded_formula f
def on_sentence_fst (f : sentence L) : (ϕ.on_sentence f).fst = ϕ.on_formula f.fst :=
ϕ.on_bounded_formula_fst f

def on_prf {Γ : set $ formula L} {f : formula L} (h : Γ ⊢ f) : ϕ.on_formula '' Γ ⊢ ϕ.on_formula f :=
begin
  induction h,
  { apply axm, exact mem_image_of_mem _ h_h, },
  { apply impI, rw [←image_insert_eq], exact h_ih },
  { exact impE _ h_ih_h₁ h_ih_h₂, },
  { apply falsumE, rw [image_insert_eq] at h_ih, exact h_ih },
  { apply allI, rw [image_image] at h_ih ⊢, simp [image_congr' (on_formula_lift ϕ 1)] at h_ih,
    exact h_ih },
  { apply allE _ _ h_ih, symmetry, apply on_formula_subst },
  { apply prf.ref },
  { simp at h_ih_h₂, apply subst _ h_ih_h₁ h_ih_h₂, simp }
end

def on_sprf {Γ : set $ sentence L} {f : sentence L} (h : Γ ⊢ f) :
  ϕ.on_sentence '' Γ ⊢ ϕ.on_sentence f :=
by have := ϕ.on_prf h; simp only [sprf, Theory.fst, image_image, function.comp,
  on_bounded_formula_fst, on_sentence] at this ⊢; exact this

instance decidable_mem_of_decidable_pred_set {α : Type*} {r : set α}
  [h : decidable_pred r] (a : α) : decidable (a ∈ r) :=
decidable.rec_on (h a) (λ h, is_false h) (λ h, is_true h)

/- replace all symbols not in the image of ϕ by a new variable -/
noncomputable def reflect_term [has_decidable_range ϕ] (t : term L') (m : ℕ) : term L :=
term.elim (λk, &k ↑' 1 # m)
     (λl f' ts' ts, if hf' : f' ∈ range (@on_function _ _ ϕ l)
       then apps (func (classical.some hf')) ts else &m) t

variable {ϕ}
lemma reflect_term_apps_pos [has_decidable_range ϕ] {l} {f : L'.functions l}
  (hf : f ∈ range (@on_function _ _ ϕ l)) (ts : dvector (term L') l) (m : ℕ) :
  ϕ.reflect_term (apps (func f) ts) m =
  apps (func (classical.some hf)) (ts.map (λt, ϕ.reflect_term t m)) :=
(term.elim_apps _ _ f ts).trans $ by rw [dif_pos hf]; refl

lemma reflect_term_apps_neg [has_decidable_range ϕ] {l} {f : L'.functions l}
  (hf : f ∉ range (@on_function _ _ ϕ l)) (ts : dvector (term L') l) (m : ℕ) :
  ϕ.reflect_term (apps (func f) ts) m = &m :=
(term.elim_apps _ _ f ts).trans $ by rw [dif_neg hf]

lemma reflect_term_const_pos [has_decidable_range ϕ] {c : L'.constants}
  (hf : c ∈ range (@on_function _ _ ϕ 0)) (m : ℕ) :
  ϕ.reflect_term (func c) m = func (classical.some hf) :=
by apply reflect_term_apps_pos hf ([]) m

lemma reflect_term_const_neg [has_decidable_range ϕ] {c : L'.constants}
  (hf : c ∉ range (@on_function _ _ ϕ 0)) (m : ℕ) :
  ϕ.reflect_term (func c) m = &m :=
by apply reflect_term_apps_neg hf ([]) m

@[simp] lemma reflect_term_var [has_decidable_range ϕ] (k : ℕ) (m : ℕ) :
  ϕ.reflect_term &k m = &k ↑' 1 # m := rfl

@[simp] lemma reflect_term_on_term [has_decidable_range ϕ] (hϕ : is_injective ϕ) (t : term L)
  (m : ℕ) : ϕ.reflect_term (ϕ.on_term t) m = t ↑' 1 # m :=
begin
  refine term.rec _ _ t; clear t; intros,
  { refl },
  { simp [reflect_term_apps_pos (mem_range_self f)],
    rw [classical.some_eq f (λy hy, hϕ.on_function hy), dvector.map_congr_pmem ih_ts] }
end

lemma reflect_term_lift_at [has_decidable_range ϕ] (hϕ : is_injective ϕ)
  {n m m' : ℕ} (h : m ≤ m') (t : term L') :
  ϕ.reflect_term (t ↑' n # m) (m'+n) = ϕ.reflect_term t m' ↑' n # m :=
begin
  refine term.rec _ _ t; clear t; intro l,
  { simp only [reflect_term_var],
    rw[lift_term_at2_small _ _ _ h],
    simpa only [lift_term_at], },
  { intros f _ ih_ts, by_cases h' : f ∈ range (@on_function _ _ ϕ l);
    simp [reflect_term_apps_pos, reflect_term_apps_neg, h', h,
      dvector.map_congr_pmem ih_ts, -add_comm]}
end

lemma reflect_term_lift [has_decidable_range ϕ] (hϕ : is_injective ϕ) {n m : ℕ}
  (t : term L') : ϕ.reflect_term (t ↑ n) (m+n) = ϕ.reflect_term t m ↑ n :=
reflect_term_lift_at hϕ m.zero_le t

lemma reflect_term_subst [has_decidable_range ϕ] (hϕ : is_injective ϕ) (n m : ℕ)
  (s t : term L') :
  ϕ.reflect_term (t[s // n]) (m+n) = (ϕ.reflect_term t (m+n+1))[ϕ.reflect_term s m // n] :=
begin
  refine term.rec _ _ t; clear t; intros,
  { simp [-lift_term_at, -add_comm, -add_assoc],
    apply lt_by_cases k n; intro h,
    { have h₂ : ¬(m + n ≤ k), from λh', not_le_of_gt h (le_trans (nat.le_add_left n m) h'),
      have h₃ : ¬(m + n + 1 ≤ k), from λh', h₂ $ le_trans (le_succ _) h',
      simp [h, h₂, h₃, -add_comm, -add_assoc] },
    { have h₂ : ¬(m + n + 1 ≤ n), from not_le_of_gt (lt_of_le_of_lt (nat.le_add_left n m) (lt.base _)) ,
      simp [h, h₂, reflect_term_lift hϕ, -add_comm, -add_assoc] },
    { have hk := one_le_of_lt h,
      have h₄ : n < k + 1, from lt_trans h (lt.base k),
      by_cases h₂' : m + n + 1 ≤ k,
      { have h₂ : m + n + 1 ≤ k, from h₂',
        have h₃ : m + n ≤ k - 1, from (le_tsub_iff_right hk).mpr h₂,
        simp only [h, h₂, h₃, h₄,
          subst_term_var_gt, add_zero, if_true, add_succ_sub_one, lift_term_at, reflect_term_var],
        rw [tsub_add_eq_max, max_eq_left hk] },
      { have h₂ : ¬(m + n + 1 ≤ k), from h₂',
        have h₃ : ¬(m + n ≤ k - 1), from λh', h₂ $ (le_tsub_iff_right hk).mp h',
        simp only [h, h₂, h₃, subst_term_var_gt, lift_term_at, if_false, reflect_term_var] }}},
  { have h : n < m + n + 1, from nat.lt_succ_of_le (nat.le_add_left n m),
    by_cases h' : f ∈ range (@on_function _ _ ϕ l);
    simp only [reflect_term_apps_pos, reflect_term_apps_neg, h, h',
      dvector.map_congr_pmem ih_ts, dvector.map_map, subst_term_apps,
      subst_term_func, add_zero, subst_term_var_gt, add_succ_sub_one, not_false_iff] }
end

variable (ϕ)

noncomputable def reflect_formula [has_decidable_range ϕ] (f : formula L') :
  ∀(m : ℕ), formula L :=
formula.rec (λm, ⊥) (λt₁ t₂ m, ϕ.reflect_term t₁ m ≃ ϕ.reflect_term t₂ m)
  (λl R' xs' m, if hR' : R' ∈ range (@on_relation _ _ ϕ l)
       then apps_rel (rel (classical.some hR')) (xs'.map $ λt, ϕ.reflect_term t m) else ⊥)
   (λf₁' f₂' f₁ f₂ m, f₁ m ⟹ f₂ m) (λf' f m, ∀' f (m+1)) f

variable {ϕ}
lemma reflect_formula_apps_rel_pos [has_decidable_range ϕ] {l} {R : L'.relations l}
  (hR : R ∈ range (@on_relation _ _ ϕ l)) (ts : dvector (term L') l) (m : ℕ) :
  ϕ.reflect_formula (apps_rel (rel R) ts) m =
  apps_rel (rel (classical.some hR)) (ts.map (λt, ϕ.reflect_term t m)) :=
by simp [reflect_formula, formula.rec_apps_rel, dif_pos hR]

lemma reflect_formula_apps_rel_neg [has_decidable_range ϕ] {l} {R : L'.relations l}
  (hR : R ∉ range (@on_relation _ _ ϕ l)) (ts : dvector (term L') l) (m : ℕ) :
  ϕ.reflect_formula (apps_rel (rel R) ts) m = ⊥ :=
by simp [reflect_formula, formula.rec_apps_rel, dif_neg hR]

@[simp] lemma reflect_formula_equal [has_decidable_range ϕ] (t₁ t₂ : term L') (m : ℕ) :
  ϕ.reflect_formula (t₁ ≃ t₂) m = ϕ.reflect_term t₁ m ≃ ϕ.reflect_term t₂ m := rfl
@[simp] lemma reflect_formula_imp [has_decidable_range ϕ] (f₁ f₂ : formula L') (m : ℕ) :
  ϕ.reflect_formula (f₁ ⟹ f₂) m = ϕ.reflect_formula f₁ m ⟹ ϕ.reflect_formula f₂ m := rfl
@[simp] lemma reflect_formula_all [has_decidable_range ϕ] (f : formula L') (m : ℕ) :
  ϕ.reflect_formula (∀' f) m = ∀' (ϕ.reflect_formula f (m+1)) := rfl

@[simp] lemma reflect_formula_on_formula [has_decidable_range ϕ] (hϕ : is_injective ϕ) (m : ℕ)
  (f : formula L) : ϕ.reflect_formula (ϕ.on_formula f) m = f ↑' 1 # m :=
begin
  revert m, refine formula.rec _ _ _ _ _ f; clear f; intros,
  { refl },
  { simp [hϕ] },
  { simp [reflect_formula_apps_rel_pos (mem_range_self R), hϕ],
    rw [classical.some_eq R (λy hy, hϕ.on_relation hy)] },
  { simp* },
  { simp* }
end

lemma reflect_formula_lift_at [has_decidable_range ϕ] (hϕ : is_injective ϕ) {n m m' : ℕ}
  (h : m ≤ m') (f : formula L') :
  ϕ.reflect_formula (f ↑' n # m) (m'+n) = ϕ.reflect_formula f m' ↑' n # m :=
begin
  revert m m', refine formula.rec _ _ _ _ _ f; clear f,
  { intros, refl },
  { intros _ _ _ _ h, simp [reflect_term_lift_at hϕ h, -add_comm] },
  { intros l R ts _ _ h,
    by_cases h' : R ∈ range (@on_relation _ _ ϕ l);
      simp [reflect_formula_apps_rel_pos, reflect_formula_apps_rel_neg,
        h', h, ts.map_congr (reflect_term_lift_at hϕ h), -add_comm] },
  { intros _ _ ih₁ ih₂ _ _ h, simp [ih₁ h, ih₂ h, -add_comm] },
  { intros _ ih m m' h, simp [-add_comm, -add_assoc], rw [←ih],
    {
      apply congr_arg (ϕ.reflect_formula (f ↑' n # (m + 1))),
      repeat {rw add_assoc},
      apply congr_arg (has_add.add m'),
      exact add_comm _ _,
    },
    {exact add_le_add_right h 1} },
end

lemma reflect_formula_lift [has_decidable_range ϕ] (hϕ : is_injective ϕ) (n m : ℕ)
  (f : formula L') : ϕ.reflect_formula (f ↑ n) (m+n) = ϕ.reflect_formula f m ↑ n :=
reflect_formula_lift_at hϕ m.zero_le f

lemma reflect_formula_lift1 [has_decidable_range ϕ] (hϕ : is_injective ϕ) (m : ℕ)
  (f : formula L') : ϕ.reflect_formula (f ↑ 1) (m+1) = ϕ.reflect_formula f m ↑ 1 :=
reflect_formula_lift hϕ 1 m f

lemma reflect_formula_subst [has_decidable_range ϕ] (hϕ : is_injective ϕ) (f : formula L')
  (n m : ℕ) (s : term L') :
  ϕ.reflect_formula (f[s // n]) (m+n) = (ϕ.reflect_formula f (m+n+1))[ϕ.reflect_term s m // n] :=
begin
  revert n, refine formula.rec _ _ _ _ _ f; clear f,
  { intro, refl },
  { intros, simp [reflect_term_subst hϕ] },
  { intros _ R _ n,
    by_cases h' : R ∈ range (@on_relation _ _ ϕ l);
      simp only [reflect_formula_apps_rel_pos,
      reflect_formula_apps_rel_neg, h',
      ts.map_congr (reflect_term_subst hϕ n m s), not_false_iff,
      dvector.map_map, subst_formula, subst_formula_apps_rel]},
  { intros _ _ ih₁ ih₂, simp [ih₁, ih₂] },
  { intros _ ih _, simp only [subst_formula, reflect_formula_all, add_assoc, ih],},
end

@[simp] lemma reflect_formula_subst0 [has_decidable_range ϕ] (hϕ : is_injective ϕ) (m : ℕ)
  (f : formula L') (s : term L') :
  ϕ.reflect_formula (f[s // 0]) m = (ϕ.reflect_formula f (m+1))[ϕ.reflect_term s m // 0] :=
reflect_formula_subst hϕ f 0 m s

noncomputable def reflect_prf_gen [has_decidable_range ϕ] (hϕ : is_injective ϕ) {Γ}
  {f : formula L'} (m) (H : Γ ⊢ f) : (λf, ϕ.reflect_formula f m) '' Γ ⊢ ϕ.reflect_formula f m :=
begin
  induction H generalizing m,
  { apply axm, apply mem_image_of_mem _ H_h },
  { apply impI, have h := @H_ih m, rw [image_insert_eq] at h, exact h },
  { apply impE, apply H_ih_h₁, apply H_ih_h₂ },
  { apply falsumE, have h := @H_ih m, rw [image_insert_eq] at h, exact h },
  { apply allI, rw [image_image], have h := @H_ih (m+1), rw [image_image] at h,
    apply cast _ h, congr1, apply image_congr' (reflect_formula_lift1 hϕ m) },
  { apply allE, have h := @H_ih m, simp at h, exact h, symmetry,
    apply reflect_formula_subst0 hϕ },
  { apply ref },
  { apply subst, have h := @H_ih_h₁ m, simp at h, exact h,
    have h := @H_ih_h₂ m, simp [hϕ] at h, exact h, simp [hϕ] },
end

section

/- maybe generalize to filter_symbol? -/
@[reducible] def filter_symbols (p : L.symbols → Prop) : Language :=
⟨λl, subtype (λf, p (sum.inl ⟨l, f⟩)), λl, subtype (λR, p (sum.inr ⟨l, R⟩))⟩

def filter_symbols_Lhom (p : L.symbols → Prop) : filter_symbols p →ᴸ L :=
⟨λl, subtype.val, λl, subtype.val⟩

def is_injective_filter_symbols_Lhom (p : L.symbols → Prop) :
  is_injective (filter_symbols_Lhom p) :=
⟨λl, subtype.val_injective, λl, subtype.val_injective⟩

lemma find_term_filter_symbols (p : L.symbols → Prop) :
  ∀{l} (t : preterm L l) (h : symbols_in_term t ⊆ { s | p s }),
  { t' : preterm (filter_symbols p) l // (filter_symbols_Lhom p).on_term t' = t }
| _ &k          h := ⟨&k, rfl⟩
| _ (func f)    h := ⟨func ⟨f, h $ mem_singleton _⟩, rfl⟩
| _ (app t₁ t₂) h :=
  begin
    let ih₁ := find_term_filter_symbols t₁ (subset.trans (subset_union_left _ _) h),
    let ih₂ := find_term_filter_symbols t₂ (subset.trans (subset_union_right _ _) h),
    refine ⟨app ih₁.1 ih₂.1, _⟩,
    simp only [on_term, ih₁.2, ih₂.2, eq_self_iff_true, and_self],
  end

lemma find_formula_filter_symbols (p : L.symbols → Prop) :
  ∀{l} (f : preformula L l) (h : symbols_in_formula f ⊆ { s | p s }),
  { f' : preformula (filter_symbols p) l // (filter_symbols_Lhom p).on_formula f' = f }
| _ falsum       h := ⟨⊥, rfl⟩
| _ (t₁ ≃ t₂)    h :=
  begin
    let ih₁ := find_term_filter_symbols p t₁ (subset.trans (subset_union_left _ _) h),
    let ih₂ := find_term_filter_symbols p t₂ (subset.trans (subset_union_right _ _) h),
    refine ⟨ih₁.1 ≃ ih₂.1, _⟩,
    simp only [on_formula, ih₁.2, ih₂.2, eq_self_iff_true, and_self],
  end
| _ (rel R)      h := ⟨rel ⟨R, h $ mem_singleton _⟩, rfl⟩
| _ (apprel f t) h :=
  begin
    let ih₁ := find_formula_filter_symbols f (subset.trans (subset_union_left _ _) h),
    let ih₂ := find_term_filter_symbols p t (subset.trans (subset_union_right _ _) h),
    refine ⟨apprel ih₁.1 ih₂.1, _⟩, simp only [on_formula, subtype.val_eq_coe],
    exact ⟨ ih₁.2, ih₂.2 ⟩,
  end
| _ (f₁ ⟹ f₂)   h :=
  begin
    let ih₁ := find_formula_filter_symbols f₁ (subset.trans (subset_union_left _ _) h),
    let ih₂ := find_formula_filter_symbols f₂ (subset.trans (subset_union_right _ _) h),
    refine ⟨ih₁.1 ⟹ ih₂.1, _⟩,
    simp only [on_formula, ih₁.2, ih₂.2, eq_self_iff_true, and_self]
  end
| _ (∀' f)       h :=
  begin
    let ih := find_formula_filter_symbols f h,
    refine ⟨∀' ih.1, _⟩, simp only [on_formula, ih.2],
  end

end

noncomputable def generalize_constant {Γ} (c : L.constants)
  (hΓ : (sum.inl ⟨0, c⟩ : L.symbols) ∉ ⋃₀ (symbols_in_formula '' Γ))
  {f : formula L} (hf : (sum.inl ⟨0, c⟩ : L.symbols) ∉ symbols_in_formula f)
  (H : Γ ⊢ f[func c // 0]) : Γ ⊢ ∀' f :=
begin
  apply allI,
  let p : L.symbols → Prop := (≠ sum.inl ⟨0, c⟩),
  let ϕ := filter_symbols_Lhom p,
  have hϕ : is_injective ϕ := is_injective_filter_symbols_Lhom p,
  have hc : c ∉ range (on_function ϕ),
  { intro hc, rw [mem_range] at hc, rcases hc with ⟨c', hc'⟩,
    apply c'.2, rw [←hc'], refl },
  have hf' : symbols_in_formula f ⊆ {s : Language.symbols L | p s},
  { intros s hs hps, subst hps, exact hf hs },
  rcases find_formula_filter_symbols p f hf' with ⟨f, rfl⟩,
  have : {Γ' // Lhom.on_formula ϕ '' Γ' = Γ } ,
  { refine ⟨Lhom.on_formula ϕ ⁻¹' Γ, _⟩,
    apply image_preimage_eq_of_subset, intros f' hf',
    have : symbols_in_formula f' ⊆ {s : Language.symbols L | p s},
    { intros s hs hps, subst hps, exact hΓ ⟨_, mem_image_of_mem _ hf', hs⟩ },
    rcases find_formula_filter_symbols p f' this with ⟨f, rfl⟩,
    apply mem_range_self },
  rcases this with ⟨Γ, rfl⟩,
  rw [image_image, ←image_congr' (ϕ.on_formula_lift 1),
    ←image_image ϕ.on_formula],
  apply ϕ.on_prf,
  haveI : has_decidable_range (filter_symbols_Lhom p) :=
    ⟨λn f, classical.prop_decidable _, λn R, classical.prop_decidable _⟩,
  have := reflect_prf_gen hϕ 0 H,
  rwa [reflect_formula_subst0 hϕ, reflect_term_const_neg hc, image_image,
    image_congr' (reflect_formula_on_formula hϕ 0),
    reflect_formula_on_formula hϕ, lift_subst_formula_cancel] at this
end

noncomputable def sgeneralize_constant {T : Theory L} (c : L.constants)
  (hΓ : (sum.inl ⟨0, c⟩ : L.symbols) ∉ ⋃₀ (symbols_in_formula '' T.fst))
  {f : bounded_formula L 1} (hf : (sum.inl ⟨0, c⟩ : L.symbols) ∉ symbols_in_formula f.fst)
  (H : T ⊢ f[bd_func c /0]) : T ⊢ ∀' f :=
  by simp only [sprf, subst0_bounded_formula_fst] at H;
     exact generalize_constant c hΓ hf H

noncomputable def reflect_prf {Γ : set $ formula L} {f : formula L} (hϕ : ϕ.is_injective)
  (h : ϕ.on_formula '' Γ ⊢ ϕ.on_formula f) : Γ ⊢ f :=
begin
  haveI : has_decidable_range ϕ :=
    ⟨λl f, classical.prop_decidable _, λl R, classical.prop_decidable _⟩,
  apply reflect_prf_lift1,
  have := reflect_prf_gen hϕ 0 h, simp [image_image, hϕ] at this, exact this
end

noncomputable def reflect_sprf {Γ : set $ sentence L} {f : sentence L} (hϕ : ϕ.is_injective)
  (h : ϕ.on_sentence '' Γ ⊢ ϕ.on_sentence f) : Γ ⊢ f :=
by { apply reflect_prf hϕ, simp only [sprf, Theory.fst, image_image, function.comp,
     on_bounded_formula_fst, on_sentence] at h ⊢, exact h }

lemma on_term_inj (h : ϕ.is_injective) {l} : injective (ϕ.on_term : preterm L l → preterm L' l) :=
begin
  intros x y hxy, induction x generalizing y; cases y; try {injection hxy with hxy' hxy''},
  { rw [hxy'] },
  { rw [h.on_function hxy'] },
  { congr1, exact x_ih_t hxy', exact x_ih_s hxy'' }
end

lemma on_formula_inj (h : ϕ.is_injective) {l} :
  injective (ϕ.on_formula : preformula L l → preformula L' l) :=
begin
  intros x y hxy, induction x generalizing y; cases y; try {injection hxy with hxy' hxy''},
  { refl },
  { rw [on_term_inj h hxy', on_term_inj h hxy''] },
  { rw [h.on_relation hxy'] },
  { rw [x_ih hxy', on_term_inj h hxy''] },
  { rw [x_ih_f₁ hxy', x_ih_f₂ hxy''] },
  { rw [x_ih hxy'] }
end

lemma on_bounded_term_inj (h : ϕ.is_injective) {n} {l} : injective (ϕ.on_bounded_term : bounded_preterm L n l → bounded_preterm L' n l) :=
begin
  intros x y hxy, induction x generalizing y; cases y; try {injection hxy with hxy' hxy''},
  { rw [hxy'] },
  { rw [h.on_function hxy'] },
  { congr1, exact x_ih_t hxy', exact x_ih_s hxy'' }
end

lemma on_bounded_formula_inj (h : ϕ.is_injective) {n l}:
  injective (ϕ.on_bounded_formula : bounded_preformula L n l → bounded_preformula L' n l) :=
begin
  intros x y hxy, induction x generalizing y; cases y; try {injection hxy with hxy' hxy''},
  { refl },
  { rw [on_bounded_term_inj h hxy', on_bounded_term_inj h hxy''] },
  { rw [h.on_relation hxy'] },
  { rw [x_ih hxy', on_bounded_term_inj h hxy''] },
  { rw [x_ih_f₁ hxy', x_ih_f₂ hxy''] },
  { rw [x_ih hxy'] }
end

variable (ϕ)

/-- Given L → L' and an L'-structure S, the reduct of S to L is the L-structure given by
restricting interpretations from L' to L --/
def reduct (S : Structure L') : Structure L :=
⟨ S.carrier, λn f, S.fun_map $ ϕ.on_function f, λn R, S.rel_map $ ϕ.on_relation R⟩

notation S`[[`:95 ϕ`]]`:90 := reduct ϕ S

variable {ϕ}

@[simp] def reduct_coe (S : Structure L') : (reduct ϕ S : Type*) = S :=
rfl

def reduct_id {S : Structure L'} : S → S[[ϕ]] := id

@[simp] lemma reduct_term_eq {S : Structure L'} (hϕ : ϕ.is_injective) {n} :
  Π(xs : dvector S n) {l} (t : bounded_preterm L n l) (xs' : dvector S l), realize_bounded_term xs (on_bounded_term ϕ t) xs' = @realize_bounded_term L (reduct ϕ S) n xs l t xs'
| xs _ (bd_var k)   xs' := rfl
| xs _ (bd_func f)  xs' := rfl
| xs l (bd_app t s) xs' := by simp*

lemma reduct_bounded_formula_iff {S : Structure L'} (hϕ : ϕ.is_injective) : Π{n l} (xs : dvector S n) (xs' : dvector S l) (f : bounded_preformula L n l),
  realize_bounded_formula xs (on_bounded_formula ϕ f) xs' ↔ @realize_bounded_formula L (reduct ϕ S) n l xs f xs'
| _ _ xs xs' (bd_falsum)      := by refl
| _ _ xs xs' (bd_equal t₁ t₂) := by simp [hϕ]
| _ _ xs xs' (bd_rel R)       := by refl
| _ _ xs xs' (bd_apprel f t)  := by simp*
| _ _ xs xs' (f₁ ⟹ f₂)       := by simp*
| _ _ xs xs' (∀' f)           := by apply forall_congr; intro x;simp*

lemma reduct_ssatisfied {S : Structure L'} {f : sentence L} (hϕ : ϕ.is_injective)
 (h : S ⊨ ϕ.on_sentence f) : ϕ.reduct S ⊨ f :=
(reduct_bounded_formula_iff hϕ ([]) ([]) f).mp h

lemma reduct_ssatisfied' {S : Structure L'} {f : sentence L} (hϕ : ϕ.is_injective)
 (h : S ⊨ ϕ.on_bounded_formula f) : ϕ.reduct S ⊨ f :=
(reduct_bounded_formula_iff hϕ ([]) ([]) f).mp h

def reduct_all_ssatisfied {S : Structure L'} {T : Theory L} (hϕ : ϕ.is_injective)
  (h : S ⊨ ϕ.on_sentence '' T) : S[[ϕ]] ⊨ T :=
λf hf, reduct_ssatisfied hϕ $ h $ mem_image_of_mem _ hf

lemma reduct_nonempty_of_nonempty {S : Structure L'} (H : nonempty S) : nonempty (reduct ϕ S) :=
by {apply nonempty.map, repeat{assumption}, exact reduct_id}

variable (ϕ)
@[reducible]def Theory_induced (T : Theory L) : Theory L' := ϕ.on_sentence '' T

variable {ϕ}
lemma is_consistent_Theory_induced (hϕ : ϕ.is_injective) {T : Theory L} (hT : is_consistent T) :
  is_consistent (ϕ.Theory_induced T) :=
λH, hT $ H.map $ λh, reflect_sprf hϕ (by apply h)

/- we could generalize this, replacing set.univ by any set s, but then we cannot use set.image
  anymore (since the domain of g would be s), and things would be more annoying -/
lemma is_consistent_extend {T : Theory L} (hT : is_consistent T) (hϕ : ϕ.is_injective)
  (h : bounded_formula L 1 → bounded_formula L 1)
  (hT' : ∀(f : bounded_formula L 1), T ⊢ ∃' (h f))
  (g : bounded_formula L 1 → L'.constants) (hg : injective g)
  (hg' : ∀x, g x ∉ range (@on_function L L' ϕ 0)) :
  is_consistent (ϕ.Theory_induced T ∪
  (λf, (ϕ.on_bounded_formula (h f))[bd_const (g f)/0]) '' set.univ) :=
begin
  haveI : decidable_eq (bounded_formula L 1) := λx y, classical.prop_decidable _,
  haveI : decidable_eq (sentence L') := λx y, classical.prop_decidable _,
  have lem : ∀(s₀ : finset (bounded_formula L 1)),
    is_consistent (ϕ.Theory_induced T ∪
      (λf, (ϕ.on_bounded_formula (h f))[bd_const (g f)/0]) '' ↑s₀),
  { refine finset.induction _ _,
    { simp, exact is_consistent_Theory_induced hϕ hT },
    { intros ψ s hψ ih hs, refine sprovable.elim _ hs, clear hs, intro hs, apply ih, constructor,
      simp [image_insert_eq] at hs,
      have : _ ⊢ (ϕ.on_bounded_formula $ ∼(h ψ))[bd_const (g ψ)/0] := simpI hs,
      have := sgeneralize_constant (g ψ) _ _ this,
      { refine simpE _ _ this, apply sweakening (subset_union_left _ _) (ϕ.on_sprf $ hT' ψ) },
      { intro h', rcases h' with ⟨s', ⟨ψ', ⟨ψ', ⟨ψ', hψ₂, rfl⟩ | ⟨ψ', hψ₂, rfl⟩, rfl⟩, rfl⟩, hψ₃⟩,
        { rw [ϕ.on_sentence_fst] at hψ₃,
          exact ϕ.not_mem_function_in_formula_on_formula (hg' _) _ hψ₃ },
        { simp at hψ₃,
          -- have h : (ϕ.on_bounded_formula (h ψ'))[bd_const (g ψ') /0].fst =
          -- (ϕ.on_bounded_formula (h ψ')).fst[bounded_preterm.fst (bd_const (g ψ')) // 0],
          -- apply subst0_bounded_formula_fst,
          rw subst0_bounded_formula_fst at hψ₃,
          cases symbols_in_formula_subst _ _ _ hψ₃ with hψ₄ hψ₄,
          { rw [on_bounded_formula_fst] at hψ₄,
            exact ϕ.not_mem_function_in_formula_on_formula (hg' _) _ hψ₄ },
          { injection eq_of_mem_singleton hψ₄ with hψ₅, injection hψ₅ with x hψ₆,
            cases hg (eq_of_heq hψ₆), exact hψ hψ₂ }}},
        { rw [on_bounded_formula_fst],
          apply not_mem_function_in_formula_on_formula, apply hg' }}},
  intro H, rcases theory_proof_compactness H with ⟨T₀, h₀, hT⟩,
  have : decidable_pred (∈ ϕ.Theory_induced T) := λx, classical.prop_decidable _,
  rcases finset.subset_union_elim hT with ⟨t₀, s₀, rfl, ht₀, hs₀⟩,
  have hs₀' := subset.trans hs₀ (diff_subset _ _),
  rcases finset.subset_image_iff.mp hs₀' with ⟨s₀, hs₀x, rfl⟩,
  apply lem s₀, refine h₀.map _, apply sweakening,
  simp only [finset.coe_union]
  ,
  apply union_subset_union ht₀,
  rw finset.coe_image,
end

end Lhom

end fol

-- instance nonempty_Language_over : nonempty (Language_over) :=
--   begin fapply nonempty.intro, exact ⟨L, language_id_morphism L⟩ end

--TODO define map induced by a language_morphism on terms/preterms, formulas/preformulas, sets of formulas/theories


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

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

/-!
# Type Spaces
This file defines the space of complete types over a first-order theory.
(Note that types in model theory are different from types in type theory.)

## Main Definitions
* `first_order.language.Theory.complete_type`:
  `T.complete_type α` consists of complete types over the theory `T` with variables `α`.

## Main Results
* `first_order.language.Theory.complete_type.nonempty_iff`:
  The space `T.complete_type α` is nonempty exactly when `T` is satisfiable.

## Implementation Notes
* Complete types are implemented as maximal consistent theories in an expanded language.
More frequently they are described as maximal consistent sets of formulas, but this is equivalent.

## TODO
* Connect `T.complete_type α` to sets of formulas `L.formula α`.

-/

universe u v w w'

open Cardinal Set

open Cardinal FirstOrder Classical

namespace FirstOrder

namespace Language

namespace Theory

variable {L : Language.{u, v}} (T : L.Theory) (α : Type w)

/-- A complete type over a given theory in a certain type of variables is a maximally
  consistent (with the theory) set of formulas in that type. -/
structure CompleteType where
  toTheory : L[[α]].Theory
  subset' : (L.lhomWithConstants α).onTheory T ⊆ to_Theory
  is_maximal' : to_Theory.IsMaximal
#align first_order.language.Theory.complete_type FirstOrder.Language.Theory.CompleteType

variable {T α}

namespace CompleteType

instance : SetLike (T.CompleteType α) L[[α]].Sentence :=
  ⟨fun p => p.toTheory, fun p q h => by
    cases p
    cases q
    congr ⟩

theorem isMaximal (p : T.CompleteType α) : IsMaximal (p : L[[α]].Theory) :=
  p.is_maximal'
#align first_order.language.Theory.complete_type.is_maximal FirstOrder.Language.Theory.CompleteType.isMaximal

theorem subset (p : T.CompleteType α) : (L.lhomWithConstants α).onTheory T ⊆ (p : L[[α]].Theory) :=
  p.subset'
#align first_order.language.Theory.complete_type.subset FirstOrder.Language.Theory.CompleteType.subset

theorem mem_or_not_mem (p : T.CompleteType α) (φ : L[[α]].Sentence) : φ ∈ p ∨ φ.Not ∈ p :=
  p.IsMaximal.mem_or_not_mem φ
#align first_order.language.Theory.complete_type.mem_or_not_mem FirstOrder.Language.Theory.CompleteType.mem_or_not_mem

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem mem_of_models (p : T.CompleteType α) {φ : L[[α]].Sentence}
    (h : (L.lhomWithConstants α).onTheory T ⊨ φ) : φ ∈ p :=
  (p.mem_or_not_mem φ).resolve_right fun con =>
    ((models_iff_not_satisfiable _).1 h)
      (p.IsMaximal.1.mono (union_subset p.Subset (singleton_subset_iff.2 Con)))
#align first_order.language.Theory.complete_type.mem_of_models FirstOrder.Language.Theory.CompleteType.mem_of_models

theorem not_mem_iff (p : T.CompleteType α) (φ : L[[α]].Sentence) : φ.Not ∈ p ↔ ¬φ ∈ p :=
  ⟨fun hf ht =>
    by
    have h : ¬is_satisfiable ({φ, φ.not} : L[[α]].Theory) :=
      by
      rintro ⟨@⟨_, _, h, _⟩⟩
      simp only [model_iff, mem_insert_iff, mem_singleton_iff, forall_eq_or_imp, forall_eq] at h
      exact h.2 h.1
    refine' h (p.is_maximal.1.mono _)
    rw [insert_subset, singleton_subset_iff]
    exact ⟨ht, hf⟩, (p.mem_or_not_mem φ).resolve_left⟩
#align first_order.language.Theory.complete_type.not_mem_iff FirstOrder.Language.Theory.CompleteType.not_mem_iff

@[simp]
theorem compl_setOf_mem {φ : L[[α]].Sentence} :
    { p : T.CompleteType α | φ ∈ p }ᶜ = { p : T.CompleteType α | φ.Not ∈ p } :=
  ext fun _ => (not_mem_iff _ _).symm
#align first_order.language.Theory.complete_type.compl_set_of_mem FirstOrder.Language.Theory.CompleteType.compl_setOf_mem

theorem setOf_subset_eq_empty_iff (S : L[[α]].Theory) :
    { p : T.CompleteType α | S ⊆ ↑p } = ∅ ↔
      ¬((L.lhomWithConstants α).onTheory T ∪ S).IsSatisfiable :=
  by
  rw [iff_not_comm, ← not_nonempty_iff_eq_empty, Classical.not_not, Set.Nonempty]
  refine'
    ⟨fun h =>
      ⟨⟨L[[α]].completeTheory h.some, (subset_union_left _ S).trans complete_theory.subset,
          complete_theory.is_maximal _ _⟩,
        (subset_union_right ((L.Lhom_with_constants α).onTheory T) _).trans complete_theory.subset⟩,
      _⟩
  rintro ⟨p, hp⟩
  exact p.is_maximal.1.mono (union_subset p.subset hp)
#align first_order.language.Theory.complete_type.set_of_subset_eq_empty_iff FirstOrder.Language.Theory.CompleteType.setOf_subset_eq_empty_iff

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem setOf_mem_eq_univ_iff (φ : L[[α]].Sentence) :
    { p : T.CompleteType α | φ ∈ p } = univ ↔ (L.lhomWithConstants α).onTheory T ⊨ φ :=
  by
  rw [models_iff_not_satisfiable, ← compl_empty_iff, compl_set_of_mem, ← set_of_subset_eq_empty_iff]
  simp
#align first_order.language.Theory.complete_type.set_of_mem_eq_univ_iff FirstOrder.Language.Theory.CompleteType.setOf_mem_eq_univ_iff

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem setOf_subset_eq_univ_iff (S : L[[α]].Theory) :
    { p : T.CompleteType α | S ⊆ ↑p } = univ ↔
      ∀ φ, φ ∈ S → (L.lhomWithConstants α).onTheory T ⊨ φ :=
  by
  have h : { p : T.complete_type α | S ⊆ ↑p } = ⋂₀ ((fun φ => { p | φ ∈ p }) '' S) :=
    by
    ext
    simp [subset_def]
  simp_rw [h, sInter_eq_univ, ← set_of_mem_eq_univ_iff]
  refine' ⟨fun h φ φS => h _ ⟨_, φS, rfl⟩, _⟩
  rintro h _ ⟨φ, h1, rfl⟩
  exact h _ h1
#align first_order.language.Theory.complete_type.set_of_subset_eq_univ_iff FirstOrder.Language.Theory.CompleteType.setOf_subset_eq_univ_iff

theorem nonempty_iff : Nonempty (T.CompleteType α) ↔ T.IsSatisfiable :=
  by
  rw [← is_satisfiable_on_Theory_iff (Lhom_with_constants_injective L α)]
  rw [nonempty_iff_univ_nonempty, nonempty_iff_ne_empty, Ne.def, not_iff_comm, ←
    union_empty ((L.Lhom_with_constants α).onTheory T), ← set_of_subset_eq_empty_iff]
  simp
#align first_order.language.Theory.complete_type.nonempty_iff FirstOrder.Language.Theory.CompleteType.nonempty_iff

instance : Nonempty (CompleteType ∅ α) :=
  nonempty_iff.2 (isSatisfiable_empty L)

theorem interᵢ_setOf_subset {ι : Type _} (S : ι → L[[α]].Theory) :
    (⋂ i : ι, { p : T.CompleteType α | S i ⊆ p }) = { p | (⋃ i : ι, S i) ⊆ p } :=
  by
  ext
  simp only [mem_Inter, mem_set_of_eq, Union_subset_iff]
#align first_order.language.Theory.complete_type.Inter_set_of_subset FirstOrder.Language.Theory.CompleteType.interᵢ_setOf_subset

theorem toList_foldr_inf_mem {p : T.CompleteType α} {t : Finset L[[α]].Sentence} :
    t.toList.foldr (· ⊓ ·) ⊤ ∈ p ↔ (t : L[[α]].Theory) ⊆ ↑p :=
  by
  simp_rw [subset_def, ← SetLike.mem_coe, p.is_maximal.mem_iff_models, models_sentence_iff,
    sentence.realize, formula.realize, bounded_formula.realize_foldr_inf, Finset.mem_toList]
  exact ⟨fun h φ hφ M => h _ _ hφ, fun h M φ hφ => h _ hφ _⟩
#align first_order.language.Theory.complete_type.to_list_foldr_inf_mem FirstOrder.Language.Theory.CompleteType.toList_foldr_inf_mem

end CompleteType

end Theory

end Language

end FirstOrder


/-
Copyright (c) 2022 Rémy Degenne, Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne, Kexing Ying
-/
import analysis.special_functions.pow
import measure_theory.function.egorov
import measure_theory.function.lp_space

/-!
# Convergence in measure

We define convergence in measure which is one of the many notions of convergence in probability.
A sequence of functions `f` is said to converge in measure to some function `g`
if for all `ε > 0`, the measure of the set `{x | ε ≤ dist (f i x) (g x)}` tends to 0 as `i`
converges along some given filter `l`.

Convergence in measure is most notably used in the formulation of the weak law of large numbers
and is also useful in theorems such as the Vitali convergence theorem. This file provides some
basic lemmas for working with convergence in measure and establishes some relations between
convergence in measure and other notions of convergence.

## Main definitions

* `measure_theory.tendsto_in_measure (μ : measure α) (f : ι → α → E) (g : α → E)`: `f` converges
  in `μ`-measure to `g`.

## Main results

* `measure_theory.tendsto_in_measure_of_tendsto_ae`: convergence almost everywhere in a finite
  measure space implies convergence in measure.
* `measure_theory.tendsto_in_measure.exists_seq_tendsto_ae`: if `f` is a sequence of functions
  which converges in measure to `g`, then `f` has a subsequence which convergence almost
  everywhere to `g`.
* `measure_theory.tendsto_in_measure_of_tendsto_snorm`: convergence in Lp implies convergence
  in measure.
-/

open topological_space filter
open_locale nnreal ennreal measure_theory topology

namespace measure_theory

variables {α ι E : Type*} {m : measurable_space α} {μ : measure α}

/-- A sequence of functions `f` is said to converge in measure to some function `g` if for all
`ε > 0`, the measure of the set `{x | ε ≤ dist (f i x) (g x)}` tends to 0 as `i` converges along
some given filter `l`. -/
def tendsto_in_measure [has_dist E] {m : measurable_space α}
  (μ : measure α) (f : ι → α → E) (l : filter ι) (g : α → E) : Prop :=
∀ ε (hε : 0 < ε), tendsto (λ i, μ {x | ε ≤ dist (f i x) (g x)}) l (𝓝 0)

lemma tendsto_in_measure_iff_norm [seminormed_add_comm_group E] {l : filter ι}
  {f : ι → α → E} {g : α → E} :
  tendsto_in_measure μ f l g
  ↔ ∀ ε (hε : 0 < ε), tendsto (λ i, μ {x | ε ≤ ‖f i x - g x‖}) l (𝓝 0) :=
by simp_rw [tendsto_in_measure, dist_eq_norm]

namespace tendsto_in_measure

variables [has_dist E] {l : filter ι} {f f' : ι → α → E} {g g' : α → E}

protected lemma congr' (h_left : ∀ᶠ i in l, f i =ᵐ[μ] f' i) (h_right : g =ᵐ[μ] g')
  (h_tendsto : tendsto_in_measure μ f l g) :
  tendsto_in_measure μ f' l g' :=
begin
  intros ε hε,
  suffices : (λ i, μ {x | ε ≤ dist (f' i x) (g' x)})
      =ᶠ[l] (λ i, μ {x | ε ≤ dist (f i x) (g x)}),
  { rw tendsto_congr' this,
    exact h_tendsto ε hε, },
  filter_upwards [h_left] with i h_ae_eq,
  refine measure_congr _,
  filter_upwards [h_ae_eq, h_right] with x hxf hxg,
  rw eq_iff_iff,
  change ε ≤ dist (f' i x) (g' x) ↔ ε ≤ dist (f i x) (g x),
  rw [hxg, hxf],
end

protected lemma congr (h_left : ∀ i, f i =ᵐ[μ] f' i) (h_right : g =ᵐ[μ] g')
  (h_tendsto : tendsto_in_measure μ f l g) :
  tendsto_in_measure μ f' l g' :=
tendsto_in_measure.congr' (eventually_of_forall h_left) h_right h_tendsto

lemma congr_left (h : ∀ i, f i =ᵐ[μ] f' i) (h_tendsto : tendsto_in_measure μ f l g) :
  tendsto_in_measure μ f' l g :=
h_tendsto.congr h (eventually_eq.rfl)

lemma congr_right (h : g =ᵐ[μ] g') (h_tendsto : tendsto_in_measure μ f l g) :
  tendsto_in_measure μ f l g' :=
h_tendsto.congr (λ i, eventually_eq.rfl) h

end tendsto_in_measure

section exists_seq_tendsto_ae

variables [metric_space E]
variables {f : ℕ → α → E} {g : α → E}

/-- Auxiliary lemma for `tendsto_in_measure_of_tendsto_ae`. -/
lemma tendsto_in_measure_of_tendsto_ae_of_strongly_measurable [is_finite_measure μ]
  (hf : ∀ n, strongly_measurable (f n)) (hg : strongly_measurable g)
  (hfg : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x))) :
  tendsto_in_measure μ f at_top g :=
begin
  refine λ ε hε, ennreal.tendsto_at_top_zero.mpr (λ δ hδ, _),
  by_cases hδi : δ = ∞,
  { simp only [hδi, implies_true_iff, le_top, exists_const], },
  lift δ to ℝ≥0 using hδi,
  rw [gt_iff_lt, ennreal.coe_pos, ← nnreal.coe_pos] at hδ,
  obtain ⟨t, htm, ht, hunif⟩ := tendsto_uniformly_on_of_ae_tendsto' hf hg hfg hδ,
  rw ennreal.of_real_coe_nnreal at ht,
  rw metric.tendsto_uniformly_on_iff at hunif,
  obtain ⟨N, hN⟩ := eventually_at_top.1 (hunif ε hε),
  refine ⟨N, λ n hn, _⟩,
  suffices : {x : α | ε ≤ dist (f n x) (g x)} ⊆ t, from (measure_mono this).trans ht,
  rw ← set.compl_subset_compl,
  intros x hx,
  rw [set.mem_compl_iff, set.nmem_set_of_iff, dist_comm, not_le],
  exact hN n hn x hx,
end

/-- Convergence a.e. implies convergence in measure in a finite measure space. -/
lemma tendsto_in_measure_of_tendsto_ae [is_finite_measure μ]
  (hf : ∀ n, ae_strongly_measurable (f n) μ)
  (hfg : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x))) :
  tendsto_in_measure μ f at_top g :=
begin
  have hg : ae_strongly_measurable g μ, from ae_strongly_measurable_of_tendsto_ae _ hf hfg,
  refine tendsto_in_measure.congr (λ i, (hf i).ae_eq_mk.symm) hg.ae_eq_mk.symm _,
  refine tendsto_in_measure_of_tendsto_ae_of_strongly_measurable
    (λ i, (hf i).strongly_measurable_mk) hg.strongly_measurable_mk _,
  have hf_eq_ae : ∀ᵐ x ∂μ, ∀ n, (hf n).mk (f n) x = f n x,
    from ae_all_iff.mpr (λ n, (hf n).ae_eq_mk.symm),
  filter_upwards [hf_eq_ae, hg.ae_eq_mk, hfg] with x hxf hxg hxfg,
  rw [← hxg, funext (λ n, hxf n)],
  exact hxfg,
end

namespace exists_seq_tendsto_ae

lemma exists_nat_measure_lt_two_inv (hfg : tendsto_in_measure μ f at_top g) (n : ℕ) :
  ∃ N, ∀ m ≥ N, μ {x | 2⁻¹ ^ n ≤ dist (f m x) (g x)} ≤ 2⁻¹ ^ n :=
begin
  specialize hfg (2⁻¹ ^ n) (by simp only [zero_lt_bit0, pow_pos, zero_lt_one, inv_pos]),
  rw ennreal.tendsto_at_top_zero at hfg,
  exact hfg (2⁻¹ ^ n) (pos_iff_ne_zero.mpr (λ h_zero, by simpa using pow_eq_zero h_zero))
end

/-- Given a sequence of functions `f` which converges in measure to `g`,
`seq_tendsto_ae_seq_aux` is a sequence such that
`∀ m ≥ seq_tendsto_ae_seq_aux n, μ {x | 2⁻¹ ^ n ≤ dist (f m x) (g x)} ≤ 2⁻¹ ^ n`. -/
noncomputable
def seq_tendsto_ae_seq_aux (hfg : tendsto_in_measure μ f at_top g) (n : ℕ) :=
classical.some (exists_nat_measure_lt_two_inv hfg n)

/-- Transformation of `seq_tendsto_ae_seq_aux` to makes sure it is strictly monotone. -/
noncomputable
def seq_tendsto_ae_seq (hfg : tendsto_in_measure μ f at_top g) : ℕ → ℕ
| 0 := seq_tendsto_ae_seq_aux hfg 0
| (n + 1) := max (seq_tendsto_ae_seq_aux hfg (n + 1))
  (seq_tendsto_ae_seq n + 1)

lemma seq_tendsto_ae_seq_succ (hfg : tendsto_in_measure μ f at_top g) {n : ℕ} :
  seq_tendsto_ae_seq hfg (n + 1) =
  max (seq_tendsto_ae_seq_aux hfg (n + 1)) (seq_tendsto_ae_seq hfg n + 1) :=
by rw seq_tendsto_ae_seq

lemma seq_tendsto_ae_seq_spec (hfg : tendsto_in_measure μ f at_top g)
  (n k : ℕ) (hn : seq_tendsto_ae_seq hfg n ≤ k) :
  μ {x | 2⁻¹ ^ n ≤ dist (f k x) (g x)} ≤ 2⁻¹ ^ n :=
begin
  cases n,
  { exact classical.some_spec (exists_nat_measure_lt_two_inv hfg 0) k hn },
  { exact classical.some_spec (exists_nat_measure_lt_two_inv hfg _) _
      (le_trans (le_max_left _ _) hn) }
end

lemma seq_tendsto_ae_seq_strict_mono (hfg : tendsto_in_measure μ f at_top g) :
  strict_mono (seq_tendsto_ae_seq hfg) :=
begin
  refine strict_mono_nat_of_lt_succ (λ n, _),
  rw seq_tendsto_ae_seq_succ,
  exact lt_of_lt_of_le (lt_add_one $ seq_tendsto_ae_seq hfg n) (le_max_right _ _),
end

end exists_seq_tendsto_ae

/-- If `f` is a sequence of functions which converges in measure to `g`, then there exists a
subsequence of `f` which converges a.e. to `g`. -/
lemma tendsto_in_measure.exists_seq_tendsto_ae
  (hfg : tendsto_in_measure μ f at_top g) :
  ∃ ns : ℕ → ℕ, strict_mono ns ∧ ∀ᵐ x ∂μ, tendsto (λ i, f (ns i) x) at_top (𝓝 (g x)) :=
begin
  /- Since `f` tends to `g` in measure, it has a subsequence `k ↦ f (ns k)` such that
  `μ {|f (ns k) - g| ≥ 2⁻ᵏ} ≤ 2⁻ᵏ` for all `k`. Defining
  `s := ⋂ k, ⋃ i ≥ k, {|f (ns k) - g| ≥ 2⁻ᵏ}`, we see that `μ s = 0` by the
  first Borel-Cantelli lemma.

  On the other hand, as `s` is precisely the set for which `f (ns k)`
  doesn't converge to `g`, `f (ns k)` converges almost everywhere to `g` as required. -/
  have h_lt_ε_real : ∀ (ε : ℝ) (hε : 0 < ε), ∃ k : ℕ, 2 * 2⁻¹ ^ k < ε,
  { intros ε hε,
    obtain ⟨k, h_k⟩ : ∃ (k : ℕ), 2⁻¹ ^ k < ε := exists_pow_lt_of_lt_one hε (by norm_num),
    refine ⟨k + 1, (le_of_eq _).trans_lt h_k⟩,
    rw pow_add, ring },
  set ns := exists_seq_tendsto_ae.seq_tendsto_ae_seq hfg,
  use ns,
  let S := λ k, {x | 2⁻¹ ^ k ≤ dist (f (ns k) x) (g x)},
  have hμS_le : ∀ k, μ (S k) ≤ 2⁻¹ ^ k :=
    λ k, exists_seq_tendsto_ae.seq_tendsto_ae_seq_spec hfg k (ns k) (le_rfl),
  set s := filter.at_top.limsup S with hs,
  have hμs : μ s = 0,
  { refine measure_limsup_eq_zero (ne_of_lt $ lt_of_le_of_lt (ennreal.tsum_le_tsum hμS_le) _),
    simp only [ennreal.tsum_geometric, ennreal.one_sub_inv_two, inv_inv],
    dec_trivial },
  have h_tendsto : ∀ x ∈ sᶜ, tendsto (λ i, f (ns i) x) at_top (𝓝 (g x)),
  { refine λ x hx, metric.tendsto_at_top.mpr (λ ε hε, _),
    rw [hs, limsup_eq_infi_supr_of_nat] at hx,
    simp only [set.supr_eq_Union, set.infi_eq_Inter, set.compl_Inter, set.compl_Union,
      set.mem_Union, set.mem_Inter, set.mem_compl_iff, set.mem_set_of_eq, not_le] at hx,
    obtain ⟨N, hNx⟩ := hx,
    obtain ⟨k, hk_lt_ε⟩ := h_lt_ε_real ε hε,
    refine ⟨max N (k - 1), λ n hn_ge, lt_of_le_of_lt _ hk_lt_ε⟩,
    specialize hNx n ((le_max_left _ _).trans hn_ge),
    have h_inv_n_le_k : (2 : ℝ)⁻¹ ^ n ≤ 2 * 2⁻¹ ^ k,
    { rw [mul_comm, ← inv_mul_le_iff' (zero_lt_two' ℝ)],
      conv_lhs { congr, rw ← pow_one (2 : ℝ)⁻¹ },
      rw [← pow_add, add_comm],
      exact pow_le_pow_of_le_one ((one_div (2 : ℝ)) ▸ one_half_pos.le) (inv_le_one one_le_two)
        ((le_tsub_add.trans (add_le_add_right (le_max_right _ _) 1)).trans
        (add_le_add_right hn_ge 1)) },
    exact le_trans hNx.le h_inv_n_le_k },
  rw ae_iff,
  refine ⟨exists_seq_tendsto_ae.seq_tendsto_ae_seq_strict_mono hfg, measure_mono_null (λ x, _) hμs⟩,
  rw [set.mem_set_of_eq, ← @not_not (x ∈ s), not_imp_not],
  exact h_tendsto x,
end

lemma tendsto_in_measure.exists_seq_tendsto_in_measure_at_top
  {u : filter ι} [ne_bot u] [is_countably_generated u] {f : ι → α → E} {g : α → E}
  (hfg : tendsto_in_measure μ f u g) :
  ∃ ns : ℕ → ι, tendsto_in_measure μ (λ n, f (ns n)) at_top g :=
begin
  obtain ⟨ns, h_tendsto_ns⟩ : ∃ (ns : ℕ → ι), tendsto ns at_top u := exists_seq_tendsto u,
  exact ⟨ns, λ ε hε, (hfg ε hε).comp h_tendsto_ns⟩,
end

lemma tendsto_in_measure.exists_seq_tendsto_ae'
  {u : filter ι} [ne_bot u] [is_countably_generated u] {f : ι → α → E} {g : α → E}
  (hfg : tendsto_in_measure μ f u g) :
  ∃ ns : ℕ → ι, ∀ᵐ x ∂μ, tendsto (λ i, f (ns i) x) at_top (𝓝 (g x)) :=
begin
  obtain ⟨ms, hms⟩ := hfg.exists_seq_tendsto_in_measure_at_top,
  obtain ⟨ns, -, hns⟩ := hms.exists_seq_tendsto_ae,
  exact ⟨ms ∘ ns, hns⟩,
end

end exists_seq_tendsto_ae

section ae_measurable_of

variables [measurable_space E] [normed_add_comm_group E] [borel_space E]

lemma tendsto_in_measure.ae_measurable
  {u : filter ι} [ne_bot u] [is_countably_generated u]
  {f : ι → α → E} {g : α → E} (hf : ∀ n, ae_measurable (f n) μ)
  (h_tendsto : tendsto_in_measure μ f u g) :
  ae_measurable g μ :=
begin
  obtain ⟨ns, hns⟩ := h_tendsto.exists_seq_tendsto_ae',
  exact ae_measurable_of_tendsto_metrizable_ae at_top (λ n, hf (ns n)) hns,
end

end ae_measurable_of

section tendsto_in_measure_of

variables [normed_add_comm_group E] {p : ℝ≥0∞}
variables {f : ι → α → E} {g : α → E}

/-- This lemma is superceded by `measure_theory.tendsto_in_measure_of_tendsto_snorm` where we
allow `p = ∞` and only require `ae_strongly_measurable`. -/
lemma tendsto_in_measure_of_tendsto_snorm_of_strongly_measurable
  (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
  (hf : ∀ n, strongly_measurable (f n)) (hg : strongly_measurable g) {l : filter ι}
  (hfg : tendsto (λ n, snorm (f n - g) p μ) l (𝓝 0)) :
  tendsto_in_measure μ f l g :=
begin
  intros ε hε,
  replace hfg := ennreal.tendsto.const_mul (tendsto.ennrpow_const p.to_real hfg)
    (or.inr $ @ennreal.of_real_ne_top (1 / ε ^ (p.to_real))),
  simp only [mul_zero, ennreal.zero_rpow_of_pos (ennreal.to_real_pos hp_ne_zero hp_ne_top)] at hfg,
  rw ennreal.tendsto_nhds_zero at hfg ⊢,
  intros δ hδ,
  refine (hfg δ hδ).mono (λ n hn, _),
  refine le_trans _ hn,
  rw [ennreal.of_real_div_of_pos (real.rpow_pos_of_pos hε _), ennreal.of_real_one, mul_comm,
    mul_one_div, ennreal.le_div_iff_mul_le _ (or.inl (ennreal.of_real_ne_top)), mul_comm],
  { convert mul_meas_ge_le_pow_snorm' μ hp_ne_zero hp_ne_top ((hf n).sub hg).ae_strongly_measurable
      (ennreal.of_real ε),
    { exact (ennreal.of_real_rpow_of_pos hε).symm },
    { ext x,
      rw [dist_eq_norm, ← ennreal.of_real_le_of_real_iff (norm_nonneg _),
          of_real_norm_eq_coe_nnnorm],
      exact iff.rfl } },
  { rw [ne, ennreal.of_real_eq_zero, not_le],
    exact or.inl (real.rpow_pos_of_pos hε _) },
end

/-- This lemma is superceded by `measure_theory.tendsto_in_measure_of_tendsto_snorm` where we
allow `p = ∞`. -/
lemma tendsto_in_measure_of_tendsto_snorm_of_ne_top
  (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
  (hf : ∀ n, ae_strongly_measurable (f n) μ) (hg : ae_strongly_measurable g μ) {l : filter ι}
  (hfg : tendsto (λ n, snorm (f n - g) p μ) l (𝓝 0)) :
  tendsto_in_measure μ f l g :=
begin
  refine tendsto_in_measure.congr (λ i, (hf i).ae_eq_mk.symm) hg.ae_eq_mk.symm _,
  refine tendsto_in_measure_of_tendsto_snorm_of_strongly_measurable hp_ne_zero hp_ne_top
    (λ i, (hf i).strongly_measurable_mk) hg.strongly_measurable_mk _,
  have : (λ n, snorm ((hf n).mk (f n) - hg.mk g) p μ) = (λ n, snorm (f n - g) p μ),
  { ext1 n, refine snorm_congr_ae (eventually_eq.sub (hf n).ae_eq_mk.symm hg.ae_eq_mk.symm), },
  rw this,
  exact hfg,
end

/-- See also `measure_theory.tendsto_in_measure_of_tendsto_snorm` which work for general
Lp-convergence for all `p ≠ 0`. -/
lemma tendsto_in_measure_of_tendsto_snorm_top {E} [normed_add_comm_group E] {f : ι → α → E}
  {g : α → E} {l : filter ι} (hfg : tendsto (λ n, snorm (f n - g) ∞ μ) l (𝓝 0)) :
  tendsto_in_measure μ f l g :=
begin
  intros δ hδ,
  simp only [snorm_exponent_top, snorm_ess_sup] at hfg,
  rw ennreal.tendsto_nhds_zero at hfg ⊢,
  intros ε hε,
  specialize hfg ((ennreal.of_real δ) / 2) (ennreal.div_pos_iff.2
    ⟨(ennreal.of_real_pos.2 hδ).ne.symm, ennreal.two_ne_top⟩),
  refine hfg.mono (λ n hn, _),
  simp only [true_and, gt_iff_lt, ge_iff_le, zero_tsub, zero_le, zero_add, set.mem_Icc,
    pi.sub_apply] at *,
  have : ess_sup (λ (x : α), (‖f n x - g x‖₊ : ℝ≥0∞)) μ < ennreal.of_real δ :=
    lt_of_le_of_lt hn (ennreal.half_lt_self (ennreal.of_real_pos.2 hδ).ne.symm
      ennreal.of_real_lt_top.ne),
  refine ((le_of_eq _).trans (ae_lt_of_ess_sup_lt this).le).trans hε.le,
  congr' with x,
  simp only [ennreal.of_real_le_iff_le_to_real ennreal.coe_lt_top.ne, ennreal.coe_to_real,
    not_lt, coe_nnnorm, set.mem_set_of_eq, set.mem_compl_iff],
  rw ← dist_eq_norm (f n x) (g x),
  refl
end

/-- Convergence in Lp implies convergence in measure. -/
lemma tendsto_in_measure_of_tendsto_snorm {l : filter ι}
  (hp_ne_zero : p ≠ 0) (hf : ∀ n, ae_strongly_measurable (f n) μ) (hg : ae_strongly_measurable g μ)
  (hfg : tendsto (λ n, snorm (f n - g) p μ) l (𝓝 0)) :
  tendsto_in_measure μ f l g :=
begin
  by_cases hp_ne_top : p = ∞,
  { subst hp_ne_top,
    exact tendsto_in_measure_of_tendsto_snorm_top hfg },
  { exact tendsto_in_measure_of_tendsto_snorm_of_ne_top hp_ne_zero hp_ne_top hf hg hfg }
end

/-- Convergence in Lp implies convergence in measure. -/
lemma tendsto_in_measure_of_tendsto_Lp [hp : fact (1 ≤ p)]
  {f : ι → Lp E p μ} {g : Lp E p μ} {l : filter ι} (hfg : tendsto f l (𝓝 g)) :
  tendsto_in_measure μ (λ n, f n) l g :=
tendsto_in_measure_of_tendsto_snorm (zero_lt_one.trans_le hp.elim).ne.symm
  (λ n, Lp.ae_strongly_measurable _) (Lp.ae_strongly_measurable _)
  ((Lp.tendsto_Lp_iff_tendsto_ℒp' _ _).mp hfg)

end tendsto_in_measure_of

end measure_theory


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.direct_sum.basic
import linear_algebra.dfinsupp

/-!
# Direct sum of modules

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

The first part of the file provides constructors for direct sums of modules. It provides a
construction of the direct sum using the universal property and proves its uniqueness
(`direct_sum.to_module.unique`).

The second part of the file covers the special case of direct sums of submodules of a fixed module
`M`.  There is a canonical linear map from this direct sum to `M` (`direct_sum.coe_linear_map`), and
the construction is of particular importance when this linear map is an equivalence; that is, when
the submodules provide an internal decomposition of `M`.  The property is defined more generally
elsewhere as `direct_sum.is_internal`, but its basic consequences on `submodule`s are established
in this file.

-/

universes u v w u₁

namespace direct_sum
open_locale direct_sum

section general
variables {R : Type u} [semiring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include R
variables {M : ι → Type w} [Π i, add_comm_monoid (M i)] [Π i, module R (M i)]

instance : module R (⨁ i, M i) := dfinsupp.module
instance {S : Type*} [semiring S] [Π i, module S (M i)] [Π i, smul_comm_class R S (M i)] :
  smul_comm_class R S (⨁ i, M i) := dfinsupp.smul_comm_class
instance {S : Type*} [semiring S] [has_smul R S] [Π i, module S (M i)]
  [Π i, is_scalar_tower R S (M i)] :
  is_scalar_tower R S (⨁ i, M i) := dfinsupp.is_scalar_tower
instance [Π i, module Rᵐᵒᵖ (M i)] [Π i, is_central_scalar R (M i)] :
  is_central_scalar R (⨁ i, M i) := dfinsupp.is_central_scalar

lemma smul_apply (b : R) (v : ⨁ i, M i) (i : ι) :
  (b • v) i = b • (v i) := dfinsupp.smul_apply _ _ _

include dec_ι

variables R ι M
/-- Create the direct sum given a family `M` of `R` modules indexed over `ι`. -/
def lmk : Π s : finset ι, (Π i : (↑s : set ι), M i.val) →ₗ[R] (⨁ i, M i) :=
dfinsupp.lmk

/-- Inclusion of each component into the direct sum. -/
def lof : Π i : ι, M i →ₗ[R] (⨁ i, M i) :=
dfinsupp.lsingle

variables {ι M}

lemma single_eq_lof (i : ι) (b : M i) :
  dfinsupp.single i b = lof R ι M i b := rfl

/-- Scalar multiplication commutes with direct sums. -/
theorem mk_smul (s : finset ι) (c : R) (x) : mk M s (c • x) = c • mk M s x :=
(lmk R ι M s).map_smul c x

/-- Scalar multiplication commutes with the inclusion of each component into the direct sum. -/
theorem of_smul (i : ι) (c : R) (x) : of M i (c • x) = c • of M i x :=
(lof R ι M i).map_smul c x

variables {R}
lemma support_smul [Π (i : ι) (x : M i), decidable (x ≠ 0)]
  (c : R) (v : ⨁ i, M i) : (c • v).support ⊆ v.support := dfinsupp.support_smul _ _

variables {N : Type u₁} [add_comm_monoid N] [module R N]
variables (φ : Π i, M i →ₗ[R] N)

variables (R ι N φ)
/-- The linear map constructed using the universal property of the coproduct. -/
def to_module : (⨁ i, M i) →ₗ[R] N :=
dfinsupp.lsum ℕ φ

/-- Coproducts in the categories of modules and additive monoids commute with the forgetful functor
from modules to additive monoids. -/
lemma coe_to_module_eq_coe_to_add_monoid :
  (to_module R ι N φ : (⨁ i, M i) → N) = to_add_monoid (λ i, (φ i).to_add_monoid_hom) :=
rfl

variables {ι N φ}

/-- The map constructed using the universal property gives back the original maps when
restricted to each component. -/
@[simp] lemma to_module_lof (i) (x : M i) : to_module R ι N φ (lof R ι M i x) = φ i x :=
to_add_monoid_of (λ i, (φ i).to_add_monoid_hom) i x

variables (ψ : (⨁ i, M i) →ₗ[R] N)

/-- Every linear map from a direct sum agrees with the one obtained by applying
the universal property to each of its components. -/
theorem to_module.unique (f : ⨁ i, M i) : ψ f = to_module R ι N (λ i, ψ.comp $ lof R ι M i) f :=
to_add_monoid.unique ψ.to_add_monoid_hom f

variables {ψ} {ψ' : (⨁ i, M i) →ₗ[R] N}

/-- Two `linear_map`s out of a direct sum are equal if they agree on the generators.

See note [partially-applied ext lemmas]. -/
@[ext]
theorem linear_map_ext ⦃ψ ψ' : (⨁ i, M i) →ₗ[R] N⦄
  (H : ∀ i, ψ.comp (lof R ι M i) = ψ'.comp (lof R ι M i)) : ψ = ψ' :=
dfinsupp.lhom_ext' H

/--
The inclusion of a subset of the direct summands
into a larger subset of the direct summands, as a linear map.
-/
def lset_to_set (S T : set ι) (H : S ⊆ T) :
  (⨁ (i : S), M i) →ₗ[R] (⨁ (i : T), M i) :=
to_module R _ _ $ λ i, lof R T (λ (i : subtype T), M i) ⟨i, H i.prop⟩

omit dec_ι

variables (ι M)
/-- Given `fintype α`, `linear_equiv_fun_on_fintype R` is the natural `R`-linear equivalence
between `⨁ i, M i` and `Π i, M i`. -/
@[simps apply] def linear_equiv_fun_on_fintype [fintype ι] :
  (⨁ i, M i) ≃ₗ[R] (Π i, M i) :=
{ to_fun := coe_fn,
  map_add' := λ f g, by { ext, simp only [add_apply, pi.add_apply] },
  map_smul' := λ c f, by { ext, simp only [dfinsupp.coe_smul, ring_hom.id_apply] },
  .. dfinsupp.equiv_fun_on_fintype }

variables {ι M}
@[simp] lemma linear_equiv_fun_on_fintype_lof [fintype ι] [decidable_eq ι] (i : ι) (m : M i) :
  (linear_equiv_fun_on_fintype R ι M) (lof R ι M i m) = pi.single i m :=
begin
  ext a,
  change (dfinsupp.equiv_fun_on_fintype (lof R ι M i m)) a = _,
  convert _root_.congr_fun (dfinsupp.equiv_fun_on_fintype_single i m) a,
end

@[simp] lemma linear_equiv_fun_on_fintype_symm_single [fintype ι] [decidable_eq ι]
  (i : ι) (m : M i) :
  (linear_equiv_fun_on_fintype R ι M).symm (pi.single i m) = lof R ι M i m :=
begin
  ext a,
  change (dfinsupp.equiv_fun_on_fintype.symm (pi.single i m)) a = _,
  rw (dfinsupp.equiv_fun_on_fintype_symm_single i m),
  refl
end

@[simp] lemma linear_equiv_fun_on_fintype_symm_coe [fintype ι] (f : ⨁ i, M i) :
  (linear_equiv_fun_on_fintype R ι M).symm f = f :=
by { ext, simp [linear_equiv_fun_on_fintype], }

/-- The natural linear equivalence between `⨁ _ : ι, M` and `M` when `unique ι`. -/
protected def lid (M : Type v) (ι : Type* := punit) [add_comm_monoid M] [module R M]
  [unique ι] :
  (⨁ (_ : ι), M) ≃ₗ[R] M :=
{ .. direct_sum.id M ι,
  .. to_module R ι M (λ i, linear_map.id) }

variables (ι M)
/-- The projection map onto one component, as a linear map. -/
def component (i : ι) : (⨁ i, M i) →ₗ[R] M i :=
dfinsupp.lapply i

variables {ι M}

lemma apply_eq_component (f : ⨁ i, M i) (i : ι) :
  f i = component R ι M i f := rfl

@[ext] lemma ext {f g : ⨁ i, M i}
  (h : ∀ i, component R ι M i f = component R ι M i g) : f = g :=
dfinsupp.ext h

lemma ext_iff {f g : ⨁ i, M i} : f = g ↔
  ∀ i, component R ι M i f = component R ι M i g :=
⟨λ h _, by rw h, ext R⟩

include dec_ι

@[simp] lemma lof_apply (i : ι) (b : M i) : ((lof R ι M i) b) i = b :=
dfinsupp.single_eq_same

@[simp] lemma component.lof_self (i : ι) (b : M i) :
  component R ι M i ((lof R ι M i) b) = b :=
lof_apply R i b

lemma component.of (i j : ι) (b : M j) :
  component R ι M i ((lof R ι M j) b) =
  if h : j = i then eq.rec_on h b else 0 :=
dfinsupp.single_apply

omit dec_ι
section congr_left
variables {κ : Type*}

/--Reindexing terms of a direct sum is linear.-/
def lequiv_congr_left (h : ι ≃ κ) : (⨁ i, M i) ≃ₗ[R] ⨁ k, M (h.symm k) :=
{ map_smul' := dfinsupp.comap_domain'_smul _ _,
  ..equiv_congr_left h }

@[simp] lemma lequiv_congr_left_apply (h : ι ≃ κ) (f : ⨁ i, M i) (k : κ) :
lequiv_congr_left R h f k = f (h.symm k) := equiv_congr_left_apply _ _ _

end congr_left

section sigma
variables {α : ι → Type*} {δ : Π i, α i → Type w}
variables [Π i j, add_comm_monoid (δ i j)] [Π i j, module R (δ i j)]

/--`curry` as a linear map.-/
noncomputable def sigma_lcurry : (⨁ (i : Σ i, _), δ i.1 i.2) →ₗ[R] ⨁ i j, δ i j :=
{ map_smul' := λ r, by convert (@dfinsupp.sigma_curry_smul _ _ _ δ _ _ _ r),
  ..sigma_curry }

@[simp] lemma sigma_lcurry_apply (f : ⨁ (i : Σ i, _), δ i.1 i.2) (i : ι) (j : α i) :
  sigma_lcurry R f i j = f ⟨i, j⟩ := sigma_curry_apply f i j

/--`uncurry` as a linear map.-/
def sigma_luncurry [Π i, decidable_eq (α i)] [Π i j, decidable_eq (δ i j)] :
  (⨁ i j, δ i j) →ₗ[R] ⨁ (i : Σ i, _), δ i.1 i.2 :=
{ map_smul' := dfinsupp.sigma_uncurry_smul,
  ..sigma_uncurry }

@[simp] lemma sigma_luncurry_apply [Π i, decidable_eq (α i)] [Π i j, decidable_eq (δ i j)]
  (f : ⨁ i j, δ i j) (i : ι) (j : α i) :
  sigma_luncurry R f ⟨i, j⟩ = f i j := sigma_uncurry_apply f i j

/--`curry_equiv` as a linear equiv.-/
noncomputable def sigma_lcurry_equiv
  [Π i, decidable_eq (α i)] [Π i j, decidable_eq (δ i j)] :
  (⨁ (i : Σ i, _), δ i.1 i.2) ≃ₗ[R] ⨁ i j, δ i j :=
{ ..sigma_curry_equiv, ..sigma_lcurry R }

end sigma

section option
variables {α : option ι → Type w} [Π i, add_comm_monoid (α i)] [Π i, module R (α i)]
include dec_ι

/--Linear isomorphism obtained by separating the term of index `none` of a direct sum over
`option ι`.-/
@[simps] noncomputable def lequiv_prod_direct_sum : (⨁ i, α i) ≃ₗ[R] α none × ⨁ i, α (some i) :=
{ map_smul' := dfinsupp.equiv_prod_dfinsupp_smul,
  ..add_equiv_prod_direct_sum }

end option

end general

section submodule

section semiring
variables {R : Type u} [semiring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include dec_ι
variables {M : Type*} [add_comm_monoid M] [module R M]
variables (A : ι → submodule R M)

/-- The canonical embedding from `⨁ i, A i` to `M`  where `A` is a collection of `submodule R M`
indexed by `ι`. This is `direct_sum.coe_add_monoid_hom` as a `linear_map`. -/
def coe_linear_map : (⨁ i, A i) →ₗ[R] M := to_module R ι M (λ i, (A i).subtype)

@[simp] lemma coe_linear_map_of (i : ι) (x : A i) :
  direct_sum.coe_linear_map A (of (λ i, A i) i x) = x :=
to_add_monoid_of _ _ _

variables {A}

/-- If a direct sum of submodules is internal then the submodules span the module. -/
lemma is_internal.submodule_supr_eq_top (h : is_internal A) : supr A = ⊤ :=
begin
  rw [submodule.supr_eq_range_dfinsupp_lsum, linear_map.range_eq_top],
  exact function.bijective.surjective h,
end

/-- If a direct sum of submodules is internal then the submodules are independent. -/
lemma is_internal.submodule_independent (h : is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_lsum_injective _ h.injective

/-- Given an internal direct sum decomposition of a module `M`, and a basis for each of the
components of the direct sum, the disjoint union of these bases is a basis for `M`. -/
noncomputable def is_internal.collected_basis
  (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) :
  basis (Σ i, α i) R M :=
{ repr :=
    (linear_equiv.of_bijective (direct_sum.coe_linear_map A) h).symm ≪≫ₗ
      (dfinsupp.map_range.linear_equiv (λ i, (v i).repr)) ≪≫ₗ
      (sigma_finsupp_lequiv_dfinsupp R).symm }

@[simp] lemma is_internal.collected_basis_coe
  (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) :
  ⇑(h.collected_basis v) = λ a : Σ i, (α i), ↑(v a.1 a.2) :=
begin
  funext a,
  simp only [is_internal.collected_basis, to_module, coe_linear_map,
    add_equiv.to_fun_eq_coe, basis.coe_of_repr, basis.repr_symm_apply, dfinsupp.lsum_apply_apply,
    dfinsupp.map_range.linear_equiv_apply, dfinsupp.map_range.linear_equiv_symm,
    dfinsupp.map_range_single, finsupp.total_single, linear_equiv.of_bijective_apply,
    linear_equiv.symm_symm, linear_equiv.symm_trans_apply, one_smul,
    sigma_finsupp_add_equiv_dfinsupp_apply, sigma_finsupp_equiv_dfinsupp_single,
    sigma_finsupp_lequiv_dfinsupp_apply],
  convert dfinsupp.sum_add_hom_single (λ i, (A i).subtype.to_add_monoid_hom) a.1 (v a.1 a.2),
end

lemma is_internal.collected_basis_mem
  (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) (a : Σ i, α i) :
  h.collected_basis v a ∈ A a.1 :=
by simp

/-- When indexed by only two distinct elements, `direct_sum.is_internal` implies
the two submodules are complementary. Over a `ring R`, this is true as an iff, as
`direct_sum.is_internal_iff_is_compl`. -/
lemma is_internal.is_compl {A : ι → submodule R M} {i j : ι} (hij : i ≠ j)
  (h : (set.univ : set ι) = {i, j}) (hi : is_internal A) : is_compl (A i) (A j) :=
⟨hi.submodule_independent.pairwise_disjoint hij,
  codisjoint_iff.mpr $ eq.symm $ hi.submodule_supr_eq_top.symm.trans $
  by rw [←Sup_pair, supr, ←set.image_univ, h, set.image_insert_eq, set.image_singleton]⟩

end semiring

section ring
variables {R : Type u} [ring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include dec_ι
variables {M : Type*} [add_comm_group M] [module R M]

/-- Note that this is not generally true for `[semiring R]`; see
`complete_lattice.independent.dfinsupp_lsum_injective` for details. -/
lemma is_internal_submodule_of_independent_of_supr_eq_top {A : ι → submodule R M}
  (hi : complete_lattice.independent A) (hs : supr A = ⊤) : is_internal A :=
⟨hi.dfinsupp_lsum_injective, linear_map.range_eq_top.1 $
  (submodule.supr_eq_range_dfinsupp_lsum _).symm.trans hs⟩

/-- `iff` version of `direct_sum.is_internal_submodule_of_independent_of_supr_eq_top`,
`direct_sum.is_internal.independent`, and `direct_sum.is_internal.supr_eq_top`.
-/
lemma is_internal_submodule_iff_independent_and_supr_eq_top (A : ι → submodule R M) :
    is_internal A ↔ complete_lattice.independent A ∧ supr A = ⊤ :=
⟨λ i, ⟨i.submodule_independent, i.submodule_supr_eq_top⟩,
 and.rec is_internal_submodule_of_independent_of_supr_eq_top⟩

/-- If a collection of submodules has just two indices, `i` and `j`, then
`direct_sum.is_internal` is equivalent to `is_compl`. -/
lemma is_internal_submodule_iff_is_compl (A : ι → submodule R M) {i j : ι} (hij : i ≠ j)
  (h : (set.univ : set ι) = {i, j}) :
  is_internal A ↔ is_compl (A i) (A j) :=
begin
  have : ∀ k, k = i ∨ k = j := λ k, by simpa using set.ext_iff.mp h k,
  rw [is_internal_submodule_iff_independent_and_supr_eq_top,
    supr, ←set.image_univ, h, set.image_insert_eq, set.image_singleton, Sup_pair,
    complete_lattice.independent_pair hij this],
  exact ⟨λ ⟨hd, ht⟩, ⟨hd, codisjoint_iff.mpr ht⟩, λ ⟨hd, ht⟩, ⟨hd, ht.eq_top⟩⟩,
end

/-! Now copy the lemmas for subgroup and submonoids. -/

lemma is_internal.add_submonoid_independent {M : Type*} [add_comm_monoid M]
  {A : ι → add_submonoid M} (h : is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_sum_add_hom_injective _ h.injective

lemma is_internal.add_subgroup_independent {M : Type*} [add_comm_group M]
  {A : ι → add_subgroup M} (h : is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_sum_add_hom_injective' _ h.injective

end ring

end submodule

end direct_sum