/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.CommRing.basic
import category_theory.limits.has_limits
import category_theory.limits.concrete_category

/-!
# The category of commutative rings has all colimits.

This file uses a "pre-automated" approach, just as for `Mon/colimits.lean`.
It is a very uniform approach, that conceivably could be synthesised directly
by a tactic that analyses the shape of `comm_ring` and `ring_hom`.
-/

universes u v

open category_theory
open category_theory.limits

-- [ROBOT VOICE]:
-- You should pretend for now that this file was automatically generated.
-- It follows the same template as colimits in Mon.
/-
`#print comm_ring` says:

structure comm_ring : Type u → Type u
fields:
comm_ring.zero : Π (α : Type u) [c : comm_ring α], α
comm_ring.one : Π (α : Type u) [c : comm_ring α], α
comm_ring.neg : Π {α : Type u} [c : comm_ring α], α → α
comm_ring.add : Π {α : Type u} [c : comm_ring α], α → α → α
comm_ring.mul : Π {α : Type u} [c : comm_ring α], α → α → α

comm_ring.zero_add : ∀ {α : Type u} [c : comm_ring α] (a : α), 0 + a = a
comm_ring.add_zero : ∀ {α : Type u} [c : comm_ring α] (a : α), a + 0 = a
comm_ring.one_mul : ∀ {α : Type u} [c : comm_ring α] (a : α), 1 * a = a
comm_ring.mul_one : ∀ {α : Type u} [c : comm_ring α] (a : α), a * 1 = a
comm_ring.add_left_neg : ∀ {α : Type u} [c : comm_ring α] (a : α), -a + a = 0
comm_ring.add_comm : ∀ {α : Type u} [c : comm_ring α] (a b : α), a + b = b + a
comm_ring.mul_comm : ∀ {α : Type u} [c : comm_ring α] (a b : α), a * b = b * a
comm_ring.add_assoc : ∀ {α : Type u} [c : comm_ring α] (a b c_1 : α), a + b + c_1 = a + (b + c_1)
comm_ring.mul_assoc : ∀ {α : Type u} [c : comm_ring α] (a b c_1 : α), a * b * c_1 = a * (b * c_1)
comm_ring.left_distrib : ∀ {α : Type u} [c : comm_ring α] (a b c_1 : α),
                                                            a * (b + c_1) = a * b + a * c_1
comm_ring.right_distrib : ∀ {α : Type u} [c : comm_ring α] (a b c_1 : α),
                                                            (a + b) * c_1 = a * c_1 + b * c_1
-/

namespace CommRing.colimits
/-!
We build the colimit of a diagram in `CommRing` by constructing the
free commutative ring on the disjoint union of all the commutative rings in the diagram,
then taking the quotient by the commutative ring laws within each commutative ring,
and the identifications given by the morphisms in the diagram.
-/

variables {J : Type v} [small_category J] (F : J ⥤ CommRing.{v})

/--
An inductive type representing all commutative ring expressions (without relations)
on a collection of types indexed by the objects of `J`.
-/
inductive prequotient
-- There's always `of`
| of : Π (j : J) (x : F.obj j), prequotient
-- Then one generator for each operation
| zero : prequotient
| one : prequotient
| neg : prequotient → prequotient
| add : prequotient → prequotient → prequotient
| mul : prequotient → prequotient → prequotient

instance : inhabited (prequotient F) := ⟨prequotient.zero⟩

open prequotient

/--
The relation on `prequotient` saying when two expressions are equal
because of the commutative ring laws, or
because one element is mapped to another by a morphism in the diagram.
-/
inductive relation : prequotient F → prequotient F → Prop
-- Make it an equivalence relation:
| refl : Π (x), relation x x
| symm : Π (x y) (h : relation x y), relation y x
| trans : Π (x y z) (h : relation x y) (k : relation y z), relation x z
-- There's always a `map` relation
| map : Π (j j' : J) (f : j ⟶ j') (x : F.obj j), relation (of j' (F.map f x)) (of j x)
-- Then one relation per operation, describing the interaction with `of`
| zero : Π (j), relation (of j 0) zero
| one : Π (j), relation (of j 1) one
| neg : Π (j) (x : F.obj j), relation (of j (-x)) (neg (of j x))
| add : Π (j) (x y : F.obj j), relation (of j (x + y)) (add (of j x) (of j y))
| mul : Π (j) (x y : F.obj j), relation (of j (x * y)) (mul (of j x) (of j y))
-- Then one relation per argument of each operation
| neg_1 : Π (x x') (r : relation x x'), relation (neg x) (neg x')
| add_1 : Π (x x' y) (r : relation x x'), relation (add x y) (add x' y)
| add_2 : Π (x y y') (r : relation y y'), relation (add x y) (add x y')
| mul_1 : Π (x x' y) (r : relation x x'), relation (mul x y) (mul x' y)
| mul_2 : Π (x y y') (r : relation y y'), relation (mul x y) (mul x y')
-- And one relation per axiom
| zero_add      : Π (x), relation (add zero x) x
| add_zero      : Π (x), relation (add x zero) x
| one_mul       : Π (x), relation (mul one x) x
| mul_one       : Π (x), relation (mul x one) x
| add_left_neg  : Π (x), relation (add (neg x) x) zero
| add_comm      : Π (x y), relation (add x y) (add y x)
| mul_comm      : Π (x y), relation (mul x y) (mul y x)
| add_assoc     : Π (x y z), relation (add (add x y) z) (add x (add y z))
| mul_assoc     : Π (x y z), relation (mul (mul x y) z) (mul x (mul y z))
| left_distrib  : Π (x y z), relation (mul x (add y z)) (add (mul x y) (mul x z))
| right_distrib : Π (x y z), relation (mul (add x y) z) (add (mul x z) (mul y z))

/--
The setoid corresponding to commutative expressions modulo monoid relations and identifications.
-/
def colimit_setoid : setoid (prequotient F) :=
{ r := relation F, iseqv := ⟨relation.refl, relation.symm, relation.trans⟩ }
attribute [instance] colimit_setoid

/--
The underlying type of the colimit of a diagram in `CommRing`.
-/
@[derive inhabited]
def colimit_type : Type v := quotient (colimit_setoid F)

instance : comm_ring (colimit_type F) :=
{ zero :=
  begin
    exact quot.mk _ zero
  end,
  one :=
  begin
    exact quot.mk _ one
  end,
  neg :=
  begin
    fapply @quot.lift,
    { intro x,
      exact quot.mk _ (neg x) },
    { intros x x' r,
      apply quot.sound,
      exact relation.neg_1 _ _ r },
  end,
  add :=
  begin
    fapply @quot.lift _ _ ((colimit_type F) → (colimit_type F)),
    { intro x,
      fapply @quot.lift,
      { intro y,
        exact quot.mk _ (add x y) },
      { intros y y' r,
        apply quot.sound,
        exact relation.add_2 _ _ _ r } },
    { intros x x' r,
      funext y,
      induction y,
      dsimp,
      apply quot.sound,
      { exact relation.add_1 _ _ _ r },
      { refl } },
  end,
  mul :=
  begin
    fapply @quot.lift _ _ ((colimit_type F) → (colimit_type F)),
    { intro x,
      fapply @quot.lift,
      { intro y,
        exact quot.mk _ (mul x y) },
      { intros y y' r,
        apply quot.sound,
        exact relation.mul_2 _ _ _ r } },
    { intros x x' r,
      funext y,
      induction y,
      dsimp,
      apply quot.sound,
      { exact relation.mul_1 _ _ _ r },
      { refl } },
  end,
  zero_add := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.zero_add,
    refl,
  end,
  add_zero := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.add_zero,
    refl,
  end,
  one_mul := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.one_mul,
    refl,
  end,
  mul_one := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.mul_one,
    refl,
  end,
  add_left_neg := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.add_left_neg,
    refl,
  end,
  add_comm := λ x y,
  begin
    induction x,
    induction y,
    dsimp,
    apply quot.sound,
    apply relation.add_comm,
    refl,
    refl,
  end,
  mul_comm := λ x y,
  begin
    induction x,
    induction y,
    dsimp,
    apply quot.sound,
    apply relation.mul_comm,
    refl,
    refl,
  end,
  add_assoc := λ x y z,
  begin
    induction x,
    induction y,
    induction z,
    dsimp,
    apply quot.sound,
    apply relation.add_assoc,
    refl,
    refl,
    refl,
  end,
  mul_assoc := λ x y z,
  begin
    induction x,
    induction y,
    induction z,
    dsimp,
    apply quot.sound,
    apply relation.mul_assoc,
    refl,
    refl,
    refl,
  end,
  left_distrib := λ x y z,
  begin
    induction x,
    induction y,
    induction z,
    dsimp,
    apply quot.sound,
    apply relation.left_distrib,
    refl,
    refl,
    refl,
  end,
  right_distrib := λ x y z,
  begin
    induction x,
    induction y,
    induction z,
    dsimp,
    apply quot.sound,
    apply relation.right_distrib,
    refl,
    refl,
    refl,
  end, }

@[simp] lemma quot_zero : quot.mk setoid.r zero = (0 : colimit_type F) := rfl
@[simp] lemma quot_one : quot.mk setoid.r one = (1 : colimit_type F) := rfl
@[simp] lemma quot_neg (x) :
  quot.mk setoid.r (neg x) = (-(quot.mk setoid.r x) : colimit_type F) := rfl
@[simp] lemma quot_add (x y) :
  quot.mk setoid.r (add x y) = ((quot.mk setoid.r x) + (quot.mk setoid.r y) : colimit_type F) := rfl
@[simp] lemma quot_mul (x y) :
  quot.mk setoid.r (mul x y) = ((quot.mk setoid.r x) * (quot.mk setoid.r y) : colimit_type F) := rfl

/-- The bundled commutative ring giving the colimit of a diagram. -/
def colimit : CommRing := CommRing.of (colimit_type F)

/-- The function from a given commutative ring in the diagram to the colimit commutative ring. -/
def cocone_fun (j : J) (x : F.obj j) : colimit_type F :=
quot.mk _ (of j x)

/-- The ring homomorphism from a given commutative ring in the diagram to the colimit commutative
ring. -/
def cocone_morphism (j : J) : F.obj j ⟶ colimit F :=
{ to_fun := cocone_fun F j,
  map_one' := by apply quot.sound; apply relation.one,
  map_mul' := by intros; apply quot.sound; apply relation.mul,
  map_zero' := by apply quot.sound; apply relation.zero,
  map_add' := by intros; apply quot.sound; apply relation.add }

@[simp] lemma cocone_naturality {j j' : J} (f : j ⟶ j') :
  F.map f ≫ (cocone_morphism F j') = cocone_morphism F j :=
begin
  ext,
  apply quot.sound,
  apply relation.map,
end

@[simp] lemma cocone_naturality_components (j j' : J) (f : j ⟶ j') (x : F.obj j):
  (cocone_morphism F j') (F.map f x) = (cocone_morphism F j) x :=
by { rw ←cocone_naturality F f, refl }

/-- The cocone over the proposed colimit commutative ring. -/
def colimit_cocone : cocone F :=
{ X := colimit F,
  ι :=
  { app := cocone_morphism F } }.

/-- The function from the free commutative ring on the diagram to the cone point of any other
cocone. -/
@[simp] def desc_fun_lift (s : cocone F) : prequotient F → s.X
| (of j x)  := (s.ι.app j) x
| zero      := 0
| one       := 1
| (neg x)   := -(desc_fun_lift x)
| (add x y) := desc_fun_lift x + desc_fun_lift y
| (mul x y) := desc_fun_lift x * desc_fun_lift y

/-- The function from the colimit commutative ring to the cone point of any other cocone. -/
def desc_fun (s : cocone F) : colimit_type F → s.X :=
begin
  fapply quot.lift,
  { exact desc_fun_lift F s },
  { intros x y r,
    induction r; try { dsimp },
    -- refl
    { refl },
    -- symm
    { exact r_ih.symm },
    -- trans
    { exact eq.trans r_ih_h r_ih_k },
    -- map
    { simp, },
    -- zero
    { simp, },
    -- one
    { simp, },
    -- neg
    { simp, },
    -- add
    { simp, },
    -- mul
    { simp, },
    -- neg_1
    { rw r_ih, },
    -- add_1
    { rw r_ih, },
    -- add_2
    { rw r_ih, },
    -- mul_1
    { rw r_ih, },
    -- mul_2
    { rw r_ih, },
    -- zero_add
    { rw zero_add, },
    -- add_zero
    { rw add_zero, },
    -- one_mul
    { rw one_mul, },
    -- mul_one
    { rw mul_one, },
    -- add_left_neg
    { rw add_left_neg, },
    -- add_comm
    { rw add_comm, },
    -- mul_comm
    { rw mul_comm, },
    -- add_assoc
    { rw add_assoc, },
    -- mul_assoc
    { rw mul_assoc, },
    -- left_distrib
    { rw left_distrib, },
    -- right_distrib
    { rw right_distrib, },
  }
end

/-- The ring homomorphism from the colimit commutative ring to the cone point of any other
cocone. -/
def desc_morphism (s : cocone F) : colimit F ⟶ s.X :=
{ to_fun := desc_fun F s,
  map_one' := rfl,
  map_zero' := rfl,
  map_add' := λ x y, by { induction x; induction y; refl },
  map_mul' := λ x y, by { induction x; induction y; refl }, }

/-- Evidence that the proposed colimit is the colimit. -/
def colimit_is_colimit : is_colimit (colimit_cocone F) :=
{ desc := λ s, desc_morphism F s,
  uniq' := λ s m w,
  begin
    ext,
    induction x,
    induction x,
    { have w' := congr_fun (congr_arg (λ f : F.obj x_j ⟶ s.X, (f : F.obj x_j → s.X)) (w x_j)) x_x,
      erw w',
      refl, },
    { simp, },
    { simp, },
    { simp *, },
    { simp *, },
    { simp *, },
    refl
  end }.

instance has_colimits_CommRing : has_colimits CommRing :=
{ has_colimits_of_shape := λ J 𝒥, by exactI
  { has_colimit := λ F, has_colimit.mk
    { cocone := colimit_cocone F,
      is_colimit := colimit_is_colimit F } } }

end CommRing.colimits


/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.ordered_ring
import Mathlib.data.int.basic
import Mathlib.tactic.norm_num
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Lemmas for `linarith`

This file contains auxiliary lemmas that `linarith` uses to construct proofs.
If you find yourself looking for a theorem here, you might be in the wrong place.
-/

namespace linarith

theorem int.coe_nat_bit0 (n : ℕ) : ↑(bit0 n) = bit0 ↑n := sorry

theorem int.coe_nat_bit1 (n : ℕ) : ↑(bit1 n) = bit1 ↑n := sorry

theorem int.coe_nat_bit0_mul (n : ℕ) (x : ℕ) : ↑(bit0 n * x) = ↑(bit0 n) * ↑x := sorry

theorem int.coe_nat_bit1_mul (n : ℕ) (x : ℕ) : ↑(bit1 n * x) = ↑(bit1 n) * ↑x := sorry

theorem int.coe_nat_one_mul (x : ℕ) : ↑(1 * x) = 1 * ↑x := sorry

theorem int.coe_nat_zero_mul (x : ℕ) : ↑(0 * x) = 0 * ↑x := sorry

theorem int.coe_nat_mul_bit0 (n : ℕ) (x : ℕ) : ↑(x * bit0 n) = ↑x * ↑(bit0 n) := sorry

theorem int.coe_nat_mul_bit1 (n : ℕ) (x : ℕ) : ↑(x * bit1 n) = ↑x * ↑(bit1 n) := sorry

theorem int.coe_nat_mul_one (x : ℕ) : ↑(x * 1) = ↑x * 1 := sorry

theorem int.coe_nat_mul_zero (x : ℕ) : ↑(x * 0) = ↑x * 0 := sorry

theorem nat_eq_subst {n1 : ℕ} {n2 : ℕ} {z1 : ℤ} {z2 : ℤ} (hn : n1 = n2) (h1 : ↑n1 = z1)
    (h2 : ↑n2 = z2) : z1 = z2 :=
  sorry

theorem nat_le_subst {n1 : ℕ} {n2 : ℕ} {z1 : ℤ} {z2 : ℤ} (hn : n1 ≤ n2) (h1 : ↑n1 = z1)
    (h2 : ↑n2 = z2) : z1 ≤ z2 :=
  sorry

theorem nat_lt_subst {n1 : ℕ} {n2 : ℕ} {z1 : ℤ} {z2 : ℤ} (hn : n1 < n2) (h1 : ↑n1 = z1)
    (h2 : ↑n2 = z2) : z1 < z2 :=
  sorry

theorem eq_of_eq_of_eq {α : Type u_1} [ordered_semiring α] {a : α} {b : α} (ha : a = 0)
    (hb : b = 0) : a + b = 0 :=
  sorry

theorem le_of_eq_of_le {α : Type u_1} [ordered_semiring α] {a : α} {b : α} (ha : a = 0)
    (hb : b ≤ 0) : a + b ≤ 0 :=
  sorry

theorem lt_of_eq_of_lt {α : Type u_1} [ordered_semiring α] {a : α} {b : α} (ha : a = 0)
    (hb : b < 0) : a + b < 0 :=
  sorry

theorem le_of_le_of_eq {α : Type u_1} [ordered_semiring α] {a : α} {b : α} (ha : a ≤ 0)
    (hb : b = 0) : a + b ≤ 0 :=
  sorry

theorem lt_of_lt_of_eq {α : Type u_1} [ordered_semiring α] {a : α} {b : α} (ha : a < 0)
    (hb : b = 0) : a + b < 0 :=
  sorry

theorem mul_neg {α : Type u_1} [ordered_ring α] {a : α} {b : α} (ha : a < 0) (hb : 0 < b) :
    b * a < 0 :=
  sorry

theorem mul_nonpos {α : Type u_1} [ordered_ring α] {a : α} {b : α} (ha : a ≤ 0) (hb : 0 < b) :
    b * a ≤ 0 :=
  sorry

-- used alongside `mul_neg` and `mul_nonpos`, so has the same argument pattern for uniformity

theorem mul_eq {α : Type u_1} [ordered_semiring α] {a : α} {b : α} (ha : a = 0) (hb : 0 < b) :
    b * a = 0 :=
  sorry

theorem eq_of_not_lt_of_not_gt {α : Type u_1} [linear_order α] (a : α) (b : α) (h1 : ¬a < b)
    (h2 : ¬b < a) : a = b :=
  le_antisymm (le_of_not_gt h2) (le_of_not_gt h1)

-- used in the `nlinarith` normalization steps. The `_` argument is for uniformity.

theorem mul_zero_eq {α : Type u_1} {R : α → α → Prop} [semiring α] {a : α} {b : α} (_x : R a 0)
    (h : b = 0) : a * b = 0 :=
  sorry

-- used in the `nlinarith` normalization steps. The `_` argument is for uniformity.

theorem zero_mul_eq {α : Type u_1} {R : α → α → Prop} [semiring α] {a : α} {b : α} (h : a = 0)
    (_x : R b 0) : a * b = 0 :=
  sorry

end Mathlib


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.CommRing.basic
import Mathlib.topology.category.Top.basic
import Mathlib.topology.algebra.ring
import Mathlib.PostPort

universes u l u_1 u_2

namespace Mathlib

/-- A bundled topological commutative ring. -/
structure TopCommRing where
  α : Type u
  is_comm_ring : comm_ring α
  is_topological_space : topological_space α
  is_topological_ring : topological_ring α

namespace TopCommRing

protected instance has_coe_to_sort : has_coe_to_sort TopCommRing := has_coe_to_sort.mk (Type u) α

protected instance category_theory.category : category_theory.category TopCommRing :=
  category_theory.category.mk

protected instance category_theory.concrete_category :
    category_theory.concrete_category TopCommRing :=
  category_theory.concrete_category.mk
    (category_theory.functor.mk (fun (R : TopCommRing) => ↥R)
      fun (R S : TopCommRing) (f : R ⟶ S) => ⇑(subtype.val f))

/-- Construct a bundled `TopCommRing` from the underlying type and the appropriate typeclasses. -/
def of (X : Type u) [comm_ring X] [topological_space X] [topological_ring X] : TopCommRing := mk X

@[simp] theorem coe_of (X : Type u) [comm_ring X] [topological_space X] [topological_ring X] :
    ↥(of X) = X :=
  rfl

protected instance forget_topological_space (R : TopCommRing) :
    topological_space (category_theory.functor.obj (category_theory.forget TopCommRing) R) :=
  is_topological_space R

protected instance forget_comm_ring (R : TopCommRing) :
    comm_ring (category_theory.functor.obj (category_theory.forget TopCommRing) R) :=
  is_comm_ring R

protected instance forget_topological_ring (R : TopCommRing) :
    topological_ring (category_theory.functor.obj (category_theory.forget TopCommRing) R) :=
  is_topological_ring R

protected instance has_forget_to_CommRing : category_theory.has_forget₂ TopCommRing CommRing :=
  category_theory.has_forget₂.mk' (fun (R : TopCommRing) => CommRing.of ↥R) sorry
    (fun (R S : TopCommRing) (f : R ⟶ S) => subtype.val f) sorry

protected instance forget_to_CommRing_topological_space (R : TopCommRing) :
    topological_space
        ↥(category_theory.functor.obj (category_theory.forget₂ TopCommRing CommRing) R) :=
  is_topological_space R

/-- The forgetful functor to Top. -/
protected instance has_forget_to_Top : category_theory.has_forget₂ TopCommRing Top :=
  category_theory.has_forget₂.mk' (fun (R : TopCommRing) => Top.of ↥R) sorry
    (fun (R S : TopCommRing) (f : R ⟶ S) => continuous_map.mk ⇑(subtype.val f)) sorry

protected instance forget_to_Top_comm_ring (R : TopCommRing) :
    comm_ring ↥(category_theory.functor.obj (category_theory.forget₂ TopCommRing Top) R) :=
  is_comm_ring R

protected instance forget_to_Top_topological_ring (R : TopCommRing) :
    topological_ring ↥(category_theory.functor.obj (category_theory.forget₂ TopCommRing Top) R) :=
  is_topological_ring R

/--
The forgetful functors to `Type` do not reflect isomorphisms,
but the forgetful functor from `TopCommRing` to `Top` does.
-/
protected instance category_theory.forget₂.category_theory.reflects_isomorphisms :
    category_theory.reflects_isomorphisms (category_theory.forget₂ TopCommRing Top) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : TopCommRing) (f : X ⟶ Y)
      (_x :
      category_theory.is_iso
        (category_theory.functor.map (category_theory.forget₂ TopCommRing Top) f)) =>
      let i_Top :
        category_theory.functor.obj (category_theory.forget₂ TopCommRing Top) X ≅
          category_theory.functor.obj (category_theory.forget₂ TopCommRing Top) Y :=
        category_theory.as_iso
          (category_theory.functor.map (category_theory.forget₂ TopCommRing Top) f);
      let e_Ring : ↥X ≃+* ↥Y :=
        ring_equiv.mk (ring_hom.to_fun (subtype.val f))
          (equiv.inv_fun
            (category_theory.iso.to_equiv
              (category_theory.functor.map_iso (category_theory.forget Top) i_Top)))
          sorry sorry sorry sorry;
      category_theory.is_iso.mk { val := ↑(ring_equiv.symm e_Ring), property := sorry }

end Mathlib


/-
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, Johan Commelin, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.variables
import Mathlib.PostPort

universes u u_1 v

namespace Mathlib

/-!
# Multivariate polynomials over a ring

Many results about polynomials hold when the coefficient ring is a commutative semiring.
Some stronger results can be derived when we assume this semiring is a ring.

This file does not define any new operations, but proves some of these stronger results.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type*` (indexing the variables)

+ `R : Type*` `[comm_ring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `a : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

-/

namespace mv_polynomial

protected instance comm_ring {R : Type u} {σ : Type u_1} [comm_ring R] : comm_ring (mv_polynomial σ R) :=
  add_monoid_algebra.comm_ring

protected instance C.is_ring_hom {R : Type u} {σ : Type u_1} [comm_ring R] : is_ring_hom ⇑C :=
  is_ring_hom.of_semiring ⇑C

@[simp] theorem C_sub {R : Type u} (σ : Type u_1) (a : R) (a' : R) [comm_ring R] : coe_fn C (a - a') = coe_fn C a - coe_fn C a' :=
  is_ring_hom.map_sub ⇑C

@[simp] theorem C_neg {R : Type u} (σ : Type u_1) (a : R) [comm_ring R] : coe_fn C (-a) = -coe_fn C a :=
  is_ring_hom.map_neg ⇑C

@[simp] theorem coeff_neg {R : Type u} (σ : Type u_1) [comm_ring R] (m : σ →₀ ℕ) (p : mv_polynomial σ R) : coeff m (-p) = -coeff m p :=
  finsupp.neg_apply

@[simp] theorem coeff_sub {R : Type u} (σ : Type u_1) [comm_ring R] (m : σ →₀ ℕ) (p : mv_polynomial σ R) (q : mv_polynomial σ R) : coeff m (p - q) = coeff m p - coeff m q :=
  finsupp.sub_apply

protected instance coeff.is_add_group_hom {R : Type u} (σ : Type u_1) [comm_ring R] (m : σ →₀ ℕ) : is_add_group_hom (coeff m) :=
  is_add_group_hom.mk

theorem degrees_neg {R : Type u} {σ : Type u_1} [comm_ring R] (p : mv_polynomial σ R) : degrees (-p) = degrees p := sorry

theorem degrees_sub {R : Type u} {σ : Type u_1} [comm_ring R] (p : mv_polynomial σ R) (q : mv_polynomial σ R) : degrees (p - q) ≤ degrees p ⊔ degrees q := sorry

@[simp] theorem vars_neg {R : Type u} {σ : Type u_1} [comm_ring R] (p : mv_polynomial σ R) : vars (-p) = vars p := sorry

theorem vars_sub_subset {R : Type u} {σ : Type u_1} [comm_ring R] (p : mv_polynomial σ R) (q : mv_polynomial σ R) : vars (p - q) ⊆ vars p ∪ vars q := sorry

@[simp] theorem vars_sub_of_disjoint {R : Type u} {σ : Type u_1} [comm_ring R] {p : mv_polynomial σ R} {q : mv_polynomial σ R} (hpq : disjoint (vars p) (vars q)) : vars (p - q) = vars p ∪ vars q := sorry

@[simp] theorem eval₂_sub {R : Type u} {S : Type v} {σ : Type u_1} [comm_ring R] (p : mv_polynomial σ R) {q : mv_polynomial σ R} [comm_ring S] (f : R →+* S) (g : σ → S) : eval₂ f g (p - q) = eval₂ f g p - eval₂ f g q :=
  ring_hom.map_sub (eval₂_hom f g) p q

@[simp] theorem eval₂_neg {R : Type u} {S : Type v} {σ : Type u_1} [comm_ring R] (p : mv_polynomial σ R) [comm_ring S] (f : R →+* S) (g : σ → S) : eval₂ f g (-p) = -eval₂ f g p :=
  ring_hom.map_neg (eval₂_hom f g) p

theorem hom_C {S : Type v} {σ : Type u_1} [comm_ring S] (f : mv_polynomial σ ℤ → S) [is_ring_hom f] (n : ℤ) : f (coe_fn C n) = ↑n :=
  ring_hom.eq_int_cast (ring_hom.comp (ring_hom.of f) (ring_hom.of ⇑C)) n

/-- A ring homomorphism f : Z[X_1, X_2, ...] → R
is determined by the evaluations f(X_1), f(X_2), ... -/
@[simp] theorem eval₂_hom_X {S : Type v} [comm_ring S] {R : Type u} (c : ℤ →+* S) (f : mv_polynomial R ℤ →+* S) (x : mv_polynomial R ℤ) : eval₂ c (⇑f ∘ X) x = coe_fn f x := sorry

/-- Ring homomorphisms out of integer polynomials on a type `σ` are the same as
functions out of the type `σ`, -/
def hom_equiv {S : Type v} {σ : Type u_1} [comm_ring S] : (mv_polynomial σ ℤ →+* S) ≃ (σ → S) :=
  equiv.mk (fun (f : mv_polynomial σ ℤ →+* S) => ⇑f ∘ X) (fun (f : σ → S) => eval₂_hom (int.cast_ring_hom S) f) sorry
    sorry

@[simp] theorem total_degree_neg {R : Type u} {σ : Type u_1} [comm_ring R] (a : mv_polynomial σ R) : total_degree (-a) = total_degree a := sorry

theorem total_degree_sub {R : Type u} {σ : Type u_1} [comm_ring R] (a : mv_polynomial σ R) (b : mv_polynomial σ R) : total_degree (a - b) ≤ max (total_degree a) (total_degree b) := sorry


example (P Q F : Type) : (P → Q) → ((Q → F) → (P → F)) :=
begin
intro f,
intro h,
intro p,
exact h(f(p)),
end


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton
-/
import tactic.tidy
import topology.continuous_function.basic
import topology.homeomorph
import topology.subset_properties

/-!
# The compact-open topology

In this file, we define the compact-open topology on the set of continuous maps between two
topological spaces.

## Main definitions

* `compact_open` is the compact-open topology on `C(α, β)`. It is declared as an instance.
* `ev` is the evaluation map `C(α, β) × α → β`. It is continuous as long as `α` is locally compact.
* `coev` is the coevaluation map `β → C(α, β × α)`. It is always continuous.
* `continuous_map.curry` is the currying map `C(α × β, γ) → C(α, C(β, γ))`. This map always exists
  and it is continuous as long as `α × β` is locally compact.
* `continuous_map.uncurry` is the uncurrying map `C(α, C(β, γ)) → C(α × β, γ)`. For this map to
  exist, we need `β` to be locally compact. If `α` is also locally compact, then this map is
  continuous.
* `homeomorph.curry` combines the currying and uncurrying operations into a homeomorphism
  `C(α × β, γ) ≃ₜ C(α, C(β, γ))`. This homeomorphism exists if `α` and `β` are locally compact.

## Tags

compact-open, curry, function space
-/

open set
open_locale topological_space

namespace continuous_map

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

/-- A generating set for the compact-open topology (when `s` is compact and `u` is open). -/
def compact_open.gen (s : set α) (u : set β) : set C(α,β) := {f | f '' s ⊆ u}

-- The compact-open topology on the space of continuous maps α → β.
instance compact_open : topological_space C(α, β) :=
topological_space.generate_from
  {m | ∃ (s : set α) (hs : is_compact s) (u : set β) (hu : is_open u), m = compact_open.gen s u}

private lemma is_open_gen {s : set α} (hs : is_compact s) {u : set β} (hu : is_open u) :
  is_open (compact_open.gen s u) :=
topological_space.generate_open.basic _ (by dsimp [mem_set_of_eq]; tauto)

section functorial

variables (g : C(β, γ))

private lemma preimage_gen {s : set α} (hs : is_compact s) {u : set γ} (hu : is_open u) :
  continuous_map.comp g ⁻¹' (compact_open.gen s u) = compact_open.gen s (g ⁻¹' u) :=
begin
  ext ⟨f, _⟩,
  change g ∘ f '' s ⊆ u ↔ f '' s ⊆ g ⁻¹' u,
  rw [image_comp, image_subset_iff]
end

/-- C(α, -) is a functor. -/
lemma continuous_comp : continuous (continuous_map.comp g : C(α, β) → C(α, γ)) :=
continuous_generated_from $ assume m ⟨s, hs, u, hu, hm⟩,
  by rw [hm, preimage_gen g hs hu]; exact is_open_gen hs (hu.preimage g.2)

end functorial

section ev

variables (α β)

/-- The evaluation map `map C(α, β) × α → β` -/
def ev (p : C(α, β) × α) : β := p.1 p.2

variables {α β}

/-- The evaluation map `C(α, β) × α → β` is continuous if `α` is locally compact. -/
lemma continuous_ev [locally_compact_space α] : continuous (ev α β) :=
continuous_iff_continuous_at.mpr $ assume ⟨f, x⟩ n hn,
  let ⟨v, vn, vo, fxv⟩ := mem_nhds_iff.mp hn in
  have v ∈ 𝓝 (f x), from is_open.mem_nhds vo fxv,
  let ⟨s, hs, sv, sc⟩ :=
    locally_compact_space.local_compact_nhds x (f ⁻¹' v)
      (f.continuous.tendsto x this) in
  let ⟨u, us, uo, xu⟩ := mem_nhds_iff.mp hs in
  show (ev α β) ⁻¹' n ∈ 𝓝 (f, x), from
  let w := set.prod (compact_open.gen s v) u in
  have w ⊆ ev α β ⁻¹' n, from assume ⟨f', x'⟩ ⟨hf', hx'⟩, calc
    f' x' ∈ f' '' s  : mem_image_of_mem f' (us hx')
    ...       ⊆ v            : hf'
    ...       ⊆ n            : vn,
  have is_open w, from (is_open_gen sc vo).prod uo,
  have (f, x) ∈ w, from ⟨image_subset_iff.mpr sv, xu⟩,
  mem_nhds_iff.mpr ⟨w, by assumption, by assumption, by assumption⟩

lemma continuous_ev₁ [locally_compact_space α] (a : α) : continuous (λ f : C(α, β), f a) :=
continuous_ev.comp (continuous_id.prod_mk continuous_const)

instance [t2_space β] [locally_compact_space α] : t2_space C(α, β) :=
⟨ begin
    intros f₁ f₂ h,
    obtain ⟨p, hp⟩ := not_forall.mp (mt continuous_map.ext h),
    exact separated_by_continuous (continuous_ev₁ p) hp,
  end ⟩

end ev

section Inf_induced

lemma compact_open_le_induced (s : set α) :
  (continuous_map.compact_open : topological_space C(α, β))
  ≤ topological_space.induced (continuous_map.restrict s) continuous_map.compact_open :=
begin
  simp only [induced_generate_from_eq, continuous_map.compact_open],
  apply generate_from_mono,
  rintros b ⟨a, ⟨c, hc, u, hu, rfl⟩, rfl⟩,
  refine ⟨coe '' c, hc.image continuous_subtype_coe, u, hu, _⟩,
  ext f,
  simp only [compact_open.gen, mem_set_of_eq, mem_preimage, continuous_map.coe_restrict],
  rw image_comp f (coe : s → α),
end

/-- The compact-open topology on `C(α, β)` is equal to the infimum of the compact-open topologies
on `C(s, β)` for `s` a compact subset of `α`.  The key point of the proof is that the union of the
compact subsets of `α` is equal to the union of compact subsets of the compact subsets of `α`. -/
lemma compact_open_eq_Inf_induced :
  (continuous_map.compact_open : topological_space C(α, β))
  = ⨅ (s : set α) (hs : is_compact s),
    topological_space.induced (continuous_map.restrict s) continuous_map.compact_open :=
begin
  refine le_antisymm _ _,
  { refine le_binfi _,
    exact λ s hs, compact_open_le_induced s },
  simp only [← generate_from_Union, induced_generate_from_eq, continuous_map.compact_open],
  apply generate_from_mono,
  rintros _ ⟨s, hs, u, hu, rfl⟩,
  rw mem_bUnion_iff',
  refine ⟨s, hs, _, ⟨univ, is_compact_iff_is_compact_univ.mp hs, u, hu, rfl⟩, _⟩,
  ext f,
  simp only [compact_open.gen, mem_set_of_eq, mem_preimage, continuous_map.coe_restrict],
  rw image_comp f (coe : s → α),
  simp
end

/-- For any subset `s` of `α`, the restriction of continuous functions to `s` is continuous as a
function from `C(α, β)` to `C(s, β)` with their respective compact-open topologies. -/
lemma continuous_restrict (s : set α) : continuous (λ F : C(α, β), F.restrict s) :=
by { rw continuous_iff_le_induced, exact compact_open_le_induced s }

lemma nhds_compact_open_eq_Inf_nhds_induced (f : C(α, β)) :
  𝓝 f = ⨅ s (hs : is_compact s), (𝓝 (f.restrict s)).comap (continuous_map.restrict s) :=
by { rw [compact_open_eq_Inf_induced], simp [nhds_infi, nhds_induced] }

lemma tendsto_compact_open_restrict {ι : Type*} {l : filter ι} {F : ι → C(α, β)} {f : C(α, β)}
  (hFf : filter.tendsto F l (𝓝 f)) (s : set α) :
  filter.tendsto (λ i, (F i).restrict s) l (𝓝 (f.restrict s)) :=
(continuous_restrict s).continuous_at.tendsto.comp hFf

lemma tendsto_compact_open_iff_forall {ι : Type*} {l : filter ι} (F : ι → C(α, β)) (f : C(α, β)) :
  filter.tendsto F l (𝓝 f)
  ↔ ∀ s (hs : is_compact s), filter.tendsto (λ i, (F i).restrict s) l (𝓝 (f.restrict s)) :=
by { rw [compact_open_eq_Inf_induced], simp [nhds_infi, nhds_induced, filter.tendsto_comap_iff] }

/-- A family `F` of functions in `C(α, β)` converges in the compact-open topology, if and only if
it converges in the compact-open topology on each compact subset of `α`. -/
lemma exists_tendsto_compact_open_iff_forall [locally_compact_space α] [t2_space α] [t2_space β]
  {ι : Type*} {l : filter ι} [filter.ne_bot l] (F : ι → C(α, β)) :
  (∃ f, filter.tendsto F l (𝓝 f))
  ↔ ∀ (s : set α) (hs : is_compact s), ∃ f, filter.tendsto (λ i, (F i).restrict s) l (𝓝 f) :=
begin
  split,
  { rintros ⟨f, hf⟩ s hs,
    exact ⟨f.restrict s, tendsto_compact_open_restrict hf s⟩ },
  { intros h,
    choose f hf using h,
    -- By uniqueness of limits in a `t2_space`, since `λ i, F i x` tends to both `f s₁ hs₁ x` and
    -- `f s₂ hs₂ x`, we have `f s₁ hs₁ x = f s₂ hs₂ x`
    have h : ∀ s₁ (hs₁ : is_compact s₁) s₂ (hs₂ : is_compact s₂) (x : α) (hxs₁ : x ∈ s₁)
      (hxs₂ : x ∈ s₂), f s₁ hs₁ ⟨x, hxs₁⟩ = f s₂ hs₂ ⟨x, hxs₂⟩,
    { rintros s₁ hs₁ s₂ hs₂ x hxs₁ hxs₂,
      haveI := is_compact_iff_compact_space.mp hs₁,
      haveI := is_compact_iff_compact_space.mp hs₂,
      have h₁ := (continuous_ev₁ (⟨x, hxs₁⟩ : s₁)).continuous_at.tendsto.comp (hf s₁ hs₁),
      have h₂ := (continuous_ev₁ (⟨x, hxs₂⟩ : s₂)).continuous_at.tendsto.comp (hf s₂ hs₂),
      exact tendsto_nhds_unique h₁ h₂ },
    -- So glue the `f s hs` together and prove that this glued function `f₀` is a limit on each
    -- compact set `s`
    have hs : ∀ x : α, ∃ s (hs : is_compact s), s ∈ 𝓝 x,
    { intros x,
      obtain ⟨s, hs, hs'⟩ := exists_compact_mem_nhds x,
      exact ⟨s, hs, hs'⟩ },
    refine ⟨lift_cover' _ _ h hs, _⟩,
    rw tendsto_compact_open_iff_forall,
    intros s hs,
    rw lift_cover_restrict',
    exact hf s hs }
end

end Inf_induced

section coev

variables (α β)

/-- The coevaluation map `β → C(α, β × α)` sending a point `x : β` to the continuous function
on `α` sending `y` to `(x, y)`. -/
def coev (b : β) : C(α, β × α) := ⟨λ a, (b, a), continuous.prod_mk continuous_const continuous_id⟩

variables {α β}
lemma image_coev {y : β} (s : set α) : (coev α β y) '' s = set.prod {y} s := by tidy

-- The coevaluation map β → C(α, β × α) is continuous (always).
lemma continuous_coev : continuous (coev α β) :=
continuous_generated_from $ begin
  rintros _ ⟨s, sc, u, uo, rfl⟩,
  rw is_open_iff_forall_mem_open,
  intros y hy,
  change (coev α β y) '' s ⊆ u at hy,
  rw image_coev s at hy,
  rcases generalized_tube_lemma is_compact_singleton sc uo hy
    with ⟨v, w, vo, wo, yv, sw, vwu⟩,
  refine ⟨v, _, vo, singleton_subset_iff.mp yv⟩,
  intros y' hy',
  change (coev α β y') '' s ⊆ u,
  rw image_coev s,
  exact subset.trans (prod_mono (singleton_subset_iff.mpr hy') sw) vwu
end

end coev

section curry

/-- Auxiliary definition, see `continuous_map.curry` and `homeomorph.curry`. -/
def curry' (f : C(α × β, γ)) (a : α) : C(β, γ) := ⟨function.curry f a⟩

/-- If a map `α × β → γ` is continuous, then its curried form `α → C(β, γ)` is continuous. -/
lemma continuous_curry' (f : C(α × β, γ)) : continuous (curry' f) :=
have hf : curry' f = continuous_map.comp f ∘ coev _ _, by { ext, refl },
hf ▸ continuous.comp (continuous_comp f) continuous_coev

/-- To show continuity of a map `α → C(β, γ)`, it suffices to show that its uncurried form
    `α × β → γ` is continuous. -/
lemma continuous_of_continuous_uncurry (f : α → C(β, γ))
  (h : continuous (function.uncurry (λ x y, f x y))) : continuous f :=
by { convert continuous_curry' ⟨_, h⟩, ext, refl }

/-- The curried form of a continuous map `α × β → γ` as a continuous map `α → C(β, γ)`.
    If `a × β` is locally compact, this is continuous. If `α` and `β` are both locally
    compact, then this is a homeomorphism, see `homeomorph.curry`. -/
def curry (f : C(α × β, γ)) : C(α, C(β, γ)) :=
⟨_, continuous_curry' f⟩

/-- The currying process is a continuous map between function spaces. -/
lemma continuous_curry [locally_compact_space (α × β)] :
  continuous (curry : C(α × β, γ) → C(α, C(β, γ))) :=
begin
  apply continuous_of_continuous_uncurry,
  apply continuous_of_continuous_uncurry,
  rw ←homeomorph.comp_continuous_iff' (homeomorph.prod_assoc _ _ _).symm,
  convert continuous_ev;
  tidy
end

@[simp]
lemma curry_apply (f : C(α × β, γ)) (a : α) (b : β) : f.curry a b = f (a, b) := rfl

/-- The uncurried form of a continuous map `α → C(β, γ)` is a continuous map `α × β → γ`. -/
lemma continuous_uncurry_of_continuous [locally_compact_space β] (f : C(α, C(β, γ))) :
  continuous (function.uncurry (λ x y, f x y)) :=
have hf : function.uncurry (λ x y, f x y) = ev β γ ∘ prod.map f id, by { ext, refl },
hf ▸ continuous.comp continuous_ev $ continuous.prod_map f.2 id.2

/-- The uncurried form of a continuous map `α → C(β, γ)` as a continuous map `α × β → γ` (if `β` is
    locally compact). If `α` is also locally compact, then this is a homeomorphism between the two
    function spaces, see `homeomorph.curry`. -/
def uncurry [locally_compact_space β] (f : C(α, C(β, γ))) : C(α × β, γ) :=
⟨_, continuous_uncurry_of_continuous f⟩

/-- The uncurrying process is a continuous map between function spaces. -/
lemma continuous_uncurry [locally_compact_space α] [locally_compact_space β] :
  continuous (uncurry : C(α, C(β, γ)) → C(α × β, γ)) :=
begin
  apply continuous_of_continuous_uncurry,
  rw ←homeomorph.comp_continuous_iff' (homeomorph.prod_assoc _ _ _),
  apply continuous.comp continuous_ev (continuous.prod_map continuous_ev id.2);
  apply_instance
end

/-- The family of constant maps: `β → C(α, β)` as a continuous map. -/
def const' : C(β, C(α, β)) := curry ⟨prod.fst, continuous_fst⟩

@[simp] lemma coe_const' : (const' : β → C(α, β)) = const := rfl

lemma continuous_const' : continuous (const : β → C(α, β)) := const'.continuous

end curry

end compact_open

end continuous_map

open continuous_map

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

/-- Currying as a homeomorphism between the function spaces `C(α × β, γ)` and `C(α, C(β, γ))`. -/
def curry [locally_compact_space α] [locally_compact_space β] : C(α × β, γ) ≃ₜ C(α, C(β, γ)) :=
⟨⟨curry, uncurry, by tidy, by tidy⟩, continuous_curry, continuous_uncurry⟩

/-- If `α` has a single element, then `β` is homeomorphic to `C(α, β)`. -/
def continuous_map_of_unique [unique α] : β ≃ₜ C(α, β) :=
{ to_fun := continuous_map.comp ⟨_, continuous_fst⟩ ∘ coev α β,
  inv_fun := ev α β ∘ (λ f, (f, default α)),
  left_inv := λ a, rfl,
  right_inv := λ f, by { ext, rw unique.eq_default x, refl },
  continuous_to_fun := continuous.comp (continuous_comp _) continuous_coev,
  continuous_inv_fun :=
    continuous.comp continuous_ev (continuous.prod_mk continuous_id continuous_const) }

@[simp]

@[simp] lemma continuous_map_of_unique_symm_apply [unique α] (f : C(α, β)) :
  continuous_map_of_unique.symm f = f (default α) :=
rfl

end homeomorph