/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Jeremy Avigad
-/
prelude
import init.datatypes init.logic
open decidable

set_option structure.proj_mk_thm true

structure subtype {A : Type} (P : A → Prop) :=
tag :: (elt_of : A) (has_property : P elt_of)

namespace subtype
  notation `{` binder ` | ` r:(scoped:1 P, subtype P) `}` := r

  definition exists_of_subtype {A : Type} {P : A → Prop} : { x | P x } → ∃ x, P x
  | (subtype.tag a h) := exists.intro a h

  variables {A : Type} {P : A → Prop}

  theorem tag_irrelevant {a : A} (H1 H2 : P a) : tag a H1 = tag a H2 :=
  rfl

  theorem tag_eq {a1 a2 : A} {H1 : P a1} {H2 : P a2} (H3 : a1 = a2) : tag a1 H1 = tag a2 H2 :=
  eq.subst H3 (tag_irrelevant H1) H2

  protected theorem eq : ∀ {a1 a2 : {x | P x}} (H : elt_of a1 = elt_of a2), a1 = a2
  | (tag x1 H1) (tag x2 H2) := tag_eq

  protected definition is_inhabited [instance] {a : A} (H : P a) : inhabited {x | P x} :=
  inhabited.mk (tag a H)

  protected definition has_decidable_eq [instance] [H : decidable_eq A] : ∀ s₁ s₂ : {x | P x}, decidable (s₁ = s₂)
  | (tag v₁ p₁) (tag v₂ p₂) :=
  decidable_of_decidable_of_iff (H v₁ v₂)
    (iff.intro tag_eq (λh, subtype.no_confusion h (λa b, a)))
end subtype


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

/-!
# Bounded linear maps

This file defines a class stating that a map between normed vector spaces is (bi)linear and
continuous.
Instead of asking for continuity, the definition takes the equivalent condition (because the space
is normed) that `∥f x∥` is bounded by a multiple of `∥x∥`. Hence the "bounded" in the name refers to
`∥f x∥/∥x∥` rather than `∥f x∥` itself.

## Main definitions

* `is_bounded_linear_map`: Class stating that a map `f : E → F` is linear and has `∥f x∥` bounded
  by a multiple of `∥x∥`.
* `is_bounded_bilinear_map`: Class stating that a map `f : E × F → G` is bilinear and continuous,
  but through the simpler to provide statement that `∥f (x, y)∥` is bounded by a multiple of
  `∥x∥ * ∥y∥`
* `is_bounded_bilinear_map.linear_deriv`: Derivative of a continuous bilinear map as a linear map.
* `is_bounded_bilinear_map.deriv`: Derivative of a continuous bilinear map as a continuous linear
  map. The proof that it is indeed the derivative is `is_bounded_bilinear_map.has_fderiv_at` in
  `analysis.calculus.fderiv`.

## Main theorems

* `is_bounded_bilinear_map.continuous`: A bounded bilinear map is continuous.
* `continuous_linear_equiv.is_open`: The continuous linear equivalences are an open subset of the
  set of continuous linear maps between a pair of Banach spaces.  Placed in this file because its
  proof uses `is_bounded_bilinear_map.continuous`.

## Notes

The main use of this file is `is_bounded_bilinear_map`. The file `analysis.normed_space.multilinear`
already expounds the theory of multilinear maps, but the `2`-variables case is sufficiently simpler
to currently deserve its own treatment.

`is_bounded_linear_map` is effectively an unbundled version of `continuous_linear_map` (defined
in `topology.algebra.module`, theory over normed spaces developed in
`analysis.normed_space.operator_norm`), albeit the name disparity. A bundled
`continuous_linear_map` is to be preferred over a `is_bounded_linear_map` hypothesis. Historical
artifact, really.
-/

noncomputable theory
open_locale classical big_operators topological_space

open filter (tendsto) metric

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

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

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

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

namespace is_bounded_linear_map

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

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

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

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

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

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

variables {f g : E → F}

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

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

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

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

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

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

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

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

section
open asymptotics filter

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

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

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

end

end is_bounded_linear_map

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

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

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

end

section bilinear_map

variable (𝕜)

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

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

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

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

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

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

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

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

lemma is_bounded_bilinear_map.continuous (h : is_bounded_bilinear_map 𝕜 f) :
  continuous f :=
begin
  have one_ne : (1:ℝ) ≠ 0 := by simp,
  obtain ⟨C, (Cpos : 0 < C), hC⟩ := h.bound,
  rw continuous_iff_continuous_at,
  intros x,
  have H : ∀ (a:E) (b:F), ∥f (a, b)∥ ≤ C * ∥∥a∥ * ∥b∥∥,
  { intros a b,
    simpa [mul_assoc] using hC a b },
  have h₁ : asymptotics.is_o (λ e : E × F, f (e.1 - x.1, e.2)) (λ e, (1:ℝ)) (𝓝 x),
  { refine (asymptotics.is_O_of_le' (𝓝 x) (λ e, H (e.1 - x.1) e.2)).trans_is_o _,
    rw asymptotics.is_o_const_iff one_ne,
    convert ((continuous_fst.sub continuous_const).norm.mul continuous_snd.norm).continuous_at,
    { simp },
    apply_instance },
  have h₂ : asymptotics.is_o (λ e : E × F, f (x.1, e.2 - x.2)) (λ e, (1:ℝ)) (𝓝 x),
  { refine (asymptotics.is_O_of_le' (𝓝 x) (λ e, H x.1 (e.2 - x.2))).trans_is_o _,
    rw asymptotics.is_o_const_iff one_ne,
    convert (continuous_const.mul (continuous_snd.sub continuous_const).norm).continuous_at,
    { simp },
    apply_instance },
  have := h₁.add h₂,
  rw asymptotics.is_o_const_iff one_ne at this,
  change tendsto _ _ _,
  convert this.add_const (f x),
  { ext e,
    simp [h.map_sub_left, h.map_sub_right], },
  { simp }
end

lemma is_bounded_bilinear_map.continuous_left (h : is_bounded_bilinear_map 𝕜 f) {e₂ : F} :
  continuous (λe₁, f (e₁, e₂)) :=
h.continuous.comp (continuous_id.prod_mk continuous_const)

lemma is_bounded_bilinear_map.continuous_right (h : is_bounded_bilinear_map 𝕜 f) {e₁ : E} :
  continuous (λe₂, f (e₁, e₂)) :=
h.continuous.comp (continuous_const.prod_mk continuous_id)

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

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

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

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

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

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

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

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

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

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

/-- Definition of the derivative of a bilinear map `f`, given at a point `p` by
`q ↦ f(p.1, q.2) + f(q.1, p.2)` as in the standard formula for the derivative of a product.
We define this function here as a linear map `E × F →ₗ[𝕜] G`, then `is_bounded_bilinear_map.deriv`
strengthens it to a continuous linear map `E × F →L[𝕜] G`.
``. -/
def is_bounded_bilinear_map.linear_deriv (h : is_bounded_bilinear_map 𝕜 f) (p : E × F) :
  E × F →ₗ[𝕜] G :=
{ to_fun := λ q, f (p.1, q.2) + f (q.1, p.2),
  map_add' := λ q₁ q₂, begin
    change f (p.1, q₁.2 + q₂.2) + f (q₁.1 + q₂.1, p.2) =
      f (p.1, q₁.2) + f (q₁.1, p.2) + (f (p.1, q₂.2) + f (q₂.1, p.2)),
    simp [h.add_left, h.add_right], abel
  end,
  map_smul' := λ c q, begin
    change f (p.1, c • q.2) + f (c • q.1, p.2) = c • (f (p.1, q.2) + f (q.1, p.2)),
    simp [h.smul_left, h.smul_right, smul_add]
  end }

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

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

variables (𝕜)

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

variables {𝕜}

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

end bilinear_map

namespace continuous_linear_equiv

open set

/-!
### The set of continuous linear equivalences between two Banach spaces is open

In this section we establish that the set of continuous linear equivalences between two Banach
spaces is an open subset of the space of linear maps between them.
-/

protected lemma is_open [complete_space E] : is_open (range (coe : (E ≃L[𝕜] F) → (E →L[𝕜] F))) :=
begin
  rw [is_open_iff_mem_nhds, forall_range_iff],
  refine λ e, is_open.mem_nhds _ (mem_range_self _),
  let O : (E →L[𝕜] F) → (E →L[𝕜] E) := λ f, (e.symm : F →L[𝕜] E).comp f,
  have h_O : continuous O := is_bounded_bilinear_map_comp.continuous_left,
  convert units.is_open.preimage h_O using 1,
  ext f',
  split,
  { rintros ⟨e', rfl⟩,
    exact ⟨(e'.trans e.symm).to_unit, rfl⟩ },
  { rintros ⟨w, hw⟩,
    use (units_equiv 𝕜 E w).trans e,
    ext x,
    simp [coe_fn_coe_base' w, hw] }
end

protected lemma nhds [complete_space E] (e : E ≃L[𝕜] F) :
  (range (coe : (E ≃L[𝕜] F) → (E →L[𝕜] F))) ∈ 𝓝 (e : E →L[𝕜] F) :=
is_open.mem_nhds continuous_linear_equiv.is_open (by simp)

end continuous_linear_equiv


import tactic .mynat

namespace hidden

class inductive decidable (p : Prop) : Type
| is_false  : ¬p → decidable
| is_true   : p → decidable

open hidden.decidable

instance decidable_true : decidable true := is_true trivial

instance decidable_false : decidable false := is_false (λ q, false.elim q)

instance decidable_not (p : Prop) [h : decidable p] : decidable ¬p :=
match h with
| (is_false hnp)  := is_true hnp
| (is_true hp)    := is_false (λ hnp, hnp hp)
end

instance decidable_and (p q : Prop) [h₁ : decidable p] [h₂ : decidable q] : decidable (p ∧ q) :=
match h₁, h₂ with
| (is_false hnp), h₂              := is_false (λ hpq, hnp hpq.left)
| (is_true hp),   (is_false hnq)  := is_false (λ hpq, hnq hpq.right)
| (is_true hp),   (is_true hq)    := is_true ⟨hp, hq⟩
end

lemma decidable_and' (p q : Prop) [h₁ : decidable p] [h₂ : decidable q] : decidable (p ∧ q) :=
begin
  tactic.unfreeze_local_instances,
  cases h₁ with hnp hp,
  { apply is_false, intro hpq, exact hnp hpq.1, },
  { cases h₂ with hnq hq,
    { apply is_false, intro hpq, exact hnq hpq.2, },
    { exact is_true ⟨hp, hq⟩ } },
end

def decidable_or' (p q : Prop) [h₁ : decidable p] [h₂ : decidable q] : decidable (p ∨ q) :=
begin
  rw [←@not_not (p ∨ q), not_or_distrib],
  apply_instance,
end

instance decidable_or (p q : Prop) [h₁ : decidable p] [h₂ : decidable q] : decidable (p ∨ q) :=
match h₁, h₂ with
| (is_true hp), h₂                := is_true (or.inl hp)
| (is_false hnp), (is_true hq)    := is_true (or.inr hq)
| (is_false hnp), (is_false hnq)  := is_false (λ hpq, or.elim hpq hnp hnq)
end

-- Note that `imp_iff_not_or` depends on the decidability of `p`.
instance decidable_if (p q : Prop) [h₁ : decidable p] [h₂ : decidable q] : decidable (p → q) :=
by { rw imp_iff_not_or, apply_instance }

instance decidable_iff (p q : Prop) [h₁ : decidable p] [h₂ : decidable q] : decidable (p ↔ q) :=
by { rw iff_def, apply_instance }

example (p q : Prop) [decidable p] [decidable q] : decidable $ (p ∧ q) → q := infer_instance

def ite (c : Prop) [d : decidable c] {α} (t e : α) : α := decidable.rec_on d (λ hnc, e) (λ hc, t)

instance decidable_eq_self {α} (x : α) : decidable (x = x) := is_true rfl

example : ite (5 = 5) true false := trivial

example : ¬(ite (5 ≠ 5) true false) := false.elim

def as_true (c : Prop) [decidable c] : Prop := ite c true false

def of_as_true {c : Prop} [h₁ : decidable c] (h₂ : as_true c) : c :=
match h₁, h₂ with
| (is_true hc),  h₂ := hc
| (is_false _),  h₂ := false.elim h₂
end

example : decidable (5 ≠ 5) := infer_instance

open mynat

instance decidable_mynat_le (a : mynat) : ∀ b : mynat, decidable (a ≤ b) :=
begin
  induction a with a ha,
  { intro b, apply is_true, apply mynat.zero_le, },
  { intro b,
    induction b with b hb,
    { apply is_false, apply not_succ_le_zero, },
    { cases ha b with h h,
      { apply is_false, intro h₂,
        apply h, exact le_of_succ_le_succ h₂, },
      { apply is_true, exact succ_le_succ_of_le h, }, } },
end

example : ite ((20 : mynat) ≤ 30) true false := trivial

example : ¬ ite ((30 : mynat) ≤ 20 ) true false := false.elim

example (x : mynat) : ite (((5 : mynat) ≤ 6) ∧ (x = x)) true false := trivial

example (x : mynat) : as_true (((5 : mynat) ≤ 6) ∧ (x = x))  := trivial

example : as_true ((50 : mynat) ≤ 60) := trivial

example : as_true ((0 : mynat) ≤ 5) = true := rfl

example : (20 : mynat) ≤ 30 ∧ (5 : mynat) = 5:= of_as_true trivial

example [h₁ : decidable (5 ≠ 5)] (h₂ : as_true (5 ≠ 5)) : 5 ≠ 5 := of_as_true h₂

instance decidable_eq_zero : ∀ (y : mynat) , decidable (zero = y)
| zero      := is_true rfl
| (succ _)  := is_false (succ_ne_zero _).symm

instance decidable_eq (x : mynat) : ∀ y : mynat, decidable (x = y) :=
begin
  induction x,
  case zero { apply_instance, },
  case succ : x h
  { intro y,
    induction y,
    case zero { apply is_false, apply succ_ne_zero, },
    case succ : z h₂
    { cases h₂,
      { cases (h z),
        case is_false : h₃ { apply is_false, intro h₄, apply h₃, exact succ.inj h₄, },
        case is_true : h₃ { apply is_true, rwa h₃, }, },
      { apply is_false, intro h₃, rw succ.inj_eq at h₃, rw h₃ at h₂, exact mynat.succ_ne_self _ h₂, }, } }
end

lemma fifteen_eq_five_plus_ten : (15 : mynat) = 5+10 := of_as_true (by trivial)

--set_option pp.all true

--#print fifteen_eq_five_plus_ten

example : (5 : mynat) ≠ 20 := of_as_true (by trivial)

end hidden

lemma foo : ite (5 = 6) 10 20 = 20 := rfl

lemma bar : ite (5 ≠ 6) 10 20 = 10 := rfl

lemma bar' : (if (5 ≠ 6) then 10 else 20) = 10 := rfl

example : decidable (5 = 6) := nat.decidable_eq 5 6

lemma decidable_not (p : Prop) [decidable p] : decidable ¬p :=
dite p (λ (h : p), decidable.is_false $ λ (hn : ¬p), hn h) (λ (h : ¬p) , decidable.is_true h)

lemma em' (p : Prop) [decidable p] : p ∨ ¬p := dite p (λ hp, or.inl hp) (λ hnp, or.inr hnp)

lemma em'' (p : Prop) [decidable p] : p ∨ ¬p := if hp : p then or.inl hp else or.inr hp

lemma boo (p : Prop) [decidable p] : p ∨ ¬p := if hp : p then or.inl hp else or.inr hp

def mod : ℕ → ℕ → ℕ
| a 0       := a
| a (b + 1)   :=
if h : a < (b + 1) then a else
  have a - (b + 1) < a, from nat.sub_lt (show 0 < a, by linarith) (show 0 < (b+1), by linarith),
  mod (a - (b + 1)) (b + 1)

  example : (5 ≠ 7) ∧ (10 ≤ 20) := dec_trivial


import M4R.Set.Finite.Finset

namespace List
  open M4R

  def range' : Nat → Nat → List Nat
  | s, 0     => []
  | s, (n+1) => s::range' (s+1) n

  @[simp] theorem range_zero : range 0 = [] := rfl

  @[simp] theorem range'_empty (n : Nat) : range' n 0 = [] := rfl
  @[simp] theorem range'_singleton (n : Nat) : range' n 1 = [n] := rfl

  theorem range_core_range' : ∀ s n : Nat, rangeAux s (range' s n) = range' 0 (n + s)
  | 0    , n => rfl
  | (s+1), n => by
    have : n+(s+1) = n+1+s := Nat.add_right_comm n s 1
    rw [this]
    exact range_core_range' s (n+1)

  theorem range_eq_range' (n : Nat) : range n = range' 0 n :=
    (range_core_range' n 0).trans (by rw [Nat.zero_add])

  theorem range'_start (s n : Nat) : range' s n.succ = [s] ++ range' s.succ n := rfl

  theorem range_start (n : Nat) : range n.succ = [0] ++ range' 1 n := by
    rw [range_eq_range', range'_start]

  @[simp] theorem range'_append : ∀ s m n : Nat, range' s m ++ range' (s+m) n = range' s (n+m)
  | s, 0  , n => rfl
  | s, m+1, n => by
    have : s :: (range' (s+1) m ++ range' (s+m+1) n) = s :: range' (s+1) (n+m) := by
      rw [Nat.add_right_comm, range'_append]
    exact this

  theorem range'_succ (s n : Nat) : range' s n.succ = range' s n ++ [s+n] := by
    rw [Nat.succ_eq_add_one, Nat.add_comm n 1]; exact (range'_append s n 1).symm

  theorem range_succ (n : Nat) : range n.succ = range n ++ [n] := by
    have := range'_succ 0 n; rw [←range_eq_range', ←range_eq_range', Nat.zero_add] at this
    exact this

  theorem range_add (a : Nat) : ∀ b, range (a + b) = range a ++ (range b).map (a + ·)
  | 0     => by rw [Nat.add_zero, range_zero, map_nil, append_nil]
  | b + 1 => by rw [Nat.add_succ, range_succ, range_add a b, range_succ, map_append, map_singleton, append_assoc]

  @[simp] theorem mem_range' : ∀ {m s n : Nat}, m ∈ range' s n ↔ s ≤ m ∧ m < s + n
  | m, s, Nat.zero => by
    rw [range'_empty, mem_nil_iff, false_iff, not_and_iff_or_not,
      Nat.add_zero, Nat.not_le, Nat.not_lt]; exact (Nat.le_or_lt s m).comm
  | m, s, Nat.succ n => by
    have : m = s → m < s + n + 1 := (· ▸ Nat.lt_succ_of_le (Nat.le_add_right _ _))
    have l : m = s ∨ s + 1 ≤ m ↔ s ≤ m := by
      conv => rhs rw [Nat.le_iff_eq_or_lt, Eq.comm]; exact Iff.rfl
    simp only [range', mem_cons_iff, mem_range', or_and_distrib_left,
      or_iff_right_of_imp this, l, Nat.add_right_comm]
    exact Iff.rfl

  @[simp] theorem mem_range {m n : Nat} : m ∈ range n ↔ m < n := by
    simp only [range_eq_range', mem_range', Nat.zero_le, true_and, Nat.zero_add]; exact Iff.rfl

  inductive chain (R : α → α → Prop) : α → List α → Prop
  | nil {a : α} : chain R a []
  | cons : ∀ {a b : α} {l : List α}, R a b → chain R b l → chain R a (b::l)

  variable {R : α → α → Prop}

  @[simp] theorem chain_cons {a b : α} {l : List α} : chain R a (b::l) ↔ R a b ∧ chain R b l :=
    ⟨fun p => by cases p with | cons n p => exact ⟨n, p⟩, fun ⟨n, p⟩ => p.cons n⟩

  theorem chain.imp' {S : α → α → Prop} (HRS : ∀ ⦃a b⦄, R a b → S a b)
    {a b : α} (Hab : ∀ ⦃c⦄, R a c → S b c)
    {l : List α} (p : chain R a l) : chain S b l := by
      induction p generalizing b with
      | nil => constructor
      | cons r c ih => exact chain.cons (Hab r) (ih (@HRS _))

  theorem chain.imp {S : α → α → Prop} (H : ∀ a b, R a b → S a b)
    {a : α} {l : List α} (p : chain R a l) : chain S a l :=
      p.imp' H (H a)

  theorem chain_of_pairwise {a : α} {l : List α} (p : Pairwise R (a::l)) : chain R a l := by
    let ⟨r, p'⟩ := Pairwise.consIff.mp p
    induction p' generalizing a with
    | nil => constructor
    | cons r' p ih =>
      simp only [chain_cons, forall_mem_cons] at r
      exact chain_cons.mpr ⟨r.left, ih (Pairwise.consIff.mp p).right r'⟩

  theorem chain_iff_pairwise (tr : ∀ ⦃x y z⦄, R x y → R y z → R x z) {a : α} {l : List α} :
    chain R a l ↔ Pairwise R (a::l) :=
      ⟨fun c => by
        induction c with
        | nil => exact Pairwise.singleton _ _
        | cons r p ih =>
          exact Pairwise.cons (fun x hx => Or.elim (eq_or_mem_of_mem_cons hx)
            (fun h => by rw [h]; exact r) (fun h => tr r ((Pairwise.consIff.mp ih).left x h))) ih,
      chain_of_pairwise⟩

  theorem chain_succ_range' : ∀ s n : Nat, chain (fun a b => b = Nat.succ a) s (range' (s+1) n)
  | s, 0     => chain.nil
  | s, (n+1) => (chain_succ_range' (s+1) n).cons rfl

  theorem chain_lt_range' (s n : Nat) : chain (fun a b => a < b) s (range' (s+1) n) :=
    (chain_succ_range' s n).imp (fun a b e => e.symm ▸ Nat.lt_succ_self _)

  theorem pairwise_lt_range' : ∀ s n : Nat, Pairwise (fun a b => a < b) (range' s n)
  | s, 0     => Pairwise.nil
  | s, (n+1) => (chain_iff_pairwise (by exact fun a b c => Nat.lt_trans)).mp (chain_lt_range' s n)

  theorem nodup_range' (s n : Nat) : nodup (range' s n) :=
    (pairwise_lt_range' s n).imp fun _ _ => Nat.ne_of_lt

  theorem nodup_range (n : Nat) : nodup (range n) := by
    simp only [range_eq_range', nodup_range']

  def antidiagonal (n : Nat) : List (Nat × Nat) :=
    (range (n+1)).map fun i => (i, n - i)

  theorem nodup_antidiagonal (n : Nat) : nodup (antidiagonal n) :=
    nodup_map_on (fun _ _ _ _ hxy => by simp only [congrArg Prod.fst hxy]) (nodup_range (n+1))

end List

namespace M4R

  /-
      range n => [0, ..., n-1]
      e.g. : range 0 => [], range 1 => [0], range 2 => [0, 1], range 3 => [0, 1, 2]

      range m, n => [m, m+1, ..., m+n-1]
      e.g. : range 2 0 => [], range 2 1 => [2], range 2 2 => [2, 3], range 2 3 => [2, 3, 4]
  -/

  namespace UnorderedList

    def range (n : Nat) : UnorderedList Nat := List.range n
    def range' (m n : Nat) : UnorderedList Nat := List.range' m n

    def antidiagonal (n : Nat) : UnorderedList (Nat × Nat) := List.antidiagonal n

    def toInt (l : UnorderedList Nat) : UnorderedList Int := l.map Int.ofNat

    theorem range_eq_range' (n : Nat) : range n = range' 0 n :=
      Quot.sound (by rw [List.range_eq_range' n]; exact Perm.refl _)

    namespace range'

      @[simp] theorem zero (n : Nat) : range' n 0 = 0 := rfl
      @[simp] theorem singleton (n : Nat) : range' n 1 = UnorderedList.singleton n := rfl

      theorem append (s m n : Nat) : range' s m + range' (s+m) n = range' s (n+m) :=
        congrArg List.to_UnorderedList (List.range'_append s m n)

      theorem start (s n : Nat) : range' s n.succ = UnorderedList.singleton s + range' s.succ n := rfl

      theorem succ (s n : Nat) : range' s n.succ = range' s n + UnorderedList.singleton (s+n) :=
        congrArg List.to_UnorderedList (List.range'_succ s n)

      @[simp] theorem mem_range' {m s n : Nat} : m ∈ range' s n ↔ s ≤ m ∧ m < s + n :=
        List.mem_range'

    end range'
    namespace range

      @[simp] theorem zero : range 0 = 0 := rfl

      theorem succ (n : Nat) : range n.succ = range n + UnorderedList.singleton n :=
        congrArg List.to_UnorderedList (List.range_succ n)

      theorem start (n : Nat) : range n.succ = UnorderedList.singleton 0 + range' 1 n :=
        congrArg List.to_UnorderedList (List.range_start n)

      theorem add (a b : Nat) : range (a + b) = range a + (range b).map (a + ·) :=
        congrArg List.to_UnorderedList (List.range_add a b)

      @[simp] theorem mem_range {m n : Nat} : m ∈ range n ↔ m < n :=
        List.mem_range

    end range

  end UnorderedList
  namespace Finset

    def range (n : Nat) : Finset Nat := ⟨UnorderedList.range n, List.nodup_range n⟩
    def range' (m n : Nat) : Finset Nat := ⟨UnorderedList.range' m n, List.nodup_range' m n⟩

    theorem range_eq_range' (n : Nat) : range n = range' 0 n := by
      apply Finset.val_inj.mp
      exact UnorderedList.range_eq_range' n

    def antidiagonal (n : Nat) : Finset (Nat × Nat) := ⟨UnorderedList.antidiagonal n, List.nodup_antidiagonal n⟩

    @[simp] theorem antidiagonal.zero : antidiagonal 0 = Finset.singleton (0, 0) := rfl

    def toInt (f : Finset Nat) : Finset Int := f.map_inj (fun _ _ => congrArg Int.toNat : Function.injective Int.ofNat)

    namespace range'

      @[simp] theorem zero (n : Nat) : range' n 0 = ∅ := rfl
      @[simp] theorem singleton (n : Nat) : range' n 1 = Finset.singleton n := rfl

      @[simp] theorem mem_range' {m s n : Nat} : m ∈ range' s n ↔ s ≤ m ∧ m < s + n :=
        UnorderedList.range'.mem_range'

      theorem not_mem_front {s n} : s ∉ range' s.succ n := by
        rw [mem_range', not_and_iff_or_not, Nat.not_le, Nat.not_lt]
        exact Or.inl (Nat.lt_succ_self s)

      theorem not_mem_back {s n} : s+n ∉ range' s n := by
        rw [mem_range', not_and_iff_or_not, Nat.not_le, Nat.not_lt]
        exact Or.inr (Nat.le_refl _)

      theorem start (s n : Nat) : range' s n.succ = (range' s.succ n).cons s not_mem_front := rfl

      theorem succ (s n : Nat) : range' s n.succ = (range' s n).cons (s+n) not_mem_back :=
        Finset.ext fun _ => by
          rw [Finset.mem_cons, mem_range', mem_range', or_and_distrib_left,
            or_iff_right_of_imp (· ▸ Nat.le_add_right s n), Nat.add_succ,
            ←Nat.le_iff_eq_or_lt, Nat.lt_succ_if_le]; exact Iff.rfl

      theorem append (s m n : Nat) : range' s m ∪ range' (s + m) n = range' s (m + n) := by
        have := UnorderedList.range'.append s m n
        apply Finset.ext; intro k
        rw [Finset.mem_union, mem_range', mem_range', mem_range']
        exact ⟨fun h => h.elim
            (fun ⟨h₁, h₂⟩ => ⟨h₁, Nat.add_assoc _ _ _ ▸ Nat.lt_add_right _ _ _ h₂⟩)
            (fun ⟨h₁, h₂⟩ => ⟨Nat.le_trans (Nat.le_add_right s m) h₁, Nat.add_assoc _ _ _ ▸ h₂⟩),
          fun ⟨h₁, h₂⟩ => Or.elim (Nat.le_or_lt (s + m) k)
            (fun h => Or.inr ⟨h, Nat.add_assoc _ _ _ ▸ h₂⟩) (fun h => Or.inl ⟨h₁, h⟩)⟩

      theorem disjoint (s₁ n₁ s₂ n₂ : Nat) : disjoint (range' s₁ n₁) (range' s₂ n₂) ↔ s₁ + n₁ ≤ s₂ ∨ s₂ + n₂ ≤ s₁ ∨ n₁ = 0 ∨ n₂ = 0 := by
        simp only [Finset.disjoint]
        have : (range' s₁ n₁ ∩ range' s₂ n₂ = ∅) ↔ ∀ a, (a < s₁ ∨ s₁ + n₁ ≤ a) ∨ a < s₂ ∨ s₂ + n₂ ≤ a := by
          simp only [Finset.ext_iff, Finset.mem_empty, iff_false, Finset.mem_inter, not_and_iff_or_not,
            mem_range', not_and_iff_or_not, Nat.not_le, Nat.not_lt]; exact Iff.rfl
        rw [this]
        exact ⟨fun h => by
          have h₁ := h s₁
          have h₂ := h s₂
          simp only [Nat.lt_irrefl, false_or, Nat.add_le] at h₁ h₂
          exact Or.elim h₁ (fun h₁ => Or.inr (Or.inr (Or.inl h₁)))
            (Or.elim · (fun h₁ => Or.elim h₂
              (Or.elim · (absurd ⟨h₁, ·⟩ Nat.lt_not_symm) Or.inl)
              (fun h₂ => Or.inr (Or.inr (Or.inr h₂))))
              (fun h₁ => Or.inr (Or.inl h₁))),
          fun h a => by
            cases h with
            | inl h =>
              byCases h' : s₁ + n₁ ≤ a;
              { exact Or.inl (Or.inr h') }
              { exact Or.inr (Or.inl (Nat.lt_of_lt_of_le (Nat.not_le.mp h') h)) }
            | inr h =>
              cases h with
              | inl h =>
                byCases h' : s₂ + n₂ ≤ a;
                { exact Or.inr (Or.inr h') }
                { exact Or.inl (Or.inl (Nat.lt_of_lt_of_le (Nat.not_le.mp h') h)) }
              | inr h =>
                cases h with
                | inl h => rw [h, Nat.add_zero]; exact Or.inl (Nat.le_or_lt s₁ a).comm
                | inr h => rw [h, Nat.add_zero]; exact Or.inr (Nat.le_or_lt s₂ a).comm⟩

    end range'
    namespace range

      @[simp] theorem zero : range 0 = ∅ := rfl

      theorem not_mem_back {n} : n ∉ range n := by
        have := @range'.not_mem_back 0 n
        rw [Nat.zero_add, ←range_eq_range'] at this
        exact this

      theorem succ (n : Nat) : range n.succ = (range n).cons n not_mem_back :=
        Finset.ext fun x => by
          rw [range_eq_range', range'.succ, Finset.mem_cons, Finset.mem_cons,
            Nat.zero_add, range_eq_range']; exact Iff.rfl

      theorem start (n : Nat) : range n.succ = (range' 1 n).cons 0 range'.not_mem_front := by
        rw [range_eq_range', range'.start]

      @[simp] theorem mem_range {m n : Nat} : m ∈ range n ↔ m < n :=
        UnorderedList.range.mem_range

      theorem append (m n : Nat) : range m ∪ range' m n = range (m + n) := by
        have := range'.append 0 m n
        simp only [Nat.zero_add, ←range_eq_range'] at this
        exact this

    end range
  end Finset
end M4R


namespace Ex1

mutual

def Foo.boo (x : Nat) :=
  match x with
  | 0 => 1
  | x + 1 => 2*Boo.bla x

def Boo.bla (x : Nat) :=
  match x with
  | 0 => 2
  | x+1 => 3*Foo.boo x

end

example : Foo.boo 2 = 2*3*1 := by
  simp [Foo.boo, Boo.bla]

end Ex1

namespace Ex2

mutual

def Bla.Foo.boo (x : Nat) :=
  match x with
  | 0 => 1
  | x + 1 => 2*Boo.bla x

def Bla.Boo.bla (x : Nat) :=
  match x with
  | 0 => 2
  | x+1 => 3*Foo.boo x

end

example : Bla.Foo.boo 2 = 2*3*1 := by
  simp [Bla.Foo.boo, Bla.Boo.bla]

end Ex2

namespace Ex3

mutual
inductive Foo
  | somefoo : Foo
  | bar : Bar → Foo

inductive Bar
  | somebar : Bar
  | foobar : Foo → Bar → Bar
end

mutual
def Foo.toString : Foo → String
  | Foo.somefoo => "foo"
  | Foo.bar b => Bar.toString b

def Bar.toString : Bar → String
  | Bar.somebar => "bar"
  | Bar.foobar f b => (Foo.toString f) ++ (Bar.toString b)
end

end Ex3

namespace Ex4

mutual
inductive Foo
  | somefoo : Foo
  | bar : Bar → Foo

inductive Bar
  | somebar : Bar
  | foobar : Foo → Bar → Bar
end

mutual
def Foo.toString : Foo → String
  | .somefoo => "foo"
  | .bar b => b.toString

def Bar.toString : Bar → String
  | .somebar => "bar"
  | .foobar f b => f.toString ++ b.toString
end

end Ex4


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.separation
import Mathlib.topology.bases
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4

namespace Mathlib

/-!
# Dense embeddings

This file defines three properties of functions:

* `dense_range f`      means `f` has dense image;
* `dense_inducing i`   means `i` is also `inducing`;
* `dense_embedding e`  means `e` is also an `embedding`.

The main theorem `continuous_extend` gives a criterion for a function
`f : X → Z` to a regular (T₃) space Z to extend along a dense embedding
`i : X → Y` to a continuous function `g : Y → Z`. Actually `i` only
has to be `dense_inducing` (not necessarily injective).

-/

/-- `i : α → β` is "dense inducing" if it has dense range and the topology on `α`
  is the one induced by `i` from the topology on `β`. -/
structure dense_inducing {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    (i : α → β)
    extends inducing i where
  dense : dense_range i

namespace dense_inducing

theorem nhds_eq_comap {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    {i : α → β} (di : dense_inducing i) (a : α) : nhds a = filter.comap i (nhds (i a)) :=
  inducing.nhds_eq_comap (to_inducing di)

protected theorem continuous {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] {i : α → β} (di : dense_inducing i) : continuous i :=
  inducing.continuous (to_inducing di)

theorem closure_range {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    {i : α → β} (di : dense_inducing i) : closure (set.range i) = set.univ :=
  dense_range.closure_range (dense di)

theorem self_sub_closure_image_preimage_of_open {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] {i : α → β} {s : set β} (di : dense_inducing i) :
    is_open s → s ⊆ closure (i '' (i ⁻¹' s)) :=
  sorry

theorem closure_image_nhds_of_nhds {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] {i : α → β} {s : set α} {a : α} (di : dense_inducing i) :
    s ∈ nhds a → closure (i '' s) ∈ nhds (i a) :=
  sorry

/-- The product of two dense inducings is a dense inducing -/
protected theorem prod {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4}
    [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]
    {e₁ : α → β} {e₂ : γ → δ} (de₁ : dense_inducing e₁) (de₂ : dense_inducing e₂) :
    dense_inducing fun (p : α × γ) => (e₁ (prod.fst p), e₂ (prod.snd p)) :=
  mk (inducing.mk (inducing.induced (inducing.prod_mk (to_inducing de₁) (to_inducing de₂))))
    (dense_range.prod_map (dense de₁) (dense de₂))

/-- If the domain of a `dense_inducing` map is a separable space, then so is the codomain. -/
protected theorem separable_space {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] {i : α → β} (di : dense_inducing i)
    [topological_space.separable_space α] : topological_space.separable_space β :=
  dense_range.separable_space (dense di) (dense_inducing.continuous di)

/--
 γ -f→ α
g↓     ↓e
 δ -h→ β
-/
theorem tendsto_comap_nhds_nhds {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4}
    [topological_space α] [topological_space β] {i : α → β} [topological_space δ] {f : γ → α}
    {g : γ → δ} {h : δ → β} {d : δ} {a : α} (di : dense_inducing i)
    (H : filter.tendsto h (nhds d) (nhds (i a))) (comm : h ∘ g = i ∘ f) :
    filter.tendsto f (filter.comap g (nhds d)) (nhds a) :=
  sorry

protected theorem nhds_within_ne_bot {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] {i : α → β} (di : dense_inducing i) (b : β) :
    filter.ne_bot (nhds_within b (set.range i)) :=
  dense_range.nhds_within_ne_bot (dense di) b

theorem comap_nhds_ne_bot {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    {i : α → β} (di : dense_inducing i) (b : β) : filter.ne_bot (filter.comap i (nhds b)) :=
  sorry

/-- If `i : α → β` is a dense inducing, then any function `f : α → γ` "extends"
  to a function `g = extend di f : β → γ`. If `γ` is Hausdorff and `f` has a
  continuous extension, then `g` is the unique such extension. In general,
  `g` might not be continuous or even extend `f`. -/
def extend {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β]
    {i : α → β} [topological_space γ] (di : dense_inducing i) (f : α → γ) (b : β) : γ :=
  lim (filter.comap i (nhds b)) f

theorem extend_eq_of_tendsto {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α]
    [topological_space β] {i : α → β} (di : dense_inducing i) [topological_space γ] [t2_space γ]
    {b : β} {c : γ} {f : α → γ} (hf : filter.tendsto f (filter.comap i (nhds b)) (nhds c)) :
    extend di f b = c :=
  filter.tendsto.lim_eq hf

theorem extend_eq_at {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α]
    [topological_space β] {i : α → β} (di : dense_inducing i) [topological_space γ] [t2_space γ]
    {f : α → γ} (a : α) (hf : continuous_at f a) : extend di f (i a) = f a :=
  extend_eq_of_tendsto di (nhds_eq_comap di a ▸ hf)

theorem extend_eq {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α]
    [topological_space β] {i : α → β} (di : dense_inducing i) [topological_space γ] [t2_space γ]
    {f : α → γ} (hf : continuous f) (a : α) : extend di f (i a) = f a :=
  extend_eq_at di a (continuous.continuous_at hf)

theorem extend_unique_at {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α]
    [topological_space β] {i : α → β} [topological_space γ] [t2_space γ] {b : β} {f : α → γ}
    {g : β → γ} (di : dense_inducing i)
    (hf : filter.eventually (fun (x : α) => g (i x) = f x) (filter.comap i (nhds b)))
    (hg : continuous_at g b) : extend di f b = g b :=
  sorry

theorem extend_unique {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α]
    [topological_space β] {i : α → β} [topological_space γ] [t2_space γ] {f : α → γ} {g : β → γ}
    (di : dense_inducing i) (hf : ∀ (x : α), g (i x) = f x) (hg : continuous g) : extend di f = g :=
  funext
    fun (b : β) =>
      extend_unique_at di (filter.eventually_of_forall hf) (continuous.continuous_at hg)

theorem continuous_at_extend {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α]
    [topological_space β] {i : α → β} [topological_space γ] [regular_space γ] {b : β} {f : α → γ}
    (di : dense_inducing i)
    (hf :
      filter.eventually
        (fun (x : β) => ∃ (c : γ), filter.tendsto f (filter.comap i (nhds x)) (nhds c)) (nhds b)) :
    continuous_at (extend di f) b :=
  sorry

theorem continuous_extend {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α]
    [topological_space β] {i : α → β} [topological_space γ] [regular_space γ] {f : α → γ}
    (di : dense_inducing i)
    (hf : ∀ (b : β), ∃ (c : γ), filter.tendsto f (filter.comap i (nhds b)) (nhds c)) :
    continuous (extend di f) :=
  iff.mpr continuous_iff_continuous_at
    fun (b : β) => continuous_at_extend di (filter.univ_mem_sets' hf)

theorem mk' {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] (i : α → β)
    (c : continuous i) (dense : ∀ (x : β), x ∈ closure (set.range i))
    (H :
      ∀ (a : α) (s : set α) (H : s ∈ nhds a),
        ∃ (t : set β), ∃ (H : t ∈ nhds (i a)), ∀ (b : α), i b ∈ t → b ∈ s) :
    dense_inducing i :=
  sorry

end dense_inducing

/-- A dense embedding is an embedding with dense image. -/
structure dense_embedding {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    (e : α → β)
    extends dense_inducing e where
  inj : function.injective e

theorem dense_embedding.mk' {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] (e : α → β) (c : continuous e) (dense : dense_range e)
    (inj : function.injective e)
    (H :
      ∀ (a : α) (s : set α) (H : s ∈ nhds a),
        ∃ (t : set β), ∃ (H : t ∈ nhds (e a)), ∀ (b : α), e b ∈ t → b ∈ s) :
    dense_embedding e :=
  sorry

namespace dense_embedding

theorem inj_iff {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    {e : α → β} (de : dense_embedding e) {x : α} {y : α} : e x = e y ↔ x = y :=
  function.injective.eq_iff (inj de)

theorem to_embedding {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    {e : α → β} (de : dense_embedding e) : embedding e :=
  embedding.mk (inducing.mk (inducing.induced (dense_inducing.to_inducing (to_dense_inducing de))))
    (inj de)

/-- If the domain of a `dense_embedding` is a separable space, then so is its codomain. -/
protected theorem separable_space {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] {e : α → β} (de : dense_embedding e)
    [topological_space.separable_space α] : topological_space.separable_space β :=
  dense_inducing.separable_space (to_dense_inducing de)

/-- The product of two dense embeddings is a dense embedding. -/
protected theorem prod {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4}
    [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]
    {e₁ : α → β} {e₂ : γ → δ} (de₁ : dense_embedding e₁) (de₂ : dense_embedding e₂) :
    dense_embedding fun (p : α × γ) => (e₁ (prod.fst p), e₂ (prod.snd p)) :=
  sorry

/-- The dense embedding of a subtype inside its closure. -/
def subtype_emb {β : Type u_2} [topological_space β] {α : Type u_1} (p : α → Prop) (e : α → β)
    (x : Subtype fun (x : α) => p x) :
    Subtype fun (x : β) => x ∈ closure (e '' set_of fun (x : α) => p x) :=
  { val := e ↑x, property := sorry }

protected theorem subtype {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    {e : α → β} (de : dense_embedding e) (p : α → Prop) : dense_embedding (subtype_emb p e) :=
  sorry

end dense_embedding

theorem is_closed_property {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β}
    {p : β → Prop} (he : dense_range e) (hp : is_closed (set_of fun (x : β) => p x))
    (h : ∀ (a : α), p (e a)) (b : β) : p b :=
  sorry

theorem is_closed_property2 {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β}
    {p : β → β → Prop} (he : dense_range e)
    (hp : is_closed (set_of fun (q : β × β) => p (prod.fst q) (prod.snd q)))
    (h : ∀ (a₁ a₂ : α), p (e a₁) (e a₂)) (b₁ : β) (b₂ : β) : p b₁ b₂ :=
  (fun (this : ∀ (q : β × β), p (prod.fst q) (prod.snd q)) (b₁ b₂ : β) => this (b₁, b₂))
    (is_closed_property (dense_range.prod_map he he) hp
      fun (_x : α × α) => h (prod.fst _x) (prod.snd _x))

theorem is_closed_property3 {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β}
    {p : β → β → β → Prop} (he : dense_range e)
    (hp :
      is_closed
        (set_of
          fun (q : β × β × β) => p (prod.fst q) (prod.fst (prod.snd q)) (prod.snd (prod.snd q))))
    (h : ∀ (a₁ a₂ a₃ : α), p (e a₁) (e a₂) (e a₃)) (b₁ : β) (b₂ : β) (b₃ : β) : p b₁ b₂ b₃ :=
  sorry

theorem dense_range.induction_on {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β}
    (he : dense_range e) {p : β → Prop} (b₀ : β) (hp : is_closed (set_of fun (b : β) => p b))
    (ih : ∀ (a : α), p (e a)) : p b₀ :=
  is_closed_property he hp ih b₀

theorem dense_range.induction_on₂ {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β}
    {p : β → β → Prop} (he : dense_range e)
    (hp : is_closed (set_of fun (q : β × β) => p (prod.fst q) (prod.snd q)))
    (h : ∀ (a₁ a₂ : α), p (e a₁) (e a₂)) (b₁ : β) (b₂ : β) : p b₁ b₂ :=
  is_closed_property2 he hp h b₁ b₂

theorem dense_range.induction_on₃ {α : Type u_1} {β : Type u_2} [topological_space β] {e : α → β}
    {p : β → β → β → Prop} (he : dense_range e)
    (hp :
      is_closed
        (set_of
          fun (q : β × β × β) => p (prod.fst q) (prod.fst (prod.snd q)) (prod.snd (prod.snd q))))
    (h : ∀ (a₁ a₂ a₃ : α), p (e a₁) (e a₂) (e a₃)) (b₁ : β) (b₂ : β) (b₃ : β) : p b₁ b₂ b₃ :=
  is_closed_property3 he hp h b₁ b₂ b₃

/-- Two continuous functions to a t2-space that agree on the dense range of a function are equal. -/
theorem dense_range.equalizer {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space β]
    [topological_space γ] [t2_space γ] {f : α → β} (hfd : dense_range f) {g : β → γ} {h : β → γ}
    (hg : continuous g) (hh : continuous h) (H : g ∘ f = h ∘ f) : g = h :=
  funext fun (y : β) => dense_range.induction_on hfd y (is_closed_eq hg hh) (congr_fun H)

end Mathlib


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .hom .use

universe u
variables {σ : Type u} {sig : σ → ℕ}
include sig

class congruence {α : Type*} (a : alg sig α) extends setoid α :=
(app : ∀ (s : σ) (xs ys : α ^ (sig s)), (∀ i, r xs[i] ys[i]) → r (alg.app a s xs) (alg.app a s ys))

section
variables {α : Type*} (a : alg sig α) (c : congruence a)
include c

definition sat_congr (e : eqn sig) : Prop :=
∀ val : ℕ → α, eval a val e.fst ≈ eval a val e.snd

definition sat_congr_use (e : eqn sig) : Prop :=
∀ val : α ^ (max (use e.fst) (use e.snd)), eval_use_of_le a val e.fst (le_max_left _ _) ≈ eval_use_of_le a val e.snd (le_max_right _ _)

notation a ` ⊧ ` e ` mod ` c := sat_congr a c e

variables {a c}

lemma sat_congr_iff_sat_congr_use {e : eqn sig} :
(a ⊧ e mod c) ↔ sat_congr_use a c e :=
let m := max (use e.fst) (use e.snd) in
iff.intro
 (λ h val,
  let x := eval_use_of_le a val e.fst (le_max_left _ _) in
  calc
  eval_use_of_le a val e.fst (le_max_left _ _)
      = eval_use_of_le a (tup.bar (tup.extend val x) m) e.fst (le_max_left _ _) : by rw tup.bar_extend
  ... = eval a (tup.extend val x) e.fst : by rw eval_eq_eval_use_of_le
  ... ≈ eval a (tup.extend val x) e.snd : by apply h
  ... = eval_use_of_le a (tup.bar (tup.extend val x) m) e.snd (le_max_right _ _) : by rw eval_eq_eval_use_of_le
  ... = eval_use_of_le a val (e.snd) (le_max_right _ _) : by rw tup.bar_extend)
 (λ h val,
  calc
  eval a val e.fst
      = eval_use_of_le a (tup.bar val m) e.fst (le_max_left _ _) : by rw eval_eq_eval_use_of_le
  ... ≈ eval_use_of_le a (tup.bar val m) e.snd (le_max_right _ _) : by apply h
  ... = eval a val e.snd : by rw eval_eq_eval_use_of_le)

variable (c)

definition quotient_alg : alg sig (quotient c.to_setoid) :=
{ app :=
  λ s, let f := λ xs, quotient.mk (a.app s xs) in
  have ∀ xs ys : α ^ (sig s), xs ≈ ys → f xs = f ys,
  from λ xs ys hxy, quotient.sound (congruence.app s xs ys hxy),
  quotient.tup_lift f this
}

@[reducible]
definition quotient_map :
α → quotient c.to_setoid := quotient.mk

definition quotient_hom :
hom a (quotient_alg c) (quotient_map c) :=
{ app := λ s xs, eq.symm (quotient.tup_lift_beta _ _ xs)
}

definition quotient_app (s : σ) {xs : α ^ (sig s)} :
quotient_map c (a.app s xs) = (quotient_alg c).app s (tup.map (quotient_map c) xs) :=
hom_app (quotient_hom c) s

definition quotient_eval (t : term sig) (val : ℕ → α) :
quotient_map c (eval a val t) = eval (quotient_alg c) (λ n, quotient_map c (val n)) t :=
hom_eval (quotient_hom c) t val

theorem quotient_sound {{x y : α}} :
x ≈ y → quotient_map c x = quotient_map c y := quotient.sound

theorem quotient_exact {{x y : α}} :
quotient_map c x = quotient_map c y → x ≈ y := quotient.exact

lemma quotient_sat_use_of_sat_congr_use {e : eqn sig} :
sat_congr_use a c e → sat_use (quotient_alg c) e :=
λ h qval,
have ∃ val, ∀ i, (quotient_map c) val[i] = qval[i],
from tup.choice (show ∀ i, ∃ x, quotient_map c x = qval[i], from λ i, quotient.exists_rep qval[i]),
exists.elim this $
λ val hval,
have tup.map (quotient_map c) val = qval,
from tup.ext hval,
calc
eval_use_of_le (quotient_alg c) qval (e.fst) (le_max_left _ _)
    = eval_use_of_le (quotient_alg c) (tup.map (quotient_map c) val) (e.fst) (le_max_left _ _) : by rw this
... = quotient_map c (eval_use_of_le a val e.fst (le_max_left _ _)) : by rw hom_eval_use (quotient_hom c)
... = quotient_map c (eval_use_of_le a val e.snd (le_max_right _ _)) : by rw quotient_sound c (h val)
... = eval_use_of_le (quotient_alg c) (tup.map (quotient_map c) val) (e.snd) (le_max_right _ _) : by rw hom_eval_use (quotient_hom c)
... = eval_use_of_le (quotient_alg c) qval (e.snd) (le_max_right _ _) : by rw this

theorem quotient_sat {e : eqn sig} :
(quotient_alg c ⊧ e) ↔ (a ⊧ e mod c) :=
⟨ λ h val, quotient_exact c $
  calc
  quotient_map c (eval a val e.fst)
      = eval (quotient_alg c) (λ n, quotient_map c (val n)) e.fst : by rw hom_eval (quotient_hom c)
  ... = eval (quotient_alg c) (λ n, quotient_map c (val n)) e.snd : by rw h
  ... = quotient_map c (eval a val e.snd) : by rw hom_eval (quotient_hom c)
, λ h, sat_iff_sat_use.mpr $
  quotient_sat_use_of_sat_congr_use c $
  sat_congr_iff_sat_congr_use.mp h
⟩

end