/-
Copyright (c) 2022 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.big_operators.basic
import tactic.norm_num

/-! ### `norm_num` plugin for big operators

This `norm_num` plugin provides support for computing sums and products of
lists, multisets and finsets.

Example goals this plugin can solve:

 * `∑ i in finset.range 10, (i^2 : ℕ) = 285`
 * `Π i in {1, 4, 9, 16}, nat.sqrt i = 24`
 * `([1, 2, 1, 3]).sum = 7`

## Implementation notes

The tactic works by first converting the expression denoting the collection
(list, multiset, finset) to a list of expressions denoting each element. For
finsets, this involves erasing duplicate elements (the tactic fails if equality
or disequality cannot be determined).

After rewriting the big operator to a product/sum of lists, we evaluate this
using `norm_num` itself to handle multiplication/addition.

Finally, we package up the result using some congruence lemmas.

-/

open tactic

namespace tactic.norm_num

/-- Use `norm_num` to decide equality between two expressions.

If the decision procedure succeeds, the `bool` value indicates whether the expressions are equal,
and the `expr` is a proof of (dis)equality.
This procedure is partial: it will fail in cases where `norm_num` can't reduce either side
to a rational numeral.
-/
meta def decide_eq (l r : expr) : tactic (bool × expr) := do
  (l', l'_pf) ← or_refl_conv norm_num.derive l,
  (r', r'_pf) ← or_refl_conv norm_num.derive r,
  n₁ ← l'.to_rat, n₂ ← r'.to_rat,
  c ← infer_type l' >>= mk_instance_cache,
  if n₁ = n₂ then do
    pf ← i_to_expr ``(eq.trans %%l'_pf $ eq.symm %%r'_pf),
    pure (tt, pf)
  else do
    (_, p) ← norm_num.prove_ne c l' r' n₁ n₂,
    pure (ff, p)

lemma list.not_mem_cons {α : Type*} {x y : α} {ys : list α} (h₁ : x ≠ y) (h₂ : x ∉ ys) :
  x ∉ y :: ys :=
λ h, ((list.mem_cons_iff _ _ _).mp h).elim h₁ h₂

/-- Use a decision procedure for the equality of list elements to decide list membership.

If the decision procedure succeeds, the `bool` value indicates whether the expressions are equal,
and the `expr` is a proof of (dis)equality.
This procedure is partial iff its parameter `decide_eq` is partial.
-/
meta def list.decide_mem (decide_eq : expr → expr → tactic (bool × expr)) :
  expr → list expr → tactic (bool × expr)
| x [] := do
  pf ← i_to_expr ``(list.not_mem_nil %%x),
  pure (ff, pf)
| x (y :: ys) := do
  (is_head, head_pf) ← decide_eq x y,
  if is_head then do
    pf ← i_to_expr ``((list.mem_cons_iff %%x %%y _).mpr (or.inl %%head_pf)),
    pure (tt, pf)
  else do
    (mem_tail, tail_pf) ← list.decide_mem x ys,
    if mem_tail then do
      pf ← i_to_expr ``((list.mem_cons_iff %%x %%y _).mpr (or.inr %%tail_pf)),
      pure (tt, pf)
    else do
      pf ← i_to_expr ``(list.not_mem_cons %%head_pf %%tail_pf),
      pure (ff, pf)

lemma finset.insert_eq_coe_list_of_mem {α : Type*} [decidable_eq α] (x : α) (xs : finset α)
  {xs' : list α} (h : x ∈ xs') (nd_xs : xs'.nodup)
  (hxs' : xs = finset.mk ↑xs' (multiset.coe_nodup.mpr nd_xs)) :
  insert x xs = finset.mk ↑xs' (multiset.coe_nodup.mpr nd_xs) :=
have h : x ∈ xs, by simpa [hxs'] using h,
by rw [finset.insert_eq_of_mem h, hxs']

lemma finset.insert_eq_coe_list_cons {α : Type*} [decidable_eq α] (x : α) (xs : finset α)
  {xs' : list α} (h : x ∉ xs') (nd_xs : xs'.nodup) (nd_xxs : (x :: xs').nodup)
  (hxs' : xs = finset.mk ↑xs' (multiset.coe_nodup.mpr nd_xs)) :
  insert x xs = finset.mk ↑(x :: xs') (multiset.coe_nodup.mpr nd_xxs) :=
have h : x ∉ xs, by simpa [hxs'] using h,
by { rw [← finset.val_inj, finset.insert_val_of_not_mem h, hxs'], simp only [multiset.cons_coe] }

/-- Convert an expression denoting a finset to a list of elements,
a proof that this list is equal to the original finset,
and a proof that the list contains no duplicates.

We return a list rather than a finset, so we can more easily iterate over it
(without having to prove that our tactics are independent of the order of iteration,
which is in general not true).

`decide_eq` is a (partial) decision procedure for determining whether two
elements of the finset are equal, for example to parse `{2, 1, 2}` into `[2, 1]`.
-/
meta def eval_finset (decide_eq : expr → expr → tactic (bool × expr)) :
  expr → tactic (list expr × expr × expr)
| e@`(has_emptyc.emptyc) := do
  eq ← mk_eq_refl e,
  nd ← i_to_expr ``(list.nodup_nil),
  pure ([], eq, nd)
| e@`(has_singleton.singleton %%x) := do
  eq ← mk_eq_refl e,
  nd ← i_to_expr ``(list.nodup_singleton %%x),
  pure ([x], eq, nd)
| `(@@has_insert.insert (@@finset.has_insert %%dec) %%x %%xs) := do
  (exs, xs_eq, xs_nd) ← eval_finset xs,
  (is_mem, mem_pf) ← list.decide_mem decide_eq x exs,
  if is_mem then do
    pf ← i_to_expr ``(finset.insert_eq_coe_list_of_mem %%x %%xs %%mem_pf %%xs_nd %%xs_eq),
    pure (exs, pf, xs_nd)
  else do
    nd ← i_to_expr ``(list.nodup_cons.mpr ⟨%%mem_pf, %%xs_nd⟩),
    pf ← i_to_expr ``(finset.insert_eq_coe_list_cons %%x %%xs %%mem_pf %%xs_nd %%nd %%xs_eq),
    pure (x :: exs, pf, nd)
| `(@@finset.univ %%ft) := do
  -- Convert the fintype instance expression `ft` to a list of its elements.
  -- Unfold it to the `fintype.mk` constructor and a list of arguments.
  `fintype.mk ← get_app_fn_const_whnf ft
    | fail (to_fmt "Unknown fintype expression" ++ format.line ++ to_fmt ft),
  [_, args, _] ← get_app_args_whnf ft | fail (to_fmt "Expected 3 arguments to `fintype.mk`"),
  eval_finset args
| e@`(finset.range %%en) := do
  n ← expr.to_nat en,
  eis ← (list.range n).mmap (λ i, expr.of_nat `(ℕ) i),
  eq ← mk_eq_refl e,
  nd ← i_to_expr ``(list.nodup_range %%en),
  pure (eis, eq, nd)
| e@`(finset.fin_range %%en) := do
  n ← expr.to_nat en,
  eis ← (list.fin_range n).mmap (λ i, expr.of_nat `(fin %%en) i),
  eq ← mk_eq_refl e,
  nd ← i_to_expr ``(list.nodup_fin_range %%en),
  pure (eis, eq, nd)
| e := fail (to_fmt "Unknown finset expression" ++ format.line ++ to_fmt e)

lemma list.map_cons_congr {α β : Type*} (f : α → β) {x : α} {xs : list α} {fx : β} {fxs : list β}
  (h₁ : f x = fx) (h₂ : xs.map f = fxs) : (x :: xs).map f = fx :: fxs :=
by rw [list.map_cons, h₁, h₂]

/-- Apply `ef : α → β` to all elements of the list, constructing an equality proof. -/
meta def eval_list_map (ef : expr) : list expr → tactic (list expr × expr)
| [] := do
  eq ← i_to_expr ``(list.map_nil %%ef),
  pure ([], eq)
| (x :: xs) := do
  (fx, fx_eq) ← or_refl_conv norm_num.derive (expr.app ef x),
  (fxs, fxs_eq) ← eval_list_map xs,
  eq ← i_to_expr ``(list.map_cons_congr %%ef %%fx_eq %%fxs_eq),
  pure (fx :: fxs, eq)

lemma multiset.cons_congr {α : Type*} (x : α) {xs : multiset α} {xs' : list α}
  (xs_eq : (xs' : multiset α) = xs) : (list.cons x xs' : multiset α) = x ::ₘ xs :=
by rw [← xs_eq]; refl

lemma multiset.map_congr {α β : Type*} (f : α → β) {xs : multiset α}
  {xs' : list α} {ys : list β} (xs_eq : xs = (xs' : multiset α)) (ys_eq : xs'.map f = ys) :
  xs.map f = (ys : multiset β) :=
by rw [← ys_eq, ← multiset.coe_map, xs_eq]

/-- Convert an expression denoting a multiset to a list of elements.

We return a list rather than a finset, so we can more easily iterate over it
(without having to prove that our tactics are independent of the order of iteration,
which is in general not true).
-/
meta def eval_multiset : expr → tactic (list expr × expr)
| e@`(@has_zero.zero (multiset _) _) := do
  eq ← mk_eq_refl e,
  pure ([], eq)
| e@`(has_emptyc.emptyc) := do
  eq ← mk_eq_refl e,
  pure ([], eq)
| e@`(has_singleton.singleton %%x) := do
  eq ← mk_eq_refl e,
  pure ([x], eq)
| e@`(multiset.cons %%x %%xs) := do
  (xs, xs_eq) ← eval_multiset xs,
  eq ← i_to_expr ``(multiset.cons_congr %%x %%xs_eq),
  pure (x :: xs, eq)
| e@`(@@has_insert.insert multiset.has_insert %%x %%xs) := do
  (xs, xs_eq) ← eval_multiset xs,
  eq ← i_to_expr ``(multiset.cons_congr %%x %%xs_eq),
  pure (x :: xs, eq)
| e@`(multiset.range %%en) := do
  n ← expr.to_nat en,
  eis ← (list.range n).mmap (λ i, expr.of_nat `(ℕ) i),
  eq ← mk_eq_refl e,
  pure (eis, eq)
| `(@multiset.map %%α %%β %%ef %%exs) := do
  (xs, xs_eq) ← eval_multiset exs,
  (ys, ys_eq) ← eval_list_map ef xs,
  eq ← i_to_expr ``(multiset.map_congr %%ef %%xs_eq %%ys_eq),
  pure (ys, eq)
| e := fail (to_fmt "Unknown multiset expression" ++ format.line ++ to_fmt e)

lemma list.cons_congr {α : Type*} (x : α) {xs : list α} {xs' : list α} (xs_eq : xs' = xs) :
  x :: xs' = x :: xs :=
by rw xs_eq

lemma list.map_congr {α β : Type*} (f : α → β) {xs xs' : list α}
  {ys : list β} (xs_eq : xs = xs') (ys_eq : xs'.map f = ys) :
  xs.map f = ys :=
by rw [← ys_eq, xs_eq]

/-- Convert an expression denoting a list to a list of elements. -/
meta def eval_list : expr → tactic (list expr × expr)
| e@`(list.nil) := do
  eq ← mk_eq_refl e,
  pure ([], eq)
| e@`(list.cons %%x %%xs) := do
  (xs, xs_eq) ← eval_list xs,
  eq ← i_to_expr ``(list.cons_congr %%x %%xs_eq),
  pure (x :: xs, eq)
| e@`(list.range %%en) := do
  n ← expr.to_nat en,
  eis ← (list.range n).mmap (λ i, expr.of_nat `(ℕ) i),
  eq ← mk_eq_refl e,
  pure (eis, eq)
| `(@list.map %%α %%β %%ef %%exs) := do
  (xs, xs_eq) ← eval_list exs,
  (ys, ys_eq) ← eval_list_map ef xs,
  eq ← i_to_expr ``(list.map_congr %%ef %%xs_eq %%ys_eq),
  pure (ys, eq)
| e := fail (to_fmt "Unknown list expression" ++ format.line ++ to_fmt e)

@[to_additive]
lemma list.prod_cons_congr {α : Type*} [monoid α] (xs : list α) (x y z : α)
  (his : xs.prod = y) (hi : x * y = z) : (x :: xs).prod = z :=
by rw [list.prod_cons, his, hi]

/-- Evaluate `list.prod %%xs`,
producing the evaluated expression and an equality proof. -/
meta def list.prove_prod (α : expr) : list expr → tactic (expr × expr)
| [] := do
  result ← expr.of_nat α 1,
  proof ← i_to_expr ``(@list.prod_nil %%α _),
  pure (result, proof)
| (x :: xs) := do
  eval_xs ← list.prove_prod xs,
  xxs ← i_to_expr ``(%%x * %%eval_xs.1),
  eval_xxs ← or_refl_conv norm_num.derive xxs,
  exs ← expr.of_list α xs,
  proof ← i_to_expr
    ``(list.prod_cons_congr %%exs%%x %%eval_xs.1 %%eval_xxs.1 %%eval_xs.2 %%eval_xxs.2),
  pure (eval_xxs.1, proof)

/-- Evaluate `list.sum %%xs`,
sumucing the evaluated expression and an equality proof. -/
meta def list.prove_sum (α : expr) : list expr → tactic (expr × expr)
| [] := do
  result ← expr.of_nat α 0,
  proof ← i_to_expr ``(@list.sum_nil %%α _),
  pure (result, proof)
| (x :: xs) := do
  eval_xs ← list.prove_sum xs,
  xxs ← i_to_expr ``(%%x + %%eval_xs.1),
  eval_xxs ← or_refl_conv norm_num.derive xxs,
  exs ← expr.of_list α xs,
  proof ← i_to_expr
    ``(list.sum_cons_congr %%exs%%x %%eval_xs.1 %%eval_xxs.1 %%eval_xs.2 %%eval_xxs.2),
  pure (eval_xxs.1, proof)

@[to_additive] lemma list.prod_congr {α : Type*} [monoid α] {xs xs' : list α} {z : α}
  (h₁ : xs = xs') (h₂ : xs'.prod = z) : xs.prod = z := by cc

@[to_additive] lemma multiset.prod_congr {α : Type*} [comm_monoid α]
  {xs : multiset α} {xs' : list α} {z : α}
  (h₁ : xs = (xs' : multiset α)) (h₂ : xs'.prod = z) : xs.prod = z :=
by rw [← h₂, ← multiset.coe_prod, h₁]

/-- Evaluate `(%%xs.map (%%ef : %%α → %%β)).prod`,
producing the evaluated expression and an equality proof. -/
meta def list.prove_prod_map (β ef : expr) (xs : list expr) : tactic (expr × expr) := do
  (fxs, fxs_eq) ← eval_list_map ef xs,
  (prod, prod_eq) ← list.prove_prod β fxs,
  eq ← i_to_expr ``(list.prod_congr %%fxs_eq %%prod_eq),
  pure (prod, eq)

/-- Evaluate `(%%xs.map (%%ef : %%α → %%β)).sum`,
producing the evaluated expression and an equality proof. -/
meta def list.prove_sum_map (β ef : expr) (xs : list expr) : tactic (expr × expr) := do
  (fxs, fxs_eq) ← eval_list_map ef xs,
  (sum, sum_eq) ← list.prove_sum β fxs,
  eq ← i_to_expr ``(list.sum_congr %%fxs_eq %%sum_eq),
  pure (sum, eq)

@[to_additive]
lemma finset.eval_prod_of_list {β α : Type*} [comm_monoid β]
  (s : finset α) (f : α → β) {is : list α} (his : is.nodup)
  (hs : finset.mk ↑is (multiset.coe_nodup.mpr his) = s)
  {x : β} (hx : (is.map f).prod = x) :
  s.prod f = x :=
by rw [← hs, finset.prod_mk, multiset.coe_map, multiset.coe_prod, hx]

/-- `norm_num` plugin for evaluating big operators:
 * `list.prod`
 * `list.sum`
 * `multiset.prod`
 * `multiset.sum`
 * `finset.prod`
 * `finset.sum`
-/
@[norm_num] meta def eval_big_operators : expr → tactic (expr × expr)
| `(@list.prod %%α %%inst1 %%inst2 %%exs) :=
tactic.trace_error "Internal error in `tactic.norm_num.eval_big_operators`:" $ do
  (xs, list_eq) ← eval_list exs,
  (result, sum_eq) ← list.prove_prod α xs,
  pf ← i_to_expr ``(list.prod_congr %%list_eq %%sum_eq),
  pure (result, pf)
| `(@list.sum %%α %%inst1 %%inst2 %%exs) :=
tactic.trace_error "Internal error in `tactic.norm_num.eval_big_operators`:" $ do
  (xs, list_eq) ← eval_list exs,
  (result, sum_eq) ← list.prove_sum α xs,
  pf ← i_to_expr ``(list.sum_congr %%list_eq %%sum_eq),
  pure (result, pf)
| `(@multiset.prod %%α %%inst %%exs) :=
tactic.trace_error "Internal error in `tactic.norm_num.eval_big_operators`:" $ do
  (xs, list_eq) ← eval_multiset exs,
  (result, sum_eq) ← list.prove_prod α xs,
  pf ← i_to_expr ``(multiset.prod_congr %%list_eq %%sum_eq),
  pure (result, pf)
| `(@multiset.sum %%α %%inst %%exs) :=
tactic.trace_error "Internal error in `tactic.norm_num.eval_big_operators`:" $ do
  (xs, list_eq) ← eval_multiset exs,
  (result, sum_eq) ← list.prove_sum α xs,
  pf ← i_to_expr ``(multiset.sum_congr %%list_eq %%sum_eq),
  pure (result, pf)
| `(@finset.prod %%β %%α %%inst %%es %%ef) :=
tactic.trace_error "Internal error in `tactic.norm_num.eval_big_operators`:" $ do
  (xs, list_eq, nodup) ← eval_finset decide_eq es,
  (result, sum_eq) ← list.prove_prod_map β ef xs,
  pf ← i_to_expr ``(finset.eval_prod_of_list %%es %%ef %%nodup %%list_eq %%sum_eq),
  pure (result, pf)
| `(@finset.sum %%β %%α %%inst %%es %%ef) :=
tactic.trace_error "Internal error in `tactic.norm_num.eval_big_operators`:" $ do
  (xs, list_eq, nodup) ← eval_finset decide_eq es,
  (result, sum_eq) ← list.prove_sum_map β ef xs,
  pf ← i_to_expr ``(finset.eval_sum_of_list %%es %%ef %%nodup %%list_eq %%sum_eq),
  pure (result, pf)
| _ := failed

end tactic.norm_num


import tactic
import data.set.basic
import data.real.basic

noncomputable theory

/-
Some set theory lemmas I couldn't find using library_search
-- do these already exist?
-- why is the autocomplete not finding all definitions in set and finset?
-- e.g. set.comp doesn't suggest set.compl
-/

@[simp] def finsInter {X : Type} (s : finset (set X)) : set X :=
  {t | ∀ a ∈ s, t ∈ a}
prefix `⋂₀`:110 := finsInter

lemma finsInter_coe {X : Type} (s : finset (set X)) :
  ⋂₀ s = ⋂₀ (s : set (set X)) := by {ext, simp}

@[simp] def finsUnion {X : Type} (s : finset (set X)) : set X :=
  {t | ∃ a ∈ s, t ∈ a}
prefix `⋃₀`:110 := finsUnion

lemma finsUnion_coe {X : Type} (s : finset (set X)) :
  ⋃₀ s = ⋃₀ (s : set (set X)) :=
begin
  ext, split; {intro hx, simp at *, exact hx,},
end

lemma finsInter_combined {X : Type} (s t : finset (set X)) [decidable_eq (set X)] :
  ⋂₀ (s ∪ t) = (⋂₀ s) ∩ (⋂₀ t) :=
begin
  rw [finsInter_coe s, finsInter_coe t, ← set.sInter_union],
  ext, simp,
end

-- topology starts here
-- definition of topology and basis

class topology (X : Type) :=
(opens [] : set (set X)) -- should this instead be: is_open : set X → Prop ?
(empty_open : ∅ ∈ opens)
(univ_open : set.univ ∈ opens)
(inter₂ : ∀ (U V : set X),
  (U ∈ opens) → (V ∈ opens) → set.inter U V ∈ opens)
(union : ∀ (sU : set (set X)),
  (sU ⊆ opens) → ⋃₀ sU ∈ opens)

namespace topology

variables {X : Type} [topology X]

@[simp]
def is_open (U : set X) := U ∈ opens X

-- can this be given useful coercions? I haven't used this much.
def nbhd (x : X) (U : set X) := U ∈ opens X ∧ x ∈ U

lemma open_of_inter_of_finset [decidable_eq (set X)] (sU : finset (set X)) :
  (↑sU ⊆ opens X) → ⋂₀ sU ∈ opens X :=
begin
  intro h_opens,
  induction sU using finset.induction_on with U sU hU1 hU2,
  simp, exact univ_open,
  clear hU1,
  simp,
  have U_open := h_opens (finset.mem_insert_self U sU),
  have inter_sU_open := hU2 (set.subset.trans (finset.subset_insert U sU) h_opens),
  have target : {t : X | t ∈ U ∧ ∀ (a : set X), a ∈ sU → t ∈ a} = U.inter (⋂₀ sU),
  finish,
  rw target,
  exact inter₂ U (⋂₀ sU) U_open inter_sU_open,
end

lemma open_if_open_around_mem (A : set X) : A ∈ opens X ↔
  ∀ x ∈ A, ∃ U, nbhd x U ∧ U ⊆ A :=
begin
  split, intros hA x hx, use A, exact ⟨⟨hA, hx⟩, by tauto⟩,
  intro hA,
  suffices : A = ⋃₀ {U | U ∈ opens X ∧ U ⊆ A},
  rw this, apply union, rw set.set_of_and, simp,
  ext x, specialize hA x, unfold nbhd at hA, simp at *,
  conv
  begin
    to_rhs, congr, funext,
    rw and_assoc,
    rw and_comm (a ⊆ A) _, rw ← and_assoc,
  end,
  split, exact hA,
  rintro ⟨U, hU⟩, apply hU.2, exact hU.1.2,
end

def basis (B : set (set X)) :=
  B ⊆ opens X ∧ ∀ (U ∈ opens X) (x ∈ U), ∃ W ∈ B, x ∈ W ∧ W ⊆ U

def pre_basis {Y : Type} (B : set (set Y)) :=
  ⋃₀ B = set.univ ∧ ∀ (U V ∈ B) (x ∈ U ∩ V), ∃ W ∈ B, x ∈ W ∧ W ⊆ U ∩ V

def topology_generated_by_basis {Y : Type} {B : set (set Y)}
  (hB : pre_basis B) : (topology Y) :=
⟨ {U : set Y | ∀ (x ∈ U), ∃ W ∈ B, x ∈ W ∧ W ⊆ U},
  λ x hx, false.rec _ hx,
  λ x hx,
    let ⟨W, hW, hxW⟩ := @eq.substr _ _ _ _ hB.1 hx in
    ⟨W, hW, hxW, by simp⟩,
  λ U V hU hV x hx,
    let ⟨U0, hU0, hxU0⟩ := hU x hx.1 in
    let ⟨V0, hV0, hxV0⟩ := hV x hx.2 in
    let ⟨W, hW, hxW⟩ := hB.2 U0 V0 hU0 hV0 x ⟨hxU0.1, hxV0.1⟩ in
    let key := set.inter_subset_inter hxU0.2 hxV0.2 in
    ⟨W, hW, hxW.1, set.subset.trans hxW.2 key⟩,
  λ sU hsU x hx,
    let ⟨U, hU, hxU⟩ := hx in
    let ⟨W, hW, hxW⟩ :=  hsU hU x hxU in
    ⟨W, hW, hxW.1, (λ w hw, ⟨U, hU, hxW.2 hw⟩)⟩,
⟩

lemma union_of_basis_of_open (B : set (set X)) : basis B → ∀ U ∈ opens X,
  U = ⋃₀ {W : set X | W ∈ B ∧ W ⊆ U} :=
begin
  intros hB U hU,
  apply set.subset.antisymm,
  intros x hxU,
  obtain ⟨W, hW, hxW⟩ := hB.2 U hU x hxU,
  use W, split, exact ⟨hW, hxW.2⟩, exact hxW.1,
  apply set.sUnion_subset,
  intros W hW, exact hW.2,
end

lemma pre_basis_of_subbasis [decidable_eq (set X)]
  (S : set (set X)) (hS : ⋃₀ S = set.univ) :
  pre_basis {W : set X | ∃ sU : finset (set X), ↑sU ⊆ S ∧ W = ⋂₀ sU} :=
begin
  split,
  ext, split, tauto, intro h, rw ← hS at h, clear hS,
  obtain ⟨S0, hS0, hxS0⟩ := h,
  use S0, split, use {S0}, simp, exact hS0, exact hxS0,
  rintros U V ⟨sU, hsU, hsU'⟩ ⟨sV, hsV, hsV'⟩ x hx,
  use U ∩ V, use (sU ∪ sV),
  split, simp, exact ⟨by assumption, by assumption⟩,
  rw hsU', rw hsV',
  clear hsU' hsV' hsU hsV hx x U V hS S,
  rw finsInter_combined,
  split, exact hx, simp,
end

/-
Tried proving this using the definition "an open set is a union of basis elements".
theorem topology_generated_by_basis2 {Y : Type} {B : set (set Y)} :
  pre_basis B → topology Y :=
begin
  intro h,
  -- use {U : set Y | ∀ (x ∈ U), ∃ W ∈ B, x ∈ W ∧ W ⊆ U},
  use {U : set Y | ∃ sU ⊆ B, ⋃₀ sU = U},
  use ∅, simp, -- empty
  simp, use B, rw h.1, simp, -- X
  rintros U V ⟨sU, hsU, hsU'⟩ ⟨sV, hsV, hsV'⟩, -- intersections...
  use {W : set Y | W ∈ B ∧ ∃ (U0 ∈ sU) (V0 ∈ sV), W ⊆ U0 ∩ V0},
  split, intros W hW, exact hW.1,
  ext, split, rintro ⟨W, ⟨hW, ⟨U0, hU0, V0, hV0, hWU0V0⟩⟩, hx⟩,
  split, rw ← hsU', use U0, split, assumption, exact (hWU0V0 hx).1,
  rw ← hsV', use V0, split, assumption, exact (hWU0V0 hx).2,
  rintro ⟨hxU, hxV⟩,
  rw ← hsU' at hxU,
  rw ← hsV' at hxV,
  obtain ⟨U0, hU0, hxU0⟩ := hxU,
  obtain ⟨V0, hV0, hxV0⟩ := hxV,
  obtain ⟨W, hW, hW'⟩ := h.2 U0 V0 (hsU hU0) (hsV hV0) x (by exact ⟨hxU0, hxV0⟩),
  use W, split, split, assumption, use U0, split, assumption, use V0, split,
  assumption, exact hW'.2, exact hW'.1, -- ... done.
  intros sU hsU, -- unions...
  use {W : set Y | W ∈ B ∧ ∃ U ∈ sU, W ⊆ U},
  split, intros W hW, exact hW.1,
  ext, split,
  rintros ⟨W, ⟨⟨hW, ⟨U, hU, hWU⟩⟩, hxW⟩⟩, use U, split, assumption, exact hWU hxW,
  rintro ⟨U, hU, hxU⟩,
  obtain ⟨sV, hsV, hsV'⟩ := hsU hU,
  rw ← hsV' at hxU,
  obtain ⟨W, hW, hxW⟩ := hxU,
  use W, split, split, exact hsV hW, use U, split, exact hU, rw ← hsV',
  intros y hy, use W, split, assumption, assumption, assumption, -- ... done.
end
-/

def discrete_topology (X : Type) : topology X :=
  ⟨set.univ, by trivial, by trivial, λ _ _ _ _, trivial, λ _ _, trivial⟩
def indiscrete_topology {X : Type} : topology X :=
  ⟨{∅, set.univ}, set.mem_insert ∅ {set.univ}, or.inr (set.mem_singleton set.univ),
  begin intros U V hU hV, cases hV,
    rw hV, left, exact set.inter_empty U,
    simp at hV, rw hV, have : U.inter set.univ = U ∩ set.univ, refl, rw this,
    rw set.inter_univ U, exact hU, end,
  begin intros sU hsU, by_cases (set.univ ∈ sU),
    right, simp, ext, simp, exact ⟨set.univ, h, trivial⟩,
    left, simp, intros s hs, cases hsU hs, exact h_1, exfalso,
    simp at h_1, rw h_1 at hs, exact h hs, end⟩

inductive point : Type | p : point
lemma point.is_singleton (x : point) : x = point.p :=
  by {induction x, refl}
lemma point.subset (s : set point) : s = ∅ ∨ s = set.univ :=
  begin by_cases point.p ∈ s,
    right, ext, simp, rw point.is_singleton x, exact h,
    left, ext, simp, rw point.is_singleton x, exact h, end
@[simp] def map_to_point (X : Type) : X → point := λ _, point.p
@[simp] def map_to_point.val (X : Type) (f : X → point) (x : X) : f x = point.p :=
  by rw point.is_singleton (f x)
def map_to_point.unq (X : Type) (f : X → point) : f = map_to_point X :=
  by {funext, rw point.is_singleton (f x), refl}
instance topology_point : topology point := discrete_topology point

end topology

open topology

section closed_sets

parameters {X : Type} [topology X]

@[simp] def closed (C : set X) := set.compl C ∈ opens X

lemma inter_of_closed (sC : set (set X)) :
  (compl '' sC) ⊆ opens X → closed ⋂₀ sC :=
begin
  rw set.sInter_eq_comp_sUnion_compl,
  dsimp, rw compl_compl,
  apply union,
end

lemma union₂_of_closed (C D : set X) : closed C → closed D → closed (C ∪ D) :=
begin
  dsimp, rw set.compl_union C D,
  apply inter₂,
end

lemma closed_of_union_of_finset [decidable_eq (set X)] (sC : finset (set X)) :
  ↑(finset.image compl sC) ⊆ opens X → closed ⋃₀ sC :=
begin
  rw finsUnion_coe, dsimp,
  rw set.sUnion_eq_compl_sInter_compl, rw compl_compl,
  rw ← finset.coe_image,
  apply open_of_inter_of_finset,
end

-- closures

def closure (A : set X) := ⋂₀ {C | closed C ∧ A ⊆ C}

lemma closure_def (A : set X) : closure A = ⋂₀ {C | closed C ∧ A ⊆ C} := rfl

lemma closure_is_closed (A : set X) : closed (closure A) :=
begin
  apply inter_of_closed,
  rw set.compl_image_set_of,
  rw set.set_of_and, simp,
end

lemma self_subset_closure (A : set X) : A ⊆ closure A :=
begin
  apply set.subset_sInter, rw set.set_of_and, simp,
end

lemma closure_subset_closed (A C : set X) : closed C ∧ A ⊆ C → closure A ⊆ C :=
begin
  intro h, apply set.sInter_subset_of_mem, assumption,
end

lemma closure_iff (A C' : set X) : C' = closure A ↔
  (∀ C, (closed C ∧ A ⊆ C) → C' ⊆ C) ∧ closed C' ∧ A ⊆ C' :=
begin
  split, intro h, rw h, clear h,
  split,
    {apply closure_subset_closed,},
  split,
    {apply closure_is_closed,},
    {apply self_subset_closure,},
  intro h, apply set.subset.antisymm,
  { apply h.1 (closure A),
    exact ⟨closure_is_closed A, self_subset_closure A⟩,},
  { exact closure_subset_closed _ _ h.2,},
end

@[simp]
lemma closure_of_closed (C : set X) (hC: closed C) : closure C = C :=
begin
  symmetry, apply (closure_iff C C).mpr,
  simp, exact ⟨hC, by tauto⟩,
end

@[simp]
lemma closure_closure (A : set X) : closure (closure A) = closure A :=
begin
  apply closure_of_closed, apply closure_is_closed,
end

-- interiors
def interior (A : set X) := ⋃₀ {U : set X | is_open U ∧ U ⊆ A}

lemma interior_def (A : set X) :
  interior A = ⋃₀ {U : set X | is_open U ∧ U ⊆ A} := rfl

-- would it be better to prove the subsequent lemmas
-- from this one + the corresponding closure lemmas?
lemma interior_compl_closure_compl (A : set X) :
  interior A = (closure A.compl).compl :=
begin
  dsimp, rw closure_def, rw interior_def,
  rw set.sInter_eq_comp_sUnion_compl, rw compl_compl,
  rw set.compl_image_set_of, simp,
end

lemma closure_compl_interior_compl (A : set X) :
  closure A = (interior A.compl).compl :=
begin
  rw interior_compl_closure_compl, simp,
end

lemma interior_is_open (A : set X) : is_open (interior A) :=
begin
  apply union,
  rw set.set_of_and, simp,
end

lemma open_subset_interior (A U : set X) : is_open U ∧ U ⊆ A → U ⊆ interior A :=
begin
  dsimp, intro h,
  apply set.subset_sUnion_of_mem, assumption,
end

lemma interior_subset_self (A : set X) : interior A ⊆ A :=
begin
  apply set.sUnion_subset, rw set.set_of_and, simp,
end

lemma interior_iff (A A' : set X) : A' = interior A ↔
  (∀ U, (is_open U ∧ U ⊆ A) → U ⊆ A') ∧ is_open A' ∧ A' ⊆ A :=
begin
  split, intro h, rw h, clear h,
  split,
    { apply open_subset_interior,},
  split,
    { apply interior_is_open,},
    { apply interior_subset_self,},
  intro h, apply set.subset.antisymm,
  apply open_subset_interior, exact h.2,
  apply h.1 (interior A),
  split, apply interior_is_open, apply interior_subset_self,
end

lemma interior_of_open (U : set X) (hU : is_open U) : interior U = U :=
begin
  symmetry, apply (interior_iff U U).mpr,
  simp, exact ⟨hU, by tauto⟩,
  /- here is the proof by taking complements, which seems harder:
  rw interior_compl_closure_compl,
  apply compl_inj_iff.mp, dsimp, rw compl_compl,
  apply closure_of_closed, dsimp, rw compl_compl, exact hU,
  -/
end

@[simp]
lemma interior_interior (A : set X) :
  interior (interior A) = interior A :=
begin
  apply interior_of_open, apply interior_is_open,
end

-- limit points and elementwise properties of closures

def accumulation_point (C : set X) (x : X) :=
  (∀ U, nbhd x U → set.nonempty (U ∩ C ∩ {x}ᶜ))

def isolated_point (C : set X) (x : X) :=
  ∃ U, nbhd x U ∧ U ∩ C = {x}

lemma mem_interior (A : set X) : interior A =
  {x | ∃ U ∈ opens X, x ∈ U ∧ U ⊆ A} :=
begin
  ext x, rw interior_def, simp, tauto,
end

lemma mem_closure (A : set X) : closure A =
  {y | ∀ U ∈ opens X, y ∈ U → set.nonempty (U ∩ A)} :=
begin
  ext y,
  rw closure_compl_interior_compl,
  rw ← not_iff_not, simp, rw mem_interior,
  conv -- rewrite ¬(U ∩ A).nonempty to U subseteq Aᶜ
  begin
    to_rhs, congr, funext,
    rw set.not_nonempty_iff_eq_empty,
    rw ← set.subset_compl_iff_disjoint,
  end,
  simp,
end

lemma closure_self_union_acc (A : set X) :
  closure A = A ∪ {x | accumulation_point A x} :=
begin
  ext x, split, intro hx, by_cases (x ∈ A), left, assumption, right,
  intros U hU, unfold nbhd at hU,
  rw mem_closure at hx,
  obtain ⟨y, hy⟩ := hx U hU.1 hU.2,
  use y, split, exact hy, simp, intro hxy, apply h, rw hxy at hy, exact hy.2,
  intro h, cases h with hL hR,
  exact self_subset_closure A hL,
  rw mem_closure,
  intros U hU hxU, obtain ⟨y, hy⟩ := hR U ⟨hU, hxU⟩,
  use y, exact hy.1,
end

end closed_sets

section cts_fn

variables {X Y : Type} [topology X] [topology Y]

def cts (f : X → Y) := ∀ V ∈ opens Y, f ⁻¹' V ∈ opens X

lemma cts.id : cts (@id X) := begin intros V hV, exact hV, end

lemma cts_of_comp {Z : Type} [topology Z] (f : X → Y) (g : Y → Z) :
  cts f → cts g → cts (g ∘ f) :=
begin
  intros hf hg W hW, rw set.preimage_comp,
  apply hf, apply hg, exact hW,
end

def ptwise_cts (f : X → Y) (x : X) :=
  ∀ V ∈ opens Y, f x ∈ V → ∃ U ∈ opens X, (f '' U) ⊆ V ∧ x ∈ U

lemma cts_of_closed_iff (f : X → Y) : cts f ↔
  ∀ C, closed C → closed (f ⁻¹' C) :=
begin
  split,
  { intros hf C hC,
    simp at *,
    rw ← set.preimage_compl, exact hf Cᶜ hC,},
  { intros hf U hU,
    simp at *,
    specialize hf Uᶜ, rw compl_compl at hf,
    specialize hf hU,
    rwa [set.preimage_compl, compl_compl] at hf,
  },
end

lemma cts_iff_ptwise_cts (f : X → Y) : cts f ↔
  ∀ (x : X), ptwise_cts f x :=
begin
  split,
  { intros hf x V hV hxV,
    exact ⟨f ⁻¹' V, hf V hV, by simp, hxV⟩, },
  { intros hf U hU,
    apply (open_if_open_around_mem _).mpr,
    intros x hx,
    obtain ⟨V, ⟨hV1, hV2, hxV⟩⟩ := hf x U hU hx,
    use V, exact ⟨⟨hV1, hxV⟩, by rwa ← set.image_subset_iff⟩,
    },
end

def cts_iff_cts_on_basis (f : X → Y) (B : set (set Y)) (hB : basis B) :
  cts f ↔ ∀ V, (V ∈ B → f ⁻¹' V ∈ opens X) :=
begin
  split; intros hf V hV,
  exact hf V (hB.1 hV),
  rw union_of_basis_of_open B hB V hV,
  let sY := {W | W ∈ B ∧ W ⊆ V},
  have key : f ⁻¹' ⋃₀ sY = ⋃₀ (set.preimage f '' sY), simp,
  rw key,
  apply union, rw ← set.maps_to',
  intros W hW, exact hf W hW.1,
end

def open_immersion (f : X → Y) := cts f ∧ function.injective f
  ∧ f '' set.univ ∈ opens Y

def open_map (f : X → Y) := ∀ U ∈ opens X, f '' U ∈ opens Y

lemma map_to_point_cts : cts (map_to_point X) :=
begin
  intros V hV, unfold set.preimage, simp, cases point.subset V; rw h,
  exact empty_open, exact univ_open,
end

end cts_fn

section homeo

variables {X Y Z : Type} [topology X] [topology Y] [topology Z]

def homeo (f : X → Y) :=
  cts f ∧ ∃ (g : Y → X) (hg : cts g),
    function.left_inverse g f ∧ function.right_inverse g f

lemma homeo_iff (f : X → Y) : homeo f ↔
  cts f ∧ function.bijective f ∧ open_map f :=
begin
  split, rintro ⟨hf, g, hg, hg'⟩,
    split, exact hf,
    split, rw function.bijective_iff_has_inverse, exact ⟨g, hg'⟩,
    intros U hU,
    suffices : f '' U = g ⁻¹' U,
    rw this, apply hg, exact hU,
    rw set.image_eq_preimage_of_inverse hg'.1 hg'.2,
  rintro ⟨hf, hbij, hf_open_map⟩,
  split, exact hf,
  obtain ⟨g, hg'⟩ := function.bijective_iff_has_inverse.mp hbij,
  have hg : cts g,
    intros U hU,
    suffices : f '' U = g ⁻¹' U,
    rw ← this, apply hf_open_map, exact hU,
    rw set.image_eq_preimage_of_inverse hg'.1 hg'.2,
  exact ⟨g, hg, hg'⟩,
end

lemma homeo_comp (f : X → Y) (g : Y → Z) :
  homeo f → homeo g → homeo (g  ∘ f) :=
begin
  rintros ⟨hf, finv, hfinv, hfinv'⟩ ⟨hg, ginv, hginv, hginv'⟩,
  split, exact cts_of_comp f g hf hg,
  use finv ∘ ginv,
  split, exact cts_of_comp ginv finv hginv hfinv,
  exact ⟨function.left_inverse.comp hginv'.1 hfinv'.1,
         function.right_inverse.comp hginv'.2 hfinv'.2⟩,
end

end homeo

section constructing_topology

lemma basis_is_basis_of_generated {Y : Type} {B : set (set Y)} (hB : pre_basis B) :
  @basis Y (topology_generated_by_basis hB) B :=
begin
  split, tauto, tauto,
end

section product_topology

variables {X Y : Type} [topology X] [topology Y]

lemma pre_basis_for_product_topology :
  pre_basis {U : set (X × Y) | ∃ (UX ∈ opens X) (UY ∈ opens Y),
    (set.prod UX UY) = U} :=
begin
  split, ext, simp, use set.univ, simp,
  use set.univ, split, exact univ_open,
  use set.univ, split, exact univ_open,
  simp,
  rintros U V ⟨UX, hUX, ⟨UY, hUY, hUU⟩⟩ ⟨VX, hVX, ⟨VY, hVY, hVV⟩⟩ p hp,
  use (UX ∩ VX).prod (UY ∩ VY), split,
  use (UX ∩ VX), split,
  exact inter₂ UX VX hUX hVX,
  use (UY ∩ VY), split,
  exact inter₂ UY VY hUY hVY, refl,
  rw [← hUU, ← hVV] at *,
  rw set.prod_inter_prod at *, exact ⟨hp, by tauto⟩,
end

instance product_topology : topology (X × Y) :=
  topology_generated_by_basis (pre_basis_for_product_topology)

instance topologies_to_product_topology :
  has_coe ((topology X) × (topology Y)) (topology (X × Y)) :=
  ⟨λ T_pair, product_topology⟩

lemma product_topology.basis :
  basis {U : set (X × Y) | ∃ (UX ∈ opens X) (UY ∈ opens Y),
    (set.prod UX UY) = U} :=
  basis_is_basis_of_generated (pre_basis_for_product_topology)

lemma basis_around_point
  (U : set (X × Y))
  (hU : U ∈ opens (X × Y))
  (p : (X × Y)) (hp : p ∈ U) :
  ∃ (UX ∈ opens X) (UY ∈ opens Y), p ∈ (set.prod UX UY) ∧ (set.prod UX UY) ⊆ U :=
begin
  have h := basis_is_basis_of_generated pre_basis_for_product_topology,
  obtain ⟨W, ⟨UX, hUX, UY, hUY, hUU⟩, ⟨hpW, hWU⟩⟩ := h.2 U hU p hp,
  use UX, split, exact hUX, use UY, clear h hU,
  split, exact hUY, split, rwa hUU, rwa hUU,
end

lemma prod_of_bases_is_basis (BX : set (set X)) (BY : set (set Y)) :
  basis BX → basis BY →
  basis {U : set (X × Y) | ∃ (UX ∈ BX) (UY ∈ BY), (set.prod UX UY) = U} :=
begin
  intros hBX hBY,
  split,
  rintros U ⟨UX, hUX, ⟨UY, hUY, hprod⟩⟩,
  intros x hx, use UX.prod UY, split,
  use UX, split, exact hBX.1 hUX,
  use UY, split, exact hBY.1 hUY,
  refl,
  split; rwa hprod,
  intros U hU p hp,
  obtain ⟨UX, hUX, ⟨UY, hUY, hp_prod, hprodU⟩⟩ := basis_around_point U hU p hp,
  obtain ⟨UX', hUX', hUX''⟩ := hBX.2 UX hUX p.fst hp_prod.1,
  obtain ⟨UY', hUY', hUY''⟩ := hBY.2 UY hUY p.snd hp_prod.2,
  use UX'.prod UY', split, rotate,
  split, exact ⟨hUX''.1, hUY''.1⟩,
  apply set.subset.trans _ hprodU,
  exact set.prod_mono hUX''.2 hUY''.2,
  use UX', split, exact hUX', use UY', split, exact hUY', refl,
end

lemma prod_of_opens_is_open
  (U : set X) (hU : U ∈ opens X) (V : set Y) (hV : V ∈ opens Y) :
  (set.prod U V) ∈ opens (X × Y) :=
begin
  intros x hx, exact ⟨set.prod U V, ⟨U, hU, V, hV, by simp⟩, hx, by refl⟩,
end

lemma prod_fst_cts : cts (prod.fst : X × Y → X) :=
begin
  intros UX hUX x hx, use prod.fst ⁻¹' UX,
  split, exact ⟨UX, hUX, set.univ, univ_open, by {ext, simp}⟩,
  tauto,
end

lemma prod_snd_cts : cts (prod.snd : X × Y → Y) :=
begin
  intros UY hUY y hy, use prod.snd ⁻¹' UY,
  split, exact ⟨set.univ, univ_open, UY, hUY, by {ext, simp}⟩,
  tauto,
end

lemma cts_map_to_prod {Z : Type} [topology Z] (f : Z → X × Y) :
  cts f ↔ cts (prod.fst ∘ f) ∧ cts (prod.snd ∘ f) :=
begin
  split, intro hf, split;
  apply cts_of_comp,
    exact hf, apply prod_fst_cts,
    exact hf, apply prod_snd_cts,
  intro hf,
  rw cts_iff_cts_on_basis f _ product_topology.basis,
  simp, rintros V UX hUX UY hUY h, rw ← h,
  have : f ⁻¹' (UX.prod UY) = ((prod.fst ∘ f) ⁻¹' UX) ∩ ((prod.snd ∘ f) ⁻¹' UY),
    ext z, exact iff.rfl, rw this,
  apply inter₂, apply hf.1 _ hUX, apply hf.2 _ hUY,
end

lemma prod_map_cts {Z W : Type} [topology Z] [topology W]
  (f : X → Z) (g : Y → W) (hf : cts f) (hg : cts g) :
  cts (prod.map f g) :=
begin
  rw cts_map_to_prod,
  split; intros V hV; rw set.preimage_comp,
  suffices key : (set.prod (f ⁻¹' V) set.univ) ∈ opens _,
  convert key, ext, simp,
  apply prod_of_opens_is_open, exact hf V hV, exact univ_open,
  suffices key : (set.prod set.univ (g ⁻¹' V)) ∈ opens _,
  convert key, ext, simp,
  apply prod_of_opens_is_open, exact univ_open, exact hg V hV,
end

def diag (X : Type) [topology X] (x : X) : X × X := (x, x)
lemma diag.cts (X : Type) [topology X] : cts (diag X) :=
begin
  rw cts_map_to_prod, exact ⟨cts.id, cts.id⟩,
end

def prod_equiv_left (X : Type) {Y Y' : Type} (φ : equiv Y Y') :
  equiv (X × Y) (X × Y') := functor.map_equiv (prod X) φ

def prod_equiv_right {X X' : Type} (φ : equiv X X') (Y : Type) :
  equiv (X × Y) (X' × Y) :=
  equiv.trans
    (equiv.trans (equiv.prod_comm _ _)
    (functor.map_equiv (prod Y) φ))
    (equiv.prod_comm _ _)

def prod_point_right (X : Type) : X × point ≃ X :=
{ to_fun    := prod.fst,
  inv_fun   := λ x, ⟨x, point.p⟩,
  left_inv  := begin rintro ⟨x, y⟩, simp, rw point.is_singleton y, end,
  right_inv := λ x, rfl }

def prod_point_left (X : Type) : point × X ≃ X :=
{ to_fun    := prod.snd,
  inv_fun   := λ x, ⟨point.p, x⟩,
  left_inv  := begin rintro ⟨y, x⟩, simp, rw point.is_singleton y, end,
  right_inv := λ x, rfl }

lemma prod_equiv_left.cts (X : Type) {Y Y' : Type} [topology X] [topology Y] [topology Y']
  (φ : equiv Y Y') (hφ : cts φ) (hφ' : cts φ.symm) : cts (prod_equiv_left X φ) :=
  prod_map_cts _ _ cts.id hφ
lemma prod_equiv_left.inv_cts (X : Type) {Y Y' : Type} [topology X] [topology Y] [topology Y']
  (φ : equiv Y Y') (hφ : cts φ) (hφ' : cts φ.symm) : cts (prod_equiv_left X φ).symm :=
  prod_map_cts _ _ cts.id hφ'
lemma prod_equiv_right.cts (X : Type) {Y Y' : Type} [topology X] [topology Y] [topology Y']
  (φ : equiv Y Y') (hφ : cts φ) (hφ' : cts φ.symm) : cts (prod_equiv_right φ X) :=
  prod_map_cts _ _ hφ cts.id
lemma prod_equiv_right.inv_cts (X : Type) {Y Y' : Type} [topology X] [topology Y] [topology Y']
  (φ : equiv Y Y') (hφ : cts φ) (hφ' : cts φ.symm) : cts (prod_equiv_right φ X).symm :=
  prod_map_cts _ _ hφ' cts.id

lemma prod_point_right.cts (X : Type) [topology X] :
  cts (prod_point_right X).to_fun := prod_fst_cts
lemma prod_point_right.inv_cts (X : Type) [topology X] :
  cts (prod_point_right X).inv_fun :=
  (cts_map_to_prod _).mpr ⟨cts.id, map_to_point_cts⟩
lemma prod_point_left.cts (X : Type) [topology X] :
  cts (prod_point_left X).to_fun := prod_snd_cts
lemma prod_point_left.inv_cts (X : Type) [topology X] :
  cts (prod_point_left X).inv_fun :=
  (cts_map_to_prod _).mpr ⟨map_to_point_cts, cts.id⟩

end product_topology

section inverse_image_topology

-- consider generalizing to "limit topology"?

variables {X Y : Type} [topology X] (i : Y → X)

@[simp]
def inverse_image_opens :=
  --{W : set Y | ∃ (U ∈ opens X), W = i ⁻¹' U}
  set.preimage i '' opens X

lemma inverse_image_open_of_open (U : set X) :
  U ∈ opens X → i ⁻¹' U ∈ inverse_image_opens i :=
begin
  simp, intro hU, exact ⟨U, hU, by simp⟩,
end

lemma open_inter_of_preimage (U V : set Y) :
  U ∈ inverse_image_opens i → V ∈ inverse_image_opens i →
  U ∩ V ∈ inverse_image_opens i :=
begin
  rintros ⟨U', hU', hU''⟩ ⟨V', hV', hV''⟩,
  exact ⟨U' ∩ V', ⟨inter₂ U' V' hU' hV',
                   by rw [set.preimage_inter, hU'', hV'']⟩⟩,
end

lemma open_union_of_preimage (sU : set (set Y)) :
  (sU ⊆ inverse_image_opens i) → ⋃₀ sU ∈ inverse_image_opens i :=
begin
  rintros hsU,
  let sV := {V : set X | V ∈ opens X ∧ i ⁻¹' V ∈ sU},
  use ⋃₀ sV,
  split, exact union _ (λ _ hV, hV.1),
  suffices : (set.preimage i) '' sV = sU,
  rw ← this, simp,
  ext U, split, rintro ⟨V, hV, hV'⟩, rw ← hV', exact hV.2,
  intro hU, obtain ⟨V, hV, hV'⟩ := hsU hU,
  use V, split, split, exact hV, rw hV', exact hU, exact hV',
end

def inverse_image_topology : topology Y := ⟨
  inverse_image_opens i,
  ⟨∅, ⟨empty_open, rfl⟩⟩,
  ⟨set.univ, ⟨univ_open, rfl⟩⟩,
  open_inter_of_preimage i,
  open_union_of_preimage i,
⟩

lemma pullback_cts_along_inverse_image (Z : Type) [topology Z] (f : X → Z):
  cts f → @cts _ _ (inverse_image_topology i) _ (f ∘ i) :=
begin
  intros hf V hV,
  change i ⁻¹' (f ⁻¹' V) ∈ opens _,
  apply inverse_image_open_of_open, exact hf V hV,
end

end inverse_image_topology

section subspace_topology

variables {X : Type} (A : set X)

@[simp] def to_sub : set X → set A := set.preimage coe
@[simp] def from_sub : set A → set X := set.image coe

def incl_of_subsets {U U' : set X} (hU' : U' ⊆ U) : U' → U :=
  subtype.map (@id X) hU'

def restrict_cod {Y : Type} (f : X → Y) {p : Y → Prop}
  (h : ∀ (x : X), p (f x)) : X → (subtype p) :=
  subtype.coind f h

def restrict_target {Y : Type} (f : X → Y)
  (U : set Y) : f ⁻¹' U → U :=
  subtype.map f (by simp)

lemma to_sub_eq_inter (V : set X) : to_sub A V = to_sub A (A ∩ V) := by simp
lemma from_sub_subset_self (U : set A) : from_sub A U ⊆ A := by simp

@[simp]
lemma from_sub_to_sub_eq_inter (V : set X) : from_sub A (to_sub A V) = A ∩ V :=
begin
  ext x, simp, tauto,
end

@[simp]
lemma to_sub_from_sub_eq_self (U : set A) : to_sub A (from_sub A U) = U :=
begin
  ext x, simp,
end

@[simp]
lemma image_of_from_sub {Y : Type} (f : X → Y) (U : set A) :
  subtype.restrict f A '' U = f '' from_sub A U :=
begin
  ext y, split; simp; tauto,
end

@[simp]
lemma image_of_to_sub {Y : Type} (f : X → Y) (U : set X) :
  subtype.restrict f A '' to_sub A U = f '' (A ∩ U) :=
begin
  ext y, split; simp; tauto,
end

variables {Y : Type} {p : X → Prop} {q : Y → Prop}
  (f : X → Y) (hf : ∀ (x : X), p x → q (f x))

variable [topology X]

instance subtype_topology (p : X → Prop) : topology (subtype p) :=
  inverse_image_topology (coe : (subtype p) → X)

instance subspace_topology : topology A := subtype_topology A

lemma to_sub_open_iff (U' : set A) :
  U' ∈ opens A ↔ ∃ U ∈ opens X, U' = to_sub A U :=
begin
  split, rintros ⟨U', hU', hU⟩, tauto, rintro ⟨U, hU, hU'⟩,
  rw hU', simp, apply inverse_image_open_of_open, exact hU,
end

lemma from_sub_open_iff (hA : A ∈ opens X) (U' : set A) :
  U' ∈ opens A ↔ from_sub A U' ∈ opens X :=
begin
  rw to_sub_open_iff, split,
  { rintro ⟨U, hU, hU'⟩,  rw [hU', from_sub_to_sub_eq_inter],
    exact inter₂ _ _ hA hU},
  intro h, use from_sub A U', rw to_sub_from_sub_eq_self, exact ⟨h, by simp⟩,
end

lemma cts_at_pt_of_open {Y : Type} [topology Y]
  (f : X → Y)
  (U : set X) (hU : U ∈ opens X)
  (x : X) (hxU : x ∈ U) :
  ptwise_cts f x ↔
  @ptwise_cts _ _ (subspace_topology U) _ (subtype.restrict f U) ⟨x, hxU⟩ :=
begin
  split;
  intros hf V hV hfxV;
  obtain ⟨U', hU', hU'V, hxU'⟩ := hf V hV hfxV,
  use (to_sub U U'),
  split, simp,
  rw to_sub_open_iff, exact ⟨U', hU', by simp⟩,
  split, rw image_of_to_sub,
  exact set.subset.trans (set.image_subset f (set.inter_subset_right U U')) hU'V,
  exact hxU',
  use from_sub U U',
  split, rw ← from_sub_open_iff U hU, exact hU',
  split, rw ← image_of_from_sub, exact hU'V,
  simp, exact ⟨hxU, hxU'⟩,
end

lemma coe_cts {U : set X} : cts (coe : U → X) :=
begin
  intros V hV, exact ⟨V, hV, rfl⟩,
end

lemma coe_cts' {p : X → Prop} : cts (coe : (subtype p) → X) :=
begin
  intros V hV, exact ⟨V, hV, rfl⟩,
end

lemma restrict_cod_cts {Y : Type} [topology Y] {f : X → Y}
  {U : set Y} {hU : ∀ (x : X), U (f x)} (hf : cts f) :
  cts (restrict_cod f hU) :=
begin
  rintros V ⟨W, hW⟩,
  suffices : restrict_cod f hU ⁻¹' V = f ⁻¹' W,
    rw this, exact hf W hW.1,
  ext, unfold restrict_cod, rw ← hW.2, simp,
end

lemma subtype_map_cts {Y : Type} [topology Y] {f : X → Y} (hf : cts f)
  {p : X → Prop} {q : Y → Prop} {h : ∀ (x : X), p x → q (f x)} :
  cts (subtype.map f h) :=
begin
  rintros V ⟨W, hW, hW'⟩, rw ← hW',
  exact ⟨f ⁻¹' W, hf W hW, rfl⟩,
end

lemma incl_of_subsets_cts {U U' : set X} {hU' : U' ⊆ U} :
  cts (incl_of_subsets hU') :=
begin
  apply subtype_map_cts, intro V, exact id,
end

lemma restrict_target_cts {Y : Type} [topology Y] {f : X → Y}
  {U : set Y} (hf : cts f) : cts (restrict_target f U) :=
begin
  apply subtype_map_cts hf,
  /-
  -- alternate proof:
  apply restrict_cod_cts,
  apply cts_of_comp,
  apply coe_cts,
  exact hf,
  -/
end

lemma subtype_map_open {Y : Type} [topology Y] {f : X → Y}
  (hf : open_map f)
  {p : X → Prop} {q : Y → Prop} (hp : p ∈ opens X)
  {hpq : ∀ (x : X), p x → q (f x)} :
  open_map (subtype.map f hpq) :=
begin
  rintros V ⟨W, hW, hW'⟩, rw ← hW',
  have : subtype.map f hpq '' (coe ⁻¹' W) = coe ⁻¹' (f '' (p ∩ W)),
    ext ⟨y, hy⟩, unfold subtype.map, simp,
    conv begin to_rhs, congr, funext, rw and_assoc, end, refl,
  rw this,
  apply coe_cts, apply hf, apply inter₂ _ _ hp hW,
end

example {X Y : Type} [topology X] [topology Y] {f : X → Y} (hf : cts f) :
  let g : @set.univ X → @set.univ Y := λ x, subtype.mk (f x) trivial in
  cts g :=
begin
  intro g,
  suffices : g = restrict_target f set.univ,
    rw this, apply restrict_target_cts hf,
  ext ⟨x, hx⟩, unfold restrict_target, simp,
end

end subspace_topology

end constructing_topology

-- example:
-- ℝ with the standard topology
def ball (x ε : ℝ) := {y : ℝ | abs (y-x) < ε}

lemma subset_of_le_eps_ball
  (r1 r2 : ℝ) (h : r1 ≤ r2) (x : ℝ) :
  set.subset (ball x r1) (ball x r2) :=
begin
  intros y hy,
  unfold ball at *, simp at *, linarith,
end

lemma subset_of_lt_eps_ball
  (r1 r2 : ℝ) (h : r1 < r2) (x : ℝ) :
  set.subset (ball x r1) (ball x r2) :=
begin
  apply subset_of_le_eps_ball, linarith,
end

def standard_opens_ℝ :=
  {U : set ℝ | ∀ x ∈ U, ∃ ε > 0, set.subset (ball x ε) U}

lemma standard_basis_ℝ : pre_basis {W : set ℝ | ∃ x ε, W = ball x ε } :=
begin
  split,
  ext, simp, use ball x 1, use x, use 1, unfold ball, simp,
  rintros U V ⟨u, εu, hU⟩ ⟨v, εv, hV⟩ x hx,
  let r := min (εu - abs (x - u)) (εv - abs (x - v)),
  simp, use ball x r, use x, use r, unfold ball at *,
  rw hU at *, rw hV at *, clear hU hV,
  obtain ⟨hx1, hx2⟩ := hx, simp at *,
  split, split, assumption, assumption,
  split; intros a ha1 ha2,
  linarith [abs_sub_le a x u],
  linarith [abs_sub_le a x v],
end

instance standard_topology_ℝ : topology ℝ :=
  topology_generated_by_basis standard_basis_ℝ


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

universes u l u_1

namespace Mathlib

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

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

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

namespace units

protected instance Mathlib.add_units.has_coe {α : Type u} [add_monoid α] : has_coe (add_units α) α :=
  has_coe.mk add_units.val

@[simp] theorem Mathlib.add_units.coe_mk {α : Type u} [add_monoid α] (a : α) (b : α) (h₁ : a + b = 0) (h₂ : b + a = 0) : ↑(add_units.mk a b h₁ h₂) = a :=
  rfl

theorem ext {α : Type u} [monoid α] : function.injective coe := sorry

theorem Mathlib.add_units.eq_iff {α : Type u} [add_monoid α] {a : add_units α} {b : add_units α} : ↑a = ↑b ↔ a = b :=
  function.injective.eq_iff add_units.ext

theorem Mathlib.add_units.ext_iff {α : Type u} [add_monoid α] {a : add_units α} {b : add_units α} : a = b ↔ ↑a = ↑b :=
  iff.symm add_units.eq_iff

protected instance Mathlib.add_units.decidable_eq {α : Type u} [add_monoid α] [DecidableEq α] : DecidableEq (add_units α) :=
  fun (a b : add_units α) => decidable_of_iff' (↑a = ↑b) add_units.ext_iff

@[simp] theorem mk_coe {α : Type u} [monoid α] (u : units α) (y : α) (h₁ : ↑u * y = 1) (h₂ : y * ↑u = 1) : mk (↑u) y h₁ h₂ = u :=
  ext rfl

/-- Units of a monoid form a group. -/
protected instance group {α : Type u} [monoid α] : group (units α) :=
  group.mk (fun (u₁ u₂ : units α) => mk (val u₁ * val u₂) (inv u₂ * inv u₁) sorry sorry) sorry (mk 1 1 sorry sorry) sorry
    sorry (fun (u : units α) => mk (inv u) (val u) (inv_val u) (val_inv u))
    (div_inv_monoid.div._default (fun (u₁ u₂ : units α) => mk (val u₁ * val u₂) (inv u₂ * inv u₁) sorry sorry) sorry
      (mk 1 1 sorry sorry) sorry sorry fun (u : units α) => mk (inv u) (val u) (inv_val u) (val_inv u))
    sorry

@[simp] theorem Mathlib.add_units.coe_add {α : Type u} [add_monoid α] (a : add_units α) (b : add_units α) : ↑(a + b) = ↑a + ↑b :=
  rfl

@[simp] theorem coe_one {α : Type u} [monoid α] : ↑1 = 1 :=
  rfl

@[simp] theorem Mathlib.add_units.coe_eq_zero {α : Type u} [add_monoid α] {a : add_units α} : ↑a = 0 ↔ a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑a = 0 ↔ a = 0)) (Eq.symm add_units.coe_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑a = ↑0 ↔ a = 0)) (propext add_units.eq_iff))) (iff.refl (a = 0)))

@[simp] theorem inv_mk {α : Type u} [monoid α] (x : α) (y : α) (h₁ : x * y = 1) (h₂ : y * x = 1) : mk x y h₁ h₂⁻¹ = mk y x h₂ h₁ :=
  rfl

theorem val_coe {α : Type u} [monoid α] (a : units α) : ↑a = val a :=
  rfl

theorem coe_inv {α : Type u} [monoid α] (a : units α) : ↑(a⁻¹) = inv a :=
  rfl

@[simp] theorem inv_mul {α : Type u} [monoid α] (a : units α) : ↑(a⁻¹) * ↑a = 1 :=
  inv_val a

@[simp] theorem Mathlib.add_units.add_neg {α : Type u} [add_monoid α] (a : add_units α) : ↑a + ↑(-a) = 0 :=
  add_units.val_neg a

theorem inv_mul_of_eq {α : Type u} [monoid α] {u : units α} {a : α} (h : ↑u = a) : ↑(u⁻¹) * a = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(u⁻¹) * a = 1)) (Eq.symm h)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(u⁻¹) * ↑u = 1)) (inv_mul u))) (Eq.refl 1))

theorem Mathlib.add_units.add_neg_of_eq {α : Type u} [add_monoid α] {u : add_units α} {a : α} (h : ↑u = a) : a + ↑(-u) = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + ↑(-u) = 0)) (Eq.symm h)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑u + ↑(-u) = 0)) (add_units.add_neg u))) (Eq.refl 0))

@[simp] theorem mul_inv_cancel_left {α : Type u} [monoid α] (a : units α) (b : α) : ↑a * (↑(a⁻¹) * b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑a * (↑(a⁻¹) * b) = b)) (Eq.symm (mul_assoc (↑a) (↑(a⁻¹)) b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑a * ↑(a⁻¹) * b = b)) (mul_inv a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 * b = b)) (one_mul b))) (Eq.refl b)))

@[simp] theorem Mathlib.add_units.neg_add_cancel_left {α : Type u} [add_monoid α] (a : add_units α) (b : α) : ↑(-a) + (↑a + b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(-a) + (↑a + b) = b)) (Eq.symm (add_assoc (↑(-a)) (↑a) b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(-a) + ↑a + b = b)) (add_units.neg_add a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 + b = b)) (zero_add b))) (Eq.refl b)))

@[simp] theorem mul_inv_cancel_right {α : Type u} [monoid α] (a : α) (b : units α) : a * ↑b * ↑(b⁻¹) = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * ↑b * ↑(b⁻¹) = a)) (mul_assoc a ↑b ↑(b⁻¹))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (↑b * ↑(b⁻¹)) = a)) (mul_inv b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = a)) (mul_one a))) (Eq.refl a)))

@[simp] theorem Mathlib.add_units.neg_add_cancel_right {α : Type u} [add_monoid α] (a : α) (b : add_units α) : a + ↑(-b) + ↑b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + ↑(-b) + ↑b = a)) (add_assoc a ↑(-b) ↑b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + (↑(-b) + ↑b) = a)) (add_units.neg_add b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a + 0 = a)) (add_zero a))) (Eq.refl a)))

protected instance Mathlib.add_units.inhabited {α : Type u} [add_monoid α] : Inhabited (add_units α) :=
  { default := 0 }

protected instance comm_group {α : Type u_1} [comm_monoid α] : comm_group (units α) :=
  comm_group.mk group.mul sorry group.one sorry sorry group.inv group.div sorry sorry

protected instance Mathlib.add_units.has_repr {α : Type u} [add_monoid α] [has_repr α] : has_repr (add_units α) :=
  has_repr.mk (repr ∘ add_units.val)

@[simp] theorem Mathlib.add_units.add_right_inj {α : Type u} [add_monoid α] (a : add_units α) {b : α} {c : α} : ↑a + b = ↑a + c ↔ b = c := sorry

@[simp] theorem Mathlib.add_units.add_left_inj {α : Type u} [add_monoid α] (a : add_units α) {b : α} {c : α} : b + ↑a = c + ↑a ↔ b = c := sorry

theorem Mathlib.add_units.eq_add_neg_iff_add_eq {α : Type u} [add_monoid α] {c : add_units α} {a : α} {b : α} : a = b + ↑(-c) ↔ a + ↑c = b := sorry

theorem eq_inv_mul_iff_mul_eq {α : Type u} [monoid α] (b : units α) {a : α} {c : α} : a = ↑(b⁻¹) * c ↔ ↑b * a = c := sorry

theorem inv_mul_eq_iff_eq_mul {α : Type u} [monoid α] (a : units α) {b : α} {c : α} : ↑(a⁻¹) * b = c ↔ b = ↑a * c := sorry

theorem mul_inv_eq_iff_eq_mul {α : Type u} [monoid α] (b : units α) {a : α} {c : α} : a * ↑(b⁻¹) = c ↔ a = c * ↑b := sorry

theorem inv_eq_of_mul_eq_one {α : Type u} [monoid α] {u : units α} {a : α} (h : ↑u * a = 1) : ↑(u⁻¹) = a := sorry

theorem inv_unique {α : Type u} [monoid α] {u₁ : units α} {u₂ : units α} (h : ↑u₁ = ↑u₂) : ↑(u₁⁻¹) = ↑(u₂⁻¹) :=
  (fun (this : ↑u₁ * ↑(u₂⁻¹) = 1) => inv_eq_of_mul_eq_one this)
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑u₁ * ↑(u₂⁻¹) = 1)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑u₂ * ↑(u₂⁻¹) = 1)) (mul_inv u₂))) (Eq.refl 1)))

end units

/-- For `a, b` in a `comm_monoid` such that `a * b = 1`, makes a unit out of `a`. -/
def add_units.mk_of_add_eq_zero {α : Type u} [add_comm_monoid α] (a : α) (b : α) (hab : a + b = 0) : add_units α :=
  add_units.mk a b hab sorry

@[simp] theorem units.coe_mk_of_mul_eq_one {α : Type u} [comm_monoid α] {a : α} {b : α} (h : a * b = 1) : ↑(units.mk_of_mul_eq_one a b h) = a :=
  rfl

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

infixl:70 " /ₚ " => Mathlib.divp

@[simp] theorem divp_self {α : Type u} [monoid α] (u : units α) : ↑u /ₚ u = 1 :=
  units.mul_inv u

@[simp] theorem divp_one {α : Type u} [monoid α] (a : α) : a /ₚ 1 = a :=
  mul_one a

theorem divp_assoc {α : Type u} [monoid α] (a : α) (b : α) (u : units α) : a * b /ₚ u = a * (b /ₚ u) :=
  mul_assoc a b ↑(u⁻¹)

@[simp] theorem divp_inv {α : Type u} [monoid α] {a : α} (u : units α) : a /ₚ (u⁻¹) = a * ↑u :=
  rfl

@[simp] theorem divp_mul_cancel {α : Type u} [monoid α] (a : α) (u : units α) : a /ₚ u * ↑u = a :=
  Eq.trans (mul_assoc a ↑(u⁻¹) ↑u)
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (↑(u⁻¹) * ↑u) = a)) (units.inv_mul u)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = a)) (mul_one a))) (Eq.refl a)))

@[simp] theorem mul_divp_cancel {α : Type u} [monoid α] (a : α) (u : units α) : a * ↑u /ₚ u = a :=
  Eq.trans (mul_assoc a ↑u ↑(u⁻¹))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (↑u * ↑(u⁻¹)) = a)) (units.mul_inv u)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = a)) (mul_one a))) (Eq.refl a)))

@[simp] theorem divp_left_inj {α : Type u} [monoid α] (u : units α) {a : α} {b : α} : a /ₚ u = b /ₚ u ↔ a = b :=
  units.mul_left_inj (u⁻¹)

theorem divp_divp_eq_divp_mul {α : Type u} [monoid α] (x : α) (u₁ : units α) (u₂ : units α) : x /ₚ u₁ /ₚ u₂ = x /ₚ (u₂ * u₁) := sorry

theorem divp_eq_iff_mul_eq {α : Type u} [monoid α] {x : α} {u : units α} {y : α} : x /ₚ u = y ↔ y * ↑u = x :=
  iff.trans (iff.symm (units.mul_left_inj u))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x /ₚ u * ↑u = y * ↑u ↔ y * ↑u = x)) (divp_mul_cancel x u)))
      { mp := Eq.symm, mpr := Eq.symm })

theorem divp_eq_one_iff_eq {α : Type u} [monoid α] {a : α} {u : units α} : a /ₚ u = 1 ↔ a = ↑u :=
  iff.trans (iff.symm (units.mul_left_inj u))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a /ₚ u * ↑u = 1 * ↑u ↔ a = ↑u)) (divp_mul_cancel a u)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a = 1 * ↑u ↔ a = ↑u)) (one_mul ↑u))) (iff.refl (a = ↑u))))

@[simp] theorem one_divp {α : Type u} [monoid α] (u : units α) : 1 /ₚ u = ↑(u⁻¹) :=
  one_mul ↑(u⁻¹)

theorem divp_eq_divp_iff {α : Type u} [comm_monoid α] {x : α} {y : α} {ux : units α} {uy : units α} : x /ₚ ux = y /ₚ uy ↔ x * ↑uy = y * ↑ux := sorry

theorem divp_mul_divp {α : Type u} [comm_monoid α] (x : α) (y : α) (ux : units α) (uy : units α) : x /ₚ ux * (y /ₚ uy) = x * y /ₚ (ux * uy) := sorry

/-!
# `is_unit` predicate

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

-/

/-- An element `a : M` of a monoid is a unit if it has a two-sided inverse.
The actual definition says that `a` is equal to some `u : units M`, where
`units M` is a bundled version of `is_unit`. -/
def is_unit {M : Type u_1} [monoid M] (a : M) :=
  ∃ (u : units M), ↑u = a

theorem is_unit_of_subsingleton {M : Type u_1} [monoid M] [subsingleton M] (a : M) : is_unit a :=
  Exists.intro (units.mk a a (subsingleton.elim (a * a) 1) (subsingleton.elim (a * a) 1)) rfl

@[simp] theorem is_unit_unit {M : Type u_1} [monoid M] (u : units M) : is_unit ↑u :=
  Exists.intro u rfl

@[simp] theorem is_add_unit_zero {M : Type u_1} [add_monoid M] : is_add_unit 0 :=
  Exists.intro 0 rfl

theorem is_add_unit_of_add_eq_zero {M : Type u_1} [add_comm_monoid M] (a : M) (b : M) (h : a + b = 0) : is_add_unit a :=
  Exists.intro (add_units.mk_of_add_eq_zero a b h) rfl

theorem is_add_unit_iff_exists_neg {M : Type u_1} [add_comm_monoid M] {a : M} : is_add_unit a ↔ ∃ (b : M), a + b = 0 := sorry

theorem is_add_unit_iff_exists_neg' {M : Type u_1} [add_comm_monoid M] {a : M} : is_add_unit a ↔ ∃ (b : M), b + a = 0 := sorry

/-- Multiplication by a `u : units M` doesn't affect `is_unit`. -/
@[simp] theorem units.is_unit_mul_units {M : Type u_1} [monoid M] (a : M) (u : units M) : is_unit (a * ↑u) ↔ is_unit a := sorry

theorem is_unit.mul {M : Type u_1} [monoid M] {x : M} {y : M} : is_unit x → is_unit y → is_unit (x * y) := sorry

theorem is_add_unit_of_add_is_add_unit_left {M : Type u_1} [add_comm_monoid M] {x : M} {y : M} (hu : is_add_unit (x + y)) : is_add_unit x := sorry

theorem is_unit_of_mul_is_unit_right {M : Type u_1} [comm_monoid M] {x : M} {y : M} (hu : is_unit (x * y)) : is_unit y :=
  is_unit_of_mul_is_unit_left (eq.mpr (id (Eq._oldrec (Eq.refl (is_unit (y * x))) (mul_comm y x))) hu)

theorem is_unit.mul_right_inj {M : Type u_1} [monoid M] {a : M} {b : M} {c : M} (ha : is_unit a) : a * b = a * c ↔ b = c := sorry

theorem is_unit.mul_left_inj {M : Type u_1} [monoid M] {a : M} {b : M} {c : M} (ha : is_unit a) : b * a = c * a ↔ b = c := sorry

/-- The element of the group of units, corresponding to an element of a monoid which is a unit. -/
def is_unit.unit {M : Type u_1} [monoid M] {a : M} (h : is_unit a) : units M :=
  classical.some h

theorem is_unit.unit_spec {M : Type u_1} [monoid M] {a : M} (h : is_unit a) : ↑(is_unit.unit h) = a :=
  classical.some_spec h

/-- Constructs a `group` structure on a `monoid` consisting only of units. -/
def group_of_is_unit {M : Type u_1} [hM : monoid M] (h : ∀ (a : M), is_unit a) : group M :=
  group.mk monoid.mul monoid.mul_assoc monoid.one monoid.one_mul monoid.mul_one (fun (a : M) => ↑(is_unit.unit (h a)⁻¹))
    (div_inv_monoid.div._default monoid.mul monoid.mul_assoc monoid.one monoid.one_mul monoid.mul_one
      fun (a : M) => ↑(is_unit.unit (h a)⁻¹))
    sorry

/-- Constructs a `comm_group` structure on a `comm_monoid` consisting only of units. -/
def comm_group_of_is_unit {M : Type u_1} [hM : comm_monoid M] (h : ∀ (a : M), is_unit a) : comm_group M :=
  comm_group.mk comm_monoid.mul comm_monoid.mul_assoc comm_monoid.one comm_monoid.one_mul comm_monoid.mul_one
    (fun (a : M) => ↑(is_unit.unit (h a)⁻¹))
    (group.div._default comm_monoid.mul comm_monoid.mul_assoc comm_monoid.one comm_monoid.one_mul comm_monoid.mul_one
      fun (a : M) => ↑(is_unit.unit (h a)⁻¹))
    sorry comm_monoid.mul_comm