/-
Copyright (c) 2020 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import deprecated.group

/-!
# Unbundled semiring and ring homomorphisms (deprecated)

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

This file is deprecated, and is no longer imported by anything in mathlib other than other
deprecated files, and test files. You should not need to import it.

This file defines predicates for unbundled semiring and ring homomorphisms. Instead of using
this file, please use `ring_hom`, defined in `algebra.hom.ring`, with notation `→+*`, for
morphisms between semirings or rings. For example use `φ : A →+* B` to represent a
ring homomorphism.

## Main Definitions

`is_semiring_hom` (deprecated), `is_ring_hom` (deprecated)

## Tags

is_semiring_hom, is_ring_hom

-/

universes u v w

variable {α : Type u}

/-- Predicate for semiring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
structure is_semiring_hom {α : Type u} {β : Type v} [semiring α] [semiring β] (f : α → β) : Prop :=
(map_zero [] : f 0 = 0)
(map_one [] : f 1 = 1)
(map_add [] : ∀ {x y}, f (x + y) = f x + f y)
(map_mul [] : ∀ {x y}, f (x * y) = f x * f y)

namespace is_semiring_hom

variables {β : Type v} [semiring α] [semiring β]
variables {f : α → β} (hf : is_semiring_hom f) {x y : α}

/-- The identity map is a semiring homomorphism. -/
lemma id : is_semiring_hom (@id α) := by refine {..}; intros; refl

/-- The composition of two semiring homomorphisms is a semiring homomorphism. -/
lemma comp (hf : is_semiring_hom f) {γ} [semiring γ] {g : β → γ} (hg : is_semiring_hom g) :
  is_semiring_hom (g ∘ f) :=
{ map_zero := by simpa [map_zero hf] using map_zero hg,
  map_one := by simpa [map_one hf] using map_one hg,
  map_add := λ x y, by simp [map_add hf, map_add hg],
  map_mul := λ x y, by simp [map_mul hf, map_mul hg] }

/-- A semiring homomorphism is an additive monoid homomorphism. -/
lemma to_is_add_monoid_hom (hf : is_semiring_hom f) : is_add_monoid_hom f :=
{ ..‹is_semiring_hom f› }

/-- A semiring homomorphism is a monoid homomorphism. -/
lemma to_is_monoid_hom (hf : is_semiring_hom f) : is_monoid_hom f :=
{ ..‹is_semiring_hom f› }

end is_semiring_hom

/-- Predicate for ring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
structure is_ring_hom {α : Type u} {β : Type v} [ring α] [ring β] (f : α → β) : Prop :=
(map_one [] : f 1 = 1)
(map_mul [] : ∀ {x y}, f (x * y) = f x * f y)
(map_add [] : ∀ {x y}, f (x + y) = f x + f y)

namespace is_ring_hom

variables {β : Type v} [ring α] [ring β]

/-- A map of rings that is a semiring homomorphism is also a ring homomorphism. -/
lemma of_semiring {f : α → β} (H : is_semiring_hom f) : is_ring_hom f := {..H}

variables {f : α → β} (hf : is_ring_hom f) {x y : α}

/-- Ring homomorphisms map zero to zero. -/
lemma map_zero (hf : is_ring_hom f) : f 0 = 0 :=
calc f 0 = f (0 + 0) - f 0 : by rw [hf.map_add]; simp
     ... = 0 : by simp

/-- Ring homomorphisms preserve additive inverses. -/
lemma map_neg (hf : is_ring_hom f) : f (-x) = -f x :=
calc f (-x) = f (-x + x) - f x : by rw [hf.map_add]; simp
        ... = -f x : by simp [hf.map_zero]

/-- Ring homomorphisms preserve subtraction. -/
lemma map_sub (hf : is_ring_hom f) : f (x - y) = f x - f y :=
by simp [sub_eq_add_neg, hf.map_add, hf.map_neg]

/-- The identity map is a ring homomorphism. -/
lemma id : is_ring_hom (@id α) := by refine {..}; intros; refl

/-- The composition of two ring homomorphisms is a ring homomorphism. -/
-- see Note [no instance on morphisms]
lemma comp (hf : is_ring_hom f) {γ} [ring γ] {g : β → γ} (hg : is_ring_hom g) :
  is_ring_hom (g ∘ f) :=
{ map_add := λ x y, by simp [map_add hf]; rw map_add hg; refl,
  map_mul := λ x y, by simp [map_mul hf]; rw map_mul hg; refl,
  map_one := by simp [map_one hf]; exact map_one hg }

/-- A ring homomorphism is also a semiring homomorphism. -/
lemma to_is_semiring_hom (hf : is_ring_hom f) : is_semiring_hom f :=
{ map_zero := map_zero hf, ..‹is_ring_hom f› }

lemma to_is_add_group_hom (hf : is_ring_hom f) : is_add_group_hom f :=
{ map_add := λ _ _, hf.map_add }

end is_ring_hom

variables {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β]

namespace ring_hom

section
include rα rβ

/-- Interpret `f : α → β` with `is_semiring_hom f` as a ring homomorphism. -/
def of {f : α → β} (hf : is_semiring_hom f) : α →+* β :=
{ to_fun := f,
  .. monoid_hom.of hf.to_is_monoid_hom,
  .. add_monoid_hom.of hf.to_is_add_monoid_hom }

@[simp] lemma coe_of {f : α → β} (hf : is_semiring_hom f) : ⇑(of hf) = f := rfl

lemma to_is_semiring_hom (f : α →+* β) : is_semiring_hom f :=
{ map_zero := f.map_zero,
  map_one := f.map_one,
  map_add := f.map_add,
  map_mul := f.map_mul }

end

lemma to_is_ring_hom {α γ} [ring α] [ring γ] (g : α →+* γ) : is_ring_hom g :=
is_ring_hom.of_semiring g.to_is_semiring_hom

end ring_hom


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl
-/
import algebra.algebra.basic
import topology.algebra.group_completion
import topology.algebra.ring.ideal

/-!
# Completion of topological rings:

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

This files endows the completion of a topological ring with a ring structure.
More precisely the instance `uniform_space.completion.ring` builds a ring structure
on the completion of a ring endowed with a compatible uniform structure in the sense of
`uniform_add_group`. There is also a commutative version when the original ring is commutative.
Moreover, if a topological ring is an algebra over a commutative semiring, then so is its
`uniform_space.completion`.

The last part of the file builds a ring structure on the biggest separated quotient of a ring.

## Main declarations:

Beyond the instances explained above (that don't have to be explicitly invoked),
the main constructions deal with continuous ring morphisms.

* `uniform_space.completion.extension_hom`: extends a continuous ring morphism from `R`
  to a complete separated group `S` to `completion R`.
* `uniform_space.completion.map_ring_hom` : promotes a continuous ring morphism
  from `R` to `S` into a continuous ring morphism from `completion R` to `completion S`.

TODO: Generalise the results here from the concrete `completion` to any `abstract_completion`.
-/
open classical set filter topological_space add_comm_group
open_locale classical
noncomputable theory
universes u

namespace uniform_space.completion
open dense_inducing uniform_space function
variables (α : Type*) [ring α] [uniform_space α]

instance : has_one (completion α) := ⟨(1:α)⟩

instance : has_mul (completion α) :=
⟨curry $ (dense_inducing_coe.prod dense_inducing_coe).extend (coe ∘ uncurry (*))⟩

@[norm_cast] lemma coe_one : ((1 : α) : completion α) = 1 := rfl

variables {α} [topological_ring α]

@[norm_cast]
lemma coe_mul (a b : α) : ((a * b : α) : completion α) = a * b :=
((dense_inducing_coe.prod dense_inducing_coe).extend_eq
  ((continuous_coe α).comp (@continuous_mul α _ _ _)) (a, b)).symm

variables [uniform_add_group α]

lemma continuous_mul : continuous (λ p : completion α × completion α, p.1 * p.2) :=
begin
  let m := (add_monoid_hom.mul : α →+ α →+ α).compr₂ to_compl,
  have : continuous (λ p : α × α, m p.1 p.2),
  from (continuous_coe α).comp continuous_mul,
  have di : dense_inducing (to_compl : α → completion α),
  from dense_inducing_coe,
  convert di.extend_Z_bilin di this,
  ext ⟨x, y⟩,
  refl
end

lemma continuous.mul {β : Type*} [topological_space β] {f g : β → completion α}
  (hf : continuous f) (hg : continuous g) : continuous (λb, f b * g b) :=
continuous_mul.comp (hf.prod_mk hg : _)

instance : ring (completion α) :=
{ one_mul       := assume a, completion.induction_on a
    (is_closed_eq (continuous.mul continuous_const continuous_id) continuous_id)
    (assume a, by rw [← coe_one, ← coe_mul, one_mul]),
  mul_one       := assume a, completion.induction_on a
    (is_closed_eq (continuous.mul continuous_id continuous_const) continuous_id)
    (assume a, by rw [← coe_one, ← coe_mul, mul_one]),
  mul_assoc     := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous.mul (continuous.mul continuous_fst (continuous_fst.comp continuous_snd))
        (continuous_snd.comp continuous_snd))
      (continuous.mul continuous_fst
        (continuous.mul (continuous_fst.comp continuous_snd) (continuous_snd.comp continuous_snd))))
    (assume a b c, by rw [← coe_mul, ← coe_mul, ← coe_mul, ← coe_mul, mul_assoc]),
  left_distrib  := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous.mul continuous_fst (continuous.add
        (continuous_fst.comp continuous_snd)
        (continuous_snd.comp continuous_snd)))
      (continuous.add
        (continuous.mul continuous_fst (continuous_fst.comp continuous_snd))
        (continuous.mul continuous_fst (continuous_snd.comp continuous_snd))))
    (assume a b c, by rw [← coe_add, ← coe_mul, ← coe_mul, ← coe_mul, ←coe_add, mul_add]),
  right_distrib := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous.mul (continuous.add continuous_fst
        (continuous_fst.comp continuous_snd)) (continuous_snd.comp continuous_snd))
      (continuous.add
        (continuous.mul continuous_fst (continuous_snd.comp continuous_snd))
        (continuous.mul (continuous_fst.comp continuous_snd) (continuous_snd.comp continuous_snd))))
    (assume a b c, by rw [← coe_add, ← coe_mul, ← coe_mul, ← coe_mul, ←coe_add, add_mul]),
  .. add_monoid_with_one.unary,
  ..completion.add_comm_group, ..completion.has_mul α, ..completion.has_one α }

/-- The map from a uniform ring to its completion, as a ring homomorphism. -/
def coe_ring_hom : α →+* completion α :=
⟨coe, coe_one α, assume a b, coe_mul a b, coe_zero, assume a b, coe_add a b⟩

lemma continuous_coe_ring_hom : continuous (coe_ring_hom : α → completion α) :=
continuous_coe α

variables {β : Type u} [uniform_space β] [ring β] [uniform_add_group β] [topological_ring β]
          (f : α →+* β) (hf : continuous f)

/-- The completion extension as a ring morphism. -/
def extension_hom [complete_space β] [separated_space β] :
  completion α →+* β :=
have hf' : continuous (f : α →+ β), from hf, -- helping the elaborator
have hf : uniform_continuous f, from uniform_continuous_add_monoid_hom_of_continuous hf',
{ to_fun := completion.extension f,
  map_zero' := by rw [← coe_zero, extension_coe hf, f.map_zero],
  map_add' := assume a b, completion.induction_on₂ a b
    (is_closed_eq
      (continuous_extension.comp continuous_add)
      ((continuous_extension.comp continuous_fst).add
                      (continuous_extension.comp continuous_snd)))
    (assume a b,
      by rw [← coe_add, extension_coe hf, extension_coe hf, extension_coe hf,
             f.map_add]),
  map_one' := by rw [← coe_one, extension_coe hf, f.map_one],
  map_mul' := assume a b, completion.induction_on₂ a b
    (is_closed_eq
      (continuous_extension.comp continuous_mul)
      ((continuous_extension.comp continuous_fst).mul (continuous_extension.comp continuous_snd)))
    (assume a b,
      by rw [← coe_mul, extension_coe hf, extension_coe hf, extension_coe hf, f.map_mul]) }

instance top_ring_compl : topological_ring (completion α) :=
{ continuous_add := continuous_add,
  continuous_mul := continuous_mul }

/-- The completion map as a ring morphism. -/
def map_ring_hom (hf : continuous f) : completion α →+* completion β :=
extension_hom (coe_ring_hom.comp f) (continuous_coe_ring_hom.comp  hf)

section algebra
variables (A : Type*) [ring A] [uniform_space A] [uniform_add_group A] [topological_ring A]
  (R : Type*) [comm_semiring R] [algebra R A] [has_uniform_continuous_const_smul R A]

@[simp] lemma map_smul_eq_mul_coe (r : R) :
  completion.map ((•) r) = (*) (algebra_map R A r : completion A) :=
begin
  ext x,
  refine completion.induction_on x _ (λ a, _),
  { exact is_closed_eq (completion.continuous_map) (continuous_mul_left _) },
  { rw [map_coe (uniform_continuous_const_smul r) a, algebra.smul_def, coe_mul] },
end

instance : algebra R (completion A) :=
{ commutes' := λ r x, completion.induction_on x
    (is_closed_eq (continuous_mul_left _) (continuous_mul_right _)) $ λ a,
      by simpa only [coe_mul] using congr_arg (coe : A → completion A) (algebra.commutes r a),
  smul_def' := λ r x, congr_fun (map_smul_eq_mul_coe A R r) x,
  ..((uniform_space.completion.coe_ring_hom : A →+* completion A).comp (algebra_map R A)) }

lemma algebra_map_def (r : R) :
  algebra_map R (completion A) r = (algebra_map R A r : completion A) :=
rfl

end algebra

section comm_ring
variables (R : Type*) [comm_ring R] [uniform_space R] [uniform_add_group R] [topological_ring R]

instance : comm_ring (completion R) :=
{ mul_comm := assume a b, completion.induction_on₂ a b
      (is_closed_eq (continuous_fst.mul continuous_snd)
                    (continuous_snd.mul continuous_fst))
      (assume a b, by rw [← coe_mul, ← coe_mul, mul_comm]),
 ..completion.ring }

 /-- A shortcut instance for the common case -/
instance algebra' : algebra R (completion R) :=
by apply_instance

end comm_ring

end uniform_space.completion

namespace uniform_space
variables {α : Type*}
lemma ring_sep_rel (α) [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  separation_setoid α = submodule.quotient_rel (ideal.closure ⊥) :=
setoid.ext $ λ x y, (add_group_separation_rel x y).trans $
  iff.trans (by refl) (submodule.quotient_rel_r_def _).symm

lemma ring_sep_quot
  (α : Type u) [r : comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  quotient (separation_setoid α) = (α ⧸ (⊥ : ideal α).closure) :=
by rw [@ring_sep_rel α r]; refl

/-- Given a topological ring `α` equipped with a uniform structure that makes subtraction uniformly
continuous, get an equivalence between the separated quotient of `α` and the quotient ring
corresponding to the closure of zero. -/
def sep_quot_equiv_ring_quot (α)
  [r : comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  quotient (separation_setoid α) ≃ (α ⧸ (⊥ : ideal α).closure) :=
quotient.congr_right $ λ x y, (add_group_separation_rel x y).trans $
  iff.trans (by refl) (submodule.quotient_rel_r_def _).symm

/- TODO: use a form of transport a.k.a. lift definition a.k.a. transfer -/
instance comm_ring [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  comm_ring (quotient (separation_setoid α)) :=
by rw ring_sep_quot α; apply_instance

instance topological_ring
  [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  topological_ring (quotient (separation_setoid α)) :=
begin
  convert topological_ring_quotient (⊥ : ideal α).closure; try {apply ring_sep_rel},
  simp [uniform_space.comm_ring]
end

end uniform_space

section uniform_extension

variables {α : Type*} [uniform_space α] [semiring α]
variables {β : Type*} [uniform_space β] [semiring β] [topological_semiring β]
variables {γ : Type*} [uniform_space γ] [semiring γ] [topological_semiring γ]
variables [t2_space γ] [complete_space γ]

/-- The dense inducing extension as a ring homomorphism. -/
noncomputable def dense_inducing.extend_ring_hom {i : α →+* β} {f : α →+* γ}
  (ue : uniform_inducing i) (dr : dense_range i) (hf : uniform_continuous f):
  β →+* γ :=
  { to_fun := (ue.dense_inducing dr).extend f,
    map_one' := by { convert dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous 1,
      exacts [i.map_one.symm, f.map_one.symm], },
    map_zero' := by { convert dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous 0,
      exacts [i.map_zero.symm, f.map_zero.symm], },
    map_add' :=
    begin
      have h := (uniform_continuous_uniformly_extend ue dr hf).continuous,
      refine λ x y, dense_range.induction_on₂ dr _ (λ a b, _) x y,
      { exact is_closed_eq (continuous.comp h continuous_add)
        ((h.comp continuous_fst).add (h.comp continuous_snd)), },
      { simp_rw [← i.map_add, dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous _,
          ← f.map_add], },
    end,
    map_mul' :=
    begin
      have h := (uniform_continuous_uniformly_extend ue dr hf).continuous,
      refine λ x y, dense_range.induction_on₂ dr _ (λ a b, _) x y,
      { exact is_closed_eq (continuous.comp h continuous_mul)
        ((h.comp continuous_fst).mul (h.comp continuous_snd)), },
      { simp_rw [← i.map_mul, dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous _,
          ← f.map_mul], },
    end, }

end uniform_extension


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash

! This file was ported from Lean 3 source module algebra.hom.non_unital_alg
! leanprover-community/mathlib commit bd9851ca476957ea4549eb19b40e7b5ade9428cc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Hom

/-!
# Morphisms of non-unital algebras

This file defines morphisms between two types, each of which carries:
 * an addition,
 * an additive zero,
 * a multiplication,
 * a scalar action.

The multiplications are not assumed to be associative or unital, or even to be compatible with the
scalar actions. In a typical application, the operations will satisfy compatibility conditions
making them into algebras (albeit possibly non-associative and/or non-unital) but such conditions
are not required to make this definition.

This notion of morphism should be useful for any category of non-unital algebras. The motivating
application at the time it was introduced was to be able to state the adjunction property for
magma algebras. These are non-unital, non-associative algebras obtained by applying the
group-algebra construction except where we take a type carrying just `Mul` instead of `Group`.

For a plausible future application, one could take the non-unital algebra of compactly-supported
functions on a non-compact topological space. A proper map between a pair of such spaces
(contravariantly) induces a morphism between their algebras of compactly-supported functions which
will be a `NonUnitalAlgHom`.

TODO: add `NonUnitalAlgEquiv` when needed.

## Main definitions

  * `NonUnitalAlgHom`
  * `AlgHom.toNonUnitalAlgHom`

## Tags

non-unital, algebra, morphism
-/

universe u v w w₁ w₂ w₃

variable (R : Type u) (A : Type v) (B : Type w) (C : Type w₁)

/-- A morphism respecting addition, multiplication, and scalar multiplication. When these arise from
algebra structures, this is the same as a not-necessarily-unital morphism of algebras. -/
structure NonUnitalAlgHom [Monoid R] [NonUnitalNonAssocSemiring A] [DistribMulAction R A]
  [NonUnitalNonAssocSemiring B] [DistribMulAction R B] extends A →+[R] B, A →ₙ* B
#align non_unital_alg_hom NonUnitalAlgHom

@[inherit_doc NonUnitalAlgHom]
infixr:25 " →ₙₐ " => NonUnitalAlgHom _

@[inherit_doc]
notation:25 A " →ₙₐ[" R "] " B => NonUnitalAlgHom R A B

attribute [nolint docBlame] NonUnitalAlgHom.toMulHom

/-- `NonUnitalAlgHomClass F R A B` asserts `F` is a type of bundled algebra homomorphisms
from `A` to `B`.  -/
class NonUnitalAlgHomClass (F : Type _) (R : outParam (Type _)) (A : outParam (Type _))
  (B : outParam (Type _)) [Monoid R] [NonUnitalNonAssocSemiring A] [NonUnitalNonAssocSemiring B]
  [DistribMulAction R A] [DistribMulAction R B] extends DistribMulActionHomClass F R A B,
  MulHomClass F A B
#align non_unital_alg_hom_class NonUnitalAlgHomClass

-- Porting note: commented out, not dangerous
-- attribute [nolint dangerousInstance] NonUnitalAlgHomClass.toMulHomClass

namespace NonUnitalAlgHomClass

-- Porting note: Made following instance non-dangerous through [...] -> {_ : ...} replacement
-- See note [lower instance priority]
instance (priority := 100) toNonUnitalRingHomClass {F R A B : Type _}
    {_ : Monoid R} {_ : NonUnitalNonAssocSemiring A} {_ : DistribMulAction R A}
    {_ : NonUnitalNonAssocSemiring B} {_ : DistribMulAction R B}
    [NonUnitalAlgHomClass F R A B] : NonUnitalRingHomClass F A B :=
  { ‹NonUnitalAlgHomClass F R A B› with coe := (⇑) }
#align non_unital_alg_hom_class.non_unital_alg_hom_class.to_non_unital_ring_hom_class NonUnitalAlgHomClass.toNonUnitalRingHomClass

variable {_ : Semiring R} {_ : NonUnitalNonAssocSemiring A} {_ : Module R A}
  {_ : NonUnitalNonAssocSemiring B} {_ : Module R B}

-- see Note [lower instance priority]
instance (priority := 100) {F : Type _} [NonUnitalAlgHomClass F R A B] : LinearMapClass F R A B :=
  { ‹NonUnitalAlgHomClass F R A B› with map_smulₛₗ := map_smul }

instance {F R A B : Type _} [Monoid R] [NonUnitalNonAssocSemiring A] [DistribMulAction R A]
    [NonUnitalNonAssocSemiring B] [DistribMulAction R B] [NonUnitalAlgHomClass F R A B] :
    CoeTC F (A →ₙₐ[R] B)
    where coe f :=
    { (f : A →ₙ+* B) with
      toFun := f
      map_smul' := map_smul f }

end NonUnitalAlgHomClass

namespace NonUnitalAlgHom

variable {R A B C} [Monoid R]

variable [NonUnitalNonAssocSemiring A] [DistribMulAction R A]

variable [NonUnitalNonAssocSemiring B] [DistribMulAction R B]

variable [NonUnitalNonAssocSemiring C] [DistribMulAction R C]

-- Porting note: Replaced with FunLike instance
-- /-- see Note [function coercion] -/
-- instance : CoeFun (A →ₙₐ[R] B) fun _ => A → B :=
--   ⟨toFun⟩

instance : FunLike (A →ₙₐ[R] B) A fun _ => B where
  coe f := f.toFun
  coe_injective' := by rintro ⟨⟨⟨f, _⟩, _⟩, _⟩ ⟨⟨⟨g, _⟩, _⟩, _⟩ h; congr

@[simp]
theorem toFun_eq_coe (f : A →ₙₐ[R] B) : f.toFun = ⇑f :=
  rfl
#align non_unital_alg_hom.to_fun_eq_coe NonUnitalAlgHom.toFun_eq_coe

/-- See Note [custom simps projection] -/
def Simps.apply (f : A →ₙₐ[R] B) : A → B := f

initialize_simps_projections NonUnitalAlgHom
  (toDistribMulActionHom_toMulActionHom_toFun → apply, -toDistribMulActionHom)

@[simp]
protected theorem coe_coe {F : Type _} [NonUnitalAlgHomClass F R A B] (f : F) :
    ⇑(f : A →ₙₐ[R] B) = f :=
  rfl
#align non_unital_alg_hom.coe_coe NonUnitalAlgHom.coe_coe

theorem coe_injective : @Function.Injective (A →ₙₐ[R] B) (A → B) (↑) := by
  rintro ⟨⟨⟨f, _⟩, _⟩, _⟩ ⟨⟨⟨g, _⟩, _⟩, _⟩ h; congr
#align non_unital_alg_hom.coe_injective NonUnitalAlgHom.coe_injective

instance : NonUnitalAlgHomClass (A →ₙₐ[R] B) R A B
    where
  coe f := f.toFun
  coe_injective' := coe_injective
  map_smul f := f.map_smul'
  map_add f := f.map_add'
  map_zero f := f.map_zero'
  map_mul f := f.map_mul'

@[ext]
theorem ext {f g : A →ₙₐ[R] B} (h : ∀ x, f x = g x) : f = g :=
  coe_injective <| funext h
#align non_unital_alg_hom.ext NonUnitalAlgHom.ext

theorem ext_iff {f g : A →ₙₐ[R] B} : f = g ↔ ∀ x, f x = g x :=
  ⟨by
    rintro rfl x
    rfl, ext⟩
#align non_unital_alg_hom.ext_iff NonUnitalAlgHom.ext_iff

theorem congr_fun {f g : A →ₙₐ[R] B} (h : f = g) (x : A) : f x = g x :=
  h ▸ rfl
#align non_unital_alg_hom.congr_fun NonUnitalAlgHom.congr_fun

@[simp]
theorem coe_mk (f : A → B) (h₁ h₂ h₃ h₄) : ⇑(⟨⟨⟨f, h₁⟩, h₂, h₃⟩, h₄⟩ : A →ₙₐ[R] B)  = f :=
  rfl
#align non_unital_alg_hom.coe_mk NonUnitalAlgHom.coe_mk

@[simp]
theorem mk_coe (f : A →ₙₐ[R] B) (h₁ h₂ h₃ h₄) : (⟨⟨⟨f, h₁⟩, h₂, h₃⟩, h₄⟩ : A →ₙₐ[R] B) = f := by
  rfl
#align non_unital_alg_hom.mk_coe NonUnitalAlgHom.mk_coe

instance : CoeOut (A →ₙₐ[R] B) (A →+[R] B) :=
  ⟨toDistribMulActionHom⟩

instance : CoeOut (A →ₙₐ[R] B) (A →ₙ* B) :=
  ⟨toMulHom⟩

@[simp]
theorem toDistribMulActionHom_eq_coe (f : A →ₙₐ[R] B) : f.toDistribMulActionHom = ↑f :=
  rfl
#align non_unital_alg_hom.to_distrib_mul_action_hom_eq_coe NonUnitalAlgHom.toDistribMulActionHom_eq_coe

@[simp]
theorem toMulHom_eq_coe (f : A →ₙₐ[R] B) : f.toMulHom = ↑f :=
  rfl
#align non_unital_alg_hom.to_mul_hom_eq_coe NonUnitalAlgHom.toMulHom_eq_coe

@[simp, norm_cast]
theorem coe_to_distribMulActionHom (f : A →ₙₐ[R] B) : ⇑(f : A →+[R] B) = f :=
  rfl
#align non_unital_alg_hom.coe_to_distrib_mul_action_hom NonUnitalAlgHom.coe_to_distribMulActionHom

@[simp, norm_cast]
theorem coe_to_mulHom (f : A →ₙₐ[R] B) : ⇑(f : A →ₙ* B) = f :=
  rfl
#align non_unital_alg_hom.coe_to_mul_hom NonUnitalAlgHom.coe_to_mulHom

theorem to_mulHom_injective {f g : A →ₙₐ[R] B} (h : (f : A →ₙ* B) = (g : A →ₙ* B)) : f = g := by
  ext a
  exact FunLike.congr_fun h a
#align non_unital_alg_hom.to_mul_hom_injective NonUnitalAlgHom.to_mulHom_injective

@[norm_cast]
theorem coe_distribMulActionHom_mk (f : A →ₙₐ[R] B) (h₁ h₂ h₃ h₄) :
    ((⟨⟨⟨f, h₁⟩, h₂, h₃⟩, h₄⟩ : A →ₙₐ[R] B) : A →+[R] B) = ⟨⟨f, h₁⟩, h₂, h₃⟩ := by
  rfl
#align non_unital_alg_hom.coe_distrib_mul_action_hom_mk NonUnitalAlgHom.coe_distribMulActionHom_mk

@[norm_cast]
theorem coe_mulHom_mk (f : A →ₙₐ[R] B) (h₁ h₂ h₃ h₄) :
    ((⟨⟨⟨f, h₁⟩, h₂, h₃⟩, h₄⟩ : A →ₙₐ[R] B) : A →ₙ* B) = ⟨f, h₄⟩ := by
  rfl
#align non_unital_alg_hom.coe_mul_hom_mk NonUnitalAlgHom.coe_mulHom_mk

-- @[simp] -- Porting note: simp can prove this
protected theorem map_smul (f : A →ₙₐ[R] B) (c : R) (x : A) : f (c • x) = c • f x :=
  map_smul _ _ _
#align non_unital_alg_hom.map_smul NonUnitalAlgHom.map_smul

-- @[simp] -- Porting note: simp can prove this
protected theorem map_add (f : A →ₙₐ[R] B) (x y : A) : f (x + y) = f x + f y :=
  map_add _ _ _
#align non_unital_alg_hom.map_add NonUnitalAlgHom.map_add

-- @[simp] -- Porting note: simp can prove this
protected theorem map_mul (f : A →ₙₐ[R] B) (x y : A) : f (x * y) = f x * f y :=
  map_mul _ _ _
#align non_unital_alg_hom.map_mul NonUnitalAlgHom.map_mul

-- @[simp] -- Porting note: simp can prove this
protected theorem map_zero (f : A →ₙₐ[R] B) : f 0 = 0 :=
  map_zero _
#align non_unital_alg_hom.map_zero NonUnitalAlgHom.map_zero

instance : Zero (A →ₙₐ[R] B) :=
  ⟨{ (0 : A →+[R] B) with map_mul' := by simp }⟩

instance : One (A →ₙₐ[R] A) :=
  ⟨{ (1 : A →+[R] A) with map_mul' := by simp }⟩

@[simp]
theorem coe_zero : ⇑(0 : A →ₙₐ[R] B) = 0 :=
  rfl
#align non_unital_alg_hom.coe_zero NonUnitalAlgHom.coe_zero

@[simp]
theorem coe_one : ((1 : A →ₙₐ[R] A) : A → A) = id :=
  rfl
#align non_unital_alg_hom.coe_one NonUnitalAlgHom.coe_one

theorem zero_apply (a : A) : (0 : A →ₙₐ[R] B) a = 0 :=
  rfl
#align non_unital_alg_hom.zero_apply NonUnitalAlgHom.zero_apply

theorem one_apply (a : A) : (1 : A →ₙₐ[R] A) a = a :=
  rfl
#align non_unital_alg_hom.one_apply NonUnitalAlgHom.one_apply

instance : Inhabited (A →ₙₐ[R] B) :=
  ⟨0⟩

/-- The composition of morphisms is a morphism. -/
def comp (f : B →ₙₐ[R] C) (g : A →ₙₐ[R] B) : A →ₙₐ[R] C :=
  { (f : B →ₙ* C).comp (g : A →ₙ* B), (f : B →+[R] C).comp (g : A →+[R] B) with }
#align non_unital_alg_hom.comp NonUnitalAlgHom.comp

@[simp, norm_cast]
theorem coe_comp (f : B →ₙₐ[R] C) (g : A →ₙₐ[R] B) :
    ⇑(f.comp g) = (⇑f) ∘ (⇑g) :=
  rfl
#align non_unital_alg_hom.coe_comp NonUnitalAlgHom.coe_comp

theorem comp_apply (f : B →ₙₐ[R] C) (g : A →ₙₐ[R] B) (x : A) : f.comp g x = f (g x) :=
  rfl
#align non_unital_alg_hom.comp_apply NonUnitalAlgHom.comp_apply

/-- The inverse of a bijective morphism is a morphism. -/
def inverse (f : A →ₙₐ[R] B) (g : B → A) (h₁ : Function.LeftInverse g f)
    (h₂ : Function.RightInverse g f) : B →ₙₐ[R] A :=
  { (f : A →ₙ* B).inverse g h₁ h₂, (f : A →+[R] B).inverse g h₁ h₂ with }
#align non_unital_alg_hom.inverse NonUnitalAlgHom.inverse

@[simp]
theorem coe_inverse (f : A →ₙₐ[R] B) (g : B → A) (h₁ : Function.LeftInverse g f)
    (h₂ : Function.RightInverse g f) : (inverse f g h₁ h₂ : B → A) = g :=
  rfl
#align non_unital_alg_hom.coe_inverse NonUnitalAlgHom.coe_inverse

/-! ### Operations on the product type

Note that much of this is copied from [`LinearAlgebra/Prod`](../../LinearAlgebra/Prod). -/

section Prod

variable (R A B)

/-- The first projection of a product is a non-unital alg_hom. -/
@[simps]
def fst : A × B →ₙₐ[R] A where
  toFun := Prod.fst
  map_zero' := rfl
  map_add' _ _ := rfl
  map_smul' _ _ := rfl
  map_mul' _ _ := rfl
#align non_unital_alg_hom.fst NonUnitalAlgHom.fst

/-- The second projection of a product is a non-unital alg_hom. -/
@[simps]
def snd : A × B →ₙₐ[R] B where
  toFun := Prod.snd
  map_zero' := rfl
  map_add' _ _ := rfl
  map_smul' _ _ := rfl
  map_mul' _ _ := rfl
#align non_unital_alg_hom.snd NonUnitalAlgHom.snd

variable {R A B}

/-- The prod of two morphisms is a morphism. -/
@[simps]
def prod (f : A →ₙₐ[R] B) (g : A →ₙₐ[R] C) : A →ₙₐ[R] B × C
    where
  toFun := Pi.prod f g
  map_zero' := by simp only [Pi.prod, Prod.zero_eq_mk, map_zero]
  map_add' x y := by simp only [Pi.prod, Prod.mk_add_mk, map_add]
  map_mul' x y := by simp only [Pi.prod, Prod.mk_mul_mk, map_mul]
  map_smul' c x := by simp only [Pi.prod, Prod.smul_mk, map_smul, RingHom.id_apply]
#align non_unital_alg_hom.prod NonUnitalAlgHom.prod

theorem coe_prod (f : A →ₙₐ[R] B) (g : A →ₙₐ[R] C) : ⇑(f.prod g) = Pi.prod f g :=
  rfl
#align non_unital_alg_hom.coe_prod NonUnitalAlgHom.coe_prod

@[simp]
theorem fst_prod (f : A →ₙₐ[R] B) (g : A →ₙₐ[R] C) : (fst R B C).comp (prod f g) = f := by
  rfl
#align non_unital_alg_hom.fst_prod NonUnitalAlgHom.fst_prod

@[simp]
theorem snd_prod (f : A →ₙₐ[R] B) (g : A →ₙₐ[R] C) : (snd R B C).comp (prod f g) = g := by
  rfl
#align non_unital_alg_hom.snd_prod NonUnitalAlgHom.snd_prod

@[simp]
theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 :=
  coe_injective Pi.prod_fst_snd
#align non_unital_alg_hom.prod_fst_snd NonUnitalAlgHom.prod_fst_snd

/-- Taking the product of two maps with the same domain is equivalent to taking the product of
their codomains. -/
@[simps]
def prodEquiv : (A →ₙₐ[R] B) × (A →ₙₐ[R] C) ≃ (A →ₙₐ[R] B × C)
    where
  toFun f := f.1.prod f.2
  invFun f := ((fst _ _ _).comp f, (snd _ _ _).comp f)
  left_inv _ := rfl
  right_inv _ := rfl
#align non_unital_alg_hom.prod_equiv NonUnitalAlgHom.prodEquiv

variable (R A B)

/-- The left injection into a product is a non-unital algebra homomorphism. -/
def inl : A →ₙₐ[R] A × B :=
  prod 1 0
#align non_unital_alg_hom.inl NonUnitalAlgHom.inl

/-- The right injection into a product is a non-unital algebra homomorphism. -/
def inr : B →ₙₐ[R] A × B :=
  prod 0 1
#align non_unital_alg_hom.inr NonUnitalAlgHom.inr

variable {R A B}

@[simp]
theorem coe_inl : (inl R A B : A → A × B) = fun x => (x, 0) :=
  rfl
#align non_unital_alg_hom.coe_inl NonUnitalAlgHom.coe_inl

theorem inl_apply (x : A) : inl R A B x = (x, 0) :=
  rfl
#align non_unital_alg_hom.inl_apply NonUnitalAlgHom.inl_apply

@[simp]
theorem coe_inr : (inr R A B : B → A × B) = Prod.mk 0 :=
  rfl
#align non_unital_alg_hom.coe_inr NonUnitalAlgHom.coe_inr

theorem inr_apply (x : B) : inr R A B x = (0, x) :=
  rfl
#align non_unital_alg_hom.inr_apply NonUnitalAlgHom.inr_apply

end Prod

end NonUnitalAlgHom

/-! ### Interaction with `alg_hom` -/

namespace AlgHom

variable {R A B} {_ : CommSemiring R} {_ : Semiring A} {_ : Semiring B} {_ : Algebra R A}
  {_ : Algebra R B}

-- see Note [lower instance priority]
instance (priority := 100) {F : Type _} [AlgHomClass F R A B] : NonUnitalAlgHomClass F R A B :=
  { ‹AlgHomClass F R A B› with map_smul := map_smul }

/-- A unital morphism of algebras is a `NonUnitalAlgHom`. -/
@[coe]
def toNonUnitalAlgHom (f : A →ₐ[R] B) : A →ₙₐ[R] B :=
  { f with map_smul' := map_smul f }
#align alg_hom.to_non_unital_alg_hom AlgHom.toNonUnitalAlgHom

instance NonUnitalAlgHom.hasCoe : CoeOut (A →ₐ[R] B) (A →ₙₐ[R] B) :=
  ⟨toNonUnitalAlgHom⟩
#align alg_hom.non_unital_alg_hom.has_coe AlgHom.NonUnitalAlgHom.hasCoe

@[simp]
theorem toNonUnitalAlgHom_eq_coe (f : A →ₐ[R] B) : f.toNonUnitalAlgHom = f :=
  rfl
#align alg_hom.to_non_unital_alg_hom_eq_coe AlgHom.toNonUnitalAlgHom_eq_coe

@[simp, norm_cast]
theorem coe_to_nonUnitalAlgHom (f : A →ₐ[R] B) : ⇑(f.toNonUnitalAlgHom) = ⇑f :=
  rfl
#align alg_hom.coe_to_non_unital_alg_hom AlgHom.coe_to_nonUnitalAlgHom

end AlgHom


/- This defines a preorder comparison function for comparing elements, and
the notation of a monotonic search predicate for searching within a ordered set.
 -/
import .ordering

section
open ordering

/--
Extend has_ordering to require the cmp function is consistent with a total
preordering.
-/
class has_preordering (α : Type _) extends has_ordering α :=
(refl : ∀ (a: α), cmp a a = eq)
(le_trans : ∀(a b c : α), cmp a b ≤ eq → cmp b c ≤ eq → cmp a c ≠ gt)
(gt_lt_symm : ∀ (a b : α), cmp a b = gt ↔ cmp b a = lt)

end

namespace has_preordering
section
parameters {α : Type _} [has_preordering α]

open has_ordering
open ordering

theorem eq_symm : ∀ (a b : α), cmp a b = eq → cmp b a = eq :=
begin
  intros a b,
  have h0 := gt_lt_symm a b,
  have h1 := gt_lt_symm b a,
  destruct (cmp a b); destruct (cmp b a); cc,
end

theorem eq_trans : ∀ (a b c : α), cmp a b = eq → cmp b c = eq → cmp a c = eq :=
begin
  intros a b c ab bc,
  have h0 := eq_symm a b,
  have h1 := eq_symm b c,
  have h2 := le_trans c b a,
  have h3 := gt_lt_symm c a,
  have h4 := le_trans a b c,
  have h5 : lt ≤ eq := dec_trivial,
  have h6 : eq ≤ eq := dec_trivial,
  destruct (cmp a c); cc,
end

theorem lt_of_lt_of_lt : ∀(a b c : α), cmp a b = lt → cmp b c = lt → cmp a c = lt :=
begin
  intros a b c ab bc,
  have h0 := eq_symm a c,
  have h1 := le_trans c a b,
  have h2 : eq ≤ eq := dec_trivial,
  have h3 : lt ≤ eq := dec_trivial,
  have h4 := gt_lt_symm c b,
  have h5 := le_trans a b c,
  destruct (cmp a c); cc,
end

theorem lt_of_lt_of_eq : ∀(a b c : α), cmp a b = lt → cmp b c = eq → cmp a c = lt :=
begin
  intros a b c,
  have h0 := gt_lt_symm b a,
  have h1 := eq_symm a c,
  have h2 := le_trans b c a,
  have h3 := le_trans a b c,
  have h4 : lt ≤ eq := dec_trivial,
  have h5 : eq ≤ eq := dec_trivial,
  destruct (cmp a c); cc,
end

theorem lt_of_eq_of_lt : ∀(a b c : α), cmp a b = eq → cmp b c = lt → cmp a c = lt :=
begin
  intros a b c,
  have h0 := gt_lt_symm a c,
  have h1 := gt_lt_symm c b,
  have h2 := eq_symm a c,
  have h3 := le_trans c a b,
  have h4 : lt ≤ eq := dec_trivial,
  have h5 : eq ≤ eq := dec_trivial,
  destruct (cmp a c); try { cc },
end

theorem swap_cmp (x y : α)
: (has_ordering.cmp x y).swap = has_ordering.cmp y x :=
begin
  have gt_lt := (gt_lt_symm y x),
  have eq_eq := (eq_symm x y),
  have lt_gt := (gt_lt_symm x y),
  destruct (has_ordering.cmp x y);
  intros d0;
  simp only [d0, ordering.swap];
  cc,
end

end
end has_preordering

-----------------------------------------------------------------------
-- monotonic_find

section
open ordering

/-- This is a search procedure which given an element returns whether
the element is less than, equal to, or greater than the value being searched for.

Note that these axioms will imply that `cmp x = ordering.eq` and `cmp y = ordering.eq`
implies `has_ordering.cmp x y`.
-/
class monotonic_find {E: Type _} [has_preordering E] (cmp : E → ordering) :=
(gt_increases : ∀(x y : E), has_ordering.cmp x y = gt → eq ≤ cmp y → cmp x = gt)
(eq_preserves : ∀(x y : E), has_ordering.cmp x y = eq → cmp x = cmp y)
(lt_decreases : ∀(x y : E), has_ordering.cmp x y = lt → cmp y ≤ eq → cmp x = lt)

end

namespace monotonic_find

/-- This is used to search for an element equivalent to a given element.-/
def eq {α : Type _} [has_preordering α] (e y : α) : ordering := has_ordering.cmp y e

instance eq_is_cmp {α : Type _} [has_preordering α] (e : α) : monotonic_find (eq e) :=
{ gt_increases :=
  begin
    unfold eq,
    intros x y x_gt_y e_ge_y,
    have h0 : ¬ (ordering.eq ≤ ordering.lt) := dec_trivial,
    have h1 := has_preordering.eq_symm y e,
    have h2 := has_preordering.gt_lt_symm x y,
    have h3 := has_preordering.gt_lt_symm x e,
    have h4 := has_preordering.gt_lt_symm y e,
    have h5 := has_preordering.lt_of_eq_of_lt e y x,
    have h6 := has_preordering.lt_of_lt_of_lt e y x,
    destruct has_ordering.cmp y e; intros cmp_y_e; cc,
  end
, eq_preserves :=
  begin
    unfold eq,
    intros x y x_eq_y,
    have h0 := has_preordering.eq_symm x y,
    have h1 := has_preordering.gt_lt_symm x e,
    have h2 := has_preordering.gt_lt_symm y e,
    have h3 := has_preordering.lt_of_eq_of_lt y x e,
    have h4 := has_preordering.eq_trans y x e,
    have h5 := has_preordering.lt_of_lt_of_eq e x y,
    destruct has_ordering.cmp x e; intro cmp_x_e; cc,
  end
, lt_decreases :=
  begin
    unfold eq,
    intros x y x_lt_y y_le_e,
    have h0 : ¬ (ordering.gt ≤ ordering.eq) := dec_trivial,
    have h1 := has_preordering.lt_of_lt_of_lt x y e,
    have h2 := has_preordering.lt_of_lt_of_eq x y e,
    destruct has_ordering.cmp y e; intros cmp_y_e; cc,
  end
}

end monotonic_find


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

namespace tactic

open expr
open tactic.interactive ( casesm constructor_matching )

/--
  find all assumptions of the shape `¬ (p ∧ q)` or `¬ (p ∨ q)` and
  replace them using de Morgan's law.
-/
meta def distrib_not : tactic unit :=
do hs ← local_context,
   hs.for_each $ λ h,
    all_goals' $
    iterate_at_most' 3 $
      do h ← get_local h.local_pp_name,
         e ← infer_type h,
         match e with
         | `(¬ _ = _) := replace h.local_pp_name ``(mt iff.to_eq %%h)
         | `(_ ≠ _)   := replace h.local_pp_name ``(mt iff.to_eq %%h)
         | `(_ = _)   := replace h.local_pp_name ``(eq.to_iff %%h)
         | `(¬ (_ ∧ _))  := replace h.local_pp_name ``(decidable.not_and_distrib'.mp %%h) <|>
                            replace h.local_pp_name ``(decidable.not_and_distrib.mp %%h)
         | `(¬ (_ ∨ _))  := replace h.local_pp_name ``(not_or_distrib.mp %%h)
         | `(¬ ¬ _)      := replace h.local_pp_name ``(decidable.of_not_not %%h)
         | `(¬ (_ → (_ : Prop))) := replace h.local_pp_name ``(decidable.not_imp.mp %%h)
         | `(¬ (_ ↔ _)) := replace h.local_pp_name ``(decidable.not_iff.mp %%h)
         | `(_ ↔ _) := replace h.local_pp_name ``(decidable.iff_iff_and_or_not_and_not.mp %%h) <|>
                       replace h.local_pp_name
                         ``(decidable.iff_iff_and_or_not_and_not.mp (%%h).symm) <|>
                       () <$ tactic.cases h
         | `(_ → _)     := replace h.local_pp_name ``(decidable.not_or_of_imp %%h)
         | _ := failed
         end

/-!
  The following definitions maintain a path compression datastructure, i.e. a forest such that:
    - every node is the type of a hypothesis
    - there is a edge between two nodes only if they are provably equivalent
    - every edge is labelled with a proof of equivalence for its vertices
    - edges are added when normalizing propositions.
-/

meta def tauto_state := ref $ expr_map (option (expr × expr))

meta def modify_ref {α : Type} (r : ref α) (f : α → α) :=
read_ref r >>= write_ref r ∘ f

meta def add_refl (r : tauto_state) (e : expr) : tactic (expr × expr) :=
do m ← read_ref r,
   p ← mk_mapp `rfl [none,e],
   write_ref r $ m.insert e none,
   return (e,p)

/--
  If there exists a symmetry lemma that can be applied to the hypothesis `e`,
  store it.
-/
meta def add_symm_proof (r : tauto_state) (e : expr) : tactic (expr × expr) :=
do env ← get_env,
   let rel := e.get_app_fn.const_name,
   some symm ← pure $ environment.symm_for env rel
     | add_refl r e,
   (do e' ← mk_meta_var `(Prop),
       iff_t ← to_expr ``(%%e = %%e'),
       (_,p) ← solve_aux iff_t
         (applyc `iff.to_eq ; () <$ split ; applyc symm),
       e' ← instantiate_mvars e',
       m ← read_ref r,
       write_ref r $ (m.insert e (e',p)).insert e' none,
       return (e',p) )
   <|> add_refl r e

meta def add_edge (r : tauto_state) (x y p : expr) : tactic unit :=
modify_ref r $ λ m, m.insert x (y,p)

/--
  Retrieve the root of the hypothesis `e` from the proof forest.
  If `e` has not been internalized, add it to the proof forest.
-/
meta def root (r : tauto_state) : expr → tactic (expr × expr) | e :=
do m ← read_ref r,
   let record_e : tactic (expr × expr) :=
       match e with
       | v@(expr.mvar _ _ _) :=
         (do (e,p) ← get_assignment v >>= root,
             add_edge r v e p,
             return (e,p)) <|>
         add_refl r e
       | _ := add_refl r e
       end,
   some e' ← pure $ m.find e | record_e,
   match e' with
   | (some (e',p')) :=
     do (e'',p'') ← root e',
        p'' ← mk_app `eq.trans [p',p''],
        add_edge r e e'' p'',
        pure (e'',p'')
   | none := prod.mk e <$> mk_mapp `rfl [none,some e]
   end

/--
  Given hypotheses `a` and `b`, build a proof that `a` is equivalent to `b`,
  applying congruence and recursing into arguments if `a` and `b`
  are applications of function symbols.
-/
meta def symm_eq (r : tauto_state) : expr → expr → tactic expr | a b :=
do m ← read_ref r,
   (a',pa) ← root r a,
   (b',pb) ← root r b,
   (unify a' b' >> add_refl r a' *> mk_mapp `rfl [none,a]) <|>
    do p ← match (a', b') with
           | (`(¬ %%a₀), `(¬ %%b₀)) :=
             do p  ← symm_eq a₀ b₀,
                p' ← mk_app `congr_arg [`(not),p],
                add_edge r a' b' p',
                return p'
           | (`(%%a₀ ∧ %%a₁), `(%%b₀ ∧ %%b₁)) :=
             do p₀ ← symm_eq a₀ b₀,
                p₁ ← symm_eq a₁ b₁,
                p' ← to_expr ``(congr (congr_arg and %%p₀) %%p₁),
                add_edge r a' b' p',
                return p'
           | (`(%%a₀ ∨ %%a₁), `(%%b₀ ∨ %%b₁)) :=
             do p₀ ← symm_eq a₀ b₀,
                p₁ ← symm_eq a₁ b₁,
                p' ← to_expr ``(congr (congr_arg or %%p₀) %%p₁),
                add_edge r a' b' p',
                return p'
           | (`(%%a₀ ↔ %%a₁), `(%%b₀ ↔ %%b₁)) :=
             (do p₀ ← symm_eq a₀ b₀,
                 p₁ ← symm_eq a₁ b₁,
                 p' ← to_expr ``(congr (congr_arg iff %%p₀) %%p₁),
                 add_edge r a' b' p',
                 return p') <|>
             do p₀ ← symm_eq a₀ b₁,
                p₁ ← symm_eq a₁ b₀,
                p' ← to_expr ``(eq.trans (congr (congr_arg iff %%p₀) %%p₁)
                                         (iff.to_eq iff.comm ) ),
                add_edge r a' b' p',
                return p'
           | (`(%%a₀ → %%a₁), `(%%b₀ → %%b₁)) :=
             if ¬ a₁.has_var ∧ ¬ b₁.has_var then
             do p₀ ← symm_eq a₀ b₀,
                p₁ ← symm_eq a₁ b₁,
                p' ← mk_app `congr_arg [`(implies),p₀,p₁],
                add_edge r a' b' p',
                return p'
             else unify a' b' >> add_refl r a' *> mk_mapp `rfl [none,a]
           | (_, _) :=
             (do guard $ a'.get_app_fn.is_constant ∧
                         a'.get_app_fn.const_name = b'.get_app_fn.const_name,
                 (a'',pa') ← add_symm_proof r a',
                 guard $ a'' =ₐ b',
                 pure pa' )
           end,
    p' ← mk_eq_trans pa p,
    add_edge r a' b' p',
    mk_eq_symm pb >>= mk_eq_trans p'

meta def find_eq_type (r : tauto_state) : expr → list expr → tactic (expr × expr)
| e []         := failed
| e (H :: Hs) :=
  do t  ← infer_type H,
     (prod.mk H <$> symm_eq r e t) <|> find_eq_type e Hs

private meta def contra_p_not_p (r : tauto_state) : list expr → list expr → tactic unit
| []         Hs := failed
| (H1 :: Rs) Hs :=
  do t ← (extract_opt_auto_param <$> infer_type H1) >>= whnf,
     (do a   ← match_not t,
         (H2,p)  ← find_eq_type r a Hs,
         H2 ← to_expr ``( (%%p).mpr %%H2 ),
         tgt ← target,
         pr  ← mk_app `absurd [tgt, H2, H1],
         tactic.exact pr)
     <|> contra_p_not_p Rs Hs

meta def contradiction_with (r : tauto_state) : tactic unit :=
contradiction <|>
do tactic.try intro1,
   ctx ← local_context,
   contra_p_not_p r ctx ctx

meta def contradiction_symm :=
using_new_ref (native.rb_map.mk _ _) contradiction_with

meta def assumption_with (r : tauto_state) : tactic unit :=
do { ctx ← local_context,
     t   ← target,
     (H,p) ← find_eq_type r t ctx,
     mk_eq_mpr p H >>= tactic.exact }
<|> fail "assumption tactic failed"

meta def assumption_symm :=
using_new_ref (native.rb_map.mk _ _) assumption_with

/--
  Configuration options for `tauto`.
  If `classical` is `tt`, runs `classical` before the rest of `tauto`.
  `closer` is run on any remaining subgoals left by `tauto_core; basic_tauto_tacs`.
-/
meta structure tauto_cfg :=
(classical : bool     := ff)
(closer : tactic unit := pure ())

meta def tautology (cfg : tauto_cfg := {}) : tactic unit := focus1 $
  let basic_tauto_tacs : list (tactic unit) :=
        [reflexivity, solve_by_elim,
          constructor_matching none [``(_ ∧ _),``(_ ↔ _),``(Exists _),``(true)]],

      tauto_core (r : tauto_state) : tactic unit :=
        do try (contradiction_with r);
           try (assumption_with r);
           repeat (do
             gs ← get_goals,
             repeat (() <$ tactic.intro1);
             distrib_not;
             casesm (some ()) [``(_ ∧ _),``(_ ∨ _),``(Exists _),``(false)];
             try (contradiction_with r);
             try (target >>= match_or >> refine ``( or_iff_not_imp_left.mpr _));
             try (target >>= match_or >> refine ``( or_iff_not_imp_right.mpr _));
             repeat (() <$ tactic.intro1);
             constructor_matching (some ()) [``(_ ∧ _),``(_ ↔ _),``(true)];
             try (assumption_with r),
             gs' ← get_goals,
             guard (gs ≠ gs') ) in

    do when cfg.classical classical,
       using_new_ref (expr_map.mk _) tauto_core;
       repeat (first basic_tauto_tacs); cfg.closer, done

namespace interactive
local postfix `?`:9001 := optional
setup_tactic_parser

/--
`tautology` breaks down assumptions of the form `_ ∧ _`, `_ ∨ _`, `_ ↔ _` and `∃ _, _`
and splits a goal of the form `_ ∧ _`, `_ ↔ _` or `∃ _, _` until it can be discharged
using `reflexivity` or `solve_by_elim`.
This is a finishing tactic: it either closes the goal or raises an error.
The variant `tautology!` uses the law of excluded middle.

`tautology {closer := tac}` will use `tac` on any subgoals created by `tautology`
that it is unable to solve before failing.
-/
meta def tautology (c : parse $ (tk "!")?) (cfg : tactic.tauto_cfg := {}) :=
tactic.tautology $ { classical := c.is_some, ..cfg }

-- Now define a shorter name for the tactic `tautology`.

/--
`tauto` breaks down assumptions of the form `_ ∧ _`, `_ ∨ _`, `_ ↔ _` and `∃ _, _`
and splits a goal of the form `_ ∧ _`, `_ ↔ _` or `∃ _, _` until it can be discharged
using `reflexivity` or `solve_by_elim`.
This is a finishing tactic: it either closes the goal or raises an error.
The variant `tauto!` uses the law of excluded middle.

`tauto {closer := tac}` will use `tac` on any subgoals created by `tauto`
that it is unable to solve before failing.
-/
meta def tauto (c : parse $ (tk "!")?) (cfg : tactic.tauto_cfg := {}) : tactic unit :=
tautology c cfg

add_hint_tactic "tauto"

/--
This tactic (with shorthand `tauto`) breaks down assumptions of the form
`_ ∧ _`, `_ ∨ _`, `_ ↔ _` and `∃ _, _`
and splits a goal of the form `_ ∧ _`, `_ ↔ _` or `∃ _, _` until it can be discharged
using `reflexivity` or `solve_by_elim`. This is a finishing tactic: it
either closes the goal or raises an error.

The variants `tautology!` and `tauto!` use the law of excluded middle.

For instance, one can write:
```lean
example (p q r : Prop) [decidable p] [decidable r] : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (r ∨ p ∨ r) := by tauto
```
and the decidability assumptions can be dropped if `tauto!` is used
instead of `tauto`.

`tauto {closer := tac}` will use `tac` on any subgoals created by `tauto`
that it is unable to solve before failing.
-/
add_tactic_doc
{ name       := "tautology",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.tautology, `tactic.interactive.tauto],
  tags       := ["logic", "decision procedure"] }

end interactive
end tactic


import data.set.lattice

/-!
# Order theoretic results
-/

open function set

variables {ι α β : Type*}

lemma csupr_neg [complete_lattice α] {p : Prop} {f : p → α} (hp : ¬ p) : (⨆ h, f h) = ⊥ :=
supr_eq_bot.2 $ λ h, (hp h).elim

namespace set
variables (f : α → β) {s t : set α}

@[simp] lemma compl_eq_empty : sᶜ = ∅ ↔ s = univ := compl_eq_bot
@[simp] lemma compl_eq_univ : sᶜ = univ ↔ s = ∅ := compl_eq_top

lemma image_sUnion (f : α → β) (S : set (set α)) : f '' ⋃₀ S = ⋃ s ∈ S, f '' s :=
by rw [sUnion_eq_bUnion, image_Union₂]

--TODO: Rename `Union_neg` to `neg_Union`
@[simp] lemma Union_pos {p : Prop} {f : p → set α} (hp : p) : (⋃ h, f h) = f hp := supr_pos hp
@[simp] lemma Union_neg' {p : Prop} {f : p → set α} (hp : ¬ p) : (⋃ h, f h) = ∅ := csupr_neg hp

variables (s)

@[simp] lemma empty_symm_diff : ∅ ∆ s = s := bot_symm_diff _
@[simp] lemma symm_diff_empty : s ∆ ∅ = s := symm_diff_bot _

end set


/-
Copyright (c) 2019 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 logic.equiv.local_equiv
import topology.sets.opens

/-!
# Local homeomorphisms

This file defines homeomorphisms between open subsets of topological spaces. An element `e` of
`local_homeomorph α β` is an extension of `local_equiv α β`, i.e., it is a pair of functions
`e.to_fun` and `e.inv_fun`, inverse of each other on the sets `e.source` and `e.target`.
Additionally, we require that these sets are open, and that the functions are continuous on them.
Equivalently, they are homeomorphisms there.

As in equivs, we register a coercion to functions, and we use `e x` and `e.symm x` throughout
instead of `e.to_fun x` and `e.inv_fun x`.

## Main definitions

`homeomorph.to_local_homeomorph`: associating a local homeomorphism to a homeomorphism, with
                                  source = target = univ
`local_homeomorph.symm`  : the inverse of a local homeomorphism
`local_homeomorph.trans` : the composition of two local homeomorphisms
`local_homeomorph.refl`  : the identity local homeomorphism
`local_homeomorph.of_set`: the identity on a set `s`
`eq_on_source`           : equivalence relation describing the "right" notion of equality for local
                           homeomorphisms

## Implementation notes

Most statements are copied from their local_equiv versions, although some care is required
especially when restricting to subsets, as these should be open subsets.

For design notes, see `local_equiv.lean`.

### Local coding conventions

If a lemma deals with the intersection of a set with either source or target of a `local_equiv`,
then it should use `e.source ∩ s` or `e.target ∩ t`, not `s ∩ e.source` or `t ∩ e.target`.
-/

open function set filter topological_space (second_countable_topology)
open_locale topological_space

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
[topological_space α] [topological_space β] [topological_space γ] [topological_space δ]

/-- local homeomorphisms, defined on open subsets of the space -/
@[nolint has_inhabited_instance]
structure local_homeomorph (α : Type*) (β : Type*) [topological_space α] [topological_space β]
  extends local_equiv α β :=
(open_source        : is_open source)
(open_target        : is_open target)
(continuous_to_fun  : continuous_on to_fun source)
(continuous_inv_fun : continuous_on inv_fun target)

/-- A homeomorphism induces a local homeomorphism on the whole space -/
def homeomorph.to_local_homeomorph (e : α ≃ₜ β) :
  local_homeomorph α β :=
{ open_source        := is_open_univ,
  open_target        := is_open_univ,
  continuous_to_fun  := by { erw ← continuous_iff_continuous_on_univ, exact e.continuous_to_fun },
  continuous_inv_fun := by { erw ← continuous_iff_continuous_on_univ, exact e.continuous_inv_fun },
  ..e.to_equiv.to_local_equiv }

namespace local_homeomorph

variables (e : local_homeomorph α β) (e' : local_homeomorph β γ)

instance : has_coe_to_fun (local_homeomorph α β) (λ _, α → β) := ⟨λ e, e.to_fun⟩

/-- The inverse of a local homeomorphism -/
protected def symm : local_homeomorph β α :=
{ open_source        := e.open_target,
  open_target        := e.open_source,
  continuous_to_fun  := e.continuous_inv_fun,
  continuous_inv_fun := e.continuous_to_fun,
  ..e.to_local_equiv.symm }

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (e : local_homeomorph α β) : α → β := e
/-- See Note [custom simps projection] -/
def simps.symm_apply (e : local_homeomorph α β) : β → α := e.symm

initialize_simps_projections local_homeomorph
  (to_local_equiv_to_fun → apply, to_local_equiv_inv_fun → symm_apply,
   to_local_equiv_source → source, to_local_equiv_target → target, -to_local_equiv)

protected lemma continuous_on : continuous_on e e.source := e.continuous_to_fun

lemma continuous_on_symm : continuous_on e.symm e.target := e.continuous_inv_fun

@[simp, mfld_simps] lemma mk_coe (e : local_equiv α β) (a b c d) :
  (local_homeomorph.mk e a b c d : α → β) = e := rfl

@[simp, mfld_simps] lemma mk_coe_symm (e : local_equiv α β) (a b c d) :
  ((local_homeomorph.mk e a b c d).symm : β → α) = e.symm := rfl

/- Register a few simp lemmas to make sure that `simp` puts the application of a local
homeomorphism in its normal form, i.e., in terms of its coercion to a function. -/

@[simp, mfld_simps] lemma to_fun_eq_coe (e : local_homeomorph α β) : e.to_fun = e := rfl

@[simp, mfld_simps] lemma inv_fun_eq_coe (e : local_homeomorph α β) : e.inv_fun = e.symm := rfl

@[simp, mfld_simps] lemma coe_coe : (e.to_local_equiv : α → β) = e := rfl

@[simp, mfld_simps] lemma coe_coe_symm : (e.to_local_equiv.symm : β → α) = e.symm := rfl

@[simp, mfld_simps] lemma map_source {x : α} (h : x ∈ e.source) : e x ∈ e.target :=
e.map_source' h

@[simp, mfld_simps] lemma map_target {x : β} (h : x ∈ e.target) : e.symm x ∈ e.source :=
e.map_target' h

@[simp, mfld_simps] lemma left_inv {x : α} (h : x ∈ e.source) : e.symm (e x) = x :=
e.left_inv' h

@[simp, mfld_simps] lemma right_inv {x : β} (h : x ∈ e.target) : e (e.symm x) = x :=
e.right_inv' h

protected lemma maps_to : maps_to e e.source e.target := λ x, e.map_source
protected lemma symm_maps_to : maps_to e.symm e.target e.source := e.symm.maps_to
protected lemma left_inv_on : left_inv_on e.symm e e.source := λ x, e.left_inv
protected lemma right_inv_on : right_inv_on e.symm e e.target := λ x, e.right_inv
protected lemma inv_on : inv_on e.symm e e.source e.target := ⟨e.left_inv_on, e.right_inv_on⟩
protected lemma inj_on : inj_on e e.source := e.left_inv_on.inj_on
protected lemma bij_on : bij_on e e.source e.target := e.inv_on.bij_on e.maps_to e.symm_maps_to
protected lemma surj_on : surj_on e e.source e.target := e.bij_on.surj_on

/-- Replace `to_local_equiv` field to provide better definitional equalities. -/
def replace_equiv (e : local_homeomorph α β) (e' : local_equiv α β) (h : e.to_local_equiv = e') :
  local_homeomorph α β :=
{ to_local_equiv := e',
  open_source := h ▸ e.open_source,
  open_target := h ▸ e.open_target,
  continuous_to_fun := h ▸ e.continuous_to_fun,
  continuous_inv_fun := h ▸ e.continuous_inv_fun }

lemma replace_equiv_eq_self (e : local_homeomorph α β) (e' : local_equiv α β)
  (h : e.to_local_equiv = e') :
  e.replace_equiv e' h = e :=
by { cases e, subst e', refl }

lemma source_preimage_target : e.source ⊆ e ⁻¹' e.target := e.maps_to

lemma eq_of_local_equiv_eq {e e' : local_homeomorph α β}
  (h : e.to_local_equiv = e'.to_local_equiv) : e = e' :=
by { cases e, cases e', cases h, refl }

lemma eventually_left_inverse (e : local_homeomorph α β) {x} (hx : x ∈ e.source) :
  ∀ᶠ y in 𝓝 x, e.symm (e y) = y :=
(e.open_source.eventually_mem hx).mono e.left_inv'

lemma eventually_left_inverse' (e : local_homeomorph α β) {x} (hx : x ∈ e.target) :
  ∀ᶠ y in 𝓝 (e.symm x), e.symm (e y) = y :=
e.eventually_left_inverse (e.map_target hx)

lemma eventually_right_inverse (e : local_homeomorph α β) {x} (hx : x ∈ e.target) :
  ∀ᶠ y in 𝓝 x, e (e.symm y) = y :=
(e.open_target.eventually_mem hx).mono e.right_inv'

lemma eventually_right_inverse' (e : local_homeomorph α β) {x} (hx : x ∈ e.source) :
  ∀ᶠ y in 𝓝 (e x), e (e.symm y) = y :=
e.eventually_right_inverse (e.map_source hx)

lemma eventually_ne_nhds_within (e : local_homeomorph α β) {x} (hx : x ∈ e.source) :
  ∀ᶠ x' in 𝓝[≠] x, e x' ≠ e x :=
eventually_nhds_within_iff.2 $ (e.eventually_left_inverse hx).mono $
  λ x' hx', mt $ λ h, by rw [mem_singleton_iff, ← e.left_inv hx, ← h, hx']

lemma nhds_within_source_inter {x} (hx : x ∈ e.source) (s : set α) :
  𝓝[e.source ∩ s] x = 𝓝[s] x :=
nhds_within_inter_of_mem (mem_nhds_within_of_mem_nhds $ is_open.mem_nhds e.open_source hx)

lemma nhds_within_target_inter {x} (hx : x ∈ e.target) (s : set β) :
  𝓝[e.target ∩ s] x = 𝓝[s] x :=
e.symm.nhds_within_source_inter hx s

lemma image_eq_target_inter_inv_preimage {s : set α} (h : s ⊆ e.source) :
  e '' s = e.target ∩ e.symm ⁻¹' s :=
e.to_local_equiv.image_eq_target_inter_inv_preimage h

lemma image_source_inter_eq' (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' s :=
e.to_local_equiv.image_source_inter_eq' s

lemma image_source_inter_eq (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' (e.source ∩ s) :=
e.to_local_equiv.image_source_inter_eq s

lemma symm_image_eq_source_inter_preimage {s : set β} (h : s ⊆ e.target) :
  e.symm '' s = e.source ∩ e ⁻¹' s :=
e.symm.image_eq_target_inter_inv_preimage h

lemma symm_image_target_inter_eq (s : set β) :
  e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' (e.target ∩ s) :=
e.symm.image_source_inter_eq _

lemma source_inter_preimage_inv_preimage (s : set α) :
  e.source ∩ e ⁻¹' (e.symm ⁻¹' s) = e.source ∩ s :=
e.to_local_equiv.source_inter_preimage_inv_preimage s

lemma target_inter_inv_preimage_preimage (s : set β) :
  e.target ∩ e.symm ⁻¹' (e ⁻¹' s) = e.target ∩ s :=
e.symm.source_inter_preimage_inv_preimage _

lemma source_inter_preimage_target_inter (s : set β) :
  e.source ∩ (e ⁻¹' (e.target ∩ s)) = e.source ∩ (e ⁻¹' s) :=
e.to_local_equiv.source_inter_preimage_target_inter s

/-- Two local homeomorphisms are equal when they have equal `to_fun`, `inv_fun` and `source`.
It is not sufficient to have equal `to_fun` and `source`, as this only determines `inv_fun` on
the target. This would only be true for a weaker notion of equality, arguably the right one,
called `eq_on_source`. -/
@[ext]
protected lemma ext (e' : local_homeomorph α β) (h : ∀x, e x = e' x)
  (hinv : ∀x, e.symm x = e'.symm x) (hs : e.source = e'.source) : e = e' :=
eq_of_local_equiv_eq (local_equiv.ext h hinv hs)

@[simp, mfld_simps] lemma symm_to_local_equiv : e.symm.to_local_equiv = e.to_local_equiv.symm := rfl
-- The following lemmas are already simp via local_equiv
lemma symm_source : e.symm.source = e.target := rfl
lemma symm_target : e.symm.target = e.source := rfl
@[simp, mfld_simps] lemma symm_symm : e.symm.symm = e := eq_of_local_equiv_eq $ by simp

/-- A local homeomorphism is continuous at any point of its source -/
protected

/-- A local homeomorphism inverse is continuous at any point of its target -/
lemma continuous_at_symm {x : β} (h : x ∈ e.target) : continuous_at e.symm x :=
e.symm.continuous_at h

lemma tendsto_symm {x} (hx : x ∈ e.source) :
  tendsto e.symm (𝓝 (e x)) (𝓝 x) :=
by simpa only [continuous_at, e.left_inv hx] using e.continuous_at_symm (e.map_source hx)

lemma map_nhds_eq {x} (hx : x ∈ e.source) : map e (𝓝 x) = 𝓝 (e x) :=
le_antisymm (e.continuous_at hx) $
  le_map_of_right_inverse (e.eventually_right_inverse' hx) (e.tendsto_symm hx)

lemma symm_map_nhds_eq {x} (hx : x ∈ e.source) :
  map e.symm (𝓝 (e x)) = 𝓝 x :=
(e.symm.map_nhds_eq $ e.map_source hx).trans $ by rw e.left_inv hx

lemma image_mem_nhds {x} (hx : x ∈ e.source) {s : set α} (hs : s ∈ 𝓝 x) :
  e '' s ∈ 𝓝 (e x) :=
e.map_nhds_eq hx ▸ filter.image_mem_map hs

lemma map_nhds_within_eq (e : local_homeomorph α β) {x} (hx : x ∈ e.source) (s : set α) :
  map e (𝓝[s] x) = 𝓝[e '' (e.source ∩ s)] (e x) :=
calc map e (𝓝[s] x) = map e (𝓝[e.source ∩ s] x) :
  congr_arg (map e) (e.nhds_within_source_inter hx _).symm
... = 𝓝[e '' (e.source ∩ s)] (e x) :
  (e.left_inv_on.mono $ inter_subset_left _ _).map_nhds_within_eq (e.left_inv hx)
    (e.continuous_at_symm (e.map_source hx)).continuous_within_at
    (e.continuous_at hx).continuous_within_at

lemma map_nhds_within_preimage_eq (e : local_homeomorph α β) {x} (hx : x ∈ e.source) (s : set β) :
  map e (𝓝[e ⁻¹' s] x) = 𝓝[s] (e x) :=
by rw [e.map_nhds_within_eq hx, e.image_source_inter_eq', e.target_inter_inv_preimage_preimage,
  e.nhds_within_target_inter (e.map_source hx)]

lemma preimage_open_of_open {s : set β} (hs : is_open s) : is_open (e.source ∩ e ⁻¹' s) :=
e.continuous_on.preimage_open_of_open e.open_source hs

/-!
### `local_homeomorph.is_image` relation

We say that `t : set β` is an image of `s : set α` under a local homeomorphism `e` if any of the
following equivalent conditions hold:

* `e '' (e.source ∩ s) = e.target ∩ t`;
* `e.source ∩ e ⁻¹ t = e.source ∩ s`;
* `∀ x ∈ e.source, e x ∈ t ↔ x ∈ s` (this one is used in the definition).

This definition is a restatement of `local_equiv.is_image` for local homeomorphisms. In this section
we transfer API about `local_equiv.is_image` to local homeomorphisms and add a few
`local_homeomorph`-specific lemmas like `local_homeomorph.is_image.closure`.
-/

/-- We say that `t : set β` is an image of `s : set α` under a local homeomorphism `e` if any of the
following equivalent conditions hold:

* `e '' (e.source ∩ s) = e.target ∩ t`;
* `e.source ∩ e ⁻¹ t = e.source ∩ s`;
* `∀ x ∈ e.source, e x ∈ t ↔ x ∈ s` (this one is used in the definition).
-/
def is_image (s : set α) (t : set β) : Prop := ∀ ⦃x⦄, x ∈ e.source → (e x ∈ t ↔ x ∈ s)

namespace is_image

variables {e} {s : set α} {t : set β} {x : α} {y : β}

lemma to_local_equiv (h : e.is_image s t) : e.to_local_equiv.is_image s t := h

lemma apply_mem_iff (h : e.is_image s t) (hx : x ∈ e.source) : e x ∈ t ↔ x ∈ s := h hx

protected lemma symm (h : e.is_image s t) : e.symm.is_image t s := h.to_local_equiv.symm

lemma symm_apply_mem_iff (h : e.is_image s t) (hy : y ∈ e.target) : (e.symm y ∈ s ↔ y ∈ t) :=
h.symm hy

@[simp] lemma symm_iff : e.symm.is_image t s ↔ e.is_image s t := ⟨λ h, h.symm, λ h, h.symm⟩

protected lemma maps_to (h : e.is_image s t) : maps_to e (e.source ∩ s) (e.target ∩ t) :=
h.to_local_equiv.maps_to

lemma symm_maps_to (h : e.is_image s t) : maps_to e.symm (e.target ∩ t) (e.source ∩ s) :=
h.symm.maps_to

lemma image_eq (h : e.is_image s t) : e '' (e.source ∩ s) = e.target ∩ t :=
h.to_local_equiv.image_eq

lemma symm_image_eq (h : e.is_image s t) : e.symm '' (e.target ∩ t) = e.source ∩ s :=
h.symm.image_eq

lemma iff_preimage_eq : e.is_image s t ↔ e.source ∩ e ⁻¹' t = e.source ∩ s :=
local_equiv.is_image.iff_preimage_eq

alias iff_preimage_eq ↔ local_homeomorph.is_image.preimage_eq
  local_homeomorph.is_image.of_preimage_eq

lemma iff_symm_preimage_eq : e.is_image s t ↔ e.target ∩ e.symm ⁻¹' s = e.target ∩ t :=
symm_iff.symm.trans iff_preimage_eq

alias iff_symm_preimage_eq ↔ local_homeomorph.is_image.symm_preimage_eq
  local_homeomorph.is_image.of_symm_preimage_eq

lemma iff_symm_preimage_eq' :
  e.is_image s t ↔ e.target ∩ e.symm ⁻¹' (e.source ∩ s) = e.target ∩ t :=
by rw [iff_symm_preimage_eq, ← image_source_inter_eq, ← image_source_inter_eq']

alias iff_symm_preimage_eq' ↔ local_homeomorph.is_image.symm_preimage_eq'
  local_homeomorph.is_image.of_symm_preimage_eq'

lemma iff_preimage_eq' : e.is_image s t ↔ e.source ∩ e ⁻¹' (e.target ∩ t) = e.source ∩ s :=
symm_iff.symm.trans iff_symm_preimage_eq'

alias iff_preimage_eq' ↔ local_homeomorph.is_image.preimage_eq'
  local_homeomorph.is_image.of_preimage_eq'

lemma of_image_eq (h : e '' (e.source ∩ s) = e.target ∩ t) : e.is_image s t :=
local_equiv.is_image.of_image_eq h

lemma of_symm_image_eq (h : e.symm '' (e.target ∩ t) = e.source ∩ s) : e.is_image s t :=
local_equiv.is_image.of_symm_image_eq h

protected lemma compl (h : e.is_image s t) : e.is_image sᶜ tᶜ :=
λ x hx, not_congr (h hx)

protected lemma inter {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∩ s') (t ∩ t') :=
λ x hx, and_congr (h hx) (h' hx)

protected lemma union {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∪ s') (t ∪ t') :=
λ x hx, or_congr (h hx) (h' hx)

protected lemma diff {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s \ s') (t \ t') :=
h.inter h'.compl

lemma left_inv_on_piecewise {e' : local_homeomorph α β} [∀ i, decidable (i ∈ s)]
  [∀ i, decidable (i ∈ t)] (h : e.is_image s t) (h' : e'.is_image s t) :
  left_inv_on (t.piecewise e.symm e'.symm) (s.piecewise e e') (s.ite e.source e'.source) :=
h.to_local_equiv.left_inv_on_piecewise h'

lemma inter_eq_of_inter_eq_of_eq_on {e' : local_homeomorph α β} (h : e.is_image s t)
  (h' : e'.is_image s t) (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  e.target ∩ t = e'.target ∩ t :=
h.to_local_equiv.inter_eq_of_inter_eq_of_eq_on h' hs Heq

lemma symm_eq_on_of_inter_eq_of_eq_on {e' : local_homeomorph α β} (h : e.is_image s t)
  (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  eq_on e.symm e'.symm (e.target ∩ t) :=
h.to_local_equiv.symm_eq_on_of_inter_eq_of_eq_on hs Heq

lemma map_nhds_within_eq (h : e.is_image s t) (hx : x ∈ e.source) :
  map e (𝓝[s] x) = 𝓝[t] (e x) :=
by rw [e.map_nhds_within_eq hx, h.image_eq, e.nhds_within_target_inter (e.map_source hx)]

protected lemma closure (h : e.is_image s t) : e.is_image (closure s) (closure t) :=
λ x hx, by simp only [mem_closure_iff_nhds_within_ne_bot, ← h.map_nhds_within_eq hx, map_ne_bot_iff]

protected lemma interior (h : e.is_image s t) : e.is_image (interior s) (interior t) :=
by simpa only [closure_compl, compl_compl] using h.compl.closure.compl

protected lemma frontier (h : e.is_image s t) :
  e.is_image (frontier s) (frontier t) :=
h.closure.diff h.interior

lemma is_open_iff (h : e.is_image s t) :
  is_open (e.source ∩ s) ↔ is_open (e.target ∩ t) :=
⟨λ hs, h.symm_preimage_eq' ▸ e.symm.preimage_open_of_open hs,
  λ hs, h.preimage_eq' ▸ e.preimage_open_of_open hs⟩

/-- Restrict a `local_homeomorph` to a pair of corresponding open sets. -/
@[simps to_local_equiv] def restr (h : e.is_image s t) (hs : is_open (e.source ∩ s)) :
  local_homeomorph α β :=
{ to_local_equiv := h.to_local_equiv.restr,
  open_source := hs,
  open_target := h.is_open_iff.1 hs,
  continuous_to_fun := e.continuous_on.mono (inter_subset_left _ _),
  continuous_inv_fun := e.symm.continuous_on.mono (inter_subset_left _ _) }

end is_image

lemma is_image_source_target : e.is_image e.source e.target :=
e.to_local_equiv.is_image_source_target

lemma is_image_source_target_of_disjoint (e' : local_homeomorph α β)
  (hs : disjoint e.source e'.source) (ht : disjoint e.target e'.target) :
  e.is_image e'.source e'.target :=
e.to_local_equiv.is_image_source_target_of_disjoint e'.to_local_equiv hs ht

/-- Preimage of interior or interior of preimage coincide for local homeomorphisms, when restricted
to the source. -/
lemma preimage_interior (s : set β) :
  e.source ∩ e ⁻¹' (interior s) = e.source ∩ interior (e ⁻¹' s) :=
(is_image.of_preimage_eq rfl).interior.preimage_eq

lemma preimage_closure (s : set β) :
  e.source ∩ e ⁻¹' (closure s) = e.source ∩ closure (e ⁻¹' s) :=
(is_image.of_preimage_eq rfl).closure.preimage_eq

lemma preimage_frontier (s : set β) :
  e.source ∩ e ⁻¹' (frontier s) = e.source ∩ frontier (e ⁻¹' s) :=
(is_image.of_preimage_eq rfl).frontier.preimage_eq

lemma preimage_open_of_open_symm {s : set α} (hs : is_open s) :
  is_open (e.target ∩ e.symm ⁻¹' s) :=
e.symm.continuous_on.preimage_open_of_open e.open_target hs

/-- The image of an open set in the source is open. -/
lemma image_open_of_open {s : set α} (hs : is_open s) (h : s ⊆ e.source) : is_open (e '' s) :=
begin
  have : e '' s = e.target ∩ e.symm ⁻¹' s :=
    e.to_local_equiv.image_eq_target_inter_inv_preimage h,
  rw this,
  exact e.continuous_on_symm.preimage_open_of_open e.open_target hs
end

/-- The image of the restriction of an open set to the source is open. -/
lemma image_open_of_open' {s : set α} (hs : is_open s) : is_open (e '' (e.source ∩ s)) :=
image_open_of_open _ (is_open.inter e.open_source hs) (inter_subset_left _ _)

/-- A `local_equiv` with continuous open forward map and an open source is a `local_homeomorph`. -/
def of_continuous_open_restrict (e : local_equiv α β) (hc : continuous_on e e.source)
  (ho : is_open_map (e.source.restrict e)) (hs : is_open e.source) :
  local_homeomorph α β :=
{ to_local_equiv := e,
  open_source := hs,
  open_target := by simpa only [range_restrict, e.image_source_eq_target] using ho.is_open_range,
  continuous_to_fun := hc,
  continuous_inv_fun := e.image_source_eq_target ▸
    ho.continuous_on_image_of_left_inv_on e.left_inv_on }

/-- A `local_equiv` with continuous open forward map and an open source is a `local_homeomorph`. -/
def of_continuous_open (e : local_equiv α β) (hc : continuous_on e e.source)
  (ho : is_open_map e) (hs : is_open e.source) :
  local_homeomorph α β :=
of_continuous_open_restrict e hc (ho.restrict hs) hs

/-- Restricting a local homeomorphism `e` to `e.source ∩ s` when `s` is open. This is sometimes hard
to use because of the openness assumption, but it has the advantage that when it can
be used then its local_equiv is defeq to local_equiv.restr -/
protected def restr_open (s : set α) (hs : is_open s) :
  local_homeomorph α β :=
(@is_image.of_symm_preimage_eq α β _ _ e s (e.symm ⁻¹' s) rfl).restr
  (is_open.inter e.open_source hs)

@[simp, mfld_simps] lemma restr_open_to_local_equiv (s : set α) (hs : is_open s) :
  (e.restr_open s hs).to_local_equiv = e.to_local_equiv.restr s := rfl

-- Already simp via local_equiv
lemma restr_open_source (s : set α) (hs : is_open s) :
  (e.restr_open s hs).source = e.source ∩ s := rfl

/-- Restricting a local homeomorphism `e` to `e.source ∩ interior s`. We use the interior to make
sure that the restriction is well defined whatever the set s, since local homeomorphisms are by
definition defined on open sets. In applications where `s` is open, this coincides with the
restriction of local equivalences -/
@[simps apply symm_apply (mfld_cfg), simps source target {attrs := []}]
protected def restr (s : set α) : local_homeomorph α β :=
e.restr_open (interior s) is_open_interior

@[simp, mfld_simps] lemma restr_to_local_equiv (s : set α) :
  (e.restr s).to_local_equiv = (e.to_local_equiv).restr (interior s) := rfl

lemma restr_source' (s : set α) (hs : is_open s) : (e.restr s).source = e.source ∩ s :=
by rw [e.restr_source, hs.interior_eq]

lemma restr_to_local_equiv' (s : set α) (hs : is_open s):
  (e.restr s).to_local_equiv = e.to_local_equiv.restr s :=
by rw [e.restr_to_local_equiv, hs.interior_eq]

lemma restr_eq_of_source_subset {e : local_homeomorph α β} {s : set α} (h : e.source ⊆ s) :
  e.restr s = e :=
begin
  apply eq_of_local_equiv_eq,
  rw restr_to_local_equiv,
  apply local_equiv.restr_eq_of_source_subset,
  exact interior_maximal h e.open_source
end

@[simp, mfld_simps] lemma restr_univ {e : local_homeomorph α β} : e.restr univ = e :=
restr_eq_of_source_subset (subset_univ _)

lemma restr_source_inter (s : set α) : e.restr (e.source ∩ s) = e.restr s :=
begin
  refine local_homeomorph.ext _ _ (λx, rfl) (λx, rfl) _,
  simp [e.open_source.interior_eq, ← inter_assoc]
end

/-- The identity on the whole space as a local homeomorphism. -/
@[simps apply (mfld_cfg), simps source target {attrs := []}]
protected def refl (α : Type*) [topological_space α] : local_homeomorph α α :=
(homeomorph.refl α).to_local_homeomorph

@[simp, mfld_simps] lemma refl_local_equiv :
  (local_homeomorph.refl α).to_local_equiv = local_equiv.refl α := rfl
@[simp, mfld_simps] lemma refl_symm : (local_homeomorph.refl α).symm = local_homeomorph.refl α :=
rfl

section
variables {s : set α} (hs : is_open s)

/-- The identity local equiv on a set `s` -/
@[simps apply (mfld_cfg), simps source target {attrs := []}]
def of_set (s : set α) (hs : is_open s) : local_homeomorph α α :=
{ open_source        := hs,
  open_target        := hs,
  continuous_to_fun  := continuous_id.continuous_on,
  continuous_inv_fun := continuous_id.continuous_on,
  ..local_equiv.of_set s }

@[simp, mfld_simps] lemma of_set_to_local_equiv :
  (of_set s hs).to_local_equiv = local_equiv.of_set s := rfl
@[simp, mfld_simps] lemma of_set_symm : (of_set s hs).symm = of_set s hs := rfl

@[simp, mfld_simps] lemma of_set_univ_eq_refl :
  of_set univ is_open_univ = local_homeomorph.refl α :=
by ext; simp

end

/-- Composition of two local homeomorphisms when the target of the first and the source of
the second coincide. -/
protected def trans' (h : e.target = e'.source) : local_homeomorph α γ :=
{ open_source       := e.open_source,
  open_target       := e'.open_target,
  continuous_to_fun := begin
    apply continuous_on.comp e'.continuous_to_fun e.continuous_to_fun,
    rw ← h,
    exact e.to_local_equiv.source_subset_preimage_target
  end,
  continuous_inv_fun := begin
    apply continuous_on.comp e.continuous_inv_fun e'.continuous_inv_fun,
    rw h,
    exact e'.to_local_equiv.target_subset_preimage_source
  end,
  ..local_equiv.trans' e.to_local_equiv e'.to_local_equiv h }

/-- Composing two local homeomorphisms, by restricting to the maximal domain where their
composition is well defined. -/
protected def trans : local_homeomorph α γ :=
  local_homeomorph.trans' (e.symm.restr_open e'.source e'.open_source).symm
    (e'.restr_open e.target e.open_target) (by simp [inter_comm])

@[simp, mfld_simps] lemma trans_to_local_equiv :
  (e.trans e').to_local_equiv = e.to_local_equiv.trans e'.to_local_equiv := rfl
@[simp, mfld_simps] lemma coe_trans : (e.trans e' : α → γ) = e' ∘ e := rfl
@[simp, mfld_simps] lemma coe_trans_symm : ((e.trans e').symm : γ → α) = e.symm ∘ e'.symm := rfl

lemma trans_symm_eq_symm_trans_symm : (e.trans e').symm = e'.symm.trans e.symm :=
by cases e; cases e'; refl

/- This could be considered as a simp lemma, but there are many situations where it makes something
simple into something more complicated. -/
lemma trans_source : (e.trans e').source = e.source ∩ e ⁻¹' e'.source :=
local_equiv.trans_source e.to_local_equiv e'.to_local_equiv

lemma trans_source' : (e.trans e').source = e.source ∩ e ⁻¹' (e.target ∩ e'.source) :=
local_equiv.trans_source' e.to_local_equiv e'.to_local_equiv

lemma trans_source'' : (e.trans e').source = e.symm '' (e.target ∩ e'.source) :=
local_equiv.trans_source'' e.to_local_equiv e'.to_local_equiv

lemma image_trans_source : e '' (e.trans e').source = e.target ∩ e'.source :=
local_equiv.image_trans_source e.to_local_equiv e'.to_local_equiv

lemma trans_target : (e.trans e').target = e'.target ∩ e'.symm ⁻¹' e.target := rfl

lemma trans_target' : (e.trans e').target = e'.target ∩ e'.symm ⁻¹' (e'.source ∩ e.target) :=
trans_source' e'.symm e.symm

lemma trans_target'' : (e.trans e').target = e' '' (e'.source ∩ e.target) :=
trans_source'' e'.symm e.symm

lemma inv_image_trans_target : e'.symm '' (e.trans e').target = e'.source ∩ e.target :=
image_trans_source e'.symm e.symm

lemma trans_assoc (e'' : local_homeomorph γ δ) :
  (e.trans e').trans e'' = e.trans (e'.trans e'') :=
eq_of_local_equiv_eq $ local_equiv.trans_assoc e.to_local_equiv e'.to_local_equiv e''.to_local_equiv

@[simp, mfld_simps] lemma trans_refl : e.trans (local_homeomorph.refl β) = e :=
eq_of_local_equiv_eq $ local_equiv.trans_refl e.to_local_equiv

@[simp, mfld_simps] lemma refl_trans : (local_homeomorph.refl α).trans e = e :=
eq_of_local_equiv_eq $ local_equiv.refl_trans e.to_local_equiv

lemma trans_of_set {s : set β} (hs : is_open s) :
  e.trans (of_set s hs) = e.restr (e ⁻¹' s) :=
local_homeomorph.ext _ _ (λx, rfl) (λx, rfl) $
  by simp [local_equiv.trans_source, (e.preimage_interior _).symm, hs.interior_eq]

lemma trans_of_set' {s : set β} (hs : is_open s) :
  e.trans (of_set s hs) = e.restr (e.source ∩ e ⁻¹' s) :=
by rw [trans_of_set, restr_source_inter]

lemma of_set_trans {s : set α} (hs : is_open s) :
  (of_set s hs).trans e = e.restr s :=
local_homeomorph.ext _ _ (λx, rfl) (λx, rfl) $
  by simp [local_equiv.trans_source, hs.interior_eq, inter_comm]

lemma of_set_trans' {s : set α} (hs : is_open s) :
  (of_set s hs).trans e = e.restr (e.source ∩ s) :=
by rw [of_set_trans, restr_source_inter]

@[simp, mfld_simps] lemma of_set_trans_of_set
  {s : set α} (hs : is_open s) {s' : set α} (hs' : is_open s') :
  (of_set s hs).trans (of_set s' hs') = of_set (s ∩ s') (is_open.inter hs hs')  :=
begin
  rw (of_set s hs).trans_of_set hs',
  ext; simp [hs'.interior_eq]
end

lemma restr_trans (s : set α) :
  (e.restr s).trans e' = (e.trans e').restr s :=
eq_of_local_equiv_eq $ local_equiv.restr_trans e.to_local_equiv e'.to_local_equiv (interior s)

/-- `eq_on_source e e'` means that `e` and `e'` have the same source, and coincide there. They
should really be considered the same local equiv. -/
def eq_on_source (e e' : local_homeomorph α β) : Prop :=
e.source = e'.source ∧ (eq_on e e' e.source)

lemma eq_on_source_iff (e e' : local_homeomorph α β) :
eq_on_source e e' ↔ local_equiv.eq_on_source e.to_local_equiv e'.to_local_equiv :=
iff.rfl

/-- `eq_on_source` is an equivalence relation -/
instance : setoid (local_homeomorph α β) :=
{ r     := eq_on_source,
  iseqv := ⟨
    λe, (@local_equiv.eq_on_source_setoid α β).iseqv.1 e.to_local_equiv,
    λe e' h, (@local_equiv.eq_on_source_setoid α β).iseqv.2.1 ((eq_on_source_iff e e').1 h),
    λe e' e'' h h', (@local_equiv.eq_on_source_setoid α β).iseqv.2.2
      ((eq_on_source_iff e e').1 h) ((eq_on_source_iff e' e'').1 h')⟩ }

lemma eq_on_source_refl : e ≈ e := setoid.refl _

/-- If two local homeomorphisms are equivalent, so are their inverses -/
lemma eq_on_source.symm' {e e' : local_homeomorph α β} (h : e ≈ e') : e.symm ≈ e'.symm :=
local_equiv.eq_on_source.symm' h

/-- Two equivalent local homeomorphisms have the same source -/
lemma eq_on_source.source_eq {e e' : local_homeomorph α β} (h : e ≈ e') : e.source = e'.source :=
h.1

/-- Two equivalent local homeomorphisms have the same target -/
lemma eq_on_source.target_eq {e e' : local_homeomorph α β} (h : e ≈ e') : e.target = e'.target :=
h.symm'.1

/-- Two equivalent local homeomorphisms have coinciding `to_fun` on the source -/
lemma eq_on_source.eq_on {e e' : local_homeomorph α β} (h : e ≈ e') :
  eq_on e e' e.source :=
h.2

/-- Two equivalent local homeomorphisms have coinciding `inv_fun` on the target -/
lemma eq_on_source.symm_eq_on_target {e e' : local_homeomorph α β} (h : e ≈ e') :
  eq_on e.symm e'.symm e.target :=
h.symm'.2

/-- Composition of local homeomorphisms respects equivalence -/
lemma eq_on_source.trans' {e e' : local_homeomorph α β} {f f' : local_homeomorph β γ}
  (he : e ≈ e') (hf : f ≈ f') : e.trans f ≈ e'.trans f' :=
local_equiv.eq_on_source.trans' he hf

/-- Restriction of local homeomorphisms respects equivalence -/
lemma eq_on_source.restr {e e' : local_homeomorph α β} (he : e ≈ e') (s : set α) :
  e.restr s ≈ e'.restr s :=
local_equiv.eq_on_source.restr he _

/-- Composition of a local homeomorphism and its inverse is equivalent to the restriction of the
identity to the source -/
lemma trans_self_symm :
  e.trans e.symm ≈ local_homeomorph.of_set e.source e.open_source :=
local_equiv.trans_self_symm _

lemma trans_symm_self :
  e.symm.trans e ≈ local_homeomorph.of_set e.target e.open_target :=
e.symm.trans_self_symm

lemma eq_of_eq_on_source_univ {e e' : local_homeomorph α β} (h : e ≈ e')
  (s : e.source = univ) (t : e.target = univ) : e = e' :=
eq_of_local_equiv_eq $ local_equiv.eq_of_eq_on_source_univ _ _ h s t

section prod

/-- The product of two local homeomorphisms, as a local homeomorphism on the product space. -/
@[simps to_local_equiv apply (mfld_cfg), simps source target symm_apply {attrs := []}]
def prod (e : local_homeomorph α β) (e' : local_homeomorph γ δ) :
  local_homeomorph (α × γ) (β × δ) :=
{ open_source := e.open_source.prod e'.open_source,
  open_target := e.open_target.prod e'.open_target,
  continuous_to_fun := e.continuous_on.prod_map e'.continuous_on,
  continuous_inv_fun := e.continuous_on_symm.prod_map e'.continuous_on_symm,
  to_local_equiv := e.to_local_equiv.prod e'.to_local_equiv }

@[simp, mfld_simps] lemma prod_symm (e : local_homeomorph α β) (e' : local_homeomorph γ δ) :
  (e.prod e').symm = (e.symm.prod e'.symm) :=
rfl

@[simp, mfld_simps] lemma prod_trans
  {η : Type*} {ε : Type*} [topological_space η] [topological_space ε]
  (e : local_homeomorph α β) (f : local_homeomorph β γ)
  (e' : local_homeomorph δ η) (f' : local_homeomorph η ε) :
  (e.prod e').trans (f.prod f') = (e.trans f).prod (e'.trans f') :=
local_homeomorph.eq_of_local_equiv_eq $
  by dsimp only [trans_to_local_equiv, prod_to_local_equiv]; apply local_equiv.prod_trans

end prod

section piecewise

/-- Combine two `local_homeomorph`s using `set.piecewise`. The source of the new `local_homeomorph`
is `s.ite e.source e'.source = e.source ∩ s ∪ e'.source \ s`, and similarly for target.  The
function sends `e.source ∩ s` to `e.target ∩ t` using `e` and `e'.source \ s` to `e'.target \ t`
using `e'`, and similarly for the inverse function. To ensure that the maps `to_fun` and `inv_fun`
are inverse of each other on the new `source` and `target`, the definition assumes that the sets `s`
and `t` are related both by `e.is_image` and `e'.is_image`. To ensure that the new maps are
continuous on `source`/`target`, it also assumes that `e.source` and `e'.source` meet `frontier s`
on the same set and `e x = e' x` on this intersection. -/
@[simps to_local_equiv apply {fully_applied := ff}]
def piecewise (e e' : local_homeomorph α β) (s : set α) (t : set β)
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)] (H : e.is_image s t) (H' : e'.is_image s t)
  (Hs : e.source ∩ frontier s = e'.source ∩ frontier s)
  (Heq : eq_on e e' (e.source ∩ frontier s)) :
  local_homeomorph α β :=
{ to_local_equiv := e.to_local_equiv.piecewise e'.to_local_equiv s t H H',
  open_source := e.open_source.ite e'.open_source Hs,
  open_target := e.open_target.ite e'.open_target $
    H.frontier.inter_eq_of_inter_eq_of_eq_on H'.frontier Hs Heq,
  continuous_to_fun := continuous_on_piecewise_ite e.continuous_on e'.continuous_on Hs Heq,
  continuous_inv_fun := continuous_on_piecewise_ite e.continuous_on_symm e'.continuous_on_symm
    (H.frontier.inter_eq_of_inter_eq_of_eq_on H'.frontier Hs Heq)
    (H.frontier.symm_eq_on_of_inter_eq_of_eq_on Hs Heq) }

@[simp] lemma symm_piecewise (e e' : local_homeomorph α β) {s : set α} {t : set β}
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)] (H : e.is_image s t) (H' : e'.is_image s t)
  (Hs : e.source ∩ frontier s = e'.source ∩ frontier s)
  (Heq : eq_on e e' (e.source ∩ frontier s)) :
  (e.piecewise e' s t H H' Hs Heq).symm =
    e.symm.piecewise e'.symm t s H.symm H'.symm
      (H.frontier.inter_eq_of_inter_eq_of_eq_on H'.frontier Hs Heq)
      (H.frontier.symm_eq_on_of_inter_eq_of_eq_on Hs Heq) :=
rfl

/-- Combine two `local_homeomorph`s with disjoint sources and disjoint targets. We reuse
`local_homeomorph.piecewise` then override `to_local_equiv` to `local_equiv.disjoint_union`.
This way we have better definitional equalities for `source` and `target`. -/
def disjoint_union (e e' : local_homeomorph α β)
  [∀ x, decidable (x ∈ e.source)] [∀ y, decidable (y ∈ e.target)]
  (Hs : disjoint e.source e'.source) (Ht : disjoint e.target e'.target) :
  local_homeomorph α β :=
(e.piecewise e' e.source e.target e.is_image_source_target
  (e'.is_image_source_target_of_disjoint e Hs.symm Ht.symm)
  (by rw [e.open_source.inter_frontier_eq, e'.open_source.inter_frontier_eq_empty_of_disjoint Hs])
  (by { rw e.open_source.inter_frontier_eq, exact eq_on_empty _ _ })).replace_equiv
    (e.to_local_equiv.disjoint_union e'.to_local_equiv Hs Ht)
    (local_equiv.disjoint_union_eq_piecewise _ _ _ _).symm

end piecewise

section pi

variables {ι : Type*} [fintype ι] {Xi Yi : ι → Type*} [Π i, topological_space (Xi i)]
  [Π i, topological_space (Yi i)] (ei : Π i, local_homeomorph (Xi i) (Yi i))

/-- The product of a finite family of `local_homeomorph`s. -/
@[simps to_local_equiv] def pi : local_homeomorph (Π i, Xi i) (Π i, Yi i) :=
{ to_local_equiv := local_equiv.pi (λ i, (ei i).to_local_equiv),
  open_source := is_open_set_pi finite_univ $ λ i hi, (ei i).open_source,
  open_target := is_open_set_pi finite_univ $ λ i hi, (ei i).open_target,
  continuous_to_fun := continuous_on_pi.2 $ λ i, (ei i).continuous_on.comp
    (continuous_apply _).continuous_on (λ f hf, hf i trivial),
  continuous_inv_fun := continuous_on_pi.2 $ λ i, (ei i).continuous_on_symm.comp
    (continuous_apply _).continuous_on (λ f hf, hf i trivial) }

end pi

section continuity

/-- Continuity within a set at a point can be read under right composition with a local
homeomorphism, if the point is in its target -/
lemma continuous_within_at_iff_continuous_within_at_comp_right
  {f : β → γ} {s : set β} {x : β} (h : x ∈ e.target) :
  continuous_within_at f s x ↔ continuous_within_at (f ∘ e) (e ⁻¹' s) (e.symm x) :=
by simp_rw [continuous_within_at, ← @tendsto_map'_iff _ _ _ _ e,
  e.map_nhds_within_preimage_eq (e.map_target h), (∘), e.right_inv h]

/-- Continuity at a point can be read under right composition with a local homeomorphism, if the
point is in its target -/
lemma continuous_at_iff_continuous_at_comp_right
  {f : β → γ} {x : β} (h : x ∈ e.target) :
  continuous_at f x ↔ continuous_at (f ∘ e) (e.symm x) :=
by rw [← continuous_within_at_univ, e.continuous_within_at_iff_continuous_within_at_comp_right h,
       preimage_univ, continuous_within_at_univ]

/-- A function is continuous on a set if and only if its composition with a local homeomorphism
on the right is continuous on the corresponding set. -/
lemma continuous_on_iff_continuous_on_comp_right {f : β → γ} {s : set β} (h : s ⊆ e.target) :
  continuous_on f s ↔ continuous_on (f ∘ e) (e.source ∩ e ⁻¹' s) :=
begin
  simp only [← e.symm_image_eq_source_inter_preimage h, continuous_on, ball_image_iff],
  refine forall₂_congr (λ x hx, _),
  rw [e.continuous_within_at_iff_continuous_within_at_comp_right (h hx),
    e.symm_image_eq_source_inter_preimage h, inter_comm, continuous_within_at_inter],
  exact is_open.mem_nhds e.open_source (e.map_target (h hx))
end

/-- Continuity within a set at a point can be read under left composition with a local
homeomorphism if a neighborhood of the initial point is sent to the source of the local
homeomorphism-/
lemma continuous_within_at_iff_continuous_within_at_comp_left
  {f : γ → α} {s : set γ} {x : γ} (hx : f x ∈ e.source) (h : f ⁻¹' e.source ∈ 𝓝[s] x) :
  continuous_within_at f s x ↔ continuous_within_at (e ∘ f) s x :=
begin
  refine ⟨(e.continuous_at hx).tendsto.comp, λ fe_cont, _⟩,
  rw [← continuous_within_at_inter' h] at fe_cont ⊢,
  have : continuous_within_at (e.symm ∘ (e ∘ f)) (s ∩ f ⁻¹' e.source) x,
  { have : continuous_within_at e.symm univ (e (f x))
      := (e.continuous_at_symm (e.map_source hx)).continuous_within_at,
    exact continuous_within_at.comp this fe_cont (subset_univ _) },
  exact this.congr (λy hy, by simp [e.left_inv hy.2]) (by simp [e.left_inv hx])
end

/-- Continuity at a point can be read under left composition with a local homeomorphism if a
neighborhood of the initial point is sent to the source of the local homeomorphism-/
lemma continuous_at_iff_continuous_at_comp_left {f : γ → α} {x : γ} (h : f ⁻¹' e.source ∈ 𝓝 x) :
  continuous_at f x ↔ continuous_at (e ∘ f) x :=
begin
  have hx : f x ∈ e.source := (mem_of_mem_nhds h : _),
  have h' : f ⁻¹' e.source ∈ 𝓝[univ] x, by rwa nhds_within_univ,
  rw [← continuous_within_at_univ, ← continuous_within_at_univ,
      e.continuous_within_at_iff_continuous_within_at_comp_left hx h']
end

/-- A function is continuous on a set if and only if its composition with a local homeomorphism
on the left is continuous on the corresponding set. -/
lemma continuous_on_iff_continuous_on_comp_left {f : γ → α} {s : set γ} (h : s ⊆ f ⁻¹' e.source) :
  continuous_on f s ↔ continuous_on (e ∘ f) s :=
forall₂_congr $ λ x hx, e.continuous_within_at_iff_continuous_within_at_comp_left
  (h hx) (mem_of_superset self_mem_nhds_within h)

/-- A function is continuous if and only if its composition with a local homeomorphism
on the left is continuous and its image is contained in the source. -/
lemma continuous_iff_continuous_comp_left {f : γ → α} (h : f ⁻¹' e.source = univ) :
  continuous f ↔ continuous (e ∘ f) :=
begin
  simp only [continuous_iff_continuous_on_univ],
  exact e.continuous_on_iff_continuous_on_comp_left (eq.symm h).subset,
end

end continuity

/-- A local homeomrphism defines a homeomorphism between its source and target. -/
def to_homeomorph_source_target : e.source ≃ₜ e.target :=
{ to_fun := e.maps_to.restrict _ _ _,
  inv_fun := e.symm_maps_to.restrict _ _ _,
  left_inv := λ x, subtype.eq $ e.left_inv x.2,
  right_inv := λ x, subtype.eq $ e.right_inv x.2,
  continuous_to_fun := continuous_subtype_mk _ $
    continuous_on_iff_continuous_restrict.1 e.continuous_on,
  continuous_inv_fun := continuous_subtype_mk _ $
    continuous_on_iff_continuous_restrict.1 e.symm.continuous_on }

lemma second_countable_topology_source [second_countable_topology β]
  (e : local_homeomorph α β) :
  second_countable_topology e.source :=
e.to_homeomorph_source_target.second_countable_topology

/-- If a local homeomorphism has source and target equal to univ, then it induces a homeomorphism
between the whole spaces, expressed in this definition. -/
@[simps apply symm_apply (mfld_cfg)]
def to_homeomorph_of_source_eq_univ_target_eq_univ (h : e.source = (univ : set α))
  (h' : e.target = univ) : α ≃ₜ β :=
{ to_fun := e,
  inv_fun := e.symm,
  left_inv := λx, e.left_inv $ by { rw h, exact mem_univ _ },
  right_inv := λx, e.right_inv $ by { rw h', exact mem_univ _ },
  continuous_to_fun := begin
    rw [continuous_iff_continuous_on_univ],
    convert e.continuous_to_fun,
    rw h
  end,
  continuous_inv_fun := begin
    rw [continuous_iff_continuous_on_univ],
    convert e.continuous_inv_fun,
    rw h'
  end }

/-- A local homeomorphism whose source is all of `α` defines an open embedding of `α` into `β`.  The
converse is also true; see `open_embedding.to_local_homeomorph`. -/
lemma to_open_embedding (h : e.source = set.univ) : open_embedding e :=
begin
  apply open_embedding_of_continuous_injective_open,
  { apply continuous_iff_continuous_on_univ.mpr,
    rw ← h,
    exact e.continuous_to_fun },
  { apply set.injective_iff_inj_on_univ.mpr,
    rw ← h,
    exact e.inj_on },
  { intros U hU,
    simpa only [h, subset_univ] with mfld_simps using e.image_open_of_open hU}
end

end local_homeomorph

namespace homeomorph
variables (e : α ≃ₜ β) (e' : β ≃ₜ γ)
/- Register as simp lemmas that the fields of a local homeomorphism built from a homeomorphism
correspond to the fields of the original homeomorphism. -/

attribute [simps apply source target {simp_rhs := tt, .. mfld_cfg}] to_local_homeomorph

@[simp, mfld_simps] lemma to_local_homeomorph_coe_symm :
  (e.to_local_homeomorph.symm : β → α) = e.symm := rfl
@[simp, mfld_simps] lemma refl_to_local_homeomorph :
  (homeomorph.refl α).to_local_homeomorph = local_homeomorph.refl α := rfl
@[simp, mfld_simps] lemma symm_to_local_homeomorph :
  e.symm.to_local_homeomorph = e.to_local_homeomorph.symm := rfl
@[simp, mfld_simps] lemma trans_to_local_homeomorph :
  (e.trans e').to_local_homeomorph = e.to_local_homeomorph.trans e'.to_local_homeomorph :=
local_homeomorph.eq_of_local_equiv_eq $ equiv.trans_to_local_equiv _ _

end homeomorph

namespace open_embedding
variables (f : α → β) (h : open_embedding f)

/-- An open embedding of `α` into `β`, with `α` nonempty, defines a local homeomorphism whose source
is all of `α`.  The converse is also true; see `local_homeomorph.to_open_embedding`. -/
@[simps apply source target (mfld_cfg)]
noncomputable def to_local_homeomorph [nonempty α] : local_homeomorph α β :=
local_homeomorph.of_continuous_open
  ((h.to_embedding.inj.inj_on univ).to_local_equiv _ _)
  h.continuous.continuous_on h.is_open_map is_open_univ

lemma continuous_at_iff
  {f : α → β} {g : β → γ} (hf : open_embedding f) {x : α} :
  continuous_at (g ∘ f) x ↔ continuous_at g (f x) :=
begin
  haveI : nonempty α := ⟨x⟩,
  convert (((hf.to_local_homeomorph f).continuous_at_iff_continuous_at_comp_right) _).symm,
  { apply (local_homeomorph.left_inv _ _).symm,
    simp, },
  { simp, },
end

end open_embedding

namespace topological_space.opens

open topological_space
variables (s : opens α) [nonempty s]

/-- The inclusion of an open subset `s` of a space `α` into `α` is a local homeomorphism from the
subtype `s` to `α`. -/
noncomputable def local_homeomorph_subtype_coe : local_homeomorph s α :=
open_embedding.to_local_homeomorph _ s.2.open_embedding_subtype_coe

@[simp, mfld_simps] lemma local_homeomorph_subtype_coe_coe :
  (s.local_homeomorph_subtype_coe : s → α) = coe := rfl

@[simp, mfld_simps] lemma local_homeomorph_subtype_coe_source :
  s.local_homeomorph_subtype_coe.source = set.univ := rfl

@[simp, mfld_simps] lemma local_homeomorph_subtype_coe_target :
  s.local_homeomorph_subtype_coe.target = s :=
by { simp only [local_homeomorph_subtype_coe, subtype.range_coe_subtype] with mfld_simps, refl }

end topological_space.opens

namespace local_homeomorph

open topological_space
variables (e : local_homeomorph α β)
variables (s : opens α) [nonempty s]

/-- The restriction of a local homeomorphism `e` to an open subset `s` of the domain type produces a
local homeomorphism whose domain is the subtype `s`.-/
noncomputable def subtype_restr : local_homeomorph s β := s.local_homeomorph_subtype_coe.trans e

lemma subtype_restr_def : e.subtype_restr s = s.local_homeomorph_subtype_coe.trans e := rfl

@[simp, mfld_simps] lemma subtype_restr_coe : ((e.subtype_restr s : local_homeomorph s β) : s → β)
  = set.restrict ↑s (e : α → β) := rfl

@[simp, mfld_simps] lemma subtype_restr_source : (e.subtype_restr s).source = coe ⁻¹' e.source :=
by simp only [subtype_restr_def] with mfld_simps

/- This lemma characterizes the transition functions of an open subset in terms of the transition
functions of the original space. -/
lemma subtype_restr_symm_trans_subtype_restr (f f' : local_homeomorph α β) :
  (f.subtype_restr s).symm.trans (f'.subtype_restr s)
  ≈ (f.symm.trans f').restr (f.target ∩ (f.symm) ⁻¹' s) :=
begin
  simp only [subtype_restr_def, trans_symm_eq_symm_trans_symm],
  have openness₁ : is_open (f.target ∩ f.symm ⁻¹' s) := f.preimage_open_of_open_symm s.2,
  rw [← of_set_trans _ openness₁, ← trans_assoc, ← trans_assoc],
  refine eq_on_source.trans' _ (eq_on_source_refl _),
  -- f' has been eliminated !!!
  have sets_identity : f.symm.source ∩ (f.target ∩ (f.symm) ⁻¹' s) = f.symm.source ∩ f.symm ⁻¹' s,
  { mfld_set_tac },
  have openness₂ : is_open (s : set α) := s.2,
  rw [of_set_trans', sets_identity, ← trans_of_set' _ openness₂, trans_assoc],
  refine eq_on_source.trans' (eq_on_source_refl _) _,
  -- f has been eliminated !!!
  refine setoid.trans (trans_symm_self s.local_homeomorph_subtype_coe) _,
  simp only with mfld_simps,
end

end local_homeomorph