/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.elements
import Mathlib.category_theory.single_obj
import Mathlib.group_theory.group_action.basic
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Actions as functors and as categories

From a multiplicative action M ↻ X, we can construct a functor from M to the category of
types, mapping the single object of M to X and an element `m : M` to map `X → X` given by
multiplication by `m`.
  This functor induces a category structure on X -- a special case of the category of elements.
A morphism `x ⟶ y` in this category is simply a scalar `m : M` such that `m • x = y`. In the case
where M is a group, this category is a groupoid -- the `action groupoid'.
-/

namespace category_theory

/-- A multiplicative action M ↻ X viewed as a functor mapping the single object of M to X
  and an element `m : M` to the map `X → X` given by multiplication by `m`. -/
@[simp] theorem action_as_functor_obj (M : Type u_1) [monoid M] (X : Type u) [mul_action M X] (_x : single_obj M) : functor.obj (action_as_functor M X) _x = X :=
  Eq.refl (functor.obj (action_as_functor M X) _x)

/-- A multiplicative action M ↻ X induces a category strucure on X, where a morphism
 from x to y is a scalar taking x to y. Due to implementation details, the object type
 of this category is not equal to X, but is in bijection with X. -/
def action_category (M : Type u_1) [monoid M] (X : Type u) [mul_action M X] :=
  functor.elements (action_as_functor M X)

namespace action_category

protected instance category_theory.groupoid (X : Type u) (G : Type u_1) [group G] [mul_action G X] : groupoid (action_category G X) :=
  category_theory.groupoid_of_elements (action_as_functor G X)

/-- The projection from the action category to the monoid, mapping a morphism to its
  label. -/
def π (M : Type u_1) [monoid M] (X : Type u) [mul_action M X] : action_category M X ⥤ single_obj M :=
  category_of_elements.π (action_as_functor M X)

@[simp] theorem π_map (M : Type u_1) [monoid M] (X : Type u) [mul_action M X] (p : action_category M X) (q : action_category M X) (f : p ⟶ q) : functor.map (π M X) f = subtype.val f :=
  rfl

@[simp] theorem π_obj (M : Type u_1) [monoid M] (X : Type u) [mul_action M X] (p : action_category M X) : functor.obj (π M X) p = single_obj.star M :=
  subsingleton.elim (functor.obj (π M X) p) (single_obj.star M)

/-- An object of the action category given by M ↻ X corresponds to an element of X. -/
def obj_equiv (M : Type u_1) [monoid M] (X : Type u) [mul_action M X] : X ≃ action_category M X :=
  equiv.mk (fun (x : X) => sigma.mk (single_obj.star M) x) (fun (p : action_category M X) => sigma.snd p) sorry sorry

theorem hom_as_subtype (M : Type u_1) [monoid M] (X : Type u) [mul_action M X] (p : action_category M X) (q : action_category M X) : (p ⟶ q) = Subtype fun (m : M) => m • coe_fn (equiv.symm (obj_equiv M X)) p = coe_fn (equiv.symm (obj_equiv M X)) q :=
  rfl

protected instance inhabited (M : Type u_1) [monoid M] (X : Type u) [mul_action M X] [Inhabited X] : Inhabited (action_category M X) :=
  { default := coe_fn (obj_equiv M X) Inhabited.default }

/-- The stabilizer of a point is isomorphic to the endomorphism monoid at the
  corresponding point. In fact they are definitionally equivalent. -/
def stabilizer_iso_End (M : Type u_1) [monoid M] {X : Type u} [mul_action M X] (x : X) : ↥(mul_action.stabilizer.submonoid M x) ≃* End (coe_fn (obj_equiv M X) x) :=
  mul_equiv.refl ↥(mul_action.stabilizer.submonoid M x)

@[simp] theorem stabilizer_iso_End_apply (M : Type u_1) [monoid M] {X : Type u} [mul_action M X] (x : X) (f : ↥(mul_action.stabilizer.submonoid M x)) : mul_equiv.to_fun (stabilizer_iso_End M x) f = f :=
  rfl

@[simp] theorem stabilizer_iso_End_symm_apply (M : Type u_1) [monoid M] {X : Type u} [mul_action M X] (x : X) (f : End (coe_fn (obj_equiv M X) x)) : mul_equiv.inv_fun (stabilizer_iso_End M x) f = f :=
  rfl


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/

import geometry.manifold.mfderiv
import geometry.manifold.local_invariant_properties

/-!
# Smooth functions between smooth manifolds

We define `Cⁿ` functions between smooth manifolds, as functions which are `Cⁿ` in charts, and prove
basic properties of these notions.

## Main definitions and statements

Let `M ` and `M'` be two smooth manifolds, with respect to model with corners `I` and `I'`. Let
`f : M → M'`.

* `times_cont_mdiff_within_at I I' n f s x` states that the function `f` is `Cⁿ` within the set `s`
  around the point `x`.
* `times_cont_mdiff_at I I' n f x` states that the function `f` is `Cⁿ` around `x`.
* `times_cont_mdiff_on I I' n f s` states that the function `f` is `Cⁿ` on the set `s`
* `times_cont_mdiff I I' n f` states that the function `f` is `Cⁿ`.
* `times_cont_mdiff_on.comp` gives the invariance of the `Cⁿ` property under composition
* `times_cont_mdiff_on.times_cont_mdiff_on_tangent_map_within` states that the bundled derivative
  of a `Cⁿ` function in a domain is `Cᵐ` when `m + 1 ≤ n`.
* `times_cont_mdiff.times_cont_mdiff_tangent_map` states that the bundled derivative
  of a `Cⁿ` function is `Cᵐ` when `m + 1 ≤ n`.
* `times_cont_mdiff_iff_times_cont_diff` states that, for functions between vector spaces,
  manifold-smoothness is equivalent to usual smoothness.

We also give many basic properties of smooth functions between manifolds, following the API of
smooth functions between vector spaces.

## Implementation details

Many properties follow for free from the corresponding properties of functions in vector spaces,
as being `Cⁿ` is a local property invariant under the smooth groupoid. We take advantage of the
general machinery developed in `local_invariant_properties.lean` to get these properties
automatically. For instance, the fact that being `Cⁿ` does not depend on the chart one considers
is given by `lift_prop_within_at_indep_chart`.

For this to work, the definition of `times_cont_mdiff_within_at` and friends has to
follow definitionally the setup of local invariant properties. Still, we recast the definition
in terms of extended charts in `times_cont_mdiff_on_iff` and `times_cont_mdiff_iff`.
-/

open set charted_space smooth_manifold_with_corners
open_locale topological_space manifold

/-! ### Definition of smooth functions between manifolds -/

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
{M : Type*} [topological_space M] [charted_space H M] [Is : smooth_manifold_with_corners I M]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] (I' : model_with_corners 𝕜 E' H')
{M' : Type*} [topological_space M'] [charted_space H' M'] [I's : smooth_manifold_with_corners I' M']
{f f₁ : M → M'} {s s₁ t : set M} {x : M}
{m n : with_top ℕ}

/-- Property in the model space of a model with corners of being `C^n` within at set at a point,
when read in the model vector space. This property will be lifted to manifolds to define smooth
functions between manifolds. -/
def times_cont_diff_within_at_prop (n : with_top ℕ) (f s x) : Prop :=
times_cont_diff_within_at 𝕜 n (I' ∘ f ∘ I.symm) (range I ∩ I.symm ⁻¹' s) (I x)

/-- Being `Cⁿ` in the model space is a local property, invariant under smooth maps. Therefore,
it will lift nicely to manifolds. -/
lemma times_cont_diff_within_at_local_invariant_prop (n : with_top ℕ) :
  (times_cont_diff_groupoid ∞ I).local_invariant_prop (times_cont_diff_groupoid ∞ I')
  (times_cont_diff_within_at_prop I I' n) :=
{ is_local :=
  begin
    assume s x u f u_open xu,
    have : range I ∩ I.symm ⁻¹' (s ∩ u) = (range I ∩ I.symm ⁻¹' s) ∩ I.symm ⁻¹' u,
      by simp only [inter_assoc, preimage_inter],
    rw [times_cont_diff_within_at_prop, times_cont_diff_within_at_prop, this],
    symmetry,
    apply times_cont_diff_within_at_inter,
    have : u ∈ 𝓝 (I.symm (I x)),
      by { rw [model_with_corners.left_inv], exact mem_nhds_sets u_open xu },
    apply continuous_at.preimage_mem_nhds I.continuous_symm.continuous_at this,
  end,
  right_invariance :=
  begin
    assume s x f e he hx h,
    rw times_cont_diff_within_at_prop at h ⊢,
    have : I x = (I ∘ e.symm ∘ I.symm) (I (e x)), by simp only [hx] with mfld_simps,
    rw this at h,
    have : I (e x) ∈ (I.symm) ⁻¹' e.target ∩ range ⇑I, by simp only [hx] with mfld_simps,
    have := ((mem_groupoid_of_pregroupoid.2 he).2.times_cont_diff_within_at this).of_le le_top,
    convert h.comp' this using 1,
    { ext y, simp only with mfld_simps },
    { mfld_set_tac }
  end,
  congr :=
  begin
    assume s x f g h hx hf,
    apply hf.congr,
    { assume y hy,
      simp only with mfld_simps at hy,
      simp only [h, hy] with mfld_simps },
    { simp only [hx] with mfld_simps }
  end,
  left_invariance :=
  begin
    assume s x f e' he' hs hx h,
    rw times_cont_diff_within_at_prop at h ⊢,
    have A : (I' ∘ f ∘ I.symm) (I x) ∈ (I'.symm ⁻¹' e'.source ∩ range I'),
      by simp only [hx] with mfld_simps,
    have := ((mem_groupoid_of_pregroupoid.2 he').1.times_cont_diff_within_at A).of_le le_top,
    convert this.comp h _,
    { ext y, simp only with mfld_simps },
    { assume y hy, simp only with mfld_simps at hy, simpa only [hy] with mfld_simps using hs hy.2 }
  end }

lemma times_cont_diff_within_at_local_invariant_prop_mono (n : with_top ℕ)
  ⦃s x t⦄ ⦃f : H → H'⦄ (hts : t ⊆ s) (h : times_cont_diff_within_at_prop I I' n f s x) :
  times_cont_diff_within_at_prop I I' n f t x :=
begin
  apply h.mono (λ y hy, _),
  simp only with mfld_simps at hy,
  simp only [hy, hts _] with mfld_simps
end

lemma times_cont_diff_within_at_local_invariant_prop_id (x : H) :
  times_cont_diff_within_at_prop I I ∞ id univ x :=
begin
  simp [times_cont_diff_within_at_prop],
  have : times_cont_diff_within_at 𝕜 ∞ id (range I) (I x) :=
    times_cont_diff_id.times_cont_diff_at.times_cont_diff_within_at,
  apply this.congr (λ y hy, _),
  { simp only with mfld_simps },
  { simp only [model_with_corners.right_inv I hy] with mfld_simps }
end

/-- A function is `n` times continuously differentiable within a set at a point in a manifold if
it is continuous and it is `n` times continuously differentiable in this set around this point, when
read in the preferred chart at this point. -/
def times_cont_mdiff_within_at (n : with_top ℕ) (f : M → M') (s : set M) (x : M) :=
lift_prop_within_at (times_cont_diff_within_at_prop I I' n) f s x

/-- A function is `n` times continuously differentiable at a point in a manifold if
it is continuous and it is `n` times continuously differentiable around this point, when
read in the preferred chart at this point. -/
def times_cont_mdiff_at (n : with_top ℕ) (f : M → M') (x : M) :=
times_cont_mdiff_within_at I I' n f univ x

/-- A function is `n` times continuously differentiable in a set of a manifold if it is continuous
and, for any pair of points, it is `n` times continuously differentiable on this set in the charts
around these points. -/
def times_cont_mdiff_on (n : with_top ℕ) (f : M → M') (s : set M) :=
∀ x ∈ s, times_cont_mdiff_within_at I I' n f s x

/-- A function is `n` times continuously differentiable in a manifold if it is continuous
and, for any pair of points, it is `n` times continuously differentiable in the charts
around these points. -/
def times_cont_mdiff (n : with_top ℕ) (f : M → M') :=
∀ x, times_cont_mdiff_at I I' n f x

/-! ### Basic properties of smooth functions between manifolds -/

variables {I I'}

lemma times_cont_mdiff.times_cont_mdiff_at (h : times_cont_mdiff I I' n f) :
  times_cont_mdiff_at I I' n f x :=
h x

lemma times_cont_mdiff_within_at_univ :
  times_cont_mdiff_within_at I I' n f univ x ↔ times_cont_mdiff_at I I' n f x :=
iff.rfl

lemma times_cont_mdiff_on_univ :
  times_cont_mdiff_on I I' n f univ ↔ times_cont_mdiff I I' n f :=
by simp only [times_cont_mdiff_on, times_cont_mdiff, times_cont_mdiff_within_at_univ,
  forall_prop_of_true, mem_univ]

include Is I's

/-- One can reformulate smoothness on a set as continuity on this set, and smoothness in any
extended chart. -/
lemma times_cont_mdiff_on_iff :
  times_cont_mdiff_on I I' n f s ↔ continuous_on f s ∧
    ∀ (x : M) (y : M'), times_cont_diff_on 𝕜 n ((ext_chart_at I' y) ∘ f ∘ (ext_chart_at I x).symm)
    ((ext_chart_at I x).target ∩ (ext_chart_at I x).symm ⁻¹' (s ∩ f ⁻¹' (ext_chart_at I' y).source)) :=
begin
  split,
  { assume h,
    refine ⟨λ x hx, (h x hx).1, λ x y z hz, _⟩,
    simp only with mfld_simps at hz,
    let w := (ext_chart_at I x).symm z,
    have : w ∈ s, by simp only [w, hz] with mfld_simps,
    specialize h w this,
    have w1 : w ∈ (chart_at H x).source, by simp only [w, hz] with mfld_simps,
    have w2 : f w ∈ (chart_at H' y).source, by simp only [w, hz] with mfld_simps,
    convert (((times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_indep_chart
      (structure_groupoid.chart_mem_maximal_atlas _ x) w1
      (structure_groupoid.chart_mem_maximal_atlas _ y) w2).1 h).2 using 1,
    { mfld_set_tac },
    { simp only [w, hz] with mfld_simps } },
  { rintros ⟨hcont, hdiff⟩ x hx,
    refine ⟨hcont x hx, _⟩,
    have Z := hdiff x (f x) (ext_chart_at I x x) (by simp only [hx] with mfld_simps),
    dsimp [times_cont_diff_within_at_prop],
    convert Z using 1,
    mfld_set_tac }
end

/-- One can reformulate smoothness as continuity and smoothness in any extended chart. -/
lemma times_cont_mdiff_iff :
  times_cont_mdiff I I' n f ↔ continuous f ∧
    ∀ (x : M) (y : M'), times_cont_diff_on 𝕜 n ((ext_chart_at I' y) ∘ f ∘ (ext_chart_at I x).symm)
    ((ext_chart_at I x).target ∩ (ext_chart_at I x).symm ⁻¹' (f ⁻¹' (ext_chart_at I' y).source)) :=
by simp [← times_cont_mdiff_on_univ, times_cont_mdiff_on_iff, continuous_iff_continuous_on_univ]

omit Is I's

/-! ### Deducing smoothness from higher smoothness -/

lemma times_cont_mdiff_within_at.of_le (hf : times_cont_mdiff_within_at I I' n f s x) (le : m ≤ n) :
  times_cont_mdiff_within_at I I' m f s x :=
⟨hf.1, hf.2.of_le le⟩

lemma times_cont_mdiff_at.of_le (hf : times_cont_mdiff_at I I' n f x) (le : m ≤ n) :
  times_cont_mdiff_at I I' m f x :=
times_cont_mdiff_within_at.of_le hf le

lemma times_cont_mdiff_on.of_le (hf : times_cont_mdiff_on I I' n f s) (le : m ≤ n) :
  times_cont_mdiff_on I I' m f s :=
λ x hx, (hf x hx).of_le le

lemma times_cont_mdiff.of_le (hf : times_cont_mdiff I I' n f) (le : m ≤ n) :
  times_cont_mdiff I I' m f :=
λ x, (hf x).of_le le

/-! ### Deducing smoothness from smoothness one step beyond -/

lemma times_cont_mdiff_within_at.of_succ {n : ℕ} (h : times_cont_mdiff_within_at I I' n.succ f s x) :
  times_cont_mdiff_within_at I I' n f s x :=
h.of_le (with_top.coe_le_coe.2 (nat.le_succ n))

lemma times_cont_mdiff_at.of_succ {n : ℕ} (h : times_cont_mdiff_at I I' n.succ f x) :
  times_cont_mdiff_at I I' n f x :=
times_cont_mdiff_within_at.of_succ h

lemma times_cont_mdiff_on.of_succ {n : ℕ} (h : times_cont_mdiff_on I I' n.succ f s) :
  times_cont_mdiff_on I I' n f s :=
λ x hx, (h x hx).of_succ

lemma times_cont_mdiff.of_succ {n : ℕ} (h : times_cont_mdiff I I' n.succ f) :
  times_cont_mdiff I I' n f :=
λ x, (h x).of_succ

/-! ### Deducing continuity from smoothness-/

lemma times_cont_mdiff_within_at.continuous_within_at
  (hf : times_cont_mdiff_within_at I I' n f s x) : continuous_within_at f s x :=
hf.1

lemma times_cont_mdiff_at.continuous_at
  (hf : times_cont_mdiff_at I I' n f x) : continuous_at f x :=
(continuous_within_at_univ _ _ ).1 $ times_cont_mdiff_within_at.continuous_within_at hf

lemma times_cont_mdiff_on.continuous_on
  (hf : times_cont_mdiff_on I I' n f s) : continuous_on f s :=
λ x hx, (hf x hx).continuous_within_at

lemma times_cont_mdiff.continuous (hf : times_cont_mdiff I I' n f) :
  continuous f :=
continuous_iff_continuous_at.2 $ λ x, (hf x).continuous_at

/-! ### Deducing differentiability from smoothness -/

lemma times_cont_mdiff_within_at.mdifferentiable_within_at
  (hf : times_cont_mdiff_within_at I I' n f s x) (hn : 1 ≤ n) :
  mdifferentiable_within_at I I' f s x :=
begin
  suffices h : mdifferentiable_within_at I I' f (s ∩ (f ⁻¹' (ext_chart_at I' (f x)).source)) x,
  { rwa mdifferentiable_within_at_inter' at h,
    apply (hf.1).preimage_mem_nhds_within,
    exact mem_nhds_sets (ext_chart_at_open_source I' (f x)) (mem_ext_chart_source I' (f x)) },
  rw mdifferentiable_within_at_iff,
  exact ⟨hf.1.mono (inter_subset_left _ _),
    (hf.2.differentiable_within_at hn).mono (by mfld_set_tac)⟩,
end

lemma times_cont_mdiff_at.mdifferentiable_at (hf : times_cont_mdiff_at I I' n f x) (hn : 1 ≤ n) :
  mdifferentiable_at I I' f x :=
mdifferentiable_within_at_univ.1 $ times_cont_mdiff_within_at.mdifferentiable_within_at hf hn

lemma times_cont_mdiff_on.mdifferentiable_on (hf : times_cont_mdiff_on I I' n f s) (hn : 1 ≤ n) :
  mdifferentiable_on I I' f s :=
λ x hx, (hf x hx).mdifferentiable_within_at hn

lemma times_cont_mdiff.mdifferentiable (hf : times_cont_mdiff I I' n f) (hn : 1 ≤ n) :
  mdifferentiable I I' f :=
λ x, (hf x).mdifferentiable_at hn

/-! ### `C^∞` smoothness -/

lemma times_cont_mdiff_within_at_top :
  times_cont_mdiff_within_at I I' ∞ f s x ↔ (∀n:ℕ, times_cont_mdiff_within_at I I' n f s x) :=
⟨λ h n, ⟨h.1, times_cont_diff_within_at_top.1 h.2 n⟩,
 λ H, ⟨(H 0).1, times_cont_diff_within_at_top.2 (λ n, (H n).2)⟩⟩

lemma times_cont_mdiff_at_top :
  times_cont_mdiff_at I I' ∞ f x ↔ (∀n:ℕ, times_cont_mdiff_at I I' n f x) :=
times_cont_mdiff_within_at_top

lemma times_cont_mdiff_on_top :
  times_cont_mdiff_on I I' ∞ f s ↔ (∀n:ℕ, times_cont_mdiff_on I I' n f s) :=
⟨λ h n, h.of_le le_top, λ h x hx, times_cont_mdiff_within_at_top.2 (λ n, h n x hx)⟩

lemma times_cont_mdiff_top :
  times_cont_mdiff I I' ∞ f ↔ (∀n:ℕ, times_cont_mdiff I I' n f) :=
⟨λ h n, h.of_le le_top, λ h x, times_cont_mdiff_within_at_top.2 (λ n, h n x)⟩

lemma times_cont_mdiff_within_at_iff_nat :
  times_cont_mdiff_within_at I I' n f s x ↔
  (∀m:ℕ, (m : with_top ℕ) ≤ n → times_cont_mdiff_within_at I I' m f s x) :=
begin
  refine ⟨λ h m hm, h.of_le hm, λ h, _⟩,
  cases n,
  { exact times_cont_mdiff_within_at_top.2 (λ n, h n le_top) },
  { exact h n (le_refl _) }
end

/-! ### Restriction to a smaller set -/

lemma times_cont_mdiff_within_at.mono (hf : times_cont_mdiff_within_at I I' n f s x) (hts : t ⊆ s) :
  times_cont_mdiff_within_at I I' n f t x :=
structure_groupoid.local_invariant_prop.lift_prop_within_at_mono
  (times_cont_diff_within_at_local_invariant_prop_mono I I' n) hf hts

lemma times_cont_mdiff_at.times_cont_mdiff_within_at (hf : times_cont_mdiff_at I I' n f x) :
  times_cont_mdiff_within_at I I' n f s x :=
times_cont_mdiff_within_at.mono hf (subset_univ _)

lemma times_cont_mdiff_on.mono (hf : times_cont_mdiff_on I I' n f s) (hts : t ⊆ s) :
  times_cont_mdiff_on I I' n f t :=
λ x hx, (hf x (hts hx)).mono hts

lemma times_cont_mdiff.times_cont_mdiff_on (hf : times_cont_mdiff I I' n f) :
  times_cont_mdiff_on I I' n f s :=
λ x hx, (hf x).times_cont_mdiff_within_at

lemma times_cont_mdiff_within_at_inter' (ht : t ∈ nhds_within x s) :
  times_cont_mdiff_within_at I I' n f (s ∩ t) x ↔ times_cont_mdiff_within_at I I' n f s x :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_inter' ht

lemma times_cont_mdiff_within_at_inter (ht : t ∈ 𝓝 x) :
  times_cont_mdiff_within_at I I' n f (s ∩ t) x ↔ times_cont_mdiff_within_at I I' n f s x :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_inter ht

lemma times_cont_mdiff_within_at.times_cont_mdiff_at
  (h : times_cont_mdiff_within_at I I' n f s x) (ht : s ∈ 𝓝 x) :
  times_cont_mdiff_at I I' n f x :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_at_of_lift_prop_within_at h ht

include Is I's

/-- A function is `C^n` within a set at a point, for `n : ℕ`, if and only if it is `C^n` on
a neighborhood of this point. -/
lemma times_cont_mdiff_within_at_iff_times_cont_mdiff_on_nhds {n : ℕ} :
  times_cont_mdiff_within_at I I' n f s x ↔
  ∃ u ∈ nhds_within x (insert x s), times_cont_mdiff_on I I' n f u :=
begin
  split,
  { assume h,
    -- the property is true in charts. We will pull such a good neighborhood in the chart to the
    -- manifold. For this, we need to restrict to a small enough set where everything makes sense
    obtain ⟨o, o_open, xo, ho, h'o⟩ : ∃ (o : set M),
      is_open o ∧ x ∈ o ∧ o ⊆ (chart_at H x).source ∧ o ∩ s ⊆ f ⁻¹' (chart_at H' (f x)).source,
    { have : (chart_at H' (f x)).source ∈ 𝓝 (f x) :=
        mem_nhds_sets (local_homeomorph.open_source _) (mem_chart_source H' (f x)),
      rcases mem_nhds_within.1 (h.1.preimage_mem_nhds_within this) with ⟨u, u_open, xu, hu⟩,
      refine ⟨u ∩ (chart_at H x).source, _, ⟨xu, mem_chart_source _ _⟩, _, _⟩,
      { exact is_open_inter u_open (local_homeomorph.open_source _) },
      { assume y hy, exact hy.2 },
      { assume y hy, exact hu ⟨hy.1.1, hy.2⟩ } },
    have h' : times_cont_mdiff_within_at I I' n f (s ∩ o) x := h.mono (inter_subset_left _ _),
    simp only [times_cont_mdiff_within_at, lift_prop_within_at, times_cont_diff_within_at_prop] at h',
    -- let `u` be a good neighborhood in the chart where the function is smooth
    rcases h.2.times_cont_diff_on (le_refl _) with ⟨u, u_nhds, u_subset, hu⟩,
    -- pull it back to the manifold, and intersect with a suitable neighborhood of `x`, to get the
    -- desired good neighborhood `v`.
    let v := ((insert x s) ∩ o) ∩ (ext_chart_at I x) ⁻¹' u,
    have v_incl : v ⊆ (chart_at H x).source := λ y hy, ho hy.1.2,
    have v_incl' : ∀ y ∈ v, f y ∈ (chart_at H' (f x)).source,
    { assume y hy,
      rcases hy.1.1 with rfl|h',
      { simp only with mfld_simps },
      { apply h'o ⟨hy.1.2, h'⟩ } },
    refine ⟨v, _, _⟩,
    show v ∈ nhds_within x (insert x s),
    { rw nhds_within_restrict _ xo o_open,
      refine filter.inter_mem_sets self_mem_nhds_within _,
      suffices : u ∈ nhds_within (ext_chart_at I x x) ((ext_chart_at I x) '' (insert x s ∩ o)),
        from (ext_chart_at_continuous_at I x).continuous_within_at.preimage_mem_nhds_within' this,
      apply nhds_within_mono _ _ u_nhds,
      rw image_subset_iff,
      assume y hy,
      rcases hy.1 with rfl|h',
      { simp only [mem_insert_iff] with mfld_simps },
      { simp only [mem_insert_iff, ho hy.2, h', h'o ⟨hy.2, h'⟩] with mfld_simps } },
    show times_cont_mdiff_on I I' n f v,
    { assume y hy,
      apply (((times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_indep_chart
        (structure_groupoid.chart_mem_maximal_atlas _ x) (v_incl hy)
        (structure_groupoid.chart_mem_maximal_atlas _ (f x)) (v_incl' y hy))).2,
      split,
      { apply (((ext_chart_at_continuous_on_symm I' (f x) _ _).comp'
          (hu _ hy.2).continuous_within_at).comp' (ext_chart_at_continuous_on I x _ _)).congr_mono,
        { assume z hz,
          simp only [v_incl hz, v_incl' z hz] with mfld_simps },
        { assume z hz,
          simp only [v_incl hz, v_incl' z hz] with mfld_simps,
          exact hz.2 },
        { simp only [v_incl hy, v_incl' y hy] with mfld_simps },
        { simp only [v_incl hy, v_incl' y hy] with mfld_simps },
        { simp only [v_incl hy] with mfld_simps } },
      { apply hu.mono,
        { assume z hz,
          simp only [v] with mfld_simps at hz,
          have : I ((chart_at H x) (((chart_at H x).symm) (I.symm z))) ∈ u, by simp only [hz],
          simpa only [hz] with mfld_simps using this },
        { have exty : I (chart_at H x y) ∈ u := hy.2,
          simp only [v_incl hy, v_incl' y hy, exty, hy.1.1, hy.1.2] with mfld_simps } } } },
  { rintros ⟨u, u_nhds, hu⟩,
    have : times_cont_mdiff_within_at I I' ↑n f (insert x s ∩ u) x,
    { have : x ∈ insert x s := mem_insert x s,
      exact hu.mono (inter_subset_right _ _) _ ⟨this, mem_of_mem_nhds_within this u_nhds⟩ },
    rw times_cont_mdiff_within_at_inter' u_nhds at this,
    exact this.mono (subset_insert x s) }
end

/-- A function is `C^n` at a point, for `n : ℕ`, if and only if it is `C^n` on
a neighborhood of this point. -/
lemma times_cont_mdiff_at_iff_times_cont_mdiff_on_nhds {n : ℕ} :
  times_cont_mdiff_at I I' n f x ↔ ∃ u ∈ 𝓝 x, times_cont_mdiff_on I I' n f u :=
by simp [← times_cont_mdiff_within_at_univ, times_cont_mdiff_within_at_iff_times_cont_mdiff_on_nhds,
  nhds_within_univ]

omit Is I's

/-! ### Congruence lemmas -/

lemma times_cont_mdiff_within_at.congr
  (h : times_cont_mdiff_within_at I I' n f s x) (h₁ : ∀ y ∈ s, f₁ y = f y)
  (hx : f₁ x = f x) : times_cont_mdiff_within_at I I' n f₁ s x :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_congr h h₁ hx

lemma times_cont_mdiff_within_at_congr (h₁ : ∀ y ∈ s, f₁ y = f y) (hx : f₁ x = f x) :
  times_cont_mdiff_within_at I I' n f₁ s x ↔ times_cont_mdiff_within_at I I' n f s x :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_congr_iff h₁ hx

lemma times_cont_mdiff_within_at.congr_of_eventually_eq
  (h : times_cont_mdiff_within_at I I' n f s x) (h₁ : f₁ =ᶠ[nhds_within x s] f)
  (hx : f₁ x = f x) : times_cont_mdiff_within_at I I' n f₁ s x :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_congr_of_eventually_eq
  h h₁ hx

lemma filter.eventually_eq.times_cont_mdiff_within_at_iff
  (h₁ : f₁ =ᶠ[nhds_within x s] f) (hx : f₁ x = f x) :
  times_cont_mdiff_within_at I I' n f₁ s x ↔ times_cont_mdiff_within_at I I' n f s x :=
(times_cont_diff_within_at_local_invariant_prop I I' n)
  .lift_prop_within_at_congr_iff_of_eventually_eq h₁ hx

lemma times_cont_mdiff_at.congr_of_eventually_eq
  (h : times_cont_mdiff_at I I' n f x) (h₁ : f₁ =ᶠ[𝓝 x] f) :
  times_cont_mdiff_at I I' n f₁ x :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_at_congr_of_eventually_eq h h₁

lemma filter.eventually_eq.times_cont_mdiff_at_iff (h₁ : f₁ =ᶠ[𝓝 x] f) :
  times_cont_mdiff_at I I' n f₁ x ↔ times_cont_mdiff_at I I' n f x :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_at_congr_iff_of_eventually_eq h₁

lemma times_cont_mdiff_on.congr (h : times_cont_mdiff_on I I' n f s) (h₁ : ∀ y ∈ s, f₁ y = f y) :
  times_cont_mdiff_on I I' n f₁ s :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_on_congr h h₁

lemma times_cont_mdiff_on_congr (h₁ : ∀ y ∈ s, f₁ y = f y) :
  times_cont_mdiff_on I I' n f₁ s ↔ times_cont_mdiff_on I I' n f s :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_on_congr_iff h₁

/-! ### Locality -/

/-- Being `C^n` is a local property. -/
lemma times_cont_mdiff_on_of_locally_times_cont_mdiff_on
  (h : ∀x∈s, ∃u, is_open u ∧ x ∈ u ∧ times_cont_mdiff_on I I' n f (s ∩ u)) :
  times_cont_mdiff_on I I' n f s :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_on_of_locally_lift_prop_on h

lemma times_cont_mdiff_of_locally_times_cont_mdiff_on
  (h : ∀x, ∃u, is_open u ∧ x ∈ u ∧ times_cont_mdiff_on I I' n f u) :
  times_cont_mdiff I I' n f :=
(times_cont_diff_within_at_local_invariant_prop I I' n).lift_prop_of_locally_lift_prop_on h

/-! ### Smoothness of the composition of smooth functions between manifolds -/

section composition

variables {E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
{M'' : Type*} [topological_space M''] [charted_space H'' M'']
[smooth_manifold_with_corners I'' M'']

include Is I's

/-- The composition of `C^n` functions on domains is `C^n`. -/
lemma times_cont_mdiff_on.comp {t : set M'} {g : M' → M''}
  (hg : times_cont_mdiff_on I' I'' n g t) (hf : times_cont_mdiff_on I I' n f s)
  (st : s ⊆ f ⁻¹' t) : times_cont_mdiff_on I I'' n (g ∘ f) s :=
begin
  rw times_cont_mdiff_on_iff at hf hg ⊢,
  have cont_gf : continuous_on (g ∘ f) s := continuous_on.comp hg.1 hf.1 st,
  refine ⟨cont_gf, λx y, _⟩,
  apply times_cont_diff_on_of_locally_times_cont_diff_on,
  assume z hz,
  let x' := (ext_chart_at I x).symm z,
  have x'_source : x' ∈ (ext_chart_at I x).source := (ext_chart_at I x).map_target hz.1,
  obtain ⟨o, o_open, zo, o_subset⟩ : ∃ o, is_open o ∧ z ∈ o ∧
    o ∩ (((ext_chart_at I x).symm ⁻¹' s ∩ range I)) ⊆
      (ext_chart_at I x).symm ⁻¹' (f ⁻¹' (ext_chart_at I' (f x')).source),
  { have x'z : (ext_chart_at I x) x' = z, by simp only [x', hz.1, -ext_chart_at] with mfld_simps,
    have : continuous_within_at f s x' := hf.1 _ hz.2.1,
    have : f ⁻¹' (ext_chart_at I' (f x')).source ∈ nhds_within x' s :=
      this.preimage_mem_nhds_within
      (mem_nhds_sets (ext_chart_at_open_source I' (f x')) (mem_ext_chart_source I' (f x'))),
    have : (ext_chart_at I x).symm ⁻¹' (f ⁻¹' (ext_chart_at I' (f x')).source) ∈
      nhds_within ((ext_chart_at I x) x') ((ext_chart_at I x).symm ⁻¹' s ∩ range I) :=
      ext_chart_preimage_mem_nhds_within' _ _ x'_source this,
    rw x'z at this,
    exact mem_nhds_within.1 this },
  refine ⟨o, o_open, zo, _⟩,
  let u := ((ext_chart_at I x).target ∩
         (ext_chart_at I x).symm ⁻¹' (s ∩ g ∘ f ⁻¹' (ext_chart_at I'' y).source) ∩ o),
  -- it remains to show that `g ∘ f` read in the charts is `C^n` on `u`
  have u_subset : u ⊆ (ext_chart_at I x).target ∩
    (ext_chart_at I x).symm ⁻¹' (s ∩ f ⁻¹' (ext_chart_at I' (f x')).source),
  { rintros p ⟨⟨hp₁, ⟨hp₂, hp₃⟩⟩, hp₄⟩,
    refine ⟨hp₁, ⟨hp₂, o_subset ⟨hp₄, ⟨hp₂, _⟩⟩⟩⟩,
    have := hp₁.1,
    rwa model_with_corners.target at this },
  have : times_cont_diff_on 𝕜 n (((ext_chart_at I'' y) ∘ g ∘ (ext_chart_at I' (f x')).symm) ∘
    ((ext_chart_at I' (f x')) ∘ f ∘ (ext_chart_at I x).symm)) u,
  { refine times_cont_diff_on.comp (hg.2 (f x') y) ((hf.2 x (f x')).mono u_subset) (λp hp, _),
    simp only [local_equiv.map_source _ (u_subset hp).2.2, local_equiv.left_inv _ (u_subset hp).2.2,
      -ext_chart_at] with mfld_simps,
    exact ⟨st (u_subset hp).2.1, hp.1.2.2⟩ },
  refine this.congr (λp hp, _),
  simp only [local_equiv.left_inv _ (u_subset hp).2.2, -ext_chart_at] with mfld_simps
end

/-- The composition of `C^n` functions on domains is `C^n`. -/
lemma times_cont_mdiff_on.comp' {t : set M'} {g : M' → M''}
  (hg : times_cont_mdiff_on I' I'' n g t) (hf : times_cont_mdiff_on I I' n f s) :
  times_cont_mdiff_on I I'' n (g ∘ f) (s ∩ f ⁻¹' t) :=
hg.comp (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _)

/-- The composition of `C^n` functions is `C^n`. -/
lemma times_cont_mdiff.comp {g : M' → M''}
  (hg : times_cont_mdiff I' I'' n g) (hf : times_cont_mdiff I I' n f) :
  times_cont_mdiff I I'' n (g ∘ f) :=
begin
  rw ← times_cont_mdiff_on_univ at hf hg ⊢,
  exact hg.comp hf subset_preimage_univ,
end

/-- The composition of `C^n` functions within domains at points is `C^n`. -/
lemma times_cont_mdiff_within_at.comp {t : set M'} {g : M' → M''}
  (hg : times_cont_mdiff_within_at I' I'' n g t (f x))
  (hf : times_cont_mdiff_within_at I I' n f s x)
  (st : s ⊆ f ⁻¹' t) : times_cont_mdiff_within_at I I'' n (g ∘ f) s x :=
begin
  apply times_cont_mdiff_within_at_iff_nat.2 (λ m hm, _),
  rcases times_cont_mdiff_within_at_iff_times_cont_mdiff_on_nhds.1 (hg.of_le hm) with ⟨v, v_nhds, hv⟩,
  rcases times_cont_mdiff_within_at_iff_times_cont_mdiff_on_nhds.1 (hf.of_le hm) with ⟨u, u_nhds, hu⟩,
  apply times_cont_mdiff_within_at_iff_times_cont_mdiff_on_nhds.2 ⟨_, _, hv.comp' hu⟩,
  apply filter.inter_mem_sets u_nhds,
  suffices h : v ∈ nhds_within (f x) (f '' s),
  { convert mem_nhds_within_insert (hf.continuous_within_at.preimage_mem_nhds_within' h),
    rw insert_eq_of_mem,
    apply mem_of_mem_nhds_within (mem_insert (f x) t) v_nhds },
  apply nhds_within_mono _ _ v_nhds,
  rw image_subset_iff,
  exact subset.trans st (preimage_mono (subset_insert _ _))
end

/-- The composition of `C^n` functions within domains at points is `C^n`. -/
lemma times_cont_mdiff_within_at.comp' {t : set M'} {g : M' → M''}
  (hg : times_cont_mdiff_within_at I' I'' n g t (f x))
  (hf : times_cont_mdiff_within_at I I' n f s x) :
  times_cont_mdiff_within_at I I'' n (g ∘ f) (s ∩ f⁻¹' t) x :=
hg.comp (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _)

/-- The composition of `C^n` functions at points is `C^n`. -/
lemma times_cont_mdiff_at.comp {g : M' → M''}
  (hg : times_cont_mdiff_at I' I'' n g (f x)) (hf : times_cont_mdiff_at I I' n f x) :
  times_cont_mdiff_at I I'' n (g ∘ f) x :=
hg.comp hf subset_preimage_univ

end composition

/-! ### Atlas members are smooth -/
section atlas

variables {e : local_homeomorph M H}
include Is

/-- An atlas member is `C^n` for any `n`. -/
lemma times_cont_mdiff_on_of_mem_maximal_atlas
  (h : e ∈ maximal_atlas I M) : times_cont_mdiff_on I I n e e.source :=
times_cont_mdiff_on.of_le
  ((times_cont_diff_within_at_local_invariant_prop I I ∞).lift_prop_on_of_mem_maximal_atlas
    (times_cont_diff_within_at_local_invariant_prop_id I) h) le_top

/-- The inverse of an atlas member is `C^n` for any `n`. -/
lemma times_cont_mdiff_on_symm_of_mem_maximal_atlas
  (h : e ∈ maximal_atlas I M) : times_cont_mdiff_on I I n e.symm e.target :=
times_cont_mdiff_on.of_le
  ((times_cont_diff_within_at_local_invariant_prop I I ∞).lift_prop_on_symm_of_mem_maximal_atlas
    (times_cont_diff_within_at_local_invariant_prop_id I) h) le_top

lemma times_cont_mdiff_on_chart :
  times_cont_mdiff_on I I n (chart_at H x) (chart_at H x).source :=
times_cont_mdiff_on_of_mem_maximal_atlas
  ((times_cont_diff_groupoid ⊤ I).chart_mem_maximal_atlas x)

lemma times_cont_mdiff_on_chart_symm :
  times_cont_mdiff_on I I n (chart_at H x).symm (chart_at H x).target :=
times_cont_mdiff_on_symm_of_mem_maximal_atlas
  ((times_cont_diff_groupoid ⊤ I).chart_mem_maximal_atlas x)

end atlas

/-! ### The identity is smooth -/
section id

lemma times_cont_mdiff_id : times_cont_mdiff I I n (id : M → M) :=
times_cont_mdiff.of_le ((times_cont_diff_within_at_local_invariant_prop I I ∞).lift_prop_id
  (times_cont_diff_within_at_local_invariant_prop_id I)) le_top

lemma times_cont_mdiff_on_id : times_cont_mdiff_on I I n (id : M → M) s :=
times_cont_mdiff_id.times_cont_mdiff_on

lemma times_cont_mdiff_at_id : times_cont_mdiff_at I I n (id : M → M) x :=
times_cont_mdiff_id.times_cont_mdiff_at

lemma times_cont_mdiff_within_at_id : times_cont_mdiff_within_at I I n (id : M → M) s x :=
times_cont_mdiff_at_id.times_cont_mdiff_within_at

end id

/-! ### Constants are smooth -/
section id

variable {c : M'}

lemma times_cont_mdiff_const : times_cont_mdiff I I' n (λ (x : M), c) :=
begin
  assume x,
  refine ⟨continuous_within_at_const, _⟩,
  simp only [times_cont_diff_within_at_prop, (∘)],
  exact times_cont_diff_within_at_const,
end

lemma times_cont_mdiff_on_const : times_cont_mdiff_on I I' n (λ (x : M), c) s :=
times_cont_mdiff_const.times_cont_mdiff_on

lemma times_cont_mdiff_at_const : times_cont_mdiff_at I I' n (λ (x : M), c) x :=
times_cont_mdiff_const.times_cont_mdiff_at

lemma times_cont_mdiff_within_at_const : times_cont_mdiff_within_at I I' n (λ (x : M), c) s x :=
times_cont_mdiff_at_const.times_cont_mdiff_within_at

end id

/-! ### Equivalence with the basic definition for functions between vector spaces -/

section vector_space

lemma times_cont_mdiff_within_at_iff_times_cont_diff_within_at {f : E → E'} {s : set E} {x : E} :
  times_cont_mdiff_within_at (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') n f s x
  ↔ times_cont_diff_within_at 𝕜 n f s x :=
begin
  simp only [times_cont_mdiff_within_at, lift_prop_within_at, times_cont_diff_within_at_prop,
    iff_def] with mfld_simps {contextual := tt},
  exact times_cont_diff_within_at.continuous_within_at
end

lemma times_cont_mdiff_at_iff_times_cont_diff_at {f : E → E'} {x : E} :
  times_cont_mdiff_at (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') n f x
  ↔ times_cont_diff_at 𝕜 n f x :=
by rw [← times_cont_mdiff_within_at_univ,
  times_cont_mdiff_within_at_iff_times_cont_diff_within_at, times_cont_diff_within_at_univ]

lemma times_cont_mdiff_on_iff_times_cont_diff_on {f : E → E'} {s : set E} :
  times_cont_mdiff_on (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') n f s
  ↔ times_cont_diff_on 𝕜 n f s :=
forall_congr $ by simp [times_cont_mdiff_within_at_iff_times_cont_diff_within_at]

lemma times_cont_mdiff_iff_times_cont_diff {f : E → E'} :
  times_cont_mdiff (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') n f
  ↔ times_cont_diff 𝕜 n f :=
by rw [← times_cont_diff_on_univ, ← times_cont_mdiff_on_univ,
  times_cont_mdiff_on_iff_times_cont_diff_on]

end vector_space

/-! ### The tangent map of a smooth function is smooth -/

section tangent_map

/-- If a function is `C^n` with `1 ≤ n` on a domain with unique derivatives, then its bundled
derivative is continuous. In this auxiliary lemma, we prove this fact when the source and target
space are model spaces in models with corners. The general fact is proved in
`times_cont_mdiff_on.continuous_on_tangent_map_within`-/
lemma times_cont_mdiff_on.continuous_on_tangent_map_within_aux
  {f : H → H'} {s : set H}
  (hf : times_cont_mdiff_on I I' n f s) (hn : 1 ≤ n) (hs : unique_mdiff_on I s) :
  continuous_on (tangent_map_within I I' f s) ((tangent_bundle.proj I H) ⁻¹' s) :=
begin
  suffices h : continuous_on (λ (p : H × E), (f p.fst,
    (fderiv_within 𝕜 (written_in_ext_chart_at I I' p.fst f) (I.symm ⁻¹' s ∩ range I)
      ((ext_chart_at I p.fst) p.fst) : E →L[𝕜] E') p.snd)) (prod.fst ⁻¹' s),
  { have : ∀ (p : tangent_bundle I H), p ∈ tangent_bundle.proj I H ⁻¹' s →
      tangent_map_within I I' f s p =
      (f p.fst, ((fderiv_within 𝕜 (written_in_ext_chart_at I I' p.fst f)
      (I.symm ⁻¹' s ∩ range I) ((ext_chart_at I p.fst) p.fst)) : E →L[𝕜] E') p.snd),
    { rintros ⟨x, v⟩ hx,
      dsimp [tangent_map_within],
      ext, { refl },
      dsimp,
      apply congr_fun,
      apply congr_arg,
      rw mdifferentiable_within_at.mfderiv_within (hf.mdifferentiable_on hn x hx),
      refl },
    convert h.congr this,
    exact tangent_bundle_model_space_topology_eq_prod H I,
    exact tangent_bundle_model_space_topology_eq_prod H' I' },
  suffices h : continuous_on (λ (p : H × E), (fderiv_within 𝕜 (I' ∘ f ∘ I.symm)
    (I.symm ⁻¹' s ∩ range I) (I p.fst) : E →L[𝕜] E') p.snd) (prod.fst ⁻¹' s),
  { dsimp [written_in_ext_chart_at, ext_chart_at],
    apply continuous_on.prod
      (continuous_on.comp hf.continuous_on continuous_fst.continuous_on (subset.refl _)),
    apply h.congr,
    assume p hp,
    refl },
  suffices h : continuous_on (fderiv_within 𝕜 (I' ∘ f ∘ I.symm)
                     (I.symm ⁻¹' s ∩ range I)) (I '' s),
  { have C := continuous_on.comp h I.continuous_to_fun.continuous_on (subset.refl _),
    have A : continuous (λq : (E →L[𝕜] E') × E, q.1 q.2) := is_bounded_bilinear_map_apply.continuous,
    have B : continuous_on (λp : H × E,
      (fderiv_within 𝕜 (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I)
                       (I p.1), p.2)) (prod.fst ⁻¹' s),
    { apply continuous_on.prod _ continuous_snd.continuous_on,
      refine (continuous_on.comp C continuous_fst.continuous_on _ : _),
      exact preimage_mono (subset_preimage_image _ _) },
    exact A.comp_continuous_on B },
  rw times_cont_mdiff_on_iff at hf,
  let x : H := I.symm (0 : E),
  let y : H' := I'.symm (0 : E'),
  have A := hf.2 x y,
  simp only [I.image, inter_comm] with mfld_simps at A ⊢,
  apply A.continuous_on_fderiv_within _ hn,
  convert hs.unique_diff_on x using 1,
  simp only [inter_comm] with mfld_simps
end

/-- If a function is `C^n` on a domain with unique derivatives, then its bundled derivative is
`C^m` when `m+1 ≤ n`. In this auxiliary lemma, we prove this fact when the source and target space
are model spaces in models with corners. The general fact is proved in
`times_cont_mdiff_on.times_cont_mdiff_on_tangent_map_within` -/
lemma times_cont_mdiff_on.times_cont_mdiff_on_tangent_map_within_aux
  {f : H → H'} {s : set H}
  (hf : times_cont_mdiff_on I I' n f s) (hmn : m + 1 ≤ n) (hs : unique_mdiff_on I s) :
  times_cont_mdiff_on I.tangent I'.tangent m (tangent_map_within I I' f s)
    ((tangent_bundle.proj I H) ⁻¹' s) :=
begin
  have m_le_n : m ≤ n,
  { apply le_trans _ hmn,
    have : m + 0 ≤ m + 1 := add_le_add_left (zero_le _) _,
    simpa only [add_zero] using this },
  have one_le_n : 1 ≤ n,
  { apply le_trans _ hmn,
    change 0 + 1 ≤ m + 1,
    exact add_le_add_right (zero_le _) _ },
  have U': unique_diff_on 𝕜 (range I ∩ I.symm ⁻¹' s),
  { assume y hy,
    simpa only [unique_mdiff_on, unique_mdiff_within_at, hy.1, inter_comm] with mfld_simps
      using hs (I.symm y) hy.2 },
  have U : unique_diff_on 𝕜 (set.prod (range I ∩ I.symm ⁻¹' s) (univ : set E)) :=
    U'.prod unique_diff_on_univ,
  rw times_cont_mdiff_on_iff,
  refine ⟨hf.continuous_on_tangent_map_within_aux one_le_n hs, λp q, _⟩,
  have A : (λ (p : E × E), (I.symm p.1, p.2)) ⁻¹' (tangent_bundle.proj I H ⁻¹' s)
           = set.prod (I.symm ⁻¹' s) univ,
    by { ext p, simp only [tangent_bundle.proj] with mfld_simps },
  -- unfold the definitions to reduce to a statement on vector spaces
  suffices h : times_cont_diff_on 𝕜 m
    ((λ (p : H' × E'), (I' p.1, p.2)) ∘ tangent_map_within I I' f s ∘
      (λ (p : E × E), (I.symm p.1, p.2))) (set.prod (range I ∩ I.symm ⁻¹' s) univ),
  by simp only [@local_equiv.refl_symm (model_prod H E), @local_equiv.refl_target (model_prod H E),
    @local_equiv.refl_source (model_prod H' E'), h, A] with mfld_simps,
  change times_cont_diff_on 𝕜 m (λ (p : E × E),
    ((I' (f (I.symm p.fst)), ((mfderiv_within I I' f s (I.symm p.fst)) : E → E') p.snd) : E' × E'))
    (set.prod (range I ∩ I.symm ⁻¹' s) univ),
  -- check that all bits in this formula are `C^n`
  have hf' := times_cont_mdiff_on_iff.1 hf,
  have A : times_cont_diff_on 𝕜 m (I' ∘ f ∘ I.symm) (range I ∩ I.symm ⁻¹' s) :=
    by simpa only with mfld_simps using (hf'.2 (I.symm 0) (I'.symm 0)).of_le m_le_n,
  have B : times_cont_diff_on 𝕜 m ((I' ∘ f ∘ I.symm) ∘ prod.fst)
           (set.prod (range I ∩ I.symm ⁻¹' s) (univ : set E)) :=
    A.comp (times_cont_diff_fst.times_cont_diff_on) (prod_subset_preimage_fst _ _),
  suffices C : times_cont_diff_on 𝕜 m (λ (p : E × E),
    ((fderiv_within 𝕜 (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I) p.1 : _) p.2))
    (set.prod (range I ∩ I.symm ⁻¹' s) univ),
  { apply times_cont_diff_on.prod B _,
    apply C.congr (λp hp, _),
    simp only with mfld_simps at hp,
    simp only [mfderiv_within, hf.mdifferentiable_on one_le_n _ hp.2, hp.1, dif_pos]
      with mfld_simps },
  have D : times_cont_diff_on 𝕜 m (λ x,
    (fderiv_within 𝕜 (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I) x))
    (range I ∩ I.symm ⁻¹' s),
  { have : times_cont_diff_on 𝕜 n (I' ∘ f ∘ I.symm) (range I ∩ I.symm ⁻¹' s) :=
      by simpa only with mfld_simps using (hf'.2 (I.symm 0) (I'.symm 0)),
    simpa only [inter_comm] using this.fderiv_within U' hmn },
  have := D.comp (times_cont_diff_fst.times_cont_diff_on) (prod_subset_preimage_fst _ _),
  have := times_cont_diff_on.prod this (times_cont_diff_snd.times_cont_diff_on),
  exact is_bounded_bilinear_map_apply.times_cont_diff.comp_times_cont_diff_on this,
end

include Is I's

/-- If a function is `C^n` on a domain with unique derivatives, then its bundled derivative
is `C^m` when `m+1 ≤ n`. -/
theorem times_cont_mdiff_on.times_cont_mdiff_on_tangent_map_within
  (hf : times_cont_mdiff_on I I' n f s) (hmn : m + 1 ≤ n) (hs : unique_mdiff_on I s) :
  times_cont_mdiff_on I.tangent I'.tangent m (tangent_map_within I I' f s)
  ((tangent_bundle.proj I M) ⁻¹' s) :=
begin
  /- The strategy of the proof is to avoid unfolding the definitions, and reduce by functoriality
  to the case of functions on the model spaces, where we have already proved the result.
  Let `l` and `r` be the charts to the left and to the right, so that we have
  ```
     l      f       r
  H ---> M ---> M' ---> H'
  ```
  Then the derivative `D(r ∘ f ∘ l)` is smooth by a previous result. Consider the composition
  ```
      Dl^{-1}          il      D(r ∘ f ∘ l)       ir            Dr^{-1}
  TM ---------> H × E ---> TH -------------> TH' ---> H' × E' ----------> TM'
  ```
  where `Dr^{-1}` and `Dl^{-1}` denote the charts on `TM` and `TM'` (they are smooth, by definition
  of charts) and `ir` and `il` are charts of `TH` and `TH'`, also smooth (they are the identity,
  between two types which are defeq but which carry two manifold structures which are not defeq a
  priori, which is why they are needed here). The composition of all these maps is `Df`, and is
  therefore smooth as a composition of smooth maps.
  -/
  have m_le_n : m ≤ n,
  { apply le_trans _ hmn,
    have : m + 0 ≤ m + 1 := add_le_add_left (zero_le _) _,
    simpa only [add_zero] },
  have one_le_n : 1 ≤ n,
  { apply le_trans _ hmn,
    change 0 + 1 ≤ m + 1,
    exact add_le_add_right (zero_le _) _ },
  /- First step: local reduction on the space, to a set `s'` which is contained in chart domains. -/
  refine times_cont_mdiff_on_of_locally_times_cont_mdiff_on (λp hp, _),
  have hf' := times_cont_mdiff_on_iff.1 hf,
  simp [tangent_bundle.proj] at hp,
  let l  := chart_at H p.1,
  let Dl := chart_at (model_prod H E) p,
  let r  := chart_at H' (f p.1),
  let Dr := chart_at (model_prod H' E') (tangent_map_within I I' f s p),
  let il := chart_at (model_prod H E) (tangent_map I I l p),
  let ir := chart_at (model_prod H' E') (tangent_map I I' (r ∘ f) p),
  let s' := f ⁻¹' r.source ∩ s ∩ l.source,
  let s'_lift := (tangent_bundle.proj I M)⁻¹' s',
  let s'l := l.target ∩ l.symm ⁻¹' s',
  let s'l_lift := (tangent_bundle.proj I H) ⁻¹' s'l,
  rcases continuous_on_iff'.1 hf'.1 r.source r.open_source with ⟨o, o_open, ho⟩,
  suffices h : times_cont_mdiff_on I.tangent I'.tangent m (tangent_map_within I I' f s) s'_lift,
  { refine ⟨(tangent_bundle.proj I M)⁻¹' (o ∩ l.source), _, _, _⟩,
    show is_open ((tangent_bundle.proj I M)⁻¹' (o ∩ l.source)), from
      tangent_bundle_proj_continuous _ _ _ (is_open_inter o_open l.open_source),
    show p ∈ tangent_bundle.proj I M ⁻¹' (o ∩ l.source),
    { simp [tangent_bundle.proj] at ⊢,
      have : p.1 ∈ f ⁻¹' r.source ∩ s, by simp [hp],
      rw ho at this,
      exact this.1 },
    { have : tangent_bundle.proj I M ⁻¹' s ∩ tangent_bundle.proj I M ⁻¹' (o ∩ l.source) = s'_lift,
      { dsimp only [s'_lift, s'], rw [ho], mfld_set_tac },
      rw this,
      exact h } },
  /- Second step: check that all functions are smooth, and use the chain rule to write the bundled
  derivative as a composition of a function between model spaces and of charts.
  Convention: statements about the differentiability of `a ∘ b ∘ c` are named `diff_abc`. Statements
  about differentiability in the bundle have a `_lift` suffix. -/
  have U' : unique_mdiff_on I s',
  { apply unique_mdiff_on.inter _ l.open_source,
    rw [ho, inter_comm],
    exact hs.inter o_open },
  have U'l : unique_mdiff_on I s'l :=
    U'.unique_mdiff_on_preimage (mdifferentiable_chart _ _),
  have diff_f : times_cont_mdiff_on I I' n f s' :=
    hf.mono (by mfld_set_tac),
  have diff_r : times_cont_mdiff_on I' I' n r r.source :=
    times_cont_mdiff_on_chart,
  have diff_rf : times_cont_mdiff_on I I' n (r ∘ f) s',
  { apply times_cont_mdiff_on.comp diff_r diff_f (λx hx, _),
    simp only [s'] with mfld_simps at hx, simp only [hx] with mfld_simps },
  have diff_l : times_cont_mdiff_on I I n l.symm s'l,
  { have A : times_cont_mdiff_on I I n l.symm l.target :=
      times_cont_mdiff_on_chart_symm,
    exact A.mono (by mfld_set_tac) },
  have diff_rfl : times_cont_mdiff_on I I' n (r ∘ f ∘ l.symm) s'l,
  { apply times_cont_mdiff_on.comp diff_rf diff_l,
    mfld_set_tac },
  have diff_rfl_lift : times_cont_mdiff_on I.tangent I'.tangent m
      (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l) s'l_lift :=
    diff_rfl.times_cont_mdiff_on_tangent_map_within_aux hmn U'l,
  have diff_irrfl_lift : times_cont_mdiff_on I.tangent I'.tangent m
      (ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l)) s'l_lift,
  { have A : times_cont_mdiff_on I'.tangent I'.tangent m ir ir.source := times_cont_mdiff_on_chart,
    exact times_cont_mdiff_on.comp A diff_rfl_lift (λp hp, by simp only [ir] with mfld_simps) },
  have diff_Drirrfl_lift : times_cont_mdiff_on I.tangent I'.tangent m
    (Dr.symm ∘ (ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l))) s'l_lift,
  { have A : times_cont_mdiff_on I'.tangent I'.tangent m Dr.symm Dr.target :=
      times_cont_mdiff_on_chart_symm,
    apply times_cont_mdiff_on.comp A diff_irrfl_lift (λp hp, _),
    simp only [s'l_lift, tangent_bundle.proj] with mfld_simps at hp,
    simp only [ir, @local_equiv.refl_coe (model_prod H' E'), hp] with mfld_simps },
  -- conclusion of this step: the composition of all the maps above is smooth
  have diff_DrirrflilDl : times_cont_mdiff_on I.tangent I'.tangent m
    (Dr.symm ∘ (ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l)) ∘
      (il.symm ∘ Dl)) s'_lift,
  { have A : times_cont_mdiff_on I.tangent I.tangent m Dl Dl.source := times_cont_mdiff_on_chart,
    have A' : times_cont_mdiff_on I.tangent I.tangent m Dl s'_lift,
    { apply A.mono (λp hp, _),
      simp only [s'_lift, tangent_bundle.proj] with mfld_simps at hp,
      simp only [Dl, hp] with mfld_simps },
    have B : times_cont_mdiff_on I.tangent I.tangent m il.symm il.target :=
      times_cont_mdiff_on_chart_symm,
    have C : times_cont_mdiff_on I.tangent I.tangent m (il.symm ∘ Dl) s'_lift :=
      times_cont_mdiff_on.comp B A' (λp hp, by simp only [il] with mfld_simps),
    apply times_cont_mdiff_on.comp diff_Drirrfl_lift C (λp hp, _),
    simp only [s'_lift, tangent_bundle.proj] with mfld_simps at hp,
    simp only [il, s'l_lift, hp, tangent_bundle.proj] with mfld_simps },
  /- Third step: check that the composition of all the maps indeed coincides with the derivative we
  are looking for -/
  have eq_comp : ∀q ∈ s'_lift, tangent_map_within I I' f s q =
      (Dr.symm ∘ ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l) ∘
      (il.symm ∘ Dl)) q,
  { assume q hq,
    simp only [s'_lift, tangent_bundle.proj] with mfld_simps at hq,
    have U'q : unique_mdiff_within_at I s' q.1,
      by { apply U', simp only [hq, s'] with mfld_simps },
    have U'lq : unique_mdiff_within_at I s'l (Dl q).1,
      by { apply U'l, simp only [hq, s'l] with mfld_simps },
    have A : tangent_map_within I I' ((r ∘ f) ∘ l.symm) s'l (Dl q) =
      tangent_map_within I I' (r ∘ f) s' (tangent_map_within I I l.symm s'l (Dl q)),
    { refine tangent_map_within_comp_at (Dl q) _ _ (λp hp, _) U'lq,
      { apply diff_rf.mdifferentiable_on one_le_n,
        simp only [hq] with mfld_simps },
      { apply diff_l.mdifferentiable_on one_le_n,
        simp only [s'l, hq] with mfld_simps },
      { simp only with mfld_simps at hp, simp only [hp] with mfld_simps } },
    have B : tangent_map_within I I l.symm s'l (Dl q) = q,
    { have : tangent_map_within I I l.symm s'l (Dl q) = tangent_map I I l.symm (Dl q),
      { refine tangent_map_within_eq_tangent_map U'lq _,
        refine mdifferentiable_at_atlas_symm _ (chart_mem_atlas _ _) _,
        simp only [hq] with mfld_simps },
      rw [this, tangent_map_chart_symm, local_homeomorph.left_inv];
      simp only [hq] with mfld_simps },
    have C : tangent_map_within I I' (r ∘ f) s' q
      = tangent_map_within I' I' r r.source (tangent_map_within I I' f s' q),
    { refine tangent_map_within_comp_at q _ _ (λr hr, _) U'q,
      { apply diff_r.mdifferentiable_on one_le_n,
        simp only [hq] with mfld_simps },
      { apply diff_f.mdifferentiable_on one_le_n,
        simp only [hq] with mfld_simps },
      { simp only [s'] with mfld_simps at hr,
        simp only [hr] with mfld_simps } },
    have D : Dr.symm (tangent_map_within I' I' r r.source (tangent_map_within I I' f s' q))
      = tangent_map_within I I' f s' q,
    { have A : tangent_map_within I' I' r r.source (tangent_map_within I I' f s' q) =
             tangent_map I' I' r (tangent_map_within I I' f s' q),
      { apply tangent_map_within_eq_tangent_map,
        { apply is_open.unique_mdiff_within_at _ r.open_source, simp [hq] },
        { refine mdifferentiable_at_atlas _ (chart_mem_atlas _ _) _,
          simp only [hq] with mfld_simps } },
      have : f p.1 = (tangent_map_within I I' f s p).1 := rfl,
      rw [A],
      dsimp [r, Dr],
      rw [this, tangent_map_chart, local_homeomorph.left_inv];
      simp only [hq] with mfld_simps },
    have M : tangent_map_within I I' f s' q = tangent_map_within I I' f s q,
    { refine tangent_map_within_subset (by mfld_set_tac) U'q _,
      apply hf.mdifferentiable_on one_le_n,
      simp only [hq] with mfld_simps },
    simp only [il, ir, A, B, C, D, M.symm] with mfld_simps },
  exact diff_DrirrflilDl.congr eq_comp,
end

/-- If a function is `C^n` on a domain with unique derivatives, with `1 ≤ n`, then its bundled
derivative is continuous there. -/
theorem times_cont_mdiff_on.continuous_on_tangent_map_within
  (hf : times_cont_mdiff_on I I' n f s) (hmn : 1 ≤ n) (hs : unique_mdiff_on I s) :
  continuous_on (tangent_map_within I I' f s) ((tangent_bundle.proj I M) ⁻¹' s) :=
begin
  have : times_cont_mdiff_on I.tangent I'.tangent 0 (tangent_map_within I I' f s)
         ((tangent_bundle.proj I M) ⁻¹' s) :=
    hf.times_cont_mdiff_on_tangent_map_within hmn hs,
  exact this.continuous_on
end

/-- If a function is `C^n`, then its bundled derivative is `C^m` when `m+1 ≤ n`. -/
theorem times_cont_mdiff.times_cont_mdiff_tangent_map
  (hf : times_cont_mdiff I I' n f) (hmn : m + 1 ≤ n) :
  times_cont_mdiff I.tangent I'.tangent m (tangent_map I I' f) :=
begin
  rw ← times_cont_mdiff_on_univ at hf ⊢,
  convert hf.times_cont_mdiff_on_tangent_map_within hmn unique_mdiff_on_univ,
  rw tangent_map_within_univ
end

/-- If a function is `C^n`, with `1 ≤ n`, then its bundled derivative is continuous. -/
theorem times_cont_mdiff.continuous_tangent_map
  (hf : times_cont_mdiff I I' n f) (hmn : 1 ≤ n) :
  continuous (tangent_map I I' f) :=
begin
  rw ← times_cont_mdiff_on_univ at hf,
  rw continuous_iff_continuous_on_univ,
  convert hf.continuous_on_tangent_map_within hmn unique_mdiff_on_univ,
  rw tangent_map_within_univ
end

end tangent_map


lemma add_right_comm (a b c : mynat) : a + b + c = a + c + b :=
begin
rw add_assoc a b c, rw add_comm b c, rw add_assoc a c b, refl,
end


/-
Copyright (c) 2020 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jannis Limperg
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.core
import Mathlib.PostPort

namespace Mathlib

/-!
# The `unify_equations` tactic

This module defines `unify_equations`, a first-order unification tactic that
unifies one or more equations in the context. It implements the Qnify algorithm
from [McBride, Inverting Inductively Defined Relations in LEGO][mcbride1996].

The tactic takes as input some equations which it simplifies one after the
other. Each equation is simplified by applying one of several possible
unification steps. Each such step may output other (simpler) equations which are
unified recursively until no unification step applies any more. See
`tactic.interactive.unify_equations` for an example and an explanation of the
different steps.
-/

namespace tactic

namespace unify_equations

/--
The result of a unification step:

- `simplified hs` means that the step succeeded and produced some new (simpler)
  equations `hs`. `hs` can be empty.
- `goal_solved` means that the step succeeded and solved the goal (by deriving a
  contradiction from the given equation).
- `not_simplified` means that the step failed to simplify the equation.
-/
/--
A unification step is a tactic that attempts to simplify a given equation and
returns a `unification_step_result`. The inputs are:

- `equ`, the equation being processed. Must be a local constant.
- `lhs_type` and `rhs_type`, the types of equ's LHS and RHS. For homogeneous
  equations, these are defeq.
- `lhs` and `rhs`, `equ`'s LHS and RHS.
- `lhs_whnf` and `rhs_whnf`, `equ`'s LHS and RHS in WHNF.
- `u`, `equ`'s level.

So `equ : @eq.{u} lhs_type lhs rhs` or `equ : @heq.{u} lhs_type lhs rhs_type rhs`.
-/
/--
For `equ : t == u` with `t : T` and `u : U`, if `T` and `U` are defeq,
we replace `equ` with `equ : t = u`.
-/
/--
For `equ : t = u`, if `t` and `u` are defeq, we delete `equ`.
-/
/--
For `equ : x = t` or `equ : t = x`, where `x` is a local constant, we
substitute `x` with `t` in the goal.
-/
-- TODO This is an improved version of `injection_with` from core

-- (init/meta/injection_tactic). Remove when the improvements have landed in

-- core.

/--
Given `equ : C x₁ ... xₙ = D y₁ ... yₘ` with `C` and `D` constructors of the
same datatype `I`:

- If `C ≠ D`, we solve the goal by contradiction using the no-confusion rule.
- If `C = D`, we clear `equ` and add equations `x₁ = y₁`, ..., `xₙ = yₙ`.
-/
/--
For `type = I x₁ ... xₙ`, where `I` is an inductive type, `get_sizeof type`
returns the constant `I.sizeof`. Fails if `type` is not of this form or if no
such constant exists.
-/
theorem add_add_one_ne (n : ℕ) (m : ℕ) : n + (m + 1) ≠ n :=
  ne_of_gt
    (nat.lt_add_of_pos_right (nat.pos_of_ne_zero (id fun (ᾰ : m + 1 = 0) => nat.no_confusion ᾰ)))

-- Linarith could prove this, but I want to avoid that dependency.

/--
`match_n_plus_m n e` matches `e` of the form `nat.succ (... (nat.succ e')...)`.
It returns `n` plus the number of `succ` constructors and `e'`. The matching is
performed up to normalisation with transparency `md`.
-/
/--
Given `equ : n + m = n` or `equ : n = n + m` with `n` and `m` natural numbers
and `m` a nonzero literal, this tactic produces a proof of `false`. More
precisely, the two sides of the equation must be of the form
`nat.succ (... (nat.succ e)...)` with different numbers of `nat.succ`
constructors. Matching is performed with transparency `md`.
-/
/--
Given `equ : t = u` with `t, u : I` and `I.sizeof t ≠ I.sizeof u`, we solve the
goal by contradiction.
-/
/--
`orelse_step s t` first runs the unification step `s`. If this was successful
(i.e. `s` simplified or solved the goal), it returns the result of `s`.
Otherwise, it runs `t` and returns its result.
-/
/--
For `equ : t = u`, try the following methods in order: `unify_defeq`,
`unify_var`, `unify_constructor_headed`, `unify_cyclic`. If any of them is
successful, stop and return its result. If none is successful, fail.
-/
end unify_equations

/--
If `equ` is the display name of a local constant with type `t = u` or `t == u`,
then `unify_equation_once equ` simplifies it once using
`unify_equations.unify_homogeneous` or `unify_equations.unify_heterogeneous`.

Otherwise it fails.
-/
/--
Given a list of display names of local hypotheses that are (homogeneous or
heterogeneous) equations, `unify_equations` performs first-order unification on
each hypothesis in order. See `tactic.interactive.unify_equations` for an
example and an explanation of what unification does.

Returns true iff the goal has been solved during the unification process.

Note: you must make sure that the input names are unique in the context.
-/
namespace interactive

/--
`unify_equations eq₁ ... eqₙ` performs a form of first-order unification on the
hypotheses `eqᵢ`. The `eqᵢ` must be homogeneous or heterogeneous equations.
Unification means that the equations are simplified using various facts about
constructors. For instance, consider this goal:

```
P : ∀ n, fin n → Prop
n m : ℕ
f : fin n
g : fin m
h₁ : n + 1 = m + 1
h₂ : f == g
h₃ : P n f
⊢ P m g
```

After `unify_equations h₁ h₂`, we get

```
P : ∀ n, fin n → Prop
n : ℕ
f : fin n
h₃ : P n f
⊢ P n f
```

In the example, `unify_equations` uses the fact that every constructor is
injective to conclude `n = m` from `h₁`. Then it replaces every `m` with `n` and
moves on to `h₂`. The types of `f` and `g` are now equal, so the heterogeneous
equation turns into a homogeneous one and `g` is replaced by `f`. Note that the
equations are processed from left to right, so `unify_equations h₂ h₁` would not
simplify as much.

In general, `unify_equations` uses the following steps on each equation until
none of them applies any more:

- Constructor injectivity: if `nat.succ n = nat.succ m` then `n = m`.
- Substitution: if `x = e` for some hypothesis `x`, then `x` is replaced by `e`
  everywhere.
- No-confusion: `nat.succ n = nat.zero` is a contradiction. If we have such an
  equation, the goal is solved immediately.
- Cycle elimination: `n = nat.succ n` is a contradiction.
- Redundancy: if `t = u` but `t` and `u` are already definitionally equal, then
  this equation is removed.
- Downgrading of heterogeneous equations: if `t == u` but `t` and `u` have the
  same type (up to definitional equality), then the equation is replaced by
  `t = u`.
-/
end Mathlib


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad, Leonardo de Moura
-/
import tactic.ext tactic.finish data.subtype tactic.interactive
open function

/- set coercion to a type -/
namespace set
instance {α : Type*} : has_coe_to_sort (set α) := ⟨_, λ s, {x // x ∈ s}⟩
end set

section set_coe
universe u
variables {α : Type u}
@[simp] theorem set.set_coe_eq_subtype (s : set α) :
  coe_sort.{(u+1) (u+2)} s = {x // x ∈ s} := rfl

@[simp] theorem set_coe.forall {s : set α} {p : s → Prop} :
  (∀ x : s, p x) ↔ (∀ x (h : x ∈ s), p ⟨x, h⟩) :=
subtype.forall

@[simp] theorem set_coe.exists {s : set α} {p : s → Prop} :
  (∃ x : s, p x) ↔ (∃ x (h : x ∈ s), p ⟨x, h⟩) :=
subtype.exists

@[simp] theorem set_coe_cast : ∀ {s t : set α} (H' : s = t) (H : @eq (Type u) s t) (x : s),
  cast H x = ⟨x.1, H' ▸ x.2⟩
| s _ rfl _ ⟨x, h⟩ := rfl

theorem set_coe.ext {s : set α} {a b : s} : (↑a : α) = ↑b → a = b :=
subtype.eq

theorem set_coe.ext_iff {s : set α} {a b : s} : (↑a : α) = ↑b ↔ a = b :=
iff.intro set_coe.ext (assume h, h ▸ rfl)

end set_coe

lemma subtype.mem {α : Type*} {s : set α} (p : s) : (p : α) ∈ s := p.property

namespace set
universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x} {a : α} {s t : set α}

instance : inhabited (set α) := ⟨∅⟩

@[extensionality]
theorem ext {a b : set α} (h : ∀ x, x ∈ a ↔ x ∈ b) : a = b :=
funext (assume x, propext (h x))

theorem ext_iff (s t : set α) : s = t ↔ ∀ x, x ∈ s ↔ x ∈ t :=
⟨begin intros h x, rw h end, ext⟩

@[trans] theorem mem_of_mem_of_subset {α : Type u} {x : α} {s t : set α} (hx : x ∈ s) (h : s ⊆ t) : x ∈ t :=
h hx

/- mem and set_of -/

@[simp] theorem mem_set_of_eq {a : α} {p : α → Prop} : a ∈ {a | p a} = p a := rfl

@[simp] theorem nmem_set_of_eq {a : α} {P : α → Prop} : a ∉ {a : α | P a} = ¬ P a := rfl

@[simp] theorem set_of_mem_eq {s : set α} : {x | x ∈ s} = s := rfl

theorem mem_def {a : α} {s : set α} : a ∈ s ↔ s a := iff.rfl

instance decidable_mem (s : set α) [H : decidable_pred s] : ∀ a, decidable (a ∈ s) := H

instance decidable_set_of (p : α → Prop) [H : decidable_pred p] : decidable_pred {a | p a} := H

@[simp] theorem set_of_subset_set_of {p q : α → Prop} : {a | p a} ⊆ {a | q a} ↔ (∀a, p a → q a) := iff.rfl

@[simp] lemma sep_set_of {α} {p q : α → Prop} : {a ∈ {a | p a } | q a} = {a | p a ∧ q a} :=
rfl

@[simp] lemma set_of_mem {α} {s : set α} : {a | a ∈ s} = s := rfl

/- subset -/

-- TODO(Jeremy): write a tactic to unfold specific instances of generic notation?
theorem subset_def {s t : set α} : (s ⊆ t) = ∀ x, x ∈ s → x ∈ t := rfl

@[refl] theorem subset.refl (a : set α) : a ⊆ a := assume x, id

@[trans] theorem subset.trans {a b c : set α} (ab : a ⊆ b) (bc : b ⊆ c) : a ⊆ c :=
assume x h, bc (ab h)

@[trans] theorem mem_of_eq_of_mem {α : Type u} {x y : α} {s : set α} (hx : x = y) (h : y ∈ s) : x ∈ s :=
hx.symm ▸ h

theorem subset.antisymm {a b : set α} (h₁ : a ⊆ b) (h₂ : b ⊆ a) : a = b :=
ext (λ x, iff.intro (λ ina, h₁ ina) (λ inb, h₂ inb))

theorem subset.antisymm_iff {a b : set α} : a = b ↔ a ⊆ b ∧ b ⊆ a :=
⟨λ e, e ▸ ⟨subset.refl _, subset.refl _⟩,
 λ ⟨h₁, h₂⟩, subset.antisymm h₁ h₂⟩

-- an alterantive name
theorem eq_of_subset_of_subset {a b : set α} (h₁ : a ⊆ b) (h₂ : b ⊆ a) : a = b :=
subset.antisymm h₁ h₂

theorem mem_of_subset_of_mem {s₁ s₂ : set α} {a : α} : s₁ ⊆ s₂ → a ∈ s₁ → a ∈ s₂ :=
assume h₁ h₂, h₁ h₂

theorem not_subset : (¬ s ⊆ t) ↔ ∃a, a ∈ s ∧ a ∉ t :=
by simp [subset_def, classical.not_forall]

/- strict subset -/

/-- `s ⊂ t` means that `s` is a strict subset of `t`, that is, `s ⊆ t` but `s ≠ t`. -/
def strict_subset (s t : set α) := s ⊆ t ∧ s ≠ t

instance : has_ssubset (set α) := ⟨strict_subset⟩

theorem ssubset_def : (s ⊂ t) = (s ⊆ t ∧ s ≠ t) := rfl

lemma exists_of_ssubset {α : Type u} {s t : set α} (h : s ⊂ t) : (∃x∈t, x ∉ s) :=
classical.by_contradiction $ assume hn,
  have t ⊆ s, from assume a hat, classical.by_contradiction $ assume has, hn ⟨a, hat, has⟩,
  h.2 $ subset.antisymm h.1 this

lemma ssubset_iff_subset_not_subset {s t : set α} : s ⊂ t ↔ s ⊆ t ∧ ¬ t ⊆ s :=
by split; simp [set.ssubset_def, ne.def, set.subset.antisymm_iff] {contextual := tt}

theorem not_mem_empty (x : α) : ¬ (x ∈ (∅ : set α)) :=
assume h : x ∈ ∅, h

@[simp] theorem not_not_mem [decidable (a ∈ s)] : ¬ (a ∉ s) ↔ a ∈ s :=
not_not

/- empty set -/

theorem empty_def : (∅ : set α) = {x | false} := rfl

@[simp] theorem mem_empty_eq (x : α) : x ∈ (∅ : set α) = false := rfl

@[simp] theorem set_of_false : {a : α | false} = ∅ := rfl

theorem eq_empty_iff_forall_not_mem {s : set α} : s = ∅ ↔ ∀ x, x ∉ s :=
by simp [ext_iff]

theorem ne_empty_of_mem {s : set α} {x : α} (h : x ∈ s) : s ≠ ∅ :=
by { intro hs, rw hs at h, apply not_mem_empty _ h }

@[simp] theorem empty_subset (s : set α) : ∅ ⊆ s :=
assume x, assume h, false.elim h

theorem subset_empty_iff {s : set α} : s ⊆ ∅ ↔ s = ∅ :=
by simp [subset.antisymm_iff]

theorem eq_empty_of_subset_empty {s : set α} : s ⊆ ∅ → s = ∅ :=
subset_empty_iff.1

theorem ne_empty_iff_exists_mem {s : set α} : s ≠ ∅ ↔ ∃ x, x ∈ s :=
by haveI := classical.prop_decidable;
   simp [eq_empty_iff_forall_not_mem]

theorem exists_mem_of_ne_empty {s : set α} : s ≠ ∅ → ∃ x, x ∈ s :=
ne_empty_iff_exists_mem.1

-- TODO: remove when simplifier stops rewriting `a ≠ b` to `¬ a = b`
theorem not_eq_empty_iff_exists {s : set α} : ¬ (s = ∅) ↔ ∃ x, x ∈ s :=
ne_empty_iff_exists_mem

theorem subset_eq_empty {s t : set α} (h : t ⊆ s) (e : s = ∅) : t = ∅ :=
subset_empty_iff.1 $ e ▸ h

theorem subset_ne_empty {s t : set α} (h : t ⊆ s) : t ≠ ∅ → s ≠ ∅ :=
mt (subset_eq_empty h)

theorem ball_empty_iff {p : α → Prop} :
  (∀ x ∈ (∅ : set α), p x) ↔ true :=
by simp [iff_def]

/- universal set -/

theorem univ_def : @univ α = {x | true} := rfl

@[simp] theorem mem_univ (x : α) : x ∈ @univ α := trivial

theorem empty_ne_univ [h : inhabited α] : (∅ : set α) ≠ univ :=
by simp [ext_iff]

@[simp] theorem subset_univ (s : set α) : s ⊆ univ := λ x H, trivial

theorem univ_subset_iff {s : set α} : univ ⊆ s ↔ s = univ :=
by simp [subset.antisymm_iff]

theorem eq_univ_of_univ_subset {s : set α} : univ ⊆ s → s = univ :=
univ_subset_iff.1

theorem eq_univ_iff_forall {s : set α} : s = univ ↔ ∀ x, x ∈ s :=
by simp [ext_iff]

theorem eq_univ_of_forall {s : set α} : (∀ x, x ∈ s) → s = univ := eq_univ_iff_forall.2

lemma nonempty_iff_univ_ne_empty {α : Type*} : nonempty α ↔ (univ : set α) ≠ ∅ :=
begin
  split,
  { rintro ⟨a⟩ H2,
    show a ∈ (∅ : set α), by rw ←H2 ; trivial },
  { intro H,
    cases exists_mem_of_ne_empty H with a _,
    exact ⟨a⟩ }
end

/- union -/

theorem union_def {s₁ s₂ : set α} : s₁ ∪ s₂ = {a | a ∈ s₁ ∨ a ∈ s₂} := rfl

theorem mem_union_left {x : α} {a : set α} (b : set α) : x ∈ a → x ∈ a ∪ b := or.inl

theorem mem_union_right {x : α} {b : set α} (a : set α) : x ∈ b → x ∈ a ∪ b := or.inr

theorem mem_or_mem_of_mem_union {x : α} {a b : set α} (H : x ∈ a ∪ b) : x ∈ a ∨ x ∈ b := H

theorem mem_union.elim {x : α} {a b : set α} {P : Prop}
    (H₁ : x ∈ a ∪ b) (H₂ : x ∈ a → P) (H₃ : x ∈ b → P) : P :=
or.elim H₁ H₂ H₃

theorem mem_union (x : α) (a b : set α) : x ∈ a ∪ b ↔ x ∈ a ∨ x ∈ b := iff.rfl

@[simp] theorem mem_union_eq (x : α) (a b : set α) : x ∈ a ∪ b = (x ∈ a ∨ x ∈ b) := rfl

@[simp] theorem union_self (a : set α) : a ∪ a = a :=
ext (assume x, or_self _)

@[simp] theorem union_empty (a : set α) : a ∪ ∅ = a :=
ext (assume x, or_false _)

@[simp] theorem empty_union (a : set α) : ∅ ∪ a = a :=
ext (assume x, false_or _)

theorem union_comm (a b : set α) : a ∪ b = b ∪ a :=
ext (assume x, or.comm)

theorem union_assoc (a b c : set α) : (a ∪ b) ∪ c = a ∪ (b ∪ c) :=
ext (assume x, or.assoc)

instance union_is_assoc : is_associative (set α) (∪) :=
⟨union_assoc⟩

instance union_is_comm : is_commutative (set α) (∪) :=
⟨union_comm⟩

theorem union_left_comm (s₁ s₂ s₃ : set α) : s₁ ∪ (s₂ ∪ s₃) = s₂ ∪ (s₁ ∪ s₃) :=
by finish

theorem union_right_comm (s₁ s₂ s₃ : set α) : (s₁ ∪ s₂) ∪ s₃ = (s₁ ∪ s₃) ∪ s₂ :=
by finish

theorem union_eq_self_of_subset_left {s t : set α} (h : s ⊆ t) : s ∪ t = t :=
by finish [subset_def, ext_iff, iff_def]

theorem union_eq_self_of_subset_right {s t : set α} (h : t ⊆ s) : s ∪ t = s :=
by finish [subset_def, ext_iff, iff_def]

@[simp] theorem subset_union_left (s t : set α) : s ⊆ s ∪ t := λ x, or.inl

@[simp] theorem subset_union_right (s t : set α) : t ⊆ s ∪ t := λ x, or.inr

theorem union_subset {s t r : set α} (sr : s ⊆ r) (tr : t ⊆ r) : s ∪ t ⊆ r :=
by finish [subset_def, union_def]

@[simp] theorem union_subset_iff {s t u : set α} : s ∪ t ⊆ u ↔ s ⊆ u ∧ t ⊆ u :=
by finish [iff_def, subset_def]

theorem union_subset_union {s₁ s₂ t₁ t₂ : set α} (h₁ : s₁ ⊆ s₂) (h₂ : t₁ ⊆ t₂) : s₁ ∪ t₁ ⊆ s₂ ∪ t₂ :=
by finish [subset_def]

theorem union_subset_union_left {s₁ s₂ : set α} (t) (h : s₁ ⊆ s₂) : s₁ ∪ t ⊆ s₂ ∪ t :=
union_subset_union h (by refl)

theorem union_subset_union_right (s) {t₁ t₂ : set α} (h : t₁ ⊆ t₂) : s ∪ t₁ ⊆ s ∪ t₂ :=
union_subset_union (by refl) h

@[simp] theorem union_empty_iff {s t : set α} : s ∪ t = ∅ ↔ s = ∅ ∧ t = ∅ :=
⟨by finish [ext_iff], by finish [ext_iff]⟩

/- intersection -/

theorem inter_def {s₁ s₂ : set α} : s₁ ∩ s₂ = {a | a ∈ s₁ ∧ a ∈ s₂} := rfl

theorem mem_inter_iff (x : α) (a b : set α) : x ∈ a ∩ b ↔ x ∈ a ∧ x ∈ b := iff.rfl

@[simp] theorem mem_inter_eq (x : α) (a b : set α) : x ∈ a ∩ b = (x ∈ a ∧ x ∈ b) := rfl

theorem mem_inter {x : α} {a b : set α} (ha : x ∈ a) (hb : x ∈ b) : x ∈ a ∩ b :=
⟨ha, hb⟩

theorem mem_of_mem_inter_left {x : α} {a b : set α} (h : x ∈ a ∩ b) : x ∈ a :=
h.left

theorem mem_of_mem_inter_right {x : α} {a b : set α} (h : x ∈ a ∩ b) : x ∈ b :=
h.right

@[simp] theorem inter_self (a : set α) : a ∩ a = a :=
ext (assume x, and_self _)

@[simp] theorem inter_empty (a : set α) : a ∩ ∅ = ∅ :=
ext (assume x, and_false _)

@[simp] theorem empty_inter (a : set α) : ∅ ∩ a = ∅ :=
ext (assume x, false_and _)

theorem inter_comm (a b : set α) : a ∩ b = b ∩ a :=
ext (assume x, and.comm)

theorem inter_assoc (a b c : set α) : (a ∩ b) ∩ c = a ∩ (b ∩ c) :=
ext (assume x, and.assoc)

instance inter_is_assoc : is_associative (set α) (∩) :=
⟨inter_assoc⟩

instance inter_is_comm : is_commutative (set α) (∩) :=
⟨inter_comm⟩

theorem inter_left_comm (s₁ s₂ s₃ : set α) : s₁ ∩ (s₂ ∩ s₃) = s₂ ∩ (s₁ ∩ s₃) :=
by finish

theorem inter_right_comm (s₁ s₂ s₃ : set α) : (s₁ ∩ s₂) ∩ s₃ = (s₁ ∩ s₃) ∩ s₂ :=
by finish

@[simp] theorem inter_subset_left (s t : set α) : s ∩ t ⊆ s := λ x H, and.left H

@[simp] theorem inter_subset_right (s t : set α) : s ∩ t ⊆ t := λ x H, and.right H

theorem subset_inter {s t r : set α} (rs : r ⊆ s) (rt : r ⊆ t) : r ⊆ s ∩ t :=
by finish [subset_def, inter_def]

@[simp] theorem subset_inter_iff {s t r : set α} : r ⊆ s ∩ t ↔ r ⊆ s ∧ r ⊆ t :=
⟨λ h, ⟨subset.trans h (inter_subset_left _ _), subset.trans h (inter_subset_right _ _)⟩,
 λ ⟨h₁, h₂⟩, subset_inter h₁ h₂⟩

@[simp] theorem inter_univ (a : set α) : a ∩ univ = a :=
ext (assume x, and_true _)

@[simp] theorem univ_inter (a : set α) : univ ∩ a = a :=
ext (assume x, true_and _)

theorem inter_subset_inter_left {s t : set α} (u : set α) (H : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
by finish [subset_def]

theorem inter_subset_inter_right {s t : set α} (u : set α) (H : s ⊆ t) : u ∩ s ⊆ u ∩ t :=
by finish [subset_def]

theorem inter_subset_inter {s₁ s₂ t₁ t₂ : set α} (h₁ : s₁ ⊆ t₁) (h₂ : s₂ ⊆ t₂) : s₁ ∩ s₂ ⊆ t₁ ∩ t₂ :=
by finish [subset_def]

theorem inter_eq_self_of_subset_left {s t : set α} (h : s ⊆ t) : s ∩ t = s :=
by finish [subset_def, ext_iff, iff_def]

theorem inter_eq_self_of_subset_right {s t : set α} (h : t ⊆ s) : s ∩ t = t :=
by finish [subset_def, ext_iff, iff_def]

theorem union_inter_cancel_left {s t : set α} (h : s ∩ t ⊆ ∅) : (s ∪ t) ∩ s = s :=
by finish [ext_iff, iff_def]

theorem union_inter_cancel_right {s t : set α} (h : s ∩ t ⊆ ∅) : (s ∪ t) ∩ t = t :=
by finish [ext_iff, iff_def]

-- TODO(Mario): remove?
theorem nonempty_of_inter_nonempty_right {s t : set α} (h : s ∩ t ≠ ∅) : t ≠ ∅ :=
by finish [ext_iff, iff_def]

theorem nonempty_of_inter_nonempty_left {s t : set α} (h : s ∩ t ≠ ∅) : s ≠ ∅ :=
by finish [ext_iff, iff_def]

/- distributivity laws -/

theorem inter_distrib_left (s t u : set α) : s ∩ (t ∪ u) = (s ∩ t) ∪ (s ∩ u) :=
ext (assume x, and_or_distrib_left)

theorem inter_distrib_right (s t u : set α) : (s ∪ t) ∩ u = (s ∩ u) ∪ (t ∩ u) :=
ext (assume x, or_and_distrib_right)

theorem union_distrib_left (s t u : set α) : s ∪ (t ∩ u) = (s ∪ t) ∩ (s ∪ u) :=
ext (assume x, or_and_distrib_left)

theorem union_distrib_right (s t u : set α) : (s ∩ t) ∪ u = (s ∪ u) ∩ (t ∪ u) :=
ext (assume x, and_or_distrib_right)

/- insert -/

theorem insert_def (x : α) (s : set α) : insert x s = { y | y = x ∨ y ∈ s } := rfl

@[simp] theorem insert_of_has_insert (x : α) (s : set α) : has_insert.insert x s = insert x s := rfl

@[simp] theorem subset_insert (x : α) (s : set α) : s ⊆ insert x s :=
assume y ys, or.inr ys

theorem mem_insert (x : α) (s : set α) : x ∈ insert x s :=
or.inl rfl

theorem mem_insert_of_mem {x : α} {s : set α} (y : α) : x ∈ s → x ∈ insert y s := or.inr

theorem eq_or_mem_of_mem_insert {x a : α} {s : set α} : x ∈ insert a s → x = a ∨ x ∈ s := id

theorem mem_of_mem_insert_of_ne {x a : α} {s : set α} (xin : x ∈ insert a s) : x ≠ a → x ∈ s :=
by finish [insert_def]

@[simp] theorem mem_insert_iff {x a : α} {s : set α} : x ∈ insert a s ↔ (x = a ∨ x ∈ s) := iff.rfl

@[simp] theorem insert_eq_of_mem {a : α} {s : set α} (h : a ∈ s) : insert a s = s :=
by finish [ext_iff, iff_def]

theorem insert_subset : insert a s ⊆ t ↔ (a ∈ t ∧ s ⊆ t) :=
by simp [subset_def, or_imp_distrib, forall_and_distrib]

theorem insert_subset_insert (h : s ⊆ t) : insert a s ⊆ insert a t :=
assume a', or.imp_right (@h a')

theorem ssubset_insert {s : set α} {a : α} (h : a ∉ s) : s ⊂ insert a s :=
by finish [ssubset_def, ext_iff]

theorem insert_comm (a b : α) (s : set α) : insert a (insert b s) = insert b (insert a s) :=
ext $ by simp [or.left_comm]

theorem insert_union : insert a s ∪ t = insert a (s ∪ t) :=
ext $ assume a, by simp [or.comm, or.left_comm]

@[simp] theorem union_insert : s ∪ insert a t = insert a (s ∪ t) :=
ext $ assume a, by simp [or.comm, or.left_comm]

-- TODO(Jeremy): make this automatic
theorem insert_ne_empty (a : α) (s : set α) : insert a s ≠ ∅ :=
by safe [ext_iff, iff_def]; have h' := a_1 a; finish

-- useful in proofs by induction
theorem forall_of_forall_insert {P : α → Prop} {a : α} {s : set α} (h : ∀ x, x ∈ insert a s → P x) :
  ∀ x, x ∈ s → P x :=
by finish

theorem forall_insert_of_forall {P : α → Prop} {a : α} {s : set α} (h : ∀ x, x ∈ s → P x) (ha : P a) :
  ∀ x, x ∈ insert a s → P x :=
by finish

theorem ball_insert_iff {P : α → Prop} {a : α} {s : set α} :
  (∀ x ∈ insert a s, P x) ↔ P a ∧ (∀x ∈ s, P x) :=
by finish [iff_def]

/- singletons -/

theorem singleton_def (a : α) : ({a} : set α) = insert a ∅ := rfl

@[simp] theorem mem_singleton_iff {a b : α} : a ∈ ({b} : set α) ↔ a = b :=
by finish [singleton_def]

-- TODO: again, annotation needed
@[simp] theorem mem_singleton (a : α) : a ∈ ({a} : set α) := by finish

theorem eq_of_mem_singleton {x y : α} (h : x ∈ ({y} : set α)) : x = y :=
by finish

@[simp] theorem singleton_eq_singleton_iff {x y : α} : {x} = ({y} : set α) ↔ x = y :=
by finish [ext_iff, iff_def]

theorem mem_singleton_of_eq {x y : α} (H : x = y) : x ∈ ({y} : set α) :=
by finish

theorem insert_eq (x : α) (s : set α) : insert x s = ({x} : set α) ∪ s :=
by finish [ext_iff, or_comm]

@[simp] theorem pair_eq_singleton (a : α) : ({a, a} : set α) = {a} :=
by finish

@[simp] theorem singleton_ne_empty (a : α) : ({a} : set α) ≠ ∅ := insert_ne_empty _ _

@[simp] theorem singleton_subset_iff {a : α} {s : set α} : {a} ⊆ s ↔ a ∈ s :=
⟨λh, h (by simp), λh b e, by simp at e; simp [*]⟩

theorem set_compr_eq_eq_singleton {a : α} : {b | b = a} = {a} :=
ext $ by simp

@[simp] theorem union_singleton : s ∪ {a} = insert a s :=
by simp [singleton_def]

@[simp] theorem singleton_union : {a} ∪ s = insert a s :=
by rw [union_comm, union_singleton]

theorem singleton_inter_eq_empty : {a} ∩ s = ∅ ↔ a ∉ s :=
by simp [eq_empty_iff_forall_not_mem]

theorem inter_singleton_eq_empty : s ∩ {a} = ∅ ↔ a ∉ s :=
by rw [inter_comm, singleton_inter_eq_empty]

/- separation -/

theorem mem_sep {s : set α} {p : α → Prop} {x : α} (xs : x ∈ s) (px : p x) : x ∈ {x ∈ s | p x} :=
⟨xs, px⟩

@[simp] theorem mem_sep_eq {s : set α} {p : α → Prop} {x : α} : x ∈ {x ∈ s | p x} = (x ∈ s ∧ p x) := rfl

theorem mem_sep_iff {s : set α} {p : α → Prop} {x : α} : x ∈ {x ∈ s | p x} ↔ x ∈ s ∧ p x :=
iff.rfl

theorem eq_sep_of_subset {s t : set α} (ssubt : s ⊆ t) : s = {x ∈ t | x ∈ s} :=
by finish [ext_iff, iff_def, subset_def]

theorem sep_subset (s : set α) (p : α → Prop) : {x ∈ s | p x} ⊆ s :=
assume x, and.left

theorem forall_not_of_sep_empty {s : set α} {p : α → Prop} (h : {x ∈ s | p x} = ∅) :
  ∀ x ∈ s, ¬ p x :=
by finish [ext_iff]

@[simp] lemma sep_univ {α} {p : α → Prop} : {a ∈ (univ : set α) | p a} = {a | p a} :=
set.ext $ by simp

/- complement -/

theorem mem_compl {s : set α} {x : α} (h : x ∉ s) : x ∈ -s := h

theorem not_mem_of_mem_compl {s : set α} {x : α} (h : x ∈ -s) : x ∉ s := h

@[simp] theorem mem_compl_eq (s : set α) (x : α) : x ∈ -s = (x ∉ s) := rfl

theorem mem_compl_iff (s : set α) (x : α) : x ∈ -s ↔ x ∉ s := iff.rfl

@[simp] theorem inter_compl_self (s : set α) : s ∩ -s = ∅ :=
by finish [ext_iff]

@[simp] theorem compl_inter_self (s : set α) : -s ∩ s = ∅ :=
by finish [ext_iff]

@[simp] theorem compl_empty : -(∅ : set α) = univ :=
by finish [ext_iff]

@[simp] theorem compl_union (s t : set α) : -(s ∪ t) = -s ∩ -t :=
by finish [ext_iff]

@[simp] theorem compl_compl (s : set α) : -(-s) = s :=
by finish [ext_iff]

-- ditto
theorem compl_inter (s t : set α) : -(s ∩ t) = -s ∪ -t :=
by finish [ext_iff]

@[simp] theorem compl_univ : -(univ : set α) = ∅ :=
by finish [ext_iff]

theorem union_eq_compl_compl_inter_compl (s t : set α) : s ∪ t = -(-s ∩ -t) :=
by simp [compl_inter, compl_compl]

theorem inter_eq_compl_compl_union_compl (s t : set α) : s ∩ t = -(-s ∪ -t) :=
by simp [compl_compl]

@[simp] theorem union_compl_self (s : set α) : s ∪ -s = univ :=
by finish [ext_iff]

@[simp] theorem compl_union_self (s : set α) : -s ∪ s = univ :=
by finish [ext_iff]

theorem compl_comp_compl : compl ∘ compl = @id (set α) :=
funext compl_compl

theorem compl_subset_comm {s t : set α} : -s ⊆ t ↔ -t ⊆ s :=
by haveI := classical.prop_decidable; exact
forall_congr (λ a, not_imp_comm)

lemma compl_subset_compl {s t : set α} : -s ⊆ -t ↔ t ⊆ s :=
by rw [compl_subset_comm, compl_compl]

theorem compl_subset_iff_union {s t : set α} : -s ⊆ t ↔ s ∪ t = univ :=
iff.symm $ eq_univ_iff_forall.trans $ forall_congr $ λ a,
by haveI := classical.prop_decidable; exact or_iff_not_imp_left

theorem subset_compl_comm {s t : set α} : s ⊆ -t ↔ t ⊆ -s :=
forall_congr $ λ a, imp_not_comm

theorem subset_compl_iff_disjoint {s t : set α} : s ⊆ -t ↔ s ∩ t = ∅ :=
iff.trans (forall_congr $ λ a, and_imp.symm) subset_empty_iff

/- set difference -/

theorem diff_eq (s t : set α) : s \ t = s ∩ -t := rfl

@[simp] theorem mem_diff {s t : set α} (x : α) : x ∈ s \ t ↔ x ∈ s ∧ x ∉ t := iff.rfl

theorem mem_diff_of_mem {s t : set α} {x : α} (h1 : x ∈ s) (h2 : x ∉ t) : x ∈ s \ t :=
⟨h1, h2⟩

theorem mem_of_mem_diff {s t : set α} {x : α} (h : x ∈ s \ t) : x ∈ s :=
h.left

theorem not_mem_of_mem_diff {s t : set α} {x : α} (h : x ∈ s \ t) : x ∉ t :=
h.right

theorem union_diff_cancel {s t : set α} (h : s ⊆ t) : s ∪ (t \ s) = t :=
by finish [ext_iff, iff_def, subset_def]

theorem union_diff_cancel_left {s t : set α} (h : s ∩ t ⊆ ∅) : (s ∪ t) \ s = t :=
by finish [ext_iff, iff_def, subset_def]

theorem union_diff_cancel_right {s t : set α} (h : s ∩ t ⊆ ∅) : (s ∪ t) \ t = s :=
by finish [ext_iff, iff_def, subset_def]

theorem union_diff_left {s t : set α} : (s ∪ t) \ s = t \ s :=
by finish [ext_iff, iff_def]

theorem union_diff_right {s t : set α} : (s ∪ t) \ t = s \ t :=
by finish [ext_iff, iff_def]

theorem union_diff_distrib {s t u : set α} : (s ∪ t) \ u = s \ u ∪ t \ u :=
inter_distrib_right _ _ _

theorem inter_diff_assoc (a b c : set α) : (a ∩ b) \ c = a ∩ (b \ c) :=
inter_assoc _ _ _

theorem inter_diff_self (a b : set α) : a ∩ (b \ a) = ∅ :=
by finish [ext_iff]

theorem inter_union_diff (s t : set α) : (s ∩ t) ∪ (s \ t) = s :=
by finish [ext_iff, iff_def]

theorem diff_subset (s t : set α) : s \ t ⊆ s :=
by finish [subset_def]

theorem diff_subset_diff {s₁ s₂ t₁ t₂ : set α} : s₁ ⊆ s₂ → t₂ ⊆ t₁ → s₁ \ t₁ ⊆ s₂ \ t₂ :=
by finish [subset_def]

theorem diff_subset_diff_left {s₁ s₂ t : set α} (h : s₁ ⊆ s₂) : s₁ \ t ⊆ s₂ \ t :=
diff_subset_diff h (by refl)

theorem diff_subset_diff_right {s t u : set α} (h : t ⊆ u) : s \ u ⊆ s \ t :=
diff_subset_diff (subset.refl s) h

theorem compl_eq_univ_diff (s : set α) : -s = univ \ s :=
by finish [ext_iff]

theorem diff_eq_empty {s t : set α} : s \ t = ∅ ↔ s ⊆ t :=
⟨assume h x hx, classical.by_contradiction $ assume : x ∉ t, show x ∈ (∅ : set α), from h ▸ ⟨hx, this⟩,
  assume h, eq_empty_of_subset_empty $ assume x ⟨hx, hnx⟩, hnx $ h hx⟩

@[simp] theorem diff_empty {s : set α} : s \ ∅ = s :=
ext $ assume x, ⟨assume ⟨hx, _⟩, hx, assume h, ⟨h, not_false⟩⟩

theorem diff_diff {u : set α} : s \ t \ u = s \ (t ∪ u) :=
ext $ by simp [not_or_distrib, and.comm, and.left_comm]

lemma diff_subset_iff {s t u : set α} : s \ t ⊆ u ↔ s ⊆ t ∪ u :=
⟨assume h x xs, classical.by_cases or.inl (assume nxt, or.inr (h ⟨xs, nxt⟩)),
 assume h x ⟨xs, nxt⟩, or.resolve_left (h xs) nxt⟩

lemma diff_subset_comm {s t u : set α} : s \ t ⊆ u ↔ s \ u ⊆ t :=
by rw [diff_subset_iff, diff_subset_iff, union_comm]

@[simp] theorem insert_diff (h : a ∈ t) : insert a s \ t = s \ t :=
ext $ by intro; constructor; simp [or_imp_distrib, h] {contextual := tt}

theorem union_diff_self {s t : set α} : s ∪ (t \ s) = s ∪ t :=
by finish [ext_iff, iff_def]

theorem diff_union_self {s t : set α} : (s \ t) ∪ t = s ∪ t :=
by rw [union_comm, union_diff_self, union_comm]

theorem diff_inter_self {a b : set α} : (b \ a) ∩ a = ∅ :=
ext $ by simp [iff_def] {contextual:=tt}

theorem diff_eq_self {s t : set α} : s \ t = s ↔ t ∩ s ⊆ ∅ :=
by finish [ext_iff, iff_def, subset_def]

@[simp] theorem diff_singleton_eq_self {a : α} {s : set α} (h : a ∉ s) : s \ {a} = s :=
diff_eq_self.2 $ by simp [singleton_inter_eq_empty.2 h]

@[simp] theorem insert_diff_singleton {a : α} {s : set α} :
  insert a (s \ {a}) = insert a s :=
by simp [insert_eq, union_diff_self, -union_singleton, -singleton_union]

@[simp] lemma diff_self {s : set α} : s \ s = ∅ := ext $ by simp

/- powerset -/

theorem mem_powerset {x s : set α} (h : x ⊆ s) : x ∈ powerset s := h

theorem subset_of_mem_powerset {x s : set α} (h : x ∈ powerset s) : x ⊆ s := h

theorem mem_powerset_iff (x s : set α) : x ∈ powerset s ↔ x ⊆ s := iff.rfl

/- inverse image -/

/-- The preimage of `s : set β` by `f : α → β`, written `f ⁻¹' s`,
  is the set of `x : α` such that `f x ∈ s`. -/
def preimage {α : Type u} {β : Type v} (f : α → β) (s : set β) : set α := {x | f x ∈ s}

infix ` ⁻¹' `:80 := preimage

section preimage
variables {f : α → β} {g : β → γ}

@[simp] theorem preimage_empty : f ⁻¹' ∅ = ∅ := rfl

@[simp] theorem mem_preimage_eq {s : set β} {a : α} : (a ∈ f ⁻¹' s) = (f a ∈ s) := rfl

theorem preimage_mono {s t : set β} (h : s ⊆ t) : f ⁻¹' s ⊆ f ⁻¹' t :=
assume x hx, h hx

@[simp] theorem preimage_univ : f ⁻¹' univ = univ := rfl

@[simp] theorem preimage_inter {s t : set β} : f ⁻¹' (s ∩ t) = f ⁻¹' s ∩ f ⁻¹' t := rfl

@[simp] theorem preimage_union {s t : set β} : f ⁻¹' (s ∪ t) = f ⁻¹' s ∪ f ⁻¹' t := rfl

@[simp] theorem preimage_compl {s : set β} : f ⁻¹' (- s) = - (f ⁻¹' s) := rfl

@[simp] theorem preimage_diff (f : α → β) (s t : set β) :
  f ⁻¹' (s \ t) = f ⁻¹' s \ f ⁻¹' t := rfl

@[simp] theorem preimage_set_of_eq {p : α → Prop} {f : β → α} : f ⁻¹' {a | p a} = {a | p (f a)} :=
rfl

theorem preimage_id {s : set α} : id ⁻¹' s = s := rfl

theorem preimage_comp {s : set γ} : (g ∘ f) ⁻¹' s = f ⁻¹' (g ⁻¹' s) := rfl

theorem eq_preimage_subtype_val_iff {p : α → Prop} {s : set (subtype p)} {t : set α} :
  s = subtype.val ⁻¹' t ↔ (∀x (h : p x), (⟨x, h⟩ : subtype p) ∈ s ↔ x ∈ t) :=
⟨assume s_eq x h, by rw [s_eq]; simp,
 assume h, ext $ assume ⟨x, hx⟩, by simp [h]⟩

end preimage

/- function image -/

section image

infix ` '' `:80 := image

/-- Two functions `f₁ f₂ : α → β` are equal on `s`
  if `f₁ x = f₂ x` for all `x ∈ a`. -/
@[reducible] def eq_on (f1 f2 : α → β) (a : set α) : Prop :=
∀ x ∈ a, f1 x = f2 x

-- TODO(Jeremy): use bounded exists in image

theorem mem_image_iff_bex {f : α → β} {s : set α} {y : β} :
  y ∈ f '' s ↔ ∃ x (_ : x ∈ s), f x = y := bex_def.symm

theorem mem_image_eq (f : α → β) (s : set α) (y: β) : y ∈ f '' s = ∃ x, x ∈ s ∧ f x = y := rfl

@[simp] theorem mem_image (f : α → β) (s : set α) (y : β) : y ∈ f '' s ↔ ∃ x, x ∈ s ∧ f x = y := iff.rfl

theorem mem_image_of_mem (f : α → β) {x : α} {a : set α} (h : x ∈ a) : f x ∈ f '' a :=
⟨_, h, rfl⟩

theorem mem_image_of_injective {f : α → β} {a : α} {s : set α} (hf : injective f) :
  f a ∈ f '' s ↔ a ∈ s :=
iff.intro
  (assume ⟨b, hb, eq⟩, (hf eq) ▸ hb)
  (assume h, mem_image_of_mem _ h)

theorem ball_image_of_ball {f : α → β} {s : set α} {p : β → Prop}
  (h : ∀ x ∈ s, p (f x)) : ∀ y ∈ f '' s, p y :=
by finish [mem_image_eq]

@[simp] theorem ball_image_iff {f : α → β} {s : set α} {p : β → Prop} :
  (∀ y ∈ f '' s, p y) ↔ (∀ x ∈ s, p (f x)) :=
iff.intro
  (assume h a ha, h _ $ mem_image_of_mem _ ha)
  (assume h b ⟨a, ha, eq⟩, eq ▸ h a ha)

theorem mono_image {f : α → β} {s t : set α} (h : s ⊆ t) : f '' s ⊆ f '' t :=
assume x ⟨y, hy, y_eq⟩, y_eq ▸ mem_image_of_mem _ $ h hy

theorem mem_image_elim {f : α → β} {s : set α} {C : β → Prop} (h : ∀ (x : α), x ∈ s → C (f x)) :
 ∀{y : β}, y ∈ f '' s → C y
| ._ ⟨a, a_in, rfl⟩ := h a a_in

theorem mem_image_elim_on {f : α → β} {s : set α} {C : β → Prop} {y : β} (h_y : y ∈ f '' s)
  (h : ∀ (x : α), x ∈ s → C (f x)) : C y :=
mem_image_elim h h_y

@[congr] lemma image_congr {f g : α → β} {s : set α}
  (h : ∀a∈s, f a = g a) : f '' s = g '' s :=
by safe [ext_iff, iff_def]

theorem image_eq_image_of_eq_on {f₁ f₂ : α → β} {s : set α} (heq : eq_on f₁ f₂ s) :
  f₁ '' s = f₂ '' s :=
image_congr heq

theorem image_comp (f : β → γ) (g : α → β) (a : set α) : (f ∘ g) '' a = f '' (g '' a) :=
subset.antisymm
  (ball_image_of_ball $ assume a ha, mem_image_of_mem _ $ mem_image_of_mem _ ha)
  (ball_image_of_ball $ ball_image_of_ball $ assume a ha, mem_image_of_mem _ ha)
/- Proof is removed as it uses generated names
TODO(Jeremy): make automatic,
begin
  safe [ext_iff, iff_def, mem_image, (∘)],
  have h' := h_2 (g a_2),
  finish
end -/

theorem image_subset {a b : set α} (f : α → β) (h : a ⊆ b) : f '' a ⊆ f '' b :=
by finish [subset_def, mem_image_eq]

theorem image_union (f : α → β) (s t : set α) :
  f '' (s ∪ t) = f '' s ∪ f '' t :=
by finish [ext_iff, iff_def, mem_image_eq]

@[simp] theorem image_empty (f : α → β) : f '' ∅ = ∅ := ext $ by simp

theorem image_inter_on {f : α → β} {s t : set α} (h : ∀x∈t, ∀y∈s, f x = f y → x = y) :
  f '' s ∩ f '' t = f '' (s ∩ t) :=
subset.antisymm
  (assume b ⟨⟨a₁, ha₁, h₁⟩, ⟨a₂, ha₂, h₂⟩⟩,
    have a₂ = a₁, from h _ ha₂ _ ha₁ (by simp *),
    ⟨a₁, ⟨ha₁, this ▸ ha₂⟩, h₁⟩)
  (subset_inter (mono_image $ inter_subset_left _ _) (mono_image $ inter_subset_right _ _))

theorem image_inter {f : α → β} {s t : set α} (H : injective f) :
  f '' s ∩ f '' t = f '' (s ∩ t) :=
image_inter_on (assume x _ y _ h, H h)

theorem image_univ_of_surjective {ι : Type*} {f : ι → β} (H : surjective f) : f '' univ = univ :=
eq_univ_of_forall $ by simp [image]; exact H

@[simp] theorem image_singleton {f : α → β} {a : α} : f '' {a} = {f a} :=
ext $ λ x, by simp [image]; rw eq_comm

lemma inter_singleton_ne_empty {α : Type*} {s : set α} {a : α} : s ∩ {a} ≠ ∅ ↔ a ∈ s :=
by finish  [set.inter_singleton_eq_empty]

theorem fix_set_compl (t : set α) : compl t = - t := rfl

-- TODO(Jeremy): there is an issue with - t unfolding to compl t
theorem mem_compl_image (t : set α) (S : set (set α)) :
  t ∈ compl '' S ↔ -t ∈ S :=
begin
  suffices : ∀ x, -x = t ↔ -t = x, {simp [fix_set_compl, this]},
  intro x, split; { intro e, subst e, simp }
end

@[simp] theorem image_id (s : set α) : id '' s = s := ext $ by simp

theorem compl_compl_image (S : set (set α)) :
  compl '' (compl '' S) = S :=
by rw [← image_comp, compl_comp_compl, image_id]

theorem image_insert_eq {f : α → β} {a : α} {s : set α} :
  f '' (insert a s) = insert (f a) (f '' s) :=
ext $ by simp [and_or_distrib_left, exists_or_distrib, eq_comm, or_comm, and_comm]

theorem image_subset_preimage_of_inverse {f : α → β} {g : β → α}
  (I : left_inverse g f) (s : set α) : f '' s ⊆ g ⁻¹' s :=
λ b ⟨a, h, e⟩, e ▸ ((I a).symm ▸ h : g (f a) ∈ s)

theorem preimage_subset_image_of_inverse {f : α → β} {g : β → α}
  (I : left_inverse g f) (s : set β) : f ⁻¹' s ⊆ g '' s :=
λ b h, ⟨f b, h, I b⟩

theorem image_eq_preimage_of_inverse {f : α → β} {g : β → α}
  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
  image f = preimage g :=
funext $ λ s, subset.antisymm
  (image_subset_preimage_of_inverse h₁ s)
  (preimage_subset_image_of_inverse h₂ s)

theorem mem_image_iff_of_inverse {f : α → β} {g : β → α} {b : β} {s : set α}
  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
  b ∈ f '' s ↔ g b ∈ s :=
by rw image_eq_preimage_of_inverse h₁ h₂; refl

theorem image_compl_subset {f : α → β} {s : set α} (H : injective f) : f '' -s ⊆ -(f '' s) :=
subset_compl_iff_disjoint.2 $ by simp [image_inter H]

theorem subset_image_compl {f : α → β} {s : set α} (H : surjective f) : -(f '' s) ⊆ f '' -s :=
compl_subset_iff_union.2 $
by rw ← image_union; simp [image_univ_of_surjective H]

theorem image_compl_eq {f : α → β} {s : set α} (H : bijective f) : f '' -s = -(f '' s) :=
subset.antisymm (image_compl_subset H.1) (subset_image_compl H.2)

/- image and preimage are a Galois connection -/
theorem image_subset_iff {s : set α} {t : set β} {f : α → β} :
  f '' s ⊆ t ↔ s ⊆ f ⁻¹' t :=
ball_image_iff

theorem image_preimage_subset (f : α → β) (s : set β) :
  f '' (f ⁻¹' s) ⊆ s :=
image_subset_iff.2 (subset.refl _)

theorem subset_preimage_image (f : α → β) (s : set α) :
  s ⊆ f ⁻¹' (f '' s) :=
λ x, mem_image_of_mem f

theorem preimage_image_eq {f : α → β} (s : set α) (h : injective f) : f ⁻¹' (f '' s) = s :=
subset.antisymm
  (λ x ⟨y, hy, e⟩, h e ▸ hy)
  (subset_preimage_image f s)

theorem image_preimage_eq {f : α → β} {s : set β} (h : surjective f) : f '' (f ⁻¹' s) = s :=
subset.antisymm
  (image_preimage_subset f s)
  (λ x hx, let ⟨y, e⟩ := h x in ⟨y, (e.symm ▸ hx : f y ∈ s), e⟩)

lemma preimage_eq_preimage {f : β → α} (hf : surjective f) : f ⁻¹' s = preimage f t ↔ s = t :=
iff.intro
  (assume eq, by rw [← @image_preimage_eq β α f s hf, ← @image_preimage_eq β α f t hf, eq])
  (assume eq, eq ▸ rfl)

lemma surjective_preimage {f : β → α} (hf : surjective f) : injective (preimage f) :=
assume s t, (preimage_eq_preimage hf).1

theorem compl_image : image (@compl α) = preimage compl :=
image_eq_preimage_of_inverse compl_compl compl_compl

theorem compl_image_set_of {α : Type u} {p : set α → Prop} :
  compl '' {x | p x} = {x | p (- x)} :=
congr_fun compl_image p

theorem inter_preimage_subset (s : set α) (t : set β) (f : α → β) :
  s ∩ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∩ t) :=
λ x h, ⟨mem_image_of_mem _ h.left, h.right⟩

theorem union_preimage_subset (s : set α) (t : set β) (f : α → β) :
  s ∪ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∪ t) :=
λ x h, or.elim h (λ l, or.inl $ mem_image_of_mem _ l) (λ r, or.inr r)

theorem subset_image_union (f : α → β) (s : set α) (t : set β) :
  f '' (s ∪ f ⁻¹' t) ⊆ f '' s ∪ t :=
image_subset_iff.2 (union_preimage_subset _ _ _)

lemma subtype_val_image {p : α → Prop} {s : set (subtype p)} :
  subtype.val '' s = {x | ∃h : p x, (⟨x, h⟩ : subtype p) ∈ s} :=
ext $ assume a,
⟨assume ⟨⟨a', ha'⟩, in_s, h_eq⟩, h_eq ▸ ⟨ha', in_s⟩,
  assume ⟨ha, in_s⟩, ⟨⟨a, ha⟩, in_s, rfl⟩⟩

lemma preimage_subset_iff {A : set α} {B : set β} {f : α → β} :
  f⁻¹' B ⊆ A ↔ (∀ a : α, f a ∈ B → a ∈ A) := iff.rfl

lemma image_eq_image {f : α → β} (hf : injective f) : f '' s = f '' t ↔ s = t :=
iff.symm $ iff.intro (assume eq, eq ▸ rfl) $ assume eq,
  by rw [← preimage_image_eq s hf, ← preimage_image_eq t hf, eq]

lemma image_subset_image_iff {f : α → β} (hf : injective f) : f '' s ⊆ f '' t ↔ s ⊆ t :=
begin
  refine (iff.symm $ iff.intro (image_subset f) $ assume h, _),
  rw [← preimage_image_eq s hf, ← preimage_image_eq t hf],
  exact preimage_mono h
end

lemma injective_image {f : α → β} (hf : injective f) : injective (('') f) :=
assume s t, (image_eq_image hf).1

end image

theorem univ_eq_true_false : univ = ({true, false} : set Prop) :=
eq.symm $ eq_univ_of_forall $ classical.cases (by simp) (by simp)

section range
variables {f : ι → α}
open function

/-- Range of a function.

This function is more flexible than `f '' univ`, as the image requires that the domain is in Type
and not an arbitrary Sort. -/
def range (f : ι → α) : set α := {x | ∃y, f y = x}

@[simp] theorem mem_range {x : α} : x ∈ range f ↔ ∃ y, f y = x := iff.rfl

theorem mem_range_self (i : ι) : f i ∈ range f := ⟨i, rfl⟩

theorem forall_range_iff {p : α → Prop} : (∀ a ∈ range f, p a) ↔ (∀ i, p (f i)) :=
⟨assume h i, h (f i) (mem_range_self _), assume h a ⟨i, (hi : f i = a)⟩, hi ▸ h i⟩

theorem range_iff_surjective : range f = univ ↔ surjective f :=
eq_univ_iff_forall

@[simp] theorem range_id : range (@id α) = univ := range_iff_surjective.2 surjective_id

@[simp] theorem image_univ {ι : Type*} {f : ι → β} : f '' univ = range f :=
ext $ by simp [image, range]

theorem range_comp {g : α → β} : range (g ∘ f) = g '' range f :=
subset.antisymm
  (forall_range_iff.mpr $ assume i, mem_image_of_mem g (mem_range_self _))
  (ball_image_iff.mpr $ forall_range_iff.mpr mem_range_self)

theorem range_subset_iff {ι : Type*} {f : ι → β} {s : set β} : range f ⊆ s ↔ ∀ y, f y ∈ s :=
forall_range_iff

lemma nonempty_of_nonempty_range {α : Type*} {β : Type*} {f : α → β} (H : ¬range f = ∅) : nonempty α :=
begin
  cases exists_mem_of_ne_empty H with x h,
  cases mem_range.1 h with y _,
  exact ⟨y⟩
end

theorem image_preimage_eq_inter_range {f : α → β} {t : set β} :
  f '' preimage f t = t ∩ range f :=
ext $ assume x, ⟨assume ⟨x, hx, heq⟩, heq ▸ ⟨hx, mem_range_self _⟩,
  assume ⟨hx, ⟨y, h_eq⟩⟩, h_eq ▸ mem_image_of_mem f $
    show y ∈ preimage f t, by simp [preimage, h_eq, hx]⟩

@[simp] theorem quot_mk_range_eq [setoid α] : range (λx : α, ⟦x⟧) = univ :=
range_iff_surjective.2 quot.exists_rep
end range

lemma subtype_val_range {p : α → Prop} :
  range (@subtype.val _ p) = {x | p x} :=
by rw ← image_univ; simp [-image_univ, subtype_val_image]

/-- The set `s` is pairwise `r` if `r x y` for all *distinct* `x y ∈ s`. -/
def pairwise_on (s : set α) (r : α → α → Prop) := ∀ x ∈ s, ∀ y ∈ s, x ≠ y → r x y

end set

namespace set

section prod

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
variables {s s₁ s₂ : set α} {t t₁ t₂ : set β}

/-- The cartesian product `prod s t` is the set of `(a, b)`
  such that `a ∈ s` and `b ∈ t`. -/
protected def prod (s : set α) (t : set β) : set (α × β) :=
{p | p.1 ∈ s ∧ p.2 ∈ t}

theorem mem_prod_eq {p : α × β} : p ∈ set.prod s t = (p.1 ∈ s ∧ p.2 ∈ t) := rfl

@[simp] theorem mem_prod {p : α × β} : p ∈ set.prod s t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl

lemma mk_mem_prod {a : α} {b : β} (a_in : a ∈ s) (b_in : b ∈ t) : (a, b) ∈ set.prod s t := ⟨a_in, b_in⟩

@[simp] theorem prod_empty {s : set α} : set.prod s ∅ = (∅ : set (α × β)) :=
ext $ by simp [set.prod]

@[simp] theorem empty_prod {t : set β} : set.prod ∅ t = (∅ : set (α × β)) :=
ext $ by simp [set.prod]

theorem insert_prod {a : α} {s : set α} {t : set β} :
  set.prod (insert a s) t = (prod.mk a '' t) ∪ set.prod s t :=
ext begin simp [set.prod, image, iff_def, or_imp_distrib] {contextual := tt}; cc end

theorem prod_insert {b : β} {s : set α} {t : set β} :
  set.prod s (insert b t) = ((λa, (a, b)) '' s) ∪ set.prod s t :=
ext begin simp [set.prod, image, iff_def, or_imp_distrib] {contextual := tt}; cc end

theorem prod_preimage_eq {f : γ → α} {g : δ → β} :
  set.prod (preimage f s) (preimage g t) = preimage (λp, (f p.1, g p.2)) (set.prod s t) := rfl

theorem prod_mono {s₁ s₂ : set α} {t₁ t₂ : set β} (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) :
  set.prod s₁ t₁ ⊆ set.prod s₂ t₂ :=
assume x ⟨h₁, h₂⟩, ⟨hs h₁, ht h₂⟩

theorem prod_inter_prod : set.prod s₁ t₁ ∩ set.prod s₂ t₂ = set.prod (s₁ ∩ s₂) (t₁ ∩ t₂) :=
subset.antisymm
  (assume ⟨a, b⟩ ⟨⟨ha₁, hb₁⟩, ⟨ha₂, hb₂⟩⟩, ⟨⟨ha₁, ha₂⟩, ⟨hb₁, hb₂⟩⟩)
  (subset_inter
    (prod_mono (inter_subset_left _ _) (inter_subset_left _ _))
    (prod_mono (inter_subset_right _ _) (inter_subset_right _ _)))

theorem image_swap_prod : (λp:β×α, (p.2, p.1)) '' set.prod t s = set.prod s t :=
ext $ assume ⟨a, b⟩, by simp [mem_image_eq, set.prod, and_comm]; exact
⟨ assume ⟨b', a', ⟨h_a, h_b⟩, h⟩, by subst a'; subst b'; assumption,
  assume h, ⟨b, a, ⟨rfl, rfl⟩, h⟩⟩

theorem image_swap_eq_preimage_swap : image (@prod.swap α β) = preimage prod.swap :=
image_eq_preimage_of_inverse prod.swap_left_inverse prod.swap_right_inverse

theorem prod_image_image_eq {m₁ : α → γ} {m₂ : β → δ} :
  set.prod (image m₁ s) (image m₂ t) = image (λp:α×β, (m₁ p.1, m₂ p.2)) (set.prod s t) :=
ext $ by simp [-exists_and_distrib_right, exists_and_distrib_right.symm, and.left_comm, and.assoc, and.comm]

theorem prod_range_range_eq {α β γ δ} {m₁ : α → γ} {m₂ : β → δ} :
  set.prod (range m₁) (range m₂) = range (λp:α×β, (m₁ p.1, m₂ p.2)) :=
ext $ by simp [range]

@[simp] theorem prod_singleton_singleton {a : α} {b : β} :
  set.prod {a} {b} = ({(a, b)} : set (α×β)) :=
ext $ by simp [set.prod]

theorem prod_neq_empty_iff {s : set α} {t : set β} :
  set.prod s t ≠ ∅ ↔ (s ≠ ∅ ∧ t ≠ ∅) :=
by simp [not_eq_empty_iff_exists]

@[simp] theorem prod_mk_mem_set_prod_eq {a : α} {b : β} {s : set α} {t : set β} :
  (a, b) ∈ set.prod s t = (a ∈ s ∧ b ∈ t) := rfl

@[simp] theorem univ_prod_univ : set.prod (@univ α) (@univ β) = univ :=
ext $ assume ⟨a, b⟩, by simp

lemma prod_sub_preimage_iff {W : set γ} {f : α × β → γ} :
  set.prod s t ⊆ f ⁻¹' W ↔ ∀ a b, a ∈ s → b ∈ t → f (a, b) ∈ W :=
by simp [subset_def]

end prod

section pi
variables {α : Type*} {π : α → Type*}

def pi (i : set α) (s : Πa, set (π a)) : set (Πa, π a) := { f | ∀a∈i, f a ∈ s a }

@[simp] lemma pi_empty_index (s : Πa, set (π a)) : pi ∅ s = univ := by ext; simp [pi]

@[simp] lemma pi_insert_index (a : α) (i : set α) (s : Πa, set (π a)) :
  pi (insert a i) s = ((λf, f a) ⁻¹' s a) ∩ pi i s :=
by ext; simp [pi, or_imp_distrib, forall_and_distrib]

@[simp] lemma pi_singleton_index (a : α) (s : Πa, set (π a)) :
  pi {a} s = ((λf:(Πa, π a), f a) ⁻¹' s a) :=
by ext; simp [pi]

lemma pi_if {p : α → Prop} [h : decidable_pred p] (i : set α) (s t : Πa, set (π a)) :
  pi i (λa, if p a then s a else t a) = pi {a ∈ i | p a} s ∩ pi {a ∈ i | ¬ p a} t :=
begin
  ext f,
  split,
  { assume h, split; { rintros a ⟨hai, hpa⟩, simpa [*] using h a } },
  { rintros ⟨hs, ht⟩ a hai,
    by_cases p a; simp [*, pi] at * }
end

end pi

end set