/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.tactic
import Mathlib.PostPort

universes u u_1 l v u_2 w u_3

namespace Mathlib

/-!
# Ordering on topologies and (co)induced topologies

Topologies on a fixed type `α` are ordered, by reverse inclusion.
That is, for topologies `t₁` and `t₂` on `α`, we write `t₁ ≤ t₂`
if every set open in `t₂` is also open in `t₁`.
(One also calls `t₁` finer than `t₂`, and `t₂` coarser than `t₁`.)

Any function `f : α → β` induces
       `induced f : topological_space β → topological_space α`
and  `coinduced f : topological_space α → topological_space β`.
Continuity, the ordering on topologies and (co)induced topologies are
related as follows:
* The identity map (α, t₁) → (α, t₂) is continuous iff t₁ ≤ t₂.
* A map f : (α, t) → (β, u) is continuous
    iff             t ≤ induced f u   (`continuous_iff_le_induced`)
    iff coinduced f t ≤ u             (`continuous_iff_coinduced_le`).

Topologies on α form a complete lattice, with ⊥ the discrete topology
and ⊤ the indiscrete topology.

For a function f : α → β, (coinduced f, induced f) is a Galois connection
between topologies on α and topologies on β.

## Implementation notes

There is a Galois insertion between topologies on α (with the inclusion ordering)
and all collections of sets in α. The complete lattice structure on topologies
on α is defined as the reverse of the one obtained via this Galois insertion.

## Tags

finer, coarser, induced topology, coinduced topology

-/

namespace topological_space

/-- The open sets of the least topology containing a collection of basic sets. -/
inductive generate_open {α : Type u} (g : set (set α)) : set α → Prop where
| basic : ∀ (s : set α), s ∈ g → generate_open g s
| univ : generate_open g set.univ
| inter : ∀ (s t : set α), generate_open g s → generate_open g t → generate_open g (s ∩ t)
| sUnion : ∀ (k : set (set α)), (∀ (s : set α), s ∈ k → generate_open g s) → generate_open g (⋃₀k)

/-- The smallest topological space containing the collection `g` of basic sets -/
def generate_from {α : Type u} (g : set (set α)) : topological_space α :=
  mk (generate_open g) generate_open.univ generate_open.inter generate_open.sUnion

theorem nhds_generate_from {α : Type u} {g : set (set α)} {a : α} :
    nhds a =
        infi
          fun (s : set α) =>
            infi fun (H : s ∈ set_of fun (s : set α) => a ∈ s ∧ s ∈ g) => filter.principal s :=
  sorry

theorem tendsto_nhds_generate_from {α : Type u} {β : Type u_1} {m : α → β} {f : filter α}
    {g : set (set β)} {b : β} (h : ∀ (s : set β), s ∈ g → b ∈ s → m ⁻¹' s ∈ f) :
    filter.tendsto m f (nhds b) :=
  sorry

/-- Construct a topology on α given the filter of neighborhoods of each point of α. -/
protected def mk_of_nhds {α : Type u} (n : α → filter α) : topological_space α :=
  mk (fun (s : set α) => ∀ (a : α), a ∈ s → s ∈ n a) sorry sorry sorry

theorem nhds_mk_of_nhds {α : Type u} (n : α → filter α) (a : α) (h₀ : pure ≤ n)
    (h₁ :
      ∀ {a : α} {s : set α},
        s ∈ n a → ∃ (t : set α), ∃ (H : t ∈ n a), t ⊆ s ∧ ∀ (a' : α), a' ∈ t → s ∈ n a') :
    nhds a = n a :=
  sorry

end topological_space

/-- The inclusion ordering on topologies on α. We use it to get a complete
   lattice instance via the Galois insertion method, but the partial order
   that we will eventually impose on `topological_space α` is the reverse one. -/
def tmp_order {α : Type u} : partial_order (topological_space α) :=
  partial_order.mk
    (fun (t s : topological_space α) => topological_space.is_open t ≤ topological_space.is_open s)
    (preorder.lt._default
      fun (t s : topological_space α) => topological_space.is_open t ≤ topological_space.is_open s)
    sorry sorry sorry

/- We'll later restate this lemma in terms of the correct order on `topological_space α`. -/

/-- If `s` equals the collection of open sets in the topology it generates,
  then `s` defines a topology. -/
protected def mk_of_closure {α : Type u} (s : set (set α))
    (hs :
      (set_of fun (u : set α) => topological_space.is_open (topological_space.generate_from s) u) =
        s) :
    topological_space α :=
  topological_space.mk (fun (u : set α) => u ∈ s) sorry sorry sorry

theorem mk_of_closure_sets {α : Type u} {s : set (set α)}
    {hs :
      (set_of fun (u : set α) => topological_space.is_open (topological_space.generate_from s) u) =
        s} :
    Mathlib.mk_of_closure s hs = topological_space.generate_from s :=
  topological_space_eq (Eq.symm hs)

/-- The Galois insertion between `set (set α)` and `topological_space α` whose lower part
  sends a collection of subsets of α to the topology they generate, and whose upper part
  sends a topology to its collection of open subsets. -/
def gi_generate_from (α : Type u_1) :
    galois_insertion topological_space.generate_from
        fun (t : topological_space α) => set_of fun (s : set α) => topological_space.is_open t s :=
  galois_insertion.mk
    (fun (g : set (set α))
      (hg :
      (set_of fun (s : set α) => topological_space.is_open (topological_space.generate_from g) s) ≤
        g) =>
      Mathlib.mk_of_closure g sorry)
    sorry sorry sorry

theorem generate_from_mono {α : Type u_1} {g₁ : set (set α)} {g₂ : set (set α)} (h : g₁ ⊆ g₂) :
    topological_space.generate_from g₁ ≤ topological_space.generate_from g₂ :=
  galois_connection.monotone_l (galois_insertion.gc (gi_generate_from α)) h

/-- The complete lattice of topological spaces, but built on the inclusion ordering. -/
def tmp_complete_lattice {α : Type u} : complete_lattice (topological_space α) :=
  galois_insertion.lift_complete_lattice (gi_generate_from α)

/-- The ordering on topologies on the type `α`.
  `t ≤ s` if every set open in `s` is also open in `t` (`t` is finer than `s`). -/
protected instance topological_space.partial_order {α : Type u} :
    partial_order (topological_space α) :=
  partial_order.mk
    (fun (t s : topological_space α) => topological_space.is_open s ≤ topological_space.is_open t)
    (preorder.lt._default
      fun (t s : topological_space α) => topological_space.is_open s ≤ topological_space.is_open t)
    sorry sorry sorry

theorem le_generate_from_iff_subset_is_open {α : Type u} {g : set (set α)}
    {t : topological_space α} :
    t ≤ topological_space.generate_from g ↔
        g ⊆ set_of fun (s : set α) => topological_space.is_open t s :=
  generate_from_le_iff_subset_is_open

/-- Topologies on `α` form a complete lattice, with `⊥` the discrete topology
  and `⊤` the indiscrete topology. The infimum of a collection of topologies
  is the topology generated by all their open sets, while the supremem is the
  topology whose open sets are those sets open in every member of the collection. -/
protected instance topological_space.complete_lattice {α : Type u} :
    complete_lattice (topological_space α) :=
  order_dual.complete_lattice (topological_space α)

/-- A topological space is discrete if every set is open, that is,
  its topology equals the discrete topology `⊥`. -/
class discrete_topology (α : Type u_1) [t : topological_space α] where
  eq_bot : t = ⊥

@[simp] theorem is_open_discrete {α : Type u} [topological_space α] [discrete_topology α]
    (s : set α) : is_open s :=
  Eq.symm (discrete_topology.eq_bot α) ▸ trivial

@[simp] theorem is_closed_discrete {α : Type u} [topological_space α] [discrete_topology α]
    (s : set α) : is_closed s :=
  Eq.symm (discrete_topology.eq_bot α) ▸ trivial

theorem continuous_of_discrete_topology {α : Type u} {β : Type v} [topological_space α]
    [discrete_topology α] [topological_space β] {f : α → β} : continuous f :=
  iff.mpr continuous_def fun (s : set β) (hs : is_open s) => is_open_discrete (f ⁻¹' s)

theorem nhds_bot (α : Type u_1) : nhds = pure :=
  le_antisymm (id fun (a : α) => id fun (s : set α) (hs : s ∈ pure a) => mem_nhds_sets trivial hs)
    pure_le_nhds

theorem nhds_discrete (α : Type u_1) [topological_space α] [discrete_topology α] : nhds = pure :=
  Eq.symm (discrete_topology.eq_bot α) ▸ nhds_bot α

theorem le_of_nhds_le_nhds {α : Type u} {t₁ : topological_space α} {t₂ : topological_space α}
    (h : ∀ (x : α), nhds x ≤ nhds x) : t₁ ≤ t₂ :=
  sorry

theorem eq_of_nhds_eq_nhds {α : Type u} {t₁ : topological_space α} {t₂ : topological_space α}
    (h : ∀ (x : α), nhds x = nhds x) : t₁ = t₂ :=
  le_antisymm (le_of_nhds_le_nhds fun (x : α) => le_of_eq (h x))
    (le_of_nhds_le_nhds fun (x : α) => le_of_eq (Eq.symm (h x)))

theorem eq_bot_of_singletons_open {α : Type u} {t : topological_space α}
    (h : ∀ (x : α), topological_space.is_open t (singleton x)) : t = ⊥ :=
  bot_unique
    fun (s : set α) (hs : topological_space.is_open ⊥ s) =>
      set.bUnion_of_singleton s ▸ is_open_bUnion fun (x : α) (_x : x ∈ s) => h x

theorem forall_open_iff_discrete {X : Type u_1} [topological_space X] :
    (∀ (s : set X), is_open s) ↔ discrete_topology X :=
  sorry

theorem singletons_open_iff_discrete {X : Type u_1} [topological_space X] :
    (∀ (a : X), is_open (singleton a)) ↔ discrete_topology X :=
  { mp :=
      fun (h : ∀ (a : X), is_open (singleton a)) =>
        discrete_topology.mk (eq_bot_of_singletons_open h),
    mpr := fun (a : discrete_topology X) (_x : X) => is_open_discrete (singleton _x) }

/-- Given `f : α → β` and a topology on `β`, the induced topology on `α` is the collection of
  sets that are preimages of some open set in `β`. This is the coarsest topology that
  makes `f` continuous. -/
def topological_space.induced {α : Type u} {β : Type v} (f : α → β) (t : topological_space β) :
    topological_space α :=
  topological_space.mk
    (fun (s : set α) => ∃ (s' : set β), topological_space.is_open t s' ∧ f ⁻¹' s' = s) sorry sorry
    sorry

theorem is_open_induced_iff {α : Type u_1} {β : Type u_2} [t : topological_space β] {s : set α}
    {f : α → β} : is_open s ↔ ∃ (t_1 : set β), is_open t_1 ∧ f ⁻¹' t_1 = s :=
  iff.rfl

theorem is_closed_induced_iff {α : Type u_1} {β : Type u_2} [t : topological_space β] {s : set α}
    {f : α → β} : is_closed s ↔ ∃ (t_1 : set β), is_closed t_1 ∧ s = f ⁻¹' t_1 :=
  sorry

/-- Given `f : α → β` and a topology on `α`, the coinduced topology on `β` is defined
  such that `s:set β` is open if the preimage of `s` is open. This is the finest topology that
  makes `f` continuous. -/
def topological_space.coinduced {α : Type u} {β : Type v} (f : α → β) (t : topological_space α) :
    topological_space β :=
  topological_space.mk (fun (s : set β) => topological_space.is_open t (f ⁻¹' s)) sorry sorry sorry

theorem is_open_coinduced {α : Type u_1} {β : Type u_2} {t : topological_space α} {s : set β}
    {f : α → β} : is_open s ↔ is_open (f ⁻¹' s) :=
  iff.rfl

theorem continuous.coinduced_le {α : Type u_1} {β : Type u_2} {t : topological_space α}
    {t' : topological_space β} {f : α → β} (h : continuous f) :
    topological_space.coinduced f t ≤ t' :=
  fun (s : set β) (hs : topological_space.is_open t' s) => iff.mp continuous_def h s hs

theorem coinduced_le_iff_le_induced {α : Type u_1} {β : Type u_2} {f : α → β}
    {tα : topological_space α} {tβ : topological_space β} :
    topological_space.coinduced f tα ≤ tβ ↔ tα ≤ topological_space.induced f tβ :=
  sorry

theorem continuous.le_induced {α : Type u_1} {β : Type u_2} {t : topological_space α}
    {t' : topological_space β} {f : α → β} (h : continuous f) :
    t ≤ topological_space.induced f t' :=
  iff.mp coinduced_le_iff_le_induced (continuous.coinduced_le h)

theorem gc_coinduced_induced {α : Type u_1} {β : Type u_2} (f : α → β) :
    galois_connection (topological_space.coinduced f) (topological_space.induced f) :=
  fun (f_1 : topological_space α) (g : topological_space β) => coinduced_le_iff_le_induced

theorem induced_mono {α : Type u_1} {β : Type u_2} {t₁ : topological_space α}
    {t₂ : topological_space α} {g : β → α} (h : t₁ ≤ t₂) :
    topological_space.induced g t₁ ≤ topological_space.induced g t₂ :=
  galois_connection.monotone_u (gc_coinduced_induced g) h

theorem coinduced_mono {α : Type u_1} {β : Type u_2} {t₁ : topological_space α}
    {t₂ : topological_space α} {f : α → β} (h : t₁ ≤ t₂) :
    topological_space.coinduced f t₁ ≤ topological_space.coinduced f t₂ :=
  galois_connection.monotone_l (gc_coinduced_induced f) h

@[simp] theorem induced_top {α : Type u_1} {β : Type u_2} {g : β → α} :
    topological_space.induced g ⊤ = ⊤ :=
  galois_connection.u_top (gc_coinduced_induced g)

@[simp] theorem induced_inf {α : Type u_1} {β : Type u_2} {t₁ : topological_space α}
    {t₂ : topological_space α} {g : β → α} :
    topological_space.induced g (t₁ ⊓ t₂) =
        topological_space.induced g t₁ ⊓ topological_space.induced g t₂ :=
  galois_connection.u_inf (gc_coinduced_induced g)

@[simp] theorem induced_infi {α : Type u_1} {β : Type u_2} {g : β → α} {ι : Sort w}
    {t : ι → topological_space α} :
    topological_space.induced g (infi fun (i : ι) => t i) =
        infi fun (i : ι) => topological_space.induced g (t i) :=
  galois_connection.u_infi (gc_coinduced_induced g)

@[simp] theorem coinduced_bot {α : Type u_1} {β : Type u_2} {f : α → β} :
    topological_space.coinduced f ⊥ = ⊥ :=
  galois_connection.l_bot (gc_coinduced_induced f)

@[simp] theorem coinduced_sup {α : Type u_1} {β : Type u_2} {t₁ : topological_space α}
    {t₂ : topological_space α} {f : α → β} :
    topological_space.coinduced f (t₁ ⊔ t₂) =
        topological_space.coinduced f t₁ ⊔ topological_space.coinduced f t₂ :=
  galois_connection.l_sup (gc_coinduced_induced f)

@[simp] theorem coinduced_supr {α : Type u_1} {β : Type u_2} {f : α → β} {ι : Sort w}
    {t : ι → topological_space α} :
    topological_space.coinduced f (supr fun (i : ι) => t i) =
        supr fun (i : ι) => topological_space.coinduced f (t i) :=
  galois_connection.l_supr (gc_coinduced_induced f)

theorem induced_id {α : Type u_1} [t : topological_space α] : topological_space.induced id t = t :=
  sorry

theorem induced_compose {α : Type u_1} {β : Type u_2} {γ : Type u_3} [tγ : topological_space γ]
    {f : α → β} {g : β → γ} :
    topological_space.induced f (topological_space.induced g tγ) =
        topological_space.induced (g ∘ f) tγ :=
  sorry

theorem coinduced_id {α : Type u_1} [t : topological_space α] :
    topological_space.coinduced id t = t :=
  topological_space_eq rfl

theorem coinduced_compose {α : Type u_1} {β : Type u_2} {γ : Type u_3} [tα : topological_space α]
    {f : α → β} {g : β → γ} :
    topological_space.coinduced g (topological_space.coinduced f tα) =
        topological_space.coinduced (g ∘ f) tα :=
  topological_space_eq rfl

/- constructions using the complete lattice structure -/

protected instance inhabited_topological_space {α : Type u} : Inhabited (topological_space α) :=
  { default := ⊤ }

protected instance subsingleton.unique_topological_space {α : Type u} [subsingleton α] :
    unique (topological_space α) :=
  unique.mk { default := ⊥ } sorry

protected instance subsingleton.discrete_topology {α : Type u} [t : topological_space α]
    [subsingleton α] : discrete_topology α :=
  discrete_topology.mk (unique.eq_default t)

protected instance empty.topological_space : topological_space empty := ⊥

protected instance empty.discrete_topology : discrete_topology empty := discrete_topology.mk rfl

protected instance pempty.topological_space : topological_space pempty := ⊥

protected instance pempty.discrete_topology : discrete_topology pempty := discrete_topology.mk rfl

protected instance unit.topological_space : topological_space Unit := ⊥

protected instance unit.discrete_topology : discrete_topology Unit := discrete_topology.mk rfl

protected instance bool.topological_space : topological_space Bool := ⊥

protected instance bool.discrete_topology : discrete_topology Bool := discrete_topology.mk rfl

protected instance nat.topological_space : topological_space ℕ := ⊥

protected instance nat.discrete_topology : discrete_topology ℕ := discrete_topology.mk rfl

protected instance int.topological_space : topological_space ℤ := ⊥

protected instance int.discrete_topology : discrete_topology ℤ := discrete_topology.mk rfl

protected instance sierpinski_space : topological_space Prop :=
  topological_space.generate_from (singleton (singleton True))

theorem le_generate_from {α : Type u} {t : topological_space α} {g : set (set α)}
    (h : ∀ (s : set α), s ∈ g → is_open s) : t ≤ topological_space.generate_from g :=
  iff.mpr le_generate_from_iff_subset_is_open h

theorem induced_generate_from_eq {α : Type u_1} {β : Type u_2} {b : set (set β)} {f : α → β} :
    topological_space.induced f (topological_space.generate_from b) =
        topological_space.generate_from (set.preimage f '' b) :=
  sorry

/-- This construction is left adjoint to the operation sending a topology on `α`
  to its neighborhood filter at a fixed point `a : α`. -/
protected def topological_space.nhds_adjoint {α : Type u} (a : α) (f : filter α) :
    topological_space α :=
  topological_space.mk (fun (s : set α) => a ∈ s → s ∈ f) sorry sorry sorry

theorem gc_nhds {α : Type u} (a : α) :
    galois_connection (topological_space.nhds_adjoint a) fun (t : topological_space α) => nhds a :=
  sorry

theorem nhds_mono {α : Type u} {t₁ : topological_space α} {t₂ : topological_space α} {a : α}
    (h : t₁ ≤ t₂) : nhds a ≤ nhds a :=
  galois_connection.monotone_u (gc_nhds a) h

theorem nhds_infi {α : Type u} {ι : Sort u_1} {t : ι → topological_space α} {a : α} :
    nhds a = infi fun (i : ι) => nhds a :=
  galois_connection.u_infi (gc_nhds a)

theorem nhds_Inf {α : Type u} {s : set (topological_space α)} {a : α} :
    nhds a = infi fun (t : topological_space α) => infi fun (H : t ∈ s) => nhds a :=
  galois_connection.u_Inf (gc_nhds a)

theorem nhds_inf {α : Type u} {t₁ : topological_space α} {t₂ : topological_space α} {a : α} :
    nhds a = nhds a ⊓ nhds a :=
  galois_connection.u_inf (gc_nhds a)

theorem nhds_top {α : Type u} {a : α} : nhds a = ⊤ := galois_connection.u_top (gc_nhds a)

theorem continuous_iff_coinduced_le {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : topological_space β} : continuous f ↔ topological_space.coinduced f t₁ ≤ t₂ :=
  iff.trans continuous_def iff.rfl

theorem continuous_iff_le_induced {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : topological_space β} : continuous f ↔ t₁ ≤ topological_space.induced f t₂ :=
  iff.trans continuous_iff_coinduced_le (gc_coinduced_induced f t₁ t₂)

theorem continuous_generated_from {α : Type u} {β : Type v} {f : α → β} {t : topological_space α}
    {b : set (set β)} (h : ∀ (s : set β), s ∈ b → is_open (f ⁻¹' s)) : continuous f :=
  iff.mpr continuous_iff_coinduced_le (le_generate_from h)

theorem continuous_induced_dom {α : Type u} {β : Type v} {f : α → β} {t : topological_space β} :
    continuous f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)))
    fun (s : set β) (h : is_open s) => Exists.intro s { left := h, right := rfl }

theorem continuous_induced_rng {α : Type u} {β : Type v} {γ : Type u_1} {f : α → β} {g : γ → α}
    {t₂ : topological_space β} {t₁ : topological_space γ} (h : continuous (f ∘ g)) : continuous g :=
  sorry

theorem continuous_induced_rng' {α : Type u} {β : Type v} {γ : Type u_1} [topological_space α]
    [topological_space β] [topological_space γ] {g : γ → α} (f : α → β)
    (H : _inst_1 = topological_space.induced f _inst_2) (h : continuous (f ∘ g)) : continuous g :=
  Eq.symm H ▸ continuous_induced_rng h

theorem continuous_coinduced_rng {α : Type u} {β : Type v} {f : α → β} {t : topological_space α} :
    continuous f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)))
    fun (s : set β) (h : is_open s) => h

theorem continuous_coinduced_dom {α : Type u} {β : Type v} {γ : Type u_1} {f : α → β} {g : β → γ}
    {t₁ : topological_space α} {t₂ : topological_space γ} (h : continuous (g ∘ f)) : continuous g :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous g)) (propext continuous_def)))
    fun (s : set γ) (hs : is_open s) =>
      eq.mp (Eq._oldrec (Eq.refl (continuous (g ∘ f))) (propext continuous_def)) h s hs

theorem continuous_le_dom {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : topological_space α} {t₃ : topological_space β} (h₁ : t₂ ≤ t₁) (h₂ : continuous f) :
    continuous f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)))
    fun (s : set β) (h : is_open s) =>
      h₁ (f ⁻¹' s) (eq.mp (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)) h₂ s h)

theorem continuous_le_rng {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : topological_space β} {t₃ : topological_space β} (h₁ : t₂ ≤ t₃) (h₂ : continuous f) :
    continuous f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)))
    fun (s : set β) (h : is_open s) =>
      eq.mp (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)) h₂ s (h₁ s h)

theorem continuous_sup_dom {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : topological_space α} {t₃ : topological_space β} (h₁ : continuous f) (h₂ : continuous f) :
    continuous f :=
  sorry

theorem continuous_sup_rng_left {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₃ : topological_space β} {t₂ : topological_space β} : continuous f → continuous f :=
  continuous_le_rng le_sup_left

theorem continuous_sup_rng_right {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₃ : topological_space β} {t₂ : topological_space β} : continuous f → continuous f :=
  continuous_le_rng le_sup_right

theorem continuous_Sup_dom {α : Type u} {β : Type v} {f : α → β} {t₁ : set (topological_space α)}
    {t₂ : topological_space β} (h : ∀ (t : topological_space α), t ∈ t₁ → continuous f) :
    continuous f :=
  iff.mpr continuous_iff_le_induced
    (Sup_le
      fun (t : topological_space α) (ht : t ∈ t₁) => iff.mp continuous_iff_le_induced (h t ht))

theorem continuous_Sup_rng {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : set (topological_space β)} {t : topological_space β} (h₁ : t ∈ t₂) (hf : continuous f) :
    continuous f :=
  iff.mpr continuous_iff_coinduced_le (le_Sup_of_le h₁ (iff.mp continuous_iff_coinduced_le hf))

theorem continuous_supr_dom {α : Type u} {β : Type v} {f : α → β} {ι : Sort u_2}
    {t₁ : ι → topological_space α} {t₂ : topological_space β} (h : ι → continuous f) :
    continuous f :=
  sorry

theorem continuous_supr_rng {α : Type u} {β : Type v} {f : α → β} {ι : Sort u_2}
    {t₁ : topological_space α} {t₂ : ι → topological_space β} {i : ι} (h : continuous f) :
    continuous f :=
  continuous_Sup_rng (Exists.intro i rfl) h

theorem continuous_inf_rng {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : topological_space β} {t₃ : topological_space β} (h₁ : continuous f) (h₂ : continuous f) :
    continuous f :=
  iff.mpr continuous_iff_coinduced_le
    (le_inf (iff.mp continuous_iff_coinduced_le h₁) (iff.mp continuous_iff_coinduced_le h₂))

theorem continuous_inf_dom_left {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : topological_space α} {t₃ : topological_space β} : continuous f → continuous f :=
  continuous_le_dom inf_le_left

theorem continuous_inf_dom_right {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : topological_space α} {t₃ : topological_space β} : continuous f → continuous f :=
  continuous_le_dom inf_le_right

theorem continuous_Inf_dom {α : Type u} {β : Type v} {f : α → β} {t₁ : set (topological_space α)}
    {t₂ : topological_space β} {t : topological_space α} (h₁ : t ∈ t₁) :
    continuous f → continuous f :=
  continuous_le_dom (Inf_le h₁)

theorem continuous_Inf_rng {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α}
    {t₂ : set (topological_space β)} (h : ∀ (t : topological_space β), t ∈ t₂ → continuous f) :
    continuous f :=
  iff.mpr continuous_iff_coinduced_le
    (le_Inf
      fun (b : topological_space β) (hb : b ∈ t₂) => iff.mp continuous_iff_coinduced_le (h b hb))

theorem continuous_infi_dom {α : Type u} {β : Type v} {f : α → β} {ι : Sort u_2}
    {t₁ : ι → topological_space α} {t₂ : topological_space β} {i : ι} :
    continuous f → continuous f :=
  continuous_le_dom (infi_le t₁ i)

theorem continuous_infi_rng {α : Type u} {β : Type v} {f : α → β} {ι : Sort u_2}
    {t₁ : topological_space α} {t₂ : ι → topological_space β} (h : ι → continuous f) :
    continuous f :=
  iff.mpr continuous_iff_coinduced_le
    (le_infi fun (i : ι) => iff.mp continuous_iff_coinduced_le (h i))

theorem continuous_bot {α : Type u} {β : Type v} {f : α → β} {t : topological_space β} :
    continuous f :=
  iff.mpr continuous_iff_le_induced bot_le

theorem continuous_top {α : Type u} {β : Type v} {f : α → β} {t : topological_space α} :
    continuous f :=
  iff.mpr continuous_iff_coinduced_le le_top

/- 𝓝 in the induced topology -/

theorem mem_nhds_induced {α : Type u} {β : Type v} [T : topological_space α] (f : β → α) (a : β)
    (s : set β) : s ∈ nhds a ↔ ∃ (u : set α), ∃ (H : u ∈ nhds (f a)), f ⁻¹' u ⊆ s :=
  sorry

theorem nhds_induced {α : Type u} {β : Type v} [T : topological_space α] (f : β → α) (a : β) :
    nhds a = filter.comap f (nhds (f a)) :=
  sorry

theorem induced_iff_nhds_eq {α : Type u} {β : Type v} [tα : topological_space α]
    [tβ : topological_space β] (f : β → α) :
    tβ = topological_space.induced f tα ↔ ∀ (b : β), nhds b = filter.comap f (nhds (f b)) :=
  sorry

theorem map_nhds_induced_of_surjective {α : Type u} {β : Type v} [T : topological_space α]
    {f : β → α} (hf : function.surjective f) (a : β) : filter.map f (nhds a) = nhds (f a) :=
  sorry

theorem is_open_induced_eq {α : Type u_1} {β : Type u_2} [t : topological_space β] {f : α → β}
    {s : set α} : is_open s ↔ s ∈ set.preimage f '' set_of fun (s : set β) => is_open s :=
  iff.rfl

theorem is_open_induced {α : Type u_1} {β : Type u_2} [t : topological_space β] {f : α → β}
    {s : set β} (h : is_open s) :
    topological_space.is_open (topological_space.induced f t) (f ⁻¹' s) :=
  Exists.intro s { left := h, right := rfl }

theorem map_nhds_induced_eq {α : Type u_1} {β : Type u_2} [t : topological_space β] {f : α → β}
    {a : α} (h : set.range f ∈ nhds (f a)) : filter.map f (nhds a) = nhds (f a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (filter.map f (nhds a) = nhds (f a))) (nhds_induced f a)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (filter.map f (filter.comap f (nhds (f a))) = nhds (f a)))
          (filter.map_comap h)))
      (Eq.refl (nhds (f a))))

theorem closure_induced {α : Type u_1} {β : Type u_2} [t : topological_space β] {f : α → β} {a : α}
    {s : set α} (hf : ∀ (x y : α), f x = f y → x = y) : a ∈ closure s ↔ f a ∈ closure (f '' s) :=
  sorry

@[simp] theorem is_open_singleton_true : is_open (singleton True) :=
  topological_space.generate_open.basic (singleton True)
    (eq.mpr
      (id
        (propext
          ((fun {α : Type} (a : α) => iff_true_intro (set.mem_singleton a)) (singleton True))))
      trivial)

theorem continuous_Prop {α : Type u_1} [topological_space α] {p : α → Prop} :
    continuous p ↔ is_open (set_of fun (x : α) => p x) :=
  sorry

theorem is_open_supr_iff {α : Type u} {ι : Type v} {t : ι → topological_space α} {s : set α} :
    is_open s ↔ ι → is_open s :=
  sorry

theorem is_closed_infi_iff {α : Type u} {ι : Type v} {t : ι → topological_space α} {s : set α} :
    is_closed s ↔ ι → is_closed s :=
  is_open_supr_iff

end Mathlib


/-
Copyright (c) 2020 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.default
import Mathlib.data.finset.basic
import Mathlib.PostPort

universes u_1 l

namespace Mathlib

/-!
# Constructions involving sets of sets.

## Finite Intersections

We define a structure `has_finite_inter` which asserts that a set `S` of subsets of `α` is
closed under finite intersections.

We define `finite_inter_closure` which, given a set `S` of subsets of `α`, is the smallest
set of subsets of `α` which is closed under finite intersections.

`finite_inter_closure S` is endowed with a term of type `has_finite_inter` using
`finite_inter_closure_has_finite_inter`.

-/

/-- A structure encapsulating the fact that a set of sets is closed under finite intersection. -/
structure has_finite_inter {α : Type u_1} (S : set (set α))
where
  univ_mem : set.univ ∈ S
  inter_mem : ∀ {s t : set α}, s ∈ S → t ∈ S → s ∩ t ∈ S

namespace has_finite_inter

-- Satisfying the inhabited linter...

protected instance inhabited {α : Type u_1} : Inhabited (has_finite_inter (singleton set.univ)) :=
  { default := mk sorry sorry }

/-- The smallest set of sets containing `S` which is closed under finite intersections. -/
inductive finite_inter_closure {α : Type u_1} (S : set (set α)) : set (set α)
where
| basic : ∀ {s : set α}, s ∈ S → finite_inter_closure S s
| univ : finite_inter_closure S set.univ
| inter : ∀ {s t : set α}, finite_inter_closure S s → finite_inter_closure S t → finite_inter_closure S (s ∩ t)

/-- Defines `has_finite_inter` for `finite_inter_closure S`. -/
def finite_inter_closure_has_finite_inter {α : Type u_1} (S : set (set α)) : has_finite_inter (finite_inter_closure S) :=
  mk finite_inter_closure.univ sorry

theorem finite_inter_mem {α : Type u_1} {S : set (set α)} (cond : has_finite_inter S) (F : finset (set α)) : ↑F ⊆ S → ⋂₀↑F ∈ S := sorry

theorem finite_inter_closure_insert {α : Type u_1} {S : set (set α)} {A : set α} (cond : has_finite_inter S) (P : set α) (H : P ∈ finite_inter_closure (insert A S)) : P ∈ S ∨ ∃ (Q : set α), ∃ (H : Q ∈ S), P = A ∩ Q := sorry


/-
Copyright (c) 2017 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.sqrt
import Mathlib.PostPort

universes l u_1

namespace Mathlib

/-!
# The complex numbers

The complex numbers are modelled as ℝ^2 in the obvious way.
-/

/-! ### Definition and basic arithmmetic -/

/-- Complex numbers consist of two `real`s: a real part `re` and an imaginary part `im`. -/
structure complex
where
  re : ℝ
  im : ℝ

notation:1024 "ℂ" => Mathlib.complex

namespace complex

protected instance decidable_eq : DecidableEq ℂ :=
  classical.dec_eq ℂ

/-- The equivalence between the complex numbers and `ℝ × ℝ`. -/
def equiv_real_prod : ℂ ≃ ℝ × ℝ :=
  equiv.mk (fun (z : ℂ) => (re z, im z)) (fun (p : ℝ × ℝ) => mk (prod.fst p) (prod.snd p)) sorry sorry

@[simp] theorem equiv_real_prod_apply (z : ℂ) : coe_fn equiv_real_prod z = (re z, im z) :=
  rfl

theorem equiv_real_prod_symm_re (x : ℝ) (y : ℝ) : re (coe_fn (equiv.symm equiv_real_prod) (x, y)) = x :=
  rfl

theorem equiv_real_prod_symm_im (x : ℝ) (y : ℝ) : im (coe_fn (equiv.symm equiv_real_prod) (x, y)) = y :=
  rfl

@[simp] theorem eta (z : ℂ) : mk (re z) (im z) = z :=
  cases_on z
    fun (z_re z_im : ℝ) =>
      idRhs (mk (re (mk z_re z_im)) (im (mk z_re z_im)) = mk (re (mk z_re z_im)) (im (mk z_re z_im))) rfl

theorem ext {z : ℂ} {w : ℂ} : re z = re w → im z = im w → z = w := sorry

theorem ext_iff {z : ℂ} {w : ℂ} : z = w ↔ re z = re w ∧ im z = im w := sorry

protected instance has_coe : has_coe ℝ ℂ :=
  has_coe.mk fun (r : ℝ) => mk r 0

@[simp] theorem of_real_re (r : ℝ) : re ↑r = r :=
  rfl

@[simp] theorem of_real_im (r : ℝ) : im ↑r = 0 :=
  rfl

@[simp] theorem of_real_inj {z : ℝ} {w : ℝ} : ↑z = ↑w ↔ z = w :=
  { mp := congr_arg re, mpr := congr_arg fun {z : ℝ} => ↑z }

protected instance has_zero : HasZero ℂ :=
  { zero := ↑0 }

protected instance inhabited : Inhabited ℂ :=
  { default := 0 }

@[simp] theorem zero_re : re 0 = 0 :=
  rfl

@[simp] theorem zero_im : im 0 = 0 :=
  rfl

@[simp] theorem of_real_zero : ↑0 = 0 :=
  rfl

@[simp] theorem of_real_eq_zero {z : ℝ} : ↑z = 0 ↔ z = 0 :=
  of_real_inj

theorem of_real_ne_zero {z : ℝ} : ↑z ≠ 0 ↔ z ≠ 0 :=
  not_congr of_real_eq_zero

protected instance has_one : HasOne ℂ :=
  { one := ↑1 }

@[simp] theorem one_re : re 1 = 1 :=
  rfl

@[simp] theorem one_im : im 1 = 0 :=
  rfl

@[simp] theorem of_real_one : ↑1 = 1 :=
  rfl

protected instance has_add : Add ℂ :=
  { add := fun (z w : ℂ) => mk (re z + re w) (im z + im w) }

@[simp] theorem add_re (z : ℂ) (w : ℂ) : re (z + w) = re z + re w :=
  rfl

@[simp] theorem add_im (z : ℂ) (w : ℂ) : im (z + w) = im z + im w :=
  rfl

@[simp] theorem bit0_re (z : ℂ) : re (bit0 z) = bit0 (re z) :=
  rfl

@[simp] theorem bit1_re (z : ℂ) : re (bit1 z) = bit1 (re z) :=
  rfl

@[simp] theorem bit0_im (z : ℂ) : im (bit0 z) = bit0 (im z) :=
  Eq.refl (im (bit0 z))

@[simp] theorem bit1_im (z : ℂ) : im (bit1 z) = bit0 (im z) :=
  add_zero (im (bit0 z))

@[simp] theorem of_real_add (r : ℝ) (s : ℝ) : ↑(r + s) = ↑r + ↑s := sorry

@[simp] theorem of_real_bit0 (r : ℝ) : ↑(bit0 r) = bit0 ↑r := sorry

@[simp] theorem of_real_bit1 (r : ℝ) : ↑(bit1 r) = bit1 ↑r := sorry

protected instance has_neg : Neg ℂ :=
  { neg := fun (z : ℂ) => mk (-re z) (-im z) }

@[simp] theorem neg_re (z : ℂ) : re (-z) = -re z :=
  rfl

@[simp] theorem neg_im (z : ℂ) : im (-z) = -im z :=
  rfl

@[simp] theorem of_real_neg (r : ℝ) : ↑(-r) = -↑r := sorry

protected instance has_sub : Sub ℂ :=
  { sub := fun (z w : ℂ) => mk (re z - re w) (im z - im w) }

protected instance has_mul : Mul ℂ :=
  { mul := fun (z w : ℂ) => mk (re z * re w - im z * im w) (re z * im w + im z * re w) }

@[simp] theorem mul_re (z : ℂ) (w : ℂ) : re (z * w) = re z * re w - im z * im w :=
  rfl

@[simp] theorem mul_im (z : ℂ) (w : ℂ) : im (z * w) = re z * im w + im z * re w :=
  rfl

@[simp] theorem of_real_mul (r : ℝ) (s : ℝ) : ↑(r * s) = ↑r * ↑s := sorry

theorem smul_re (r : ℝ) (z : ℂ) : re (↑r * z) = r * re z := sorry

theorem smul_im (r : ℝ) (z : ℂ) : im (↑r * z) = r * im z := sorry

theorem of_real_smul (r : ℝ) (z : ℂ) : ↑r * z = mk (r * re z) (r * im z) :=
  ext (smul_re r z) (smul_im r z)

/-! ### The imaginary unit, `I` -/

/-- The imaginary unit. -/
def I : ℂ :=
  mk 0 1

@[simp] theorem I_re : re I = 0 :=
  rfl

@[simp] theorem I_im : im I = 1 :=
  rfl

@[simp] theorem I_mul_I : I * I = -1 := sorry

theorem I_mul (z : ℂ) : I * z = mk (-im z) (re z) := sorry

theorem I_ne_zero : I ≠ 0 :=
  mt (congr_arg im) (ne.symm zero_ne_one)

theorem mk_eq_add_mul_I (a : ℝ) (b : ℝ) : mk a b = ↑a + ↑b * I := sorry

@[simp] theorem re_add_im (z : ℂ) : ↑(re z) + ↑(im z) * I = z := sorry

/-! ### Commutative ring instance and lemmas -/

protected instance comm_ring : comm_ring ℂ :=
  comm_ring.mk Add.add sorry 0 sorry sorry Neg.neg Sub.sub sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry

protected instance re.is_add_group_hom : is_add_group_hom re :=
  is_add_group_hom.mk

protected instance im.is_add_group_hom : is_add_group_hom im :=
  is_add_group_hom.mk

@[simp] theorem I_pow_bit0 (n : ℕ) : I ^ bit0 n = (-1) ^ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (I ^ bit0 n = (-1) ^ n)) (pow_bit0' I n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((I * I) ^ n = (-1) ^ n)) I_mul_I)) (Eq.refl ((-1) ^ n)))

@[simp] theorem I_pow_bit1 (n : ℕ) : I ^ bit1 n = (-1) ^ n * I :=
  eq.mpr (id (Eq._oldrec (Eq.refl (I ^ bit1 n = (-1) ^ n * I)) (pow_bit1' I n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((I * I) ^ n * I = (-1) ^ n * I)) I_mul_I)) (Eq.refl ((-1) ^ n * I)))

/-! ### Complex conjugation -/

/-- The complex conjugate. -/
def conj : ℂ →+* ℂ :=
  ring_hom.mk (fun (z : ℂ) => mk (re z) (-im z)) sorry sorry sorry sorry

@[simp] theorem conj_re (z : ℂ) : re (coe_fn conj z) = re z :=
  rfl

@[simp] theorem conj_im (z : ℂ) : im (coe_fn conj z) = -im z :=
  rfl

@[simp] theorem conj_of_real (r : ℝ) : coe_fn conj ↑r = ↑r := sorry

@[simp] theorem conj_I : coe_fn conj I = -I := sorry

@[simp] theorem conj_bit0 (z : ℂ) : coe_fn conj (bit0 z) = bit0 (coe_fn conj z) := sorry

@[simp] theorem conj_bit1 (z : ℂ) : coe_fn conj (bit1 z) = bit1 (coe_fn conj z) := sorry

@[simp] theorem conj_neg_I : coe_fn conj (-I) = I := sorry

@[simp] theorem conj_conj (z : ℂ) : coe_fn conj (coe_fn conj z) = z := sorry

theorem conj_involutive : function.involutive ⇑conj :=
  conj_conj

theorem conj_bijective : function.bijective ⇑conj :=
  function.involutive.bijective conj_involutive

theorem conj_inj {z : ℂ} {w : ℂ} : coe_fn conj z = coe_fn conj w ↔ z = w :=
  function.injective.eq_iff (and.left conj_bijective)

@[simp] theorem conj_eq_zero {z : ℂ} : coe_fn conj z = 0 ↔ z = 0 := sorry

theorem eq_conj_iff_real {z : ℂ} : coe_fn conj z = z ↔ ∃ (r : ℝ), z = ↑r := sorry

theorem eq_conj_iff_re {z : ℂ} : coe_fn conj z = z ↔ ↑(re z) = z := sorry

protected instance star_ring : star_ring ℂ :=
  star_ring.mk sorry

/-! ### Norm squared -/

/-- The norm squared function. -/
def norm_sq : monoid_with_zero_hom ℂ ℝ :=
  monoid_with_zero_hom.mk (fun (z : ℂ) => re z * re z + im z * im z) sorry sorry sorry

theorem norm_sq_apply (z : ℂ) : coe_fn norm_sq z = re z * re z + im z * im z :=
  rfl

@[simp] theorem norm_sq_of_real (r : ℝ) : coe_fn norm_sq ↑r = r * r := sorry

theorem norm_sq_zero : coe_fn norm_sq 0 = 0 :=
  monoid_with_zero_hom.map_zero norm_sq

theorem norm_sq_one : coe_fn norm_sq 1 = 1 :=
  monoid_with_zero_hom.map_one norm_sq

@[simp] theorem norm_sq_I : coe_fn norm_sq I = 1 := sorry

theorem norm_sq_nonneg (z : ℂ) : 0 ≤ coe_fn norm_sq z :=
  add_nonneg (mul_self_nonneg (re z)) (mul_self_nonneg (im z))

theorem norm_sq_eq_zero {z : ℂ} : coe_fn norm_sq z = 0 ↔ z = 0 := sorry

@[simp] theorem norm_sq_pos {z : ℂ} : 0 < coe_fn norm_sq z ↔ z ≠ 0 :=
  iff.trans (has_le.le.lt_iff_ne (norm_sq_nonneg z)) (not_congr (iff.trans eq_comm norm_sq_eq_zero))

@[simp] theorem norm_sq_neg (z : ℂ) : coe_fn norm_sq (-z) = coe_fn norm_sq z := sorry

@[simp] theorem norm_sq_conj (z : ℂ) : coe_fn norm_sq (coe_fn conj z) = coe_fn norm_sq z := sorry

theorem norm_sq_mul (z : ℂ) (w : ℂ) : coe_fn norm_sq (z * w) = coe_fn norm_sq z * coe_fn norm_sq w :=
  monoid_with_zero_hom.map_mul norm_sq z w

theorem norm_sq_add (z : ℂ) (w : ℂ) : coe_fn norm_sq (z + w) = coe_fn norm_sq z + coe_fn norm_sq w + bit0 1 * re (z * coe_fn conj w) := sorry

theorem re_sq_le_norm_sq (z : ℂ) : re z * re z ≤ coe_fn norm_sq z :=
  le_add_of_nonneg_right (mul_self_nonneg (im z))

theorem im_sq_le_norm_sq (z : ℂ) : im z * im z ≤ coe_fn norm_sq z :=
  le_add_of_nonneg_left (mul_self_nonneg (re z))

theorem mul_conj (z : ℂ) : z * coe_fn conj z = ↑(coe_fn norm_sq z) := sorry

theorem add_conj (z : ℂ) : z + coe_fn conj z = ↑(bit0 1 * re z) := sorry

/-- The coercion `ℝ → ℂ` as a `ring_hom`. -/
def of_real : ℝ →+* ℂ :=
  ring_hom.mk coe of_real_one of_real_mul of_real_zero of_real_add

@[simp] theorem of_real_eq_coe (r : ℝ) : coe_fn of_real r = ↑r :=
  rfl

@[simp] theorem I_sq : I ^ bit0 1 = -1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (I ^ bit0 1 = -1)) (pow_two I)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (I * I = -1)) I_mul_I)) (Eq.refl (-1)))

@[simp] theorem sub_re (z : ℂ) (w : ℂ) : re (z - w) = re z - re w :=
  rfl

@[simp] theorem sub_im (z : ℂ) (w : ℂ) : im (z - w) = im z - im w :=
  rfl

@[simp] theorem of_real_sub (r : ℝ) (s : ℝ) : ↑(r - s) = ↑r - ↑s := sorry

@[simp] theorem of_real_pow (r : ℝ) (n : ℕ) : ↑(r ^ n) = ↑r ^ n := sorry

theorem sub_conj (z : ℂ) : z - coe_fn conj z = ↑(bit0 1 * im z) * I := sorry

theorem norm_sq_sub (z : ℂ) (w : ℂ) : coe_fn norm_sq (z - w) = coe_fn norm_sq z + coe_fn norm_sq w - bit0 1 * re (z * coe_fn conj w) := sorry

/-! ### Inversion -/

protected instance has_inv : has_inv ℂ :=
  has_inv.mk fun (z : ℂ) => coe_fn conj z * ↑(coe_fn norm_sq z⁻¹)

theorem inv_def (z : ℂ) : z⁻¹ = coe_fn conj z * ↑(coe_fn norm_sq z⁻¹) :=
  rfl

@[simp] theorem inv_re (z : ℂ) : re (z⁻¹) = re z / coe_fn norm_sq z := sorry

@[simp] theorem inv_im (z : ℂ) : im (z⁻¹) = -im z / coe_fn norm_sq z := sorry

@[simp] theorem of_real_inv (r : ℝ) : ↑(r⁻¹) = (↑r⁻¹) := sorry

protected theorem inv_zero : 0⁻¹ = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0⁻¹ = 0)) (Eq.symm of_real_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑0⁻¹ = ↑0)) (Eq.symm (of_real_inv 0))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑(0⁻¹) = ↑0)) inv_zero)) (Eq.refl ↑0)))

protected theorem mul_inv_cancel {z : ℂ} (h : z ≠ 0) : z * (z⁻¹) = 1 := sorry

/-! ### Field instance and lemmas -/

protected instance field : field ℂ :=
  field.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 has_inv.inv
    sorry complex.mul_inv_cancel complex.inv_zero

@[simp] theorem I_fpow_bit0 (n : ℤ) : I ^ bit0 n = (-1) ^ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (I ^ bit0 n = (-1) ^ n)) (fpow_bit0' I n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((I * I) ^ n = (-1) ^ n)) I_mul_I)) (Eq.refl ((-1) ^ n)))

@[simp] theorem I_fpow_bit1 (n : ℤ) : I ^ bit1 n = (-1) ^ n * I :=
  eq.mpr (id (Eq._oldrec (Eq.refl (I ^ bit1 n = (-1) ^ n * I)) (fpow_bit1' I n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((I * I) ^ n * I = (-1) ^ n * I)) I_mul_I)) (Eq.refl ((-1) ^ n * I)))

theorem div_re (z : ℂ) (w : ℂ) : re (z / w) = re z * re w / coe_fn norm_sq w + im z * im w / coe_fn norm_sq w := sorry

theorem div_im (z : ℂ) (w : ℂ) : im (z / w) = im z * re w / coe_fn norm_sq w - re z * im w / coe_fn norm_sq w := sorry

@[simp] theorem of_real_div (r : ℝ) (s : ℝ) : ↑(r / s) = ↑r / ↑s :=
  ring_hom.map_div of_real r s

@[simp] theorem of_real_fpow (r : ℝ) (n : ℤ) : ↑(r ^ n) = ↑r ^ n :=
  ring_hom.map_fpow of_real r n

@[simp] theorem div_I (z : ℂ) : z / I = -(z * I) := sorry

@[simp] theorem inv_I : I⁻¹ = -I := sorry

@[simp] theorem norm_sq_inv (z : ℂ) : coe_fn norm_sq (z⁻¹) = (coe_fn norm_sq z⁻¹) :=
  monoid_with_zero_hom.map_inv' norm_sq z

@[simp] theorem norm_sq_div (z : ℂ) (w : ℂ) : coe_fn norm_sq (z / w) = coe_fn norm_sq z / coe_fn norm_sq w :=
  monoid_with_zero_hom.map_div norm_sq z w

/-! ### Cast lemmas -/

@[simp] theorem of_real_nat_cast (n : ℕ) : ↑↑n = ↑n :=
  ring_hom.map_nat_cast of_real n

@[simp] theorem nat_cast_re (n : ℕ) : re ↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (re ↑n = ↑n)) (Eq.symm (of_real_nat_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (re ↑↑n = ↑n)) (of_real_re ↑n))) (Eq.refl ↑n))

@[simp] theorem nat_cast_im (n : ℕ) : im ↑n = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (im ↑n = 0)) (Eq.symm (of_real_nat_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (im ↑↑n = 0)) (of_real_im ↑n))) (Eq.refl 0))

@[simp] theorem of_real_int_cast (n : ℤ) : ↑↑n = ↑n :=
  ring_hom.map_int_cast of_real n

@[simp] theorem int_cast_re (n : ℤ) : re ↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (re ↑n = ↑n)) (Eq.symm (of_real_int_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (re ↑↑n = ↑n)) (of_real_re ↑n))) (Eq.refl ↑n))

@[simp] theorem int_cast_im (n : ℤ) : im ↑n = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (im ↑n = 0)) (Eq.symm (of_real_int_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (im ↑↑n = 0)) (of_real_im ↑n))) (Eq.refl 0))

@[simp] theorem of_real_rat_cast (n : ℚ) : ↑↑n = ↑n :=
  ring_hom.map_rat_cast of_real n

@[simp] theorem rat_cast_re (q : ℚ) : re ↑q = ↑q :=
  eq.mpr (id (Eq._oldrec (Eq.refl (re ↑q = ↑q)) (Eq.symm (of_real_rat_cast q))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (re ↑↑q = ↑q)) (of_real_re ↑q))) (Eq.refl ↑q))

@[simp] theorem rat_cast_im (q : ℚ) : im ↑q = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (im ↑q = 0)) (Eq.symm (of_real_rat_cast q))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (im ↑↑q = 0)) (of_real_im ↑q))) (Eq.refl 0))

/-! ### Characteristic zero -/

protected instance char_zero_complex : char_zero ℂ :=
  char_zero_of_inj_zero
    fun (n : ℕ) (h : ↑n = 0) =>
      eq.mp (Eq._oldrec (Eq.refl (↑n = 0)) (propext nat.cast_eq_zero))
        (eq.mp (Eq._oldrec (Eq.refl (↑↑n = 0)) (propext of_real_eq_zero))
          (eq.mp (Eq._oldrec (Eq.refl (↑n = 0)) (Eq.symm (of_real_nat_cast n))) h))

/-- A complex number `z` plus its conjugate `conj z` is `2` times its real part. -/
theorem re_eq_add_conj (z : ℂ) : ↑(re z) = (z + coe_fn conj z) / bit0 1 := sorry

/-- A complex number `z` minus its conjugate `conj z` is `2i` times its imaginary part. -/
theorem im_eq_sub_conj (z : ℂ) : ↑(im z) = (z - coe_fn conj z) / (bit0 1 * I) := sorry

/-! ### Absolute value -/

/-- The complex absolute value function, defined as the square root of the norm squared. -/
def abs (z : ℂ) : ℝ :=
  real.sqrt (coe_fn norm_sq z)

@[simp] theorem abs_of_real (r : ℝ) : abs ↑r = abs r := sorry

theorem abs_of_nonneg {r : ℝ} (h : 0 ≤ r) : abs ↑r = r :=
  Eq.trans (abs_of_real r) (abs_of_nonneg h)

theorem abs_of_nat (n : ℕ) : abs ↑n = ↑n :=
  Eq.trans (eq.mpr (id (Eq._oldrec (Eq.refl (abs ↑n = abs ↑↑n)) (of_real_nat_cast n))) (Eq.refl (abs ↑n)))
    (abs_of_nonneg (nat.cast_nonneg n))

theorem mul_self_abs (z : ℂ) : abs z * abs z = coe_fn norm_sq z :=
  real.mul_self_sqrt (norm_sq_nonneg z)

@[simp] theorem abs_zero : abs 0 = 0 := sorry

@[simp] theorem abs_one : abs 1 = 1 := sorry

@[simp] theorem abs_I : abs I = 1 := sorry

@[simp] theorem abs_two : abs (bit0 1) = bit0 1 := sorry

theorem abs_nonneg (z : ℂ) : 0 ≤ abs z :=
  real.sqrt_nonneg (coe_fn norm_sq z)

@[simp] theorem abs_eq_zero {z : ℂ} : abs z = 0 ↔ z = 0 :=
  iff.trans (real.sqrt_eq_zero (norm_sq_nonneg z)) norm_sq_eq_zero

theorem abs_ne_zero {z : ℂ} : abs z ≠ 0 ↔ z ≠ 0 :=
  not_congr abs_eq_zero

@[simp] theorem abs_conj (z : ℂ) : abs (coe_fn conj z) = abs z := sorry

@[simp] theorem abs_mul (z : ℂ) (w : ℂ) : abs (z * w) = abs z * abs w := sorry

theorem abs_re_le_abs (z : ℂ) : abs (re z) ≤ abs z := sorry

theorem abs_im_le_abs (z : ℂ) : abs (im z) ≤ abs z := sorry

theorem re_le_abs (z : ℂ) : re z ≤ abs z :=
  and.right (iff.mp abs_le (abs_re_le_abs z))

theorem im_le_abs (z : ℂ) : im z ≤ abs z :=
  and.right (iff.mp abs_le (abs_im_le_abs z))

theorem abs_add (z : ℂ) (w : ℂ) : abs (z + w) ≤ abs z + abs w := sorry

protected instance abs.is_absolute_value : is_absolute_value abs :=
  is_absolute_value.mk abs_nonneg (fun (_x : ℂ) => abs_eq_zero) abs_add abs_mul

@[simp] theorem abs_abs (z : ℂ) : abs (abs z) = abs z :=
  abs_of_nonneg (abs_nonneg z)

@[simp] theorem abs_pos {z : ℂ} : 0 < abs z ↔ z ≠ 0 :=
  is_absolute_value.abv_pos abs

@[simp] theorem abs_neg (z : ℂ) : abs (-z) = abs z :=
  is_absolute_value.abv_neg abs

theorem abs_sub (z : ℂ) (w : ℂ) : abs (z - w) = abs (w - z) :=
  is_absolute_value.abv_sub abs

theorem abs_sub_le (a : ℂ) (b : ℂ) (c : ℂ) : abs (a - c) ≤ abs (a - b) + abs (b - c) :=
  is_absolute_value.abv_sub_le abs

@[simp] theorem abs_inv (z : ℂ) : abs (z⁻¹) = (abs z⁻¹) :=
  is_absolute_value.abv_inv abs

@[simp] theorem abs_div (z : ℂ) (w : ℂ) : abs (z / w) = abs z / abs w :=
  is_absolute_value.abv_div abs

theorem abs_abs_sub_le_abs_sub (z : ℂ) (w : ℂ) : abs (abs z - abs w) ≤ abs (z - w) :=
  is_absolute_value.abs_abv_sub_le_abv_sub abs

theorem abs_le_abs_re_add_abs_im (z : ℂ) : abs z ≤ abs (re z) + abs (im z) := sorry

theorem abs_re_div_abs_le_one (z : ℂ) : abs (re z / abs z) ≤ 1 := sorry

theorem abs_im_div_abs_le_one (z : ℂ) : abs (im z / abs z) ≤ 1 := sorry

@[simp] theorem abs_cast_nat (n : ℕ) : abs ↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (abs ↑n = ↑n)) (Eq.symm (of_real_nat_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (abs ↑↑n = ↑n)) (abs_of_nonneg (nat.cast_nonneg n)))) (Eq.refl ↑n))

@[simp] theorem int_cast_abs (n : ℤ) : ↑(abs n) = abs ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(abs n) = abs ↑n)) (Eq.symm (of_real_int_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(abs n) = abs ↑↑n)) (abs_of_real ↑n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑(abs n) = abs ↑n)) int.cast_abs)) (Eq.refl (abs ↑n))))

theorem norm_sq_eq_abs (x : ℂ) : coe_fn norm_sq x = abs x ^ bit0 1 := sorry

/-! ### Cauchy sequences -/

theorem is_cau_seq_re (f : cau_seq ℂ abs) : is_cau_seq abs fun (n : ℕ) => re (coe_fn f n) := sorry

theorem is_cau_seq_im (f : cau_seq ℂ abs) : is_cau_seq abs fun (n : ℕ) => im (coe_fn f n) := sorry

/-- The real part of a complex Cauchy sequence, as a real Cauchy sequence. -/
def cau_seq_re (f : cau_seq ℂ abs) : cau_seq ℝ abs :=
  { val := fun (n : ℕ) => re (coe_fn f n), property := is_cau_seq_re f }

/-- The imaginary part of a complex Cauchy sequence, as a real Cauchy sequence. -/
def cau_seq_im (f : cau_seq ℂ abs) : cau_seq ℝ abs :=
  { val := fun (n : ℕ) => im (coe_fn f n), property := is_cau_seq_im f }

theorem is_cau_seq_abs {f : ℕ → ℂ} (hf : is_cau_seq abs f) : is_cau_seq abs (abs ∘ f) := sorry

/-- The limit of a Cauchy sequence of complex numbers. -/
def lim_aux (f : cau_seq ℂ abs) : ℂ :=
  mk (cau_seq.lim (cau_seq_re f)) (cau_seq.lim (cau_seq_im f))

theorem equiv_lim_aux (f : cau_seq ℂ abs) : f ≈ cau_seq.const abs (lim_aux f) := sorry

protected instance abs.cau_seq.is_complete : cau_seq.is_complete ℂ abs :=
  cau_seq.is_complete.mk sorry

theorem lim_eq_lim_im_add_lim_re (f : cau_seq ℂ abs) : cau_seq.lim f = ↑(cau_seq.lim (cau_seq_re f)) + ↑(cau_seq.lim (cau_seq_im f)) * I := sorry

theorem lim_re (f : cau_seq ℂ abs) : cau_seq.lim (cau_seq_re f) = re (cau_seq.lim f) := sorry

theorem lim_im (f : cau_seq ℂ abs) : cau_seq.lim (cau_seq_im f) = im (cau_seq.lim f) := sorry

theorem is_cau_seq_conj (f : cau_seq ℂ abs) : is_cau_seq abs fun (n : ℕ) => coe_fn conj (coe_fn f n) := sorry

/-- The complex conjugate of a complex Cauchy sequence, as a complex Cauchy sequence. -/
def cau_seq_conj (f : cau_seq ℂ abs) : cau_seq ℂ abs :=
  { val := fun (n : ℕ) => coe_fn conj (coe_fn f n), property := is_cau_seq_conj f }

theorem lim_conj (f : cau_seq ℂ abs) : cau_seq.lim (cau_seq_conj f) = coe_fn conj (cau_seq.lim f) := sorry

/-- The absolute value of a complex Cauchy sequence, as a real Cauchy sequence. -/
def cau_seq_abs (f : cau_seq ℂ abs) : cau_seq ℝ abs :=
  { val := abs ∘ subtype.val f, property := sorry }

theorem lim_abs (f : cau_seq ℂ abs) : cau_seq.lim (cau_seq_abs f) = abs (cau_seq.lim f) := sorry

@[simp] theorem of_real_prod {α : Type u_1} (s : finset α) (f : α → ℝ) : ↑(finset.prod s fun (i : α) => f i) = finset.prod s fun (i : α) => ↑(f i) :=
  ring_hom.map_prod of_real (fun (x : α) => f x) s

@[simp] theorem of_real_sum {α : Type u_1} (s : finset α) (f : α → ℝ) : ↑(finset.sum s fun (i : α) => f i) = finset.sum s fun (i : α) => ↑(f i) :=
  ring_hom.map_sum of_real (fun (x : α) => f x) s


/-
Copyright (c) 2022 Yaël Dillies, Sara Rousta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Sara Rousta
-/
import data.set_like.basic
import order.hom.complete_lattice

/-!
# Up-sets and down-sets

This file defines upper and lower sets in an order.

## Main declarations

* `is_upper_set`: Predicate for a set to be an upper set. This means every element greater than a
  member of the set is in the set itself.
* `is_lower_set`: Predicate for a set to be a lower set. This means every element less than a member
  of the set is in the set itself.
* `upper_set`: The type of upper sets.
* `lower_set`: The type of lower sets.
* `upper_set.Ici`: Principal upper set. `set.Ici` as an upper set.
* `upper_set.Ioi`: Strict principal upper set. `set.Ioi` as an upper set.
* `lower_set.Iic`: Principal lower set. `set.Iic` as an lower set.
* `lower_set.Iio`: Strict principal lower set. `set.Iio` as an lower set.

## Notes

Upper sets are ordered by **reverse** inclusion. This convention is motivated by the fact that this
makes them order-isomorphic to lower sets and antichains, and matches the convention on `filter`.

## TODO

Lattice structure on antichains. Order equivalence between upper/lower sets and antichains.
-/

open order_dual set

variables {α : Type*} {ι : Sort*} {κ : ι → Sort*}

/-! ### Unbundled upper/lower sets -/

section has_le
variables [has_le α] {s t : set α}

/-- An upper set in an order `α` is a set such that any element greater than one of its members is
also a member. Also called up-set, upward-closed set. -/
def is_upper_set (s : set α) : Prop := ∀ ⦃a b : α⦄, a ≤ b → a ∈ s → b ∈ s

/-- A lower set in an order `α` is a set such that any element less than one of its members is also
a member. Also called down-set, downward-closed set. -/
def is_lower_set (s : set α) : Prop := ∀ ⦃a b : α⦄, b ≤ a → a ∈ s → b ∈ s

lemma is_upper_set_empty : is_upper_set (∅ : set α) := λ _ _ _, id
lemma is_lower_set_empty : is_lower_set (∅ : set α) := λ _ _ _, id
lemma is_upper_set_univ : is_upper_set (univ : set α) := λ _ _ _, id
lemma is_lower_set_univ : is_lower_set (univ : set α) := λ _ _ _, id
lemma is_upper_set.compl (hs : is_upper_set s) : is_lower_set sᶜ := λ a b h hb ha, hb $ hs h ha
lemma is_lower_set.compl (hs : is_lower_set s) : is_upper_set sᶜ := λ a b h hb ha, hb $ hs h ha

lemma is_upper_set.union (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ∪ t) :=
λ a b h, or.imp (hs h) (ht h)

lemma is_lower_set.union (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ∪ t) :=
λ a b h, or.imp (hs h) (ht h)

lemma is_upper_set.inter (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ∩ t) :=
λ a b h, and.imp (hs h) (ht h)

lemma is_lower_set.inter (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ∩ t) :=
λ a b h, and.imp (hs h) (ht h)

lemma is_upper_set_Union {f : ι → set α} (hf : ∀ i, is_upper_set (f i)) : is_upper_set (⋃ i, f i) :=
λ a b h, Exists₂.imp $ forall_range_iff.2 $ λ i, hf i h

lemma is_lower_set_Union {f : ι → set α} (hf : ∀ i, is_lower_set (f i)) : is_lower_set (⋃ i, f i) :=
λ a b h, Exists₂.imp $ forall_range_iff.2 $ λ i, hf i h

lemma is_upper_set_Union₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_upper_set (f i j)) :
  is_upper_set (⋃ i j, f i j) :=
is_upper_set_Union $ λ i, is_upper_set_Union $ hf i

lemma is_lower_set_Union₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_lower_set (f i j)) :
  is_lower_set (⋃ i j, f i j) :=
is_lower_set_Union $ λ i, is_lower_set_Union $ hf i

lemma is_upper_set_sUnion {S : set (set α)} (hf : ∀ s ∈ S, is_upper_set s) : is_upper_set (⋃₀ S) :=
λ a b h, Exists₂.imp $ λ s hs, hf s hs h

lemma is_lower_set_sUnion {S : set (set α)} (hf : ∀ s ∈ S, is_lower_set s) : is_lower_set (⋃₀ S) :=
λ a b h, Exists₂.imp $ λ s hs, hf s hs h

lemma is_upper_set_Inter {f : ι → set α} (hf : ∀ i, is_upper_set (f i)) : is_upper_set (⋂ i, f i) :=
λ a b h, forall₂_imp $ forall_range_iff.2 $ λ i, hf i h

lemma is_lower_set_Inter {f : ι → set α} (hf : ∀ i, is_lower_set (f i)) : is_lower_set (⋂ i, f i) :=
λ a b h, forall₂_imp $ forall_range_iff.2 $ λ i, hf i h

lemma is_upper_set_Inter₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_upper_set (f i j)) :
  is_upper_set (⋂ i j, f i j) :=
is_upper_set_Inter $ λ i, is_upper_set_Inter $ hf i

lemma is_lower_set_Inter₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_lower_set (f i j)) :
  is_lower_set (⋂ i j, f i j) :=
is_lower_set_Inter $ λ i, is_lower_set_Inter $ hf i

lemma is_upper_set_sInter {S : set (set α)} (hf : ∀ s ∈ S, is_upper_set s) : is_upper_set (⋂₀ S) :=
λ a b h, forall₂_imp $ λ s hs, hf s hs h

lemma is_lower_set_sInter {S : set (set α)} (hf : ∀ s ∈ S, is_lower_set s) : is_lower_set (⋂₀ S) :=
λ a b h, forall₂_imp $ λ s hs, hf s hs h

@[simp] lemma is_lower_set_preimage_of_dual_iff : is_lower_set (of_dual ⁻¹' s) ↔ is_upper_set s :=
iff.rfl
@[simp] lemma is_upper_set_preimage_of_dual_iff : is_upper_set (of_dual ⁻¹' s) ↔ is_lower_set s :=
iff.rfl
@[simp] lemma is_lower_set_preimage_to_dual_iff {s : set αᵒᵈ} :
  is_lower_set (to_dual ⁻¹' s) ↔ is_upper_set s := iff.rfl
@[simp] lemma is_upper_set_preimage_to_dual_iff {s : set αᵒᵈ} :
  is_upper_set (to_dual ⁻¹' s) ↔ is_lower_set s := iff.rfl

alias is_lower_set_preimage_of_dual_iff ↔ _ is_upper_set.of_dual
alias is_upper_set_preimage_of_dual_iff ↔ _ is_lower_set.of_dual
alias is_lower_set_preimage_to_dual_iff ↔ _ is_upper_set.to_dual
alias is_upper_set_preimage_to_dual_iff ↔ _ is_lower_set.to_dual

end has_le

section preorder
variables [preorder α] (a : α)

lemma is_upper_set_Ici : is_upper_set (Ici a) := λ _ _, ge_trans
lemma is_lower_set_Iic : is_lower_set (Iic a) := λ _ _, le_trans
lemma is_upper_set_Ioi : is_upper_set (Ioi a) := λ _ _, flip lt_of_lt_of_le
lemma is_lower_set_Iio : is_lower_set (Iio a) := λ _ _, lt_of_le_of_lt

end preorder

/-! ### Bundled upper/lower sets -/

section has_le
variables [has_le α]

/-- The type of upper sets of an order. -/
structure upper_set (α : Type*) [has_le α] :=
(carrier : set α)
(upper' : is_upper_set carrier)

/-- The type of lower sets of an order. -/
structure lower_set (α : Type*) [has_le α] :=
(carrier : set α)
(lower' : is_lower_set carrier)

namespace upper_set

instance : set_like (upper_set α) α :=
{ coe := upper_set.carrier,
  coe_injective' := λ s t h, by { cases s, cases t, congr' } }

@[ext] lemma ext {s t : upper_set α} : (s : set α) = t → s = t := set_like.ext'

@[simp] lemma carrier_eq_coe (s : upper_set α) : s.carrier = s := rfl

protected lemma upper (s : upper_set α) : is_upper_set (s : set α) := s.upper'

end upper_set

namespace lower_set

instance : set_like (lower_set α) α :=
{ coe := lower_set.carrier,
  coe_injective' := λ s t h, by { cases s, cases t, congr' } }

@[ext] lemma ext {s t : lower_set α} : (s : set α) = t → s = t := set_like.ext'

@[simp] lemma carrier_eq_coe (s : lower_set α) : s.carrier = s := rfl

protected lemma lower (s : lower_set α) : is_lower_set (s : set α) := s.lower'

end lower_set

/-! #### Order -/

namespace upper_set
variables {S : set (upper_set α)} {s t : upper_set α} {a : α}

instance : has_sup (upper_set α) := ⟨λ s t, ⟨s ∩ t, s.upper.inter t.upper⟩⟩
instance : has_inf (upper_set α) := ⟨λ s t, ⟨s ∪ t, s.upper.union t.upper⟩⟩
instance : has_top (upper_set α) := ⟨⟨∅, is_upper_set_empty⟩⟩
instance : has_bot (upper_set α) := ⟨⟨univ, is_upper_set_univ⟩⟩
instance : has_Sup (upper_set α) :=
⟨λ S, ⟨⋂ s ∈ S, ↑s, is_upper_set_Inter₂ $ λ s _, s.upper⟩⟩
instance : has_Inf (upper_set α) :=
⟨λ S, ⟨⋃ s ∈ S, ↑s, is_upper_set_Union₂ $ λ s _, s.upper⟩⟩

instance : complete_distrib_lattice (upper_set α) :=
(to_dual.injective.comp $ set_like.coe_injective).complete_distrib_lattice _
  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) rfl rfl

instance : inhabited (upper_set α) := ⟨⊥⟩

@[simp] lemma coe_top : ((⊤ : upper_set α) : set α) = ∅ := rfl
@[simp] lemma coe_bot : ((⊥ : upper_set α) : set α) = univ := rfl
@[simp] lemma coe_sup (s t : upper_set α) : (↑(s ⊔ t) : set α) = s ∩ t := rfl
@[simp] lemma coe_inf (s t : upper_set α) : (↑(s ⊓ t) : set α) = s ∪ t := rfl
@[simp] lemma coe_Sup (S : set (upper_set α)) : (↑(Sup S) : set α) = ⋂ s ∈ S, ↑s := rfl
@[simp] lemma coe_Inf (S : set (upper_set α)) : (↑(Inf S) : set α) = ⋃ s ∈ S, ↑s := rfl
@[simp] lemma coe_supr (f : ι → upper_set α) : (↑(⨆ i, f i) : set α) = ⋂ i, f i := by simp [supr]
@[simp] lemma coe_infi (f : ι → upper_set α) : (↑(⨅ i, f i) : set α) = ⋃ i, f i := by simp [infi]
@[simp] lemma coe_supr₂ (f : Π i, κ i → upper_set α) : (↑(⨆ i j, f i j) : set α) = ⋂ i j, f i j :=
by simp_rw coe_supr
@[simp] lemma coe_infi₂ (f : Π i, κ i → upper_set α) : (↑(⨅ i j, f i j) : set α) = ⋃ i j, f i j :=
by simp_rw coe_infi

@[simp] lemma not_mem_top : a ∉ (⊤ : upper_set α) := id
@[simp] lemma mem_bot : a ∈ (⊥ : upper_set α) := trivial
@[simp] lemma mem_sup_iff : a ∈ s ⊔ t ↔ a ∈ s ∧ a ∈ t := iff.rfl
@[simp] lemma mem_inf_iff : a ∈ s ⊓ t ↔ a ∈ s ∨ a ∈ t := iff.rfl
@[simp] lemma mem_Sup_iff : a ∈ Sup S ↔ ∀ s ∈ S, a ∈ s := mem_Inter₂
@[simp] lemma mem_Inf_iff  : a ∈ Inf S ↔ ∃ s ∈ S, a ∈ s := mem_Union₂
@[simp] lemma mem_supr_iff {f : ι → upper_set α} : a ∈ (⨆ i, f i) ↔ ∀ i, a ∈ f i :=
by { rw [←set_like.mem_coe, coe_supr], exact mem_Inter }
@[simp] lemma mem_infi_iff {f : ι → upper_set α} : a ∈ (⨅ i, f i) ↔ ∃ i, a ∈ f i :=
by { rw [←set_like.mem_coe, coe_infi], exact mem_Union }
@[simp] lemma mem_supr₂_iff {f : Π i, κ i → upper_set α} : a ∈ (⨆ i j, f i j) ↔ ∀ i j, a ∈ f i j :=
by simp_rw mem_supr_iff
@[simp] lemma mem_infi₂_iff {f : Π i, κ i → upper_set α} : a ∈ (⨅ i j, f i j) ↔ ∃ i j, a ∈ f i j :=
by simp_rw mem_infi_iff

end upper_set

namespace lower_set
variables {S : set (lower_set α)} {s t : lower_set α} {a : α}

instance : has_sup (lower_set α) := ⟨λ s t, ⟨s ∪ t, λ a b h, or.imp (s.lower h) (t.lower h)⟩⟩
instance : has_inf (lower_set α) := ⟨λ s t, ⟨s ∩ t, λ a b h, and.imp (s.lower h) (t.lower h)⟩⟩
instance : has_top (lower_set α) := ⟨⟨univ, λ a b h, id⟩⟩
instance : has_bot (lower_set α) := ⟨⟨∅, λ a b h, id⟩⟩
instance : has_Sup (lower_set α) := ⟨λ S, ⟨⋃ s ∈ S, ↑s, is_lower_set_Union₂ $ λ s _, s.lower⟩⟩
instance : has_Inf (lower_set α) := ⟨λ S, ⟨⋂ s ∈ S, ↑s, is_lower_set_Inter₂ $ λ s _, s.lower⟩⟩

instance : complete_distrib_lattice (lower_set α) :=
set_like.coe_injective.complete_distrib_lattice _
  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) rfl rfl

instance : inhabited (lower_set α) := ⟨⊥⟩

@[simp] lemma coe_top : ((⊤ : lower_set α) : set α) = univ := rfl
@[simp] lemma coe_bot : ((⊥ : lower_set α) : set α) = ∅ := rfl
@[simp] lemma coe_sup (s t : lower_set α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
@[simp] lemma coe_inf (s t : lower_set α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
@[simp] lemma coe_Sup (S : set (lower_set α)) : (↑(Sup S) : set α) = ⋃ s ∈ S, ↑s := rfl
@[simp] lemma coe_Inf (S : set (lower_set α)) : (↑(Inf S) : set α) = ⋂ s ∈ S, ↑s := rfl
@[simp] lemma coe_supr (f : ι → lower_set α) : (↑(⨆ i, f i) : set α) = ⋃ i, f i :=
by simp_rw [supr, coe_Sup, mem_range, Union_exists, Union_Union_eq']
@[simp] lemma coe_infi (f : ι → lower_set α) : (↑(⨅ i, f i) : set α) = ⋂ i, f i :=
by simp_rw [infi, coe_Inf, mem_range, Inter_exists, Inter_Inter_eq']
@[simp] lemma coe_supr₂ (f : Π i, κ i → lower_set α) : (↑(⨆ i j, f i j) : set α) = ⋃ i j, f i j :=
by simp_rw coe_supr
@[simp] lemma coe_infi₂ (f : Π i, κ i → lower_set α) : (↑(⨅ i j, f i j) : set α) = ⋂ i j, f i j :=
by simp_rw coe_infi

@[simp] lemma mem_top : a ∈ (⊤ : lower_set α) := trivial
@[simp] lemma not_mem_bot : a ∉ (⊥ : lower_set α) := id
@[simp] lemma mem_sup_iff : a ∈ s ⊔ t ↔ a ∈ s ∨ a ∈ t := iff.rfl
@[simp] lemma mem_inf_iff : a ∈ s ⊓ t ↔ a ∈ s ∧ a ∈ t := iff.rfl
@[simp] lemma mem_Sup_iff : a ∈ Sup S ↔ ∃ s ∈ S, a ∈ s := mem_Union₂
@[simp] lemma mem_Inf_iff  : a ∈ Inf S ↔ ∀ s ∈ S, a ∈ s := mem_Inter₂
@[simp] lemma mem_supr_iff {f : ι → lower_set α} : a ∈ (⨆ i, f i) ↔ ∃ i, a ∈ f i :=
by { rw [←set_like.mem_coe, coe_supr], exact mem_Union }
@[simp] lemma mem_infi_iff {f : ι → lower_set α} : a ∈ (⨅ i, f i) ↔ ∀ i, a ∈ f i :=
by { rw [←set_like.mem_coe, coe_infi], exact mem_Inter }
@[simp] lemma mem_supr₂_iff {f : Π i, κ i → lower_set α} : a ∈ (⨆ i j, f i j) ↔ ∃ i j, a ∈ f i j :=
by simp_rw mem_supr_iff
@[simp] lemma mem_infi₂_iff {f : Π i, κ i → lower_set α} : a ∈ (⨅ i j, f i j) ↔ ∀ i j, a ∈ f i j :=
by simp_rw mem_infi_iff

end lower_set

/-! #### Complement -/

/-- The complement of a lower set as an upper set. -/
def upper_set.compl (s : upper_set α) : lower_set α := ⟨sᶜ, s.upper.compl⟩

/-- The complement of a lower set as an upper set. -/
def lower_set.compl (s : lower_set α) : upper_set α := ⟨sᶜ, s.lower.compl⟩

namespace upper_set
variables {s t : upper_set α} {a : α}

@[simp] lemma coe_compl (s : upper_set α) : (s.compl : set α) = sᶜ := rfl
@[simp] lemma mem_compl_iff : a ∈ s.compl ↔ a ∉ s := iff.rfl
@[simp] lemma compl_compl (s : upper_set α) : s.compl.compl = s := upper_set.ext $ compl_compl _
@[simp] lemma compl_le_compl : s.compl ≤ t.compl ↔ s ≤ t := compl_subset_compl

@[simp] protected lemma compl_sup (s t : upper_set α) : (s ⊔ t).compl = s.compl ⊔ t.compl :=
lower_set.ext compl_inf
@[simp] protected lemma compl_inf (s t : upper_set α) : (s ⊓ t).compl = s.compl ⊓ t.compl :=
lower_set.ext compl_sup
@[simp] protected lemma compl_top : (⊤ : upper_set α).compl = ⊤ := lower_set.ext compl_empty
@[simp] protected lemma compl_bot : (⊥ : upper_set α).compl = ⊥  := lower_set.ext compl_univ
@[simp] protected lemma compl_Sup (S : set (upper_set α)) :
  (Sup S).compl = ⨆ s ∈ S, upper_set.compl s :=
lower_set.ext $ by simp only [coe_compl, coe_Sup, compl_Inter₂, lower_set.coe_supr₂]

@[simp] protected lemma compl_Inf (S : set (upper_set α)) :
  (Inf S).compl = ⨅ s ∈ S, upper_set.compl s :=
lower_set.ext $ by simp only [coe_compl, coe_Inf, compl_Union₂, lower_set.coe_infi₂]

@[simp] protected lemma compl_supr (f : ι → upper_set α) : (⨆ i, f i).compl = ⨆ i, (f i).compl :=
lower_set.ext $ by simp only [coe_compl, coe_supr, compl_Inter, lower_set.coe_supr]

@[simp] protected lemma compl_infi (f : ι → upper_set α) : (⨅ i, f i).compl = ⨅ i, (f i).compl :=
lower_set.ext $ by simp only [coe_compl, coe_infi, compl_Union, lower_set.coe_infi]

@[simp] lemma compl_supr₂ (f : Π i, κ i → upper_set α) :
  (⨆ i j, f i j).compl = ⨆ i j, (f i j).compl :=
by simp_rw upper_set.compl_supr

@[simp] lemma compl_infi₂ (f : Π i, κ i → upper_set α) :
  (⨅ i j, f i j).compl = ⨅ i j, (f i j).compl :=
by simp_rw upper_set.compl_infi

end upper_set

namespace lower_set
variables {s t : lower_set α} {a : α}

@[simp] lemma coe_compl (s : lower_set α) : (s.compl : set α) = sᶜ := rfl
@[simp] lemma mem_compl_iff : a ∈ s.compl ↔ a ∉ s := iff.rfl
@[simp] lemma compl_compl (s : lower_set α) : s.compl.compl = s := lower_set.ext $ compl_compl _
@[simp] lemma compl_le_compl : s.compl ≤ t.compl ↔ s ≤ t := compl_subset_compl

protected lemma compl_sup (s t : lower_set α) : (s ⊔ t).compl = s.compl ⊔ t.compl :=
upper_set.ext compl_sup
protected lemma compl_inf (s t : lower_set α) : (s ⊓ t).compl = s.compl ⊓ t.compl :=
upper_set.ext compl_inf
protected lemma compl_top : (⊤ : lower_set α).compl = ⊤ := upper_set.ext compl_univ
protected lemma compl_bot : (⊥ : lower_set α).compl = ⊥ := upper_set.ext compl_empty
protected lemma compl_Sup (S : set (lower_set α)) : (Sup S).compl = ⨆ s ∈ S, lower_set.compl s :=
upper_set.ext $ by simp only [coe_compl, coe_Sup, compl_Union₂, upper_set.coe_supr₂]

protected lemma compl_Inf (S : set (lower_set α)) : (Inf S).compl = ⨅ s ∈ S, lower_set.compl s :=
upper_set.ext $ by simp only [coe_compl, coe_Inf, compl_Inter₂, upper_set.coe_infi₂]

protected lemma compl_supr (f : ι → lower_set α) : (⨆ i, f i).compl = ⨆ i, (f i).compl :=
upper_set.ext $ by simp only [coe_compl, coe_supr, compl_Union, upper_set.coe_supr]

protected lemma compl_infi (f : ι → lower_set α) : (⨅ i, f i).compl = ⨅ i, (f i).compl :=
upper_set.ext $ by simp only [coe_compl, coe_infi, compl_Inter, upper_set.coe_infi]

@[simp] lemma compl_supr₂ (f : Π i, κ i → lower_set α) :
  (⨆ i j, f i j).compl = ⨆ i j, (f i j).compl :=
by simp_rw lower_set.compl_supr

@[simp] lemma compl_infi₂ (f : Π i, κ i → lower_set α) :
  (⨅ i j, f i j).compl = ⨅ i j, (f i j).compl :=
by simp_rw lower_set.compl_infi

end lower_set

/-- Upper sets are order-isomorphic to lower sets under complementation. -/
@[simps] def upper_set_iso_lower_set : upper_set α ≃o lower_set α :=
{ to_fun := upper_set.compl,
  inv_fun := lower_set.compl,
  left_inv := upper_set.compl_compl,
  right_inv := lower_set.compl_compl,
  map_rel_iff' := λ _ _, upper_set.compl_le_compl }

end has_le

/-! #### Principal sets -/

namespace upper_set
section preorder
variables [preorder α] {a b : α}

/-- The smallest upper set containing a given element. -/
def Ici (a : α) : upper_set α := ⟨Ici a, is_upper_set_Ici a⟩

/-- The smallest upper set containing a given element. -/
def Ioi (a : α) : upper_set α := ⟨Ioi a, is_upper_set_Ioi a⟩

@[simp] lemma coe_Ici (a : α) : ↑(Ici a) = set.Ici a := rfl
@[simp] lemma coe_Ioi (a : α) : ↑(Ioi a) = set.Ioi a := rfl
@[simp] lemma mem_Ici_iff : b ∈ Ici a ↔ a ≤ b := iff.rfl
@[simp] lemma mem_Ioi_iff : b ∈ Ioi a ↔ a < b := iff.rfl

lemma Icoi_le_Ioi (a : α) : Ici a ≤ Ioi a := Ioi_subset_Ici_self

@[simp] lemma Ioi_top [order_top α] : Ioi (⊤ : α) = ⊤ := set_like.coe_injective Ioi_top
@[simp] lemma Ici_bot [order_bot α] : Ici (⊥ : α) = ⊥ := set_like.coe_injective Ici_bot

end preorder

section semilattice_sup
variables [semilattice_sup α]

@[simp] lemma Ici_sup (a b : α) : Ici (a ⊔ b) = Ici a ⊔ Ici b := ext Ici_inter_Ici.symm

/-- `upper_set.Ici` as a `sup_hom`. -/
def Ici_sup_hom : sup_hom α (upper_set α) := ⟨Ici, Ici_sup⟩

@[simp] lemma Ici_sup_hom_apply (a : α) : Ici_sup_hom a = (Ici a) := rfl

end semilattice_sup

section complete_lattice
variables [complete_lattice α]

@[simp] lemma Ici_Sup (S : set α) : Ici (Sup S) = ⨆ a ∈ S, Ici a :=
set_like.ext $ λ c, by simp only [mem_Ici_iff, mem_supr_iff, Sup_le_iff]

@[simp] lemma Ici_supr (f : ι → α) : Ici (⨆ i, f i) = ⨆ i, Ici (f i) :=
set_like.ext $ λ c, by simp only [mem_Ici_iff, mem_supr_iff, supr_le_iff]

@[simp] lemma Ici_supr₂ (f : Π i, κ i → α) : Ici (⨆ i j, f i j) = ⨆ i j, Ici (f i j) :=
by simp_rw Ici_supr

/-- `upper_set.Ici` as a `Sup_hom`. -/
def Ici_Sup_hom : Sup_hom α (upper_set α) := ⟨Ici, λ s, (Ici_Sup s).trans Sup_image.symm⟩

@[simp] lemma Ici_Sup_hom_apply (a : α) : Ici_Sup_hom a = to_dual (Ici a) := rfl

end complete_lattice
end upper_set

namespace lower_set
section preorder
variables [preorder α] {a b : α}

/-- Principal lower set. `set.Iic` as a lower set. The smallest lower set containing a given
element. -/
def Iic (a : α) : lower_set α := ⟨Iic a, is_lower_set_Iic a⟩

/-- Strict principal lower set. `set.Iio` as a lower set. -/
def Iio (a : α) : lower_set α := ⟨Iio a, is_lower_set_Iio a⟩

@[simp] lemma coe_Iic (a : α) : ↑(Iic a) = set.Iic a := rfl
@[simp] lemma coe_Iio (a : α) : ↑(Iio a) = set.Iio a := rfl
@[simp] lemma mem_Iic_iff : b ∈ Iic a ↔ b ≤ a := iff.rfl
@[simp] lemma mem_Iio_iff : b ∈ Iio a ↔ b < a := iff.rfl

lemma Ioi_le_Ici (a : α) : Ioi a ≤ Ici a := Ioi_subset_Ici_self

@[simp] lemma Iic_top [order_top α] : Iic (⊤ : α) = ⊤ := set_like.coe_injective Iic_top
@[simp] lemma Iio_bot [order_bot α] : Iio (⊥ : α) = ⊥ := set_like.coe_injective Iio_bot

end preorder

section semilattice_inf
variables [semilattice_inf α]

@[simp] lemma Iic_inf (a b : α) : Iic (a ⊓ b) = Iic a ⊓ Iic b :=
set_like.coe_injective Iic_inter_Iic.symm

/-- `lower_set.Iic` as an `inf_hom`. -/
def Iic_inf_hom : inf_hom α (lower_set α) := ⟨Iic, Iic_inf⟩

@[simp] lemma coe_Iic_inf_hom : (Iic_inf_hom : α → lower_set α) = Iic := rfl
@[simp] lemma Iic_inf_hom_apply (a : α) : Iic_inf_hom a = Iic a := rfl

end semilattice_inf

section complete_lattice
variables [complete_lattice α]

@[simp] lemma Iic_Inf (S : set α) : Iic (Inf S) = ⨅ a ∈ S, Iic a :=
set_like.ext $ λ c, by simp only [mem_Iic_iff, mem_infi₂_iff, le_Inf_iff]

@[simp] lemma Iic_infi (f : ι → α) : Iic (⨅ i, f i) = ⨅ i, Iic (f i) :=
set_like.ext $ λ c, by simp only [mem_Iic_iff, mem_infi_iff, le_infi_iff]

@[simp] lemma Iic_infi₂ (f : Π i, κ i → α) : Iic (⨅ i j, f i j) = ⨅ i j, Iic (f i j) :=
by simp_rw Iic_infi

/-- `lower_set.Iic` as an `Inf_hom`. -/
def Iic_Inf_hom : Inf_hom α (lower_set α) := ⟨Iic, λ s, (Iic_Inf s).trans Inf_image.symm⟩

@[simp] lemma coe_Iic_Inf_hom : (Iic_Inf_hom : α → lower_set α) = Iic := rfl
@[simp] lemma Iic_Inf_hom_apply (a : α) : Iic_Inf_hom a = Iic a := rfl

end complete_lattice
end lower_set


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import init.data.list.lemmas init.wf

namespace list

-- Note: we can't use the equation compiler here because
-- init.meta.well_founded_tactics uses this file
def qsort.F {α} (lt : α → α → bool) : Π (x : list α),
  (Π (y : list α), length y < length x → list α) → list α
| []     IH := []
| (h::t) IH := begin
    induction e : partition (λ x, lt h x = tt) t with large small,
    have : length small < length (h::t) ∧ length large < length (h::t),
    { rw partition_eq_filter_filter at e,
      injection e,
      subst large, subst small,
      constructor;
      exact nat.succ_le_succ (length_le_of_sublist (filter_sublist _)) },
    exact IH small this.left ++ h :: IH large this.right
  end

/- This is based on the minimalist Haskell "quicksort".

   Remark: this is *not* really quicksort since it doesn't partition the elements in-place -/
def qsort {α} (lt : α → α → bool) : list α → list α :=
well_founded.fix (inv_image.wf length nat.lt_wf) (qsort.F lt)

@[simp] theorem qsort_nil {α} (lt : α → α → bool) : qsort lt [] = [] :=
by rw [qsort, well_founded.fix_eq, qsort.F]

@[simp] theorem qsort_cons {α} (lt : α → α → bool) (h t) : qsort lt (h::t) =
  let (large, small) := partition (λ x, lt h x = tt) t in
  qsort lt small ++ h :: qsort lt large :=
begin
  rw [qsort, well_founded.fix_eq, qsort.F],
  induction e : partition (λ x, lt h x = tt) t with large small,
  simp [e], rw [e]
end

end list


/-
Copyright (c) 2014 Jakob von Raumer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob von Raumer, Floris van Doorn

Ported from Coq HoTT
-/
import .trunc .equiv .ua

universes u v w l k
hott_theory

namespace hott

open hott.eq hott.is_trunc sigma function hott.is_equiv hott.equiv prod unit

/-
   We now prove that funext follows from a couple of weaker-looking forms
   of function extensionality.

   This proof is originally due to Voevodsky; it has since been simplified
   by Peter Lumsdaine and Michael Shulman.
-/

@[hott] def funext :=
  Π ⦃A : Type l⦄ {P : A → Type k} (f g : Π x, P x), is_equiv (@apd10 A P f g)

-- Naive funext is the simple assertion that pointwise equal functions are equal.
@[hott] def naive_funext :=
  Π ⦃A : Type _⦄ {P : A → Type _} (f g : Πx, P x), (f ~ g) → f = g

-- Weak funext says that a product of contractible types is contractible.
@[hott] def weak_funext :=
  Π ⦃A : Type _⦄ (P : A → Type _) [H: Πx, is_contr (P x)], is_contr (Πx, P x)

@[hott] def weak_funext_of_naive_funext : naive_funext → weak_funext :=
begin
  intros nf A P Pc,
  unfreezeI,
  let c := λ x, center (P x),
  apply is_contr.mk c, intro f,
  have eq' : (λx, center (P x)) ~ f := λ x, center_eq (f x),
  have eq : (λx, center (P x)) = f := @nf A P (λx, center (P x)) f eq',
  assumption
end

/-
  The less obvious direction is that weak_funext implies funext
  (and hence all three are logically equivalent).  The point is that under weak
  funext, the space of "pointwise homotopies" has the same universal property as
  the space of paths.
-/

section
  parameters [wf : weak_funext.{l k}] {A : Type.{l}} {B : A → Type.{k}} (f : Π x, B x)

  @[hott] def is_contr_sigma_homotopy : is_contr (Σ (g : Π x, B x), f ~ g) :=
    is_contr.mk (sigma.mk f (homotopy.refl f))
      (λ ⟨(g : Π x, B x), (h : f ~ g)⟩,
          let r := λ (k : Π x, Σ y, f x = y),
            @sigma.mk _ (λg, f ~ g)
              (λx, fst (k x)) (λx, snd (k x)) in
          let s (g : Π x, B x) (h : f ~ g) (x) :=
            @sigma.mk _ (λy, f x = y) (g x) (h x) in
          have t1 : Πx, is_contr (Σ y, f x = y),
            from (λx, is_contr_sigma_eq _),
          have t2 : is_contr (Πx, Σ y, f x = y),
            from wf _,
          have t3 : (λ x, @sigma.mk _ (λ y, f x = y) (f x) idp) = s g h,
            from @eq_of_is_contr (Π x, Σ y, f x = y) t2 _ _,
          have t4 : r (λ x, sigma.mk (f x) idp) = r (s g h),
            from ap r t3,
          t4
        )
  local attribute [instance] is_contr_sigma_homotopy

  parameters (Q : Π g (h : f ~ g), Type _) (d : Q f (homotopy.refl f))

  @[hott] def homotopy_ind (g : Πx, B x) (h : f ~ g) : Q g h :=
    @transport _ (λ gh, Q (sigma.fst gh) (snd gh)) (sigma.mk f (homotopy.refl f)) (sigma.mk g h)
      (@eq_of_is_contr _ is_contr_sigma_homotopy _ _) d

  -- local attribute weak_funext [reducible]
  -- local attribute homotopy_ind [reducible]
  @[hott] def homotopy_ind_comp : homotopy_ind f (homotopy.refl f) = d :=
  begin
    dsimp [homotopy_ind],
    have := @prop_eq_of_is_contr _ _ _ _ (eq_of_is_contr _ _) idp,
    rwr this, apply @is_contr_sigma_homotopy wf,
  end
end

/- Now the proof is fairly easy; we can just use the same induction principle on both sides. -/
section

-- local attribute weak_funext [reducible]
@[hott] def funext_of_weak_funext (wf : weak_funext.{l k}) : funext.{l k} :=
begin
  intros A B f g,
  let eq_to_f := λ g' x, f = g',
  let sim2path := @homotopy_ind wf _ _ f eq_to_f idp,
  have t1 : sim2path f (homotopy.refl f) = idp,
    by apply @homotopy_ind_comp wf,
  have t2 : apd10 (sim2path f (homotopy.refl f)) = (homotopy.refl f),
    from ap apd10 t1,
  have left_inv : apd10 ∘ (sim2path g) ~ id,
    from (@homotopy_ind wf _ _ f (λ g' x, apd10 (sim2path g' x) = x) t2) g,
  have right_inv : @comp (f = g) (f ~ g) (f = g) (sim2path g) (@apd10 A B f g) ~ id,
    {intro h, induction h, apply homotopy_ind_comp},
  exact is_equiv.adjointify apd10 (sim2path g) left_inv right_inv
end

@[hott] def funext_from_naive_funext : naive_funext → funext :=
  funext_of_weak_funext ∘ weak_funext_of_naive_funext
end

section

  @[hott] private theorem ua_isequiv_postcompose {A B : Type.{l}} {C : Type u}
      {w : A → B} [H0 : is_equiv w] : is_equiv (@comp C A B w) :=
    let w' := equiv.mk w H0 in
    let eqinv : A = B := ((@is_equiv.inv _ _ _ (univalence A B)) w') in
    let eq' := equiv_of_eq eqinv in
    have eqretr : eq' = w', from (@right_inv _ _ (@equiv_of_eq A B) (univalence A B) w'),
    have invs_eq : eq'⁻¹ᶠ = w'⁻¹ᶠ, from inv_eq eq' w' eqretr,
    is_equiv.adjointify (@comp C A B w)
      (@comp C B A (is_equiv.inv w))
      (λ (x : C → B),
        have eqfin1 : Π(p : A = B), equiv_of_eq p ∘ ((equiv_of_eq p)⁻¹ᶠ ∘ x) = x,
          by intro p; unfreezeI; induction p; reflexivity,
        have eqfin : eq' ∘ (eq'⁻¹ᶠ ∘ x) = x,
          from eqfin1 eqinv,
        have eqfin' : w' ∘ (eq'⁻¹ᶠ ∘ x) = x,
          by { refine _ ⬝ eqfin, rwr eqretr },
        show w' ∘ (w'⁻¹ᶠ ∘ x) = x,
          by { refine _ ⬝ eqfin', rwr invs_eq }
      )
      (λ (x : C → A),
        have eqfin1 : Π(p : A = B), (equiv_of_eq p)⁻¹ᶠ ∘ (equiv_of_eq p ∘ x) = x,
          by intro p; unfreezeI; induction p; reflexivity,
        have eqfin : eq'⁻¹ᶠ ∘ (eq' ∘ x) = x,
          from eqfin1 eqinv,
        have eqfin' : eq'⁻¹ᶠ ∘ (w' ∘ x) = x,
          by { refine _ ⬝ eqfin, rwr eqretr },
        show w'⁻¹ᶠ ∘ (w' ∘ x) = x,
          by { refine _ ⬝ eqfin', rwr invs_eq }
      )

  -- We are ready to prove functional extensionality,
  -- starting with the naive non-dependent version.
  @[hott] private def diagonal (B : Type _) : Type _
    := Σ xy : B × B, fst xy = snd xy

  @[hott] private def isequiv_src_compose {A : Type u} {B : Type v}
      : @is_equiv (A → diagonal B)
                 (A → B)
                 (comp (prod.fst ∘ sigma.fst)) :=
    @ua_isequiv_postcompose (diagonal B) _ _ (prod.fst ∘ sigma.fst)
        (is_equiv.adjointify (prod.fst ∘ sigma.fst)
          (λ x : B, (sigma.mk (x , x) idp : diagonal B)) (λx, idp)
          (λ ⟨⟨b, c⟩, p⟩, by { dsimp at p, induction p, refl }))

  @[hott] private def isequiv_tgt_compose {A : Type u} {B : Type v}
      : is_equiv (comp (prod.snd ∘ sigma.fst) : (A → diagonal B) → (A → B)) :=
  @ua_isequiv_postcompose _ _ _ _ begin
    fapply adjointify,
    { intro b, exact ⟨(b, b), idp⟩},
    { intro b, reflexivity},
    { intro a, induction a with q p, induction q, dsimp at *, induction p, reflexivity}
  end

  @[hott] theorem nondep_funext_from_ua {A : Type _} {B : Type _}
      : Π {f g : A → B}, f ~ g → f = g :=
  begin
    intros f g p,
    let d := λ (x : A), @sigma.mk (B × B) (λ (xy : B × B), xy.1 = xy.2) (f x , f x) (eq.refl (f x, f x).1),
    let e := λ (x : A), @sigma.mk (B × B) (λ (xy : B × B), xy.1 = xy.2) (f x , g x) (p x),
    let precomp1 : (A → diagonal B) → (A → B) := comp (prod.fst ∘ sigma.fst),
    haveI equiv1 : is_equiv precomp1,
      from @isequiv_src_compose A B,
    haveI equiv2 : Π (x y : A → diagonal B), is_equiv (ap precomp1),
      from is_equiv.is_equiv_ap precomp1,
    haveI H' : Π (x y : A → diagonal B), prod.fst ∘ sigma.fst ∘ x = prod.fst ∘ sigma.fst ∘ y → x = y,
      from (λ x y, is_equiv.inv (ap precomp1)),
    have eq2 : prod.fst ∘ sigma.fst ∘ d = prod.fst ∘ sigma.fst ∘ e,
      from idp,
    have eq0 : d = e,
      from H' d e eq2,
    have eq1 : (prod.snd ∘ sigma.fst) ∘ d = (prod.snd ∘ sigma.fst) ∘ e,
      from ap _ eq0,
    exact eq1
  end

end

-- Now we use this to prove weak funext, which as we know
-- implies (with dependent eta) also the strong dependent funext.
@[hott] theorem weak_funext_of_ua : weak_funext.{u v} :=
  (λ (A : Type _) (P : A → Type _) allcontr,
    let U := (λ (x : A), ulift unit) in
  have pequiv : Π (x : A), P x ≃ unit,
    from (λ x, @equiv_unit_of_is_contr (P x) (allcontr x)),
  have psim : Π (x : A), P x = U x,
    from (λ x, eq_of_equiv_lift (pequiv x)),
  have p : P = U,
    from @nondep_funext_from_ua A _ P U psim,
  have tU' : is_contr (A → ulift unit),
    from is_contr.mk (λ x, ulift.up ())
      (λ f, nondep_funext_from_ua (λa, by induction (f a) with u;induction u;reflexivity)),
  have tU : is_contr (Π x, U x),
    from tU',
  have tlast : is_contr (Πx, P x),
    from transport (λ PU : A → Type v, is_contr $ Π x, PU x) p⁻¹ᵖ tU,
  tlast)

-- we have proven function extensionality from the univalence axiom
@[hott] def funext_of_ua : funext :=
  funext_of_weak_funext (@weak_funext_of_ua)

/-
  We still take funext as an axiom, so that when you write "print axioms foo", you can see whether
  it uses only function extensionality, and not also univalence.
-/

axiom function_extensionality : funext

variables {A : Type _} {P : A → Type _} {f g : Π x, P x}

namespace funext
  @[instance, hott]
  theorem is_equiv_apdt (f g : Π x, P x) : is_equiv (@apd10 A P f g) :=
  function_extensionality f g
end funext

open funext

namespace eq
  variables (f g)
  @[hott] def eq_equiv_homotopy : (f = g) ≃ (f ~ g) :=
  equiv.mk apd10 (by apply_instance)

  variables {f g}
  @[hott] def eq_of_homotopy : f ~ g → f = g :=
  (@apd10 A P f g)⁻¹ᶠ

  @[hott] def apd10_eq_of_homotopy (p : f ~ g) : apd10 (eq_of_homotopy p) = p :=
  right_inv apd10 p

  @[hott] def eq_of_homotopy_apd10 (p : f = g) : eq_of_homotopy (apd10 p) = p :=
  left_inv apd10 p

  @[hott] def eq_of_homotopy_idp (f : Π x, P x) : eq_of_homotopy (λx : A, idpath (f x)) = idpath f :=
  is_equiv.left_inv apd10 idp

  @[hott] def eq_of_homotopy_refl (f : Π x, P x) : eq_of_homotopy (homotopy.refl f) = idpath f :=
  eq_of_homotopy_idp _

  @[hott] def naive_funext_of_ua : naive_funext :=
  λ A P f g h, eq_of_homotopy h

  @[hott] protected def homotopy.rec_on {Q : (f ~ g) → Type _} (p : f ~ g)
    (H : Π(q : f = g), Q (apd10 q)) : Q p :=
  right_inv apd10 p ▸ H (eq_of_homotopy p)

  @[hott] protected def homotopy.rec_on_idp {Q : Π{g}, (f ~ g) → Type _} {g : Π x, P x}
    (p : f ~ g) (H : Q (homotopy.refl f)) : Q p :=
  homotopy.rec_on p (λq, by induction q; exact H)

  @[hott] protected def homotopy.rec_on' {f f' : Πa, P a} {Q : (f ~ f') → (f = f') → Type _}
    (p : f ~ f') (H : Π(q : f = f'), Q (apd10 q) q) : Q p (eq_of_homotopy p) :=
  begin
    refine homotopy.rec_on p _,
    intro q,
    dunfold eq_of_homotopy, rwr left_inv apd10 q,
    apply H
  end

  @[hott] protected def homotopy.rec_on_idp' {f : Πa, P a} {Q : Π{g}, (f ~ g) → (f = g) → Type _}
    {g : Πa, P a} (p : f ~ g) (H : Q (homotopy.refl f) idp) : Q p (eq_of_homotopy p) :=
  begin
    refine homotopy.rec_on' p _, intro q, induction q, exact H
  end

  @[hott] protected def homotopy.rec_on_idp_left {A : Type _} {P : A → Type _} {g : Πa, P a}
    {Q : Πf, (f ~ g) → Type _} {f : Π x, P x}
    (p : f ~ g) (H : Q g (homotopy.refl g)) : Q f p :=
  begin
    refine homotopy.rec_on p (λ q, _), induction q, exact H
  end

  @[hott] def homotopy.rec_idp {A : Type _} {P : A → Type _} {f : Πa, P a}
    (Q : Π{g}, (f ~ g) → Type _) (H : Q (homotopy.refl f)) {g : Π x, P x} (p : f ~ g) : Q p :=
  homotopy.rec_on_idp p H

  @[hott] def homotopy_rec_on_apd10 {A : Type _} {P : A → Type _} {f g : Πa, P a}
    (Q : f ~ g → Type _) (H : Π(q : f = g), Q (apd10 q)) (p : f = g) :
    homotopy.rec_on (apd10 p) H = H p :=
  begin
    dunfold homotopy.rec_on,
    transitivity, rwr adj,
    transitivity, symmetry; apply tr_compose,
    apply apdt
  end

  @[hott] def homotopy_rec_idp_refl {A : Type _} {P : A → Type _} {f : Πa, P a}
    (Q : Π{g}, f ~ g → Type _) (H : Q homotopy.rfl) :
    homotopy.rec_idp @Q H homotopy.rfl = H :=
  homotopy_rec_on_apd10 Q _ rfl

  @[hott] def eq_of_homotopy_inv {f g : Π x, P x} (H : f ~ g)
    : eq_of_homotopy (λx, (H x)⁻¹ᵖ) = (eq_of_homotopy H)⁻¹ :=
  begin
    apply homotopy.rec_on_idp H,
    change eq_of_homotopy (λ x, idp) = _,
    rwr [eq_of_homotopy_refl],
  end

  @[hott] def eq_of_homotopy_con {f g h : Π x, P x} (H1 : f ~ g) (H2 : g ~ h)
    : eq_of_homotopy (λx, H1 x ⬝ H2 x) = eq_of_homotopy H1 ⬝ eq_of_homotopy H2 :=
  begin
    apply homotopy.rec_on_idp H2, apply homotopy.rec_on_idp H1,
    rwr eq_of_homotopy_refl, apply eq_of_homotopy_idp,
  end

  @[hott] def compose_eq_of_homotopy {A B C : Type _} (g : B → C) {f f' : A → B} (H : f ~ f') :
    ap (λf : A → B, g ∘ f) (eq_of_homotopy H) = eq_of_homotopy (hwhisker_left g H) :=
  begin
    apply homotopy.rec_on_idp H, rwr eq_of_homotopy_refl,
    symmetry, apply eq_of_homotopy_idp
  end

end eq

end hott


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Mario Carneiro

Define the p-adic integers ℤ_p as a subtype of ℚ_p. Construct algebraic structures on ℤ_p.
-/

import ring_theory.ideals data.int.modeq
import tactic.linarith
import padics.padic_numbers

open nat padic metric
noncomputable theory
local attribute [instance] classical.prop_decidable

def padic_int (p : ℕ) [p.prime] := {x : ℚ_[p] // ∥x∥ ≤ 1}
notation `ℤ_[`p`]` := padic_int p

namespace padic_int
variables {p : ℕ} [nat.prime p]

def add : ℤ_[p] → ℤ_[p] → ℤ_[p]
| ⟨x, hx⟩ ⟨y, hy⟩ := ⟨x+y,
    le_trans (padic_norm_e.nonarchimedean _ _) (max_le_iff.2 ⟨hx,hy⟩)⟩

def mul : ℤ_[p] → ℤ_[p] → ℤ_[p]
| ⟨x, hx⟩ ⟨y, hy⟩ := ⟨x*y,
    begin rw padic_norm_e.mul, apply mul_le_one; {assumption <|> apply norm_nonneg} end⟩

def neg : ℤ_[p] → ℤ_[p]
| ⟨x, hx⟩ := ⟨-x, by simpa⟩

instance : ring ℤ_[p] :=
begin
  refine { add := add,
           mul := mul,
           neg := neg,
           zero := ⟨0, by simp [zero_le_one]⟩,
           one := ⟨1, by simp⟩,
           .. };
  {repeat {rintro ⟨_, _⟩}, simp [mul_assoc, left_distrib, right_distrib, add, mul, neg]}
end

lemma zero_def : ∀ x : ℤ_[p], x = 0 ↔ x.val = 0
| ⟨x, _⟩ := ⟨subtype.mk.inj, λ h, by simp at h; simp only [h]; refl⟩

@[simp] lemma add_def : ∀ (x y : ℤ_[p]), (x+y).val = x.val + y.val
| ⟨x, hx⟩ ⟨y, hy⟩ := rfl

@[simp] lemma mul_def : ∀ (x y : ℤ_[p]), (x*y).val = x.val * y.val
| ⟨x, hx⟩ ⟨y, hy⟩ := rfl

@[simp] lemma mk_zero {h} : (⟨0, h⟩ : ℤ_[p]) = (0 : ℤ_[p]) := rfl

instance : has_coe ℤ_[p] ℚ_[p] := ⟨subtype.val⟩

@[simp] lemma val_eq_coe (z : ℤ_[p]) : z.val = ↑z := rfl

@[simp, norm_cast] lemma coe_add : ∀ (z1 z2 : ℤ_[p]), (↑(z1 + z2) : ℚ_[p]) = ↑z1 + ↑z2
| ⟨_, _⟩ ⟨_, _⟩ := rfl

@[simp, norm_cast] lemma coe_mul : ∀ (z1 z2 : ℤ_[p]), (↑(z1 * z2) : ℚ_[p]) = ↑z1 * ↑z2
| ⟨_, _⟩ ⟨_, _⟩ := rfl

@[simp, norm_cast] lemma coe_neg : ∀ (z1 : ℤ_[p]), (↑(-z1) : ℚ_[p]) = -↑z1
| ⟨_, _⟩ := rfl

@[simp, norm_cast] lemma coe_sub : ∀ (z1 z2 : ℤ_[p]), (↑(z1 - z2) : ℚ_[p]) = ↑z1 - ↑z2
| ⟨_, _⟩ ⟨_, _⟩ := rfl

@[simp, simp_cast] lemma coe_one : (↑(1 : ℤ_[p]) : ℚ_[p]) = 1 := rfl

@[simp, simp_cast] lemma coe_coe : ∀ n : ℕ, (↑(↑n : ℤ_[p]) : ℚ_[p]) = (↑n : ℚ_[p])
| 0 := rfl
| (k+1) := by simp [coe_coe]

@[simp, simp_cast] lemma coe_zero : (↑(0 : ℤ_[p]) : ℚ_[p]) = 0 := rfl

@[simp, norm_cast] lemma cast_pow (x : ℤ_[p]) : ∀ (n : ℕ), (↑(x^n) : ℚ_[p]) = (↑x : ℚ_[p])^n
| 0 := by simp
| (k+1) := by simp [monoid.pow, pow]; congr; apply cast_pow

lemma mk_coe : ∀ (k : ℤ_[p]), (⟨↑k, k.2⟩ : ℤ_[p]) = k
| ⟨_, _⟩ := rfl

def inv : ℤ_[p] → ℤ_[p]
| ⟨k, _⟩ := if h : ∥k∥ = 1 then ⟨1/k, by simp [h]⟩ else 0

end padic_int

section instances
variables {p : ℕ} [nat.prime p]

@[reducible] def padic_norm_z (z : ℤ_[p]) : ℝ := ∥z.val∥

instance : metric_space ℤ_[p] := subtype.metric_space

instance : has_norm ℤ_[p] := ⟨padic_norm_z⟩

instance : normed_ring ℤ_[p] :=
{ dist_eq := λ ⟨_, _⟩ ⟨_, _⟩, rfl,
  norm_mul := λ ⟨_, _⟩ ⟨_, _⟩, norm_mul_le _ _ }

instance padic_norm_z.is_absolute_value : is_absolute_value (λ z : ℤ_[p], ∥z∥) :=
{ abv_nonneg := norm_nonneg,
  abv_eq_zero := λ ⟨_, _⟩, by simp [norm_eq_zero, padic_int.zero_def],
  abv_add := λ ⟨_,_⟩ ⟨_, _⟩, norm_triangle _ _,
  abv_mul := λ _ _, by unfold norm; simp [padic_norm_z] }

protected lemma padic_int.pmul_comm : ∀ z1 z2 : ℤ_[p], z1*z2 = z2*z1
| ⟨q1, h1⟩ ⟨q2, h2⟩ := show (⟨q1*q2, _⟩ : ℤ_[p]) = ⟨q2*q1, _⟩, by simp [mul_comm]

instance : comm_ring ℤ_[p] :=
{ mul_comm := padic_int.pmul_comm,
  ..padic_int.ring }

protected lemma padic_int.zero_ne_one : (0 : ℤ_[p]) ≠ 1 :=
show (⟨(0 : ℚ_[p]), _⟩ : ℤ_[p]) ≠ ⟨(1 : ℚ_[p]), _⟩, from mt subtype.ext.1 zero_ne_one

protected lemma padic_int.eq_zero_or_eq_zero_of_mul_eq_zero :
          ∀ (a b : ℤ_[p]), a * b = 0 → a = 0 ∨ b = 0
| ⟨a, ha⟩ ⟨b, hb⟩ := λ h : (⟨a * b, _⟩ : ℤ_[p]) = ⟨0, _⟩,
have a * b = 0, from subtype.ext.1 h,
(mul_eq_zero_iff_eq_zero_or_eq_zero.1 this).elim
  (λ h1, or.inl (by simp [h1]; refl))
  (λ h2, or.inr (by simp [h2]; refl))

instance : integral_domain ℤ_[p] :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := padic_int.eq_zero_or_eq_zero_of_mul_eq_zero,
  zero_ne_one := padic_int.zero_ne_one,
  ..padic_int.comm_ring }

end instances

namespace padic_norm_z

variables {p : ℕ} [nat.prime p]

lemma le_one : ∀ z : ℤ_[p], ∥z∥ ≤ 1
| ⟨_, h⟩ := h

@[simp] lemma one : ∥(1 : ℤ_[p])∥ = 1 := by simp [norm, padic_norm_z]

@[simp] lemma mul (z1 z2 : ℤ_[p]) : ∥z1 * z2∥ = ∥z1∥ * ∥z2∥ :=
by unfold norm; simp [padic_norm_z]

@[simp] lemma pow (z : ℤ_[p]) : ∀ n : ℕ, ∥z^n∥ = ∥z∥^n
| 0 := by simp
| (k+1) := show ∥z*z^k∥ = ∥z∥*∥z∥^k, by {rw mul, congr, apply pow}

theorem nonarchimedean : ∀ (q r : ℤ_[p]), ∥q + r∥ ≤ max (∥q∥) (∥r∥)
| ⟨_, _⟩ ⟨_, _⟩ := padic_norm_e.nonarchimedean _ _

theorem add_eq_max_of_ne : ∀ {q r : ℤ_[p]}, ∥q∥ ≠ ∥r∥ → ∥q+r∥ = max (∥q∥) (∥r∥)
| ⟨_, _⟩ ⟨_, _⟩ := padic_norm_e.add_eq_max_of_ne

@[simp] lemma norm_one : ∥(1 : ℤ_[p])∥ = 1 := norm_one

lemma eq_of_norm_add_lt_right {z1 z2 : ℤ_[p]}
  (h : ∥z1 + z2∥ < ∥z2∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_z.add_eq_max_of_ne hne; apply le_max_right) h

lemma eq_of_norm_add_lt_left {z1 z2 : ℤ_[p]}
  (h : ∥z1 + z2∥ < ∥z1∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_z.add_eq_max_of_ne hne; apply le_max_left) h

@[simp] lemma padic_norm_e_of_padic_int (z : ℤ_[p]) : ∥(↑z : ℚ_[p])∥ = ∥z∥ :=
by simp [norm, padic_norm_z]

@[simp] lemma padic_norm_z_eq_padic_norm_e {q : ℚ_[p]} (hq : ∥q∥ ≤ 1) :
  @norm ℤ_[p] _ ⟨q, hq⟩ = ∥q∥ := rfl

end padic_norm_z

private lemma mul_lt_one {α} [decidable_linear_ordered_comm_ring α] {a b : α} (hbz : 0 < b)
  (ha : a < 1) (hb : b < 1) : a * b < 1 :=
suffices a*b < 1*1, by simpa,
mul_lt_mul ha (le_of_lt hb) hbz zero_le_one

private lemma mul_lt_one_of_le_of_lt {α} [decidable_linear_ordered_comm_ring α] {a b : α} (ha : a ≤ 1)
  (hbz : 0 ≤ b) (hb : b < 1) : a * b < 1 :=
if hb' : b = 0 then by simpa [hb'] using zero_lt_one
else if ha' : a = 1 then by simpa [ha']
else mul_lt_one (lt_of_le_of_ne hbz (ne.symm hb')) (lt_of_le_of_ne ha ha') hb

namespace padic_int

variables {p : ℕ} [nat.prime p]

local attribute [reducible] padic_int

lemma mul_inv : ∀ {z : ℤ_[p]}, ∥z∥ = 1 → z * z.inv = 1
| ⟨k, _⟩ h :=
  begin
    have hk : k ≠ 0, from λ h', @zero_ne_one ℚ_[p] _ (by simpa [h'] using h),
    unfold padic_int.inv, split_ifs,
    { change (⟨k * (1/k), _⟩ : ℤ_[p]) = 1,
      simp [hk], refl },
    { apply subtype.ext.2, simp [mul_inv_cancel hk] }
  end

lemma inv_mul {z : ℤ_[p]} (hz : ∥z∥ = 1) : z.inv * z = 1 :=
by rw [mul_comm, mul_inv hz]

lemma is_unit_iff {z : ℤ_[p]} : is_unit z ↔ ∥z∥ = 1 :=
⟨λ h, begin
  rcases is_unit_iff_dvd_one.1 h with ⟨w, eq⟩,
  refine le_antisymm (padic_norm_z.le_one _) _,
  have := mul_le_mul_of_nonneg_left (padic_norm_z.le_one w) (norm_nonneg z),
  rwa [mul_one, ← padic_norm_z.mul, ← eq, padic_norm_z.one] at this
end, λ h, ⟨⟨z, z.inv, mul_inv h, inv_mul h⟩, rfl⟩⟩

lemma norm_lt_one_add {z1 z2 : ℤ_[p]} (hz1 : ∥z1∥ < 1) (hz2 : ∥z2∥ < 1) : ∥z1 + z2∥ < 1 :=
lt_of_le_of_lt (padic_norm_z.nonarchimedean _ _) (max_lt hz1 hz2)

lemma norm_lt_one_mul {z1 z2 : ℤ_[p]} (hz2 : ∥z2∥ < 1) : ∥z1 * z2∥ < 1 :=
calc  ∥z1 * z2∥ = ∥z1∥ * ∥z2∥ : by simp
           ... < 1 : mul_lt_one_of_le_of_lt (padic_norm_z.le_one _) (norm_nonneg _) hz2

@[simp] lemma mem_nonunits {z : ℤ_[p]} : z ∈ nonunits ℤ_[p] ↔ ∥z∥ < 1 :=
by rw lt_iff_le_and_ne; simp [padic_norm_z.le_one z, nonunits, is_unit_iff]

instance : is_local_ring ℤ_[p] :=
local_of_nonunits_ideal zero_ne_one $ λ x y, by simp; exact norm_lt_one_add

private def cau_seq_to_rat_cau_seq (f : cau_seq ℤ_[p] norm) :
  cau_seq ℚ_[p] (λ a, ∥a∥) :=
⟨ λ n, f n,
  λ _ hε, by simpa [norm, padic_norm_z] using f.cauchy hε ⟩

instance complete : cau_seq.is_complete ℤ_[p] norm :=
⟨ λ f,
  have hqn : ∥cau_seq.lim (cau_seq_to_rat_cau_seq f)∥ ≤ 1,
    from padic_norm_e_lim_le zero_lt_one (λ _, padic_norm_z.le_one _),
  ⟨ ⟨_, hqn⟩,
    λ ε, by simpa [norm, padic_norm_z] using cau_seq.equiv_lim (cau_seq_to_rat_cau_seq f) ε⟩⟩

end padic_int

namespace padic_norm_z
variables {p : ℕ} [nat.prime p]

lemma padic_val_of_cong_pow_p {z1 z2 : ℤ} {n : ℕ} (hz : z1 ≡ z2 [ZMOD ↑(p^n)]) :
      ∥(z1 - z2 : ℚ_[p])∥ ≤ ↑(↑p ^ (-n : ℤ) : ℚ) :=
have hdvd : ↑(p^n) ∣ z2 - z1, from int.modeq.modeq_iff_dvd.1 hz,
have (↑(z2 - z1) : ℚ_[p]) = ↑(↑(z2 - z1) : ℚ), by norm_cast,
begin
  rw norm_sub_rev,
  norm_cast,
  rw [this, padic_norm_e.eq_padic_norm],
  exact_mod_cast padic_norm.le_of_dvd p hdvd
end

end padic_norm_z