/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.sqrt
import Mathlib.field_theory.tower
import Mathlib.analysis.normed_space.finite_dimension
import Mathlib.PostPort

universes u_1 l u_2 u_3

namespace Mathlib

/-!
# `is_R_or_C`: a typeclass for ℝ or ℂ

This file defines the typeclass `is_R_or_C` intended to have only two instances:
ℝ and ℂ. It is meant for definitions and theorems which hold for both the real and the complex case,
and in particular when the real case follows directly from the complex case by setting `re` to `id`,
`im` to zero and so on. Its API follows closely that of ℂ.

Possible applications include defining inner products and Hilbert spaces for both the real and
complex case. One would produce the definitions and proof for an arbitrary field of this
typeclass, which basically amounts to doing the complex case, and the two cases then fall out
immediately from the two instances of the class.

The instance for `ℝ` is registered in this file.
The instance for `ℂ` is declared in `analysis.complex.basic`.

## Implementation notes

The coercion from reals into an `is_R_or_C` field is done by registering `algebra_map ℝ K` as
a `has_coe_t`. For this to work, we must proceed carefully to avoid problems involving circular
coercions in the case `K=ℝ`; in particular, we cannot use the plain `has_coe` and must set
priorities carefully. This problem was already solved for `ℕ`, and we copy the solution detailed
in `data/nat/cast`. See also Note [coercion into rings] for more details.

In addition, several lemmas need to be set at priority 900 to make sure that they do not override
their counterparts in `complex.lean` (which causes linter errors).
-/

/--
This typeclass captures properties shared by ℝ and ℂ, with an API that closely matches that of ℂ.
-/
class is_R_or_C (K : Type u_1)
extends nondiscrete_normed_field K, normed_algebra ℝ K, complete_space K
where
  re : K →+ ℝ
  im : K →+ ℝ
  conj : K →+* K
  I : K
  I_re_ax : coe_fn re I = 0
  I_mul_I_ax : I = 0 ∨ I * I = -1
  re_add_im_ax : ∀ (z : K), coe_fn (algebra_map ℝ K) (coe_fn re z) + coe_fn (algebra_map ℝ K) (coe_fn im z) * I = z
  of_real_re_ax : ∀ (r : ℝ), coe_fn re (coe_fn (algebra_map ℝ K) r) = r
  of_real_im_ax : ∀ (r : ℝ), coe_fn im (coe_fn (algebra_map ℝ K) r) = 0
  mul_re_ax : ∀ (z w : K), coe_fn re (z * w) = coe_fn re z * coe_fn re w - coe_fn im z * coe_fn im w
  mul_im_ax : ∀ (z w : K), coe_fn im (z * w) = coe_fn re z * coe_fn im w + coe_fn im z * coe_fn re w
  conj_re_ax : ∀ (z : K), coe_fn re (coe_fn conj z) = coe_fn re z
  conj_im_ax : ∀ (z : K), coe_fn im (coe_fn conj z) = -coe_fn im z
  conj_I_ax : coe_fn conj I = -I
  norm_sq_eq_def_ax : ∀ (z : K), norm z ^ bit0 1 = coe_fn re z * coe_fn re z + coe_fn im z * coe_fn im z
  mul_im_I_ax : ∀ (z : K), coe_fn im z * coe_fn im I = coe_fn im z
  inv_def_ax : ∀ (z : K), z⁻¹ = coe_fn conj z * coe_fn (algebra_map ℝ K) (norm z ^ bit0 1⁻¹)
  div_I_ax : ∀ (z : K), z / I = -(z * I)

namespace is_R_or_C

/- The priority must be set at 900 to ensure that coercions are tried in the right order.
See Note [coercion into rings], or `data/nat/cast.lean` for more details. -/

protected instance algebra_map_coe {K : Type u_1} [is_R_or_C K] : has_coe_t ℝ K :=
  has_coe_t.mk ⇑(algebra_map ℝ K)

theorem of_real_alg {K : Type u_1} [is_R_or_C K] (x : ℝ) : ↑x = x • 1 :=
  algebra.algebra_map_eq_smul_one x

theorem algebra_map_eq_of_real {K : Type u_1} [is_R_or_C K] : ⇑(algebra_map ℝ K) = coe :=
  rfl

@[simp] theorem re_add_im {K : Type u_1} [is_R_or_C K] (z : K) : ↑(coe_fn re z) + ↑(coe_fn im z) * I = z :=
  re_add_im_ax z

@[simp] theorem of_real_re {K : Type u_1} [is_R_or_C K] (r : ℝ) : coe_fn re ↑r = r :=
  of_real_re_ax

@[simp] theorem of_real_im {K : Type u_1} [is_R_or_C K] (r : ℝ) : coe_fn im ↑r = 0 :=
  of_real_im_ax

@[simp] theorem mul_re {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : coe_fn re (z * w) = coe_fn re z * coe_fn re w - coe_fn im z * coe_fn im w :=
  mul_re_ax

@[simp] theorem mul_im {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : coe_fn im (z * w) = coe_fn re z * coe_fn im w + coe_fn im z * coe_fn re w :=
  mul_im_ax

theorem inv_def {K : Type u_1} [is_R_or_C K] (z : K) : z⁻¹ = coe_fn conj z * ↑(norm z ^ bit0 1⁻¹) :=
  inv_def_ax z

theorem ext_iff {K : Type u_1} [is_R_or_C K] {z : K} {w : K} : z = w ↔ coe_fn re z = coe_fn re w ∧ coe_fn im z = coe_fn im w := sorry

theorem ext {K : Type u_1} [is_R_or_C K] {z : K} {w : K} : coe_fn re z = coe_fn re w → coe_fn im z = coe_fn im w → z = w := sorry

@[simp] theorem of_real_zero {K : Type u_1} [is_R_or_C K] : ↑0 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑0 = 0)) (of_real_alg 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 • 1 = 0)) (zero_smul ℝ 1))) (Eq.refl 0))

@[simp] theorem zero_re' {K : Type u_1} [is_R_or_C K] : coe_fn re 0 = 0 :=
  add_monoid_hom.map_zero re

@[simp] theorem of_real_one {K : Type u_1} [is_R_or_C K] : ↑1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑1 = 1)) (of_real_alg 1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 • 1 = 1)) (one_smul ℝ 1))) (Eq.refl 1))

@[simp] theorem one_re {K : Type u_1} [is_R_or_C K] : coe_fn re 1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn re 1 = 1)) (Eq.symm of_real_one)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn re ↑1 = 1)) (of_real_re 1))) (Eq.refl 1))

@[simp] theorem one_im {K : Type u_1} [is_R_or_C K] : coe_fn im 1 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im 1 = 0)) (Eq.symm of_real_one)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im ↑1 = 0)) (of_real_im 1))) (Eq.refl 0))

@[simp] theorem of_real_inj {K : Type u_1} [is_R_or_C K] {z : ℝ} {w : ℝ} : ↑z = ↑w ↔ z = w := sorry

@[simp] theorem bit0_re {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn re (bit0 z) = bit0 (coe_fn re z) := sorry

@[simp] theorem bit1_re {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn re (bit1 z) = bit1 (coe_fn re z) := sorry

@[simp] theorem bit0_im {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn im (bit0 z) = bit0 (coe_fn im z) := sorry

@[simp] theorem bit1_im {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn im (bit1 z) = bit0 (coe_fn im z) := sorry

@[simp] theorem of_real_eq_zero {K : Type u_1} [is_R_or_C K] {z : ℝ} : ↑z = 0 ↔ z = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑z = 0 ↔ z = 0)) (Eq.symm of_real_zero))) of_real_inj

@[simp] theorem of_real_add {K : Type u_1} [is_R_or_C K] {r : ℝ} {s : ℝ} : ↑(r + s) = ↑r + ↑s := sorry

@[simp] theorem of_real_bit0 {K : Type u_1} [is_R_or_C K] (r : ℝ) : ↑(bit0 r) = bit0 ↑r := sorry

@[simp] theorem of_real_bit1 {K : Type u_1} [is_R_or_C K] (r : ℝ) : ↑(bit1 r) = bit1 ↑r := sorry

/- Note: This can be proven by `norm_num` once K is proven to be of characteristic zero below. -/

theorem two_ne_zero {K : Type u_1} [is_R_or_C K] : bit0 1 ≠ 0 := sorry

@[simp] theorem of_real_neg {K : Type u_1} [is_R_or_C K] (r : ℝ) : ↑(-r) = -↑r := sorry

@[simp] theorem of_real_mul {K : Type u_1} [is_R_or_C K] (r : ℝ) (s : ℝ) : ↑(r * s) = ↑r * ↑s := sorry

theorem of_real_mul_re {K : Type u_1} [is_R_or_C K] (r : ℝ) (z : K) : coe_fn re (↑r * z) = r * coe_fn re z := sorry

theorem smul_re {K : Type u_1} [is_R_or_C K] (r : ℝ) (z : K) : coe_fn re (↑r * z) = r * coe_fn re z := sorry

theorem smul_im {K : Type u_1} [is_R_or_C K] (r : ℝ) (z : K) : coe_fn im (↑r * z) = r * coe_fn im z := sorry

theorem smul_re' {K : Type u_1} [is_R_or_C K] (r : ℝ) (z : K) : coe_fn re (r • z) = r * coe_fn re z :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn re (r • z) = r * coe_fn re z)) (algebra.smul_def r z))) (smul_re r z)

theorem smul_im' {K : Type u_1} [is_R_or_C K] (r : ℝ) (z : K) : coe_fn im (r • z) = r * coe_fn im z :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im (r • z) = r * coe_fn im z)) (algebra.smul_def r z))) (smul_im r z)

/-- The real part in a `is_R_or_C` field, as a linear map. -/
def re_lm {K : Type u_1} [is_R_or_C K] : linear_map ℝ K ℝ :=
  linear_map.mk (add_monoid_hom.to_fun re) sorry smul_re'

@[simp] theorem re_lm_coe {K : Type u_1} [is_R_or_C K] : ⇑re_lm = ⇑re :=
  rfl

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

/-- The imaginary unit. -/
@[simp] theorem I_re {K : Type u_1} [is_R_or_C K] : coe_fn re I = 0 :=
  I_re_ax

@[simp] theorem I_im {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn im z * coe_fn im I = coe_fn im z :=
  mul_im_I_ax z

@[simp] theorem I_im' {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn im I * coe_fn im z = coe_fn im z :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im I * coe_fn im z = coe_fn im z)) (mul_comm (coe_fn im I) (coe_fn im z))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im z * coe_fn im I = coe_fn im z)) (I_im z))) (Eq.refl (coe_fn im z)))

theorem I_mul_re {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn re (I * z) = -coe_fn im z := sorry

theorem I_mul_I {K : Type u_1} [is_R_or_C K] : I = 0 ∨ I * I = -1 :=
  I_mul_I_ax

@[simp] theorem conj_re {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn re (coe_fn conj z) = coe_fn re z :=
  conj_re_ax z

@[simp] theorem conj_im {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn im (coe_fn conj z) = -coe_fn im z :=
  conj_im_ax z

@[simp] theorem conj_of_real {K : Type u_1} [is_R_or_C K] (r : ℝ) : coe_fn conj ↑r = ↑r := sorry

@[simp] theorem conj_bit0 {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn conj (bit0 z) = bit0 (coe_fn conj z) := sorry

@[simp] theorem conj_bit1 {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn conj (bit1 z) = bit1 (coe_fn conj z) := sorry

@[simp] theorem conj_neg_I {K : Type u_1} [is_R_or_C K] : coe_fn conj (-I) = I := sorry

@[simp] theorem conj_conj {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn conj (coe_fn conj z) = z := sorry

theorem conj_involutive {K : Type u_1} [is_R_or_C K] : function.involutive ⇑conj :=
  conj_conj

theorem conj_bijective {K : Type u_1} [is_R_or_C K] : function.bijective ⇑conj :=
  function.involutive.bijective conj_involutive

theorem conj_inj {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : coe_fn conj z = coe_fn conj w ↔ z = w :=
  function.injective.eq_iff (and.left conj_bijective)

theorem conj_eq_zero {K : Type u_1} [is_R_or_C K] {z : K} : coe_fn conj z = 0 ↔ z = 0 :=
  ring_hom.map_eq_zero conj

theorem eq_conj_iff_real {K : Type u_1} [is_R_or_C K] {z : K} : coe_fn conj z = z ↔ ∃ (r : ℝ), z = ↑r := sorry

/-- Conjugation as a ring equivalence. This is used to convert the inner product into a
sesquilinear product. -/
def conj_to_ring_equiv (K : Type u_1) [is_R_or_C K] : K ≃+* (Kᵒᵖ) :=
  ring_equiv.mk (opposite.op ∘ ⇑conj) (⇑conj ∘ opposite.unop) sorry sorry sorry sorry

@[simp] theorem ring_equiv_apply {K : Type u_1} [is_R_or_C K] {x : K} : opposite.unop (coe_fn (conj_to_ring_equiv K) x) = coe_fn conj x :=
  rfl

theorem eq_conj_iff_re {K : Type u_1} [is_R_or_C K] {z : K} : coe_fn conj z = z ↔ ↑(coe_fn re z) = z := sorry

/-- The norm squared function. -/
def norm_sq {K : Type u_1} [is_R_or_C K] : monoid_with_zero_hom K ℝ :=
  monoid_with_zero_hom.mk (fun (z : K) => coe_fn re z * coe_fn re z + coe_fn im z * coe_fn im z) sorry sorry sorry

theorem norm_sq_eq_def {K : Type u_1} [is_R_or_C K] {z : K} : norm z ^ bit0 1 = coe_fn re z * coe_fn re z + coe_fn im z * coe_fn im z :=
  norm_sq_eq_def_ax z

theorem norm_sq_eq_def' {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn norm_sq z = norm z ^ bit0 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn norm_sq z = norm z ^ bit0 1)) norm_sq_eq_def)) (Eq.refl (coe_fn norm_sq z))

@[simp] theorem norm_sq_of_real {K : Type u_1} [is_R_or_C K] (r : ℝ) : norm ↑r ^ bit0 1 = r * r := sorry

theorem norm_sq_zero {K : Type u_1} [is_R_or_C K] : coe_fn norm_sq 0 = 0 :=
  monoid_with_zero_hom.map_zero norm_sq

theorem norm_sq_one {K : Type u_1} [is_R_or_C K] : coe_fn norm_sq 1 = 1 :=
  monoid_with_zero_hom.map_one norm_sq

theorem norm_sq_nonneg {K : Type u_1} [is_R_or_C K] (z : K) : 0 ≤ coe_fn norm_sq z :=
  add_nonneg (mul_self_nonneg (coe_fn re z)) (mul_self_nonneg (coe_fn im z))

@[simp] theorem norm_sq_eq_zero {K : Type u_1} [is_R_or_C K] {z : K} : coe_fn norm_sq z = 0 ↔ z = 0 := sorry

@[simp] theorem norm_sq_pos {K : Type u_1} [is_R_or_C K] {z : K} : 0 < coe_fn norm_sq z ↔ z ≠ 0 := sorry

@[simp] theorem norm_sq_neg {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn norm_sq (-z) = coe_fn norm_sq z := sorry

@[simp] theorem norm_sq_conj {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn norm_sq (coe_fn conj z) = coe_fn norm_sq z := sorry

@[simp] theorem norm_sq_mul {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : coe_fn norm_sq (z * w) = coe_fn norm_sq z * coe_fn norm_sq w :=
  monoid_with_zero_hom.map_mul norm_sq z w

theorem norm_sq_add {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : coe_fn norm_sq (z + w) = coe_fn norm_sq z + coe_fn norm_sq w + bit0 1 * coe_fn re (z * coe_fn conj w) := sorry

theorem re_sq_le_norm_sq {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn re z * coe_fn re z ≤ coe_fn norm_sq z :=
  le_add_of_nonneg_right (mul_self_nonneg (coe_fn im z))

theorem im_sq_le_norm_sq {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn im z * coe_fn im z ≤ coe_fn norm_sq z :=
  le_add_of_nonneg_left (mul_self_nonneg (coe_fn re z))

theorem mul_conj {K : Type u_1} [is_R_or_C K] (z : K) : z * coe_fn conj z = ↑(coe_fn norm_sq z) := sorry

theorem add_conj {K : Type u_1} [is_R_or_C K] (z : K) : z + coe_fn conj z = bit0 1 * ↑(coe_fn re z) := sorry

/-- The pseudo-coercion `of_real` as a `ring_hom`. -/
def of_real_hom {K : Type u_1} [is_R_or_C K] : ℝ →+* K :=
  algebra_map ℝ K

/-- The coercion from reals as a `ring_hom`. -/
def coe_hom {K : Type u_1} [is_R_or_C K] : ℝ →+* K :=
  ring_hom.mk coe of_real_one of_real_mul of_real_zero of_real_add

@[simp] theorem of_real_sub {K : Type u_1} [is_R_or_C K] (r : ℝ) (s : ℝ) : ↑(r - s) = ↑r - ↑s := sorry

@[simp] theorem of_real_pow {K : Type u_1} [is_R_or_C K] (r : ℝ) (n : ℕ) : ↑(r ^ n) = ↑r ^ n := sorry

theorem sub_conj {K : Type u_1} [is_R_or_C K] (z : K) : z - coe_fn conj z = bit0 1 * ↑(coe_fn im z) * I := sorry

theorem norm_sq_sub {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : coe_fn norm_sq (z - w) = coe_fn norm_sq z + coe_fn norm_sq w - bit0 1 * coe_fn re (z * coe_fn conj w) := sorry

theorem sqrt_norm_sq_eq_norm {K : Type u_1} [is_R_or_C K] {z : K} : real.sqrt (coe_fn norm_sq z) = norm z :=
  eq.mpr (id (Eq._oldrec (Eq.refl (real.sqrt (coe_fn norm_sq z) = norm z)) (Eq.symm (real.sqrt_sqr (norm_nonneg z)))))
    (congr_arg real.sqrt (norm_sq_eq_def' z))

/-! ### Inversion -/

@[simp] theorem inv_re {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn re (z⁻¹) = coe_fn re z / coe_fn norm_sq z := sorry

@[simp] theorem inv_im {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn im (z⁻¹) = coe_fn im (-z) / coe_fn norm_sq z := sorry

@[simp] theorem of_real_inv {K : Type u_1} [is_R_or_C K] (r : ℝ) : ↑(r⁻¹) = (↑r⁻¹) := sorry

protected theorem inv_zero {K : Type u_1} [is_R_or_C K] : 0⁻¹ = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0⁻¹ = 0)) (Eq.symm of_real_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑0⁻¹ = ↑0)) (Eq.symm (of_real_inv 0))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑(0⁻¹) = ↑0)) inv_zero)) (Eq.refl ↑0)))

protected theorem mul_inv_cancel {K : Type u_1} [is_R_or_C K] {z : K} (h : z ≠ 0) : z * (z⁻¹) = 1 := sorry

theorem div_re {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : coe_fn re (z / w) = coe_fn re z * coe_fn re w / coe_fn norm_sq w + coe_fn im z * coe_fn im w / coe_fn norm_sq w := sorry

theorem div_im {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : coe_fn im (z / w) = coe_fn im z * coe_fn re w / coe_fn norm_sq w - coe_fn re z * coe_fn im w / coe_fn norm_sq w := sorry

@[simp] theorem of_real_div {K : Type u_1} [is_R_or_C K] (r : ℝ) (s : ℝ) : ↑(r / s) = ↑r / ↑s :=
  ring_hom.map_div coe_hom r s

theorem div_re_of_real {K : Type u_1} [is_R_or_C K] {z : K} {r : ℝ} : coe_fn re (z / ↑r) = coe_fn re z / r := sorry

@[simp] theorem of_real_fpow {K : Type u_1} [is_R_or_C K] (r : ℝ) (n : ℤ) : ↑(r ^ n) = ↑r ^ n :=
  ring_hom.map_fpow coe_hom r n

theorem I_mul_I_of_nonzero {K : Type u_1} [is_R_or_C K] : I ≠ 0 → I * I = -1 :=
  fun (ᾰ : I ≠ 0) =>
    or.dcases_on I_mul_I_ax (fun (this : I = 0) => absurd this ᾰ) fun (this : I * I = -1) => eq.mpr rfl this

@[simp] theorem div_I {K : Type u_1} [is_R_or_C K] (z : K) : z / I = -(z * I) := sorry

@[simp] theorem inv_I {K : Type u_1} [is_R_or_C K] : I⁻¹ = -I := sorry

@[simp] theorem norm_sq_inv {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn norm_sq (z⁻¹) = (coe_fn norm_sq z⁻¹) :=
  monoid_with_zero_hom.map_inv' norm_sq z

@[simp] theorem norm_sq_div {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : coe_fn norm_sq (z / w) = coe_fn norm_sq z / coe_fn norm_sq w :=
  monoid_with_zero_hom.map_div norm_sq z w

theorem norm_conj {K : Type u_1} [is_R_or_C K] {z : K} : norm (coe_fn conj z) = norm z := sorry

theorem conj_inv {K : Type u_1} [is_R_or_C K] {z : K} : coe_fn conj (z⁻¹) = (coe_fn conj z⁻¹) := sorry

theorem conj_div {K : Type u_1} [is_R_or_C K] {z : K} {w : K} : coe_fn conj (z / w) = coe_fn conj z / coe_fn conj w := sorry

/-! ### Cast lemmas -/

@[simp] theorem of_real_nat_cast {K : Type u_1} [is_R_or_C K] (n : ℕ) : ↑↑n = ↑n :=
  ring_hom.map_nat_cast of_real_hom n

@[simp] theorem nat_cast_re {K : Type u_1} [is_R_or_C K] (n : ℕ) : coe_fn re ↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn re ↑n = ↑n)) (Eq.symm (of_real_nat_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn re ↑↑n = ↑n)) (of_real_re ↑n))) (Eq.refl ↑n))

@[simp] theorem nat_cast_im {K : Type u_1} [is_R_or_C K] (n : ℕ) : coe_fn im ↑n = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im ↑n = 0)) (Eq.symm (of_real_nat_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im ↑↑n = 0)) (of_real_im ↑n))) (Eq.refl 0))

@[simp] theorem of_real_int_cast {K : Type u_1} [is_R_or_C K] (n : ℤ) : ↑↑n = ↑n :=
  ring_hom.map_int_cast of_real_hom n

@[simp] theorem int_cast_re {K : Type u_1} [is_R_or_C K] (n : ℤ) : coe_fn re ↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn re ↑n = ↑n)) (Eq.symm (of_real_int_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn re ↑↑n = ↑n)) (of_real_re ↑n))) (Eq.refl ↑n))

@[simp] theorem int_cast_im {K : Type u_1} [is_R_or_C K] (n : ℤ) : coe_fn im ↑n = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im ↑n = 0)) (Eq.symm (of_real_int_cast n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im ↑↑n = 0)) (of_real_im ↑n))) (Eq.refl 0))

@[simp] theorem of_real_rat_cast {K : Type u_1} [is_R_or_C K] (n : ℚ) : ↑↑n = ↑n :=
  ring_hom.map_rat_cast of_real_hom n

@[simp] theorem rat_cast_re {K : Type u_1} [is_R_or_C K] (q : ℚ) : coe_fn re ↑q = ↑q :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn re ↑q = ↑q)) (Eq.symm (of_real_rat_cast q))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn re ↑↑q = ↑q)) (of_real_re ↑q))) (Eq.refl ↑q))

@[simp] theorem rat_cast_im {K : Type u_1} [is_R_or_C K] (q : ℚ) : coe_fn im ↑q = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im ↑q = 0)) (Eq.symm (of_real_rat_cast q))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn im ↑↑q = 0)) (of_real_im ↑q))) (Eq.refl 0))

/-! ### Characteristic zero -/

-- TODO: I think this can be instance, because it is a `Prop`

/--
ℝ and ℂ are both of characteristic zero.

Note: This is not registered as an instance to avoid having multiple instances on ℝ and ℂ.
-/
theorem char_zero_R_or_C {K : Type u_1} [is_R_or_C K] : char_zero K := sorry

theorem re_eq_add_conj {K : Type u_1} [is_R_or_C K] (z : K) : ↑(coe_fn re z) = (z + coe_fn conj z) / bit0 1 := sorry

/-! ### Absolute value -/

/-- The complex absolute value function, defined as the square root of the norm squared. -/
def abs {K : Type u_1} [is_R_or_C K] (z : K) : ℝ :=
  real.sqrt (coe_fn norm_sq z)

@[simp] theorem abs_of_real {K : Type u_1} [is_R_or_C K] (r : ℝ) : abs ↑r = abs r := sorry

theorem norm_eq_abs {K : Type u_1} [is_R_or_C K] (z : K) : norm z = abs z := sorry

theorem abs_of_nonneg {K : Type u_1} [is_R_or_C K] {r : ℝ} (h : 0 ≤ r) : abs ↑r = r :=
  Eq.trans (abs_of_real r) (abs_of_nonneg h)

theorem abs_of_nat {K : Type u_1} [is_R_or_C K] (n : ℕ) : abs ↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (abs ↑n = ↑n)) (Eq.symm (of_real_nat_cast n)))) (abs_of_nonneg (nat.cast_nonneg n))

theorem mul_self_abs {K : Type u_1} [is_R_or_C K] (z : K) : abs z * abs z = coe_fn norm_sq z :=
  real.mul_self_sqrt (norm_sq_nonneg z)

@[simp] theorem abs_zero {K : Type u_1} [is_R_or_C K] : abs 0 = 0 := sorry

@[simp] theorem abs_one {K : Type u_1} [is_R_or_C K] : abs 1 = 1 := sorry

@[simp] theorem abs_two {K : Type u_1} [is_R_or_C K] : abs (bit0 1) = bit0 1 := sorry

theorem abs_nonneg {K : Type u_1} [is_R_or_C K] (z : K) : 0 ≤ abs z :=
  real.sqrt_nonneg (coe_fn norm_sq z)

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

theorem abs_ne_zero {K : Type u_1} [is_R_or_C K] {z : K} : abs z ≠ 0 ↔ z ≠ 0 :=
  not_congr abs_eq_zero

@[simp] theorem abs_conj {K : Type u_1} [is_R_or_C K] (z : K) : abs (coe_fn conj z) = abs z := sorry

@[simp] theorem abs_mul {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : abs (z * w) = abs z * abs w := sorry

theorem abs_re_le_abs {K : Type u_1} [is_R_or_C K] (z : K) : abs (coe_fn re z) ≤ abs z := sorry

theorem abs_im_le_abs {K : Type u_1} [is_R_or_C K] (z : K) : abs (coe_fn im z) ≤ abs z := sorry

theorem re_le_abs {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn re z ≤ abs z :=
  and.right (iff.mp abs_le (abs_re_le_abs z))

theorem im_le_abs {K : Type u_1} [is_R_or_C K] (z : K) : coe_fn im z ≤ abs z :=
  and.right (iff.mp abs_le (abs_im_le_abs z))

theorem im_eq_zero_of_le {K : Type u_1} [is_R_or_C K] {a : K} (h : abs a ≤ coe_fn re a) : coe_fn im a = 0 := sorry

theorem re_eq_self_of_le {K : Type u_1} [is_R_or_C K] {a : K} (h : abs a ≤ coe_fn re a) : ↑(coe_fn re a) = a := sorry

theorem abs_add {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : abs (z + w) ≤ abs z + abs w := sorry

protected instance abs.is_absolute_value {K : Type u_1} [is_R_or_C K] : is_absolute_value abs :=
  is_absolute_value.mk abs_nonneg (fun (_x : K) => abs_eq_zero) abs_add abs_mul

@[simp] theorem abs_abs {K : Type u_1} [is_R_or_C K] (z : K) : abs (abs z) = abs z :=
  abs_of_nonneg (abs_nonneg z)

@[simp] theorem abs_pos {K : Type u_1} [is_R_or_C K] {z : K} : 0 < abs z ↔ z ≠ 0 :=
  is_absolute_value.abv_pos abs

@[simp] theorem abs_neg {K : Type u_1} [is_R_or_C K] (z : K) : abs (-z) = abs z :=
  is_absolute_value.abv_neg abs

theorem abs_sub {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : abs (z - w) = abs (w - z) :=
  is_absolute_value.abv_sub abs

theorem abs_sub_le {K : Type u_1} [is_R_or_C K] (a : K) (b : K) (c : K) : abs (a - c) ≤ abs (a - b) + abs (b - c) :=
  is_absolute_value.abv_sub_le abs

@[simp] theorem abs_inv {K : Type u_1} [is_R_or_C K] (z : K) : abs (z⁻¹) = (abs z⁻¹) :=
  is_absolute_value.abv_inv abs

@[simp] theorem abs_div {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : abs (z / w) = abs z / abs w :=
  is_absolute_value.abv_div abs

theorem abs_abs_sub_le_abs_sub {K : Type u_1} [is_R_or_C K] (z : K) (w : K) : abs (abs z - abs w) ≤ abs (z - w) :=
  is_absolute_value.abs_abv_sub_le_abv_sub abs

theorem abs_re_div_abs_le_one {K : Type u_1} [is_R_or_C K] (z : K) : abs (coe_fn re z / abs z) ≤ 1 := sorry

theorem abs_im_div_abs_le_one {K : Type u_1} [is_R_or_C K] (z : K) : abs (coe_fn im z / abs z) ≤ 1 := sorry

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

theorem norm_sq_eq_abs {K : Type u_1} [is_R_or_C K] (x : K) : coe_fn norm_sq x = abs x ^ bit0 1 := sorry

theorem re_eq_abs_of_mul_conj {K : Type u_1} [is_R_or_C K] (x : K) : coe_fn re (x * coe_fn conj x) = abs (x * coe_fn conj x) := sorry

theorem abs_sqr_re_add_conj {K : Type u_1} [is_R_or_C K] (x : K) : abs (x + coe_fn conj x) ^ bit0 1 = coe_fn re (x + coe_fn conj x) ^ bit0 1 := sorry

theorem abs_sqr_re_add_conj' {K : Type u_1} [is_R_or_C K] (x : K) : abs (coe_fn conj x + x) ^ bit0 1 = coe_fn re (coe_fn conj x + x) ^ bit0 1 := sorry

theorem conj_mul_eq_norm_sq_left {K : Type u_1} [is_R_or_C K] (x : K) : coe_fn conj x * x = ↑(coe_fn norm_sq x) := sorry

/-- The real part in a `is_R_or_C` field, as a continuous linear map. -/
def re_clm {K : Type u_1} [is_R_or_C K] : continuous_linear_map ℝ K ℝ :=
  linear_map.mk_continuous re_lm 1 sorry

@[simp] theorem norm_re_clm {K : Type u_1} [is_R_or_C K] : norm re_clm = 1 := sorry

@[simp] theorem re_clm_coe {K : Type u_1} [is_R_or_C K] : ↑re_clm = re_lm :=
  rfl

@[simp] theorem re_clm_apply {K : Type u_1} [is_R_or_C K] : ⇑re_clm = ⇑re :=
  rfl

/-! ### Cauchy sequences -/

theorem is_cau_seq_re {K : Type u_1} [is_R_or_C K] (f : cau_seq K abs) : is_cau_seq abs fun (n : ℕ) => coe_fn re (coe_fn f n) := sorry

theorem is_cau_seq_im {K : Type u_1} [is_R_or_C K] (f : cau_seq K abs) : is_cau_seq abs fun (n : ℕ) => coe_fn im (coe_fn f n) := sorry

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

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

theorem is_cau_seq_abs {K : Type u_1} [is_R_or_C K] {f : ℕ → K} (hf : is_cau_seq abs f) : is_cau_seq abs (abs ∘ f) := sorry

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

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

@[simp] theorem of_real_finsupp_sum {K : Type u_1} [is_R_or_C K] {α : Type u_2} {M : Type u_3} [HasZero M] (f : α →₀ M) (g : α → M → ℝ) : ↑(finsupp.sum f fun (a : α) (b : M) => g a b) = finsupp.sum f fun (a : α) (b : M) => ↑(g a b) :=
  ring_hom.map_finsupp_sum (algebra_map ℝ K) f g

@[simp] theorem of_real_finsupp_prod {K : Type u_1} [is_R_or_C K] {α : Type u_2} {M : Type u_3} [HasZero M] (f : α →₀ M) (g : α → M → ℝ) : ↑(finsupp.prod f fun (a : α) (b : M) => g a b) = finsupp.prod f fun (a : α) (b : M) => ↑(g a b) :=
  ring_hom.map_finsupp_prod (algebra_map ℝ K) f g

end is_R_or_C

namespace finite_dimensional

/-- This instance generates a type-class problem with a metavariable `?m` that should satisfy
`is_R_or_C ?m`. Since this can only be satisfied by `ℝ` or `ℂ`, this does not cause problems. -/
/-- An `is_R_or_C` field is finite-dimensional over `ℝ`, since it is spanned by `{1, I}`. -/
protected instance is_R_or_C_to_real {K : Type u_1} [is_R_or_C K] : finite_dimensional ℝ K := sorry

/-- Over an `is_R_or_C` field, we can register the properness of finite-dimensional normed spaces as
an instance. -/
protected instance proper_is_R_or_C {K : Type u_1} [is_R_or_C K] {E : Type u_2} [normed_group E] [normed_space K E] [finite_dimensional K E] : proper_space E :=
  let _inst : normed_space ℝ E := restrict_scalars.normed_space ℝ K E;
  let _inst_5 : is_scalar_tower ℝ K E := restrict_scalars.is_scalar_tower ℝ K E;
  let _inst_6 : finite_dimensional ℝ E := trans ℝ K E;
  finite_dimensional.proper_real E

end finite_dimensional

protected instance real.is_R_or_C : is_R_or_C ℝ :=
  is_R_or_C.mk (add_monoid_hom.id ℝ) 0 (ring_hom.id ℝ) 0 sorry sorry sorry sorry sorry sorry sorry sorry sorry sorry sorry
    sorry sorry sorry

namespace is_R_or_C

@[simp] theorem re_to_real {x : ℝ} : coe_fn re x = x :=
  rfl

@[simp] theorem im_to_real {x : ℝ} : coe_fn im x = 0 :=
  rfl

@[simp] theorem conj_to_real {x : ℝ} : coe_fn conj x = x :=
  rfl

@[simp] theorem I_to_real : I = 0 :=
  rfl

@[simp] theorem norm_sq_to_real {x : ℝ} : coe_fn norm_sq x = x * x := sorry

@[simp] theorem abs_to_real {x : ℝ} : abs x = abs x := sorry

@[simp] theorem coe_real_eq_id : coe = id :=
  rfl

end is_R_or_C

/- Note: one might think the following lemma belongs in `analysis.normed_space.basic`.  But it
can't be placed there, because that file is an import of `data.complex.is_R_or_C`! -/

/-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to unit length. -/
@[simp] theorem norm_smul_inv_norm {K : Type u_1} [is_R_or_C K] {E : Type u_2} [normed_group E] [normed_space K E] {x : E} (hx : x ≠ 0) : norm (↑(norm x)⁻¹ • x) = 1 := sorry


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import control.monad.basic
import data.fintype.basic
import data.list.prod_sigma

/-!
> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

Type class for finitely enumerable types. The property is stronger
than `fintype` in that it assigns each element a rank in a finite
enumeration.
-/

universes u v
open finset

/-- `fin_enum α` means that `α` is finite and can be enumerated in some order,
  i.e. `α` has an explicit bijection with `fin n` for some n. -/
class fin_enum (α : Sort*) :=
(card : ℕ)
(equiv [] : α ≃ fin card)
[dec_eq : decidable_eq α]

attribute [instance, priority 100] fin_enum.dec_eq

namespace fin_enum

variables {α : Type u} {β : α → Type v}

/-- transport a `fin_enum` instance across an equivalence -/
def of_equiv (α) {β} [fin_enum α] (h : β ≃ α) : fin_enum β :=
{ card := card α,
  equiv := h.trans (equiv α),
  dec_eq := (h.trans (equiv _)).decidable_eq }

/-- create a `fin_enum` instance from an exhaustive list without duplicates -/
def of_nodup_list [decidable_eq α] (xs : list α) (h : ∀ x : α, x ∈ xs) (h' : list.nodup xs) :
  fin_enum α :=
{ card := xs.length,
  equiv := ⟨λ x, ⟨xs.index_of x,by rw [list.index_of_lt_length]; apply h⟩,
           λ ⟨i,h⟩, xs.nth_le _ h,
           λ x, by simp [of_nodup_list._match_1],
           λ ⟨i,h⟩, by simp [of_nodup_list._match_1,*]; rw list.nth_le_index_of;
             apply list.nodup_dedup ⟩ }

/-- create a `fin_enum` instance from an exhaustive list; duplicates are removed -/
def of_list [decidable_eq α] (xs : list α) (h : ∀ x : α, x ∈ xs) : fin_enum α :=
of_nodup_list xs.dedup (by simp *) (list.nodup_dedup _)

/-- create an exhaustive list of the values of a given type -/
def to_list (α) [fin_enum α] : list α :=
(list.fin_range (card α)).map (equiv α).symm

open function

@[simp] lemma mem_to_list [fin_enum α] (x : α) : x ∈ to_list α :=
by simp [to_list]; existsi equiv α x; simp

@[simp] lemma nodup_to_list [fin_enum α] : list.nodup (to_list α) :=
by simp [to_list]; apply list.nodup.map; [apply equiv.injective, apply list.nodup_fin_range]

/-- create a `fin_enum` instance using a surjection -/
def of_surjective {β} (f : β → α) [decidable_eq α] [fin_enum β] (h : surjective f) : fin_enum α :=
of_list ((to_list β).map f) (by intro; simp; exact h _)

/-- create a `fin_enum` instance using an injection -/
noncomputable def of_injective {α β} (f : α → β) [decidable_eq α] [fin_enum β] (h : injective f) :
  fin_enum α :=
of_list ((to_list β).filter_map (partial_inv f))
begin
  intro x,
  simp only [mem_to_list, true_and, list.mem_filter_map],
  use f x,
  simp only [h, function.partial_inv_left],
end

instance pempty : fin_enum pempty :=
of_list [] (λ x, pempty.elim x)

instance empty : fin_enum empty :=
of_list [] (λ x, empty.elim x)

instance punit : fin_enum punit :=
of_list [punit.star] (λ x, by cases x; simp)

instance prod {β} [fin_enum α] [fin_enum β] : fin_enum (α × β) :=
of_list (to_list α ×ˢ to_list β) (λ x, by cases x; simp)

instance sum {β} [fin_enum α] [fin_enum β] : fin_enum (α ⊕ β) :=
of_list ( (to_list α).map sum.inl ++ (to_list β).map sum.inr ) (λ x, by cases x; simp)

instance fin {n} : fin_enum (fin n) :=
of_list (list.fin_range _) (by simp)

instance quotient.enum [fin_enum α] (s : setoid α)
  [decidable_rel ((≈) : α → α → Prop)] : fin_enum (quotient s) :=
fin_enum.of_surjective quotient.mk (λ x, quotient.induction_on x (λ x, ⟨x, rfl⟩))

/-- enumerate all finite sets of a given type -/
def finset.enum [decidable_eq α] : list α → list (finset α)
| [] := [∅]
| (x :: xs) :=
  do r ← finset.enum xs,
     [r,{x} ∪ r]

@[simp]lemma finset.mem_enum [decidable_eq α] (s : finset α) (xs : list α) :
  s ∈ finset.enum xs ↔ ∀ x ∈ s, x ∈ xs :=
begin
  induction xs generalizing s; simp [*,finset.enum],
  { simp [finset.eq_empty_iff_forall_not_mem,(∉)], refl },
  { split, rintro ⟨a,h,h'⟩ x hx,
    cases h',
    { right, apply h, subst a, exact hx, },
    { simp only [h', mem_union, mem_singleton] at hx ⊢, cases hx,
      { exact or.inl hx },
      { exact or.inr (h _ hx) } },
    intro h, existsi s \ ({xs_hd} : finset α),
    simp only [and_imp, mem_sdiff, mem_singleton],
    simp only [or_iff_not_imp_left] at h,
    existsi h,
    by_cases xs_hd ∈ s,
    { have : {xs_hd} ⊆ s, simp only [has_subset.subset, *, forall_eq, mem_singleton],
      simp only [union_sdiff_of_subset this, or_true, finset.union_sdiff_of_subset,
        eq_self_iff_true], },
    { left, symmetry, simp only [sdiff_eq_self],
      intro a, simp only [and_imp, mem_inter, mem_singleton],
      rintro h₀ rfl, apply h h₀, } }
end

instance finset.fin_enum [fin_enum α] : fin_enum (finset α) :=
of_list (finset.enum (to_list α)) (by intro; simp)

instance subtype.fin_enum [fin_enum α] (p : α → Prop) [decidable_pred p] : fin_enum {x // p x} :=
of_list ((to_list α).filter_map $ λ x, if h : p x then some ⟨_,h⟩ else none)
  (by rintro ⟨x,h⟩; simp; existsi x; simp *)

instance (β : α → Type v)
  [fin_enum α] [∀ a, fin_enum (β a)] : fin_enum (sigma β) :=
of_list
  ((to_list α).bind $ λ a, (to_list (β a)).map $ sigma.mk a)
  (by intro x; cases x; simp)

instance psigma.fin_enum [fin_enum α] [∀ a, fin_enum (β a)] :
  fin_enum (Σ' a, β a) :=
fin_enum.of_equiv _ (equiv.psigma_equiv_sigma _)

instance psigma.fin_enum_prop_left {α : Prop} {β : α → Type v} [∀ a, fin_enum (β a)] [decidable α] :
  fin_enum (Σ' a, β a) :=
if h : α then of_list ((to_list (β h)).map $ psigma.mk h) (λ ⟨a,Ba⟩, by simp)
else of_list [] (λ ⟨a,Ba⟩, (h a).elim)

instance psigma.fin_enum_prop_right {β : α → Prop} [fin_enum α] [∀ a, decidable (β a)] :
  fin_enum (Σ' a, β a) :=
fin_enum.of_equiv {a // β a} ⟨λ ⟨x, y⟩, ⟨x, y⟩, λ ⟨x, y⟩, ⟨x, y⟩, λ ⟨x, y⟩, rfl, λ ⟨x, y⟩, rfl⟩

instance psigma.fin_enum_prop_prop {α : Prop} {β : α → Prop} [decidable α] [∀ a, decidable (β a)] :
  fin_enum (Σ' a, β a) :=
if h : ∃ a, β a
  then of_list [⟨h.fst,h.snd⟩] (by rintro ⟨⟩; simp)
  else of_list [] (λ a, (h ⟨a.fst,a.snd⟩).elim)

@[priority 100]
instance [fin_enum α] : fintype α :=
{ elems := univ.map (equiv α).symm.to_embedding,
  complete := by intros; simp; existsi (equiv α x); simp }

/-- For `pi.cons x xs y f` create a function where every `i ∈ xs` is mapped to `f i` and
`x` is mapped to `y`  -/
def pi.cons [decidable_eq α] (x : α) (xs : list α) (y : β x)
  (f : Π a, a ∈ xs → β a) :
  Π a, a ∈ (x :: xs : list α) → β a
| b h :=
  if h' : b = x then cast (by rw h') y
    else f b (list.mem_of_ne_of_mem h' h)

/-- Given `f` a function whose domain is `x :: xs`, produce a function whose domain
is restricted to `xs`.  -/
def pi.tail {x : α} {xs : list α} (f : Π a, a ∈ (x :: xs : list α) → β a) :
  Π a, a ∈ xs → β a
| a h := f a (list.mem_cons_of_mem _ h)

/-- `pi xs f` creates the list of functions `g` such that, for `x ∈ xs`, `g x ∈ f x` -/
def pi {β : α → Type (max u v)} [decidable_eq α] : Π xs : list α, (Π a, list (β a)) →
  list (Π a, a ∈ xs → β a)
| [] fs := [λ x h, h.elim]
| (x :: xs) fs :=
  fin_enum.pi.cons x xs <$> fs x <*> pi xs fs

lemma mem_pi {β : α → Type (max u v)} [fin_enum α] [∀a, fin_enum (β a)] (xs : list α)
  (f : Π a, a ∈ xs → β a) :
  f ∈ pi xs (λ x, to_list (β x)) :=
begin
  induction xs; simp [pi,-list.map_eq_map] with monad_norm functor_norm,
  { ext a ⟨ ⟩ },
  { existsi pi.cons xs_hd xs_tl (f _ (list.mem_cons_self _ _)),
    split, exact ⟨_,rfl⟩,
    existsi pi.tail f, split,
    { apply xs_ih, },
    { ext x h, simp [pi.cons], split_ifs, subst x, refl, refl }, }
end

/-- enumerate all functions whose domain and range are finitely enumerable -/
def pi.enum (β : α → Type (max u v)) [fin_enum α] [∀a, fin_enum (β a)] : list (Π a, β a) :=
(pi (to_list α) (λ x, to_list (β x))).map (λ f x, f x (mem_to_list _))

lemma pi.mem_enum {β : α → Type (max u v)} [fin_enum α] [∀a, fin_enum (β a)] (f : Π a, β a) :
  f ∈ pi.enum β :=
by simp [pi.enum]; refine ⟨λ a h, f a, mem_pi _ _, rfl⟩

instance pi.fin_enum {β : α → Type (max u v)}
  [fin_enum α] [∀a, fin_enum (β a)] : fin_enum (Πa, β a) :=
of_list (pi.enum _) (λ x, pi.mem_enum _)

instance pfun_fin_enum (p : Prop) [decidable p] (α : p → Type*)
  [Π hp, fin_enum (α hp)] : fin_enum (Π hp : p, α hp) :=
if hp : p then of_list ( (to_list (α hp)).map $ λ x hp', x ) (by intro; simp; exact ⟨x hp,rfl⟩)
          else of_list [λ hp', (hp hp').elim] (by intro; simp; ext hp'; cases hp hp')

end fin_enum


import data.finset.basic data.fintype.basic multiset

-- needed to get decidable_eq for sets!
open classical
local attribute [instance] prop_decidable

lemma finset_image_eq_set_image {α β: Type} (f : α → β)
(s : finset α) : f '' s = finset.image f s :=
begin
    ext, split,
    {
      intro hx,
      rcases hx with ⟨px, ⟨hpx, rfl⟩⟩,
      apply finset.mem_coe.mpr,
      apply finset.mem_image.mpr,
      refine ⟨px, hpx, rfl⟩,
    },
    {
      intro hx,
      replace hx := finset.mem_coe.mp hx,
      rcases finset.mem_image.mp hx with ⟨px, hpx, rfl⟩,
      refine ⟨px, hpx, rfl⟩,
    },
end

lemma set_range_eq_finset_range {α β : Type} [fintype α] (f : α → β) :
set.range f = finset.image f finset.univ :=
begin
  rw [←set.image_univ, ←finset.coe_univ],
  apply finset_image_eq_set_image,
end

lemma finset_exists_subset_of_subset_image {α β: Type}
{s : finset α} {t : finset β} {f : α → β} (h : t ⊆ finset.image f s) :
∃ u : finset α, u ⊆ s ∧ finset.image f u = t :=
begin
  replace h := finset.val_le_iff.mpr h,
  simp only [finset.image, multiset.to_finset_val _] at h,
  replace h := le_trans h (multiset.dedup_le _),
  rcases multiset_exists_of_le_map h with ⟨m, hm, htval⟩,
  refine ⟨m.to_finset, _, _⟩,
  {
    intros x hx,
    simp only [multiset.mem_to_finset] at hx,
    exact (multiset.subset_of_le hm) hx,
  },
  {
    simp only [finset.image],
    apply finset.val_inj.mp,
    simp only [multiset.to_finset_val _],
    rw [←htval, multiset.dedup_map_dedup_eq],
    rw [htval],
    apply multiset.nodup.dedup,
    apply finset.nodup,
  }
end

lemma ex_finset_argmax {α : Type} (f : α → ℝ) {s : finset α} (hs : s.nonempty) :
∃ a ∈ s, ∀ b ∈ s, f a ≥ f b :=
begin
  have hsval : s.val ≠ 0,
  {
    intro h,
    rcases hs with ⟨x, hx⟩,
    simpa only [finset.mem_def, h] using hx,
  },
  rcases ex_multiset_argmax f hsval with ⟨a, ha, hp⟩,
  exact ⟨a, ha, hp⟩,
end


/-
Copyright (c) 2019 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.adjunction.fully_faithful
! leanprover-community/mathlib commit 9e7c80f638149bfb3504ba8ff48dfdbfc949fb1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Adjunction.Basic
import Mathlib.CategoryTheory.Conj
import Mathlib.CategoryTheory.Yoneda

/-!
# Adjoints of fully faithful functors

A left adjoint is fully faithful, if and only if the unit is an isomorphism
(and similarly for right adjoints and the counit).

`Adjunction.restrictFullyFaithful` shows that an adjunction can be restricted along fully faithful
inclusions.

## Future work

The statements from Riehl 4.5.13 for adjoints which are either full, or faithful.
-/

open CategoryTheory

namespace CategoryTheory

universe v₁ v₂ u₁ u₂

open Category

open Opposite

variable {C : Type u₁} [Category.{v₁} C]

variable {D : Type u₂} [Category.{v₂} D]

variable {L : C ⥤ D} {R : D ⥤ C} (h : L ⊣ R)

/-- If the left adjoint is fully faithful, then the unit is an isomorphism.

See
* Lemma 4.5.13 from [Riehl][riehl2017]
* https://math.stackexchange.com/a/2727177
* https://stacks.math.columbia.edu/tag/07RB (we only prove the forward direction!)
-/
instance unit_isIso_of_L_fully_faithful [Full L] [Faithful L] : IsIso (Adjunction.unit h) :=
  @NatIso.isIso_of_isIso_app _ _ _ _ _ _ (Adjunction.unit h) fun X =>
    @Yoneda.isIso _ _ _ _ ((Adjunction.unit h).app X)
      ⟨⟨{ app := fun Y f => L.preimage ((h.homEquiv (unop Y) (L.obj X)).symm f),
          naturality := fun X Y f => by
            funext x -- porting note: `aesop_cat` is not able to do `funext` automatically
            aesop_cat },
          ⟨by
            ext x
            funext f
            apply L.map_injective
            aesop_cat, by
            ext x
            funext f
            dsimp
            simp only [Adjunction.homEquiv_counit, preimage_comp, preimage_map, Category.assoc]
            rw [← h.unit_naturality]
            simp⟩⟩⟩
set_option linter.uppercaseLean3 false in
#align category_theory.unit_is_iso_of_L_fully_faithful CategoryTheory.unit_isIso_of_L_fully_faithful

/-- If the right adjoint is fully faithful, then the counit is an isomorphism.

See <https://stacks.math.columbia.edu/tag/07RB> (we only prove the forward direction!)
-/
instance counit_isIso_of_R_fully_faithful [Full R] [Faithful R] : IsIso (Adjunction.counit h) :=
  @NatIso.isIso_of_isIso_app _ _ _ _ _ _ (Adjunction.counit h) fun X =>
    @isIso_of_op _ _ _ _ _ <|
      @Coyoneda.isIso _ _ _ _ ((Adjunction.counit h).app X).op
        ⟨⟨{ app := fun Y f => R.preimage ((h.homEquiv (R.obj X) Y) f),
            naturality := fun X Y f => by
              funext x
              aesop_cat },
            ⟨by
              ext x
              funext f
              apply R.map_injective
              simp, by
              ext x
              funext f
              dsimp
              simp only [Adjunction.homEquiv_unit, preimage_comp, preimage_map]
              rw [← h.counit_naturality]
              simp⟩⟩⟩
set_option linter.uppercaseLean3 false in
#align category_theory.counit_is_iso_of_R_fully_faithful CategoryTheory.counit_isIso_of_R_fully_faithful

/-- If the unit of an adjunction is an isomorphism, then its inverse on the image of L is given
by L whiskered with the counit. -/
@[simp]
theorem inv_map_unit {X : C} [IsIso (h.unit.app X)] :
    inv (L.map (h.unit.app X)) = h.counit.app (L.obj X) :=
  IsIso.inv_eq_of_hom_inv_id h.left_triangle_components
#align category_theory.inv_map_unit CategoryTheory.inv_map_unit

/-- If the unit is an isomorphism, bundle one has an isomorphism `L ⋙ R ⋙ L ≅ L`. -/
@[simps!]
noncomputable def whiskerLeftLCounitIsoOfIsIsoUnit [IsIso h.unit] : L ⋙ R ⋙ L ≅ L :=
  (L.associator R L).symm ≪≫ isoWhiskerRight (asIso h.unit).symm L ≪≫ Functor.leftUnitor _
set_option linter.uppercaseLean3 false in
#align category_theory.whisker_left_L_counit_iso_of_is_iso_unit CategoryTheory.whiskerLeftLCounitIsoOfIsIsoUnit

/-- If the counit of an adjunction is an isomorphism, then its inverse on the image of R is given
by R whiskered with the unit. -/
@[simp]
theorem inv_counit_map {X : D} [IsIso (h.counit.app X)] :
    inv (R.map (h.counit.app X)) = h.unit.app (R.obj X) :=
  IsIso.inv_eq_of_inv_hom_id h.right_triangle_components
#align category_theory.inv_counit_map CategoryTheory.inv_counit_map

/-- If the counit of an is an isomorphism, one has an isomorphism `(R ⋙ L ⋙ R) ≅ R`. -/
@[simps!]
noncomputable def whiskerLeftRUnitIsoOfIsIsoCounit [IsIso h.counit] : R ⋙ L ⋙ R ≅ R :=
  (R.associator L R).symm ≪≫ isoWhiskerRight (asIso h.counit) R ≪≫ Functor.leftUnitor _
set_option linter.uppercaseLean3 false in
#align category_theory.whisker_left_R_unit_iso_of_is_iso_counit CategoryTheory.whiskerLeftRUnitIsoOfIsIsoCounit

/-- If the unit is an isomorphism, then the left adjoint is full-/
noncomputable def lFullOfUnitIsIso [IsIso h.unit] : Full L
    where preimage {X Y} f := h.homEquiv _ (L.obj Y) f ≫ inv (h.unit.app Y)
set_option linter.uppercaseLean3 false in
#align category_theory.L_full_of_unit_is_iso CategoryTheory.lFullOfUnitIsIso

/-- If the unit is an isomorphism, then the left adjoint is faithful-/
theorem L_faithful_of_unit_isIso [IsIso h.unit] : Faithful L :=
  ⟨fun {X Y f g} H => by
    rw [← (h.homEquiv X (L.obj Y)).apply_eq_iff_eq] at H
    simpa using H =≫ inv (h.unit.app Y)⟩
set_option linter.uppercaseLean3 false in
#align category_theory.L_faithful_of_unit_is_iso CategoryTheory.L_faithful_of_unit_isIso

/-- If the counit is an isomorphism, then the right adjoint is full-/
noncomputable def rFullOfCounitIsIso [IsIso h.counit] : Full R
    where preimage {X Y} f := inv (h.counit.app X) ≫ (h.homEquiv (R.obj X) Y).symm f
set_option linter.uppercaseLean3 false in
#align category_theory.R_full_of_counit_is_iso CategoryTheory.rFullOfCounitIsIso

/-- If the counit is an isomorphism, then the right adjoint is faithful-/

instance whiskerLeft_counit_iso_of_L_fully_faithful [Full L] [Faithful L] :
    IsIso (whiskerLeft L h.counit) := by
  have := h.left_triangle
  rw [← IsIso.eq_inv_comp] at this
  rw [this]
  infer_instance
set_option linter.uppercaseLean3 false in
#align category_theory.whisker_left_counit_iso_of_L_fully_faithful CategoryTheory.whiskerLeft_counit_iso_of_L_fully_faithful

instance whiskerRight_counit_iso_of_L_fully_faithful [Full L] [Faithful L] :
    IsIso (whiskerRight h.counit R) := by
  have := h.right_triangle
  rw [← IsIso.eq_inv_comp] at this
  rw [this]
  infer_instance
set_option linter.uppercaseLean3 false in
#align category_theory.whisker_right_counit_iso_of_L_fully_faithful CategoryTheory.whiskerRight_counit_iso_of_L_fully_faithful

instance whiskerLeft_unit_iso_of_R_fully_faithful [Full R] [Faithful R] :
    IsIso (whiskerLeft R h.unit) := by
  have := h.right_triangle
  rw [← IsIso.eq_comp_inv] at this
  rw [this]
  infer_instance
set_option linter.uppercaseLean3 false in
#align category_theory.whisker_left_unit_iso_of_R_fully_faithful CategoryTheory.whiskerLeft_unit_iso_of_R_fully_faithful

instance whiskerRight_unit_iso_of_R_fully_faithful [Full R] [Faithful R] :
    IsIso (whiskerRight h.unit L) := by
  have := h.left_triangle
  rw [← IsIso.eq_comp_inv] at this
  rw [this]
  infer_instance
set_option linter.uppercaseLean3 false in
#align category_theory.whisker_right_unit_iso_of_R_fully_faithful CategoryTheory.whiskerRight_unit_iso_of_R_fully_faithful

-- TODO also do the statements from Riehl 4.5.13 for full and faithful separately?
universe v₃ v₄ u₃ u₄

variable {C' : Type u₃} [Category.{v₃} C']

variable {D' : Type u₄} [Category.{v₄} D']

-- TODO: This needs some lemmas describing the produced adjunction, probably in terms of `adj`,
-- `iC` and `iD`.
/-- If `C` is a full subcategory of `C'` and `D` is a full subcategory of `D'`, then we can restrict
an adjunction `L' ⊣ R'` where `L' : C' ⥤ D'` and `R' : D' ⥤ C'` to `C` and `D`.
The construction here is slightly more general, in that `C` is required only to have a full and
faithful "inclusion" functor `iC : C ⥤ C'` (and similarly `iD : D ⥤ D'`) which commute (up to
natural isomorphism) with the proposed restrictions.
-/
def Adjunction.restrictFullyFaithful (iC : C ⥤ C') (iD : D ⥤ D') {L' : C' ⥤ D'} {R' : D' ⥤ C'}
    (adj : L' ⊣ R') {L : C ⥤ D} {R : D ⥤ C} (comm1 : iC ⋙ L' ≅ L ⋙ iD) (comm2 : iD ⋙ R' ≅ R ⋙ iC)
    [Full iC] [Faithful iC] [Full iD] [Faithful iD] : L ⊣ R :=
  Adjunction.mkOfHomEquiv
    { homEquiv := fun X Y =>
        calc
          (L.obj X ⟶ Y) ≃ (iD.obj (L.obj X) ⟶ iD.obj Y) := equivOfFullyFaithful iD
          _ ≃ (L'.obj (iC.obj X) ⟶ iD.obj Y) := Iso.homCongr (comm1.symm.app X) (Iso.refl _)
          _ ≃ (iC.obj X ⟶ R'.obj (iD.obj Y)) := adj.homEquiv _ _
          _ ≃ (iC.obj X ⟶ iC.obj (R.obj Y)) := Iso.homCongr (Iso.refl _) (comm2.app Y)
          _ ≃ (X ⟶ R.obj Y) := (equivOfFullyFaithful iC).symm

      homEquiv_naturality_left_symm := fun {X' X Y} f g => by
        apply iD.map_injective
        simpa [Trans.trans] using (comm1.inv.naturality_assoc f _).symm
      homEquiv_naturality_right := fun {X Y' Y} f g => by
        apply iC.map_injective
        suffices : R'.map (iD.map g) ≫ comm2.hom.app Y = comm2.hom.app Y' ≫ iC.map (R.map g)
        . simp [Trans.trans, this]
        . apply comm2.hom.naturality g }
#align category_theory.adjunction.restrict_fully_faithful CategoryTheory.Adjunction.restrictFullyFaithful

end CategoryTheory


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.continued_fractions.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Basic Translation Lemmas Between Functions Defined for Continued Fractions

## Summary

Some simple translation lemmas between the different definitions of functions defined in
`algebra.continued_fractions.basic`.
-/

namespace generalized_continued_fraction

/-!
### Translations Between General Access Functions

Here we give some basic translations that hold by definition between the various methods that allow
us to access the numerators and denominators of a continued fraction.
-/

theorem terminated_at_iff_s_terminated_at {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} : terminated_at g n ↔ seq.terminated_at (s g) n :=
  iff.refl (terminated_at g n)

theorem terminated_at_iff_s_none {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} : terminated_at g n ↔ seq.nth (s g) n = none :=
  iff.refl (terminated_at g n)

theorem part_num_none_iff_s_none {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} : seq.nth (partial_numerators g) n = none ↔ seq.nth (s g) n = none := sorry

theorem terminated_at_iff_part_num_none {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} : terminated_at g n ↔ seq.nth (partial_numerators g) n = none := sorry

theorem part_denom_none_iff_s_none {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} : seq.nth (partial_denominators g) n = none ↔ seq.nth (s g) n = none := sorry

theorem terminated_at_iff_part_denom_none {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} : terminated_at g n ↔ seq.nth (partial_denominators g) n = none := sorry

theorem part_num_eq_s_a {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} {gp : pair α} (s_nth_eq : seq.nth (s g) n = some gp) : seq.nth (partial_numerators g) n = some (pair.a gp) := sorry

theorem part_denom_eq_s_b {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} {gp : pair α} (s_nth_eq : seq.nth (s g) n = some gp) : seq.nth (partial_denominators g) n = some (pair.b gp) := sorry

theorem exists_s_a_of_part_num {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} {a : α} (nth_part_num_eq : seq.nth (partial_numerators g) n = some a) : ∃ (gp : pair α), seq.nth (s g) n = some gp ∧ pair.a gp = a := sorry

theorem exists_s_b_of_part_denom {α : Type u_1} {g : generalized_continued_fraction α} {n : ℕ} {b : α} (nth_part_denom_eq : seq.nth (partial_denominators g) n = some b) : ∃ (gp : pair α), seq.nth (s g) n = some gp ∧ pair.b gp = b := sorry

/-!
### Translations Between Computational Functions

Here we  give some basic translations that hold by definition for the computational methods of a
continued fraction.
-/

theorem nth_cont_eq_succ_nth_cont_aux {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] : continuants g n = continuants_aux g (n + 1) :=
  rfl

theorem num_eq_conts_a {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] : numerators g n = pair.a (continuants g n) :=
  rfl

theorem denom_eq_conts_b {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] : denominators g n = pair.b (continuants g n) :=
  rfl

theorem convergent_eq_num_div_denom {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] : convergents g n = numerators g n / denominators g n :=
  rfl

theorem convergent_eq_conts_a_div_conts_b {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] : convergents g n = pair.a (continuants g n) / pair.b (continuants g n) :=
  rfl

theorem exists_conts_a_of_num {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] {A : K} (nth_num_eq : numerators g n = A) : ∃ (conts : pair K), continuants g n = conts ∧ pair.a conts = A :=
  eq.mpr (id (propext exists_eq_left')) nth_num_eq

theorem exists_conts_b_of_denom {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] {B : K} (nth_denom_eq : denominators g n = B) : ∃ (conts : pair K), continuants g n = conts ∧ pair.b conts = B :=
  eq.mpr (id (propext exists_eq_left')) nth_denom_eq

@[simp] theorem zeroth_continuant_aux_eq_one_zero {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] : continuants_aux g 0 = pair.mk 1 0 :=
  rfl

@[simp] theorem first_continuant_aux_eq_h_one {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] : continuants_aux g 1 = pair.mk (h g) 1 :=
  rfl

@[simp] theorem zeroth_continuant_eq_h_one {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] : continuants g 0 = pair.mk (h g) 1 :=
  rfl

@[simp] theorem zeroth_numerator_eq_h {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] : numerators g 0 = h g :=
  rfl

@[simp] theorem zeroth_denominator_eq_one {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] : denominators g 0 = 1 :=
  rfl

@[simp] theorem zeroth_convergent_eq_h {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] : convergents g 0 = h g := sorry

theorem second_continuant_aux_eq {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] {gp : pair K} (zeroth_s_eq : seq.nth (s g) 0 = some gp) : continuants_aux g (bit0 1) = pair.mk (pair.b gp * h g + pair.a gp) (pair.b gp) := sorry

theorem first_continuant_eq {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] {gp : pair K} (zeroth_s_eq : seq.nth (s g) 0 = some gp) : continuants g 1 = pair.mk (pair.b gp * h g + pair.a gp) (pair.b gp) := sorry

theorem first_numerator_eq {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] {gp : pair K} (zeroth_s_eq : seq.nth (s g) 0 = some gp) : numerators g 1 = pair.b gp * h g + pair.a gp := sorry

theorem first_denominator_eq {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] {gp : pair K} (zeroth_s_eq : seq.nth (s g) 0 = some gp) : denominators g 1 = pair.b gp := sorry

@[simp] theorem zeroth_convergent'_aux_eq_zero {K : Type u_1} [division_ring K] {s : seq (pair K)} : convergents'_aux s 0 = 0 :=
  rfl

@[simp] theorem zeroth_convergent'_eq_h {K : Type u_1} {g : generalized_continued_fraction K} [division_ring K] : convergents' g 0 = h g := sorry


universe u
--variables (α : Type u) (p q : α → Prop) (r : α → α → Prop)

--example : (∀ x : α, p x ∧ q x) → ∀ y : α, p y := λ h x, (h x).left

--variable refl_r : ∀ x, r x x
--variable symm_r : ∀ {x y}, r x y → r y x
--variable trans_r : ∀ {x y z}, r x y → r y z → r x z

--variables a b c : α
--variables (hab : r a b) (hbc : r b c)

--example (a b c d : α) (hab : r a b) (hcb : r c b) (hcd : r c d) :
 -- r a d := trans_r hab (trans_r (symm_r hcb) hcd)

--#check eq.refl    -- ∀ (a : ?M_1), a = a
--#check eq.symm    -- ?M_2 = ?M_3 → ?M_3 = ?M_2
--#check eq.trans

example (α : Type u) (a b : α) (p : α → Prop)
  (h1 : a = b) (h2 : p a) : p b := h1 ▸ h2

--variables f g : α → ℕ
--variable h₁ : a = b
--variable h₂ : f = g

--example : f a = f b := congr_arg f h₁
--example : f a = g a := congr_fun h₂ a
--example : f a = g b := congr h₂ h₁

example (x y : ℕ) :
  (x + y) * (x + y) = x * x + 2 * x * y + y * y :=
calc
    (x + y) * (x + y) = x * (x + y) + y * (x + y) : by rw add_mul
    ... = x * x + x * y + y * (x + y) : by rw mul_add
    ... = (x * x + x * y) + (y * x + y * y) : by rw mul_add
    ... = x * x + x * y + y * x + y * y : by rw ←add_assoc
    ... = x * x + (x * y + y * x) + y * y : by rw ←add_assoc
    ... = x * x + (1 * (x * y) + y * x) + y * y : by rw one_mul
    ... = x * x + (1 * (x * y) + 1 * (y * x)) + y * y : by rw one_mul (y * x)
    ... = x * x + (1 * (x * y) + 1 * (x * y)) + y * y : by rw mul_comm y x
    ... = x * x + (1 + 1) * (x * y) + y * y : by rw ←add_mul
    ... = x * x + 2 * (x * y) + y * y : rfl
    ... = x * x + 2 * x * y + y * y : by rw mul_assoc

--variable h1 : a = b
--variable h2 : b = c + 1
--variable h3 : c = d
--variable h4 : e = 1 + d

--include h1 h2 h3 h4
--theorem T : a = e := by simp [h1, h2, h3, h4]

theorem T2 (a b c d : ℕ)
  (h1 : a = b) (h2 : b ≤ c) (h3 : c + 1 < d) : a < d :=
calc
    a = b : h1
    ... ≤ c : h2
    ... < c + 1 : nat.lt_succ_self c
    ... < d : h3

open nat

example : ∃ x : ℕ, x > 0 := ⟨1, zero_lt_succ 0⟩

example (x : ℕ) (h : x > 0) : ∃ y, y < x := ⟨0, h⟩

example (x y z : ℕ) (hxy : x < y) (hyz : y < z) :
  ∃ w, x < w ∧ w < z := ⟨y, hxy, hyz⟩

--example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
--exists.elim h (λ w hw, ⟨w, hw.right, hw.left⟩)

def is_even (a : nat) := ∃ b, a = 2 * b

theorem even_plus_even {a b : nat} (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
exists.elim h1(λ a0 ha, exists.elim h2(λ b0 hb, ⟨a0+b0, by rw [ha, hb, ←mul_add]⟩))

open classical

variables (α : Type) (p q : α → Prop)

example (h : ¬ ∀ x, ¬ p x) : ∃ x, p x := by_contradiction
(λ h0, (λ (h1 : (∀ x, ¬ p x)), h h1) (λ x hpx, h0 ⟨x, hpx⟩))

open classical

variable a : α
variable r : Prop

example : (∃ x : α, r) → r := λ h, exists.elim h (λ x hr, hr)
example : r → (∃ x : α, r) := λ hr, ⟨a, hr⟩
example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := iff.intro
(λ h, exists.elim h (λ x hpr, ⟨⟨x, hpr.left⟩,hpr.right⟩))
(λ h, exists.elim h.left (λ x hpx, ⟨x, hpx, h.right⟩))
example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := iff.intro
(λ h, exists.elim h (λ x hpq, hpq.elim (λ hpx, or.inl ⟨x, hpx⟩) (λ hqx, or.inr ⟨x, hqx⟩)))
(λ h, or.elim h (λ hpx, exists.elim hpx (λ x hpx, ⟨x, or.intro_left (q x) hpx⟩))
(λ hqx, exists.elim hqx (λ x hqx, ⟨x, or.intro_right (p x) hqx⟩)))

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := iff.intro
(λ hpx hnpx, exists.elim hnpx (λ x hnpx, hnpx (hpx x)))
(λ hnnpx x, by_contradiction (λ hnpx, hnnpx ⟨x, hnpx⟩))
example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := iff.intro
(λ hpx h, exists.elim hpx (λ x hpx, (h x) hpx))
(λ h, by_contradiction (λ hnpx, (λ (h0 : ∀ x, ¬ p x), h h0)
(λ x, (em (p x)).elim (λ hpx, absurd (exists.intro x hpx) hnpx) id)))
example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := iff.intro
(λ h x hpx, h ⟨x, hpx⟩)
(λ h h0, exists.elim h0 (λ x hpx, h x hpx))
example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := iff.intro
(λ hnapx, by_contradiction (λ hnenpx, (λ (h : ∀ x, p x), hnapx h)
(λ x, by_contradiction (λ hnpx, hnenpx ⟨x, hnpx⟩))))
(λ henpx hapx, exists.elim henpx (λ x hnpx, hnpx (hapx x)))
example : (∀ x, p x → r) ↔ (∃ x, p x) → r := iff.intro
(λ hapxr hepx, exists.elim hepx (λ x hpx, hapxr x hpx))
(λ hexpxr x px, hexpxr ⟨x,px⟩)
example : (∃ x, p x → r) ↔ (∀ x, p x) → r := iff.intro
(λ he ha, exists.elim he (λ x hr, hr (ha x)))
(λ h, (em (∀ x, p x)).elim (λ hpx, ⟨a, λ pa, h hpx⟩) (λ hnpx, by_contradiction
(λ h0, absurd (λ x, by_contradiction (λ npx, h0 ⟨x, λ hpx, absurd hpx npx⟩)) hnpx)))
example : (∃ x, r → p x) ↔ (r → ∃ x, p x) := iff.intro
(λ h hr, exists.elim h (λ x hpx, ⟨x, hpx hr⟩))
(λ h, (em r).elim (λ hr, exists.elim (h hr) (λ x px, ⟨x, λ hr, px⟩))
(λ hnr, ⟨a, λ hr, absurd hr hnr⟩))

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := iff.intro
(λ h, ⟨(λ x, (h x).left), (λ x, (h x).right)⟩)
(λ h x, ⟨h.left x, h.right x⟩)
example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := λ hpq hp x, hpq x (hp x)
example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := λ h, h.elim (λ h x, or.inl (h x))
(λ h x, or.inr (h x))

example : α → ((∀ x : α, r) ↔ r) := λ x, iff.intro (λ f, f x) (λ hr x, hr)
example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := iff.intro
(λ h, (em r).elim or.inr (λ hnr, or.inl (λ x, (h x).elim id (λ hr, absurd hr hnr))))
(λ h x, h.elim (λ h0, or.inl (h0 x)) or.inr)
example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := iff.intro
(λ h hr x, h x hr)
(λ h x hr, h hr x)

variables (men : Type) (barber : men)
variable  (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
(λ (hnp : ¬(shaves barber barber)), hnp ((h barber).elim_right hnp))
(λ hp, (h barber).elim_left hp hp)

example (p : Prop) : ¬(p ↔ ¬p) :=
λ h, (λ (hnp : ¬p), hnp (h.elim_right hnp)) (λ hp, h.elim_left hp hp)

namespace hidden

def divides (m n : ℕ) : Prop := ∃ k, m * k = n

instance : has_dvd nat := ⟨divides⟩

def even (n : ℕ) : Prop := 2 ∣ n

section
  variables m n : ℕ

  --#check m ∣ n
  --#check m^n
  --#check even (m^n +3)
end

def prime (n : ℕ) : Prop := ∀ (m : ℕ), (m ∣ n) → (m = 1 ∨ m = n)

def infinitely_many_primes : Prop := ∀ (n : ℕ), ∃ (p : ℕ), (prime p) → n < p

def Fermat_prime (n : ℕ) : Prop := ∃ (k : ℕ), n = 2 ^ k + 1

def infinitely_many_Fermat_primes : Prop := ∀ (n : ℕ), ∃ (p : ℕ), (Fermat_prime p) → n < p

def goldbach_conjecture : Prop :=
∀ (n : ℕ), n > 2 → even n → ∃ (p q : ℕ), prime p → prime q → n = p + q

def Goldbach's_weak_conjecture : Prop :=
∀ (n : ℕ), n > 5 → (¬ even n) → ∃ (p q r : ℕ), prime p → prime q → prime r → n = p + q + r

def Fermat's_last_theorem : Prop :=
∀ (n : ℕ), n > 2 → ¬ (∃ (a b c : ℕ), a ≠ 0 → b ≠ 0 → c ≠ 0 → a ^ n + b ^ n = c ^ n)

end hidden

variables (real : Type) [ordered_ring real]
variables (log exp : real → real)
variable  log_exp_eq : ∀ x, log (exp x) = x
variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
variable  exp_pos    : ∀ x, exp x > 0
variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

-- this ensures the assumptions are available in tactic proofs
include log_exp_eq exp_log_eq exp_pos exp_add

example (x y z : real) :
  exp (x + y + z) = exp x * exp y * exp z :=
by rw [exp_add, exp_add]

example (y : real) (h : y > 0)  : exp (log y) = y := exp_log_eq h

theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
  log (x * y) = log x + log y :=
calc
    log (x * y) = log (exp (log x) * exp (log y)) : by rw [exp_log_eq hx, exp_log_eq hy]
    ... = log (exp (log x + log y)) : by rw exp_add (log x) (log y)
    ... = log x + log y : by rw log_exp_eq

--#check sub_self

example (x : ℤ) : x * 0 = 0 := calc
    x * 0 = x * (x - x) : by rw sub_self x
    ... = x * x - x * x : mul_sub x x x
    ... = 0 : sub_self (x * x)


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash, Antoine Labelle
-/
import linear_algebra.dual
import linear_algebra.matrix.to_lin

/-!
# Contractions

Given modules $M, N$ over a commutative ring $R$, this file defines the natural linear maps:
$M^* \otimes M \to R$, $M \otimes M^* \to R$, and $M^* \otimes N → Hom(M, N)$, as well as proving
some basic properties of these maps.

## Tags

contraction, dual module, tensor product
-/

variables {ι : Type*} (R M N P Q : Type*)

local attribute [ext] tensor_product.ext

section contraction

open tensor_product linear_map matrix module
open_locale tensor_product big_operators

section comm_semiring
variables [comm_semiring R]
variables [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
variables [module R M] [module R N] [module R P] [module R Q]
variables [decidable_eq ι] [fintype ι] (b : basis ι R M)

/-- The natural left-handed pairing between a module and its dual. -/
def contract_left : (module.dual R M) ⊗ M →ₗ[R] R := (uncurry _ _ _ _).to_fun linear_map.id

/-- The natural right-handed pairing between a module and its dual. -/
def contract_right : M ⊗ (module.dual R M) →ₗ[R] R :=
(uncurry _ _ _ _).to_fun (linear_map.flip linear_map.id)

/-- The natural map associating a linear map to the tensor product of two modules. -/
def dual_tensor_hom : (module.dual R M) ⊗ N →ₗ[R] M →ₗ[R] N :=
  let M' := module.dual R M in
  (uncurry R M' N (M →ₗ[R] N) : _ → M' ⊗ N →ₗ[R] M →ₗ[R] N) linear_map.smul_rightₗ

variables {R M N P Q}

@[simp] lemma contract_left_apply (f : module.dual R M) (m : M) :
  contract_left R M (f ⊗ₜ m) = f m := rfl

@[simp] lemma contract_right_apply (f : module.dual R M) (m : M) :
  contract_right R M (m ⊗ₜ f) = f m := rfl

@[simp] lemma dual_tensor_hom_apply (f : module.dual R M) (m : M) (n : N) :
  dual_tensor_hom R M N (f ⊗ₜ n) m = (f m) • n :=
rfl

@[simp] lemma transpose_dual_tensor_hom (f : module.dual R M) (m : M) :
  dual.transpose (dual_tensor_hom R M M (f ⊗ₜ m)) = dual_tensor_hom R _ _ (dual.eval R M m ⊗ₜ f) :=
by { ext f' m', simp only [dual.transpose_apply, coe_comp, function.comp_app, dual_tensor_hom_apply,
  linear_map.map_smulₛₗ, ring_hom.id_apply, algebra.id.smul_eq_mul, dual.eval_apply, smul_apply],
  exact mul_comm _ _ }

@[simp] lemma dual_tensor_hom_prod_map_zero (f : module.dual R M) (p : P) :
  ((dual_tensor_hom R M P) (f ⊗ₜ[R] p)).prod_map (0 : N →ₗ[R] Q) =
  dual_tensor_hom R (M × N) (P × Q) ((f ∘ₗ fst R M N) ⊗ₜ inl R P Q p) :=
by {ext; simp only [coe_comp, coe_inl, function.comp_app, prod_map_apply, dual_tensor_hom_apply,
fst_apply, prod.smul_mk, zero_apply, smul_zero]}

@[simp] lemma zero_prod_map_dual_tensor_hom (g : module.dual R N) (q : Q) :
  (0 : M →ₗ[R] P).prod_map ((dual_tensor_hom R N Q) (g ⊗ₜ[R] q)) =
  dual_tensor_hom R (M × N) (P × Q) ((g ∘ₗ snd R M N) ⊗ₜ inr R P Q q) :=
by {ext; simp only [coe_comp, coe_inr, function.comp_app, prod_map_apply, dual_tensor_hom_apply,
  snd_apply, prod.smul_mk, zero_apply, smul_zero]}

lemma map_dual_tensor_hom (f : module.dual R M) (p : P) (g : module.dual R N) (q : Q) :
  tensor_product.map (dual_tensor_hom R M P (f ⊗ₜ[R] p)) (dual_tensor_hom R N Q (g ⊗ₜ[R] q)) =
  dual_tensor_hom R (M ⊗[R] N) (P ⊗[R] Q) (dual_distrib R M N (f ⊗ₜ g) ⊗ₜ[R] (p ⊗ₜ[R] q)) :=
begin
  ext m n, simp only [compr₂_apply, mk_apply, map_tmul, dual_tensor_hom_apply,
  dual_distrib_apply, ←smul_tmul_smul],
end

@[simp] lemma comp_dual_tensor_hom (f : module.dual R M) (n : N) (g : module.dual R N) (p : P) :
  (dual_tensor_hom R N P (g ⊗ₜ[R] p)) ∘ₗ (dual_tensor_hom R M N (f ⊗ₜ[R] n)) =
  g n • dual_tensor_hom R M P (f ⊗ₜ p) :=
begin
  ext m, simp only [coe_comp, function.comp_app, dual_tensor_hom_apply, linear_map.map_smul,
                    ring_hom.id_apply, smul_apply], rw smul_comm,
end

/-- As a matrix, `dual_tensor_hom` evaluated on a basis element of `M* ⊗ N` is a matrix with a
single one and zeros elsewhere -/
theorem to_matrix_dual_tensor_hom
  {m : Type*} {n : Type*} [fintype m] [fintype n] [decidable_eq m] [decidable_eq n]
  (bM : basis m R M) (bN : basis n R N) (j : m) (i : n) :
    to_matrix bM bN (dual_tensor_hom R M N (bM.coord j ⊗ₜ bN i)) = std_basis_matrix i j 1 :=
begin
  ext i' j',
  by_cases hij : (i = i' ∧ j = j');
  simp [linear_map.to_matrix_apply, finsupp.single_eq_pi_single, hij],
  rw [and_iff_not_or_not, not_not] at hij, cases hij; simp [hij],
end

end comm_semiring

section comm_ring
variables [comm_ring R]
variables [add_comm_group M] [add_comm_group N] [add_comm_group P] [add_comm_group Q]
variables [module R M] [module R N] [module R P] [module R Q]
variables [decidable_eq ι] [fintype ι] (b : basis ι R M)

variables {R M N P Q}

/-- If `M` is free, the natural linear map $M^* ⊗ N → Hom(M, N)$ is an equivalence. This function
provides this equivalence in return for a basis of `M`. -/
@[simps apply]
noncomputable def dual_tensor_hom_equiv_of_basis :
  (module.dual R M) ⊗[R] N ≃ₗ[R] M →ₗ[R] N :=
linear_equiv.of_linear
  (dual_tensor_hom R M N)
  (∑ i, (tensor_product.mk R _ N (b.dual_basis i)) ∘ₗ linear_map.applyₗ (b i))
  (begin
    ext f m,
    simp only [applyₗ_apply_apply, coe_fn_sum, dual_tensor_hom_apply, mk_apply, id_coe, id.def,
      fintype.sum_apply, function.comp_app, basis.coe_dual_basis, coe_comp,
      basis.coord_apply, ← f.map_smul, (dual_tensor_hom R M N).map_sum, ← f.map_sum, b.sum_repr],
  end)
  (begin
    ext f m,
    simp only [applyₗ_apply_apply, coe_fn_sum, dual_tensor_hom_apply, mk_apply, id_coe, id.def,
      fintype.sum_apply, function.comp_app, basis.coe_dual_basis, coe_comp,
      compr₂_apply, tmul_smul, smul_tmul', ← sum_tmul, basis.sum_dual_apply_smul_coord],
end)

@[simp] lemma dual_tensor_hom_equiv_of_basis_to_linear_map :
  (dual_tensor_hom_equiv_of_basis b : (module.dual R M) ⊗[R] N ≃ₗ[R] M →ₗ[R] N).to_linear_map =
  dual_tensor_hom R M N :=
rfl

@[simp] lemma dual_tensor_hom_equiv_of_basis_symm_cancel_left (x : (module.dual R M) ⊗[R] N) :
  (dual_tensor_hom_equiv_of_basis b).symm (dual_tensor_hom R M N x) = x :=
by rw [←dual_tensor_hom_equiv_of_basis_apply b, linear_equiv.symm_apply_apply]

@[simp] lemma dual_tensor_hom_equiv_of_basis_symm_cancel_right (x : M →ₗ[R] N) :
  dual_tensor_hom R M N ((dual_tensor_hom_equiv_of_basis b).symm x)  = x :=
by rw [←dual_tensor_hom_equiv_of_basis_apply b, linear_equiv.apply_symm_apply]

variables (R M N P Q)

variables [module.free R M] [module.finite R M] [nontrivial R]

open_locale classical

/-- If `M` is finite free, the natural map $M^* ⊗ N → Hom(M, N)$ is an
equivalence. -/
@[simp] noncomputable def dual_tensor_hom_equiv : (module.dual R M) ⊗[R] N ≃ₗ[R] M →ₗ[R] N :=
dual_tensor_hom_equiv_of_basis (module.free.choose_basis R M)

end comm_ring

end contraction

section hom_tensor_hom

open_locale tensor_product

open module tensor_product linear_map

section comm_ring

variables [comm_ring R]
variables [add_comm_group M] [add_comm_group N] [add_comm_group P] [add_comm_group Q]
variables [module R M] [module R N] [module R P] [module R Q]
variables [free R M] [finite R M] [free R N] [finite R N] [nontrivial R]

/-- When `M` is a finite free module, the map `ltensor_hom_to_hom_ltensor` is an equivalence. Note
that `ltensor_hom_equiv_hom_ltensor` is not defined directly in terms of
`ltensor_hom_to_hom_ltensor`, but the equivalence between the two is given by
`ltensor_hom_equiv_hom_ltensor_to_linear_map` and `ltensor_hom_equiv_hom_ltensor_apply`. -/
noncomputable def ltensor_hom_equiv_hom_ltensor : P ⊗[R] (M →ₗ[R] Q) ≃ₗ[R] (M →ₗ[R] P ⊗[R] Q) :=
congr (linear_equiv.refl R P) (dual_tensor_hom_equiv R M Q).symm ≪≫ₗ
  tensor_product.left_comm R P _ Q ≪≫ₗ dual_tensor_hom_equiv R M _

/-- When `M` is a finite free module, the map `rtensor_hom_to_hom_rtensor` is an equivalence. Note
that `rtensor_hom_equiv_hom_rtensor` is not defined directly in terms of
`rtensor_hom_to_hom_rtensor`, but the equivalence between the two is given by
`rtensor_hom_equiv_hom_rtensor_to_linear_map` and `rtensor_hom_equiv_hom_rtensor_apply`. -/
noncomputable def rtensor_hom_equiv_hom_rtensor : (M →ₗ[R] P) ⊗[R] Q ≃ₗ[R] (M →ₗ[R] P ⊗[R] Q) :=
congr (dual_tensor_hom_equiv R M P).symm (linear_equiv.refl R Q) ≪≫ₗ
  tensor_product.assoc R _ P Q ≪≫ₗ dual_tensor_hom_equiv R M _

@[simp] lemma ltensor_hom_equiv_hom_ltensor_to_linear_map :
  (ltensor_hom_equiv_hom_ltensor R M P Q).to_linear_map = ltensor_hom_to_hom_ltensor R M P Q :=
begin
  let e := congr (linear_equiv.refl R P) (dual_tensor_hom_equiv R M Q),
  have h : function.surjective e.to_linear_map := e.surjective,
  refine (cancel_right h).1 _,
  ext p f q m,
  dsimp [ltensor_hom_equiv_hom_ltensor],
  simp only [ltensor_hom_equiv_hom_ltensor, dual_tensor_hom_equiv, compr₂_apply, mk_apply, coe_comp,
  linear_equiv.coe_to_linear_map, function.comp_app, map_tmul, linear_equiv.coe_coe,
  dual_tensor_hom_equiv_of_basis_apply, linear_equiv.trans_apply, congr_tmul,
  linear_equiv.refl_apply, dual_tensor_hom_equiv_of_basis_symm_cancel_left, left_comm_tmul,
  dual_tensor_hom_apply, ltensor_hom_to_hom_ltensor_apply, tmul_smul],
end

@[simp] lemma rtensor_hom_equiv_hom_rtensor_to_linear_map :
  (rtensor_hom_equiv_hom_rtensor R M P Q).to_linear_map = rtensor_hom_to_hom_rtensor R M P Q :=
begin
  let e := congr (dual_tensor_hom_equiv R M P) (linear_equiv.refl R Q),
  have h : function.surjective e.to_linear_map := e.surjective,
  refine (cancel_right h).1 _,
  ext f p q m,
  simp only [rtensor_hom_equiv_hom_rtensor, dual_tensor_hom_equiv, compr₂_apply, mk_apply, coe_comp,
  linear_equiv.coe_to_linear_map, function.comp_app, map_tmul, linear_equiv.coe_coe,
  dual_tensor_hom_equiv_of_basis_apply, linear_equiv.trans_apply, congr_tmul,
  dual_tensor_hom_equiv_of_basis_symm_cancel_left, linear_equiv.refl_apply, assoc_tmul,
  dual_tensor_hom_apply, rtensor_hom_to_hom_rtensor_apply, smul_tmul'],
end

variables {R M N P Q}

@[simp] lemma ltensor_hom_equiv_hom_ltensor_apply (x : P ⊗[R] (M →ₗ[R] Q)) :
  ltensor_hom_equiv_hom_ltensor R M P Q x = ltensor_hom_to_hom_ltensor R M P Q x :=
by rw [←linear_equiv.coe_to_linear_map, ltensor_hom_equiv_hom_ltensor_to_linear_map]

@[simp] lemma rtensor_hom_equiv_hom_rtensor_apply (x : (M →ₗ[R] P) ⊗[R] Q) :
  rtensor_hom_equiv_hom_rtensor R M P Q x = rtensor_hom_to_hom_rtensor R M P Q x :=
by rw [←linear_equiv.coe_to_linear_map, rtensor_hom_equiv_hom_rtensor_to_linear_map]

variables (R M N P Q)

/--
When `M` and `N` are free `R` modules, the map `hom_tensor_hom_map` is an equivalence. Note that
`hom_tensor_hom_equiv` is not defined directly in terms of `hom_tensor_hom_map`, but the equivalence
between the two is given by `hom_tensor_hom_equiv_to_linear_map` and `hom_tensor_hom_equiv_apply`.
-/
noncomputable
def hom_tensor_hom_equiv : (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q) ≃ₗ[R] (M ⊗[R] N →ₗ[R] P ⊗[R] Q) :=
rtensor_hom_equiv_hom_rtensor R M P _ ≪≫ₗ
  (linear_equiv.refl R M).arrow_congr (ltensor_hom_equiv_hom_ltensor R N _ Q) ≪≫ₗ
  lift.equiv R M N _

@[simp]
lemma hom_tensor_hom_equiv_to_linear_map :
  (hom_tensor_hom_equiv R M N P Q).to_linear_map = hom_tensor_hom_map R M N P Q :=
begin
  ext f g m n,
  simp only [hom_tensor_hom_equiv, compr₂_apply, mk_apply, linear_equiv.coe_to_linear_map,
  linear_equiv.trans_apply, lift.equiv_apply, linear_equiv.arrow_congr_apply,
  linear_equiv.refl_symm, linear_equiv.refl_apply, rtensor_hom_equiv_hom_rtensor_apply,
  ltensor_hom_equiv_hom_ltensor_apply, ltensor_hom_to_hom_ltensor_apply,
  rtensor_hom_to_hom_rtensor_apply, hom_tensor_hom_map_apply, map_tmul],
end

variables {R M N P Q}

@[simp]
lemma hom_tensor_hom_equiv_apply (x : (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q)) :
  hom_tensor_hom_equiv R M N P Q x = hom_tensor_hom_map R M N P Q x :=
by rw [←linear_equiv.coe_to_linear_map, hom_tensor_hom_equiv_to_linear_map]

end comm_ring

end hom_tensor_hom


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.lattice

/-!
# Relations holding pairwise on finite sets

In this file we prove a few results about the interaction of `set.pairwise_disjoint` and `finset`.
-/

open finset

variables {α ι ι' : Type*}

instance [decidable_eq α] {r : α → α → Prop} [decidable_rel r] {s : finset α} :
  decidable ((s : set α).pairwise r) :=
decidable_of_iff' (∀ a ∈ s, ∀ b ∈ s, a ≠ b → r a b) iff.rfl

lemma finset.pairwise_disjoint_range_singleton [decidable_eq α] :
  (set.range (singleton : α → finset α)).pairwise_disjoint id :=
begin
  rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ h,
  exact disjoint_singleton.2 (ne_of_apply_ne _ h),
end

namespace set

lemma pairwise_disjoint.elim_finset [decidable_eq α] {s : set ι} {f : ι → finset α}
  (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s) (a : α) (hai : a ∈ f i)
  (haj : a ∈ f j) :
  i = j :=
hs.elim hi hj (finset.not_disjoint_iff.2 ⟨a, hai, haj⟩)

variables [lattice α] [order_bot α]

/-- Bind operation for `set.pairwise_disjoint`. In a complete lattice, you can use
`set.pairwise_disjoint.bUnion`. -/
lemma pairwise_disjoint.bUnion_finset {s : set ι'} {g : ι' → finset ι} {f : ι → α}
  (hs : s.pairwise_disjoint (λ i' : ι', (g i').sup f))
  (hg : ∀ i ∈ s, (g i : set ι).pairwise_disjoint f) :
  (⋃ i ∈ s, ↑(g i)).pairwise_disjoint f :=
begin
  rintro a ha b hb hab,
  simp_rw set.mem_Union at ha hb,
  obtain ⟨c, hc, ha⟩ := ha,
  obtain ⟨d, hd, hb⟩ := hb,
  obtain hcd | hcd := eq_or_ne (g c) (g d),
  { exact hg d hd (by rwa hcd at ha) hb hab },
  { exact (hs hc hd (ne_of_apply_ne _ hcd)).mono (finset.le_sup ha) (finset.le_sup hb) }
end

end set


/-
Copyright (c) 2021 Hunter Monroe. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hunter Monroe, Kyle Miller, Alena Gusakov
-/
import combinatorics.simple_graph.basic

/-!
# Subgraphs of a simple graph

A subgraph of a simple graph consists of subsets of the graph's vertices and edges such that the
endpoints of each edge are present in the vertex subset. The edge subset is formalized as a
sub-relation of the adjacency relation of the simple graph.

## Main definitions

* `subgraph G` is the type of subgraphs of a `G : simple_graph`

* `subgraph.neighbor_set`, `subgraph.incidence_set`, and `subgraph.degree` are like their
  `simple_graph` counterparts, but they refer to vertices from `G` to avoid subtype coercions.

* `subgraph.coe` is the coercion from a `G' : subgraph G` to a `simple_graph G'.verts`.
  (This cannot be a `has_coe` instance since the destination type depends on `G'`.)

* `subgraph.is_spanning` for whether a subgraph is a spanning subgraph and
  `subgraph.is_induced` for whether a subgraph is an induced subgraph.

* Instances for `lattice (subgraph G)` and `bounded_order (subgraph G)`.

* `simple_graph.to_subgraph`: If a `simple_graph` is a subgraph of another, then you can turn it
  into a member of the larger graph's `simple_graph.subgraph` type.

* Graph homomorphisms from a subgraph to a graph (`subgraph.map_top`) and between subgraphs
  (`subgraph.map`).

## Implementation notes

* Recall that subgraphs are not determined by their vertex sets, so `set_like` does not apply to
  this kind of subobject.

## Todo

* Images of graph homomorphisms as subgraphs.

-/

universe u

namespace simple_graph

/-- A subgraph of a `simple_graph` is a subset of vertices along with a restriction of the adjacency
relation that is symmetric and is supported by the vertex subset.  They also form a bounded lattice.

Thinking of `V → V → Prop` as `set (V × V)`, a set of darts (i.e., half-edges), then
`subgraph.adj_sub` is that the darts of a subgraph are a subset of the darts of `G`. -/
@[ext]
structure subgraph {V : Type u} (G : simple_graph V) :=
(verts : set V)
(adj : V → V → Prop)
(adj_sub : ∀ {v w : V}, adj v w → G.adj v w)
(edge_vert : ∀ {v w : V}, adj v w → v ∈ verts)
(symm : symmetric adj . obviously)

namespace subgraph

variables {V : Type u} {G : simple_graph V}

lemma adj_comm (G' : subgraph G) (v w : V) : G'.adj v w ↔ G'.adj w v :=
⟨λ x, G'.symm x, λ x, G'.symm x⟩

@[symm] lemma adj_symm (G' : subgraph G) {u v : V} (h : G'.adj u v) : G'.adj v u := G'.symm h

/-- Coercion from `G' : subgraph G` to a `simple_graph ↥G'.verts`. -/
@[simps] def coe (G' : subgraph G) : simple_graph G'.verts :=
{ adj := λ v w, G'.adj v w,
  symm := λ v w h, G'.symm h,
  loopless := λ v h, loopless G v (G'.adj_sub h) }

@[simp] lemma coe_adj_sub (G' : subgraph G) (u v : G'.verts) (h : G'.coe.adj u v) : G.adj u v :=
G'.adj_sub h

/-- A subgraph is called a *spanning subgraph* if it contains all the vertices of `G`. --/
def is_spanning (G' : subgraph G) : Prop := ∀ (v : V), v ∈ G'.verts

lemma is_spanning_iff {G' : subgraph G} : G'.is_spanning ↔ G'.verts = set.univ :=
set.eq_univ_iff_forall.symm

/-- Coercion from `subgraph G` to `simple_graph V`.  If `G'` is a spanning
subgraph, then `G'.spanning_coe` yields an isomorphic graph.
In general, this adds in all vertices from `V` as isolated vertices. -/
@[simps] def spanning_coe (G' : subgraph G) : simple_graph V :=
{ adj := G'.adj,
  symm := G'.symm,
  loopless := λ v hv, G.loopless v (G'.adj_sub hv) }

@[simp] lemma spanning_coe_adj_sub (H : subgraph G) (u v : H.verts) (h : H.spanning_coe.adj u v) :
  G.adj u v := H.adj_sub h

/-- `spanning_coe` is equivalent to `coe` for a subgraph that `is_spanning`.  -/
@[simps] def spanning_coe_equiv_coe_of_spanning (G' : subgraph G) (h : G'.is_spanning) :
  G'.spanning_coe ≃g G'.coe :=
{ to_fun := λ v, ⟨v, h v⟩,
  inv_fun := λ v, v,
  left_inv := λ v, rfl,
  right_inv := λ ⟨v, hv⟩, rfl,
  map_rel_iff' := λ v w, iff.rfl }

/-- A subgraph is called an *induced subgraph* if vertices of `G'` are adjacent if
they are adjacent in `G`. -/
def is_induced (G' : subgraph G) : Prop :=
∀ {v w : V}, v ∈ G'.verts → w ∈ G'.verts → G.adj v w → G'.adj v w

/-- `H.support` is the set of vertices that form edges in the subgraph `H`. -/
def support (H : subgraph G) : set V := rel.dom H.adj

lemma mem_support (H : subgraph G) {v : V} : v ∈ H.support ↔ ∃ w, H.adj v w := iff.rfl

lemma support_subset_verts (H : subgraph G) : H.support ⊆ H.verts := λ v ⟨w, h⟩, H.edge_vert h

/-- `G'.neighbor_set v` is the set of vertices adjacent to `v` in `G'`. -/
def neighbor_set (G' : subgraph G) (v : V) : set V := set_of (G'.adj v)

lemma neighbor_set_subset (G' : subgraph G) (v : V) : G'.neighbor_set v ⊆ G.neighbor_set v :=
λ w h, G'.adj_sub h

@[simp] lemma mem_neighbor_set (G' : subgraph G) (v w : V) : w ∈ G'.neighbor_set v ↔ G'.adj v w :=
iff.rfl

/-- A subgraph as a graph has equivalent neighbor sets. -/
def coe_neighbor_set_equiv {G' : subgraph G} (v : G'.verts) :
  G'.coe.neighbor_set v ≃ G'.neighbor_set v :=
{ to_fun := λ w, ⟨w, by { obtain ⟨w', hw'⟩ := w, simpa using hw' }⟩,
  inv_fun := λ w, ⟨⟨w, G'.edge_vert (G'.adj_symm w.2)⟩, by simpa using w.2⟩,
  left_inv := λ w, by simp,
  right_inv := λ w, by simp }

/-- The edge set of `G'` consists of a subset of edges of `G`. -/
def edge_set (G' : subgraph G) : set (sym2 V) := sym2.from_rel G'.symm

lemma edge_set_subset (G' : subgraph G) : G'.edge_set ⊆ G.edge_set :=
λ e, quotient.ind (λ e h, G'.adj_sub h) e

@[simp]
lemma mem_edge_set {G' : subgraph G} {v w : V} : ⟦(v, w)⟧ ∈ G'.edge_set ↔ G'.adj v w := iff.rfl

lemma mem_verts_if_mem_edge {G' : subgraph G} {e : sym2 V} {v : V}
  (he : e ∈ G'.edge_set) (hv : v ∈ e) : v ∈ G'.verts :=
begin
  refine quotient.ind (λ e he hv, _) e he hv,
  cases e with v w,
  simp only [mem_edge_set] at he,
  cases sym2.mem_iff.mp hv with h h; subst h,
  { exact G'.edge_vert he, },
  { exact G'.edge_vert (G'.symm he), },
end

/-- The `incidence_set` is the set of edges incident to a given vertex. -/
def incidence_set (G' : subgraph G) (v : V) : set (sym2 V) := {e ∈ G'.edge_set | v ∈ e}

lemma incidence_set_subset_incidence_set (G' : subgraph G) (v : V) :
  G'.incidence_set v ⊆ G.incidence_set v :=
λ e h, ⟨G'.edge_set_subset h.1, h.2⟩

lemma incidence_set_subset (G' : subgraph G) (v : V) : G'.incidence_set v ⊆ G'.edge_set :=
λ _ h, h.1

/-- Give a vertex as an element of the subgraph's vertex type. -/
@[reducible]
def vert (G' : subgraph G) (v : V) (h : v ∈ G'.verts) : G'.verts := ⟨v, h⟩

/--
Create an equal copy of a subgraph (see `copy_eq`) with possibly different definitional equalities.
See Note [range copy pattern].
-/
def copy (G' : subgraph G)
  (V'' : set V) (hV : V'' = G'.verts)
  (adj' : V → V → Prop) (hadj : adj' = G'.adj) :
  subgraph G :=
{ verts := V'',
  adj := adj',
  adj_sub := hadj.symm ▸ G'.adj_sub,
  edge_vert := hV.symm ▸ hadj.symm ▸ G'.edge_vert,
  symm := hadj.symm ▸ G'.symm }

lemma copy_eq (G' : subgraph G)
  (V'' : set V) (hV : V'' = G'.verts)
  (adj' : V → V → Prop) (hadj : adj' = G'.adj) :
  G'.copy V'' hV adj' hadj = G' :=
subgraph.ext _ _ hV hadj

/-- The union of two subgraphs. -/
def union (x y : subgraph G) : subgraph G :=
{ verts := x.verts ∪ y.verts,
  adj := x.adj ⊔ y.adj,
  adj_sub := λ v w h, or.cases_on h (λ h, x.adj_sub h) (λ h, y.adj_sub h),
  edge_vert := λ v w h, or.cases_on h (λ h, or.inl (x.edge_vert h)) (λ h, or.inr (y.edge_vert h)),
  symm := λ v w h, by rwa [pi.sup_apply, pi.sup_apply, x.adj_comm, y.adj_comm] }

/-- The intersection of two subgraphs. -/
def inter (x y : subgraph G) : subgraph G :=
{ verts := x.verts ∩ y.verts,
  adj := x.adj ⊓ y.adj,
  adj_sub := λ v w h, x.adj_sub h.1,
  edge_vert := λ v w h, ⟨x.edge_vert h.1, y.edge_vert h.2⟩,
  symm := λ v w h, by rwa [pi.inf_apply, pi.inf_apply, x.adj_comm, y.adj_comm] }

/-- The `top` subgraph is `G` as a subgraph of itself. -/
def top : subgraph G :=
{ verts := set.univ,
  adj := G.adj,
  adj_sub := λ v w h, h,
  edge_vert := λ v w h, set.mem_univ v,
  symm := G.symm }

/-- The `bot` subgraph is the subgraph with no vertices or edges. -/
def bot : subgraph G :=
{ verts := ∅,
  adj := λ v w, false,
  adj_sub := λ v w h, false.rec _ h,
  edge_vert := λ v w h, false.rec _ h,
  symm := λ u v h, h }

instance subgraph_inhabited : inhabited (subgraph G) := ⟨bot⟩

/-- The relation that one subgraph is a subgraph of another. -/
def is_subgraph (x y : subgraph G) : Prop := x.verts ⊆ y.verts ∧ ∀ ⦃v w : V⦄, x.adj v w → y.adj v w

instance : lattice (subgraph G) :=
{ le := is_subgraph,
  sup := union,
  inf := inter,
  le_refl := λ x, ⟨rfl.subset, λ _ _ h, h⟩,
  le_trans := λ x y z hxy hyz, ⟨hxy.1.trans hyz.1, λ _ _ h, hyz.2 (hxy.2 h)⟩,
  le_antisymm := begin
    intros x y hxy hyx,
    ext1 v,
    exact set.subset.antisymm hxy.1 hyx.1,
    ext v w,
    exact iff.intro (λ h, hxy.2 h) (λ h, hyx.2 h),
  end,
  sup_le := λ x y z hxy hyz,
            ⟨set.union_subset hxy.1 hyz.1,
              (λ v w h, h.cases_on (λ h, hxy.2 h) (λ h, hyz.2 h))⟩,
  le_sup_left := λ x y, ⟨set.subset_union_left x.verts y.verts, (λ v w h, or.inl h)⟩,
  le_sup_right := λ x y, ⟨set.subset_union_right x.verts y.verts, (λ v w h, or.inr h)⟩,
  le_inf := λ x y z hxy hyz, ⟨set.subset_inter hxy.1 hyz.1, (λ v w h, ⟨hxy.2 h, hyz.2 h⟩)⟩,
  inf_le_left := λ x y, ⟨set.inter_subset_left x.verts y.verts, (λ v w h, h.1)⟩,
  inf_le_right := λ x y, ⟨set.inter_subset_right x.verts y.verts, (λ v w h, h.2)⟩ }

instance : bounded_order (subgraph G) :=
{ top := top,
  bot := bot,
  le_top := λ x, ⟨set.subset_univ _, (λ v w h, x.adj_sub h)⟩,
  bot_le := λ x, ⟨set.empty_subset _, (λ v w h, false.rec _ h)⟩ }

/-- Turn a subgraph of a `simple_graph` into a member of its subgraph type. -/
@[simps] def _root_.simple_graph.to_subgraph (H : simple_graph V) (h : H ≤ G) :
  G.subgraph :=
{ verts := set.univ,
  adj := H.adj,
  adj_sub := h,
  edge_vert := λ v w h, set.mem_univ v,
  symm := H.symm }

lemma support_mono {H H' : subgraph G} (h : H ≤ H') : H.support ⊆ H'.support :=
rel.dom_mono h.2

lemma _root_.simple_graph.to_subgraph.is_spanning (H : simple_graph V) (h : H ≤ G) :
  (H.to_subgraph h).is_spanning := set.mem_univ

lemma spanning_coe.is_subgraph_of_is_subgraph {H H' : subgraph G} (h : H ≤ H') :
  H.spanning_coe ≤ H'.spanning_coe := h.2

/-- The top of the `subgraph G` lattice is equivalent to the graph itself. -/
def top_equiv : (⊤ : subgraph G).coe ≃g G :=
{ to_fun := λ v, ↑v,
  inv_fun := λ v, ⟨v, trivial⟩,
  left_inv := λ ⟨v, _⟩, rfl,
  right_inv := λ v, rfl,
  map_rel_iff' := λ a b, iff.rfl }

/-- The bottom of the `subgraph G` lattice is equivalent to the empty graph on the empty
vertex type. -/
def bot_equiv : (⊥ : subgraph G).coe ≃g (⊥ : simple_graph empty) :=
{ to_fun := λ v, v.property.elim,
  inv_fun := λ v, v.elim,
  left_inv := λ ⟨_, h⟩, h.elim,
  right_inv := λ v, v.elim,
  map_rel_iff' := λ a b, iff.rfl }

/-- Given two subgraphs, one a subgraph of the other, there is an induced injective homomorphism of
the subgraphs as graphs. -/
def map {x y : subgraph G} (h : x ≤ y) : x.coe →g y.coe :=
{ to_fun := λ v, ⟨↑v, and.left h v.property⟩,
  map_rel' := λ v w hvw, h.2 hvw }

lemma map.injective {x y : subgraph G} (h : x ≤ y) : function.injective (map h) :=
λ v w h, by { simp only [map, rel_hom.coe_fn_mk, subtype.mk_eq_mk] at h, exact subtype.ext h }

/-- There is an induced injective homomorphism of a subgraph of `G` into `G`. -/
def map_top (x : subgraph G) : x.coe →g G :=
{ to_fun := λ v, v,
  map_rel' := λ v w hvw, x.adj_sub hvw }

lemma map_top.injective {x : subgraph G} : function.injective x.map_top :=
λ v w h, subtype.ext h

@[simp]
lemma map_top_to_fun {x : subgraph G} (v : x.verts) : x.map_top v = v := rfl

lemma neighbor_set_subset_of_subgraph {x y : subgraph G} (h : x ≤ y) (v : V) :
  x.neighbor_set v ⊆ y.neighbor_set v :=
λ w h', h.2 h'

instance neighbor_set.decidable_pred (G' : subgraph G) [h : decidable_rel G'.adj] (v : V) :
  decidable_pred (∈ G'.neighbor_set v) := h v

/-- If a graph is locally finite at a vertex, then so is a subgraph of that graph. -/
instance finite_at {G' : subgraph G} (v : G'.verts) [decidable_rel G'.adj]
   [fintype (G.neighbor_set v)] : fintype (G'.neighbor_set v) :=
set.fintype_subset (G.neighbor_set v) (G'.neighbor_set_subset v)

/-- If a subgraph is locally finite at a vertex, then so are subgraphs of that subgraph.

This is not an instance because `G''` cannot be inferred. -/
def finite_at_of_subgraph {G' G'' : subgraph G} [decidable_rel G'.adj]
   (h : G' ≤ G'') (v : G'.verts) [hf : fintype (G''.neighbor_set v)] :
   fintype (G'.neighbor_set v) :=
set.fintype_subset (G''.neighbor_set v) (neighbor_set_subset_of_subgraph h v)

instance coe_finite_at {G' : subgraph G} (v : G'.verts) [fintype (G'.neighbor_set v)] :
  fintype (G'.coe.neighbor_set v) :=
fintype.of_equiv _ (coe_neighbor_set_equiv v).symm

/-- The degree of a vertex in a subgraph.  Is zero for vertices outside the subgraph. -/
def degree (G' : subgraph G) (v : V) [fintype (G'.neighbor_set v)] : ℕ :=
fintype.card (G'.neighbor_set v)

lemma degree_le (G' : subgraph G) (v : V)
  [fintype (G'.neighbor_set v)] [fintype (G.neighbor_set v)] :
  G'.degree v ≤ G.degree v :=
begin
  rw ←card_neighbor_set_eq_degree,
  exact set.card_le_of_subset (G'.neighbor_set_subset v),
end

lemma degree_le' (G' G'' : subgraph G) (h : G' ≤ G'') (v : V)
  [fintype (G'.neighbor_set v)] [fintype (G''.neighbor_set v)] :
  G'.degree v ≤ G''.degree v :=
set.card_le_of_subset (neighbor_set_subset_of_subgraph h v)

@[simp] lemma coe_degree (G' : subgraph G) (v : G'.verts)
  [fintype (G'.coe.neighbor_set v)] [fintype (G'.neighbor_set v)] :
  G'.coe.degree v = G'.degree v :=
begin
  rw ←card_neighbor_set_eq_degree,
  exact fintype.card_congr (coe_neighbor_set_equiv v),
end

end subgraph

end simple_graph


/-
Copyright (c) 2022 Chris Birkbeck. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Birkbeck

! This file was ported from Lean 3 source module number_theory.modular_forms.slash_invariant_forms
! leanprover-community/mathlib commit e65771194f9e923a70dfb49b6ca7be6e400d8b6f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.ModularForms.SlashActions

/-!
# Slash invariant forms

This file defines functions that are invariant under a `slash_action` which forms the basis for
defining `modular_form` and `cusp_form`. We prove several instances for such spaces, in particular
that they form a module.
-/

open Complex UpperHalfPlane

open UpperHalfPlane

noncomputable section

-- mathport name: «expr↑ₘ »
local prefix:1024 "↑ₘ" => @coe _ (Matrix (Fin 2) (Fin 2) _) _

-- mathport name: «expr↑ₘ[ ]»
-- like `↑ₘ`, but allows the user to specify the ring `R`. Useful to help Lean elaborate.
local notation "↑ₘ[" R "]" => @coe _ (Matrix (Fin 2) (Fin 2) R) _

-- mathport name: «exprGL( , )⁺»
local notation "GL(" n ", " R ")" "⁺" => Matrix.gLPos (Fin n) R

-- mathport name: «exprSL( , )»
local notation "SL(" n ", " R ")" => Matrix.SpecialLinearGroup (Fin n) R

section SlashInvariantForms

open ModularForm

variable (F : Type _) (Γ : outParam <| Subgroup SL(2, ℤ)) (k : outParam ℤ)

-- mathport name: «expr ∣[ , ]»
scoped[SlashInvariantForms] notation:73 f "∣[" k:0 "," A "]" => SlashAction.map ℂ k A f

/-- Functions `ℍ → ℂ` that are invariant under the `slash_action`. -/
structure SlashInvariantForm where
  toFun : ℍ → ℂ
  slash_action_eq' : ∀ γ : Γ, to_fun∣[k,γ] = to_fun
#align slash_invariant_form SlashInvariantForm

/-- `slash_invariant_form_class F Γ k` asserts `F` is a type of bundled functions that are invariant
under the `slash_action`. -/
class SlashInvariantFormClass extends FunLike F ℍ fun _ => ℂ where
  slash_action_eq : ∀ (f : F) (γ : Γ), (f : ℍ → ℂ)∣[k,γ] = f
#align slash_invariant_form_class SlashInvariantFormClass

attribute [nolint dangerous_instance] SlashInvariantFormClass.toFunLike

instance (priority := 100) SlashInvariantFormClass.slashInvariantForm :
    SlashInvariantFormClass (SlashInvariantForm Γ k) Γ k
    where
  coe := SlashInvariantForm.toFun
  coe_injective' f g h := by cases f <;> cases g <;> congr
  slash_action_eq := SlashInvariantForm.slash_action_eq'
#align slash_invariant_form_class.slash_invariant_form SlashInvariantFormClass.slashInvariantForm

variable {F Γ k}

instance : CoeFun (SlashInvariantForm Γ k) fun _ => ℍ → ℂ :=
  FunLike.hasCoeToFun

@[simp]
theorem slashInvariantForm_toFun_eq_coe {f : SlashInvariantForm Γ k} : f.toFun = (f : ℍ → ℂ) :=
  rfl
#align slash_invariant_form_to_fun_eq_coe slashInvariantForm_toFun_eq_coe

@[ext]
theorem slashInvariantForm_ext {f g : SlashInvariantForm Γ k} (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext f g h
#align slash_invariant_form_ext slashInvariantForm_ext

/-- Copy of a `slash_invariant_form` with a new `to_fun` equal to the old one.
Useful to fix definitional equalities. -/
protected def SlashInvariantForm.copy (f : SlashInvariantForm Γ k) (f' : ℍ → ℂ) (h : f' = ⇑f) :
    SlashInvariantForm Γ k where
  toFun := f'
  slash_action_eq' := h.symm ▸ f.slash_action_eq'
#align slash_invariant_form.copy SlashInvariantForm.copy

end SlashInvariantForms

namespace SlashInvariantForm

open SlashInvariantForm

variable {F : Type _} {Γ : outParam <| Subgroup SL(2, ℤ)} {k : outParam ℤ}

@[nolint dangerous_instance]
instance (priority := 100) SlashInvariantFormClass.coeToFun [SlashInvariantFormClass F Γ k] :
    CoeFun F fun _ => ℍ → ℂ :=
  FunLike.hasCoeToFun
#align slash_invariant_form.slash_invariant_form_class.coe_to_fun SlashInvariantForm.SlashInvariantFormClass.coeToFun

@[simp]
theorem slash_action_eqn [SlashInvariantFormClass F Γ k] (f : F) (γ : Γ) :
    SlashAction.map ℂ k γ ⇑f = ⇑f :=
  SlashInvariantFormClass.slash_action_eq f γ
#align slash_invariant_form.slash_action_eqn SlashInvariantForm.slash_action_eqn

theorem slash_action_eqn' (k : ℤ) (Γ : Subgroup SL(2, ℤ)) [SlashInvariantFormClass F Γ k] (f : F)
    (γ : Γ) (z : ℍ) : f (γ • z) = ((↑ₘ[ℤ] γ 1 0 : ℂ) * z + (↑ₘ[ℤ] γ 1 1 : ℂ)) ^ k * f z :=
  by
  rw [← ModularForm.slash_action_eq'_iff]
  simp
#align slash_invariant_form.slash_action_eqn' SlashInvariantForm.slash_action_eqn'

instance [SlashInvariantFormClass F Γ k] : CoeTC F (SlashInvariantForm Γ k) :=
  ⟨fun f =>
    { toFun := f
      slash_action_eq' := slash_action_eqn f }⟩

@[simp]
theorem SlashInvariantFormClass.coe_coe [SlashInvariantFormClass F Γ k] (f : F) :
    ((f : SlashInvariantForm Γ k) : ℍ → ℂ) = f :=
  rfl
#align slash_invariant_form.slash_invariant_form_class.coe_coe SlashInvariantForm.SlashInvariantFormClass.coe_coe

instance hasAdd : Add (SlashInvariantForm Γ k) :=
  ⟨fun f g =>
    { toFun := f + g
      slash_action_eq' := fun γ => by convert SlashAction.add_action k γ (f : ℍ → ℂ) g <;> simp }⟩
#align slash_invariant_form.has_add SlashInvariantForm.hasAdd

@[simp]
theorem coe_add (f g : SlashInvariantForm Γ k) : ⇑(f + g) = f + g :=
  rfl
#align slash_invariant_form.coe_add SlashInvariantForm.coe_add

@[simp]
theorem add_apply (f g : SlashInvariantForm Γ k) (z : ℍ) : (f + g) z = f z + g z :=
  rfl
#align slash_invariant_form.add_apply SlashInvariantForm.add_apply

instance hasZero : Zero (SlashInvariantForm Γ k) :=
  ⟨{  toFun := 0
      slash_action_eq' := SlashAction.zero_slash _ }⟩
#align slash_invariant_form.has_zero SlashInvariantForm.hasZero

@[simp]
theorem coe_zero : ⇑(0 : SlashInvariantForm Γ k) = (0 : ℍ → ℂ) :=
  rfl
#align slash_invariant_form.coe_zero SlashInvariantForm.coe_zero

section

variable {α : Type _} [SMul α ℂ] [IsScalarTower α ℂ ℂ]

instance hasSmul : SMul α (SlashInvariantForm Γ k) :=
  ⟨fun c f =>
    { toFun := c • f
      slash_action_eq' := fun γ => by
        rw [← smul_one_smul ℂ c ⇑f, SlashAction.smul_action k γ ⇑f, slash_action_eqn] }⟩
#align slash_invariant_form.has_smul SlashInvariantForm.hasSmul

@[simp]
theorem coe_smul (f : SlashInvariantForm Γ k) (n : α) : ⇑(n • f) = n • f :=
  rfl
#align slash_invariant_form.coe_smul SlashInvariantForm.coe_smul

@[simp]
theorem smul_apply (f : SlashInvariantForm Γ k) (n : α) (z : ℍ) : (n • f) z = n • f z :=
  rfl
#align slash_invariant_form.smul_apply SlashInvariantForm.smul_apply

end

instance hasNeg : Neg (SlashInvariantForm Γ k) :=
  ⟨fun f =>
    { toFun := -f
      slash_action_eq' := fun γ => by
        simpa [ModularForm.subgroup_slash, ModularForm.neg_slash] using f.slash_action_eq' γ }⟩
#align slash_invariant_form.has_neg SlashInvariantForm.hasNeg

@[simp]
theorem coe_neg (f : SlashInvariantForm Γ k) : ⇑(-f) = -f :=
  rfl
#align slash_invariant_form.coe_neg SlashInvariantForm.coe_neg

@[simp]
theorem neg_apply (f : SlashInvariantForm Γ k) (z : ℍ) : (-f) z = -f z :=
  rfl
#align slash_invariant_form.neg_apply SlashInvariantForm.neg_apply

instance hasSub : Sub (SlashInvariantForm Γ k) :=
  ⟨fun f g => f + -g⟩
#align slash_invariant_form.has_sub SlashInvariantForm.hasSub

@[simp]
theorem coe_sub (f g : SlashInvariantForm Γ k) : ⇑(f - g) = f - g :=
  rfl
#align slash_invariant_form.coe_sub SlashInvariantForm.coe_sub

@[simp]
theorem sub_apply (f g : SlashInvariantForm Γ k) (z : ℍ) : (f - g) z = f z - g z :=
  rfl
#align slash_invariant_form.sub_apply SlashInvariantForm.sub_apply

instance : AddCommGroup (SlashInvariantForm Γ k) :=
  FunLike.coe_injective.AddCommGroup _ rfl coe_add coe_neg coe_sub coe_smul coe_smul

/-- Additive coercion from `slash_invariant_form` to `ℍ → ℂ`.-/
def coeHom : SlashInvariantForm Γ k →+ ℍ → ℂ
    where
  toFun f := f
  map_zero' := rfl
  map_add' _ _ := rfl
#align slash_invariant_form.coe_hom SlashInvariantForm.coeHom

theorem coeHom_injective : Function.Injective (@coeHom Γ k) :=
  FunLike.coe_injective
#align slash_invariant_form.coe_hom_injective SlashInvariantForm.coeHom_injective

instance : Module ℂ (SlashInvariantForm Γ k) :=
  coeHom_injective.Module ℂ coeHom fun _ _ => rfl

instance : One (SlashInvariantForm Γ 0) :=
  ⟨{  toFun := 1
      slash_action_eq' := fun A => ModularForm.is_invariant_one A }⟩

@[simp]
theorem one_coe_eq_one : ((1 : SlashInvariantForm Γ 0) : ℍ → ℂ) = 1 :=
  rfl
#align slash_invariant_form.one_coe_eq_one SlashInvariantForm.one_coe_eq_one

instance : Inhabited (SlashInvariantForm Γ k) :=
  ⟨0⟩

end SlashInvariantForm