/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andreas Swerdlow
-/
import algebra.module.linear_map
import linear_algebra.basis.bilinear
import linear_algebra.bilinear_map
import algebra.euclidean_domain.instances
import ring_theory.non_zero_divisors

/-!
# Sesquilinear form

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

This files provides properties about sesquilinear forms. The maps considered are of the form
`M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R`, where `I₁ : R₁ →+* R` and `I₂ : R₂ →+* R` are ring homomorphisms and
`M₁` is a module over `R₁` and `M₂` is a module over `R₂`.
Sesquilinear forms are the special case that `M₁ = M₂`, `R₁ = R₂ = R`, and `I₁ = ring_hom.id R`.
Taking additionally `I₂ = ring_hom.id R`, then one obtains bilinear forms.

These forms are a special case of the bilinear maps defined in `bilinear_map.lean` and all basic
lemmas about construction and elementary calculations are found there.

## Main declarations

* `is_ortho`: states that two vectors are orthogonal with respect to a sesquilinear form
* `is_symm`, `is_alt`: states that a sesquilinear form is symmetric and alternating, respectively
* `orthogonal_bilin`: provides the orthogonal complement with respect to sesquilinear form

## References

* <https://en.wikipedia.org/wiki/Sesquilinear_form#Over_arbitrary_rings>

## Tags

Sesquilinear form,
-/

open_locale big_operators

variables {R R₁ R₂ R₃ M M₁ M₂ Mₗ₁ Mₗ₁' Mₗ₂ Mₗ₂' K K₁ K₂ V V₁ V₂ n : Type*}

namespace linear_map

/-! ### Orthogonal vectors -/

section comm_ring

-- the `ₗ` subscript variables are for special cases about linear (as opposed to semilinear) maps
variables [comm_semiring R] [comm_semiring R₁] [add_comm_monoid M₁] [module R₁ M₁]
  [comm_semiring R₂] [add_comm_monoid M₂] [module R₂ M₂]
  {I₁ : R₁ →+* R} {I₂ : R₂ →+* R} {I₁' : R₁ →+* R}

/-- The proposition that two elements of a sesquilinear form space are orthogonal -/
def is_ortho (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) (x y) : Prop := B x y = 0

lemma is_ortho_def {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} {x y} : B.is_ortho x y ↔ B x y = 0 := iff.rfl

lemma is_ortho_zero_left (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) (x) : is_ortho B (0 : M₁) x :=
by { dunfold is_ortho, rw [ map_zero B, zero_apply] }

lemma is_ortho_zero_right (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) (x) : is_ortho B x (0 : M₂) :=
map_zero (B x)

/-- A set of vectors `v` is orthogonal with respect to some bilinear form `B` if and only
if for all `i ≠ j`, `B (v i) (v j) = 0`. For orthogonality between two elements, use
`bilin_form.is_ortho` -/
def is_Ortho (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₁'] R) (v : n → M₁) : Prop :=
pairwise (B.is_ortho on v)

lemma is_Ortho_def {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₁'] R} {v : n → M₁} :
  B.is_Ortho v ↔ ∀ i j : n, i ≠ j → B (v i) (v j) = 0 := iff.rfl

lemma is_Ortho_flip (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₁'] R) {v : n → M₁} :
  B.is_Ortho v ↔ B.flip.is_Ortho v :=
begin
  simp_rw is_Ortho_def,
  split; intros h i j hij,
  { rw flip_apply,
    exact h j i (ne.symm hij) },
  simp_rw flip_apply at h,
  exact h j i (ne.symm hij),
end

end comm_ring
section field

variables [field K] [field K₁] [add_comm_group V₁] [module K₁ V₁]
  [field K₂] [add_comm_group V₂] [module K₂ V₂]
  {I₁ : K₁ →+* K} {I₂ : K₂ →+* K} {I₁' : K₁ →+* K}
  {J₁ : K →+* K} {J₂ : K →+* K}

-- todo: this also holds for [comm_ring R] [is_domain R] when J₁ is invertible
lemma ortho_smul_left {B : V₁ →ₛₗ[I₁] V₂ →ₛₗ[I₂] K} {x y} {a : K₁} (ha : a ≠ 0) :
  (is_ortho B x y) ↔ (is_ortho B (a • x) y) :=
begin
  dunfold is_ortho,
  split; intro H,
  { rw [map_smulₛₗ₂, H, smul_zero]},
  { rw [map_smulₛₗ₂, smul_eq_zero] at H,
    cases H,
    { rw map_eq_zero I₁ at H, trivial },
    { exact H }}
end

-- todo: this also holds for [comm_ring R] [is_domain R] when J₂ is invertible
lemma ortho_smul_right {B : V₁ →ₛₗ[I₁] V₂ →ₛₗ[I₂] K} {x y} {a : K₂} {ha : a ≠ 0} :
(is_ortho B x y) ↔ (is_ortho B x (a • y)) :=
begin
  dunfold is_ortho,
  split; intro H,
  { rw [map_smulₛₗ, H, smul_zero] },
  { rw [map_smulₛₗ, smul_eq_zero] at H,
    cases H,
    { simp at H,
      exfalso,
      exact ha H },
    { exact H }}
end

/-- A set of orthogonal vectors `v` with respect to some sesquilinear form `B` is linearly
  independent if for all `i`, `B (v i) (v i) ≠ 0`. -/
lemma linear_independent_of_is_Ortho {B : V₁ →ₛₗ[I₁] V₁ →ₛₗ[I₁'] K} {v : n → V₁}
  (hv₁ : B.is_Ortho v) (hv₂ : ∀ i, ¬ B.is_ortho (v i) (v i)) : linear_independent K₁ v :=
begin
  classical,
  rw linear_independent_iff',
  intros s w hs i hi,
  have : B (s.sum $ λ (i : n), w i • v i) (v i) = 0,
  { rw [hs, map_zero, zero_apply] },
  have hsum : s.sum (λ (j : n), I₁(w j) * B (v j) (v i)) = I₁(w i) * B (v i) (v i),
  { apply finset.sum_eq_single_of_mem i hi,
    intros j hj hij,
    rw [is_Ortho_def.1 hv₁ _ _ hij, mul_zero], },
  simp_rw [B.map_sum₂, map_smulₛₗ₂, smul_eq_mul, hsum] at this,
  apply (map_eq_zero I₁).mp,
  exact eq_zero_of_ne_zero_of_mul_right_eq_zero (hv₂ i) this,
end

end field

/-! ### Reflexive bilinear forms -/

section reflexive

variables [comm_semiring R] [comm_semiring R₁] [add_comm_monoid M₁] [module R₁ M₁]
  {I₁ : R₁ →+* R} {I₂ : R₁ →+* R}
  {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R}

/-- The proposition that a sesquilinear form is reflexive -/
def is_refl (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R) : Prop :=
  ∀ (x y), B x y = 0 → B y x = 0

namespace is_refl

variable (H : B.is_refl)

lemma eq_zero : ∀ {x y}, B x y = 0 → B y x = 0 := λ x y, H x y

lemma ortho_comm {x y} : is_ortho B x y ↔ is_ortho B y x := ⟨eq_zero H, eq_zero H⟩

lemma dom_restrict_refl (H : B.is_refl) (p : submodule R₁ M₁) : (B.dom_restrict₁₂ p p).is_refl :=
λ _ _, by { simp_rw dom_restrict₁₂_apply, exact H _ _}

@[simp] lemma flip_is_refl_iff : B.flip.is_refl ↔ B.is_refl :=
⟨λ h x y H, h y x ((B.flip_apply _ _).trans H), λ h x y, h y x⟩

lemma ker_flip_eq_bot (H : B.is_refl) (h : B.ker = ⊥) : B.flip.ker = ⊥ :=
begin
  refine ker_eq_bot'.mpr (λ _ hx, ker_eq_bot'.mp h _ _),
  ext,
  exact H _ _ (linear_map.congr_fun hx _),
end

lemma ker_eq_bot_iff_ker_flip_eq_bot (H : B.is_refl) : B.ker = ⊥ ↔ B.flip.ker = ⊥ :=
begin
  refine ⟨ker_flip_eq_bot H, λ h, _⟩,
  exact (congr_arg _ B.flip_flip.symm).trans (ker_flip_eq_bot (flip_is_refl_iff.mpr H) h),
end

end is_refl
end reflexive

/-! ### Symmetric bilinear forms -/

section symmetric

variables [comm_semiring R] [add_comm_monoid M] [module R M]
  {I : R →+* R} {B : M →ₛₗ[I] M →ₗ[R] R}

/-- The proposition that a sesquilinear form is symmetric -/
def is_symm (B : M →ₛₗ[I] M →ₗ[R] R) : Prop :=
  ∀ (x y), I (B x y) = B y x

namespace is_symm

protected lemma eq (H : B.is_symm) (x y) : I (B x y) = B y x := H x y

lemma is_refl (H : B.is_symm) : B.is_refl := λ x y H1, by { rw ←H.eq, simp [H1] }

lemma ortho_comm (H : B.is_symm) {x y} : is_ortho B x y ↔ is_ortho B y x := H.is_refl.ortho_comm

lemma dom_restrict_symm (H : B.is_symm) (p : submodule R M) : (B.dom_restrict₁₂ p p).is_symm :=
λ _ _, by { simp_rw dom_restrict₁₂_apply, exact H _ _}

end is_symm

lemma is_symm_iff_eq_flip {B : M →ₗ[R] M →ₗ[R] R} : B.is_symm ↔ B = B.flip :=
begin
  split; intro h,
  { ext,
    rw [←h, flip_apply, ring_hom.id_apply] },
  intros x y,
  conv_lhs { rw h },
  rw [flip_apply, ring_hom.id_apply],
end

end symmetric

/-! ### Alternating bilinear forms -/

section alternating

variables [comm_ring R] [comm_semiring R₁] [add_comm_monoid M₁] [module R₁ M₁]
  {I₁ : R₁ →+* R} {I₂ : R₁ →+* R} {I : R₁ →+* R} {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R}

/-- The proposition that a sesquilinear form is alternating -/
def is_alt (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R) : Prop := ∀ x, B x x = 0

namespace is_alt

variable (H : B.is_alt)
include H

lemma self_eq_zero (x) : B x x = 0 := H x

lemma neg (x y) : - B x y = B y x :=
begin
  have H1 : B (y + x) (y + x) = 0,
  { exact self_eq_zero H (y + x) },
  simp [map_add, self_eq_zero H] at H1,
  rw [add_eq_zero_iff_neg_eq] at H1,
  exact H1,
end

lemma is_refl : B.is_refl :=
begin
  intros x y h,
  rw [←neg H, h, neg_zero],
end

lemma ortho_comm {x y} : is_ortho B x y ↔ is_ortho B y x := H.is_refl.ortho_comm

end is_alt

lemma is_alt_iff_eq_neg_flip  [no_zero_divisors R] [char_zero R] {B : M₁ →ₛₗ[I] M₁ →ₛₗ[I] R} :
  B.is_alt ↔ B = -B.flip :=
begin
  split; intro h,
  { ext,
    simp_rw [neg_apply, flip_apply],
    exact (h.neg _ _).symm },
  intros x,
  let h' := congr_fun₂ h x x,
  simp only [neg_apply, flip_apply, ←add_eq_zero_iff_eq_neg] at h',
  exact add_self_eq_zero.mp h',
end

end alternating

end linear_map

namespace submodule

/-! ### The orthogonal complement -/

variables [comm_ring R] [comm_ring R₁] [add_comm_group M₁] [module R₁ M₁]
  {I₁ : R₁ →+* R} {I₂ : R₁ →+* R}
  {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R}

/-- The orthogonal complement of a submodule `N` with respect to some bilinear form is the set of
elements `x` which are orthogonal to all elements of `N`; i.e., for all `y` in `N`, `B x y = 0`.

Note that for general (neither symmetric nor antisymmetric) bilinear forms this definition has a
chirality; in addition to this "left" orthogonal complement one could define a "right" orthogonal
complement for which, for all `y` in `N`, `B y x = 0`.  This variant definition is not currently
provided in mathlib. -/
def orthogonal_bilin (N : submodule R₁ M₁) (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R) : submodule R₁ M₁ :=
{ carrier := { m | ∀ n ∈ N, B.is_ortho n m },
  zero_mem' := λ x _, B.is_ortho_zero_right x,
  add_mem' := λ x y hx hy n hn,
    by rw [linear_map.is_ortho, map_add, show B n x = 0, by exact hx n hn,
        show B n y = 0, by exact hy n hn, zero_add],
  smul_mem' := λ c x hx n hn,
    by rw [linear_map.is_ortho, linear_map.map_smulₛₗ, show B n x = 0, by exact hx n hn,
        smul_zero] }

variables {N L : submodule R₁ M₁}

@[simp] lemma mem_orthogonal_bilin_iff {m : M₁} :
  m ∈ N.orthogonal_bilin B ↔ ∀ n ∈ N, B.is_ortho n m := iff.rfl

lemma orthogonal_bilin_le (h : N ≤ L) : L.orthogonal_bilin B ≤ N.orthogonal_bilin B :=
λ _ hn l hl, hn l (h hl)

lemma le_orthogonal_bilin_orthogonal_bilin (b : B.is_refl) :
  N ≤ (N.orthogonal_bilin B).orthogonal_bilin B :=
λ n hn m hm, b _ _ (hm n hn)

end submodule

namespace linear_map

section orthogonal

variables [field K] [add_comm_group V] [module K V]
  [field K₁] [add_comm_group V₁] [module K₁ V₁]
  {J : K →+* K} {J₁ : K₁ →+* K} {J₁' : K₁ →+* K}

-- ↓ This lemma only applies in fields as we require `a * b = 0 → a = 0 ∨ b = 0`
lemma span_singleton_inf_orthogonal_eq_bot
  (B : V₁ →ₛₗ[J₁] V₁ →ₛₗ[J₁'] K) (x : V₁) (hx : ¬ B.is_ortho x x) :
  (K₁ ∙ x) ⊓ submodule.orthogonal_bilin (K₁ ∙ x) B = ⊥ :=
begin
  rw ← finset.coe_singleton,
  refine eq_bot_iff.2 (λ y h, _),
  rcases mem_span_finset.1 h.1 with ⟨μ, rfl⟩,
  have := h.2 x _,
  { rw finset.sum_singleton at this ⊢,
    suffices hμzero : μ x = 0,
    { rw [hμzero, zero_smul, submodule.mem_bot] },
    change B x (μ x • x) = 0 at this, rw [map_smulₛₗ, smul_eq_mul] at this,
    exact or.elim (zero_eq_mul.mp this.symm)
    (λ y, by { simp at y, exact y })
    (λ hfalse, false.elim $ hx hfalse) },
  { rw submodule.mem_span; exact λ _ hp, hp $ finset.mem_singleton_self _ }
end

-- ↓ This lemma only applies in fields since we use the `mul_eq_zero`
lemma orthogonal_span_singleton_eq_to_lin_ker {B : V →ₗ[K] V →ₛₗ[J] K} (x : V) :
  submodule.orthogonal_bilin (K ∙ x) B = (B x).ker :=
begin
  ext y,
  simp_rw [submodule.mem_orthogonal_bilin_iff, linear_map.mem_ker,
           submodule.mem_span_singleton ],
  split,
  { exact λ h, h x ⟨1, one_smul _ _⟩ },
  { rintro h _ ⟨z, rfl⟩,
    rw [is_ortho, map_smulₛₗ₂, smul_eq_zero],
    exact or.intro_right _ h }
end

-- todo: Generalize this to sesquilinear maps
lemma span_singleton_sup_orthogonal_eq_top {B : V →ₗ[K] V →ₗ[K] K}
  {x : V} (hx : ¬ B.is_ortho x x) :
  (K ∙ x) ⊔ submodule.orthogonal_bilin (K ∙ x) B = ⊤ :=
begin
  rw orthogonal_span_singleton_eq_to_lin_ker,
  exact (B x).span_singleton_sup_ker_eq_top hx,
end

-- todo: Generalize this to sesquilinear maps
/-- Given a bilinear form `B` and some `x` such that `B x x ≠ 0`, the span of the singleton of `x`
  is complement to its orthogonal complement. -/
lemma is_compl_span_singleton_orthogonal {B : V →ₗ[K] V →ₗ[K] K}
  {x : V} (hx : ¬ B.is_ortho x x) : is_compl (K ∙ x) (submodule.orthogonal_bilin (K ∙ x) B) :=
{ disjoint := disjoint_iff.2 $ span_singleton_inf_orthogonal_eq_bot B x hx,
  codisjoint := codisjoint_iff.2 $ span_singleton_sup_orthogonal_eq_top hx }

end orthogonal

/-! ### Adjoint pairs -/

section adjoint_pair

section add_comm_monoid

variables [comm_semiring R]
variables [add_comm_monoid M] [module R M]
variables [add_comm_monoid M₁] [module R M₁]
variables [add_comm_monoid M₂] [module R M₂]
variables {I : R →+* R}
variables {B F : M →ₗ[R] M →ₛₗ[I] R} {B' : M₁ →ₗ[R] M₁ →ₛₗ[I] R} {B'' : M₂ →ₗ[R] M₂ →ₛₗ[I] R}
variables {f f' : M →ₗ[R] M₁} {g g' : M₁ →ₗ[R] M}

variables (B B' f g)

/-- Given a pair of modules equipped with bilinear forms, this is the condition for a pair of
maps between them to be mutually adjoint. -/
def is_adjoint_pair := ∀ x y, B' (f x) y = B x (g y)

variables {B B' f g}

lemma is_adjoint_pair_iff_comp_eq_compl₂ :
  is_adjoint_pair B B' f g ↔ B'.comp f = B.compl₂ g :=
begin
  split; intros h,
  { ext x y, rw [comp_apply, compl₂_apply], exact h x y },
  { intros _ _, rw [←compl₂_apply, ←comp_apply, h] },
end

lemma is_adjoint_pair_zero : is_adjoint_pair B B' 0 0 :=
λ _ _, by simp only [zero_apply, map_zero]

lemma is_adjoint_pair_id : is_adjoint_pair B B 1 1 := λ x y, rfl

lemma is_adjoint_pair.add (h : is_adjoint_pair B B' f g) (h' : is_adjoint_pair B B' f' g') :
  is_adjoint_pair B B' (f + f') (g + g') :=
λ x _, by rw [f.add_apply, g.add_apply, B'.map_add₂, (B x).map_add, h, h']

lemma is_adjoint_pair.comp {f' : M₁ →ₗ[R] M₂} {g' : M₂ →ₗ[R] M₁}
  (h : is_adjoint_pair B B' f g) (h' : is_adjoint_pair B' B'' f' g') :
  is_adjoint_pair B B'' (f'.comp f) (g.comp g') :=
λ _ _, by rw [linear_map.comp_apply, linear_map.comp_apply, h', h]

lemma is_adjoint_pair.mul
  {f g f' g' : module.End R M} (h : is_adjoint_pair B B f g) (h' : is_adjoint_pair B B f' g') :
  is_adjoint_pair B B (f * f') (g' * g) :=
h'.comp h

end add_comm_monoid

section add_comm_group

variables [comm_ring R]
variables [add_comm_group M] [module R M]
variables [add_comm_group M₁] [module R M₁]
variables {B F : M →ₗ[R] M →ₗ[R] R} {B' : M₁ →ₗ[R] M₁ →ₗ[R] R}
variables {f f' : M →ₗ[R] M₁} {g g' : M₁ →ₗ[R] M}

lemma is_adjoint_pair.sub (h : is_adjoint_pair B B' f g) (h' : is_adjoint_pair B B' f' g') :
  is_adjoint_pair B B' (f - f') (g - g') :=
λ x _, by rw [f.sub_apply, g.sub_apply, B'.map_sub₂, (B x).map_sub, h, h']

lemma is_adjoint_pair.smul (c : R) (h : is_adjoint_pair B B' f g) :
  is_adjoint_pair B B' (c • f) (c • g) :=
λ _ _, by simp only [smul_apply, map_smul, smul_eq_mul, h _ _]

end add_comm_group

end adjoint_pair

/-! ### Self-adjoint pairs-/

section selfadjoint_pair

section add_comm_monoid

variables [comm_semiring R]
variables [add_comm_monoid M] [module R M]
variables {I : R →+* R}
variables (B F : M →ₗ[R] M →ₛₗ[I] R)

/-- The condition for an endomorphism to be "self-adjoint" with respect to a pair of bilinear forms
on the underlying module. In the case that these two forms are identical, this is the usual concept
of self adjointness. In the case that one of the forms is the negation of the other, this is the
usual concept of skew adjointness. -/
def is_pair_self_adjoint (f : module.End R M) := is_adjoint_pair B F f f

/-- An endomorphism of a module is self-adjoint with respect to a bilinear form if it serves as an
adjoint for itself. -/
protected def is_self_adjoint (f : module.End R M) := is_adjoint_pair B B f f

end add_comm_monoid

section add_comm_group

variables [comm_ring R]
variables [add_comm_group M] [module R M]
variables [add_comm_group M₁] [module R M₁]
(B F : M →ₗ[R] M →ₗ[R] R)

/-- The set of pair-self-adjoint endomorphisms are a submodule of the type of all endomorphisms. -/
def is_pair_self_adjoint_submodule : submodule R (module.End R M) :=
{ carrier   := { f | is_pair_self_adjoint B F f },
  zero_mem' := is_adjoint_pair_zero,
  add_mem'  := λ f g hf hg, hf.add hg,
  smul_mem' := λ c f h, h.smul c, }

/-- An endomorphism of a module is skew-adjoint with respect to a bilinear form if its negation
serves as an adjoint. -/
def is_skew_adjoint (f : module.End R M) := is_adjoint_pair B B f (-f)

/-- The set of self-adjoint endomorphisms of a module with bilinear form is a submodule. (In fact
it is a Jordan subalgebra.) -/
def self_adjoint_submodule := is_pair_self_adjoint_submodule B B

/-- The set of skew-adjoint endomorphisms of a module with bilinear form is a submodule. (In fact
it is a Lie subalgebra.) -/
def skew_adjoint_submodule := is_pair_self_adjoint_submodule (-B) B

variables {B F}

@[simp] lemma mem_is_pair_self_adjoint_submodule (f : module.End R M) :
  f ∈ is_pair_self_adjoint_submodule B F ↔ is_pair_self_adjoint B F f :=
iff.rfl

lemma is_pair_self_adjoint_equiv (e : M₁ ≃ₗ[R] M) (f : module.End R M) :
  is_pair_self_adjoint B F f ↔
    is_pair_self_adjoint (B.compl₁₂ ↑e ↑e) (F.compl₁₂ ↑e ↑e) (e.symm.conj f) :=
begin
  have hₗ : (F.compl₁₂ (↑e : M₁ →ₗ[R] M) (↑e : M₁ →ₗ[R] M)).comp (e.symm.conj f) =
    (F.comp f).compl₁₂ (↑e : M₁ →ₗ[R] M) (↑e : M₁ →ₗ[R] M) :=
  by { ext, simp only [linear_equiv.symm_conj_apply, coe_comp, linear_equiv.coe_coe, compl₁₂_apply,
    linear_equiv.apply_symm_apply], },
  have hᵣ : (B.compl₁₂ (↑e : M₁ →ₗ[R] M) (↑e : M₁ →ₗ[R] M)).compl₂ (e.symm.conj f) =
    (B.compl₂ f).compl₁₂ (↑e : M₁ →ₗ[R] M) (↑e : M₁ →ₗ[R] M) :=
  by { ext, simp only [linear_equiv.symm_conj_apply, compl₂_apply, coe_comp, linear_equiv.coe_coe,
      compl₁₂_apply, linear_equiv.apply_symm_apply] },
  have he : function.surjective (⇑(↑e : M₁ →ₗ[R] M) : M₁ → M) := e.surjective,
  simp_rw [is_pair_self_adjoint, is_adjoint_pair_iff_comp_eq_compl₂, hₗ, hᵣ,
    compl₁₂_inj he he],
end

lemma is_skew_adjoint_iff_neg_self_adjoint (f : module.End R M) :
  B.is_skew_adjoint f ↔ is_adjoint_pair (-B) B f f :=
show (∀ x y, B (f x) y = B x ((-f) y)) ↔ ∀ x y, B (f x) y = (-B) x (f y),
by simp

@[simp] lemma mem_self_adjoint_submodule (f : module.End R M) :
  f ∈ B.self_adjoint_submodule ↔ B.is_self_adjoint f := iff.rfl

@[simp] lemma mem_skew_adjoint_submodule (f : module.End R M) :
  f ∈ B.skew_adjoint_submodule ↔ B.is_skew_adjoint f :=
by { rw is_skew_adjoint_iff_neg_self_adjoint, exact iff.rfl }

end add_comm_group

end selfadjoint_pair

/-! ### Nondegenerate bilinear forms -/

section nondegenerate

section comm_semiring
variables [comm_semiring R] [comm_semiring R₁] [add_comm_monoid M₁] [module R₁ M₁]
  [comm_semiring R₂] [add_comm_monoid M₂] [module R₂ M₂]
  {I₁ : R₁ →+* R} {I₂ : R₂ →+* R} {I₁' : R₁ →+* R}

/-- A bilinear form is called left-separating if
the only element that is left-orthogonal to every other element is `0`; i.e.,
for every nonzero `x` in `M₁`, there exists `y` in `M₂` with `B x y ≠ 0`.-/
def separating_left (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop :=
∀ x : M₁, (∀ y : M₂, B x y = 0) → x = 0

variables (M₁ M₂ I₁ I₂)

/-- In a non-trivial module, zero is not non-degenerate. -/
lemma not_separating_left_zero [nontrivial M₁] : ¬(0 : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R).separating_left :=
let ⟨m, hm⟩ := exists_ne (0 : M₁) in λ h, hm (h m $ λ n, rfl)

variables {M₁ M₂ I₁ I₂}

lemma separating_left.ne_zero [nontrivial M₁] {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R}
  (h : B.separating_left) : B ≠ 0 :=
λ h0, not_separating_left_zero M₁ M₂ I₁ I₂ $ h0 ▸ h

section linear

variables [add_comm_monoid Mₗ₁] [add_comm_monoid Mₗ₂] [add_comm_monoid Mₗ₁'] [add_comm_monoid Mₗ₂']
variables [module R Mₗ₁] [module R Mₗ₂] [module R Mₗ₁'] [module R Mₗ₂']
variables {B : Mₗ₁ →ₗ[R] Mₗ₂ →ₗ[R] R} (e₁ : Mₗ₁ ≃ₗ[R] Mₗ₁') (e₂ : Mₗ₂ ≃ₗ[R] Mₗ₂')

lemma separating_left.congr (h : B.separating_left) :
  (e₁.arrow_congr (e₂.arrow_congr (linear_equiv.refl R R)) B).separating_left :=
begin
  intros x hx,
  rw ←e₁.symm.map_eq_zero_iff,
  refine h (e₁.symm x) (λ y, _),
  specialize hx (e₂ y),
  simp only [linear_equiv.arrow_congr_apply, linear_equiv.symm_apply_apply,
    linear_equiv.map_eq_zero_iff] at hx,
  exact hx,
end

@[simp] lemma separating_left_congr_iff :
  (e₁.arrow_congr (e₂.arrow_congr (linear_equiv.refl R R)) B).separating_left ↔ B.separating_left :=
⟨λ h, begin
  convert h.congr e₁.symm e₂.symm,
  ext x y,
  simp,
end, separating_left.congr e₁ e₂⟩

end linear

/-- A bilinear form is called right-separating if
the only element that is right-orthogonal to every other element is `0`; i.e.,
for every nonzero `y` in `M₂`, there exists `x` in `M₁` with `B x y ≠ 0`.-/
def separating_right (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop :=
∀ y : M₂, (∀ x : M₁, B x y = 0) → y = 0

/-- A bilinear form is called non-degenerate if it is left-separating and right-separating. -/
def nondegenerate (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop := separating_left B ∧ separating_right B

@[simp] lemma flip_separating_right {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.flip.separating_right ↔ B.separating_left := ⟨λ hB x hy, hB x hy, λ hB x hy, hB x hy⟩

@[simp] lemma flip_separating_left {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.flip.separating_left ↔ separating_right B := by rw [←flip_separating_right, flip_flip]

@[simp] lemma flip_nondegenerate {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.flip.nondegenerate ↔ B.nondegenerate :=
iff.trans and.comm (and_congr flip_separating_right flip_separating_left)

lemma separating_left_iff_linear_nontrivial {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.separating_left ↔ ∀ x : M₁, B x = 0 → x = 0 :=
begin
  split; intros h x hB,
  { let h' := h x,
    simp only [hB, zero_apply, eq_self_iff_true, forall_const] at h',
    exact h' },
  have h' : B x = 0 := by { ext, rw [zero_apply], exact hB _ },
  exact h x h',
end

lemma separating_right_iff_linear_flip_nontrivial {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.separating_right ↔ ∀ y : M₂, B.flip y = 0 → y = 0 :=
by rw [←flip_separating_left, separating_left_iff_linear_nontrivial]

/-- A bilinear form is left-separating if and only if it has a trivial kernel. -/
theorem separating_left_iff_ker_eq_bot {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.separating_left ↔ B.ker = ⊥ :=
iff.trans separating_left_iff_linear_nontrivial linear_map.ker_eq_bot'.symm

/-- A bilinear form is right-separating if and only if its flip has a trivial kernel. -/
theorem separating_right_iff_flip_ker_eq_bot {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.separating_right ↔ B.flip.ker = ⊥ :=
by rw [←flip_separating_left, separating_left_iff_ker_eq_bot]

end comm_semiring

section comm_ring

variables [comm_ring R] [add_comm_group M] [module R M]
  {I I' : R →+* R}

lemma is_refl.nondegenerate_of_separating_left {B : M →ₗ[R] M →ₗ[R] R}
  (hB : B.is_refl) (hB' : B.separating_left) : B.nondegenerate :=
begin
  refine ⟨hB', _⟩,
  rw [separating_right_iff_flip_ker_eq_bot, hB.ker_eq_bot_iff_ker_flip_eq_bot.mp],
  rwa ←separating_left_iff_ker_eq_bot,
end

lemma is_refl.nondegenerate_of_separating_right {B : M →ₗ[R] M →ₗ[R] R}
  (hB : B.is_refl) (hB' : B.separating_right) : B.nondegenerate :=
begin
  refine ⟨_, hB'⟩,
  rw [separating_left_iff_ker_eq_bot, hB.ker_eq_bot_iff_ker_flip_eq_bot.mpr],
  rwa ←separating_right_iff_flip_ker_eq_bot,
end

/-- The restriction of a reflexive bilinear form `B` onto a submodule `W` is
nondegenerate if `W` has trivial intersection with its orthogonal complement,
that is `disjoint W (W.orthogonal_bilin B)`. -/
lemma nondegenerate_restrict_of_disjoint_orthogonal
  {B : M →ₗ[R] M →ₗ[R] R} (hB : B.is_refl)
  {W : submodule R M} (hW : disjoint W (W.orthogonal_bilin B)) :
  (B.dom_restrict₁₂ W W).nondegenerate :=
begin
  refine (hB.dom_restrict_refl W).nondegenerate_of_separating_left  _,
  rintro ⟨x, hx⟩ b₁,
  rw [submodule.mk_eq_zero, ← submodule.mem_bot R],
  refine hW.le_bot ⟨hx, λ y hy, _⟩,
  specialize b₁ ⟨y, hy⟩,
  simp_rw [dom_restrict₁₂_apply, submodule.coe_mk] at b₁,
  rw hB.ortho_comm,
  exact b₁,
end

/-- An orthogonal basis with respect to a left-separating bilinear form has no self-orthogonal
elements. -/
lemma is_Ortho.not_is_ortho_basis_self_of_separating_left [nontrivial R]
  {B : M →ₛₗ[I] M →ₛₗ[I'] R} {v : basis n R M} (h : B.is_Ortho v) (hB : B.separating_left)
  (i : n) : ¬B.is_ortho (v i) (v i) :=
begin
  intro ho,
  refine v.ne_zero i (hB (v i) $ λ m, _),
  obtain ⟨vi, rfl⟩ := v.repr.symm.surjective m,
  rw [basis.repr_symm_apply, finsupp.total_apply, finsupp.sum, map_sum],
  apply finset.sum_eq_zero,
  rintros j -,
  rw map_smulₛₗ,
  convert mul_zero _ using 2,
  obtain rfl | hij := eq_or_ne i j,
  { exact ho },
  { exact h hij },
end

/-- An orthogonal basis with respect to a right-separating bilinear form has no self-orthogonal
elements. -/
lemma is_Ortho.not_is_ortho_basis_self_of_separating_right [nontrivial R]
  {B : M →ₛₗ[I] M →ₛₗ[I'] R} {v : basis n R M} (h : B.is_Ortho v) (hB : B.separating_right)
  (i : n) : ¬B.is_ortho (v i) (v i) :=
begin
  rw is_Ortho_flip at h,
  rw is_ortho_flip,
  exact h.not_is_ortho_basis_self_of_separating_left (flip_separating_left.mpr hB) i,
end

/-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is left-separating
if the basis has no elements which are self-orthogonal. -/
lemma is_Ortho.separating_left_of_not_is_ortho_basis_self [no_zero_divisors R]
  {B : M →ₗ[R] M →ₗ[R] R} (v : basis n R M) (hO : B.is_Ortho v) (h : ∀ i, ¬B.is_ortho (v i) (v i)) :
  B.separating_left :=
begin
  intros m hB,
  obtain ⟨vi, rfl⟩ := v.repr.symm.surjective m,
  rw linear_equiv.map_eq_zero_iff,
  ext i,
  rw [finsupp.zero_apply],
  specialize hB (v i),
  simp_rw [basis.repr_symm_apply, finsupp.total_apply, finsupp.sum, map_sum₂, map_smulₛₗ₂,
    smul_eq_mul] at hB,
  rw finset.sum_eq_single i at hB,
  { exact eq_zero_of_ne_zero_of_mul_right_eq_zero (h i) hB, },
  { intros j hj hij, convert mul_zero _ using 2, exact hO hij, },
  { intros hi, convert zero_mul _ using 2, exact finsupp.not_mem_support_iff.mp hi }
end

/-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is right-separating
if the basis has no elements which are self-orthogonal. -/
lemma is_Ortho.separating_right_iff_not_is_ortho_basis_self [no_zero_divisors R]
  {B : M →ₗ[R] M →ₗ[R] R} (v : basis n R M) (hO : B.is_Ortho v) (h : ∀ i, ¬B.is_ortho (v i) (v i)) :
  B.separating_right :=
begin
  rw is_Ortho_flip at hO,
  rw [←flip_separating_left],
  refine is_Ortho.separating_left_of_not_is_ortho_basis_self v hO (λ i, _),
  rw is_ortho_flip,
  exact h i,
end

/-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is nondegenerate
if the basis has no elements which are self-orthogonal. -/
lemma is_Ortho.nondegenerate_of_not_is_ortho_basis_self [no_zero_divisors R]
  {B : M →ₗ[R] M →ₗ[R] R} (v : basis n R M) (hO : B.is_Ortho v) (h : ∀ i, ¬B.is_ortho (v i) (v i)) :
  B.nondegenerate :=
⟨is_Ortho.separating_left_of_not_is_ortho_basis_self v hO h,
  is_Ortho.separating_right_iff_not_is_ortho_basis_self v hO h⟩

end comm_ring

end nondegenerate

end linear_map


theorem tst1 {α : Type} {p : Prop} (xs : List α) (h₁ : (a : α) → (as : List α) → xs = a :: as → p) (h₂ : xs = [] → p) : p :=
by match (generalizing := false) h : xs with
   | []    => exact h₂ h
   | z::zs => apply h₁ z zs; assumption

theorem tst1' {α : Type} {p : Prop} (xs : List α) (h₁ : (a : α) → (as : List α) → xs = a :: as → p) (h₂ : xs = [] → p) : p :=
by match xs with
   | []    => exact h₂ rfl
   | z::zs => exact h₁ z zs rfl

theorem tst2 {α : Type} {p : Prop} (xs : List α) (h₁ : (a : α) → (as : List α) → xs = a :: as → p) (h₂ : xs = [] → p) : p :=
by match (generalizing := false) h:xs with
   | []    => ?nilCase
   | z::zs => ?consCase;
   case consCase => exact h₁ z zs h;
   case nilCase => exact h₂ h

def tst3 {α β γ : Type} (h : α × β × γ) : β × α × γ :=
by {
  match h with
  | (a, b, c) => exact (b, a, c)
}

theorem tst4 {α : Type} {p : Prop} (xs : List α) (h₁ : (a : α) → (as : List α) → xs = a :: as → p) (h₂ : xs = [] → p) : p := by
match (generalizing := false) h : xs with
| []    => _
| z::zs => _
case match_2 => exact h₁ z zs h
exact h₂ h

theorem tst5 {p q r} (h : p ∨ q ∨ r) : r ∨ q ∨ p:= by
match h with
| Or.inl h          => exact Or.inr (Or.inr h)
| Or.inr (Or.inl h) => ?c1
| Or.inr (Or.inr h) => ?c2
case c2 =>
  apply Or.inl
  assumption
case c1 =>
  apply Or.inr
  apply Or.inl
  assumption

theorem tst6 {p q r} (h : p ∨ q ∨ r) : r ∨ q ∨ p:= by
match h with
| Or.inl h          => exact Or.inr (Or.inr h)
| Or.inr (Or.inl h) => ?c1
| Or.inr (Or.inr h) =>
  apply Or.inl
  assumption
case c1 => apply Or.inr; apply Or.inl; assumption

theorem tst7 {p q r} (h : p ∨ q ∨ r) : r ∨ q ∨ p:=
by match h with
   | Or.inl h =>
     exact Or.inr (Or.inr h)
   | Or.inr (Or.inl h) =>
     apply Or.inr;
     apply Or.inl;
     assumption
   | Or.inr (Or.inr h) =>
     apply Or.inl;
     assumption

inductive ListLast.{u} {α : Type u} : List α → Type u
| empty    : ListLast []
| nonEmpty : (as : List α) → (a : α) → ListLast (as ++ [a])

axiom last {α} (xs : List α) : ListLast xs
axiom back {α} [Inhabited α] (xs : List α) : α
axiom popBack {α} : List α → List α
axiom backEq {α} [Inhabited α] : (xs : List α) → (x : α) → back (xs ++ [x]) = x
axiom popBackEq {α} : (xs : List α) → (x : α) → popBack (xs ++ [x]) = xs

theorem tst8 {α} [Inhabited α] (xs : List α) : xs ≠ [] → xs = popBack xs ++ [back xs] :=
match (generalizing := false) xs, h:last xs with
| _, ListLast.empty         => fun h => absurd rfl h
| _, ListLast.nonEmpty ys y => fun _ => sorry

theorem tst9 {α} [Inhabited α] (xs : List α) : xs ≠ [] → xs = popBack xs ++ [back xs] := by
  match (generalizing := false) xs, h:last xs with
  | _, ListLast.empty         => intro h; exact absurd rfl h
  | _, ListLast.nonEmpty ys y => intro; rw [popBackEq, backEq]

theorem tst8' {α} [Inhabited α] (xs : List α) : xs ≠ [] → xs = popBack xs ++ [back xs] :=
match xs, last xs with
| _, ListLast.empty         => fun h => absurd rfl h
| _, ListLast.nonEmpty ys y => fun _ => sorry

theorem tst8'' {α} [Inhabited α] (xs : List α) (h : xs ≠ []) : xs = popBack xs ++ [back xs] :=
match xs, last xs with
| _, ListLast.empty         => absurd rfl h
| _, ListLast.nonEmpty ys y => sorry

example (xs : List α) : xs = xs := by
  match xs with
  | [] | [x] | x::x'::xs => rfl


import analysis.complex.basic
import analysis.calculus.deriv
import tactic.pi_instances
import ring_theory.subring.basic
import analysis.normed_space.basic
import analysis.calculus.deriv
import analysis.analytic.basic

local attribute [instance] classical.prop_decidable
noncomputable theory

universes u v
open_locale classical topological_space big_operators filter
open filter complex asymptotics

section
variables {α : Type*} {β : Type*} {s : set α}

def extend_by_zero [has_zero β] (f : s → β) : α → β :=
λ z, if h : z ∈ s then f ⟨z, h⟩ else 0

lemma extend_by_zero_eq_of_mem [has_zero β] (f : s → β) (x : α) (hx : x ∈ s):
  (extend_by_zero f) x = f ⟨ x, hx ⟩ :=
begin
  rw extend_by_zero, dsimp, split_ifs, tauto,
end

lemma extend_by_zero_zero [has_zero β] :
extend_by_zero (λ s, 0 : s → β) = (λ h, 0) :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_zero' [has_zero β] :
extend_by_zero (0 : s → β) = 0 :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_f_eq_zero [has_zero β] (f : s → β)
(h : extend_by_zero f = 0) : f = 0 :=
begin

sorry,
end

lemma extend_by_zero_f_neq_zero [has_zero β] (f : s → β)
(h : extend_by_zero f ≠ 0) : f ≠ 0 :=
begin

sorry,
end

lemma extend_by_zero_add [add_group β] (f g : s → β) :
extend_by_zero (f + g) = extend_by_zero f + extend_by_zero g :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_sum [add_comm_monoid β] (ι  : finset α) (F : ι →  s → β) :
extend_by_zero (λ (x : s), ∑ (i : ι ), F i x) = ∑ (i : ι), extend_by_zero (F i) :=
begin
ext z,
by_cases h : z ∈ s,
simp only [extend_by_zero, h, finset.sum_apply, dif_pos],
simp only [extend_by_zero, h, finset.sum_apply, dif_neg, not_false_iff, finset.sum_const_zero],
end

lemma extend_by_zero_mul [semiring β] (f g : s → β) :
extend_by_zero (f * g) = extend_by_zero f * extend_by_zero g :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_neg [add_group β] (f : s → β) :
extend_by_zero (-f) = -extend_by_zero f :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_smul [ring β] (c : β) (f : s → β) :
  extend_by_zero (c • f) = c • extend_by_zero f :=
  by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

end

def open_subs := topological_space.opens ℂ

/--A function is Holomorphic on an open subset of the complex numbers, if for every point in the domain
there is a neibourhood around the point containing the derivative of the function. In order to make it work
with has_deriv_within_at, we first extend the function by zero to the entire complex plane. -/

def is_holomorphic_on {D : open_subs} (f : D.1 → ℂ) : Prop :=
  ∀ z : D.1, ∃ f', has_deriv_within_at (extend_by_zero f) (f') D.1 z

lemma is_holomorphic_on_iff_differentiable_on  (D : open_subs) (f : D.1 → ℂ):
  differentiable_on ℂ (extend_by_zero f) D.1 ↔ is_holomorphic_on f:=
begin
  rw is_holomorphic_on,
  split,
  rw differentiable_on,
  intros hd z,
  have h1:= hd z.1 z.2,
  have h2:=  differentiable_within_at.has_fderiv_within_at h1,
  simp_rw has_deriv_within_at,
  simp_rw has_deriv_at_filter,
  simp_rw has_fderiv_within_at at h2,
  simp at *,
  dunfold fderiv_within at h2,
  dunfold differentiable_within_at at h1,
  rw dif_pos h1 at h2,
  use classical.some h1 1,
  simp,
  exact h2,
  intro hz,
  rw differentiable_on,
  intros x hx,
  have h1:= hz ⟨x, hx⟩,
  have h2:= classical.some_spec h1,
  apply has_deriv_within_at.differentiable_within_at  h2,
end

variable {D : open_subs}

lemma ext_by_zero_eq (D: open_subs) (c : ℂ):
∀ (y : ℂ), (y ∈ (D.1 : set ℂ)) → extend_by_zero (λ z : D.1, (c : ℂ)) y = c :=
begin
  intros y hy,
  rw extend_by_zero,
  simp only [dite_eq_ite],
  cases D,
  dsimp at *,
  simp only [ite_eq_left_iff] at *,
  intros A,
  solve_by_elim,
end

lemma ext_by_zero_eq' (D: open_subs) (f : D.1 → ℂ) (y : ℂ) (h: y ∈ (D.1 : set ℂ)):
  extend_by_zero (f ) y = (f ⟨ y, h⟩) :=
begin
  rw extend_by_zero,
  simp,
  cases D,
  dsimp at *,
  exact dif_pos h,
end

lemma ext_by_zero_apply (D: open_subs) (f : D.1 → ℂ) (y : D.1) :
  extend_by_zero (f ) y = (f y) :=
begin
  have:= ext_by_zero_eq' D f y y.2,
  rw this,
  simp,
end

lemma const_hol  (c : ℂ) : is_holomorphic_on (λ z : D.1, (c : ℂ)) :=
begin
  rw is_holomorphic_on,
  intro z,
  use (0: ℂ),
  have h1:=has_deriv_within_at_const  z.1 D.1 c,
  have H:= has_deriv_within_at.congr_of_eventually_eq_of_mem h1 _ z.property ,
  convert H,
  rw  eventually_eq,
  rw eventually_iff_exists_mem,
  use D.1,
  have H2:= ext_by_zero_eq D c,
  split,
  have h3:= D.2,
  simp at h3,
  have h4:=is_open.mem_nhds h3 z.2,
  simp only [subtype.val_eq_coe],
  convert h4,
  simp,
  rw nhds_within,
  simp only [inf_eq_left, le_principal_iff],
  exact h4,
  exact H2,
end

lemma zero_hol (D: open_subs) : is_holomorphic_on (λ z : D.1, (0 : ℂ)) :=
begin
  apply const_hol (0:ℂ ),
end

lemma one_hol (D: open_subs) : is_holomorphic_on (λ z : D.1, (1 : ℂ)) :=
begin
apply const_hol (1: ℂ),

end
lemma add_hol (f g : D.1 → ℂ) (f_hol : is_holomorphic_on f) (g_hol : is_holomorphic_on g) :
  is_holomorphic_on (f + g) :=
begin
  intro z₀,
  cases f_hol z₀ with f'z₀ Hf,
  cases g_hol z₀ with g'z₀ Hg,
  existsi (f'z₀ + g'z₀),
  rw extend_by_zero_add,
  have:=has_deriv_within_at.add Hf Hg,
  exact this,
end

lemma mul_hol (f g : D.1 → ℂ) (f_hol : is_holomorphic_on f) (g_hol : is_holomorphic_on g) :
  is_holomorphic_on (f * g) :=
begin
  intro z₀,
  cases f_hol z₀ with f'z₀ Hf,
  cases g_hol z₀ with g'z₀ Hg,
  existsi f'z₀*(extend_by_zero g z₀) + (extend_by_zero f z₀)*g'z₀,
  rw extend_by_zero_mul,
  have:=has_deriv_within_at.mul Hf Hg,
  exact this,
end

lemma neg_hol (f : D.1 → ℂ) (f_hol : is_holomorphic_on f) : is_holomorphic_on (-f) :=
begin
  intro z₀,
  cases f_hol z₀ with f'z₀ H,
  existsi -f'z₀,
  rw extend_by_zero_neg,
  have h3:=has_deriv_within_at.neg H,
  exact h3,
end

/--The ring of holomorphic functions-/
def hol_ring (D: open_subs) : subring (D.1 → ℂ) :=
{ carrier := {f : D.1 → ℂ | is_holomorphic_on f},
  zero_mem' := zero_hol D,
  add_mem'  := add_hol,
  neg_mem'  := neg_hol,
  mul_mem'  := mul_hol,
  one_mem'  := one_hol D
}

lemma smul_hol (c : ℂ) (f : D.1 → ℂ) (f_hol : is_holomorphic_on f) : is_holomorphic_on (c • f) :=
begin
  intro z₀,
  cases f_hol z₀ with f'z₀ Hf,
  existsi c * f'z₀,
  rw extend_by_zero_smul,
  have h2:= has_deriv_within_at.const_smul c Hf,
  exact h2,

end

def hol_submodule (D: open_subs) : submodule (ℂ)  (D.1 → ℂ) :=
{ carrier := {f : D.1 → ℂ | is_holomorphic_on f},
  zero_mem' := zero_hol D,
  add_mem' := add_hol,
  smul_mem' := smul_hol}

lemma aux (s t d : set ℂ) (h :  s ⊆ t) : s ∩ d ⊆ t :=
begin
  intros x hx,
  apply h,
  simp at *,
  apply hx.1,
end

lemma aux2 (x : ℂ) (a b : ℝ) : metric.ball x a ∩ metric.ball x b = metric.ball x (min a b) :=
begin
  ext,
  split,
  simp only [and_imp, metric.mem_ball, set.mem_inter_iff, lt_min_iff],
  intros ha hb,
  simp only [ha, hb, and_self],
  simp only [and_imp, metric.mem_ball, set.mem_inter_iff, lt_min_iff],
  intros ha hb,
  simp only [ha, hb, and_self],
end

lemma diff_on_diff (f : D.1 → ℂ) (h : ∀ x : D.1, ∃ (ε: ℝ), 0 < ε ∧ (metric.ball x.1 ε ⊆ D.val ) ∧
  differentiable_on ℂ (extend_by_zero f) (metric.ball x ε)) :
  differentiable_on ℂ (extend_by_zero f) D.1 :=
begin
  simp_rw differentiable_on at *,
  simp_rw differentiable_within_at at *,
  intros x hx,
  have hh := h ⟨x, hx⟩,
  obtain ⟨ε, hε, hb, H⟩:= hh,
  have HH:= H x,
  simp only [metric.mem_ball, subtype.coe_mk, dist_self] at HH,
  have HHH:= HH hε,
  obtain ⟨f', hf'⟩:= HHH,
  use f',
  simp_rw has_fderiv_within_at_iff_tendsto at *,
  rw metric.tendsto_nhds at *,
  intros δ hδ,
  have hf2 := hf'  δ hδ,
  rw filter.eventually_iff_exists_mem at *,
  simp only [exists_prop, metric.mem_ball, gt_iff_lt, topological_space.opens.mem_coe,
    dist_zero_right, continuous_linear_map.map_sub, set_coe.forall, subtype.coe_mk,
    subtype.val_eq_coe,norm_eq_abs, norm_mul, norm_inv] at *,
  obtain ⟨S, hS, HD⟩ := hf2,
  simp_rw metric.mem_nhds_within_iff at *,
  obtain ⟨e, he, HE⟩:= hS,
  use S,
  split,
  use min e ε,
  simp only [gt_iff_lt, topological_space.opens.mem_coe, lt_min_iff, subtype.val_eq_coe] at *,
  simp only [he, hε, and_self],
  simp only [true_and],
  have : metric.ball x e ∩ metric.ball x ε = metric.ball x (min e ε), by {apply aux2,},
  rw this at HE,
  apply aux _ _ _ HE,
  apply HD,
end

lemma tendsto_unif_extend_by_zero (F : ℕ → D.1 → ℂ) (f : D.1 → ℂ)
(h: tendsto_uniformly F f filter.at_top ) :
  tendsto_uniformly_on (λ (n : ℕ), extend_by_zero (F n)) (extend_by_zero f) filter.at_top D.1 :=
begin
  simp_rw metric.tendsto_uniformly_on_iff,
  rw metric.tendsto_uniformly_iff at h,
  intros ε hε,
  have h2:= h ε hε,
  simp only [gt_iff_lt, topological_space.opens.mem_coe, ge_iff_le, nonempty_of_inhabited,
  set_coe.forall, eventually_at_top, subtype.val_eq_coe] at *,
  obtain ⟨a, ha⟩:= h2,
  use a,
  intros b hb x hx,
  have hf:= ext_by_zero_apply D f ⟨x, hx⟩,
  have hFb:= ext_by_zero_apply D (F b) ⟨x, hx⟩,
  simp only [topological_space.opens.mem_coe, subtype.coe_mk, subtype.val_eq_coe] at *,
  rw hf,
  rw hFb,
  apply ha b hb x hx,
end


/-
Copyright (c) 2017 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

! This file was ported from Lean 3 source module control.applicative
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Defs
import Mathlib.Control.Functor

/-!
# `applicative` instances

This file provides `Applicative` instances for concrete functors:
* `id`
* `Functor.comp`
* `Functor.const`
* `Functor.add_const`
-/

universe u v w

section Lemmas

open Function

variable {F : Type u → Type v}

variable [Applicative F] [LawfulApplicative F]

variable {α β γ σ : Type u}

theorem Applicative.map_seq_map (f : α → β → γ) (g : σ → β) (x : F α) (y : F σ) :
    f <$> x <*> g <$> y = (flip (· ∘ ·) g ∘ f) <$> x <*> y := by simp [flip, functor_norm]
#align applicative.map_seq_map Applicative.map_seq_map

theorem Applicative.pure_seq_eq_map' (f : α → β) : (· <*> ·) (pure f : F (α → β)) = (· <$> ·) f :=
  by ext; simp [functor_norm]
#align applicative.pure_seq_eq_map' Applicative.pure_seq_eq_map'

theorem Applicative.ext {F} :
    ∀ {A1 : Applicative F} {A2 : Applicative F} [@LawfulApplicative F A1] [@LawfulApplicative F A2],
      (∀ {α : Type u} (x : α), @Pure.pure _ A1.toPure _ x = @Pure.pure _ A2.toPure _ x) →
      (∀ {α β : Type u} (f : F (α → β)) (x : F α),
          @Seq.seq _ A1.toSeq _ _ f (fun _ => x) = @Seq.seq _ A2.toSeq _ _ f (fun _ => x)) →
      A1 = A2
  | { toFunctor := F1, seq := s1, pure := p1, seqLeft := sl1, seqRight := sr1 },
    { toFunctor := F2, seq := s2, pure := p2, seqLeft := sl2, seqRight := sr2 }, L1, L2, H1, H2 =>
    by
    obtain rfl : @p1 = @p2 := by
      funext α x
      apply H1
    obtain rfl : @s1 = @s2 := by
      funext α β f x
      exact H2 f (x Unit.unit)
    obtain ⟨seqLeft_eq1, seqRight_eq1, pure_seq1, -⟩ := L1
    obtain ⟨seqLeft_eq2, seqRight_eq2, pure_seq2, -⟩ := L2
    obtain rfl : F1 = F2 := by
      apply Functor.ext
      intros
      exact (pure_seq1 _ _).symm.trans (pure_seq2 _ _)
    congr <;> funext α β x y
    · exact (seqLeft_eq1 _ (y Unit.unit)).trans (seqLeft_eq2 _ _).symm
    · exact (seqRight_eq1 _ (y Unit.unit)).trans (seqRight_eq2 _ (y Unit.unit)).symm

#align applicative.ext Applicative.ext

end Lemmas

-- Porting note: mathport failed to see the #align on `CommApplicative`,
-- therefore using `IsCommApplicative` instead.

-- Porting note: we have a monad instance for `Id` but not `id`, mathport can't tell
-- which one is intended

instance : CommApplicative Id := by refine' { .. } <;> intros <;> rfl

namespace Functor

namespace Comp

open Function hiding comp

open Functor

variable {F : Type u → Type w} {G : Type v → Type u}

variable [Applicative F] [Applicative G]

variable [LawfulApplicative F] [LawfulApplicative G]

variable {α β γ : Type v}

theorem map_pure (f : α → β) (x : α) : (f <$> pure x : Comp F G β) = pure (f x) :=
  Comp.ext <| by simp
#align functor.comp.map_pure Functor.Comp.map_pure

theorem seq_pure (f : Comp F G (α → β)) (x : α) : f <*> pure x = (fun g : α → β => g x) <$> f :=
  Comp.ext <| by simp [(· ∘ ·), functor_norm]
#align functor.comp.seq_pure Functor.Comp.seq_pure

theorem seq_assoc (x : Comp F G α) (f : Comp F G (α → β)) (g : Comp F G (β → γ)) :
    g <*> (f <*> x) = @Function.comp α β γ <$> g <*> f <*> x :=
  Comp.ext <| by simp [(· ∘ ·), functor_norm]
#align functor.comp.seq_assoc Functor.Comp.seq_assoc

theorem pure_seq_eq_map (f : α → β) (x : Comp F G α) : pure f <*> x = f <$> x :=
  Comp.ext <| by simp [Applicative.pure_seq_eq_map', functor_norm]
#align functor.comp.pure_seq_eq_map Functor.Comp.pure_seq_eq_map

-- TODO: the first two results were handled by `control_laws_tac` in mathlib3
instance : LawfulApplicative (Comp F G) where
  seqLeft_eq := by intros; rfl
  seqRight_eq := by intros; rfl
  pure_seq := @Comp.pure_seq_eq_map F G _ _ _ _
  map_pure := @Comp.map_pure F G _ _ _ _
  seq_pure := @Comp.seq_pure F G _ _ _ _
  seq_assoc := @Comp.seq_assoc F G _ _ _ _

-- Porting note: mathport wasn't aware of the new implicit parameter omission in these `fun` binders

theorem applicative_id_comp {F} [AF : Applicative F] [LawfulApplicative F] :
    @instApplicativeComp Id F _ _ = AF :=
  @Applicative.ext F _ _ (@instLawfulApplicativeCompInstApplicativeComp Id F _ _ _ _) _
    (fun _ => rfl) (fun _ _ => rfl)
#align functor.comp.applicative_id_comp Functor.Comp.applicative_id_comp

theorem applicative_comp_id {F} [AF : Applicative F] [LawfulApplicative F] :
    @Comp.instApplicativeComp F Id _ _ = AF :=
  @Applicative.ext F _ _ (@Comp.instLawfulApplicativeCompInstApplicativeComp F Id _ _ _ _) _
    (fun _ => rfl) (fun f x => show id <$> f <*> x = f <*> x by rw [id_map])
#align functor.comp.applicative_comp_id Functor.Comp.applicative_comp_id

open CommApplicative

instance {f : Type u → Type w} {g : Type v → Type u} [Applicative f] [Applicative g]
    [CommApplicative f] [CommApplicative g] : CommApplicative (Comp f g) := by
  refine' { @instLawfulApplicativeCompInstApplicativeComp f g _ _ _ _ with .. }
  intros
  simp! [map, Seq.seq, functor_norm]
  rw [commutative_map]
  simp [Comp.mk, flip, (· ∘ ·), functor_norm]
  congr
  funext x y
  rw [commutative_map]
  congr

end Comp

end Functor

open Functor

@[functor_norm]
theorem Comp.seq_mk {α β : Type w} {f : Type u → Type v} {g : Type w → Type u} [Applicative f]
    [Applicative g] (h : f (g (α → β))) (x : f (g α)) :
    Comp.mk h <*> Comp.mk x = Comp.mk ((· <*> ·) <$> h <*> x) :=
  rfl
#align comp.seq_mk Comp.seq_mk

-- Porting note: There is some awkwardness in the following definition now that we have `HMul`.

instance {α} [One α] [Mul α] : Applicative (Const α) where
  pure _ := (1 : α)
  seq f x := (show α from f) * (show α from x Unit.unit)

-- Porting note: `(· <*> ·)` needed to change to `Seq.seq` in the `simp`.
-- Also, `simp` didn't close `refl` goals.

instance {α} [Monoid α] : LawfulApplicative (Const α) := by
  refine' { .. } <;> intros <;> simp [mul_assoc, (· <$> ·), Seq.seq, pure] <;> rfl

instance {α} [Zero α] [Add α] : Applicative (AddConst α) where
  pure _ := (0 : α)
  seq f x := (show α from f) + (show α from x Unit.unit)

instance {α} [AddMonoid α] : LawfulApplicative (AddConst α) := by
  refine' { .. } <;> intros <;> simp [add_assoc, (· <$> ·), Seq.seq, pure] <;> rfl


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.logic.embedding
import Mathlib.order.rel_classes
import Mathlib.data.set.intervals.basic
import Mathlib.PostPort

universes u_4 u_5 l u_1 u_2 u_3

namespace Mathlib

/-- A relation homomorphism with respect to a given pair of relations `r` and `s`
is a function `f : α → β` such that `r a b → s (f a) (f b)`. -/
structure rel_hom {α : Type u_4} {β : Type u_5} (r : α → α → Prop) (s : β → β → Prop) where
  to_fun : α → β
  map_rel' : ∀ {a b : α}, r a b → s (to_fun a) (to_fun b)

infixl:25 " →r " => Mathlib.rel_hom

namespace rel_hom

protected instance has_coe_to_fun {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} : has_coe_to_fun (r →r s) :=
  has_coe_to_fun.mk (fun (_x : r →r s) => α → β) fun (o : r →r s) => to_fun o

theorem map_rel {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} (f : r →r s)
    {a : α} {b : α} : r a b → s (coe_fn f a) (coe_fn f b) :=
  map_rel' f

@[simp] theorem coe_fn_mk {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : α → β) (o : ∀ {a b : α}, r a b → s (f a) (f b)) : ⇑(mk f o) = f :=
  rfl

@[simp] theorem coe_fn_to_fun {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r →r s) : to_fun f = ⇑f :=
  rfl

/-- The map `coe_fn : (r →r s) → (α → β)` is injective. We can't use `function.injective`
here but mimic its signature by using `⦃e₁ e₂⦄`. -/
theorem coe_fn_inj {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} {e₁ : r →r s}
    {e₂ : r →r s} : ⇑e₁ = ⇑e₂ → e₁ = e₂ :=
  sorry

theorem ext {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} {f : r →r s}
    {g : r →r s} (h : ∀ (x : α), coe_fn f x = coe_fn g x) : f = g :=
  coe_fn_inj (funext h)

theorem ext_iff {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} {f : r →r s}
    {g : r →r s} : f = g ↔ ∀ (x : α), coe_fn f x = coe_fn g x :=
  { mp := fun (h : f = g) (x : α) => h ▸ rfl,
    mpr := fun (h : ∀ (x : α), coe_fn f x = coe_fn g x) => ext h }

/-- Identity map is a relation homomorphism. -/
protected def id {α : Type u_1} (r : α → α → Prop) : r →r r := mk id sorry

/-- Composition of two relation homomorphisms is a relation homomorphism. -/
protected def comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : α → α → Prop}
    {s : β → β → Prop} {t : γ → γ → Prop} (g : s →r t) (f : r →r s) : r →r t :=
  mk (to_fun g ∘ to_fun f) sorry

@[simp] theorem id_apply {α : Type u_1} {r : α → α → Prop} (x : α) : coe_fn (rel_hom.id r) x = x :=
  rfl

@[simp] theorem comp_apply {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : α → α → Prop}
    {s : β → β → Prop} {t : γ → γ → Prop} (g : s →r t) (f : r →r s) (a : α) :
    coe_fn (rel_hom.comp g f) a = coe_fn g (coe_fn f a) :=
  rfl

/-- A relation homomorphism is also a relation homomorphism between dual relations. -/
protected def swap {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r →r s) : function.swap r →r function.swap s :=
  mk ⇑f sorry

/-- A function is a relation homomorphism from the preimage relation of `s` to `s`. -/
def preimage {α : Type u_1} {β : Type u_2} (f : α → β) (s : β → β → Prop) : f ⁻¹'o s →r s :=
  mk f sorry

protected theorem is_irrefl {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r →r s) [is_irrefl β s] : is_irrefl α r :=
  sorry

protected theorem is_asymm {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r →r s) [is_asymm β s] : is_asymm α r :=
  sorry

protected theorem acc {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r →r s) (a : α) : acc s (coe_fn f a) → acc r a :=
  sorry

protected theorem well_founded {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r →r s) (h : well_founded s) : well_founded r :=
  well_founded.dcases_on h
    fun (h : ∀ (a : β), acc s a) =>
      idRhs (well_founded r) (well_founded.intro fun (a : α) => rel_hom.acc f a (h (coe_fn f a)))

theorem map_inf {α : Type u_1} {β : Type u_2} [semilattice_inf α] [linear_order β]
    (a : Less →r Less) (m : β) (n : β) : coe_fn a (m ⊓ n) = coe_fn a m ⊓ coe_fn a n :=
  sorry

theorem map_sup {α : Type u_1} {β : Type u_2} [semilattice_sup α] [linear_order β] (a : gt →r gt)
    (m : β) (n : β) : coe_fn a (m ⊔ n) = coe_fn a m ⊔ coe_fn a n :=
  sorry

end rel_hom

/-- An increasing function is injective -/
theorem injective_of_increasing {α : Type u_1} {β : Type u_2} (r : α → α → Prop) (s : β → β → Prop)
    [is_trichotomous α r] [is_irrefl β s] (f : α → β) (hf : ∀ {x y : α}, r x y → s (f x) (f y)) :
    function.injective f :=
  sorry

/-- An increasing function is injective -/
theorem rel_hom.injective_of_increasing {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} [is_trichotomous α r] [is_irrefl β s] (f : r →r s) : function.injective ⇑f :=
  injective_of_increasing r s ⇑f fun (x y : α) => rel_hom.map_rel f

theorem surjective.well_founded_iff {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} {f : α → β} (hf : function.surjective f)
    (o : ∀ {a b : α}, r a b ↔ s (f a) (f b)) : well_founded r ↔ well_founded s :=
  sorry

/-- A relation embedding with respect to a given pair of relations `r` and `s`
is an embedding `f : α ↪ β` such that `r a b ↔ s (f a) (f b)`. -/
structure rel_embedding {α : Type u_4} {β : Type u_5} (r : α → α → Prop) (s : β → β → Prop)
    extends α ↪ β where
  map_rel_iff' : ∀ {a b : α}, s (coe_fn _to_embedding a) (coe_fn _to_embedding b) ↔ r a b

infixl:25 " ↪r " => Mathlib.rel_embedding

/-- An order embedding is an embedding `f : α ↪ β` such that `a ≤ b ↔ (f a) ≤ (f b)`.
This definition is an abbreviation of `rel_embedding (≤) (≤)`. -/
def order_embedding (α : Type u_1) (β : Type u_2) [HasLessEq α] [HasLessEq β] := LessEq ↪r LessEq

infixl:25 " ↪o " => Mathlib.order_embedding

/-- The induced relation on a subtype is an embedding under the natural inclusion. -/
def subtype.rel_embedding {X : Type u_1} (r : X → X → Prop) (p : X → Prop) :
    subtype.val ⁻¹'o r ↪r r :=
  rel_embedding.mk (function.embedding.subtype p) sorry

theorem preimage_equivalence {α : Sort u_1} {β : Sort u_2} (f : α → β) {s : β → β → Prop}
    (hs : equivalence s) : equivalence (f ⁻¹'o s) :=
  sorry

namespace rel_embedding

/-- A relation embedding is also a relation homomorphism -/
def to_rel_hom {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} (f : r ↪r s) :
    r →r s :=
  rel_hom.mk (function.embedding.to_fun (to_embedding f)) sorry

-- see Note [function coercion]

protected instance rel_hom.has_coe {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} : has_coe (r ↪r s) (r →r s) :=
  has_coe.mk to_rel_hom

protected instance has_coe_to_fun {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} : has_coe_to_fun (r ↪r s) :=
  has_coe_to_fun.mk (fun (_x : r ↪r s) => α → β) fun (o : r ↪r s) => ⇑(to_embedding o)

@[simp] theorem to_rel_hom_eq_coe {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (f : r ↪r s) : to_rel_hom f = ↑f :=
  rfl

@[simp] theorem coe_coe_fn {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) : ⇑↑f = ⇑f :=
  rfl

theorem injective {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} (f : r ↪r s) :
    function.injective ⇑f :=
  function.embedding.inj' (to_embedding f)

theorem map_rel_iff {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} (f : r ↪r s)
    {a : α} {b : α} : s (coe_fn f a) (coe_fn f b) ↔ r a b :=
  map_rel_iff' f

@[simp] theorem coe_fn_mk {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : α ↪ β) (o : ∀ {a b : α}, s (coe_fn f a) (coe_fn f b) ↔ r a b) : ⇑(mk f o) = ⇑f :=
  rfl

@[simp] theorem coe_fn_to_embedding {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (f : r ↪r s) : ⇑(to_embedding f) = ⇑f :=
  rfl

/-- The map `coe_fn : (r ↪r s) → (α → β)` is injective. We can't use `function.injective`
here but mimic its signature by using `⦃e₁ e₂⦄`. -/
theorem coe_fn_inj {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} {e₁ : r ↪r s}
    {e₂ : r ↪r s} : ⇑e₁ = ⇑e₂ → e₁ = e₂ :=
  sorry

theorem ext {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} {f : r ↪r s}
    {g : r ↪r s} (h : ∀ (x : α), coe_fn f x = coe_fn g x) : f = g :=
  coe_fn_inj (funext h)

theorem ext_iff {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} {f : r ↪r s}
    {g : r ↪r s} : f = g ↔ ∀ (x : α), coe_fn f x = coe_fn g x :=
  { mp := fun (h : f = g) (x : α) => h ▸ rfl,
    mpr := fun (h : ∀ (x : α), coe_fn f x = coe_fn g x) => ext h }

/-- Identity map is a relation embedding. -/
protected def refl {α : Type u_1} (r : α → α → Prop) : r ↪r r :=
  mk (function.embedding.refl α) sorry

/-- Composition of two relation embeddings is a relation embedding. -/
protected def trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : α → α → Prop}
    {s : β → β → Prop} {t : γ → γ → Prop} (f : r ↪r s) (g : s ↪r t) : r ↪r t :=
  mk (function.embedding.trans (to_embedding f) (to_embedding g)) sorry

protected instance inhabited {α : Type u_1} (r : α → α → Prop) : Inhabited (r ↪r r) :=
  { default := rel_embedding.refl r }

@[simp] theorem refl_apply {α : Type u_1} {r : α → α → Prop} (x : α) :
    coe_fn (rel_embedding.refl r) x = x :=
  rfl

theorem trans_apply {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : α → α → Prop}
    {s : β → β → Prop} {t : γ → γ → Prop} (f : r ↪r s) (g : s ↪r t) (a : α) :
    coe_fn (rel_embedding.trans f g) a = coe_fn g (coe_fn f a) :=
  rfl

@[simp] theorem coe_trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : α → α → Prop}
    {s : β → β → Prop} {t : γ → γ → Prop} (f : r ↪r s) (g : s ↪r t) :
    ⇑(rel_embedding.trans f g) = ⇑g ∘ ⇑f :=
  rfl

/-- A relation embedding is also a relation embedding between dual relations. -/
protected def swap {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) : function.swap r ↪r function.swap s :=
  mk (to_embedding f) sorry

/-- If `f` is injective, then it is a relation embedding from the
  preimage relation of `s` to `s`. -/
def preimage {α : Type u_1} {β : Type u_2} (f : α ↪ β) (s : β → β → Prop) : ⇑f ⁻¹'o s ↪r s :=
  mk f sorry

theorem eq_preimage {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) : r = ⇑f ⁻¹'o s :=
  funext fun (a : α) => funext fun (b : α) => propext (iff.symm (map_rel_iff f))

protected theorem is_irrefl {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) [is_irrefl β s] : is_irrefl α r :=
  is_irrefl.mk fun (a : α) => mt (iff.mpr (map_rel_iff f)) (irrefl (coe_fn f a))

protected theorem is_refl {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) [is_refl β s] : is_refl α r :=
  is_refl.mk fun (a : α) => iff.mp (map_rel_iff f) (refl (coe_fn f a))

protected theorem is_symm {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) [is_symm β s] : is_symm α r :=
  is_symm.mk fun (a b : α) => imp_imp_imp (iff.mpr (map_rel_iff f)) (iff.mp (map_rel_iff f)) symm

protected theorem is_asymm {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) [is_asymm β s] : is_asymm α r :=
  is_asymm.mk
    fun (a b : α) (h₁ : r a b) (h₂ : r b a) =>
      asymm (iff.mpr (map_rel_iff f) h₁) (iff.mpr (map_rel_iff f) h₂)

protected theorem is_antisymm {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) [is_antisymm β s] : is_antisymm α r :=
  sorry

protected theorem is_trans {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) [is_trans β s] : is_trans α r :=
  sorry

protected theorem is_total {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) [is_total β s] : is_total α r :=
  sorry

protected theorem is_preorder {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) [is_preorder β s] : is_preorder α r :=
  idRhs (is_preorder α r) is_preorder.mk

protected theorem is_partial_order {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (f : r ↪r s) [is_partial_order β s] : is_partial_order α r :=
  idRhs (is_partial_order α r) is_partial_order.mk

protected theorem is_linear_order {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (f : r ↪r s) [is_linear_order β s] : is_linear_order α r :=
  idRhs (is_linear_order α r) is_linear_order.mk

protected theorem is_strict_order {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (f : r ↪r s) [is_strict_order β s] : is_strict_order α r :=
  idRhs (is_strict_order α r) is_strict_order.mk

protected theorem is_trichotomous {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (f : r ↪r s) [is_trichotomous β s] : is_trichotomous α r :=
  sorry

protected theorem is_strict_total_order' {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (f : r ↪r s) [is_strict_total_order' β s] : is_strict_total_order' α r :=
  idRhs (is_strict_total_order' α r) is_strict_total_order'.mk

protected theorem acc {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) (a : α) : acc s (coe_fn f a) → acc r a :=
  sorry

protected theorem well_founded {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) (h : well_founded s) : well_founded r :=
  well_founded.dcases_on h
    fun (h : ∀ (a : β), acc s a) =>
      idRhs (well_founded r)
        (well_founded.intro fun (a : α) => rel_embedding.acc f a (h (coe_fn f a)))

protected theorem is_well_order {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ↪r s) [is_well_order β s] : is_well_order α r :=
  idRhs (is_well_order α r) (is_well_order.mk (rel_embedding.well_founded f is_well_order.wf))

/-- It suffices to prove `f` is monotone between strict relations
  to show it is a relation embedding. -/
def of_monotone {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    [is_trichotomous α r] [is_asymm β s] (f : α → β) (H : ∀ (a b : α), r a b → s (f a) (f b)) :
    r ↪r s :=
  mk (function.embedding.mk f sorry) sorry

@[simp] theorem of_monotone_coe {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    [is_trichotomous α r] [is_asymm β s] (f : α → β) (H : ∀ (a b : α), r a b → s (f a) (f b)) :
    ⇑(of_monotone f H) = f :=
  rfl

/-- Embeddings of partial orders that preserve `<` also preserve `≤`  -/
def order_embedding_of_lt_embedding {α : Type u_1} {β : Type u_2} [partial_order α]
    [partial_order β] (f : Less ↪r Less) : α ↪o β :=
  mk (to_embedding f) sorry

end rel_embedding

namespace order_embedding

/-- lt is preserved by order embeddings of preorders -/
def lt_embedding {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ↪o β) :
    Less ↪r Less :=
  rel_embedding.mk (rel_embedding.to_embedding f) sorry

@[simp] theorem lt_embedding_apply {α : Type u_1} {β : Type u_2} [preorder α] [preorder β]
    (f : α ↪o β) (x : α) : coe_fn (lt_embedding f) x = coe_fn f x :=
  rfl

@[simp] theorem le_iff_le {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ↪o β)
    {a : α} {b : α} : coe_fn f a ≤ coe_fn f b ↔ a ≤ b :=
  rel_embedding.map_rel_iff f

@[simp] theorem lt_iff_lt {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ↪o β)
    {a : α} {b : α} : coe_fn f a < coe_fn f b ↔ a < b :=
  rel_embedding.map_rel_iff (lt_embedding f)

@[simp] theorem eq_iff_eq {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ↪o β)
    {a : α} {b : α} : coe_fn f a = coe_fn f b ↔ a = b :=
  function.injective.eq_iff (rel_embedding.injective f)

protected theorem monotone {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ↪o β) :
    monotone ⇑f :=
  fun (x y : α) => iff.mpr (le_iff_le f)

protected theorem strict_mono {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ↪o β) :
    strict_mono ⇑f :=
  fun (x y : α) => iff.mpr (lt_iff_lt f)

protected theorem acc {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ↪o β) (a : α) :
    acc Less (coe_fn f a) → acc Less a :=
  rel_embedding.acc (lt_embedding f) a

protected theorem well_founded {α : Type u_1} {β : Type u_2} [preorder α] [preorder β]
    (f : α ↪o β) : well_founded Less → well_founded Less :=
  rel_embedding.well_founded (lt_embedding f)

protected theorem is_well_order {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ↪o β)
    [is_well_order β Less] : is_well_order α Less :=
  rel_embedding.is_well_order (lt_embedding f)

/-- An order embedding is also an order embedding between dual orders. -/
protected def dual {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ↪o β) :
    order_dual α ↪o order_dual β :=
  rel_embedding.mk (rel_embedding.to_embedding f) sorry

/-- A sctrictly monotone map from a linear order is an order embedding. --/
def of_strict_mono {α : Type u_1} {β : Type u_2} [linear_order α] [preorder β] (f : α → β)
    (h : strict_mono f) : α ↪o β :=
  rel_embedding.mk (function.embedding.mk f (strict_mono.injective h)) sorry

@[simp] theorem coe_of_strict_mono {α : Type u_1} {β : Type u_2} [linear_order α] [preorder β]
    {f : α → β} (h : strict_mono f) : ⇑(of_strict_mono f h) = f :=
  rfl

/-- Embedding of a subtype into the ambient type as an `order_embedding`. -/
def subtype {α : Type u_1} [preorder α] (p : α → Prop) : Subtype p ↪o α :=
  rel_embedding.mk (function.embedding.subtype p) sorry

@[simp] theorem coe_subtype {α : Type u_1} [preorder α] (p : α → Prop) : ⇑(subtype p) = coe := rfl

end order_embedding

/-- A relation isomorphism is an equivalence that is also a relation embedding. -/
structure rel_iso {α : Type u_4} {β : Type u_5} (r : α → α → Prop) (s : β → β → Prop) extends α ≃ β
    where
  map_rel_iff' : ∀ {a b : α}, s (coe_fn _to_equiv a) (coe_fn _to_equiv b) ↔ r a b

infixl:25 " ≃r " => Mathlib.rel_iso

/-- An order isomorphism is an equivalence such that `a ≤ b ↔ (f a) ≤ (f b)`.
This definition is an abbreviation of `rel_iso (≤) (≤)`. -/
def order_iso (α : Type u_1) (β : Type u_2) [HasLessEq α] [HasLessEq β] := LessEq ≃r LessEq

infixl:25 " ≃o " => Mathlib.order_iso

namespace rel_iso

/-- Convert an `rel_iso` to an `rel_embedding`. This function is also available as a coercion
but often it is easier to write `f.to_rel_embedding` than to write explicitly `r` and `s`
in the target type. -/
def to_rel_embedding {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ≃r s) : r ↪r s :=
  rel_embedding.mk (equiv.to_embedding (to_equiv f)) (map_rel_iff' f)

-- see Note [function coercion]

protected instance rel_embedding.has_coe {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} : has_coe (r ≃r s) (r ↪r s) :=
  has_coe.mk to_rel_embedding

protected instance has_coe_to_fun {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} : has_coe_to_fun (r ≃r s) :=
  has_coe_to_fun.mk (fun (_x : r ≃r s) => α → β) fun (f : r ≃r s) => ⇑f

@[simp] theorem to_rel_embedding_eq_coe {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (f : r ≃r s) : to_rel_embedding f = ↑f :=
  rfl

@[simp] theorem coe_coe_fn {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ≃r s) : ⇑↑f = ⇑f :=
  rfl

theorem map_rel_iff {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} (f : r ≃r s)
    {a : α} {b : α} : s (coe_fn f a) (coe_fn f b) ↔ r a b :=
  map_rel_iff' f

@[simp] theorem coe_fn_mk {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : α ≃ β) (o : ∀ {a b : α}, s (coe_fn f a) (coe_fn f b) ↔ r a b) : ⇑(mk f o) = ⇑f :=
  rfl

@[simp] theorem coe_fn_to_equiv {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ≃r s) : ⇑(to_equiv f) = ⇑f :=
  rfl

theorem injective_to_equiv {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} :
    function.injective to_equiv :=
  sorry

/-- The map `coe_fn : (r ≃r s) → (α → β)` is injective. Lean fails to parse
`function.injective (λ e : r ≃r s, (e : α → β))`, so we use a trick to say the same. -/
theorem injective_coe_fn {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} :
    function.injective fun (e : r ≃r s) (x : α) => coe_fn e x :=
  function.injective.comp equiv.injective_coe_fn injective_to_equiv

theorem ext {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} {f : r ≃r s}
    {g : r ≃r s} (h : ∀ (x : α), coe_fn f x = coe_fn g x) : f = g :=
  injective_coe_fn (funext h)

theorem ext_iff {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} {f : r ≃r s}
    {g : r ≃r s} : f = g ↔ ∀ (x : α), coe_fn f x = coe_fn g x :=
  { mp := fun (h : f = g) (x : α) => h ▸ rfl,
    mpr := fun (h : ∀ (x : α), coe_fn f x = coe_fn g x) => ext h }

/-- Identity map is a relation isomorphism. -/
protected def refl {α : Type u_1} (r : α → α → Prop) : r ≃r r := mk (equiv.refl α) sorry

/-- Inverse map of a relation isomorphism is a relation isomorphism. -/
protected def symm {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ≃r s) : s ≃r r :=
  mk (equiv.symm (to_equiv f)) sorry

/-- Composition of two relation isomorphisms is a relation isomorphism. -/
protected def trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : α → α → Prop}
    {s : β → β → Prop} {t : γ → γ → Prop} (f₁ : r ≃r s) (f₂ : s ≃r t) : r ≃r t :=
  mk (equiv.trans (to_equiv f₁) (to_equiv f₂)) sorry

protected instance inhabited {α : Type u_1} (r : α → α → Prop) : Inhabited (r ≃r r) :=
  { default := rel_iso.refl r }

@[simp] theorem default_def {α : Type u_1} (r : α → α → Prop) :
    Inhabited.default = rel_iso.refl r :=
  rfl

/-- a relation isomorphism is also a relation isomorphism between dual relations. -/
protected def swap {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ≃r s) : function.swap r ≃r function.swap s :=
  mk (to_equiv f) sorry

@[simp] theorem coe_fn_symm_mk {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : α ≃ β) (o : ∀ {a b : α}, s (coe_fn f a) (coe_fn f b) ↔ r a b) :
    ⇑(rel_iso.symm (mk f o)) = ⇑(equiv.symm f) :=
  rfl

@[simp] theorem refl_apply {α : Type u_1} {r : α → α → Prop} (x : α) :
    coe_fn (rel_iso.refl r) x = x :=
  rfl

@[simp] theorem trans_apply {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : α → α → Prop}
    {s : β → β → Prop} {t : γ → γ → Prop} (f : r ≃r s) (g : s ≃r t) (a : α) :
    coe_fn (rel_iso.trans f g) a = coe_fn g (coe_fn f a) :=
  rfl

@[simp] theorem apply_symm_apply {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (e : r ≃r s) (x : β) : coe_fn e (coe_fn (rel_iso.symm e) x) = x :=
  equiv.apply_symm_apply (to_equiv e) x

@[simp] theorem symm_apply_apply {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (e : r ≃r s) (x : α) : coe_fn (rel_iso.symm e) (coe_fn e x) = x :=
  equiv.symm_apply_apply (to_equiv e) x

theorem rel_symm_apply {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (e : r ≃r s) {x : α} {y : β} : r x (coe_fn (rel_iso.symm e) y) ↔ s (coe_fn e x) y :=
  sorry

theorem symm_apply_rel {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (e : r ≃r s) {x : β} {y : α} : r (coe_fn (rel_iso.symm e) x) y ↔ s x (coe_fn e y) :=
  sorry

protected theorem bijective {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (e : r ≃r s) : function.bijective ⇑e :=
  equiv.bijective (to_equiv e)

protected theorem injective {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (e : r ≃r s) : function.injective ⇑e :=
  equiv.injective (to_equiv e)

protected theorem surjective {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (e : r ≃r s) : function.surjective ⇑e :=
  equiv.surjective (to_equiv e)

@[simp] theorem range_eq {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (e : r ≃r s) : set.range ⇑e = set.univ :=
  function.surjective.range_eq (rel_iso.surjective e)

@[simp] theorem eq_iff_eq {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (f : r ≃r s) {a : α} {b : α} : coe_fn f a = coe_fn f b ↔ a = b :=
  function.injective.eq_iff (rel_iso.injective f)

/-- Any equivalence lifts to a relation isomorphism between `s` and its preimage. -/
protected def preimage {α : Type u_1} {β : Type u_2} (f : α ≃ β) (s : β → β → Prop) :
    ⇑f ⁻¹'o s ≃r s :=
  mk f sorry

/-- A surjective relation embedding is a relation isomorphism. -/
def of_surjective {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop} (f : r ↪r s)
    (H : function.surjective ⇑f) : r ≃r s :=
  mk (equiv.of_bijective ⇑f sorry) sorry

@[simp] theorem of_surjective_coe {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (f : r ↪r s) (H : function.surjective ⇑f) : ⇑(of_surjective f H) = ⇑f :=
  rfl

/--
Given relation isomorphisms `r₁ ≃r r₂` and `s₁ ≃r s₂`, construct a relation isomorphism for the
lexicographic orders on the sum.
-/
def sum_lex_congr {α₁ : Type u_1} {α₂ : Type u_2} {β₁ : Type u_3} {β₂ : Type u_4}
    {r₁ : α₁ → α₁ → Prop} {r₂ : α₂ → α₂ → Prop} {s₁ : β₁ → β₁ → Prop} {s₂ : β₂ → β₂ → Prop}
    (e₁ : r₁ ≃r r₂) (e₂ : s₁ ≃r s₂) : sum.lex r₁ s₁ ≃r sum.lex r₂ s₂ :=
  mk (equiv.sum_congr (to_equiv e₁) (to_equiv e₂)) sorry

/--
Given relation isomorphisms `r₁ ≃r r₂` and `s₁ ≃r s₂`, construct a relation isomorphism for the
lexicographic orders on the product.
-/
def prod_lex_congr {α₁ : Type u_1} {α₂ : Type u_2} {β₁ : Type u_3} {β₂ : Type u_4}
    {r₁ : α₁ → α₁ → Prop} {r₂ : α₂ → α₂ → Prop} {s₁ : β₁ → β₁ → Prop} {s₂ : β₂ → β₂ → Prop}
    (e₁ : r₁ ≃r r₂) (e₂ : s₁ ≃r s₂) : prod.lex r₁ s₁ ≃r prod.lex r₂ s₂ :=
  mk (equiv.prod_congr (to_equiv e₁) (to_equiv e₂)) sorry

protected instance group {α : Type u_1} {r : α → α → Prop} : group (r ≃r r) :=
  group.mk (fun (f₁ f₂ : r ≃r r) => rel_iso.trans f₂ f₁) sorry (rel_iso.refl r) sorry sorry
    rel_iso.symm
    (div_inv_monoid.div._default (fun (f₁ f₂ : r ≃r r) => rel_iso.trans f₂ f₁) sorry
      (rel_iso.refl r) sorry sorry rel_iso.symm)
    sorry

@[simp] theorem coe_one {α : Type u_1} {r : α → α → Prop} : ⇑1 = id := rfl

@[simp] theorem coe_mul {α : Type u_1} {r : α → α → Prop} (e₁ : r ≃r r) (e₂ : r ≃r r) :
    ⇑(e₁ * e₂) = ⇑e₁ ∘ ⇑e₂ :=
  rfl

theorem mul_apply {α : Type u_1} {r : α → α → Prop} (e₁ : r ≃r r) (e₂ : r ≃r r) (x : α) :
    coe_fn (e₁ * e₂) x = coe_fn e₁ (coe_fn e₂ x) :=
  rfl

@[simp] theorem inv_apply_self {α : Type u_1} {r : α → α → Prop} (e : r ≃r r) (x : α) :
    coe_fn (e⁻¹) (coe_fn e x) = x :=
  symm_apply_apply e x

@[simp] theorem apply_inv_self {α : Type u_1} {r : α → α → Prop} (e : r ≃r r) (x : α) :
    coe_fn e (coe_fn (e⁻¹) x) = x :=
  apply_symm_apply e x

end rel_iso

namespace order_iso

/-- Reinterpret an order isomorphism as an order embedding. -/
def to_order_embedding {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β] (e : α ≃o β) :
    α ↪o β :=
  rel_iso.to_rel_embedding e

@[simp] theorem coe_to_order_embedding {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β]
    (e : α ≃o β) : ⇑(to_order_embedding e) = ⇑e :=
  rfl

protected theorem bijective {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β] (e : α ≃o β) :
    function.bijective ⇑e :=
  equiv.bijective (rel_iso.to_equiv e)

protected theorem injective {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β] (e : α ≃o β) :
    function.injective ⇑e :=
  equiv.injective (rel_iso.to_equiv e)

protected theorem surjective {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β]
    (e : α ≃o β) : function.surjective ⇑e :=
  equiv.surjective (rel_iso.to_equiv e)

@[simp] theorem range_eq {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β] (e : α ≃o β) :
    set.range ⇑e = set.univ :=
  function.surjective.range_eq (order_iso.surjective e)

@[simp] theorem apply_eq_iff_eq {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β]
    (e : α ≃o β) {x : α} {y : α} : coe_fn e x = coe_fn e y ↔ x = y :=
  equiv.apply_eq_iff_eq (rel_iso.to_equiv e)

/-- Inverse of an order isomorphism. -/
def symm {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β] (e : α ≃o β) : β ≃o α :=
  rel_iso.symm e

@[simp] theorem apply_symm_apply {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β]
    (e : α ≃o β) (x : β) : coe_fn e (coe_fn (symm e) x) = x :=
  equiv.apply_symm_apply (rel_iso.to_equiv e) x

@[simp] theorem symm_apply_apply {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β]
    (e : α ≃o β) (x : α) : coe_fn (symm e) (coe_fn e x) = x :=
  equiv.symm_apply_apply (rel_iso.to_equiv e) x

theorem symm_apply_eq {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β] (e : α ≃o β) {x : α}
    {y : β} : coe_fn (symm e) y = x ↔ y = coe_fn e x :=
  equiv.symm_apply_eq (rel_iso.to_equiv e)

@[simp] theorem symm_symm {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β] (e : α ≃o β) :
    symm (symm e) = e :=
  rel_iso.ext fun (x : α) => Eq.refl (coe_fn (symm (symm e)) x)

theorem symm_injective {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β] :
    function.injective symm :=
  sorry

@[simp] theorem to_equiv_symm {α : Type u_1} {β : Type u_2} [HasLessEq α] [HasLessEq β]
    (e : α ≃o β) : equiv.symm (rel_iso.to_equiv e) = rel_iso.to_equiv (symm e) :=
  rfl

/-- Composition of two order isomorphisms is an order isomorphism. -/
def trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [HasLessEq α] [HasLessEq β] [HasLessEq γ]
    (e : α ≃o β) (e' : β ≃o γ) : α ≃o γ :=
  rel_iso.trans e e'

@[simp] theorem coe_trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [HasLessEq α] [HasLessEq β]
    [HasLessEq γ] (e : α ≃o β) (e' : β ≃o γ) : ⇑(trans e e') = ⇑e' ∘ ⇑e :=
  rfl

theorem trans_apply {α : Type u_1} {β : Type u_2} {γ : Type u_3} [HasLessEq α] [HasLessEq β]
    [HasLessEq γ] (e : α ≃o β) (e' : β ≃o γ) (x : α) :
    coe_fn (trans e e') x = coe_fn e' (coe_fn e x) :=
  rfl

protected theorem monotone {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β) :
    monotone ⇑e :=
  order_embedding.monotone (to_order_embedding e)

protected theorem strict_mono {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β) :
    strict_mono ⇑e :=
  order_embedding.strict_mono (to_order_embedding e)

@[simp] theorem le_iff_le {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    {x : α} {y : α} : coe_fn e x ≤ coe_fn e y ↔ x ≤ y :=
  rel_iso.map_rel_iff e

@[simp] theorem lt_iff_lt {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    {x : α} {y : α} : coe_fn e x < coe_fn e y ↔ x < y :=
  order_embedding.lt_iff_lt (to_order_embedding e)

@[simp] theorem preimage_Iic {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    (b : β) : ⇑e ⁻¹' set.Iic b = set.Iic (coe_fn (symm e) b) :=
  sorry

@[simp] theorem preimage_Ici {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    (b : β) : ⇑e ⁻¹' set.Ici b = set.Ici (coe_fn (symm e) b) :=
  sorry

@[simp] theorem preimage_Iio {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    (b : β) : ⇑e ⁻¹' set.Iio b = set.Iio (coe_fn (symm e) b) :=
  sorry

@[simp] theorem preimage_Ioi {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    (b : β) : ⇑e ⁻¹' set.Ioi b = set.Ioi (coe_fn (symm e) b) :=
  sorry

@[simp] theorem preimage_Icc {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    (a : β) (b : β) : ⇑e ⁻¹' set.Icc a b = set.Icc (coe_fn (symm e) a) (coe_fn (symm e) b) :=
  sorry

@[simp] theorem preimage_Ico {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    (a : β) (b : β) : ⇑e ⁻¹' set.Ico a b = set.Ico (coe_fn (symm e) a) (coe_fn (symm e) b) :=
  sorry

@[simp] theorem preimage_Ioc {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    (a : β) (b : β) : ⇑e ⁻¹' set.Ioc a b = set.Ioc (coe_fn (symm e) a) (coe_fn (symm e) b) :=
  sorry

@[simp] theorem preimage_Ioo {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (e : α ≃o β)
    (a : β) (b : β) : ⇑e ⁻¹' set.Ioo a b = set.Ioo (coe_fn (symm e) a) (coe_fn (symm e) b) :=
  sorry

/-- To show that `f : α → β`, `g : β → α` make up an order isomorphism of linear orders,
    it suffices to prove `cmp a (g b) = cmp (f a) b`. --/
def of_cmp_eq_cmp {α : Type u_1} {β : Type u_2} [linear_order α] [linear_order β] (f : α → β)
    (g : β → α) (h : ∀ (a : α) (b : β), cmp a (g b) = cmp (f a) b) : α ≃o β :=
  (fun (gf : ∀ (a : α), a = g (f a)) => rel_iso.mk (equiv.mk f g sorry sorry) sorry) sorry

/-- Order isomorphism between two equal sets. -/
def set_congr {α : Type u_1} [preorder α] (s : set α) (t : set α) (h : s = t) : ↥s ≃o ↥t :=
  rel_iso.mk (equiv.set_congr h) sorry

/-- Order isomorphism between `univ : set α` and `α`. -/
def set.univ {α : Type u_1} [preorder α] : ↥set.univ ≃o α := rel_iso.mk (equiv.set.univ α) sorry

end order_iso

/-- If a function `f` is strictly monotone on a set `s`, then it defines an order isomorphism
between `s` and its image. -/
protected def strict_mono_incr_on.order_iso {α : Type u_1} {β : Type u_2} [linear_order α]
    [preorder β] (f : α → β) (s : set α) (hf : strict_mono_incr_on f s) : ↥s ≃o ↥(f '' s) :=
  rel_iso.mk (set.bij_on.equiv f sorry) sorry

/-- A strictly monotone function from a linear order is an order isomorphism between its domain and
its range. -/
protected def strict_mono.order_iso {α : Type u_1} {β : Type u_2} [linear_order α] [preorder β]
    (f : α → β) (h_mono : strict_mono f) : α ≃o ↥(set.range f) :=
  rel_iso.mk (equiv.set.range f (strict_mono.injective h_mono)) sorry

/-- A strictly monotone surjective function from a linear order is an order isomorphism. -/
def strict_mono.order_iso_of_surjective {α : Type u_1} {β : Type u_2} [linear_order α] [preorder β]
    (f : α → β) (h_mono : strict_mono f) (h_surj : function.surjective f) : α ≃o β :=
  order_iso.trans (strict_mono.order_iso f h_mono)
    (order_iso.trans
      (order_iso.set_congr (set.range f) set.univ (function.surjective.range_eq h_surj))
      order_iso.set.univ)

/-- `subrel r p` is the inherited relation on a subset. -/
def subrel {α : Type u_1} (r : α → α → Prop) (p : set α) : ↥p → ↥p → Prop := coe ⁻¹'o r

@[simp] theorem subrel_val {α : Type u_1} (r : α → α → Prop) (p : set α) {a : ↥p} {b : ↥p} :
    subrel r p a b ↔ r (subtype.val a) (subtype.val b) :=
  iff.rfl

namespace subrel

/-- The relation embedding from the inherited relation on a subset. -/
protected def rel_embedding {α : Type u_1} (r : α → α → Prop) (p : set α) : subrel r p ↪r r :=
  rel_embedding.mk (function.embedding.subtype fun (x : α) => x ∈ p) sorry

@[simp] theorem rel_embedding_apply {α : Type u_1} (r : α → α → Prop) (p : set α) (a : ↥p) :
    coe_fn (subrel.rel_embedding r p) a = subtype.val a :=
  rfl

protected instance is_well_order {α : Type u_1} (r : α → α → Prop) [is_well_order α r] (p : set α) :
    is_well_order (↥p) (subrel r p) :=
  rel_embedding.is_well_order (subrel.rel_embedding r p)

end subrel

/-- Restrict the codomain of a relation embedding. -/
def rel_embedding.cod_restrict {α : Type u_1} {β : Type u_2} {r : α → α → Prop} {s : β → β → Prop}
    (p : set β) (f : r ↪r s) (H : ∀ (a : α), coe_fn f a ∈ p) : r ↪r subrel s p :=
  rel_embedding.mk (function.embedding.cod_restrict p (rel_embedding.to_embedding f) H)
    (rel_embedding.map_rel_iff' f)

@[simp] theorem rel_embedding.cod_restrict_apply {α : Type u_1} {β : Type u_2} {r : α → α → Prop}
    {s : β → β → Prop} (p : set β) (f : r ↪r s) (H : ∀ (a : α), coe_fn f a ∈ p) (a : α) :
    coe_fn (rel_embedding.cod_restrict p f H) a = { val := coe_fn f a, property := H a } :=
  rfl

protected def order_iso.dual {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α ≃o β) :
    order_dual α ≃o order_dual β :=
  rel_iso.mk (rel_iso.to_equiv f) sorry

theorem order_iso.map_bot' {α : Type u_1} {β : Type u_2} [partial_order α] [partial_order β]
    (f : α ≃o β) {x : α} {y : β} (hx : ∀ (x' : α), x ≤ x') (hy : ∀ (y' : β), y ≤ y') :
    coe_fn f x = y :=
  sorry

theorem order_iso.map_bot {α : Type u_1} {β : Type u_2} [order_bot α] [order_bot β] (f : α ≃o β) :
    coe_fn f ⊥ = ⊥ :=
  order_iso.map_bot' f (fun (_x : α) => bot_le) fun (_x : β) => bot_le

theorem order_iso.map_top' {α : Type u_1} {β : Type u_2} [partial_order α] [partial_order β]
    (f : α ≃o β) {x : α} {y : β} (hx : ∀ (x' : α), x' ≤ x) (hy : ∀ (y' : β), y' ≤ y) :
    coe_fn f x = y :=
  order_iso.map_bot' (order_iso.dual f) hx hy

theorem order_iso.map_top {α : Type u_1} {β : Type u_2} [order_top α] [order_top β] (f : α ≃o β) :
    coe_fn f ⊤ = ⊤ :=
  order_iso.map_bot (order_iso.dual f)

theorem order_embedding.map_inf_le {α : Type u_1} {β : Type u_2} [semilattice_inf α]
    [semilattice_inf β] (f : α ↪o β) (x : α) (y : α) : coe_fn f (x ⊓ y) ≤ coe_fn f x ⊓ coe_fn f y :=
  monotone.map_inf_le (order_embedding.monotone f) x y

theorem order_iso.map_inf {α : Type u_1} {β : Type u_2} [semilattice_inf α] [semilattice_inf β]
    (f : α ≃o β) (x : α) (y : α) : coe_fn f (x ⊓ y) = coe_fn f x ⊓ coe_fn f y :=
  sorry

theorem order_embedding.le_map_sup {α : Type u_1} {β : Type u_2} [semilattice_sup α]
    [semilattice_sup β] (f : α ↪o β) (x : α) (y : α) : coe_fn f x ⊔ coe_fn f y ≤ coe_fn f (x ⊔ y) :=
  monotone.le_map_sup (order_embedding.monotone f) x y

theorem order_iso.map_sup {α : Type u_1} {β : Type u_2} [semilattice_sup α] [semilattice_sup β]
    (f : α ≃o β) (x : α) (y : α) : coe_fn f (x ⊔ y) = coe_fn f x ⊔ coe_fn f y :=
  order_iso.map_inf (order_iso.dual f) x y

end Mathlib


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.simulation_semantics.simulate.support

/-!
# State Masking for Simulation Oracles

This file defines a construction for masking the state of an oracle using some equivalence.
This is particularlly useful when combining multiple oracles,
as this can lead to irrelevent extra bits of the state floating around.
The definition is in terms of an equivalence `S ≃ S'` between types (i.e. a bijection),
with `S` the original state and `S'` the new one.

We also give the natural lemmas for the compatibility of masking with `support` and `eval_dist`,
showing that the masking doesn't affect their values (up to applying the mask to the state).
-/

variables {α β γ : Type} {spec spec' : oracle_spec} {S S' S'' : Type}

open oracle_comp oracle_spec

namespace sim_oracle

/-- Mask the state value of an oracle, without changing the oracle's behaviour.
We capture this unchanged functionality by using an equivalence for the masking.
Convenient when working with composed or appended oracles, to remove unneeded state elements.
In particular `unit` state values that start spreading can be avoided.
-/
def mask_state (so : sim_oracle spec spec' S) (mask : S ≃ S') :
  sim_oracle spec spec' S' :=
{ default_state := mask so.default_state,
  o := λ i x, prod.map id mask <$> (so.o i $ prod.map id mask.symm x) }

variables (so : sim_oracle spec spec' S) (mask : S ≃ S') (mask' : S' ≃ S'')
  (a : α) (i : spec.ι) (t : spec.domain i) (oa : oracle_comp spec α)
  (ob : α → oracle_comp spec β) (s : S) (s' : S') (s'' : S'')
  (x : spec.domain i × S') (y : spec.range i × S')

lemma mask_state_apply_eq : so.mask_state mask i x =
  prod.map id mask <$> (so.o i $ prod.map id mask.symm x) := rfl

section support

/-- The `support` of a simulation with masked state is the same as the support without masking -/
@[simp]
theorem support_simulate_mask_eq_image_support_simulate :
  (simulate (so.mask_state mask) oa s').support =
    (prod.map id mask) '' (simulate so oa (mask.symm s')).support :=
begin
  refine support_simulate_eq_induction (so.mask_state mask) oa s' (λ α a s, _) _ (λ i t s, _),
  { rw [support_simulate_return, set.image_singleton, prod_map, id.def, equiv.apply_symm_apply] },
  { refine λ α β oa ob s, set.ext (λ x, _),
    simp_rw [support_simulate_bind, set.image_Union, set.mem_Union],
    refine ⟨λ h, _, λ h, _⟩,
    { obtain ⟨⟨a, t⟩, hta, hx⟩ := h,
      exact ⟨(a, mask t), ⟨(a, t), hta, rfl⟩, (mask.symm_apply_apply t).symm ▸ hx⟩ },
    { obtain ⟨⟨a, t⟩, ⟨⟨a', t'⟩, ⟨htas, hta⟩⟩, hx⟩ := h,
      rw [prod.map_mk, prod.eq_iff_fst_eq_snd_eq] at hta,
      have : mask.symm t = t' := (congr_arg _ hta.2.symm).trans (mask.symm_apply_apply t'),
      exact ⟨(a', mask.symm t), this.symm ▸ htas, hta.1.symm ▸ hx⟩ } },
  { simpa only [simulate_query, mask_state_apply_eq, support_map] }
end

lemma support_simulate_mask_eq_preimage_support_simulate :
  (simulate (so.mask_state mask) oa s').support =
    (prod.map id mask.symm) ⁻¹' (simulate so oa (mask.symm s')).support :=
begin
  rw [support_simulate_mask_eq_image_support_simulate],
  refine congr_fun (set.image_eq_preimage_of_inverse _ _) _;
  exact λ x, by simp only [prod_map, id.def, equiv.symm_apply_apply,
    equiv.apply_symm_apply, prod.mk.eta]
end

/-- The `support` of a regular simulation can be represented as the image of a simulation
with a masked state, with the image applying an unmask function for the masking -/
lemma support_simulate_eq_image_support_simulate_mask : (simulate so oa s).support =
  (prod.map id mask.symm) '' (simulate (so.mask_state mask) oa (mask s)).support :=
by simp_rw [support_simulate_mask_eq_image_support_simulate, set.image_image, prod.map_map,
  equiv.symm_comp_self, equiv.symm_apply_apply, function.comp.right_id, prod.map_id, set.image_id]

lemma support_simulate_eq_preimage_support_simulate_mask : (simulate so oa s).support =
  (prod.map id mask) ⁻¹' (simulate (so.mask_state mask) oa (mask s)).support :=
by simp_rw [support_simulate_mask_eq_preimage_support_simulate, set.preimage_preimage,
  prod.map_map, equiv.symm_comp_self, equiv.symm_apply_apply, function.comp.right_id,
    prod.map_id, set.preimage_id]

@[simp]
lemma support_simulate'_mask_eq_support_simulate' :
  (simulate' (so.mask_state mask) oa s').support = (simulate' so oa (mask.symm s')).support :=
by simpa only [support_simulate', support_simulate_mask_eq_image_support_simulate, set.image_image]

lemma support_simulate'_eq_support_simulate'_mask :
  (simulate' so oa s).support = (simulate' (so.mask_state mask) oa (mask s)).support :=
by rw [support_simulate'_mask_eq_support_simulate', equiv.symm_apply_apply]

lemma support_simulate_mask_mask_eq_support_simulate_mask_comp :
  (simulate ((so.mask_state mask).mask_state mask') oa s'').support =
    (simulate (so.mask_state $ mask.trans mask') oa s'').support :=
by simpa only [support_simulate_mask_eq_image_support_simulate, set.image_image, prod.map_map,
  equiv.symm_trans_apply, function.comp.right_id]

end support

section fin_support

end fin_support

section distribution_semantics

section eval_dist

@[simp]
lemma eval_dist_mask_apply : ⁅so.mask_state mask i (t, s')⁆ =
  (⁅so i (t, mask.symm s')⁆).map (prod.map id mask) :=
by simpa only [mask_state_apply_eq, eval_dist_map]

@[simp]
theorem eval_dist_simulate_mask : ⁅simulate (so.mask_state mask) oa s'⁆
  = (⁅simulate so oa (mask.symm s')⁆).map (prod.map id mask) :=
begin
  induction oa using oracle_comp.induction_on with α a α β oa ob hoa hob i t generalizing s',
  { simp only [pmf.pure_map, simulate_return, eval_dist_return,
      prod.map_mk, id.def, equiv.apply_symm_apply] },
  { simp_rw [eval_dist_simulate_bind, hoa, hob, pmf.map_bind, pmf.bind_map],
    refine congr_arg _ (funext $ λ x, _),
    simp only [function.comp_app, prod_map, id.def, equiv.symm_apply_apply] },
  { simp only [eval_dist_mask_apply, simulate_query] }
end

@[simp]
lemma eval_dist_simulate_mask_apply (x : α × S') : ⁅simulate (so.mask_state mask) oa s'⁆ x =
  ⁅simulate so oa (mask.symm s')⁆ (x.1, mask.symm x.2) :=
begin
  simp only [eval_dist_simulate_mask, pmf.map_apply],
  refine (tsum_eq_single (x.1, mask.symm x.2) $ λ y hy, _).trans _,
  { have : x ≠ prod.map id ⇑mask y := λ hx, hy (by rw [hx, prod.map_fst, prod.map_snd,
      equiv.symm_apply_apply, id.def, prod.mk.eta]),
    simp_rw [this, if_false] },
  { simp only [prod.map_mk, id.def, equiv.apply_symm_apply, prod.mk.eta,
      eq_self_iff_true, if_true] }
end

@[simp]
lemma eval_dist_simulate'_mask : ⁅simulate' (so.mask_state mask) oa s'⁆ =
  ⁅simulate' so oa (mask.symm s')⁆ :=
by simp_rw [eval_dist_simulate', eval_dist_simulate_mask, pmf.map_comp,
  prod.map_fst', function.comp.left_id]

lemma eval_dist_simulate'_mask_apply : ⁅simulate' (so.mask_state mask) oa s'⁆ a =
  ⁅simulate' so oa (mask.symm s')⁆ a :=
by rw [eval_dist_simulate'_mask]

end eval_dist

section equiv

end equiv

section prob_event

@[simp]
lemma prob_event_mask_apply (e : set (spec.range i × S')) :
  ⁅e | so.mask_state mask i (t, s')⁆ = ⁅(prod.map id mask) ⁻¹' e | so i (t, mask.symm s')⁆ :=
by simpa only [mask_state_apply_eq, prob_event_map, prod_map, id.def]

/-- The probability of an event holding after masking state is the same as the
probability of the preimage of the event holding on the unmasked computation. -/
@[simp]
theorem prob_event_simulate_mask_eq_preimage (e : set (α × S')) :
  ⁅e | simulate (so.mask_state mask) oa s'⁆ =
    ⁅(prod.map id mask) ⁻¹' e | simulate so oa (mask.symm s')⁆ :=
by simp_rw [prob_event.def, eval_dist_simulate_mask, pmf.to_outer_measure_map_apply]

lemma prob_event_simulate_mask_eq_image (e : set (α × S')) :
  ⁅e | simulate (so.mask_state mask) oa s'⁆ =
    ⁅(prod.map id mask.symm) '' e | simulate so oa (mask.symm s')⁆ :=
begin
  convert (prob_event_simulate_mask_eq_preimage so mask oa s' e),
  ext x,
  simp only [prod_map, id.def, set.mem_image, set.mem_preimage],
  exact ⟨λ ⟨x', hx'⟩, by simpa only [← hx'.2, equiv.apply_symm_apply, prod.mk.eta] using hx'.1,
    λ h, ⟨(x.1, mask x.2), h, prod.eq_iff_fst_eq_snd_eq.2 ⟨rfl, equiv.symm_apply_apply _ _⟩⟩⟩
end

end prob_event

end distribution_semantics

end sim_oracle