import analysis.complex.basic
import analysis.calculus.deriv
import tactic.pi_instances
import ring_theory.subring.basic
import analysis.normed_space.basic
import analysis.calculus.deriv
import analysis.analytic.basic

local attribute [instance] classical.prop_decidable
noncomputable theory

universes u v
open_locale classical  big_operators filter
open filter complex asymptotics

section
variables {α : Type*} {β : Type*} {s : set α}

def extend_by_zero [has_zero β] (f : s → β) : α → β :=
λ z, if h : z ∈ s then f ⟨z, h⟩ else 0

lemma extend_by_zero_eq_of_mem [has_zero β] (f : s → β) (x : α) (hx : x ∈ s):
  (extend_by_zero f) x = f ⟨ x, hx ⟩ :=
begin
  rw extend_by_zero, dsimp, split_ifs, tauto,
end

lemma extend_by_zero_zero [has_zero β] :
extend_by_zero (λ s, 0 : s → β) = (λ h, 0) :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_zero' [has_zero β] :
extend_by_zero (0 : s → β) = 0 :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_add [add_group β] (f g : s → β) :
extend_by_zero (f + g) = extend_by_zero f + extend_by_zero g :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_sum [add_comm_monoid β] (ι  : finset α) (F : ι →  s → β) :
extend_by_zero (λ (x : s), ∑ (i : ι ), F i x) = ∑ (i : ι), extend_by_zero (F i) :=
begin
ext z,
by_cases h : z ∈ s,
simp only [extend_by_zero, h, finset.sum_apply, dif_pos],
simp only [extend_by_zero, h, finset.sum_apply, dif_neg, not_false_iff, finset.sum_const_zero],
end

lemma extend_by_zero_mul [semiring β] (f g : s → β) :
extend_by_zero (f * g) = extend_by_zero f * extend_by_zero g :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_neg [add_group β] (f : s → β) :
extend_by_zero (-f) = -extend_by_zero f :=
by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

lemma extend_by_zero_smul [ring β] (c : β) (f : s → β) :
  extend_by_zero (c • f) = c • extend_by_zero f :=
  by ext z; by_cases h : z ∈ s; simp [extend_by_zero, h]

end

def open_subs:=topological_space.opens ℂ

/--A function is Holomorphic on an open subset of the complex numbers, if for every point in the domain
there is a neibourhood around the point containing the derivative of the function. In order to make it work
with has_deriv_within_at, we first extend the function by zero to the entire complex plane. -/

def is_holomorphic_on {D : open_subs} (f : D.1 → ℂ) : Prop :=
  ∀ z : D.1, ∃ f', has_deriv_within_at (extend_by_zero f) (f') D.1 z

lemma is_holomorphic_on_iff_differentiable_on  (D : open_subs) (f : D.1 → ℂ):
  differentiable_on ℂ  (extend_by_zero f) D.1 ↔ is_holomorphic_on f:=
begin
  rw is_holomorphic_on,
  split,
  rw differentiable_on,
  intros hd z,
  have h1:= hd z.1 z.2,
  have h2:=  differentiable_within_at.has_fderiv_within_at h1,
  simp_rw has_deriv_within_at,
  simp_rw has_deriv_at_filter,
  simp_rw has_fderiv_within_at at h2,
  simp at *,
  dunfold fderiv_within at h2,
  dunfold differentiable_within_at at h1,
  rw dif_pos h1 at h2,
  use classical.some h1 1,
  simp,
  exact h2,
  intro hz,
  rw differentiable_on,
  intros x hx,
  have h1:= hz ⟨x, hx⟩,
  have h2:= classical.some_spec h1,
  apply has_deriv_within_at.differentiable_within_at  h2,
end

variable {D : open_subs}

lemma ext_by_zero_eq (D: open_subs) (c : ℂ):
∀ (y : ℂ), (y ∈ (D.1 : set ℂ)) → extend_by_zero (λ z : D.1, (c : ℂ)) y = c :=
begin
  intros y hy,
  rw extend_by_zero,
  simp only [dite_eq_ite],
  cases D,
  dsimp at *,
  simp only [ite_eq_left_iff] at *,
  intros A,
  solve_by_elim,
end

lemma ext_by_zero_eq' (D: open_subs) (f : D.1 → ℂ) (y : ℂ) (h: y ∈ (D.1 : set ℂ)):
  extend_by_zero (f ) y = (f ⟨ y, h⟩) :=
begin
 rw extend_by_zero,
 simp,
 cases D,
 dsimp at *,
 exact dif_pos h,
end

lemma ext_by_zero_apply (D: open_subs) (f : D.1 → ℂ) (y : D.1) :
  extend_by_zero (f ) y = (f y) :=
begin
  have:= ext_by_zero_eq' D f y y.2,
  rw this,
  simp,
end

lemma const_hol  (c : ℂ) : is_holomorphic_on (λ z : D.1, (c : ℂ)) :=
begin
  rw is_holomorphic_on,
  intro z,
  use (0: ℂ),
  have h1:=has_deriv_within_at_const  z.1 D.1 c,
  have H:= has_deriv_within_at.congr_of_eventually_eq_of_mem h1 _ z.property ,
  convert H,
  rw  eventually_eq,
  rw eventually_iff_exists_mem,
  use D.1,
  have H2:= ext_by_zero_eq D c,
  split,
  have h3:= D.2,
  simp at h3,
  have h4:=is_open.mem_nhds h3 z.2,
  simp only [subtype.val_eq_coe],
  convert h4,
  simp,
  rw nhds_within,
  simp only [inf_eq_left, le_principal_iff],
  exact h4,
  exact H2,
end

lemma zero_hol (D: open_subs) : is_holomorphic_on (λ z : D.1, (0 : ℂ)) :=
begin
  apply const_hol (0:ℂ ),
end

lemma one_hol (D: open_subs) : is_holomorphic_on (λ z : D.1, (1 : ℂ)) :=
begin
apply const_hol (1: ℂ),

end
lemma add_hol (f g : D.1 → ℂ) (f_hol : is_holomorphic_on f) (g_hol : is_holomorphic_on g) :
  is_holomorphic_on (f + g) :=
begin
  intro z₀,
  cases f_hol z₀ with f'z₀ Hf,
  cases g_hol z₀ with g'z₀ Hg,
  existsi (f'z₀ + g'z₀),
  rw extend_by_zero_add,
  have:=has_deriv_within_at.add Hf Hg,
  exact this,
end

lemma mul_hol (f g : D.1 → ℂ) (f_hol : is_holomorphic_on f) (g_hol : is_holomorphic_on g) :
  is_holomorphic_on (f * g) :=
begin
  intro z₀,
  cases f_hol z₀ with f'z₀ Hf,
  cases g_hol z₀ with g'z₀ Hg,
  existsi f'z₀*(extend_by_zero g z₀) + (extend_by_zero f z₀)*g'z₀,
  rw extend_by_zero_mul,
 have:=has_deriv_within_at.mul Hf Hg,
 exact this,
end

lemma neg_hol (f : D.1 → ℂ) (f_hol : is_holomorphic_on f) : is_holomorphic_on (-f) :=
begin
  intro z₀,
  cases f_hol z₀ with f'z₀ H,
  existsi -f'z₀,
  rw extend_by_zero_neg,
  have h3:=has_deriv_within_at.neg H,
  exact h3,
end

/--The ring of holomorphic functions-/
def hol_ring (D: open_subs) : subring (D.1 → ℂ) :=
{ carrier := {f : D.1 → ℂ | is_holomorphic_on f},
  zero_mem' := zero_hol D,
 add_mem'  := add_hol,
 neg_mem'  := neg_hol,
 mul_mem'  := mul_hol,
 one_mem'  := one_hol D
}

lemma smul_hol (c : ℂ) (f : D.1 → ℂ) (f_hol : is_holomorphic_on f) : is_holomorphic_on (c • f) :=
begin
  intro z₀,
  cases f_hol z₀ with f'z₀ Hf,
  existsi c * f'z₀,
  rw extend_by_zero_smul,
  have h2:= has_deriv_within_at.const_smul c Hf,
  exact h2,

end

def hol_submodule (D: open_subs) : submodule (ℂ)  (D.1 → ℂ) :=
{ carrier := {f : D.1 → ℂ | is_holomorphic_on f},
  zero_mem' := zero_hol D,
  add_mem' := add_hol,
  smul_mem' := smul_hol}

lemma aux (s t d : set ℂ) (h :  s ⊆ t) : s ∩ d ⊆ t :=
begin
  intros x hx,
  apply h,
  simp at *,
  apply hx.1,
end

lemma aux2 (x : ℂ) (a b : ℝ) : metric.ball x a ∩ metric.ball x b = metric.ball x (min a b) :=
begin
  ext,
  split,
  simp  [and_imp, metric.mem_ball, lt_min_iff],
  intros ha hb,
  simp only [ha, hb, and_self],
  simp [and_imp, metric.mem_ball,  lt_min_iff],
  intros ha hb,
  simp only [ha, hb, and_self],
end

lemma diff_on_diff (f : D.1 → ℂ) (h : ∀ x : D.1, ∃ (ε: ℝ), 0 < ε ∧ (metric.ball x.1 ε ⊆ D.val ) ∧
  differentiable_on ℂ (extend_by_zero f) (metric.ball x ε)) :
  differentiable_on ℂ (extend_by_zero f) D.1 :=
begin
  simp_rw differentiable_on at *,
  simp_rw differentiable_within_at at *,
  intros x hx,
  have hh := h ⟨x, hx⟩,
  obtain ⟨ε, hε, hb, H⟩:= hh,
  have HH:= H x,
  simp only [metric.mem_ball, subtype.coe_mk, dist_self] at HH,
  have HHH:= HH hε,
  obtain ⟨f', hf'⟩:= HHH,
  use f',
  simp_rw has_fderiv_within_at_iff_tendsto at *,
  rw metric.tendsto_nhds at *,
  intros δ hδ,
  have hf2 := hf'  δ hδ,
  rw filter.eventually_iff_exists_mem at *,
  simp only [exists_prop, metric.mem_ball, gt_iff_lt, topological_space.opens.mem_coe,
    dist_zero_right, continuous_linear_map.map_sub, set_coe.forall, subtype.coe_mk,
    subtype.val_eq_coe,norm_eq_abs, norm_mul, norm_inv] at *,
  obtain ⟨S, hS, HD⟩ := hf2,
  simp_rw metric.mem_nhds_within_iff at *,
  obtain ⟨e, he, HE⟩:= hS,
  use S,
  split,
  use min e ε,
  simp only [gt_iff_lt, topological_space.opens.mem_coe, lt_min_iff, subtype.val_eq_coe] at *,
  simp only [he, hε, and_self],
  simp only [true_and],
  have : metric.ball x e ∩ metric.ball x ε = metric.ball x (min e ε), by {apply aux2,},
  rw this at HE,
  apply aux _ _ _ HE,
  apply HD,
end

lemma tendsto_unif_extend_by_zero (F : ℕ → D.1 → ℂ) (f : D.1 → ℂ)
(h: tendsto_uniformly F f filter.at_top ) :
  tendsto_uniformly_on (λ (n : ℕ), extend_by_zero (F n)) (extend_by_zero f) filter.at_top D.1 :=
begin
  simp_rw metric.tendsto_uniformly_on_iff,
  rw metric.tendsto_uniformly_iff at h,
  intros ε hε,
  have h2:= h ε hε,
  simp only [gt_iff_lt, topological_space.opens.mem_coe, ge_iff_le, nonempty_of_inhabited,
  set_coe.forall, eventually_at_top, subtype.val_eq_coe] at *,
  obtain ⟨a, ha⟩:= h2,
  use a,
  intros b hb x hx,
  have hf:= ext_by_zero_apply D f ⟨x, hx⟩,
  have hFb:= ext_by_zero_apply D (F b) ⟨x, hx⟩,
  simp only [topological_space.opens.mem_coe, subtype.coe_mk, subtype.val_eq_coe] at *,
  rw hf,
  rw hFb,
  apply ha b hb x hx,
end


-- Lean can do single line comments

/-
It also has multi-line comments
# Comments

## can

* **have**
* `Markdown`
* _Formatting_
* [A good guide for MD syntax](https://www.markdownguide.org/basic-syntax/).
-/

/-
Remember the import statements, in this case it imports the file in some directory
`something_in_leans_path/data/nat/basic.lean`. They have to be at the top of the file.
-/
import data.nat.basic
import algebra.group.basic

/-
Opens a namespace. Now everything in this portion of code will be accessible
as `random_examples.thing`
-/
namespace random_examples

-- `end random_examples` is a few lines down

/-
Makes everything in a namespace accessible. Note, this is slightly different from namespace/end.
Nothing in this file will enter the nat namespace for example.
-/
open nat

/-
A quick one-line format for defining things (being purposefully vague with the word things).
Subscripts can be typed using \1 \2 \3, ..., \9, \0
-/
def definition_name (input₁ : Sort) (input₂ : Type) : Type 0 := sorry

-- You'll see a lot of lemmas.
lemma lemma_name {implicit assumption : Prop}
    : ℕ :=
-- Here we begin the tactics block, where all our proofs.
begin
  sorry
end

/-
If something is important enough it deserves to be called a theorem!
Notice you can get pretty wild with the whitespace.
-/
theorem theorem_name (
  same : Type
  )
  :
  ℕ = list ℕ
  :=
  by sorry

end random_examples

/-
Opening a section is a good way of portioning out your code off by common assumptions.
You can name sections which can help Lean know which section to close when you say `end`.
-/
section

-- There's an `end` a few lines down which ends the current section.

-- Sometimes it might be annoying to have to write out the same assumptions over multiple lemmas.
lemma lemma₁ (assumption₁ : Type) (assumption₂ : Type): Prop := sorry
lemma lemma₂ (assumption₁ : Type) (assumption₂ : Type): Prop := sorry

/-
Instead we can define variables that will persist until the end of the section and become
available in each assumption. They can be implicit or explicit.
-/
-- variables (a : ℕ) (b : ℕ)
variables (a b : ℕ)
/-
Notice we didn't include `a` and `b` as variables in this lemma, but it knows they exist because
of the variables above.
-/
lemma random_lemma (h : a = b) : a = a :=
begin
  refl
end

/-
Lean is also smart and only includes variables in the assumptions that are actually referenced.
Check out the context by putting your cusor after `by` but before the actual proof.
-/
lemma other_random_lemma : a < a + 1 := by exact lt_add_one a

/-
Sometimes you'll see lemmas or theorems with proofs that don't have `begin` and `end`. These
are still valid proofs, but are instead called _proof terms_. We'll talk about those next time!
-/
lemma last_random_lemma : a ≥ b ∨ a < b := le_or_lt b a

-- This ends the un-named section
end

/-
Sometimes it's helpful to define constants and do local calculations to test out what works and
doesn't work, but they shouldn't be part of your theorems or proofs.
-/
constants (pointless_constant : Type)

/-
We've seen `#check` before, it's helpful to figure out what the type of something is to test
things out while proving stuff. There's some tricky type theory going on with the outputs.
-/
#check pointless_constant
#check last_random_lemma

-- Starting the section called `random-section`.
section random_section

/-
Here we see a new kind of variable declaration using the brackets `[]` (and our old friend,
the implicit variable declaration `{}`). This is basically saying that we're carrying around
some un-named hypothesis that G has a way of multiplying its elements throughout.
-/
variables {G : Type} [has_mul G] (g h : G)

#check g * h

end random_section

/-
Actually we want to use more than just the fact that we can multiply elements. We want the
multiplication to have some properties so that we can reason about it. Below we add in the
assumption that G is a group, and all that comes along with it.
-/
section stuff_about_groups
variables {G : Type} [group G] (g h : G)

#check g⁻¹
#check group.inv g
#check _inst_1

-- You'll see examples often in demo documents. These are basically un-named lemmas.
example (a b : G) : a * (a⁻¹ * b) = b :=
begin
  rw [←mul_assoc, mul_right_inv, one_mul]
end

/-
This is something more indicative of what you'll find in mathlib. There's a lot going on in
this lemma, so lets take some time to piece it all together.

* `@[simp, to_additive]` tags the lemma with the `simp` and `to_additive` attributes. Don't worry
too much about what this means for now. The key takeaway about the `simp` attribute is that
this now lets the `simp` tactic use our lemma when it does its thing.

* The names of lemmas in mathlib are usually something crazy like `mul_eq_one_iff_inv_eq`. This is
in principle in order to make it easier to find them, but I don't find this to be the case at all.

* Here we're using a new technique to prove equalities/equivalences/inequalities. This is the
incredibly versitile `calc` block. The format

* This is something you won't find in mathlib, but the `library_search` tactic can be helpful.
When you can't remember the names of the lemmas you need, but they aren't too hidden for Lean
to look up `library_search` can find them for you.
-/
@[simp, to_additive]
theorem mul_eq_one_iff_inv_eq' : g * h = 1 ↔ g⁻¹ = h :=
begin
  calc g * h = 1 ↔ g = h⁻¹ : by rw mul_eq_one_iff_eq_inv
  ...            ↔ h = g⁻¹ : by library_search -- It actually worked this time!
  ...            ↔ g⁻¹ = h : by rw eq_comm
end

example (a b c d : ℕ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
/-
think about the sequence of moves if you start with hyp and go forward by rewriting with
hyp', mul_comm, two_mul, mul_assoc
-/
-- by rw [hyp, hyp', mul_comm, two_mul, add_mul]
begin
  calc c = d*a + b   : by exact hyp
  ...    = d*a + a*d : by rw hyp'
  ...    = a*d + a*d : by rw mul_comm
  ...    = (a + a)*d : by rw add_mul
  ...    = 2*a*d     : by rw two_mul
end

#check two_mul

example (a : ℕ) : a < a + 2 :=
calc a   < a + 1 : lt_add_one a
...  < a + 2 : lt_add_one (a + 1)

end stuff_about_groups

/-
In lean files where new objects are defined you may see the following kinds of constructions
For now don't worry too much about the differences between `structure` and `class`. Structures
and classes are defined in terms of providing a bunch of different fields.
-/
structure three_numbers :=
  (num1 : ℕ)
  (num2 : ℕ)
  (num3 : ℕ)

#check three_numbers.num1

/-
Here is the _class_ of a Group together with an extra point I call step which has as one of
its hypotheses that it's not the identity.
-/
class group_with_step (G : Type) extends group G :=
    (step : G)
    (step_neq_one : step ≠ 1)

-- We'll devote a lot of time to understanding `structure` and `class` later on in the semester.

/-
You may not see this too often in mathlib, but you can define inductive datatypes (whatever
those are) using the following kind of declaration. In this case, I'm defining a datatype with
two elements.
-/
inductive z2 : Type
| e : z2
| s : z2

-- This is exactly how nat is defined!
#check nat

open z2

/-
As you can see I can play around with it just like in any other functional programming
language.
-/
def z2_mul : z2 → z2 → z2
| e e := e
| e s := s
| s e := s
| s s := e

/-
`#eval` evaluates the function. It's kind of what you would expect form an actual programming
language (which we shuldn't forget is exactly what Lean is).
-/
#eval z2_mul s s
#eval z2_mul s e

-- Here I'm saying that z2 has multiplication.
instance : has_mul z2 := {mul := z2_mul}

/-
We can now use the `*` for our function, because that's precisely how we defined the operation.
The `*` symbol is just another alias for `has_mul.mul`. We can go back and forth between the infix
and regular notation by putting the operator in `()`. All of the following lines are doing the
exact same thing.
-/
#eval e * s
#eval has_mul.mul e s
#eval (*) e s
#eval ( * s) e

/-
We can even make things print out nicer by telling Lean how to represent the elements of my
structure. First we define the `z2_repr` function which has a reasonable looking type.
-/

def z2_repr : z2 → string
| e := "e"
| s := "s"

-- Next we tell Lean that z2 has a string representation given by that function.
instance : has_repr z2 := { repr := z2_repr}

-- Now everything shows up nicely!
#eval s * e

-- Here we'll show that it actually is a group!
instance : group z2 := { mul := _,
  mul_assoc := _,
  one := _,
  one_mul := _,
  mul_one := _,
  npow := _,
  npow_zero' := _,
  npow_succ' := _,
  inv := _,
  div := _,
  div_eq_mul_inv := _,
  zpow := _,
  zpow_zero' := _,
  zpow_succ' := _,
  zpow_neg' := _,
  mul_left_inv := _ }

-- On second thought, maybe not...

/-
There are also a lot of keywords that you may encounter. We'll get to them eventually as well,
but it's not super critical to understand what they're all saying for now.
-/

universes u v

variables (T : Type u)

noncomputable theory

section

local attribute [simp] add_assoc

end

-- And other exotic things like open_locale and stuff I'm probably forgetting to mention.

/-
This was all probably very overwhelming! And that's ok because this was intended to be a whirlwind
tour through Lean. A lot of the things we talked about in this demo will be touched on later in
more depth, so the goal for today was to mainly show you the highlights of what's out there.

This demo file and the associated slides can serve as a possible reference guide to notation and
constructions we'll use later in the semester (though there are still a few things I haven't
talked about).

Where to go from here:

* First stop is the Lean Community website: <https://leanprover-community.github.io/index.html>.
Pretty much all of links below (and much more!) can be found at this site. In particular, there's
a section on Undergraduate math that has not been formalized yet. Check it out and maybe you can
get inspired on a project to work on! <https://leanprover-community.github.io/undergrad.html>

Some hands-on games to play with:

* If you've completed the Natural Number Game
<https://www.ma.imperial.ac.uk/~buzzard/xena/natural_number_game/>
or you're finding it tedious after a point, the _Real Number Game_ may be fun for you.
The first few ``levels'' may be a bit easy after the NNG, but it gets pretty tough!
<https://github.com/leanprover-community/tutorials>

* Another way to get hands-on with Lean is by working on the _Complex Number Game_
<https://github.com/ImperialCollegeLondon/complex-number-game>
as opposed to following the usual curriculum from an undergraduate real analysis class, you'll be
constructing the complex numbers as pairs of real numbers from scratch.

* Finally, a great learning resource which combines video lectures, demonstrations, and exercises
(and where I'm getting a lot of the inspiration for my own demos, examples, exercises, ...) is
the _Lean for the Curious Mathematician_ 2020 conference.
<https://leanprover-community.github.io/lftcm2020/>

If you want to read more in then some

* _Lean Forward_ <https://lean-forward.github.io/>
  * A group of researchers and grad students at Vrije Universiteit Amsterdam
  * Have 4 semesters worth of projects <https://lean-forward.github.io/logical-verification/>
  * Textbook used in the courses is excellent (though has a distinct CS flavor to it)
  <https://github.com/blanchette/logical_verification_2021/blob/main/hitchhikers_guide.pdf>

* _Theorem proving in Lean_ <https://leanprover.github.io/theorem_proving_in_lean>. Kind of the
canonical tome. Covers pretty much everything that goes into proving theorems in Lean.

* _Mathematics in Lean_ <https://leanprover-community.github.io/mathematics_in_lean/basics.html>.
Much shorter than Theorem Proving in Lean, so it doesn't go into nearly as much detail. Maybe a
good first read before tackling _Theorem Proving in Lean_

Finally there's the actual documentation:

* _Lean Reference Manual_ <https://leanprover.github.io/reference/>

* _mathlib Documentation_ <https://leanprover-community.github.io/mathlib_docs/>
-/


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module category_theory.yoneda
! leanprover-community/mathlib commit 369525b73f229ccd76a6ec0e0e0bf2be57599768
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Functor.Hom
import Mathlib.CategoryTheory.Functor.Currying
import Mathlib.CategoryTheory.Products.Basic

/-!
# The Yoneda embedding

The Yoneda embedding as a functor `yoneda : C ⥤ (Cᵒᵖ ⥤ Type v₁)`,
along with an instance that it is `FullyFaithful`.

Also the Yoneda lemma, `yonedaLemma : (yoneda_pairing C) ≅ (yoneda_evaluation C)`.

## References
* [Stacks: Opposite Categories and the Yoneda Lemma](https://stacks.math.columbia.edu/tag/001L)
-/

namespace CategoryTheory

open Opposite

universe v₁ u₁ u₂

-- morphism levels before object levels. See note [CategoryTheory universes].
variable {C : Type u₁} [Category.{v₁} C]

/-- The Yoneda embedding, as a functor from `C` into presheaves on `C`.

See <https://stacks.math.columbia.edu/tag/001O>.
-/
@[simps]
def yoneda : C ⥤ Cᵒᵖ ⥤ Type v₁
    where
  obj X :=
    { obj := fun Y => unop Y ⟶ X
      map := fun f g => f.unop ≫ g
      map_comp := fun f g => by funext; dsimp; erw [Category.assoc]
      map_id := fun Y => by funext; dsimp; erw [Category.id_comp] }
  map f :=
    { app := fun Y g => g ≫ f
      naturality := fun Y Y' g => by funext Z; aesop_cat }
  map_id := by aesop_cat
  map_comp := fun f g => by ext Y; dsimp; funext f; simp
#align category_theory.yoneda CategoryTheory.yoneda

/-- The co-Yoneda embedding, as a functor from `Cᵒᵖ` into co-presheaves on `C`.
-/
@[simps]
def coyoneda : Cᵒᵖ ⥤ C ⥤ Type v₁
    where
  obj X :=
    { obj := fun Y => unop X ⟶ Y
      map := fun f g => g ≫ f
      map_comp := fun f g => by funext; dsimp; erw [Category.assoc]
      map_id := fun Y => by funext; dsimp; erw [Category.comp_id] }
  map f :=
    { app := fun Y g => f.unop ≫ g
      naturality := fun Y Y' g => by funext Z; aesop_cat }
#align category_theory.coyoneda CategoryTheory.coyoneda

namespace Yoneda

theorem obj_map_id {X Y : C} (f : op X ⟶ op Y) :
    (yoneda.obj X).map f (𝟙 X) = (yoneda.map f.unop).app (op Y) (𝟙 Y) := by
  dsimp
  simp
#align category_theory.yoneda.obj_map_id CategoryTheory.Yoneda.obj_map_id

@[simp]
theorem naturality {X Y : C} (α : yoneda.obj X ⟶ yoneda.obj Y) {Z Z' : C} (f : Z ⟶ Z')
    (h : Z' ⟶ X) : f ≫ α.app (op Z') h = α.app (op Z) (f ≫ h) :=
  (FunctorToTypes.naturality _ _ α f.op h).symm
#align category_theory.yoneda.naturality CategoryTheory.Yoneda.naturality

/-- The Yoneda embedding is full.

See <https://stacks.math.columbia.edu/tag/001P>.
-/
instance yonedaFull : Full (yoneda : C ⥤ Cᵒᵖ ⥤ Type v₁) where
  preimage {X} {Y} f := f.app (op X) (𝟙 X)
  witness {X} {Y} f := by simp only [yoneda]; aesop_cat
#align category_theory.yoneda.yoneda_full CategoryTheory.Yoneda.yonedaFull

/-- The Yoneda embedding is faithful.

See <https://stacks.math.columbia.edu/tag/001P>.
-/
instance yoneda_faithful : Faithful (yoneda : C ⥤ Cᵒᵖ ⥤ Type v₁) where
  map_injective {X} {Y} f g p := by
    convert congr_fun (congr_app p (op X)) (𝟙 X) using 1 <;> dsimp <;> simp
#align category_theory.yoneda.yoneda_faithful CategoryTheory.Yoneda.yoneda_faithful

/-- Extensionality via Yoneda. The typical usage would be
```
-- Goal is `X ≅ Y`
apply yoneda.ext,
-- Goals are now functions `(Z ⟶ X) → (Z ⟶ Y)`, `(Z ⟶ Y) → (Z ⟶ X)`, and the fact that these
functions are inverses and natural in `Z`.
```
-/
def ext (X Y : C) (p : ∀ {Z : C}, (Z ⟶ X) → (Z ⟶ Y)) (q : ∀ {Z : C}, (Z ⟶ Y) → (Z ⟶ X))
    (h₁ : ∀ {Z : C} (f : Z ⟶ X), q (p f) = f) (h₂ : ∀ {Z : C} (f : Z ⟶ Y), p (q f) = f)
    (n : ∀ {Z Z' : C} (f : Z' ⟶ Z) (g : Z ⟶ X), p (f ≫ g) = f ≫ p g) : X ≅ Y :=
  yoneda.preimageIso
    (NatIso.ofComponents
      (fun Z =>
        { hom := p
          inv := q
          hom_inv_id := by simp only [yoneda]; funext; apply h₁
          inv_hom_id := by simp only [yoneda]; funext; apply h₂ })
      (fun f => by simp only [yoneda]; funext; apply n))
#align category_theory.yoneda.ext CategoryTheory.Yoneda.ext

/-- If `yoneda.map f` is an isomorphism, so was `f`.
-/

end Yoneda

namespace Coyoneda

@[simp]
theorem naturality {X Y : Cᵒᵖ} (α : coyoneda.obj X ⟶ coyoneda.obj Y) {Z Z' : C} (f : Z' ⟶ Z)
    (h : unop X ⟶ Z') : α.app Z' h ≫ f = α.app Z (h ≫ f) :=
  (FunctorToTypes.naturality _ _ α f h).symm
#align category_theory.coyoneda.naturality CategoryTheory.Coyoneda.naturality

instance coyonedaFull : Full (coyoneda : Cᵒᵖ ⥤ C ⥤ Type v₁)
    where
      preimage {X} _ f := (f.app _ (𝟙 X.unop)).op
      witness {X} {Y} f := by simp only [coyoneda]; aesop_cat
#align category_theory.coyoneda.coyoneda_full CategoryTheory.Coyoneda.coyonedaFull

instance coyoneda_faithful : Faithful (coyoneda : Cᵒᵖ ⥤ C ⥤ Type v₁) where
  map_injective {X} _ _ _ p := by
    have t := congr_fun (congr_app p X.unop) (𝟙 _)
    simpa using congr_arg Quiver.Hom.op t
#align category_theory.coyoneda.coyoneda_faithful CategoryTheory.Coyoneda.coyoneda_faithful

/-- If `coyoneda.map f` is an isomorphism, so was `f`.
-/
theorem isIso {X Y : Cᵒᵖ} (f : X ⟶ Y) [IsIso (coyoneda.map f)] : IsIso f :=
  isIso_of_fully_faithful coyoneda f
#align category_theory.coyoneda.is_iso CategoryTheory.Coyoneda.isIso

/-- The identity functor on `Type` is isomorphic to the coyoneda functor coming from `punit`. -/
def punitIso : coyoneda.obj (Opposite.op PUnit) ≅ 𝟭 (Type v₁) :=
  NatIso.ofComponents
    (fun X =>
      { hom := fun f => f ⟨⟩
        inv := fun x _ => x })
    (by aesop_cat)
#align category_theory.coyoneda.punit_iso CategoryTheory.Coyoneda.punitIso

/-- Taking the `unop` of morphisms is a natural isomorphism. -/
@[simps!]
def objOpOp (X : C) : coyoneda.obj (op (op X)) ≅ yoneda.obj X :=
  NatIso.ofComponents (fun _ => (opEquiv _ _).toIso) fun _ {_Y} _f => rfl
#align category_theory.coyoneda.obj_op_op CategoryTheory.Coyoneda.objOpOp

end Coyoneda

namespace Functor

/-- A functor `F : Cᵒᵖ ⥤ Type v₁` is representable if there is object `X` so `F ≅ yoneda.obj X`.

See <https://stacks.math.columbia.edu/tag/001Q>.
-/
class Representable (F : Cᵒᵖ ⥤ Type v₁) : Prop where
  /-- `Hom(-,X) ≅ F` via `f` -/
  has_representation : ∃ (X : _)(f : yoneda.obj X ⟶ F), IsIso f
#align category_theory.functor.representable CategoryTheory.Functor.Representable

instance {X : C} : Representable (yoneda.obj X) where has_representation := ⟨X, 𝟙 _, inferInstance⟩

/-- A functor `F : C ⥤ Type v₁` is corepresentable if there is object `X` so `F ≅ coyoneda.obj X`.

See <https://stacks.math.columbia.edu/tag/001Q>.
-/
class Corepresentable (F : C ⥤ Type v₁) : Prop where
  /-- `Hom(X,-) ≅ F` via `f` -/
  has_corepresentation : ∃ (X : _)(f : coyoneda.obj X ⟶ F), IsIso f
#align category_theory.functor.corepresentable CategoryTheory.Functor.Corepresentable

instance {X : Cᵒᵖ} : Corepresentable (coyoneda.obj X)
    where has_corepresentation := ⟨X, 𝟙 _, inferInstance⟩

-- instance : corepresentable (𝟭 (Type v₁)) :=
-- corepresentable_of_nat_iso (op punit) coyoneda.punit_iso
section Representable

variable (F : Cᵒᵖ ⥤ Type v₁)

variable [F.Representable]

/-- The representing object for the representable functor `F`. -/
noncomputable def reprX : C :=
  (Representable.has_representation : ∃ (_ : _)(_ : _ ⟶ F), _).choose
set_option linter.uppercaseLean3 false
#align category_theory.functor.repr_X CategoryTheory.Functor.reprX

/-- The (forward direction of the) isomorphism witnessing `F` is representable. -/
noncomputable def reprF : yoneda.obj F.reprX ⟶ F :=
  Representable.has_representation.choose_spec.choose
#align category_theory.functor.repr_f CategoryTheory.Functor.reprF

/-- The representing element for the representable functor `F`, sometimes called the universal
element of the functor.
-/
noncomputable def reprx : F.obj (op F.reprX) :=
  F.reprF.app (op F.reprX) (𝟙 F.reprX)
#align category_theory.functor.repr_x CategoryTheory.Functor.reprx

instance : IsIso F.reprF :=
  Representable.has_representation.choose_spec.choose_spec

/-- An isomorphism between `F` and a functor of the form `C(-, F.repr_X)`.  Note the components
`F.repr_w.app X` definitionally have type `(X.unop ⟶ F.repr_X) ≅ F.obj X`.
-/
noncomputable def reprW : yoneda.obj F.reprX ≅ F :=
  asIso F.reprF
#align category_theory.functor.repr_w CategoryTheory.Functor.reprW

@[simp]
theorem reprW_hom : F.reprW.hom = F.reprF :=
  rfl
#align category_theory.functor.repr_w_hom CategoryTheory.Functor.reprW_hom

theorem reprW_app_hom (X : Cᵒᵖ) (f : unop X ⟶ F.reprX) :
    (F.reprW.app X).hom f = F.map f.op F.reprx := by
  change F.reprF.app X f = (F.reprF.app (op F.reprX) ≫ F.map f.op) (𝟙 F.reprX)
  rw [← F.reprF.naturality]
  dsimp
  simp
#align category_theory.functor.repr_w_app_hom CategoryTheory.Functor.reprW_app_hom

end Representable

section Corepresentable

variable (F : C ⥤ Type v₁)

variable [F.Corepresentable]

/-- The representing object for the corepresentable functor `F`. -/
noncomputable def coreprX : C :=
  (Corepresentable.has_corepresentation : ∃ (_ : _)(_ : _ ⟶ F), _).choose.unop
set_option linter.uppercaseLean3 false
#align category_theory.functor.corepr_X CategoryTheory.Functor.coreprX

/-- The (forward direction of the) isomorphism witnessing `F` is corepresentable. -/
noncomputable def coreprF : coyoneda.obj (op F.coreprX) ⟶ F :=
  Corepresentable.has_corepresentation.choose_spec.choose
#align category_theory.functor.corepr_f CategoryTheory.Functor.coreprF

/-- The representing element for the corepresentable functor `F`, sometimes called the universal
element of the functor.
-/
noncomputable def coreprx : F.obj F.coreprX :=
  F.coreprF.app F.coreprX (𝟙 F.coreprX)
#align category_theory.functor.corepr_x CategoryTheory.Functor.coreprx

instance : IsIso F.coreprF :=
  Corepresentable.has_corepresentation.choose_spec.choose_spec

/-- An isomorphism between `F` and a functor of the form `C(F.corepr X, -)`. Note the components
`F.corepr_w.app X` definitionally have type `F.corepr_X ⟶ X ≅ F.obj X`.
-/
noncomputable def coreprW : coyoneda.obj (op F.coreprX) ≅ F :=
  asIso F.coreprF
#align category_theory.functor.corepr_w CategoryTheory.Functor.coreprW

theorem coreprW_app_hom (X : C) (f : F.coreprX ⟶ X) : (F.coreprW.app X).hom f = F.map f F.coreprx :=
  by
  change F.coreprF.app X f = (F.coreprF.app F.coreprX ≫ F.map f) (𝟙 F.coreprX)
  rw [← F.coreprF.naturality]
  dsimp
  simp
#align category_theory.functor.corepr_w_app_hom CategoryTheory.Functor.coreprW_app_hom

end Corepresentable

end Functor

theorem representable_of_nat_iso (F : Cᵒᵖ ⥤ Type v₁) {G} (i : F ≅ G) [F.Representable] :
    G.Representable :=
  { has_representation := ⟨F.reprX, F.reprF ≫ i.hom, inferInstance⟩ }
#align category_theory.representable_of_nat_iso CategoryTheory.representable_of_nat_iso

theorem corepresentable_of_nat_iso (F : C ⥤ Type v₁) {G} (i : F ≅ G) [F.Corepresentable] :
    G.Corepresentable :=
  { has_corepresentation := ⟨op F.coreprX, F.coreprF ≫ i.hom, inferInstance⟩ }
#align category_theory.corepresentable_of_nat_iso CategoryTheory.corepresentable_of_nat_iso

instance : Functor.Corepresentable (𝟭 (Type v₁)) :=
  corepresentable_of_nat_iso (coyoneda.obj (op PUnit)) Coyoneda.punitIso

open Opposite

variable (C)

-- We need to help typeclass inference with some awkward universe levels here.
instance prodCategoryInstance1 : Category ((Cᵒᵖ ⥤ Type v₁) × Cᵒᵖ) :=
  CategoryTheory.prod.{max u₁ v₁, v₁} (Cᵒᵖ ⥤ Type v₁) Cᵒᵖ
#align category_theory.prod_category_instance_1 CategoryTheory.prodCategoryInstance1

instance prodCategoryInstance2 : Category (Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) :=
  CategoryTheory.prod.{v₁, max u₁ v₁} Cᵒᵖ (Cᵒᵖ ⥤ Type v₁)
#align category_theory.prod_category_instance_2 CategoryTheory.prodCategoryInstance2

open Yoneda

/-- The "Yoneda evaluation" functor, which sends `X : Cᵒᵖ` and `F : Cᵒᵖ ⥤ Type`
to `F.obj X`, functorially in both `X` and `F`.
-/
def yonedaEvaluation : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type max u₁ v₁ :=
  evaluationUncurried Cᵒᵖ (Type v₁) ⋙ uliftFunctor.{u₁}
#align category_theory.yoneda_evaluation CategoryTheory.yonedaEvaluation

@[simp]
theorem yonedaEvaluation_map_down (P Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q)
    (x : (yonedaEvaluation C).obj P) :
    ((yonedaEvaluation C).map α x).down = α.2.app Q.1 (P.2.map α.1 x.down) :=
  rfl
#align category_theory.yoneda_evaluation_map_down CategoryTheory.yonedaEvaluation_map_down

/-- The "Yoneda pairing" functor, which sends `X : Cᵒᵖ` and `F : Cᵒᵖ ⥤ Type`
to `yoneda.op.obj X ⟶ F`, functorially in both `X` and `F`.
-/
def yonedaPairing : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type max u₁ v₁ :=
  Functor.prod yoneda.op (𝟭 (Cᵒᵖ ⥤ Type v₁)) ⋙ Functor.hom (Cᵒᵖ ⥤ Type v₁)
#align category_theory.yoneda_pairing CategoryTheory.yonedaPairing

@[simp]
theorem yonedaPairing_map (P Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (β : (yonedaPairing C).obj P) :
    (yonedaPairing C).map α β = yoneda.map α.1.unop ≫ β ≫ α.2 :=
  rfl
#align category_theory.yoneda_pairing_map CategoryTheory.yonedaPairing_map

/-- The Yoneda lemma asserts that that the Yoneda pairing
`(X : Cᵒᵖ, F : Cᵒᵖ ⥤ Type) ↦ (yoneda.obj (unop X) ⟶ F)`
is naturally isomorphic to the evaluation `(X, F) ↦ F.obj X`.

See <https://stacks.math.columbia.edu/tag/001P>.
-/
def yonedaLemma : yonedaPairing C ≅ yonedaEvaluation C
    where
  hom :=
    { app := fun F x => ULift.up ((x.app F.1) (𝟙 (unop F.1)))
      naturality := by
        intro X Y f; simp only [yonedaEvaluation]; funext; dsimp
        erw [Category.id_comp, ←FunctorToTypes.naturality]
        simp only [Category.comp_id, yoneda_obj_map] }
  inv :=
    { app := fun F x =>
        { app := fun X a => (F.2.map a.op) x.down
          naturality := by
            intro X Y f; funext; dsimp
            rw [FunctorToTypes.map_comp_apply] }
      naturality := by
        intro X Y f; simp only [yoneda]; funext; apply NatTrans.ext; funext; funext; dsimp
        rw [←FunctorToTypes.naturality X.snd Y.snd f.snd, FunctorToTypes.map_comp_apply] }
  hom_inv_id := by
    apply NatTrans.ext; funext; funext;
    apply NatTrans.ext; funext; funext; dsimp
    erw [← FunctorToTypes.naturality, obj_map_id]
    simp only [yoneda_map_app, Quiver.Hom.unop_op]
    erw [Category.id_comp]
  inv_hom_id := by
    apply NatTrans.ext; funext; funext; dsimp
    rw [FunctorToTypes.map_id_apply, ULift.up_down]
#align category_theory.yoneda_lemma CategoryTheory.yonedaLemma

variable {C}

/-- The isomorphism between `yoneda.obj X ⟶ F` and `F.obj (op X)`
(we need to insert a `ulift` to get the universes right!)
given by the Yoneda lemma.
-/
@[simps!]
def yonedaSections (X : C) (F : Cᵒᵖ ⥤ Type v₁) : (yoneda.obj X ⟶ F) ≅ ULift.{u₁} (F.obj (op X)) :=
  (yonedaLemma C).app (op X, F)
#align category_theory.yoneda_sections CategoryTheory.yonedaSections

/-- We have a type-level equivalence between natural transformations from the yoneda embedding
and elements of `F.obj X`, without any universe switching.
-/
def yonedaEquiv {X : C} {F : Cᵒᵖ ⥤ Type v₁} : (yoneda.obj X ⟶ F) ≃ F.obj (op X) :=
  (yonedaSections X F).toEquiv.trans Equiv.ulift
#align category_theory.yoneda_equiv CategoryTheory.yonedaEquiv

@[simp]
theorem yonedaEquiv_apply {X : C} {F : Cᵒᵖ ⥤ Type v₁} (f : yoneda.obj X ⟶ F) :
    yonedaEquiv f = f.app (op X) (𝟙 X) :=
  rfl
#align category_theory.yoneda_equiv_apply CategoryTheory.yonedaEquiv_apply

@[simp]
theorem yonedaEquiv_symm_app_apply {X : C} {F : Cᵒᵖ ⥤ Type v₁} (x : F.obj (op X)) (Y : Cᵒᵖ)
    (f : Y.unop ⟶ X) : (yonedaEquiv.symm x).app Y f = F.map f.op x :=
  rfl
#align category_theory.yoneda_equiv_symm_app_apply CategoryTheory.yonedaEquiv_symm_app_apply

theorem yonedaEquiv_naturality {X Y : C} {F : Cᵒᵖ ⥤ Type v₁} (f : yoneda.obj X ⟶ F) (g : Y ⟶ X) :
    F.map g.op (yonedaEquiv f) = yonedaEquiv (yoneda.map g ≫ f) := by
  change (f.app (op X) ≫ F.map g.op) (𝟙 X) = f.app (op Y) (𝟙 Y ≫ g)
  rw [← f.naturality]
  dsimp
  simp
#align category_theory.yoneda_equiv_naturality CategoryTheory.yonedaEquiv_naturality

/-- When `C` is a small category, we can restate the isomorphism from `yoneda_sections`
without having to change universes.
-/
def yonedaSectionsSmall {C : Type u₁} [SmallCategory C] (X : C) (F : Cᵒᵖ ⥤ Type u₁) :
    (yoneda.obj X ⟶ F) ≅ F.obj (op X) :=
  yonedaSections X F ≪≫ uliftTrivial _
#align category_theory.yoneda_sections_small CategoryTheory.yonedaSectionsSmall

@[simp]
theorem yonedaSectionsSmall_hom {C : Type u₁} [SmallCategory C] (X : C) (F : Cᵒᵖ ⥤ Type u₁)
    (f : yoneda.obj X ⟶ F) : (yonedaSectionsSmall X F).hom f = f.app _ (𝟙 _) :=
  rfl
#align category_theory.yoneda_sections_small_hom CategoryTheory.yonedaSectionsSmall_hom

@[simp]
theorem yonedaSectionsSmall_inv_app_apply {C : Type u₁} [SmallCategory C] (X : C)
    (F : Cᵒᵖ ⥤ Type u₁) (t : F.obj (op X)) (Y : Cᵒᵖ) (f : Y.unop ⟶ X) :
    ((yonedaSectionsSmall X F).inv t).app Y f = F.map f.op t :=
  rfl
#align category_theory.yoneda_sections_small_inv_app_apply CategoryTheory.yonedaSectionsSmall_inv_app_apply

attribute [local ext] Functor.ext

/- Porting note: this used to be two calls to `tidy` -/
/-- The curried version of yoneda lemma when `C` is small. -/
def curriedYonedaLemma {C : Type u₁} [SmallCategory C] :
    (yoneda.op ⋙ coyoneda : Cᵒᵖ ⥤ (Cᵒᵖ ⥤ Type u₁) ⥤ Type u₁) ≅ evaluation Cᵒᵖ (Type u₁) := by
  refine eqToIso ?_ ≪≫ curry.mapIso
    (yonedaLemma C ≪≫ isoWhiskerLeft (evaluationUncurried Cᵒᵖ (Type u₁)) uliftFunctorTrivial) ≪≫
    eqToIso ?_
  · apply Functor.ext
    · intro X Y f
      simp only [curry, yoneda, coyoneda, curryObj, yonedaPairing]
      dsimp
      apply NatTrans.ext
      dsimp at *
      funext F g
      apply NatTrans.ext
      simp
    · intro X
      simp only [curry, yoneda, coyoneda, curryObj, yonedaPairing]
      aesop_cat
  · apply Functor.ext
    · intro X Y f
      simp only [curry, yoneda, coyoneda, curryObj, yonedaPairing]
      dsimp
      apply NatTrans.ext
      dsimp at *
      funext F g
      simp
    · intro X
      simp only [curry, yoneda, coyoneda, curryObj, yonedaPairing]
      aesop_cat
#align category_theory.curried_yoneda_lemma CategoryTheory.curriedYonedaLemma

/-- The curried version of yoneda lemma when `C` is small. -/
def curriedYonedaLemma' {C : Type u₁} [SmallCategory C] :
    yoneda ⋙ (whiskeringLeft Cᵒᵖ (Cᵒᵖ ⥤ Type u₁)ᵒᵖ (Type u₁)).obj yoneda.op ≅ 𝟭 (Cᵒᵖ ⥤ Type u₁)
    := by
  refine eqToIso ?_ ≪≫ curry.mapIso (isoWhiskerLeft (Prod.swap _ _)
    (yonedaLemma C ≪≫ isoWhiskerLeft (evaluationUncurried Cᵒᵖ (Type u₁)) uliftFunctorTrivial :_))
    ≪≫ eqToIso ?_
  · apply Functor.ext
    · intro X Y f
      simp only [curry, yoneda, coyoneda, curryObj, yonedaPairing]
      aesop_cat
  · apply Functor.ext
    · intro X Y f
      aesop_cat
#align category_theory.curried_yoneda_lemma' CategoryTheory.curriedYonedaLemma'

end CategoryTheory


--  An abstract formalization of "isomorphism is equality up to relabeling"
-- -------------------------------------------------------------------------
--
-- See `README.md` for more info.
--
-- In this file, we define some basic building blocks which are closely related to the cases mentioned in
-- `README.md`.

import Structure.Basic
import Structure.Forgetfulness
import Structure.UniverseFunctor
import Structure.AbstractPiSigma

import mathlib4_experiments.Data.Equiv

open Morphisms
open Structure
open StructureFunctor
open Forgetfulness
open PiSigma
open PiSigmaEquivalences

set_option autoBoundImplicitLocal false

universes u v

namespace BuildingBlocks

-- If we think of `SigmaEquiv` as defining our concept of isomorphism, we can actually _prove_ that
-- isomorphisms between particular structures match their concrete definitions. This even works for
-- structures that lack an obvious concept of "morphism".
--
-- We will call `SigmaExpr.fst` the "type" and `SigmaExpr.snd` the "instance" (that depends on the type).
-- Correspondingly, `SigmaEquiv.fst` is the "type equivalence", and `SigmaEquiv.snd` is the "instance
-- equivalence".

-- We would like to state our theorems not about the entire `SigmaEquiv` but about how the instance
-- equivalence depends on the type equivalence.
-- Whenever we do want to reason about the entire `SigmaEquiv`, `isoEquiv` will provide the desired
-- result. Although `isoEquiv` is a _definition_ (of an equivalence), it can also be read as the theorem
-- that the two types are equivalent.

def HasIso {F : StructureDependency} (a b : SigmaExpr F) (I : ∀ e : a.fst ≃ b.fst, Prop) :=
∀ e : a.fst ≃ b.fst, a.snd ≈[congrArg F.F e] b.snd ↔ I e

structure InstanceIsoCriterion {F : StructureDependency} (a b : SigmaExpr F) where
{I : ∀ e : a.fst ≃ b.fst, Prop}
(h : HasIso a b I)

def IsoCriterion (F : StructureDependency) := ∀ a b : SigmaExpr F, InstanceIsoCriterion a b

def isoEquiv {F : StructureDependency} {a b : SigmaExpr F} (c : InstanceIsoCriterion a b) :
  IsType.type (a ≃ b) ≃ Σ' e : a.fst ≃ b.fst, c.I e :=
{ toFun    := λ ⟨h₁, h₂⟩ => ⟨h₁, (c.h h₁).mp  h₂⟩,
  invFun   := λ ⟨h₁, h₂⟩ => ⟨h₁, (c.h h₁).mpr h₂⟩,
  leftInv  := λ ⟨h₁, h₂⟩ => rfl,
  rightInv := λ ⟨h₁, h₂⟩ => rfl }

-- Degenerate case: If the instance does not actually depend on the type, an isomorphism is just an
-- equivalence between the types together with an equivalence between the instances.

def independentPairDependency (S T : Structure) := StructureDependency.constDep S T

def IndependentPair (S T : Structure) := SigmaExpr (independentPairDependency S T)

namespace IndependentPair

variable (S T : Structure)

-- This degenerate case is actually equivalent to `PProd S T`.

def equivProd : IndependentPair S T ≃ PProd (IsType.type S) (IsType.type T) :=
{ toFun    := λ ⟨x, y⟩ => ⟨x, y⟩,
  invFun   := λ ⟨x, y⟩ => ⟨x, y⟩,
  leftInv  := λ ⟨x, y⟩ => rfl,
  rightInv := λ ⟨x, y⟩ => rfl }

-- The instance equivalence does not depend on the type equivalence.

theorem iso (a b : IndependentPair S T) : HasIso a b (λ e => SetoidEquiv (IsType.type T) a.snd b.snd) :=
λ e => Iff.rfl

def isoCriterion : IsoCriterion (independentPairDependency S T) := λ a b => ⟨iso S T a b⟩

-- For this particular case, we can also specialize `isoEquiv` a bit.

def equiv (a b : IndependentPair S T) : SigmaExpr.SigmaEquiv a b ≃ PProd (IsType.type (a.fst ≃ b.fst)) (SetoidEquiv (IsType.type T) a.snd b.snd) :=
{ toFun    := λ ⟨h₁, h₂⟩ => ⟨h₁, h₂⟩,
  invFun   := λ ⟨h₁, h₂⟩ => ⟨h₁, h₂⟩,
  leftInv  := λ ⟨h₁, h₂⟩ => rfl,
  rightInv := λ ⟨h₁, h₂⟩ => rfl }

-- And in particular, if any of the two structures is the unit structure, we just have the equivalence
-- on the other side.

-- TODO

end IndependentPair

-- Another simple case is that the instance on the right is just a particular instance of the type on the
-- left, i.e. we have a generalized "pointed type" structure. Obviously, in that case an isomorphism
-- should transport the instance along the type equivalence.

def instanceDependency : StructureDependency := ⟨universeStructure, idFun⟩

def InstanceInstance := SigmaExpr instanceDependency

namespace InstanceInstance

def equivSigma : InstanceInstance ≃ Σ' S : Structure, IsType.type S :=
{ toFun    := λ ⟨S, x⟩ => ⟨S, x⟩,
  invFun   := λ ⟨S, x⟩ => ⟨S, x⟩,
  leftInv  := λ ⟨S, x⟩ => rfl,
  rightInv := λ ⟨S, x⟩ => rfl }

theorem iso (a b : InstanceInstance) : HasIso a b (λ e => e.toFun a.snd ≈ b.snd) :=
λ e => SetoidInstanceEquiv.setoidInstanceEquiv e a.snd b.snd

def isoCriterion : IsoCriterion instanceDependency := λ a b => ⟨iso a b⟩

end InstanceInstance

-- The next building block is a bit opaque in its full generality. It covers the case where the instance
-- is a functor between two structures that are both obtained from a `StructureDependency`. This is quite
-- a powerful building block because functors are an abstraction of functions, so n-ary operations and
-- relations are just special cases of this and the previous two building blocks composed in different
-- ways.
--
-- This is best explained by considering the main use case where the type is really `α : Sort u` and `F`
-- and `G` are functions `Sort u → Sort _`. Then we can consider the analogue of
-- `functorMap F G : Sort u → Sort _ := λ α => F α → G α` (defined below)
-- to be a type class that assigns to each `α` a function between two types that depend on `α` in a very
-- flexible way.
--
-- For example:
-- * `functorMap id (const _ γ)` is a type class that maps `α` to `α → γ`. In particular, if `γ` is
--   `Prop`, we have a unary relation aka subset of `α`.
-- * `functorMap id (functorMap id (const _ γ))` maps `α` to `α → α → γ`. In particular, if `γ` is `Prop`,
--   we have a binary relation on `α`.
-- * `functorMap id id` maps `α` to `α → α`, i.e. a unary operation.
-- * `functorMap id (functorMap id id)` maps `α` to `α → α → α`, i.e. a binary operation.
-- * `functorMap (const _ γ) id` maps `α` to `γ → α`, i.e. we have an instance of `α` that depends on some
--   external constant.
-- * `functorMap (const _ γ) (functorMap id id)` maps `α` to `γ → α → α`, which is an outer operation.
--
-- To give a general isomorphism criterion for `functorMap F G`, we need to consider `F` and `G` as
-- functors again. Then we can prove the following: An `e : α ≃ β` is an isomorphism between `⟨α, f⟩` and
-- `⟨β, g⟩` (with functions `f` and `g`) iff for all `x y : α` such that `congrArg F e` transports `x`
-- to `y`, `congrArg G e` transports `f x` to `g y`.
--
-- Applying this criterion to the examples above, we obtain all familiar special cases:
--
--  Example                              | Isomorphism criterion
-- --------------------------------------+-----------------------------
--  Function returning a constant        | `f x = g (e x)`
--  Unary relation                       | `f x ↔ g (e x)`
--  Binary relation                      | `f x y ↔ g (e x) (e y)`
--  Unary operation                      | `e (f x) = g (e x)`
--  Binary operation                     | `e (f x y) = g (e x) (e y)`
--  Instance depending on a constant `c` | `e (f c) = g c`
--  Outer operation                      | `e (f c x) = g c (e x)`

section FunctorInstanceDef

variable {S : Structure} (F G : UniverseFunctor S)

def functorMap (a : S) := functorStructure (F a) (G a)

def functorToFun {a b : S} (e : a ≃ b) : SetoidStructureFunctor (functorMap F G a) (functorMap F G b) :=
{ map     := λ f => ((StructureFunctor.congrArg G e).toFun ⊙ f) ⊙ (StructureFunctor.congrArg F e).invFun,
  functor := sorry }  -- TODO: Since we are dealing with setoid functors here, we just need to combine `compFun.congrArg'` etc.

def functorFunDesc : SetoidUniverseFunctorDesc S :=
{ map            := functorMap   F G,
  toFun          := functorToFun F G,
  respectsSetoid := sorry,
  respectsComp   := sorry,
  respectsId     := sorry }

def functorFun : UniverseFunctor S := SetoidUniverseFunctorDesc.universeFunctor (functorFunDesc F G)

def functorDependency : StructureDependency := ⟨S, functorFun F G⟩

def FunctorInstance := SigmaExpr (functorDependency F G)

namespace FunctorInstance

-- The isomorphism criterion for the functors `a.snd` and `b.snd`, as described above.

theorem iso (a b : FunctorInstance F G) :
  HasIso a b (λ e => ∀ x y, x ≈[congrArg F e] y → a.snd.map x ≈[congrArg G e] b.snd.map y) :=
λ e => let f := StructureFunctor.congrArg F e;
       let g := StructureFunctor.congrArg G e;
       ⟨λ h₁ x y h₂ => let h₄ : g.toFun ⊙ a.snd ≃ b.snd ⊙ f.toFun := sorry;
                       let h₅ : g.toFun (a.snd.map x) ≃ b.snd.map (f.toFun x) := h₄.ext x;
                       let h₆ : g.toFun (a.snd.map x) ≃ b.snd.map y := sorry;
                       ⟨h₆⟩,
        sorry⟩

-- If we have isomorphism criteria for `F` and `G`, we can combine them with `iso`. This way, we can not
-- only compose the building blocks but also their isomorphism criteria.

theorem iso' (a b : FunctorInstance F G) (cF : IsoCriterion ⟨S, F⟩) (cG : IsoCriterion ⟨S, G⟩) :
  HasIso a b (λ e => ∀ x y, (cF ⟨a.fst, x⟩ ⟨b.fst, y⟩).I e → (cG ⟨a.fst, a.snd.map x⟩ ⟨b.fst, b.snd.map y⟩).I e) :=
λ e => let h₁ := iso F G a b e;
       let h₂ := λ x y => (cF ⟨a.fst, x⟩ ⟨b.fst, y⟩).h e;
       let h₃ := λ x y => (cG ⟨a.fst, a.snd.map x⟩ ⟨b.fst, b.snd.map y⟩).h e;
       ⟨λ h₄ x y h₅ => (h₃ x y).mp (h₁.mp h₄ x y ((h₂ x y).mpr h₅)),
        λ h₄ => h₁.mpr (λ x y h₅ => (h₃ x y).mpr (h₄ x y ((h₂ x y).mp h₅)))⟩

def isoCriterion (cF : IsoCriterion ⟨S, F⟩) (cG : IsoCriterion ⟨S, G⟩) : IsoCriterion (functorDependency F G) :=
λ a b => ⟨iso' F G a b cF cG⟩

end FunctorInstance

end FunctorInstanceDef

-- TODO: Generalize `FunctorInstance` to `PiExpr`, somewhat similarly to how we treat `SigmaExpr`. This
-- would be useful because ultimately everything is built on Π types.

-- TODO: At least we need to define some simple cases for dependent propositions.

-- The previous building blocks give us criteria for the individual fields of a type class. To combine
-- these fields, we need to give an isomorphism criterion for an instance that is a dependent pair.
--
-- To specify the isomorphism criterion for a dependent pair `⟨x, y⟩`, we can consider a bundled instance
-- `⟨α, ⟨x, y⟩⟩` canonically as `⟨⟨α, x⟩, y⟩`, as mentioned in the introduction. In this term, we can
-- consider both the inner and the outer pair as a type with an instance, and if we have isomorphism
-- criteria for these, we can combine them into an isomorphism criterion for the original term.
--
-- It turns out that our setoid-based formalization prevents us from generically supporting all possible
-- sigma instances on the right by defining a `StructureDependency` for generic sigma types.
-- Therefore, the variables `F` and `G` are based on the variant where the dependent types are nested on
-- the left, and then we convert that to a `StructureDependency` where the structure contained in `F` is
-- moved to the outside.

section SigmaInstanceDef

variable (D : NestedDependency)

def UncurriedSigmaInstance := SigmaExpr (innerPairDependency   D)
def SigmaInstance          := SigmaExpr (nestedSigmaDependency D)

namespace SigmaInstance

def innerPair (a : SigmaInstance D) : innerPairStructure D.fst :=
⟨a.fst, a.snd.fst⟩

def outerPair (a : SigmaInstance D) : UncurriedSigmaInstance D :=
⟨innerPair D a, a.snd.snd⟩

-- TODO: Make use of `PiSigmaEquivalences` here (and finish those first).

def applyInnerEquiv (a b : SigmaInstance D) (e : a.fst ≃ b.fst)
                    (h : a.snd.fst ≈[UniverseStructureFunctor.congrArg D.fst e] b.snd.fst) :
  innerPair D a ≃ innerPair D b :=
sorry

theorem iso (a b : SigmaInstance D) :
  HasIso a b (λ e => ∃ h : a.snd.fst ≈[UniverseStructureFunctor.congrArg D.fst e] b.snd.fst,
                     a.snd.snd ≈[congrArg D.snd (applyInnerEquiv D a b e h)] b.snd.snd) :=
sorry

--def applyInnerEquiv' (a b : SigmaInstance D) (cF : IsoCriterion D.fst) (e : a.fst ≃ b.fst)
--                     (h : (cF (innerPair D a) (innerPair D b)).I e) :
--  innerPair D a ≃ innerPair D b :=
--sorry
--
--theorem iso' (a b : SigmaInstance D) (cF : IsoCriterion D.fst) (cG : IsoCriterion (innerPairDependency D)) :
--  HasIso a b (λ e => ∃ h : (cF (innerPair D a) (innerPair D b)).I e,
--                     (cG (outerPair D a) (outerPair D b)).I (applyInnerEquiv' D a b cF e h)) :=
--sorry
--
--def isoCriterion (cF : IsoCriterion D.fst) (cG : IsoCriterion (innerPairDependency D)) :
--  IsoCriterion (nestedSigmaDependency D) :=
--λ a b => ⟨iso' D a b cF cG⟩

end SigmaInstance

end SigmaInstanceDef

-- TODO: Also define building blocks for everything we need in order to formalize categories and
-- groupoids, and then define isomorphism for the `HasStructure` type class. This gives us an interesting
-- and probably quite powerful reflection principle.
--
-- Maybe it will lead to a proof of something like univalence in the internal logic. Or rather: We can
-- construct an internal logic where "isomorphism is equality" holds.

end BuildingBlocks

open BuildingBlocks


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import ring_theory.adjoin.basic
import data.polynomial.eval

/-!
# Theory of univariate polynomials

We show that `polynomial A` is an R-algebra when `A` is an R-algebra.
We promote `eval₂` to an algebra hom in `aeval`.
-/

noncomputable theory
open finset
open_locale big_operators polynomial

namespace polynomial
universes u v w z
variables {R : Type u} {S : Type v} {T : Type w} {A : Type z} {A' B' : Type*} {a b : R} {n : ℕ}
variables [comm_semiring A'] [comm_semiring B']

section comm_semiring
variables [comm_semiring R] {p q r : R[X]}

variables [semiring A] [algebra R A]

/-- Note that this instance also provides `algebra R R[X]`. -/
instance algebra_of_algebra : algebra R (polynomial A) :=
{ smul_def' := λ r p, to_finsupp_injective $ begin
    dsimp only [ring_hom.to_fun_eq_coe, ring_hom.comp_apply],
    rw [to_finsupp_smul, to_finsupp_mul, to_finsupp_C],
    exact algebra.smul_def' _ _,
  end,
  commutes' := λ r p, to_finsupp_injective $ begin
    dsimp only [ring_hom.to_fun_eq_coe, ring_hom.comp_apply],
    simp_rw [to_finsupp_mul, to_finsupp_C],
    convert algebra.commutes' r p.to_finsupp,
  end,
  to_ring_hom := C.comp (algebra_map R A) }

lemma algebra_map_apply (r : R) :
  algebra_map R (polynomial A) r = C (algebra_map R A r) :=
rfl

@[simp] lemma to_finsupp_algebra_map (r : R) :
  (algebra_map R (polynomial A) r).to_finsupp = algebra_map R _ r :=
show to_finsupp (C (algebra_map _ _ r)) = _, by { rw to_finsupp_C, refl }

lemma of_finsupp_algebra_map (r : R) :
  (⟨algebra_map R _ r⟩ : A[X]) = algebra_map R (polynomial A) r :=
to_finsupp_injective (to_finsupp_algebra_map _).symm

/--
When we have `[comm_ring R]`, the function `C` is the same as `algebra_map R R[X]`.

(But note that `C` is defined when `R` is not necessarily commutative, in which case
`algebra_map` is not available.)
-/
lemma C_eq_algebra_map (r : R) :
  C r = algebra_map R R[X] r :=
rfl

variables {R}

/--
  Extensionality lemma for algebra maps out of `polynomial A'` over a smaller base ring than `A'`
-/
@[ext] lemma alg_hom_ext' [algebra R A'] [algebra R B']
  {f g : A'[X] →ₐ[R] B'}
  (h₁ : f.comp (is_scalar_tower.to_alg_hom R A' (polynomial A')) =
        g.comp (is_scalar_tower.to_alg_hom R A' (polynomial A')))
  (h₂ : f X = g X) : f = g :=
alg_hom.coe_ring_hom_injective (polynomial.ring_hom_ext'
  (congr_arg alg_hom.to_ring_hom h₁) h₂)

variable (R)

/-- Algebra isomorphism between `polynomial R` and `add_monoid_algebra R ℕ`. This is just an
implementation detail, but it can be useful to transfer results from `finsupp` to polynomials. -/
@[simps]
def to_finsupp_iso_alg : R[X] ≃ₐ[R] add_monoid_algebra R ℕ :=
{ commutes' := λ r,
  begin
    dsimp,
    exact to_finsupp_algebra_map _,
  end,
  ..to_finsupp_iso R }

variable {R}

instance [nontrivial A] : nontrivial (subalgebra R (polynomial A)) :=
⟨⟨⊥, ⊤, begin
  rw [ne.def, set_like.ext_iff, not_forall],
  refine ⟨X, _⟩,
  simp only [algebra.mem_bot, not_exists, set.mem_range, iff_true, algebra.mem_top,
    algebra_map_apply, not_forall],
  intro x,
  rw [ext_iff, not_forall],
  refine ⟨1, _⟩,
  simp [coeff_C],
end⟩⟩

@[simp]
lemma alg_hom_eval₂_algebra_map
  {R A B : Type*} [comm_ring R] [ring A] [ring B] [algebra R A] [algebra R B]
  (p : R[X]) (f : A →ₐ[R] B) (a : A) :
  f (eval₂ (algebra_map R A) a p) = eval₂ (algebra_map R B) (f a) p :=
begin
  dsimp [eval₂, sum],
  simp only [f.map_sum, f.map_mul, f.map_pow, ring_hom.eq_int_cast, ring_hom.map_int_cast,
    alg_hom.commutes],
end

@[simp]
lemma eval₂_algebra_map_X {R A : Type*} [comm_ring R] [ring A] [algebra R A]
  (p : R[X]) (f : R[X] →ₐ[R] A) :
  eval₂ (algebra_map R A) (f X) p = f p :=
begin
  conv_rhs { rw [←polynomial.sum_C_mul_X_eq p], },
  dsimp [eval₂, sum],
  simp only [f.map_sum, f.map_mul, f.map_pow, ring_hom.eq_int_cast, ring_hom.map_int_cast],
  simp [polynomial.C_eq_algebra_map],
end

-- these used to be about `algebra_map ℤ R`, but now the simp-normal form is `int.cast_ring_hom R`.
@[simp]
lemma ring_hom_eval₂_cast_int_ring_hom {R S : Type*} [ring R] [ring S]
  (p : ℤ[X]) (f : R →+* S) (r : R) :
  f (eval₂ (int.cast_ring_hom R) r p) = eval₂ (int.cast_ring_hom S) (f r) p :=
alg_hom_eval₂_algebra_map p f.to_int_alg_hom r

@[simp]
lemma eval₂_int_cast_ring_hom_X {R : Type*} [ring R] (p : ℤ[X]) (f : ℤ[X] →+* R) :
  eval₂ (int.cast_ring_hom R) (f X) p = f p :=
eval₂_algebra_map_X p f.to_int_alg_hom

end comm_semiring

section aeval
variables [comm_semiring R] {p q : R[X]}

variables [semiring A] [algebra R A]
variables {B : Type*} [semiring B] [algebra R B]
variables (x : A)

/-- Given a valuation `x` of the variable in an `R`-algebra `A`, `aeval R A x` is
the unique `R`-algebra homomorphism from `R[X]` to `A` sending `X` to `x`.

This is a stronger variant of the linear map `polynomial.leval`. -/
def aeval : R[X] →ₐ[R] A :=
{ commutes' := λ r, eval₂_C _ _,
  ..eval₂_ring_hom' (algebra_map R A) x (λ a, algebra.commutes _ _) }

variables {R A}

@[simp] lemma adjoin_X : algebra.adjoin R ({X} : set R[X]) = ⊤ :=
begin
  refine top_unique (λ p hp, _),
  set S := algebra.adjoin R ({X} : set R[X]),
  rw [← sum_monomial_eq p], simp only [monomial_eq_smul_X, sum],
  exact S.sum_mem (λ n hn, S.smul_mem (S.pow_mem (algebra.subset_adjoin rfl) _) _)
end

@[ext] lemma alg_hom_ext {f g : R[X] →ₐ[R] A} (h : f X = g X) : f = g :=
alg_hom.ext_of_adjoin_eq_top adjoin_X $ λ p hp, (set.mem_singleton_iff.1 hp).symm ▸ h

theorem aeval_def (p : R[X]) : aeval x p = eval₂ (algebra_map R A) x p := rfl

@[simp] lemma aeval_zero : aeval x (0 : R[X]) = 0 :=
alg_hom.map_zero (aeval x)

@[simp] lemma aeval_X : aeval x (X : R[X]) = x := eval₂_X _ x

@[simp] lemma aeval_C (r : R) : aeval x (C r) = algebra_map R A r := eval₂_C _ x

@[simp] lemma aeval_monomial {n : ℕ} {r : R} : aeval x (monomial n r) = (algebra_map _ _ r) * x^n :=
eval₂_monomial _ _

@[simp] lemma aeval_X_pow {n : ℕ} : aeval x ((X : R[X])^n) = x^n :=
eval₂_X_pow _ _

@[simp] lemma aeval_add : aeval x (p + q) = aeval x p + aeval x q :=
alg_hom.map_add _ _ _

@[simp] lemma aeval_one : aeval x (1 : R[X]) = 1 :=
alg_hom.map_one _

@[simp] lemma aeval_bit0 : aeval x (bit0 p) = bit0 (aeval x p) :=
alg_hom.map_bit0 _ _

@[simp] lemma aeval_bit1 : aeval x (bit1 p) = bit1 (aeval x p) :=
alg_hom.map_bit1 _ _

@[simp] lemma aeval_nat_cast (n : ℕ) : aeval x (n : R[X]) = n :=
map_nat_cast _ _

lemma aeval_mul : aeval x (p * q) = aeval x p * aeval x q :=
alg_hom.map_mul _ _ _

lemma aeval_comp {A : Type*} [comm_semiring A] [algebra R A] (x : A) :
  aeval x (p.comp q) = (aeval (aeval x q) p) :=
eval₂_comp (algebra_map R A)

@[simp] lemma aeval_map {A : Type*} [comm_semiring A] [algebra R A] [algebra A B]
  [is_scalar_tower R A B] (b : B) (p : R[X]) :
  aeval b (p.map (algebra_map R A)) = aeval b p :=
by rw [aeval_def, eval₂_map, ←is_scalar_tower.algebra_map_eq, ←aeval_def]

theorem aeval_alg_hom (f : A →ₐ[R] B) (x : A) : aeval (f x) = f.comp (aeval x) :=
alg_hom_ext $ by simp only [aeval_X, alg_hom.comp_apply]

@[simp] theorem aeval_X_left : aeval (X : R[X]) = alg_hom.id R R[X] :=
alg_hom_ext $ aeval_X X

theorem eval_unique (φ : R[X] →ₐ[R] A) (p) :
  φ p = eval₂ (algebra_map R A) (φ X) p :=
by rw [← aeval_def, aeval_alg_hom, aeval_X_left, alg_hom.comp_id]

theorem aeval_alg_equiv (f : A ≃ₐ[R] B) (x : A) : aeval (f x) = (f : A →ₐ[R] B).comp (aeval x) :=
aeval_alg_hom (f : A →ₐ[R] B) x

theorem aeval_alg_equiv_apply (f : A ≃ₐ[R] B) (x : A) (p : R[X]) :
  aeval (f x) p = f (aeval x p) :=
aeval_alg_hom_apply (f : A →ₐ[R] B) x p

lemma aeval_algebra_map_apply (x : R) (p : R[X]) :
  aeval (algebra_map R A x) p = algebra_map R A (p.eval x) :=
aeval_alg_hom_apply (algebra.of_id R A) x p

@[simp] lemma coe_aeval_eq_eval (r : R) :
  (aeval r : R[X] → R) = eval r := rfl

@[simp] lemma aeval_fn_apply {X : Type*} (g : R[X]) (f : X → R) (x : X) :
  ((aeval f) g) x = aeval (f x) g :=
(aeval_alg_hom_apply (pi.eval_alg_hom _ _ x) f g).symm

@[norm_cast] lemma aeval_subalgebra_coe
  (g : R[X]) {A : Type*} [semiring A] [algebra R A] (s : subalgebra R A) (f : s) :
  (aeval f g : A) = aeval (f : A) g :=
(aeval_alg_hom_apply s.val f g).symm

lemma coeff_zero_eq_aeval_zero (p : R[X]) : p.coeff 0 = aeval 0 p :=
by simp [coeff_zero_eq_eval_zero]

lemma coeff_zero_eq_aeval_zero' (p : R[X]) :
  algebra_map R A (p.coeff 0) = aeval (0 : A) p :=
by simp [aeval_def]

variable (R)

theorem _root_.algebra.adjoin_singleton_eq_range_aeval (x : A) :
  algebra.adjoin R {x} = (polynomial.aeval x).range :=
by rw [← algebra.map_top, ← adjoin_X, alg_hom.map_adjoin, set.image_singleton, aeval_X]

variable {R}

section comm_semiring

variables [comm_semiring S] {f : R →+* S}

lemma aeval_eq_sum_range [algebra R S] {p : R[X]} (x : S) :
  aeval x p = ∑ i in finset.range (p.nat_degree + 1), p.coeff i • x ^ i :=
by { simp_rw algebra.smul_def, exact eval₂_eq_sum_range (algebra_map R S) x }

lemma aeval_eq_sum_range' [algebra R S] {p : R[X]} {n : ℕ} (hn : p.nat_degree < n) (x : S) :
  aeval x p = ∑ i in finset.range n, p.coeff i • x ^ i :=
by { simp_rw algebra.smul_def, exact eval₂_eq_sum_range' (algebra_map R S) hn x }

lemma aeval_sum {ι : Type*} [algebra R S] (s : finset ι) (f : ι → R[X])
  (g : S) : aeval g (∑ i in s, f i) = ∑ i in s, aeval g (f i) :=
(polynomial.aeval g : R[X] →ₐ[_] _).map_sum f s

@[to_additive]
lemma aeval_prod {ι : Type*} [algebra R S] (s : finset ι)
  (f : ι → R[X]) (g : S) : aeval g (∏ i in s, f i) = ∏ i in s, aeval g (f i) :=
(polynomial.aeval g : R[X] →ₐ[_] _).map_prod f s

lemma is_root_of_eval₂_map_eq_zero
  (hf : function.injective f) {r : R} : eval₂ f (f r) p = 0 → p.is_root r :=
begin
  intro h,
  apply hf,
  rw [←eval₂_hom, h, f.map_zero],
end

lemma is_root_of_aeval_algebra_map_eq_zero [algebra R S] {p : R[X]}
  (inj : function.injective (algebra_map R S))
  {r : R} (hr : aeval (algebra_map R S r) p = 0) : p.is_root r :=
is_root_of_eval₂_map_eq_zero inj hr

section aeval_tower

variables [algebra S R] [algebra S A'] [algebra S B']

/-- Version of `aeval` for defining algebra homs out of `polynomial R` over a smaller base ring
  than `R`. -/
def aeval_tower (f : R →ₐ[S] A') (x : A') : R[X] →ₐ[S] A' :=
{ commutes' := λ r, by simp [algebra_map_apply],
  ..eval₂_ring_hom ↑f x }

variables (g : R →ₐ[S] A') (y : A')

@[simp] lemma aeval_tower_X : aeval_tower g y X = y := eval₂_X _ _

@[simp] lemma aeval_tower_C (x : R) : aeval_tower g y (C x) = g x := eval₂_C _ _

@[simp] lemma aeval_tower_comp_C : ((aeval_tower g y : R[X] →+* A').comp C) = g :=
ring_hom.ext $ aeval_tower_C _ _

@[simp] lemma aeval_tower_algebra_map (x : R) :
  aeval_tower g y (algebra_map R R[X] x) = g x := eval₂_C _ _

@[simp] lemma aeval_tower_comp_algebra_map :
  (aeval_tower g y : R[X] →+* A').comp (algebra_map R R[X]) = g :=
aeval_tower_comp_C _ _

lemma aeval_tower_to_alg_hom (x : R) :
  aeval_tower g y (is_scalar_tower.to_alg_hom S R R[X] x) = g x :=
aeval_tower_algebra_map _ _ _

@[simp] lemma aeval_tower_comp_to_alg_hom :
  (aeval_tower g y).comp (is_scalar_tower.to_alg_hom S R R[X]) = g :=
alg_hom.coe_ring_hom_injective $ aeval_tower_comp_algebra_map _ _

@[simp] lemma aeval_tower_id : aeval_tower (alg_hom.id S S) = aeval :=
by { ext, simp only [eval_X, aeval_tower_X, coe_aeval_eq_eval], }

@[simp] lemma aeval_tower_of_id : aeval_tower (algebra.of_id S A') = aeval :=
by { ext, simp only [aeval_X, aeval_tower_X], }

end aeval_tower

end comm_semiring

section comm_ring

variables [comm_ring S] {f : R →+* S}

lemma dvd_term_of_dvd_eval_of_dvd_terms {z p : S} {f : S[X]} (i : ℕ)
  (dvd_eval : p ∣ f.eval z) (dvd_terms : ∀ (j ≠ i), p ∣ f.coeff j * z ^ j) :
  p ∣ f.coeff i * z ^ i :=
begin
  by_cases hi : i ∈ f.support,
  { rw [eval, eval₂, sum] at dvd_eval,
    rw [←finset.insert_erase hi, finset.sum_insert (finset.not_mem_erase _ _)] at dvd_eval,
    refine (dvd_add_left _).mp dvd_eval,
    apply finset.dvd_sum,
    intros j hj,
    exact dvd_terms j (finset.ne_of_mem_erase hj) },
  { convert dvd_zero p,
    rw not_mem_support_iff at hi,
    simp [hi] }
end

lemma dvd_term_of_is_root_of_dvd_terms {r p : S} {f : S[X]} (i : ℕ)
  (hr : f.is_root r) (h : ∀ (j ≠ i), p ∣ f.coeff j * r ^ j) : p ∣ f.coeff i * r ^ i :=
dvd_term_of_dvd_eval_of_dvd_terms i (eq.symm hr ▸ dvd_zero p) h

end comm_ring

end aeval

section ring
variables [ring R]

/--
The evaluation map is not generally multiplicative when the coefficient ring is noncommutative,
but nevertheless any polynomial of the form `p * (X - monomial 0 r)` is sent to zero
when evaluated at `r`.

This is the key step in our proof of the Cayley-Hamilton theorem.
-/
lemma eval_mul_X_sub_C {p : R[X]} (r : R) :
  (p * (X - C r)).eval r = 0 :=
begin
  simp only [eval, eval₂, ring_hom.id_apply],
  have bound := calc
    (p * (X - C r)).nat_degree
         ≤ p.nat_degree + (X - C r).nat_degree : nat_degree_mul_le
     ... ≤ p.nat_degree + 1 : add_le_add_left nat_degree_X_sub_C_le _
     ... < p.nat_degree + 2 : lt_add_one _,
  rw sum_over_range' _ _ (p.nat_degree + 2) bound,
  swap,
  { simp, },
  rw sum_range_succ',
  conv_lhs
  { congr, apply_congr, skip,
    rw [coeff_mul_X_sub_C, sub_mul, mul_assoc, ←pow_succ], },
  simp [sum_range_sub', coeff_monomial],
end

theorem not_is_unit_X_sub_C [nontrivial R] (r : R) : ¬ is_unit (X - C r) :=
λ ⟨⟨_, g, hfg, hgf⟩, rfl⟩, @zero_ne_one R _ _ $ by erw [← eval_mul_X_sub_C, hgf, eval_one]

end ring

lemma aeval_endomorphism {M : Type*}
  [comm_ring R] [add_comm_group M] [module R M]
  (f : M →ₗ[R] M) (v : M) (p : R[X]) :
  aeval f p v = p.sum (λ n b, b • (f ^ n) v) :=
begin
  rw [aeval_def, eval₂],
  exact (linear_map.applyₗ v).map_sum,
end

end polynomial


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

! This file was ported from Lean 3 source module algebra.category.Group.filtered_colimits
! leanprover-community/mathlib commit c43486ecf2a5a17479a32ce09e4818924145e90e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Category.Group.Basic
import Mathbin.Algebra.Category.Mon.FilteredColimits

/-!
# The forgetful functor from (commutative) (additive) groups preserves filtered colimits.

Forgetful functors from algebraic categories usually don't preserve colimits. However, they tend
to preserve _filtered_ colimits.

In this file, we start with a small filtered category `J` and a functor `F : J ⥤ Group`.
We show that the colimit of `F ⋙ forget₂ Group Mon` (in `Mon`) carries the structure of a group,
thereby showing that the forgetful functor `forget₂ Group Mon` preserves filtered colimits. In
particular, this implies that `forget Group` preserves filtered colimits. Similarly for `AddGroup`,
`CommGroup` and `AddCommGroup`.

-/

universe v u

noncomputable section

open Classical

open CategoryTheory

open CategoryTheory.Limits

open CategoryTheory.IsFiltered renaming max → max'

-- avoid name collision with `_root_.max`.
namespace GroupCat.FilteredColimits

section

open MonCat.FilteredColimits (colimit_one_eq colimit_mul_mk_eq)

-- We use parameters here, mainly so we can have the abbreviations `G` and `G.mk` below, without
-- passing around `F` all the time.
parameter {J : Type v}[SmallCategory J][IsFiltered J](F : J ⥤ GroupCat.{max v u})

/-- The colimit of `F ⋙ forget₂ Group Mon` in the category `Mon`.
In the following, we will show that this has the structure of a group.
-/
@[to_additive
      "The colimit of `F ⋙ forget₂ AddGroup AddMon` in the category `AddMon`.\nIn the following, we will show that this has the structure of an additive group."]
abbrev g : MonCat :=
  MonCat.FilteredColimits.colimit (F ⋙ forget₂ GroupCat MonCat.{max v u})
#align Group.filtered_colimits.G GroupCat.FilteredColimits.g
#align AddGroup.filtered_colimits.G AddGroupCat.FilteredColimits.g

/-- The canonical projection into the colimit, as a quotient type. -/
@[to_additive "The canonical projection into the colimit, as a quotient type."]
abbrev g.mk : (Σj, F.obj j) → G :=
  Quot.mk (Types.Quot.Rel (F ⋙ forget GroupCat))
#align Group.filtered_colimits.G.mk GroupCat.FilteredColimits.g.mk
#align AddGroup.filtered_colimits.G.mk AddGroupCat.FilteredColimits.g.mk

@[to_additive]
theorem g.mk_eq (x y : Σj, F.obj j)
    (h : ∃ (k : J)(f : x.1 ⟶ k)(g : y.1 ⟶ k), F.map f x.2 = F.map g y.2) : G.mk x = G.mk y :=
  Quot.EqvGen_sound (Types.FilteredColimit.eqvGen_quot_rel_of_rel (F ⋙ forget GroupCat) x y h)
#align Group.filtered_colimits.G.mk_eq GroupCat.FilteredColimits.g.mk_eq
#align AddGroup.filtered_colimits.G.mk_eq AddGroupCat.FilteredColimits.g.mk_eq

/-- The "unlifted" version of taking inverses in the colimit. -/
@[to_additive "The \"unlifted\" version of negation in the colimit."]
def colimitInvAux (x : Σj, F.obj j) : G :=
  G.mk ⟨x.1, x.2⁻¹⟩
#align Group.filtered_colimits.colimit_inv_aux GroupCat.FilteredColimits.colimitInvAux
#align AddGroup.filtered_colimits.colimit_neg_aux AddGroupCat.FilteredColimits.colimitNegAux

@[to_additive]
theorem colimitInvAux_eq_of_rel (x y : Σj, F.obj j)
    (h : Types.FilteredColimit.Rel (F ⋙ forget GroupCat) x y) :
    colimit_inv_aux x = colimit_inv_aux y :=
  by
  apply G.mk_eq
  obtain ⟨k, f, g, hfg⟩ := h
  use k, f, g
  rw [MonoidHom.map_inv, MonoidHom.map_inv, inv_inj]
  exact hfg
#align Group.filtered_colimits.colimit_inv_aux_eq_of_rel GroupCat.FilteredColimits.colimitInvAux_eq_of_rel
#align AddGroup.filtered_colimits.colimit_neg_aux_eq_of_rel AddGroupCat.FilteredColimits.colimit_neg_aux_eq_of_rel

/-- Taking inverses in the colimit. See also `colimit_inv_aux`. -/
@[to_additive "Negation in the colimit. See also `colimit_neg_aux`."]
instance colimitHasInv : Inv G
    where inv x := by
    refine' Quot.lift (colimit_inv_aux F) _ x
    intro x y h
    apply colimit_inv_aux_eq_of_rel
    apply types.filtered_colimit.rel_of_quot_rel
    exact h
#align Group.filtered_colimits.colimit_has_inv GroupCat.FilteredColimits.colimitHasInv
#align AddGroup.filtered_colimits.colimit_has_neg AddGroupCat.FilteredColimits.colimitHasNeg

@[simp, to_additive]
theorem colimit_inv_mk_eq (x : Σj, F.obj j) : (G.mk x)⁻¹ = G.mk ⟨x.1, x.2⁻¹⟩ :=
  rfl
#align Group.filtered_colimits.colimit_inv_mk_eq GroupCat.FilteredColimits.colimit_inv_mk_eq
#align AddGroup.filtered_colimits.colimit_neg_mk_eq AddGroupCat.FilteredColimits.colimit_neg_mk_eq

@[to_additive]
instance colimitGroup : Group G :=
  { G.Monoid, colimit_has_inv with
    mul_left_inv := fun x => by
      apply Quot.inductionOn x; clear x; intro x
      cases' x with j x
      erw [colimit_inv_mk_eq,
        colimit_mul_mk_eq (F ⋙ forget₂ GroupCat MonCat.{max v u}) ⟨j, _⟩ ⟨j, _⟩ j (𝟙 j) (𝟙 j),
        colimit_one_eq (F ⋙ forget₂ GroupCat MonCat.{max v u}) j]
      dsimp
      simp only [CategoryTheory.Functor.map_id, id_apply, mul_left_inv] }
#align Group.filtered_colimits.colimit_group GroupCat.FilteredColimits.colimitGroup
#align AddGroup.filtered_colimits.colimit_add_group AddGroupCat.FilteredColimits.colimitAddGroup

/-- The bundled group giving the filtered colimit of a diagram. -/
@[to_additive "The bundled additive group giving the filtered colimit of a diagram."]
def colimit : GroupCat :=
  GroupCat.of G
#align Group.filtered_colimits.colimit GroupCat.FilteredColimits.colimit
#align AddGroup.filtered_colimits.colimit AddGroupCat.FilteredColimits.colimit

/-- The cocone over the proposed colimit group. -/
@[to_additive "The cocone over the proposed colimit additive group."]
def colimitCocone : cocone F where
  pt := colimit
  ι := { (MonCat.FilteredColimits.colimitCocone (F ⋙ forget₂ GroupCat MonCat.{max v u})).ι with }
#align Group.filtered_colimits.colimit_cocone GroupCat.FilteredColimits.colimitCocone
#align AddGroup.filtered_colimits.colimit_cocone AddGroupCat.FilteredColimits.colimitCocone

/-- The proposed colimit cocone is a colimit in `Group`. -/
@[to_additive "The proposed colimit cocone is a colimit in `AddGroup`."]
def colimitCoconeIsColimit : IsColimit colimit_cocone
    where
  desc t :=
    MonCat.FilteredColimits.colimitDesc (F ⋙ forget₂ GroupCat MonCat.{max v u})
      ((forget₂ GroupCat MonCat).mapCocone t)
  fac t j :=
    MonoidHom.coe_inj <|
      (Types.colimitCoconeIsColimit (F ⋙ forget GroupCat)).fac ((forget GroupCat).mapCocone t) j
  uniq t m h :=
    MonoidHom.coe_inj <|
      (Types.colimitCoconeIsColimit (F ⋙ forget GroupCat)).uniq ((forget GroupCat).mapCocone t) m
        fun j => funext fun x => MonoidHom.congr_fun (h j) x
#align Group.filtered_colimits.colimit_cocone_is_colimit GroupCat.FilteredColimits.colimitCoconeIsColimit
#align AddGroup.filtered_colimits.colimit_cocone_is_colimit AddGroupCat.FilteredColimits.colimitCoconeIsColimit

@[to_additive forget₂_AddMon_preserves_filtered_colimits]
instance forget₂MonPreservesFilteredColimits :
    PreservesFilteredColimits (forget₂ GroupCat MonCat.{u})
    where PreservesFilteredColimits J _ _ :=
    {
      PreservesColimit := fun F =>
        preserves_colimit_of_preserves_colimit_cocone (colimitCoconeIsColimit.{u, u} F)
          (MonCat.FilteredColimits.colimitCoconeIsColimit (F ⋙ forget₂ GroupCat MonCat.{u})) }
#align Group.filtered_colimits.forget₂_Mon_preserves_filtered_colimits GroupCat.FilteredColimits.forget₂MonPreservesFilteredColimits
#align AddGroup.filtered_colimits.forget₂_AddMon_preserves_filtered_colimits AddGroupCat.FilteredColimits.forget₂AddMonPreservesFilteredColimits

@[to_additive]
instance forgetPreservesFilteredColimits : PreservesFilteredColimits (forget GroupCat.{u}) :=
  Limits.compPreservesFilteredColimits (forget₂ GroupCat MonCat) (forget MonCat.{u})
#align Group.filtered_colimits.forget_preserves_filtered_colimits GroupCat.FilteredColimits.forgetPreservesFilteredColimits
#align AddGroup.filtered_colimits.forget_preserves_filtered_colimits AddGroupCat.FilteredColimits.forgetPreservesFilteredColimits

end

end GroupCat.FilteredColimits

namespace CommGroupCat.FilteredColimits

section

-- We use parameters here, mainly so we can have the abbreviation `G` below, without
-- passing around `F` all the time.
parameter {J : Type v}[SmallCategory J][IsFiltered J](F : J ⥤ CommGroupCat.{max v u})

/-- The colimit of `F ⋙ forget₂ CommGroup Group` in the category `Group`.
In the following, we will show that this has the structure of a _commutative_ group.
-/
@[to_additive
      "The colimit of `F ⋙ forget₂ AddCommGroup AddGroup` in the category `AddGroup`.\nIn the following, we will show that this has the structure of a _commutative_ additive group."]
abbrev g : GroupCat :=
  GroupCat.FilteredColimits.colimit (F ⋙ forget₂ CommGroupCat GroupCat.{max v u})
#align CommGroup.filtered_colimits.G CommGroupCat.FilteredColimits.g
#align AddCommGroup.filtered_colimits.G AddCommGroupCat.FilteredColimits.g

@[to_additive]
instance colimitCommGroup : CommGroup G :=
  { G.Group,
    CommMonCat.FilteredColimits.colimitCommMonoid
      (F ⋙ forget₂ CommGroupCat CommMonCat.{max v u}) with }
#align CommGroup.filtered_colimits.colimit_comm_group CommGroupCat.FilteredColimits.colimitCommGroup
#align AddCommGroup.filtered_colimits.colimit_add_comm_group AddCommGroupCat.FilteredColimits.colimitAddCommGroup

/-- The bundled commutative group giving the filtered colimit of a diagram. -/
@[to_additive "The bundled additive commutative group giving the filtered colimit of a diagram."]
def colimit : CommGroupCat :=
  CommGroupCat.of G
#align CommGroup.filtered_colimits.colimit CommGroupCat.FilteredColimits.colimit
#align AddCommGroup.filtered_colimits.colimit AddCommGroupCat.FilteredColimits.colimit

/-- The cocone over the proposed colimit commutative group. -/
@[to_additive "The cocone over the proposed colimit additive commutative group."]
def colimitCocone : cocone F where
  pt := colimit
  ι :=
    {
      (GroupCat.FilteredColimits.colimitCocone
          (F ⋙ forget₂ CommGroupCat GroupCat.{max v u})).ι with }
#align CommGroup.filtered_colimits.colimit_cocone CommGroupCat.FilteredColimits.colimitCocone
#align AddCommGroup.filtered_colimits.colimit_cocone AddCommGroupCat.FilteredColimits.colimitCocone

/-- The proposed colimit cocone is a colimit in `CommGroup`. -/
@[to_additive "The proposed colimit cocone is a colimit in `AddCommGroup`."]
def colimitCoconeIsColimit : IsColimit colimit_cocone
    where
  desc t :=
    (GroupCat.FilteredColimits.colimitCoconeIsColimit
          (F ⋙ forget₂ CommGroupCat GroupCat.{max v u})).desc
      ((forget₂ CommGroupCat GroupCat.{max v u}).mapCocone t)
  fac t j :=
    MonoidHom.coe_inj <|
      (Types.colimitCoconeIsColimit (F ⋙ forget CommGroupCat)).fac
        ((forget CommGroupCat).mapCocone t) j
  uniq t m h :=
    MonoidHom.coe_inj <|
      (Types.colimitCoconeIsColimit (F ⋙ forget CommGroupCat)).uniq
        ((forget CommGroupCat).mapCocone t) m fun j => funext fun x => MonoidHom.congr_fun (h j) x
#align CommGroup.filtered_colimits.colimit_cocone_is_colimit CommGroupCat.FilteredColimits.colimitCoconeIsColimit
#align AddCommGroup.filtered_colimits.colimit_cocone_is_colimit AddCommGroupCat.FilteredColimits.colimitCoconeIsColimit

@[to_additive forget₂_AddGroup_preserves_filtered_colimits]
instance forget₂GroupPreservesFilteredColimits :
    PreservesFilteredColimits (forget₂ CommGroupCat GroupCat.{u})
    where PreservesFilteredColimits J _ _ :=
    {
      PreservesColimit := fun F =>
        preserves_colimit_of_preserves_colimit_cocone (colimitCoconeIsColimit.{u, u} F)
          (GroupCat.FilteredColimits.colimitCoconeIsColimit
            (F ⋙ forget₂ CommGroupCat GroupCat.{u})) }
#align CommGroup.filtered_colimits.forget₂_Group_preserves_filtered_colimits CommGroupCat.FilteredColimits.forget₂GroupPreservesFilteredColimits
#align AddCommGroup.filtered_colimits.forget₂_AddGroup_preserves_filtered_colimits AddCommGroupCat.FilteredColimits.forget₂AddGroupPreservesFilteredColimits

@[to_additive]
instance forgetPreservesFilteredColimits : PreservesFilteredColimits (forget CommGroupCat.{u}) :=
  Limits.compPreservesFilteredColimits (forget₂ CommGroupCat GroupCat) (forget GroupCat.{u})
#align CommGroup.filtered_colimits.forget_preserves_filtered_colimits CommGroupCat.FilteredColimits.forgetPreservesFilteredColimits
#align AddCommGroup.filtered_colimits.forget_preserves_filtered_colimits AddCommGroupCat.FilteredColimits.forgetPreservesFilteredColimits

end

end CommGroupCat.FilteredColimits