/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä, Moritz Doll

! This file was ported from Lean 3 source module topology.algebra.module.weak_dual
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.Module.Basic
import Mathbin.LinearAlgebra.BilinearMap

/-!
# Weak dual topology

This file defines the weak topology given two vector spaces `E` and `F` over a commutative semiring
`𝕜` and a bilinear form `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`. The weak topology on `E` is the coarsest topology
such that for all `y : F` every map `λ x, B x y` is continuous.

In the case that `F = E →L[𝕜] 𝕜` and `B` being the canonical pairing, we obtain the weak-* topology,
`weak_dual 𝕜 E := (E →L[𝕜] 𝕜)`. Interchanging the arguments in the bilinear form yields the
weak topology `weak_space 𝕜 E := E`.

## Main definitions

The main definitions are the types `weak_bilin B` for the general case and the two special cases
`weak_dual 𝕜 E` and `weak_space 𝕜 E` with the respective topology instances on it.

* Given `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`, the type `weak_bilin B` is a type synonym for `E`.
* The instance `weak_bilin.topological_space` is the weak topology induced by the bilinear form `B`.
* `weak_dual 𝕜 E` is a type synonym for `dual 𝕜 E` (when the latter is defined): both are equal to
  the type `E →L[𝕜] 𝕜` of continuous linear maps from a module `E` over `𝕜` to the ring `𝕜`.
* The instance `weak_dual.topological_space` is the weak-* topology on `weak_dual 𝕜 E`, i.e., the
  coarsest topology making the evaluation maps at all `z : E` continuous.
* `weak_space 𝕜 E` is a type synonym for `E` (when the latter is defined).
* The instance `weak_dual.topological_space` is the weak topology on `E`, i.e., the
  coarsest topology such that all `v : dual 𝕜 E` remain continuous.

## Main results

We establish that `weak_bilin B` has the following structure:
* `weak_bilin.has_continuous_add`: The addition in `weak_bilin B` is continuous.
* `weak_bilin.has_continuous_smul`: The scalar multiplication in `weak_bilin B` is continuous.

We prove the following results characterizing the weak topology:
* `eval_continuous`: For any `y : F`, the evaluation mapping `λ x, B x y` is continuous.
* `continuous_of_continuous_eval`: For a mapping to `weak_bilin B` to be continuous,
  it suffices that its compositions with pairing with `B` at all points `y : F` is continuous.
* `tendsto_iff_forall_eval_tendsto`: Convergence in `weak_bilin B` can be characterized
  in terms of convergence of the evaluations at all points `y : F`.

## Notations

No new notation is introduced.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

weak-star, weak dual, duality

-/

noncomputable section

open Filter

open Topology

variable {α 𝕜 𝕝 R E F M : Type _}

section WeakTopology

/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] 𝕜 -/
/-- The space `E` equipped with the weak topology induced by the bilinear form `B`. -/
@[nolint has_nonempty_instance unused_arguments]
def WeakBilin [CommSemiring 𝕜] [AddCommMonoid E] [Module 𝕜 E] [AddCommMonoid F] [Module 𝕜 F]
    (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) :=
  E deriving AddCommMonoid,
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] 𝕜»
#align weak_bilin WeakBilin

namespace WeakBilin

instance [CommSemiring 𝕜] [a : AddCommGroup E] [Module 𝕜 E] [AddCommMonoid F] [Module 𝕜 F]
    (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) : AddCommGroup (WeakBilin B) :=
  a

instance (priority := 100) module' [CommSemiring 𝕜] [CommSemiring 𝕝] [AddCommGroup E] [Module 𝕜 E]
    [AddCommGroup F] [Module 𝕜 F] [m : Module 𝕝 E] (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) :
    Module 𝕝 (WeakBilin B) :=
  m
#align weak_bilin.module' WeakBilin.module'

instance [CommSemiring 𝕜] [CommSemiring 𝕝] [AddCommGroup E] [Module 𝕜 E] [AddCommGroup F]
    [Module 𝕜 F] [SMul 𝕝 𝕜] [Module 𝕝 E] [s : IsScalarTower 𝕝 𝕜 E] (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) :
    IsScalarTower 𝕝 𝕜 (WeakBilin B) :=
  s

section Semiring

variable [TopologicalSpace 𝕜] [CommSemiring 𝕜]

variable [AddCommMonoid E] [Module 𝕜 E]

variable [AddCommMonoid F] [Module 𝕜 F]

variable (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜)

instance : TopologicalSpace (WeakBilin B) :=
  TopologicalSpace.induced (fun x y => B x y) Pi.topologicalSpace

/-- The coercion `(λ x y, B x y) : E → (F → 𝕜)` is continuous. -/
theorem coeFn_continuous : Continuous fun (x : WeakBilin B) y => B x y :=
  continuous_induced_dom
#align weak_bilin.coe_fn_continuous WeakBilin.coeFn_continuous

theorem eval_continuous (y : F) : Continuous fun x : WeakBilin B => B x y :=
  (continuous_pi_iff.mp (coeFn_continuous B)) y
#align weak_bilin.eval_continuous WeakBilin.eval_continuous

theorem continuous_of_continuous_eval [TopologicalSpace α] {g : α → WeakBilin B}
    (h : ∀ y, Continuous fun a => B (g a) y) : Continuous g :=
  continuous_induced_rng.2 (continuous_pi_iff.mpr h)
#align weak_bilin.continuous_of_continuous_eval WeakBilin.continuous_of_continuous_eval

/-- The coercion `(λ x y, B x y) : E → (F → 𝕜)` is an embedding. -/
theorem embedding {B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜} (hB : Function.Injective B) :
    Embedding fun (x : WeakBilin B) y => B x y :=
  Function.Injective.embedding_induced <| LinearMap.coe_injective.comp hB
#align weak_bilin.embedding WeakBilin.embedding

theorem tendsto_iff_forall_eval_tendsto {l : Filter α} {f : α → WeakBilin B} {x : WeakBilin B}
    (hB : Function.Injective B) :
    Tendsto f l (𝓝 x) ↔ ∀ y, Tendsto (fun i => B (f i) y) l (𝓝 (B x y)) := by
  rw [← tendsto_pi_nhds, Embedding.tendsto_nhds_iff (Embedding hB)]
#align weak_bilin.tendsto_iff_forall_eval_tendsto WeakBilin.tendsto_iff_forall_eval_tendsto

/-- Addition in `weak_space B` is continuous. -/
instance [ContinuousAdd 𝕜] : ContinuousAdd (WeakBilin B) :=
  by
  refine' ⟨continuous_induced_rng.2 _⟩
  refine'
    cast (congr_arg _ _)
      (((coe_fn_continuous B).comp continuous_fst).add ((coe_fn_continuous B).comp continuous_snd))
  ext
  simp only [Function.comp_apply, Pi.add_apply, map_add, LinearMap.add_apply]

/-- Scalar multiplication by `𝕜` on `weak_bilin B` is continuous. -/
instance [ContinuousSMul 𝕜 𝕜] : ContinuousSMul 𝕜 (WeakBilin B) :=
  by
  refine' ⟨continuous_induced_rng.2 _⟩
  refine' cast (congr_arg _ _) (continuous_fst.smul ((coe_fn_continuous B).comp continuous_snd))
  ext
  simp only [Function.comp_apply, Pi.smul_apply, LinearMap.map_smulₛₗ, RingHom.id_apply,
    LinearMap.smul_apply]

end Semiring

section Ring

variable [TopologicalSpace 𝕜] [CommRing 𝕜]

variable [AddCommGroup E] [Module 𝕜 E]

variable [AddCommGroup F] [Module 𝕜 F]

variable (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜)

/-- `weak_space B` is a `topological_add_group`, meaning that addition and negation are
continuous. -/
instance [ContinuousAdd 𝕜] : TopologicalAddGroup (WeakBilin B)
    where
  to_continuousAdd := by infer_instance
  continuous_neg :=
    by
    refine' continuous_induced_rng.2 (continuous_pi_iff.mpr fun y => _)
    refine' cast (congr_arg _ _) (eval_continuous B (-y))
    ext
    simp only [map_neg, Function.comp_apply, LinearMap.neg_apply]

end Ring

end WeakBilin

end WeakTopology

section WeakStarTopology

/-- The canonical pairing of a vector space and its topological dual. -/
def topDualPairing (𝕜 E) [CommSemiring 𝕜] [TopologicalSpace 𝕜] [ContinuousAdd 𝕜] [AddCommMonoid E]
    [Module 𝕜 E] [TopologicalSpace E] [ContinuousConstSMul 𝕜 𝕜] : (E →L[𝕜] 𝕜) →ₗ[𝕜] E →ₗ[𝕜] 𝕜 :=
  ContinuousLinearMap.coeLm 𝕜
#align top_dual_pairing topDualPairing

variable [CommSemiring 𝕜] [TopologicalSpace 𝕜] [ContinuousAdd 𝕜]

variable [ContinuousConstSMul 𝕜 𝕜]

variable [AddCommMonoid E] [Module 𝕜 E] [TopologicalSpace E]

theorem dual_pairing_apply (v : E →L[𝕜] 𝕜) (x : E) : topDualPairing 𝕜 E v x = v x :=
  rfl
#align dual_pairing_apply dual_pairing_apply

/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] 𝕜 -/
/-- The weak star topology is the topology coarsest topology on `E →L[𝕜] 𝕜` such that all
functionals `λ v, top_dual_pairing 𝕜 E v x` are continuous. -/
def WeakDual (𝕜 E) [CommSemiring 𝕜] [TopologicalSpace 𝕜] [ContinuousAdd 𝕜] [ContinuousConstSMul 𝕜 𝕜]
    [AddCommMonoid E] [Module 𝕜 E] [TopologicalSpace E] :=
  WeakBilin (topDualPairing 𝕜 E)deriving AddCommMonoid,
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] 𝕜»,
  TopologicalSpace, ContinuousAdd
#align weak_dual WeakDual

namespace WeakDual

instance : Inhabited (WeakDual 𝕜 E) :=
  ContinuousLinearMap.inhabited

instance WeakDual.continuousLinearMapClass : ContinuousLinearMapClass (WeakDual 𝕜 E) 𝕜 E 𝕜 :=
  ContinuousLinearMap.continuousSemilinearMapClass
#align weak_dual.weak_dual.continuous_linear_map_class WeakDual.WeakDual.continuousLinearMapClass

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : CoeFun (WeakDual 𝕜 E) fun _ => E → 𝕜 :=
  FunLike.hasCoeToFun

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it acts on `weak_dual 𝕜 E`. -/
instance (M) [Monoid M] [DistribMulAction M 𝕜] [SMulCommClass 𝕜 M 𝕜] [ContinuousConstSMul M 𝕜] :
    MulAction M (WeakDual 𝕜 E) :=
  ContinuousLinearMap.mulAction

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it acts distributively on `weak_dual 𝕜 E`. -/
instance (M) [Monoid M] [DistribMulAction M 𝕜] [SMulCommClass 𝕜 M 𝕜] [ContinuousConstSMul M 𝕜] :
    DistribMulAction M (WeakDual 𝕜 E) :=
  ContinuousLinearMap.distribMulAction

/-- If `𝕜` is a topological module over a semiring `R` and scalar multiplication commutes with the
multiplication on `𝕜`, then `weak_dual 𝕜 E` is a module over `R`. -/
instance module' (R) [Semiring R] [Module R 𝕜] [SMulCommClass 𝕜 R 𝕜] [ContinuousConstSMul R 𝕜] :
    Module R (WeakDual 𝕜 E) :=
  ContinuousLinearMap.module
#align weak_dual.module' WeakDual.module'

instance (M) [Monoid M] [DistribMulAction M 𝕜] [SMulCommClass 𝕜 M 𝕜] [ContinuousConstSMul M 𝕜] :
    ContinuousConstSMul M (WeakDual 𝕜 E) :=
  ⟨fun m =>
    continuous_induced_rng.2 <| (WeakBilin.coeFn_continuous (topDualPairing 𝕜 E)).const_smul m⟩

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it continuously acts on `weak_dual 𝕜 E`. -/
instance (M) [Monoid M] [DistribMulAction M 𝕜] [SMulCommClass 𝕜 M 𝕜] [TopologicalSpace M]
    [ContinuousSMul M 𝕜] : ContinuousSMul M (WeakDual 𝕜 E) :=
  ⟨continuous_induced_rng.2 <|
      continuous_fst.smul ((WeakBilin.coeFn_continuous (topDualPairing 𝕜 E)).comp continuous_snd)⟩

theorem coeFn_continuous : Continuous fun (x : WeakDual 𝕜 E) y => x y :=
  continuous_induced_dom
#align weak_dual.coe_fn_continuous WeakDual.coeFn_continuous

theorem eval_continuous (y : E) : Continuous fun x : WeakDual 𝕜 E => x y :=
  continuous_pi_iff.mp coeFn_continuous y
#align weak_dual.eval_continuous WeakDual.eval_continuous

theorem continuous_of_continuous_eval [TopologicalSpace α] {g : α → WeakDual 𝕜 E}
    (h : ∀ y, Continuous fun a => (g a) y) : Continuous g :=
  continuous_induced_rng.2 (continuous_pi_iff.mpr h)
#align weak_dual.continuous_of_continuous_eval WeakDual.continuous_of_continuous_eval

instance [T2Space 𝕜] : T2Space (WeakDual 𝕜 E) :=
  Embedding.t2Space <|
    WeakBilin.embedding <|
      show Function.Injective (topDualPairing 𝕜 E) from ContinuousLinearMap.coe_injective

end WeakDual

/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] 𝕜 -/
/-- The weak topology is the topology coarsest topology on `E` such that all
functionals `λ x, top_dual_pairing 𝕜 E v x` are continuous. -/
@[nolint has_nonempty_instance]
def WeakSpace (𝕜 E) [CommSemiring 𝕜] [TopologicalSpace 𝕜] [ContinuousAdd 𝕜]
    [ContinuousConstSMul 𝕜 𝕜] [AddCommMonoid E] [Module 𝕜 E] [TopologicalSpace E] :=
  WeakBilin (topDualPairing 𝕜 E).flip deriving AddCommMonoid,
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] 𝕜»,
  TopologicalSpace, ContinuousAdd
#align weak_space WeakSpace

namespace WeakSpace

variable {𝕜 E F} [AddCommMonoid F] [Module 𝕜 F] [TopologicalSpace F]

/-- A continuous linear map from `E` to `F` is still continuous when `E` and `F` are equipped with
their weak topologies. -/
def map (f : E →L[𝕜] F) : WeakSpace 𝕜 E →L[𝕜] WeakSpace 𝕜 F :=
  { f with
    cont :=
      WeakBilin.continuous_of_continuous_eval _ fun l => WeakBilin.eval_continuous _ (l ∘L f) }
#align weak_space.map WeakSpace.map

theorem map_apply (f : E →L[𝕜] F) (x : E) : WeakSpace.map f x = f x :=
  rfl
#align weak_space.map_apply WeakSpace.map_apply

@[simp]
theorem coe_map (f : E →L[𝕜] F) : (WeakSpace.map f : E → F) = f :=
  rfl
#align weak_space.coe_map WeakSpace.coe_map

end WeakSpace

theorem tendsto_iff_forall_eval_tendsto_topDualPairing {l : Filter α} {f : α → WeakDual 𝕜 E}
    {x : WeakDual 𝕜 E} :
    Tendsto f l (𝓝 x) ↔
      ∀ y, Tendsto (fun i => topDualPairing 𝕜 E (f i) y) l (𝓝 (topDualPairing 𝕜 E x y)) :=
  WeakBilin.tendsto_iff_forall_eval_tendsto _ ContinuousLinearMap.coe_injective
#align tendsto_iff_forall_eval_tendsto_top_dual_pairing tendsto_iff_forall_eval_tendsto_topDualPairing

end WeakStarTopology


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module topology.partial
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.ContinuousOn
import Mathlib.Order.Filter.Partial

/-!
# Partial functions and topological spaces

In this file we prove properties of `Filter.Ptendsto` etc in topological spaces. We also introduce
`Pcontinuous`, a version of `Continuous` for partially defined functions.
-/

open Filter

open Topology

variable {α β : Type _} [TopologicalSpace α]

theorem rtendsto_nhds {r : Rel β α} {l : Filter β} {a : α} :
    Rtendsto r l (𝓝 a) ↔ ∀ s, IsOpen s → a ∈ s → r.core s ∈ l :=
  all_mem_nhds_filter _ _ (fun _s _t => id) _
#align rtendsto_nhds rtendsto_nhds

theorem rtendsto'_nhds {r : Rel β α} {l : Filter β} {a : α} :
    Rtendsto' r l (𝓝 a) ↔ ∀ s, IsOpen s → a ∈ s → r.preimage s ∈ l := by
  rw [rtendsto'_def]
  apply all_mem_nhds_filter
  apply Rel.preimage_mono
#align rtendsto'_nhds rtendsto'_nhds

theorem ptendsto_nhds {f : β →. α} {l : Filter β} {a : α} :
    Ptendsto f l (𝓝 a) ↔ ∀ s, IsOpen s → a ∈ s → f.core s ∈ l :=
  rtendsto_nhds
#align ptendsto_nhds ptendsto_nhds

theorem ptendsto'_nhds {f : β →. α} {l : Filter β} {a : α} :
    Ptendsto' f l (𝓝 a) ↔ ∀ s, IsOpen s → a ∈ s → f.preimage s ∈ l :=
  rtendsto'_nhds
#align ptendsto'_nhds ptendsto'_nhds

/-! ### Continuity and partial functions -/

variable [TopologicalSpace β]

/-- Continuity of a partial function -/
def Pcontinuous (f : α →. β) :=
  ∀ s, IsOpen s → IsOpen (f.preimage s)
#align pcontinuous Pcontinuous

theorem open_dom_of_pcontinuous {f : α →. β} (h : Pcontinuous f) : IsOpen f.Dom := by
  rw [← PFun.preimage_univ]; exact h _ isOpen_univ
#align open_dom_of_pcontinuous open_dom_of_pcontinuous

theorem pcontinuous_iff' {f : α →. β} :
    Pcontinuous f ↔ ∀ {x y} (h : y ∈ f x), Ptendsto' f (𝓝 x) (𝓝 y) := by
  constructor
  · intro h x y h'
    simp only [ptendsto'_def, mem_nhds_iff]
    rintro s ⟨t, tsubs, opent, yt⟩
    exact ⟨f.preimage t, PFun.preimage_mono _ tsubs, h _ opent, ⟨y, yt, h'⟩⟩
  intro hf s os
  rw [isOpen_iff_nhds]
  rintro x ⟨y, ys, fxy⟩ t
  rw [mem_principal]
  intro (h : f.preimage s ⊆ t)
  change t ∈ 𝓝 x
  apply mem_of_superset _ h
  have h' : ∀ s ∈ 𝓝 y, f.preimage s ∈ 𝓝 x := by
    intro s hs
    have : Ptendsto' f (𝓝 x) (𝓝 y) := hf fxy
    rw [ptendsto'_def] at this
    exact this s hs
  show f.preimage s ∈ 𝓝 x
  apply h'
  rw [mem_nhds_iff]
  exact ⟨s, Set.Subset.refl _, os, ys⟩
#align pcontinuous_iff' pcontinuous_iff'

theorem continuousWithinAt_iff_ptendsto_res (f : α → β) {x : α} {s : Set α} :
    ContinuousWithinAt f s x ↔ Ptendsto (PFun.res f s) (𝓝 x) (𝓝 (f x)) :=
  tendsto_iff_ptendsto _ _ _ _
#align continuous_within_at_iff_ptendsto_res continuousWithinAt_iff_ptendsto_res


/-
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 topology.metric_space.isometry

/-!
# Metric space gluing

Gluing two metric spaces along a common subset. Formally, we are given

```
     Φ
  Z ---> X
  |
  |Ψ
  v
  Y
```
where `hΦ : isometry Φ` and `hΨ : isometry Ψ`.
We want to complete the square by a space `glue_space hΦ hΨ` and two isometries
`to_glue_l hΦ hΨ` and `to_glue_r hΦ hΨ` that make the square commute.
We start by defining a predistance on the disjoint union `X ⊕ Y`, for which
points `Φ p` and `Ψ p` are at distance 0. The (quotient) metric space associated
to this predistance is the desired space.

This is an instance of a more general construction, where `Φ` and `Ψ` do not have to be isometries,
but the distances in the image almost coincide, up to `2ε` say. Then one can almost glue the two
spaces so that the images of a point under `Φ` and `Ψ` are `ε`-close. If `ε > 0`, this yields a
metric space structure on `X ⊕ Y`, without the need to take a quotient. In particular,
this gives a natural metric space structure on `X ⊕ Y`, where the basepoints
are at distance 1, say, and the distances between other points are obtained by going through the two
basepoints.
(We also register the same metric space structure on a general disjoint union `Σ i, E i`).

We also define the inductive limit of metric spaces. Given
```
     f 0        f 1        f 2        f 3
X 0 -----> X 1 -----> X 2 -----> X 3 -----> ...
```
where the `X n` are metric spaces and `f n` isometric embeddings, we define the inductive
limit of the `X n`, also known as the increasing union of the `X n` in this context, if we
identify `X n` and `X (n+1)` through `f n`. This is a metric space in which all `X n` embed
isometrically and in a way compatible with `f n`.

-/

noncomputable theory

universes u v w
open function set
open_locale uniformity

namespace metric
section approx_gluing

variables {X : Type u} {Y : Type v} {Z : Type w}

variables [metric_space X] [metric_space Y]
          {Φ : Z → X} {Ψ : Z → Y} {ε : ℝ}
open _root_.sum (inl inr)

/-- Define a predistance on `X ⊕ Y`, for which `Φ p` and `Ψ p` are at distance `ε` -/
def glue_dist (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) : X ⊕ Y → X ⊕ Y → ℝ
| (inl x) (inl y) := dist x y
| (inr x) (inr y) := dist x y
| (inl x) (inr y) := (⨅ p, dist x (Φ p) + dist y (Ψ p)) + ε
| (inr x) (inl y) := (⨅ p, dist y (Φ p) + dist x (Ψ p)) + ε

private lemma glue_dist_self (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) : ∀ x, glue_dist Φ Ψ ε x x = 0
| (inl x) := dist_self _
| (inr x) := dist_self _

lemma glue_dist_glued_points [nonempty Z] (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (p : Z) :
  glue_dist Φ Ψ ε (inl (Φ p)) (inr (Ψ p)) = ε :=
begin
  have : (⨅ q, dist (Φ p) (Φ q) + dist (Ψ p) (Ψ q)) = 0,
  { have A : ∀ q, 0 ≤ dist (Φ p) (Φ q) + dist (Ψ p) (Ψ q) :=
      λq, by rw ← add_zero (0 : ℝ); exact add_le_add dist_nonneg dist_nonneg,
    refine le_antisymm _ (le_cinfi A),
    have : 0 = dist (Φ p) (Φ p) + dist (Ψ p) (Ψ p), by simp,
    rw this,
    exact cinfi_le ⟨0, forall_range_iff.2 A⟩ p },
  rw [glue_dist, this, zero_add]
end

private lemma glue_dist_comm (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) :
  ∀ x y, glue_dist Φ Ψ ε x y = glue_dist Φ Ψ ε y x
| (inl x) (inl y) := dist_comm _ _
| (inr x) (inr y) := dist_comm _ _
| (inl x) (inr y) := rfl
| (inr x) (inl y) := rfl

variable [nonempty Z]

private lemma glue_dist_triangle (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ)
  (H : ∀ p q, |dist (Φ p) (Φ q) - dist (Ψ p) (Ψ q)| ≤ 2 * ε) :
  ∀ x y z, glue_dist Φ Ψ ε x z ≤ glue_dist Φ Ψ ε x y + glue_dist Φ Ψ ε y z
| (inl x) (inl y) (inl z) := dist_triangle _ _ _
| (inr x) (inr y) (inr z) := dist_triangle _ _ _
| (inr x) (inl y) (inl z) := begin
    have B : ∀ a b, bdd_below (range (λ (p : Z), dist a (Φ p) + dist b (Ψ p))) :=
      λa b, ⟨0, forall_range_iff.2 (λp, add_nonneg dist_nonneg dist_nonneg)⟩,
    unfold glue_dist,
    have : (⨅ p, dist z (Φ p) + dist x (Ψ p)) ≤ (⨅ p, dist y (Φ p) + dist x (Ψ p)) + dist y z,
    { have : (⨅ p, dist y (Φ p) + dist x (Ψ p)) + dist y z =
            infi ((λt, t + dist y z) ∘ (λp, dist y (Φ p) + dist x (Ψ p))),
      { refine map_cinfi_of_continuous_at_of_monotone (continuous_at_id.add continuous_at_const) _
          (B _ _),
        intros x y hx, simpa },
      rw [this, comp],
      refine cinfi_le_cinfi (B _ _) (λp, _),
      calc
        dist z (Φ p) + dist x (Ψ p) ≤ (dist y z + dist y (Φ p)) + dist x (Ψ p) :
          add_le_add (dist_triangle_left _ _ _) le_rfl
        ... = dist y (Φ p) + dist x (Ψ p) + dist y z : by ring },
    linarith
  end
| (inr x) (inr y) (inl z) := begin
    have B : ∀ a b, bdd_below (range (λ (p : Z), dist a (Φ p) + dist b (Ψ p))) :=
      λa b, ⟨0, forall_range_iff.2 (λp, add_nonneg dist_nonneg dist_nonneg)⟩,
    unfold glue_dist,
    have : (⨅ p, dist z (Φ p) + dist x (Ψ p)) ≤ dist x y + ⨅ p, dist z (Φ p) + dist y (Ψ p),
    { have : dist x y + (⨅ p, dist z (Φ p) + dist y (Ψ p)) =
            infi ((λt, dist x y + t) ∘ (λp, dist z (Φ p) + dist y (Ψ p))),
      { refine map_cinfi_of_continuous_at_of_monotone (continuous_at_const.add continuous_at_id) _
          (B _ _),
        intros x y hx, simpa },
      rw [this, comp],
      refine cinfi_le_cinfi (B _ _) (λp, _),
      calc
        dist z (Φ p) + dist x (Ψ p) ≤ dist z (Φ p) + (dist x y + dist y (Ψ p)) :
          add_le_add le_rfl (dist_triangle _ _ _)
        ... = dist x y + (dist z (Φ p) + dist y (Ψ p)) : by ring },
    linarith
  end
| (inl x) (inl y) (inr z) := begin
    have B : ∀ a b, bdd_below (range (λ (p : Z), dist a (Φ p) + dist b (Ψ p))) :=
      λa b, ⟨0, forall_range_iff.2 (λp, add_nonneg dist_nonneg dist_nonneg)⟩,
    unfold glue_dist,
    have : (⨅ p, dist x (Φ p) + dist z (Ψ p)) ≤ dist x y + ⨅ p, dist y (Φ p) + dist z (Ψ p),
    { have : dist x y + (⨅ p, dist y (Φ p) + dist z (Ψ p)) =
            infi ((λt, dist x y + t) ∘ (λp, dist y (Φ p) + dist z (Ψ p))),
      { refine map_cinfi_of_continuous_at_of_monotone (continuous_at_const.add continuous_at_id) _
          (B _ _),
        intros x y hx, simpa },
      rw [this, comp],
      refine cinfi_le_cinfi (B _ _) (λp, _),
      calc
        dist x (Φ p) + dist z (Ψ p) ≤ (dist x y + dist y (Φ p)) + dist z (Ψ p) :
          add_le_add (dist_triangle _ _ _) le_rfl
        ... = dist x y + (dist y (Φ p) + dist z (Ψ p)) : by ring },
    linarith
  end
| (inl x) (inr y) (inr z) := begin
    have B : ∀ a b, bdd_below (range (λ (p : Z), dist a (Φ p) + dist b (Ψ p))) :=
      λa b, ⟨0, forall_range_iff.2 (λp, add_nonneg dist_nonneg dist_nonneg)⟩,
    unfold glue_dist,
    have : (⨅ p, dist x (Φ p) + dist z (Ψ p)) ≤ (⨅ p, dist x (Φ p) + dist y (Ψ p)) + dist y z,
    { have : (⨅ p, dist x (Φ p) + dist y (Ψ p)) + dist y z =
            infi ((λt, t + dist y z) ∘ (λp, dist x (Φ p) + dist y (Ψ p))),
      { refine map_cinfi_of_continuous_at_of_monotone (continuous_at_id.add continuous_at_const) _
          (B _ _),
        intros x y hx, simpa },
      rw [this, comp],
      refine cinfi_le_cinfi (B _ _) (λp, _),
      calc
        dist x (Φ p) + dist z (Ψ p) ≤ dist x (Φ p) + (dist y z + dist y (Ψ p)) :
          add_le_add le_rfl (dist_triangle_left _ _ _)
        ... = dist x (Φ p) + dist y (Ψ p) + dist y z : by ring },
    linarith
  end
| (inl x) (inr y) (inl z) := le_of_forall_pos_le_add $ λδ δpos, begin
    obtain ⟨p, hp⟩ : ∃ p, dist x (Φ p) + dist y (Ψ p) < (⨅ p, dist x (Φ p) + dist y (Ψ p)) + δ / 2,
      from exists_lt_of_cinfi_lt (by linarith),
    obtain ⟨q, hq⟩ : ∃ q, dist z (Φ q) + dist y (Ψ q) < (⨅ p, dist z (Φ p) + dist y (Ψ p)) + δ / 2,
      from exists_lt_of_cinfi_lt (by linarith),
    have : dist (Φ p) (Φ q) ≤ dist (Ψ p) (Ψ q) + 2 * ε,
      { have := le_trans (le_abs_self _) (H p q), by linarith },
    calc dist x z ≤ dist x (Φ p) + dist (Φ p) (Φ q) + dist (Φ q) z : dist_triangle4 _ _ _ _
      ... ≤ dist x (Φ p) + dist (Ψ p) (Ψ q) + dist z (Φ q) + 2 * ε : by rw [dist_comm z]; linarith
      ... ≤ dist x (Φ p) + (dist y (Ψ p) + dist y (Ψ q)) + dist z (Φ q) + 2 * ε :
        add_le_add (add_le_add (add_le_add le_rfl (dist_triangle_left _ _ _)) le_rfl) le_rfl
      ... ≤ ((⨅ p, dist x (Φ p) + dist y (Ψ p)) + ε) +
            ((⨅ p, dist z (Φ p) + dist y (Ψ p)) + ε) + δ : by linarith
  end
| (inr x) (inl y) (inr z) := le_of_forall_pos_le_add $ λδ δpos, begin
    obtain ⟨p, hp⟩ : ∃ p, dist y (Φ p) + dist x (Ψ p) < (⨅ p, dist y (Φ p) + dist x (Ψ p)) + δ / 2,
      from exists_lt_of_cinfi_lt (by linarith),
    obtain ⟨q, hq⟩ : ∃ q, dist y (Φ q) + dist z (Ψ q) < (⨅ p, dist y (Φ p) + dist z (Ψ p)) + δ / 2,
      from exists_lt_of_cinfi_lt (by linarith),
    have : dist (Ψ p) (Ψ q) ≤ dist (Φ p) (Φ q) + 2 * ε,
      { have := le_trans (neg_le_abs_self _) (H p q), by linarith },
    calc dist x z ≤ dist x (Ψ p) + dist (Ψ p) (Ψ q) + dist (Ψ q) z : dist_triangle4 _ _ _ _
      ... ≤ dist x (Ψ p) + dist (Φ p) (Φ q) + dist z (Ψ q) + 2 * ε : by rw [dist_comm z]; linarith
      ... ≤ dist x (Ψ p) + (dist y (Φ p) + dist y (Φ q)) + dist z (Ψ q) + 2 * ε :
        add_le_add (add_le_add (add_le_add le_rfl (dist_triangle_left _ _ _)) le_rfl) le_rfl
      ... ≤ ((⨅ p, dist y (Φ p) + dist x (Ψ p)) + ε) +
            ((⨅ p, dist y (Φ p) + dist z (Ψ p)) + ε) + δ : by linarith
  end

private lemma glue_eq_of_dist_eq_zero (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (ε0 : 0 < ε) :
  ∀ p q : X ⊕ Y, glue_dist Φ Ψ ε p q = 0 → p = q
| (inl x) (inl y) h := by rw eq_of_dist_eq_zero h
| (inl x) (inr y) h := begin
    have : 0 ≤ (⨅ p, dist x (Φ p) + dist y (Ψ p)) :=
      le_cinfi (λp, by simpa using add_le_add (@dist_nonneg _ _ x _) (@dist_nonneg _ _ y _)),
    have : 0 + ε ≤ glue_dist Φ Ψ ε (inl x) (inr y) := add_le_add this (le_refl ε),
    exfalso,
    linarith
  end
| (inr x) (inl y) h := begin
    have : 0 ≤ ⨅ p, dist y (Φ p) + dist x (Ψ p) :=
      le_cinfi (λp, by simpa [add_comm]
                         using add_le_add (@dist_nonneg _ _ x _) (@dist_nonneg _ _ y _)),
    have : 0 + ε ≤ glue_dist Φ Ψ ε (inr x) (inl y) := add_le_add this (le_refl ε),
    exfalso,
    linarith
  end
| (inr x) (inr y) h := by rw eq_of_dist_eq_zero h

/-- Given two maps `Φ` and `Ψ` intro metric spaces `X` and `Y` such that the distances between
`Φ p` and `Φ q`, and between `Ψ p` and `Ψ q`, coincide up to `2 ε` where `ε > 0`, one can almost
glue the two spaces `X` and `Y` along the images of `Φ` and `Ψ`, so that `Φ p` and `Ψ p` are
at distance `ε`. -/
def glue_metric_approx (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (ε0 : 0 < ε)
  (H : ∀ p q, |dist (Φ p) (Φ q) - dist (Ψ p) (Ψ q)| ≤ 2 * ε) : metric_space (X ⊕ Y) :=
{ dist               := glue_dist Φ Ψ ε,
  dist_self          := glue_dist_self Φ Ψ ε,
  dist_comm          := glue_dist_comm Φ Ψ ε,
  dist_triangle      := glue_dist_triangle Φ Ψ ε H,
  eq_of_dist_eq_zero := glue_eq_of_dist_eq_zero Φ Ψ ε ε0 }

end approx_gluing

section sum
/- A particular case of the previous construction is when one uses basepoints in `X` and `Y` and one
glues only along the basepoints, putting them at distance 1. We give a direct definition of
the distance, without infi, as it is easier to use in applications, and show that it is equal to
the gluing distance defined above to take advantage of the lemmas we have already proved. -/

variables {X : Type u} {Y : Type v} {Z : Type w}
variables [metric_space X] [metric_space Y]
open sum (inl inr)

/-- Distance on a disjoint union. There are many (noncanonical) ways to put a distance compatible
with each factor.
If the two spaces are bounded, one can say for instance that each point in the first is at distance
`diam X + diam Y + 1` of each point in the second.
Instead, we choose a construction that works for unbounded spaces, but requires basepoints,
chosen arbitrarily.
We embed isometrically each factor, set the basepoints at distance 1,
arbitrarily, and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
def sum.dist : X ⊕ Y → X ⊕ Y → ℝ
| (inl a) (inl a') := dist a a'
| (inr b) (inr b') := dist b b'
| (inl a) (inr b)  := dist a (nonempty.some ⟨a⟩) + 1 + dist (nonempty.some ⟨b⟩) b
| (inr b) (inl a)  := dist b (nonempty.some ⟨b⟩) + 1 + dist (nonempty.some ⟨a⟩) a

lemma sum.dist_eq_glue_dist {p q : X ⊕ Y} (x : X) (y : Y) :
  sum.dist p q = glue_dist (λ _ : unit, nonempty.some ⟨x⟩) (λ _ : unit, nonempty.some ⟨y⟩) 1 p q :=
by cases p; cases q; refl <|> simp [sum.dist, glue_dist, dist_comm, add_comm, add_left_comm]

private lemma sum.dist_comm (x y : X ⊕ Y) : sum.dist x y = sum.dist y x :=
by cases x; cases y; simp only [sum.dist, dist_comm, add_comm, add_left_comm]

lemma sum.one_dist_le {x : X} {y : Y} : 1 ≤ sum.dist (inl x) (inr y) :=
le_trans (le_add_of_nonneg_right dist_nonneg) $
add_le_add_right (le_add_of_nonneg_left dist_nonneg) _

lemma sum.one_dist_le' {x : X} {y : Y} : 1 ≤ sum.dist (inr y) (inl x) :=
by rw sum.dist_comm; exact sum.one_dist_le

private lemma sum.mem_uniformity (s : set ((X ⊕ Y) × (X ⊕ Y))) :
  s ∈ 𝓤 (X ⊕ Y) ↔ ∃ ε > 0, ∀ a b, sum.dist a b < ε → (a, b) ∈ s :=
begin
  split,
  { rintro ⟨hsX, hsY⟩,
    rcases mem_uniformity_dist.1 hsX with ⟨εX, εX0, hX⟩,
    rcases mem_uniformity_dist.1 hsY with ⟨εY, εY0, hY⟩,
    refine ⟨min (min εX εY) 1, lt_min (lt_min εX0 εY0) zero_lt_one, _⟩,
    rintro (a|a) (b|b) h,
    { exact hX (lt_of_lt_of_le h (le_trans (min_le_left _ _) (min_le_left _ _))) },
    { cases not_le_of_lt (lt_of_lt_of_le h (min_le_right _ _)) sum.one_dist_le },
    { cases not_le_of_lt (lt_of_lt_of_le h (min_le_right _ _)) sum.one_dist_le' },
    { exact hY (lt_of_lt_of_le h (le_trans (min_le_left _ _) (min_le_right _ _))) } },
  { rintro ⟨ε, ε0, H⟩,
    split; rw [filter.mem_sets, filter.mem_map, mem_uniformity_dist];
      exact ⟨ε, ε0, λ x y h, H _ _ (by exact h)⟩ }
end

/-- The distance on the disjoint union indeed defines a metric space. All the distance properties
follow from our choice of the distance. The harder work is to show that the uniform structure
defined by the distance coincides with the disjoint union uniform structure. -/
def metric_space_sum : metric_space (X ⊕ Y) :=
{ dist               := sum.dist,
  dist_self          := λx, by cases x; simp only [sum.dist, dist_self],
  dist_comm          := sum.dist_comm,
  dist_triangle      := λ p q r,
  begin
    cases p; cases q; cases r,
    { exact dist_triangle _ _ _ },
    { simp only [dist, sum.dist_eq_glue_dist p r],
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _ },
    { simp only [dist, sum.dist_eq_glue_dist p q],
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _ },
    { simp only [dist, sum.dist_eq_glue_dist p q],
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _ },
    { simp only [dist, sum.dist_eq_glue_dist q p],
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _ },
    { simp only [dist, sum.dist_eq_glue_dist q p],
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _ },
    { simp only [dist, sum.dist_eq_glue_dist r p],
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _ },
    { exact dist_triangle _ _ _ },
  end,
  eq_of_dist_eq_zero := λ p q,
  begin
    cases p; cases q,
    { simp only [sum.dist, dist_eq_zero, imp_self] },
    { assume h,
      simp only [dist, sum.dist_eq_glue_dist p q] at h,
      exact glue_eq_of_dist_eq_zero _ _ _ zero_lt_one _ _ h },
    { assume h,
      simp only [dist, sum.dist_eq_glue_dist q p] at h,
      exact glue_eq_of_dist_eq_zero _ _ _ zero_lt_one _ _ h },
    { simp only [sum.dist, dist_eq_zero, imp_self] },
  end,
  to_uniform_space   := sum.uniform_space,
  uniformity_dist    := uniformity_dist_of_mem_uniformity _ _ sum.mem_uniformity }

local attribute [instance] metric_space_sum

lemma sum.dist_eq {x y : X ⊕ Y} : dist x y = sum.dist x y := rfl

/-- The left injection of a space in a disjoint union is an isometry -/
lemma isometry_inl : isometry (sum.inl : X → (X ⊕ Y)) :=
isometry_emetric_iff_metric.2 $ λx y, rfl

/-- The right injection of a space in a disjoint union is an isometry -/
lemma isometry_inr : isometry (sum.inr : Y → (X ⊕ Y)) :=
isometry_emetric_iff_metric.2 $ λx y, rfl

end sum

namespace sigma
/- Copy of the previous paragraph, but for arbitrary disjoint unions instead of the disjoint union
of two spaces. I.e., work with sigma types instead of sum types. -/

variables {ι : Type*} {E : ι → Type*} [∀ i, metric_space (E i)]

open_locale classical

/-- Distance on a disjoint union. There are many (noncanonical) ways to put a distance compatible
with each factor.
We choose a construction that works for unbounded spaces, but requires basepoints,
chosen arbitrarily.
We embed isometrically each factor, set the basepoints at distance 1, arbitrarily,
and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
protected def dist : (Σ i, E i) → (Σ i, E i) → ℝ
| ⟨i, x⟩ ⟨j, y⟩ :=
    if h : i = j then by { have : E j = E i, by rw h, exact has_dist.dist x (cast this y) }
    else has_dist.dist x (nonempty.some ⟨x⟩) + 1 + has_dist.dist (nonempty.some ⟨y⟩) y

/-- A `has_dist` instance on the disjoint union `Σ i, E i`.
We embed isometrically each factor, set the basepoints at distance 1, arbitrarily,
and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
def has_dist : has_dist (Σ i, E i) :=
⟨sigma.dist⟩

local attribute [instance] sigma.has_dist

@[simp] lemma dist_same (i : ι) (x : E i) (y : E i) :
  dist (⟨i, x⟩ : Σ j, E j) ⟨i, y⟩ = dist x y :=
by simp [has_dist.dist, sigma.dist]

@[simp] lemma dist_ne {i j : ι} (h : i ≠ j) (x : E i) (y : E j) :
  dist (⟨i, x⟩ : Σ k, E k) ⟨j, y⟩ = dist x (nonempty.some ⟨x⟩) + 1 + dist (nonempty.some ⟨y⟩) y :=
by simp [has_dist.dist, sigma.dist, h]

lemma one_le_dist_of_ne {i j : ι} (h : i ≠ j) (x : E i) (y : E j) :
  1 ≤ dist (⟨i, x⟩ : Σ k, E k) ⟨j, y⟩ :=
begin
  rw sigma.dist_ne h x y,
  linarith [@dist_nonneg _ _ x (nonempty.some ⟨x⟩), @dist_nonneg _ _ (nonempty.some ⟨y⟩) y]
end

lemma fst_eq_of_dist_lt_one (x y : Σ i, E i) (h : dist x y < 1) :
  x.1 = y.1 :=
begin
  cases x, cases y,
  contrapose! h,
  apply one_le_dist_of_ne h,
end

protected lemma dist_triangle (x y z : Σ i, E i) :
  dist x z ≤ dist x y + dist y z :=
begin
  rcases x with ⟨i, x⟩, rcases y with ⟨j, y⟩, rcases z with ⟨k, z⟩,
  rcases eq_or_ne i k with rfl|hik,
  { rcases eq_or_ne i j with rfl|hij,
    { simpa using dist_triangle x y z },
    { simp only [hij, hij.symm, sigma.dist_same, sigma.dist_ne, ne.def, not_false_iff],
      calc dist x z ≤ dist x (nonempty.some ⟨x⟩) + 0 + 0 + (0 + 0 + dist (nonempty.some ⟨z⟩) z) :
        by simpa only [zero_add, add_zero] using dist_triangle _ _ _
      ... ≤ _ : by apply_rules [add_le_add, le_rfl, dist_nonneg, zero_le_one] } },
  { rcases eq_or_ne i j with rfl|hij,
    { simp only [hik, sigma.dist_ne, ne.def, not_false_iff, sigma.dist_same],
      calc dist x (nonempty.some ⟨x⟩) + 1 + dist (nonempty.some ⟨z⟩) z ≤
        (dist x y + dist y (nonempty.some ⟨y⟩) + 1 + dist (nonempty.some ⟨z⟩) z) :
          by apply_rules [add_le_add, le_rfl, dist_triangle]
      ... = _ : by abel },
    { rcases eq_or_ne j k with rfl|hjk,
      { simp only [hij, sigma.dist_ne, ne.def, not_false_iff, sigma.dist_same],
        calc dist x (nonempty.some ⟨x⟩) + 1 + dist (nonempty.some ⟨z⟩) z ≤
          dist x (nonempty.some ⟨x⟩) + 1 + (dist (nonempty.some ⟨z⟩) y + dist y z) :
            by apply_rules [add_le_add, le_rfl, dist_triangle]
        ... = _ : by abel },
      { simp only [hik, hij, hjk, sigma.dist_ne, ne.def, not_false_iff],
        calc dist x (nonempty.some ⟨x⟩) + 1 + dist (nonempty.some ⟨z⟩) z
          = dist x (nonempty.some ⟨x⟩) + 1 + 0 + (0 + 0 + dist (nonempty.some ⟨z⟩) z) :
            by simp only [add_zero, zero_add]
        ... ≤ _ :
          by apply_rules [add_le_add, zero_le_one, dist_nonneg, le_rfl] } } }
end

protected lemma is_open_iff (s : set (Σ i, E i)) :
  is_open s ↔ ∀ x ∈ s, ∃ ε > 0, ∀ y, dist x y < ε → y ∈ s :=
begin
  split,
  { rintros hs ⟨i, x⟩ hx,
    obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ) (H : ε > 0), ball x ε ⊆ sigma.mk i ⁻¹' s :=
      metric.is_open_iff.1 (is_open_sigma_iff.1 hs i) x hx,
    refine ⟨min ε 1, lt_min εpos zero_lt_one, _⟩,
    rintros ⟨j, y⟩ hy,
    rcases eq_or_ne i j with rfl|hij,
    { simp only [sigma.dist_same, lt_min_iff] at hy,
      exact hε (mem_ball'.2 hy.1) },
    { apply (lt_irrefl (1 : ℝ) _).elim,
      calc 1 ≤ sigma.dist ⟨i, x⟩ ⟨j, y⟩ : sigma.one_le_dist_of_ne hij _ _
      ... < 1 : hy.trans_le (min_le_right _ _) } },
  { assume H,
    apply is_open_sigma_iff.2 (λ i, _),
    apply metric.is_open_iff.2 (λ x hx, _),
    obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ) (H : ε > 0), ∀ y, dist (⟨i, x⟩ : Σ j, E j) y < ε → y ∈ s :=
      H ⟨i, x⟩ hx,
    refine ⟨ε, εpos, λ y hy, _⟩,
    apply hε ⟨i, y⟩,
    rw sigma.dist_same,
    exact mem_ball'.1 hy }
end

/-- A metric space structure on the disjoint union `Σ i, E i`.
We embed isometrically each factor, set the basepoints at distance 1, arbitrarily,
and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
protected def metric_space : metric_space (Σ i, E i) :=
begin
  refine metric_space.of_metrizable sigma.dist _ _ sigma.dist_triangle
    sigma.is_open_iff _,
  { rintros ⟨i, x⟩, simp [sigma.dist] },
  { rintros ⟨i, x⟩ ⟨j, y⟩,
    rcases eq_or_ne i j with rfl|h,
    { simp [sigma.dist, dist_comm] },
    { simp only [sigma.dist, dist_comm, h, h.symm, not_false_iff, dif_neg], abel } },
  { rintros ⟨i, x⟩ ⟨j, y⟩,
    rcases eq_or_ne i j with rfl|hij,
    { simp [sigma.dist] },
    { assume h,
      apply (lt_irrefl (1 : ℝ) _).elim,
      calc 1 ≤ sigma.dist (⟨i, x⟩ : Σ k, E k) ⟨j, y⟩ : sigma.one_le_dist_of_ne hij _ _
      ... < 1 : by { rw h, exact zero_lt_one } } }
end

local attribute [instance] sigma.metric_space

open_locale topological_space
open filter

/-- The injection of a space in a disjoint union is an isometry -/
lemma isometry_mk (i : ι) : isometry (sigma.mk i : E i → Σ k, E k) :=
isometry_emetric_iff_metric.2 (by simp)

/-- A disjoint union of complete metric spaces is complete. -/
protected lemma complete_space [∀ i, complete_space (E i)] : complete_space (Σ i, E i) :=
begin
  set s : ι → set (Σ i, E i) := λ i, (sigma.fst ⁻¹' {i}),
  set U := {p : (Σ k, E k) × (Σ k, E k) | dist p.1 p.2 < 1},
  have hc : ∀ i, is_complete (s i),
  { intro i,
    simp only [s, ← range_sigma_mk],
    exact (isometry_mk i).uniform_inducing.is_complete_range },
  have hd : ∀ i j (x ∈ s i) (y ∈ s j), (x, y) ∈ U → i = j,
    from λ i j x hx y hy hxy, (eq.symm hx).trans ((fst_eq_of_dist_lt_one _ _ hxy).trans hy),
  refine complete_space_of_is_complete_univ _,
  convert is_complete_Union_separated hc (dist_mem_uniformity zero_lt_one) hd,
  simp [s, ← preimage_Union]
end

end sigma

section gluing
/- Exact gluing of two metric spaces along isometric subsets. -/

variables {X : Type u} {Y : Type v} {Z : Type w}
variables [nonempty Z] [metric_space Z] [metric_space X] [metric_space Y]
          {Φ : Z → X} {Ψ : Z → Y} {ε : ℝ}
open _root_.sum (inl inr)
local attribute [instance] pseudo_metric.dist_setoid

/-- Given two isometric embeddings `Φ : Z → X` and `Ψ : Z → Y`, we define a pseudo metric space
structure on `X ⊕ Y` by declaring that `Φ x` and `Ψ x` are at distance `0`. -/
def glue_premetric (hΦ : isometry Φ) (hΨ : isometry Ψ) : pseudo_metric_space (X ⊕ Y) :=
{ dist          := glue_dist Φ Ψ 0,
  dist_self     := glue_dist_self Φ Ψ 0,
  dist_comm     := glue_dist_comm Φ Ψ 0,
  dist_triangle := glue_dist_triangle Φ Ψ 0 $ λp q, by rw [hΦ.dist_eq, hΨ.dist_eq]; simp }

/-- Given two isometric embeddings `Φ : Z → X` and `Ψ : Z → Y`, we define a
space  `glue_space hΦ hΨ` by identifying in `X ⊕ Y` the points `Φ x` and `Ψ x`. -/
def glue_space (hΦ : isometry Φ) (hΨ : isometry Ψ) : Type* :=
@pseudo_metric_quot _ (glue_premetric hΦ hΨ)

instance metric_space_glue_space (hΦ : isometry Φ) (hΨ : isometry Ψ) :
  metric_space (glue_space hΦ hΨ) :=
@metric_space_quot _ (glue_premetric hΦ hΨ)

/-- The canonical map from `X` to the space obtained by gluing isometric subsets in `X` and `Y`. -/
def to_glue_l (hΦ : isometry Φ) (hΨ : isometry Ψ) (x : X) : glue_space hΦ hΨ :=
by letI : pseudo_metric_space (X ⊕ Y) := glue_premetric hΦ hΨ; exact ⟦inl x⟧

/-- The canonical map from `Y` to the space obtained by gluing isometric subsets in `X` and `Y`. -/
def to_glue_r (hΦ : isometry Φ) (hΨ : isometry Ψ) (y : Y) : glue_space hΦ hΨ :=
by letI : pseudo_metric_space (X ⊕ Y) := glue_premetric hΦ hΨ; exact ⟦inr y⟧

instance inhabited_left (hΦ : isometry Φ) (hΨ : isometry Ψ) [inhabited X] :
  inhabited (glue_space hΦ hΨ) :=
⟨to_glue_l _ _ default⟩

instance inhabited_right (hΦ : isometry Φ) (hΨ : isometry Ψ) [inhabited Y] :
  inhabited (glue_space hΦ hΨ) :=
⟨to_glue_r _ _ default⟩

lemma to_glue_commute (hΦ : isometry Φ) (hΨ : isometry Ψ) :
  (to_glue_l hΦ hΨ) ∘ Φ = (to_glue_r hΦ hΨ) ∘ Ψ :=
begin
  letI : pseudo_metric_space (X ⊕ Y) := glue_premetric hΦ hΨ,
  funext,
  simp only [comp, to_glue_l, to_glue_r, quotient.eq],
  exact glue_dist_glued_points Φ Ψ 0 x
end

lemma to_glue_l_isometry (hΦ : isometry Φ) (hΨ : isometry Ψ) : isometry (to_glue_l hΦ hΨ) :=
isometry_emetric_iff_metric.2 $ λ_ _, rfl

lemma to_glue_r_isometry (hΦ : isometry Φ) (hΨ : isometry Ψ) : isometry (to_glue_r hΦ hΨ) :=
isometry_emetric_iff_metric.2 $ λ_ _, rfl

end gluing --section

section inductive_limit
/- In this section, we define the inductive limit of
     f 0        f 1        f 2        f 3
X 0 -----> X 1 -----> X 2 -----> X 3 -----> ...
where the X n are metric spaces and f n isometric embeddings. We do it by defining a premetric
space structure on Σ n, X n, where the predistance dist x y is obtained by pushing x and y in a
common X k using composition by the f n, and taking the distance there. This does not depend on
the choice of k as the f n are isometries. The metric space associated to this premetric space
is the desired inductive limit.-/
open nat

variables {X : ℕ → Type u} [∀ n, metric_space (X n)] {f : Π n, X n → X (n+1)}

/-- Predistance on the disjoint union `Σ n, X n`. -/
def inductive_limit_dist (f : Π n, X n → X (n+1)) (x y : Σ n, X n) : ℝ :=
dist (le_rec_on (le_max_left  x.1 y.1) f x.2 : X (max x.1 y.1))
     (le_rec_on (le_max_right x.1 y.1) f y.2 : X (max x.1 y.1))

/-- The predistance on the disjoint union `Σ n, X n` can be computed in any `X k` for large
enough `k`. -/
lemma inductive_limit_dist_eq_dist (I : ∀ n, isometry (f n))
  (x y : Σ n, X n) (m : ℕ) : ∀ hx : x.1 ≤ m, ∀ hy : y.1 ≤ m,
  inductive_limit_dist f x y = dist (le_rec_on hx f x.2 : X m) (le_rec_on hy f y.2 : X m) :=
begin
  induction m with m hm,
  { assume hx hy,
    have A : max x.1 y.1 = 0, { rw [nonpos_iff_eq_zero.1 hx, nonpos_iff_eq_zero.1 hy], simp },
    unfold inductive_limit_dist,
    congr; simp only [A] },
  { assume hx hy,
    by_cases h : max x.1 y.1 = m.succ,
    { unfold inductive_limit_dist,
      congr; simp only [h] },
    { have : max x.1 y.1 ≤ succ m := by simp [hx, hy],
      have : max x.1 y.1 ≤ m := by simpa [h] using of_le_succ this,
      have xm : x.1 ≤ m := le_trans (le_max_left _ _) this,
      have ym : y.1 ≤ m := le_trans (le_max_right _ _) this,
      rw [le_rec_on_succ xm, le_rec_on_succ ym, (I m).dist_eq],
      exact hm xm ym }}
end

/-- Premetric space structure on `Σ n, X n`.-/
def inductive_premetric (I : ∀ n, isometry (f n)) :
  pseudo_metric_space (Σ n, X n) :=
{ dist          := inductive_limit_dist f,
  dist_self     := λx, by simp [dist, inductive_limit_dist],
  dist_comm     := λx y, begin
    let m := max x.1 y.1,
    have hx : x.1 ≤ m := le_max_left _ _,
    have hy : y.1 ≤ m := le_max_right _ _,
    unfold dist,
    rw [inductive_limit_dist_eq_dist I x y m hx hy, inductive_limit_dist_eq_dist I y x m hy hx,
        dist_comm]
  end,
  dist_triangle := λx y z, begin
    let m := max (max x.1 y.1) z.1,
    have hx : x.1 ≤ m := le_trans (le_max_left _ _) (le_max_left _ _),
    have hy : y.1 ≤ m := le_trans (le_max_right _ _) (le_max_left _ _),
    have hz : z.1 ≤ m := le_max_right _ _,
    calc inductive_limit_dist f x z
      = dist (le_rec_on hx f x.2 : X m) (le_rec_on hz f z.2 : X m) :
        inductive_limit_dist_eq_dist I x z m hx hz
      ... ≤ dist (le_rec_on hx f x.2 : X m) (le_rec_on hy f y.2 : X m)
          + dist (le_rec_on hy f y.2 : X m) (le_rec_on hz f z.2 : X m) :
        dist_triangle _ _ _
      ... = inductive_limit_dist f x y + inductive_limit_dist f y z :
         by rw [inductive_limit_dist_eq_dist I x y m hx hy,
                inductive_limit_dist_eq_dist I y z m hy hz]
  end }

local attribute [instance] inductive_premetric pseudo_metric.dist_setoid

/-- The type giving the inductive limit in a metric space context. -/
def inductive_limit (I : ∀ n, isometry (f n)) : Type* :=
@pseudo_metric_quot _ (inductive_premetric I)

/-- Metric space structure on the inductive limit. -/
instance metric_space_inductive_limit (I : ∀ n, isometry (f n)) :
  metric_space (inductive_limit I) :=
@metric_space_quot _ (inductive_premetric I)

/-- Mapping each `X n` to the inductive limit. -/
def to_inductive_limit (I : ∀ n, isometry (f n)) (n : ℕ) (x : X n) : metric.inductive_limit I :=
by letI : pseudo_metric_space (Σ n, X n) := inductive_premetric I; exact ⟦sigma.mk n x⟧

instance (I : ∀ n, isometry (f n)) [inhabited (X 0)] : inhabited (inductive_limit I) :=
⟨to_inductive_limit _ 0 default⟩

/-- The map `to_inductive_limit n` mapping `X n` to the inductive limit is an isometry. -/
lemma to_inductive_limit_isometry (I : ∀ n, isometry (f n)) (n : ℕ) :
  isometry (to_inductive_limit I n) := isometry_emetric_iff_metric.2 $ λx y,
begin
  change inductive_limit_dist f ⟨n, x⟩ ⟨n, y⟩ = dist x y,
  rw [inductive_limit_dist_eq_dist I ⟨n, x⟩ ⟨n, y⟩ n (le_refl n) (le_refl n),
      le_rec_on_self, le_rec_on_self]
end

/-- The maps `to_inductive_limit n` are compatible with the maps `f n`. -/
lemma to_inductive_limit_commute (I : ∀ n, isometry (f n)) (n : ℕ) :
  (to_inductive_limit I n.succ) ∘ (f n) = to_inductive_limit I n :=
begin
  funext,
  simp only [comp, to_inductive_limit, quotient.eq],
  show inductive_limit_dist f ⟨n.succ, f n x⟩ ⟨n, x⟩ = 0,
  { rw [inductive_limit_dist_eq_dist I ⟨n.succ, f n x⟩ ⟨n, x⟩ n.succ,
        le_rec_on_self, le_rec_on_succ, le_rec_on_self, dist_self],
    exact le_rfl,
    exact le_rfl,
    exact le_succ _ }
end

end inductive_limit --section
end metric --namespace


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Ashvni Narayanan
-/
import field_theory.ratfunc
import ring_theory.algebraic
import ring_theory.dedekind_domain.integral_closure
import ring_theory.integrally_closed
import topology.algebra.valued_field

/-!
# Function fields

This file defines a function field and the ring of integers corresponding to it.

## Main definitions
 - `function_field Fq F` states that `F` is a function field over the (finite) field `Fq`,
   i.e. it is a finite extension of the field of rational functions in one variable over `Fq`.
 - `function_field.ring_of_integers` defines the ring of integers corresponding to a function field
    as the integral closure of `polynomial Fq` in the function field.
 - `function_field.infty_valuation` : The place at infinity on `Fq(t)` is the nonarchimedean
    valuation on `Fq(t)` with uniformizer `1/t`.
 -  `function_field.Fqt_infty` : The completion `Fq((t⁻¹))`  of `Fq(t)` with respect to the
    valuation at infinity.

## Implementation notes
The definitions that involve a field of fractions choose a canonical field of fractions,
but are independent of that choice. We also omit assumptions like `finite Fq` or
`is_scalar_tower Fq[X] (fraction_ring Fq[X]) F` in definitions,
adding them back in lemmas when they are needed.

## References
* [D. Marcus, *Number Fields*][marcus1977number]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [P. Samuel, *Algebraic Theory of Numbers*][samuel1970algebraic]

## Tags
function field, ring of integers
-/

noncomputable theory
open_locale non_zero_divisors polynomial

variables (Fq F : Type) [field Fq] [field F]

/-- `F` is a function field over the finite field `Fq` if it is a finite
extension of the field of rational functions in one variable over `Fq`.

Note that `F` can be a function field over multiple, non-isomorphic, `Fq`.
-/
abbreviation function_field [algebra (ratfunc Fq) F] : Prop :=
finite_dimensional (ratfunc Fq) F

/-- `F` is a function field over `Fq` iff it is a finite extension of `Fq(t)`. -/
protected lemma function_field_iff (Fqt : Type*) [field Fqt]
  [algebra Fq[X] Fqt] [is_fraction_ring Fq[X] Fqt]
  [algebra (ratfunc Fq) F] [algebra Fqt F]
  [algebra Fq[X] F] [is_scalar_tower Fq[X] Fqt F]
  [is_scalar_tower Fq[X] (ratfunc Fq) F] :
  function_field Fq F ↔ finite_dimensional Fqt F :=
begin
  let e := is_localization.alg_equiv Fq[X]⁰ (ratfunc Fq) Fqt,
  have : ∀ c (x : F), e c • x = c • x,
  { intros c x,
    rw [algebra.smul_def, algebra.smul_def],
    congr,
    refine congr_fun _ c,
    refine is_localization.ext (non_zero_divisors (Fq[X])) _ _ _ _ _ _ _;
      intros; simp only [alg_equiv.map_one, ring_hom.map_one, alg_equiv.map_mul, ring_hom.map_mul,
                         alg_equiv.commutes, ← is_scalar_tower.algebra_map_apply], },
  split; intro h; resetI,
  { let b := finite_dimensional.fin_basis (ratfunc Fq) F,
    exact finite_dimensional.of_fintype_basis (b.map_coeffs e this) },
  { let b := finite_dimensional.fin_basis Fqt F,
    refine finite_dimensional.of_fintype_basis (b.map_coeffs e.symm _),
    intros c x, convert (this (e.symm c) x).symm, simp only [e.apply_symm_apply] },
end

lemma algebra_map_injective [algebra Fq[X] F] [algebra (ratfunc Fq) F]
  [is_scalar_tower Fq[X] (ratfunc Fq) F] : function.injective ⇑(algebra_map Fq[X] F) :=
begin
  rw is_scalar_tower.algebra_map_eq Fq[X] (ratfunc Fq) F,
  exact function.injective.comp ((algebra_map (ratfunc Fq) F).injective)
    (is_fraction_ring.injective Fq[X] (ratfunc Fq)),
end

namespace function_field

/-- The function field analogue of `number_field.ring_of_integers`:
`function_field.ring_of_integers Fq Fqt F` is the integral closure of `Fq[t]` in `F`.

We don't actually assume `F` is a function field over `Fq` in the definition,
only when proving its properties.
-/
def ring_of_integers [algebra Fq[X] F] := integral_closure Fq[X] F

namespace ring_of_integers

variables [algebra Fq[X] F]

instance : is_domain (ring_of_integers Fq F) :=
(ring_of_integers Fq F).is_domain

instance : is_integral_closure (ring_of_integers Fq F) Fq[X] F :=
integral_closure.is_integral_closure _ _

variables [algebra (ratfunc Fq) F] [is_scalar_tower Fq[X] (ratfunc Fq) F]

lemma algebra_map_injective :
  function.injective ⇑(algebra_map Fq[X] (ring_of_integers Fq F)) :=
begin
  have hinj : function.injective ⇑(algebra_map Fq[X] F),
  { rw is_scalar_tower.algebra_map_eq Fq[X] (ratfunc Fq) F,
    exact function.injective.comp ((algebra_map (ratfunc Fq) F).injective)
      (is_fraction_ring.injective Fq[X] (ratfunc Fq)), },
  rw injective_iff_map_eq_zero (algebra_map Fq[X] ↥(ring_of_integers Fq F)),
  intros p hp,
  rw [← subtype.coe_inj, subalgebra.coe_zero] at hp,
  rw injective_iff_map_eq_zero (algebra_map Fq[X] F) at hinj,
  exact hinj p hp,
end

lemma not_is_field : ¬ is_field (ring_of_integers Fq F) :=
by simpa [← (is_integral.is_field_iff_is_field (is_integral_closure.is_integral_algebra Fq[X] F)
  (algebra_map_injective Fq F))] using (polynomial.not_is_field Fq)

variables [function_field Fq F]

instance : is_fraction_ring (ring_of_integers Fq F) F :=
integral_closure.is_fraction_ring_of_finite_extension (ratfunc Fq) F

instance : is_integrally_closed (ring_of_integers Fq F) :=
integral_closure.is_integrally_closed_of_finite_extension (ratfunc Fq)

instance [is_separable (ratfunc Fq) F] :
  is_dedekind_domain (ring_of_integers Fq F) :=
is_integral_closure.is_dedekind_domain Fq[X] (ratfunc Fq) F _

end ring_of_integers

/-! ### The place at infinity on Fq(t) -/

section infty_valuation

variable [decidable_eq (ratfunc Fq)]

/-- The valuation at infinity is the nonarchimedean valuation on `Fq(t)` with uniformizer `1/t`.
Explicitly, if `f/g ∈ Fq(t)` is a nonzero quotient of polynomials, its valuation at infinity is
`multiplicative.of_add(degree(f) - degree(g))`. -/
def infty_valuation_def (r : ratfunc Fq) : with_zero (multiplicative ℤ) :=
if r = 0 then 0 else (multiplicative.of_add r.int_degree)

lemma infty_valuation.map_zero' : infty_valuation_def Fq 0 = 0 := if_pos rfl

lemma infty_valuation.map_one' : infty_valuation_def Fq 1 = 1 :=
(if_neg one_ne_zero).trans $
  by rw [ratfunc.int_degree_one, of_add_zero, with_zero.coe_one]

lemma infty_valuation.map_mul' (x y : ratfunc Fq) :
  infty_valuation_def Fq (x * y) = infty_valuation_def Fq x * infty_valuation_def Fq y :=
begin
  rw [infty_valuation_def, infty_valuation_def, infty_valuation_def],
  by_cases hx : x = 0,
  { rw [hx, zero_mul, if_pos (eq.refl _), zero_mul] },
  { by_cases hy : y = 0,
    { rw [hy, mul_zero, if_pos (eq.refl _), mul_zero] },
    { rw [if_neg hx, if_neg hy, if_neg (mul_ne_zero hx hy), ← with_zero.coe_mul,
        with_zero.coe_inj, ← of_add_add, ratfunc.int_degree_mul hx hy], }}
end

lemma infty_valuation.map_add_le_max' (x y : ratfunc Fq) :
  infty_valuation_def Fq (x + y) ≤ max (infty_valuation_def Fq x) (infty_valuation_def Fq y) :=
begin
  by_cases hx : x = 0,
  { rw [hx, zero_add],
    conv_rhs { rw [infty_valuation_def, if_pos (eq.refl _)] },
    rw max_eq_right (with_zero.zero_le (infty_valuation_def Fq y)),
    exact le_refl _ },
  { by_cases hy : y = 0,
    { rw [hy, add_zero],
      conv_rhs { rw [max_comm, infty_valuation_def, if_pos (eq.refl _)] },
      rw max_eq_right (with_zero.zero_le (infty_valuation_def Fq x)),
      exact le_refl _ },
    { by_cases hxy : x + y = 0,
      { rw [infty_valuation_def, if_pos hxy], exact zero_le',},
      { rw [infty_valuation_def, infty_valuation_def, infty_valuation_def, if_neg hx, if_neg hy,
        if_neg hxy],
        rw [le_max_iff,
        with_zero.coe_le_coe, multiplicative.of_add_le, with_zero.coe_le_coe,
        multiplicative.of_add_le, ← le_max_iff],
        exact ratfunc.int_degree_add_le hy hxy }}}
end

@[simp] lemma infty_valuation_of_nonzero {x : ratfunc Fq} (hx : x ≠ 0) :
  infty_valuation_def Fq x = (multiplicative.of_add x.int_degree) :=
by rw [infty_valuation_def, if_neg hx]

/-- The valuation at infinity on `Fq(t)`. -/
def infty_valuation  : valuation (ratfunc Fq) (with_zero (multiplicative ℤ)) :=
{ to_fun          := infty_valuation_def Fq,
  map_zero'       := infty_valuation.map_zero' Fq,
  map_one'        := infty_valuation.map_one' Fq,
  map_mul'        := infty_valuation.map_mul' Fq,
  map_add_le_max' := infty_valuation.map_add_le_max' Fq }

@[simp] lemma infty_valuation_apply {x : ratfunc Fq} :
  infty_valuation Fq x = infty_valuation_def Fq x := rfl

@[simp] lemma infty_valuation.C {k : Fq} (hk : k ≠ 0) :
  infty_valuation_def Fq (ratfunc.C k) = (multiplicative.of_add (0 : ℤ)) :=
begin
  have hCk : ratfunc.C k ≠ 0 := (ring_hom.map_ne_zero _).mpr hk,
  rw [infty_valuation_def, if_neg hCk, ratfunc.int_degree_C],
end

@[simp] lemma infty_valuation.X :
  infty_valuation_def Fq (ratfunc.X) = (multiplicative.of_add (1 : ℤ)) :=
by rw [infty_valuation_def, if_neg ratfunc.X_ne_zero, ratfunc.int_degree_X]

@[simp] lemma infty_valuation.polynomial {p : polynomial Fq} (hp : p ≠ 0) :
  infty_valuation_def Fq (algebra_map (polynomial Fq) (ratfunc Fq) p) =
    (multiplicative.of_add (p.nat_degree : ℤ)) :=
begin
  have hp' : algebra_map (polynomial Fq) (ratfunc Fq) p ≠ 0,
  { rw [ne.def, ratfunc.algebra_map_eq_zero_iff], exact hp },
  rw [infty_valuation_def, if_neg hp', ratfunc.int_degree_polynomial]
end

/-- The valued field `Fq(t)` with the valuation at infinity. -/
def infty_valued_Fqt : valued (ratfunc Fq) (with_zero (multiplicative ℤ)) :=
valued.mk' $ infty_valuation Fq

lemma infty_valued_Fqt.def {x : ratfunc Fq} :
  @valued.v (ratfunc Fq) _ _ _ (infty_valued_Fqt Fq) x = infty_valuation_def Fq x := rfl

/-- The completion `Fq((t⁻¹))`  of `Fq(t)` with respect to the valuation at infinity. -/
def Fqt_infty := @uniform_space.completion (ratfunc Fq) $ (infty_valued_Fqt Fq).to_uniform_space

instance : field (Fqt_infty Fq) :=
begin
  letI := infty_valued_Fqt Fq,
  exact field_completion,
end

instance : inhabited (Fqt_infty Fq) := ⟨(0 : Fqt_infty Fq)⟩

/-- The valuation at infinity on `k(t)` extends to a valuation on `Fqt_infty`. -/
instance valued_Fqt_infty : valued (Fqt_infty Fq) (with_zero (multiplicative ℤ)) :=
@valued.valued_completion _ _ _ _ (infty_valued_Fqt Fq)

lemma valued_Fqt_infty.def {x : Fqt_infty Fq} :
  valued.v x = @valued.extension (ratfunc Fq) _ _ _ (infty_valued_Fqt Fq) x := rfl

end infty_valuation

end function_field


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_182
  (y : ℂ) :
  7 * (3 * y + 2) = 21 * y + 14 :=
begin
  ring_nf,
end


/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Lu-Ming Zhang.
-/
import tactic
import data.finset.basic
import data.fintype.card

/-!
This file supplements things about `set`, `finset`, `fintype`, that are current missing in mathlib.

## Main definition

- `set.card`: given a set `S : set I`, `S.card` is a shortcut of `S.to_finset.card`,
  under the conditions `[decidable_pred (λ (x : I), x ∈ S)] [fintype ↥S]`.
-/

local attribute [instance] set_fintype

open_locale big_operators

namespace set

variables {I : Type*} (S T U : set I)

lemma union_compl : S ∪ set.compl S = @set.univ I := by ext; simp

lemma union_compl' : S ∪ (λ x, ¬ (S x)) = @set.univ I :=
by {ext, simp, exact em (S x)}

@[simp] lemma inter_eq_empty_of_compl : S ∩ S.compl = ∅ := by simp

@[simp] lemma inter_eq_empty_of_compl' : S ∩ (λ x, ¬ (S x)) = ∅ := by {ext, simp, tauto}

lemma disjoint_of_compl: disjoint S S.compl := by simp [set.disjoint_iff_inter_eq_empty]

lemma disjoint_of_compl': disjoint S (λ x, ¬ (S x)) := by simp [set.disjoint_iff_inter_eq_empty]

/-- Given a set `S : set I`, `S.card` is a shortcut of `S.to_finset.card`. -/
def card [decidable_pred (λ (x : I), x ∈ S)] [fintype ↥S] : ℕ := S.to_finset.card

lemma univ_card_eq_fintype_card [fintype I] : (@set.univ I).card = fintype.card I :=
by simp [card, fintype.card]

@[simp] lemma coe_union_to_finset
[decidable_eq I] [fintype ↥S] [fintype ↥T] :
↑(S.to_finset ∪ T.to_finset) = S ∪ T :=
by ext; simp

instance union_decidable (x : I)
[decidable_pred (λ (x : I), x ∈ S)] [decidable_pred (λ (x : I), x ∈ T)] :
decidable (x ∈ (S ∪ T)) :=
by {simp [set.mem_union x S T], exact or.decidable}

instance union_decidable_pred
[decidable_pred (λ (x : I), x ∈ S)] [decidable_pred (λ (x : I), x ∈ T)] :
decidable_pred (λ (x : I), x ∈ (S ∪ T)) :=
infer_instance

variables {S T U}

lemma to_finset_union_eq_iff [decidable_eq I]
[fintype ↥S] [fintype ↥T] [fintype ↥U] :
S.to_finset ∪ T.to_finset = U.to_finset ↔ S ∪ T = U :=
by simp [←to_finset_union, set.to_finset_inj]

lemma card_disjoint_union [decidable_eq I]
[decidable_pred (λ (x : I), x ∈ S)] [fintype ↥S]
[decidable_pred (λ (x : I), x ∈ T)] [fintype ↥T]
(h : disjoint S T):
(S ∪ T).card = S.card + T.card :=
begin
  have h' := to_finset_disjoint_iff.2 h,
  dsimp [card],
  rw [← finset.card_disjoint_union h', to_finset_union],
end

lemma card_disjoint_union' [decidable_eq I]
[decidable_pred (λ (x : I), x ∈ S)] [fintype ↥S]
[decidable_pred (λ (x : I), x ∈ T)] [fintype ↥T]
[decidable_pred (λ (x : I), x ∈ U)] [fintype ↥U]
(d : disjoint S T) (u : S ∪ T = U) :
(U).card = S.card + T.card :=
begin
  rw ← card_disjoint_union d,
  congr,
  rw u,
end

end set

variables {α β I : Type*} [comm_monoid β] [fintype I]

open fintype finset

lemma finset.univ_eq_set_univ_to_finset : -- DO NOT use in simp!!!
finset.univ = (@set.univ I).to_finset := set.to_finset_univ.symm

lemma fintype.card_eq_finset_card_of_set (S : set α)
[fintype ↥S] [decidable_pred (λ (x : α), x ∈ S)]:
fintype.card S = finset.card (set.to_finset S) :=
by simp only [set.to_finset_card]

variable (I)
lemma fintype.card_eq_finset_card_of_univ :
fintype.card I = finset.card (@finset.univ I _):=
by simp only [fintype.card]

lemma fintype.card_eq_set_card_of_univ :
fintype.card I = (@set.univ I).card :=
by simp [set.card, fintype.card]

variable {I}

lemma finset.card_eq_sum_ones_ℚ {s : finset α}: (s.card : ℚ) = ∑ _ in s, 1 :=
by rw (finset.card_eq_sum_ones s); simp

@[to_additive]
lemma finset.prod_union' [decidable_eq α] {s₁ s₂ s : finset α} {f : α → β}
(d : disjoint s₁ s₂) (u : s₁ ∪ s₂ = s):
(∏ x in s, f x) = (∏ x in s₁, f x) * (∏ x in s₂, f x) :=
by simp [*, ← finset.prod_union]

@[to_additive]
lemma set.prod_union' [decidable_eq α] {S T U : set α} {f : α → β}
[fintype ↥S] [fintype ↥T] [fintype ↥U]
(d : disjoint S T) (u : S ∪ T = U):
(∏ x in U.to_finset, f x) =
(∏ x in S.to_finset, f x) *
(∏ x in T.to_finset, f x) :=
begin
  have d' := set.to_finset_disjoint_iff.2 d,
  have u' := set.to_finset_union_eq_iff.2 u,
  rw ← finset.prod_union' d' u',
end

lemma finset.card_erase_of_mem' [decidable_eq α] {a : α} {s : finset α} :
  a ∈ s →  finset.card s = finset.card (finset.erase s a) + 1:=
begin
  intro ha,
  have h:= finset.card_pos.mpr ⟨a, ha⟩,
  simp [finset.card_erase_of_mem ha, *],
  exact (nat.succ_pred_eq_of_pos h).symm
end

attribute [to_additive] fintype.prod_dite

lemma fintype.sum_split {α} {β} [fintype α] [add_comm_monoid β]
{f : α → β} (p : α → Prop) [decidable_pred p] :
  ∑ j, f j =
  ∑ j : {j : α // p j}, f j +
  ∑ j : {j : α //¬ p j}, f j :=
by simp [←fintype.sum_dite (λ a _, f a) (λ a _, f a)]

lemma fintype.sum_split' {α} {β} [fintype α] [add_comm_monoid β]
{f : α → β} (p q : α → Prop) [decidable_pred p] [decidable_pred q] :
  ∑ j : {j : α // p j}, f j =
  ∑ j : {j : α // p j ∧ q j}, f j +
  ∑ j : {j : α // p j ∧ ¬ q j}, f j :=
begin
  set q': (subtype p) → Prop := λ a, q (a.1),
  simp [fintype.sum_split q'],
  suffices h₁ : ∑ (j : {j // q' j}), f j = ∑ (j : {j // p j ∧ q j}), f j,
  suffices h₂ : ∑ (j : {j // ¬q' j}), f j = ∑ (j : {j // p j ∧ ¬q j}), f j,
  simp [←h₁, ←h₂],
  set g : {j // ¬q' j} → {j // p j ∧ ¬q j} := λ a, ⟨a.1.1, by tidy⟩,
  swap 2,
  set g : {j // q' j} → {j // p j ∧ q j} := λ a, ⟨a.1.1, by tidy⟩,
  any_goals
  { have hg : function.bijective g :=
      ⟨λ a b hab, by tidy, λ a, by tidy⟩,
    convert function.bijective.sum_comp hg _,
    ext, congr' 1 },
end

lemma fintype.card_split {α} [fintype α]
(p : α → Prop) [decidable_pred p] :
  fintype.card α =
  fintype.card {j : α // p j} +
  fintype.card {j : α // ¬ p j} :=
by simp only [fintype.card_eq_sum_ones, fintype.sum_split p]

lemma fintype.card_split' {α} [fintype α]
(p q : α → Prop) [decidable_pred p] [decidable_pred q]:
  fintype.card {j : α // p j} =
  fintype.card {j : α // p j ∧ q j} +
  fintype.card {j : α // p j ∧ ¬ q j} :=
begin
  have eq:= @fintype.sum_split' _ _ _ _ (λ _, 1) p q _ _,
  simp[*, fintype.card_eq_sum_ones] at *,
end

lemma finset.sum_split {α} {β} [add_comm_monoid β]
(s : finset α) {f : α → β} (p : α → Prop) [decidable_pred p] :
  ∑ j in s, f j =
  ∑ j in filter p s, f j +
  ∑ j in filter (λ (x : α), ¬p x) s, f j :=
by simp [←finset.sum_ite (λ j, f j) (λ j, f j)]

@[simp]
lemma finset.sum_filter_one {β} [add_comm_monoid β] [decidable_eq I]
(i : I) {f : I → β}:
∑ (x : I) in filter (λ (x : I), x = i) univ, f x = f i :=
begin
  simp [finset.filter_eq'],
end

@[simp]
lemma finset.sum_filter_two {β} [add_comm_monoid β] [decidable_eq I]
{i j : I} (h : i ≠ j) {f : I → β}:
∑ (k : I) in filter (λ (k : I), k = i ∨ k = j) univ, f k = f i + f j  :=
begin
  rw [finset.sum_split _ (λ k, k = i)],
  simp [finset.filter_eq', finset.filter_ne'],
  have : ∑ (x : I) in (filter (λ (k : I), k = i ∨ k = j) univ).erase i, f x
       = ∑ (x : I) in filter (λ (x : I), x = j) univ, f x,
  { apply finset.sum_congr,
    { ext, simp, split,
      { rintros ⟨h₁, (h₂ | h₂)⟩, contradiction, assumption },
      { rintros rfl, use ⟨h.symm, or.inr rfl⟩ } },
    { rintros, refl } },
  simp [this],
end


axiom q : Nat → Prop
axiom p : Nat → Prop
axiom q_eq_p : q = p

example (h₁ : ¬ q 0) (h₂ : ¬ q 0) : ¬ p 0 := by
  trace_state
  /-
     h₁ : ¬ q 0
     h₂ : ¬ q 0
     ⊢ ¬ p 0
  -/
  simp_all
  /-
     h₂ : ¬ q 0
     ⊢ ¬ p 0
  -/
  trace_state
  rw [← q_eq_p]
  assumption


/-
Copyright (c) 2017 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johannes Hölzl, Chris Hughes, Jens Wagemaker
-/
import algebra.group.basic
import logic.nontrivial

/-!
# Units (i.e., invertible elements) of a monoid

An element of a `monoid` is a unit if it has a two-sided inverse.

## Main declarations

* `units M`: the group of units (i.e., invertible elements) of a monoid.
* `is_unit x`: a predicate asserting that `x` is a unit (i.e., invertible element) of a monoid.

For both declarations, there is an additive counterpart: `add_units` and `is_add_unit`.

## Notation

We provide `Mˣ` as notation for `units M`,
resembling the notation $R^{\times}$ for the units of a ring, which is common in mathematics.

-/

universe u
variable {α : Type u}

/-- Units of a `monoid`, bundled version. Notation: `αˣ`.

An element of a `monoid` is a unit if it has a two-sided inverse.
This version bundles the inverse element so that it can be computed.
For a predicate see `is_unit`. -/
structure units (α : Type u) [monoid α] :=
(val : α)
(inv : α)
(val_inv : val * inv = 1)
(inv_val : inv * val = 1)

postfix `ˣ`:1025 := units
-- We don't provide notation for the additive version, because its use is somewhat rare.

/-- Units of an `add_monoid`, bundled version.

An element of an `add_monoid` is a unit if it has a two-sided additive inverse.
This version bundles the inverse element so that it can be computed.
For a predicate see `is_add_unit`. -/
structure add_units (α : Type u) [add_monoid α] :=
(val : α)
(neg : α)
(val_neg : val + neg = 0)
(neg_val : neg + val = 0)

attribute [to_additive add_units] units

section has_elem

@[to_additive] lemma unique_has_one {α : Type*} [unique α] [has_one α] :
  default = (1 : α) :=
unique.default_eq 1

end has_elem

namespace units

variables [monoid α]

@[to_additive] instance : has_coe αˣ α := ⟨val⟩

@[to_additive] instance : has_inv αˣ := ⟨λ u, ⟨u.2, u.1, u.4, u.3⟩⟩

/-- See Note [custom simps projection] -/
@[to_additive /-" See Note [custom simps projection] "-/]
def simps.coe (u : αˣ) : α := u

/-- See Note [custom simps projection] -/
@[to_additive /-" See Note [custom simps projection] "-/]
def simps.coe_inv (u : αˣ) : α := ↑(u⁻¹)

initialize_simps_projections units (val → coe as_prefix, inv → coe_inv as_prefix)
initialize_simps_projections add_units (val → coe as_prefix, neg → coe_neg as_prefix)

@[simp, to_additive] lemma coe_mk (a : α) (b h₁ h₂) : ↑(units.mk a b h₁ h₂) = a := rfl

@[ext, to_additive] theorem ext :
  function.injective (coe : αˣ → α)
| ⟨v, i₁, vi₁, iv₁⟩ ⟨v', i₂, vi₂, iv₂⟩ e :=
  by change v = v' at e; subst v'; congr;
      simpa only [iv₂, vi₁, one_mul, mul_one] using mul_assoc i₂ v i₁

@[norm_cast, to_additive] theorem eq_iff {a b : αˣ} :
  (a : α) = b ↔ a = b := ext.eq_iff

@[to_additive] theorem ext_iff {a b : αˣ} :
  a = b ↔ (a : α) = b := eq_iff.symm

@[to_additive] instance [decidable_eq α] : decidable_eq αˣ :=
λ a b, decidable_of_iff' _ ext_iff

@[simp, to_additive] theorem mk_coe (u : αˣ) (y h₁ h₂) :
  mk (u : α) y h₁ h₂ = u :=
ext rfl

/-- Copy a unit, adjusting definition equalities. -/
@[to_additive /-"Copy an `add_unit`, adjusting definitional equalities."-/, simps]
def copy (u : αˣ) (val : α) (hv : val = u) (inv : α) (hi : inv = ↑(u⁻¹)) : αˣ :=
{ val := val, inv := inv,
  inv_val := hv.symm ▸ hi.symm ▸ u.inv_val, val_inv := hv.symm ▸ hi.symm ▸ u.val_inv }

@[to_additive]
lemma copy_eq (u : αˣ) (val hv inv hi) :
  u.copy val hv inv hi = u :=
ext hv

/-- Units of a monoid form a group. -/
@[to_additive] instance : group αˣ :=
{ mul := λ u₁ u₂, ⟨u₁.val * u₂.val, u₂.inv * u₁.inv,
    by rw [mul_assoc, ← mul_assoc u₂.val, val_inv, one_mul, val_inv],
    by rw [mul_assoc, ← mul_assoc u₁.inv, inv_val, one_mul, inv_val]⟩,
  one := ⟨1, 1, one_mul 1, one_mul 1⟩,
  mul_one := λ u, ext $ mul_one u,
  one_mul := λ u, ext $ one_mul u,
  mul_assoc := λ u₁ u₂ u₃, ext $ mul_assoc u₁ u₂ u₃,
  inv := has_inv.inv,
  mul_left_inv := λ u, ext u.inv_val }

variables (a b : αˣ) {c : αˣ}
@[simp, norm_cast, to_additive] lemma coe_mul : (↑(a * b) : α) = a * b := rfl

@[simp, norm_cast, to_additive] lemma coe_one : ((1 : αˣ) : α) = 1 := rfl

@[simp, norm_cast, to_additive] lemma coe_eq_one {a : αˣ} : (a : α) = 1 ↔ a = 1 :=
by rw [←units.coe_one, eq_iff]

@[simp, to_additive] lemma inv_mk (x y : α) (h₁ h₂) : (mk x y h₁ h₂)⁻¹ = mk y x h₂ h₁ := rfl

@[simp, to_additive] lemma val_eq_coe : a.val = (↑a : α) := rfl

@[simp, to_additive] lemma inv_eq_coe_inv : a.inv = ((a⁻¹ : αˣ) : α) := rfl

@[simp, to_additive] lemma inv_mul : (↑a⁻¹ * a : α) = 1 := inv_val _
@[simp, to_additive] lemma mul_inv : (a * ↑a⁻¹ : α) = 1 := val_inv _

@[to_additive] lemma inv_mul_of_eq {u : αˣ} {a : α} (h : ↑u = a) : ↑u⁻¹ * a = 1 :=
by { rw [←h, u.inv_mul], }

@[to_additive] lemma mul_inv_of_eq {u : αˣ} {a : α} (h : ↑u = a) : a * ↑u⁻¹ = 1 :=
by { rw [←h, u.mul_inv], }

@[simp, to_additive] lemma mul_inv_cancel_left (a : αˣ) (b : α) : (a:α) * (↑a⁻¹ * b) = b :=
by rw [← mul_assoc, mul_inv, one_mul]

@[simp, to_additive] lemma inv_mul_cancel_left (a : αˣ) (b : α) : (↑a⁻¹:α) * (a * b) = b :=
by rw [← mul_assoc, inv_mul, one_mul]

@[simp, to_additive] lemma mul_inv_cancel_right (a : α) (b : αˣ) : a * b * ↑b⁻¹ = a :=
by rw [mul_assoc, mul_inv, mul_one]

@[simp, to_additive] lemma inv_mul_cancel_right (a : α) (b : αˣ) : a * ↑b⁻¹ * b = a :=
by rw [mul_assoc, inv_mul, mul_one]

@[to_additive] instance : inhabited αˣ := ⟨1⟩

@[to_additive] instance {α} [comm_monoid α] : comm_group αˣ :=
{ mul_comm := λ u₁ u₂, ext $ mul_comm _ _, ..units.group }

@[to_additive] instance [has_repr α] : has_repr αˣ := ⟨repr ∘ val⟩

@[simp, to_additive] theorem mul_right_inj (a : αˣ) {b c : α} : (a:α) * b = a * c ↔ b = c :=
⟨λ h, by simpa only [inv_mul_cancel_left] using congr_arg ((*) ↑(a⁻¹ : αˣ)) h, congr_arg _⟩

@[simp, to_additive] theorem mul_left_inj (a : αˣ) {b c : α} : b * a = c * a ↔ b = c :=
⟨λ h, by simpa only [mul_inv_cancel_right] using congr_arg (* ↑(a⁻¹ : αˣ)) h, congr_arg _⟩

@[to_additive] theorem eq_mul_inv_iff_mul_eq {a b : α} : a = b * ↑c⁻¹ ↔ a * c = b :=
⟨λ h, by rw [h, inv_mul_cancel_right], λ h, by rw [← h, mul_inv_cancel_right]⟩

@[to_additive] theorem eq_inv_mul_iff_mul_eq {a c : α} : a = ↑b⁻¹ * c ↔ ↑b * a = c :=
⟨λ h, by rw [h, mul_inv_cancel_left], λ h, by rw [← h, inv_mul_cancel_left]⟩

@[to_additive] theorem inv_mul_eq_iff_eq_mul {b c : α} : ↑a⁻¹ * b = c ↔ b = a * c :=
⟨λ h, by rw [← h, mul_inv_cancel_left], λ h, by rw [h, inv_mul_cancel_left]⟩

@[to_additive]

lemma inv_eq_of_mul_eq_one {u : αˣ} {a : α} (h : ↑u * a = 1) : ↑u⁻¹ = a :=
calc ↑u⁻¹ = ↑u⁻¹ * 1 : by rw mul_one
      ... = ↑u⁻¹ * ↑u * a : by rw [←h, ←mul_assoc]
      ... = a : by rw [u.inv_mul, one_mul]

lemma inv_unique {u₁ u₂ : αˣ} (h : (↑u₁ : α) = ↑u₂) : (↑u₁⁻¹ : α) = ↑u₂⁻¹ :=
inv_eq_of_mul_eq_one $ by rw [h, u₂.mul_inv]

end units

/-- For `a, b` in a `comm_monoid` such that `a * b = 1`, makes a unit out of `a`. -/
@[to_additive "For `a, b` in an `add_comm_monoid` such that `a + b = 0`, makes an add_unit
out of `a`."]
def units.mk_of_mul_eq_one [comm_monoid α] (a b : α) (hab : a * b = 1) :
  αˣ :=
⟨a, b, hab, (mul_comm b a).trans hab⟩

@[simp, to_additive] lemma units.coe_mk_of_mul_eq_one [comm_monoid α] {a b : α} (h : a * b = 1) :
  (units.mk_of_mul_eq_one a b h : α) = a := rfl

section monoid
variables [monoid α] {a b c : α}

/-- Partial division. It is defined when the
  second argument is invertible, and unlike the division operator
  in `division_ring` it is not totalized at zero. -/
def divp (a : α) (u) : α := a * (u⁻¹ : αˣ)

infix ` /ₚ `:70 := divp

@[simp] theorem divp_self (u : αˣ) : (u : α) /ₚ u = 1 := units.mul_inv _

@[simp] theorem divp_one (a : α) : a /ₚ 1 = a := mul_one _

theorem divp_assoc (a b : α) (u : αˣ) : a * b /ₚ u = a * (b /ₚ u) :=
mul_assoc _ _ _

@[simp] theorem divp_inv (u : αˣ) : a /ₚ u⁻¹ = a * u := rfl

@[simp] theorem divp_mul_cancel (a : α) (u : αˣ) : a /ₚ u * u = a :=
(mul_assoc _ _ _).trans $ by rw [units.inv_mul, mul_one]

@[simp] theorem mul_divp_cancel (a : α) (u : αˣ) : (a * u) /ₚ u = a :=
(mul_assoc _ _ _).trans $ by rw [units.mul_inv, mul_one]

@[simp] theorem divp_left_inj (u : αˣ) {a b : α} : a /ₚ u = b /ₚ u ↔ a = b :=
units.mul_left_inj _

theorem divp_divp_eq_divp_mul (x : α) (u₁ u₂ : αˣ) : (x /ₚ u₁) /ₚ u₂ = x /ₚ (u₂ * u₁) :=
by simp only [divp, mul_inv_rev, units.coe_mul, mul_assoc]

theorem divp_eq_iff_mul_eq {x : α} {u : αˣ} {y : α} : x /ₚ u = y ↔ y * u = x :=
u.mul_left_inj.symm.trans $ by rw [divp_mul_cancel]; exact ⟨eq.symm, eq.symm⟩

theorem divp_eq_one_iff_eq {a : α} {u : αˣ} : a /ₚ u = 1 ↔ a = u :=
(units.mul_left_inj u).symm.trans $ by rw [divp_mul_cancel, one_mul]

@[simp] theorem one_divp (u : αˣ) : 1 /ₚ u = ↑u⁻¹ :=
one_mul _

end monoid

section comm_monoid

variables [comm_monoid α]

theorem divp_eq_divp_iff {x y : α} {ux uy : αˣ} :
  x /ₚ ux = y /ₚ uy ↔ x * uy = y * ux :=
by rw [divp_eq_iff_mul_eq, mul_comm, ← divp_assoc, divp_eq_iff_mul_eq, mul_comm y ux]

theorem divp_mul_divp (x y : α) (ux uy : αˣ) :
  (x /ₚ ux) * (y /ₚ uy) = (x * y) /ₚ (ux * uy) :=
by rw [← divp_divp_eq_divp_mul, divp_assoc, mul_comm x, divp_assoc, mul_comm]

end comm_monoid

/-!
# `is_unit` predicate

In this file we define the `is_unit` predicate on a `monoid`, and
prove a few basic properties. For the bundled version see `units`. See
also `prime`, `associated`, and `irreducible` in `algebra/associated`.

-/

section is_unit

variables {M : Type*} {N : Type*}

/-- An element `a : M` of a monoid is a unit if it has a two-sided inverse.
The actual definition says that `a` is equal to some `u : Mˣ`, where
`Mˣ` is a bundled version of `is_unit`. -/
@[to_additive is_add_unit "An element `a : M` of an add_monoid is an `add_unit` if it has
a two-sided additive inverse. The actual definition says that `a` is equal to some
`u : add_units M`, where `add_units M` is a bundled version of `is_add_unit`."]
def is_unit [monoid M] (a : M) : Prop := ∃ u : Mˣ, (u : M) = a

@[nontriviality, to_additive is_add_unit_of_subsingleton]
lemma is_unit_of_subsingleton [monoid M] [subsingleton M] (a : M) : is_unit a :=
⟨⟨a, a, subsingleton.elim _ _, subsingleton.elim _ _⟩, rfl⟩

attribute [nontriviality] is_add_unit_of_subsingleton

@[to_additive] instance [monoid M] : can_lift M Mˣ :=
{ coe := coe,
  cond := is_unit,
  prf := λ _, id }

@[to_additive] instance [monoid M] [subsingleton M] : unique Mˣ :=
{ default := 1,
  uniq := λ a, units.coe_eq_one.mp $ subsingleton.elim (a : M) 1 }

@[simp, to_additive is_add_unit_add_unit]
protected lemma units.is_unit [monoid M] (u : Mˣ) : is_unit (u : M) := ⟨u, rfl⟩

@[simp, to_additive is_add_unit_zero]
theorem is_unit_one [monoid M] : is_unit (1:M) := ⟨1, rfl⟩

@[to_additive is_add_unit_of_add_eq_zero] theorem is_unit_of_mul_eq_one [comm_monoid M]
  (a b : M) (h : a * b = 1) : is_unit a :=
⟨units.mk_of_mul_eq_one a b h, rfl⟩

@[to_additive is_add_unit.exists_neg] theorem is_unit.exists_right_inv [monoid M]
  {a : M} (h : is_unit a) : ∃ b, a * b = 1 :=
by { rcases h with ⟨⟨a, b, hab, _⟩, rfl⟩, exact ⟨b, hab⟩ }

@[to_additive is_add_unit.exists_neg'] theorem is_unit.exists_left_inv [monoid M]
  {a : M} (h : is_unit a) : ∃ b, b * a = 1 :=
by { rcases h with ⟨⟨a, b, _, hba⟩, rfl⟩, exact ⟨b, hba⟩ }

@[to_additive is_add_unit_iff_exists_neg] theorem is_unit_iff_exists_inv [comm_monoid M]
  {a : M} : is_unit a ↔ ∃ b, a * b = 1 :=
⟨λ h, h.exists_right_inv,
 λ ⟨b, hab⟩, is_unit_of_mul_eq_one _ b hab⟩

@[to_additive is_add_unit_iff_exists_neg'] theorem is_unit_iff_exists_inv' [comm_monoid M]
  {a : M} : is_unit a ↔ ∃ b, b * a = 1 :=
by simp [is_unit_iff_exists_inv, mul_comm]

@[to_additive]
lemma is_unit.mul [monoid M] {x y : M} : is_unit x → is_unit y → is_unit (x * y) :=
by { rintros ⟨x, rfl⟩ ⟨y, rfl⟩, exact ⟨x * y, units.coe_mul _ _⟩ }

/-- Multiplication by a `u : Mˣ` on the right doesn't affect `is_unit`. -/
@[simp, to_additive is_add_unit_add_add_units "Addition of a `u : add_units M` on the right doesn't
affect `is_add_unit`."]
theorem units.is_unit_mul_units [monoid M] (a : M) (u : Mˣ) :
  is_unit (a * u) ↔ is_unit a :=
iff.intro
  (assume ⟨v, hv⟩,
    have is_unit (a * ↑u * ↑u⁻¹), by existsi v * u⁻¹; rw [←hv, units.coe_mul],
    by rwa [mul_assoc, units.mul_inv, mul_one] at this)
  (λ v, v.mul u.is_unit)

/-- Multiplication by a `u : Mˣ` on the left doesn't affect `is_unit`. -/
@[simp, to_additive is_add_unit_add_units_add "Addition of a `u : add_units M` on the left doesn't
affect `is_add_unit`."]
theorem units.is_unit_units_mul {M : Type*} [monoid M] (u : Mˣ) (a : M) :
  is_unit (↑u * a) ↔ is_unit a :=
iff.intro
  (assume ⟨v, hv⟩,
    have is_unit (↑u⁻¹ * (↑u * a)), by existsi u⁻¹ * v; rw [←hv, units.coe_mul],
    by rwa [←mul_assoc, units.inv_mul, one_mul] at this)
  u.is_unit.mul

@[to_additive is_add_unit_of_add_is_add_unit_left]
theorem is_unit_of_mul_is_unit_left [comm_monoid M] {x y : M}
  (hu : is_unit (x * y)) : is_unit x :=
let ⟨z, hz⟩ := is_unit_iff_exists_inv.1 hu in
is_unit_iff_exists_inv.2 ⟨y * z, by rwa ← mul_assoc⟩

@[to_additive] theorem is_unit_of_mul_is_unit_right [comm_monoid M] {x y : M}
  (hu : is_unit (x * y)) : is_unit y :=
@is_unit_of_mul_is_unit_left _ _ y x $ by rwa mul_comm

@[simp, to_additive]
lemma is_unit.mul_iff [comm_monoid M] {x y : M} : is_unit (x * y) ↔ is_unit x ∧ is_unit y :=
⟨λ h, ⟨is_unit_of_mul_is_unit_left h, is_unit_of_mul_is_unit_right h⟩,
  λ h, is_unit.mul h.1 h.2⟩

@[to_additive] theorem is_unit.mul_right_inj [monoid M] {a b c : M} (ha : is_unit a) :
  a * b = a * c ↔ b = c :=
by cases ha with a ha; rw [←ha, units.mul_right_inj]

@[to_additive] theorem is_unit.mul_left_inj [monoid M] {a b c : M} (ha : is_unit a) :
  b * a = c * a ↔ b = c :=
by cases ha with a ha; rw [←ha, units.mul_left_inj]

/-- The element of the group of units, corresponding to an element of a monoid which is a unit. -/
@[to_additive "The element of the additive group of additive units, corresponding to an element of
an additive monoid which is an additive unit."]
noncomputable def is_unit.unit [monoid M] {a : M} (h : is_unit a) : Mˣ :=
(classical.some h).copy a (classical.some_spec h).symm _ rfl

@[to_additive]
lemma is_unit.unit_spec [monoid M] {a : M} (h : is_unit a) : ↑h.unit = a :=
rfl

@[to_additive]
lemma is_unit.coe_inv_mul [monoid M] {a : M} (h : is_unit a) :
  ↑(h.unit)⁻¹ * a = 1 :=
units.mul_inv _

@[to_additive]
lemma is_unit.mul_coe_inv [monoid M] {a : M} (h : is_unit a) :
  a * ↑(h.unit)⁻¹ = 1 :=
begin
  convert units.mul_inv _,
  simp [h.unit_spec]
end

end is_unit

section noncomputable_defs

variables {M : Type*}

/-- Constructs a `group` structure on a `monoid` consisting only of units. -/
noncomputable def group_of_is_unit [hM : monoid M] (h : ∀ (a : M), is_unit a) : group M :=
{ inv := λ a, ↑((h a).unit)⁻¹,
  mul_left_inv := λ a, by
  { change ↑((h a).unit)⁻¹ * a = 1,
    rw [units.inv_mul_eq_iff_eq_mul, (h a).unit_spec, mul_one] },
  .. hM }

/-- Constructs a `comm_group` structure on a `comm_monoid` consisting only of units. -/
noncomputable def comm_group_of_is_unit [hM : comm_monoid M] (h : ∀ (a : M), is_unit a) :
  comm_group M :=
{ inv := λ a, ↑((h a).unit)⁻¹,
  mul_left_inv := λ a, by
  { change ↑((h a).unit)⁻¹ * a = 1,
    rw [units.inv_mul_eq_iff_eq_mul, (h a).unit_spec, mul_one] },
  .. hM }

end noncomputable_defs


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

! This file was ported from Lean 3 source module group_theory.perm.option
! leanprover-community/mathlib commit c3019c79074b0619edb4b27553a91b2e82242395
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Perm
import Mathlib.GroupTheory.Perm.Sign
import Mathlib.Logic.Equiv.Option

/-!
# Permutations of `option α`
-/

open Equiv

@[simp]
theorem Equiv.optionCongr_one {α : Type _} : (1 : Perm α).optionCongr = 1 :=
  Equiv.optionCongr_refl
#align equiv.option_congr_one Equiv.optionCongr_one

@[simp]
theorem Equiv.optionCongr_swap {α : Type _} [DecidableEq α] (x y : α) :
    optionCongr (swap x y) = swap (some x) (some y) := by
  ext (_ | i)
  · simp [swap_apply_of_ne_of_ne]
  · by_cases hx : i = x
    simp [hx, swap_apply_of_ne_of_ne]
    by_cases hy : i = y <;> simp [hx, hy, swap_apply_of_ne_of_ne]
#align equiv.option_congr_swap Equiv.optionCongr_swap

@[simp]
theorem Equiv.optionCongr_sign {α : Type _} [DecidableEq α] [Fintype α] (e : Perm α) :
    Perm.sign e.optionCongr = Perm.sign e := by
  refine Perm.swap_induction_on e ?_ ?_
  · simp [Perm.one_def]
  · intro f x y hne h
    simp [h, hne, Perm.mul_def, ← Equiv.optionCongr_trans]
#align equiv.option_congr_sign Equiv.optionCongr_sign

@[simp]
theorem map_equiv_removeNone {α : Type _} [DecidableEq α] (σ : Perm (Option α)) :
    (removeNone σ).optionCongr = swap none (σ none) * σ := by
  ext1 x
  have : Option.map (⇑(removeNone σ)) x = (swap none (σ none)) (σ x) :=
    by
    cases' x with x
    · simp
    · cases h : σ (some _)
      · simp [removeNone_none _ h]
      · have hn : σ (some x) ≠ none := by simp [h]
        have hσn : σ (some x) ≠ σ none := σ.injective.ne (by simp)
        simp [removeNone_some _ ⟨_, h⟩, ← h, swap_apply_of_ne_of_ne hn hσn]
  simpa using this
#align map_equiv_remove_none map_equiv_removeNone

/-- Permutations of `Option α` are equivalent to fixing an
`Option α` and permuting the remaining with a `Perm α`.
The fixed `Option α` is swapped with `none`. -/
@[simps]
def Equiv.Perm.decomposeOption {α : Type _} [DecidableEq α] : Perm (Option α) ≃ Option α × Perm α
    where
  toFun σ := (σ none, removeNone σ)
  invFun i := swap none i.1 * i.2.optionCongr
  left_inv σ := by simp
  right_inv := fun ⟨x, σ⟩ =>
    by
    have : removeNone (swap none x * σ.optionCongr) = σ :=
      Equiv.optionCongr_injective (by simp [← mul_assoc])
    simp [← Perm.eq_inv_iff_eq, this]
#align equiv.perm.decompose_option Equiv.Perm.decomposeOption

theorem Equiv.Perm.decomposeOption_symm_of_none_apply {α : Type _} [DecidableEq α] (e : Perm α)
    (i : Option α) : Equiv.Perm.decomposeOption.symm (none, e) i = i.map e := by simp
#align equiv.perm.decompose_option_symm_of_none_apply Equiv.Perm.decomposeOption_symm_of_none_apply

theorem Equiv.Perm.decomposeOption_symm_sign {α : Type _} [DecidableEq α] [Fintype α] (e : Perm α) :
    Perm.sign (Equiv.Perm.decomposeOption.symm (none, e)) = Perm.sign e := by simp
#align equiv.perm.decompose_option_symm_sign Equiv.Perm.decomposeOption_symm_sign

/-- The set of all permutations of `Option α` can be constructed by augmenting the set of
permutations of `α` by each element of `Option α` in turn. -/
theorem Finset.univ_perm_option {α : Type _} [DecidableEq α] [Fintype α] :
    @Finset.univ (Perm <| Option α) _ =
      (Finset.univ : Finset <| Option α × Perm α).map Equiv.Perm.decomposeOption.symm.toEmbedding :=
  (Finset.univ_map_equiv_to_embedding _).symm
#align finset.univ_perm_option Finset.univ_perm_option


import ring_theory.polynomial.basic
import ring_theory.principal_ideal_domain
import data.polynomial.field_division
import missing_mathlib.data.multiset
import missing_mathlib.data.polynomial
import missing_mathlib.data.list.basic

noncomputable theory
local attribute [instance, priority 100] classical.prop_decidable

universes u v w

namespace polynomial

open principal_ideal_ring

lemma ne_0_of_mem_factors {α : Type v} [field α] {p q : polynomial α}
  (hp : p ≠ 0) (hq : q ∈ factors p) : q ≠ 0 :=
begin
  intro h_q_eq_0,
  rw h_q_eq_0 at hq,
  apply hp ((associated_zero_iff_eq_zero p).1 _),
  rw ←multiset.prod_eq_zero hq,
  apply (factors_spec p hp).2
end

lemma exists_noninjective_factor_of_eval₂_0 {α : Type v} {β : Type w}
  [field α] [decidable_eq α] [decidable_eq β] [add_comm_group β] [vector_space α β]
  (f : β →ₗ[α] β) (v : β) (hv : v ≠ 0)
  (p : polynomial α) (h_p_ne_0 : p ≠ 0) (h_eval_p : (polynomial.eval₂ (algebra_map _ _) f p) v = 0) :
  ∃ q ∈ factors p, ¬ function.injective ((polynomial.eval₂ (algebra_map _ _) f q : β →ₗ[α] β) : β → β) :=
begin
  obtain ⟨c, hc⟩ := (factors_spec p h_p_ne_0).2,
  have am_comm : ∀ (a : α) (b : β →ₗ[α] β), (algebra_map _ _) a * b = b * (algebra_map _ _) a := algebra.commutes',
  rw ←units.eq_mul_inv_iff_mul_eq at hc,
  rw [hc,
    @eval₂_mul_noncomm _ (β →ₗ[α] β) _ _ _ (algebra_map α _) f (factors p).prod
      (@has_inv.inv (units (polynomial α)) _ c) (λ x y, ( algebra.commutes' x y).symm),
    polynomial.eq_C_of_degree_eq_zero (polynomial.degree_coe_units (c⁻¹)),
    polynomial.eval₂_C, ← multiset.coe_to_list (factors p), multiset.coe_prod,
    eval₂_prod_noncomm (algebra_map α _) (λ x y, (am_comm x y).symm)] at h_eval_p,
  have h_noninj : ¬ function.injective ⇑(list.prod
    (list.map (λ p, polynomial.eval₂ (algebra_map _ _) f p) (multiset.to_list (factors p))) *
    (algebra_map _ _) (polynomial.coeff ↑c⁻¹ 0)),
  { rw [←linear_map.ker_eq_bot, linear_map.ker_eq_bot', classical.not_forall],
    use v,
    exact not_imp.2 (and.intro h_eval_p hv) },
  show ∃ q ∈ factors p, ¬ function.injective ((polynomial.eval₂ (algebra_map _ _) f q).to_fun),
  { classical,
    by_contra h_contra,
    simp only [not_exists, not_not] at h_contra,
    have h_factors_inj : ∀ g ∈ (factors p).to_list.map (λ q, (polynomial.eval₂ (algebra_map _ _) f q).to_fun),
        function.injective g,
    { intros g hg,
      rw list.mem_map at hg,
      rcases hg with ⟨q, hq₁, hq₂⟩,
      rw multiset.mem_to_list at hq₁,
      rw ←hq₂,
      exact h_contra q hq₁ },
    refine h_noninj (function.injective.comp _ _),
    { unfold_coes,
      dsimp only [list.prod, (*), mul_zero_class.mul, semiring.mul, ring.mul],
      rw list.foldl_map' linear_map.to_fun linear_map.comp function.comp _ _ (λ _ _, rfl),
      rw list.map_map,
      unfold function.comp,
      apply function.injective_foldl_comp (λ g, h_factors_inj g) function.injective_id },
    { rw [←linear_map.ker_eq_bot, module.endomorphism_algebra_map_apply, linear_map.ker_smul, linear_map.ker_id],
      apply polynomial.coeff_coe_units_zero_ne_zero }
  }
end

lemma linear_independent_iff_eval₂ {α : Type v} {β : Type w}
  [decidable_eq α] [comm_ring α] [decidable_eq β] [add_comm_group β] [module α β]
  (f : β →ₗ[α] β) (v : β) :
  linear_independent α (λ n : ℕ, (f ^ n) v)
    ↔ ∀ (p : polynomial α), polynomial.eval₂ (algebra_map _ _) f p v = 0 → p = 0 :=
begin
  rw linear_independent_iff,
  simp only [finsupp.total_apply],
  simp only [finsupp_sum_eq_eval₂],
  refl
end

end polynomial


import Mathbin.Data.MvPolynomial.Basic
import Mathbin.Data.Polynomial.Div
import Mathbin.Data.Polynomial.FieldDivision

section

universe u

variable {R : Type u} [CommSemiringₓ R]

/-- Converting a single variable polynomial to a multivariable polynomial and back yields the same polynomial -/
lemma multivariable_to_single_variable (S : Type) (s : S) (f : S → Polynomial R) (hf : f s = @Polynomial.x R _) (t : Polynomial R) :
  ((t.eval₂ MvPolynomial.c (MvPolynomial.x s)).eval₂ Polynomial.c f) = t := by
  rw [Polynomial.eval₂, Polynomial.sum]
  simp_rw [MvPolynomial.eval₂_sum, MvPolynomial.eval₂_mul, MvPolynomial.eval₂_C, MvPolynomial.eval₂_pow, MvPolynomial.eval₂_X]
  conv_lhs =>
  · congr skip
    ext
    rw [hf, Polynomial.X_pow_eq_monomial, ←Polynomial.monomial_zero_left, Polynomial.monomial_mul_monomial]
    simp_rw [zero_addₓ, mul_oneₓ]
  rw [t.as_sum_support.symm]


import tpow

universe u
variables (R : Type u) [comm_semiring R] (M : Type u) [add_comm_monoid M] [semimodule R M]
open tpow

/-def talg_ring : ring (tensor_algebra R M) :=
algebra.semiring_to_ring R
def talg_acg : add_comm_group (tensor_algebra R M) :=
@ring.to_add_comm_group _ talg_ring
def talg_mod : @module R (tensor_algebra R M) _ talg_acg :=
{ smul := (•),
  one_smul := one_smul _,
  mul_smul := mul_smul,
  smul_add := smul_add,
  smul_zero := smul_zero,
  add_smul := add_smul,
  zero_smul := zero_smul _ }-/

def pow_to_alg (n : ℕ) : (tpow R M n) →ₗ[R] (tensor_algebra R M) :=
tpow.lift R n (tensor_algebra R M) $ tensor_algebra.mk R M

variables {R M}
theorem inj_of_pow_to_alg (n : ℕ) : (pow_to_alg R M n).ker = ⊥ :=
linear_map.ker_eq_bot'.2 $ λ x h, sorry