/-
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)    := by refl
| _ (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 decidable.lt_by_cases n k; intro h; simp [h]
| _ (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')

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 id_is_right_identity {L1 L2} {F : L1 →ᴸ L2} : F ∘ (Lhom.id L1) = 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 := by simp
| _ (func f)    n m := by refl
| _ (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 decidable.lt_by_cases k n; intro h; simp [h]
| _ (func f)    s n := by refl
| _ (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 []       := by refl
| _ 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       := by refl
| _ n m (t₁ ≃ t₂)    := by simp
| _ n m (rel R)      := by refl
| _ 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 := by refl
| _ (t₁ ≃ t₂)    s n := by simp
| _ (rel R)      s n := by refl
| _ (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 []       := by refl
| _ 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           := by refl
| _ (bd_func f)  := by refl
| _ (bd_app t s) := by dsimp; simp*

@[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       := by refl
| _ _ (t₁ ≃ t₂)       := by simp
| _ _ (bd_rel R)      := by refl
| _ _ (bd_apprel f t) := by simp*
| _ _ (f₁ ⟹ f₂)      := by simp*
| _ _ (∀' f)          := by simp*

/- 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
      := by refl

/- 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)
      := by refl

@[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
      := by refl

/- 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)
      := by refl

@[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          := by refl
| _ (func f)    := by refl
| 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        := by refl
| _ (t₁ ≃ t₂)         := by simp[id_term]
| _ (rel R)       := by refl
| 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) := by refl
| _ (bd_func k) := by refl
| 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        := by refl
| _ _ (t₁ ≃ t₂)         := by simp[id_bounded_term]
| _ _ (bd_rel R)       := by refl
| _ 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

/- 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 := by refl

@[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; intros,
  { simp [-lift_term_at], rw[lift_term_at2_small _ _ _ h], simp },
  { 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 decidable.lt_by_cases k n; intro h,
    { have h₂ : ¬(m + n ≤ k), from λh', not_le_of_gt h (le_trans (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 (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 (nat.le_sub_right_iff_add_le hk).mpr h₂,
        simp [h, h₂, h₃, h₄, -add_comm, -add_assoc],
        rw [sub_add_eq_max, max_eq_left hk] },
      { have h₂ : ¬(m + n + 1 ≤ k), from h₂',
        have h₃ : ¬(m + n ≤ k - 1), from λh', h₂ $ (nat.le_sub_right_iff_add_le hk).mp h',
        simp [h, h₂, h₃, -add_comm, -add_assoc] }}},
  { 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 [reflect_term_apps_pos,
      reflect_term_apps_neg, h, h', dvector.map_congr_pmem ih_ts, -add_comm, -add_assoc] }
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 := by refl
@[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 := by refl
@[simp] lemma reflect_formula_all [has_decidable_range ϕ] (f : formula L') (m : ℕ) :
  ϕ.reflect_formula (∀' f) m = ∀' (ϕ.reflect_formula f (m+1)) := by refl

@[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 },
  { simp [reflect_term_lift_at hϕ h, -add_comm] },
  { 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] },
  { simp [ih₁ h, ih₂ h, -add_comm] },
  { simp [-add_comm, -add_assoc], rw [←ih], simp, 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; intros,
  { refl },
  { simp [reflect_term_subst hϕ, -add_comm] },
  { by_cases h' : R ∈ range (@on_relation _ _ ϕ l); simp [reflect_formula_apps_rel_pos,
      reflect_formula_apps_rel_neg, h', ts.map_congr (reflect_term_subst hϕ n m s), -add_comm] },
  { simp [ih₁, ih₂, -add_comm] },
  { simp [-add_comm, 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, _⟩, dsimp, rw [ih₁.2, ih₂.2]
  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, _⟩, dsimp, rw [ih₁.2, ih₂.2]
  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, _⟩, dsimp, rw [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, _⟩, dsimp, rw [ih₁.2, ih₂.2]
  end
| _ (∀' f)       h :=
  begin
    let ih := find_formula_filter_symbols f h,
    refine ⟨∀' ih.1, _⟩, dsimp, rw [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 [sprf] 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) = S :=
by refl

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' := by refl
| xs _ (bd_func f)  xs' := by refl
| 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ψ₃,
          cases symbols_in_formula_subst _ _ _ hψ₃ with hψ₄ 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, refine subset.trans ht₀ _, simp
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) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth, Sébastien Gouëzel
-/
import analysis.calculus.times_cont_diff
import tactic.ring_exp
import analysis.normed_space.banach
import topology.local_homeomorph

/-!
# Inverse function theorem

In this file we prove the inverse function theorem. It says that if a map `f : E → F`
has an invertible strict derivative `f'` at `a`, then it is locally invertible,
and the inverse function has derivative `f' ⁻¹`.

We define `has_strict_deriv_at.to_local_homeomorph` that repacks a function `f`
with a `hf : has_strict_fderiv_at f f' a`, `f' : E ≃L[𝕜] F`, into a `local_homeomorph`.
The `to_fun` of this `local_homeomorph` is `defeq` to `f`, so one can apply theorems
about `local_homeomorph` to `hf.to_local_homeomorph f`, and get statements about `f`.

Then we define `has_strict_fderiv_at.local_inverse` to be the `inv_fun` of this `local_homeomorph`,
and prove two versions of the inverse function theorem:

* `has_strict_fderiv_at.to_local_inverse`: if `f` has an invertible derivative `f'` at `a` in the
  strict sense (`hf`), then `hf.local_inverse f f' a` has derivative `f'.symm` at `f a` in the
  strict sense;

* `has_strict_fderiv_at.to_local_left_inverse`: if `f` has an invertible derivative `f'` at `a` in
  the strict sense and `g` is locally left inverse to `f` near `a`, then `g` has derivative
  `f'.symm` at `f a` in the strict sense.

In the one-dimensional case we reformulate these theorems in terms of `has_strict_deriv_at` and
`f'⁻¹`.

We also reformulate the theorems in terms of `times_cont_diff`, to give that `C^k` (respectively,
smooth) inputs give `C^k` (smooth) inverses.  These versions require that continuous
differentiability implies strict differentiability; this is false over a general field, true over
`ℝ` or `ℂ` and implemented here assuming `is_R_or_C 𝕂`.

Some related theorems, providing the derivative and higher regularity assuming that we already know
the inverse function, are formulated in `fderiv.lean`, `deriv.lean`, and `times_cont_diff.lean`.

## Notations

In the section about `approximates_linear_on` we introduce some `local notation` to make formulas
shorter:

* by `N` we denote `∥f'⁻¹∥`;
* by `g` we denote the auxiliary contracting map `x ↦ x + f'.symm (y - f x)` used to prove that
  `{x | f x = y}` is nonempty.

## Tags

derivative, strictly differentiable, continuously differentiable, smooth, inverse function
-/

open function set filter metric
open_locale topological_space classical nnreal

noncomputable theory

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

open asymptotics filter metric set
open continuous_linear_map (id)

/-!
### Non-linear maps close to affine maps

In this section we study a map `f` such that `∥f x - f y - f' (x - y)∥ ≤ c * ∥x - y∥` on an open set
`s`, where `f' : E →L[𝕜] F` is a continuous linear map and `c` is suitably small. Maps of this type
behave like `f a + f' (x - a)` near each `a ∈ s`.

When `f'` is onto, we show that `f` is locally onto.

When `f'` is a continuous linear equiv, we show that `f` is a homeomorphism
between `s` and `f '' s`. More precisely, we define `approximates_linear_on.to_local_homeomorph` to
be a `local_homeomorph` with `to_fun = f`, `source = s`, and `target = f '' s`.

Maps of this type naturally appear in the proof of the inverse function theorem (see next section),
and `approximates_linear_on.to_local_homeomorph` will imply that the locally inverse function
exists.

We define this auxiliary notion to split the proof of the inverse function theorem into small
lemmas. This approach makes it possible

- to prove a lower estimate on the size of the domain of the inverse function;

- to reuse parts of the proofs in the case if a function is not strictly differentiable. E.g., for a
  function `f : E × F → G` with estimates on `f x y₁ - f x y₂` but not on `f x₁ y - f x₂ y`.
-/

/-- We say that `f` approximates a continuous linear map `f'` on `s` with constant `c`,
if `∥f x - f y - f' (x - y)∥ ≤ c * ∥x - y∥` whenever `x, y ∈ s`.

This predicate is defined to facilitate the splitting of the inverse function theorem into small
lemmas. Some of these lemmas can be useful, e.g., to prove that the inverse function is defined
on a specific set. -/
def approximates_linear_on (f : E → F) (f' : E →L[𝕜] F) (s : set E) (c : ℝ≥0) : Prop :=
∀ (x ∈ s) (y ∈ s), ∥f x - f y - f' (x - y)∥ ≤ c * ∥x - y∥

namespace approximates_linear_on

variables [cs : complete_space E] {f : E → F}

/-! First we prove some properties of a function that `approximates_linear_on` a (not necessarily
invertible) continuous linear map. -/

section

variables {f' : E →L[𝕜] F} {s t : set E} {c c' : ℝ≥0}

theorem mono_num (hc : c ≤ c') (hf : approximates_linear_on f f' s c) :
  approximates_linear_on f f' s c' :=
λ x hx y hy, le_trans (hf x hx y hy) (mul_le_mul_of_nonneg_right hc $ norm_nonneg _)

theorem mono_set (hst : s ⊆ t) (hf : approximates_linear_on f f' t c) :
  approximates_linear_on f f' s c :=
λ x hx y hy, hf x (hst hx) y (hst hy)

lemma lipschitz_sub (hf : approximates_linear_on f f' s c) :
  lipschitz_with c (λ x : s, f x - f' x) :=
begin
  refine lipschitz_with.of_dist_le_mul (λ x y, _),
  rw [dist_eq_norm, subtype.dist_eq, dist_eq_norm],
  convert hf x x.2 y y.2 using 2,
  rw [f'.map_sub], abel
end

protected lemma lipschitz (hf : approximates_linear_on f f' s c) :
  lipschitz_with (nnnorm f' + c) (s.restrict f) :=
by simpa only [restrict_apply, add_sub_cancel'_right]
  using (f'.lipschitz.restrict s).add hf.lipschitz_sub

protected lemma continuous (hf : approximates_linear_on f f' s c) :
  continuous (s.restrict f) :=
hf.lipschitz.continuous

protected lemma continuous_on (hf : approximates_linear_on f f' s c) :
  continuous_on f s :=
continuous_on_iff_continuous_restrict.2 hf.continuous

end

section locally_onto
/-!
We prove that a function which is linearly approximated by a continuous linear map with a nonlinear
right inverse is locally onto. This will apply to the case where the approximating map is a linear
equivalence, for the local inverse theorem, but also whenever the approximating map is onto,
by Banach's open mapping theorem. -/

include cs

variables {s : set E} {c : ℝ≥0} {f' : E →L[𝕜] F}

/-- If a function is linearly approximated by a continuous linear map with a (possibly nonlinear)
right inverse, then it is locally onto: a ball of an explicit radius is included in the image
of the map. -/
theorem surj_on_closed_ball_of_nonlinear_right_inverse
  (hf : approximates_linear_on f f' s c)  (f'symm : f'.nonlinear_right_inverse)
  {ε : ℝ} {b : E} (ε0 : 0 ≤ ε) (hε : closed_ball b ε ⊆ s) :
  surj_on f (closed_ball b ε) (closed_ball (f b) (((f'symm.nnnorm : ℝ)⁻¹ - c) * ε)) :=
begin
  assume y hy,
  cases le_or_lt (f'symm.nnnorm : ℝ) ⁻¹ c with hc hc,
  { refine ⟨b, by simp [ε0], _⟩,
    have : dist y (f b) ≤ 0 :=
      (mem_closed_ball.1 hy).trans (mul_nonpos_of_nonpos_of_nonneg (by linarith) ε0),
    simp only [dist_le_zero] at this,
    rw this },
  have If' : (0 : ℝ) < f'symm.nnnorm,
    by { rw [← inv_pos], exact (nnreal.coe_nonneg _).trans_lt hc },
  have Icf' : (c : ℝ) * f'symm.nnnorm < 1, by rwa [inv_eq_one_div, lt_div_iff If'] at hc,
  have Jf' : (f'symm.nnnorm : ℝ) ≠ 0 := ne_of_gt If',
  have Jcf' : (1 : ℝ) - c * f'symm.nnnorm ≠ 0, by { apply ne_of_gt, linarith },
  /- We have to show that `y` can be written as `f x` for some `x ∈ closed_ball b ε`.
  The idea of the proof is to apply the Banach contraction principle to the map
  `g : x ↦ x + f'symm (y - f x)`, as a fixed point of this map satisfies `f x = y`.
  When `f'symm` is a genuine linear inverse, `g` is a contracting map. In our case, since `f'symm`
  is nonlinear, this map is not contracting (it is not even continuous), but still the proof of
  the contraction theorem holds: `uₙ = gⁿ b` is a Cauchy sequence, converging exponentially fast
  to the desired point `x`. Instead of appealing to general results, we check this by hand.

  The main point is that `f (u n)` becomes exponentially close to `y`, and therefore
  `dist (u (n+1)) (u n)` becomes exponentally small, making it possible to get an inductive
  bound on `dist (u n) b`, from which one checks that `u n` stays in the ball on which one has a
  control. Therefore, the bound can be checked at the next step, and so on inductively.
  -/
  set g := λ x, x + f'symm (y - f x) with hg,
  set u := λ (n : ℕ), g ^[n] b with hu,
  have usucc : ∀ n, u (n + 1) = g (u n), by simp [hu, ← iterate_succ_apply' g _ b],
  -- First bound: if `f z` is close to `y`, then `g z` is close to `z` (i.e., almost a fixed point).
  have A : ∀ z, dist (g z) z ≤ f'symm.nnnorm * dist (f z) y,
  { assume z,
    rw [dist_eq_norm, hg, add_sub_cancel', dist_eq_norm'],
    exact f'symm.bound _ },
  -- Second bound: if `z` and `g z` are in the set with good control, then `f (g z)` becomes closer
  -- to `y` than `f z` was (this uses the linear approximation property, and is the reason for the
  -- choice of the formula for `g`).
  have B : ∀ z ∈ closed_ball b ε, g z ∈ closed_ball b ε →
    dist (f (g z)) y ≤ c * f'symm.nnnorm * dist (f z) y,
  { assume z hz hgz,
    set v := f'symm (y - f z) with hv,
    calc dist (f (g z)) y = ∥f (z + v) - y∥ : by rw [dist_eq_norm]
    ... = ∥f (z + v) - f  z - f' v + f' v - (y - f z)∥ : by { congr' 1, abel }
    ... = ∥f (z + v) - f z - f' ((z + v) - z)∥ :
      by simp only [continuous_linear_map.nonlinear_right_inverse.right_inv,
                    add_sub_cancel', sub_add_cancel]
    ... ≤ c * ∥(z + v) - z∥ : hf _ (hε hgz) _ (hε hz)
    ... ≤ c * (f'symm.nnnorm * dist (f z) y) : begin
      apply mul_le_mul_of_nonneg_left _ (nnreal.coe_nonneg c),
      simpa [hv, dist_eq_norm'] using f'symm.bound (y - f z),
    end
    ... = c * f'symm.nnnorm * dist (f z) y : by ring },
  -- Third bound: a complicated bound on `dist w b` (that will show up in the induction) is enough
  -- to check that `w` is in the ball on which one has controls. Will be used to check that `u n`
  -- belongs to this ball for all `n`.
  have C : ∀ (n : ℕ) (w : E),
    dist w b ≤ f'symm.nnnorm * (1 - (c * f'symm.nnnorm)^n) / (1 - c * f'symm.nnnorm) * dist (f b) y
    → w ∈ closed_ball b ε,
  { assume n w hw,
    apply hw.trans,
    rw [div_mul_eq_mul_div, div_le_iff], swap, { linarith },
    calc (f'symm.nnnorm : ℝ) * (1 - (c * f'symm.nnnorm) ^ n) * dist (f b) y
      = f'symm.nnnorm * dist (f b) y * (1 - (c * f'symm.nnnorm) ^ n) : by ring
      ... ≤ f'symm.nnnorm * dist (f b) y * 1 :
      begin
        apply mul_le_mul_of_nonneg_left _ (mul_nonneg (nnreal.coe_nonneg _) dist_nonneg),
        rw [sub_le_self_iff],
        exact pow_nonneg (mul_nonneg (nnreal.coe_nonneg _) (nnreal.coe_nonneg _)) _,
      end
    ... ≤ f'symm.nnnorm * (((f'symm.nnnorm : ℝ)⁻¹ - c) * ε) :
      by { rw [mul_one],
           exact mul_le_mul_of_nonneg_left (mem_closed_ball'.1 hy) (nnreal.coe_nonneg _) }
    ... = ε * (1 - c * f'symm.nnnorm) : by { field_simp, ring } },
  /- Main inductive control: `f (u n)` becomes exponentially close to `y`, and therefore
  `dist (u (n+1)) (u n)` becomes exponentally small, making it possible to get an inductive
  bound on `dist (u n) b`, from which one checks that `u n` remains in the ball on which we
  have estimates. -/
  have D : ∀ (n : ℕ), dist (f (u n)) y ≤ (c * f'symm.nnnorm)^n * dist (f b) y
    ∧ dist (u n) b ≤ f'symm.nnnorm * (1 - (c * f'symm.nnnorm)^n) / (1 - c * f'symm.nnnorm)
      * dist (f b) y,
  { assume n,
    induction n with n IH, { simp [hu, le_refl] },
    rw usucc,
    have Ign : dist (g (u n)) b ≤
      f'symm.nnnorm * (1 - (c * f'symm.nnnorm)^n.succ) / (1 - c * f'symm.nnnorm) * dist (f b) y :=
    calc
      dist (g (u n)) b ≤ dist (g (u n)) (u n) + dist (u n) b : dist_triangle _ _ _
      ... ≤ f'symm.nnnorm * dist (f (u n)) y + dist (u n) b : add_le_add (A _) (le_refl _)
      ... ≤ f'symm.nnnorm * ((c * f'symm.nnnorm)^n * dist (f b) y) +
        f'symm.nnnorm * (1 - (c * f'symm.nnnorm)^n) / (1 - c * f'symm.nnnorm) * dist (f b) y :
          add_le_add (mul_le_mul_of_nonneg_left IH.1 (nnreal.coe_nonneg _)) IH.2
      ... = f'symm.nnnorm * (1 - (c * f'symm.nnnorm)^n.succ) / (1 - c * f'symm.nnnorm)
        * dist (f b) y : by { field_simp [Jcf'], ring_exp },
    refine ⟨_, Ign⟩,
    calc dist (f (g (u n))) y ≤ c * f'symm.nnnorm * dist (f (u n)) y :
      B _ (C n _ IH.2) (C n.succ _ Ign)
    ... ≤ (c * f'symm.nnnorm) * ((c * f'symm.nnnorm)^n * dist (f b) y) :
      mul_le_mul_of_nonneg_left IH.1 (mul_nonneg (nnreal.coe_nonneg _) (nnreal.coe_nonneg _))
    ... = (c * f'symm.nnnorm) ^ n.succ * dist (f b) y : by ring_exp },
  -- Deduce from the inductive bound that `uₙ` is a Cauchy sequence, therefore converging.
  have : cauchy_seq u,
  { have : ∀ (n : ℕ), dist (u n) (u (n+1)) ≤ f'symm.nnnorm * dist (f b) y * (c * f'symm.nnnorm)^n,
    { assume n,
      calc dist (u n) (u (n+1)) = dist (g (u n)) (u n) :  by rw [usucc, dist_comm]
      ... ≤ f'symm.nnnorm * dist (f (u n)) y : A _
      ... ≤ f'symm.nnnorm * ((c * f'symm.nnnorm)^n * dist (f b) y) :
        mul_le_mul_of_nonneg_left (D n).1 (nnreal.coe_nonneg _)
      ... = f'symm.nnnorm * dist (f b) y * (c * f'symm.nnnorm)^n : by ring },
    exact cauchy_seq_of_le_geometric _ _ Icf' this },
  obtain ⟨x, hx⟩ : ∃ x, tendsto u at_top (𝓝 x) := cauchy_seq_tendsto_of_complete this,
  -- As all the `uₙ` belong to the ball `closed_ball b ε`, so does their limit `x`.
  have xmem : x ∈ closed_ball b ε :=
    is_closed_ball.mem_of_tendsto hx (eventually_of_forall (λ n, C n _ (D n).2)),
  refine ⟨x, xmem, _⟩,
  -- It remains to check that `f x = y`. This follows from continuity of `f` on `closed_ball b ε`
  -- and from the fact that `f uₙ` is converging to `y` by construction.
  have hx' : tendsto u at_top (𝓝[closed_ball b ε] x),
  { simp only [nhds_within, tendsto_inf, hx, true_and, ge_iff_le, tendsto_principal],
    exact eventually_of_forall (λ n, C n _ (D n).2) },
  have T1 : tendsto (λ n, f (u n)) at_top (𝓝 (f x)) :=
    (hf.continuous_on.mono hε x xmem).tendsto.comp hx',
  have T2 : tendsto (λ n, f (u n)) at_top (𝓝 y),
  { rw tendsto_iff_dist_tendsto_zero,
    refine squeeze_zero (λ n, dist_nonneg) (λ n, (D n).1) _,
    simpa using (tendsto_pow_at_top_nhds_0_of_lt_1
      (mul_nonneg (nnreal.coe_nonneg _) (nnreal.coe_nonneg _)) Icf').mul tendsto_const_nhds },
  exact tendsto_nhds_unique T1 T2,
end

lemma open_image (hf : approximates_linear_on f f' s c)  (f'symm : f'.nonlinear_right_inverse)
  (hs : is_open s) (hc : subsingleton F ∨ c < f'symm.nnnorm⁻¹) : is_open (f '' s) :=
begin
  cases hc with hE hc, { resetI, apply is_open_discrete },
  simp only [is_open_iff_mem_nhds, nhds_basis_closed_ball.mem_iff, ball_image_iff] at hs ⊢,
  intros x hx,
  rcases hs x hx with ⟨ε, ε0, hε⟩,
  refine ⟨(f'symm.nnnorm⁻¹ - c) * ε, mul_pos (sub_pos.2 hc) ε0, _⟩,
  exact (hf.surj_on_closed_ball_of_nonlinear_right_inverse f'symm (le_of_lt ε0) hε).mono
    hε (subset.refl _)
end

lemma image_mem_nhds (hf : approximates_linear_on f f' s c) (f'symm : f'.nonlinear_right_inverse)
  {x : E} (hs : s ∈ 𝓝 x) (hc : subsingleton F ∨ c < f'symm.nnnorm⁻¹) :
  f '' s ∈ 𝓝 (f x) :=
begin
  obtain ⟨t, hts, ht, xt⟩ : ∃ t ⊆ s, is_open t ∧ x ∈ t := _root_.mem_nhds_iff.1 hs,
  have := is_open.mem_nhds ((hf.mono_set hts).open_image f'symm ht hc) (mem_image_of_mem _ xt),
  exact mem_of_superset this (image_subset _ hts),
end

lemma map_nhds_eq (hf : approximates_linear_on f f' s c) (f'symm : f'.nonlinear_right_inverse)
  {x : E} (hs : s ∈ 𝓝 x) (hc : subsingleton F ∨ c < f'symm.nnnorm⁻¹) :
  map f (𝓝 x) = 𝓝 (f x) :=
begin
  refine le_antisymm ((hf.continuous_on x (mem_of_mem_nhds hs)).continuous_at hs)
    (le_map (λ t ht, _)),
  have : f '' (s ∩ t) ∈ 𝓝 (f x) := (hf.mono_set (inter_subset_left s t)).image_mem_nhds
    f'symm (inter_mem hs ht) hc,
  exact mem_of_superset this (image_subset _ (inter_subset_right _ _)),
end

end locally_onto

/-!
From now on we assume that `f` approximates an invertible continuous linear map `f : E ≃L[𝕜] F`.

We also assume that either `E = {0}`, or `c < ∥f'⁻¹∥⁻¹`. We use `N` as an abbreviation for `∥f'⁻¹∥`.
-/

variables {f' : E ≃L[𝕜] F} {s : set E} {c : ℝ≥0}

local notation `N` := nnnorm (f'.symm : F →L[𝕜] E)

protected lemma antilipschitz (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) :
  antilipschitz_with (N⁻¹ - c)⁻¹ (s.restrict f) :=
begin
  cases hc with hE hc,
  { haveI : subsingleton s := ⟨λ x y, subtype.eq $ @subsingleton.elim _ hE _ _⟩,
    exact antilipschitz_with.of_subsingleton },
  convert (f'.antilipschitz.restrict s).add_lipschitz_with hf.lipschitz_sub hc,
  simp [restrict]
end

protected lemma injective (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) :
  injective (s.restrict f) :=
(hf.antilipschitz hc).injective

protected lemma inj_on (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) :
  inj_on f s :=
inj_on_iff_injective.2 $ hf.injective hc

/-- A map approximating a linear equivalence on a set defines a local equivalence on this set.
Should not be used outside of this file, because it is superseded by `to_local_homeomorph` below.

This is a first step towards the inverse function. -/
def to_local_equiv (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) : local_equiv E F :=
(hf.inj_on hc).to_local_equiv _ _

/-- The inverse function is continuous on `f '' s`. Use properties of `local_homeomorph` instead. -/
lemma inverse_continuous_on (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) :
  continuous_on (hf.to_local_equiv hc).symm (f '' s) :=
begin
  apply continuous_on_iff_continuous_restrict.2,
  refine ((hf.antilipschitz hc).to_right_inv_on' _ (hf.to_local_equiv hc).right_inv').continuous,
  exact (λ x hx, (hf.to_local_equiv hc).map_target hx)
end

include cs

section
variables (f s)

/-- Given a function `f` that approximates a linear equivalence on an open set `s`,
returns a local homeomorph with `to_fun = f` and `source = s`. -/
def to_local_homeomorph (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) (hs : is_open s) : local_homeomorph E F :=
{ to_local_equiv := hf.to_local_equiv hc,
  open_source := hs,
  open_target := hf.open_image f'.to_nonlinear_right_inverse hs
    (by rwa f'.to_linear_equiv.to_equiv.subsingleton_congr at hc),
  continuous_to_fun := hf.continuous_on,
  continuous_inv_fun := hf.inverse_continuous_on hc }

end

@[simp] lemma to_local_homeomorph_coe (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) (hs : is_open s) :
  (hf.to_local_homeomorph f s hc hs : E → F) = f := rfl

@[simp] lemma to_local_homeomorph_source (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) (hs : is_open s) :
  (hf.to_local_homeomorph f s hc hs).source = s := rfl

@[simp] lemma to_local_homeomorph_target (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) (hs : is_open s) :
  (hf.to_local_homeomorph f s hc hs).target = f '' s := rfl

lemma closed_ball_subset_target (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c)
  (hc : subsingleton E ∨ c < N⁻¹) (hs : is_open s) {b : E} (ε0 : 0 ≤ ε) (hε : closed_ball b ε ⊆ s) :
  closed_ball (f b) ((N⁻¹ - c) * ε) ⊆ (hf.to_local_homeomorph f s hc hs).target :=
(hf.surj_on_closed_ball_of_nonlinear_right_inverse f'.to_nonlinear_right_inverse
  ε0 hε).mono hε (subset.refl _)

end approximates_linear_on

/-!
### Inverse function theorem

Now we prove the inverse function theorem. Let `f : E → F` be a map defined on a complete vector
space `E`. Assume that `f` has an invertible derivative `f' : E ≃L[𝕜] F` at `a : E` in the strict
sense. Then `f` approximates `f'` in the sense of `approximates_linear_on` on an open neighborhood
of `a`, and we can apply `approximates_linear_on.to_local_homeomorph` to construct the inverse
function. -/

namespace has_strict_fderiv_at

/-- If `f` has derivative `f'` at `a` in the strict sense and `c > 0`, then `f` approximates `f'`
with constant `c` on some neighborhood of `a`. -/
lemma approximates_deriv_on_nhds {f : E → F} {f' : E →L[𝕜] F} {a : E}
  (hf : has_strict_fderiv_at f f' a) {c : ℝ≥0} (hc : subsingleton E ∨ 0 < c) :
  ∃ s ∈ 𝓝 a, approximates_linear_on f f' s c :=
begin
  cases hc with hE hc,
  { refine ⟨univ, is_open.mem_nhds is_open_univ trivial, λ x hx y hy, _⟩,
    simp [@subsingleton.elim E hE x y] },
  have := hf.def hc,
  rw [nhds_prod_eq, filter.eventually, mem_prod_same_iff] at this,
  rcases this with ⟨s, has, hs⟩,
  exact ⟨s, has, λ x hx y hy, hs (mk_mem_prod hx hy)⟩
end

lemma map_nhds_eq_of_surj [complete_space E] [complete_space F]
  {f : E → F} {f' : E →L[𝕜] F} {a : E}
  (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) (h : f'.range = ⊤) :
  map f (𝓝 a) = 𝓝 (f a) :=
begin
  let f'symm := f'.nonlinear_right_inverse_of_surjective h,
  set c : ℝ≥0 := f'symm.nnnorm⁻¹ / 2 with hc,
  have f'symm_pos : 0 < f'symm.nnnorm := f'.nonlinear_right_inverse_of_surjective_nnnorm_pos h,
  have cpos : 0 < c, by simp [hc, nnreal.half_pos, nnreal.inv_pos, f'symm_pos],
  obtain ⟨s, s_nhds, hs⟩ : ∃ s ∈ 𝓝 a, approximates_linear_on f f' s c :=
    hf.approximates_deriv_on_nhds (or.inr cpos),
  apply hs.map_nhds_eq f'symm s_nhds (or.inr (nnreal.half_lt_self _)),
  simp [ne_of_gt f'symm_pos],
end

variables [cs : complete_space E] {f : E → F} {f' : E ≃L[𝕜] F} {a : E}

lemma approximates_deriv_on_open_nhds (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  ∃ (s : set E) (hs : a ∈ s ∧ is_open s),
    approximates_linear_on f (f' : E →L[𝕜] F) s ((nnnorm (f'.symm : F →L[𝕜] E))⁻¹ / 2) :=
begin
  refine ((nhds_basis_opens a).exists_iff _).1 _,
  exact (λ s t, approximates_linear_on.mono_set),
  exact (hf.approximates_deriv_on_nhds $ f'.subsingleton_or_nnnorm_symm_pos.imp id $
    λ hf', nnreal.half_pos $ nnreal.inv_pos.2 $ hf')
end

include cs

variable (f)

/-- Given a function with an invertible strict derivative at `a`, returns a `local_homeomorph`
with `to_fun = f` and `a ∈ source`. This is a part of the inverse function theorem.
The other part `has_strict_fderiv_at.to_local_inverse` states that the inverse function
of this `local_homeomorph` has derivative `f'.symm`. -/
def to_local_homeomorph (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) : local_homeomorph E F :=
approximates_linear_on.to_local_homeomorph f
  (classical.some hf.approximates_deriv_on_open_nhds)
  (classical.some_spec hf.approximates_deriv_on_open_nhds).snd
  (f'.subsingleton_or_nnnorm_symm_pos.imp id $ λ hf', nnreal.half_lt_self $ ne_of_gt $
    nnreal.inv_pos.2 $ hf')
  (classical.some_spec hf.approximates_deriv_on_open_nhds).fst.2

variable {f}

@[simp] lemma to_local_homeomorph_coe (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  (hf.to_local_homeomorph f : E → F) = f := rfl

lemma mem_to_local_homeomorph_source (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  a ∈ (hf.to_local_homeomorph f).source :=
(classical.some_spec hf.approximates_deriv_on_open_nhds).fst.1

lemma image_mem_to_local_homeomorph_target (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  f a ∈ (hf.to_local_homeomorph f).target :=
(hf.to_local_homeomorph f).map_source hf.mem_to_local_homeomorph_source

lemma map_nhds_eq_of_equiv (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  map f (𝓝 a) = 𝓝 (f a) :=
(hf.to_local_homeomorph f).map_nhds_eq hf.mem_to_local_homeomorph_source

variables (f f' a)

/-- Given a function `f` with an invertible derivative, returns a function that is locally inverse
to `f`. -/
def local_inverse (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) : F → E :=
(hf.to_local_homeomorph f).symm

variables {f f' a}

lemma local_inverse_def (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  hf.local_inverse f _ _ = (hf.to_local_homeomorph f).symm :=
rfl

lemma eventually_left_inverse (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  ∀ᶠ x in 𝓝 a, hf.local_inverse f f' a (f x) = x :=
(hf.to_local_homeomorph f).eventually_left_inverse hf.mem_to_local_homeomorph_source

@[simp]

lemma eventually_right_inverse (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  ∀ᶠ y in 𝓝 (f a), f (hf.local_inverse f f' a y) = y :=
(hf.to_local_homeomorph f).eventually_right_inverse' hf.mem_to_local_homeomorph_source

lemma local_inverse_continuous_at (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  continuous_at (hf.local_inverse f f' a) (f a) :=
(hf.to_local_homeomorph f).continuous_at_symm hf.image_mem_to_local_homeomorph_target

lemma local_inverse_tendsto (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  tendsto (hf.local_inverse f f' a) (𝓝 $ f a) (𝓝 a) :=
(hf.to_local_homeomorph f).tendsto_symm hf.mem_to_local_homeomorph_source

lemma local_inverse_unique (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) {g : F → E}
  (hg : ∀ᶠ x in 𝓝 a, g (f x) = x) :
  ∀ᶠ y in 𝓝 (f a), g y = local_inverse f f' a hf y :=
eventually_eq_of_left_inv_of_right_inv hg hf.eventually_right_inverse $
  (hf.to_local_homeomorph f).tendsto_symm hf.mem_to_local_homeomorph_source

/-- If `f` has an invertible derivative `f'` at `a` in the sense of strict differentiability `(hf)`,
then the inverse function `hf.local_inverse f` has derivative `f'.symm` at `f a`. -/
theorem to_local_inverse (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) :
  has_strict_fderiv_at (hf.local_inverse f f' a) (f'.symm : F →L[𝕜] E) (f a) :=
(hf.to_local_homeomorph f).has_strict_fderiv_at_symm hf.image_mem_to_local_homeomorph_target $
  by simpa [← local_inverse_def] using hf

/-- If `f : E → F` has an invertible derivative `f'` at `a` in the sense of strict differentiability
and `g (f x) = x` in a neighborhood of `a`, then `g` has derivative `f'.symm` at `f a`.

For a version assuming `f (g y) = y` and continuity of `g` at `f a` but not `[complete_space E]`
see `of_local_left_inverse`.  -/
theorem to_local_left_inverse (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) {g : F → E}
  (hg : ∀ᶠ x in 𝓝 a, g (f x) = x) :
  has_strict_fderiv_at g (f'.symm : F →L[𝕜] E) (f a) :=
hf.to_local_inverse.congr_of_eventually_eq $ (hf.local_inverse_unique hg).mono $ λ _, eq.symm

end has_strict_fderiv_at

/-- If a function has an invertible strict derivative at all points, then it is an open map. -/
lemma open_map_of_strict_fderiv_equiv [complete_space E] {f : E → F} {f' : E → E ≃L[𝕜] F}
  (hf : ∀ x, has_strict_fderiv_at f (f' x : E →L[𝕜] F) x) :
  is_open_map f :=
is_open_map_iff_nhds_le.2 $ λ x, (hf x).map_nhds_eq_of_equiv.ge

/-!
### Inverse function theorem, 1D case

In this case we prove a version of the inverse function theorem for maps `f : 𝕜 → 𝕜`.
We use `continuous_linear_equiv.units_equiv_aut` to translate `has_strict_deriv_at f f' a` and
`f' ≠ 0` into `has_strict_fderiv_at f (_ : 𝕜 ≃L[𝕜] 𝕜) a`.
-/

namespace has_strict_deriv_at

variables [cs : complete_space 𝕜] {f : 𝕜 → 𝕜} {f' a : 𝕜} (hf : has_strict_deriv_at f f' a)
  (hf' : f' ≠ 0)

include cs

variables (f f' a)

/-- A function that is inverse to `f` near `a`. -/
@[reducible] def local_inverse : 𝕜 → 𝕜 :=
(hf.has_strict_fderiv_at_equiv hf').local_inverse _ _ _

variables {f f' a}

lemma map_nhds_eq : map f (𝓝 a) = 𝓝 (f a) :=
(hf.has_strict_fderiv_at_equiv hf').map_nhds_eq_of_equiv

theorem to_local_inverse : has_strict_deriv_at (hf.local_inverse f f' a hf') f'⁻¹ (f a) :=
(hf.has_strict_fderiv_at_equiv hf').to_local_inverse

theorem to_local_left_inverse {g : 𝕜 → 𝕜} (hg : ∀ᶠ x in 𝓝 a, g (f x) = x) :
  has_strict_deriv_at g f'⁻¹ (f a) :=
(hf.has_strict_fderiv_at_equiv hf').to_local_left_inverse hg

end has_strict_deriv_at

/-- If a function has a non-zero strict derivative at all points, then it is an open map. -/
lemma open_map_of_strict_deriv [complete_space 𝕜] {f f' : 𝕜 → 𝕜}
  (hf : ∀ x, has_strict_deriv_at f (f' x) x) (h0 : ∀ x, f' x ≠ 0) :
  is_open_map f :=
is_open_map_iff_nhds_le.2 $ λ x, ((hf x).map_nhds_eq (h0 x)).ge

/-!
### Inverse function theorem, smooth case

-/

namespace times_cont_diff_at
variables {𝕂 : Type*} [is_R_or_C 𝕂]
variables {E' : Type*} [normed_group E'] [normed_space 𝕂 E']
variables {F' : Type*} [normed_group F'] [normed_space 𝕂 F']
variables [complete_space E'] (f : E' → F') {f' : E' ≃L[𝕂] F'} {a : E'}

/-- Given a `times_cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible
derivative at `a`, returns a `local_homeomorph` with `to_fun = f` and `a ∈ source`. -/
def to_local_homeomorph
  {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a)
  (hn : 1 ≤ n) :
  local_homeomorph E' F' :=
(hf.has_strict_fderiv_at' hf' hn).to_local_homeomorph f

variable {f}

@[simp] lemma to_local_homeomorph_coe
  {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a)
  (hn : 1 ≤ n) :
  (hf.to_local_homeomorph f hf' hn : E' → F') = f := rfl

lemma mem_to_local_homeomorph_source
  {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a)
  (hn : 1 ≤ n) :
  a ∈ (hf.to_local_homeomorph f hf' hn).source :=
(hf.has_strict_fderiv_at' hf' hn).mem_to_local_homeomorph_source

lemma image_mem_to_local_homeomorph_target
  {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a)
  (hn : 1 ≤ n) :
  f a ∈ (hf.to_local_homeomorph f hf' hn).target :=
(hf.has_strict_fderiv_at' hf' hn).image_mem_to_local_homeomorph_target

/-- Given a `times_cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible derivative
at `a`, returns a function that is locally inverse to `f`. -/
def local_inverse
  {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a)
  (hn : 1 ≤ n) :
  F' → E' :=
(hf.has_strict_fderiv_at' hf' hn).local_inverse f f' a

lemma local_inverse_apply_image
  {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a)
  (hn : 1 ≤ n) :
  hf.local_inverse hf' hn (f a) = a :=
(hf.has_strict_fderiv_at' hf' hn).local_inverse_apply_image

/-- Given a `times_cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible derivative
at `a`, the inverse function (produced by `times_cont_diff.to_local_homeomorph`) is
also `times_cont_diff`. -/
lemma to_local_inverse
  {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a)
  (hn : 1 ≤ n) :
  times_cont_diff_at 𝕂 n (hf.local_inverse hf' hn) (f a) :=
begin
  have := hf.local_inverse_apply_image hf' hn,
  apply (hf.to_local_homeomorph f hf' hn).times_cont_diff_at_symm
    (image_mem_to_local_homeomorph_target hf hf' hn),
  { convert hf' },
  { convert hf }
end

end times_cont_diff_at


/-
Copyright (c) 2020 Kevin Buzzard
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, and whoever else wants to join in.
-/

 -- need the definition of an affine alg set
import affine_algebraic_set.basic

 -- need so I can state that the kernel of the evaluation map is 𝕀
import affine_algebraic_set.I

/-!

# Regular functions

Let k be a field (or even an integral domain), and let V be an
affine algebraic subset of 𝔸ⁿ (where n can even be infinite).
A _regular function_ on V is a function V → k which is induced
by some polynomial F ∈ k[X₁, X₂, …, Xₙ]. Note that F itself
is not part of the data, and a regular function can be induced
by more than one polynomial in general.

-/

-- I think it might all work with commutative semirings but
-- let's let k be a commutative ring.
variables {k : Type*} [comm_ring k] {n : Type*}

local notation `𝔸ⁿ` := n → k
local notation `k[n]` := mv_polynomial n k

-- The idea: a mathematician shouldn't need to look at most of this file.
-- The plan would be that they just read the API in the comments above.

-- They just need to know the API.

-- Throughout this file, let V ⊆ 𝔸ⁿ be an affine algebraic subset.
variable {V : affine_algebraic_set k n}

local notation `subset_of` := set

open mv_polynomial

def is_regular2 (f : (V : subset_of 𝔸ⁿ) → k) : Prop :=
  ∃ F : k[n], ∀ (x : 𝔸ⁿ) (hx : x ∈ V), F.eval x = f ⟨x, hx⟩

def is_regular (f : (V : subset_of 𝔸ⁿ) → k) : Prop :=
  ∃ F : k[n], ∀ (x : (V : subset_of 𝔸ⁿ)), F.eval x = f x

/-- A "regular function" is a pair: a function V → k, and a proof that
it comes from a polynomial -/
structure regular_fun (V : affine_algebraic_set k n) :=
(to_fun : {x : 𝔸ⁿ // x ∈ (V : subset_of 𝔸ⁿ)} → k)
(is_regular' : is_regular to_fun)

local notation `k[V]` := regular_fun V

namespace regular_fun

/-- A regular function on V can be regarded as a function from V to k -/
instance : has_coe_to_fun (k[V]) :=
⟨_, regular_fun.to_fun⟩

variable {V}

/-- A regular function is induced from a polynomial -/
lemma is_regular (f : k[V]): ∃ F : k[n],
   ∀ (x : (V : subset_of 𝔸ⁿ)), F.eval x = f x := f.is_regular'

variable (V)

def mk' (V : affine_algebraic_set k n) (F : k[n]) : regular_fun V :=
{ to_fun := λ x, F.eval x, -- i.e. F(x)
  is_regular' := ⟨F, λ x, rfl⟩ }

variable {V}

def mk'.some_spec (F : k[n]) (x : (V : subset_of 𝔸ⁿ)) :
  (classical.some (mk' V F).is_regular).eval x = _ := classical.some_spec (mk' V F).is_regular x

/- Two regular functions are equal if and only if their
 underlying functions V → k are equal -/
@[ext] lemma ext (f g : k[V]) : (f : (V : set 𝔸ⁿ) → k) = g → f = g :=
begin
  intro h,
  cases f,
  cases g,
  congr',
end

/-- The iff is also sometimes helpful-/
lemma ext_iff (f g : k[V]) : f = g ↔ (f : (V : set 𝔸ⁿ) → k) = g :=
⟨λ h, h ▸ rfl, ext f g⟩

-- We prove the regular functions are naturally a ring.

def zero : k[V] :=
{ to_fun := λ x, 0,
  is_regular' := begin
    -- the function V → k sending everything to zero is a regular function
    use 0,
    intros,
    rw eval_zero,
  end
}

instance : has_zero (k[V]) := ⟨zero⟩

def one : k[V] :=
{ to_fun := λ x, 1,
  is_regular' := begin
    -- the function V → k sending everything to zero is a regular function
    use 1,
    intros,
    rw eval_one,
  end
}

instance : has_one (k[V]) := ⟨one⟩

def add (f g : k[V]) : k[V] :=
{ to_fun := λ x, f x + g x,
  is_regular' := begin
    -- sum of two regular functions is regular
    cases f.is_regular with F hF,
    cases g.is_regular with G hG,
    use F + G,
    intro x,
    rw eval_add,
    rw hF,
    rw hG,
  end
}

instance : has_add (k[V]) := ⟨add⟩

def neg (f : k[V]) : k[V] :=
{ to_fun := λ x, -(f x),
  is_regular' := begin
    -- additive inverse of a regular function is regular
    cases f.is_regular with F hF,
    use -F,
    intro x,
    rw eval_neg,
    rw hF,
  end
}

instance : has_neg (k[V]) := ⟨neg⟩

def mul (f g : k[V]) : k[V] :=
{ to_fun := λ x, (f x) * (g x),
  is_regular' := begin
    -- additive inverse of a regular function is regular
    cases f.is_regular with F hF,
    cases g.is_regular with G hG,
    use F * G,
    intro x,
    rw eval_mul,
    rw hF,
    rw hG,
  end
}

instance : has_mul (k[V]) := ⟨mul⟩

instance : comm_ring (k[V]) :=
{ add := (+),
  add_assoc := begin intros f g h, ext, apply add_assoc, end,
  zero := 0,
  zero_add := begin intro f, ext, apply zero_add, end,
  add_zero := begin intro f, ext, apply add_zero, end,
  neg := has_neg.neg,
  add_left_neg := begin intro f, ext, apply add_left_neg, end,
  add_comm := begin intros f g, ext, apply add_comm, end,
  mul := (*),
  mul_assoc := begin intros f g h, ext, apply mul_assoc, end,
  one := 1,
  one_mul := begin intro f, ext, apply one_mul, end,
  mul_one := begin intro f, ext, apply mul_one, end,
  left_distrib := begin intros f g h, ext, apply left_distrib, end,
  right_distrib := begin intros f g h, ext, apply right_distrib, end,
  mul_comm := begin intros f g, ext, apply mul_comm, end }

end regular_fun

/-- The ring homomorphism from k[X₁, X₂, …, Xₙ] to k[V] -/
noncomputable def mv_polynomial.to_regular_fun : mv_polynomial n k →+* k[V] :=
{ to_fun := λ F,
  { to_fun := λ x, F.eval x.1,
    is_regular' := ⟨F, λ x, rfl⟩
  },
  -- proof that it's a ring homomorphism
  map_one' := begin
    ext,
    apply eval_one,
  end,
  map_mul' := begin
    intros f g,
    ext,
    apply eval_mul,
  end,
  map_zero' := begin
    ext,
    unfold_coes, dsimp,
    apply eval_zero,
  end,
  map_add' := begin
    intros f g,
    ext,
    apply eval_add,
  end
}

namespace regular_fun

instance : has_scalar k k[V] :=
{ smul := λ t f,
  { to_fun := λ v, t * f v,
    is_regular' := begin
      cases f.is_regular with F hF,
      use (C t) * F,
      intro x,
      rw [eval_mul, eval_C, hF]
    end
  }
}

instance : is_ring_hom (λ t, mk' V (C t)) :=
{ map_one := begin
    ext x,
    unfold_coes,
    unfold mk',
    dsimp,
    rw eval_one,
    refl,
  end,
  map_mul :=
  begin
    intros s t,
    ext x,
    unfold_coes,
    unfold mk',
    dsimp,
    rw eval_C,
    simp [eval_C],
    refl,
  end,
  map_add :=
  begin
    intros s t,
    ext x,
    unfold_coes,
    unfold mk',
    dsimp,
    simp [eval_C],
    refl
  end
}.

noncomputable instance : algebra k k[V] :=
{ to_fun := (λ t, mk' V (C t)),
  hom := by apply_instance,
  commutes' := begin
    intros r x,
    apply mul_comm,
  end,
  smul_def' := begin
    intros r f,
    ext x,
    show _ = mk' V (C r) x * f x,
    unfold_coes,
    unfold mk',
    simp only [eval_C],
    refl,
  end
}
end regular_fun

open mv_polynomial function

lemma mv_polynomial.to_regular_fun.surjective :
  surjective
    ((to_regular_fun : mv_polynomial n k →+* k[V]) : mv_polynomial n k → k[V]) :=
begin
  intro f,
  cases f.is_regular with F hF,
  use F,
  ext x,
  rw ←hF x,
  refl,
end

open affine_algebraic_set

lemma to_regular_fun.mem_kernel (F : mv_polynomial n k) :
  ((to_regular_fun : mv_polynomial n k →+* k[V]) : mv_polynomial n k → k[V]) F = 0
  ↔ F ∈ 𝕀 V :=
begin
  rw mem_𝕀_iff,
  rw regular_fun.ext_iff,
  rw funext_iff,
  split, -- sigh
  { intros f x hx, exact f ⟨x, hx⟩},
  { intros f x, exact f x.1 x.2}
end

-- let's prove it's a k-algebra hom
noncomputable def mv_polynomial.to_regular_fun_algebra_map : k[n] →ₐ[k] k[V] :=
{ to_fun := to_regular_fun.to_fun,
  map_one' := begin
    ext x,
    cases x with x hx,
    exact eval_one x
  end,
  map_mul' := begin
    intros f g,
    ext x,
    exact eval_mul,
  end,
  map_zero' := begin
    ext x,
    cases x with x hx,
    convert @eval_zero _ _ _ x,
  end,
  map_add' := begin
    intros f g,
    ext x,
    exact eval_add,
  end,
  commutes' := begin
    intro s,
    refl,
  end }

/-
TODO -- ask on Zulip why f is implicit and x explicit (note the trouble this caused me in map_zero')

mv_polynomial.eval_one : ∀ {X : Type u_2} {R : Type u_1} [_inst_1 : comm_semiring R] (x : X → R), eval x 1 = 1
mv_polynomial.eval_zero : ∀ {α : Type ?} {n : Type ?} [_inst_1 : comm_semiring α] {f : n → α}, eval f 0 = 0
-/