/-
Copyright (c) 2021 Alex Kontorovich, Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Kontorovich, Heather Macbeth

! This file was ported from Lean 3 source module topology.algebra.const_mul_action
! leanprover-community/mathlib commit d90e4e186f1d18e375dcd4e5b5f6364b01cb3e46
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Algebra.Constructions
import Mathlib.Topology.Homeomorph
import Mathlib.GroupTheory.GroupAction.Basic
import Mathlib.Topology.Bases
import Mathlib.Topology.Support

/-!
# Monoid actions continuous in the second variable

In this file we define class `ContinuousConstSMul`. We say `ContinuousConstSMul Γ T` if
`Γ` acts on `T` and for each `γ`, the map `x ↦ γ • x` is continuous. (This differs from
`ContinuousSMul`, which requires simultaneous continuity in both variables.)

## Main definitions

* `ContinuousConstSMul Γ T` : typeclass saying that the map `x ↦ γ • x` is continuous on `T`;
* `ProperlyDiscontinuousSMul`: says that the scalar multiplication `(•) : Γ → T → T`
  is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely
  many `γ:Γ` move `K` to have nontrivial intersection with `L`.
* `Homeomorph.smul`: scalar multiplication by an element of a group `Γ` acting on `T`
  is a homeomorphism of `T`.

## Main results

* `isOpenMap_quotient_mk'_mul` : The quotient map by a group action is open.
* `t2Space_of_properlyDiscontinuousSMul_of_t2Space` : The quotient by a discontinuous group
  action of a locally compact t2 space is t2.

## Tags

Hausdorff, discrete group, properly discontinuous, quotient space

-/

open Topology Pointwise Filter Set TopologicalSpace

attribute [local instance] MulAction.orbitRel

/-- Class `ContinuousConstSMul Γ T` says that the scalar multiplication `(•) : Γ → T → T`
is continuous in the second argument. We use the same class for all kinds of multiplicative
actions, including (semi)modules and algebras.

Note that both `ContinuousConstSMul α α` and `ContinuousConstSMul αᵐᵒᵖ α` are
weaker versions of `ContinuousMul α`. -/
class ContinuousConstSMul (Γ : Type _) (T : Type _) [TopologicalSpace T] [SMul Γ T] : Prop where
  /-- The scalar multiplication `(•) : Γ → T → T` is continuous in the second argument. -/
  continuous_const_smul : ∀ γ : Γ, Continuous fun x : T => γ • x
#align has_continuous_const_smul ContinuousConstSMul

/-- Class `ContinuousConstVAdd Γ T` says that the additive action `(+ᵥ) : Γ → T → T`
is continuous in the second argument. We use the same class for all kinds of additive actions,
including (semi)modules and algebras.

Note that both `ContinuousConstVAdd α α` and `ContinuousConstVAdd αᵐᵒᵖ α` are
weaker versions of `ContinuousVAdd α`. -/
class ContinuousConstVAdd (Γ : Type _) (T : Type _) [TopologicalSpace T] [VAdd Γ T] : Prop where
  /-- The additive action `(+ᵥ) : Γ → T → T` is continuous in the second argument. -/
  continuous_const_vadd : ∀ γ : Γ, Continuous fun x : T => γ +ᵥ x
#align has_continuous_const_vadd ContinuousConstVAdd

attribute [to_additive] ContinuousConstSMul

export ContinuousConstSMul (continuous_const_smul)
export ContinuousConstVAdd (continuous_const_vadd)

variable {M α β : Type _}

section SMul

variable [TopologicalSpace α] [SMul M α] [ContinuousConstSMul M α]

@[to_additive]
theorem Filter.Tendsto.const_smul {f : β → α} {l : Filter β} {a : α} (hf : Tendsto f l (𝓝 a))
    (c : M) : Tendsto (fun x => c • f x) l (𝓝 (c • a)) :=
  ((continuous_const_smul _).tendsto _).comp hf
#align filter.tendsto.const_smul Filter.Tendsto.const_smul
#align filter.tendsto.const_vadd Filter.Tendsto.const_vadd

variable [TopologicalSpace β] {f : β → M} {g : β → α} {b : β} {s : Set β}

@[to_additive]
nonrec theorem ContinuousWithinAt.const_smul (hg : ContinuousWithinAt g s b) (c : M) :
    ContinuousWithinAt (fun x => c • g x) s b :=
  hg.const_smul c
#align continuous_within_at.const_smul ContinuousWithinAt.const_smul
#align continuous_within_at.const_vadd ContinuousWithinAt.const_vadd

@[to_additive]
nonrec theorem ContinuousAt.const_smul (hg : ContinuousAt g b) (c : M) :
    ContinuousAt (fun x => c • g x) b :=
  hg.const_smul c
#align continuous_at.const_smul ContinuousAt.const_smul
#align continuous_at.const_vadd ContinuousAt.const_vadd

@[to_additive]
theorem ContinuousOn.const_smul (hg : ContinuousOn g s) (c : M) :
    ContinuousOn (fun x => c • g x) s := fun x hx => (hg x hx).const_smul c
#align continuous_on.const_smul ContinuousOn.const_smul
#align continuous_on.const_vadd ContinuousOn.const_vadd

@[to_additive (attr := continuity)]
theorem Continuous.const_smul (hg : Continuous g) (c : M) : Continuous fun x => c • g x :=
  (continuous_const_smul _).comp hg
#align continuous.const_smul Continuous.const_smul
#align continuous.const_vadd Continuous.const_vadd

/-- If a scalar is central, then its right action is continuous when its left action is. -/
@[to_additive "If an additive action is central, then its right action is continuous when its left
action is."]
instance ContinuousConstSMul.op [SMul Mᵐᵒᵖ α] [IsCentralScalar M α] :
    ContinuousConstSMul Mᵐᵒᵖ α :=
  ⟨MulOpposite.rec' fun c => by simpa only [op_smul_eq_smul] using continuous_const_smul c⟩
#align has_continuous_const_smul.op ContinuousConstSMul.op
#align has_continuous_const_vadd.op ContinuousConstVAdd.op

@[to_additive]
instance MulOpposite.continuousConstSMul : ContinuousConstSMul M αᵐᵒᵖ :=
  ⟨fun c => MulOpposite.continuous_op.comp <| MulOpposite.continuous_unop.const_smul c⟩
#align mul_opposite.has_continuous_const_smul MulOpposite.continuousConstSMul
#align add_opposite.has_continuous_const_vadd AddOpposite.continuousConstVAdd

@[to_additive]
instance : ContinuousConstSMul M αᵒᵈ := ‹ContinuousConstSMul M α›

@[to_additive]
instance OrderDual.continuousConstSMul' : ContinuousConstSMul Mᵒᵈ α :=
  ‹ContinuousConstSMul M α›
#align order_dual.has_continuous_const_smul' OrderDual.continuousConstSMul'
#align order_dual.has_continuous_const_vadd' OrderDual.continuousConstVAdd'

@[to_additive]
instance [SMul M β] [ContinuousConstSMul M β] : ContinuousConstSMul M (α × β) :=
  ⟨fun _ => (continuous_fst.const_smul _).prod_mk (continuous_snd.const_smul _)⟩

@[to_additive]
instance {ι : Type _} {γ : ι → Type _} [∀ i, TopologicalSpace (γ i)] [∀ i, SMul M (γ i)]
    [∀ i, ContinuousConstSMul M (γ i)] : ContinuousConstSMul M (∀ i, γ i) :=
  ⟨fun _ => continuous_pi fun i => (continuous_apply i).const_smul _⟩

@[to_additive]
theorem IsCompact.smul {α β} [SMul α β] [TopologicalSpace β] [ContinuousConstSMul α β] (a : α)
    {s : Set β} (hs : IsCompact s) : IsCompact (a • s) :=
  hs.image (continuous_id.const_smul a)
#align is_compact.smul IsCompact.smul
#align is_compact.vadd IsCompact.vadd

end SMul

section Monoid

variable [TopologicalSpace α]

variable [Monoid M] [MulAction M α] [ContinuousConstSMul M α]

@[to_additive]
instance Units.continuousConstSMul : ContinuousConstSMul Mˣ α
    where continuous_const_smul m := (continuous_const_smul (m : M) : _)
#align units.has_continuous_const_smul Units.continuousConstSMul
#align add_units.has_continuous_const_vadd AddUnits.continuousConstVAdd

@[to_additive]
theorem smul_closure_subset (c : M) (s : Set α) : c • closure s ⊆ closure (c • s) :=
  ((Set.mapsTo_image _ _).closure <| continuous_id.const_smul c).image_subset
#align smul_closure_subset smul_closure_subset
#align vadd_closure_subset vadd_closure_subset

@[to_additive]
theorem smul_closure_orbit_subset (c : M) (x : α) :
    c • closure (MulAction.orbit M x) ⊆ closure (MulAction.orbit M x) :=
  (smul_closure_subset c _).trans <| closure_mono <| MulAction.smul_orbit_subset _ _
#align smul_closure_orbit_subset smul_closure_orbit_subset
#align vadd_closure_orbit_subset vadd_closure_orbit_subset

end Monoid

section Group

variable {G : Type _} [TopologicalSpace α] [Group G] [MulAction G α] [ContinuousConstSMul G α]

@[to_additive]
theorem tendsto_const_smul_iff {f : β → α} {l : Filter β} {a : α} (c : G) :
    Tendsto (fun x => c • f x) l (𝓝 <| c • a) ↔ Tendsto f l (𝓝 a) :=
  ⟨fun h => by simpa only [inv_smul_smul] using h.const_smul c⁻¹, fun h => h.const_smul _⟩
#align tendsto_const_smul_iff tendsto_const_smul_iff
#align tendsto_const_vadd_iff tendsto_const_vadd_iff

variable [TopologicalSpace β] {f : β → α} {b : β} {s : Set β}

@[to_additive]
theorem continuousWithinAt_const_smul_iff (c : G) :
    ContinuousWithinAt (fun x => c • f x) s b ↔ ContinuousWithinAt f s b :=
  tendsto_const_smul_iff c
#align continuous_within_at_const_smul_iff continuousWithinAt_const_smul_iff
#align continuous_within_at_const_vadd_iff continuousWithinAt_const_vadd_iff

@[to_additive]
theorem continuousOn_const_smul_iff (c : G) :
    ContinuousOn (fun x => c • f x) s ↔ ContinuousOn f s :=
  forall₂_congr fun _ _ => continuousWithinAt_const_smul_iff c
#align continuous_on_const_smul_iff continuousOn_const_smul_iff
#align continuous_on_const_vadd_iff continuousOn_const_vadd_iff

@[to_additive]
theorem continuousAt_const_smul_iff (c : G) :
    ContinuousAt (fun x => c • f x) b ↔ ContinuousAt f b :=
  tendsto_const_smul_iff c
#align continuous_at_const_smul_iff continuousAt_const_smul_iff
#align continuous_at_const_vadd_iff continuousAt_const_vadd_iff

@[to_additive]
theorem continuous_const_smul_iff (c : G) : (Continuous fun x => c • f x) ↔ Continuous f := by
  simp only [continuous_iff_continuousAt, continuousAt_const_smul_iff]
#align continuous_const_smul_iff continuous_const_smul_iff
#align continuous_const_vadd_iff continuous_const_vadd_iff

/-- The homeomorphism given by scalar multiplication by a given element of a group `Γ` acting on
  `T` is a homeomorphism from `T` to itself. -/
@[to_additive]
def Homeomorph.smul (γ : G) : α ≃ₜ α where
  toEquiv := MulAction.toPerm γ
  continuous_toFun := continuous_const_smul γ
  continuous_invFun := continuous_const_smul γ⁻¹
#align homeomorph.smul Homeomorph.smul
#align homeomorph.vadd Homeomorph.vadd

/-- The homeomorphism given by affine-addition by an element of an additive group `Γ` acting on
  `T` is a homeomorphism from `T` to itself. -/
add_decl_doc Homeomorph.vadd

@[to_additive]
theorem isOpenMap_smul (c : G) : IsOpenMap fun x : α => c • x :=
  (Homeomorph.smul c).isOpenMap
#align is_open_map_smul isOpenMap_smul
#align is_open_map_vadd isOpenMap_vadd

@[to_additive]
theorem IsOpen.smul {s : Set α} (hs : IsOpen s) (c : G) : IsOpen (c • s) :=
  isOpenMap_smul c s hs
#align is_open.smul IsOpen.smul
#align is_open.vadd IsOpen.vadd

@[to_additive]
theorem isClosedMap_smul (c : G) : IsClosedMap fun x : α => c • x :=
  (Homeomorph.smul c).isClosedMap
#align is_closed_map_smul isClosedMap_smul
#align is_closed_map_vadd isClosedMap_vadd

@[to_additive]
theorem IsClosed.smul {s : Set α} (hs : IsClosed s) (c : G) : IsClosed (c • s) :=
  isClosedMap_smul c s hs
#align is_closed.smul IsClosed.smul
#align is_closed.vadd IsClosed.vadd

@[to_additive]
theorem closure_smul (c : G) (s : Set α) : closure (c • s) = c • closure s :=
  ((Homeomorph.smul c).image_closure s).symm
#align closure_smul closure_smul
#align closure_vadd closure_vadd

@[to_additive]
theorem Dense.smul (c : G) {s : Set α} (hs : Dense s) : Dense (c • s) := by
  rw [dense_iff_closure_eq] at hs ⊢; rw [closure_smul, hs, smul_set_univ]
#align dense.smul Dense.smul
#align dense.vadd Dense.vadd

@[to_additive]
theorem interior_smul (c : G) (s : Set α) : interior (c • s) = c • interior s :=
  ((Homeomorph.smul c).image_interior s).symm
#align interior_smul interior_smul
#align interior_vadd interior_vadd

end Group

section GroupWithZero

variable {G₀ : Type _} [TopologicalSpace α] [GroupWithZero G₀] [MulAction G₀ α]
  [ContinuousConstSMul G₀ α]

theorem tendsto_const_smul_iff₀ {f : β → α} {l : Filter β} {a : α} {c : G₀} (hc : c ≠ 0) :
    Tendsto (fun x => c • f x) l (𝓝 <| c • a) ↔ Tendsto f l (𝓝 a) :=
  tendsto_const_smul_iff (Units.mk0 c hc)
#align tendsto_const_smul_iff₀ tendsto_const_smul_iff₀

variable [TopologicalSpace β] {f : β → α} {b : β} {c : G₀} {s : Set β}

theorem continuousWithinAt_const_smul_iff₀ (hc : c ≠ 0) :
    ContinuousWithinAt (fun x => c • f x) s b ↔ ContinuousWithinAt f s b :=
  tendsto_const_smul_iff (Units.mk0 c hc)
#align continuous_within_at_const_smul_iff₀ continuousWithinAt_const_smul_iff₀

theorem continuousOn_const_smul_iff₀ (hc : c ≠ 0) :
    ContinuousOn (fun x => c • f x) s ↔ ContinuousOn f s :=
  continuousOn_const_smul_iff (Units.mk0 c hc)
#align continuous_on_const_smul_iff₀ continuousOn_const_smul_iff₀

theorem continuousAt_const_smul_iff₀ (hc : c ≠ 0) :
    ContinuousAt (fun x => c • f x) b ↔ ContinuousAt f b :=
  continuousAt_const_smul_iff (Units.mk0 c hc)
#align continuous_at_const_smul_iff₀ continuousAt_const_smul_iff₀

theorem continuous_const_smul_iff₀ (hc : c ≠ 0) : (Continuous fun x => c • f x) ↔ Continuous f :=
  continuous_const_smul_iff (Units.mk0 c hc)
#align continuous_const_smul_iff₀ continuous_const_smul_iff₀

/-- Scalar multiplication by a non-zero element of a group with zero acting on `α` is a
homeomorphism from `α` onto itself. -/
protected def Homeomorph.smulOfNeZero (c : G₀) (hc : c ≠ 0) : α ≃ₜ α :=
  Homeomorph.smul (Units.mk0 c hc)
#align homeomorph.smul_of_ne_zero Homeomorph.smulOfNeZero

theorem isOpenMap_smul₀ {c : G₀} (hc : c ≠ 0) : IsOpenMap fun x : α => c • x :=
  (Homeomorph.smulOfNeZero c hc).isOpenMap
#align is_open_map_smul₀ isOpenMap_smul₀

theorem IsOpen.smul₀ {c : G₀} {s : Set α} (hs : IsOpen s) (hc : c ≠ 0) : IsOpen (c • s) :=
  isOpenMap_smul₀ hc s hs
#align is_open.smul₀ IsOpen.smul₀

theorem interior_smul₀ {c : G₀} (hc : c ≠ 0) (s : Set α) : interior (c • s) = c • interior s :=
  ((Homeomorph.smulOfNeZero c hc).image_interior s).symm
#align interior_smul₀ interior_smul₀

theorem closure_smul₀ {E} [Zero E] [MulActionWithZero G₀ E] [TopologicalSpace E] [T1Space E]
    [ContinuousConstSMul G₀ E] (c : G₀) (s : Set E) : closure (c • s) = c • closure s := by
  rcases eq_or_ne c 0 with (rfl | hc)
  · rcases eq_empty_or_nonempty s with (rfl | hs)
    · simp
    · rw [zero_smul_set hs, zero_smul_set hs.closure]
      exact closure_singleton
  · exact ((Homeomorph.smulOfNeZero c hc).image_closure s).symm
#align closure_smul₀ closure_smul₀

/-- `smul` is a closed map in the second argument.

The lemma that `smul` is a closed map in the first argument (for a normed space over a complete
normed field) is `isClosedMap_smul_left` in `Analysis.NormedSpace.FiniteDimension`. -/
theorem isClosedMap_smul_of_ne_zero {c : G₀} (hc : c ≠ 0) : IsClosedMap fun x : α => c • x :=
  (Homeomorph.smulOfNeZero c hc).isClosedMap
#align is_closed_map_smul_of_ne_zero isClosedMap_smul_of_ne_zero

theorem IsClosed.smul_of_ne_zero {c : G₀} {s : Set α} (hs : IsClosed s) (hc : c ≠ 0) :
    IsClosed (c • s) :=
  isClosedMap_smul_of_ne_zero hc s hs
#align is_closed.smul_of_ne_zero IsClosed.smul_of_ne_zero

/-- `smul` is a closed map in the second argument.

The lemma that `smul` is a closed map in the first argument (for a normed space over a complete
normed field) is `isClosedMap_smul_left` in `Analysis.NormedSpace.FiniteDimension`. -/
theorem isClosedMap_smul₀ {𝕜 M : Type _} [DivisionRing 𝕜] [AddCommMonoid M] [TopologicalSpace M]
    [T1Space M] [Module 𝕜 M] [ContinuousConstSMul 𝕜 M] (c : 𝕜) :
    IsClosedMap fun x : M => c • x := by
  rcases eq_or_ne c 0 with (rfl | hne)
  · simp only [zero_smul]
    exact isClosedMap_const
  · exact (Homeomorph.smulOfNeZero c hne).isClosedMap
#align is_closed_map_smul₀ isClosedMap_smul₀

theorem IsClosed.smul₀ {𝕜 M : Type _} [DivisionRing 𝕜] [AddCommMonoid M] [TopologicalSpace M]
    [T1Space M] [Module 𝕜 M] [ContinuousConstSMul 𝕜 M] (c : 𝕜) {s : Set M} (hs : IsClosed s) :
    IsClosed (c • s) :=
  isClosedMap_smul₀ c s hs
#align is_closed.smul₀ IsClosed.smul₀

theorem HasCompactMulSupport.comp_smul {β : Type _} [One β] {f : α → β} (h : HasCompactMulSupport f)
    {c : G₀} (hc : c ≠ 0) : HasCompactMulSupport fun x => f (c • x) :=
  h.comp_homeomorph (Homeomorph.smulOfNeZero c hc)
#align has_compact_mul_support.comp_smul HasCompactMulSupport.comp_smul

theorem HasCompactSupport.comp_smul {β : Type _} [Zero β] {f : α → β} (h : HasCompactSupport f)
    {c : G₀} (hc : c ≠ 0) : HasCompactSupport fun x => f (c • x) :=
  h.comp_homeomorph (Homeomorph.smulOfNeZero c hc)
#align has_compact_support.comp_smul HasCompactSupport.comp_smul

attribute [to_additive existing HasCompactSupport.comp_smul] HasCompactMulSupport.comp_smul

end GroupWithZero

namespace IsUnit

variable [Monoid M] [TopologicalSpace α] [MulAction M α] [ContinuousConstSMul M α]

nonrec theorem tendsto_const_smul_iff {f : β → α} {l : Filter β} {a : α} {c : M} (hc : IsUnit c) :
    Tendsto (fun x => c • f x) l (𝓝 <| c • a) ↔ Tendsto f l (𝓝 a) :=
  let ⟨u, hu⟩ := hc
  hu ▸ tendsto_const_smul_iff u
#align is_unit.tendsto_const_smul_iff IsUnit.tendsto_const_smul_iff

variable [TopologicalSpace β] {f : β → α} {b : β} {c : M} {s : Set β}

nonrec theorem continuousWithinAt_const_smul_iff (hc : IsUnit c) :
    ContinuousWithinAt (fun x => c • f x) s b ↔ ContinuousWithinAt f s b :=
  let ⟨u, hu⟩ := hc
  hu ▸ continuousWithinAt_const_smul_iff u
#align is_unit.continuous_within_at_const_smul_iff IsUnit.continuousWithinAt_const_smul_iff

nonrec theorem continuousOn_const_smul_iff (hc : IsUnit c) :
    ContinuousOn (fun x => c • f x) s ↔ ContinuousOn f s :=
  let ⟨u, hu⟩ := hc
  hu ▸ continuousOn_const_smul_iff u
#align is_unit.continuous_on_const_smul_iff IsUnit.continuousOn_const_smul_iff

nonrec theorem continuousAt_const_smul_iff (hc : IsUnit c) :
    ContinuousAt (fun x => c • f x) b ↔ ContinuousAt f b :=
  let ⟨u, hu⟩ := hc
  hu ▸ continuousAt_const_smul_iff u
#align is_unit.continuous_at_const_smul_iff IsUnit.continuousAt_const_smul_iff

nonrec theorem continuous_const_smul_iff (hc : IsUnit c) :
    (Continuous fun x => c • f x) ↔ Continuous f :=
  let ⟨u, hu⟩ := hc
  hu ▸ continuous_const_smul_iff u
#align is_unit.continuous_const_smul_iff IsUnit.continuous_const_smul_iff

nonrec theorem isOpenMap_smul (hc : IsUnit c) : IsOpenMap fun x : α => c • x :=
  let ⟨u, hu⟩ := hc
  hu ▸ isOpenMap_smul u
#align is_unit.is_open_map_smul IsUnit.isOpenMap_smul

nonrec theorem isClosedMap_smul (hc : IsUnit c) : IsClosedMap fun x : α => c • x :=
  let ⟨u, hu⟩ := hc
  hu ▸ isClosedMap_smul u
#align is_unit.is_closed_map_smul IsUnit.isClosedMap_smul

end IsUnit

-- porting note: todo: use `Set.Nonempty`
/-- Class `ProperlyDiscontinuousSMul Γ T` says that the scalar multiplication `(•) : Γ → T → T`
is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely many
`γ:Γ` move `K` to have nontrivial intersection with `L`.
-/
class ProperlyDiscontinuousSMul (Γ : Type _) (T : Type _) [TopologicalSpace T] [SMul Γ T] :
    Prop where
  /-- Given two compact sets `K` and `L`, `γ • K ∩ L` is nonempty for finitely many `γ`. -/
  finite_disjoint_inter_image :
    ∀ {K L : Set T}, IsCompact K → IsCompact L → Set.Finite { γ : Γ | (γ • ·)  '' K ∩ L ≠ ∅ }
#align properly_discontinuous_smul ProperlyDiscontinuousSMul

/-- Class `ProperlyDiscontinuousVAdd Γ T` says that the additive action `(+ᵥ) : Γ → T → T`
is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely many
`γ:Γ` move `K` to have nontrivial intersection with `L`.
-/
class ProperlyDiscontinuousVAdd (Γ : Type _) (T : Type _) [TopologicalSpace T] [VAdd Γ T] :
  Prop where
  /-- Given two compact sets `K` and `L`, `γ +ᵥ K ∩ L` is nonempty for finitely many `γ`. -/
  finite_disjoint_inter_image :
    ∀ {K L : Set T}, IsCompact K → IsCompact L → Set.Finite { γ : Γ | (γ +ᵥ ·) '' K ∩ L ≠ ∅ }
#align properly_discontinuous_vadd ProperlyDiscontinuousVAdd

attribute [to_additive] ProperlyDiscontinuousSMul

variable {Γ : Type _} [Group Γ] {T : Type _} [TopologicalSpace T] [MulAction Γ T]

/-- A finite group action is always properly discontinuous. -/
@[to_additive "A finite group action is always properly discontinuous."]
instance (priority := 100) Finite.to_properlyDiscontinuousSMul [Finite Γ] :
    ProperlyDiscontinuousSMul Γ T where finite_disjoint_inter_image _ _ := Set.toFinite _
#align finite.to_properly_discontinuous_smul Finite.to_properlyDiscontinuousSMul
#align finite.to_properly_discontinuous_vadd Finite.to_properlyDiscontinuousVAdd

export ProperlyDiscontinuousSMul (finite_disjoint_inter_image)
export ProperlyDiscontinuousVAdd (finite_disjoint_inter_image)

/-- The quotient map by a group action is open, i.e. the quotient by a group action is an open
  quotient. -/
@[to_additive "The quotient map by a group action is open, i.e. the quotient by a group
action is an open quotient. "]
theorem isOpenMap_quotient_mk'_mul [ContinuousConstSMul Γ T] :
    IsOpenMap (Quotient.mk' : T → Quotient (MulAction.orbitRel Γ T)) := fun U hU => by
  rw [isOpen_coinduced, MulAction.quotient_preimage_image_eq_union_mul U]
  exact isOpen_unionᵢ fun γ => isOpenMap_smul γ U hU
#align is_open_map_quotient_mk_mul isOpenMap_quotient_mk'_mul
#align is_open_map_quotient_mk_add isOpenMap_quotient_mk'_add

/-- The quotient by a discontinuous group action of a locally compact t2 space is t2. -/
@[to_additive "The quotient by a discontinuous group action of a locally compact t2
space is t2."]
instance (priority := 100) t2Space_of_properlyDiscontinuousSMul_of_t2Space [T2Space T]
    [LocallyCompactSpace T] [ContinuousConstSMul Γ T] [ProperlyDiscontinuousSMul Γ T] :
    T2Space (Quotient (MulAction.orbitRel Γ T)) := by
  set Q := Quotient (MulAction.orbitRel Γ T)
  rw [t2Space_iff_nhds]
  let f : T → Q := Quotient.mk'
  have f_op : IsOpenMap f := isOpenMap_quotient_mk'_mul
  rintro ⟨x₀⟩ ⟨y₀⟩ (hxy : f x₀ ≠ f y₀)
  show ∃ U ∈ 𝓝 (f x₀), ∃ V ∈ 𝓝 (f y₀), _
  have hγx₀y₀ : ∀ γ : Γ, γ • x₀ ≠ y₀ := not_exists.mp (mt Quotient.sound hxy.symm : _)
  obtain ⟨K₀, hK₀, K₀_in⟩ := exists_compact_mem_nhds x₀
  obtain ⟨L₀, hL₀, L₀_in⟩ := exists_compact_mem_nhds y₀
  let bad_Γ_set := { γ : Γ | (γ • ·) '' K₀ ∩ L₀ ≠ ∅ }
  have bad_Γ_finite : bad_Γ_set.Finite := finite_disjoint_inter_image (Γ := Γ) hK₀ hL₀
  choose u v hu hv u_v_disjoint using fun γ => t2_separation_nhds (hγx₀y₀ γ)
  let U₀₀ := ⋂ γ ∈ bad_Γ_set, (γ • ·) ⁻¹' u γ
  let U₀ := U₀₀ ∩ K₀
  let V₀₀ := ⋂ γ ∈ bad_Γ_set, v γ
  let V₀ := V₀₀ ∩ L₀
  have U_nhds : f '' U₀ ∈ 𝓝 (f x₀) := by
    refine f_op.image_mem_nhds (inter_mem ((binterᵢ_mem bad_Γ_finite).mpr fun γ _ => ?_) K₀_in)
    exact (continuous_const_smul _).continuousAt (hu γ)
  have V_nhds : f '' V₀ ∈ 𝓝 (f y₀) :=
    f_op.image_mem_nhds (inter_mem ((binterᵢ_mem bad_Γ_finite).mpr fun γ _ => hv γ) L₀_in)
  refine' ⟨f '' U₀, U_nhds, f '' V₀, V_nhds, MulAction.disjoint_image_image_iff.2 _⟩
  rintro x ⟨x_in_U₀₀, x_in_K₀⟩ γ
  by_cases H : γ ∈ bad_Γ_set
  · exact fun h => (u_v_disjoint γ).le_bot ⟨mem_interᵢ₂.mp x_in_U₀₀ γ H, mem_interᵢ₂.mp h.1 γ H⟩
  · rintro ⟨-, h'⟩
    simp only [image_smul, Classical.not_not, mem_setOf_eq, Ne.def] at H
    exact eq_empty_iff_forall_not_mem.mp H (γ • x) ⟨mem_image_of_mem _ x_in_K₀, h'⟩
#align t2_space_of_properly_discontinuous_smul_of_t2_space t2Space_of_properlyDiscontinuousSMul_of_t2Space
#align t2_space_of_properly_discontinuous_vadd_of_t2_space t2Space_of_properlyDiscontinuousVAdd_of_t2Space

/-- The quotient of a second countable space by a group action is second countable. -/
@[to_additive "The quotient of a second countable space by an additive group action is second
countable."]
theorem ContinuousConstSMul.secondCountableTopology [SecondCountableTopology T]
    [ContinuousConstSMul Γ T] : SecondCountableTopology (Quotient (MulAction.orbitRel Γ T)) :=
  TopologicalSpace.Quotient.secondCountableTopology isOpenMap_quotient_mk'_mul
#align has_continuous_const_smul.second_countable_topology ContinuousConstSMul.secondCountableTopology
#align has_continuous_const_vadd.second_countable_topology ContinuousConstVAdd.secondCountableTopology

section nhds

section MulAction

variable {G₀ : Type _} [GroupWithZero G₀] [MulAction G₀ α] [TopologicalSpace α]
  [ContinuousConstSMul G₀ α]

-- porting note: generalize to a group action + `IsUnit`
/-- Scalar multiplication preserves neighborhoods. -/
theorem set_smul_mem_nhds_smul {c : G₀} {s : Set α} {x : α} (hs : s ∈ 𝓝 x) (hc : c ≠ 0) :
    c • s ∈ 𝓝 (c • x : α) := by
  rw [mem_nhds_iff] at hs ⊢
  obtain ⟨U, hs', hU, hU'⟩ := hs
  exact ⟨c • U, Set.smul_set_mono hs', hU.smul₀ hc, Set.smul_mem_smul_set hU'⟩
#align set_smul_mem_nhds_smul set_smul_mem_nhds_smul

theorem set_smul_mem_nhds_smul_iff {c : G₀} {s : Set α} {x : α} (hc : c ≠ 0) :
    c • s ∈ 𝓝 (c • x : α) ↔ s ∈ 𝓝 x := by
  refine' ⟨fun h => _, fun h => set_smul_mem_nhds_smul h hc⟩
  rw [← inv_smul_smul₀ hc x, ← inv_smul_smul₀ hc s]
  exact set_smul_mem_nhds_smul h (inv_ne_zero hc)
#align set_smul_mem_nhds_smul_iff set_smul_mem_nhds_smul_iff

end MulAction

section DistribMulAction

variable {G₀ : Type _} [GroupWithZero G₀] [AddMonoid α] [DistribMulAction G₀ α] [TopologicalSpace α]
  [ContinuousConstSMul G₀ α]

theorem set_smul_mem_nhds_zero_iff {s : Set α} {c : G₀} (hc : c ≠ 0) :
    c • s ∈ 𝓝 (0 : α) ↔ s ∈ 𝓝 (0 : α) := by
  refine' Iff.trans _ (set_smul_mem_nhds_smul_iff hc)
  rw [smul_zero]
#align set_smul_mem_nhds_zero_iff set_smul_mem_nhds_zero_iff

end DistribMulAction

end nhds


/-
Copyright (c) 2019 Lucas Allen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lucas Allen
-/
import tactic.converter.interactive

/-!
# Tests for the `conv` tactic inside the interactive `conv` monad
-/

example (a b c d : ℕ) (h₁ : b = c) (h₂ : a + c = a + d) : a + b = a + d :=
begin
conv {     --| a + b = a + d
  --Conv to the left hand side
  to_lhs,  -- | a + b
  --Zoom into the left hand side.
  conv {   -- | a + b
    congr, -- two goals: | a and | b
    skip,  -- | b
    rw h₁, -- | c
  },       -- | a + c
  --At this point, to get back to this position, without zoom, we would need to close
  --this conv block, and open a new one.
  rw h₂,   -- | a + d
},         -- goals accomplished
end

example : 1 + (5 * 8) - (3 * 14) + (4 * 99 - 45) - 350 = 1 :=
begin
  have h₁ : 5 * 8 = 40, from dec_trivial,
  have h₂ : 3 * 14 = 42, from dec_trivial,
  have h₃ : 4 * 99 - 45 = 351, from dec_trivial,
  conv {
    to_lhs,    -- conv to the left hand side
    conv {     -- zooming in to rewrite 4 * 99 - 45 to 351
      congr, congr, skip,
      rw h₃,
    },         -- returning to the left hand side, note we don't need to open a new conv block
    conv {     -- zooming in to rewrite 3 * 14 to 42
      congr, congr, congr, skip,
      rw h₂,
    },         -- returning to the left hand side
    conv {     -- zooming in to rewrite 5 * 8 to 40
      congr, congr, congr, congr, skip,
      rw h₁,
    },         -- returning to the left hand side
  },
end


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.zsqrtd.basic
import Mathlib.data.complex.basic
import Mathlib.ring_theory.principal_ideal_domain
import Mathlib.number_theory.quadratic_reciprocity
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Gaussian integers

The Gaussian integers are complex integer, complex numbers whose real and imaginary parts are both
integers.

## Main definitions

The Euclidean domain structure on `ℤ[i]` is defined in this file.

The homomorphism `to_complex` into the complex numbers is also defined in this file.

## Main statements

`prime_iff_mod_four_eq_three_of_nat_prime`
A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4`

## Notations

This file uses the local notation `ℤ[i]` for `gaussian_int`

## Implementation notes

Gaussian integers are implemented using the more general definition `zsqrtd`, the type of integers
adjoined a square root of `d`, in this case `-1`. The definition is reducible, so that properties
and definitions about `zsqrtd` can easily be used.
-/

def gaussian_int :=
  ℤ√(-1)

namespace gaussian_int

protected instance has_repr : has_repr gaussian_int :=
  has_repr.mk
    fun (x : gaussian_int) =>
      string.str string.empty
                (char.of_nat
                  (bit0 (bit0 (bit0 (bit1 (bit0 (bit1 (bit1 (bit1 (bit1 (bit1 (bit1 (bit0 (bit0 1)))))))))))))) ++
              repr (zsqrtd.re x) ++
            string.str (string.str string.empty (char.of_nat (bit0 (bit0 (bit1 (bit1 (bit0 1)))))))
              (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit0 1)))))) ++
          repr (zsqrtd.im x) ++
        string.str string.empty
          (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit0 (bit1 (bit1 (bit1 (bit1 (bit1 (bit1 (bit0 (bit0 1))))))))))))))

protected instance comm_ring : comm_ring gaussian_int :=
  zsqrtd.comm_ring

/-- The embedding of the Gaussian integers into the complex numbers, as a ring homomorphism. -/
def to_complex : gaussian_int →+* ℂ :=
  coe_fn zsqrtd.lift { val := complex.I, property := sorry }

protected instance complex.has_coe : has_coe gaussian_int ℂ :=
  has_coe.mk ⇑to_complex

theorem to_complex_def (x : gaussian_int) : ↑x = ↑(zsqrtd.re x) + ↑(zsqrtd.im x) * complex.I :=
  rfl

theorem to_complex_def' (x : ℤ) (y : ℤ) : ↑(zsqrtd.mk x y) = ↑x + ↑y * complex.I := sorry

theorem to_complex_def₂ (x : gaussian_int) : ↑x = complex.mk ↑(zsqrtd.re x) ↑(zsqrtd.im x) := sorry

@[simp] theorem to_real_re (x : gaussian_int) : ↑(zsqrtd.re x) = complex.re ↑x := sorry

@[simp] theorem to_real_im (x : gaussian_int) : ↑(zsqrtd.im x) = complex.im ↑x := sorry

@[simp] theorem to_complex_re (x : ℤ) (y : ℤ) : complex.re ↑(zsqrtd.mk x y) = ↑x := sorry

@[simp] theorem to_complex_im (x : ℤ) (y : ℤ) : complex.im ↑(zsqrtd.mk x y) = ↑y := sorry

@[simp] theorem to_complex_add (x : gaussian_int) (y : gaussian_int) : ↑(x + y) = ↑x + ↑y :=
  ring_hom.map_add to_complex x y

@[simp] theorem to_complex_mul (x : gaussian_int) (y : gaussian_int) : ↑(x * y) = ↑x * ↑y :=
  ring_hom.map_mul to_complex x y

@[simp] theorem to_complex_one : ↑1 = 1 :=
  ring_hom.map_one to_complex

@[simp] theorem to_complex_zero : ↑0 = 0 :=
  ring_hom.map_zero to_complex

@[simp] theorem to_complex_neg (x : gaussian_int) : ↑(-x) = -↑x :=
  ring_hom.map_neg to_complex x

@[simp] theorem to_complex_sub (x : gaussian_int) (y : gaussian_int) : ↑(x - y) = ↑x - ↑y :=
  ring_hom.map_sub to_complex x y

@[simp] theorem to_complex_inj {x : gaussian_int} {y : gaussian_int} : ↑x = ↑y ↔ x = y := sorry

@[simp] theorem to_complex_eq_zero {x : gaussian_int} : ↑x = 0 ↔ x = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑x = 0 ↔ x = 0)) (Eq.symm to_complex_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑x = ↑0 ↔ x = 0)) (propext to_complex_inj))) (iff.refl (x = 0)))

@[simp] theorem nat_cast_real_norm (x : gaussian_int) : ↑(zsqrtd.norm x) = coe_fn complex.norm_sq ↑x := sorry

@[simp] theorem nat_cast_complex_norm (x : gaussian_int) : ↑(zsqrtd.norm x) = ↑(coe_fn complex.norm_sq ↑x) := sorry

theorem norm_nonneg (x : gaussian_int) : 0 ≤ zsqrtd.norm x :=
  zsqrtd.norm_nonneg (eq.mpr (id (eq_true_intro (neg_nonpos_of_nonneg (norm_num.nonneg_pos 1 zero_lt_one')))) trivial) x

@[simp] theorem norm_eq_zero {x : gaussian_int} : zsqrtd.norm x = 0 ↔ x = 0 := sorry

theorem norm_pos {x : gaussian_int} : 0 < zsqrtd.norm x ↔ x ≠ 0 := sorry

@[simp] theorem coe_nat_abs_norm (x : gaussian_int) : ↑(int.nat_abs (zsqrtd.norm x)) = zsqrtd.norm x :=
  int.nat_abs_of_nonneg (norm_nonneg x)

@[simp] theorem nat_cast_nat_abs_norm {α : Type u_1} [ring α] (x : gaussian_int) : ↑(int.nat_abs (zsqrtd.norm x)) = ↑(zsqrtd.norm x) := sorry

theorem nat_abs_norm_eq (x : gaussian_int) : int.nat_abs (zsqrtd.norm x) =
  int.nat_abs (zsqrtd.re x) * int.nat_abs (zsqrtd.re x) + int.nat_abs (zsqrtd.im x) * int.nat_abs (zsqrtd.im x) := sorry

protected def div (x : gaussian_int) (y : gaussian_int) : gaussian_int :=
  let n : ℚ := rat.of_int (zsqrtd.norm y)⁻¹;
  let c : ℤ√(-1) := zsqrtd.conj y;
  zsqrtd.mk (round (rat.of_int (zsqrtd.re (x * c)) * n)) (round (rat.of_int (zsqrtd.im (x * c)) * n))

protected instance has_div : Div gaussian_int :=
  { div := gaussian_int.div }

theorem div_def (x : gaussian_int) (y : gaussian_int) : x / y =
  zsqrtd.mk (round (↑(zsqrtd.re (x * zsqrtd.conj y)) / ↑(zsqrtd.norm y)))
    (round (↑(zsqrtd.im (x * zsqrtd.conj y)) / ↑(zsqrtd.norm y))) := sorry

theorem to_complex_div_re (x : gaussian_int) (y : gaussian_int) : complex.re ↑(x / y) = ↑(round (complex.re (↑x / ↑y))) := sorry

theorem to_complex_div_im (x : gaussian_int) (y : gaussian_int) : complex.im ↑(x / y) = ↑(round (complex.im (↑x / ↑y))) := sorry

theorem norm_sq_le_norm_sq_of_re_le_of_im_le {x : ℂ} {y : ℂ} (hre : abs (complex.re x) ≤ abs (complex.re y)) (him : abs (complex.im x) ≤ abs (complex.im y)) : coe_fn complex.norm_sq x ≤ coe_fn complex.norm_sq y := sorry

theorem norm_sq_div_sub_div_lt_one (x : gaussian_int) (y : gaussian_int) : coe_fn complex.norm_sq (↑x / ↑y - ↑(x / y)) < 1 := sorry

protected def mod (x : gaussian_int) (y : gaussian_int) : gaussian_int :=
  x - y * (x / y)

protected instance has_mod : Mod gaussian_int :=
  { mod := gaussian_int.mod }

theorem mod_def (x : gaussian_int) (y : gaussian_int) : x % y = x - y * (x / y) :=
  rfl

theorem norm_mod_lt (x : gaussian_int) {y : gaussian_int} (hy : y ≠ 0) : zsqrtd.norm (x % y) < zsqrtd.norm y := sorry

theorem nat_abs_norm_mod_lt (x : gaussian_int) {y : gaussian_int} (hy : y ≠ 0) : int.nat_abs (zsqrtd.norm (x % y)) < int.nat_abs (zsqrtd.norm y) := sorry

theorem norm_le_norm_mul_left (x : gaussian_int) {y : gaussian_int} (hy : y ≠ 0) : int.nat_abs (zsqrtd.norm x) ≤ int.nat_abs (zsqrtd.norm (x * y)) := sorry

protected instance nontrivial : nontrivial gaussian_int :=
  nontrivial.mk (Exists.intro 0 (Exists.intro 1 (of_as_true trivial)))

protected instance euclidean_domain : euclidean_domain gaussian_int :=
  euclidean_domain.mk comm_ring.add comm_ring.add_assoc comm_ring.zero comm_ring.zero_add comm_ring.add_zero comm_ring.neg
    comm_ring.sub comm_ring.add_left_neg comm_ring.add_comm comm_ring.mul comm_ring.mul_assoc comm_ring.one
    comm_ring.one_mul comm_ring.mul_one comm_ring.left_distrib comm_ring.right_distrib comm_ring.mul_comm
    nontrivial.exists_pair_ne Div.div sorry Mod.mod sorry (measure (int.nat_abs ∘ zsqrtd.norm)) sorry nat_abs_norm_mod_lt
    sorry

theorem mod_four_eq_three_of_nat_prime_of_prime (p : ℕ) [hp : fact (nat.prime p)] (hpi : prime ↑p) : p % bit0 (bit0 1) = bit1 1 := sorry

theorem sum_two_squares_of_nat_prime_of_not_irreducible (p : ℕ) [hp : fact (nat.prime p)] (hpi : ¬irreducible ↑p) : ∃ (a : ℕ), ∃ (b : ℕ), a ^ bit0 1 + b ^ bit0 1 = p := sorry

theorem prime_of_nat_prime_of_mod_four_eq_three (p : ℕ) [hp : fact (nat.prime p)] (hp3 : p % bit0 (bit0 1) = bit1 1) : prime ↑p := sorry

/-- A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4` -/
theorem prime_iff_mod_four_eq_three_of_nat_prime (p : ℕ) [hp : fact (nat.prime p)] : prime ↑p ↔ p % bit0 (bit0 1) = bit1 1 :=
  { mp := mod_four_eq_three_of_nat_prime_of_prime p, mpr := prime_of_nat_prime_of_mod_four_eq_three p }


import data.equiv.basic
--import analysis.topology.topological_structures
universes u v w

-- Scott's basic class.
class transportable (f : Type u → Type v) :=
(on_equiv : Π {α β : Type u} (e : equiv α β), equiv (f α) (f β))
(on_refl  : Π (α : Type u), on_equiv (equiv.refl α) = equiv.refl (f α))
(on_trans : Π {α β γ : Type u} (d : equiv α β) (e : equiv β γ), on_equiv (equiv.trans d e) = equiv.trans (on_equiv d) (on_equiv e))

-- One goal is an automagic proof of the following
theorem group.transportable : transportable group := sorry
-- we know it can be proved by hand, but we're bored of doing it.
-- Kenny even did ring in his github
-- theorem topological_ring.transportable : transportable topological_ring := sorry
-- type mismatch at application

-- But some basic constructions we might need to do by hand.

def Const : Type u → Type v := λ α, punit
lemma Const.transportable : (transportable Const) :=
{ on_equiv := λ α β e, equiv.punit_equiv_punit,
  on_refl  := λ α, equiv.ext _ _ $ λ ⟨⟩, rfl,
  on_trans := λ α β γ e1 e2, equiv.ext _ _ $ λ ⟨⟩, rfl }

def Fun : Type u → Type v → Type (max u v) := λ α β, α → β
lemma Fun.transportable (α : Type u) : (transportable (Fun α)) :=
{ on_equiv := λ β γ e, equiv.arrow_congr (equiv.refl α) e,
  on_refl  := λ β, equiv.ext _ _ $ λ f, rfl,
  on_trans := λ β γ δ e1 e2, equiv.ext _ _ $ λ f, funext $ λ x,
    by cases e1; cases e2; refl }

theorem prod.ext' {α β : Type*} {p q : α × β} (H1 : p.1 = q.1) (H2 : p.2 = q.2) : p = q :=
prod.ext H1 H2

def Prod : Type u → Type v → Type (max u v) := λ α β, α × β
lemma Prod.transportable (α : Type u) : (transportable (Prod α)) :=
{ on_equiv := λ β γ e, equiv.prod_congr (equiv.refl α) e,
  on_refl  := λ β, equiv.ext _ _ $ λ ⟨x, y⟩, by simp,
  on_trans := λ β γ δ e1 e2, equiv.ext _ _ $ λ ⟨x, y⟩, by simp }

def Swap : Type u → Type v → Type (max u v) := λ α β, β × α
lemma Swap.transportable (α : Type u) : (transportable (Swap α)) :=
{ on_equiv := λ β γ e, equiv.prod_congr e (equiv.refl α),
  on_refl  := λ β, equiv.ext _ _ $ λ ⟨x, y⟩, by simp,
  on_trans := λ β γ δ e1 e2, equiv.ext _ _ $ λ ⟨x, y⟩, by simp }

-- And then we can define
def Hom1 (α : Type u) : Type v → Type (max u v) := λ β, α → β
def Hom2 (β : Type v) : Type u → Type (max u v) := λ α, α → β
def Aut : Type u → Type u := λ α, α → α

-- And hopefully automagically derive
lemma Hom1.transportable (α : Type u) : (transportable (Hom1 α)) :=
Fun.transportable α

lemma Hom2.transportable (β : Type v) : (transportable (Hom2 β)) :=
{ on_equiv := λ α γ e, equiv.arrow_congr e (equiv.refl β),
  on_refl  := λ β, equiv.ext _ _ $ λ f, rfl,
  on_trans := λ β γ δ e1 e2, equiv.ext _ _ $ λ f, funext $ λ x,
    by cases e1; cases e2; refl }

lemma Aut.transportable : (transportable Aut) :=
{ on_equiv := λ α β e, equiv.arrow_congr e e,
  on_refl  := λ α, equiv.ext _ _ $ λ f, funext $ λ x, rfl,
  on_trans := λ α β γ e1 e2, equiv.ext _ _ $ λ f, funext $ λ x,
    by cases e1; cases e2; refl }

-- If we have all these in place...
-- A bit of magic might actually be able to derive `group.transportable` on line 11.
-- After all, a group just is a type plus some functions... and we can now transport functions.

#print prefix prod

--theorem T {α : Type u} {β : Type v} [group α] [group β] :
--group α × β := by apply_instance

definition prod_group (G : Type u) (H : Type v) [HG : group G] [HH : group H] : group (G × H) :=
{ mul := λ ⟨g1,h1⟩ ⟨g2,h2⟩, ⟨g1 * g2,h1 * h2⟩,
  mul_assoc := λ ⟨g1,h1⟩ ⟨g2,h2⟩ ⟨g3,h3⟩,prod.ext (mul_assoc _ _ _) (mul_assoc _ _ _),
  one := ⟨HG.one,HH.one⟩,
  one_mul := λ ⟨g,h⟩, prod.ext (one_mul _) (one_mul _),
  mul_one := λ ⟨g,h⟩, prod.ext (mul_one _) (mul_one _),
  inv := λ ⟨g,h⟩, ⟨group.inv g,group.inv h⟩,--begin end,--λ ⟨g,h⟩, ⟨HG.inv g,HH.inv h⟩,
  mul_left_inv := λ ⟨g,h⟩, prod.ext (mul_left_inv g) (mul_left_inv h)
}

-- I can prove that if G is can iso to G', and H to H', then the diagram commutes?
-- remember we proved that Prod was transportable

-- free theorem for chnat
def chℕ := Π X : Type, (X → X) → X → X
theorem free_chnat : ∀ (A B : Type), ∀ f : A → B, ∀ r : chℕ,
∀ a : A,
r (A → B) (λ g,f) f a  = r (A → B) (λ g,g) f a
 := begin
intros A B f r a,
let Athing1 := r A (λ b, a) a,
let Athing2 := r A (λ b, b) a,
let Bthing1 := r B (λ b,f a) (f a),
let Bthing2 := r B (λ b,b) (f a),
-- these free theorems are hard to prove
admit,
 end


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot

! This file was ported from Lean 3 source module topology.dense_embedding
! leanprover-community/mathlib commit d90e4e186f1d18e375dcd4e5b5f6364b01cb3e46
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Separation
import Mathlib.Topology.Bases

/-!
# Dense embeddings

This file defines three properties of functions:

* `DenseRange f`      means `f` has dense image;
* `DenseInducing i`   means `i` is also `Inducing`;
* `DenseEmbedding e`  means `e` is also an `Embedding`.

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

-/

noncomputable section

open Set Filter

open Classical Topology Filter

variable {α : Type _} {β : Type _} {γ : Type _} {δ : Type _}

/-- `i : α → β` is "dense inducing" if it has dense range and the topology on `α`
  is the one induced by `i` from the topology on `β`. -/
structure DenseInducing [TopologicalSpace α] [TopologicalSpace β] (i : α → β)
    extends Inducing i : Prop where
  /-- The range of a dense inducing map is a dense set. -/
  protected dense : DenseRange i
#align dense_inducing DenseInducing

namespace DenseInducing

variable [TopologicalSpace α] [TopologicalSpace β]

variable {i : α → β} (di : DenseInducing i)

theorem nhds_eq_comap (di : DenseInducing i) : ∀ a : α, 𝓝 a = comap i (𝓝 <| i a) :=
  di.toInducing.nhds_eq_comap
#align dense_inducing.nhds_eq_comap DenseInducing.nhds_eq_comap

protected theorem continuous (di : DenseInducing i) : Continuous i :=
  di.toInducing.continuous
#align dense_inducing.continuous DenseInducing.continuous

theorem closure_range : closure (range i) = univ :=
  di.dense.closure_range
#align dense_inducing.closure_range DenseInducing.closure_range

protected

theorem closure_image_mem_nhds {s : Set α} {a : α} (di : DenseInducing i) (hs : s ∈ 𝓝 a) :
    closure (i '' s) ∈ 𝓝 (i a) := by
  rw [di.nhds_eq_comap a, ((nhds_basis_opens _).comap _).mem_iff] at hs
  rcases hs with ⟨U, ⟨haU, hUo⟩, sub : i ⁻¹' U ⊆ s⟩
  refine' mem_of_superset (hUo.mem_nhds haU) _
  calc
    U ⊆ closure (i '' (i ⁻¹' U)) := di.dense.subset_closure_image_preimage_of_isOpen hUo
    _ ⊆ closure (i '' s) := closure_mono (image_subset i sub)

#align dense_inducing.closure_image_mem_nhds DenseInducing.closure_image_mem_nhds

theorem dense_image (di : DenseInducing i) {s : Set α} : Dense (i '' s) ↔ Dense s := by
  refine' ⟨fun H x => _, di.dense.dense_image di.continuous⟩
  rw [di.toInducing.closure_eq_preimage_closure_image, H.closure_eq, preimage_univ]
  trivial
#align dense_inducing.dense_image DenseInducing.dense_image

/-- If `i : α → β` is a dense embedding with dense complement of the range, then any compact set in
`α` has empty interior. -/
theorem interior_compact_eq_empty [T2Space β] (di : DenseInducing i) (hd : Dense (range iᶜ))
    {s : Set α} (hs : IsCompact s) : interior s = ∅ := by
  refine' eq_empty_iff_forall_not_mem.2 fun x hx => _
  rw [mem_interior_iff_mem_nhds] at hx
  have := di.closure_image_mem_nhds hx
  rw [(hs.image di.continuous).isClosed.closure_eq] at this
  rcases hd.inter_nhds_nonempty this with ⟨y, hyi, hys⟩
  exact hyi (image_subset_range _ _ hys)
#align dense_inducing.interior_compact_eq_empty DenseInducing.interior_compact_eq_empty

/-- The product of two dense inducings is a dense inducing -/
protected theorem prod [TopologicalSpace γ] [TopologicalSpace δ] {e₁ : α → β} {e₂ : γ → δ}
    (de₁ : DenseInducing e₁) (de₂ : DenseInducing e₂) :
    DenseInducing fun p : α × γ => (e₁ p.1, e₂ p.2) where
  toInducing := de₁.toInducing.prod_map de₂.toInducing
  dense := de₁.dense.prod_map de₂.dense
#align dense_inducing.prod DenseInducing.prod

open TopologicalSpace

/-- If the domain of a `DenseInducing` map is a separable space, then so is the codomain. -/
protected theorem separableSpace [SeparableSpace α] : SeparableSpace β :=
  di.dense.separableSpace di.continuous
#align dense_inducing.separable_space DenseInducing.separableSpace

variable [TopologicalSpace δ] {f : γ → α} {g : γ → δ} {h : δ → β}

/-- ```
 γ -f→ α
g↓     ↓e
 δ -h→ β
```
-/
theorem tendsto_comap_nhds_nhds {d : δ} {a : α} (di : DenseInducing i)
    (H : Tendsto h (𝓝 d) (𝓝 (i a))) (comm : h ∘ g = i ∘ f) : Tendsto f (comap g (𝓝 d)) (𝓝 a) := by
  have lim1 : map g (comap g (𝓝 d)) ≤ 𝓝 d := map_comap_le
  replace lim1 : map h (map g (comap g (𝓝 d))) ≤ map h (𝓝 d) := map_mono lim1
  rw [Filter.map_map, comm, ← Filter.map_map, map_le_iff_le_comap] at lim1
  have lim2 : comap i (map h (𝓝 d)) ≤ comap i (𝓝 (i a)) := comap_mono H
  rw [← di.nhds_eq_comap] at lim2
  exact le_trans lim1 lim2
#align dense_inducing.tendsto_comap_nhds_nhds DenseInducing.tendsto_comap_nhds_nhds

protected theorem nhdsWithin_neBot (di : DenseInducing i) (b : β) : NeBot (𝓝[range i] b) :=
  di.dense.nhdsWithin_neBot b
#align dense_inducing.nhds_within_ne_bot DenseInducing.nhdsWithin_neBot

theorem comap_nhds_neBot (di : DenseInducing i) (b : β) : NeBot (comap i (𝓝 b)) :=
  comap_neBot fun s hs => by
    rcases mem_closure_iff_nhds.1 (di.dense b) s hs with ⟨_, ⟨ha, a, rfl⟩⟩
    exact ⟨a, ha⟩
#align dense_inducing.comap_nhds_ne_bot DenseInducing.comap_nhds_neBot

variable [TopologicalSpace γ]

/-- If `i : α → β` is a dense inducing, then any function `f : α → γ` "extends" to a function `g =
  DenseInducing.extend di f : β → γ`. If `γ` is Hausdorff and `f` has a continuous extension, then
  `g` is the unique such extension. In general, `g` might not be continuous or even extend `f`. -/
def extend (di : DenseInducing i) (f : α → γ) (b : β) : γ :=
  @limUnder _ _ _ ⟨f (di.dense.some b)⟩ (comap i (𝓝 b)) f
#align dense_inducing.extend DenseInducing.extend

theorem extend_eq_of_tendsto [T2Space γ] {b : β} {c : γ} {f : α → γ}
    (hf : Tendsto f (comap i (𝓝 b)) (𝓝 c)) : di.extend f b = c :=
  haveI := di.comap_nhds_neBot
  hf.limUnder_eq
#align dense_inducing.extend_eq_of_tendsto DenseInducing.extend_eq_of_tendsto

theorem extend_eq_at [T2Space γ] {f : α → γ} {a : α} (hf : ContinuousAt f a) :
    di.extend f (i a) = f a :=
  extend_eq_of_tendsto _ <| di.nhds_eq_comap a ▸ hf
#align dense_inducing.extend_eq_at DenseInducing.extend_eq_at

theorem extend_eq_at' [T2Space γ] {f : α → γ} {a : α} (c : γ) (hf : Tendsto f (𝓝 a) (𝓝 c)) :
    di.extend f (i a) = f a :=
  di.extend_eq_at (continuousAt_of_tendsto_nhds hf)
#align dense_inducing.extend_eq_at' DenseInducing.extend_eq_at'

theorem extend_eq [T2Space γ] {f : α → γ} (hf : Continuous f) (a : α) : di.extend f (i a) = f a :=
  di.extend_eq_at hf.continuousAt
#align dense_inducing.extend_eq DenseInducing.extend_eq

/-- Variation of `extend_eq` where we ask that `f` has a limit along `comap i (𝓝 b)` for each
`b : β`. This is a strictly stronger assumption than continuity of `f`, but in a lot of cases
you'd have to prove it anyway to use `continuous_extend`, so this avoids doing the work twice. -/
theorem extend_eq' [T2Space γ] {f : α → γ} (di : DenseInducing i)
    (hf : ∀ b, ∃ c, Tendsto f (comap i (𝓝 b)) (𝓝 c)) (a : α) : di.extend f (i a) = f a := by
  rcases hf (i a) with ⟨b, hb⟩
  refine' di.extend_eq_at' b _
  rwa [← di.toInducing.nhds_eq_comap] at hb
#align dense_inducing.extend_eq' DenseInducing.extend_eq'

theorem extend_unique_at [T2Space γ] {b : β} {f : α → γ} {g : β → γ} (di : DenseInducing i)
    (hf : ∀ᶠ x in comap i (𝓝 b), g (i x) = f x) (hg : ContinuousAt g b) : di.extend f b = g b := by
  refine' di.extend_eq_of_tendsto fun s hs => mem_map.2 _
  suffices : ∀ᶠ x : α in comap i (𝓝 b), g (i x) ∈ s
  exact hf.mp (this.mono fun x hgx hfx => hfx ▸ hgx)
  clear hf f
  refine' eventually_comap.2 ((hg.eventually hs).mono _)
  rintro _ hxs x rfl
  exact hxs
#align dense_inducing.extend_unique_at DenseInducing.extend_unique_at

theorem extend_unique [T2Space γ] {f : α → γ} {g : β → γ} (di : DenseInducing i)
    (hf : ∀ x, g (i x) = f x) (hg : Continuous g) : di.extend f = g :=
  funext fun _ => extend_unique_at di (eventually_of_forall hf) hg.continuousAt
#align dense_inducing.extend_unique DenseInducing.extend_unique

theorem continuousAt_extend [T3Space γ] {b : β} {f : α → γ} (di : DenseInducing i)
    (hf : ∀ᶠ x in 𝓝 b, ∃ c, Tendsto f (comap i <| 𝓝 x) (𝓝 c)) : ContinuousAt (di.extend f) b := by
  set φ := di.extend f
  haveI := di.comap_nhds_neBot
  suffices ∀ V' ∈ 𝓝 (φ b), IsClosed V' → φ ⁻¹' V' ∈ 𝓝 b by
    simpa [ContinuousAt, (closed_nhds_basis (φ b)).tendsto_right_iff]
  intro V' V'_in V'_closed
  set V₁ := { x | Tendsto f (comap i <| 𝓝 x) (𝓝 <| φ x) }
  have V₁_in : V₁ ∈ 𝓝 b := by
    filter_upwards [hf]
    rintro x ⟨c, hc⟩
    rwa [di.extend_eq_of_tendsto hc]
  obtain ⟨V₂, V₂_in, V₂_op, hV₂⟩ : ∃ V₂ ∈ 𝓝 b, IsOpen V₂ ∧ ∀ x ∈ i ⁻¹' V₂, f x ∈ V' := by
    simpa [and_assoc] using
      ((nhds_basis_opens' b).comap i).tendsto_left_iff.mp (mem_of_mem_nhds V₁_in : b ∈ V₁) V' V'_in
  suffices ∀ x ∈ V₁ ∩ V₂, φ x ∈ V' by filter_upwards [inter_mem V₁_in V₂_in]using this
  rintro x ⟨x_in₁, x_in₂⟩
  have hV₂x : V₂ ∈ 𝓝 x := IsOpen.mem_nhds V₂_op x_in₂
  apply V'_closed.mem_of_tendsto x_in₁
  use V₂
  tauto
#align dense_inducing.continuous_at_extend DenseInducing.continuousAt_extend

theorem continuous_extend [T3Space γ] {f : α → γ} (di : DenseInducing i)
    (hf : ∀ b, ∃ c, Tendsto f (comap i (𝓝 b)) (𝓝 c)) : Continuous (di.extend f) :=
  continuous_iff_continuousAt.mpr fun _ => di.continuousAt_extend <| univ_mem' hf
#align dense_inducing.continuous_extend DenseInducing.continuous_extend

theorem mk' (i : α → β) (c : Continuous i) (dense : ∀ x, x ∈ closure (range i))
    (H : ∀ (a : α), ∀ s ∈ 𝓝 a, ∃ t ∈ 𝓝 (i a), ∀ b, i b ∈ t → b ∈ s) : DenseInducing i :=
  { toInducing := inducing_iff_nhds.2 fun a =>
      le_antisymm (c.tendsto _).le_comap (by simpa [Filter.le_def] using H a)
    dense }
#align dense_inducing.mk' DenseInducing.mk'

end DenseInducing

/-- A dense embedding is an embedding with dense image. -/
structure DenseEmbedding [TopologicalSpace α] [TopologicalSpace β] (e : α → β) extends
  DenseInducing e : Prop where
  /-- A dense embedding is injective. -/
  inj : Function.Injective e
#align dense_embedding DenseEmbedding

theorem DenseEmbedding.mk' [TopologicalSpace α] [TopologicalSpace β] (e : α → β) (c : Continuous e)
    (dense : DenseRange e) (inj : Function.Injective e)
    (H : ∀ (a : α), ∀ s ∈ 𝓝 a, ∃ t ∈ 𝓝 (e a), ∀ b, e b ∈ t → b ∈ s) : DenseEmbedding e :=
  { DenseInducing.mk' e c dense H with inj }
#align dense_embedding.mk' DenseEmbedding.mk'

namespace DenseEmbedding

open TopologicalSpace

variable [TopologicalSpace α] [TopologicalSpace β] [TopologicalSpace γ] [TopologicalSpace δ]

variable {e : α → β} (de : DenseEmbedding e)

theorem inj_iff {x y} : e x = e y ↔ x = y :=
  de.inj.eq_iff
#align dense_embedding.inj_iff DenseEmbedding.inj_iff

theorem to_embedding : Embedding e :=
  { induced := de.induced
    inj := de.inj }
#align dense_embedding.to_embedding DenseEmbedding.to_embedding

/-- If the domain of a `DenseEmbedding` is a separable space, then so is its codomain. -/
protected theorem separableSpace [SeparableSpace α] : SeparableSpace β :=
  de.toDenseInducing.separableSpace
#align dense_embedding.separable_space DenseEmbedding.separableSpace

/-- The product of two dense embeddings is a dense embedding. -/
protected theorem prod {e₁ : α → β} {e₂ : γ → δ} (de₁ : DenseEmbedding e₁)
    (de₂ : DenseEmbedding e₂) : DenseEmbedding fun p : α × γ => (e₁ p.1, e₂ p.2) :=
  { de₁.toDenseInducing.prod de₂.toDenseInducing with
    inj := de₁.inj.Prod_map de₂.inj }
#align dense_embedding.prod DenseEmbedding.prod

/-- The dense embedding of a subtype inside its closure. -/
@[simps]
def subtypeEmb {α : Type _} (p : α → Prop) (e : α → β) (x : { x // p x }) :
    { x // x ∈ closure (e '' { x | p x }) } :=
  ⟨e x, subset_closure <| mem_image_of_mem e x.prop⟩
#align dense_embedding.subtype_emb DenseEmbedding.subtypeEmb

protected theorem subtype (p : α → Prop) : DenseEmbedding (subtypeEmb p e) :=
  { dense :=
      dense_iff_closure_eq.2 <| by
        ext ⟨x, hx⟩
        rw [image_eq_range] at hx
        simpa [closure_subtype, ← range_comp, (· ∘ ·)]
    inj := (de.inj.comp Subtype.coe_injective).codRestrict _
    induced :=
      (induced_iff_nhds_eq _).2 fun ⟨x, hx⟩ => by
        simp [subtypeEmb, nhds_subtype_eq_comap, de.toInducing.nhds_eq_comap, comap_comap,
          (· ∘ ·)] }
#align dense_embedding.subtype DenseEmbedding.subtype

theorem dense_image {s : Set α} : Dense (e '' s) ↔ Dense s :=
  de.toDenseInducing.dense_image
#align dense_embedding.dense_image DenseEmbedding.dense_image

end DenseEmbedding

theorem denseEmbedding_id {α : Type _} [TopologicalSpace α] : DenseEmbedding (id : α → α) :=
  { embedding_id with dense := denseRange_id }
#align dense_embedding_id denseEmbedding_id

theorem Dense.denseEmbedding_val [TopologicalSpace α] {s : Set α} (hs : Dense s) :
    DenseEmbedding ((↑) : s → α) :=
  { embedding_subtype_val with dense := hs.denseRange_val }
#align dense.dense_embedding_coe Dense.denseEmbedding_val

theorem isClosed_property [TopologicalSpace β] {e : α → β} {p : β → Prop} (he : DenseRange e)
    (hp : IsClosed { x | p x }) (h : ∀ a, p (e a)) : ∀ b, p b :=
  have : univ ⊆ { b | p b } :=
    calc
      univ = closure (range e) := he.closure_range.symm
      _ ⊆ closure { b | p b } := closure_mono <| range_subset_iff.mpr h
      _ = _ := hp.closure_eq

  fun _ => this trivial
#align is_closed_property isClosed_property

theorem isClosed_property2 [TopologicalSpace β] {e : α → β} {p : β → β → Prop} (he : DenseRange e)
    (hp : IsClosed { q : β × β | p q.1 q.2 }) (h : ∀ a₁ a₂, p (e a₁) (e a₂)) : ∀ b₁ b₂, p b₁ b₂ :=
  have : ∀ q : β × β, p q.1 q.2 := isClosed_property (he.prod_map he) hp fun _ => h _ _
  fun b₁ b₂ => this ⟨b₁, b₂⟩
#align is_closed_property2 isClosed_property2

theorem isClosed_property3 [TopologicalSpace β] {e : α → β} {p : β → β → β → Prop}
    (he : DenseRange e) (hp : IsClosed { q : β × β × β | p q.1 q.2.1 q.2.2 })
    (h : ∀ a₁ a₂ a₃, p (e a₁) (e a₂) (e a₃)) : ∀ b₁ b₂ b₃, p b₁ b₂ b₃ :=
  have : ∀ q : β × β × β, p q.1 q.2.1 q.2.2 :=
    isClosed_property (he.prod_map <| he.prod_map he) hp fun _ => h _ _ _
  fun b₁ b₂ b₃ => this ⟨b₁, b₂, b₃⟩
#align is_closed_property3 isClosed_property3

@[elab_as_elim]
theorem DenseRange.induction_on [TopologicalSpace β] {e : α → β} (he : DenseRange e) {p : β → Prop}
    (b₀ : β) (hp : IsClosed { b | p b }) (ih : ∀ a : α, p <| e a) : p b₀ :=
  isClosed_property he hp ih b₀
#align dense_range.induction_on DenseRange.induction_on

@[elab_as_elim]
theorem DenseRange.induction_on₂ [TopologicalSpace β] {e : α → β} {p : β → β → Prop}
    (he : DenseRange e) (hp : IsClosed { q : β × β | p q.1 q.2 }) (h : ∀ a₁ a₂, p (e a₁) (e a₂))
    (b₁ b₂ : β) : p b₁ b₂ :=
  isClosed_property2 he hp h _ _
#align dense_range.induction_on₂ DenseRange.induction_on₂

@[elab_as_elim]
theorem DenseRange.induction_on₃ [TopologicalSpace β] {e : α → β} {p : β → β → β → Prop}
    (he : DenseRange e) (hp : IsClosed { q : β × β × β | p q.1 q.2.1 q.2.2 })
    (h : ∀ a₁ a₂ a₃, p (e a₁) (e a₂) (e a₃)) (b₁ b₂ b₃ : β) : p b₁ b₂ b₃ :=
  isClosed_property3 he hp h _ _ _
#align dense_range.induction_on₃ DenseRange.induction_on₃

section

variable [TopologicalSpace β] [TopologicalSpace γ] [T2Space γ]

variable {f : α → β}

/-- Two continuous functions to a t2-space that agree on the dense range of a function are equal. -/
theorem DenseRange.equalizer (hfd : DenseRange f) {g h : β → γ} (hg : Continuous g)
    (hh : Continuous h) (H : g ∘ f = h ∘ f) : g = h :=
  funext fun y => hfd.induction_on y (isClosed_eq hg hh) <| congr_fun H
#align dense_range.equalizer DenseRange.equalizer

end

-- Bourbaki GT III §3 no.4 Proposition 7 (generalised to any dense-inducing map to a T₃ space)
theorem Filter.HasBasis.hasBasis_of_denseInducing [TopologicalSpace α] [TopologicalSpace β]
    [T3Space β] {ι : Type _} {s : ι → Set α} {p : ι → Prop} {x : α} (h : (𝓝 x).HasBasis p s)
    {f : α → β} (hf : DenseInducing f) : (𝓝 (f x)).HasBasis p fun i => closure <| f '' s i := by
  rw [Filter.hasBasis_iff] at h⊢
  intro T
  refine' ⟨fun hT => _, fun hT => _⟩
  · obtain ⟨T', hT₁, hT₂, hT₃⟩ := exists_mem_nhds_isClosed_subset hT
    have hT₄ : f ⁻¹' T' ∈ 𝓝 x := by
      rw [hf.toInducing.nhds_eq_comap x]
      exact ⟨T', hT₁, Subset.rfl⟩
    obtain ⟨i, hi, hi'⟩ := (h _).mp hT₄
    exact
      ⟨i, hi,
        (closure_mono (image_subset f hi')).trans
          (Subset.trans (closure_minimal (image_preimage_subset _ _) hT₂) hT₃)⟩
  · obtain ⟨i, hi, hi'⟩ := hT
    suffices closure (f '' s i) ∈ 𝓝 (f x) by filter_upwards [this]using hi'
    replace h := (h (s i)).mpr ⟨i, hi, Subset.rfl⟩
    exact hf.closure_image_mem_nhds h
#align filter.has_basis.has_basis_of_dense_inducing Filter.HasBasis.hasBasis_of_denseInducing


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.group_power.lemmas

/-!
# Powers of elements of groups with an adjoined zero element

In this file we define integer power functions for groups with an adjoined zero element.
This generalises the integer power function on a division ring.
-/

section group_with_zero
variables {G₀ : Type*} [group_with_zero G₀] {a : G₀} {m n : ℕ}

section nat_pow

theorem pow_sub₀ (a : G₀) {m n : ℕ} (ha : a ≠ 0) (h : n ≤ m) : a ^ (m - n) = a ^ m * (a ^ n)⁻¹ :=
have h1 : m - n + n = m, from tsub_add_cancel_of_le h,
have h2 : a ^ (m - n) * a ^ n = a ^ m, by rw [←pow_add, h1],
by simpa only [div_eq_mul_inv] using eq_div_of_mul_eq (pow_ne_zero _ ha) h2

lemma pow_sub_of_lt (a : G₀) {m n : ℕ} (h : n < m) : a ^ (m - n) = a ^ m * (a ^ n)⁻¹ :=
begin
  obtain rfl | ha := eq_or_ne a 0,
  { rw [zero_pow (tsub_pos_of_lt h), zero_pow (n.zero_le.trans_lt h), zero_mul] },
  { exact pow_sub₀ _ ha h.le }
end

theorem pow_inv_comm₀ (a : G₀) (m n : ℕ) : (a⁻¹) ^ m * a ^ n = a ^ n * (a⁻¹) ^ m :=
(commute.refl a).inv_left₀.pow_pow m n

lemma inv_pow_sub₀ (ha : a ≠ 0) (h : n ≤ m) : a⁻¹ ^ (m - n) = (a ^ m)⁻¹ * a ^ n :=
by rw [pow_sub₀ _ (inv_ne_zero ha) h, inv_pow, inv_pow, inv_inv]

lemma inv_pow_sub_of_lt (a : G₀) (h : n < m) : a⁻¹ ^ (m - n) = (a ^ m)⁻¹ * a ^ n :=
by rw [pow_sub_of_lt a⁻¹ h, inv_pow, inv_pow, inv_inv]

end nat_pow

end group_with_zero

section zpow
open int
variables {G₀ : Type*} [group_with_zero G₀]

local attribute [ematch] le_of_lt

lemma zero_zpow : ∀ z : ℤ, z ≠ 0 → (0 : G₀) ^ z = 0
| (n : ℕ) h := by { rw [zpow_coe_nat, zero_pow'], simpa using h }
| -[1+n]  h := by simp

lemma zero_zpow_eq (n : ℤ) : (0 : G₀) ^ n = if n = 0 then 1 else 0 :=
begin
  split_ifs with h,
  { rw [h, zpow_zero] },
  { rw [zero_zpow _ h] }
end

lemma zpow_add_one₀ {a : G₀} (ha : a ≠ 0) : ∀ n : ℤ, a ^ (n + 1) = a ^ n * a
| (n : ℕ)    := by simp only [← int.coe_nat_succ, zpow_coe_nat, pow_succ']
| -[1+0]     := by erw [zpow_zero, zpow_neg_succ_of_nat, pow_one, inv_mul_cancel ha]
| -[1+(n+1)] := by rw [int.neg_succ_of_nat_eq, zpow_neg, neg_add, neg_add_cancel_right, zpow_neg,
  ← int.coe_nat_succ, zpow_coe_nat, zpow_coe_nat, pow_succ _ (n + 1), mul_inv_rev, mul_assoc,
  inv_mul_cancel ha, mul_one]

lemma zpow_sub_one₀ {a : G₀} (ha : a ≠ 0) (n : ℤ) : a ^ (n - 1) = a ^ n * a⁻¹ :=
calc a ^ (n - 1) = a ^ (n - 1) * a * a⁻¹ : by rw [mul_assoc, mul_inv_cancel ha, mul_one]
             ... = a^n * a⁻¹             : by rw [← zpow_add_one₀ ha, sub_add_cancel]

lemma zpow_add₀ {a : G₀} (ha : a ≠ 0) (m n : ℤ) : a ^ (m + n) = a ^ m * a ^ n :=
begin
  induction n using int.induction_on with n ihn n ihn,
  case hz : { simp },
  { simp only [← add_assoc, zpow_add_one₀ ha, ihn, mul_assoc] },
  { rw [zpow_sub_one₀ ha, ← mul_assoc, ← ihn, ← zpow_sub_one₀ ha, add_sub_assoc] }
end

lemma zpow_add' {a : G₀} {m n : ℤ} (h : a ≠ 0 ∨ m + n ≠ 0 ∨ m = 0 ∧ n = 0) :
  a ^ (m + n) = a ^ m * a ^ n :=
begin
  by_cases hm : m = 0, { simp [hm] },
  by_cases hn : n = 0, { simp [hn] },
  by_cases ha : a = 0,
  { subst a,
    simp only [false_or, eq_self_iff_true, not_true, ne.def, hm, hn, false_and, or_false] at h,
    rw [zero_zpow _ h, zero_zpow _ hm, zero_mul] },
  { exact zpow_add₀ ha m n }
end

theorem zpow_one_add₀ {a : G₀} (h : a ≠ 0) (i : ℤ) : a ^ (1 + i) = a * a ^ i :=
by rw [zpow_add₀ h, zpow_one]

theorem semiconj_by.zpow_right₀ {a x y : G₀} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (x^m) (y^m)
| (n : ℕ) := by simp [h.pow_right n]
| -[1+n]  := by simp [(h.pow_right (n + 1)).inv_right₀]

theorem commute.zpow_right₀ {a b : G₀} (h : commute a b) : ∀ m : ℤ, commute a (b^m) :=
h.zpow_right₀

theorem commute.zpow_left₀ {a b : G₀} (h : commute a b) (m : ℤ) : commute (a^m) b :=
(h.symm.zpow_right₀ m).symm

theorem commute.zpow_zpow₀ {a b : G₀} (h : commute a b) (m n : ℤ) : commute (a^m) (b^n) :=
(h.zpow_left₀ m).zpow_right₀ n

theorem commute.zpow_self₀ (a : G₀) (n : ℤ) : commute (a^n) a := (commute.refl a).zpow_left₀ n

theorem commute.self_zpow₀ (a : G₀) (n : ℤ) : commute a (a^n) := (commute.refl a).zpow_right₀ n

theorem commute.zpow_zpow_self₀ (a : G₀) (m n : ℤ) : commute (a^m) (a^n) :=
(commute.refl a).zpow_zpow₀ m n

theorem zpow_bit1₀ (a : G₀) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a :=
begin
  rw [← zpow_bit0, bit1, zpow_add', zpow_one],
  right, left,
  apply bit1_ne_zero
end

lemma zpow_ne_zero_of_ne_zero {a : G₀} (ha : a ≠ 0) : ∀ (z : ℤ), a ^ z ≠ 0
| (n : ℕ) := by { rw zpow_coe_nat, exact pow_ne_zero _ ha }
| -[1+n]  := by { rw zpow_neg_succ_of_nat, exact inv_ne_zero (pow_ne_zero _ ha) }

lemma zpow_sub₀ {a : G₀} (ha : a ≠ 0) (z1 z2 : ℤ) : a ^ (z1 - z2) = a ^ z1 / a ^ z2 :=
by rw [sub_eq_add_neg, zpow_add₀ ha, zpow_neg, div_eq_mul_inv]

theorem zpow_bit1' (a : G₀) (n : ℤ) : a ^ bit1 n = (a * a) ^ n * a :=
by rw [zpow_bit1₀, (commute.refl a).mul_zpow]

lemma zpow_eq_zero {x : G₀} {n : ℤ} (h : x ^ n = 0) : x = 0 :=
classical.by_contradiction $ λ hx, zpow_ne_zero_of_ne_zero hx n h

lemma zpow_eq_zero_iff {a : G₀} {n : ℤ} (hn : 0 < n) :
  a ^ n = 0 ↔ a = 0 :=
begin
  refine ⟨zpow_eq_zero, _⟩,
  rintros rfl,
  exact zero_zpow _ hn.ne'
end

lemma zpow_ne_zero {x : G₀} (n : ℤ) : x ≠ 0 → x ^ n ≠ 0 :=
mt zpow_eq_zero

theorem zpow_neg_mul_zpow_self (n : ℤ) {x : G₀} (h : x ≠ 0) :
  x ^ (-n) * x ^ n = 1 :=
begin
  rw [zpow_neg],
  exact inv_mul_cancel (zpow_ne_zero n h)
end

end zpow

section
variables {G₀ : Type*} [comm_group_with_zero G₀]

lemma div_sq_cancel (a b : G₀) : a ^ 2 * b / a = a * b :=
begin
  by_cases ha : a = 0,
  { simp [ha] },
  rw [sq, mul_assoc, mul_div_cancel_left _ ha]
end

end

/-- If a monoid homomorphism `f` between two `group_with_zero`s maps `0` to `0`, then it maps `x^n`,
`n : ℤ`, to `(f x)^n`. -/
lemma monoid_with_zero_hom.map_zpow {G₀ G₀' : Type*} [group_with_zero G₀] [group_with_zero G₀']
  (f : G₀ →*₀ G₀') (x : G₀) :
  ∀ n : ℤ, f (x ^ n) = f x ^ n
| (n : ℕ) := by { rw [zpow_coe_nat, zpow_coe_nat], exact f.to_monoid_hom.map_pow x n }
| -[1+n] := begin
    rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat],
    exact ((f.map_inv _).trans $ congr_arg _ $ f.to_monoid_hom.map_pow x _)
  end


import geometry.manifold.smooth_manifold_with_corners

/-!
This PR implements the product of smooth manifolds with corners. We define the natural instance of
the product of charted space and of the product of smooth manifolds with corners. To this goal, we
also prove that the product map of two smooth maps (times_cont_diff \top) is smooth and we prove
some technical lemmas necessary to do simplifications.
-/

namespace CMP_2020

section analysis__calculus__times_cont_diff

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{G : Type*} [normed_group G] [normed_space 𝕜 G]
{s s₁ t u : set E} {f f₁ : E → F} {g : F → G} {x : E} {c : F}
{b : E × F → G}

/--
The first projection on a domain in a product is `C^∞`.
-/
lemma times_cont_diff_on_fst {s : set (E×F)} {n : with_top ℕ} :
  times_cont_diff_on 𝕜 n (prod.fst : E × F → E) s :=
times_cont_diff.times_cont_diff_on times_cont_diff_fst

/--
The second projection on a domain in a product is `C^∞`.
-/
lemma times_cont_diff_on_snd {s : set (E×F)} {n : with_top ℕ} :
  times_cont_diff_on 𝕜 n (prod.snd : E × F → F) s :=
times_cont_diff.times_cont_diff_on times_cont_diff_snd

/-- The product map of two `C^n` functions is `C^n`. -/
lemma times_cont_diff_on.map_prod {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
  {F' : Type*} [normed_group F'] [normed_space 𝕜 F']
  {s : set E} {t : set E'} {n : with_top ℕ} {f : E → F} {g : E' → F'}
  (hf : times_cont_diff_on 𝕜 n f s) (hg : times_cont_diff_on 𝕜 n g t) :
  times_cont_diff_on 𝕜 n (prod.map f g) (set.prod s t) :=
begin
  have hs : s.prod t ⊆ (prod.fst) ⁻¹' s := by { rintros x ⟨h_x_1, h_x_2⟩, exact h_x_1, },
  have ht : s.prod t ⊆ (prod.snd) ⁻¹' t := by { rintros x ⟨h_x_1, h_x_2⟩, exact h_x_2, },
  exact (hf.comp (times_cont_diff_on_fst) hs).prod (hg.comp (times_cont_diff_on_snd) ht),
end

end analysis__calculus__times_cont_diff

section data__prod

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

@[simp] lemma prod_map (f : α → γ) (g : β → δ) (p : α × β) : prod.map f g p = (f p.1, g p.2) := rfl

end data__prod

section geometry__manifold__charted_space

variables {H : Type*} {H' : Type*} {M : Type*} {M' : Type*} {M'' : Type*}
[topological_space H] [topological_space M] [charted_space H M]
[topological_space H'] [topological_space M'] [charted_space H' M'] {x : M×M'}

open set

/-- Same thing as `H × H'`. We introduce it for technical reasons: a charted space `M` with model `H`
is a set of local charts from `M` to `H` covering the space. Every space is registered as a charted
space over itself, using the only chart `id`, in `manifold_model_space`. You can also define a product
of charted space `M` and `M'` (with model space `H × H'`) by taking the products of the charts. Now,
on `H × H'`, there are two charted space structures with model space `H × H'` itself, the one coming
from `manifold_model_space`, and the one coming from the product of the two `manifold_model_space` on
each component. They are equal, but not defeq (because the product of `id` and `id` is not defeq to
`id`), which is bad as we know. This expedient of renaming `H × H'` solves this problem. -/
def model_prod (H : Type*) (H' : Type*) := H × H'

section

local attribute [reducible] model_prod

instance model_prod_inhabited {α β : Type*} [inhabited α] [inhabited β] :
  inhabited (model_prod α β) :=
⟨(default α, default β)⟩

instance (H : Type*) [topological_space H] (H' : Type*) [topological_space H'] :
  topological_space (model_prod H H') :=
by apply_instance

/- Next lemma shows up often when dealing with derivatives, register it as simp. -/
@[simp, mfld_simps] lemma model_prod_range_prod_id
  {H : Type*} {H' : Type*} {α : Type*} (f : H → α) :
  range (λ (p : model_prod H H'), (f p.1, p.2)) = set.prod (range f) univ :=
by rw prod_range_univ_eq

end

/-- The product of two charted spaces is naturally a charted space, with the canonical
construction of the atlas of product maps. -/
instance prod_charted_space (H : Type*) [topological_space H]
  (M : Type*) [topological_space M] [charted_space H M]
  (H' : Type*) [topological_space H']
  (M' : Type*) [topological_space M'] [charted_space H' M'] :
  charted_space (model_prod H H') (M × M') :=
{ atlas            :=
    {f : (local_homeomorph (M×M') (model_prod H H')) |
      ∃ g ∈ charted_space.atlas H M, ∃ h ∈ (charted_space.atlas H' M'),
        f = local_homeomorph.prod g h},
  chart_at         := λ x: (M × M'),
    (charted_space.chart_at H x.1).prod (charted_space.chart_at H' x.2),
  mem_chart_source :=
  begin
    intro x,
    simp only with mfld_simps,
  end,
  chart_mem_atlas  :=
  begin
    intro x,
    use (charted_space.chart_at H x.1),
    split,
    { apply chart_mem_atlas _, },
    { use (charted_space.chart_at H' x.2), simp only [chart_mem_atlas, eq_self_iff_true, and_self], }
  end }

section prod_charted_space

variables [topological_space H] [topological_space M] [charted_space H M]
[topological_space H'] [topological_space M'] [charted_space H' M']

@[simp, mfld_simps] lemma prod_charted_space_chart_at :
  (chart_at (model_prod H H') x) = (chart_at H x.fst).prod (chart_at H' x.snd) := rfl

end prod_charted_space

end geometry__manifold__charted_space

section geometry__manifold__smooth_manifold_with_corners

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{F : Type*} [normed_group F] [normed_space 𝕜 F] {F' : Type*} [normed_group F'] [normed_space 𝕜 F']
{H : Type*} [topological_space H] {H' : Type*} [topological_space H']
{G : Type*} [topological_space G] {G' : Type*} [topological_space G']
{I : model_with_corners 𝕜 E H} {J : model_with_corners 𝕜 F G}

@[simp, mfld_simps] lemma model_with_corners_prod_to_local_equiv :
  (I.prod J).to_local_equiv = (I.to_local_equiv).prod (J.to_local_equiv) :=
begin
  ext1 x,
  { refl, },
  { intro x, refl, },
  { simp only [set.univ_prod_univ, model_with_corners.source_eq, local_equiv.prod_source], }
end

@[simp, mfld_simps] lemma model_with_corners_prod_coe
  (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') :
  (I.prod I' : _ × _ → _ × _) = prod.map I I' := rfl

@[simp, mfld_simps] lemma model_with_corners_prod_coe_symm
  (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') :
  ((I.prod I').symm : _ × _ → _ × _) = prod.map I.symm I'.symm := rfl

/-- The product of two smooth local homeomorphisms is smooth. -/
lemma times_cont_diff_groupoid_prod
  {I : model_with_corners 𝕜 E H} {I' : model_with_corners 𝕜 E' H'}
  {e : local_homeomorph H H} {e' : local_homeomorph H' H'}
  (he : e ∈ times_cont_diff_groupoid ⊤ I) (he' : e' ∈ times_cont_diff_groupoid ⊤ I') :
  e.prod e' ∈ times_cont_diff_groupoid ⊤ (I.prod I') :=
begin
  cases he with he he_symm,
  cases he' with he' he'_symm,
  simp only at he he_symm he' he'_symm,
  split;
  simp only [local_equiv.prod_source, local_homeomorph.prod_to_local_equiv],
  { have h3 := times_cont_diff_on.map_prod he he',
    rw [← model_with_corners.image I _, ← model_with_corners.image I' _,
    set.prod_image_image_eq] at h3,
    rw ← model_with_corners.image (I.prod I') _,
    exact h3, },
  { have h3 := times_cont_diff_on.map_prod he_symm he'_symm,
    rw [← model_with_corners.image I _, ← model_with_corners.image I' _,
    set.prod_image_image_eq] at h3,
    rw ← model_with_corners.image (I.prod I') _,
    exact h3, }
end

/-- The product of two smooth manifolds with corners is naturally a smooth manifold with corners. -/
instance prod_smooth_manifold_with_corners {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
  {H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
  {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
  (M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
  (M' : Type*) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] :
  smooth_manifold_with_corners (I.prod I') (M×M') :=
{ compatible :=
  begin
    rintros f g ⟨f1, hf1, f2, hf2, hf⟩ ⟨g1, hg1, g2, hg2, hg⟩,
    rw [hf, hg, local_homeomorph.prod_symm, local_homeomorph.prod_trans],
    have h1 := has_groupoid.compatible (times_cont_diff_groupoid ⊤ I) hf1 hg1,
    have h2 := has_groupoid.compatible (times_cont_diff_groupoid ⊤ I') hf2 hg2,
    exact times_cont_diff_groupoid_prod h1 h2,
  end }

end geometry__manifold__smooth_manifold_with_corners

section

end

end CMP_2020


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import data.fin.tuple.basic
import data.list.range
import group_theory.group_action.pi
import meta.univs

/-!
# Matrix and vector notation

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

This file defines notation for vectors and matrices. Given `a b c d : α`,
the notation allows us to write `![a, b, c, d] : fin 4 → α`.
Nesting vectors gives coefficients of a matrix, so `![![a, b], ![c, d]] : fin 2 → fin 2 → α`.
In later files we introduce `!![a, b; c, d]` as notation for `matrix.of ![![a, b], ![c, d]]`.

## Main definitions

* `vec_empty` is the empty vector (or `0` by `n` matrix) `![]`
* `vec_cons` prepends an entry to a vector, so `![a, b]` is `vec_cons a (vec_cons b vec_empty)`

## Implementation notes

The `simp` lemmas require that one of the arguments is of the form `vec_cons _ _`.
This ensures `simp` works with entries only when (some) entries are already given.
In other words, this notation will only appear in the output of `simp` if it
already appears in the input.

## Notations

The main new notation is `![a, b]`, which gets expanded to `vec_cons a (vec_cons b vec_empty)`.

## Examples

Examples of usage can be found in the `test/matrix.lean` file.
-/

namespace matrix

universe u
variables {α : Type u}

section matrix_notation

/-- `![]` is the vector with no entries. -/
def vec_empty : fin 0 → α := fin.elim0'

/-- `vec_cons h t` prepends an entry `h` to a vector `t`.

The inverse functions are `vec_head` and `vec_tail`.
The notation `![a, b, ...]` expands to `vec_cons a (vec_cons b ...)`.
-/
def vec_cons {n : ℕ} (h : α) (t : fin n → α) : fin n.succ → α :=
fin.cons h t

notation `![` l:(foldr `, ` (h t, vec_cons h t) vec_empty `]`) := l

/-- `vec_head v` gives the first entry of the vector `v` -/
def vec_head {n : ℕ} (v : fin n.succ → α) : α :=
v 0

/-- `vec_tail v` gives a vector consisting of all entries of `v` except the first -/
def vec_tail {n : ℕ} (v : fin n.succ → α) : fin n → α :=
v ∘ fin.succ

variables {m n : ℕ}

/-- Use `![...]` notation for displaying a vector `fin n → α`, for example:

```
#eval ![1, 2] + ![3, 4] -- ![4, 6]
```
-/
instance _root_.pi_fin.has_repr [has_repr α] : has_repr (fin n → α) :=
{ repr := λ f, "![" ++ (string.intercalate ", " ((list.fin_range n).map (λ n, repr (f n)))) ++ "]" }

end matrix_notation

variables {m n o : ℕ} {m' n' o' : Type*}

lemma empty_eq (v : fin 0 → α) : v = ![] := subsingleton.elim _ _

section val

@[simp] lemma head_fin_const (a : α) : vec_head (λ (i : fin (n + 1)), a) = a := rfl

@[simp] lemma cons_val_zero (x : α) (u : fin m → α) : vec_cons x u 0 = x := rfl

lemma cons_val_zero' (h : 0 < m.succ) (x : α) (u : fin m → α) :
  vec_cons x u ⟨0, h⟩ = x :=
rfl

@[simp] lemma cons_val_succ (x : α) (u : fin m → α) (i : fin m) :
  vec_cons x u i.succ = u i :=
by simp [vec_cons]

@[simp] lemma cons_val_succ' {i : ℕ} (h : i.succ < m.succ) (x : α) (u : fin m → α) :
  vec_cons x u ⟨i.succ, h⟩ = u ⟨i, nat.lt_of_succ_lt_succ h⟩ :=
by simp only [vec_cons, fin.cons, fin.cases_succ']

@[simp] lemma head_cons (x : α) (u : fin m → α) :
  vec_head (vec_cons x u) = x :=
rfl

@[simp] lemma tail_cons (x : α) (u : fin m → α) :
  vec_tail (vec_cons x u) = u :=
by { ext, simp [vec_tail] }

@[simp] lemma empty_val' {n' : Type*} (j : n') :
  (λ i, (![] : fin 0 → n' → α) i j) = ![] :=
empty_eq _

@[simp] lemma cons_head_tail (u : fin m.succ → α) :
 vec_cons (vec_head u) (vec_tail u) = u :=
fin.cons_self_tail _

@[simp] lemma range_cons (x : α) (u : fin n → α) :
  set.range (vec_cons x u) = {x} ∪ set.range u :=
set.ext $ λ y, by simp [fin.exists_fin_succ, eq_comm]

@[simp]

@[simp] lemma range_cons_empty (x : α) (u : fin 0 → α) : set.range (matrix.vec_cons x u) = {x} :=
by rw [range_cons, range_empty, set.union_empty]

@[simp] lemma range_cons_cons_empty (x y : α) (u : fin 0 → α) :
  set.range (vec_cons x $ vec_cons y u) = {x, y} :=
by rw [range_cons, range_cons_empty, set.singleton_union]

@[simp] lemma vec_cons_const (a : α) : vec_cons a (λ k : fin n, a) = λ _, a :=
funext $ fin.forall_fin_succ.2 ⟨rfl, cons_val_succ _ _⟩

lemma vec_single_eq_const (a : α) : ![a] = λ _, a :=
funext $ unique.forall_iff.2 rfl

/-- `![a, b, ...] 1` is equal to `b`.

  The simplifier needs a special lemma for length `≥ 2`, in addition to
  `cons_val_succ`, because `1 : fin 1 = 0 : fin 1`.
-/
@[simp] lemma cons_val_one (x : α) (u : fin m.succ → α) :
  vec_cons x u 1 = vec_head u :=
by { rw [← fin.succ_zero_eq_one, cons_val_succ], refl }

@[simp] lemma cons_val_fin_one (x : α) (u : fin 0 → α) (i : fin 1) :
  vec_cons x u i = x :=
by { refine fin.forall_fin_one.2 _ i, refl }

lemma cons_fin_one (x : α) (u : fin 0 → α) : vec_cons x u = (λ _, x) :=
funext (cons_val_fin_one x u)

meta instance _root_.pi_fin.reflect [reflected_univ.{u}] [reflected _ α] [has_reflect α] :
  Π {n}, has_reflect (fin n → α)
| 0 v := (subsingleton.elim vec_empty v).rec
    ((by reflect_name : reflected _ (@vec_empty.{u})).subst `(α))
| (n + 1) v := (cons_head_tail v).rec $
    (by reflect_name : reflected _ @vec_cons.{u}).subst₄ `(α) `(n) `(_) (_root_.pi_fin.reflect _)

/-- Convert a vector of pexprs to the pexpr constructing that vector.-/
meta def _root_.pi_fin.to_pexpr : Π {n}, (fin n → pexpr) → pexpr
| 0 v := ``(![])
| (n + 1) v := ``(vec_cons %%(v 0) %%(_root_.pi_fin.to_pexpr $ vec_tail v))

/-! ### Numeral (`bit0` and `bit1`) indices
The following definitions and `simp` lemmas are to allow any
numeral-indexed element of a vector given with matrix notation to
be extracted by `simp` (even when the numeral is larger than the
number of elements in the vector, which is taken modulo that number
of elements by virtue of the semantics of `bit0` and `bit1` and of
addition on `fin n`).
-/

/-- `vec_append ho u v` appends two vectors of lengths `m` and `n` to produce
one of length `o = m + n`. This is a variant of `fin.append` with an additional `ho` argument,
which provides control of definitional equality for the vector length.

This turns out to be helpful when providing simp lemmas to reduce `![a, b, c] n`, and also means
that `vec_append ho u v 0` is valid. `fin.append u v 0` is not valid in this case because there is
no `has_zero (fin (m + n))` instance. -/
def vec_append {α : Type*} {o : ℕ} (ho : o = m + n) (u : fin m → α) (v : fin n → α) : fin o → α :=
fin.append u v ∘ fin.cast ho

lemma vec_append_eq_ite {α : Type*} {o : ℕ} (ho : o = m + n) (u : fin m → α) (v : fin n → α) :
  vec_append ho u v = λ i,
    if h : (i : ℕ) < m
      then u ⟨i, h⟩
      else v ⟨(i : ℕ) - m, (tsub_lt_iff_left (le_of_not_lt h)).2 (ho ▸ i.property)⟩ :=
begin
  ext i,
  rw [vec_append, fin.append, function.comp_apply, fin.add_cases],
  congr' with hi,
  simp only [eq_rec_constant],
  refl,
end

@[simp] lemma vec_append_apply_zero {α : Type*} {o : ℕ} (ho : (o + 1) = (m + 1) + n)
  (u : fin (m + 1) → α) (v : fin n → α) :
  vec_append ho u v 0 = u 0 := rfl

@[simp] lemma empty_vec_append (v : fin n → α) : vec_append (zero_add _).symm ![] v = v :=
by { ext, simp [vec_append_eq_ite] }

@[simp] lemma cons_vec_append (ho : o + 1 = m + 1 + n) (x : α) (u : fin m → α) (v : fin n → α) :
  vec_append ho (vec_cons x u) v =
    vec_cons x (vec_append (by rwa [add_assoc, add_comm 1, ←add_assoc,
                                  add_right_cancel_iff] at ho) u v) :=
begin
  ext i,
  simp_rw [vec_append_eq_ite],
  split_ifs with h,
  { rcases i with ⟨⟨⟩ | i, hi⟩,
    { simp },
    { simp only [nat.succ_eq_add_one, add_lt_add_iff_right, fin.coe_mk] at h,
      simp [h] } },
  { rcases i with ⟨⟨⟩ | i, hi⟩,
    { simpa using h },
    { rw [not_lt, fin.coe_mk, nat.succ_eq_add_one, add_le_add_iff_right] at h,
      simp [h] } }
end

/-- `vec_alt0 v` gives a vector with half the length of `v`, with
only alternate elements (even-numbered). -/
def vec_alt0 (hm : m = n + n) (v : fin m → α) (k : fin n) : α :=
v ⟨(k : ℕ) + k, hm.symm ▸ add_lt_add k.property k.property⟩

/-- `vec_alt1 v` gives a vector with half the length of `v`, with
only alternate elements (odd-numbered). -/
def vec_alt1 (hm : m = n + n) (v : fin m → α) (k : fin n) : α :=
v ⟨(k : ℕ) + k + 1, hm.symm ▸ nat.add_succ_lt_add k.property k.property⟩

lemma vec_alt0_vec_append (v : fin n → α) : vec_alt0 rfl (vec_append rfl v v) = v ∘ bit0 :=
begin
  ext i,
  simp_rw [function.comp, bit0, vec_alt0, vec_append_eq_ite],
  split_ifs with h; congr,
  { rw fin.coe_mk at h,
    simp only [fin.ext_iff, fin.coe_add, fin.coe_mk],
    exact (nat.mod_eq_of_lt h).symm },
  { rw [fin.coe_mk, not_lt] at h,
    simp only [fin.ext_iff, fin.coe_add, fin.coe_mk, nat.mod_eq_sub_mod h],
    refine (nat.mod_eq_of_lt _).symm,
    rw tsub_lt_iff_left h,
    exact add_lt_add i.property i.property }
end

lemma vec_alt1_vec_append (v : fin (n + 1) → α) : vec_alt1 rfl (vec_append rfl v v) = v ∘ bit1 :=
begin
  ext i,
  simp_rw [function.comp, vec_alt1, vec_append_eq_ite],
  cases n,
  { simp, congr },
  { split_ifs with h; simp_rw [bit1, bit0]; congr,
    { simp only [fin.ext_iff, fin.coe_add, fin.coe_mk],
      rw fin.coe_mk at h,
      rw fin.coe_one,
      rw nat.mod_eq_of_lt (nat.lt_of_succ_lt h),
      rw nat.mod_eq_of_lt h },
    { rw [fin.coe_mk, not_lt] at h,
      simp only [fin.ext_iff, fin.coe_add, fin.coe_mk, nat.mod_add_mod, fin.coe_one,
                 nat.mod_eq_sub_mod h],
      refine (nat.mod_eq_of_lt _).symm,
      rw tsub_lt_iff_left h,
      exact nat.add_succ_lt_add i.property i.property } }
end

@[simp] lemma vec_head_vec_alt0 (hm : (m + 2) = (n + 1) + (n + 1)) (v : fin (m + 2) → α) :
  vec_head (vec_alt0 hm v) = v 0 := rfl

@[simp] lemma vec_head_vec_alt1 (hm : (m + 2) = (n + 1) + (n + 1)) (v : fin (m + 2) → α) :
  vec_head (vec_alt1 hm v) = v 1 :=
by simp [vec_head, vec_alt1]

@[simp] lemma cons_vec_bit0_eq_alt0 (x : α) (u : fin n → α) (i : fin (n + 1)) :
  vec_cons x u (bit0 i) = vec_alt0 rfl (vec_append rfl (vec_cons x u) (vec_cons x u)) i :=
by rw vec_alt0_vec_append

@[simp] lemma cons_vec_bit1_eq_alt1 (x : α) (u : fin n → α) (i : fin (n + 1)) :
  vec_cons x u (bit1 i) = vec_alt1 rfl (vec_append rfl (vec_cons x u) (vec_cons x u)) i :=
by rw vec_alt1_vec_append

@[simp] lemma cons_vec_alt0 (h : m + 1 + 1 = (n + 1) + (n + 1)) (x y : α) (u : fin m → α) :
  vec_alt0 h (vec_cons x (vec_cons y u)) = vec_cons x (vec_alt0
    (by rwa [add_assoc n, add_comm 1, ←add_assoc, ←add_assoc, add_right_cancel_iff,
             add_right_cancel_iff] at h) u) :=
begin
  ext i,
  simp_rw [vec_alt0],
  rcases i with ⟨⟨⟩ | i, hi⟩,
  { refl },
  { simp [vec_alt0, nat.add_succ, nat.succ_add] }
end

-- Although proved by simp, extracting element 8 of a five-element
-- vector does not work by simp unless this lemma is present.
@[simp] lemma empty_vec_alt0 (α) {h} : vec_alt0 h (![] : fin 0 → α) = ![] :=
by simp

@[simp] lemma cons_vec_alt1 (h : m + 1 + 1 = (n + 1) + (n + 1)) (x y : α) (u : fin m → α) :
  vec_alt1 h (vec_cons x (vec_cons y u)) = vec_cons y (vec_alt1
    (by rwa [add_assoc n, add_comm 1, ←add_assoc, ←add_assoc, add_right_cancel_iff,
             add_right_cancel_iff] at h) u) :=
begin
  ext i,
  simp_rw [vec_alt1],
  rcases i with ⟨⟨⟩ | i, hi⟩,
  { refl },
  { simp [vec_alt1, nat.add_succ, nat.succ_add] }
end

-- Although proved by simp, extracting element 9 of a five-element
-- vector does not work by simp unless this lemma is present.
@[simp] lemma empty_vec_alt1 (α) {h} : vec_alt1 h (![] : fin 0 → α) = ![] :=
by simp

end val

section smul

variables {M : Type*} [has_smul M α]

@[simp] lemma smul_empty (x : M) (v : fin 0 → α) : x • v = ![] := empty_eq _

@[simp] lemma smul_cons (x : M) (y : α) (v : fin n → α) :
  x • vec_cons y v = vec_cons (x • y) (x • v) :=
by { ext i, refine fin.cases _ _ i; simp }

end smul

section add

variables [has_add α]

@[simp] lemma empty_add_empty (v w : fin 0 → α) : v + w = ![] := empty_eq _

@[simp] lemma cons_add (x : α) (v : fin n → α) (w : fin n.succ → α) :
  vec_cons x v + w = vec_cons (x + vec_head w) (v + vec_tail w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma add_cons (v : fin n.succ → α) (y : α) (w : fin n → α) :
  v + vec_cons y w = vec_cons (vec_head v + y) (vec_tail v + w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma cons_add_cons (x : α) (v : fin n → α) (y : α) (w : fin n → α) :
  vec_cons x v + vec_cons y w = vec_cons (x + y) (v + w) :=
by simp

@[simp] lemma head_add (a b : fin n.succ → α) : vec_head (a + b) = vec_head a + vec_head b := rfl

@[simp] lemma tail_add (a b : fin n.succ → α) : vec_tail (a + b) = vec_tail a + vec_tail b := rfl

end add

section sub

variables [has_sub α]

@[simp] lemma empty_sub_empty (v w : fin 0 → α) : v - w = ![] := empty_eq _

@[simp] lemma cons_sub (x : α) (v : fin n → α) (w : fin n.succ → α) :
  vec_cons x v - w = vec_cons (x - vec_head w) (v - vec_tail w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma sub_cons (v : fin n.succ → α) (y : α) (w : fin n → α) :
  v - vec_cons y w = vec_cons (vec_head v - y) (vec_tail v - w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma cons_sub_cons (x : α) (v : fin n → α) (y : α) (w : fin n → α) :
  vec_cons x v - vec_cons y w = vec_cons (x - y) (v - w) :=
by simp

@[simp] lemma head_sub (a b : fin n.succ → α) : vec_head (a - b) = vec_head a - vec_head b := rfl

@[simp] lemma tail_sub (a b : fin n.succ → α) : vec_tail (a - b) = vec_tail a - vec_tail b := rfl

end sub

section zero

variables [has_zero α]

@[simp] lemma zero_empty : (0 : fin 0 → α) = ![] :=
empty_eq _

@[simp] lemma cons_zero_zero : vec_cons (0 : α) (0 : fin n → α) = 0 :=
by { ext i j, refine fin.cases _ _ i, { refl }, simp }

@[simp] lemma head_zero : vec_head (0 : fin n.succ → α) = 0 := rfl

@[simp] lemma tail_zero : vec_tail (0 : fin n.succ → α) = 0 := rfl

@[simp] lemma cons_eq_zero_iff {v : fin n → α} {x : α} :
  vec_cons x v = 0 ↔ x = 0 ∧ v = 0 :=
⟨ λ h, ⟨ congr_fun h 0, by { convert congr_arg vec_tail h, simp } ⟩,
  λ ⟨hx, hv⟩, by simp [hx, hv] ⟩

open_locale classical

lemma cons_nonzero_iff {v : fin n → α} {x : α} :
  vec_cons x v ≠ 0 ↔ (x ≠ 0 ∨ v ≠ 0) :=
⟨ λ h, not_and_distrib.mp (h ∘ cons_eq_zero_iff.mpr),
  λ h, mt cons_eq_zero_iff.mp (not_and_distrib.mpr h) ⟩

end zero

section neg

variables [has_neg α]

@[simp] lemma neg_empty (v : fin 0 → α) : -v = ![] := empty_eq _

@[simp] lemma neg_cons (x : α) (v : fin n → α) :
  -(vec_cons x v) = vec_cons (-x) (-v) :=
by { ext i, refine fin.cases _ _ i; simp }

@[simp] lemma head_neg (a : fin n.succ → α) : vec_head (-a) = -vec_head a := rfl

@[simp] lemma tail_neg (a : fin n.succ → α) : vec_tail (-a) = -vec_tail a := rfl

end neg

end matrix